diff --git a/Batch/DESBD321.cob b/Batch/DESBD321.cob new file mode 100644 index 0000000..985bfab --- /dev/null +++ b/Batch/DESBD321.cob @@ -0,0 +1,350 @@ +00001 IDENTIFICATION DIVISION. 04/08/10 +00002 PROGRAM-ID. DESBD321. DESBD321 +00003 AUTHOR. NGC. LV005 +00004 DATE-WRITTEN. APRIL 2009. DESBD321 +00005 DATE-COMPILED. DESBD321 +00006 SKIP3 DESBD321 +00007 ***** DESBD321 +00008 * DESBD321 +00009 * DESBD321 +00010 * FUNCTION: EXTRACT CLAIMANT NAMES FROM BENEFITS DESBD321 +00011 * MASTER FILE FOR DOWNLOAD TO SERVER DESBD321 +00012 * DESBD321 +00013 * MODIFICATION LOG: DESBD321 +00014 * DESBD321 +00015 * 04/08/2009 INITIAL DEVELOPMENT. DESBD321 +00016 * WORK ORDER: PROGRAMMER: GD DESBD321 +00017 * DESBD321 +00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD321 +00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD321 +00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD321 +00021 * DESBD321 +00022 * DESBD321 +00023 * DESCRIPTION: DESBD321 +00024 * DESBD321 +00025 * DESBD321 +00026 * MODULES CALLED: DESBD321 +00027 * DESBD321 +00028 * DESBD321 +00029 * DESBD321 +00030 ***** DESBD321 +00031 SKIP3 DESBD321 +00032 ENVIRONMENT DIVISION. DESBD321 +00033 INPUT-OUTPUT SECTION. DESBD321 +00034 DESBD321 +00035 FILE-CONTROL. DESBD321 +00036 DESBD321 +00037 SELECT SSN-NAME-FILE ASSIGN TO DESFB321 DESBD321 +00038 FILE STATUS IS NAME-STATUS. DESBD321 +00039 DESBD321 +00040 DATA DIVISION. DESBD321 +00041 FILE SECTION. DESBD321 +00042 DESBD321 +00043 FD SSN-NAME-FILE DESBD321 +00044 RECORDING MODE IS F DESBD321 +00045 BLOCK CONTAINS 0 RECORDS DESBD321 +00046 LABEL RECORDS ARE OMITTED. DESBD321 +00047 DESBD321 +00048 01 SSN-NAME-REC PIC X(46). DESBD321 +00049 DESBD321 +00050 WORKING-STORAGE SECTION. DESBD321 +000505 77 PAN-VALET PICTURE X(24) VALUE '005DESBD321 04/08/10'. DESBD321 +00051 SKIP3 DESBD321 +00052 DESBD321 +00053 01 WRK-AREA. DESBD321 +00054 05 WRK-ABEND-CODE PIC X(04) VALUE 'B321'. DESBD321 +00055 DESBD321 +00056 05 NAME-STATUS PIC X(02). DESBD321 +00057 88 NAME-STATUS-OK-88 VALUE '00'. DESBD321 +00058 DESBD321 +00059 05 WRK-ERROR-IND PIC X(01). DESBD321 +00060 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD321 +00061 DESBD321 +00062 05 WRK-CURR-SSN PIC S9(09) COMP-3 VALUE +0. DESBD321 +00063 DESBD321 +00064 05 NAME-REFORMAT-AREA. DESBD321 +00065 10 NAME-MAX PIC S9(04) COMP VALUE +32. DESBD321 +00066 10 S1 PIC S9(04) COMP VALUE +0. DESBD321 +00067 10 S2 PIC S9(04) COMP VALUE +0. DESBD321 +00068 10 S3 PIC S9(04) COMP VALUE +0. DESBD321 +00069 10 WRK-LAST-FOUND PIC X(01). DESBD321 +00070 88 WRK-LAST-FOUND-YES-88 VALUE 'Y'. DESBD321 +00071 88 WRK-LAST-FOUND-NO-88 VALUE 'N'. DESBD321 +00072 10 WRK-FIRST-FOUND PIC X(01). DESBD321 +00073 88 WRK-FIRST-FOUND-YES-88 VALUE 'Y'. DESBD321 +00074 88 WRK-FIRST-FOUND-NO-88 VALUE 'N'. DESBD321 +00075 10 WRK-INIT-FOUND PIC X(01). DESBD321 +00076 88 WRK-INIT-FOUND-YES-88 VALUE 'Y'. DESBD321 +00077 88 WRK-INIT-FOUND-NO-88 VALUE 'N'. DESBD321 +00078 10 WRK-LAST-NAME PIC X(32). DESBD321 +00079 10 WRK-FIRST-NAME PIC X(32). DESBD321 +00080 10 WRK-MID-INIT PIC X(01). DESBD321 +00081 DESBD321 +00082 05 WRK-SSN-IN-CNT PIC S9(09) COMP-3 VALUE +0. DESBD321 +00083 05 WRK-X147-CNT PIC S9(09) COMP-3 VALUE +0. DESBD321 +00084 DESBD321 +00085 DESBD321 +00086 01 COMMON-LINKAGE-SECTION. DESBD321 +00087 DESBD321 +00088 ++INCLUDE ESPLINKB DESBD321 +00089 DESBD321 +00090 ++INCLUDE EWGLINKB DESBD321 +00091 DESBD321 +00092 ++INCLUDE EWGTRNB0 DESBD321 +00093 DESBD321 +00094 01 L001-LINK-AREA. DESBD321 +00095 ++INCLUDE DTSIL001 DESBD321 +00096 DESBD321 +00097 01 L005-LINK-AREA. DESBD321 +00098 ++INCLUDE DTSIL005 DESBD321 +00099 DESBD321 +00100 01 WRK-X147-REC. DESBD321 +00101 ++INCLUDE DTSIX147 DESBD321 +00102 DESBD321 +00103 PROCEDURE DIVISION. DESBD321 +00104 PERFORM I0000-INIT THRU I0000-EXIT. DESBD321 +00105 DESBD321 +00106 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD321 +00107 DESBD321 +00108 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD321 +00109 GOBACK. DESBD321 +00110 EJECT DESBD321 +00111 I0000-INIT. DESBD321 +00112 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD321 +00113 DESBD321 +00114 I0000-EXIT. DESBD321 +00115 EXIT. DESBD321 +00116 DESBD321 +00117 I1000-OPEN-FILES. DESBD321 +00118 OPEN OUTPUT SSN-NAME-FILE. DESBD321 +00119 IF NOT NAME-STATUS-OK-88 DESBD321 +00120 DISPLAY 'CANNOT OPEN SSN-NAME FILE ' NAME-STATUS DESBD321 +00121 PERFORM S9999-ABEND THRU S9999-EXIT DESBD321 +00122 END-IF. DESBD321 +00123 DESBD321 +00124 MOVE 'DESBD321' TO DB-PROGRAM-NAME. DESBD321 +00125 SET DB-HEADER-RECORD TO TRUE. DESBD321 +00126 SET DB-RANDOM-PROCESSING TO TRUE. DESBD321 +00127 SET DB-OPEN-INPUT TO TRUE. DESBD321 +00128 MOVE ZEROS TO DB-KEY. DESBD321 +00129 DESBD321 +00130 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. DESBD321 +00131 IF DB-SUCCESSFUL-COMPLETION DESBD321 +00132 NEXT SENTENCE DESBD321 +00133 ELSE DESBD321 +00134 DISPLAY 'CANNOT OPEN BENEFITS FILE' DESBD321 +00135 PERFORM S9999-ABEND THRU S9999-EXIT DESBD321 +00136 END-IF. DESBD321 +00137 DESBD321 +00138 I1000-EXIT. DESBD321 +00139 EXIT. DESBD321 +00140 DESBD321 +00141 P0000-PROCESS. DESBD321 +00142 PERFORM S1000-RESET-ALL THRU S1000-EXIT. DESBD321 +00143 PERFORM S1100-READ-SEG01 THRU S1100-EXIT. DESBD321 +00144 DESBD321 +00145 PERFORM UNTIL DB-END-OF-FILE DESBD321 +00146 IF CPD-SSN-SEQ = 0 DESBD321 +00147 PERFORM P1000-BUILD-X147 THRU P1000-EXIT DESBD321 +00148 END-IF DESBD321 +00149 PERFORM S1100-READ-SEG01 THRU S1100-EXIT DESBD321 +00150 END-PERFORM. DESBD321 +00151 DESBD321 +00152 P0000-EXIT. DESBD321 +00153 EXIT. DESBD321 +00154 DESBD321 +00155 P1000-BUILD-X147. DESBD321 +00156 MOVE CPD-SSN TO X147-SSN. DESBD321 +00157 DESBD321 +00158 MOVE CPD-INITIAL-ENTRY-DATE TO L001-FED-8-DATE-9. DESBD321 +00159 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DESBD321 +00160 IF NOT L001-VALID-DATE DESBD321 +00161 DISPLAY 'BD321 INVALID EFF DT ' CPD-SSN DESBD321 +00162 ' ' CPD-INITIAL-ENTRY-DATE DESBD321 +00163 MOVE CPD-INITIAL-ENTRY-DATE TO L001-FED-8-DATE-9 DESBD321 +00164 MOVE 2008 TO L001-FED-8-YR DESBD321 +00165 PERFORM S001-FROM-FED-8 THRU S001-EXIT DESBD321 +00166 IF L001-VALID-DATE DESBD321 +00167 MOVE L001-FED-8-DATE-9 TO X147-EFF-DATE DESBD321 +00168 ELSE DESBD321 +00169 DISPLAY 'STILL BAD ' CPD-SSN ' ' DESBD321 +00170 L001-FED-8-DATE-9 DESBD321 +00171 MOVE 20091101 TO X147-EFF-DATE DESBD321 +00172 END-IF DESBD321 +00173 ELSE DESBD321 +00174 MOVE L001-FED-8-DATE-9 TO X147-EFF-DATE DESBD321 +00175 END-IF. DESBD321 +00176 DESBD321 +00177 PERFORM P1100-REFORMAT-NAME THRU P1100-EXIT. DESBD321 +00178 MOVE WRK-LAST-NAME TO X147-LAST-NAME DESBD321 +00179 MOVE WRK-FIRST-NAME TO X147-FIRST-NAME DESBD321 +00180 MOVE WRK-MID-INIT TO X147-MID-INIT. DESBD321 +00181 DESBD321 +00182 WRITE SSN-NAME-REC FROM WRK-X147-REC. DESBD321 +00183 IF NOT NAME-STATUS-OK-88 DESBD321 +00184 DISPLAY 'CANNOT WRITE NAME REC ' NAME-STATUS DESBD321 +00185 PERFORM S9999-ABEND THRU S9999-EXIT DESBD321 +00186 ELSE DESBD321 +00187 ADD +1 TO WRK-X147-CNT DESBD321 +00188 END-IF. DESBD321 +00189 DESBD321 +00190 P1000-EXIT. DESBD321 +00191 EXIT. DESBD321 +00192 DESBD321 +00193 P1100-REFORMAT-NAME. DESBD321 +00194 INSPECT CPD-NAME REPLACING ALL ',' BY SPACE. DESBD321 +00195 INSPECT CPD-NAME REPLACING ALL LOW-VALUES BY SPACE. DESBD321 +00196 DESBD321 +00197 MOVE SPACES TO WRK-LAST-NAME DESBD321 +00198 WRK-FIRST-NAME DESBD321 +00199 WRK-MID-INIT. DESBD321 +00200 DESBD321 +00201 MOVE ZERO TO S1 DESBD321 +00202 S2. DESBD321 +00203 DESBD321 +00204 DESBD321 +00205 SET WRK-LAST-FOUND-NO-88 TO TRUE. DESBD321 +00206 SET WRK-FIRST-FOUND-NO-88 TO TRUE. DESBD321 +00207 SET WRK-INIT-FOUND-NO-88 TO TRUE. DESBD321 +00208 DESBD321 +00209 ** FIND LAST NAME DESBD321 +00210 PERFORM DESBD321 +00211 VARYING S1 FROM +1 BY +1 DESBD321 +00212 UNTIL WRK-LAST-FOUND-YES-88 DESBD321 +00213 OR S1 > NAME-MAX DESBD321 +00214 IF CPD-NAME (S1:1) NOT = '/' DESBD321 +00215 ADD +1 TO S2 DESBD321 +00216 MOVE CPD-NAME (S1:1) TO WRK-LAST-NAME(S2:1) DESBD321 +00217 ELSE DESBD321 +00218 MOVE S1 TO S3 DESBD321 +00219 SET WRK-LAST-FOUND-YES-88 TO TRUE DESBD321 +00220 END-IF DESBD321 +00221 END-PERFORM. DESBD321 +00222 DESBD321 +00223 ** FIND FIRST NAME DESBD321 +00224 MOVE ZERO TO S2. DESBD321 +00225 DESBD321 +00226 IF S3 = +32 DESBD321 +00227 GO TO P1100-EXIT DESBD321 +00228 END-IF. DESBD321 +00229 DESBD321 +00230 ADD +1 TO S3. DESBD321 +00231 DESBD321 +00232 PERFORM DESBD321 +00233 VARYING S1 FROM S3 BY +1 DESBD321 +00234 UNTIL WRK-FIRST-FOUND-YES-88 DESBD321 +00235 OR S1 > NAME-MAX DESBD321 +00236 IF CPD-NAME (S1:1) NOT = ' ' DESBD321 +00237 ADD +1 TO S2 DESBD321 +00238 MOVE CPD-NAME (S1:1) TO WRK-FIRST-NAME(S2:1) DESBD321 +00239 ELSE DESBD321 +00240 MOVE S1 TO S3 DESBD321 +00241 SET WRK-FIRST-FOUND-YES-88 TO TRUE DESBD321 +00242 END-IF DESBD321 +00243 END-PERFORM. DESBD321 +00244 DESBD321 +00245 ** FIND MIDDLE INITIAL DESBD321 +00246 DESBD321 +00247 IF S3 = +32 DESBD321 +00248 GO TO P1100-EXIT DESBD321 +00249 END-IF. DESBD321 +00250 DESBD321 +00251 PERFORM DESBD321 +00252 VARYING S1 FROM NAME-MAX BY -1 DESBD321 +00253 UNTIL WRK-INIT-FOUND-YES-88 DESBD321 +00254 OR S1 < S3 DESBD321 +00255 IF CPD-NAME (S1:1) NOT = ' ' DESBD321 +00256 IF CPD-NAME ((S1 - 1):1) = ' ' DESBD321 +00257 MOVE CPD-NAME (S1:1) TO WRK-MID-INIT DESBD321 +00258 SET WRK-INIT-FOUND-YES-88 TO TRUE DESBD321 +00259 END-IF DESBD321 +00260 END-IF DESBD321 +00261 END-PERFORM. DESBD321 +00262 DESBD321 +00263 DESBD321 +00264 P1100-EXIT. DESBD321 +00265 EXIT. DESBD321 +00266 DESBD321 +00267 DESBD321 +00268 S1000-RESET-ALL. DESBD321 +00269 SET DB-RESET-POINTERS TO TRUE. DESBD321 +00270 SET DB-RANDOM-PROCESSING TO TRUE. DESBD321 +00271 SET DB-BENEFIT-PAYMENTS TO TRUE. DESBD321 +00272 SET DB-ALL-SEGMENTS TO TRUE. DESBD321 +00273 DESBD321 +00274 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. DESBD321 +00275 DESBD321 +00276 S1000-EXIT. DESBD321 +00277 EXIT. DESBD321 +00278 DESBD321 +00279 S1100-READ-SEG01. DESBD321 +00280 SET DB-SEQUENTIAL-PROCESSING TO TRUE. DESBD321 +00281 SET DB-CLAIMANT-PROFILE TO TRUE. DESBD321 +00282 SET DB-READ-SEGMENT TO TRUE. DESBD321 +00283 DESBD321 +00284 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. DESBD321 +00285 DESBD321 +00286 IF DB-SUCCESSFUL-COMPLETION DESBD321 +00287 ADD +1 TO WRK-SSN-IN-CNT DESBD321 +00288 ELSE DESBD321 +00289 IF DB-END-OF-FILE DESBD321 +00290 NEXT SENTENCE DESBD321 +00291 ELSE DESBD321 +00292 DISPLAY 'BAD READ ON SEG01 ' DB-COMPLETION-CODE DESBD321 +00293 SET DB-END-OF-FILE TO TRUE DESBD321 +00294 END-IF DESBD321 +00295 END-IF. DESBD321 +00296 DESBD321 +00297 S1100-EXIT. DESBD321 +00298 EXIT. DESBD321 +00299 DESBD321 +00300 T0000-TERMINATE. DESBD321 +00301 DESBD321 +00302 CLOSE SSN-NAME-FILE. DESBD321 +00303 DESBD321 +00304 MOVE 'C' TO DB-COMMAND-CODE. DESBD321 +00305 DESBD321 +00306 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. DESBD321 +00307 DESBD321 +00308 DISPLAY 'SEG1 READ ' WRK-SSN-IN-CNT. DESBD321 +00309 DISPLAY 'X147 WRITTEN ' WRK-X147-CNT. DESBD321 +00310 DESBD321 +00311 T0000-EXIT. DESBD321 +00312 EXIT. DESBD321 +00313 DESBD321 +00314 S001-FROM-FED-8. DESBD321 +00315 SET L001-FROM-FED-8 TO TRUE. DESBD321 +00316 GO TO S001-DATE. DESBD321 +00317 DESBD321 +00318 S001-FROM-ABS-DAY. DESBD321 +00319 SET L001-FROM-ABS-DAY TO TRUE. DESBD321 +00320 GO TO S001-DATE. DESBD321 +00321 DESBD321 +00322 S001-FROM-CAL-6. DESBD321 +00323 SET L001-FROM-CAL-6 TO TRUE. DESBD321 +00324 GO TO S001-DATE. DESBD321 +00325 DESBD321 +00326 S001-DATE. DESBD321 +00327 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD321 +00328 S001-EXIT. DESBD321 +00329 EXIT. DESBD321 +00330 DESBD321 +00331 DESBD321 +00332 S005-FROM-SYS. DESBD321 +00333 DESBD321 +00334 SET L005-FROM-SYS TO TRUE. DESBD321 +00335 GO TO S005-ABSTIME. DESBD321 +00336 DESBD321 +00337 S005-ABSTIME. DESBD321 +00338 DESBD321 +00339 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD321 +00340 DESBD321 +00341 S005-EXIT. DESBD321 +00342 EXIT. DESBD321 +00343 DESBD321 +00344 S9999-ABEND. DESBD321 +00345 SKIP1 DESBD321 +00346 CALL 'DTSBU999' USING WRK-ABEND-CODE. DESBD321 +00347 SKIP1 DESBD321 +00348 S9999-EXIT. DESBD321 +00349 EXIT. DESBD321 diff --git a/Batch/DESBD324.cob b/Batch/DESBD324.cob new file mode 100644 index 0000000..96d0bd7 --- /dev/null +++ b/Batch/DESBD324.cob @@ -0,0 +1,301 @@ +00001 IDENTIFICATION DIVISION. 06/17/09 +00002 PROGRAM-ID. DESBD324. DESBD324 +00003 AUTHOR. NGC. LV001 +00004 DATE-WRITTEN. JUNE 2009. DESBD324 +00005 DATE-COMPILED. DESBD324 +00006 SKIP3 DESBD324 +00007 ***** DESBD324 +00008 * DESBD324 +00009 * DESBD324 +00010 * FUNCTION: EXTRACT CLAIMANT NAMES FROM BENEFITS IB6 DESBD324 +00011 * MASTER FILE FOR DOWNLOAD TO SERVER DESBD324 +00012 * MERGE REGULAR BENEFITS NAMES WITH IB6 NAMES, DESBD324 +00013 * SELECTING ONLY ONE RECORD FOR EACH SSN. DESBD324 +00014 * DESBD324 +00015 * MODIFICATION LOG: DESBD324 +00016 * DESBD324 +00017 * 06/11/2009 INITIAL DEVELOPMENT. DESBD324 +00018 * WORK ORDER: PROGRAMMER: GD DESBD324 +00019 * DESBD324 +00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD324 +00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD324 +00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD324 +00023 * DESBD324 +00024 * DESBD324 +00025 * DESCRIPTION: DESBD324 +00026 * DESBD324 +00027 * DESBD324 +00028 * MODULES CALLED: DESBD324 +00029 * DESBD324 +00030 * DESBD324 +00031 * DESBD324 +00032 ***** DESBD324 +00033 SKIP3 DESBD324 +00034 ENVIRONMENT DIVISION. DESBD324 +00035 INPUT-OUTPUT SECTION. DESBD324 +00036 DESBD324 +00037 FILE-CONTROL. DESBD324 +00038 DESBD324 +00039 SELECT IB6-NAME-FILE ASSIGN TO DESFB324 DESBD324 +00040 FILE STATUS IS NAME-STATUS. DESBD324 +00041 DESBD324 +00042 DATA DIVISION. DESBD324 +00043 FILE SECTION. DESBD324 +00044 DESBD324 +00045 FD IB6-NAME-FILE DESBD324 +00046 RECORDING MODE IS F DESBD324 +00047 BLOCK CONTAINS 0 RECORDS DESBD324 +00048 LABEL RECORDS ARE OMITTED. DESBD324 +00049 DESBD324 +00050 01 IB6-NAME-REC PIC X(46). DESBD324 +00051 DESBD324 +00052 WORKING-STORAGE SECTION. DESBD324 +000525 77 PAN-VALET PICTURE X(24) VALUE '001DESBD324 06/17/09'. DESBD324 +00053 SKIP3 DESBD324 +00054 DESBD324 +00055 01 WRK-AREA. DESBD324 +00056 05 WRK-ABEND-CODE PIC X(04) VALUE 'B324'. DESBD324 +00057 DESBD324 +00058 05 NAME-STATUS PIC X(02). DESBD324 +00059 88 NAME-STATUS-OK-88 VALUE '00'. DESBD324 +00060 DESBD324 +00061 05 WRK-ERROR-IND PIC X(01). DESBD324 +00062 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD324 +00063 DESBD324 +00064 05 WRK-CURR-SSN PIC S9(09) COMP-3 VALUE +0. DESBD324 +00065 DESBD324 +00066 05 NAME-REFORMAT-AREA. DESBD324 +00067 10 NAME-MAX PIC S9(04) COMP VALUE +32. DESBD324 +00068 10 S1 PIC S9(04) COMP VALUE +0. DESBD324 +00069 10 S2 PIC S9(04) COMP VALUE +0. DESBD324 +00070 10 S3 PIC S9(04) COMP VALUE +0. DESBD324 +00071 10 WRK-LAST-FOUND PIC X(01). DESBD324 +00072 88 WRK-LAST-FOUND-YES-88 VALUE 'Y'. DESBD324 +00073 88 WRK-LAST-FOUND-NO-88 VALUE 'N'. DESBD324 +00074 10 WRK-FIRST-FOUND PIC X(01). DESBD324 +00075 88 WRK-FIRST-FOUND-YES-88 VALUE 'Y'. DESBD324 +00076 88 WRK-FIRST-FOUND-NO-88 VALUE 'N'. DESBD324 +00077 10 WRK-INIT-FOUND PIC X(01). DESBD324 +00078 88 WRK-INIT-FOUND-YES-88 VALUE 'Y'. DESBD324 +00079 88 WRK-INIT-FOUND-NO-88 VALUE 'N'. DESBD324 +00080 10 WRK-LAST-NAME PIC X(32). DESBD324 +00081 10 WRK-FIRST-NAME PIC X(32). DESBD324 +00082 10 WRK-MID-INIT PIC X(01). DESBD324 +00083 DESBD324 +00084 05 WRK-SSN-IN-CNT PIC S9(09) COMP-3 VALUE +0. DESBD324 +00085 05 WRK-X147-CNT PIC S9(09) COMP-3 VALUE +0. DESBD324 +00086 DESBD324 +00087 DESBD324 +00088 01 IB6-LINKAGE-SECTION. DESBD324 +00089 ++INCLUDE IB6VSMCB DESBD324 +00090 EJECT DESBD324 +00091 ++INCLUDE ESPDATEW DESBD324 +00092 EJECT DESBD324 +00093 ++INCLUDE IB6SCCD DESBD324 +00094 EJECT DESBD324 +00095 ++INCLUDE ESPSTRER DESBD324 +00096 EJECT DESBD324 +00097 ++INCLUDE IB6SCSWA DESBD324 +00098 EJECT DESBD324 +00099 ++INCLUDE IB6SCTWA DESBD324 +00100 EJECT DESBD324 +00101 ++INCLUDE IB6SEG01 DESBD324 +00102 EJECT DESBD324 +00103 ++INCLUDE IB6SEG02 DESBD324 +00104 EJECT DESBD324 +00105 ++INCLUDE IB6SEG03 DESBD324 +00106 EJECT DESBD324 +00107 ++INCLUDE IB6TRAND DESBD324 +00108 EJECT DESBD324 +00109 ++INCLUDE IB6HEADR DESBD324 +00110 DESBD324 +00111 DESBD324 +00112 01 L001-LINK-AREA. DESBD324 +00113 ++INCLUDE DTSIL001 DESBD324 +00114 DESBD324 +00115 01 L005-LINK-AREA. DESBD324 +00116 ++INCLUDE DTSIL005 DESBD324 +00117 DESBD324 +00118 01 WRK-X147-REC. DESBD324 +00119 ++INCLUDE DTSIX147 DESBD324 +00120 DESBD324 +00121 PROCEDURE DIVISION. DESBD324 +00122 PERFORM I0000-INIT THRU I0000-EXIT. DESBD324 +00123 DESBD324 +00124 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD324 +00125 DESBD324 +00126 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD324 +00127 GOBACK. DESBD324 +00128 EJECT DESBD324 +00129 I0000-INIT. DESBD324 +00130 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD324 +00131 DESBD324 +00132 I0000-EXIT. DESBD324 +00133 EXIT. DESBD324 +00134 DESBD324 +00135 I1000-OPEN-FILES. DESBD324 +00136 OPEN OUTPUT IB6-NAME-FILE. DESBD324 +00137 IF NOT NAME-STATUS-OK-88 DESBD324 +00138 DISPLAY 'CANNOT OPEN IB6-NAME FILE ' NAME-STATUS DESBD324 +00139 PERFORM S9999-ABEND THRU S9999-EXIT DESBD324 +00140 END-IF. DESBD324 +00141 DESBD324 +00142 MOVE 'DESBD324' TO DB-PROGRAM-NAME. DESBD324 +00143 SET DB-HEADER-RECORD TO TRUE. DESBD324 +00144 SET DB-RANDOM-PROCESSING TO TRUE. DESBD324 +00145 SET DB-OPEN-INPUT TO TRUE. DESBD324 +00146 MOVE ZEROS TO DB-KEY. DESBD324 +00147 DESBD324 +00148 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DESBD324 +00149 IF DB-SUCCESSFUL-COMPLETION DESBD324 +00150 NEXT SENTENCE DESBD324 +00151 ELSE DESBD324 +00152 DISPLAY 'CANNOT OPEN IB6 FILE' DESBD324 +00153 PERFORM S9999-ABEND THRU S9999-EXIT DESBD324 +00154 END-IF. DESBD324 +00155 DESBD324 +00156 I1000-EXIT. DESBD324 +00157 EXIT. DESBD324 +00158 DESBD324 +00159 P0000-PROCESS. DESBD324 +00160 PERFORM S1000-RESET-ALL THRU S1000-EXIT. DESBD324 +00161 PERFORM S1100-READ-SEG01 THRU S1100-EXIT. DESBD324 +00162 DESBD324 +00163 PERFORM UNTIL DB-END-OF-FILE DESBD324 +00164 IF IN1-SSN-SEQ = 0 DESBD324 +00165 PERFORM P1000-BUILD-X147 THRU P1000-EXIT DESBD324 +00166 END-IF DESBD324 +00167 PERFORM S1100-READ-SEG01 THRU S1100-EXIT DESBD324 +00168 END-PERFORM. DESBD324 +00169 DESBD324 +00170 P0000-EXIT. DESBD324 +00171 EXIT. DESBD324 +00172 DESBD324 +00173 P1000-BUILD-X147. DESBD324 +00174 *& DESBD324 +00175 IF IN1-SSN = 229547215 OR 237745844 DESBD324 +00176 OR 567664966 OR 577179049 OR 577682101 DESBD324 +00177 OR 577782934 OR 579216134 OR 579925131 DESBD324 +00178 DISPLAY IN1-SSN ' ' IN1-INITIAL-ENTRY-DATE DESBD324 +00179 END-IF DESBD324 +00180 *& DESBD324 +00181 MOVE IN1-SSN TO X147-SSN. DESBD324 +00182 DESBD324 +00183 MOVE IN1-INITIAL-ENTRY-DATE TO L001-FED-8-DATE-9. DESBD324 +00184 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DESBD324 +00185 IF NOT L001-VALID-DATE DESBD324 +00186 DISPLAY 'BD324 INVALID EFF DT ' IN1-SSN DESBD324 +00187 ' ' IN1-INITIAL-ENTRY-DATE DESBD324 +00188 MOVE 19000101 TO X147-EFF-DATE DESBD324 +00189 ELSE DESBD324 +00190 MOVE L001-FED-8-DATE-9 TO X147-EFF-DATE DESBD324 +00191 END-IF. DESBD324 +00192 DESBD324 +00193 INSPECT IN1-CLAIM-LAST-NAME REPLACING ALL ',' BY SPACE. DESBD324 +00194 INSPECT IN1-CLAIM-LAST-NAME DESBD324 +00195 REPLACING ALL LOW-VALUES BY SPACE. DESBD324 +00196 MOVE IN1-CLAIM-LAST-NAME TO X147-LAST-NAME DESBD324 +00197 DESBD324 +00198 INSPECT IN1-CLAIM-FIRST-NAME REPLACING ALL ',' BY SPACE. DESBD324 +00199 INSPECT IN1-CLAIM-FIRST-NAME DESBD324 +00200 REPLACING ALL LOW-VALUES BY SPACE. DESBD324 +00201 MOVE IN1-CLAIM-FIRST-NAME TO X147-FIRST-NAME DESBD324 +00202 DESBD324 +00203 INSPECT IN1-CLAIM-MIDDLE-NAME REPLACING ALL ',' BY SPACE. DESBD324 +00204 INSPECT IN1-CLAIM-MIDDLE-NAME DESBD324 +00205 REPLACING ALL LOW-VALUES BY SPACE. DESBD324 +00206 MOVE IN1-CLAIM-MIDDLE-NAME TO X147-MID-INIT. DESBD324 +00207 DESBD324 +00208 WRITE IB6-NAME-REC FROM WRK-X147-REC. DESBD324 +00209 IF NOT NAME-STATUS-OK-88 DESBD324 +00210 DISPLAY 'CANNOT WRITE NAME REC ' NAME-STATUS DESBD324 +00211 PERFORM S9999-ABEND THRU S9999-EXIT DESBD324 +00212 ELSE DESBD324 +00213 ADD +1 TO WRK-X147-CNT DESBD324 +00214 END-IF. DESBD324 +00215 DESBD324 +00216 P1000-EXIT. DESBD324 +00217 EXIT. DESBD324 +00218 DESBD324 +00219 DESBD324 +00220 S1000-RESET-ALL. DESBD324 +00221 SET DB-RESET-POINTERS TO TRUE. DESBD324 +00222 SET DB-RANDOM-PROCESSING TO TRUE. DESBD324 +00223 SET DB-ALL-SEGMENTS TO TRUE. DESBD324 +00224 DESBD324 +00225 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DESBD324 +00226 DESBD324 +00227 S1000-EXIT. DESBD324 +00228 EXIT. DESBD324 +00229 DESBD324 +00230 S1100-READ-SEG01. DESBD324 +00231 SET DB-SEQUENTIAL-PROCESSING TO TRUE. DESBD324 +00232 SET DB-IB6-PROFILE TO TRUE. DESBD324 +00233 SET DB-READ-SEGMENT TO TRUE. DESBD324 +00234 DESBD324 +00235 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DESBD324 +00236 DESBD324 +00237 IF DB-SUCCESSFUL-COMPLETION DESBD324 +00238 ADD +1 TO WRK-SSN-IN-CNT DESBD324 +00239 ELSE DESBD324 +00240 IF DB-END-OF-FILE DESBD324 +00241 NEXT SENTENCE DESBD324 +00242 ELSE DESBD324 +00243 DISPLAY 'BAD READ ON SEG01 ' DB-COMPLETION-CODE DESBD324 +00244 SET DB-END-OF-FILE TO TRUE DESBD324 +00245 END-IF DESBD324 +00246 END-IF. DESBD324 +00247 DESBD324 +00248 S1100-EXIT. DESBD324 +00249 EXIT. DESBD324 +00250 DESBD324 +00251 T0000-TERMINATE. DESBD324 +00252 DESBD324 +00253 CLOSE IB6-NAME-FILE. DESBD324 +00254 DESBD324 +00255 SET DB-CLOSE-DATASET TO TRUE. DESBD324 +00256 DESBD324 +00257 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DESBD324 +00258 DESBD324 +00259 DISPLAY 'SEG1 READ ' WRK-SSN-IN-CNT. DESBD324 +00260 DISPLAY 'X147 WRITTEN ' WRK-X147-CNT. DESBD324 +00261 DESBD324 +00262 T0000-EXIT. DESBD324 +00263 EXIT. DESBD324 +00264 DESBD324 +00265 S001-FROM-FED-8. DESBD324 +00266 SET L001-FROM-FED-8 TO TRUE. DESBD324 +00267 GO TO S001-DATE. DESBD324 +00268 DESBD324 +00269 S001-FROM-ABS-DAY. DESBD324 +00270 SET L001-FROM-ABS-DAY TO TRUE. DESBD324 +00271 GO TO S001-DATE. DESBD324 +00272 DESBD324 +00273 S001-FROM-CAL-6. DESBD324 +00274 SET L001-FROM-CAL-6 TO TRUE. DESBD324 +00275 GO TO S001-DATE. DESBD324 +00276 DESBD324 +00277 S001-DATE. DESBD324 +00278 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD324 +00279 S001-EXIT. DESBD324 +00280 EXIT. DESBD324 +00281 DESBD324 +00282 DESBD324 +00283 S005-FROM-SYS. DESBD324 +00284 DESBD324 +00285 SET L005-FROM-SYS TO TRUE. DESBD324 +00286 GO TO S005-ABSTIME. DESBD324 +00287 DESBD324 +00288 S005-ABSTIME. DESBD324 +00289 DESBD324 +00290 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD324 +00291 DESBD324 +00292 S005-EXIT. DESBD324 +00293 EXIT. DESBD324 +00294 DESBD324 +00295 S9999-ABEND. DESBD324 +00296 SKIP1 DESBD324 +00297 CALL 'DTSBU999' USING WRK-ABEND-CODE. DESBD324 +00298 SKIP1 DESBD324 +00299 S9999-EXIT. DESBD324 +00300 EXIT. DESBD324 diff --git a/Batch/DESBD426.cob b/Batch/DESBD426.cob new file mode 100644 index 0000000..2960f63 --- /dev/null +++ b/Batch/DESBD426.cob @@ -0,0 +1,1019 @@ +00001 IDENTIFICATION DIVISION. 01/20/24 +00002 PROGRAM-ID. DESBD426. DESBD426 +00003 AUTHOR. NGC. LV032 +00004 DATE-WRITTEN. NOVEMBER 2013. CL**2 +00005 DATE-COMPILED. DESBD426 +00006 DESBD426 +00007 ***** DESBD426 +00008 * DESBD426 +00009 * FUNCTION: UPDATE THE WAGE NAME VSAM FILE WITH FULL NAME CL**2 +00010 * FROM DC GOVT QUARTERLY ICESA WAGE SUBMISSIONS. CL*24 +00011 * DESBD426 +00012 * DESBD426 +00013 * MODIFICATION HISTORY: DESBD426 +00014 * DESBD426 +00015 * 11/22/2011 INITIAL DEVELOPMENT DESBD426 +00016 * REFERENCE: PROGRAMMER: GD DESBD426 +00017 * DESBD426 +00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD426 +00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD426 +00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD426 +00021 * DESBD426 +00022 * DESCRIPTION: DESBD426 +00023 * DESBD426 +00024 * DESBD426 +00025 * RECORDS READ: DESBD426 +00026 * TDEC ONTINE AND DELINQUENT WAGE RECORDS CL**2 +00027 * DESBD426 +00028 * PRINTED OUTPUTS: DESBD426 +00029 * NONE DESBD426 +00030 * DESBD426 +00031 * RECORDS WRITTEN: DESBD426 +00032 * UPDATE WAGE NAME VSAM FILE CL**2 +00033 * DESBD426 +00034 * MODULES CALLED: DESBD426 +00035 * NONE DESBD426 +00036 * DESBD426 +00037 ***** DESBD426 +00038 DESBD426 +00039 ENVIRONMENT DIVISION. DESBD426 +00040 SKIP2 DESBD426 +00041 INPUT-OUTPUT SECTION. DESBD426 +00042 SKIP3 DESBD426 +00043 FILE-CONTROL. DESBD426 +00044 SELECT ICESA-DCG-IN ASSIGN TO DTSFXDCG CL*24 +00045 FILE STATUS IS TDEC-IN-STATUS. DESBD426 +00046 DESBD426 +00047 SELECT X146-WAGE-OUT ASSIGN TO DTSFX146 CL*14 +00048 FILE STATUS IS TDEC-IN-STATUS. CL**8 +00049 CL**8 +00050 DESBD426 +00051 DATA DIVISION. DESBD426 +00052 DESBD426 +00053 FILE SECTION. DESBD426 +00054 CL*24 +00055 FD ICESA-DCG-IN CL*24 +00056 RECORDING MODE F CL*24 +00057 BLOCK CONTAINS 0 RECORDS CL*24 +00058 LABEL RECORDS ARE STANDARD CL*24 +00059 DATA RECORD IS ICESA-REC. CL*24 +00060 CL*24 +00061 01 ICESA-REC. CL*24 +00062 05 ICESA-REC-TYPE PIC X(01). CL*24 +00063 05 DCG-SSN PIC X(09). CL*24 +00064 05 DCG-NAME. CL*27 +00065 15 DCG-LNAME PIC X(20). CL*27 +00066 15 DCG-FNAME PIC X(12). CL*27 +00067 15 DCG-INAME PIC X(01). CL*27 +00068 05 FILLER PIC X(171). CL*24 +00069 05 DCG-WDATE PIC 9(06). CL*24 +00070 05 FILLER PIC X(55). CL*24 +00071 CL*24 +00072 FD X146-WAGE-OUT CL**8 +00073 RECORDING MODE IS F CL**8 +00074 LABEL RECORDS ARE STANDARD CL**8 +00075 BLOCK CONTAINS 0 CHARACTERS. CL**8 +00076 SKIP1 CL**8 +00077 01 X146-REC PIC X(76). CL*15 +00078 CL**8 +00079 DESBD426 +00080 WORKING-STORAGE SECTION. DESBD426 +000805 77 PAN-VALET PICTURE X(24) VALUE '032DESBD426 01/20/24'. DESBD426 +00081 SKIP3 DESBD426 +00082 01 W-AREA. DESBD426 +00083 05 W-MOD-NAME PIC X(08) VALUE 'DESBD425'. CL**8 +00084 05 W-TRACE-IND PIC X(01) VALUE 'N'. DESBD426 +00085 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +425. CL**8 +00086 DESBD426 +00087 05 W-START-BATCH PIC S9(05) COMP-3 DESBD426 +00088 VALUE +71937. DESBD426 +00089 DESBD426 +00090 05 W-ERROR-IND PIC X(01) VALUE 'N'. DESBD426 +00091 88 W-ERROR-YES-88 VALUE 'Y'. DESBD426 +00092 88 W-ERROR-NO-88 VALUE 'N'. DESBD426 +00093 DESBD426 +00094 05 TDEC-IN-STATUS PIC X(02) VALUE SPACES. DESBD426 +00095 88 TDEC-IN-OK-88 VALUE '00'. DESBD426 +00096 88 TDEC-IN-EOF-88 VALUE '10'. DESBD426 +00097 DESBD426 +00098 05 PENDING-STATUS PIC X(02) VALUE SPACES. DESBD426 +00099 88 PENDING-OK-88 VALUE '00'. DESBD426 +00100 DESBD426 +00101 05 MISSING-RPT-STATUS PIC X(02) VALUE SPACES. DESBD426 +00102 88 MISSING-RPT-OK-88 VALUE '00'. DESBD426 +00103 DESBD426 +00104 05 WAGE-ERROR-STATUS PIC X(02) VALUE SPACES. DESBD426 +00105 88 WAGE-ERROR-OK-88 VALUE '00'. DESBD426 +00106 DESBD426 +00107 05 RECORD-COUNT-STATUS PIC X(02) VALUE SPACES. DESBD426 +00108 88 RECORD-COUNT-OK-88 VALUE '00'. DESBD426 +00109 DESBD426 +00110 05 WAGE-X148-STATUS PIC X(02) VALUE SPACES. DESBD426 +00111 88 WAGE-X148-OK-88 VALUE '00'. DESBD426 +00112 DESBD426 +00113 DESBD426 +00114 05 WAGE-X153-STATUS PIC X(02). DESBD426 +00115 88 WAGE-X153-FILE-OK-88 VALUE '00'. DESBD426 +00116 88 WAGE-X153-FILE-VERIFY-88 VALUE '97'. DESBD426 +00117 DESBD426 +00118 05 WAGE-W001-STATUS PIC X(02) VALUE SPACES. DESBD426 +00119 88 WAGE-W001-OK-88 VALUE '00'. DESBD426 +00120 DESBD426 +00121 05 WWG2-STATUS PIC X(02) VALUE SPACES. DESBD426 +00122 88 WWG2-OK-88 VALUE '00'. DESBD426 +00123 88 WWG2-EOF-88 VALUE '10'. DESBD426 +00124 DESBD426 +00125 05 WITM-STATUS PIC X(02) VALUE SPACES. DESBD426 +00126 88 WITM-OK-88 VALUE '00'. DESBD426 +00127 88 WITM-EOF-88 VALUE '10'. DESBD426 +00128 DESBD426 +00129 05 W-WAGE-REC-IND PIC X(01) VALUE 'N'. DESBD426 +00130 88 W-WAGE-REC-ERR-YES-88 VALUE 'Y'. DESBD426 +00131 88 W-WAGE-REC-ERR-NO-88 VALUE 'N'. DESBD426 +00132 DESBD426 +00133 05 W-BATCH-ERR-IND PIC X(01) VALUE 'N'. DESBD426 +00134 88 W-BATCH-ERR-YES-88 VALUE 'Y'. DESBD426 +00135 88 W-BATCH-ERR-NO-88 VALUE 'N'. DESBD426 +00136 DESBD426 +00137 05 W-EMP-NBR-CHNG-IND PIC X(01) VALUE 'N'. DESBD426 +00138 88 W-EMP-NBR-CHNG-YES-88 VALUE 'Y'. DESBD426 +00139 88 W-EMP-NBR-CHNG-NO-88 VALUE 'N'. DESBD426 +00140 DESBD426 +00141 05 W-WAGE-ERR-IND PIC X(01) VALUE 'N'. DESBD426 +00142 88 W-WAGE-ERR-YES-88 VALUE 'Y'. DESBD426 +00143 88 W-WAGE-ERR-NO-88 VALUE 'N'. DESBD426 +00144 DESBD426 +00145 05 W-WAGE-ON-FILE-IND PIC X(01) VALUE 'N'. DESBD426 +00146 88 W-WAGE-ON-FILE-YES-88 VALUE 'Y'. DESBD426 +00147 88 W-WAGE-ON-FILE-NO-88 VALUE 'N'. DESBD426 +00148 DESBD426 +00149 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DESBD426 +00150 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DESBD426 +00151 88 W-EMP-FOUND-NO-88 VALUE 'N'. DESBD426 +00152 DESBD426 +00153 05 W-EMP-LIABLE-IND PIC X(01) VALUE 'N'. DESBD426 +00154 88 W-EMP-LIABLE-YES-88 VALUE 'Y'. DESBD426 +00155 88 W-EMP-LIABLE-NO-88 VALUE 'N'. DESBD426 +00156 DESBD426 +00157 05 W-VALID-QTR-IND PIC X(01) VALUE 'N'. DESBD426 +00158 88 W-VALID-QTR-YES-88 VALUE 'Y'. DESBD426 +00159 88 W-VALID-QTR-NO-88 VALUE 'N'. DESBD426 +00160 DESBD426 +00161 05 W-RPT-FOUND-IND PIC X(01) VALUE '0'. DESBD426 +00162 88 W-RPT-FOUND-NO-88 VALUE '0'. DESBD426 +00163 88 W-RPT-FOUND-MRPT-88 VALUE '1'. DESBD426 +00164 88 W-RPT-FOUND-ATC-88 VALUE '2'. DESBD426 +00165 88 W-RPT-FOUND-YES-88 VALUE '1' '2'. DESBD426 +00166 DESBD426 +00167 05 W-SSN-ERR-IND PIC X(01) VALUE 'N'. DESBD426 +00168 88 W-SSN-ERR-YES-88 VALUE 'Y'. DESBD426 +00169 88 W-SSN-ERR-NO-88 VALUE 'N'. DESBD426 +00170 CL**8 +00171 05 WRK-SLASH-QTR. CL**8 +00172 10 WRK-YEAR PIC 9(04). CL**8 +00173 10 FILLER PIC X(01). CL**8 +00174 10 WRK-QTR PIC 9(01). CL**8 +00175 DESBD426 +00176 05 WRK-SLASH-DATE. DESBD426 +00177 10 WRK-SLASH-MM PIC 9(02). DESBD426 +00178 10 WRK-SLASH-DD PIC 9(02). DESBD426 +00179 10 WRK-SLASH-YR PIC 9(02). DESBD426 +00180 CL*24 +00181 05 WRK-EFF-DATE. CL**8 +00182 10 WRK-EFF-MM PIC 9(02). CL**8 +00183 10 FILLER PIC X(01) VALUE '/'. CL**8 +00184 10 WRK-EFF-DD PIC 9(02) VALUE 01. CL**8 +00185 10 FILLER PIC X(01) VALUE '/'. CL**8 +00186 10 WRK-EFF-CC PIC 9(02) VALUE 20. CL*24 +00187 10 WRK-EFF-YR PIC 9(02). CL*24 +00188 DESBD426 +00189 05 WRK-PEND-DATE. DESBD426 +00190 10 WRK-PEND-MM PIC 9(02). DESBD426 +00191 10 WRK-PEND-DD PIC 9(02). DESBD426 +00192 10 WRK-PEND-YR PIC 9(02). DESBD426 +00193 DESBD426 +00194 05 W-EMP-NO PIC 9(06) VALUE 0. DESBD426 +00195 05 WRK-WADD-CNT PIC 9(05) VALUE 0. CL*20 +00196 05 WRK-WUPD-CNT PIC 9(05) VALUE 0. CL*20 +00197 05 W-YRQ PIC 9(05) VALUE 0. DESBD426 +00198 05 W-ANNUAL-YRQ PIC 9(05) VALUE 0. DESBD426 +00199 05 W-DEFAULT-YRQ PIC 9(05) VALUE 0. DESBD426 +00200 05 W-DEFAULT-QTR-DISP PIC X(06) VALUE SPACES. DESBD426 +00201 05 W-CURR-EMP PIC 9(06) VALUE 0. DESBD426 +00202 05 W-CURR-QTR PIC X(06) VALUE SPACES. DESBD426 +00203 05 W-CURR-SSN PIC 9(09) VALUE 0. DESBD426 +00204 05 W-CURR-WAGES PIC 9(08)V99 VALUE 0. DESBD426 +00205 05 W-SEQ-NO PIC S9(07) COMP-3 VALUE +0. DESBD426 +00206 05 W-RPT-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD426 +00207 05 W-RPT-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD426 +00208 05 W-RPT-ITEM PIC S9(03) COMP-3 VALUE +0. DESBD426 +00209 05 W-W4-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD426 +00210 05 W-MRPT-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD426 +00211 05 W-WGH-TOT-WAGE PIC S9(09)V99 COMP-3 VALUE +0. DESBD426 +00212 05 W-SSN PIC S9(09) COMP-3 VALUE +0. CL**7 +00213 05 WRK-SSN PIC S9(09) COMP-3 VALUE +0. CL**7 +00214 05 W-MRPT-RESP-OPID PIC X(08). DESBD426 +00215 05 W-MRPT-ESTB-DATE PIC S9(09). DESBD426 +00216 05 W-DIFF PIC S9(09)V99 COMP-3 VALUE +0. DESBD426 +00217 05 W-ESTB-DATE PIC X(10) VALUE SPACES. DESBD426 +00218 05 W-SLASH-QTR. CL**8 +00219 15 W-SLASH-Y PIC X(04) VALUE SPACES. CL**8 +00220 15 W-SLASH-F PIC X(01) VALUE '/'. CL**8 +00221 15 W-SLASH-Q PIC X(01) VALUE SPACES. CL*12 +00222 05 WRK-NAME. CL**8 +00223 15 WRK-LNAME PIC X(20) VALUE SPACES. CL**8 +00224 15 WRK-FNAME PIC X(15) VALUE SPACES. CL**8 +00225 15 WRK-INAME PIC X(01) VALUE SPACES. CL*13 +00226 DESBD426 +00227 01 WAGE-TRANS-AREA. DESBD426 +00228 05 ESP-TRANSACTION-AREA PIC X(80). DESBD426 +00229 ++INCLUDE EWGTRNW4 DESBD426 +00230 EJECT DESBD426 +00231 DESBD426 +00232 05 W-W001-REC. DESBD426 +00233 ++INCLUDE DTSIW001 DESBD426 +00234 DESBD426 +00235 01 WRK-X153-REC. DESBD426 +00236 ++INCLUDE DTSIX153 DESBD426 +00237 DESBD426 +00238 05 W-RPT1-FIRST-TIME PIC X(01) VALUE 'Y'. DESBD426 +00239 88 W-RPT1-FIRST-TIME-YES-88 DESBD426 +00240 VALUE 'Y'. DESBD426 +00241 88 W-RPT1-FIRST-TIME-NO-88 DESBD426 +00242 VALUE 'N'. DESBD426 +00243 05 W-MISSING-RPT-HDR. DESBD426 +00244 10 FILLER PIC X(07) VALUE DESBD426 +00245 'EMP; '. DESBD426 +00246 10 FILLER PIC X(07) VALUE DESBD426 +00247 'BATCH#;'. DESBD426 +00248 10 FILLER PIC X(07) VALUE DESBD426 +00249 'QTR '. DESBD426 +00250 10 FILLER PIC X(06) VALUE DESBD426 +00251 'ANN?; '. DESBD426 +00252 10 FILLER PIC X(12) VALUE DESBD426 +00253 'TOT WAGES;'. DESBD426 +00254 10 FILLER PIC X(10) VALUE DESBD426 +00255 'WAGE DATE;'. DESBD426 +00256 10 FILLER PIC X(07) VALUE DESBD426 +00257 'MESSAGE'. DESBD426 +00258 DESBD426 +00259 05 W-MISSING-RPT-REC. DESBD426 +00260 10 MSRP-EMP PIC 9(06). DESBD426 +00261 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00262 10 MSRP-BATCH PIC 9(05). DESBD426 +00263 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00264 10 MSRP-QTR PIC X(06). DESBD426 +00265 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00266 10 MSRP-FILING-SCHED PIC X(05). DESBD426 +00267 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00268 10 MSRP-TOT-WAGE PIC --------9.99. DESBD426 +00269 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00270 10 MSRP-DATE PIC X(10). DESBD426 +00271 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00272 10 MSRP-REASON PIC X(40). DESBD426 +00273 88 MSRP-RSN-NOT-FOUND-88 VALUE DESBD426 +00274 'ACCOUNT NUMBER DOES NOT EXIST '. DESBD426 +00275 88 MSRP-RSN-NOT-LIABLE-88 VALUE DESBD426 +00276 'EMPLOYER NOT LIABLE '. DESBD426 +00277 88 MSRP-RSN-INVALID-QTR-88 VALUE DESBD426 +00278 'INVALID QUARTER '. DESBD426 +00279 88 MSRP-RSN-RPT-NOT-FOUND-88 VALUE DESBD426 +00280 'REPORT NOT FOUND '. DESBD426 +00281 DESBD426 +00282 05 W-RPT2-FIRST-TIME PIC X(01) VALUE 'Y'. DESBD426 +00283 88 W-RPT2-FIRST-TIME-YES-88 DESBD426 +00284 VALUE 'Y'. DESBD426 +00285 88 W-RPT2-FIRST-TIME-NO-88 DESBD426 +00286 VALUE 'N'. DESBD426 +00287 05 W-WAGE-ERROR-HDR. DESBD426 +00288 10 FILLER PIC X(09) VALUE DESBD426 +00289 'EMPLOYER;'. DESBD426 +00290 10 FILLER PIC X(09) VALUE DESBD426 +00291 'BATCH#: '. DESBD426 +00292 10 FILLER PIC X(08) VALUE DESBD426 +00293 'QUARTER;'. DESBD426 +00294 10 FILLER PIC X(09) VALUE DESBD426 +00295 'W4 WAGES;'. DESBD426 +00296 10 FILLER PIC X(12) VALUE DESBD426 +00297 'UC-30 WAGES;'. DESBD426 +00298 10 FILLER PIC X(11) VALUE DESBD426 +00299 'DIFFERENCE;'. DESBD426 +00300 10 FILLER PIC X(13) VALUE DESBD426 +00301 'WORKER COUNT;'. DESBD426 +00302 10 FILLER PIC X(14) VALUE DESBD426 +00303 'WAGES ON FILE;'. DESBD426 +00304 10 FILLER PIC X(18) VALUE DESBD426 +00305 'REPORT ENTERED DT;'. DESBD426 +00306 10 FILLER PIC X(17) VALUE DESBD426 +00307 'WAGES ENTERED DT;'. DESBD426 +00308 10 FILLER PIC X(10) VALUE DESBD426 +00309 'RESP OPID;'. DESBD426 +00310 05 W-WAGE-ERROR-REC. DESBD426 +00311 10 WERR-EMP PIC 9(06). DESBD426 +00312 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00313 10 WERR-BATCH PIC 9(05). DESBD426 +00314 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00315 10 WERR-QTR PIC X(06). DESBD426 +00316 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00317 10 WERR-W4-WAGE PIC --------9.99. DESBD426 +00318 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00319 10 WERR-MRPT-WAGE PIC --------9.99. DESBD426 +00320 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00321 10 WERR-DIFFERENCE PIC --------9.99. DESBD426 +00322 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00323 10 WERR-WORKER-CNT PIC 9(07). DESBD426 +00324 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00325 10 WERR-WGH-WAGE PIC --------9.99. DESBD426 +00326 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00327 10 WERR-RPT-DATE PIC X(10). DESBD426 +00328 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00329 10 WERR-WAGE-DATE PIC X(10). DESBD426 +00330 10 FILLER PIC X(01) VALUE ';'. DESBD426 +00331 10 WERR-RESP-OPID PIC X(08). DESBD426 +00332 DESBD426 +00333 05 W-RECORD-COUNT-REC. DESBD426 +00334 10 WC-REC-IN. DESBD426 +00335 15 FILLER PIC X(30) VALUE DESBD426 +00336 'INPUT RECORDS: '. DESBD426 +00337 15 WC-REC-IN-CNT PIC 9(07). DESBD426 +00338 10 WC-TOT-RPTS. DESBD426 +00339 15 FILLER PIC X(30) VALUE DESBD426 +00340 'TOTAL REPORTS: '. DESBD426 +00341 15 WC-TOT-RPTS-CNT PIC 9(07). DESBD426 +00342 10 WC-RPTS-FOUND. DESBD426 +00343 15 FILLER PIC X(30) VALUE DESBD426 +00344 'REPORTS FOUND: '. DESBD426 +00345 15 WC-RPTS-FOUND-CNT PIC 9(07). DESBD426 +00346 10 WC-MRPT-FOUND. DESBD426 +00347 15 FILLER PIC X(30) VALUE DESBD426 +00348 'REPORTS POSTED: '. DESBD426 +00349 15 WC-MRPT-FOUND-CNT PIC 9(07). DESBD426 +00350 10 WC-ATC-FOUND. DESBD426 +00351 15 FILLER PIC X(30) VALUE DESBD426 +00352 'REPORTS FOUND IN ATC '. DESBD426 +00353 15 WC-ATC-FOUND-CNT PIC 9(07). DESBD426 +00354 10 WC-RPT-MISSING. DESBD426 +00355 15 FILLER PIC X(30) VALUE DESBD426 +00356 'TOTAL REPORTS MISSING '. DESBD426 +00357 15 WC-RPT-MISSING-CNT PIC 9(07). DESBD426 +00358 10 WC-EMP-CHANGED. DESBD426 +00359 15 FILLER PIC X(30) VALUE DESBD426 +00360 'EMPLOYER NBR CHANGED '. DESBD426 +00361 15 WC-EMP-CHANGED-CNT PIC 9(07). DESBD426 +00362 10 WC-NOT-LIABLE. DESBD426 +00363 15 FILLER PIC X(30) VALUE DESBD426 +00364 'EMPLOYER NOT LIABLE '. DESBD426 +00365 15 WC-NOT-LIABLE-CNT PIC 9(07). DESBD426 +00366 10 WC-NO-EMP. DESBD426 +00367 15 FILLER PIC X(30) VALUE DESBD426 +00368 'EMPLOYER NBR NOT FOUND '. DESBD426 +00369 15 WC-NO-EMP-CNT PIC 9(07). DESBD426 +00370 10 WC-INVALID-QTR. DESBD426 +00371 15 FILLER PIC X(30) VALUE DESBD426 +00372 'INVALID QUARTER '. DESBD426 +00373 15 WC-INVALID-QTR-CNT PIC 9(07). DESBD426 +00374 10 WC-WAGE-DIFF. DESBD426 +00375 15 FILLER PIC X(30) VALUE DESBD426 +00376 'WAGE DISCREPANCIES '. DESBD426 +00377 15 WC-WAGE-DIFF-CNT PIC 9(07). DESBD426 +00378 10 WC-DUP-SSN. DESBD426 +00379 15 FILLER PIC X(30) VALUE DESBD426 +00380 'DUPLICATE SSNS '. DESBD426 +00381 15 WC-DUP-SSN-CNT PIC 9(07). DESBD426 +00382 10 WC-X148. DESBD426 +00383 15 FILLER PIC X(30) VALUE DESBD426 +00384 'WAGE RECORDS WRITTEN '. DESBD426 +00385 15 WC-X148-CNT PIC 9(07). DESBD426 +00386 DESBD426 +00387 05 WRK-ABSTIME PIC S9(15) COMP-3. DESBD426 +00388 05 W-TDEC-IN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00389 05 W-X148-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00390 05 W-X153-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00391 05 W-W001-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00392 05 W-REPORT-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00393 05 W-WORKER-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00394 05 W-FOUND-IN-ATC-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00395 05 W-EMP-IN-ATC-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00396 05 W-MRPT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00397 05 W-RPT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00398 05 W-RPT-MISSING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00399 05 W-EMP-NBR-CHNG-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00400 05 W-PAY-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00401 05 W-EMP-MISSING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00402 05 W-NOT-LIABLE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00403 05 W-MISS-RPT-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00404 05 W-DUP-SSN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00405 05 W-WAGE-MISMATCH-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00406 05 W-INVALID-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00407 05 W-PENDING-CNT PIC S9(07) COMP-3 VALUE +0. DESBD426 +00408 DESBD426 +00409 05 AMT-DISP1 PIC ----------9.99. DESBD426 +00410 05 AMT-DISP2 PIC ----------9.99. DESBD426 +00411 05 AMT-DISP3 PIC ----------9.99. DESBD426 +00412 05 AMT-DISP4 PIC ----------9.99. DESBD426 +00413 DESBD426 +00414 DESBD426 +00415 01 L001-LINK-AREA. DESBD426 +00416 ++INCLUDE DTSIL001 DESBD426 +00417 DESBD426 +00418 01 L004-LINK-AREA. DESBD426 +00419 ++INCLUDE DTSIL004 DESBD426 +00420 DESBD426 +00421 01 L005-LINK-AREA. DESBD426 +00422 ++INCLUDE DTSIL005 DESBD426 +00423 DESBD426 +00424 01 L516-LINK-AREA. DESBD426 +00425 ++INCLUDE DTSIL516 DESBD426 +00426 DESBD426 +00427 01 L910-LINK-AREA. DESBD426 +00428 ++INCLUDE DTSIL910 DESBD426 +00429 DESBD426 +00430 01 L982-LINK-AREA. DESBD426 +00431 ++INCLUDE DTSIL982 DESBD426 +00432 DESBD426 +00433 01 X146-WEB-REC. CL*10 +00434 ++INCLUDE DTSIX146 CL*10 +00435 CL*10 +00436 01 X144-WEB-REC. CL*10 +00437 15 X144-REC-TYPE PIC X(03) VALUE '144'. CL*19 +00438 15 FILLER PIC X(01) VALUE ','. CL*19 +00439 15 X144-EMP-NO PIC 9(06). CL*19 +00440 15 FILLER PIC X(01) VALUE ','. CL*19 +00441 15 X144-QUARTER PIC X(06). CL*19 +00442 15 FILLER PIC X(01) VALUE ','. CL*19 +00443 15 X144-AMEND PIC 9(08). CL*19 +00444 15 FILLER PIC X(01) VALUE ','. CL*19 +00445 15 X144-SSN PIC 9(09). CL*19 +00446 15 FILLER PIC X(01) VALUE ','. CL*19 +00447 15 X144-LAST-NAME PIC X(20). CL*19 +00448 15 FILLER PIC X(10). CL*19 +00449 15 FILLER PIC X(01) VALUE ','. CL*19 +00450 15 X144-FIRST-NAME PIC X(15). CL*19 +00451 15 FILLER PIC X(15). CL*19 +00452 15 FILLER PIC X(01) VALUE ','. CL*19 +00453 15 X144-MID-INIT PIC X(01). CL*19 +00454 15 FILLER PIC X(01) VALUE ','. CL*19 +00455 15 X144-EARNINGS PIC ---------9.99. CL*19 +00456 15 FILLER PIC X(01) VALUE ','. CL*19 +00457 15 FILLER PIC X(432). CL*19 +00458 CL*10 +00459 01 MSKL-REC. DESBD426 +00460 ++INCLUDE DTSIMSKL DESBD426 +00461 DESBD426 +00462 01 MHDR-REC. DESBD426 +00463 ++INCLUDE DTSIMHDR DESBD426 +00464 DESBD426 +00465 01 MPRF-REC. DESBD426 +00466 ++INCLUDE DTSIMPRF DESBD426 +00467 DESBD426 +00468 01 MRPT-REC. DESBD426 +00469 ++INCLUDE DTSIMRPT DESBD426 +00470 DESBD426 +00471 01 MPAY-REC. DESBD426 +00472 ++INCLUDE DTSIMPAY DESBD426 +00473 DESBD426 +00474 01 L923-LINK-AREA. DESBD426 +00475 ++INCLUDE DTSIL923 DESBD426 +00476 DESBD426 +00477 01 L009-LINK-AREA. CL*21 +00478 ++INCLUDE DTSIL009 CL*21 +00479 CL*21 +00480 01 ASKL-REC. DESBD426 +00481 ++INCLUDE DTSIASKL DESBD426 +00482 DESBD426 +00483 01 AHDR-REC. DESBD426 +00484 ++INCLUDE DTSIAHDR DESBD426 +00485 DESBD426 +00486 01 ARPT-REC. DESBD426 +00487 ++INCLUDE DTSIARPT DESBD426 +00488 EJECT DESBD426 +00489 01 AATX-REC. DESBD426 +00490 ++INCLUDE DTSIAATX DESBD426 +00491 DESBD426 +00492 01 APAY-REC. DESBD426 +00493 ++INCLUDE DTSIAPAY DESBD426 +00494 DESBD426 +00495 01 L931-LINK-AREA. DESBD426 +00496 ++INCLUDE DTSIL931 DESBD426 +00497 DESBD426 +00498 01 FSKL-REC. DESBD426 +00499 ++INCLUDE DTSIFSKL DESBD426 +00500 DESBD426 +00501 01 L981-LINK-AREA. DESBD426 +00502 ++INCLUDE DTSIL981 DESBD426 +00503 SKIP3 DESBD426 +00504 01 WWGH-REC. DESBD426 +00505 ++INCLUDE DTSIWWGH DESBD426 +00506 DESBD426 +00507 01 WNAM-REC. DESBD426 +00508 ++INCLUDE DTSIWNAM DESBD426 +00509 DESBD426 +00510 PROCEDURE DIVISION. DESBD426 +00511 DESBD426 +00512 DESBD422-MAIN. DESBD426 +00513 PERFORM I0000-INIT THRU I0000-EXIT. DESBD426 +00514 IF W-ERROR-YES-88 DESBD426 +00515 GO TO DESBD422-MAIN-EXIT. DESBD426 +00516 DESBD426 +00517 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD426 +00518 DESBD426 +00519 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD426 +00520 DESBD426 +00521 DESBD422-MAIN-EXIT. DESBD426 +00522 GOBACK. DESBD426 +00523 DESBD426 +00524 I0000-INIT. DESBD426 +00525 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD426 +00526 DESBD426 +00527 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD426 +00528 MOVE L005-SLASH-8-DATE TO X146-PROCESS-DATE. CL**8 +00529 MOVE L005-DATE TO L004-DATE. DESBD426 +00530 PERFORM S004-FROM-DATE THRU S004-EXIT. DESBD426 +00531 SUBTRACT 1 FROM L004-ABS-QTR. DESBD426 +00532 PERFORM S004-FROM-ABS THRU S004-EXIT. DESBD426 +00533 MOVE L004-QTR-5-9 TO W-DEFAULT-YRQ. DESBD426 +00534 MOVE L004-SLASH-5-QTR TO W-DEFAULT-QTR-DISP.DESBD426 +00535 DISPLAY 'DEFAULT QTR: ' W-DEFAULT-YRQ DESBD426 +00536 ' ' W-DEFAULT-QTR-DISP. DESBD426 +00537 DESBD426 +00538 I0000-EXIT. DESBD426 +00539 EXIT. DESBD426 +00540 DESBD426 +00541 I2000-OPEN-FILES. DESBD426 +00542 PERFORM S1000-OPEN-TDEC-IN THRU S1000-EXIT. DESBD426 +00543 IF W-ERROR-YES-88 DESBD426 +00544 GO TO I2000-EXIT DESBD426 +00545 END-IF. DESBD426 +00546 DESBD426 +00547 DESBD426 +00548 PERFORM S982O-OPEN-UPDATE THRU S982O-EXIT. CL**2 +00549 IF NOT L982-OK-88 CL*16 +00550 DISPLAY 'NAME FILE CANT OPEN'. CL*16 +00551 I2000-EXIT. DESBD426 +00552 EXIT. DESBD426 +00553 DESBD426 +00554 P0000-PROCESS. DESBD426 +00555 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT. DESBD426 +00556 IF TDEC-IN-EOF-88 DESBD426 +00557 DISPLAY 'INPUT FILE IS EMPTY' DESBD426 +00558 GO TO P0000-EXIT DESBD426 +00559 END-IF. DESBD426 +00560 DESBD426 +00561 PERFORM UNTIL TDEC-IN-EOF-88 DESBD426 +00562 PERFORM P3100-UPDATE-NAME THRU P3100-EXIT CL**2 +00563 PERFORM S1010-READ-TDEC-IN THRU S1010-EXIT DESBD426 +00564 END-PERFORM. DESBD426 +00565 DESBD426 +00566 DESBD426 +00567 P0000-EXIT. DESBD426 +00568 EXIT. DESBD426 +00569 DESBD426 +00570 DESBD426 +00571 P3100-UPDATE-NAME. DESBD426 +00572 DESBD426 +00573 * DISPLAY 'CHECK NAME ' X154-SSN ' ' X154-LAST-NAME. CL**4 +00574 MOVE SPACES TO WRK-NAME. CL**8 +00575 MOVE LOW-VALUE TO WNAM-REC. DESBD426 +00576 MOVE DCG-SSN TO WNAM-SSN WRK-SSN. CL*24 +00577 MOVE DCG-LNAME TO WRK-LNAME. CL*24 +00578 MOVE DCG-FNAME TO WRK-FNAME. CL*24 +00579 MOVE DCG-INAME TO WRK-INAME. CL*24 +00580 MOVE DCG-WDATE TO WRK-SLASH-DATE. CL*24 +00581 MOVE WRK-SLASH-MM TO WRK-EFF-MM CL*24 +00582 MOVE WRK-SLASH-DD TO WRK-EFF-DD CL*24 +00583 MOVE WRK-SLASH-YR TO WRK-EFF-YR CL*25 +00584 CL**9 +00585 MOVE L005-SLASH-8-DATE TO X146-PROCESS-DATE. CL**9 +00586 CL**9 +00587 IF DCG-LNAME > SPACES CL*24 +00588 MOVE DCG-LNAME TO L009-DATA CL*24 +00589 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*20 +00590 MOVE L009-DATA TO WRK-LNAME DCG-LNAME CL*24 +00591 ELSE CL*20 +00592 MOVE DCG-LNAME TO WRK-LNAME. CL*24 +00593 CL**9 +00594 IF DCG-FNAME > SPACES CL*24 +00595 MOVE DCG-FNAME TO L009-DATA CL*24 +00596 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*20 +00597 MOVE L009-DATA TO WRK-FNAME DCG-FNAME CL*24 +00598 ELSE CL*20 +00599 MOVE DCG-FNAME TO WRK-FNAME. CL*24 +00600 CL*20 +00601 IF DCG-INAME > SPACES CL*24 +00602 MOVE DCG-INAME TO L009-DATA CL*24 +00603 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*20 +00604 MOVE L009-DATA TO WRK-INAME DCG-INAME CL*24 +00605 ELSE CL*20 +00606 MOVE DCG-INAME TO WRK-INAME. CL*24 +00607 CL*20 +00608 MOVE WRK-EFF-DATE TO X146-EFF-DATE. CL**9 +00609 DESBD426 +00610 PERFORM S982A-START-BROWSE THRU S982A-EXIT. DESBD426 +00611 DESBD426 +00612 IF NOT L982-OK-88 DESBD426 +00613 DISPLAY 'BROWSE NOT OK-ADD NAME' CL**4 +00614 PERFORM P3110-ADD-NAME THRU P3110-EXIT DESBD426 +00615 GO TO P3100-EXIT DESBD426 +00616 END-IF. DESBD426 +00617 DESBD426 +00618 MOVE WNAM-SSN TO W-SSN. DESBD426 +00619 DESBD426 +00620 IF WRK-SSN = W-SSN CL**7 +00621 NEXT SENTENCE DESBD426 +00622 ELSE DESBD426 +00623 DISPLAY 'SSN NOT ON FILE ADD ' X144-SSN CL*23 +00624 PERFORM P3110-ADD-NAME THRU P3110-EXIT DESBD426 +00625 GO TO P3100-EXIT. DESBD426 +00626 DESBD426 +00627 IF WNAM-FIRST-NAME = WRK-FNAME AND CL*32 +00628 WNAM-LAST-NAME = WRK-LNAME CL*32 +00629 GO TO P3100-EXIT CL*32 +00630 END-IF. CL*32 +00631 DESBD426 +00632 * IF WNAM-TYPE-3CHAR-88 CL*28 +00633 PERFORM P3120-REWRITE-NAME THRU P3120-EXIT. CL*28 +00634 * ELSE CL*28 +00635 * DISPLAY 'WNAM ' WNAM-SSN ' ' WNAM-NAME-TYPE ' ' WNAM-NAME CL*28 +00636 * DISPLAY ' DCG ' DCG-SSN ' ' WNAM-NAME-TYPE ' ' DCG-NAME CL*28 +00637 * END-IF. CL*28 +00638 DESBD426 +00639 P3100-EXIT. DESBD426 +00640 EXIT. DESBD426 +00641 P3110-ADD-NAME. DESBD426 +00642 * DESBD426 +00643 * DISPLAY 'ADD NAME P3110 ' W001-LAST-NAME. CL**8 +00644 * DESBD426 +00645 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD426 +00646 ADD +1 TO L005-ABSTIME. DESBD426 +00647 PERFORM S005-ABSTIME THRU S005-EXIT. DESBD426 +00648 MOVE L005-NINES-COMPLEMENT-ABSTIME DESBD426 +00649 TO WNAM-NINES-COMPLEMENT-ABSTIME. DESBD426 +00650 MOVE DCG-SSN TO WNAM-SSN. CL*24 +00651 MOVE DCG-LNAME TO WNAM-LAST-NAME. CL*24 +00652 MOVE DCG-FNAME TO WNAM-FIRST-NAME. CL*24 +00653 MOVE DCG-INAME TO WNAM-MID-INIT. CL*24 +00654 SET WNAM-TYPE-FULL-88 TO TRUE. DESBD426 +00655 PERFORM S982C-WRITE THRU S982C-EXIT. DESBD426 +00656 DISPLAY ' REC ADDED ' DCG-SSN ' ' DCG-LNAME ' ' CL*24 +00657 DCG-FNAME. CL*24 +00658 ADD +1 TO WRK-WADD-CNT. CL*20 +00659 *& CL**9 +00660 MOVE DCG-SSN TO X146-SSN CL*24 +00661 INSPECT DCG-LNAME CL*31 +00662 REPLACING ALL ',' BY ' '. CL*30 +00663 INSPECT DCG-FNAME CL*31 +00664 REPLACING ALL ',' BY ' '. CL*30 +00665 MOVE DCG-LNAME TO X146-LAST-NAME. CL*31 +00666 MOVE DCG-FNAME TO X146-FIRST-NAME. CL*31 +00667 MOVE DCG-INAME TO X146-MID-INIT. CL*24 +00668 SET X146-INSERT-88 TO TRUE. CL*10 +00669 WRITE X146-REC FROM X146-WEB-REC. CL*13 +00670 DESBD426 +00671 P3110-EXIT. DESBD426 +00672 EXIT. DESBD426 +00673 DESBD426 +00674 P3120-REWRITE-NAME. DESBD426 +00675 *& DESBD426 +00676 * DISPLAY 'UPD NAME P3120 ' W001-LAST-NAME. CL*20 +00677 *& DESBD426 +00678 MOVE DCG-LNAME TO WNAM-LAST-NAME. CL*26 +00679 MOVE DCG-FNAME TO WNAM-FIRST-NAME. CL*26 +00680 MOVE DCG-INAME TO WNAM-MID-INIT. CL*26 +00681 SET WNAM-TYPE-FULL-88 TO TRUE. DESBD426 +00682 DESBD426 +00683 PERFORM S982D-REWRITE THRU S982D-EXIT. DESBD426 +00684 DESBD426 +00685 DISPLAY ' REC UPDT ' DCG-SSN ' ' DCG-LNAME ' ' CL*26 +00686 DCG-FNAME. CL*26 +00687 ADD +1 TO WRK-WUPD-CNT. CL*20 +00688 *& CL**8 +00689 MOVE DCG-SSN TO X146-SSN CL*26 +00690 INSPECT DCG-LNAME CL*31 +00691 REPLACING ALL ',' BY ' '. CL*30 +00692 INSPECT DCG-FNAME CL*31 +00693 REPLACING ALL ',' BY ' '. CL*30 +00694 MOVE DCG-LNAME TO X146-LAST-NAME. CL*31 +00695 MOVE DCG-FNAME TO X146-FIRST-NAME. CL*31 +00696 MOVE DCG-INAME TO X146-MID-INIT. CL*26 +00697 SET X146-UPDATE-88 TO TRUE. CL*26 +00698 WRITE X146-REC FROM X146-WEB-REC. CL*13 +00699 DESBD426 +00700 P3120-EXIT. DESBD426 +00701 EXIT. DESBD426 +00702 DESBD426 +00703 DESBD426 +00704 T0000-TERMINATE. DESBD426 +00705 DESBD426 +00706 DISPLAY ' '. DESBD426 +00707 DISPLAY ' '. DESBD426 +00708 DESBD426 +00709 DISPLAY '*** DESBD425 TERMINATION STATISTICS ***'. CL**2 +00710 DESBD426 +00711 DISPLAY ' '. DESBD426 +00712 DESBD426 +00713 DISPLAY ' '. DESBD426 +00714 DISPLAY 'TDEC RECORDS READ : 'DESBD426 +00715 W-TDEC-IN-CNT. DESBD426 +00716 DESBD426 +00717 DISPLAY ' '. DESBD426 +00718 DISPLAY 'TOTAL NAMES ADDED : ' CL**2 +00719 WRK-WADD-CNT. CL*20 +00720 DESBD426 +00721 DISPLAY ' '. DESBD426 +00722 DISPLAY 'TOTAL NAMES UPDATED : ' CL**2 +00723 WRK-WUPD-CNT. CL*20 +00724 DESBD426 +00725 DESBD426 +00726 PERFORM S1020-CLOSE-TDEC-IN THRU S1020-EXIT. DESBD426 +00727 DESBD426 +00728 PERFORM S982F-CLOSE THRU S982F-EXIT. CL**2 +00729 DESBD426 +00730 T0000-EXIT. DESBD426 +00731 EXIT. DESBD426 +00732 DESBD426 +00733 S001-FROM-FED-8. DESBD426 +00734 SET L001-FROM-FED-8 TO TRUE. DESBD426 +00735 GO TO S001-DATE. DESBD426 +00736 DESBD426 +00737 S001-FROM-CAL-8. DESBD426 +00738 SET L001-FROM-CAL-8 TO TRUE. DESBD426 +00739 GO TO S001-DATE. DESBD426 +00740 DESBD426 +00741 S001-FROM-ABS-DAY. DESBD426 +00742 SET L001-FROM-ABS-DAY TO TRUE. DESBD426 +00743 GO TO S001-DATE. DESBD426 +00744 DESBD426 +00745 S001-DATE. DESBD426 +00746 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD426 +00747 S001-EXIT. DESBD426 +00748 EXIT. DESBD426 +00749 DESBD426 +00750 S004-FROM-DATE. DESBD426 +00751 SET L004-FROM-DATE TO TRUE. DESBD426 +00752 GO TO S004-QTR. DESBD426 +00753 DESBD426 +00754 S004-FROM-5. DESBD426 +00755 SET L004-FROM-5 TO TRUE. DESBD426 +00756 GO TO S004-QTR. DESBD426 +00757 DESBD426 +00758 S004-FROM-ABS. DESBD426 +00759 SET L004-FROM-ABS TO TRUE. DESBD426 +00760 GO TO S004-QTR. DESBD426 +00761 DESBD426 +00762 S004-FROM-3. DESBD426 +00763 SET L004-FROM-3 TO TRUE. DESBD426 +00764 GO TO S004-QTR. DESBD426 +00765 DESBD426 +00766 S004-QTR. DESBD426 +00767 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD426 +00768 S004-EXIT. DESBD426 +00769 DESBD426 +00770 S005-FROM-SYS. DESBD426 +00771 SET L005-FROM-SYS TO TRUE. DESBD426 +00772 GO TO S005-ABSTIME. DESBD426 +00773 DESBD426 +00774 S005-ABSTIME. DESBD426 +00775 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD426 +00776 S005-EXIT. DESBD426 +00777 EXIT. DESBD426 +00778 DESBD426 +00779 S516-LIABILITY-INFO. DESBD426 +00780 CALL 'DTSBU516' USING L516-LINK-AREA DESBD426 +00781 MPRF-REC. DESBD426 +00782 S516-EXIT. DESBD426 +00783 EXIT. DESBD426 +00784 DESBD426 +00785 S910A-OPEN-READ. DESBD426 +00786 SET L910-OPEN-READ-88 TO TRUE. DESBD426 +00787 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD426 +00788 DESBD426 +00789 S910A-EXIT. DESBD426 +00790 EXIT. DESBD426 +00791 DESBD426 +00792 S910C-CLOSE. DESBD426 +00793 SET L910-CLOSE-88 TO TRUE. DESBD426 +00794 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD426 +00795 DESBD426 +00796 S910C-EXIT. DESBD426 +00797 EXIT. DESBD426 +00798 DESBD426 +00799 S910D-START-BROWSE. DESBD426 +00800 SET L910-START-BROWSE-88 TO TRUE. DESBD426 +00801 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD426 +00802 DESBD426 +00803 S910D-EXIT. DESBD426 +00804 EXIT. DESBD426 +00805 DESBD426 +00806 S910E-READ-NEXT. DESBD426 +00807 SET L910-READ-NEXT-88 TO TRUE. DESBD426 +00808 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD426 +00809 DESBD426 +00810 S910E-EXIT. DESBD426 +00811 EXIT. DESBD426 +00812 DESBD426 +00813 S910F-READ. DESBD426 +00814 SET L910-READ-88 TO TRUE. DESBD426 +00815 PERFORM S910Z-MSTR-I THRU S910Z-EXIT. DESBD426 +00816 DESBD426 +00817 S910F-EXIT. DESBD426 +00818 EXIT. DESBD426 +00819 DESBD426 +00820 S910Z-MSTR-I. DESBD426 +00821 CALL 'DTSBU910' USING L910-LINK-AREA DESBD426 +00822 MSKL-REC. DESBD426 +00823 S910Z-EXIT. DESBD426 +00824 EXIT. DESBD426 +00825 DESBD426 +00826 S923A-OPEN-READ. DESBD426 +00827 SET L923-OPEN-READ-88 TO TRUE. DESBD426 +00828 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD426 +00829 DESBD426 +00830 S923A-EXIT. DESBD426 +00831 EXIT. DESBD426 +00832 DESBD426 +00833 S923B-START-BROWSE. DESBD426 +00834 SET L923-START-BROWSE-88 TO TRUE. DESBD426 +00835 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD426 +00836 DESBD426 +00837 S923B-EXIT. DESBD426 +00838 EXIT. DESBD426 +00839 DESBD426 +00840 S923C-READ-NEXT. DESBD426 +00841 SET L923-READ-NEXT-88 TO TRUE. DESBD426 +00842 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD426 +00843 DESBD426 +00844 S923C-EXIT. DESBD426 +00845 EXIT. DESBD426 +00846 DESBD426 +00847 S923D-READ. DESBD426 +00848 SET L923-READ-88 TO TRUE. DESBD426 +00849 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD426 +00850 DESBD426 +00851 S923D-EXIT. DESBD426 +00852 EXIT. DESBD426 +00853 DESBD426 +00854 S923E-CLOSE. DESBD426 +00855 SET L923-CLOSE-88 TO TRUE. DESBD426 +00856 PERFORM S923Z-ATC-IO THRU S923Z-EXIT. DESBD426 +00857 DESBD426 +00858 S923E-EXIT. DESBD426 +00859 EXIT. DESBD426 +00860 DESBD426 +00861 DESBD426 +00862 S923Z-ATC-IO. DESBD426 +00863 CALL 'DTSBU923' USING L923-LINK-AREA DESBD426 +00864 ASKL-REC. DESBD426 +00865 S923Z-EXIT. DESBD426 +00866 EXIT. DESBD426 +00867 DESBD426 +00868 S931-OPEN-READ. DESBD426 +00869 SET L931-OPEN-READ-88 TO TRUE. DESBD426 +00870 GO TO S931-REF-IO. DESBD426 +00871 DESBD426 +00872 S931-CLOSE. DESBD426 +00873 SET L931-CLOSE-88 TO TRUE. DESBD426 +00874 GO TO S931-REF-IO. DESBD426 +00875 DESBD426 +00876 S931-REF-IO. DESBD426 +00877 CALL 'DTSBU931' USING L931-LINK-AREA DESBD426 +00878 FSKL-REC. DESBD426 +00879 S931-EXIT. DESBD426 +00880 EXIT. DESBD426 +00881 DESBD426 +00882 S981A-OPEN-READ. DESBD426 +00883 SET L981-OPEN-READ-88 TO TRUE. DESBD426 +00884 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD426 +00885 DESBD426 +00886 S981A-EXIT. DESBD426 +00887 EXIT. DESBD426 +00888 DESBD426 +00889 S981C-CLOSE. DESBD426 +00890 SET L981-CLOSE-88 TO TRUE. DESBD426 +00891 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD426 +00892 DESBD426 +00893 S981C-EXIT. DESBD426 +00894 EXIT. DESBD426 +00895 DESBD426 +00896 S981D-START-BROWSE. DESBD426 +00897 SET L981-START-BROWSE-88 TO TRUE. DESBD426 +00898 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD426 +00899 DESBD426 +00900 S981D-EXIT. DESBD426 +00901 EXIT. DESBD426 +00902 DESBD426 +00903 S981E-READ-NEXT. DESBD426 +00904 SET L981-READ-NEXT-88 TO TRUE. DESBD426 +00905 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD426 +00906 DESBD426 +00907 S981E-EXIT. DESBD426 +00908 EXIT. DESBD426 +00909 DESBD426 +00910 S981F-READ. DESBD426 +00911 SET L981-READ-88 TO TRUE. DESBD426 +00912 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DESBD426 +00913 DESBD426 +00914 S981F-EXIT. DESBD426 +00915 EXIT. DESBD426 +00916 DESBD426 +00917 S981Z-WAGE-I. DESBD426 +00918 CALL 'DTSBU981' USING L981-LINK-AREA DESBD426 +00919 WWGH-REC. DESBD426 +00920 S981Z-EXIT. DESBD426 +00921 EXIT. DESBD426 +00922 S982O-OPEN-UPDATE. DESBD426 +00923 SET L982-OPEN-UPDATE-88 TO TRUE. DESBD426 +00924 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD426 +00925 DESBD426 +00926 S982O-EXIT. DESBD426 +00927 EXIT. DESBD426 +00928 DESBD426 +00929 S982A-START-BROWSE. DESBD426 +00930 SET L982-START-BROWSE-88 TO TRUE. DESBD426 +00931 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD426 +00932 DESBD426 +00933 S982A-EXIT. DESBD426 +00934 EXIT. DESBD426 +00935 DESBD426 +00936 S982B-READ-NEXT. DESBD426 +00937 SET L982-READ-NEXT-88 TO TRUE. DESBD426 +00938 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD426 +00939 DESBD426 +00940 S982B-EXIT. DESBD426 +00941 EXIT. DESBD426 +00942 S982C-WRITE. DESBD426 +00943 SET L982-WRITE-88 TO TRUE. DESBD426 +00944 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD426 +00945 DESBD426 +00946 S982C-EXIT. DESBD426 +00947 EXIT. DESBD426 +00948 DESBD426 +00949 S982D-REWRITE. DESBD426 +00950 SET L982-REWRITE-88 TO TRUE. DESBD426 +00951 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD426 +00952 DESBD426 +00953 S982D-EXIT. DESBD426 +00954 EXIT. DESBD426 +00955 S982F-CLOSE. DESBD426 +00956 SET L982-CLOSE-88 TO TRUE. DESBD426 +00957 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD426 +00958 DESBD426 +00959 S982F-EXIT. DESBD426 +00960 EXIT. DESBD426 +00961 DESBD426 +00962 S982Z-WNAM-IO. DESBD426 +00963 CALL 'DTSBU982' USING L982-LINK-AREA DESBD426 +00964 WNAM-REC. DESBD426 +00965 S982Z-EXIT. DESBD426 +00966 EXIT. DESBD426 +00967 DESBD426 +00968 S1000-OPEN-TDEC-IN. DESBD426 +00969 OPEN INPUT ICESA-DCG-IN CL*24 +00970 IF NOT TDEC-IN-OK-88 DESBD426 +00971 DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS DESBD426 +00972 SET W-ERROR-YES-88 TO TRUE DESBD426 +00973 END-IF. DESBD426 +00974 DESBD426 +00975 OPEN OUTPUT X146-WAGE-OUT CL**8 +00976 IF NOT TDEC-IN-OK-88 CL**8 +00977 DISPLAY 'CANNOT OPEN TDEC-TRAN-IN ' TDEC-IN-STATUS CL**8 +00978 SET W-ERROR-YES-88 TO TRUE CL**8 +00979 END-IF. CL**8 +00980 CL**8 +00981 S1000-EXIT. DESBD426 +00982 EXIT. DESBD426 +00983 DESBD426 +00984 S1010-READ-TDEC-IN. DESBD426 +00985 * READ TDEC-TRAN-IN INTO ESP-TRANSACTION-AREA. DESBD426 +00986 READ ICESA-DCG-IN CL*24 +00987 IF TDEC-IN-OK-88 DESBD426 +00988 ADD +1 TO W-TDEC-IN-CNT DESBD426 +00989 ELSE DESBD426 +00990 IF TDEC-IN-EOF-88 DESBD426 +00991 DISPLAY 'EOF' DESBD426 +00992 ELSE DESBD426 +00993 DISPLAY 'CANNOT READ TDEC INPUT ' TDEC-IN-STATUS DESBD426 +00994 END-IF DESBD426 +00995 END-IF. DESBD426 +00996 DESBD426 +00997 S1010-EXIT. DESBD426 +00998 EXIT. DESBD426 +00999 DESBD426 +01000 S1020-CLOSE-TDEC-IN. DESBD426 +01001 CLOSE ICESA-DCG-IN CL*24 +01002 X146-WAGE-OUT. CL*10 +01003 DESBD426 +01004 S1020-EXIT. DESBD426 +01005 EXIT. DESBD426 +01006 S009-CONVERT-TO-CAPS. CL*20 +01007 CL*20 +01008 CALL 'DTSBU009' USING L009-LINK-AREA. CL*20 +01009 CL*20 +01010 S009-EXIT. CL*20 +01011 EXIT. CL*20 +01012 DESBD426 +01013 S999-ABEND. DESBD426 +01014 DISPLAY '*** I/O MODULE ABENDING'. DESBD426 +01015 DESBD426 +01016 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD426 +01017 S999-EXIT. DESBD426 +01018 EXIT. DESBD426 diff --git a/Batch/DESBD473.cob b/Batch/DESBD473.cob index 00e3146..cbab80a 100644 --- a/Batch/DESBD473.cob +++ b/Batch/DESBD473.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 11/25/24 +00001 IDENTIFICATION DIVISION. 09/05/25 00002 PROGRAM-ID. DESBD471. DESBD473 -00003 AUTHOR. NGC. LV041 +00003 AUTHOR. NGC. LV047 00004 DATE-WRITTEN. DECEMBER 2012. DESBD473 00005 DATE-COMPILED. DESBD473 00006 SKIP3 DESBD473 @@ -14,885 +14,897 @@ 00014 * DESBD473 00015 * 12/06/2012 INITIAL DEVELOPMENT. DESBD473 00016 * WORK ORDER: PROGRAMMER: GD DESBD473 -00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD473 -00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD473 -00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD473 -00020 * DESBD473 -00021 * DESBD473 -00022 * DESCRIPTION: DESBD473 -00023 * DESBD473 -00024 * DESBD473 +00017 * 08/04/2025 MODIFIED PGM TO CHK MRPT FILE INSTEAD OF MQTR CL*43 +00018 * FOR ORIGINAL REPORTS. PROGRAMMER: SC CL*43 +00019 * 09/04/2025 MODIFIED PGM TO CHK IF X140-RESP-OPID GREATER CL*46 +00020 * THAN SPACES. IF YES, IT IS NOT FRAUD,WRITE THE CL*46 +00021 * RECORD TO PASSED FILE. PROGRAMMER: SC CL*46 +00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD473 +00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD473 +00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD473 00025 * DESBD473 00026 * DESBD473 -00027 * DESBD473 +00027 * DESCRIPTION: DESBD473 00028 * DESBD473 00029 * DESBD473 00030 * DESBD473 00031 * DESBD473 00032 * DESBD473 00033 * DESBD473 -00034 * GENERAL SPECIFICATIONS: DESBD473 +00034 * DESBD473 00035 * DESBD473 -00036 * ALL COMMANDS ARE VALID. DESBD473 +00036 * DESBD473 00037 * DESBD473 -00038 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DESBD473 -00039 * MODULE. DESBD473 +00038 * DESBD473 +00039 * GENERAL SPECIFICATIONS: DESBD473 00040 * DESBD473 -00041 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DESBD473 -00042 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DESBD473 -00043 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DESBD473 -00044 * DESBD473 +00041 * ALL COMMANDS ARE VALID. DESBD473 +00042 * DESBD473 +00043 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DESBD473 +00044 * MODULE. DESBD473 00045 * DESBD473 -00046 * DESBD473 -00047 * COMMAND SPECIFIC SPECIFICATIONS: DESBD473 -00048 * DESBD473 -00049 * OPEN-READ DESBD473 -00050 * OPEN INPUT. DESBD473 +00046 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DESBD473 +00047 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DESBD473 +00048 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DESBD473 +00049 * DESBD473 +00050 * DESBD473 00051 * DESBD473 -00052 * OPEN-UPDATE DESBD473 -00053 * OPEN I-O. DESBD473 -00054 * DESBD473 -00055 * CLOSE DESBD473 +00052 * COMMAND SPECIFIC SPECIFICATIONS: DESBD473 +00053 * DESBD473 +00054 * OPEN-READ DESBD473 +00055 * OPEN INPUT. DESBD473 00056 * DESBD473 -00057 * READ DESBD473 -00058 * DESBD473 -00059 * START BROWSE DESBD473 -00060 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DESBD473 -00061 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DESBD473 -00062 * A RECORD. DESBD473 +00057 * OPEN-UPDATE DESBD473 +00058 * OPEN I-O. DESBD473 +00059 * DESBD473 +00060 * CLOSE DESBD473 +00061 * DESBD473 +00062 * READ DESBD473 00063 * DESBD473 -00064 * READ NEXT DESBD473 -00065 * DESBD473 -00066 * WRITE DESBD473 -00067 * DESBD473 -00068 * REWRITE DESBD473 -00069 * DESBD473 -00070 * DELETE DESBD473 -00071 * DESBD473 +00064 * START BROWSE DESBD473 +00065 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DESBD473 +00066 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DESBD473 +00067 * A RECORD. DESBD473 +00068 * DESBD473 +00069 * READ NEXT DESBD473 +00070 * DESBD473 +00071 * WRITE DESBD473 00072 * DESBD473 -00073 ***** DESBD473 -00074 DESBD473 -00075 ENVIRONMENT DIVISION. CL*10 -00076 CONFIGURATION SECTION. CL*10 -00077 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*10 -00078 DESBD473 -00079 INPUT-OUTPUT SECTION. DESBD473 -00080 DESBD473 -00081 FILE-CONTROL. DESBD473 -00082 SELECT RPT-ESSP-FILE ASSIGN TO DTSFX140 CL**2 -00083 FILE STATUS IS WAGE-TRANS-STATUS. DESBD473 -00084 DESBD473 -00085 SELECT RPT-FRAUD-FILE ASSIGN TO DTSFF140 CL**2 -00086 FILE STATUS IS WAGE-TRANS-STATUS. CL**2 -00087 CL**2 -00088 SELECT RPT-PASSED-FILE ASSIGN TO DTSFP140 CL**2 -00089 FILE STATUS IS WAGE-TRANS-STATUS. CL**2 -00090 CL**5 -00091 SELECT RPT-EROR-FILE ASSIGN TO DTSFR140 CL**5 -00092 FILE STATUS IS REPT-TRANS-STATUS. CL*11 -00093 DESBD473 -00094 DATA DIVISION. DESBD473 -00095 DESBD473 -00096 FILE SECTION. DESBD473 -00097 DESBD473 -00098 FD RPT-ESSP-FILE CL**2 -00099 RECORDING MODE IS F DESBD473 -00100 BLOCK CONTAINS 0 RECORDS. DESBD473 -00101 DESBD473 -00102 01 RPT-ESSP-REC PIC X(512). CL**2 -00103 DESBD473 -00104 FD RPT-FRAUD-FILE CL**2 -00105 RECORDING MODE IS F CL**2 -00106 BLOCK CONTAINS 0 RECORDS. CL**2 -00107 CL**2 -00108 01 RPT-FRAUD-REC PIC X(512). CL**2 -00109 CL**2 -00110 FD RPT-PASSED-FILE CL**2 -00111 RECORDING MODE IS F CL**2 -00112 BLOCK CONTAINS 0 RECORDS. CL**2 -00113 CL**2 -00114 01 RPT-PASSED-REC PIC X(512). CL**2 -00115 DESBD473 -00116 FD RPT-EROR-FILE CL**5 -00117 RECORDING MODE IS F CL**5 -00118 BLOCK CONTAINS 0 RECORDS. CL**5 -00119 CL**5 -00120 01 REPT-EROR-REC PIC X(160). CL*27 -00121 CL**5 -00122 DESBD473 -00123 WORKING-STORAGE SECTION. DESBD473 -001235 77 PAN-VALET PICTURE X(24) VALUE '041DESBD473 11/25/24'. DESBD473 -00124 SKIP3 DESBD473 -00125 01 WRK-AREA. DESBD473 -00126 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +480. DESBD473 -00127 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. DESBD473 -00128 DESBD473 -00129 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU480'. DESBD473 -00130 DESBD473 -00131 05 W-CURR-EMP-NO PIC S9(06) COMP-3 VALUE +0. DESBD473 -00132 05 W-CURR-YRQ PIC S9(05) COMP-3 DESBD473 -00133 VALUE +20121. DESBD473 -00134 05 W-CURR-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD473 -00135 05 W-CURR-ITEM PIC S9(03) COMP-3 VALUE +0. DESBD473 -00136 05 W-MQTR-TOT-WAGE PIC S9(11)V99 COMP-3 DESBD473 -00137 VALUE +0. DESBD473 -00138 05 W-WTC-BATCH-NO PIC S9(05) COMP-3 DESBD473 -00139 VALUE +90001. DESBD473 -00140 05 W-WTC-ITEM-NO PIC S9(03) COMP-3 DESBD473 -00141 VALUE +003. DESBD473 -00142 05 W-WTC-SEQ-NO PIC S9(03) COMP-3 DESBD473 -00143 VALUE +001. DESBD473 -00144 05 W-MAX-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD473 -00145 05 W-MIN-BATCH PIC S9(05) COMP-3 DESBD473 -00146 VALUE +99999. DESBD473 -00147 05 WRK-W2-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 -00148 05 WRK-W4-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 -00149 05 WRK-WWGH-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 -00150 05 WRK-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 -00151 05 W-BYPASSED-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 -00152 05 W-BACKLOG PIC S9(07) COMP-3 VALUE +0. DESBD473 -00153 05 AMT-DISP1 PIC ----------9.99. DESBD473 -00154 05 AMT-DISP2 PIC ----------9.99. DESBD473 -00155 05 AMT-DISP3 PIC ----------9.99. DESBD473 -00156 05 AMT-DISP4 PIC ----------9.99. DESBD473 -00157 DESBD473 -00158 05 WRK-NET-WAGE PIC S9(11)V99 COMP-3 DESBD473 -00159 VALUE +0. DESBD473 -00160 05 W-WGH-WAGE PIC S9(11)V99 COMP-3 DESBD473 -00161 VALUE +0. DESBD473 -00162 05 WRK-FRAUD-CUTOFF-DATE PIC S9(09) COMP-3 VALUE +0. CL**2 -00163 05 W-DIFFERENCE PIC S9(11)V99 COMP-3 DESBD473 +00073 * REWRITE DESBD473 +00074 * DESBD473 +00075 * DELETE DESBD473 +00076 * DESBD473 +00077 * DESBD473 +00078 ***** DESBD473 +00079 DESBD473 +00080 ENVIRONMENT DIVISION. CL*10 +00081 CONFIGURATION SECTION. CL*10 +00082 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*10 +00083 DESBD473 +00084 INPUT-OUTPUT SECTION. DESBD473 +00085 DESBD473 +00086 FILE-CONTROL. DESBD473 +00087 SELECT RPT-ESSP-FILE ASSIGN TO DTSFX140 CL**2 +00088 FILE STATUS IS WAGE-TRANS-STATUS. DESBD473 +00089 DESBD473 +00090 SELECT RPT-FRAUD-FILE ASSIGN TO DTSFF140 CL**2 +00091 FILE STATUS IS WAGE-TRANS-STATUS. CL**2 +00092 CL**2 +00093 SELECT RPT-PASSED-FILE ASSIGN TO DTSFP140 CL**2 +00094 FILE STATUS IS WAGE-TRANS-STATUS. CL**2 +00095 CL**5 +00096 SELECT RPT-EROR-FILE ASSIGN TO DTSFR140 CL**5 +00097 FILE STATUS IS REPT-TRANS-STATUS. CL*11 +00098 DESBD473 +00099 DATA DIVISION. DESBD473 +00100 DESBD473 +00101 FILE SECTION. DESBD473 +00102 DESBD473 +00103 FD RPT-ESSP-FILE CL**2 +00104 RECORDING MODE IS F DESBD473 +00105 BLOCK CONTAINS 0 RECORDS. DESBD473 +00106 DESBD473 +00107 01 RPT-ESSP-REC PIC X(512). CL**2 +00108 DESBD473 +00109 FD RPT-FRAUD-FILE CL**2 +00110 RECORDING MODE IS F CL**2 +00111 BLOCK CONTAINS 0 RECORDS. CL**2 +00112 CL**2 +00113 01 RPT-FRAUD-REC PIC X(512). CL**2 +00114 CL**2 +00115 FD RPT-PASSED-FILE CL**2 +00116 RECORDING MODE IS F CL**2 +00117 BLOCK CONTAINS 0 RECORDS. CL**2 +00118 CL**2 +00119 01 RPT-PASSED-REC PIC X(512). CL**2 +00120 DESBD473 +00121 FD RPT-EROR-FILE CL**5 +00122 RECORDING MODE IS F CL**5 +00123 BLOCK CONTAINS 0 RECORDS. CL**5 +00124 CL**5 +00125 01 REPT-EROR-REC PIC X(160). CL*27 +00126 CL**5 +00127 DESBD473 +00128 WORKING-STORAGE SECTION. DESBD473 +001285 77 PAN-VALET PICTURE X(24) VALUE '047DESBD473 09/05/25'. DESBD473 +00129 SKIP3 DESBD473 +00130 01 WRK-AREA. DESBD473 +00131 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +480. DESBD473 +00132 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. DESBD473 +00133 DESBD473 +00134 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU480'. DESBD473 +00135 DESBD473 +00136 05 W-CURR-EMP-NO PIC S9(06) COMP-3 VALUE +0. DESBD473 +00137 05 W-CURR-YRQ PIC S9(05) COMP-3 DESBD473 +00138 VALUE +20121. DESBD473 +00139 05 W-CURR-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD473 +00140 05 W-CURR-ITEM PIC S9(03) COMP-3 VALUE +0. DESBD473 +00141 05 W-MQTR-TOT-WAGE PIC S9(11)V99 COMP-3 DESBD473 +00142 VALUE +0. DESBD473 +00143 05 W-WTC-BATCH-NO PIC S9(05) COMP-3 DESBD473 +00144 VALUE +90001. DESBD473 +00145 05 W-WTC-ITEM-NO PIC S9(03) COMP-3 DESBD473 +00146 VALUE +003. DESBD473 +00147 05 W-WTC-SEQ-NO PIC S9(03) COMP-3 DESBD473 +00148 VALUE +001. DESBD473 +00149 05 W-MAX-BATCH PIC S9(05) COMP-3 VALUE +0. DESBD473 +00150 05 W-MIN-BATCH PIC S9(05) COMP-3 DESBD473 +00151 VALUE +99999. DESBD473 +00152 05 WRK-W2-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 +00153 05 WRK-W4-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 +00154 05 WRK-WWGH-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 +00155 05 WRK-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 +00156 05 W-BYPASSED-CNT PIC S9(07) COMP-3 VALUE +0. DESBD473 +00157 05 W-BACKLOG PIC S9(07) COMP-3 VALUE +0. DESBD473 +00158 05 AMT-DISP1 PIC ----------9.99. DESBD473 +00159 05 AMT-DISP2 PIC ----------9.99. DESBD473 +00160 05 AMT-DISP3 PIC ----------9.99. DESBD473 +00161 05 AMT-DISP4 PIC ----------9.99. DESBD473 +00162 DESBD473 +00163 05 WRK-NET-WAGE PIC S9(11)V99 COMP-3 DESBD473 00164 VALUE +0. DESBD473 -00165 DESBD473 -00166 05 NO-REPORT-FILED PIC 9(9) VALUE 0. CL*25 -00167 05 RPT-FRAUD-CNT PIC 9(9) VALUE 0. CL*25 -00168 05 RPT-PASSED-CNT PIC 9(9) VALUE 0. CL**2 -00169 05 RPT-X140-READ PIC 9(9) VALUE 0. CL**3 -00170 05 RPT-X140-CNT PIC 9(9) VALUE 0. CL**8 -00171 05 WS-LINE-CNT PIC 9(9) VALUE 60. CL**7 -00172 05 WS-PAGE-CNT PIC 9(9) VALUE 0. CL*20 -00173 05 W2-REC-DELETED PIC 9(9) VALUE 0. DESBD473 -00174 05 W2-REC-FOUND PIC 9(9) VALUE 0. DESBD473 -00175 05 W-SLASH-DATE PIC X(10). DESBD473 -00176 05 W-ZDATE REDEFINES W-SLASH-DATE. DESBD473 -00177 10 W-SLASH-DT-MM PIC X(02). DESBD473 -00178 10 FILLER PIC X(01). DESBD473 -00179 10 W-SLASH-DT-DD PIC X(02). DESBD473 -00180 10 FILLER PIC X(01). DESBD473 -00181 10 W-SLASH-DT-CCYY PIC X(04). DESBD473 -00182 DESBD473 -00183 05 WRK-FED-Z-DATE PIC 9(8) VALUE ZEROS. CL*16 -00184 05 WRK-FED-8-DATE. CL*16 -00185 10 RPT-FED-8-YR PIC 9(4). CL**2 -00186 10 RPT-FED-8-MO PIC 9(2). CL**2 -00187 10 RPT-FED-8-DA PIC 9(2). CL**2 -00188 CL**2 -00189 05 W-RESP-OPID PIC X(08). DESBD473 -00190 05 WRK-ERROR-IND PIC X(01). DESBD473 -00191 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD473 -00192 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD473 -00193 DESBD473 -00194 05 W-EMP-EXISTS-IND PIC X(01). DESBD473 -00195 88 W-EMP-EXISTS-YES-88 VALUE 'Y'. DESBD473 -00196 88 W-EMP-EXISTS-NO-88 VALUE 'N'. DESBD473 -00197 05 W-DELINQUENT-IND PIC X(01). DESBD473 -00198 88 W-DELINQUENT-YES-88 VALUE 'Y'. DESBD473 -00199 88 W-DELINQUENT-NO-88 VALUE 'N'. DESBD473 -00200 05 WAGE-TRANS-STATUS PIC X(02). DESBD473 -00201 88 WAGE-TRANS-FILE-OK-88 VALUE '00'. DESBD473 -00202 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DESBD473 -00203 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DESBD473 -00204 DESBD473 -00205 05 REPT-TRANS-STATUS PIC X(02). CL*11 -00206 88 REPT-TRANS-FILE-OK-88 VALUE '00'. CL*11 -00207 88 REPT-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*11 -00208 88 REPT-TRANS-FILE-VERIFY-88 VALUE '97'. CL*11 -00209 CL*11 -00210 05 DOWNLOAD-STATUS PIC X(02). DESBD473 -00211 88 DOWNLOAD-FILE-OK-88 VALUE '00'. DESBD473 -00212 DESBD473 -00213 05 WRK-YRQ PIC 9(05). DESBD473 -00214 05 FILLER REDEFINES WRK-YRQ. DESBD473 -00215 10 WRK-YRQ-YEAR PIC 9(04). DESBD473 -00216 10 WRK-YRQ-QTR PIC 9(01). DESBD473 +00165 05 W-WGH-WAGE PIC S9(11)V99 COMP-3 DESBD473 +00166 VALUE +0. DESBD473 +00167 05 WRK-FRAUD-CUTOFF-DATE PIC S9(09) COMP-3 VALUE +0. CL**2 +00168 05 W-DIFFERENCE PIC S9(11)V99 COMP-3 DESBD473 +00169 VALUE +0. DESBD473 +00170 DESBD473 +00171 05 NO-REPORT-FILED PIC 9(9) VALUE 0. CL*25 +00172 05 RPT-FRAUD-CNT PIC 9(9) VALUE 0. CL*25 +00173 05 RPT-PASSED-CNT PIC 9(9) VALUE 0. CL**2 +00174 05 RPT-X140-READ PIC 9(9) VALUE 0. CL**3 +00175 05 RPT-X140-CNT PIC 9(9) VALUE 0. CL**8 +00176 05 WS-LINE-CNT PIC 9(9) VALUE 60. CL**7 +00177 05 WS-PAGE-CNT PIC 9(9) VALUE 0. CL*20 +00178 05 W2-REC-DELETED PIC 9(9) VALUE 0. DESBD473 +00179 05 W2-REC-FOUND PIC 9(9) VALUE 0. DESBD473 +00180 05 W-SLASH-DATE PIC X(10). DESBD473 +00181 05 W-ZDATE REDEFINES W-SLASH-DATE. DESBD473 +00182 10 W-SLASH-DT-MM PIC X(02). DESBD473 +00183 10 FILLER PIC X(01). DESBD473 +00184 10 W-SLASH-DT-DD PIC X(02). DESBD473 +00185 10 FILLER PIC X(01). DESBD473 +00186 10 W-SLASH-DT-CCYY PIC X(04). DESBD473 +00187 DESBD473 +00188 05 WRK-FED-Z-DATE PIC 9(8) VALUE ZEROS. CL*16 +00189 05 WRK-FED-8-DATE. CL*16 +00190 10 RPT-FED-8-YR PIC 9(4). CL**2 +00191 10 RPT-FED-8-MO PIC 9(2). CL**2 +00192 10 RPT-FED-8-DA PIC 9(2). CL**2 +00193 CL**2 +00194 05 W-RESP-OPID PIC X(08). DESBD473 +00195 05 WRK-ERROR-IND PIC X(01). DESBD473 +00196 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD473 +00197 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD473 +00198 DESBD473 +00199 05 W-EMP-EXISTS-IND PIC X(01). DESBD473 +00200 88 W-EMP-EXISTS-YES-88 VALUE 'Y'. DESBD473 +00201 88 W-EMP-EXISTS-NO-88 VALUE 'N'. DESBD473 +00202 05 W-DELINQUENT-IND PIC X(01). DESBD473 +00203 88 W-DELINQUENT-YES-88 VALUE 'Y'. DESBD473 +00204 88 W-DELINQUENT-NO-88 VALUE 'N'. DESBD473 +00205 05 WAGE-TRANS-STATUS PIC X(02). DESBD473 +00206 88 WAGE-TRANS-FILE-OK-88 VALUE '00'. DESBD473 +00207 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DESBD473 +00208 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DESBD473 +00209 DESBD473 +00210 05 REPT-TRANS-STATUS PIC X(02). CL*11 +00211 88 REPT-TRANS-FILE-OK-88 VALUE '00'. CL*11 +00212 88 REPT-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*11 +00213 88 REPT-TRANS-FILE-VERIFY-88 VALUE '97'. CL*11 +00214 CL*11 +00215 05 DOWNLOAD-STATUS PIC X(02). DESBD473 +00216 88 DOWNLOAD-FILE-OK-88 VALUE '00'. DESBD473 00217 DESBD473 -00218 05 WRK-YRQ-X. DESBD473 -00219 10 WRK-YRQ-YEAR-X PIC 9(04). DESBD473 -00220 10 FILLER PIC X(01) VALUE '/'. DESBD473 -00221 10 WRK-YRQ-QTR-X PIC 9(01). DESBD473 -00222 05 WRK-MPRF-IND PIC X(01). CL**3 -00223 88 WRK-MPRF-OK VALUE 'Y'. CL**3 -00224 88 WRK-MPRF-NO-REC VALUE 'N'. CL**3 -00225 DESBD473 -00226 01 HEADER-1. CL**6 -00227 05 FILLER PIC X(01) VALUE SPACES. CL**6 -00228 05 FILLER PIC X(49) VALUE '140R1'. CL**6 -00229 05 FILLER PIC X(60) VALUE CL**6 -00230 'DISTRICT OF COLUMBIA'. CL**6 -00231 05 FILLER PIC X(06) VALUE 'DATE:'. CL**6 -00232 * 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*35 -00233 05 HDR3-PAGE PIC ZZ,ZZ9. CL*35 -00234 01 HEADER-2. CL**6 -00235 05 FILLER PIC X(54) VALUE SPACES. CL**6 -00236 05 FILLER PIC X(56) VALUE CL**6 -00237 'TAX DIVISION'. CL**6 -00238 05 FILLER PIC X(06) VALUE 'TIME:'. CL**6 -00239 05 HDR2-LRCM-SYS-TIME PIC X(08). CL**6 -00240 01 HEADER-3. CL**6 -00241 05 FILLER PIC X(01) VALUE SPACES. CL**6 -00242 05 FILLER PIC X(38) VALUE CL**6 -00243 ' '. CL*35 -00244 05 HDR3-LITERAL PIC X(43) VALUE CL**6 -00245 ' ESSP DAILY POTENTIAL FRAUD REPORTS '. CL**7 -00246 05 FILLER PIC X(28) VALUE SPACES. CL**6 -00247 05 FILLER PIC X(06) VALUE 'DATE:'. CL*40 -00248 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*35 -00249 CL**6 -00250 01 HEADER-4. CL**7 -00251 05 FILLER PIC X(02) VALUE SPACES. CL**6 -00252 05 FILLER PIC X(07) VALUE CL*38 -00253 'EMP NO '. CL*38 -00254 05 FILLER PIC X(01) VALUE ','. CL*39 -00255 05 FILLER PIC X(20) VALUE CL*38 -00256 ' NAME '. CL*38 -00257 05 FILLER PIC X(01) VALUE ','. CL*39 -00258 05 FILLER PIC X(06) VALUE CL*36 -00259 ' QTR '. CL*36 -00260 05 FILLER PIC X(01) VALUE ','. CL*39 -00261 05 FILLER PIC X(03) VALUE CL*36 -00262 'STA'. CL*36 -00263 05 FILLER PIC X(01) VALUE ','. CL*39 -00264 05 FILLER PIC X(03) VALUE CL*36 -00265 'CLS'. CL*36 -00266 05 FILLER PIC X(01) VALUE ','. CL*39 -00267 05 FILLER PIC X(03) VALUE CL*36 -00268 'ORG'. CL*36 -00269 05 FILLER PIC X(01) VALUE ','. CL*39 -00270 05 FILLER PIC X(10) VALUE CL*36 -00271 ' RECV-DATE'. CL*36 -00272 05 FILLER PIC X(01) VALUE ','. CL*39 -00273 05 FILLER PIC X(10) VALUE CL*36 -00274 ' REG-DATE'. CL*36 -00275 05 FILLER PIC X(01) VALUE ','. CL*39 -00276 05 FILLER PIC X(12) VALUE CL*40 -00277 'TOTAL-AMT '. CL*40 -00278 05 FILLER PIC X(01) VALUE ','. CL*39 -00279 05 FILLER PIC X(12) VALUE CL*40 -00280 ' TAX-AMT '. CL*40 -00281 05 FILLER PIC X(01) VALUE ','. CL*39 -00282 05 FILLER PIC X(12) VALUE CL*40 -00283 'EXCES-AMT '. CL*40 -00284 05 FILLER PIC X(01) VALUE ','. CL*39 -00285 05 FILLER PIC X(05) VALUE CL*36 -00286 ' M1'. CL*36 -00287 05 FILLER PIC X(01) VALUE ','. CL*39 -00288 05 FILLER PIC X(05) VALUE CL*36 -00289 ' M2'. CL*36 -00290 05 FILLER PIC X(01) VALUE ','. CL*39 -00291 05 FILLER PIC X(05) VALUE CL*36 -00292 ' M3'. CL*36 -00293 05 FILLER PIC X(01) VALUE ','. CL*39 -00294 05 FILLER PIC X(05) VALUE CL*36 -00295 ' 1RPT'. CL*36 -00296 05 FILLER PIC X(01) VALUE ','. CL*39 -00297 05 FILLER PIC X(10) VALUE SPACES. CL*40 -00298 05 FILLER PIC X(23) VALUE CL*40 -00299 'NOTES(VALIDATED/FRAUD)'. CL*40 -00300 01 HEADER-5. CL**7 -00301 05 FILLER PIC X(01) VALUE SPACES. CL**6 -00302 05 FILLER PIC X(132) VALUE SPACES. CL**6 -00303 01 DETAIL-LINE-1. CL**6 -00304 15 FILLER PIC X(02) VALUE SPACES. CL**6 -00305 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL**8 -00306 15 FILLER PIC X(01) VALUE ','. CL*39 -00307 15 X434-NAME-CHECK PIC X(20) VALUE SPACES. CL**8 -00308 15 FILLER PIC X(01) VALUE ','. CL*39 -00309 15 X434-QTR. CL*16 -00310 25 X434-QTR-Y PIC X(04). CL*16 -00311 25 X434-QTR-F PIC X(01). CL*16 -00312 25 X434-QTR-Q PIC X(01). CL*16 +00218 05 WRK-YRQ PIC 9(05). DESBD473 +00219 05 FILLER REDEFINES WRK-YRQ. DESBD473 +00220 10 WRK-YRQ-YEAR PIC 9(04). DESBD473 +00221 10 WRK-YRQ-QTR PIC 9(01). DESBD473 +00222 DESBD473 +00223 05 WRK-YRQ-X. DESBD473 +00224 10 WRK-YRQ-YEAR-X PIC 9(04). DESBD473 +00225 10 FILLER PIC X(01) VALUE '/'. DESBD473 +00226 10 WRK-YRQ-QTR-X PIC 9(01). DESBD473 +00227 05 WRK-MPRF-IND PIC X(01). CL**3 +00228 88 WRK-MPRF-OK VALUE 'Y'. CL**3 +00229 88 WRK-MPRF-NO-REC VALUE 'N'. CL**3 +00230 DESBD473 +00231 01 HEADER-1. CL**6 +00232 05 FILLER PIC X(01) VALUE SPACES. CL**6 +00233 05 FILLER PIC X(49) VALUE '140R1'. CL**6 +00234 05 FILLER PIC X(60) VALUE CL**6 +00235 'DISTRICT OF COLUMBIA'. CL**6 +00236 05 FILLER PIC X(06) VALUE 'DATE:'. CL**6 +00237 * 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*35 +00238 05 HDR3-PAGE PIC ZZ,ZZ9. CL*35 +00239 01 HEADER-2. CL**6 +00240 05 FILLER PIC X(54) VALUE SPACES. CL**6 +00241 05 FILLER PIC X(56) VALUE CL**6 +00242 'TAX DIVISION'. CL**6 +00243 05 FILLER PIC X(06) VALUE 'TIME:'. CL**6 +00244 05 HDR2-LRCM-SYS-TIME PIC X(08). CL**6 +00245 01 HEADER-3. CL**6 +00246 05 FILLER PIC X(01) VALUE SPACES. CL**6 +00247 05 FILLER PIC X(38) VALUE CL**6 +00248 ' '. CL*35 +00249 05 HDR3-LITERAL PIC X(43) VALUE CL**6 +00250 ' ESSP DAILY POTENTIAL FRAUD REPORTS '. CL**7 +00251 05 FILLER PIC X(28) VALUE SPACES. CL**6 +00252 05 FILLER PIC X(06) VALUE 'DATE:'. CL*40 +00253 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*35 +00254 CL**6 +00255 01 HEADER-4. CL**7 +00256 05 FILLER PIC X(02) VALUE SPACES. CL**6 +00257 05 FILLER PIC X(07) VALUE CL*38 +00258 'EMP NO '. CL*38 +00259 05 FILLER PIC X(01) VALUE ','. CL*39 +00260 05 FILLER PIC X(20) VALUE CL*38 +00261 ' NAME '. CL*38 +00262 05 FILLER PIC X(01) VALUE ','. CL*39 +00263 05 FILLER PIC X(06) VALUE CL*36 +00264 ' QTR '. CL*36 +00265 05 FILLER PIC X(01) VALUE ','. CL*39 +00266 05 FILLER PIC X(03) VALUE CL*36 +00267 'STA'. CL*36 +00268 05 FILLER PIC X(01) VALUE ','. CL*39 +00269 05 FILLER PIC X(03) VALUE CL*36 +00270 'CLS'. CL*36 +00271 05 FILLER PIC X(01) VALUE ','. CL*39 +00272 05 FILLER PIC X(03) VALUE CL*36 +00273 'ORG'. CL*36 +00274 05 FILLER PIC X(01) VALUE ','. CL*39 +00275 05 FILLER PIC X(10) VALUE CL*36 +00276 ' RECV-DATE'. CL*36 +00277 05 FILLER PIC X(01) VALUE ','. CL*39 +00278 05 FILLER PIC X(10) VALUE CL*36 +00279 ' REG-DATE'. CL*36 +00280 05 FILLER PIC X(01) VALUE ','. CL*39 +00281 05 FILLER PIC X(12) VALUE CL*40 +00282 'TOTAL-AMT '. CL*40 +00283 05 FILLER PIC X(01) VALUE ','. CL*39 +00284 05 FILLER PIC X(12) VALUE CL*40 +00285 ' TAX-AMT '. CL*40 +00286 05 FILLER PIC X(01) VALUE ','. CL*39 +00287 05 FILLER PIC X(12) VALUE CL*40 +00288 'EXCES-AMT '. CL*40 +00289 05 FILLER PIC X(01) VALUE ','. CL*39 +00290 05 FILLER PIC X(05) VALUE CL*36 +00291 ' M1'. CL*36 +00292 05 FILLER PIC X(01) VALUE ','. CL*39 +00293 05 FILLER PIC X(05) VALUE CL*36 +00294 ' M2'. CL*36 +00295 05 FILLER PIC X(01) VALUE ','. CL*39 +00296 05 FILLER PIC X(05) VALUE CL*36 +00297 ' M3'. CL*36 +00298 05 FILLER PIC X(01) VALUE ','. CL*39 +00299 05 FILLER PIC X(05) VALUE CL*36 +00300 ' 1RPT'. CL*36 +00301 05 FILLER PIC X(01) VALUE ','. CL*39 +00302 05 FILLER PIC X(10) VALUE SPACES. CL*40 +00303 05 FILLER PIC X(23) VALUE CL*40 +00304 'NOTES(VALIDATED/FRAUD)'. CL*40 +00305 01 HEADER-5. CL**7 +00306 05 FILLER PIC X(01) VALUE SPACES. CL**6 +00307 05 FILLER PIC X(132) VALUE SPACES. CL**6 +00308 01 DETAIL-LINE-1. CL**6 +00309 15 FILLER PIC X(02) VALUE SPACES. CL**6 +00310 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL**8 +00311 15 FILLER PIC X(01) VALUE ','. CL*39 +00312 15 X434-NAME-CHECK PIC X(20) VALUE SPACES. CL**8 00313 15 FILLER PIC X(01) VALUE ','. CL*39 -00314 15 X434-EMP-STATUS PIC X(03) VALUE SPACES. CL*38 -00315 15 FILLER PIC X(01) VALUE ','. CL*39 -00316 15 X434-EMP-CLASS PIC X(03) VALUE SPACES. CL*38 -00317 15 FILLER PIC X(01) VALUE ','. CL*39 -00318 15 X434-EMP-ORG PIC X(03) VALUE SPACES. CL*38 -00319 15 FILLER PIC X(01) VALUE ','. CL*39 -00320 15 X434-RCVD-DATE PIC X(10) VALUE SPACES. CL*38 -00321 15 FILLER PIC X(01) VALUE ','. CL*39 -00322 15 X434-REGD-DATE PIC X(10) VALUE SPACES. CL*38 -00323 15 FILLER PIC X(01) VALUE ','. CL*39 -00324 15 X434-TOT-WAGE PIC --------9.99. CL**6 -00325 15 FILLER PIC X(01) VALUE ','. CL*39 -00326 15 X434-TAX-WAGE PIC --------9.99. CL*14 -00327 15 FILLER PIC X(01) VALUE ','. CL*39 -00328 15 X434-EXC-WAGE PIC --------9.99. CL*14 -00329 15 FILLER PIC X(01) VALUE ','. CL*39 -00330 15 X434-M1-CNT PIC ZZZ99. CL*25 -00331 15 FILLER PIC X(01) VALUE ','. CL*39 -00332 15 X434-M2-CNT PIC ZZZ99. CL*25 -00333 15 FILLER PIC X(01) VALUE ','. CL*39 -00334 15 X434-M3-CNT PIC ZZZ99. CL*25 -00335 15 FILLER PIC X(01) VALUE ','. CL*39 -00336 15 X434-QTR-FILED PIC X. CL*26 -00337 CL**7 -00338 01 FOOTING-LINE-1. CL**7 -00339 05 FILLER PIC X(25) VALUE SPACES. CL**6 -00340 05 WS-X140-RED-CNT PIC ZZ,ZZ9. CL**6 -00341 05 FILLER PIC X(02) VALUE SPACES. CL**6 -00342 05 FILLER PIC X(45) VALUE CL**6 -00343 'TOTAL REPORTS RECEIVED FROM ESSP '. CL**7 -00344 05 FILLER PIC X(32) VALUE SPACES. CL**6 -00345 CL**6 -00346 01 FOOTING-LINE-2. CL**7 -00347 05 FILLER PIC X(25) VALUE SPACES. CL**6 -00348 05 WS-X140-PEN-CNT PIC ZZ,ZZ9. CL**6 -00349 05 FILLER PIC X(02) VALUE SPACES. CL**6 -00350 05 FILLER PIC X(40) VALUE CL**6 -00351 ' # OF POTENTIAL FRAUD REPORTS '. CL**7 -00352 05 FILLER PIC X(32) VALUE SPACES. CL**6 -00353 CL**6 -00354 CL**7 -00355 01 FOOTING-LINE-3. CL**7 -00356 05 FILLER PIC X(25) VALUE SPACES. CL**7 -00357 05 WS-X140-PAS-CNT PIC ZZ,ZZ9. CL**7 -00358 05 FILLER PIC X(02) VALUE SPACES. CL**7 -00359 05 FILLER PIC X(45) VALUE CL**7 -00360 'TOTAL REPORTS PASSED TO DUTAS '. CL**7 -00361 05 FILLER PIC X(32) VALUE SPACES. CL**7 -00362 CL**6 -00363 CL**6 -00364 01 NOREPORT-LINE. CL*22 -00365 05 FILLER PIC X(35) VALUE SPACES. CL*22 -00366 05 FILLER PIC X(57) VALUE CL*22 -00367 ' ******** NO POTENTIAL FRAUD REPORT/WAGES TODAY *******'. CL*22 -00368 05 FILLER PIC X(35) VALUE SPACES. CL*22 -00369 CL*22 -00370 CL**6 -00371 01 L004-COMM-AREA. DESBD473 -00372 ++INCLUDE DTSIL004 DESBD473 -00373 DESBD473 -00374 01 L001-LINK-AREA. CL**2 -00375 ++INCLUDE DTSIL001 CL**2 -00376 CL**2 -00377 01 L005-COMM-AREA. DESBD473 -00378 ++INCLUDE DTSIL005 DESBD473 -00379 DESBD473 -00380 01 L424-LINK-AREA. DESBD473 -00381 ++INCLUDE DTSIL424 DESBD473 -00382 DESBD473 -00383 01 L516-LINK-AREA. DESBD473 -00384 ++INCLUDE DTSIL516 DESBD473 -00385 DESBD473 -00386 01 L910-LINK-AREA. DESBD473 -00387 ++INCLUDE DTSIL910 DESBD473 -00388 DESBD473 -00389 01 X140-REC. CL**2 -00390 ++INCLUDE DTSES140 CL**2 -00391 DESBD473 -00392 01 MSKL-REC. DESBD473 -00393 ++INCLUDE DTSIMSKL DESBD473 -00394 DESBD473 -00395 01 MPRF-REC. DESBD473 -00396 ++INCLUDE DTSIMPRF DESBD473 -00397 DESBD473 -00398 01 MQTR-REC. DESBD473 -00399 ++INCLUDE DTSIMQTR DESBD473 -00400 DESBD473 -00401 01 L931-LINK-AREA. DESBD473 -00402 ++INCLUDE DTSIL931 DESBD473 -00403 DESBD473 -00404 01 FSKL-REC. DESBD473 -00405 ++INCLUDE DTSIFSKL DESBD473 -00406 DESBD473 -00407 01 L981-LINK-AREA. DESBD473 -00408 ++INCLUDE DTSIL981 DESBD473 -00409 DESBD473 -00410 01 WWGH-REC. DESBD473 -00411 ++INCLUDE DTSIWWGH DESBD473 -00412 DESBD473 -00413 01 X143-REC. DESBD473 -00414 ++INCLUDE DTSIX143 DESBD473 -00415 DESBD473 -00416 01 L983-LINK-AREA. DESBD473 -00417 ++INCLUDE DTSIL983 DESBD473 -00418 DESBD473 -00419 01 WSKL-REC. DESBD473 -00420 ++INCLUDE DTSIWSKL DESBD473 -00421 DESBD473 -00422 01 W001-REC. DESBD473 -00423 ++INCLUDE DTSIW001 DESBD473 -00424 DESBD473 -00425 01 L982-LINK-AREA. DESBD473 -00426 ++INCLUDE DTSIL982 DESBD473 -00427 DESBD473 -00428 01 WNAM-REC. DESBD473 -00429 ++INCLUDE DTSIWNAM DESBD473 -00430 DESBD473 -00431 DESBD473 -00432 PROCEDURE DIVISION. DESBD473 -00433 DESBD473 -00434 PERFORM I0000-INIT THRU I0000-EXIT. DESBD473 -00435 IF WRK-ERROR-NO-88 DESBD473 -00436 PERFORM P0000-PROCESS THRU P0000-EXIT DESBD473 -00437 PERFORM T0000-TERM THRU T0000-EXIT DESBD473 -00438 END-IF. DESBD473 -00439 DESBD473 -00440 GOBACK. DESBD473 -00441 EJECT DESBD473 -00442 I0000-INIT. DESBD473 -00443 SET WRK-ERROR-NO-88 TO TRUE. DESBD473 +00314 15 X434-QTR. CL*16 +00315 25 X434-QTR-Y PIC X(04). CL*16 +00316 25 X434-QTR-F PIC X(01). CL*16 +00317 25 X434-QTR-Q PIC X(01). CL*16 +00318 15 FILLER PIC X(01) VALUE ','. CL*39 +00319 15 X434-EMP-STATUS PIC X(03) VALUE SPACES. CL*38 +00320 15 FILLER PIC X(01) VALUE ','. CL*39 +00321 15 X434-EMP-CLASS PIC X(03) VALUE SPACES. CL*38 +00322 15 FILLER PIC X(01) VALUE ','. CL*39 +00323 15 X434-EMP-ORG PIC X(03) VALUE SPACES. CL*38 +00324 15 FILLER PIC X(01) VALUE ','. CL*39 +00325 15 X434-RCVD-DATE PIC X(10) VALUE SPACES. CL*38 +00326 15 FILLER PIC X(01) VALUE ','. CL*39 +00327 15 X434-REGD-DATE PIC X(10) VALUE SPACES. CL*38 +00328 15 FILLER PIC X(01) VALUE ','. CL*39 +00329 15 X434-TOT-WAGE PIC --------9.99. CL**6 +00330 15 FILLER PIC X(01) VALUE ','. CL*39 +00331 15 X434-TAX-WAGE PIC --------9.99. CL*14 +00332 15 FILLER PIC X(01) VALUE ','. CL*39 +00333 15 X434-EXC-WAGE PIC --------9.99. CL*14 +00334 15 FILLER PIC X(01) VALUE ','. CL*39 +00335 15 X434-M1-CNT PIC ZZZ99. CL*25 +00336 15 FILLER PIC X(01) VALUE ','. CL*39 +00337 15 X434-M2-CNT PIC ZZZ99. CL*25 +00338 15 FILLER PIC X(01) VALUE ','. CL*39 +00339 15 X434-M3-CNT PIC ZZZ99. CL*25 +00340 15 FILLER PIC X(01) VALUE ','. CL*39 +00341 15 X434-QTR-FILED PIC X. CL*26 +00342 CL**7 +00343 01 FOOTING-LINE-1. CL**7 +00344 05 FILLER PIC X(25) VALUE SPACES. CL**6 +00345 05 WS-X140-RED-CNT PIC ZZ,ZZ9. CL**6 +00346 05 FILLER PIC X(02) VALUE SPACES. CL**6 +00347 05 FILLER PIC X(45) VALUE CL**6 +00348 'TOTAL REPORTS RECEIVED FROM ESSP '. CL**7 +00349 05 FILLER PIC X(32) VALUE SPACES. CL**6 +00350 CL**6 +00351 01 FOOTING-LINE-2. CL**7 +00352 05 FILLER PIC X(25) VALUE SPACES. CL**6 +00353 05 WS-X140-PEN-CNT PIC ZZ,ZZ9. CL**6 +00354 05 FILLER PIC X(02) VALUE SPACES. CL**6 +00355 05 FILLER PIC X(40) VALUE CL**6 +00356 ' # OF POTENTIAL FRAUD REPORTS '. CL**7 +00357 05 FILLER PIC X(32) VALUE SPACES. CL**6 +00358 CL**6 +00359 CL**7 +00360 01 FOOTING-LINE-3. CL**7 +00361 05 FILLER PIC X(25) VALUE SPACES. CL**7 +00362 05 WS-X140-PAS-CNT PIC ZZ,ZZ9. CL**7 +00363 05 FILLER PIC X(02) VALUE SPACES. CL**7 +00364 05 FILLER PIC X(45) VALUE CL**7 +00365 'TOTAL REPORTS PASSED TO DUTAS '. CL**7 +00366 05 FILLER PIC X(32) VALUE SPACES. CL**7 +00367 CL**6 +00368 CL**6 +00369 01 NOREPORT-LINE. CL*22 +00370 05 FILLER PIC X(35) VALUE SPACES. CL*22 +00371 05 FILLER PIC X(57) VALUE CL*22 +00372 ' ******** NO POTENTIAL FRAUD REPORT/WAGES TODAY *******'. CL*22 +00373 05 FILLER PIC X(35) VALUE SPACES. CL*22 +00374 CL*22 +00375 CL**6 +00376 01 L004-COMM-AREA. DESBD473 +00377 ++INCLUDE DTSIL004 DESBD473 +00378 DESBD473 +00379 01 L001-LINK-AREA. CL**2 +00380 ++INCLUDE DTSIL001 CL**2 +00381 CL**2 +00382 01 L005-COMM-AREA. DESBD473 +00383 ++INCLUDE DTSIL005 DESBD473 +00384 DESBD473 +00385 01 L424-LINK-AREA. DESBD473 +00386 ++INCLUDE DTSIL424 DESBD473 +00387 DESBD473 +00388 01 L516-LINK-AREA. DESBD473 +00389 ++INCLUDE DTSIL516 DESBD473 +00390 DESBD473 +00391 01 L910-LINK-AREA. DESBD473 +00392 ++INCLUDE DTSIL910 DESBD473 +00393 DESBD473 +00394 01 X140-REC. CL**2 +00395 ++INCLUDE DTSES140 CL**2 +00396 DESBD473 +00397 01 MSKL-REC. DESBD473 +00398 ++INCLUDE DTSIMSKL DESBD473 +00399 DESBD473 +00400 01 MPRF-REC. DESBD473 +00401 ++INCLUDE DTSIMPRF DESBD473 +00402 DESBD473 +00403 01 MRPT-REC. CL*42 +00404 ++INCLUDE DTSIMRPT CL*42 +00405 DESBD473 +00406 01 L931-LINK-AREA. DESBD473 +00407 ++INCLUDE DTSIL931 DESBD473 +00408 DESBD473 +00409 01 FSKL-REC. DESBD473 +00410 ++INCLUDE DTSIFSKL DESBD473 +00411 DESBD473 +00412 01 L981-LINK-AREA. DESBD473 +00413 ++INCLUDE DTSIL981 DESBD473 +00414 DESBD473 +00415 01 WWGH-REC. DESBD473 +00416 ++INCLUDE DTSIWWGH DESBD473 +00417 DESBD473 +00418 01 X143-REC. DESBD473 +00419 ++INCLUDE DTSIX143 DESBD473 +00420 DESBD473 +00421 01 L983-LINK-AREA. DESBD473 +00422 ++INCLUDE DTSIL983 DESBD473 +00423 DESBD473 +00424 01 WSKL-REC. DESBD473 +00425 ++INCLUDE DTSIWSKL DESBD473 +00426 DESBD473 +00427 01 W001-REC. DESBD473 +00428 ++INCLUDE DTSIW001 DESBD473 +00429 DESBD473 +00430 01 L982-LINK-AREA. DESBD473 +00431 ++INCLUDE DTSIL982 DESBD473 +00432 DESBD473 +00433 01 WNAM-REC. DESBD473 +00434 ++INCLUDE DTSIWNAM DESBD473 +00435 DESBD473 +00436 DESBD473 +00437 PROCEDURE DIVISION. DESBD473 +00438 DESBD473 +00439 PERFORM I0000-INIT THRU I0000-EXIT. DESBD473 +00440 IF WRK-ERROR-NO-88 DESBD473 +00441 PERFORM P0000-PROCESS THRU P0000-EXIT DESBD473 +00442 PERFORM T0000-TERM THRU T0000-EXIT DESBD473 +00443 END-IF. DESBD473 00444 DESBD473 -00445 OPEN INPUT RPT-ESSP-FILE. CL**2 -00446 IF WAGE-TRANS-FILE-OK-88 DESBD473 -00447 OR WAGE-TRANS-FILE-VERIFY-88 DESBD473 -00448 NEXT SENTENCE DESBD473 -00449 ELSE DESBD473 -00450 PERFORM S999-ABEND THRU S999-EXIT DESBD473 -00451 END-IF. DESBD473 -00452 DESBD473 -00453 DESBD473 -00454 OPEN OUTPUT RPT-FRAUD-FILE CL**2 -00455 IF WAGE-TRANS-FILE-OK-88 DESBD473 -00456 OR WAGE-TRANS-FILE-VERIFY-88 DESBD473 -00457 NEXT SENTENCE DESBD473 -00458 ELSE DESBD473 -00459 PERFORM S999-ABEND THRU S999-EXIT DESBD473 -00460 END-IF. DESBD473 -00461 DESBD473 -00462 CL**2 -00463 OPEN OUTPUT RPT-PASSED-FILE CL**2 -00464 IF WAGE-TRANS-FILE-OK-88 CL**2 -00465 OR WAGE-TRANS-FILE-VERIFY-88 CL**2 -00466 NEXT SENTENCE CL**2 -00467 ELSE CL**2 -00468 PERFORM S999-ABEND THRU S999-EXIT CL**2 -00469 END-IF. CL**2 -00470 CL**2 -00471 CL**7 -00472 OPEN OUTPUT RPT-EROR-FILE CL**7 -00473 IF REPT-TRANS-FILE-OK-88 CL*11 -00474 OR REPT-TRANS-FILE-VERIFY-88 CL*11 -00475 NEXT SENTENCE CL**7 -00476 ELSE CL**7 -00477 PERFORM S999-ABEND THRU S999-EXIT CL**7 -00478 END-IF. CL**7 -00479 CL**7 -00480 DESBD473 -00481 PERFORM S005-FROM-SYS THRU S005-EXIT. CL**7 -00482 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL**7 -00483 MOVE L005-SLASH-8-DATE TO W-SLASH-DATE. CL**7 -00484 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL**7 -00485 MOVE L005-SLASH-8-DATE TO HDR1-LRCM-SYS-DATE CL**7 -00486 MOVE L005-DISPLAY-TIME TO HDR2-LRCM-SYS-TIME CL**7 -00487 DESBD473 -00488 * PERFORM S981A-OPEN-UPDATE THRU S981A-EXIT. DESBD473 -00489 * PERFORM S983-OPEN-UPDATE THRU S983-EXIT. DESBD473 -00490 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**2 -00491 DESBD473 -00492 I0000-EXIT. DESBD473 -00493 EXIT. DESBD473 -00494 DESBD473 -00495 P0000-PROCESS. DESBD473 -00496 READ RPT-ESSP-FILE INTO X140-REC CL**2 -00497 DESBD473 -00498 PERFORM UNTIL WAGE-TRANS-FILE-NO-REC-88 DESBD473 -00499 PERFORM P2000-FIND-MPRF THRU P2000-EXIT CL**2 -00500 READ RPT-ESSP-FILE INTO X140-REC CL**2 -00501 DESBD473 -00502 END-PERFORM. DESBD473 -00503 DESBD473 -00504 P0000-EXIT. DESBD473 -00505 EXIT. DESBD473 +00445 GOBACK. DESBD473 +00446 EJECT DESBD473 +00447 I0000-INIT. DESBD473 +00448 SET WRK-ERROR-NO-88 TO TRUE. DESBD473 +00449 DESBD473 +00450 OPEN INPUT RPT-ESSP-FILE. CL**2 +00451 IF WAGE-TRANS-FILE-OK-88 DESBD473 +00452 OR WAGE-TRANS-FILE-VERIFY-88 DESBD473 +00453 NEXT SENTENCE DESBD473 +00454 ELSE DESBD473 +00455 PERFORM S999-ABEND THRU S999-EXIT DESBD473 +00456 END-IF. DESBD473 +00457 DESBD473 +00458 DESBD473 +00459 OPEN OUTPUT RPT-FRAUD-FILE CL**2 +00460 IF WAGE-TRANS-FILE-OK-88 DESBD473 +00461 OR WAGE-TRANS-FILE-VERIFY-88 DESBD473 +00462 NEXT SENTENCE DESBD473 +00463 ELSE DESBD473 +00464 PERFORM S999-ABEND THRU S999-EXIT DESBD473 +00465 END-IF. DESBD473 +00466 DESBD473 +00467 CL**2 +00468 OPEN OUTPUT RPT-PASSED-FILE CL**2 +00469 IF WAGE-TRANS-FILE-OK-88 CL**2 +00470 OR WAGE-TRANS-FILE-VERIFY-88 CL**2 +00471 NEXT SENTENCE CL**2 +00472 ELSE CL**2 +00473 PERFORM S999-ABEND THRU S999-EXIT CL**2 +00474 END-IF. CL**2 +00475 CL**2 +00476 CL**7 +00477 OPEN OUTPUT RPT-EROR-FILE CL**7 +00478 IF REPT-TRANS-FILE-OK-88 CL*11 +00479 OR REPT-TRANS-FILE-VERIFY-88 CL*11 +00480 NEXT SENTENCE CL**7 +00481 ELSE CL**7 +00482 PERFORM S999-ABEND THRU S999-EXIT CL**7 +00483 END-IF. CL**7 +00484 CL**7 +00485 DESBD473 +00486 PERFORM S005-FROM-SYS THRU S005-EXIT. CL**7 +00487 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL**7 +00488 MOVE L005-SLASH-8-DATE TO W-SLASH-DATE. CL**7 +00489 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL**7 +00490 MOVE L005-SLASH-8-DATE TO HDR1-LRCM-SYS-DATE CL**7 +00491 MOVE L005-DISPLAY-TIME TO HDR2-LRCM-SYS-TIME CL**7 +00492 DESBD473 +00493 * PERFORM S981A-OPEN-UPDATE THRU S981A-EXIT. DESBD473 +00494 * PERFORM S983-OPEN-UPDATE THRU S983-EXIT. DESBD473 +00495 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**2 +00496 DESBD473 +00497 I0000-EXIT. DESBD473 +00498 EXIT. DESBD473 +00499 DESBD473 +00500 P0000-PROCESS. DESBD473 +00501 READ RPT-ESSP-FILE INTO X140-REC CL**2 +00502 DESBD473 +00503 PERFORM UNTIL WAGE-TRANS-FILE-NO-REC-88 DESBD473 +00504 PERFORM P2000-FIND-MPRF THRU P2000-EXIT CL**2 +00505 READ RPT-ESSP-FILE INTO X140-REC CL**2 00506 DESBD473 -00507 DESBD473 -00508 P2000-FIND-MPRF. CL**3 -00509 ADD 1 TO RPT-X140-READ. CL**2 -00510 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL**2 -00511 CL**2 -00512 * MOVE +000001 TO MSKL-EMP-NO. CL**2 -00513 MOVE X140-EMP-NO TO MSKL-EMP-NO. CL**2 -00514 CL**2 -00515 SET MSKL-PRF-88 TO TRUE. CL**2 +00507 END-PERFORM. DESBD473 +00508 DESBD473 +00509 P0000-EXIT. DESBD473 +00510 EXIT. DESBD473 +00511 DESBD473 +00512 DESBD473 +00513 P2000-FIND-MPRF. CL**3 +00514 ADD 1 TO RPT-X140-READ. CL**2 +00515 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL**2 00516 CL**2 -00517 PERFORM S910-READ THRU S910-EXIT. CL**2 -00518 IF L910-OK-88 CL**2 -00519 MOVE MSKL-REC TO MPRF-REC CL**2 -00520 SET WRK-MPRF-OK TO TRUE CL**2 -00521 ELSE CL**2 -00522 DISPLAY 'EMPLOYER NOT IN DUTAS ' X140-EMP-NO CL**2 -00523 ADD 1 TO RPT-FRAUD-CNT CL*25 -00524 WRITE RPT-FRAUD-REC FROM X140-REC CL*27 -00525 PERFORM P4500-WRITE-EROR-MPRF THRU P4500-EXIT CL*26 -00526 SET L910-NO-REC-88 TO TRUE CL*25 -00527 GO TO P2000-EXIT. CL**2 -00528 DESBD473 -00529 DISPLAY ' '. CL**4 -00530 DISPLAY '----- NEW EMP ' X140-EMP-NO CL**4 -00531 IF X140-EMP-NO(1:3) = 186 CL*31 -00532 DISPLAY '--MINI CONV ACCT- PASSED ' X140-EMP-NO CL*31 -00533 MOVE '140' TO X140-REC-TYPE CL*34 -00534 WRITE RPT-PASSED-REC FROM X140-REC CL*31 -00535 ADD 1 TO RPT-PASSED-CNT CL*31 -00536 GO TO P2000-EXIT. CL*31 -00537 CL**2 -00538 IF X140-REC-TYPE = 'REL' CL*32 -00539 DISPLAY '--X140 RELEASED - PASSED ' X140-EMP-NO CL*32 -00540 MOVE '140' TO X140-REC-TYPE CL*33 -00541 WRITE RPT-PASSED-REC FROM X140-REC CL*32 -00542 ADD 1 TO RPT-PASSED-CNT CL*32 -00543 GO TO P2000-EXIT. CL*32 -00544 CL*32 -00545 MOVE X140-RCVD-DATE TO W-SLASH-DATE CL**2 -00546 DISPLAY 'RPT RECEIVED DATE ' X140-RCVD-DATE CL**2 -00547 CL**2 -00548 MOVE W-SLASH-DT-DD TO RPT-FED-8-DA CL**2 -00549 MOVE W-SLASH-DT-MM TO RPT-FED-8-MO CL**2 -00550 MOVE W-SLASH-DT-CCYY TO RPT-FED-8-YR CL**2 -00551 CL**2 -00552 MOVE WRK-FED-8-DATE TO L001-FED-8-DATE-9 CL**2 -00553 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL**2 -00554 SUBTRACT 30 FROM L001-JUL-ABS-DAY CL**2 -00555 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT CL**2 -00556 MOVE L001-FED-8-DATE-9 TO WRK-FRAUD-CUTOFF-DATE. CL**2 -00557 DISPLAY 'FRAUD CUTOFF DATE ' L001-FED-8-DATE-9. CL**4 -00558 CL**2 +00517 * MOVE +000001 TO MSKL-EMP-NO. CL**2 +00518 MOVE X140-EMP-NO TO MSKL-EMP-NO. CL**2 +00519 CL**2 +00520 SET MSKL-PRF-88 TO TRUE. CL**2 +00521 CL**2 +00522 PERFORM S910-READ THRU S910-EXIT. CL**2 +00523 IF L910-OK-88 CL**2 +00524 MOVE MSKL-REC TO MPRF-REC CL**2 +00525 SET WRK-MPRF-OK TO TRUE CL**2 +00526 ELSE CL**2 +00527 DISPLAY 'EMPLOYER NOT IN DUTAS ' X140-EMP-NO CL**2 +00528 ADD 1 TO RPT-FRAUD-CNT CL*25 +00529 WRITE RPT-FRAUD-REC FROM X140-REC CL*27 +00530 PERFORM P4500-WRITE-EROR-MPRF THRU P4500-EXIT CL*26 +00531 SET L910-NO-REC-88 TO TRUE CL*25 +00532 GO TO P2000-EXIT. CL**2 +00533 DESBD473 +00534 DISPLAY ' '. CL**4 +00535 DISPLAY '----- NEW EMP ' X140-EMP-NO CL**4 +00536 IF X140-EMP-NO(1:3) = 186 CL*31 +00537 DISPLAY '--MINI CONV ACCT- PASSED ' X140-EMP-NO CL*31 +00538 MOVE '140' TO X140-REC-TYPE CL*34 +00539 WRITE RPT-PASSED-REC FROM X140-REC CL*31 +00540 ADD 1 TO RPT-PASSED-CNT CL*31 +00541 GO TO P2000-EXIT. CL*31 +00542 CL**2 +00543 IF X140-REC-TYPE = 'REL' CL*32 +00544 DISPLAY '--X140 RELEASED - PASSED ' X140-EMP-NO CL*32 +00545 MOVE '140' TO X140-REC-TYPE CL*33 +00546 WRITE RPT-PASSED-REC FROM X140-REC CL*32 +00547 ADD 1 TO RPT-PASSED-CNT CL*32 +00548 GO TO P2000-EXIT. CL*32 +00549 CL*32 +00550 IF X140-RESP-OPID > SPACES CL*46 +00551 DISPLAY 'UPDATED BY OPERATOR-PASSED ' X140-EMP-NO CL*47 +00552 MOVE '140' TO X140-REC-TYPE CL*46 +00553 WRITE RPT-PASSED-REC FROM X140-REC CL*46 +00554 ADD 1 TO RPT-PASSED-CNT CL*46 +00555 GO TO P2000-EXIT. CL*46 +00556 CL*46 +00557 MOVE X140-RCVD-DATE TO W-SLASH-DATE CL**2 +00558 DISPLAY 'RPT RECEIVED DATE ' X140-RCVD-DATE CL**2 00559 CL**2 -00560 PERFORM P5000-FIND-MQTR THRU P5000-EXIT. CL*41 -00561 CL*41 -00562 IF MPRF-ESTB-DATE >= WRK-FRAUD-CUTOFF-DATE CL**2 -00563 DISPLAY 'FRAUD REPORT..... ' MPRF-EMP-NO CL**4 -00564 DISPLAY 'MPRF ESTB DATE ' MPRF-ESTB-DATE CL**4 -00565 DISPLAY 'FRAUD CUTOFF DATE ' WRK-FRAUD-CUTOFF-DATE CL**4 -00566 WRITE RPT-FRAUD-REC FROM X140-REC CL**2 -00567 ADD 1 TO RPT-FRAUD-CNT CL**2 -00568 PERFORM P4000-WRITE-EROR-REPT THRU P4000-EXIT CL**7 -00569 ELSE CL**2 -00570 IF NO-REPORT-FILED = 1 CL*41 -00571 DISPLAY 'FRAUD 1ST RPT FILED ' MPRF-EMP-NO CL*41 -00572 WRITE RPT-FRAUD-REC FROM X140-REC CL*41 -00573 ADD 1 TO RPT-FRAUD-CNT CL*41 -00574 PERFORM P4000-WRITE-EROR-REPT THRU P4000-EXIT CL*41 -00575 ELSE CL*41 -00576 WRITE RPT-PASSED-REC FROM X140-REC CL**2 -00577 ADD 1 TO RPT-PASSED-CNT. CL**2 -00578 P2000-EXIT. DESBD473 -00579 EXIT. DESBD473 -00580 P4000-WRITE-EROR-REPT. CL**7 -00581 CL*30 -00582 MOVE MPRF-ESTB-DATE TO WRK-FED-Z-DATE CL*30 -00583 MOVE WRK-FED-Z-DATE TO L001-FED-8-DATE-9 CL*16 -00584 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*15 -00585 * SUBTRACT 30 FROM L001-JUL-ABS-DAY CL*15 -00586 * PERFORM S001-FROM-ABS-DAY THRU S001-EXIT CL*15 -00587 MOVE L001-SLASH-8-DATE TO X434-REGD-DATE. CL*15 -00588 * DISPLAY 'REG DATE ' L001-SLASH-8-DATE. CL*25 -00589 CL*15 -00590 MOVE X140-EMP-NO TO X434-EMP-NO CL**6 -00591 MOVE X140-QUARTER TO X434-QTR CL**6 -00592 MOVE '/' TO X434-QTR-F CL*16 -00593 CL**7 -00594 CL*25 -00595 MOVE MPRF-PRIMARY-NAME (1:20) CL**7 -00596 TO X434-NAME-CHECK CL**7 -00597 MOVE MPRF-EMP-STATUS TO X434-EMP-STATUS CL*16 -00598 MOVE MPRF-EMP-CLASS TO X434-EMP-CLASS CL*16 -00599 MOVE MPRF-ORG-TYPE TO X434-EMP-ORG CL*16 -00600 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL**6 -00601 * MOVE X140-RCVD-DATE TO X434-REGD-DATE CL*17 -00602 MOVE X140-TOTAL-WAGE TO X434-TOT-WAGE CL**9 -00603 MOVE X140-EXCESS-WAGE TO X434-EXC-WAGE CL**9 -00604 MOVE X140-TAX-WAGE TO X434-TAX-WAGE CL**9 -00605 DESBD473 -00606 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL*25 -00607 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL*25 -00608 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL*25 -00609 CL**6 -00610 PERFORM P5000-FIND-MQTR THRU P5000-EXIT. CL*27 -00611 MOVE 'N' TO X434-QTR-FILED. CL*30 -00612 IF NO-REPORT-FILED = 1 CL*27 -00613 MOVE 'Y' TO X434-QTR-FILED. CL*27 -00614 * MOVE ' ' TO X434-MESSAGE CL*25 -00615 CL**6 -00616 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL**6 -00617 WRITE REPT-EROR-REC FROM DETAIL-LINE-1 AFTER 1. CL**7 -00618 ADD 1 TO WS-LINE-CNT. CL**7 -00619 P4000-EXIT. CL**6 -00620 EXIT. CL**6 -00621 P4500-WRITE-EROR-MPRF. CL*25 -00622 CL*25 -00623 MOVE SPACES TO X434-REGD-DATE. CL*25 -00624 CL*25 -00625 MOVE X140-EMP-NO TO X434-EMP-NO CL*25 -00626 MOVE X140-QUARTER TO X434-QTR CL*25 -00627 MOVE '/' TO X434-QTR-F CL*25 -00628 CL*25 -00629 MOVE 'N' TO X434-QTR-FILED CL*25 -00630 MOVE 'EMPLOYER NOT IN DUTAS' CL*25 -00631 TO X434-NAME-CHECK CL*25 -00632 MOVE SPACES TO X434-EMP-STATUS CL*25 -00633 MOVE SPACES TO X434-EMP-CLASS CL*25 -00634 MOVE SPACES TO X434-EMP-ORG CL*25 -00635 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL*25 -00636 MOVE X140-TOTAL-WAGE TO X434-TOT-WAGE CL*25 -00637 MOVE X140-EXCESS-WAGE TO X434-EXC-WAGE CL*25 -00638 MOVE X140-TAX-WAGE TO X434-TAX-WAGE CL*25 -00639 CL*25 -00640 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL*25 -00641 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL*25 -00642 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL*25 -00643 CL*25 -00644 * MOVE ' ' TO X434-MESSAGE CL*25 -00645 CL*25 -00646 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL*25 -00647 WRITE REPT-EROR-REC FROM DETAIL-LINE-1 AFTER 1. CL*25 -00648 ADD 1 TO WS-LINE-CNT. CL*25 -00649 P4500-EXIT. CL*25 -00650 EXIT. CL*25 -00651 CL*26 -00652 P5000-FIND-MQTR. CL*30 -00653 CL*25 -00654 MOVE 0 TO NO-REPORT-FILED CL*25 -00655 MOVE LOW-VALUES TO MQTR-KEY-AREA. CL*25 -00656 CL*25 -00657 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. CL*25 -00658 SET MQTR-QTR-88 TO TRUE. CL*25 -00659 MOVE 20201 TO MQTR-YRQ. CL*25 -00660 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL*25 -00661 CL*25 -00662 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*25 -00663 IF L910-NO-REC-88 CL*25 -00664 MOVE 1 TO NO-REPORT-FILED CL*25 -00665 DISPLAY 'NO QTRS FILED ' MPRF-EMP-NO ' ' WRK-YRQ. CL*25 -00666 P5000-EXIT. CL*25 -00667 EXIT. CL*25 +00560 MOVE W-SLASH-DT-DD TO RPT-FED-8-DA CL**2 +00561 MOVE W-SLASH-DT-MM TO RPT-FED-8-MO CL**2 +00562 MOVE W-SLASH-DT-CCYY TO RPT-FED-8-YR CL**2 +00563 CL**2 +00564 MOVE WRK-FED-8-DATE TO L001-FED-8-DATE-9 CL**2 +00565 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL**2 +00566 SUBTRACT 180 FROM L001-JUL-ABS-DAY CL*44 +00567 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT CL**2 +00568 MOVE L001-FED-8-DATE-9 TO WRK-FRAUD-CUTOFF-DATE. CL**2 +00569 DISPLAY 'FRAUD CUTOFF DATE ' L001-FED-8-DATE-9. CL**4 +00570 CL**2 +00571 CL**2 +00572 PERFORM P5000-FIND-MRPT THRU P5000-EXIT. CL*42 +00573 CL*41 +00574 IF MPRF-ESTB-DATE >= WRK-FRAUD-CUTOFF-DATE CL**2 +00575 DISPLAY 'FRAUD REPORT..... ' MPRF-EMP-NO CL**4 +00576 DISPLAY 'MPRF ESTB DATE ' MPRF-ESTB-DATE CL**4 +00577 DISPLAY 'FRAUD CUTOFF DATE ' WRK-FRAUD-CUTOFF-DATE CL**4 +00578 WRITE RPT-FRAUD-REC FROM X140-REC CL**2 +00579 ADD 1 TO RPT-FRAUD-CNT CL**2 +00580 PERFORM P4000-WRITE-EROR-REPT THRU P4000-EXIT CL**7 +00581 ELSE CL**2 +00582 IF NO-REPORT-FILED = 1 CL*41 +00583 DISPLAY 'FRAUD 1ST RPT FILED ' MPRF-EMP-NO CL*41 +00584 WRITE RPT-FRAUD-REC FROM X140-REC CL*41 +00585 ADD 1 TO RPT-FRAUD-CNT CL*41 +00586 PERFORM P4000-WRITE-EROR-REPT THRU P4000-EXIT CL*41 +00587 ELSE CL*41 +00588 WRITE RPT-PASSED-REC FROM X140-REC CL**2 +00589 ADD 1 TO RPT-PASSED-CNT. CL**2 +00590 P2000-EXIT. DESBD473 +00591 EXIT. DESBD473 +00592 P4000-WRITE-EROR-REPT. CL**7 +00593 CL*30 +00594 MOVE MPRF-ESTB-DATE TO WRK-FED-Z-DATE CL*30 +00595 MOVE WRK-FED-Z-DATE TO L001-FED-8-DATE-9 CL*16 +00596 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*15 +00597 * SUBTRACT 30 FROM L001-JUL-ABS-DAY CL*15 +00598 * PERFORM S001-FROM-ABS-DAY THRU S001-EXIT CL*15 +00599 MOVE L001-SLASH-8-DATE TO X434-REGD-DATE. CL*15 +00600 * DISPLAY 'REG DATE ' L001-SLASH-8-DATE. CL*25 +00601 CL*15 +00602 MOVE X140-EMP-NO TO X434-EMP-NO CL**6 +00603 MOVE X140-QUARTER TO X434-QTR CL**6 +00604 MOVE '/' TO X434-QTR-F CL*16 +00605 CL**7 +00606 CL*25 +00607 MOVE MPRF-PRIMARY-NAME (1:20) CL**7 +00608 TO X434-NAME-CHECK CL**7 +00609 MOVE MPRF-EMP-STATUS TO X434-EMP-STATUS CL*16 +00610 MOVE MPRF-EMP-CLASS TO X434-EMP-CLASS CL*16 +00611 MOVE MPRF-ORG-TYPE TO X434-EMP-ORG CL*16 +00612 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL**6 +00613 * MOVE X140-RCVD-DATE TO X434-REGD-DATE CL*17 +00614 MOVE X140-TOTAL-WAGE TO X434-TOT-WAGE CL**9 +00615 MOVE X140-EXCESS-WAGE TO X434-EXC-WAGE CL**9 +00616 MOVE X140-TAX-WAGE TO X434-TAX-WAGE CL**9 +00617 DESBD473 +00618 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL*25 +00619 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL*25 +00620 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL*25 +00621 CL**6 +00622 PERFORM P5000-FIND-MRPT THRU P5000-EXIT. CL*42 +00623 MOVE 'N' TO X434-QTR-FILED. CL*30 +00624 IF NO-REPORT-FILED = 1 CL*27 +00625 MOVE 'Y' TO X434-QTR-FILED. CL*27 +00626 * MOVE ' ' TO X434-MESSAGE CL*25 +00627 CL**6 +00628 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL**6 +00629 WRITE REPT-EROR-REC FROM DETAIL-LINE-1 AFTER 1. CL**7 +00630 ADD 1 TO WS-LINE-CNT. CL**7 +00631 P4000-EXIT. CL**6 +00632 EXIT. CL**6 +00633 P4500-WRITE-EROR-MPRF. CL*25 +00634 CL*25 +00635 MOVE SPACES TO X434-REGD-DATE. CL*25 +00636 CL*25 +00637 MOVE X140-EMP-NO TO X434-EMP-NO CL*25 +00638 MOVE X140-QUARTER TO X434-QTR CL*25 +00639 MOVE '/' TO X434-QTR-F CL*25 +00640 CL*25 +00641 MOVE 'N' TO X434-QTR-FILED CL*25 +00642 MOVE 'EMPLOYER NOT IN DUTAS' CL*25 +00643 TO X434-NAME-CHECK CL*25 +00644 MOVE SPACES TO X434-EMP-STATUS CL*25 +00645 MOVE SPACES TO X434-EMP-CLASS CL*25 +00646 MOVE SPACES TO X434-EMP-ORG CL*25 +00647 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL*25 +00648 MOVE X140-TOTAL-WAGE TO X434-TOT-WAGE CL*25 +00649 MOVE X140-EXCESS-WAGE TO X434-EXC-WAGE CL*25 +00650 MOVE X140-TAX-WAGE TO X434-TAX-WAGE CL*25 +00651 CL*25 +00652 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL*25 +00653 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL*25 +00654 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL*25 +00655 CL*25 +00656 * MOVE ' ' TO X434-MESSAGE CL*25 +00657 CL*25 +00658 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL*25 +00659 WRITE REPT-EROR-REC FROM DETAIL-LINE-1 AFTER 1. CL*25 +00660 ADD 1 TO WS-LINE-CNT. CL*25 +00661 P4500-EXIT. CL*25 +00662 EXIT. CL*25 +00663 CL*26 +00664 P5000-FIND-MRPT. CL*42 +00665 CL*25 +00666 MOVE 0 TO NO-REPORT-FILED CL*25 +00667 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL*42 00668 CL*25 -00669 P4100-PRINT-HEADER. CL*25 -00670 IF WS-LINE-CNT GREATER 58 CL**7 -00671 MOVE +0 TO WS-LINE-CNT CL**6 -00672 ADD +1 TO WS-PAGE-CNT CL**6 -00673 MOVE WS-PAGE-CNT TO HDR3-PAGE CL**6 -00674 * WRITE REPT-EROR-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*35 -00675 * WRITE REPT-EROR-REC FROM HEADER-2 AFTER 1 CL*35 -00676 WRITE REPT-EROR-REC FROM HEADER-3 AFTER TOP-OF-PAGE CL*35 -00677 WRITE REPT-EROR-REC FROM HEADER-5 AFTER 1 CL*20 -00678 WRITE REPT-EROR-REC FROM HEADER-4 AFTER 1 CL**7 -00679 ADD +6 TO WS-LINE-CNT. CL**7 -00680 P4100-EXIT. CL**6 -00681 EXIT. CL**6 -00682 T0000-TERM. DESBD473 -00683 DESBD473 -00684 DESBD473 -00685 DISPLAY '******************************************' DESBD473 -00686 DISPLAY '** DTSBD473 TERMINATION STATISTICS **'. CL**2 -00687 DESBD473 -00688 DISPLAY 'TOTAL ESSP X140 READ = ' RPT-X140-READ. CL**2 -00689 DISPLAY 'TOTAL FRAUD RPTS WRITTEN = ' RPT-FRAUD-CNT. CL**2 -00690 DISPLAY 'TOTAL RPTS PASSED TO DUTAS = ' RPT-PASSED-CNT. CL**2 -00691 DISPLAY ' '. DESBD473 -00692 MOVE RPT-FRAUD-CNT TO WS-X140-PEN-CNT. CL**7 -00693 MOVE RPT-X140-READ TO WS-X140-RED-CNT. CL*14 -00694 MOVE RPT-PASSED-CNT TO WS-X140-PAS-CNT. CL**7 -00695 CL*22 -00696 IF RPT-FRAUD-CNT = ZERO CL*22 -00697 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*22 -00698 WRITE REPT-EROR-REC FROM NOREPORT-LINE AFTER 5. CL*22 -00699 CL*22 -00700 WRITE REPT-EROR-REC FROM FOOTING-LINE-1 AFTER 5 CL*22 -00701 WRITE REPT-EROR-REC FROM FOOTING-LINE-2 AFTER 1 CL**7 -00702 WRITE REPT-EROR-REC FROM FOOTING-LINE-3 AFTER 1 CL**7 -00703 CLOSE RPT-ESSP-FILE RPT-FRAUD-FILE RPT-PASSED-FILE. CL**7 -00704 T0000-EXIT. DESBD473 -00705 EXIT. DESBD473 -00706 DESBD473 -00707 S004-EDIT-QTR. DESBD473 -00708 CALL 'DTSBU004' USING L004-COMM-AREA. DESBD473 -00709 DESBD473 -00710 S004-EXIT. DESBD473 -00711 EXIT. DESBD473 -00712 S005-FROM-SYS. DESBD473 -00713 DESBD473 -00714 SET L005-FROM-SYS TO TRUE. DESBD473 -00715 GO TO S005-ABSTIME. DESBD473 -00716 DESBD473 -00717 S005-ABSTIME. DESBD473 +00669 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL*42 +00670 SET MRPT-RPT-88 TO TRUE. CL*42 +00671 MOVE 20201 TO MRPT-YRQ. CL*42 +00672 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL*42 +00673 CL*25 +00674 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*25 +00675 IF L910-NO-REC-88 CL*25 +00676 MOVE 1 TO NO-REPORT-FILED CL*25 +00677 DISPLAY 'NO QTRS FILED ' MPRF-EMP-NO ' ' WRK-YRQ. CL*25 +00678 P5000-EXIT. CL*25 +00679 EXIT. CL*25 +00680 CL*25 +00681 P4100-PRINT-HEADER. CL*25 +00682 IF WS-LINE-CNT GREATER 58 CL**7 +00683 MOVE +0 TO WS-LINE-CNT CL**6 +00684 ADD +1 TO WS-PAGE-CNT CL**6 +00685 MOVE WS-PAGE-CNT TO HDR3-PAGE CL**6 +00686 * WRITE REPT-EROR-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*35 +00687 * WRITE REPT-EROR-REC FROM HEADER-2 AFTER 1 CL*35 +00688 WRITE REPT-EROR-REC FROM HEADER-3 AFTER TOP-OF-PAGE CL*35 +00689 WRITE REPT-EROR-REC FROM HEADER-5 AFTER 1 CL*20 +00690 WRITE REPT-EROR-REC FROM HEADER-4 AFTER 1 CL**7 +00691 ADD +6 TO WS-LINE-CNT. CL**7 +00692 P4100-EXIT. CL**6 +00693 EXIT. CL**6 +00694 T0000-TERM. DESBD473 +00695 DESBD473 +00696 DESBD473 +00697 DISPLAY '******************************************' DESBD473 +00698 DISPLAY '** DTSBD473 TERMINATION STATISTICS **'. CL**2 +00699 DESBD473 +00700 DISPLAY 'TOTAL ESSP X140 READ = ' RPT-X140-READ. CL**2 +00701 DISPLAY 'TOTAL FRAUD RPTS WRITTEN = ' RPT-FRAUD-CNT. CL**2 +00702 DISPLAY 'TOTAL RPTS PASSED TO DUTAS = ' RPT-PASSED-CNT. CL**2 +00703 DISPLAY ' '. DESBD473 +00704 MOVE RPT-FRAUD-CNT TO WS-X140-PEN-CNT. CL**7 +00705 MOVE RPT-X140-READ TO WS-X140-RED-CNT. CL*14 +00706 MOVE RPT-PASSED-CNT TO WS-X140-PAS-CNT. CL**7 +00707 CL*22 +00708 IF RPT-FRAUD-CNT = ZERO CL*22 +00709 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*22 +00710 WRITE REPT-EROR-REC FROM NOREPORT-LINE AFTER 5. CL*22 +00711 CL*22 +00712 WRITE REPT-EROR-REC FROM FOOTING-LINE-1 AFTER 5 CL*22 +00713 WRITE REPT-EROR-REC FROM FOOTING-LINE-2 AFTER 1 CL**7 +00714 WRITE REPT-EROR-REC FROM FOOTING-LINE-3 AFTER 1 CL**7 +00715 CLOSE RPT-ESSP-FILE RPT-FRAUD-FILE RPT-PASSED-FILE. CL**7 +00716 T0000-EXIT. DESBD473 +00717 EXIT. DESBD473 00718 DESBD473 -00719 CALL 'DTSBU005' USING L005-COMM-AREA. DESBD473 -00720 DESBD473 -00721 S005-EXIT. DESBD473 -00722 EXIT. DESBD473 -00723 DESBD473 -00724 CL**2 -00725 S001-FROM-FED-8. CL**2 -00726 SET L001-FROM-FED-8 TO TRUE. CL**2 -00727 GO TO S001-DATE. CL**2 -00728 SKIP1 CL**2 -00729 S001-FROM-ABS-DAY. CL**2 -00730 SET L001-FROM-ABS-DAY TO TRUE. CL**2 -00731 GO TO S001-DATE. CL**2 -00732 SKIP1 CL**2 -00733 S001-FROM-CAL-6. CL**2 -00734 SET L001-FROM-CAL-6 TO TRUE. CL**2 -00735 GO TO S001-DATE. CL**2 -00736 SKIP1 CL**2 -00737 S001-DATE. CL**2 -00738 CALL 'DTSBU001' USING L001-LINK-AREA. CL**2 -00739 S001-EXIT. CL**2 -00740 EXIT. CL**2 -00741 DESBD473 -00742 DESBD473 -00743 S516-LIABILITY-INFO. DESBD473 -00744 CALL 'DTSBU516' USING L516-LINK-AREA DESBD473 -00745 MPRF-REC. DESBD473 -00746 S516-EXIT. DESBD473 -00747 EXIT. DESBD473 -00748 DESBD473 -00749 S910-OPEN-READ. DESBD473 -00750 SET L910-OPEN-READ-88 TO TRUE. DESBD473 -00751 GO TO S910-MSTR-IO. DESBD473 -00752 DESBD473 -00753 S910-READ. DESBD473 -00754 SET L910-READ-88 TO TRUE. DESBD473 -00755 GO TO S910-MSTR-IO. DESBD473 -00756 DESBD473 -00757 S910-START-BROWSE. DESBD473 -00758 SET L910-START-BROWSE-88 TO TRUE. DESBD473 -00759 GO TO S910-MSTR-IO. DESBD473 +00719 S004-EDIT-QTR. DESBD473 +00720 CALL 'DTSBU004' USING L004-COMM-AREA. DESBD473 +00721 DESBD473 +00722 S004-EXIT. DESBD473 +00723 EXIT. DESBD473 +00724 S005-FROM-SYS. DESBD473 +00725 DESBD473 +00726 SET L005-FROM-SYS TO TRUE. DESBD473 +00727 GO TO S005-ABSTIME. DESBD473 +00728 DESBD473 +00729 S005-ABSTIME. DESBD473 +00730 DESBD473 +00731 CALL 'DTSBU005' USING L005-COMM-AREA. DESBD473 +00732 DESBD473 +00733 S005-EXIT. DESBD473 +00734 EXIT. DESBD473 +00735 DESBD473 +00736 CL**2 +00737 S001-FROM-FED-8. CL**2 +00738 SET L001-FROM-FED-8 TO TRUE. CL**2 +00739 GO TO S001-DATE. CL**2 +00740 SKIP1 CL**2 +00741 S001-FROM-ABS-DAY. CL**2 +00742 SET L001-FROM-ABS-DAY TO TRUE. CL**2 +00743 GO TO S001-DATE. CL**2 +00744 SKIP1 CL**2 +00745 S001-FROM-CAL-6. CL**2 +00746 SET L001-FROM-CAL-6 TO TRUE. CL**2 +00747 GO TO S001-DATE. CL**2 +00748 SKIP1 CL**2 +00749 S001-DATE. CL**2 +00750 CALL 'DTSBU001' USING L001-LINK-AREA. CL**2 +00751 S001-EXIT. CL**2 +00752 EXIT. CL**2 +00753 DESBD473 +00754 DESBD473 +00755 S516-LIABILITY-INFO. DESBD473 +00756 CALL 'DTSBU516' USING L516-LINK-AREA DESBD473 +00757 MPRF-REC. DESBD473 +00758 S516-EXIT. DESBD473 +00759 EXIT. DESBD473 00760 DESBD473 -00761 S910-READ-NEXT. DESBD473 -00762 SET L910-READ-NEXT-88 TO TRUE. DESBD473 +00761 S910-OPEN-READ. DESBD473 +00762 SET L910-OPEN-READ-88 TO TRUE. DESBD473 00763 GO TO S910-MSTR-IO. DESBD473 00764 DESBD473 -00765 S910-CLOSE. DESBD473 -00766 SET L910-CLOSE-88 TO TRUE. DESBD473 +00765 S910-READ. DESBD473 +00766 SET L910-READ-88 TO TRUE. DESBD473 00767 GO TO S910-MSTR-IO. DESBD473 00768 DESBD473 -00769 S910-MSTR-IO. DESBD473 -00770 CALL 'DTSBU910' USING L910-LINK-AREA DESBD473 -00771 MSKL-REC. DESBD473 -00772 S910-EXIT. DESBD473 -00773 EXIT. DESBD473 -00774 DESBD473 -00775 S931-OPEN-READ. DESBD473 -00776 SET L931-OPEN-READ-88 TO TRUE. DESBD473 -00777 GO TO S931-REF-IO. DESBD473 -00778 DESBD473 -00779 S931-CLOSE. DESBD473 -00780 SET L931-CLOSE-88 TO TRUE. DESBD473 -00781 GO TO S931-REF-IO. DESBD473 -00782 DESBD473 -00783 S931-REF-IO. DESBD473 -00784 CALL 'DTSBU931' USING L931-LINK-AREA DESBD473 -00785 FSKL-REC. DESBD473 -00786 S931-EXIT. DESBD473 -00787 EXIT. DESBD473 -00788 DESBD473 -00789 S981A-OPEN-UPDATE. DESBD473 -00790 SET L981-OPEN-UPDATE-88 TO TRUE. DESBD473 -00791 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 -00792 DESBD473 -00793 S981A-EXIT. DESBD473 -00794 EXIT. DESBD473 -00795 DESBD473 -00796 S981B-WRITE. DESBD473 -00797 SET L981-WRITE-88 TO TRUE. DESBD473 -00798 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 -00799 DESBD473 -00800 S981B-EXIT. DESBD473 -00801 EXIT. DESBD473 -00802 S981C-READ. DESBD473 -00803 SET L981-READ-88 TO TRUE. DESBD473 -00804 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 -00805 DESBD473 -00806 S981C-EXIT. DESBD473 -00807 EXIT. DESBD473 -00808 S981E-DELETE. DESBD473 -00809 SET L981-DELETE-88 TO TRUE. DESBD473 +00769 S910-START-BROWSE. DESBD473 +00770 SET L910-START-BROWSE-88 TO TRUE. DESBD473 +00771 GO TO S910-MSTR-IO. DESBD473 +00772 DESBD473 +00773 S910-READ-NEXT. DESBD473 +00774 SET L910-READ-NEXT-88 TO TRUE. DESBD473 +00775 GO TO S910-MSTR-IO. DESBD473 +00776 DESBD473 +00777 S910-CLOSE. DESBD473 +00778 SET L910-CLOSE-88 TO TRUE. DESBD473 +00779 GO TO S910-MSTR-IO. DESBD473 +00780 DESBD473 +00781 S910-MSTR-IO. DESBD473 +00782 CALL 'DTSBU910' USING L910-LINK-AREA DESBD473 +00783 MSKL-REC. DESBD473 +00784 S910-EXIT. DESBD473 +00785 EXIT. DESBD473 +00786 DESBD473 +00787 S931-OPEN-READ. DESBD473 +00788 SET L931-OPEN-READ-88 TO TRUE. DESBD473 +00789 GO TO S931-REF-IO. DESBD473 +00790 DESBD473 +00791 S931-CLOSE. DESBD473 +00792 SET L931-CLOSE-88 TO TRUE. DESBD473 +00793 GO TO S931-REF-IO. DESBD473 +00794 DESBD473 +00795 S931-REF-IO. DESBD473 +00796 CALL 'DTSBU931' USING L931-LINK-AREA DESBD473 +00797 FSKL-REC. DESBD473 +00798 S931-EXIT. DESBD473 +00799 EXIT. DESBD473 +00800 DESBD473 +00801 S981A-OPEN-UPDATE. DESBD473 +00802 SET L981-OPEN-UPDATE-88 TO TRUE. DESBD473 +00803 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 +00804 DESBD473 +00805 S981A-EXIT. DESBD473 +00806 EXIT. DESBD473 +00807 DESBD473 +00808 S981B-WRITE. DESBD473 +00809 SET L981-WRITE-88 TO TRUE. DESBD473 00810 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 00811 DESBD473 -00812 S981E-EXIT. DESBD473 +00812 S981B-EXIT. DESBD473 00813 EXIT. DESBD473 -00814 DESBD473 -00815 S981D-CLOSE. DESBD473 -00816 SET L981-CLOSE-88 TO TRUE. DESBD473 -00817 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 -00818 DESBD473 -00819 S981D-EXIT. DESBD473 -00820 EXIT. DESBD473 -00821 DESBD473 -00822 S981Z-WWGH-IO. DESBD473 -00823 CALL 'DTSBU981' USING L981-LINK-AREA DESBD473 -00824 WWGH-REC. DESBD473 -00825 S981Z-EXIT. DESBD473 -00826 EXIT. DESBD473 -00827 DESBD473 -00828 S983-OPEN-UPDATE. DESBD473 -00829 SET L983-OPEN-UPDATE-88 TO TRUE. DESBD473 -00830 GO TO S983-WAGE-I. DESBD473 -00831 DESBD473 -00832 S983-WRITE. DESBD473 -00833 SET L983-WRITE-88 TO TRUE. DESBD473 -00834 GO TO S983-WAGE-I. DESBD473 -00835 DESBD473 -00836 S983-DELETE. DESBD473 -00837 SET L983-DELETE-88 TO TRUE. DESBD473 -00838 GO TO S983-WAGE-I. DESBD473 +00814 S981C-READ. DESBD473 +00815 SET L981-READ-88 TO TRUE. DESBD473 +00816 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 +00817 DESBD473 +00818 S981C-EXIT. DESBD473 +00819 EXIT. DESBD473 +00820 S981E-DELETE. DESBD473 +00821 SET L981-DELETE-88 TO TRUE. DESBD473 +00822 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 +00823 DESBD473 +00824 S981E-EXIT. DESBD473 +00825 EXIT. DESBD473 +00826 DESBD473 +00827 S981D-CLOSE. DESBD473 +00828 SET L981-CLOSE-88 TO TRUE. DESBD473 +00829 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DESBD473 +00830 DESBD473 +00831 S981D-EXIT. DESBD473 +00832 EXIT. DESBD473 +00833 DESBD473 +00834 S981Z-WWGH-IO. DESBD473 +00835 CALL 'DTSBU981' USING L981-LINK-AREA DESBD473 +00836 WWGH-REC. DESBD473 +00837 S981Z-EXIT. DESBD473 +00838 EXIT. DESBD473 00839 DESBD473 -00840 S983-CLOSE. DESBD473 -00841 SET L983-CLOSE-88 TO TRUE. DESBD473 +00840 S983-OPEN-UPDATE. DESBD473 +00841 SET L983-OPEN-UPDATE-88 TO TRUE. DESBD473 00842 GO TO S983-WAGE-I. DESBD473 00843 DESBD473 -00844 S983-WAGE-I. DESBD473 -00845 CALL 'DTSBU983' USING L983-LINK-AREA DESBD473 -00846 WSKL-REC. DESBD473 -00847 S983-EXIT. DESBD473 -00848 EXIT. DESBD473 -00849 DESBD473 -00850 S982A-START-BROWSE. DESBD473 -00851 SET L982-START-BROWSE-88 TO TRUE. DESBD473 -00852 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 -00853 DESBD473 -00854 S982A-EXIT. DESBD473 -00855 EXIT. DESBD473 -00856 DESBD473 -00857 S982B-READ-NEXT. DESBD473 -00858 SET L982-READ-NEXT-88 TO TRUE. DESBD473 -00859 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 -00860 DESBD473 -00861 S982B-EXIT. DESBD473 -00862 EXIT. DESBD473 -00863 DESBD473 -00864 S982C-OPEN-READ. DESBD473 -00865 SET L982-OPEN-READ-88 TO TRUE. DESBD473 -00866 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 -00867 DESBD473 -00868 S982C-EXIT. DESBD473 -00869 EXIT. DESBD473 -00870 DESBD473 -00871 S982D-CLOSE. DESBD473 -00872 SET L982-CLOSE-88 TO TRUE. DESBD473 -00873 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 -00874 DESBD473 -00875 S982D-EXIT. DESBD473 -00876 EXIT. DESBD473 -00877 DESBD473 -00878 S982Z-WNAM-IO. DESBD473 -00879 CALL 'DTSBU982' USING L982-LINK-AREA DESBD473 -00880 WNAM-REC. DESBD473 -00881 S982Z-EXIT. DESBD473 -00882 EXIT. DESBD473 -00883 DESBD473 -00884 DESBD473 -00885 S999-ABEND. DESBD473 -00886 DISPLAY '*** I/O MODULE ABENDING'. DESBD473 -00887 DESBD473 -00888 DISPLAY '*** CMND-CD = ' L983-CMND-CD. DESBD473 +00844 S983-WRITE. DESBD473 +00845 SET L983-WRITE-88 TO TRUE. DESBD473 +00846 GO TO S983-WAGE-I. DESBD473 +00847 DESBD473 +00848 S983-DELETE. DESBD473 +00849 SET L983-DELETE-88 TO TRUE. DESBD473 +00850 GO TO S983-WAGE-I. DESBD473 +00851 DESBD473 +00852 S983-CLOSE. DESBD473 +00853 SET L983-CLOSE-88 TO TRUE. DESBD473 +00854 GO TO S983-WAGE-I. DESBD473 +00855 DESBD473 +00856 S983-WAGE-I. DESBD473 +00857 CALL 'DTSBU983' USING L983-LINK-AREA DESBD473 +00858 WSKL-REC. DESBD473 +00859 S983-EXIT. DESBD473 +00860 EXIT. DESBD473 +00861 DESBD473 +00862 S982A-START-BROWSE. DESBD473 +00863 SET L982-START-BROWSE-88 TO TRUE. DESBD473 +00864 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 +00865 DESBD473 +00866 S982A-EXIT. DESBD473 +00867 EXIT. DESBD473 +00868 DESBD473 +00869 S982B-READ-NEXT. DESBD473 +00870 SET L982-READ-NEXT-88 TO TRUE. DESBD473 +00871 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 +00872 DESBD473 +00873 S982B-EXIT. DESBD473 +00874 EXIT. DESBD473 +00875 DESBD473 +00876 S982C-OPEN-READ. DESBD473 +00877 SET L982-OPEN-READ-88 TO TRUE. DESBD473 +00878 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 +00879 DESBD473 +00880 S982C-EXIT. DESBD473 +00881 EXIT. DESBD473 +00882 DESBD473 +00883 S982D-CLOSE. DESBD473 +00884 SET L982-CLOSE-88 TO TRUE. DESBD473 +00885 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD473 +00886 DESBD473 +00887 S982D-EXIT. DESBD473 +00888 EXIT. DESBD473 00889 DESBD473 -00890 DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS. DESBD473 -00891 DESBD473 -00892 DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME. DESBD473 -00893 DESBD473 -00894 DESBD473 -00895 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD473 -00896 S999-EXIT. DESBD473 -00897 EXIT. DESBD473 +00890 S982Z-WNAM-IO. DESBD473 +00891 CALL 'DTSBU982' USING L982-LINK-AREA DESBD473 +00892 WNAM-REC. DESBD473 +00893 S982Z-EXIT. DESBD473 +00894 EXIT. DESBD473 +00895 DESBD473 +00896 DESBD473 +00897 S999-ABEND. DESBD473 +00898 DISPLAY '*** I/O MODULE ABENDING'. DESBD473 +00899 DESBD473 +00900 DISPLAY '*** CMND-CD = ' L983-CMND-CD. DESBD473 +00901 DESBD473 +00902 DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS. DESBD473 +00903 DESBD473 +00904 DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME. DESBD473 +00905 DESBD473 +00906 DESBD473 +00907 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD473 +00908 S999-EXIT. DESBD473 +00909 EXIT. DESBD473 diff --git a/Batch/DOESLABL.cob b/Batch/DOESLABL.cob new file mode 100644 index 0000000..917ef78 --- /dev/null +++ b/Batch/DOESLABL.cob @@ -0,0 +1,415 @@ +00001 IDENTIFICATION DIVISION. 09/29/04 +00002 PROGRAM-ID. DOESLABL. DOESLABL +00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV004 +00004 DATE-WRITTEN. JULY 1994. DOESLABL +00005 DATE-COMPILED. DOESLABL +00006 DOESLABL +00007 ***** DOESLABL +00008 * CALLING SEQUENCE: DTSBU941 DOESLABL +00009 * UPDATE DOESILBL RECORDS DOESLABL +00010 * DOESLABL +00011 * TO PRINT THE EXTRACTED LABELS. DOESLABL +00012 * FUNCTION: LABEL PRINTING. DOESLABL +00013 * DOESLABL +00014 * DOESLABL +00015 * MODIFICATION HISTORY: DOESLABL +00016 * DOESLABL +00017 * 01-31-03 MODIFIED PROGRAM TO START PRINTING NEW USER LABELS ON DOESLABL +00018 * LEFT SIDE OF PAGE. IF RIGHT SIDE IS BLANK PRINT A END DOESLABL +00019 * LABEL MESSAGE. DOESLABL +00020 * REFERENCE: SYS MAINT PROGRAMMER: ZL1 DOESLABL +00021 * 09-29-04 MODIFIED PROGRAM TO PRINT 45 POSITION ADDRESS ON LABEL CL**4 +00022 * 40 CHARATERS PLUS 5 CONTROL DASHES. ALSO MODIFIED CL**4 +00023 * ++INCLUDE DOESLABL TO ACCOMMODATE 45 CHARACTER LABEL CL**4 +00024 * REFERENCE: L PERRY PROGRAMMER: REW CL**4 +00025 * DOESLABL +00026 * DOESLABL +00027 * DOESLABL +00028 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DOESLABL +00029 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DOESLABL +00030 * REFERENCE RFP #**** PROGRAMMER: XXX DOESLABL +00031 * DOESLABL +00032 * DOESLABL +00033 * DESCRIPTION: DOESLABL +00034 * DOESLABL +00035 * THIS MODULE GENERATES LABELS FOR VARIOUS PROCESSES DOESLABL +00036 * IN THE TAX SYSTEM. DOESLABL +00037 * DOESLABL +00038 * DOESLABL +00039 * RECORDS READ: DOESLABL +00040 * DOESLABL +00041 * NONE. DOESLABL +00042 * DOESLABL +00043 * DOESLABL +00044 * PRINTED OUTPUTS: DOESLABL +00045 * DOESLABL +00046 * 901R1 LABELS DOESLABL +00047 * DOESLABL +00048 * DOESLABL +00049 * RECORDS WRITTEN: DOESLABL +00050 * DOESLABL +00051 * NONE. DOESLABL +00052 * DOESLABL +00053 * DOESLABL +00054 * MODULES CALLED: DOESLABL +00055 * DOESLABL +00056 * DTSBU941 READ LABEL INPUT RECORDS DOESLABL +00057 * DOESLABL +00058 ***** DOESLABL +00059 EJECT DOESLABL +00060 ENVIRONMENT DIVISION. DOESLABL +00061 DOESLABL +00062 CONFIGURATION SECTION. DOESLABL +00063 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DOESLABL +00064 DOESLABL +00065 INPUT-OUTPUT SECTION. DOESLABL +00066 DOESLABL +00067 FILE-CONTROL. DOESLABL +00068 SELECT PRT-FILE1 ASSIGN TO DOESLBL1. DOESLABL +00069 DOESLABL +00070 DATA DIVISION. DOESLABL +00071 DOESLABL +00072 FILE SECTION. DOESLABL +00073 DOESLABL +00074 FD PRT-FILE1 DOESLABL +00075 RECORDING MODE IS F. DOESLABL +00076 01 LABEL-REC PIC X(100). DOESLABL +00077 DOESLABL +00078 EJECT DOESLABL +00079 WORKING-STORAGE SECTION. DOESLABL +00080 DOESLABL +00081 01 WRK-AREA. DOESLABL +00082 05 WRK-ABEND-CD PIC X(04) VALUE 'LABL'. DOESLABL +00083 05 WRK-MOD-NAME PIC X(08) VALUE 'DOESLABL'.DOESLABL +00084 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DOESLABL +00085 05 TOTAL-LABELS-PRINTED PIC 9(05) VALUE ZEROS. DOESLABL +00086 05 LABEL-INDEX PIC 9(01) VALUE ZEROS. DOESLABL +00087 05 LABEL-ROW PIC 9(02) VALUE ZEROS. DOESLABL +00088 05 SHIFT-LABEL-LEFT PIC 9(01) VALUE ZEROS. DOESLABL +00089 88 SHIFT-LABEL-LEFT-YES-88 VALUE 1. DOESLABL +00090 88 SHIFT-LABEL-LEFT-NO-88 VALUE 2. DOESLABL +00091 DOESLABL +00092 05 PRINT-ROUTE-LABEL PIC 9(01) VALUE ZEROS. DOESLABL +00093 88 PRINT-ROUTE-LABEL-YES-88 VALUE 1. DOESLABL +00094 88 PRINT-ROUTE-LABEL-NO-88 VALUE 2. DOESLABL +00095 DOESLABL +00096 05 ROUTE-CARD. DOESLABL +00097 10 ROUTE-SPACE PIC X(01) VALUE SPACES. DOESLABL +00098 10 ROUTE-INFO PIC X(39) VALUE DOESLABL +00099 '***************************************'. DOESLABL +00100 DOESLABL +00101 05 END-BLANK PIC X(39) VALUE DOESLABL +00102 '**---------- BLANK LABEL -----------**'. DOESLABL +00103 DOESLABL +00104 05 LABELS-TABLE. DOESLABL +00105 10 LABEL-ACCROSS OCCURS 2 TIMES. DOESLABL +00106 15 LABEL-DOWN OCCURS 8 TIMES. DOESLABL +00107 * 20 LABEL-DATA PIC X(40). CL**4 +00108 20 LABEL-DATA PIC X(45). CL**4 +00109 EJECT DOESLABL +00110 DOESLABL +00111 01 ROUTE-LABEL-TABLE. DOESLABL +00112 05 ROUTE-LABEL OCCURS 8 TIMES PIC X(40) VALUE SPACES. DOESLABL +00113 DOESLABL +00114 01 LABEL-PRINT-LINE. DOESLABL +00115 05 FILLER PIC X(03) VALUE SPACES. DOESLABL +00116 * 05 LABEL1-DATA PIC X(40) VALUE SPACES. CL**4 +00117 05 LABEL1-DATA PIC X(45) VALUE SPACES. CL**4 +00118 * 05 FILLER PIC X(10) VALUE SPACES. CL**4 +00119 05 FILLER PIC X(05) VALUE SPACES. CL**4 +00120 * 05 LABEL2-DATA PIC X(40) VALUE SPACES. CL**4 +00121 05 LABEL2-DATA PIC X(45) VALUE SPACES. CL**4 +00122 * 05 FILLER PIC X(05) VALUE SPACES. CL**4 +00123 DOESLABL +00124 ++INCLUDE DOESXLBL DOESLABL +00125 DOESLABL +00126 01 ILBL-REC. DOESLABL +00127 ++INCLUDE DOESILBL DOESLABL +00128 DOESLABL +00129 01 L941-LINK-AREA. DOESLABL +00130 ++INCLUDE DTSIL941 DOESLABL +00131 DOESLABL +00132 DOESLABL +00133 LINKAGE SECTION. DOESLABL +00134 DOESLABL +00135 PROCEDURE DIVISION. DOESLABL +00136 DOESLABL +00137 IF FIRST-TIME-IND = 'Y' DOESLABL +00138 PERFORM I1000-INITIATE THRU I1000-EXIT DOESLABL +00139 MOVE 'N' TO FIRST-TIME-IND. DOESLABL +00140 DOESLABL +00141 PERFORM P1000-PROCESS THRU P1000-EXIT. DOESLABL +00142 PERFORM T1000-TERMINATE THRU T1000-EXIT. DOESLABL +00143 DOESLABL +00144 GOBACK. DOESLABL +00145 EJECT DOESLABL +00146 I1000-INITIATE. DOESLABL +00147 PERFORM S941-OPEN-READ THRU S941-EXIT. DOESLABL +00148 DOESLABL +00149 IF L941-NO-REC-88 DOESLABL +00150 GO TO I1000-EXIT. DOESLABL +00151 DOESLABL +00152 OPEN OUTPUT PRT-FILE1 DOESLABL +00153 MOVE 'N' TO L941-TRACE-IND. DOESLABL +00154 MOVE WRK-MOD-NAME TO L941-MOD-NAME. DOESLABL +00155 DOESLABL +00156 WRITE LABEL-REC FROM XEROX-CNTL-LINE1 AFTER DOESLABL +00157 ADVANCING TOP-OF-PAGE. DOESLABL +00158 DOESLABL +00159 I1000-EXIT. DOESLABL +00160 EXIT. DOESLABL +00161 EJECT DOESLABL +00162 P1000-PROCESS. DOESLABL +00163 DOESLABL +00164 MOVE SPACES TO ROUTE-LABEL-TABLE. DOESLABL +00165 DOESLABL +00166 PERFORM P1100-READ-LABELS THRU P1100-EXIT DOESLABL +00167 UNTIL L941-NO-REC-88. DOESLABL +00168 DOESLABL +00169 IF LABEL-ROW = 7 DOESLABL +00170 MOVE 8 TO LABEL-ROW DOESLABL +00171 END-IF. DOESLABL +00172 DOESLABL +00173 IF LABEL-INDEX > 0 DOESLABL +00174 PERFORM P3000-PRINT-LABEL THRU P3000-EXIT DOESLABL +00175 END-IF. DOESLABL +00176 DOESLABL +00177 P1000-EXIT. DOESLABL +00178 EXIT. DOESLABL +00179 P1100-READ-LABELS. DOESLABL +00180 DOESLABL +00181 PERFORM S941-READ-NEXT THRU S941-EXIT. DOESLABL +00182 DOESLABL +00183 IF L941-NO-REC-88 DOESLABL +00184 GO TO P1100-EXIT. DOESLABL +00185 DOESLABL +00186 ADD 1 TO LABEL-INDEX. DOESLABL +00187 PERFORM P2000-SETUP-LABEL THRU P2000-EXIT. DOESLABL +00188 DOESLABL +00189 IF SHIFT-LABEL-LEFT-YES-88 OR DOESLABL +00190 PRINT-ROUTE-LABEL-YES-88 DOESLABL +00191 ADD 1 TO LABEL-INDEX DOESLABL +00192 PERFORM P2000-SETUP-LABEL THRU P2000-EXIT. DOESLABL +00193 P1100-EXIT. DOESLABL +00194 EXIT. DOESLABL +00195 P2000-SETUP-LABEL. DOESLABL +00196 DOESLABL +00197 SET SHIFT-LABEL-LEFT-NO-88 TO TRUE. DOESLABL +00198 SET PRINT-ROUTE-LABEL-NO-88 TO TRUE. DOESLABL +00199 DOESLABL +00200 MOVE ILBL-FMT-LINE(1) TO LABEL-DATA(LABEL-INDEX, 1). DOESLABL +00201 MOVE ILBL-FMT-LINE(2) TO LABEL-DATA(LABEL-INDEX, 2). DOESLABL +00202 MOVE ILBL-FMT-LINE(3) TO LABEL-DATA(LABEL-INDEX, 3). DOESLABL +00203 MOVE ILBL-FMT-LINE(4) TO LABEL-DATA(LABEL-INDEX, 4). DOESLABL +00204 MOVE ILBL-FMT-LINE(5) TO LABEL-DATA(LABEL-INDEX, 5). DOESLABL +00205 MOVE ILBL-FMT-LINE(6) TO LABEL-DATA(LABEL-INDEX, 6). DOESLABL +00206 MOVE ILBL-FMT-LINE(7) TO LABEL-DATA(LABEL-INDEX, 7). DOESLABL +00207 MOVE ILBL-FMT-LINE(8) TO LABEL-DATA(LABEL-INDEX, 8). DOESLABL +00208 DOESLABL +00209 PERFORM P2700-CHECK-ROUTE-CARD THRU P2700-EXIT DOESLABL +00210 DOESLABL +00211 IF LABEL-INDEX = 2 DOESLABL +00212 PERFORM P2500-CHECK-ROUTE-LABEL THRU P2500-EXIT DOESLABL +00213 ADD 1 TO LABEL-ROW DOESLABL +00214 PERFORM P3000-PRINT-LABEL THRU P3000-EXIT DOESLABL +00215 END-IF. DOESLABL +00216 DOESLABL +00217 P2000-EXIT. DOESLABL +00218 EXIT. DOESLABL +00219 DOESLABL +00220 P2500-CHECK-ROUTE-LABEL. DOESLABL +00221 DOESLABL +00222 IF LABEL-DATA(LABEL-INDEX, 1) = ROUTE-CARD OR DOESLABL +00223 LABEL-DATA(LABEL-INDEX, 2) = ROUTE-CARD OR DOESLABL +00224 LABEL-DATA(LABEL-INDEX, 3) = ROUTE-CARD OR DOESLABL +00225 LABEL-DATA(LABEL-INDEX, 4) = ROUTE-CARD OR DOESLABL +00226 LABEL-DATA(LABEL-INDEX, 5) = ROUTE-CARD DOESLABL +00227 SET SHIFT-LABEL-LEFT-YES-88 TO TRUE DOESLABL +00228 MOVE END-BLANK TO LABEL-DATA(LABEL-INDEX, 4) DOESLABL +00229 LABEL-DATA(LABEL-INDEX, 5) DOESLABL +00230 MOVE SPACES TO LABEL-DATA(LABEL-INDEX, 1) DOESLABL +00231 LABEL-DATA(LABEL-INDEX, 2) DOESLABL +00232 LABEL-DATA(LABEL-INDEX, 3) DOESLABL +00233 LABEL-DATA(LABEL-INDEX, 6) DOESLABL +00234 LABEL-DATA(LABEL-INDEX, 7) DOESLABL +00235 LABEL-DATA(LABEL-INDEX, 8) DOESLABL +00236 END-IF. DOESLABL +00237 DOESLABL +00238 P2500-EXIT. DOESLABL +00239 EXIT. DOESLABL +00240 DOESLABL +00241 P2700-CHECK-ROUTE-CARD. DOESLABL +00242 DOESLABL +00243 IF LABEL-DATA(LABEL-INDEX, 1) = ROUTE-CARD OR DOESLABL +00244 LABEL-DATA(LABEL-INDEX, 2) = ROUTE-CARD OR DOESLABL +00245 LABEL-DATA(LABEL-INDEX, 3) = ROUTE-CARD OR DOESLABL +00246 LABEL-DATA(LABEL-INDEX, 4) = ROUTE-CARD OR DOESLABL +00247 LABEL-DATA(LABEL-INDEX, 5) = ROUTE-CARD DOESLABL +00248 MOVE LABEL-DATA(LABEL-INDEX, 1) TO ROUTE-LABEL(1) DOESLABL +00249 MOVE LABEL-DATA(LABEL-INDEX, 2) TO ROUTE-LABEL(2) DOESLABL +00250 MOVE LABEL-DATA(LABEL-INDEX, 3) TO ROUTE-LABEL(3) DOESLABL +00251 MOVE LABEL-DATA(LABEL-INDEX, 4) TO ROUTE-LABEL(4) DOESLABL +00252 MOVE LABEL-DATA(LABEL-INDEX, 5) TO ROUTE-LABEL(5) DOESLABL +00253 MOVE LABEL-DATA(LABEL-INDEX, 6) TO ROUTE-LABEL(6) DOESLABL +00254 MOVE LABEL-DATA(LABEL-INDEX, 7) TO ROUTE-LABEL(7) DOESLABL +00255 MOVE LABEL-DATA(LABEL-INDEX, 8) TO ROUTE-LABEL(8) DOESLABL +00256 END-IF. DOESLABL +00257 DOESLABL +00258 P2700-EXIT. DOESLABL +00259 EXIT. DOESLABL +00260 P3000-PRINT-LABEL. DOESLABL +00261 DOESLABL +00262 IF LABEL-ROW > 7 DOESLABL +00263 MOVE 1 TO LABEL-ROW DOESLABL +00264 PERFORM P3500-PRINT-ROUTE-LABEL THRU P3500-EXIT DOESLABL +00265 MOVE LABEL-DATA(1, 1) TO LABEL1-DATA DOESLABL +00266 MOVE LABEL-DATA(2, 1) TO LABEL2-DATA DOESLABL +00267 IF PRINT-ROUTE-LABEL-NO-88 DOESLABL +00268 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER DOESLABL +00269 ADVANCING TOP-OF-PAGE DOESLABL +00270 ELSE DOESLABL +00271 MOVE SPACES TO LABELS-TABLE DOESLABL +00272 ADD 1 TO TOTAL-LABELS-PRINTED DOESLABL +00273 MOVE ZEROS TO LABEL-INDEX DOESLABL +00274 MOVE SPACES TO LABEL1-DATA LABEL2-DATA DOESLABL +00275 GO TO P3000-EXIT DOESLABL +00276 ELSE DOESLABL +00277 MOVE LABEL-DATA(1, 1) TO LABEL1-DATA DOESLABL +00278 MOVE LABEL-DATA(2, 1) TO LABEL2-DATA DOESLABL +00279 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00280 DOESLABL +00281 MOVE LABEL-DATA(1, 2) TO LABEL1-DATA DOESLABL +00282 MOVE LABEL-DATA(2, 2) TO LABEL2-DATA DOESLABL +00283 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00284 MOVE LABEL-DATA(1, 3) TO LABEL1-DATA DOESLABL +00285 MOVE LABEL-DATA(2, 3) TO LABEL2-DATA DOESLABL +00286 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00287 MOVE LABEL-DATA(1, 4) TO LABEL1-DATA DOESLABL +00288 MOVE LABEL-DATA(2, 4) TO LABEL2-DATA DOESLABL +00289 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00290 MOVE LABEL-DATA(1, 5) TO LABEL1-DATA DOESLABL +00291 MOVE LABEL-DATA(2, 5) TO LABEL2-DATA DOESLABL +00292 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00293 MOVE LABEL-DATA(1, 6) TO LABEL1-DATA DOESLABL +00294 MOVE LABEL-DATA(2, 6) TO LABEL2-DATA DOESLABL +00295 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00296 MOVE LABEL-DATA(1, 7) TO LABEL1-DATA DOESLABL +00297 MOVE LABEL-DATA(2, 7) TO LABEL2-DATA DOESLABL +00298 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00299 MOVE LABEL-DATA(1, 8) TO LABEL1-DATA DOESLABL +00300 MOVE LABEL-DATA(2, 8) TO LABEL2-DATA DOESLABL +00301 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00302 MOVE SPACES TO LABEL-PRINT-LINE. DOESLABL +00303 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00304 DOESLABL +00305 IF LABEL-ROW = 3 OR LABEL-ROW = 5 DOESLABL +00306 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00307 DOESLABL +00308 MOVE SPACES TO LABEL-PRINT-LINE. DOESLABL +00309 MOVE SPACES TO LABELS-TABLE. DOESLABL +00310 ADD LABEL-INDEX TO TOTAL-LABELS-PRINTED. DOESLABL +00311 MOVE ZEROS TO LABEL-INDEX. DOESLABL +00312 DOESLABL +00313 P3000-EXIT. DOESLABL +00314 EXIT. DOESLABL +00315 P3500-PRINT-ROUTE-LABEL. DOESLABL +00316 DOESLABL +00317 SET PRINT-ROUTE-LABEL-NO-88 TO TRUE. DOESLABL +00318 DOESLABL +00319 IF LABEL-DATA(1, 1) = ROUTE-CARD OR DOESLABL +00320 LABEL-DATA(1, 2) = ROUTE-CARD OR DOESLABL +00321 LABEL-DATA(1, 3) = ROUTE-CARD OR DOESLABL +00322 LABEL-DATA(1, 4) = ROUTE-CARD OR DOESLABL +00323 LABEL-DATA(1, 5) = ROUTE-CARD DOESLABL +00324 GO TO P3500-EXIT. DOESLABL +00325 DOESLABL +00326 DOESLABL +00327 IF ROUTE-LABEL(1) = SPACES AND DOESLABL +00328 ROUTE-LABEL(2) = SPACES AND DOESLABL +00329 ROUTE-LABEL(3) = SPACES AND DOESLABL +00330 ROUTE-LABEL(4) = SPACES AND DOESLABL +00331 ROUTE-LABEL(5) = SPACES DOESLABL +00332 GO TO P3500-EXIT. DOESLABL +00333 DOESLABL +00334 DISPLAY 'PRINTING ROUTE INFO ' DOESLABL +00335 SET PRINT-ROUTE-LABEL-YES-88 TO TRUE. DOESLABL +00336 DOESLABL +00337 MOVE ROUTE-LABEL(1) TO LABEL1-DATA DOESLABL +00338 MOVE LABEL-DATA(1, 1) TO LABEL2-DATA DOESLABL +00339 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER DOESLABL +00340 ADVANCING TOP-OF-PAGE. DOESLABL +00341 DOESLABL +00342 MOVE ROUTE-LABEL(2) TO LABEL1-DATA DOESLABL +00343 MOVE LABEL-DATA(1, 2) TO LABEL2-DATA DOESLABL +00344 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00345 DOESLABL +00346 MOVE ROUTE-LABEL(3) TO LABEL1-DATA DOESLABL +00347 MOVE LABEL-DATA(1, 3) TO LABEL2-DATA DOESLABL +00348 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00349 DOESLABL +00350 MOVE ROUTE-LABEL(4) TO LABEL1-DATA DOESLABL +00351 MOVE LABEL-DATA(1, 4) TO LABEL2-DATA DOESLABL +00352 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00353 DOESLABL +00354 MOVE ROUTE-LABEL(5) TO LABEL1-DATA DOESLABL +00355 MOVE LABEL-DATA(1, 5) TO LABEL2-DATA DOESLABL +00356 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00357 DOESLABL +00358 MOVE ROUTE-LABEL(6) TO LABEL1-DATA DOESLABL +00359 MOVE LABEL-DATA(1, 6) TO LABEL2-DATA DOESLABL +00360 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00361 DOESLABL +00362 MOVE ROUTE-LABEL(7) TO LABEL1-DATA DOESLABL +00363 MOVE LABEL-DATA(1, 7) TO LABEL2-DATA DOESLABL +00364 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00365 DOESLABL +00366 MOVE ROUTE-LABEL(8) TO LABEL1-DATA DOESLABL +00367 MOVE LABEL-DATA(1, 8) TO LABEL2-DATA DOESLABL +00368 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00369 DOESLABL +00370 MOVE SPACES TO LABEL-PRINT-LINE. DOESLABL +00371 WRITE LABEL-REC FROM LABEL-PRINT-LINE AFTER 1. DOESLABL +00372 DOESLABL +00373 DOESLABL +00374 P3500-EXIT. DOESLABL +00375 EXIT. DOESLABL +00376 T1000-TERMINATE. DOESLABL +00377 DOESLABL +00378 MOVE 1 TO LABEL-INDEX. DOESLABL +00379 MOVE '********************************' TO LABEL-DATA(1, 3). DOESLABL +00380 MOVE '**** TOTAL LABELS PRINTED ****' TO LABEL-DATA(1, 4). DOESLABL +00381 MOVE TOTAL-LABELS-PRINTED TO LABEL-DATA(1, 5). DOESLABL +00382 MOVE '********************************' TO LABEL-DATA(1, 6). DOESLABL +00383 PERFORM P3000-PRINT-LABEL THRU P3000-EXIT. DOESLABL +00384 DOESLABL +00385 * WRITE LABEL-REC FROM XEROX-CNTL-LINE2 AFTER 1. DOESLABL +00386 PERFORM S941-CLOSE THRU S941-EXIT. DOESLABL +00387 CLOSE PRT-FILE1. DOESLABL +00388 DOESLABL +00389 T1000-EXIT. DOESLABL +00390 EXIT. DOESLABL +00391 EJECT DOESLABL +00392 S941-OPEN-READ. DOESLABL +00393 SET L941-OPEN-READ-88 TO TRUE. DOESLABL +00394 GO TO S941-I. DOESLABL +00395 DOESLABL +00396 S941-READ-NEXT. DOESLABL +00397 SET L941-READ-NEXT-88 TO TRUE. DOESLABL +00398 GO TO S941-I. DOESLABL +00399 DOESLABL +00400 S941-CLOSE. DOESLABL +00401 SET L941-CLOSE-88 TO TRUE. DOESLABL +00402 GO TO S941-I. DOESLABL +00403 DOESLABL +00404 S941-I. DOESLABL +00405 CALL 'DOESU941' USING L941-LINK-AREA DOESLABL +00406 ILBL-REC. DOESLABL +00407 S941-EXIT. DOESLABL +00408 DOESLABL +00409 DOESLABL +00410 S999-ABEND. DOESLABL +00411 DOESLABL +00412 CALL 'DTSBU999' USING WRK-ABEND-CD. DOESLABL +00413 DOESLABL +00414 S999-EXIT. DOESLABL +00415 EXIT. DOESLABL diff --git a/Batch/DTSBD400.TXT b/Batch/DTSBD400.TXT new file mode 100644 index 0000000..80dd523 --- /dev/null +++ b/Batch/DTSBD400.TXT @@ -0,0 +1,956 @@ +00001 IDENTIFICATION DIVISION. 02/05/08 +00002 PROGRAM-ID. DTSBD400. DTSBD400 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV006 +00004 DATE-WRITTEN. DECEMBER 1991. DTSBD400 +00005 DATE-COMPILED. DTSBD400 +00006 SKIP3 DTSBD400 +00007 ***** DTSBD400 +00008 * DTSBD400 +00009 * FUNCTION: PERIODIC REPORT EXTRACT. DTSBD400 +00010 * DTSBD400 +00011 * DTSBD400 +00012 * MODIFICATION LOG: DTSBD400 +00013 * DTSBD400 +00014 * 12/31/91 INITIAL DEVELOPMENT. DTSBD400 +00015 * WORK ORDER: PROGRAMMER: TCL DTSBD400 +00016 * DTSBD400 +00017 * 10/05/1998 REVIEWED AND MODIFIED FOR DC. CL**2 +00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 +00019 * CL**2 +00020 * 05/24/1999 INITIALIZE LECM-PICKUP-DIR. CL**5 +00021 * REFERENCE: PICKUP DIR PROGRAMMER: EHH CL**5 +00022 * CL**5 +00023 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5 +00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5 +00025 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**5 +00026 * DTSBD400 +00027 * DTSBD400 +00028 * DESCRIPTION: DTSBD400 +00029 * DTSBD400 +00030 * INITIATION. DTSBD400 +00031 * DTSBD400 +00032 * PROCESS PARAMETERS INPUT VIA LINKAGE (IN PARM-AREA). DTSBD400 +00033 * DTSBD400 +00034 * DTSBD400 +00035 * READ THE PARM-FILE UNTIL PARM-EOF. ONE TO FIFTY PARM DTSBD400 +00036 * RECORD WILL BE INPUT. DTSBD400 +00037 * DTSBD400 +00038 * DISPLAY EACH PARM RECORD. DTSBD400 +00039 * DTSBD400 +00040 * EACH PARM RECORD INDICATES AN EXTRACT MODULE TO BE CALLED DTSBD400 +00041 * DURING THIS PARTICULAR RUN, AND CONTAINS ANY EXTRACT DTSBD400 +00042 * MODULE SPECIFIC PARAMETERS. DTSBD400 +00043 * DTSBD400 +00044 * TABLE PARM RECORDS 1 THRU N IN WRK-EXTRACT-AREA. DTSBD400 +00045 * DTSBD400 +00046 * THE SAME WRK-EXTRACT-ID VALUE IN MULTIPLE OCCURRENCES OF DTSBD400 +00047 * WRK-EXTRACT-AREA IS NOT ALLOWED. IF THIS CONDITION DTSBD400 +00048 * OCCURS, THEN ABEND THE MODULE. DTSBD400 +00049 * DTSBD400 +00050 * MAKE AN 'INITIALIZATION' CALL TO EACH OF THE EXTRACT DTSBD400 +00051 * MODULES TABLED IN WRK-EXTRACT-AREA. SAVE THE HIGHEST DTSBD400 +00052 * VALUE RETURNED IN LECM-OPEN-MST-IND AND SAVE THE DTSBD400 +00053 * HIGHEST VALUE RETURNED IN LECM-OPEN-REF-IND. DTSBD400 +00054 * DTSBD400 +00055 * OPEN THE MASTER FILE, ALTERNATE INDEX FILE AND DTSBD400 +00056 * REFERENCE FILE WITH THE OPEN COMMAND (READ ONLY DTSBD400 +00057 * OR UPDATE) AS INDICATED BY THE INFORMATION RETURNED DTSBD400 +00058 * BY THE "INITIALIZATION" CALLS. DTSBD400 +00059 * DTSBD400 +00060 * DTSBD400 +00061 * READ THE MHDR RECORD. DTSBD400 +00062 * DTSBD400 +00063 * IF L910-NO-REC-88 DTSBD400 +00064 * ABEND THE MODULE. DTSBD400 +00065 * DTSBD400 +00066 * INITIALIZE THE LECM FIELDS. DTSBD400 +00067 * DTSBD400 +00068 * SET LECM-PROCESS-88 TO TRUE. DTSBD400 +00069 * DTSBD400 +00070 * SET L910 TO "READ NEXT" A MPRF RECORD. DTSBD400 +00071 * DTSBD400 +00072 * MOVE +0 TO WRK-MPRF-CNT. DTSBD400 +00073 * DTSBD400 +00074 * DTSBD400 +00075 * DTSBD400 +00076 * PROCESSING. DTSBD400 +00077 * DTSBD400 +00078 * PERFORM P1000-READ-NEXT DTSBD400 +00079 * UNTIL L910-NO-REC-88. DTSBD400 +00080 * DTSBD400 +00081 * P1000-READ-NEXT. DTSBD400 +00082 * READ THE NEXT MPRF RECORD. DTSBD400 +00083 * IF L910-OK-88 DTSBD400 +00084 * ADD +1 TO WRK-MPRF-CNT DTSBD400 +00085 * PERFORM S1000-CALL-EXTRACT DTSBD400 +00086 * VARYING WRK-EXT-IDX FROM 1 BY 1 DTSBD400 +00087 * UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DTSBD400 +00088 * DTSBD400 +00089 * S1000-CALL-EXTRACT. DTSBD400 +00090 * MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX) DTSBD400 +00091 * TO LECM-EXTRACT-PARMS. DTSBD400 +00092 * DTSBD400 +00093 * CALL 'DTSBE***' USING LECM-LINK-AREA CL**2 +00094 * MPRF-REC. DTSBD400 +00095 * DTSBD400 +00096 * IF NO EXTRACT MODULE CORRESPONDING TO WRK-EXTRACT-SUB DTSBD400 +00097 * EXISTS, THEN THE STEP ABENDS (MODULE NOT FOUND). DTSBD400 +00098 * DTSBD400 +00099 * DTSBD400 +00100 * DTSBD400 +00101 * TERMINATION. DTSBD400 +00102 * DTSBD400 +00103 * SET LECM-TERMINATE-88 TO TRUE. DTSBD400 +00104 * DTSBD400 +00105 * PERFORM S1000-CALL-EXTRACT DTSBD400 +00106 * VARYING WRK-EXT-IDX FROM 1 BY 1 DTSBD400 +00107 * UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DTSBD400 +00108 * DTSBD400 +00109 * DISPLAY TERMINATION STATISTICS (VARIOUS LECM FIELDS AND DTSBD400 +00110 * WRK-MPRF-CNT. DTSBD400 +00111 * DTSBD400 +00112 * CLOSE MASTER FILE. DTSBD400 +00113 * CLOSE ALTERNATE INDEX FILE. DTSBD400 +00114 * CLOSE REFERENCE FILE. DTSBD400 +00115 * CLOSE REPORT RECORD FILE. DTSBD400 +00116 * DTSBD400 +00117 * SET RETURN-CODE TO 0. DTSBD400 +00118 * DTSBD400 +00119 ***** DTSBD400 +00120 SKIP3 DTSBD400 +00121 ENVIRONMENT DIVISION. DTSBD400 +00122 SKIP2 DTSBD400 +00123 INPUT-OUTPUT SECTION. DTSBD400 +00124 DTSBD400 +00125 FILE-CONTROL. DTSBD400 +00126 SELECT PARM-FILE ASSIGN TO SYSIN. DTSBD400 +00127 EJECT DTSBD400 +00128 DATA DIVISION. DTSBD400 +00129 SKIP3 DTSBD400 +00130 FILE SECTION. DTSBD400 +00131 SKIP2 DTSBD400 +00132 FD PARM-FILE DTSBD400 +00133 RECORDING MODE IS F DTSBD400 +00134 BLOCK CONTAINS 0 RECORDS. DTSBD400 +00135 DTSBD400 +00136 01 PARM-REC. DTSBD400 +00137 10 PREC-EXTRACT-ID PIC X(03). DTSBD400 +00138 10 FILLER PIC X(01). DTSBD400 +00139 10 PREC-EXTRACT-PARMS PIC X(68). DTSBD400 +00140 10 FILLER PIC X(08). DTSBD400 +00141 EJECT DTSBD400 +00142 WORKING-STORAGE SECTION. DTSBD400 +001425 77 PAN-VALET PICTURE X(24) VALUE '006DTSBD400 02/05/08'. DTSBD400 +00143 SKIP3 DTSBD400 +00144 01 WRK-AREA. DTSBD400 +00145 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSBD400 +00146 DTSBD400 +00147 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'. CL**2 +00148 DTSBD400 +00149 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSBD400 +00150 DTSBD400 +00151 05 WRK-UPDATED-CNT PIC S9(07) COMP-3. DTSBD400 +00152 DTSBD400 +00153 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBD400 +00154 DTSBD400 +00155 05 HOLD-EXTRACT-SUB PIC S9(04) COMP. DTSBD400 +00156 DTSBD400 +00157 05 WRK-SUB PIC S9(04) COMP. DTSBD400 +00158 DTSBD400 +00159 05 PARM-EOF-IND PIC X(01). DTSBD400 +00160 DTSBD400 +00161 05 WRK-RUN-TYPE PIC X(02). DTSBD400 +00162 DTSBD400 +00163 05 WRK-PRE-BACKUP-IND PIC X(01). DTSBD400 +00164 DTSBD400 +00165 05 WRK-ONLY-CHECK-PARM-IND PIC X(01). DTSBD400 +00166 DTSBD400 +00167 05 WRK-TRACE-IND PIC X(01). DTSBD400 +00168 DTSBD400 +00169 05 WRK-MST-OPEN-IND PIC X(01). DTSBD400 +00170 DTSBD400 +00171 05 WRK-REF-OPEN-IND PIC X(01). DTSBD400 +00172 DTSBD400 +00173 *****05 WRK-BTC-IND PIC X(01). DTSBD400 +00174 DTSBD400 +00175 05 WRK-EMP-UPDATED-IND PIC X(01). DTSBD400 +00176 88 WRK-EMP-UPDATED-NO-88 VALUE 'N'. DTSBD400 +00177 88 WRK-EMP-UPDATED-YES-88 VALUE 'Y'. DTSBD400 +00178 SKIP3 DTSBD400 +00179 05 WRK-EXTRACT-CNT PIC S9(04) COMP. DTSBD400 +00180 DTSBD400 +00181 05 WRK-EXTRACT-AREA OCCURS 50 TIMES DTSBD400 +00182 INDEXED BY WRK-EXT-IDX. DTSBD400 +00183 10 WRK-EXTRACT-ID PIC X(03). DTSBD400 +00184 10 WRK-EXTRACT-PARMS PIC X(68). DTSBD400 +00185 SKIP3 DTSBD400 +00186 05 WRK-START-ABSTIME PIC S9(15) COMP-3. DTSBD400 +00187 DTSBD400 +00188 05 WRK-STEP-DURATION-X PIC X(09). DTSBD400 +00189 05 WRK-STEP-DURATION REDEFINES WRK-STEP-DURATION-X DTSBD400 +00190 PIC ZZ,ZZ9.99. DTSBD400 +00191 SKIP3 DTSBD400 +00192 05 EXTRACT-MOD-NAME. DTSBD400 +00193 10 FILLER PIC X(05) VALUE 'DTSBE'. CL**2 +00194 10 EXTRACT-MOD-ID PIC X(03). DTSBD400 +00195 EJECT DTSBD400 +00196 01 MSG-TABLE. DTSBD400 +00197 05 MSG1-UPDATE-LOCKED-EMP. DTSBD400 +00198 10 MSG1-ID PIC X(03) VALUE '991'. DTSBD400 +00199 10 MSG1-TEXT. DTSBD400 +00200 15 FILLER PIC X(30) DTSBD400 +00201 VALUE 'DESPITE BEING LOCKED AGAINST U'. DTSBD400 +00202 15 FILLER PIC X(30) DTSBD400 +00203 VALUE 'PDATE, A PERIODIC EXTRACT PROC'. DTSBD400 +00204 15 FILLER PIC X(05) DTSBD400 +00205 VALUE 'ESS ('. DTSBD400 +00206 15 MSG1-EXTRACT-ID PIC X(03). DTSBD400 +00207 15 FILLER PIC X(31) DTSBD400 +00208 VALUE ') UPDATED THE EMPLOYERS RECORDS'. DTSBD400 +00209 EJECT DTSBD400 +00210 01 LECM-LINK-AREA. DTSBD400 +00211 ++INCLUDE DTSILECM CL**6 +00212 EJECT DTSBD400 +00213 01 L910-LINK-AREA. DTSBD400 +00214 ++INCLUDE DTSIL910 CL**2 +00215 EJECT DTSBD400 +00216 01 MSKL-REC. DTSBD400 +00217 ++INCLUDE DTSIMSKL CL**2 +00218 EJECT DTSBD400 +00219 01 MHDR-REC REDEFINES MSKL-REC. DTSBD400 +00220 ++INCLUDE DTSIMHDR CL**2 +00221 EJECT DTSBD400 +00222 01 MPRF-REC REDEFINES MSKL-REC. DTSBD400 +00223 ++INCLUDE DTSIMPRF CL**2 +00224 EJECT DTSBD400 +00225 01 L921-LINK-AREA. DTSBD400 +00226 ++INCLUDE DTSIL921 CL**2 +00227 EJECT DTSBD400 +00228 01 ISKL-REC. DTSBD400 +00229 ++INCLUDE DTSIISKL CL**2 +00230 EJECT DTSBD400 +00231 01 L927-LINK-AREA. DTSBD400 +00232 ++INCLUDE DTSIL927 CL**3 +00233 EJECT DTSBD400 +00234 01 RSKL-REC. DTSBD400 +00235 ++INCLUDE DTSIRSK1 CL**3 +00236 SKIP3 DTSBD400 +00237 01 R907-REC. DTSBD400 +00238 ++INCLUDE DTSIR907 CL**3 +00239 EJECT DTSBD400 +00240 01 L931-LINK-AREA. DTSBD400 +00241 ++INCLUDE DTSIL931 CL**3 +00242 EJECT DTSBD400 +00243 01 FSKL-REC. DTSBD400 +00244 ++INCLUDE DTSIFSKL CL**3 +00245 EJECT DTSBD400 +00246 01 L005-LINK-AREA. DTSBD400 +00247 ++INCLUDE DTSIL005 CL**3 +00248 EJECT DTSBD400 +00249 LINKAGE SECTION. DTSBD400 +00250 SKIP3 DTSBD400 +00251 01 PARM-AREA. DTSBD400 +00252 05 PARM-LENGTH PIC S9(04) COMP. DTSBD400 +00253 05 PARM-DATA. DTSBD400 +00254 10 PARM-RUN-TYPE PIC X(02). DTSBD400 +00255 10 FILLER PIC X(01). DTSBD400 +00256 10 PARM-PRE-BACKUP-IND PIC X(01). DTSBD400 +00257 10 FILLER PIC X(01). DTSBD400 +00258 10 PARM-ONLY-CHECK-PARM-IND PIC X(01). DTSBD400 +00259 10 FILLER PIC X(01). DTSBD400 +00260 10 PARM-TRACE-IND PIC X(01). DTSBD400 +00261 EJECT DTSBD400 +00262 PROCEDURE DIVISION USING PARM-AREA. DTSBD400 +00263 SKIP2 DTSBD400 +00264 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD400 +00265 DTSBD400 +00266 IF WRK-ONLY-CHECK-PARM-IND = 'Y' DTSBD400 +00267 NEXT SENTENCE DTSBD400 +00268 ELSE DTSBD400 +00269 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD400 +00270 DTSBD400 +00271 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD400 +00272 SKIP2 DTSBD400 +00273 GOBACK. DTSBD400 +00274 EJECT DTSBD400 +00275 I0000-INITIATE. DTSBD400 +00276 SKIP2 DTSBD400 +00277 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBD400 +00278 DTSBD400 +00279 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBD400 +00280 DTSBD400 +00281 PERFORM I3000-INITIALIZE-WRK THRU I3000-EXIT. DTSBD400 +00282 DTSBD400 +00283 PERFORM I4000-INITIAL-CALLS THRU I4000-EXIT. DTSBD400 +00284 DTSBD400 +00285 IF WRK-ONLY-CHECK-PARM-IND = 'Y' DTSBD400 +00286 NEXT SENTENCE DTSBD400 +00287 ELSE DTSBD400 +00288 PERFORM I5000-OPEN-FILES-2 THRU I5000-EXIT. DTSBD400 +00289 DTSBD400 +00290 PERFORM I6000-RERUN-INSTRUCTIONS THRU I6000-EXIT. DTSBD400 +00291 SKIP2 DTSBD400 +00292 I0000-EXIT. DTSBD400 +00293 EXIT. DTSBD400 +00294 EJECT DTSBD400 +00295 I1000-PROCESS-PARMS. DTSBD400 +00296 DISPLAY ' '. DTSBD400 +00297 CL**3 +00298 DISPLAY '*** DTSBD400 PARAMETERS'. CL**2 +00299 DTSBD400 +00300 CL**3 +00301 IF PARM-LENGTH = +8 DTSBD400 +00302 NEXT SENTENCE DTSBD400 +00303 ELSE DTSBD400 +00304 DISPLAY 'PARM LENGTH NOT EQUAL TO EIGHT' DTSBD400 +00305 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00306 DTSBD400 +00307 CL**3 +00308 IF PARM-PRE-BACKUP-IND = SPACES DTSBD400 +00309 MOVE 'N' TO WRK-PRE-BACKUP-IND DTSBD400 +00310 ELSE DTSBD400 +00311 IF PARM-PRE-BACKUP-IND = 'Y' OR 'N' DTSBD400 +00312 MOVE PARM-PRE-BACKUP-IND DTSBD400 +00313 TO WRK-PRE-BACKUP-IND DTSBD400 +00314 ELSE DTSBD400 +00315 DISPLAY 'PARM PRE BACKUP IND = ' DTSBD400 +00316 PARM-PRE-BACKUP-IND DTSBD400 +00317 ' IS NOT A VALID VALUE' DTSBD400 +00318 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00319 DTSBD400 +00320 CL**3 +00321 IF PARM-RUN-TYPE = SPACES DTSBD400 +00322 MOVE 'OR' TO WRK-RUN-TYPE DTSBD400 +00323 ELSE DTSBD400 +00324 IF PARM-RUN-TYPE = 'WE' OR 'MC' OR 'ME' OR 'QR' OR 'QP' CL**3 +00325 OR 'QD' CL**3 +00326 OR 'QE' OR 'QF' OR 'YE' OR 'OR' DTSBD400 +00327 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DTSBD400 +00328 ELSE DTSBD400 +00329 DISPLAY 'PARM RUN TYPE = ' DTSBD400 +00330 PARM-RUN-TYPE DTSBD400 +00331 ' IS NOT A VALID RUN TYPE' DTSBD400 +00332 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00333 DTSBD400 +00334 CL**3 +00335 IF PARM-ONLY-CHECK-PARM-IND = SPACES DTSBD400 +00336 MOVE 'N' TO WRK-ONLY-CHECK-PARM-IND DTSBD400 +00337 ELSE DTSBD400 +00338 IF PARM-ONLY-CHECK-PARM-IND = 'Y' OR 'N' DTSBD400 +00339 MOVE PARM-ONLY-CHECK-PARM-IND DTSBD400 +00340 TO WRK-ONLY-CHECK-PARM-IND DTSBD400 +00341 ELSE DTSBD400 +00342 DISPLAY 'PARM ONLY CHECK PARM IND = ' DTSBD400 +00343 PARM-ONLY-CHECK-PARM-IND DTSBD400 +00344 ' IS NOT A VALID VALUE' DTSBD400 +00345 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00346 DTSBD400 +00347 CL**3 +00348 IF PARM-TRACE-IND = SPACES DTSBD400 +00349 MOVE 'N' TO WRK-TRACE-IND DTSBD400 +00350 ELSE DTSBD400 +00351 MOVE PARM-TRACE-IND TO WRK-TRACE-IND. DTSBD400 +00352 DTSBD400 +00353 CL**3 +00354 DISPLAY ' '. DTSBD400 +00355 CL**3 +00356 DISPLAY ' RUN TYPE: ' DTSBD400 +00357 WRK-RUN-TYPE. DTSBD400 +00358 CL**3 +00359 DISPLAY ' PRE-BACKUP IND: ' DTSBD400 +00360 WRK-PRE-BACKUP-IND. DTSBD400 +00361 CL**3 +00362 DISPLAY 'ONLY CHECK PARM: ' DTSBD400 +00363 WRK-ONLY-CHECK-PARM-IND. DTSBD400 +00364 CL**3 +00365 DISPLAY 'TRACE INDICATOR: ' DTSBD400 +00366 WRK-TRACE-IND. DTSBD400 +00367 CL**3 +00368 DISPLAY ' '. DTSBD400 +00369 DTSBD400 +00370 CL**3 +00371 OPEN INPUT PARM-FILE. DTSBD400 +00372 DTSBD400 +00373 MOVE 'N' TO PARM-EOF-IND. DTSBD400 +00374 DTSBD400 +00375 MOVE +0 TO PARM-REC-CNT. DTSBD400 +00376 DTSBD400 +00377 MOVE +0 TO WRK-EXTRACT-CNT. DTSBD400 +00378 DTSBD400 +00379 PERFORM I1100-READ-PARM THRU I1100-EXIT DTSBD400 +00380 UNTIL PARM-EOF-IND = 'Y'. DTSBD400 +00381 DTSBD400 +00382 IF PARM-REC-CNT < 1 OR > 50 DTSBD400 +00383 DISPLAY 'MORE THAN 50 PARAMETER RECORDS IS NOT VALID' DTSBD400 +00384 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00385 DTSBD400 +00386 CLOSE PARM-FILE. DTSBD400 +00387 I1000-EXIT. DTSBD400 +00388 EXIT. DTSBD400 +00389 EJECT DTSBD400 +00390 I1100-READ-PARM. DTSBD400 +00391 READ PARM-FILE DTSBD400 +00392 AT END DTSBD400 +00393 MOVE 'Y' TO PARM-EOF-IND DTSBD400 +00394 GO TO I1100-EXIT. DTSBD400 +00395 DTSBD400 +00396 CL**3 +00397 DISPLAY '*** ' DTSBD400 +00398 PARM-REC. DTSBD400 +00399 DTSBD400 +00400 CL**3 +00401 IF PREC-EXTRACT-ID = '***' DTSBD400 +00402 GO TO I1100-EXIT. DTSBD400 +00403 DTSBD400 +00404 CL**3 +00405 ADD +1 TO PARM-REC-CNT. DTSBD400 +00406 DTSBD400 +00407 PERFORM I1200-LOAD-PARM-TABLE THRU I1200-EXIT. DTSBD400 +00408 I1100-EXIT. DTSBD400 +00409 EXIT. DTSBD400 +00410 EJECT DTSBD400 +00411 I1200-LOAD-PARM-TABLE. DTSBD400 +00412 IF WRK-EXTRACT-CNT > 0 DTSBD400 +00413 PERFORM I1250-DUP-EXTRACT-ID-CHECK THRU I1250-EXIT DTSBD400 +00414 VARYING WRK-SUB FROM 1 BY 1 DTSBD400 +00415 UNTIL WRK-SUB > WRK-EXTRACT-CNT. DTSBD400 +00416 DTSBD400 +00417 ADD +1 TO WRK-EXTRACT-CNT. DTSBD400 +00418 DTSBD400 +00419 IF WRK-EXTRACT-CNT > 50 DTSBD400 +00420 DISPLAY 'MORE THAN 50 EXTRACT ID CODES INVALID' DTSBD400 +00421 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00422 DTSBD400 +00423 MOVE PREC-EXTRACT-ID DTSBD400 +00424 TO WRK-EXTRACT-ID (WRK-EXTRACT-CNT). DTSBD400 +00425 CL**3 +00426 MOVE PREC-EXTRACT-PARMS DTSBD400 +00427 TO WRK-EXTRACT-PARMS (WRK-EXTRACT-CNT). DTSBD400 +00428 I1200-EXIT. DTSBD400 +00429 EXIT. DTSBD400 +00430 EJECT DTSBD400 +00431 I1250-DUP-EXTRACT-ID-CHECK. DTSBD400 +00432 IF PREC-EXTRACT-ID = WRK-EXTRACT-ID (WRK-SUB) DTSBD400 +00433 DISPLAY 'DUPLICATE EXTRACT ID CODES INVALID ' DTSBD400 +00434 WRK-EXTRACT-ID (WRK-SUB) DTSBD400 +00435 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00436 I1250-EXIT. DTSBD400 +00437 EXIT. DTSBD400 +00438 EJECT DTSBD400 +00439 I2000-OPEN-FILES-1. DTSBD400 +00440 MOVE WRK-TRACE-IND TO L910-TRACE-IND DTSBD400 +00441 L921-TRACE-IND DTSBD400 +00442 L927-TRACE-IND DTSBD400 +00443 L931-TRACE-IND. DTSBD400 +00444 CL**3 +00445 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD400 +00446 L921-MOD-NAME DTSBD400 +00447 L927-MOD-NAME DTSBD400 +00448 L931-MOD-NAME. DTSBD400 +00449 DTSBD400 +00450 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**3 +00451 DTSBD400 +00452 PERFORM S921-OPEN-READ THRU S921-EXIT. CL**3 +00453 DTSBD400 +00454 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. CL**3 +00455 DTSBD400 +00456 PERFORM S931-OPEN-READ THRU S931-EXIT. CL**3 +00457 CL**3 +00458 MOVE LENGTH OF R907-REC TO R907-LENGTH. CL**3 +00459 I2000-EXIT. DTSBD400 +00460 EXIT. DTSBD400 +00461 EJECT DTSBD400 +00462 I3000-INITIALIZE-WRK. DTSBD400 +00463 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD400 +00464 CL**3 +00465 MOVE +0 TO MHDR-EMP-NO. CL**3 +00466 CL**3 +00467 SET MHDR-HDR-88 TO TRUE. CL**3 +00468 CL**3 +00469 PERFORM S910-READ THRU S910-EXIT. DTSBD400 +00470 DTSBD400 +00471 IF L910-NO-REC-88 DTSBD400 +00472 PERFORM S999-ABEND THRU S999-EXIT. CL**3 +00473 DTSBD400 +00474 PERFORM S005-FROM-SYS THRU S005-EXIT. CL**3 +00475 DTSBD400 +00476 MOVE L005-ABSTIME TO WRK-START-ABSTIME. DTSBD400 +00477 DTSBD400 +00478 PERFORM I3100-INIT-LECM-PARMS THRU I3100-EXIT. CL**3 +00479 DTSBD400 +00480 MOVE +0 TO WRK-MPRF-CNT CL**3 +00481 WRK-UPDATED-CNT. CL**3 +00482 I3000-EXIT. DTSBD400 +00483 EXIT. DTSBD400 +00484 EJECT DTSBD400 +00485 I3100-INIT-LECM-PARMS. DTSBD400 +00486 MOVE WRK-RUN-TYPE TO LECM-RUN-TYPE. CL**3 +00487 DTSBD400 +00488 IF WRK-RUN-TYPE = 'WE' DTSBD400 +00489 MOVE MHDR-CMPL-WEEK-BEGIN-DATE TO LECM-PERIOD-START-DATE CL**3 +00490 MOVE MHDR-CMPL-WEEK-END-DATE TO LECM-PERIOD-END-DATE CL**3 +00491 ELSE DTSBD400 +00492 IF WRK-RUN-TYPE = 'MC' OR 'ME' DTSBD400 +00493 MOVE MHDR-CMPL-MONTH-BEGIN-DATE TO LECM-PERIOD-START-DATE DTSBD400 +00494 MOVE MHDR-CMPL-MONTH-END-DATE TO LECM-PERIOD-END-DATE CL**3 +00495 ELSE DTSBD400 +00496 IF WRK-RUN-TYPE = 'QR' OR 'QD' OR 'QE' OR 'QF' OR 'QP' CL**3 +00497 MOVE MHDR-CMPL-QTR-BEGIN-DATE TO LECM-PERIOD-START-DATE CL**3 +00498 MOVE MHDR-CMPL-QTR-END-DATE TO LECM-PERIOD-END-DATE CL**3 +00499 ELSE DTSBD400 +00500 IF WRK-RUN-TYPE = 'YE' DTSBD400 +00501 MOVE MHDR-CMPL-YEAR-BEGIN-DATE TO LECM-PERIOD-START-DATE CL**3 +00502 MOVE MHDR-CMPL-YEAR-END-DATE TO LECM-PERIOD-END-DATE CL**3 +00503 ELSE DTSBD400 +00504 MOVE +0 TO LECM-PERIOD-START-DATE CL**3 +00505 MOVE +0 TO LECM-PERIOD-END-DATE. CL**3 +00506 DTSBD400 +00507 MOVE L005-ABSTIME TO LECM-RUN-ABSTIME. CL**3 +00508 DTSBD400 +00509 MOVE L005-DATE TO LECM-SYS-DATE. CL**3 +00510 CL**3 +00511 MOVE L005-TIME TO LECM-SYS-TIME. CL**3 +00512 DTSBD400 +00513 MOVE MHDR-CURR-RUN-DATE TO LECM-CURR-RUN-DATE. CL**3 +00514 CL**3 +00515 MOVE MHDR-CURR-MAIL-DATE TO LECM-CURR-MAIL-DATE. CL**3 +00516 DTSBD400 +00517 MOVE MHDR-PRIOR-RUN-DATE TO LECM-PRIOR-RUN-DATE. CL**3 +00518 CL**3 +00519 MOVE MHDR-PRIOR-MAIL-DATE TO LECM-PRIOR-MAIL-DATE. CL**3 +00520 DTSBD400 +00521 MOVE MHDR-LAST-UC30-MASS-MAIL-YRQ CL**3 +00522 TO LECM-LAST-UC30-MASS-MAIL-YRQ. CL**3 +00523 CL**3 +00524 MOVE MHDR-LAST-PEN-ASSESSED-YRQ CL**3 +00525 TO LECM-LAST-PEN-ASSESSED-YRQ. CL**3 +00526 CL**3 +00527 MOVE MHDR-LAST-UC30-DEL-MAIL-YRQ CL**3 +00528 TO LECM-LAST-UC30-DEL-MAIL-YRQ. CL**3 +00529 DTSBD400 +00530 MOVE MHDR-FIRST-PURSUED-RPT-YRQ DTSBD400 +00531 TO LECM-FIRST-PURSUED-RPT-YRQ. DTSBD400 +00532 DTSBD400 +00533 MOVE MHDR-LAST-RATE-END-YRQ CL**3 +00534 TO LECM-LAST-RATE-END-YRQ. CL**3 +00535 DTSBD400 +00536 MOVE MHDR-LAST-MJRN-PURGE-DATE DTSBD400 +00537 TO LECM-LAST-MJRN-PURGE-DATE. DTSBD400 +00538 DTSBD400 +00539 MOVE +19924 TO LECM-PICKUP-YRQ. CL**5 +00540 CL**5 +00541 MOVE WRK-TRACE-IND TO LECM-TRACE-IND. CL**3 +00542 I3100-EXIT. DTSBD400 +00543 EXIT. DTSBD400 +00544 EJECT DTSBD400 +00545 I4000-INITIAL-CALLS. DTSBD400 +00546 SET LECM-INITIALIZE-88 TO TRUE. DTSBD400 +00547 CL**3 +00548 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBD400 +00549 CL**3 +00550 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBD400 +00551 CL**3 +00552 MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND. DTSBD400 +00553 CL**3 +00554 MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND. DTSBD400 +00555 DTSBD400 +00556 PERFORM I4100-EXTRACT-LOOP THRU I4100-EXIT DTSBD400 +00557 VARYING WRK-EXT-IDX FROM 1 BY 1 DTSBD400 +00558 UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DTSBD400 +00559 I4000-EXIT. DTSBD400 +00560 EXIT. DTSBD400 +00561 SKIP3 DTSBD400 +00562 I4100-EXTRACT-LOOP. DTSBD400 +00563 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBD400 +00564 CL**3 +00565 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBD400 +00566 DTSBD400 +00567 PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT. DTSBD400 +00568 DTSBD400 +00569 IF LECM-MST-OPEN-IND > WRK-MST-OPEN-IND DTSBD400 +00570 MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND. DTSBD400 +00571 CL**3 +00572 IF LECM-REF-OPEN-IND > WRK-REF-OPEN-IND DTSBD400 +00573 MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND. DTSBD400 +00574 I4100-EXIT. DTSBD400 +00575 EXIT. DTSBD400 +00576 EJECT DTSBD400 +00577 I5000-OPEN-FILES-2. DTSBD400 +00578 MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND. DTSBD400 +00579 CL**3 +00580 MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND. DTSBD400 +00581 DTSBD400 +00582 IF (LECM-MST-OPEN-UPDATE-HDR-88) DTSBD400 +00583 OR DTSBD400 +00584 (LECM-MST-OPEN-UPDATE-88) DTSBD400 +00585 IF WRK-PRE-BACKUP-IND = 'Y' DTSBD400 +00586 NEXT SENTENCE DTSBD400 +00587 ELSE DTSBD400 +00588 DISPLAY 'MASTER FILE UPDATING POSSIBLE ' DTSBD400 +00589 'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"' DTSBD400 +00590 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00591 DTSBD400 +00592 IF LECM-MST-OPEN-READ-88 DTSBD400 +00593 NEXT SENTENCE DTSBD400 +00594 ELSE DTSBD400 +00595 PERFORM S910-CLOSE THRU S910-EXIT DTSBD400 +00596 IF LECM-MST-OPEN-UPDATE-HDR-88 DTSBD400 +00597 PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT DTSBD400 +00598 ELSE DTSBD400 +00599 IF LECM-MST-OPEN-UPDATE-88 DTSBD400 +00600 PERFORM S921-CLOSE THRU S921-EXIT DTSBD400 +00601 PERFORM S910-OPEN-UPDATE THRU S910-EXIT DTSBD400 +00602 PERFORM S921-OPEN-UPDATE THRU S921-EXIT DTSBD400 +00603 ELSE DTSBD400 +00604 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00605 DTSBD400 +00606 IF LECM-REF-OPEN-UPDATE-88 DTSBD400 +00607 IF WRK-PRE-BACKUP-IND = 'Y' DTSBD400 +00608 NEXT SENTENCE DTSBD400 +00609 ELSE DTSBD400 +00610 DISPLAY 'REFERENCE FILE UPDATING POSSIBLE ' DTSBD400 +00611 'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"' DTSBD400 +00612 PERFORM S999-ABEND THRU S999-EXIT. DTSBD400 +00613 DTSBD400 +00614 IF LECM-REF-OPEN-UPDATE-88 DTSBD400 +00615 PERFORM S931-CLOSE THRU S931-EXIT DTSBD400 +00616 PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DTSBD400 +00617 I5000-EXIT. DTSBD400 +00618 EXIT. DTSBD400 +00619 EJECT DTSBD400 +00620 I6000-RERUN-INSTRUCTIONS. DTSBD400 +00621 DISPLAY ' '. DTSBD400 +00622 CL**3 +00623 DISPLAY ' '. DTSBD400 +00624 CL**3 +00625 DISPLAY '****************************************' DTSBD400 +00626 '****************************************'. DTSBD400 +00627 CL**3 +00628 DISPLAY '** ' DTSBD400 +00629 ' **'. DTSBD400 +00630 CL**3 +00631 DISPLAY '** DTSBD400 RERUN' CL**2 +00632 ' INSTRUCTIONS **'. DTSBD400 +00633 CL**3 +00634 DISPLAY '** ' DTSBD400 +00635 ' **'. DTSBD400 +00636 CL**3 +00637 DISPLAY '** IF DTSBD400 ABENDS THEN: ' CL**2 +00638 ' **'. DTSBD400 +00639 DTSBD400 +00640 IF LECM-MST-OPEN-UPDATE-HDR-88 DTSBD400 +00641 DISPLAY '** ' DTSBD400 +00642 ' **' DTSBD400 +00643 DISPLAY '** RESTORE MASTER FILE HEADER R' DTSBD400 +00644 'ECORD PRIOR TO ATTEMPTING RERUN. **'. DTSBD400 +00645 DTSBD400 +00646 IF LECM-MST-OPEN-UPDATE-88 DTSBD400 +00647 DISPLAY '** ' DTSBD400 +00648 ' **' DTSBD400 +00649 DISPLAY '** RESTORE MASTER FILE PRIOR TO' DTSBD400 +00650 ' ATTEMPTING RERUN. **'. DTSBD400 +00651 DTSBD400 +00652 IF LECM-REF-OPEN-UPDATE-88 DTSBD400 +00653 DISPLAY '** ' DTSBD400 +00654 ' **' DTSBD400 +00655 DISPLAY '** RESTORE REFERENCE FILE PRIOR' DTSBD400 +00656 ' TO ATTEMPTING RERUN. **'. DTSBD400 +00657 DTSBD400 +00658 IF (LECM-MST-OPEN-UPDATE-HDR-88) DTSBD400 +00659 OR DTSBD400 +00660 (LECM-MST-OPEN-UPDATE-88) DTSBD400 +00661 OR DTSBD400 +00662 (LECM-REF-OPEN-UPDATE-88) DTSBD400 +00663 NEXT SENTENCE DTSBD400 +00664 ELSE DTSBD400 +00665 DISPLAY '** ' DTSBD400 +00666 ' **' DTSBD400 +00667 DISPLAY '** NO SPECIAL ACTIONS NEEDED. ' DTSBD400 +00668 ' **'. DTSBD400 +00669 CL**3 +00670 DISPLAY '** ' DTSBD400 +00671 ' **'. DTSBD400 +00672 CL**3 +00673 DISPLAY '****************************************' DTSBD400 +00674 '****************************************'. DTSBD400 +00675 CL**3 +00676 DISPLAY ' '. DTSBD400 +00677 CL**3 +00678 DISPLAY ' '. DTSBD400 +00679 I6000-EXIT. DTSBD400 +00680 EXIT. DTSBD400 +00681 EJECT DTSBD400 +00682 P0000-PROCESS. DTSBD400 +00683 SET LECM-PROCESS-88 TO TRUE. DTSBD400 +00684 DTSBD400 +00685 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD400 +00686 CL**3 +00687 MOVE +0 TO MPRF-EMP-NO. DTSBD400 +00688 CL**3 +00689 SET MPRF-PRF-88 TO TRUE. DTSBD400 +00690 DTSBD400 +00691 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD400 +00692 DTSBD400 +00693 PERFORM P1000-READ-NEXT THRU P1000-EXIT DTSBD400 +00694 UNTIL L910-NO-REC-88. DTSBD400 +00695 P0000-EXIT. DTSBD400 +00696 EXIT. DTSBD400 +00697 EJECT DTSBD400 +00698 P1000-READ-NEXT. DTSBD400 +00699 ADD +1 TO WRK-MPRF-CNT. DTSBD400 +00700 DTSBD400 +00701 SET WRK-EMP-UPDATED-NO-88 TO TRUE. DTSBD400 +00702 DTSBD400 +00703 MOVE LECM-RUN-ABSTIME TO LECM-EMP-ABSTIME. DTSBD400 +00704 DTSBD400 +00705 PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT DTSBD400 +00706 VARYING WRK-EXT-IDX FROM 1 BY 1 DTSBD400 +00707 UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DTSBD400 +00708 DTSBD400 +00709 IF WRK-EMP-UPDATED-YES-88 DTSBD400 +00710 PERFORM P1100-EMPLOYER-UPDATED THRU P1100-EXIT. DTSBD400 +00711 DTSBD400 +00712 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD400 +00713 P1000-EXIT. DTSBD400 +00714 EXIT. DTSBD400 +00715 SKIP3 DTSBD400 +00716 P1100-EMPLOYER-UPDATED. DTSBD400 +00717 IF MPRF-UPDATE-ACTIVE-88 DTSBD400 +00718 NEXT SENTENCE DTSBD400 +00719 ELSE DTSBD400 +00720 MOVE LECM-RUN-ABSTIME TO MPRF-UPDATE-END-ABSTIME DTSBD400 +00721 MOVE +0 TO MPRF-UPDATE-TASK-ID DTSBD400 +00722 MOVE 'BATCH' TO MPRF-UPDATE-OP-ID DTSBD400 +00723 MOVE SPACES TO MPRF-UPDATE-TERMID DTSBD400 +00724 MOVE SPACES TO MPRF-UPDATE-NETNAME CL**4 +00725 MOVE LECM-SYS-DATE TO MPRF-UPDATE-START-DATE DTSBD400 +00726 MOVE LECM-SYS-TIME TO MPRF-UPDATE-START-TIME DTSBD400 +00727 MOVE SPACES TO MPRF-UPDATE-SCR-ID DTSBD400 +00728 MPRF-UPDATE-FUNCTION DTSBD400 +00729 MOVE LECM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSBD400 +00730 DTSBD400 +00731 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD400 +00732 DTSBD400 +00733 ADD +1 TO WRK-UPDATED-CNT. DTSBD400 +00734 P1100-EXIT. DTSBD400 +00735 EXIT. DTSBD400 +00736 EJECT DTSBD400 +00737 T0000-TERMINATE. DTSBD400 +00738 IF WRK-ONLY-CHECK-PARM-IND = 'Y' DTSBD400 +00739 NEXT SENTENCE DTSBD400 +00740 ELSE DTSBD400 +00741 SET LECM-TERMINATE-88 TO TRUE DTSBD400 +00742 PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT DTSBD400 +00743 VARYING WRK-EXT-IDX FROM 1 BY 1 DTSBD400 +00744 UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT. DTSBD400 +00745 DTSBD400 +00746 CL**4 +00747 DISPLAY ' '. DTSBD400 +00748 CL**4 +00749 DISPLAY '*** DTSBD400 TERMINATION STATISTICS ***'. CL**2 +00750 CL**4 +00751 DISPLAY ' '. DTSBD400 +00752 CL**4 +00753 DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DTSBD400 +00754 WRK-MPRF-CNT. DTSBD400 +00755 CL**4 +00756 DISPLAY ' '. DTSBD400 +00757 CL**4 +00758 DISPLAY 'NUMBER OF MASTER FILE EMPLOYERS UPDATED : 'DTSBD400 +00759 WRK-UPDATED-CNT. DTSBD400 +00760 CL**4 +00761 DISPLAY ' '. DTSBD400 +00762 CL**4 +00763 DISPLAY 'MODULE LINKAGE - RUN TYPE : ' DTSBD400 +00764 LECM-RUN-TYPE. DTSBD400 +00765 CL**4 +00766 DISPLAY ' '. DTSBD400 +00767 CL**4 +00768 DISPLAY 'MODULE LINKAGE - PERIOD START DATE : ' DTSBD400 +00769 LECM-PERIOD-START-DATE. DTSBD400 +00770 CL**4 +00771 DISPLAY ' '. DTSBD400 +00772 CL**4 +00773 DISPLAY 'MODULE LINKAGE - PERIOD END DATE : ' DTSBD400 +00774 LECM-PERIOD-END-DATE. DTSBD400 +00775 CL**4 +00776 DISPLAY ' '. DTSBD400 +00777 DTSBD400 +00778 CL**4 +00779 PERFORM S910-CLOSE THRU S910-EXIT. CL**4 +00780 DTSBD400 +00781 PERFORM S921-CLOSE THRU S921-EXIT. CL**4 +00782 DTSBD400 +00783 PERFORM S927-CLOSE THRU S927-EXIT. CL**4 +00784 DTSBD400 +00785 PERFORM S931-CLOSE THRU S931-EXIT. CL**4 +00786 DTSBD400 +00787 MOVE -1 TO RSK1-LENGTH. CL**4 +00788 CL**4 +00789 PERFORM S946-RPT-O THRU S946-EXIT. CL**4 +00790 DTSBD400 +00791 CL**4 +00792 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD400 +00793 CL**4 +00794 COMPUTE WRK-STEP-DURATION ROUNDED DTSBD400 +00795 = (L005-ABSTIME - WRK-START-ABSTIME ) / 1000. DTSBD400 +00796 CL**4 +00797 DISPLAY '*** ' DTSBD400 +00798 WRK-STEP-DURATION-X DTSBD400 +00799 ' STEP DURATION (SECONDS)'. DTSBD400 +00800 DTSBD400 +00801 *****MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND. CL**4 +00802 CL**4 +00803 *****MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND. CL**4 +00804 DTSBD400 +00805 *****IF LECM-MST-OPEN-READ-88 DTSBD400 +00806 ***** MOVE +0 TO RETURN-CODE DTSBD400 +00807 *****ELSE DTSBD400 +00808 *****IF LECM-MST-OPEN-UPDATE-HDR-88 DTSBD400 +00809 ***** MOVE +1 TO RETURN-CODE DTSBD400 +00810 *****ELSE DTSBD400 +00811 ***** MOVE +2 TO RETURN-CODE. DTSBD400 +00812 T0000-EXIT. DTSBD400 +00813 EXIT. DTSBD400 +00814 EJECT DTSBD400 +00815 S1000-CALL-EXTRACT. DTSBD400 +00816 SET LECM-EMP-UPDATED-NO-88 TO TRUE. DTSBD400 +00817 DTSBD400 +00818 MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX) DTSBD400 +00819 TO LECM-EXTRACT-PARMS. DTSBD400 +00820 DTSBD400 +00821 MOVE WRK-EXTRACT-ID (WRK-EXT-IDX) TO EXTRACT-MOD-ID. DTSBD400 +00822 DTSBD400 +00823 CALL EXTRACT-MOD-NAME USING LECM-LINK-AREA DTSBD400 +00824 MPRF-REC. DTSBD400 +00825 DTSBD400 +00826 IF LECM-EMP-UPDATED-YES-88 DTSBD400 +00827 PERFORM S1100-EMPLOYER-UPDATED THRU S1100-EXIT. DTSBD400 +00828 S1000-EXIT. DTSBD400 +00829 EXIT. DTSBD400 +00830 SKIP3 DTSBD400 +00831 S1100-EMPLOYER-UPDATED. DTSBD400 +00832 IF LECM-PROCESS-88 DTSBD400 +00833 NEXT SENTENCE DTSBD400 +00834 ELSE DTSBD400 +00835 GO TO S1100-EXIT. DTSBD400 +00836 DTSBD400 +00837 SET WRK-EMP-UPDATED-YES-88 TO TRUE. DTSBD400 +00838 DTSBD400 +00839 IF MPRF-UPDATE-ACTIVE-88 DTSBD400 +00840 MOVE MSG1-ID TO R907-MSG-ID DTSBD400 +00841 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD400 +00842 MOVE EXTRACT-MOD-ID TO MSG1-EXTRACT-ID DTSBD400 +00843 MOVE MSG1-TEXT TO R907-MSG-TEXT DTSBD400 +00844 MOVE WRK-MOD-NAME TO R907-MODULE-NAME DTSBD400 +00845 MOVE R907-REC TO RSKL-REC DTSBD400 +00846 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD400 +00847 S1100-EXIT. DTSBD400 +00848 EXIT. DTSBD400 +00849 EJECT DTSBD400 +00850 S005-FROM-SYS. DTSBD400 +00851 SET L005-FROM-SYS TO TRUE. DTSBD400 +00852 GO TO S005-ABSTIME. DTSBD400 +00853 DTSBD400 +00854 S005-ABSTIME. DTSBD400 +00855 CALL 'DTSBU005' USING L005-LINK-AREA. CL**2 +00856 S005-EXIT. DTSBD400 +00857 EXIT. DTSBD400 +00858 SKIP3 DTSBD400 +00859 S910-OPEN-READ. DTSBD400 +00860 SET L910-OPEN-READ-88 TO TRUE. DTSBD400 +00861 GO TO S910-MSTR-IO. DTSBD400 +00862 DTSBD400 +00863 S910-OPEN-UPDATE-HDR. DTSBD400 +00864 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DTSBD400 +00865 GO TO S910-MSTR-IO. DTSBD400 +00866 DTSBD400 +00867 S910-OPEN-UPDATE. DTSBD400 +00868 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD400 +00869 GO TO S910-MSTR-IO. DTSBD400 +00870 DTSBD400 +00871 S910-READ. DTSBD400 +00872 SET L910-READ-88 TO TRUE. DTSBD400 +00873 GO TO S910-MSTR-IO. DTSBD400 +00874 DTSBD400 +00875 S910-START-BROWSE. DTSBD400 +00876 SET L910-START-BROWSE-88 TO TRUE. DTSBD400 +00877 GO TO S910-MSTR-IO. DTSBD400 +00878 DTSBD400 +00879 S910-READ-NEXT. DTSBD400 +00880 SET L910-READ-NEXT-88 TO TRUE. DTSBD400 +00881 GO TO S910-MSTR-IO. DTSBD400 +00882 DTSBD400 +00883 S910-REWRITE. DTSBD400 +00884 SET L910-REWRITE-88 TO TRUE. DTSBD400 +00885 GO TO S910-MSTR-IO. DTSBD400 +00886 DTSBD400 +00887 S910-CLOSE. DTSBD400 +00888 SET L910-CLOSE-88 TO TRUE. DTSBD400 +00889 GO TO S910-MSTR-IO. DTSBD400 +00890 DTSBD400 +00891 S910-MSTR-IO. DTSBD400 +00892 CALL 'DTSBU910' USING L910-LINK-AREA CL**2 +00893 MSKL-REC. DTSBD400 +00894 S910-EXIT. DTSBD400 +00895 EXIT. DTSBD400 +00896 SKIP3 DTSBD400 +00897 S921-OPEN-READ. DTSBD400 +00898 SET L921-OPEN-READ-88 TO TRUE. DTSBD400 +00899 GO TO S921-AIX-IO. DTSBD400 +00900 DTSBD400 +00901 S921-OPEN-UPDATE. DTSBD400 +00902 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD400 +00903 GO TO S921-AIX-IO. DTSBD400 +00904 DTSBD400 +00905 S921-CLOSE. DTSBD400 +00906 SET L921-CLOSE-88 TO TRUE. DTSBD400 +00907 GO TO S921-AIX-IO. DTSBD400 +00908 DTSBD400 +00909 S921-AIX-IO. DTSBD400 +00910 CALL 'DTSBU921' USING L921-LINK-AREA CL**2 +00911 ISKL-REC. DTSBD400 +00912 S921-EXIT. DTSBD400 +00913 EXIT. DTSBD400 +00914 SKIP3 DTSBD400 +00915 S927-OPEN-UPDATE. DTSBD400 +00916 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBD400 +00917 GO TO S927-BTC-O. DTSBD400 +00918 DTSBD400 +00919 S927-CLOSE. DTSBD400 +00920 SET L927-CLOSE-88 TO TRUE. DTSBD400 +00921 GO TO S927-BTC-O. DTSBD400 +00922 DTSBD400 +00923 S927-BTC-O. DTSBD400 +00924 CALL 'DTSBU927' USING L927-LINK-AREA CL**2 +00925 RSKL-REC. DTSBD400 +00926 S927-EXIT. DTSBD400 +00927 EXIT. DTSBD400 +00928 SKIP3 DTSBD400 +00929 S931-OPEN-READ. DTSBD400 +00930 SET L931-OPEN-READ-88 TO TRUE. DTSBD400 +00931 GO TO S931-REF-IO. DTSBD400 +00932 DTSBD400 +00933 S931-OPEN-UPDATE. DTSBD400 +00934 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBD400 +00935 GO TO S931-REF-IO. DTSBD400 +00936 DTSBD400 +00937 S931-CLOSE. DTSBD400 +00938 SET L931-CLOSE-88 TO TRUE. DTSBD400 +00939 GO TO S931-REF-IO. DTSBD400 +00940 DTSBD400 +00941 S931-REF-IO. DTSBD400 +00942 CALL 'DTSBU931' USING L931-LINK-AREA CL**2 +00943 FSKL-REC. DTSBD400 +00944 S931-EXIT. DTSBD400 +00945 EXIT. DTSBD400 +00946 SKIP3 DTSBD400 +00947 S946-RPT-O. DTSBD400 +00948 CALL 'DTSBU946' USING RSKL-REC. CL**2 +00949 S946-EXIT. DTSBD400 +00950 EXIT. DTSBD400 +00951 SKIP3 DTSBD400 +00952 S999-ABEND. DTSBD400 +00953 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 +00954 S999-EXIT. DTSBD400 +00955 EXIT. DTSBD400 diff --git a/Batch/DTSBD520.cob b/Batch/DTSBD520.cob new file mode 100644 index 0000000..3e9a349 --- /dev/null +++ b/Batch/DTSBD520.cob @@ -0,0 +1,858 @@ +00001 IDENTIFICATION DIVISION. 05/10/04 +00002 PROGRAM-ID. DTSBD520. DTSBD520 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV014 +00004 DATE-WRITTEN. APRIL 1995. DTSBD520 +00005 DATE-COMPILED. DTSBD520 +00006 SKIP2 DTSBD520 +00007 ***** DTSBD520 +00008 * DTSBD520 +00009 * FUNCTION: DTSBD520 +00010 * DTSBD520 +00011 * WAGE FILE EXTRACT STEP OF THE WAGE FILE / TAX FILE DTSBD520 +00012 * COMPARISON PROCESS. DTSBD520 +00013 * DTSBD520 +00014 * DTSBD520 +00015 * MODIFICATION HISTORY: DTSBD520 +00016 * DTSBD520 +00017 * 04/10/95 MODULE WRITTEN. DTSBD520 +00018 * RFP: CR048 PROGRAMMER: EHH DTSBD520 +00019 * DTSBD520 +00020 * 02/13/1999 REVIEWED AND MODIFIED FOR DC. DTSBD520 +00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD520 +00022 * DTSBD520 +00023 * 05/20/1999 PICKUP MODIFICATIONS. LIMIT PARAMETER INPUT DTSBD520 +00024 * YRQ TO GREATER THAN 19924. DTSBD520 +00025 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBD520 +00026 * DTSBD520 +00027 * 12/14/1999 ADDED CALL TO WAGE I-O MODULE TO OPEN FOR INPUT DTSBD520 +00028 * ONLY IN I0000-INITIATE. DTSBD520 +00029 * REFERENCE: PROGRAMMER: GD DTSBD520 +00030 * DTSBD520 +00031 * 04/26/2004 CHANGE WGP-SEGMENT TO WGP-SEGMENT-ONE AND DTSBD520 +00032 * WGD-SEGEMENT TO WGD-SEGEMENT-TWO : ZL1 DTSBD520 +00033 * DTSBD520 +00034 * DTSBD520 +00035 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD520 +00036 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD520 +00037 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD520 +00038 * DTSBD520 +00039 * DTSBD520 +00040 * DESCRIPTION: DTSBD520 +00041 * DTSBD520 +00042 * DTSBD520 +00043 * DTSBD520 +00044 * DTSBD520 +00045 * DTSBD520 +00046 * DTSBD520 +00047 * DTSBD520 +00048 * RECORDS READ: DTSBD520 +00049 * DTSBD520 +00050 * MPRF DTSBD520 +00051 * MREL DTSBD520 +00052 * DTSBD520 +00053 * WAGE DTSBD520 +00054 * DTSBD520 +00055 * DTSBD520 +00056 * PRINTED OUTPUTS: DTSBD520 +00057 * DTSBD520 +00058 * NONE DTSBD520 +00059 * DTSBD520 +00060 * DTSBD520 +00061 * RECORDS WRITTEN: DTSBD520 +00062 * DTSBD520 +00063 * DTSIX737 WAGE FILE / TAX FILE COMPARISON EXTRACT DTSBD520 +00064 * RECORD. DTSBD520 +00065 * DTSBD520 +00066 * DTSBD520 +00067 * MODULES CALLED: DTSBD520 +00068 * DTSBD520 +00069 * EWG961D WAGE FILE ACCESS MODULE DTSBD520 +00070 * DTSBU001 DATE CONVERSION MODULE DTSBD520 +00071 * DTSBU004 YEAR/QUARTER CONVERSION MODULE DTSBD520 +00072 * DTSBU910 TAX FILE ACCESS MODULE DTSBD520 +00073 * DTSBD520 +00074 ***** DTSBD520 +00075 SKIP3 DTSBD520 +00076 ENVIRONMENT DIVISION. DTSBD520 +00077 SKIP3 DTSBD520 +00078 INPUT-OUTPUT SECTION. DTSBD520 +00079 SKIP2 DTSBD520 +00080 FILE-CONTROL. DTSBD520 +00081 SELECT EXTRACT-FILE ASSIGN TO EXTFILE DTSBD520 +00082 FILE STATUS IS EXT-FILE-STATUS. DTSBD520 +00083 SKIP2 DTSBD520 +00084 DATA DIVISION. DTSBD520 +00085 SKIP3 DTSBD520 +00086 FILE SECTION. DTSBD520 +00087 EJECT DTSBD520 +00088 FD EXTRACT-FILE DTSBD520 +00089 LABEL RECORDS ARE STANDARD DTSBD520 +00090 RECORDING MODE IS F DTSBD520 +00091 BLOCK CONTAINS 0 RECORDS. DTSBD520 +00092 DTSBD520 +00093 01 EXTRACT-REC. DTSBD520 +00094 ++INCLUDE DTSIX737 DTSBD520 +00095 EJECT DTSBD520 +00096 WORKING-STORAGE SECTION. DTSBD520 +000965 77 PAN-VALET PICTURE X(24) VALUE '014DTSBD520 05/10/04'. DTSBD520 +00097 SKIP3 DTSBD520 +00098 01 WRK-AREA. DTSBD520 +00099 05 ABEND-CODE PIC S9(04) COMP VALUE +520. DTSBD520 +00100 DTSBD520 +00101 05 MOD-NAME PIC X(08) VALUE 'DTSBD520'.DTSBD520 +00102 DTSBD520 +00103 05 MIN-EMP-NO PIC S9(07) COMP-3 DTSBD520 +00104 VALUE +1. DTSBD520 +00105 DTSBD520 +00106 05 MAX-EMP-NO PIC S9(07) COMP-3 DTSBD520 +00107 VALUE +999999. DTSBD520 +00108 DTSBD520 +00109 05 WRK-PICKUP-YRQ PIC S9(05) COMP-3 DTSBD520 +00110 VALUE +19924. DTSBD520 +00111 DTSBD520 +00112 DTSBD520 +00113 05 ABEND-MSG PIC X(60). DTSBD520 +00114 DTSBD520 +00115 DTSBD520 +00116 05 EXT-FILE-STATUS PIC X(02). DTSBD520 +00117 88 EXT-FILE-OK-88 VALUE '00'. DTSBD520 +00118 DTSBD520 +00119 05 FILE-COMMAND PIC X(10). DTSBD520 +00120 DTSBD520 +00121 DTSBD520 +00122 05 OUT-EXT-CNT PIC S9(09) COMP-3. DTSBD520 +00123 DTSBD520 +00124 05 DISPLAY-REC-CNT-X PIC X(11). DTSBD520 +00125 05 DISPLAY-REC-CNT REDEFINES DISPLAY-REC-CNT-X DTSBD520 +00126 PIC ZZZ,ZZZ,ZZ9. DTSBD520 +00127 DTSBD520 +00128 DTSBD520 +00129 05 WRK-YEAR-START-DATE PIC S9(09) COMP-3. DTSBD520 +00130 DTSBD520 +00131 05 WRK-YEAR-END-DATE PIC S9(09) COMP-3. DTSBD520 +00132 DTSBD520 +00133 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSBD520 +00134 DTSBD520 +00135 05 WRK-END-YRQ PIC S9(05) COMP-3. DTSBD520 +00136 DTSBD520 +00137 05 WRK-YRQ-CNT PIC S9(04) COMP. DTSBD520 +00138 DTSBD520 +00139 05 WRK-YRQ OCCURS 4 TIMES DTSBD520 +00140 INDEXED BY WRK-YRQ-IDX PIC S9(05) COMP-3. DTSBD520 +00141 DTSBD520 +00142 DTSBD520 +00143 05 MAX-WAGES-EMP-CNT PIC S9(04) COMP. DTSBD520 +00144 DTSBD520 +00145 05 MAX-PRED-EMP-CNT PIC S9(04) COMP. DTSBD520 +00146 DTSBD520 +00147 DTSBD520 +00148 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD520 +00149 EJECT DTSBD520 +00150 01 WAGES-TABLE. DTSBD520 +00151 05 WAGES-EMP-MAX PIC S9(04) COMP VALUE +1000.DTSBD520 +00152 DTSBD520 +00153 05 WAGES-EMP-SUB PIC S9(04) COMP. DTSBD520 +00154 DTSBD520 +00155 05 WAGES-EMP-CNT PIC S9(04) COMP. DTSBD520 +00156 DTSBD520 +00157 05 WAGES-EMP-AREA OCCURS 1000 TIMES DTSBD520 +00158 INDEXED BY WAGES-EMP-IDX1 DTSBD520 +00159 WAGES-EMP-IDX2. DTSBD520 +00160 10 WAGES-EMP-NO PIC S9(07) COMP-3. DTSBD520 +00161 10 WAGES-YRQ-AMT OCCURS 4 TIMES DTSBD520 +00162 INDEXED BY WAGES-YRQ-IDX DTSBD520 +00163 PIC S9(09)V9(02) COMP-3. DTSBD520 +00164 DTSBD520 +00165 DTSBD520 +00166 DTSBD520 +00167 01 PRED-AREA. DTSBD520 +00168 05 PRED-EMP-MAX PIC S9(04) COMP VALUE +100.DTSBD520 +00169 DTSBD520 +00170 05 SUCC-EMP-NO PIC S9(07) COMP-3. DTSBD520 +00171 DTSBD520 +00172 05 PRED-EMP-SUB PIC S9(04) COMP. DTSBD520 +00173 DTSBD520 +00174 05 PRED-EMP-CNT PIC S9(04) COMP. DTSBD520 +00175 DTSBD520 +00176 05 PRED-EMP-AREA OCCURS 100 TIMES DTSBD520 +00177 INDEXED BY PRED-EMP-IDX1 DTSBD520 +00178 PRED-EMP-IDX2. DTSBD520 +00179 10 PRED-EMP-NO PIC S9(07) COMP-3. DTSBD520 +00180 EJECT DTSBD520 +00181 01 L001-LINK-AREA. DTSBD520 +00182 ++INCLUDE DTSIL001 DTSBD520 +00183 SKIP3 DTSBD520 +00184 01 L004-LINK-AREA. DTSBD520 +00185 ++INCLUDE DTSIL004 DTSBD520 +00186 EJECT DTSBD520 +00187 01 L910-LINK-AREA. DTSBD520 +00188 ++INCLUDE DTSIL910 DTSBD520 +00189 EJECT DTSBD520 +00190 01 MSKL-REC. DTSBD520 +00191 ++INCLUDE DTSIMSKL DTSBD520 +00192 EJECT DTSBD520 +00193 01 MPRF-REC. DTSBD520 +00194 ++INCLUDE DTSIMPRF DTSBD520 +00195 SKIP3 DTSBD520 +00196 01 MREL-REC. DTSBD520 +00197 ++INCLUDE DTSIMREL DTSBD520 +00198 EJECT DTSBD520 +00199 ++INCLUDE EWGLINKB DTSBD520 +00200 EJECT DTSBD520 +00201 01 EMPLOYER-INDS. DTSBD520 +00202 05 EMPLOYER-IND OCCURS 999999 TIMES DTSBD520 +00203 PIC X(01). DTSBD520 +00204 88 EMP-PRED-EXISTS-NO-88 VALUE '0'. DTSBD520 +00205 88 EMP-PRED-EXISTS-YES-88 VALUE '1'. DTSBD520 +00206 88 EMP-NOT-RATED-88 VALUE '2'. DTSBD520 +00207 EJECT DTSBD520 +00208 LINKAGE SECTION. DTSBD520 +00209 DTSBD520 +00210 01 PARM-AREA. DTSBD520 +00211 05 PARM-LENGTH PIC S9(04) COMP. DTSBD520 +00212 DTSBD520 +00213 05 PARM-DATA. DTSBD520 +00214 10 PARM-YRQ-X PIC X(03). DTSBD520 +00215 EJECT DTSBD520 +00216 PROCEDURE DIVISION USING PARM-AREA. DTSBD520 +00217 DTSBD520 +00218 DTSBD520 +00219 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD520 +00220 DTSBD520 +00221 DTSBD520 +00222 MOVE LOW-VALUES TO VSAM-WAGEDATA-CONTROL-BLOCK. DTSBD520 +00223 DTSBD520 +00224 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DTSBD520 +00225 DTSBD520 +00226 SET DBW-READ-SEGMENT TO TRUE. DTSBD520 +00227 DTSBD520 +00228 SET DBW-PROFILE-SEGMENT TO TRUE. DTSBD520 +00229 DTSBD520 +00230 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 +00231 DTSBD520 +00232 DTSBD520 +00233 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD520 +00234 UNTIL DBW-END-OF-FILE. DTSBD520 +00235 DTSBD520 +00236 DTSBD520 +00237 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD520 +00238 DTSBD520 +00239 DTSBD520 +00240 MOVE +0 TO RETURN-CODE. DTSBD520 +00241 DTSBD520 +00242 DTSBD520 +00243 GOBACK. DTSBD520 +00244 EJECT DTSBD520 +00245 I0000-INITIATE. DTSBD520 +00246 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD520 +00247 DTSBD520 +00248 PERFORM SEXT-OPEN-OUTPUT THRU SEXT-EXIT. DTSBD520 +00249 DTSBD520 +00250 SET DBW-OPEN-INPUT TO TRUE. DTSBD520 +00251 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 +00252 DTSBD520 +00253 MOVE +0 TO OUT-EXT-CNT. DTSBD520 +00254 DTSBD520 +00255 MOVE +0 TO MAX-WAGES-EMP-CNT DTSBD520 +00256 MAX-PRED-EMP-CNT. DTSBD520 +00257 DTSBD520 +00258 PERFORM I1000-PARMS THRU I1000-EXIT. DTSBD520 +00259 DTSBD520 +00260 PERFORM I2000-PRED-EXISTS-INDS THRU I2000-EXIT. DTSBD520 +00261 I0000-EXIT. DTSBD520 +00262 EXIT. DTSBD520 +00263 SKIP3 DTSBD520 +00264 I1000-PARMS. DTSBD520 +00265 IF PARM-LENGTH = +3 DTSBD520 +00266 NEXT SENTENCE DTSBD520 +00267 ELSE DTSBD520 +00268 MOVE 'PARM-LENGTH NOT EQUAL TO 3' DTSBD520 +00269 TO ABEND-MSG DTSBD520 +00270 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 +00271 DTSBD520 +00272 DTSBD520 +00273 DISPLAY '***'. DTSBD520 +00274 DTSBD520 +00275 DISPLAY '*** ' DTSBD520 +00276 MOD-NAME DTSBD520 +00277 ' PARAMETERS: ' DTSBD520 +00278 PARM-DATA. DTSBD520 +00279 DTSBD520 +00280 DISPLAY '***'. DTSBD520 +00281 DTSBD520 +00282 DTSBD520 +00283 MOVE PARM-YRQ-X TO L004-QTR-3. DTSBD520 +00284 DTSBD520 +00285 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD520 +00286 DTSBD520 +00287 IF (L004-INVALID-QTR) DTSBD520 +00288 OR DTSBD520 +00289 (L004-QTR-5-9 <= WRK-PICKUP-YRQ) DTSBD520 +00290 MOVE 'PARM-YRQ-X NOT VALID' DTSBD520 +00291 TO ABEND-MSG DTSBD520 +00292 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 +00293 DTSBD520 +00294 MOVE L004-QTR-5-Q TO WRK-YRQ-CNT. DTSBD520 +00295 DTSBD520 +00296 MOVE L004-QTR-5-9 TO WRK-END-YRQ. DTSBD520 +00297 DTSBD520 +00298 MOVE 1 TO L004-QTR-5-Q. DTSBD520 +00299 DTSBD520 +00300 MOVE L004-QTR-5-9 TO WRK-START-YRQ. DTSBD520 +00301 DTSBD520 +00302 PERFORM DTSBD520 +00303 VARYING L004-QTR-5-Q FROM 1 BY 1 DTSBD520 +00304 UNTIL L004-QTR-5-Q > WRK-YRQ-CNT DTSBD520 +00305 MOVE L004-QTR-5-9 TO WRK-YRQ (L004-QTR-5-Q) DTSBD520 +00306 END-PERFORM. DTSBD520 +00307 DTSBD520 +00308 DTSBD520 +00309 MOVE 1 TO L004-QTR-5-Q. DTSBD520 +00310 DTSBD520 +00311 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 +00312 DTSBD520 +00313 MOVE L004-QTR-START-DATE TO WRK-YEAR-START-DATE. DTSBD520 +00314 DTSBD520 +00315 DTSBD520 +00316 MOVE 4 TO L004-QTR-5-Q. DTSBD520 +00317 DTSBD520 +00318 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 +00319 DTSBD520 +00320 MOVE L004-QTR-END-DATE TO WRK-YEAR-END-DATE. DTSBD520 +00321 I1000-EXIT. DTSBD520 +00322 EXIT. DTSBD520 +00323 SKIP3 DTSBD520 +00324 I2000-PRED-EXISTS-INDS. DTSBD520 +00325 MOVE ALL '0' TO EMPLOYER-INDS. DTSBD520 +00326 DTSBD520 +00327 DTSBD520 +00328 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD520 +00329 DTSBD520 +00330 MOVE +0 TO MSKL-EMP-NO. DTSBD520 +00331 DTSBD520 +00332 SET MSKL-PRF-88 TO TRUE. DTSBD520 +00333 DTSBD520 +00334 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD520 +00335 DTSBD520 +00336 PERFORM I2100-MPRF-SCAN THRU I2100-EXIT DTSBD520 +00337 UNTIL L910-NO-REC-88. DTSBD520 +00338 I2000-EXIT. DTSBD520 +00339 EXIT. DTSBD520 +00340 SKIP3 DTSBD520 +00341 I2100-MPRF-SCAN. DTSBD520 +00342 MOVE MSKL-REC TO MPRF-REC. DTSBD520 +00343 DTSBD520 +00344 DTSBD520 +00345 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD520 +00346 DTSBD520 +00347 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD520 +00348 DTSBD520 +00349 SET MSKL-REL-88 TO TRUE. DTSBD520 +00350 DTSBD520 +00351 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD520 +00352 DTSBD520 +00353 PERFORM I2110-MREL-SCAN THRU I2110-EXIT DTSBD520 +00354 UNTIL L910-NO-REC-88. DTSBD520 +00355 DTSBD520 +00356 DTSBD520 +00357 IF (MPRF-EMP-NO < MIN-EMP-NO) DTSBD520 +00358 OR DTSBD520 +00359 (MPRF-EMP-NO > MAX-EMP-NO) DTSBD520 +00360 NEXT SENTENCE DTSBD520 +00361 ELSE DTSBD520 +00362 IF NOT MPRF-CLASS-RATED-88 DTSBD520 +00363 SET EMP-NOT-RATED-88 (MPRF-EMP-NO) TO TRUE. DTSBD520 +00364 DTSBD520 +00365 DTSBD520 +00366 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD520 +00367 DTSBD520 +00368 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD520 +00369 I2100-EXIT. DTSBD520 +00370 EXIT. DTSBD520 +00371 SKIP3 DTSBD520 +00372 I2110-MREL-SCAN. DTSBD520 +00373 MOVE MSKL-REC TO MREL-REC. DTSBD520 +00374 DTSBD520 +00375 PERFORM I2111-EVALUATE-MREL THRU I2111-EXIT. DTSBD520 +00376 DTSBD520 +00377 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD520 +00378 I2110-EXIT. DTSBD520 +00379 EXIT. DTSBD520 +00380 SKIP3 DTSBD520 +00381 I2111-EVALUATE-MREL. DTSBD520 +00382 IF (MREL-EFF-DATE < WRK-YEAR-START-DATE) DTSBD520 +00383 OR DTSBD520 +00384 (MREL-EFF-DATE > WRK-YEAR-END-DATE) DTSBD520 +00385 GO TO I2111-EXIT. DTSBD520 +00386 DTSBD520 +00387 IF MREL-EXP-TRNSF-NO-88 DTSBD520 +00388 GO TO I2111-EXIT. DTSBD520 +00389 DTSBD520 +00390 IF (MREL-EMP-NO < MIN-EMP-NO) DTSBD520 +00391 OR DTSBD520 +00392 (MREL-EMP-NO > MAX-EMP-NO) DTSBD520 +00393 GO TO I2111-EXIT. DTSBD520 +00394 DTSBD520 +00395 SET EMP-PRED-EXISTS-YES-88 (MREL-EMP-NO) TO TRUE. DTSBD520 +00396 I2111-EXIT. DTSBD520 +00397 EXIT. DTSBD520 +00398 EJECT DTSBD520 +00399 P0000-PROCESS. DTSBD520 +00400 MOVE +0 TO WAGES-EMP-CNT. DTSBD520 +00401 DTSBD520 +00402 DTSBD520 +00403 SET DBW-RANDOM-PROCESSING TO TRUE. DTSBD520 +00404 DTSBD520 +00405 SET DBW-WAGE-SEGMENT TO TRUE. DTSBD520 +00406 DTSBD520 +00407 PERFORM P1000-WGD-LOOP THRU P1000-EXIT DTSBD520 +00408 UNTIL DBW-NO-RECORD-FOUND. DTSBD520 +00409 DTSBD520 +00410 DTSBD520 +00411 IF WAGES-EMP-CNT > MAX-WAGES-EMP-CNT DTSBD520 +00412 MOVE WAGES-EMP-CNT TO MAX-WAGES-EMP-CNT. DTSBD520 +00413 DTSBD520 +00414 DTSBD520 +00415 PERFORM P2000-EXTRACT-LOOP THRU P2000-EXIT DTSBD520 +00416 VARYING WAGES-EMP-IDX1 FROM 1 BY 1 DTSBD520 +00417 UNTIL WAGES-EMP-IDX1 > WAGES-EMP-CNT. DTSBD520 +00418 DTSBD520 +00419 DTSBD520 +00420 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DTSBD520 +00421 DTSBD520 +00422 SET DBW-READ-SEGMENT TO TRUE. DTSBD520 +00423 DTSBD520 +00424 SET DBW-PROFILE-SEGMENT TO TRUE. DTSBD520 +00425 DTSBD520 +00426 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 +00427 P0000-EXIT. DTSBD520 +00428 EXIT. DTSBD520 +00429 SKIP3 DTSBD520 +00430 P1000-WGD-LOOP. DTSBD520 +00431 SET DBW-READ-SEGMENT TO TRUE. DTSBD520 +00432 DTSBD520 +00433 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 +00434 DTSBD520 +00435 IF DBW-NO-RECORD-FOUND DTSBD520 +00436 GO TO P1000-EXIT. DTSBD520 +00437 DTSBD520 +00438 DTSBD520 +00439 IF WGD-ACCOUNT-NUMBER NOT NUMERIC DTSBD520 +00440 GO TO P1000-EXIT. DTSBD520 +00441 DTSBD520 +00442 IF (WGD-ACCOUNT-NUMBER < MIN-EMP-NO) DTSBD520 +00443 OR DTSBD520 +00444 (WGD-ACCOUNT-NUMBER > MAX-EMP-NO) DTSBD520 +00445 GO TO P1000-EXIT. DTSBD520 +00446 DTSBD520 +00447 DTSBD520 +00448 IF EMP-NOT-RATED-88 (WGD-ACCOUNT-NUMBER) DTSBD520 +00449 GO TO P1000-EXIT. DTSBD520 +00450 DTSBD520 +00451 DTSBD520 +00452 MOVE WGD-YR TO L004-QTR-3-YR. DTSBD520 +00453 DTSBD520 +00454 MOVE WGD-QTR TO L004-QTR-3-Q. DTSBD520 +00455 DTSBD520 +00456 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD520 +00457 DTSBD520 +00458 IF L004-INVALID-QTR DTSBD520 +00459 GO TO P1000-EXIT. DTSBD520 +00460 DTSBD520 +00461 IF (L004-QTR-5-9 < WRK-START-YRQ) DTSBD520 +00462 OR DTSBD520 +00463 (L004-QTR-5-9 > WRK-END-YRQ) DTSBD520 +00464 GO TO P1000-EXIT. DTSBD520 +00465 DTSBD520 +00466 DTSBD520 +00467 IF WGD-QUARTER-EARNINGS NOT NUMERIC DTSBD520 +00468 GO TO P1000-EXIT. DTSBD520 +00469 DTSBD520 +00470 DTSBD520 +00471 MOVE +0 TO WAGES-EMP-SUB. DTSBD520 +00472 DTSBD520 +00473 PERFORM DTSBD520 +00474 VARYING WAGES-EMP-IDX1 FROM 1 BY 1 DTSBD520 +00475 UNTIL (WAGES-EMP-IDX1 > WAGES-EMP-CNT) DTSBD520 +00476 OR DTSBD520 +00477 (WAGES-EMP-SUB NOT = +0) DTSBD520 +00478 IF WAGES-EMP-NO (WAGES-EMP-IDX1) = WGD-ACCOUNT-NUMBER DTSBD520 +00479 SET WAGES-EMP-SUB TO WAGES-EMP-IDX1 DTSBD520 +00480 END-IF DTSBD520 +00481 END-PERFORM. DTSBD520 +00482 DTSBD520 +00483 DTSBD520 +00484 IF WAGES-EMP-SUB = +0 DTSBD520 +00485 IF WAGES-EMP-CNT < WAGES-EMP-MAX DTSBD520 +00486 ADD +1 TO WAGES-EMP-CNT DTSBD520 +00487 MOVE WAGES-EMP-CNT TO WAGES-EMP-SUB DTSBD520 +00488 MOVE WGD-ACCOUNT-NUMBER DTSBD520 +00489 TO WAGES-EMP-NO (WAGES-EMP-SUB) DTSBD520 +00490 MOVE +0 TO WAGES-YRQ-AMT (WAGES-EMP-SUB 1) DTSBD520 +00491 WAGES-YRQ-AMT (WAGES-EMP-SUB 2) DTSBD520 +00492 WAGES-YRQ-AMT (WAGES-EMP-SUB 3) DTSBD520 +00493 WAGES-YRQ-AMT (WAGES-EMP-SUB 4) DTSBD520 +00494 ELSE DTSBD520 +00495 MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG DTSBD520 +00496 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 +00497 DTSBD520 +00498 ***** DTSBD520 +00499 * DTSBD520 +00500 * PER A 02/15/1999 EMAIL FROM GIL DIMATTIA, IGNORE DTSBD520 +00501 * WGP-WHOLE-DOLLARS AND ALWAYS USE WGD-QUARTER-EARNINGS. DTSBD520 +00502 * DTSBD520 +00503 ***** DTSBD520 +00504 DTSBD520 +00505 *****IF WGP-WHOLE-DOLLARS DTSBD520 +00506 *********ADD WGD-QTR-EARN-WHOLE-DOLLAR DTSBD520 +00507 **********TO WAGES-YRQ-AMT (WAGES-EMP-SUB L004-QTR-5-Q) DTSBD520 +00508 *****ELSE DTSBD520 +00509 DTSBD520 +00510 ADD WGD-QUARTER-EARNINGS DTSBD520 +00511 TO WAGES-YRQ-AMT (WAGES-EMP-SUB L004-QTR-5-Q). DTSBD520 +00512 P1000-EXIT. DTSBD520 +00513 EXIT. DTSBD520 +00514 EJECT DTSBD520 +00515 P2000-EXTRACT-LOOP. DTSBD520 +00516 MOVE LOW-VALUES TO EXTRACT-REC. DTSBD520 +00517 DTSBD520 +00518 DTSBD520 +00519 MOVE WAGES-EMP-NO (WAGES-EMP-IDX1) TO X737-EMP-NO. DTSBD520 +00520 DTSBD520 +00521 MOVE WGP-SSN TO X737-SSN. DTSBD520 +00522 DTSBD520 +00523 MOVE WRK-YRQ-CNT TO X737-YRQ-CNT. DTSBD520 +00524 DTSBD520 +00525 PERFORM P2100-WAGES-TO-X737 THRU P2100-EXIT DTSBD520 +00526 VARYING WAGES-YRQ-IDX FROM 1 BY 1 DTSBD520 +00527 UNTIL WAGES-YRQ-IDX > X737-YRQ-CNT. DTSBD520 +00528 DTSBD520 +00529 IF (WAGES-EMP-CNT > +1) DTSBD520 +00530 AND DTSBD520 +00531 (EMP-PRED-EXISTS-YES-88 (X737-EMP-NO)) DTSBD520 +00532 DTSBD520 +00533 MOVE +0 TO PRED-EMP-CNT DTSBD520 +00534 DTSBD520 +00535 PERFORM P3000-TABLE-PREDECESSORS THRU P3000-EXIT DTSBD520 +00536 DTSBD520 +00537 IF PRED-EMP-CNT > MAX-PRED-EMP-CNT DTSBD520 +00538 MOVE PRED-EMP-CNT TO MAX-PRED-EMP-CNT DTSBD520 +00539 END-IF DTSBD520 +00540 DTSBD520 +00541 PERFORM P2200-PRED-WAGES THRU P2200-EXIT DTSBD520 +00542 VARYING WAGES-EMP-IDX2 FROM 1 BY 1 DTSBD520 +00543 UNTIL WAGES-EMP-IDX2 > WAGES-EMP-CNT. DTSBD520 +00544 DTSBD520 +00545 DTSBD520 +00546 PERFORM SEXT-WRITE THRU SEXT-EXIT. DTSBD520 +00547 P2000-EXIT. DTSBD520 +00548 EXIT. DTSBD520 +00549 SKIP3 DTSBD520 +00550 P2100-WAGES-TO-X737. DTSBD520 +00551 SET WRK-YRQ-IDX TO WAGES-YRQ-IDX. DTSBD520 +00552 DTSBD520 +00553 SET X737-YRQ-IDX TO WAGES-YRQ-IDX. DTSBD520 +00554 DTSBD520 +00555 MOVE WRK-YRQ (WRK-YRQ-IDX) DTSBD520 +00556 TO X737-YRQ (X737-YRQ-IDX). DTSBD520 +00557 DTSBD520 +00558 MOVE WAGES-YRQ-AMT (WAGES-EMP-IDX1 WAGES-YRQ-IDX) DTSBD520 +00559 TO X737-EMP-WAGES (X737-YRQ-IDX). DTSBD520 +00560 DTSBD520 +00561 MOVE +0 TO X737-PRED-WAGES (X737-YRQ-IDX). DTSBD520 +00562 P2100-EXIT. DTSBD520 +00563 EXIT. DTSBD520 +00564 SKIP3 DTSBD520 +00565 P2200-PRED-WAGES. DTSBD520 +00566 MOVE WAGES-EMP-NO (WAGES-EMP-IDX2) TO WRK-EMP-NO. DTSBD520 +00567 DTSBD520 +00568 IF WRK-EMP-NO = X737-EMP-NO DTSBD520 +00569 GO TO P2200-EXIT. DTSBD520 +00570 DTSBD520 +00571 MOVE +0 TO PRED-EMP-SUB. DTSBD520 +00572 DTSBD520 +00573 PERFORM DTSBD520 +00574 VARYING PRED-EMP-IDX1 FROM 1 BY 1 DTSBD520 +00575 UNTIL (PRED-EMP-SUB NOT = +0) DTSBD520 +00576 OR DTSBD520 +00577 (PRED-EMP-IDX1 > PRED-EMP-CNT) DTSBD520 +00578 IF WRK-EMP-NO = PRED-EMP-NO (PRED-EMP-IDX1) DTSBD520 +00579 SET PRED-EMP-SUB TO PRED-EMP-IDX1 DTSBD520 +00580 END-IF DTSBD520 +00581 END-PERFORM. DTSBD520 +00582 DTSBD520 +00583 IF PRED-EMP-SUB = +0 DTSBD520 +00584 GO TO P2200-EXIT. DTSBD520 +00585 DTSBD520 +00586 PERFORM P2210-PRED-WAGES-TO-X737 THRU P2210-EXIT DTSBD520 +00587 VARYING WAGES-YRQ-IDX FROM 1 BY 1 DTSBD520 +00588 UNTIL WAGES-YRQ-IDX > X737-YRQ-CNT. DTSBD520 +00589 P2200-EXIT. DTSBD520 +00590 EXIT. DTSBD520 +00591 SKIP3 DTSBD520 +00592 P2210-PRED-WAGES-TO-X737. DTSBD520 +00593 SET X737-YRQ-IDX TO WAGES-YRQ-IDX. DTSBD520 +00594 DTSBD520 +00595 ADD WAGES-YRQ-AMT (WAGES-EMP-IDX2 WAGES-YRQ-IDX) DTSBD520 +00596 TO X737-PRED-WAGES (X737-YRQ-IDX). DTSBD520 +00597 P2210-EXIT. DTSBD520 +00598 EXIT. DTSBD520 +00599 EJECT DTSBD520 +00600 P3000-TABLE-PREDECESSORS. DTSBD520 +00601 MOVE X737-EMP-NO TO SUCC-EMP-NO. DTSBD520 +00602 DTSBD520 +00603 PERFORM P3900-TABLE-PREDECESSORS THRU P3900-EXIT. DTSBD520 +00604 DTSBD520 +00605 PERFORM P3100-PRED-LOOP THRU P3100-EXIT DTSBD520 +00606 VARYING PRED-EMP-IDX1 FROM 1 BY 1 DTSBD520 +00607 UNTIL PRED-EMP-IDX1 > PRED-EMP-CNT. DTSBD520 +00608 P3000-EXIT. DTSBD520 +00609 EXIT. DTSBD520 +00610 SKIP3 DTSBD520 +00611 P3100-PRED-LOOP. DTSBD520 +00612 MOVE PRED-EMP-NO (PRED-EMP-IDX1) TO SUCC-EMP-NO. DTSBD520 +00613 DTSBD520 +00614 PERFORM P3900-TABLE-PREDECESSORS THRU P3900-EXIT. DTSBD520 +00615 P3100-EXIT. DTSBD520 +00616 EXIT. DTSBD520 +00617 SKIP3 DTSBD520 +00618 P3900-TABLE-PREDECESSORS. DTSBD520 +00619 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD520 +00620 DTSBD520 +00621 MOVE SUCC-EMP-NO TO MSKL-EMP-NO. DTSBD520 +00622 DTSBD520 +00623 SET MSKL-REL-88 TO TRUE. DTSBD520 +00624 DTSBD520 +00625 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD520 +00626 DTSBD520 +00627 DTSBD520 +00628 PERFORM DTSBD520 +00629 UNTIL L910-NO-REC-88 DTSBD520 +00630 MOVE MSKL-REC TO MREL-REC DTSBD520 +00631 PERFORM P3910-ANALYZE-MREL THRU P3910-EXIT DTSBD520 +00632 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD520 +00633 END-PERFORM. DTSBD520 +00634 P3900-EXIT. DTSBD520 +00635 EXIT. DTSBD520 +00636 SKIP3 DTSBD520 +00637 P3910-ANALYZE-MREL. DTSBD520 +00638 IF (MREL-EFF-DATE < WRK-YEAR-START-DATE) DTSBD520 +00639 OR DTSBD520 +00640 (MREL-EFF-DATE > WRK-YEAR-END-DATE) DTSBD520 +00641 GO TO P3910-EXIT. DTSBD520 +00642 DTSBD520 +00643 IF MREL-EXP-TRNSF-NO-88 DTSBD520 +00644 GO TO P3910-EXIT. DTSBD520 +00645 DTSBD520 +00646 IF MREL-PRED-EMP-NO = X737-EMP-NO DTSBD520 +00647 GO TO P3910-EXIT. DTSBD520 +00648 DTSBD520 +00649 MOVE +0 TO PRED-EMP-SUB. DTSBD520 +00650 DTSBD520 +00651 PERFORM DTSBD520 +00652 VARYING PRED-EMP-IDX2 FROM 1 BY 1 DTSBD520 +00653 UNTIL (PRED-EMP-IDX2 > PRED-EMP-CNT) DTSBD520 +00654 OR DTSBD520 +00655 (PRED-EMP-SUB NOT = +0) DTSBD520 +00656 IF PRED-EMP-NO (PRED-EMP-IDX2) = MREL-PRED-EMP-NO DTSBD520 +00657 SET PRED-EMP-SUB TO PRED-EMP-IDX2 DTSBD520 +00658 END-IF DTSBD520 +00659 END-PERFORM. DTSBD520 +00660 DTSBD520 +00661 IF PRED-EMP-SUB = +0 DTSBD520 +00662 IF PRED-EMP-CNT < PRED-EMP-MAX DTSBD520 +00663 ADD +1 TO PRED-EMP-CNT DTSBD520 +00664 MOVE MREL-PRED-EMP-NO DTSBD520 +00665 TO PRED-EMP-NO (PRED-EMP-CNT) DTSBD520 +00666 ELSE DTSBD520 +00667 MOVE 'LOGIC ERROR P3910-1' TO ABEND-MSG DTSBD520 +00668 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 +00669 P3910-EXIT. DTSBD520 +00670 EXIT. DTSBD520 +00671 EJECT DTSBD520 +00672 T0000-TERMINATE. DTSBD520 +00673 SET DBW-CLOSE-DATASET TO TRUE. DTSBD520 +00674 DTSBD520 +00675 PERFORM S961-WAGE-I THRU S961-EXIT. DTSBD520 +00676 DTSBD520 +00677 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD520 +00678 DTSBD520 +00679 PERFORM SEXT-CLOSE THRU SEXT-EXIT. DTSBD520 +00680 DTSBD520 +00681 DTSBD520 +00682 DISPLAY '***'. DTSBD520 +00683 DTSBD520 +00684 DISPLAY '*** ' DTSBD520 +00685 MOD-NAME DTSBD520 +00686 ' TERMINATION STATISTICS'. DTSBD520 +00687 DTSBD520 +00688 DISPLAY '*** '. DTSBD520 +00689 DTSBD520 +00690 MOVE WRK-START-YRQ TO L004-QTR-5-9. DTSBD520 +00691 DTSBD520 +00692 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 +00693 DTSBD520 +00694 DISPLAY '*** FIRST QUARTER EXTRACTED: ' DTSBD520 +00695 L004-SLASH-QTR. DTSBD520 +00696 DTSBD520 +00697 DISPLAY '*** '. DTSBD520 +00698 DTSBD520 +00699 MOVE WRK-END-YRQ TO L004-QTR-5-9. DTSBD520 +00700 DTSBD520 +00701 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD520 +00702 DTSBD520 +00703 DISPLAY '*** LAST QUARTER EXTRACTED: ' DTSBD520 +00704 L004-SLASH-QTR. DTSBD520 +00705 DTSBD520 +00706 DISPLAY '*** '. DTSBD520 +00707 DTSBD520 +00708 MOVE OUT-EXT-CNT TO DISPLAY-REC-CNT. DTSBD520 +00709 DTSBD520 +00710 DISPLAY '*** EXTRACT RECORDS WRITTEN: ' DTSBD520 +00711 DISPLAY-REC-CNT-X. DTSBD520 +00712 DTSBD520 +00713 DISPLAY '*** '. DTSBD520 +00714 DTSBD520 +00715 MOVE MAX-WAGES-EMP-CNT TO DISPLAY-REC-CNT. DTSBD520 +00716 DTSBD520 +00717 DISPLAY '*** MAXIMUM WAGES-EMP-AREA OCCURRENCES USED: ' DTSBD520 +00718 DISPLAY-REC-CNT-X. DTSBD520 +00719 DTSBD520 +00720 DISPLAY '*** '. DTSBD520 +00721 DTSBD520 +00722 MOVE MAX-PRED-EMP-CNT TO DISPLAY-REC-CNT. DTSBD520 +00723 DTSBD520 +00724 DISPLAY '*** MAXIMUM PRED-EMP-AREA OCCURRENCES USED: ' DTSBD520 +00725 DISPLAY-REC-CNT-X. DTSBD520 +00726 T0000-EXIT. DTSBD520 +00727 EXIT. DTSBD520 +00728 EJECT DTSBD520 +00729 S001-FROM-FED-8. DTSBD520 +00730 SET L001-FROM-FED-8 TO TRUE. DTSBD520 +00731 GO TO S001-DATE. DTSBD520 +00732 DTSBD520 +00733 S001-FROM-ABS-DAY. DTSBD520 +00734 SET L001-FROM-ABS-DAY TO TRUE. DTSBD520 +00735 GO TO S001-DATE. DTSBD520 +00736 DTSBD520 +00737 S001-DATE. DTSBD520 +00738 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD520 +00739 S001-EXIT. DTSBD520 +00740 EXIT. DTSBD520 +00741 SKIP3 DTSBD520 +00742 S004-FROM-3. DTSBD520 +00743 SET L004-FROM-3 TO TRUE. DTSBD520 +00744 GO TO S004-YRQ. DTSBD520 +00745 DTSBD520 +00746 S004-FROM-5. DTSBD520 +00747 SET L004-FROM-5 TO TRUE. DTSBD520 +00748 GO TO S004-YRQ. DTSBD520 +00749 DTSBD520 +00750 S004-YRQ. DTSBD520 +00751 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD520 +00752 S004-EXIT. DTSBD520 +00753 EXIT. DTSBD520 +00754 SKIP3 DTSBD520 +00755 S910-OPEN-READ. DTSBD520 +00756 SET L910-OPEN-READ-88 TO TRUE. DTSBD520 +00757 GO TO S910-MSTR-IO. DTSBD520 +00758 DTSBD520 +00759 S910-READ. DTSBD520 +00760 SET L910-READ-88 TO TRUE. DTSBD520 +00761 GO TO S910-MSTR-IO. DTSBD520 +00762 DTSBD520 +00763 S910-READ-NEXT. DTSBD520 +00764 SET L910-READ-NEXT-88 TO TRUE. DTSBD520 +00765 GO TO S910-MSTR-IO. DTSBD520 +00766 DTSBD520 +00767 S910-START-BROWSE. DTSBD520 +00768 SET L910-START-BROWSE-88 TO TRUE. DTSBD520 +00769 GO TO S910-MSTR-IO. DTSBD520 +00770 DTSBD520 +00771 S910-CLOSE. DTSBD520 +00772 SET L910-CLOSE-88 TO TRUE. DTSBD520 +00773 GO TO S910-MSTR-IO. DTSBD520 +00774 DTSBD520 +00775 S910-MSTR-IO. DTSBD520 +00776 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD520 +00777 MSKL-REC. DTSBD520 +00778 S910-EXIT. DTSBD520 +00779 EXIT. DTSBD520 +00780 SKIP3 DTSBD520 +00781 S961-WAGE-I. DTSBD520 +00782 IF DBW-WAGE-SEGMENT DTSBD520 +00783 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DTSBD520 +00784 WGD-SEGMENT-TWO DTSBD520 +00785 ELSE DTSBD520 +00786 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DTSBD520 +00787 WGP-SEGMENT-ONE. DTSBD520 +00788 S961-EXIT. DTSBD520 +00789 EXIT. DTSBD520 +00790 SKIP3 DTSBD520 +00791 SEXT-OPEN-OUTPUT. DTSBD520 +00792 OPEN OUTPUT EXTRACT-FILE. DTSBD520 +00793 DTSBD520 +00794 IF EXT-FILE-OK-88 DTSBD520 +00795 GO TO SEXT-EXIT DTSBD520 +00796 ELSE DTSBD520 +00797 MOVE 'OPEN' TO FILE-COMMAND DTSBD520 +00798 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD520 +00799 THRU SEXT-UNEXPECTED-EXIT DTSBD520 +00800 GO TO SEXT-EXIT. DTSBD520 +00801 DTSBD520 +00802 SEXT-WRITE. DTSBD520 +00803 WRITE EXTRACT-REC. DTSBD520 +00804 DTSBD520 +00805 IF EXT-FILE-OK-88 DTSBD520 +00806 ADD +1 TO OUT-EXT-CNT DTSBD520 +00807 GO TO SEXT-EXIT DTSBD520 +00808 ELSE DTSBD520 +00809 MOVE 'WRITE' TO FILE-COMMAND DTSBD520 +00810 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD520 +00811 THRU SEXT-UNEXPECTED-EXIT DTSBD520 +00812 GO TO SEXT-EXIT. DTSBD520 +00813 DTSBD520 +00814 SEXT-CLOSE. DTSBD520 +00815 CLOSE EXTRACT-FILE. DTSBD520 +00816 DTSBD520 +00817 IF EXT-FILE-OK-88 DTSBD520 +00818 GO TO SEXT-EXIT DTSBD520 +00819 ELSE DTSBD520 +00820 MOVE 'CLOSE' TO FILE-COMMAND DTSBD520 +00821 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD520 +00822 THRU SEXT-UNEXPECTED-EXIT DTSBD520 +00823 GO TO SEXT-EXIT. DTSBD520 +00824 DTSBD520 +00825 SEXT-EXIT. DTSBD520 +00826 EXIT. DTSBD520 +00827 DTSBD520 +00828 SEXT-UNEXPECTED-FILE-STATUS. DTSBD520 +00829 MOVE SPACES TO ABEND-MSG. DTSBD520 +00830 DTSBD520 +00831 STRING DTSBD520 +00832 'UNEXPECTED EXTRACT FILE STATUS ON ' DTSBD520 +00833 DELIMITED BY SIZE DTSBD520 +00834 FILE-COMMAND DTSBD520 +00835 DELIMITED BY ' ' DTSBD520 +00836 ': ' DTSBD520 +00837 DELIMITED BY SIZE DTSBD520 +00838 EXT-FILE-STATUS DTSBD520 +00839 DELIMITED BY SIZE DTSBD520 +00840 INTO DTSBD520 +00841 ABEND-MSG. DTSBD520 +00842 DTSBD520 +00843 PERFORM S999-ABEND THRU S999-EXIT. DTSBD520 +00844 SEXT-UNEXPECTED-EXIT. DTSBD520 +00845 EXIT. DTSBD520 +00846 SKIP3 DTSBD520 +00847 S999-ABEND. DTSBD520 +00848 DISPLAY '***'. DTSBD520 +00849 DISPLAY '*** ' DTSBD520 +00850 MOD-NAME DTSBD520 +00851 ' IS ABENDING BECAUSE ' DTSBD520 +00852 ABEND-MSG. DTSBD520 +00853 DISPLAY '***'. DTSBD520 +00854 DTSBD520 +00855 CALL 'DTSBU999' USING ABEND-CODE. DTSBD520 +00856 S999-EXIT. DTSBD520 +00857 EXIT. DTSBD520 diff --git a/Batch/DTSBD551.cob b/Batch/DTSBD551.cob new file mode 100644 index 0000000..ab1dae0 --- /dev/null +++ b/Batch/DTSBD551.cob @@ -0,0 +1,5263 @@ +00001 IDENTIFICATION DIVISION. 12/13/13 +00002 PROGRAM-ID. DTSBD551. DTSBD551 +00003 AUTHOR. NGC. LV067 +00004 DATE-WRITTEN. JUNE 2004. DTSBD551 +00005 DATE-COMPILED. DTSBD551 +00006 SKIP3 DTSBD551 +00007 ***** DTSBD551 +00008 * DTSBD551 +00009 * DTSBD551 +00010 * NOTE: ARCHIVE JCL SET TO DEVL PARMLIB DTSBD551 +00011 * DTSBD551 +00012 * FUNCTION: PRELIMINARY EDIT FOR EMPLOYER REPORT AND WAGE DTSBD551 +00013 * DATA SUBMITTED ELECTRONICALLY OR ON MAGNETIC DTSBD551 +00014 * MEDIA. DTSBD551 +00015 * DTSBD551 +00016 * ICESA FORMAT DTSBD551 +00017 * DTSBD551 +00018 * MODIFICATION HISTORY: DTSBD551 +00019 * DTSBD551 +00020 * 12-01-2004 INITIAL DEVELOPMENT DTSBD551 +00021 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - DTSBD551 +00022 * DTSBD551 +00023 * 02-14-2005 MODIFIED P1512 TO USE TOTAL PAYMENT OR, OPTIONALLYDTSBD551 +00024 * TOTAL DUE FROM 'T' RECORD FOR REMITTANCE. DTSBD551 +00025 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - DTSBD551 +00026 * DTSBD551 +00027 * 02-20-2005 MODIFIED TO OUTPUT A RETURN-CODE = 4 IF A FATAL DTSBD551 +00028 * ERROR HAS BEEN DETECTED DURING ON THE EDITING DTSBD551 +00029 * INPUT DATA PROCESSING. ALL THE FATAL ERRORS WILL DTSBD551 +00030 * BE REPORTED ON RPT55R1. DTSBD551 +00031 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - RLW DTSBD551 +00032 * DTSBD551 +00033 * 03-17-2005 MODIFIED P1500 TO BYPASS ZERO-WAGE REPORTS WHEN DTSBD551 +00034 * THE EMPLOYER IS NOT LIABLE. DTSBD551 +00035 * MODIFIED S2030 TO SET W-LIABLE-NO TO TRUE WHEN DTSBD551 +00036 * THERE IS NO SUCCESSOR. DTSBD551 +00037 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - GD DTSBD551 +00038 * DTSBD551 +00039 * 06-22-2005 ADDED TEST IN P1311 TO CHECK WHETHER FEIN FROM DTSBD551 +00040 * INPUT DATA MATCHES FEIN ON FILE. THIS TEST IS DTSBD551 +00041 * PERFORMED ONLY WHEN THE EMPLOYER WAS FOUND USING DTSBD551 +00042 * THE ACCOUNT NUMBER ON THE INPUT FILE. IT IS NOT DTSBD551 +00043 * PERFORMED WHEN THE EMPLOYER WAS FOUND USING THE DTSBD551 +00044 * FEIN, OR WHEN THE EMPLOYER REFERENCED ON THE DTSBD551 +00045 * INPUT FILE HAS BEEN SUCCEEDED. DTSBD551 +00046 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - GD DTSBD551 +00047 * DTSBD551 +00048 * 08-15-2005 ADDED I1300 TO EDIT LOG NUMBER, MODIFIED I3000 DTSBD551 +00049 * TO DETERMINE FULL LOG NUMBER (INCLUDING YEAR), DTSBD551 +00050 * MODIFIED P1320 TO ADD LOG NUMBER TO T027 RECORD. DTSBD551 +00051 * REFERENCE RFP: ICESA AUTHOR OF CHANGE - GD DTSBD551 +00052 * DTSBD551 +00053 * 09-02-2005 ADDED SUBMITTER AND EMP-RPT FILES. THESE ARE DTSBD551 +00054 * DOWNLOADED TO SQL SERVER AND USED TO TRACK DTSBD551 +00055 * ACCOUNTING BATCHES AND REMITTANCES. DTSBD551 +00056 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00057 * DTSBD551 +00058 * 11-03-2005 CHANGED FROM DTSBU600 TO DTSBU601 FOR DTSBD551 +00059 * FINDING SUCCESSORS. DTSBU601 INCLUDES DTSBD551 +00060 * NON-RATING SUCCESSORS. DTSBD551 +00061 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00062 * DTSBD551 +00063 * 12-19-2005 MOVE PROCESS THAT INCREMENTS ITEM AND BATCH DTSBD551 +00064 * NUMBERS BACK TO P1320 FROM P1540. DTSBD551 +00065 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00066 * DTSBD551 +00067 * 02-03-2006 MODIFIED X210 SUBMITTER RECORD TO INCLUDE DTSBD551 +00068 * STARTING AND ENDING BATCH NUMBERS AND RUN DATE DTSBD551 +00069 * AND TIME. DTSBD551 +00070 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00071 * DTSBD551 +00072 * 04-06-2006 MODIFIED P1512A AND P1512B FOR ADMINISTRATIVE DTSBD551 +00073 * ASSESSMENT. DTSBD551 +00074 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00075 * DTSBD551 +00076 * 06-14-2006 MODIFIED P1310 - CHANGED MISSING ADDRESS FROM DTSBD551 +00077 * FATAL TO NON-FATAL ERROR. DTSBD551 +00078 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00079 * DTSBD551 +00080 * 06-14-2006 CORRECTION FOR PAYCHEX: AMOUNTS IN ASSESSMENT DTSBD551 +00081 * FIELD DO NOT NEED TO BE ADDED TO THE TOTAL DTSBD551 +00082 * PAYMENT. THE ASSESSMENT IS INCLUDED IN THE DTSBD551 +00083 * TOTAL PAYMENT. DTSBD551 +00084 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00085 * DTSBD551 +00086 * 06-14-2006 TEMPORARY CHANGE FOR PAYCHEX: P1620 - REMOVED DTSBD551 +00087 * CHECK FOR WORKER COUNTS. DTSBD551 +00088 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00089 * DTSBD551 +00090 * 06-16-2006 REMOVED ABOVE CHANGE TO P1620. DTSBD551 +00091 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00092 * DTSBD551 +00093 * 08-03-2006 MODIFIED ACCOUNT NUMBER EDIT IN P1311, S2200: DTSBD551 +00094 * IGNORE NON-NUMERIC CHARACTERS (SUCH AS HYPHENS DTSBD551 +00095 * OR SPACES). IF 6 NUMERIC DIGITS SUPPLIED, DTSBD551 +00096 * ACCEPT ACCOUNT NUMBER. DTSBD551 +00097 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00098 * DTSBD551 +00099 * 10-16-2006 ADDED EDIT IN S2020 TO CHECK FOR ANNUAL FILERS. DTSBD551 +00100 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00101 * DTSBD551 +00102 * 11-02-2006 ADDED CHECK TO ELIMINATE COMMAS FROM DTSIX2* DTSBD551 +00103 * EXPORT RECORDS. DTSBD551 +00104 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00105 * DTSBD551 +00106 * 11-02-2006 MODIFIED DTSIX216, ELIMINATING MESSAGE TYPE DTSBD551 +00107 * FIELD. DTSBD551 +00108 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00109 * DTSBD551 +00110 * 02-05-2007 MODIFIED P1420 - THE PARAGRAPH NO LONGER WRITES DTSBD551 +00111 * W001 WAGE TRANSACTIONS IF THE SSN = ZERO. DTSBD551 +00112 * WAGE RECORDS WITH ZERO IN THE SSN FIELD WERE DTSBD551 +00113 * CAUSING PROBLEMS WITH THE BENEFITS WAGE UPDATE. DTSBD551 +00114 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00115 * DTSBD551 +00116 * 08-07-2007 ADDED TIMELY AND BYPASS ERROR PARMS. DTSBD551 +00117 * TIMELY PARM CONTROLS WHETHER SUBMISSION IS TIMELY DTSBD551 +00118 * OR LATE. SEE I1400, I1500, I3000, P1110. DTSBD551 +00119 * BYPASS ERROR PARM ALLOWS PROGRAM TO IGNORE A DTSBD551 +00120 * FATAL ERROR. DTSBD551 +00121 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00122 * DTSBD551 +00123 * 09-17-2007 ADDED TEST FOR ANNUAL FILER IN P1540. IF EMPLOYER DTSBD551 +00124 * IS AN ANNUAL FILER FOR THE QUARTER, SET DTSBD551 +00125 * T027-PASSED-FULL-EDITS TO FALSE. DTSBD551 +00126 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00127 * DTSBD551 +00128 * 11-05-2007 MODIFY TO PROCESS NEW VERSION OF T002 RECORDS DTSBD551 +00129 * REFERENCE RFP: AUTHOR OF CHANGE - ZL1 DTSBD551 +00130 * DTSBD551 +00131 * 01-25-2008 MODIFIED FOR PARTIAL TRANSFERS OF EXPERIENCE. DTSBD551 +00132 * NEW VERSION OF DTSBU601 IS USED. DTSBD551 +00133 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00134 * DTSBD551 +00135 * 09-09-2008 UPDATED P0000 TO CHECK LAST RECORD TYPE AT DTSBD551 +00136 * END-OF-FILE. IF LAST REC IS NOT TYPE F, DTSBD551 +00137 * THE SUBMISSION IS INCOMPLETE. DTSBD551 +00138 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00139 * DTSBD551 +00140 * 04-24-2009 MODIFIED FOR DEPOSIT TRANSMITTAL PROCESS. DTSBD551 +00141 * REMITTANCE PARM CHANGED TO INCLUDE CENTS. DTSBD551 +00142 * WRITE R202 REPORT RECORD TO EXPORT DEPOSIT DTSBD551 +00143 * TRANSMITTAL DATA TO MAINFRAME. DTSBD551 +00144 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00145 * DTSBD551 +00146 * 05-04-2009 MODIFIED P1311 TO BYPASS TEST THAT CHECKS WHETHER DTSBD551 +00147 * THE MPRF-FEIN = THE FEIN IN THE E RECORD IF DTSBD551 +00148 * NO EMPLOYER IS FOUND. DTSBD551 +00149 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00150 * DTSBD551 +00151 * 05-15-2009 MODIFIED T1120: DO NOT WRITE R202 RECORD IF DTSBD551 +00152 * REMITTANCE = ZERO. DTSBD551 +00153 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00154 * DTSBD551 +00155 * 05-18-2009 MODIFIED FUTURE QUARTER EDIT IN S2110, S2120. DTSBD551 +00156 * REJECT SUBMISSION IF QUARTER >= TO W-CURR-QTR. DTSBD551 +00157 * PREVIOUSLY, THE SUBMISSION WAS ONLY REJECTED IF DTSBD551 +00158 * THE IF WAS GREATER THAN THE CURRENT QUARTER. DTSBD551 +00159 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00160 * DTSBD551 +00161 * 08-19-2009 MODIFIED EDIT COMPARING CHECK AMOUNT TO DTSBD551 +00162 * CALCULATED AMOUNT DUE. INSTEAD OF CHECKING DTSBD551 +00163 * THAT THE INTEGER PARTS OF EACH AMOUNT ARE EQUAL, DTSBD551 +00164 * THE NEW EDIT SUBTRACTS THE ACTUAL NUMBERS DTSBD551 +00165 * AND TOLERATES A DIFFERENCE OF 0.99 OR LESS. DTSBD551 +00166 * P1620. DTSBD551 +00167 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00168 * DTSBD551 +00169 * 12-08-2009 ADDED AN EDIT TO PREVENT PROCESSING OF THE DTSBD551 +00170 * SAME SUBMISSION MORE THAN ONCE DURING THE SAME DTSBD551 +00171 * DAY. I4100 ADDED TO READ CURRENT DAY DTSBD551 +00172 * SUBMISSIONS INTO A TABLE. P1110 CHECKS THE DTSBD551 +00173 * TABLE TO SEE IF THE FEIN IS ALREADY THERE. DTSBD551 +00174 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00175 * DTSBD551 +00176 * 02-01-2010 REMOVED ABOVE EDIT IN ORDER TO PROCESS DTSBD551 +00177 * MULTIPLE SUBMISSIONS FROM THE SAME EMPLOYER FOR DTSBD551 +00178 * DIFFERENT EMPLOYERS. DTSBD551 +00179 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00180 * DTSBD551 +00181 * 04-19-2011 MODIFIED P1540 TO ADD LOG NUMBER TO T027 RECORD. DTSBD551 +00182 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00183 * DTSBD551 +00184 * 05-24-2011 MODIFIED P1512B TO USE SUM OF TAX DUE AND ADMIN DTSBD551 +00185 * ASSESS DUE IF PAYMENT AMOUNT ON T RECORD IS ZERO. DTSBD551 +00186 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00187 * DTSBD551 +00188 * 06-02-2011 CORRECTED PROBLEM CAUSED BY ABOVE CHANGE. P1540, DTSBD551 +00189 * WHICH BUILDS THE T027 TRANSACTION, USES THE DTSBD551 +00190 * W-TYPE-T-TAX-DUE FIELD FOR THE REMITTANCE AMOUNT. DTSBD551 +00191 * AS A RESULT OF THE CHANGE ON 5/24, THIS FIELD NOW DTSBD551 +00192 * CONTAINS ONLY THE UI TAX DUE, NOT THE TOTAL DTSBD551 +00193 * PAYMENT. P1540 HAS BEEN CHANGED TO USE DTSBD551 +00194 * W-CALC-EMP-REMITTANCE INSTEAD. DTSBD551 +00195 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00196 * DTSBD551 +00197 * 07-15-2011 MODIFIED TO READ LOG NUMBER AND REMITTANCE AMOUNT DTSBD551 +00198 * FROM THE A RECORD. THESE AMOUNTS ARE STORED IN THEDTSBD551 +00199 * FILE BY THE WEB APPLICATION. DTSBD551 +00200 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00201 * DTSBD551 +00202 * 08-03-2011 INCREASED LENGTH OF FIELDS FOR REMITTANCE. DTSBD551 +00203 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00204 * DTSBD551 +00205 * 02-07-2012 EDITS ON CONTACT INFORMATION IN TYPE A RECORD DTSBD551 +00206 * REMOVED. THE CONTACT DATA IS NOW HANDLED IN DTSBD551 +00207 * THE ICESA WEB APPLICATION. DTSBD551 +00208 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00209 * DTSBD551 +00210 * 04-26-2012 UPDATED TO USE DTSIT028 INSTEAD OF DTSIT027. DTSBD551 +00211 * THE NEW COPY BOOK INCLUDES CHANGES TO THE SORT DTSBD551 +00212 * FIELDS TO ALLOW ICESA SUBMISSIONS TO FALL INTO DTSBD551 +00213 * CONSECUTIVE BATCHES. DTSBD551 +00214 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00215 * DTSBD551 +00216 * 05-07-2012 MODIFIED P1420 TO REMOVE COMMAS FROM NAME FIELDS. DTSBD551 +00217 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00218 * DTSBD551 +00219 * 06-05-2012 MODIFIED P1420 TO WRITE W001 WAGE TRANSACTIONS DTSBD551 +00220 * WHEN THE SSN IS ZERO. THESE WILL BE SAVED TO DTSBD551 +00221 * A SEPARATE FILE. DTSBD551 +00222 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00223 * DTSBD551 +00224 * 08-10-2012 MODIFIED PROCESS IN P1500 THAT BYPASSES ZERO- DTSBD551 +00225 * WAGE REPORTS FOR NOT-LIABLE EMPLOYERS. THE CODE DTSBD551 +00226 * NOW CHECKS FOR A REMITTANCE FIRST. DTSBD551 +00227 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00228 * DTSBD551 +00229 * 07-24-2013 MODIFIED S2210 (EDIT EMP NBR FROM TYPE S). DTSBD551 +00230 * IF ACCOUNT NBR IS RIGHT JUSTIFIED, READ LAST DTSBD551 +00231 * 6 BYTES INSTEAD OF FIRST 6. DTSBD551 +00232 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00233 * DTSBD551 +00234 * 07-29-2013 MODIFIED P1410-EXIT-TYPE-S: IF TOTAL WAGES = DTSBD551 +00235 * ZERO, BYPASS REMAINING EDITS. THE RECORD WILL DTSBD551 +00236 * BE SKIPPED IN P1420. DTSBD551 +00237 * REFERENCE RFP: AUTHOR OF CHANGE - GD DTSBD551 +00238 * DTSBD551 +00239 * 10-25-2013 MODIFIED TO READ A NEW TYPE 1 HEADER RECORD DTSBD551 +00240 * THAT WILL CONTAIN LOG NUMBER, RECEIVED DATE DTSBD551 +00241 * AND REMITTANCE AMT. DTSBD551 +00242 * REFERENCE RFP: AUTHOR OF CHANGE - ZL1 DTSBD551 +00243 * DTSBD551 +00244 ***** DTSBD551 +00245 SKIP3 DTSBD551 +00246 ENVIRONMENT DIVISION. DTSBD551 +00247 SKIP2 DTSBD551 +00248 INPUT-OUTPUT SECTION. DTSBD551 +00249 DTSBD551 +00250 FILE-CONTROL. DTSBD551 +00251 DTSBD551 +00252 SELECT ICESA-FILE ASSIGN TO ICESAFIL DTSBD551 +00253 FILE STATUS IS ICESA-STATUS. DTSBD551 +00254 DTSBD551 +00255 *& SELECT RPT-FILE ASSIGN TO DTSFBTCO DTSBD551 +00256 *& FILE STATUS IS RPT-STATUS. DTSBD551 +00257 DTSBD551 +00258 SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBD551 +00259 FILE STATUS IS BATCH-STATUS. DTSBD551 +00260 DTSBD551 +00261 SELECT UC30-ARCHIVE-DD ASSIGN TO UC30ARCV DTSBD551 +00262 FILE STATUS IS ARCHIVE-STATUS. DTSBD551 +00263 DTSBD551 +00264 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSBD551 +00265 FILE STATUS IS WAGE-TEMP-STATUS. DTSBD551 +00266 DTSBD551 +00267 SELECT WAGE-FILE-OUT ASSIGN TO WAGEOUT DTSBD551 +00268 FILE STATUS IS WAGE-OUT-STATUS. DTSBD551 +00269 DTSBD551 +00270 SELECT SUBMITTER-FILE ASSIGN TO DTSBX210 DTSBD551 +00271 FILE STATUS IS SUBMITTER-STATUS. DTSBD551 +00272 DTSBD551 +00273 SELECT EMP-RPT-FILE ASSIGN TO DTSBX212 DTSBD551 +00274 FILE STATUS IS EMP-RPT-STATUS. DTSBD551 +00275 DTSBD551 +00276 SELECT MESSAGE-FILE ASSIGN TO DTSBX216 DTSBD551 +00277 FILE STATUS IS MSG-STATUS. DTSBD551 +00278 DTSBD551 +00279 SELECT SUBMITTER-GDG ASSIGN TO CURBX210 DTSBD551 +00280 FILE STATUS IS CURBX210-STATUS. DTSBD551 +00281 DTSBD551 +00282 DATA DIVISION. DTSBD551 +00283 DTSBD551 +00284 FILE SECTION. DTSBD551 +00285 DTSBD551 +00286 FD ICESA-FILE DTSBD551 +00287 RECORDING MODE IS F DTSBD551 +00288 BLOCK CONTAINS 0 RECORDS DTSBD551 +00289 LABEL RECORDS ARE OMITTED. DTSBD551 +00290 DTSBD551 +00291 01 ICESA-REC. DTSBD551 +00292 05 ICESA-REC-TYPE PIC X(01). DTSBD551 +00293 88 ICESA-REC-TYPE-1-88 VALUE '1'. DTSBD551 +00294 88 ICESA-REC-TYPE-A-88 VALUE 'A'. DTSBD551 +00295 88 ICESA-REC-TYPE-B-88 VALUE 'B'. DTSBD551 +00296 88 ICESA-REC-TYPE-E-88 VALUE 'E'. DTSBD551 +00297 88 ICESA-REC-TYPE-F-88 VALUE 'F'. DTSBD551 +00298 88 ICESA-REC-TYPE-S-88 VALUE 'S'. DTSBD551 +00299 88 ICESA-REC-TYPE-T-88 VALUE 'T'. DTSBD551 +00300 05 ICESA-FILLER PIC X(274). DTSBD551 +00301 *** 05 ICESA-FILLER PIC X(275). DTSBD551 +00302 DTSBD551 +00303 FD CURR-BATCH-NO DTSBD551 +00304 RECORDING MODE IS F DTSBD551 +00305 BLOCK CONTAINS 0 RECORDS DTSBD551 +00306 LABEL RECORDS ARE OMITTED. DTSBD551 +00307 DTSBD551 +00308 01 CURR-BATCH-NO-REC. DTSBD551 +00309 05 CURRENT-BATCH-NO PIC 9(05). DTSBD551 +00310 05 CURRENT-ITEM-NO PIC 9(03). DTSBD551 +00311 05 FILLER PIC X(01). DTSBD551 +00312 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBD551 +00313 05 FILLER PIC X(01). DTSBD551 +00314 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBD551 +00315 05 FILLER PIC X(62). DTSBD551 +00316 DTSBD551 +00317 *FD RPT-FILE DTSBD551 +00318 * RECORDING MODE IS V DTSBD551 +00319 * BLOCK CONTAINS 0 RECORDS. DTSBD551 +00320 * DTSBD551 +00321 *01 RPT-REC. DTSBD551 +00322 ***INCLUDE DTSIRVAR DTSBD551 +00323 DTSBD551 +00324 *01 RSK1-REC. DTSBD551 +00325 ***INCLUDE DTSIRSK1 DTSBD551 +00326 DTSBD551 +00327 FD UC30-ARCHIVE-DD DTSBD551 +00328 RECORDING MODE IS F DTSBD551 +00329 BLOCK CONTAINS 0 RECORDS DTSBD551 +00330 LABEL RECORDS ARE OMITTED. DTSBD551 +00331 DTSBD551 +00332 01 UC30-ARCHIVE-DD-REC PIC X(80). DTSBD551 +00333 DTSBD551 +00334 FD WAGE-FILE-TEMP DTSBD551 +00335 RECORDING MODE IS F DTSBD551 +00336 BLOCK CONTAINS 0 RECORDS DTSBD551 +00337 LABEL RECORDS ARE OMITTED. DTSBD551 +00338 DTSBD551 +00339 01 WAGE-TEMP-REC PIC X(128). DTSBD551 +00340 DTSBD551 +00341 FD WAGE-FILE-OUT DTSBD551 +00342 RECORDING MODE IS F DTSBD551 +00343 BLOCK CONTAINS 0 RECORDS DTSBD551 +00344 LABEL RECORDS ARE OMITTED. DTSBD551 +00345 DTSBD551 +00346 01 WAGE-OUT-REC PIC X(128). DTSBD551 +00347 DTSBD551 +00348 FD SUBMITTER-FILE DTSBD551 +00349 RECORDING MODE IS F DTSBD551 +00350 BLOCK CONTAINS 0 RECORDS DTSBD551 +00351 LABEL RECORDS ARE OMITTED. DTSBD551 +00352 DTSBD551 +00353 01 SUBMITTER-REC PIC X(231). DTSBD551 +00354 DTSBD551 +00355 FD EMP-RPT-FILE DTSBD551 +00356 RECORDING MODE IS F DTSBD551 +00357 BLOCK CONTAINS 0 RECORDS DTSBD551 +00358 LABEL RECORDS ARE OMITTED. DTSBD551 +00359 DTSBD551 +00360 01 EMP-RPT-REC PIC X(106). DTSBD551 +00361 DTSBD551 +00362 FD MESSAGE-FILE DTSBD551 +00363 RECORDING MODE IS F DTSBD551 +00364 BLOCK CONTAINS 0 RECORDS DTSBD551 +00365 LABEL RECORDS ARE OMITTED. DTSBD551 +00366 DTSBD551 +00367 01 MESSAGE-REC PIC X(318). DTSBD551 +00368 DTSBD551 +00369 FD SUBMITTER-GDG DTSBD551 +00370 RECORDING MODE IS F DTSBD551 +00371 BLOCK CONTAINS 0 RECORDS DTSBD551 +00372 LABEL RECORDS ARE OMITTED. DTSBD551 +00373 DTSBD551 +00374 01 SUBMITTER-GDG-REC PIC X(231). DTSBD551 +00375 DTSBD551 +00376 WORKING-STORAGE SECTION. DTSBD551 +003765 77 PAN-VALET PICTURE X(24) VALUE '067DTSBD551 12/13/13'. DTSBD551 +00377 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD551 12/13/13'. DTSBD551 +00378 77 PAN-VALET PICTURE X(24) VALUE '065DTSBD551 12/11/13'. DTSBD551 +00379 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD551 12/11/13'. DTSBD551 +00380 77 PAN-VALET PICTURE X(24) VALUE '063DTSBD551 12/06/13'. DTSBD551 +00381 77 PAN-VALET PICTURE X(24) VALUE '039DTSBD551 12/05/13'. DTSBD551 +00382 01 WRK-AREA. DTSBD551 +00383 05 W-ABEND-CD PIC S9(04) COMP VALUE +551.DTSBD551 +00384 05 W-MOD-NAME PIC X(08) VALUE 'DTSBD551'.DTSBD551 +00385 * 05 W-PARM-LOG-NO-AREA. DTSBD551 +00386 * 10 W-LOG-YEAR PIC 9(04). DTSBD551 +00387 * 10 W-PARM-LOG-NO PIC 9(06). DTSBD551 +00388 * 05 W-LOG-NO REDEFINES W-PARM-LOG-NO-AREA DTSBD551 +00389 * PIC 9(10). DTSBD551 +00390 DTSBD551 +00391 05 W-PARM-TIMELY-IND PIC X(01). DTSBD551 +00392 88 W-PARM-TIMELY-YES-88 VALUE 'Y'. DTSBD551 +00393 88 W-PARM-TIMELY-NO-88 VALUE 'N'. DTSBD551 +00394 DTSBD551 +00395 DTSBD551 +00396 05 W-PARM-BYPASS-ERR-IND PIC X(01). DTSBD551 +00397 88 W-PARM-BYPASS-ERR-YES-88 VALUE 'Y'. DTSBD551 +00398 88 W-PARM-BYPASS-ERR-NO-88 VALUE 'N'. DTSBD551 +00399 DTSBD551 +00400 05 W-PARM-ALLOW-DUP-IND PIC X(01). DTSBD551 +00401 88 W-PARM-ALLOW-DUP-YES-88 VALUE 'Y'. DTSBD551 +00402 88 W-PARM-ALLOW-DUP-NO-88 VALUE 'N'. DTSBD551 +00403 DTSBD551 +00404 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBD551 +00405 DTSBD551 +00406 05 W-PARM-LOG-NO PIC 9(06). DTSBD551 +00407 05 W-PARM-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD551 +00408 05 W-PARM-REMIT-AREA. DTSBD551 +00409 10 W-PARM-REMIT-9 PIC 9(13). DTSBD551 +00410 10 W-PARM-REMIT-X REDEFINES W-PARM-REMIT-9. DTSBD551 +00411 15 W-PARM-REMIT-DOLLARS PIC 9(11). DTSBD551 +00412 15 W-PARM-REMIT-CENTS PIC 9(02). DTSBD551 +00413 10 W-PARM-REMIT-DECIMAL REDEFINES W-PARM-REMIT-9 DTSBD551 +00414 PIC 9(11)V99. DTSBD551 +00415 DTSBD551 +00416 05 W-LOG-NO PIC S9(06) COMP-3. DTSBD551 +00417 05 W-LOG-NO-9 PIC 9(06). DTSBD551 +00418 05 W-LOG-NO-X REDEFINES W-LOG-NO-9 DTSBD551 +00419 PIC X(06). DTSBD551 +00420 DTSBD551 +00421 ** 05 W-PARM-TOT-REMITTANCE PIC S9(09) COMP-3. DTSBD551 +00422 05 W-PARM-DEPOSIT-REMIT PIC S9(11)V99 COMP-3. DTSBD551 +00423 DTSBD551 +00424 05 W-CALC-EMP-REMITTANCE PIC S9(09)V99 COMP-3 DTSBD551 +00425 VALUE +0. DTSBD551 +00426 05 W-CALC-TOT-REMITTANCE PIC S9(09)V99 COMP-3 DTSBD551 +00427 VALUE +0. DTSBD551 +00428 ** 05 W-CALC-TOT-REMITTANCE-INT PIC S9(09) COMP-3 DTSBD551 +00429 ** VALUE +0. DTSBD551 +00430 05 W-DIFF PIC S9(09)V99 COMP-3 DTSBD551 +00431 VALUE +0. DTSBD551 +00432 05 DISP-CALC-TOT-REMITTANCE PIC $$,$$$,$$$,$$9.99. DTSBD551 +00433 DTSBD551 +00434 05 W-DEFAULT-RCVD-DT PIC S9(09) COMP-3. DTSBD551 +00435 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD551 +00436 DTSBD551 +00437 05 W-PREV-REC-TYPE PIC X(01) VALUE SPACE. DTSBD551 +00438 88 W-PREV-REC-TYPE-1-88 VALUE '1'. DTSBD551 +00439 88 W-PREV-REC-TYPE-A-88 VALUE 'A'. DTSBD551 +00440 88 W-PREV-REC-TYPE-B-88 VALUE 'B'. DTSBD551 +00441 88 W-PREV-REC-TYPE-E-88 VALUE 'E'. DTSBD551 +00442 88 W-PREV-REC-TYPE-S-88 VALUE 'S'. DTSBD551 +00443 88 W-PREV-REC-TYPE-T-88 VALUE 'T'. DTSBD551 +00444 88 W-PREV-REC-TYPE-F-88 VALUE 'F'. DTSBD551 +00445 88 W-PREV-REC-TYPE-NULL-88 VALUE SPACE. DTSBD551 +00446 DTSBD551 +00447 05 SUB3 PIC S9(04) COMP. DTSBD551 +00448 05 SB-MAX PIC S9(04) COMP VALUE +200. DTSBD551 +00449 05 SB-LAST PIC S9(04) COMP VALUE +0. DTSBD551 +00450 05 W-SB-FEIN OCCURS 200 TIMES DTSBD551 +00451 PIC S9(09) COMP-3. DTSBD551 +00452 DTSBD551 +00453 *& 05 ZW-SUB PIC S9(07) COMP-3. DTSBD551 +00454 * 05 ZW-MAX PIC S9(07) COMP-3 DTSBD551 +00455 * VALUE +999999. DTSBD551 +00456 * 05 ZERO-WAGE-RPTS OCCURS 999999 TIMES. DTSBD551 +00457 * 10 ZERO-WAGE-IND PIC X(01). DTSBD551 +00458 * 88 ZW-ZERO-WAGE-YES-88 VALUE 'Y'. DTSBD551 +00459 *& 88 ZW-ZERO-WAGE-NO-88 VALUE 'N'. DTSBD551 +00460 DTSBD551 +00461 05 ICESA-STATUS PIC X(02). DTSBD551 +00462 88 ICESA-STATUS-OK-88 VALUE '00'. DTSBD551 +00463 88 ICESA-STATUS-EOF-88 VALUE '10'. DTSBD551 +00464 DTSBD551 +00465 05 BATCH-STATUS PIC X(02). DTSBD551 +00466 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBD551 +00467 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBD551 +00468 DTSBD551 +00469 05 RPT-STATUS PIC X(02). DTSBD551 +00470 88 RPT-STATUS-OK-88 VALUE '00'. DTSBD551 +00471 88 RPT-STATUS-EOF-88 VALUE '10'. DTSBD551 +00472 DTSBD551 +00473 05 ARCHIVE-STATUS PIC X(02). DTSBD551 +00474 88 ARCHIVE-STATUS-OK-88 VALUE '00'. DTSBD551 +00475 DTSBD551 +00476 05 SUBMITTER-STATUS PIC X(02). DTSBD551 +00477 88 SUBMITTER-STATUS-OK-88 VALUE '00'. DTSBD551 +00478 DTSBD551 +00479 05 CURBX210-STATUS PIC X(02). DTSBD551 +00480 88 CURBX210-STATUS-OK-88 VALUE '00'. DTSBD551 +00481 88 CURBX210-STATUS-EOF-88 VALUE '10'. DTSBD551 +00482 DTSBD551 +00483 05 EMP-RPT-STATUS PIC X(02). DTSBD551 +00484 88 EMP-RPT-STATUS-OK-88 VALUE '00'. DTSBD551 +00485 88 EMP-RPT-STATUS-EOF-88 VALUE '10'. DTSBD551 +00486 DTSBD551 +00487 05 MSG-STATUS PIC X(02). DTSBD551 +00488 88 MSG-STATUS-OK-88 VALUE '00'. DTSBD551 +00489 DTSBD551 +00490 05 WAGE-TEMP-STATUS PIC X(02). DTSBD551 +00491 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBD551 +00492 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBD551 +00493 DTSBD551 +00494 05 WAGE-OUT-STATUS PIC X(02). DTSBD551 +00495 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBD551 +00496 DTSBD551 +00497 05 WAGE-TEMP-OPEN-IND PIC X(01) VALUE 'C'. DTSBD551 +00498 88 WAGE-TEMP-OPEN-88 VALUE 'O'. DTSBD551 +00499 88 WAGE-TEMP-CLOSED-88 VALUE 'C'. DTSBD551 +00500 DTSBD551 +00501 05 WAGE-TEMP-REQUEST-IND PIC X(02) VALUE SPACE. DTSBD551 +00502 88 WAGE-TEMP-REQ-OPEN-INP-88 VALUE 'OI'. DTSBD551 +00503 88 WAGE-TEMP-REQ-OPEN-OUT-88 VALUE 'OP'. DTSBD551 +00504 88 WAGE-TEMP-REQ-CLOSE-88 VALUE 'CL'. DTSBD551 +00505 88 WAGE-TEMP-REQ-WRITE-88 VALUE 'WR'. DTSBD551 +00506 88 WAGE-TEMP-REQ-NULL-88 VALUE SPACES. DTSBD551 +00507 DTSBD551 +00508 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBD551 +00509 88 W-ERROR-YES-88 VALUE 'Y'. DTSBD551 +00510 88 W-ERROR-NO-88 VALUE 'N'. DTSBD551 +00511 DTSBD551 +00512 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBD551 +00513 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBD551 +00514 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBD551 +00515 DTSBD551 +00516 05 W-LIABLE-IND PIC X(01) VALUE 'N'. DTSBD551 +00517 88 W-LIABLE-YES-88 VALUE 'Y'. DTSBD551 +00518 88 W-LIABLE-NO-88 VALUE 'N'. DTSBD551 +00519 DTSBD551 +00520 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBD551 +00521 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBD551 +00522 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBD551 +00523 DTSBD551 +00524 05 W-DUP-RPT-IND PIC X(01) VALUE 'N'. DTSBD551 +00525 88 W-DUP-RPT-YES-88 VALUE 'Y'. DTSBD551 +00526 88 W-DUP-RPT-NO-88 VALUE 'N'. DTSBD551 +00527 DTSBD551 +00528 05 W-ANNUAL-QTR-IND PIC X(01) VALUE 'N'. DTSBD551 +00529 88 W-ANNUAL-QTR-YES-88 VALUE 'Y'. DTSBD551 +00530 88 W-ANNUAL-QTR-NO-88 VALUE 'N'. DTSBD551 +00531 DTSBD551 +00532 05 W-MOPO-FOUND-IND PIC X(01) VALUE 'N'. DTSBD551 +00533 88 W-MOPO-FOUND-YES-88 VALUE 'Y'. DTSBD551 +00534 88 W-MOPO-FOUND-NO-88 VALUE 'N'. DTSBD551 +00535 DTSBD551 +00536 ** 05 W-SUCCESSOR-FOUND-IND PIC X(01) VALUE 'N'. DTSBD551 +00537 * 88 W-SUCCESSOR-YES-88 VALUE 'Y'. DTSBD551 +00538 ** 88 W-SUCCESSOR-NO-88 VALUE 'N'. DTSBD551 +00539 DTSBD551 +00540 05 W-SUBMITTER-DATA-AREA. DTSBD551 +00541 10 W-SUBM-FEIN PIC 9(09). DTSBD551 +00542 10 W-SUBM-NAME PIC X(50). DTSBD551 +00543 10 W-SUBM-STREET PIC X(40). DTSBD551 +00544 10 W-SUBM-CITY PIC X(25). DTSBD551 +00545 10 W-SUBM-STATE PIC X(02). DTSBD551 +00546 10 W-SUBM-ZIP PIC X(05). DTSBD551 +00547 10 W-SUBM-ZIP-EXT PIC X(05). DTSBD551 +00548 10 FILLER REDEFINES W-SUBM-ZIP-EXT. DTSBD551 +00549 15 FILLER PIC X(01). DTSBD551 +00550 15 W-SUBM-ZIP-EXT4 PIC X(04). DTSBD551 +00551 10 W-SUBM-CONTACT-NAME PIC X(30). DTSBD551 +00552 10 W-SUBM-CONTACT-PHONE-AREA. DTSBD551 +00553 15 W-SUBM-CONTACT-PHONE PIC X(10). DTSBD551 +00554 15 W-SUBM-CONTACT-PHONE-EXT PIC X(04). DTSBD551 +00555 10 W-SUBM-REMIT-AMT-X PIC X(13). DTSBD551 +00556 10 W-SUBM-REMIT-AMT-9 REDEFINES DTSBD551 +00557 W-SUBM-REMIT-AMT-X PIC 9(10).99. DTSBD551 +00558 10 W-SUBM-CREATE-DATE PIC 9(08). DTSBD551 +00559 10 FILLER REDEFINES W-SUBM-CREATE-DATE. DTSBD551 +00560 15 W-SUBM-CREATE-CCYY PIC 9(04). DTSBD551 +00561 15 FILLER PIC X(04). DTSBD551 +00562 DTSBD551 +00563 05 W-WAGES-EXPECTED-IND PIC 9(01). DTSBD551 +00564 88 W-WAGES-EXPECTED-YES-88 VALUE 1. DTSBD551 +00565 88 W-WAGES-EXPECTED-NO-88 VALUE 0. DTSBD551 +00566 DTSBD551 +00567 05 W-ACCT-NBR-ERR-IND PIC X(01) VALUE 'N'. DTSBD551 +00568 88 W-ACCT-NBR-ERR-YES-88 VALUE 'Y'. DTSBD551 +00569 88 W-ACCT-NBR-ERR-NO-88 VALUE 'N'. DTSBD551 +00570 DTSBD551 +00571 05 W-SSN-ERR-IND PIC X(01) VALUE '0'. DTSBD551 +00572 88 W-SSN-ERR-YES-88 VALUE '1'. DTSBD551 +00573 88 W-SSN-ERR-NO-88 VALUE '0'. DTSBD551 +00574 88 W-SSN-MISSING-88 VALUE '2'. DTSBD551 +00575 DTSBD551 +00576 05 W-INTEGER PIC S9(11) COMP-3. DTSBD551 +00577 05 W-FRACTION PIC SV9(11) COMP-3. DTSBD551 +00578 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBD551 +00579 DTSBD551 +00580 05 SUB1 PIC S9(04) COMP. DTSBD551 +00581 05 SUB1-INIT PIC S9(04) COMP VALUE +1. DTSBD551 +00582 05 SUB2 PIC S9(04) COMP. DTSBD551 +00583 05 W-ACCT-NBR-LEN PIC S9(04) COMP VALUE +6. DTSBD551 +00584 05 W-ACCT-NBR-IN. DTSBD551 +00585 10 W-ACCT-NBR-IN-X OCCURS 15 TIMES DTSBD551 +00586 PIC X(01). DTSBD551 +00587 05 FILLER REDEFINES W-ACCT-NBR-IN. DTSBD551 +00588 10 W-ACCT-NBR-1-6 PIC X(06). DTSBD551 +00589 88 FIRST-6-ALL-ZERO-88 VALUE '000000'. DTSBD551 +00590 10 FILLER PIC X(09). DTSBD551 +00591 DTSBD551 +00592 05 W-ACCT-NBR-OUT. DTSBD551 +00593 10 W-ACCT-NBR-OUT-X OCCURS 6 TIMES DTSBD551 +00594 PIC X(01). DTSBD551 +00595 05 W-ACCT-NBR-9 REDEFINES W-ACCT-NBR-OUT DTSBD551 +00596 PIC 9(06). DTSBD551 +00597 DTSBD551 +00598 05 W-EDITED-E-ACCT PIC 9(06). DTSBD551 +00599 05 W-EDITED-S-ACCT PIC 9(06). DTSBD551 +00600 DTSBD551 +00601 05 W-SSN-LEN PIC S9(04) COMP VALUE +9. DTSBD551 +00602 05 W-SSN-IN. DTSBD551 +00603 10 W-SSN-IN-X OCCURS 9 TIMES DTSBD551 +00604 PIC X(01). DTSBD551 +00605 05 W-SSN-OUT. DTSBD551 +00606 10 W-SSN-OUT-X OCCURS 9 TIMES DTSBD551 +00607 PIC X(01). DTSBD551 +00608 05 W-SSN-OUT-9 REDEFINES W-SSN-OUT DTSBD551 +00609 PIC 9(09). DTSBD551 +00610 DTSBD551 +00611 05 W-EMP-NO PIC S9(07) COMP-3 DTSBD551 +00612 VALUE +0. DTSBD551 +00613 05 W-FEIN-EMP-NO PIC S9(07) COMP-3 DTSBD551 +00614 VALUE +0. DTSBD551 +00615 05 W-FINAL-FEIN PIC S9(09) COMP-3 DTSBD551 +00616 VALUE +0. DTSBD551 +00617 05 W-PRED-NO PIC S9(07) COMP-3 DTSBD551 +00618 VALUE +0. DTSBD551 +00619 05 W-EMP-NAME PIC X(40). DTSBD551 +00620 DTSBD551 +00621 05 W-DIFFERENCE PIC S9(07) COMP-3. DTSBD551 +00622 DTSBD551 +00623 05 W-REPORT-MM-X PIC X(02). DTSBD551 +00624 05 W-REPORT-MM-9 REDEFINES W-REPORT-MM-X DTSBD551 +00625 PIC 9(02). DTSBD551 +00626 05 W-REPORT-CCYY. DTSBD551 +00627 10 W-REPORT-CC PIC X(02). DTSBD551 +00628 10 W-REPORT-YY PIC X(02). DTSBD551 +00629 05 W-REPORT-CCYY-9 REDEFINES W-REPORT-CCYY DTSBD551 +00630 PIC 9(04). DTSBD551 +00631 05 W-ZIP-AREA. DTSBD551 +00632 10 W-ZIP5 PIC X(05). DTSBD551 +00633 10 W-ZIP-DASH PIC X(01) VALUE '-'. DTSBD551 +00634 10 W-ZIP-PLUS4 PIC X(04). DTSBD551 +00635 05 W-ZIP REDEFINES W-ZIP-AREA DTSBD551 +00636 PIC X(10). DTSBD551 +00637 DTSBD551 +00638 05 W-EARLIEST-QTR PIC 9(05) VALUE ZERO. DTSBD551 +00639 05 W-CURR-QTR PIC 9(05) VALUE ZERO. DTSBD551 +00640 05 W-RPT-QTR PIC 9(05) VALUE ZERO. DTSBD551 +00641 05 W-RPT-DATE PIC 9(08) VALUE ZERO. DTSBD551 +00642 05 W-CURR-DATE PIC 9(08) VALUE ZERO. DTSBD551 +00643 DTSBD551 +00644 05 W-L001-JUL-DATE PIC 9(7) VALUE ZERO. DTSBD551 +00645 05 FILLER REDEFINES W-L001-JUL-DATE. DTSBD551 +00646 10 W-JULIAN-YR PIC 9(4). DTSBD551 +00647 10 W-JULIAN-DAYS PIC 9(3). DTSBD551 +00648 DTSBD551 +00649 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBD551 +00650 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBD551 +00651 10 W-PSEUDO-DAYS PIC 9(03). DTSBD551 +00652 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBD551 +00653 DTSBD551 +00654 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBD551 +00655 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBD551 +00656 DTSBD551 +00657 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBD551 +00658 DTSBD551 +00659 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBD551 +00660 DTSBD551 +00661 05 W-TYPE-S-TOT-WAGE PIC 9(12)V99. DTSBD551 +00662 05 W-TYPE-S-TAX-WAGE PIC 9(12)V99. DTSBD551 +00663 05 W-TYPE-T-TOT-WAGE PIC 9(12)V99. DTSBD551 +00664 05 W-TYPE-T-TAX-WAGE PIC 9(12)V99. DTSBD551 +00665 05 W-TYPE-F-TOT-WAGE PIC S9(13)V99 COMP-3 VALUE +0. DTSBD551 +00666 05 W-EMP-TOT-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBD551 +00667 05 W-EMP-TAX-WAGE PIC S9(11)V99 COMP-3 VALUE +0. DTSBD551 +00668 05 W-TYPE-T-RATE-X PIC X(06). DTSBD551 +00669 05 FILLER REDEFINES W-TYPE-T-RATE-X. DTSBD551 +00670 10 FILLER PIC X(01). DTSBD551 +00671 10 W-TYPE-T-RATE-9 PIC 9(05). DTSBD551 +00672 05 W-EMP-TAX-RATE PIC 9V9(05). DTSBD551 +00673 05 W-UI-RATE PIC S9(01)V9(04) COMP-3. DTSBD551 +00674 05 W-TYPE-T-TAX-DUE PIC 9(11)V99. DTSBD551 +00675 05 W-TYPE-T-PMT-DUE PIC 9(11)V99. DTSBD551 +00676 05 W-TYPE-T-TOT-WORKER PIC 9(07). DTSBD551 +00677 05 W-TYPE-F-TOT-WORKER PIC 9(09). DTSBD551 +00678 05 W-TYPE-F-TOT-EMP PIC 9(09). DTSBD551 +00679 05 W-TYPE-T-ASSESS-X PIC X(11). DTSBD551 +00680 05 W-TYPE-T-ASSESS REDEFINES W-TYPE-T-ASSESS-X DTSBD551 +00681 PIC 9(09)V99. DTSBD551 +00682 05 W-AMT-DISP1 PIC --,---,---,--9.99. DTSBD551 +00683 05 W-AMT-DISP2 PIC --,---,---,--9.99. DTSBD551 +00684 05 W-AMT-DISP3 PIC --,---,---,--9.99. DTSBD551 +00685 DTSBD551 +00686 05 W-MNTE-WORK-AREA. DTSBD551 +00687 10 W-MNTE-STARTED-IND PIC X(01). DTSBD551 +00688 88 W-MNTE-STARTED-YES-88 VALUE 'Y'. DTSBD551 +00689 88 W-MNTE-STARTED-NO-88 VALUE 'N'. DTSBD551 +00690 10 W-MNTE-SUBJECT-ACCT PIC X(40) VALUE DTSBD551 +00691 'MAG UC30 ACCOUNT NUMBER CHANGE '. DTSBD551 +00692 10 W-MNTE-SUBJECT-SSN PIC X(40) VALUE DTSBD551 +00693 'MAG UC30 BAD OR MISSING SSN '. DTSBD551 +00694 10 W-MNTE-SUBJECT-BOTH PIC X(40) VALUE DTSBD551 +00695 'MAG UC30 ACCT NBR CHNG/MISSING SSN '. DTSBD551 +00696 10 W-MNTE-TEXT-CNT PIC S9(04) COMP VALUE +0. DTSBD551 +00697 10 W-MNTE-TEXT-MAX PIC S9(04) COMP VALUE +16. DTSBD551 +00698 10 W-MNTE-TEXT-AREA. DTSBD551 +00699 15 W-MNTE-TEXT OCCURS 16 TIMES DTSBD551 +00700 PIC X(72). DTSBD551 +00701 DTSBD551 +00702 05 W-ARCHIVE-CURR-YEAR PIC 9(04). DTSBD551 +00703 05 W-ARCHIVE-FIRST-YEAR PIC 9(04). DTSBD551 +00704 05 W-ARCHIVE-JOB-STATMENTS. DTSBD551 +00705 DTSBD551 +00706 10 DD-LINE-1-JOB. DTSBD551 +00707 15 FILLER PIC X(40) VALUE DTSBD551 +00708 '//BCGB551 JOB (UI,4300,3400,T),UC30ARX,'. DTSBD551 +00709 15 FILLER PIC X(40) VALUE SPACES.DTSBD551 +00710 10 DD-LINE-2-JOB. DTSBD551 +00711 15 FILLER PIC X(30) VALUE DTSBD551 +00712 '// CLASS=S,MSGCLASS=X,'. DTSBD551 +00713 15 FILLER PIC X(50) VALUE SPACES.DTSBD551 +00714 10 DD-LINE-3-JOB. DTSBD551 +00715 15 FILLER PIC X(34) VALUE DTSBD551 +00716 '// NOTIFY=DCGGAB,REGION=0M'. DTSBD551 +00717 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 +00718 10 DD-LINE-3A-JOB. DTSBD551 +00719 15 FILLER PIC X(03) VALUE DTSBD551 +00720 '//*'. DTSBD551 +00721 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 +00722 10 DD-LINE-3B-JOB. DTSBD551 +00723 15 FILLER PIC X(03) VALUE DTSBD551 +00724 '//*'. DTSBD551 +00725 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 +00726 10 DD-LINE-3C-JOB. DTSBD551 +00727 15 FILLER PIC X(50) VALUE DTSBD551 +00728 '//* THIS JOB ARCHIVES ICESA CONTRIB/WAGE FILES '.DTSBD551 +00729 15 FILLER PIC X(28) VALUE SPACES.DTSBD551 +00730 10 DD-LINE-3D-JOB. DTSBD551 +00731 15 FILLER PIC X(47) VALUE DTSBD551 +00732 '//* THE INTERNAL FILE CREATION DATE DETERMINES'. DTSBD551 +00733 15 FILLER PIC X(33) VALUE SPACES.DTSBD551 +00734 10 DD-LINE-3E-JOB. DTSBD551 +00735 15 FILLER PIC X(47) VALUE DTSBD551 +00736 '//* THE OUTPUT FILE CREATION YEAR (MOD OR NEW)'. DTSBD551 +00737 15 FILLER PIC X(33) VALUE SPACES.DTSBD551 +00738 10 DD-LINE-3F-JOB. DTSBD551 +00739 15 FILLER PIC X(03) VALUE DTSBD551 +00740 '//*'. DTSBD551 +00741 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 +00742 10 DD-LINE-3G-JOB. DTSBD551 +00743 15 FILLER PIC X(03) VALUE DTSBD551 +00744 '//*'. DTSBD551 +00745 15 FILLER PIC X(77) VALUE SPACES.DTSBD551 +00746 10 DD-LINE-4-JOB. DTSBD551 +00747 15 FILLER PIC X(39) VALUE DTSBD551 +00748 '//STEP100 EXEC PGM=IDCAMS,COND=(0,LT)'. DTSBD551 +00749 15 FILLER PIC X(41) VALUE SPACES.DTSBD551 +00750 10 DD-LINE-5-JOB. DTSBD551 +00751 15 FILLER PIC X(29) VALUE DTSBD551 +00752 '//SYSPRINT DD SYSOUT=*'. DTSBD551 +00753 15 FILLER PIC X(51) VALUE SPACES.DTSBD551 +00754 10 DD-LINE-6-JOB. DTSBD551 +00755 15 FILLER PIC X(45) VALUE DTSBD551 +00756 '//INDD01 DD DSN=DOESTAX.CONV.ICESA.UPLOAD,'. DTSBD551 +00757 15 FILLER PIC X(35) VALUE SPACES.DTSBD551 +00758 10 DD-LINE-7-JOB. DTSBD551 +00759 15 FILLER PIC X(23) VALUE DTSBD551 +00760 '// DISP=SHR'. DTSBD551 +00761 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 +00762 10 DD-LINE-8-JOB. DTSBD551 +00763 15 FILLER PIC X(49) VALUE DTSBD551 +00764 '//SYSIN DD DSN=DOESTAX.DEVL.PARMLIB(DTSRONE),'. DTSBD551 +00765 15 FILLER PIC X(31) VALUE SPACES.DTSBD551 +00766 10 DD-LINE-9-JOB. DTSBD551 +00767 15 FILLER PIC X(23) VALUE DTSBD551 +00768 '// DISP=SHR'. DTSBD551 +00769 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 +00770 10 DD-LINE-10-JOB. DTSBD551 +00771 15 FILLER PIC X(05) VALUE DTSBD551 +00772 '/*EOF'. DTSBD551 +00773 15 FILLER PIC X(75) VALUE SPACES.DTSBD551 +00774 10 DD-LINE-11-JOB. DTSBD551 +00775 15 FILLER PIC X(02) VALUE DTSBD551 +00776 '/*'. DTSBD551 +00777 15 FILLER PIC X(78) VALUE SPACES.DTSBD551 +00778 10 DD-LINE-12-JOB. DTSBD551 +00779 15 FILLER PIC X(02) VALUE DTSBD551 +00780 '//'. DTSBD551 +00781 15 FILLER PIC X(78) VALUE SPACES.DTSBD551 +00782 05 W-ARCHIVE-OLD-DD-STATEMENT. DTSBD551 +00783 DTSBD551 +00784 10 DD-LINE-1-OLD. DTSBD551 +00785 15 FILLER PIC X(48) VALUE DTSBD551 +00786 '//OUTDD01 DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 +00787 15 W-ARCHIVE-OLD-YEAR PIC X(04). DTSBD551 +00788 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00789 15 FILLER PIC X(27) VALUE SPACES.DTSBD551 +00790 10 DD-LINE-2-OLD. DTSBD551 +00791 15 FILLER PIC X(24) VALUE DTSBD551 +00792 '// UNIT=CART'. DTSBD551 +00793 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00794 15 FILLER PIC X(54) VALUE SPACES.DTSBD551 +00795 10 DD-LINE-3-OLD. DTSBD551 +00796 15 FILLER PIC X(33) VALUE DTSBD551 +00797 '// SPACE=(CYL,(5,5)),'. DTSBD551 +00798 15 FILLER PIC X(47) VALUE SPACES.DTSBD551 +00799 10 DD-LINE-4-OLD. DTSBD551 +00800 15 FILLER PIC X(35) VALUE DTSBD551 +00801 '// DISP=(MOD,KEEP,KEEP)'. DTSBD551 +00802 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 +00803 DTSBD551 +00804 05 W-ARCHIVE-UNCATLG-DD-STATEMENT. DTSBD551 +00805 DTSBD551 +00806 10 DD-LINE-1-UNCATLG. DTSBD551 +00807 15 FILLER PIC X(27) VALUE DTSBD551 +00808 '//UNCATLG EXEC PGM=IEHPROGM'. DTSBD551 +00809 15 FILLER PIC X(53) VALUE SPACES.DTSBD551 +00810 10 DD-LINE-2-UNCATLG. DTSBD551 +00811 15 FILLER PIC X(22) VALUE DTSBD551 +00812 '//SYSPRINT DD SYSOUT=*'. DTSBD551 +00813 15 FILLER PIC X(56) VALUE SPACES.DTSBD551 +00814 10 DD-LINE-3-UNCATLG. DTSBD551 +00815 15 FILLER PIC X(12) VALUE DTSBD551 +00816 '//SYSIN DD *'. DTSBD551 +00817 15 FILLER PIC X(68) VALUE SPACES.DTSBD551 +00818 DTSBD551 +00819 10 DD-LINE-4-UNCATLG. DTSBD551 +00820 15 FILLER PIC X(46) VALUE DTSBD551 +00821 ' UNCATLG DSNAME=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 +00822 15 W-ARCHIVE-UNCATLG-YEAR PIC X(04). DTSBD551 +00823 15 FILLER PIC X(07) VALUE DTSBD551 +00824 '.BACKUP'. DTSBD551 +00825 15 FILLER PIC X(23) VALUE SPACES.DTSBD551 +00826 DTSBD551 +00827 10 DD-LINE-5-UNCATLG. DTSBD551 +00828 15 FILLER PIC X(02) VALUE DTSBD551 +00829 '/*'. DTSBD551 +00830 15 FILLER PIC X(78) VALUE SPACES.DTSBD551 +00831 DTSBD551 +00832 05 W-ARCHIVE-BACKUP-DD-STATEMENT. DTSBD551 +00833 DTSBD551 +00834 10 DD-LINE-1-BACKUP. DTSBD551 +00835 15 FILLER PIC X(23) VALUE DTSBD551 +00836 '//STEP2 EXEC PGM=IDCAMS'. DTSBD551 +00837 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 +00838 DTSBD551 +00839 10 DD-LINE-2-BACKUP. DTSBD551 +00840 15 FILLER PIC X(44) VALUE DTSBD551 +00841 '//IFILE DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 +00842 15 W-ARCHIVE-BACKUP-YEAR-I PIC X(04). DTSBD551 +00843 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00844 15 FILLER PIC X(27) VALUE SPACES.DTSBD551 +00845 DTSBD551 +00846 10 DD-LINE-3-BACKUP. DTSBD551 +00847 15 FILLER PIC X(35) VALUE DTSBD551 +00848 '// DISP=(OLD,KEEP,KEEP)'. DTSBD551 +00849 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 +00850 DTSBD551 +00851 10 DD-LINE-4-BACKUP. DTSBD551 +00852 15 FILLER PIC X(44) VALUE DTSBD551 +00853 '//OFILE DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 +00854 15 W-ARCHIVE-BACKUP-YEAR-O PIC X(04). DTSBD551 +00855 15 FILLER PIC X(07) VALUE DTSBD551 +00856 '.BACKUP'. DTSBD551 +00857 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00858 15 FILLER PIC X(24) VALUE SPACES.DTSBD551 +00859 DTSBD551 +00860 10 DD-LINE-5-BACKUP. DTSBD551 +00861 15 FILLER PIC X(43) VALUE DTSBD551 +00862 '// DCB=(RECFM=FB,LRECL=275,BLKSIZE=27500)'. DTSBD551 +00863 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00864 15 FILLER PIC X(35) VALUE SPACES.DTSBD551 +00865 DTSBD551 +00866 10 DD-LINE-6-BACKUP. DTSBD551 +00867 15 FILLER PIC X(34) VALUE DTSBD551 +00868 '// UNIT=CART,LABEL=(,SL,RETPD=1)'. DTSBD551 +00869 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00870 15 FILLER PIC X(45) VALUE SPACES.DTSBD551 +00871 DTSBD551 +00872 10 DD-LINE-7-BACKUP. DTSBD551 +00873 15 FILLER PIC X(28) VALUE DTSBD551 +00874 '// DISP=(NEW,CATLG,DELETE)'. DTSBD551 +00875 15 FILLER PIC X(51) VALUE SPACES.DTSBD551 +00876 DTSBD551 +00877 10 DD-LINE-8-BACKUP. DTSBD551 +00878 15 FILLER PIC X(24) VALUE DTSBD551 +00879 '//SYSPRINT DD SYSOUT=(X)'. DTSBD551 +00880 15 FILLER PIC X(56) VALUE SPACES.DTSBD551 +00881 DTSBD551 +00882 10 DD-LINE-9-BACKUP. DTSBD551 +00883 15 FILLER PIC X(49) VALUE DTSBD551 +00884 '//SYSIN DD DSN=DOESTAX.DEVL.PARMLIB(DTSRONE),'. DTSBD551 +00885 15 FILLER PIC X(31) VALUE SPACES.DTSBD551 +00886 DTSBD551 +00887 10 DD-LINE-10-BACKUP. DTSBD551 +00888 15 FILLER PIC X(23) VALUE DTSBD551 +00889 '// DISP=SHR'. DTSBD551 +00890 15 FILLER PIC X(57) VALUE SPACES.DTSBD551 +00891 DTSBD551 +00892 05 W-ARCHIVE-NEW-DD-STATEMENT. DTSBD551 +00893 10 DD-LINE-1-NEW. DTSBD551 +00894 15 FILLER PIC X(49) VALUE DTSBD551 +00895 '//OUTDD01 DD DSN=DOESTAX.CONV.UC30.ARCHIVET.YR'. DTSBD551 +00896 15 W-ARCHIVE-NEW-YEAR PIC X(04). DTSBD551 +00897 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00898 15 FILLER PIC X(26) VALUE SPACES.DTSBD551 +00899 10 DD-LINE-2-NEW. DTSBD551 +00900 15 FILLER PIC X(37) VALUE DTSBD551 +00901 '// DISP=(NEW,CATLG,KEEP),'. DTSBD551 +00902 15 FILLER PIC X(43) VALUE SPACES.DTSBD551 +00903 DTSBD551 +00904 10 DD-LINE-3-NEW. DTSBD551 +00905 15 FILLER PIC X(14) VALUE DTSBD551 +00906 '// UNIT=CART'. DTSBD551 +00907 15 FILLER PIC X(01) VALUE ','. DTSBD551 +00908 15 FILLER PIC X(64) VALUE SPACES.DTSBD551 +00909 DTSBD551 +00910 10 DD-LINE-4-NEW. DTSBD551 +00911 15 FILLER PIC X(43) VALUE DTSBD551 +00912 '// SPACE=(CYL,(5,5)),'. DTSBD551 +00913 15 FILLER PIC X(37) VALUE SPACES.DTSBD551 +00914 DTSBD551 +00915 10 DD-LINE-5-NEW. DTSBD551 +00916 15 FILLER PIC X(53) VALUE DTSBD551 +00917 '// DCB=(RECFM=FB,LRECL=275,BLKSIZE=27500)'. DTSBD551 +00918 15 FILLER PIC X(27) VALUE SPACES.DTSBD551 +00919 DTSBD551 +00920 05 W-INPUT-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00921 05 W-ALL-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00922 05 W-EMP-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00923 05 W-FAILED-FULL-EDITS-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00924 05 W-BYPASS-0-WAGE-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00925 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00926 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00927 05 W-ACCT-NOT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00928 05 W-ACCT-FROM-FEIN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00929 05 W-ACCT-FROM-SUCC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00930 05 W-ALL-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00931 05 W-WAGE-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00932 05 W-ZERO-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00933 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00934 05 W-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00935 05 W-T003-MNTE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00936 05 W-VALID-NEW-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00937 05 W-SI-WITH-REMIT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00938 05 W-INVALID-NEW-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00939 05 W-MISSING-SSN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD551 +00940 05 W-ALL-TOT-WAGE PIC S9(13)V99 COMP-3 VALUE +0. DTSBD551 +00941 DTSBD551 +00942 05 W-MONTH-1-CNT-X PIC X(07). DTSBD551 +00943 05 W-MONTH-1-CNT-9 REDEFINES W-MONTH-1-CNT-X PIC 9(07). DTSBD551 +00944 05 W-MONTH-2-CNT-X PIC X(07). DTSBD551 +00945 05 W-MONTH-2-CNT-9 REDEFINES W-MONTH-2-CNT-X PIC 9(07). DTSBD551 +00946 05 W-MONTH-3-CNT-X PIC X(07). DTSBD551 +00947 05 W-MONTH-3-CNT-9 REDEFINES W-MONTH-3-CNT-X PIC 9(07). DTSBD551 +00948 DTSBD551 +00949 01 MESSAGE-AREA. DTSBD551 +00950 *** FATAL ERRORS MSG-A DTSBD551 +00951 05 MSG-A1. DTSBD551 +00952 10 FILLER PIC X(32) DTSBD551 +00953 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBD551 +00954 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBD551 +00955 05 MSG-A2. DTSBD551 +00956 10 FILLER PIC X(20) DTSBD551 +00957 VALUE 'A-NON-NUMERIC FEIN: '. DTSBD551 +00958 10 MSG-A2-FEIN PIC X(09). DTSBD551 +00959 05 MSG-A3. DTSBD551 +00960 10 FILLER PIC X(37) DTSBD551 +00961 VALUE 'A-SUBMITTER NAME MISSING '. DTSBD551 +00962 05 MSG-A4. DTSBD551 +00963 10 FILLER PIC X(37) DTSBD551 +00964 VALUE 'A-SUBMITTER ADDRESS MISSING '. DTSBD551 +00965 05 MSG-A5. DTSBD551 +00966 10 FILLER PIC X(37) DTSBD551 +00967 VALUE 'A-SUBMITTER ZIP CODE MISSING '. DTSBD551 +00968 05 MSG-A6. DTSBD551 +00969 10 FILLER PIC X(37) DTSBD551 +00970 VALUE 'A-CONTACT NAME MISSING '. DTSBD551 +00971 05 MSG-A7. DTSBD551 +00972 10 FILLER PIC X(37) DTSBD551 +00973 VALUE 'A-CONTACT PHONE MISSING '. DTSBD551 +00974 05 MSG-A8. DTSBD551 +00975 10 FILLER PIC X(33) DTSBD551 +00976 VALUE 'A-NON-NUMERIC MEDIA CREATE DATE: '. DTSBD551 +00977 10 MSG-A8-MEDIA-DATE PIC X(08). DTSBD551 +00978 05 MSG-A9. DTSBD551 +00979 10 FILLER PIC X(29) DTSBD551 +00980 VALUE 'A-INVALID MEDIA CREATE DATE: '. DTSBD551 +00981 10 MSG-A9-MEDIA-DATE PIC X(08). DTSBD551 +00982 05 MSG-A10. DTSBD551 +00983 10 FILLER PIC X(29) DTSBD551 +00984 VALUE 'DUPLICATE SUBMISSION '. DTSBD551 +00985 10 MSG-A10-FEIN PIC 9(09). DTSBD551 +00986 05 MSG-A11. DTSBD551 +00987 10 FILLER PIC X(20) DTSBD551 +00988 VALUE 'INVALID LOG NUMBER: '. DTSBD551 +00989 10 MSG-A11-LOG-REMIT PIC X(25). DTSBD551 +00990 05 MSG-A12. DTSBD551 +00991 10 FILLER PIC X(20) DTSBD551 +00992 VALUE 'INVALID REMITTANCE: '. DTSBD551 +00993 10 MSG-A12-LOG-REMIT PIC X(25). DTSBD551 +00994 DTSBD551 +00995 *** NON-FATAL ERRORS MSG-E DTSBD551 +00996 05 MSG-E1. DTSBD551 +00997 10 FILLER PIC X(38) DTSBD551 +00998 VALUE 'ACCOUNT NUMBER NOT FOUND FROM FEIN: '. DTSBD551 +00999 10 MSG-E1-FEIN PIC X(09). DTSBD551 +01000 DTSBD551 +01001 05 MSG-E2. DTSBD551 +01002 10 FILLER PIC X(34) DTSBD551 +01003 VALUE 'ACCOUNT NUMBER NOT ON TAX FILE: '. DTSBD551 +01004 10 MSG-E2-BATCH PIC 9(05). DTSBD551 +01005 10 FILLER PIC X(01) DTSBD551 +01006 VALUE '/'. DTSBD551 +01007 10 MSG-E2-ITEM PIC 9(03). DTSBD551 +01008 05 MSG-E3. DTSBD551 +01009 10 FILLER PIC X(35) DTSBD551 +01010 VALUE 'NO UI RATE FOR QUARTER '. DTSBD551 +01011 DTSBD551 +01012 05 MSG-E4. DTSBD551 +01013 10 FILLER PIC X(23) DTSBD551 +01014 VALUE 'NOT LIABLE FOR QUARTER '. DTSBD551 +01015 10 MSG-E4-REPORT-CCYY PIC X(04). DTSBD551 +01016 10 FILLER PIC X(01) DTSBD551 +01017 VALUE '/'. DTSBD551 +01018 10 MSG-E4-REPORT-MM-X PIC X(02). DTSBD551 +01019 DTSBD551 +01020 05 MSG-E4A. DTSBD551 +01021 10 FILLER PIC X(29) DTSBD551 +01022 VALUE 'NOT LIABLE - PARTIAL TRANSFER'. DTSBD551 +01023 10 MSG-E4A-REPORT-CCYY PIC X(04). DTSBD551 +01024 10 FILLER PIC X(01) DTSBD551 +01025 VALUE '/'. DTSBD551 +01026 10 MSG-E4A-REPORT-MM-X PIC X(02). DTSBD551 +01027 DTSBD551 +01028 05 MSG-E5. DTSBD551 +01029 10 FILLER PIC X(32) DTSBD551 +01030 VALUE 'RPT ALREADY ON FILE FOR THE QTR '. DTSBD551 +01031 10 MSG-E5-ACCT-NO PIC 9(06). DTSBD551 +01032 10 FILLER PIC X(03) DTSBD551 +01033 VALUE ' - '. DTSBD551 +01034 10 MSG-E5-REPORT-CCYY PIC X(04). DTSBD551 +01035 10 FILLER PIC X(01) DTSBD551 +01036 VALUE '/'. DTSBD551 +01037 10 MSG-E5-REPORT-MM-X PIC X(02). DTSBD551 +01038 DTSBD551 +01039 05 MSG-E6. DTSBD551 +01040 10 FILLER PIC X(23) DTSBD551 +01041 VALUE 'INVALID ACCOUNT NUMBER '. DTSBD551 +01042 10 MSG-E6-ACCT-NO PIC X(15). DTSBD551 +01043 DTSBD551 +01044 05 MSG-E7. DTSBD551 +01045 10 FILLER PIC X(16) DTSBD551 +01046 VALUE 'FOUND ACCT NBR: '. DTSBD551 +01047 10 MSG-E7-ACCT-NO PIC X(06). DTSBD551 +01048 10 FILLER PIC X(12) DTSBD551 +01049 VALUE ' FROM FEIN: '. DTSBD551 +01050 10 MSG-E7-FEIN PIC X(09). DTSBD551 +01051 DTSBD551 +01052 05 MSG-E8. DTSBD551 +01053 10 FILLER PIC X(09) DTSBD551 +01054 VALUE 'ACCT NBR '. DTSBD551 +01055 10 MSG-E8-ACCT-NO PIC 9(06). DTSBD551 +01056 10 FILLER PIC X(29) DTSBD551 +01057 VALUE ' SUCCEEDED. USING SUCCESSOR: '. DTSBD551 +01058 10 MSG-E8-SUCCESSOR PIC 9(06). DTSBD551 +01059 DTSBD551 +01060 05 MSG-E9A. DTSBD551 +01061 10 FILLER PIC X(17) DTSBD551 +01062 VALUE 'NEW ADDRESS FOR: '. DTSBD551 +01063 10 MSG-E9A-ACCT-NO PIC 9(06). DTSBD551 +01064 10 FILLER PIC X(11) DTSBD551 +01065 VALUE ' IS INVALID'. DTSBD551 +01066 DTSBD551 +01067 05 MSG-E9B. DTSBD551 +01068 10 FILLER PIC X(17) DTSBD551 +01069 VALUE 'NEW ADDRESS FOR: '. DTSBD551 +01070 10 MSG-E9B-ACCT-NO PIC 9(06). DTSBD551 +01071 10 FILLER PIC X(09) DTSBD551 +01072 VALUE ' IS VALID'. DTSBD551 +01073 DTSBD551 +01074 05 MSG-E9C. DTSBD551 +01075 10 FILLER PIC X(27) DTSBD551 +01076 VALUE 'ZERO-WAGE REPORT IGNORED: '. DTSBD551 +01077 10 MSG-E9C-REASON PIC X(11). DTSBD551 +01078 10 MSG-E9C-ACCT-NO PIC 9(06). DTSBD551 +01079 DTSBD551 +01080 05 MSG-E9D. DTSBD551 +01081 10 FILLER PIC X(29) DTSBD551 +01082 VALUE 'TAX FEIN/REPORT FEIN DIFFER: '. DTSBD551 +01083 10 MSG-E9D-TAX-FEIN PIC 9(09). DTSBD551 +01084 10 FILLER PIC X(01) DTSBD551 +01085 VALUE '/'. DTSBD551 +01086 10 MSG-E9D-RPT-FEIN PIC 9(09). DTSBD551 +01087 DTSBD551 +01088 05 MSG-E9E. DTSBD551 +01089 10 FILLER PIC X(29) DTSBD551 +01090 VALUE 'QUARTER IS FILED ANNUALLY. '. DTSBD551 +01091 DTSBD551 +01092 *** FATAL ERRORS MSG-E DTSBD551 +01093 05 MSG-E10. DTSBD551 +01094 10 FILLER PIC X(32) DTSBD551 +01095 VALUE 'E-PREVIOUS REC TYPE NOT A OR T: '. DTSBD551 +01096 10 MSG-E10-REC-TYPE PIC X(01). DTSBD551 +01097 05 MSG-E11. DTSBD551 +01098 10 FILLER PIC X(20) DTSBD551 +01099 VALUE 'E-INVALID FEIN: '. DTSBD551 +01100 10 MSG-E11-FEIN PIC X(09). DTSBD551 +01101 05 MSG-E12. DTSBD551 +01102 10 FILLER PIC X(35) DTSBD551 +01103 VALUE 'E-EMPLOYER NAME MISSING '. DTSBD551 +01104 05 MSG-E13. DTSBD551 +01105 10 FILLER PIC X(35) DTSBD551 +01106 VALUE 'E-EMPLOYER ADDRESS MISSING '. DTSBD551 +01107 05 MSG-E14. DTSBD551 +01108 10 FILLER PIC X(35) DTSBD551 +01109 VALUE 'E-EMPLOYER ZIP CODE MISSING '. DTSBD551 +01110 05 MSG-E15. DTSBD551 +01111 10 FILLER PIC X(21) DTSBD551 +01112 VALUE 'E-STATE CODE NOT DC: '. DTSBD551 +01113 10 MSG-E15-STATE-CODE PIC X(02). DTSBD551 +01114 05 MSG-E16. DTSBD551 +01115 10 FILLER PIC X(26) DTSBD551 +01116 VALUE 'INVALID WORKER/WAGE CODE: '. DTSBD551 +01117 10 MSG-E16-WORKER-WAGE PIC X(01). DTSBD551 +01118 ** 05 MSG-E17. DTSBD551 +01119 * 10 FILLER PIC X(27) DTSBD551 +01120 * VALUE 'ACCT NBR EXCEEDS 6 DIGITS: '. DTSBD551 +01121 * 10 MSG-E17-ACCT-NO PIC X(15). DTSBD551 +01122 * 05 MSG-E18. DTSBD551 +01123 * 10 FILLER PIC X(35) DTSBD551 +01124 * VALUE 'ACCOUNT NUMBER MISSING '. DTSBD551 +01125 * 05 MSG-E19. DTSBD551 +01126 * 10 FILLER PIC X(22) DTSBD551 +01127 * VALUE 'ACCT NBR NOT NUMERIC: '. DTSBD551 +01128 ** 10 MSG-E19-ACCT-NO PIC X(15). DTSBD551 +01129 05 MSG-E20. DTSBD551 +01130 10 FILLER PIC X(24) DTSBD551 +01131 VALUE 'REPORT QTR NOT NUMERIC: '. DTSBD551 +01132 10 MSG-E20-REPORT-CCYY PIC X(04). DTSBD551 +01133 10 FILLER PIC X(01) DTSBD551 +01134 VALUE '/'. DTSBD551 +01135 10 MSG-E20-REPORT-MM-X PIC X(02). DTSBD551 +01136 05 MSG-E21. DTSBD551 +01137 10 FILLER PIC X(23) DTSBD551 +01138 * VALUE 'INVALID REPORT QTR: '. DTSBD551 +01139 VALUE 'INVALID REPORT PERIOD: '. DTSBD551 +01140 10 MSG-E21-REPORT-MM-9 PIC X(02). DTSBD551 +01141 05 MSG-E22. DTSBD551 +01142 10 FILLER PIC X(25) DTSBD551 +01143 VALUE 'INVALID REPORT YEAR-QTR: '. DTSBD551 +01144 10 MSG-E22-REPORT-CCYY PIC X(04). DTSBD551 +01145 10 FILLER PIC X(01). DTSBD551 +01146 10 MSG-E22-REPORT-MM-X PIC X(02). DTSBD551 +01147 05 MSG-E23. DTSBD551 +01148 10 FILLER PIC X(35) DTSBD551 +01149 VALUE 'REPORT QTR >= CURR QTR - REJECTED: '. DTSBD551 +01150 10 MSG-E23-RPT-QTR PIC X(05). DTSBD551 +01151 10 FILLER PIC X(01). DTSBD551 +01152 10 MSG-E23-CURR-QTR PIC X(05). DTSBD551 +01153 DTSBD551 +01154 *** FATAL ERRORS MSG-S DTSBD551 +01155 05 MSG-S1. DTSBD551 +01156 10 FILLER PIC X(20) DTSBD551 +01157 VALUE 'WAGES NOT EXPECTED: '. DTSBD551 +01158 10 MSG-S1-WAGES-EXP-IND PIC X(01). DTSBD551 +01159 05 MSG-S2. DTSBD551 +01160 10 FILLER PIC X(30) DTSBD551 +01161 VALUE 'PREVIOUS REC TYPE NOT E OR S: '. DTSBD551 +01162 10 MSG-S2-REC-TYPE PIC X(01). DTSBD551 +01163 05 MSG-S3. DTSBD551 +01164 10 FILLER PIC X(17) DTSBD551 +01165 VALUE 'NON-NUMERIC SSN: '. DTSBD551 +01166 10 MSG-S3-SSN PIC X(09). DTSBD551 +01167 05 MSG-S4. DTSBD551 +01168 10 FILLER PIC X(35) DTSBD551 +01169 VALUE 'EMPLOYEE NAME MISSING '. DTSBD551 +01170 05 MSG-S5. DTSBD551 +01171 10 FILLER PIC X(19) DTSBD551 +01172 VALUE 'STATE CODE NOT DC: '. DTSBD551 +01173 10 MSG-S5-STATE-CODE PIC X(02). DTSBD551 +01174 05 MSG-S6. DTSBD551 +01175 10 FILLER PIC X(32) DTSBD551 +01176 VALUE 'NON-NUM TOT WAGE, SSN & EMP-NO: '. DTSBD551 +01177 10 MSG-S6-SSN PIC X(09). DTSBD551 +01178 10 FILLER PIC X(01). DTSBD551 +01179 10 MSG-S6-EMP-NO PIC 9(06). DTSBD551 +01180 05 MSG-S7. DTSBD551 +01181 10 FILLER PIC X(32) DTSBD551 +01182 VALUE 'NON-NUM TAX WAGE, SSN & EMP-NO: '. DTSBD551 +01183 10 MSG-S7-SSN PIC X(09). DTSBD551 +01184 10 FILLER PIC X(01). DTSBD551 +01185 10 MSG-S7-EMP-NO PIC 9(06). DTSBD551 +01186 DTSBD551 +01187 *** NON-FATAL ERRORS MSG-S DTSBD551 +01188 05 MSG-S8. DTSBD551 +01189 10 FILLER PIC X(34) DTSBD551 +01190 VALUE 'SKIP ZERO WAGE REC, SSN & EMP-NO: '. DTSBD551 +01191 10 MSG-S8-SSN PIC X(09). DTSBD551 +01192 10 FILLER PIC X(01). DTSBD551 +01193 10 MSG-S8-EMP-NO PIC 9(06). DTSBD551 +01194 05 MSG-S9. DTSBD551 +01195 10 FILLER PIC X(37) DTSBD551 +01196 VALUE 'TYPE S INVALID, USING TYPE E EMP-NO: '. DTSBD551 +01197 10 MSG-S9-S-EMP-NO PIC 9(06). DTSBD551 +01198 10 FILLER PIC X(01). DTSBD551 +01199 10 MSG-S9-E-EMP-NO PIC 9(06). DTSBD551 +01200 05 MSG-S10. DTSBD551 +01201 10 FILLER PIC X(35) DTSBD551 +01202 VALUE 'TYPE S EMP-NO NOT = TYPE E EMP-NO: '. DTSBD551 +01203 10 MSG-S10-S-EMP-NO PIC 9(06). DTSBD551 +01204 10 FILLER PIC X(01). DTSBD551 +01205 10 MSG-S10-E-EMP-NO PIC 9(06). DTSBD551 +01206 05 MSG-S11. DTSBD551 +01207 10 FILLER PIC X(18) DTSBD551 +01208 VALUE 'MISSING SSN. EMP: '. DTSBD551 +01209 10 MSG-S11-EMP-NO PIC 9(06). DTSBD551 +01210 10 FILLER PIC X(06) DTSBD551 +01211 VALUE ' SSN: '. DTSBD551 +01212 10 MSG-S11-SSN PIC X(09). DTSBD551 +01213 05 MSG-S12. DTSBD551 +01214 10 FILLER PIC X(22) DTSBD551 +01215 VALUE 'NON-NUMERIC SSN. EMP: '. DTSBD551 +01216 10 MSG-S12-EMP-NO PIC 9(06). DTSBD551 +01217 10 FILLER PIC X(06) DTSBD551 +01218 VALUE ' SSN: '. DTSBD551 +01219 10 MSG-S12-SSN PIC X(09). DTSBD551 +01220 DTSBD551 +01221 *** FATAL ERRORS MSG-T DTSBD551 +01222 05 MSG-T1. DTSBD551 +01223 10 FILLER PIC X(25) DTSBD551 +01224 VALUE 'PREVIOUS REC NOT E OR S: '. DTSBD551 +01225 10 MSG-T1-REC-TYPE PIC X(01). DTSBD551 +01226 05 MSG-T2. DTSBD551 +01227 10 FILLER PIC X(27) DTSBD551 +01228 VALUE 'NON-NUMERIC TOTAL WORKERS: '. DTSBD551 +01229 10 MSG-T2-TOT-EMPLOYEE PIC X(09). DTSBD551 +01230 05 MSG-T3. DTSBD551 +01231 10 FILLER PIC X(31) DTSBD551 +01232 VALUE 'NON-NUMERIC TOT WAGES, EMP-NO: '. DTSBD551 +01233 10 MSG-T3-EMP-NO PIC 9(06). DTSBD551 +01234 05 MSG-T4. DTSBD551 +01235 10 FILLER PIC X(31) DTSBD551 +01236 VALUE 'NON-NUMERIC TAX WAGES, EMP-NO: '. DTSBD551 +01237 10 MSG-T4-EMP-NO PIC 9(06). DTSBD551 +01238 05 MSG-T5. DTSBD551 +01239 10 FILLER PIC X(35) DTSBD551 +01240 VALUE 'NON-NUMERIC TAX RATE - IGNORED '. DTSBD551 +01241 05 MSG-T6. DTSBD551 +01242 10 FILLER PIC X(35) DTSBD551 +01243 VALUE 'TAX RATE IGNORED - SELF-INSRED '. DTSBD551 +01244 05 MSG-T7. DTSBD551 +01245 10 FILLER PIC X(35) DTSBD551 +01246 VALUE 'INVALID RATE IGNORED '. DTSBD551 +01247 05 MSG-T8. DTSBD551 +01248 10 FILLER PIC X(35) DTSBD551 +01249 VALUE 'NON-NUMERIC TAX DUE '. DTSBD551 +01250 05 MSG-T9. DTSBD551 +01251 10 FILLER PIC X(21) DTSBD551 +01252 VALUE 'NON-NUMERIC MONTH 1: '. DTSBD551 +01253 10 MSG-T9-NON-NUM-MONTH1 PIC X(07). DTSBD551 +01254 05 MSG-T10. DTSBD551 +01255 10 FILLER PIC X(21) DTSBD551 +01256 VALUE 'NON-NUMERIC MONTH 2: '. DTSBD551 +01257 10 MSG-T10-NON-NUM-MONTH2 PIC X(07). DTSBD551 +01258 05 MSG-T11. DTSBD551 +01259 10 FILLER PIC X(21) DTSBD551 +01260 VALUE 'NON-NUMERIC MONTH 3: '. DTSBD551 +01261 10 MSG-T11-NON-NUM-MONTH3 PIC X(07). DTSBD551 +01262 05 MSG-T12. DTSBD551 +01263 10 FILLER PIC X(27) DTSBD551 +01264 VALUE 'TOT WAGE NOT = TYPE S SUM: '. DTSBD551 +01265 10 MSG-T12-TOT-WAGES PIC Z(07)9.99. DTSBD551 +01266 10 FILLER PIC X(01). DTSBD551 +01267 10 MSG-T12-S-SUM PIC Z(07)9.99. DTSBD551 +01268 05 MSG-T13. DTSBD551 +01269 10 FILLER PIC X(27) DTSBD551 +01270 VALUE 'TAX WAGE NOT = TYPE S SUM: '. DTSBD551 +01271 10 MSG-T13-TAX-WAGES PIC Z(07)9.99. DTSBD551 +01272 10 FILLER PIC X(01). DTSBD551 +01273 10 MSG-T13-S-SUM PIC Z(07)9.99. DTSBD551 +01274 05 MSG-T14. DTSBD551 +01275 10 FILLER PIC X(25) DTSBD551 +01276 VALUE 'TAX WAGES > TOTAL WAGES: '. DTSBD551 +01277 10 MSG-T14-TAX-WAGES PIC Z(07)9.99. DTSBD551 +01278 10 FILLER PIC X(02). DTSBD551 +01279 10 MSG-T14-TOT-WAGES PIC Z(07)9.99. DTSBD551 +01280 05 MSG-T15. DTSBD551 +01281 10 FILLER PIC X(34) DTSBD551 +01282 VALUE 'WORKERS T CNT & S SUM CNT NOT = : '. DTSBD551 +01283 10 MSG-T15-T-COUNT PIC Z(06)9. DTSBD551 +01284 10 FILLER PIC X(01). DTSBD551 +01285 10 MSG-T15-S-COUNT PIC Z(06)9. DTSBD551 +01286 05 MSG-T16. DTSBD551 +01287 10 FILLER PIC X(24) DTSBD551 +01288 VALUE 'CHECK FOR SELF-INS EMP: '. DTSBD551 +01289 10 MSG-T16-EMP-NO PIC 9(06). DTSBD551 +01290 10 FILLER PIC X(07) DTSBD551 +01291 VALUE ' AMT = '. DTSBD551 +01292 10 MSG-T16-REMIT PIC Z(09).99. DTSBD551 +01293 05 MSG-T17. DTSBD551 +01294 10 FILLER PIC X(33) DTSBD551 +01295 VALUE 'DUPLICATE ZERO WAGE RPT DELETED: '. DTSBD551 +01296 10 MSG-T17-EMP-NO PIC 9(06). DTSBD551 +01297 DTSBD551 +01298 *** FATAL ERRORS MSG-F DTSBD551 +01299 05 MSG-F1. DTSBD551 +01300 10 FILLER PIC X(20) DTSBD551 +01301 VALUE 'PREVIOUS REC NOT T: '. DTSBD551 +01302 10 MSG-F1-REC-TYPE PIC X(01). DTSBD551 +01303 05 MSG-F2. DTSBD551 +01304 10 FILLER PIC X(29) DTSBD551 +01305 VALUE 'NON-NUMERIC TOTAL WORKERS: '. DTSBD551 +01306 10 MSG-F2-TOT-EMPLOYEE PIC X(10). DTSBD551 +01307 05 MSG-F3. DTSBD551 +01308 10 FILLER PIC X(29) DTSBD551 +01309 VALUE 'NON-NUMERIC TOTAL EMPLOYERS: '. DTSBD551 +01310 10 MSG-F3-TOT-EMPLOYER PIC X(10). DTSBD551 +01311 05 MSG-F4. DTSBD551 +01312 10 FILLER PIC X(25) DTSBD551 +01313 VALUE 'NON-NUMERIC TOTAL WAGES '. DTSBD551 +01314 05 MSG-F5. DTSBD551 +01315 10 FILLER PIC X(32) DTSBD551 +01316 VALUE 'TYPE F NOT = ACTUAL WORKER CNT: '. DTSBD551 +01317 10 MSG-F5-TOT-WORKERS PIC Z(07)9. DTSBD551 +01318 10 FILLER PIC X(02). DTSBD551 +01319 10 MSG-F5-ALL-WAGE-CNT PIC Z(07)9. DTSBD551 +01320 05 MSG-F6. DTSBD551 +01321 10 FILLER PIC X(32) DTSBD551 +01322 VALUE 'TYPE F NOT = ACTUAL EMPL CNT: '. DTSBD551 +01323 10 MSG-F6-TOT-EMPLOYER PIC Z(07)9. DTSBD551 +01324 10 FILLER PIC X(02). DTSBD551 +01325 10 MSG-F6-ALL-EMPL-CNT PIC Z(07)9. DTSBD551 +01326 05 MSG-F7. DTSBD551 +01327 10 FILLER PIC X(21) DTSBD551 +01328 VALUE 'INVALID TOTAL WAGES: '. DTSBD551 +01329 10 MSG-F7-TOT-WAGE PIC Z(10)9.99. DTSBD551 +01330 10 FILLER PIC X(01). DTSBD551 +01331 10 MSG-F7-ALL-TOT-WAGE PIC Z(10)9.99. DTSBD551 +01332 05 MSG-F8. DTSBD551 +01333 10 FILLER PIC X(28) DTSBD551 +01334 VALUE 'CALC REMIT NOT = PARM REMIT '. DTSBD551 +01335 10 MSG-F8-CALC-REMIT PIC Z(09).99. DTSBD551 +01336 10 FILLER PIC X(01) DTSBD551 +01337 VALUE '/'. DTSBD551 +01338 10 MSG-F8-PARM-REMIT PIC Z(09).99. DTSBD551 +01339 05 MSG-F9. DTSBD551 +01340 10 FILLER PIC X(32) DTSBD551 +01341 VALUE 'INCOMPLETE FILE: LAST REC NOT F '. DTSBD551 +01342 DTSBD551 +01343 ++INCLUDE EWGREC1 DTSBD551 +01344 DTSBD551 +01345 ++INCLUDE EWGRECA DTSBD551 +01346 DTSBD551 +01347 ++INCLUDE EWGRECB DTSBD551 +01348 DTSBD551 +01349 ++INCLUDE EWGRECE DTSBD551 +01350 DTSBD551 +01351 ++INCLUDE EWGRECF DTSBD551 +01352 DTSBD551 +01353 ++INCLUDE EWGRECS DTSBD551 +01354 DTSBD551 +01355 ++INCLUDE EWGRECT DTSBD551 +01356 DTSBD551 +01357 01 T028-REC. DTSBD551 +01358 ++INCLUDE DTSIT028 DTSBD551 +01359 DTSBD551 +01360 01 T002-REC. DTSBD551 +01361 ++INCLUDE DTSIT002 DTSBD551 +01362 DTSBD551 +01363 01 T003-REC. DTSBD551 +01364 ++INCLUDE DTSIT003 DTSBD551 +01365 DTSBD551 +01366 01 W001-REC. DTSBD551 +01367 ++INCLUDE DTSIW001 DTSBD551 +01368 DTSBD551 +01369 01 W-SUBMITTER-REC. DTSBD551 +01370 ++INCLUDE DTSIX210 DTSBD551 +01371 DTSBD551 +01372 01 W-EMP-RPT-REC. DTSBD551 +01373 ++INCLUDE DTSIX212 DTSBD551 +01374 DTSBD551 +01375 01 W-MESSAGE-REC. DTSBD551 +01376 ++INCLUDE DTSIX216 DTSBD551 +01377 DTSBD551 +01378 01 L001-LINK-AREA. DTSBD551 +01379 ++INCLUDE DTSIL001 DTSBD551 +01380 DTSBD551 +01381 01 L003-LINK-AREA. DTSBD551 +01382 ++INCLUDE DTSIL003 DTSBD551 +01383 DTSBD551 +01384 01 L004-LINK-AREA. DTSBD551 +01385 ++INCLUDE DTSIL004 DTSBD551 +01386 DTSBD551 +01387 01 L072-LINK-AREA. DTSBD551 +01388 ++INCLUDE DTSIL072 DTSBD551 +01389 DTSBD551 +01390 01 L205-LINK-AREA. DTSBD551 +01391 ++INCLUDE DTSIL205 DTSBD551 +01392 DTSBD551 +01393 01 L005-LINK-AREA. DTSBD551 +01394 ++INCLUDE DTSIL005 DTSBD551 +01395 DTSBD551 +01396 01 L516-LINK-AREA. DTSBD551 +01397 ++INCLUDE DTSIL516 DTSBD551 +01398 DTSBD551 +01399 01 L601-LINK-AREA. DTSBD551 +01400 ++INCLUDE DTSIL601 DTSBD551 +01401 DTSBD551 +01402 01 L910-LINK-AREA. DTSBD551 +01403 ++INCLUDE DTSIL910 DTSBD551 +01404 01 MSKL-REC. DTSBD551 +01405 ++INCLUDE DTSIMSKL DTSBD551 +01406 DTSBD551 +01407 01 MHDR-REC. DTSBD551 +01408 ++INCLUDE DTSIMHDR DTSBD551 +01409 DTSBD551 +01410 01 MPRF-REC. DTSBD551 +01411 ++INCLUDE DTSIMPRF DTSBD551 +01412 DTSBD551 +01413 01 MSOL-REC. DTSBD551 +01414 ++INCLUDE DTSIMSOL DTSBD551 +01415 DTSBD551 +01416 01 MQTR-REC. DTSBD551 +01417 ++INCLUDE DTSIMQTR DTSBD551 +01418 DTSBD551 +01419 01 MOPO-REC. DTSBD551 +01420 ++INCLUDE DTSIMOPO DTSBD551 +01421 DTSBD551 +01422 01 MTAD-REC. DTSBD551 +01423 ++INCLUDE DTSIMTAD DTSBD551 +01424 DTSBD551 +01425 01 MNTE-REC. DTSBD551 +01426 ++INCLUDE DTSIMNTE DTSBD551 +01427 DTSBD551 +01428 01 L921-LINK-AREA. DTSBD551 +01429 ++INCLUDE DTSIL921 DTSBD551 +01430 SKIP3 DTSBD551 +01431 01 ISKL-REC. DTSBD551 +01432 ++INCLUDE DTSIISKL DTSBD551 +01433 SKIP3 DTSBD551 +01434 01 IEIN-REC. DTSBD551 +01435 ++INCLUDE DTSIIEIN DTSBD551 +01436 DTSBD551 +01437 01 L927-LINK-AREA. DTSBD551 +01438 ++INCLUDE DTSIL927 DTSBD551 +01439 DTSBD551 +01440 01 L931-LINK-AREA. DTSBD551 +01441 ++INCLUDE DTSIL931 DTSBD551 +01442 DTSBD551 +01443 01 FSKL-REC. DTSBD551 +01444 ++INCLUDE DTSIFSKL DTSBD551 +01445 DTSBD551 +01446 01 TSKL-REC. DTSBD551 +01447 ++INCLUDE DTSITSKL DTSBD551 +01448 DTSBD551 +01449 01 RSKL-REC. DTSBD551 +01450 ++INCLUDE DTSIRSK1 DTSBD551 +01451 EJECT DTSBD551 +01452 01 R551-REC. DTSBD551 +01453 ++INCLUDE DTSIR551 DTSBD551 +01454 DTSBD551 +01455 01 R202-REC. DTSBD551 +01456 ++INCLUDE DTSIR202 DTSBD551 +01457 DTSBD551 +01458 01 IY120-REC. DTSBD551 +01459 ++INCLUDE DTSIY120 DTSBD551 +01460 DTSBD551 +01461 *01 C202-MSG-TABLE. DTSBD551 +01462 ***INCLUDE DTSIC202 DTSBD551 +01463 DTSBD551 +01464 01 WORK-PARM-AREA. DTSBD551 +01465 DTSBD551 +01466 05 WORK-PARM-DATA. DTSBD551 +01467 10 WORK-PARM-TOT-REMITTANCE PIC 9(11)V99. DTSBD551 +01468 10 FILLER PIC X(01). DTSBD551 +01469 10 WORK-PARM-LOG-NO PIC 9(06). DTSBD551 +01470 10 FILLER PIC X(01). DTSBD551 +01471 10 WORK-PARM-RUN-TYPE PIC X(01). DTSBD551 +01472 88 WORK-PARM-RUN-TYPE-RECENT-88 VALUE '0'. DTSBD551 +01473 88 WORK-PARM-RUN-TYPE-ANY-88 VALUE '1'. DTSBD551 +01474 10 FILLER PIC X(01). DTSBD551 +01475 10 WORK-PARM-TIMELY-IND PIC X(01). DTSBD551 +01476 88 WORK-PARM-TIMELY-YES-88 VALUE 'Y'. DTSBD551 +01477 88 WORK-PARM-TIMELY-NO-88 VALUE 'N'. DTSBD551 +01478 10 FILLER PIC X(01). DTSBD551 +01479 10 WORK-PARM-RECEIVED-DATE PIC X(08). DTSBD551 +01480 10 FILLER PIC X(01). DTSBD551 +01481 10 WORK-PARM-BYPASS-ERR-IND PIC X(01). DTSBD551 +01482 88 WORK-PARM-BYPASS-ERR-YES-88 VALUE 'Y'. DTSBD551 +01483 88 WORK-PARM-BYPASS-ERR-NO-88 VALUE 'N'. DTSBD551 +01484 10 FILLER PIC X(01). DTSBD551 +01485 LINKAGE SECTION. DTSBD551 +01486 SKIP3 DTSBD551 +01487 01 PARM-AREA. DTSBD551 +01488 05 PARM-LENGTH PIC S9(04) COMP. DTSBD551 +01489 DTSBD551 +01490 05 PARM-DATA. DTSBD551 +01491 10 PARM-ALLOW-DUP-IND PIC X(01). DTSBD551 +01492 88 PARM-ALLOW-DUP-YES-88 VALUE 'Y'. DTSBD551 +01493 88 PARM-ALLOW-DUP-NO-88 VALUE 'N'. DTSBD551 +01494 DTSBD551 +01495 PROCEDURE DIVISION USING PARM-AREA. DTSBD551 +01496 DTSBD551 +01497 DTSBD551-MAIN. DTSBD551 +01498 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD551 +01499 IF W-ERROR-YES-88 DTSBD551 +01500 MOVE +4 TO RETURN-CODE DTSBD551 +01501 GO TO DTSBD551-MAIN-EXIT. DTSBD551 +01502 DTSBD551 +01503 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD551 +01504 DTSBD551 +01505 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD551 +01506 DTSBD551 +01507 IF W-FATAL-ERROR-YES-88 DTSBD551 +01508 MOVE 4 TO RETURN-CODE DTSBD551 +01509 DISPLAY '!! FATAL ERROR ON END OF SUBMISSION !!' DTSBD551 +01510 DISPLAY ' SUBMISSION REJECTED' DTSBD551 +01511 DISPLAY ' RETURN-CODE = ' RETURN-CODE DTSBD551 +01512 DISPLAY SPACE. DTSBD551 +01513 DTSBD551 +01514 DTSBD551-MAIN-EXIT. DTSBD551 +01515 GOBACK. DTSBD551 +01516 EJECT DTSBD551 +01517 I0000-INITIATE. DTSBD551 +01518 SET W-ERROR-NO-88 TO TRUE. DTSBD551 +01519 DTSBD551 +01520 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBD551 +01521 IF W-ERROR-YES-88 DTSBD551 +01522 GO TO I0000-EXIT. DTSBD551 +01523 DTSBD551 +01524 PERFORM I3000-READ-HDR THRU I3000-EXIT DTSBD551 +01525 IF W-ERROR-YES-88 DTSBD551 +01526 GO TO I0000-EXIT DTSBD551 +01527 END-IF. DTSBD551 +01528 DTSBD551 +01529 PERFORM I0999-READ-WEB-HDR THRU I0999-EXIT DTSBD551 +01530 IF W-ERROR-YES-88 DTSBD551 +01531 GO TO I0000-EXIT DTSBD551 +01532 END-IF. DTSBD551 +01533 DTSBD551 +01534 PERFORM I1000-EDIT-PARM THRU I1000-EXIT. DTSBD551 +01535 IF W-ERROR-YES-88 DTSBD551 +01536 GO TO I0000-EXIT DTSBD551 +01537 ELSE DTSBD551 +01538 PERFORM I3100-SYS-DATE THRU I3100-EXIT DTSBD551 +01539 PERFORM I4000-READ-FIRST THRU I4000-EXIT DTSBD551 +01540 IF W-ERROR-YES-88 DTSBD551 +01541 GO TO I0000-EXIT DTSBD551 +01542 ELSE DTSBD551 +01543 PERFORM I4100-SUBMITTERS THRU I4100-EXIT DTSBD551 +01544 END-IF DTSBD551 +01545 END-IF. DTSBD551 +01546 DTSBD551 +01547 *& PERFORM DTSBD551 +01548 * VARYING ZW-SUB FROM +1 BY +1 DTSBD551 +01549 * UNTIL ZW-SUB > ZW-MAX DTSBD551 +01550 * SET ZW-ZERO-WAGE-YES-88 (ZW-SUB) TO TRUE DTSBD551 +01551 *& END-PERFORM. DTSBD551 +01552 DTSBD551 +01553 IF W-ERROR-YES-88 DTSBD551 +01554 DISPLAY SPACE DTSBD551 +01555 DISPLAY '*** DTSBD551 FAILED WITH FATAL ERROR ***' DTSBD551 +01556 END-IF. DTSBD551 +01557 DTSBD551 +01558 I0000-EXIT. DTSBD551 +01559 EXIT. DTSBD551 +01560 DTSBD551 +01561 I0999-READ-WEB-HDR. DTSBD551 +01562 OPEN INPUT ICESA-FILE. DTSBD551 +01563 IF ICESA-STATUS-OK-88 DTSBD551 +01564 NEXT SENTENCE DTSBD551 +01565 ELSE DTSBD551 +01566 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01567 DISPLAY 'ICESA FILE EMPTY: ' ICESA-STATUS DTSBD551 +01568 GO TO I4000-EXIT DTSBD551 +01569 END-IF. DTSBD551 +01570 DTSBD551 +01571 READ ICESA-FILE. DTSBD551 +01572 IF ICESA-STATUS-OK-88 DTSBD551 +01573 NEXT SENTENCE DTSBD551 +01574 ELSE DTSBD551 +01575 DISPLAY 'BAD FIRST READ ' ICESA-STATUS DTSBD551 +01576 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01577 GO TO I4000-EXIT DTSBD551 +01578 END-IF. DTSBD551 +01579 DTSBD551 +01580 IF ICESA-REC-TYPE-1-88 DTSBD551 +01581 MOVE ICESA-REC TO WAGE-RECORD-1 DTSBD551 +01582 ELSE DTSBD551 +01583 DISPLAY 'ZIRST RECORD NOT TYPE 1: ' ICESA-REC-TYPE DTSBD551 +01584 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01585 GO TO I4000-EXIT DTSBD551 +01586 END-IF. DTSBD551 +01587 DTSBD551 +01588 PERFORM P1111-LOG-RCV-REMIT THRU P1111-EXIT. DTSBD551 +01589 SET WORK-PARM-RUN-TYPE-ANY-88 TO TRUE DTSBD551 +01590 SET WORK-PARM-BYPASS-ERR-NO-88 TO TRUE DTSBD551 +01591 SET WORK-PARM-TIMELY-YES-88 TO TRUE. DTSBD551 +01592 DTSBD551 +01593 I0999-EXIT. DTSBD551 +01594 EXIT. DTSBD551 +01595 DTSBD551 +01596 I1000-EDIT-PARM. DTSBD551 +01597 PERFORM I1100-RUN-TYPE THRU I1100-EXIT. DTSBD551 +01598 PERFORM I1200-REMITTANCE THRU I1200-EXIT. DTSBD551 +01599 PERFORM I1300-LOG-NO THRU I1300-EXIT. DTSBD551 +01600 PERFORM I1400-TIMELY-IND THRU I1400-EXIT. DTSBD551 +01601 * PERFORM I1500-RCVD-DATE THRU I1500-EXIT. DTSBD551 +01602 PERFORM I1600-BYPASS-ERR THRU I1600-EXIT. DTSBD551 +01603 PERFORM I1700-ALLOW-DUP THRU I1700-EXIT. DTSBD551 +01604 DTSBD551 +01605 I1000-EXIT. DTSBD551 +01606 EXIT. DTSBD551 +01607 DTSBD551 +01608 I1100-RUN-TYPE. DTSBD551 +01609 IF WORK-PARM-RUN-TYPE-ANY-88 DTSBD551 +01610 OR WORK-PARM-RUN-TYPE-RECENT-88 DTSBD551 +01611 NEXT SENTENCE DTSBD551 +01612 ELSE DTSBD551 +01613 DISPLAY 'INVALID PARM ' WORK-PARM-RUN-TYPE DTSBD551 +01614 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01615 END-IF. DTSBD551 +01616 I1100-EXIT. DTSBD551 +01617 EXIT. DTSBD551 +01618 DTSBD551 +01619 I1200-REMITTANCE. DTSBD551 +01620 DISPLAY 'I12 PARM REMIT ' WORK-PARM-TOT-REMITTANCE. DTSBD551 +01621 * IF WORK-PARM-TOT-REMITTANCE = ZEROS DTSBD551 +01622 * DISPLAY 'REMITTANCE AMOUNT REQUIRED ' DTSBD551 +01623 * SET W-ERROR-YES-88 TO TRUE DTSBD551 +01624 * ELSE DTSBD551 +01625 IF WORK-PARM-TOT-REMITTANCE NOT NUMERIC DTSBD551 +01626 DISPLAY 'REMITTANCE AMOUNT IS NOT NUMERIC ' DTSBD551 +01627 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01628 * ELSE DTSBD551 +01629 * MOVE WORK-PARM-TOT-REMITTANCE TO W-PARM-REMIT-9 DTSBD551 +01630 * MOVE W-PARM-REMIT-DECIMAL TO W-PARM-DEPOSIT-REMIT DTSBD551 +01631 * DISPLAY ' I121 REMIT ' W-PARM-DEPOSIT-REMIT DTSBD551 +01632 END-IF. DTSBD551 +01633 DTSBD551 +01634 I1200-EXIT. DTSBD551 +01635 EXIT. DTSBD551 +01636 DTSBD551 +01637 I1300-LOG-NO. DTSBD551 +01638 IF WORK-PARM-LOG-NO NOT NUMERIC DTSBD551 +01639 DISPLAY 'LOG NUMBER REQUIRED ' DTSBD551 +01640 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01641 ELSE DTSBD551 +01642 MOVE WORK-PARM-LOG-NO TO W-PARM-LOG-NO DTSBD551 +01643 END-IF. DTSBD551 +01644 DTSBD551 +01645 I1300-EXIT. DTSBD551 +01646 EXIT. DTSBD551 +01647 DTSBD551 +01648 I1400-TIMELY-IND. DTSBD551 +01649 IF WORK-PARM-TIMELY-YES-88 DTSBD551 +01650 OR WORK-PARM-TIMELY-NO-88 DTSBD551 +01651 MOVE WORK-PARM-TIMELY-IND TO W-PARM-TIMELY-IND DTSBD551 +01652 ELSE DTSBD551 +01653 DISPLAY 'INVALID TIMELY IND: ' WORK-PARM-TIMELY-IND DTSBD551 +01654 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01655 END-IF. DTSBD551 +01656 DTSBD551 +01657 I1400-EXIT. DTSBD551 +01658 EXIT. DTSBD551 +01659 DTSBD551 +01660 I1500-RCVD-DATE. DTSBD551 +01661 IF WORK-PARM-TIMELY-NO-88 DTSBD551 +01662 MOVE WORK-PARM-RECEIVED-DATE TO L001-CAL-6-DATE-X DTSBD551 +01663 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBD551 +01664 IF L001-VALID-DATE DTSBD551 +01665 MOVE L001-FED-8-DATE-9 TO W-PARM-RECEIVED-DATE DTSBD551 +01666 ELSE DTSBD551 +01667 DISPLAY 'INVALID PARM RECEIVED DATE ' DTSBD551 +01668 WORK-PARM-RECEIVED-DATE DTSBD551 +01669 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01670 END-IF DTSBD551 +01671 ELSE DTSBD551 +01672 MOVE ZEROS TO W-PARM-RECEIVED-DATE DTSBD551 +01673 END-IF. DTSBD551 +01674 DTSBD551 +01675 I1500-EXIT. DTSBD551 +01676 EXIT. DTSBD551 +01677 DTSBD551 +01678 I1600-BYPASS-ERR. DTSBD551 +01679 IF WORK-PARM-BYPASS-ERR-YES-88 DTSBD551 +01680 OR WORK-PARM-BYPASS-ERR-NO-88 DTSBD551 +01681 MOVE WORK-PARM-BYPASS-ERR-IND TO W-PARM-BYPASS-ERR-IND DTSBD551 +01682 ELSE DTSBD551 +01683 DISPLAY 'INVALID BYPASS ERROR IND: ' DTSBD551 +01684 WORK-PARM-BYPASS-ERR-IND DTSBD551 +01685 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01686 END-IF. DTSBD551 +01687 DTSBD551 +01688 DISPLAY 'I1600 ' W-PARM-BYPASS-ERR-IND. DTSBD551 +01689 I1600-EXIT. DTSBD551 +01690 EXIT. DTSBD551 +01691 DTSBD551 +01692 I1700-ALLOW-DUP. DTSBD551 +01693 IF PARM-ALLOW-DUP-YES-88 DTSBD551 +01694 OR PARM-ALLOW-DUP-NO-88 DTSBD551 +01695 MOVE PARM-ALLOW-DUP-IND TO W-PARM-ALLOW-DUP-IND DTSBD551 +01696 ELSE DTSBD551 +01697 DISPLAY 'INVALID ALLOW DUP IND: ' DTSBD551 +01698 PARM-ALLOW-DUP-IND DTSBD551 +01699 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01700 END-IF. DTSBD551 +01701 DTSBD551 +01702 DISPLAY 'I1700 ' W-PARM-ALLOW-DUP-IND. DTSBD551 +01703 I1700-EXIT. DTSBD551 +01704 EXIT. DTSBD551 +01705 DTSBD551 +01706 I2000-OPEN-FILES. DTSBD551 +01707 OPEN I-O CURR-BATCH-NO. DTSBD551 +01708 IF BATCH-STATUS-OK-88 DTSBD551 +01709 READ CURR-BATCH-NO DTSBD551 +01710 IF BATCH-STATUS-OK-88 DTSBD551 +01711 MOVE CURRENT-ARCHIVE-YEAR TO W-ARCHIVE-CURR-YEAR DTSBD551 +01712 MOVE FIRST-ARCHIVE-YEAR TO W-ARCHIVE-FIRST-YEAR DTSBD551 +01713 COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBD551 +01714 MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBD551 +01715 MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBD551 +01716 DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBD551 +01717 DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBD551 +01718 DISPLAY 'CURRENT YEAR ' W-ARCHIVE-CURR-YEAR DTSBD551 +01719 DISPLAY 'FIRST YEAR ' W-ARCHIVE-FIRST-YEAR DTSBD551 +01720 ELSE DTSBD551 +01721 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01722 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBD551 +01723 BATCH-STATUS DTSBD551 +01724 GO TO I2000-EXIT DTSBD551 +01725 END-IF DTSBD551 +01726 ELSE DTSBD551 +01727 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01728 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBD551 +01729 BATCH-STATUS DTSBD551 +01730 GO TO I2000-EXIT DTSBD551 +01731 END-IF. DTSBD551 +01732 DTSBD551 +01733 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD551 +01734 DTSBD551 +01735 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD551 +01736 DTSBD551 +01737 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD551 +01738 DTSBD551 +01739 PERFORM S1500-OPEN-WAGE-OUT THRU S1500-EXIT. DTSBD551 +01740 IF W-ERROR-YES-88 DTSBD551 +01741 GO TO I2000-EXIT DTSBD551 +01742 END-IF. DTSBD551 +01743 DTSBD551 +01744 OPEN OUTPUT SUBMITTER-FILE. DTSBD551 +01745 IF SUBMITTER-STATUS-OK-88 DTSBD551 +01746 NEXT SENTENCE DTSBD551 +01747 ELSE DTSBD551 +01748 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01749 DISPLAY 'CANNOT OPEN SUBMITTER FILE ' SUBMITTER-STATUS DTSBD551 +01750 GO TO I2000-EXIT DTSBD551 +01751 END-IF. DTSBD551 +01752 DTSBD551 +01753 OPEN OUTPUT EMP-RPT-FILE. DTSBD551 +01754 IF EMP-RPT-STATUS-OK-88 DTSBD551 +01755 NEXT SENTENCE DTSBD551 +01756 ELSE DTSBD551 +01757 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01758 DISPLAY 'CANNOT OPEN EMP-RPT FILE ' EMP-RPT-STATUS DTSBD551 +01759 GO TO I2000-EXIT DTSBD551 +01760 END-IF. DTSBD551 +01761 DTSBD551 +01762 OPEN OUTPUT MESSAGE-FILE. DTSBD551 +01763 IF MSG-STATUS-OK-88 DTSBD551 +01764 NEXT SENTENCE DTSBD551 +01765 ELSE DTSBD551 +01766 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01767 DISPLAY 'CANNOT OPEN MESSAGE FILE ' MSG-STATUS DTSBD551 +01768 GO TO I2000-EXIT DTSBD551 +01769 END-IF. DTSBD551 +01770 DTSBD551 +01771 MOVE 'N' TO L927-TRACE-IND. DTSBD551 +01772 MOVE W-MOD-NAME TO L927-MOD-NAME. DTSBD551 +01773 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBD551 +01774 DTSBD551 +01775 *** INITALIZE REPORT RECORD DTSBD551 +01776 MOVE LENGTH OF R551-REC TO R551-LENGTH. DTSBD551 +01777 MOVE '551' TO R551-REC-TYPE. DTSBD551 +01778 DTSBD551 +01779 MOVE LENGTH OF R202-REC TO R202-LENGTH. DTSBD551 +01780 MOVE '202' TO R202-REC-TYPE. DTSBD551 +01781 *** DTSBD551 +01782 I2000-EXIT. DTSBD551 +01783 EXIT. DTSBD551 +01784 DTSBD551 +01785 *I2500-INIT-LOG. DTSBD551 +01786 * DISPLAY 'PARM LOG NO ' PARM-LOG-NO. DTSBD551 +01787 * IF PARM-LOG-NO NOT NUMERIC DTSBD551 +01788 * DISPLAY 'LOG NUMBER REQUIRED ' DTSBD551 +01789 * SET W-ERROR-YES-88 TO TRUE DTSBD551 +01790 * ELSE DTSBD551 +01791 * MOVE PARM-LOG-NO TO W-PARM-LOG-NO DTSBD551 +01792 * SET L200-CMD-INIT-88 TO TRUE DTSBD551 +01793 * MOVE W-PARM-LOG-NO TO L200-LOG-NO-SFX DTSBD551 +01794 * MOVE W-MOD-NAME TO L200-PROG-NAME DTSBD551 +01795 * PERFORM S200-INIT-LOG THRU S200-EXIT DTSBD551 +01796 * MOVE L200-LOG-NO TO W-LOG-NO DTSBD551 +01797 * DISPLAY 'PARM-LOG-NO = ' W-LOG-NO DTSBD551 +01798 * END-IF. DTSBD551 +01799 * DTSBD551 +01800 *I2500-EXIT. DTSBD551 +01801 * EXIT. DTSBD551 +01802 DTSBD551 +01803 I3000-READ-HDR. DTSBD551 +01804 MOVE LOW-VALUES TO MSKL-REC. DTSBD551 +01805 MOVE +0 TO MSKL-EMP-NO. DTSBD551 +01806 SET MSKL-HDR-88 TO TRUE. DTSBD551 +01807 DTSBD551 +01808 PERFORM S910-READ THRU S910-EXIT. DTSBD551 +01809 IF L910-NO-REC-88 DTSBD551 +01810 DISPLAY 'DTSBD551: MHDR RECORD IS MISSING' DTSBD551 +01811 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01812 GO TO I3000-EXIT DTSBD551 +01813 ELSE DTSBD551 +01814 MOVE MSKL-REC TO MHDR-REC DTSBD551 +01815 END-IF. DTSBD551 +01816 DTSBD551 +01817 ** MOVE MHDR-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBD551 +01818 ** MOVE L001-FED-8-YR TO W-LOG-YEAR. DTSBD551 +01819 ** DISPLAY 'LOG NUMBER: ' W-LOG-NO. DTSBD551 +01820 DTSBD551 +01821 MOVE MHDR-CURR-RUN-DATE TO L004-DATE DTSBD551 +01822 W-CURR-DATE. DTSBD551 +01823 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBD551 +01824 MOVE L004-QTR-5-9 TO W-CURR-QTR. DTSBD551 +01825 MOVE L004-QTR-DEFAULT-DUE-DATE TO W-DEFAULT-RCVD-DT. DTSBD551 +01826 SUBTRACT +12 FROM L004-ABS-QTR. DTSBD551 +01827 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD551 +01828 IF WORK-PARM-RUN-TYPE-ANY-88 DTSBD551 +01829 MOVE ZERO TO W-EARLIEST-QTR DTSBD551 +01830 ELSE DTSBD551 +01831 MOVE L004-ABS-QTR TO W-EARLIEST-QTR DTSBD551 +01832 END-IF. DTSBD551 +01833 DTSBD551 +01834 DISPLAY 'CURR QTR ' W-CURR-QTR ' EARLIEST ' W-EARLIEST-QTR. DTSBD551 +01835 DISPLAY 'DEFAULT RECEIVED DATE ' W-DEFAULT-RCVD-DT. DTSBD551 +01836 DTSBD551 +01837 I3000-EXIT. DTSBD551 +01838 EXIT. DTSBD551 +01839 DTSBD551 +01840 I3100-SYS-DATE. DTSBD551 +01841 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD551 +01842 DTSBD551 +01843 I3100-EXIT. DTSBD551 +01844 EXIT. DTSBD551 +01845 DTSBD551 +01846 I4000-READ-FIRST. DTSBD551 +01847 READ ICESA-FILE. DTSBD551 +01848 IF ICESA-STATUS-OK-88 DTSBD551 +01849 ADD +1 TO W-INPUT-READ-CNT DTSBD551 +01850 ELSE DTSBD551 +01851 DISPLAY 'BAD FIRST READ ' ICESA-STATUS DTSBD551 +01852 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01853 GO TO I4000-EXIT DTSBD551 +01854 END-IF. DTSBD551 +01855 DTSBD551 +01856 IF ICESA-REC-TYPE-A-88 DTSBD551 +01857 NEXT SENTENCE DTSBD551 +01858 ELSE DTSBD551 +01859 DISPLAY 'FIRST RECORD NOT TYPE A: ' ICESA-REC-TYPE DTSBD551 +01860 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01861 GO TO I4000-EXIT DTSBD551 +01862 END-IF. DTSBD551 +01863 DTSBD551 +01864 DTSBD551 +01865 I4000-EXIT. DTSBD551 +01866 EXIT. DTSBD551 +01867 DTSBD551 +01868 I4100-SUBMITTERS. DTSBD551 +01869 OPEN INPUT SUBMITTER-GDG. DTSBD551 +01870 IF CURBX210-STATUS-OK-88 DTSBD551 +01871 NEXT SENTENCE DTSBD551 +01872 ELSE DTSBD551 +01873 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01874 DISPLAY 'CANNOT OPEN SUBMITTER GDG ' CURBX210-STATUS DTSBD551 +01875 GO TO I4100-EXIT DTSBD551 +01876 END-IF. DTSBD551 +01877 DTSBD551 +01878 PERFORM DTSBD551 +01879 VARYING SUB3 FROM +1 BY +1 DTSBD551 +01880 UNTIL SUB3 > SB-MAX DTSBD551 +01881 MOVE +0 TO W-SB-FEIN (SUB3) DTSBD551 +01882 END-PERFORM. DTSBD551 +01883 DTSBD551 +01884 READ SUBMITTER-GDG INTO W-SUBMITTER-REC. DTSBD551 +01885 IF CURBX210-STATUS-OK-88 DTSBD551 +01886 PERFORM UNTIL CURBX210-STATUS-EOF-88 DTSBD551 +01887 IF SB-LAST < SB-MAX DTSBD551 +01888 ADD +1 TO SB-LAST DTSBD551 +01889 MOVE X210-FEIN TO W-SB-FEIN (SB-LAST) DTSBD551 +01890 READ SUBMITTER-GDG INTO W-SUBMITTER-REC DTSBD551 +01891 ELSE DTSBD551 +01892 DISPLAY 'SUBMITTER TABLE LENGTH EXCEEDED' DTSBD551 +01893 SET CURBX210-STATUS-EOF-88 TO TRUE DTSBD551 +01894 END-IF DTSBD551 +01895 END-PERFORM DTSBD551 +01896 END-IF. DTSBD551 +01897 DTSBD551 +01898 CLOSE SUBMITTER-GDG. DTSBD551 +01899 DTSBD551 +01900 DTSBD551 +01901 I4100-EXIT. DTSBD551 +01902 EXIT. DTSBD551 +01903 DTSBD551 +01904 EJECT DTSBD551 +01905 P0000-PROCESS. DTSBD551 +01906 DISPLAY 'ICESA CONTRIBUTION AND WAGE REPORTS '. DTSBD551 +01907 DISPLAY SPACE. DTSBD551 +01908 DTSBD551 +01909 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBD551 +01910 DTSBD551 +01911 PERFORM P1000-READ-INPUT THRU P1000-EXIT DTSBD551 +01912 UNTIL ICESA-STATUS-EOF-88 DTSBD551 +01913 OR W-ERROR-YES-88. DTSBD551 +01914 DTSBD551 +01915 ********************************************************** DTSBD551 +01916 * IF LAST RECORD TYPE IS NOT F AT END OF FILE, THE DTSBD551 +01917 * SUBMISSION IS INCOMPLETE. DTSBD551 +01918 ********************************************************** DTSBD551 +01919 IF ICESA-STATUS-EOF-88 DTSBD551 +01920 IF NOT W-PREV-REC-TYPE-F-88 DTSBD551 +01921 DISPLAY 'INCOMPLETE SUBMISSION. LAST REC TYPE IS: ' DTSBD551 +01922 W-PREV-REC-TYPE DTSBD551 +01923 MOVE MSG-F9 TO R551-MSG-TEXT DTSBD551 +01924 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD551 +01925 MOVE A-NAME TO R551-SUBMITTER-NAME DTSBD551 +01926 MOVE A-CONTACT TO R551-CONTACT-NAME DTSBD551 +01927 MOVE A-CONTACT-PHONE TO R551-CONTACT-PHONE DTSBD551 +01928 MOVE A-PHONE-BOX TO R551-CONTACT-PHONE-EXT DTSBD551 +01929 MOVE W-INPUT-READ-CNT TO R551-REC-NO DTSBD551 +01930 SET R551-RPT-TYPE-FATAL-88 TO TRUE DTSBD551 +01931 MOVE ICESA-REC-TYPE TO R551-ICESA-REC-TYPE DTSBD551 +01932 MOVE R551-REC TO RSKL-REC DTSBD551 +01933 PERFORM S946-RPT-1 THRU S946-EXIT DTSBD551 +01934 END-IF DTSBD551 +01935 END-IF. DTSBD551 +01936 DTSBD551 +01937 P0000-EXIT. DTSBD551 +01938 EXIT. DTSBD551 +01939 EJECT DTSBD551 +01940 DTSBD551 +01941 P1000-READ-INPUT. DTSBD551 +01942 EVALUATE TRUE DTSBD551 +01943 WHEN ICESA-REC-TYPE-A-88 DTSBD551 +01944 PERFORM P1100-TYPE-A THRU P1100-EXIT DTSBD551 +01945 DTSBD551 +01946 WHEN ICESA-REC-TYPE-B-88 DTSBD551 +01947 PERFORM P1200-TYPE-B THRU P1200-EXIT DTSBD551 +01948 DTSBD551 +01949 WHEN ICESA-REC-TYPE-E-88 DTSBD551 +01950 PERFORM P1300-TYPE-E THRU P1300-EXIT DTSBD551 +01951 DTSBD551 +01952 WHEN ICESA-REC-TYPE-S-88 DTSBD551 +01953 PERFORM P1400-TYPE-S THRU P1400-EXIT DTSBD551 +01954 DTSBD551 +01955 WHEN ICESA-REC-TYPE-T-88 DTSBD551 +01956 PERFORM P1500-TYPE-T THRU P1500-EXIT DTSBD551 +01957 DTSBD551 +01958 WHEN ICESA-REC-TYPE-F-88 DTSBD551 +01959 PERFORM P1600-TYPE-F THRU P1600-EXIT DTSBD551 +01960 DTSBD551 +01961 END-EVALUATE. DTSBD551 +01962 DTSBD551 +01963 IF W-ERROR-YES-88 DTSBD551 +01964 GO TO P1000-EXIT DTSBD551 +01965 ELSE DTSBD551 +01966 READ ICESA-FILE DTSBD551 +01967 IF ICESA-STATUS-OK-88 DTSBD551 +01968 OR ICESA-STATUS-EOF-88 DTSBD551 +01969 ADD +1 TO W-INPUT-READ-CNT DTSBD551 +01970 ELSE DTSBD551 +01971 DISPLAY 'BAD READ ON INPUT FILE ' ICESA-STATUS DTSBD551 +01972 SET W-ERROR-YES-88 TO TRUE DTSBD551 +01973 END-IF DTSBD551 +01974 END-IF. DTSBD551 +01975 DTSBD551 +01976 P1000-EXIT. DTSBD551 +01977 EXIT. DTSBD551 +01978 DTSBD551 +01979 P1100-TYPE-A. DTSBD551 +01980 * DISPLAY 'P1100-TYEP A ' DTSBD551 +01981 MOVE ICESA-REC TO WAGE-RECORD-A. DTSBD551 +01982 *& DTSBD551 +01983 DISPLAY 'TYPE A ' WAGE-RECORD-A (1:60). DTSBD551 +01984 *& DTSBD551 +01985 DTSBD551 +01986 PERFORM P1110-EDIT-TYPE-A THRU P1110-EXIT DTSBD551 +01987 IF W-ERROR-NO-88 DTSBD551 +01988 SET W-PREV-REC-TYPE-A-88 TO TRUE DTSBD551 +01989 PERFORM P1120-SAVE-TYPE-A THRU P1120-EXIT DTSBD551 +01990 ELSE DTSBD551 +01991 DISPLAY 'TYPE A REC NOT FIRST IN FILE ' DTSBD551 +01992 W-PREV-REC-TYPE DTSBD551 +01993 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +01994 MOVE W-PREV-REC-TYPE TO MSG-A1-PREV-REC-TYPE DTSBD551 +01995 MOVE MSG-A1 TO R551-MSG-TEXT DTSBD551 +01996 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +01997 END-IF. DTSBD551 +01998 DTSBD551 +01999 P1100-EXIT. DTSBD551 +02000 EXIT. DTSBD551 +02001 DTSBD551 +02002 P1110-EDIT-TYPE-A. DTSBD551 +02003 * DISPLAY 'P1110-TYEP A ' DTSBD551 +02004 IF A-FEDERAL-EIN NOT NUMERIC DTSBD551 +02005 * DISPLAY 'TYPE A: NON-NUMERIC FEIN ' A-FEDERAL-EIN DTSBD551 +02006 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02007 MOVE A-FEDERAL-EIN TO MSG-A2-FEIN DTSBD551 +02008 MOVE MSG-A2 TO R551-MSG-TEXT DTSBD551 +02009 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02010 END-IF. DTSBD551 +02011 DTSBD551 +02012 IF A-NAME = SPACES DTSBD551 +02013 * DISPLAY 'TYPE A: SUBMITTER NAME MISSING' DTSBD551 +02014 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02015 MOVE MSG-A3 TO R551-MSG-TEXT DTSBD551 +02016 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02017 END-IF. DTSBD551 +02018 DTSBD551 +02019 ************************************************************* DTSBD551 +02020 * 02/07/2012: EDITS ON CONTACT INFORMATION REMOVED. DTSBD551 +02021 * THE ICESA WEB APPLICATION HANDLES THIS INFORMATION. DTSBD551 +02022 ************************************************************* DTSBD551 +02023 * IF A-STREET = SPACES DTSBD551 +02024 * OR A-CITY = SPACES DTSBD551 +02025 * OR A-STATE = SPACES DTSBD551 +02026 * DISPLAY 'TYPE A: SUBMITTER ADDRESS MISSING' DTSBD551 +02027 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02028 * MOVE MSG-A4 TO R551-MSG-TEXT DTSBD551 +02029 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02030 * END-IF. DTSBD551 +02031 * DTSBD551 +02032 * IF A-ZIP-CODE = SPACES DTSBD551 +02033 * DISPLAY 'TYPE A: SUBMITTER ZIP CODE MISSING' DTSBD551 +02034 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02035 * MOVE MSG-A5 TO R551-MSG-TEXT DTSBD551 +02036 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02037 * END-IF. DTSBD551 +02038 * DTSBD551 +02039 * IF A-CONTACT = SPACES DTSBD551 +02040 * DISPLAY 'TYPE A: CONTACT NAME MISSING' DTSBD551 +02041 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02042 * MOVE MSG-A6 TO R551-MSG-TEXT DTSBD551 +02043 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02044 * END-IF. DTSBD551 +02045 * DTSBD551 +02046 * IF A-CONTACT-PHONE = SPACES DTSBD551 +02047 * DISPLAY 'TYPE A: CONTACT PHONE MISSING' DTSBD551 +02048 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02049 * MOVE MSG-A7 TO R551-MSG-TEXT DTSBD551 +02050 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02051 * END-IF. DTSBD551 +02052 * DTSBD551 +02053 IF A-MEDIA-DATE NOT NUMERIC DTSBD551 +02054 DISPLAY 'TYPE A: NON-NUMERIC MEDIA CREATE DATE ' DTSBD551 +02055 A-MEDIA-DATE DTSBD551 +02056 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02057 MOVE A-MEDIA-DATE TO MSG-A8-MEDIA-DATE DTSBD551 +02058 MOVE MSG-A8 TO R551-MSG-TEXT DTSBD551 +02059 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02060 ELSE DTSBD551 +02061 MOVE A-MEDIA-DATE TO L001-CAL-8-DATE-X DTSBD551 +02062 PERFORM S001-FROM-CAL-8 THRU S001-EXIT DTSBD551 +02063 IF L001-VALID-DATE DTSBD551 +02064 MOVE L001-FED-8-DATE-9 TO W-SUBM-CREATE-DATE DTSBD551 +02065 ELSE DTSBD551 +02066 * DISPLAY 'TYPE A: INVALID MEDIA CREATE DATE ' DTSBD551 +02067 * A-MEDIA-DATE DTSBD551 +02068 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02069 MOVE A-MEDIA-DATE TO MSG-A9-MEDIA-DATE DTSBD551 +02070 MOVE MSG-A9 TO R551-MSG-TEXT DTSBD551 +02071 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02072 END-IF DTSBD551 +02073 END-IF. DTSBD551 +02074 DTSBD551 +02075 DTSBD551 +02076 IF W-PARM-ALLOW-DUP-YES-88 DTSBD551 +02077 NEXT SENTENCE DTSBD551 +02078 ELSE DTSBD551 +02079 PERFORM DTSBD551 +02080 VARYING SUB3 FROM +1 BY +1 DTSBD551 +02081 UNTIL SUB3 > SB-LAST DTSBD551 +02082 IF W-SB-FEIN (SUB3) = A-FEDERAL-EIN DTSBD551 +02083 DISPLAY 'P1110: DUPLICATE SUBMISSION ' DTSBD551 +02084 A-FEDERAL-EIN DTSBD551 +02085 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02086 MOVE A-FEDERAL-EIN TO MSG-A10-FEIN DTSBD551 +02087 MOVE MSG-A10 TO R551-MSG-TEXT DTSBD551 +02088 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02089 SET W-ERROR-YES-88 TO TRUE DTSBD551 +02090 END-IF DTSBD551 +02091 END-PERFORM DTSBD551 +02092 END-IF. DTSBD551 +02093 DTSBD551 +02094 * IF A-REMITT-AMOUNT NOT NUMERIC DTSBD551 +02095 * DISPLAY 'TYPE A: NON-NUMERIC REMIT AMT ' DTSBD551 +02096 * A-REMITT-AMOUNT DTSBD551 +02097 * SET W-ERROR-YES-88 TO TRUE DTSBD551 +02098 * END-IF. DTSBD551 +02099 DTSBD551 +02100 P1110-EXIT. DTSBD551 +02101 EXIT. DTSBD551 +02102 DTSBD551 +02103 P1111-LOG-RCV-REMIT. DTSBD551 +02104 * DISPLAY 'P1111-TYEP A ' DTSBD551 +02105 PERFORM DTSBD551 +02106 VARYING SUB1 FROM +1 BY +1 DTSBD551 +02107 UNTIL SUB1 > +100 DTSBD551 +02108 MOVE +0 TO L205-FIELD-LENGTH (SUB1) DTSBD551 +02109 L205-INTEGER (SUB1) DTSBD551 +02110 L205-FRACTION (SUB1) DTSBD551 +02111 MOVE SPACES TO L205-TEXT (SUB1) DTSBD551 +02112 L205-DATE (SUB1) DTSBD551 +02113 SET L205-TYPE-TEXT-88 (SUB1) TO TRUE DTSBD551 +02114 END-PERFORM. DTSBD551 +02115 DTSBD551 +02116 MOVE +4 TO L205-LAST-FIELD DTSBD551 +02117 MOVE +10 TO L205-LAST-FIELD-LEN DTSBD551 +02118 DTSBD551 +02119 MOVE +1 TO L205-FIELD-LENGTH (1). DTSBD551 +02120 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBD551 +02121 DTSBD551 +02122 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBD551 +02123 SET L205-TYPE-NUMBER-88 (2) TO TRUE. DTSBD551 +02124 DTSBD551 +02125 MOVE +13 TO L205-FIELD-LENGTH (3). DTSBD551 +02126 SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBD551 +02127 DTSBD551 +02128 SET L205-TYPE-DATE-88 (4) TO TRUE. DTSBD551 +02129 DTSBD551 +02130 MOVE ICESA-REC (1:30) TO L205-INPUT-DATA. DTSBD551 +02131 DISPLAY ' WEB HDR REC=' L205-INPUT-DATA (1:30). DTSBD551 +02132 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBD551 +02133 DTSBD551 +02134 IF L205-TEXT (1) (1:1) NOT = '1' DTSBD551 +02135 DISPLAY 'INVALID TYPE 1 RECORD ' L205-TEXT (1) (1:10) DTSBD551 +02136 SET W-ERROR-YES-88 TO TRUE DTSBD551 +02137 GO TO P1111-EXIT DTSBD551 +02138 END-IF. DTSBD551 +02139 DTSBD551 +02140 IF L205-VALID-NO-88 (2) DTSBD551 +02141 DISPLAY ' LOG NO ' L205-INTEGER (2) DTSBD551 +02142 * MOVE A-LOG-REMIT TO MSG-A11-LOG-REMIT DTSBD551 +02143 MOVE MSG-A11 TO R551-MSG-TEXT DTSBD551 +02144 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02145 ELSE DTSBD551 +02146 MOVE L205-INTEGER (2) TO WORK-PARM-LOG-NO DTSBD551 +02147 W-LOG-NO DTSBD551 +02148 DISPLAY '**** LOG-NO ' WORK-PARM-LOG-NO DTSBD551 +02149 END-IF. DTSBD551 +02150 DTSBD551 +02151 DTSBD551 +02152 DTSBD551 +02153 DTSBD551 +02154 IF L205-VALID-NO-88 (3) DTSBD551 +02155 DISPLAY ' REMIT DOLLS ' L205-INTEGER (3) DTSBD551 +02156 DISPLAY ' REMIT CENTS ' L205-FRACTION (3) DTSBD551 +02157 * MOVE A-LOG-REMIT TO MSG-A12-LOG-REMIT DTSBD551 +02158 MOVE MSG-A12 TO R551-MSG-TEXT DTSBD551 +02159 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02160 ELSE DTSBD551 +02161 MOVE L205-INTEGER (3) TO W-INTEGER DTSBD551 +02162 MOVE L205-FRACTION (3) TO W-FRACTION DTSBD551 +02163 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION DTSBD551 +02164 MOVE W-NUMBER TO W-PARM-DEPOSIT-REMIT DTSBD551 +02165 MOVE W-NUMBER TO WORK-PARM-TOT-REMITTANCE DTSBD551 +02166 END-IF. DTSBD551 +02167 DTSBD551 +02168 IF L205-VALID-YES-88 (4) DTSBD551 +02169 MOVE L205-DATE (4) TO L001-SLASH-8-DATE DTSBD551 +02170 MOVE L001-SLASH-8-MO TO L001-FED-8-MO DTSBD551 +02171 MOVE L001-SLASH-8-DA TO L001-FED-8-DA DTSBD551 +02172 MOVE L001-SLASH-8-YR TO L001-FED-8-YR DTSBD551 +02173 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBD551 +02174 IF L001-VALID-DATE DTSBD551 +02175 MOVE L001-FED-8-DATE-9 TO WORK-PARM-RECEIVED-DATE DTSBD551 +02176 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBD551 +02177 ELSE DTSBD551 +02178 DISPLAY 'USING DEFAULT RCVD DT ' W-DEFAULT-RCVD-DT DTSBD551 +02179 MOVE W-DEFAULT-RCVD-DT TO WORK-PARM-RECEIVED-DATE DTSBD551 +02180 MOVE W-DEFAULT-RCVD-DT TO W-RECEIVED-DATE DTSBD551 +02181 END-IF DTSBD551 +02182 END-IF. DTSBD551 +02183 DTSBD551 +02184 MOVE W-PARM-DEPOSIT-REMIT TO W-AMT-DISP1. DTSBD551 +02185 DISPLAY 'P1111 - LOG: ' WORK-PARM-LOG-NO DTSBD551 +02186 ' REMIT: ' W-AMT-DISP1 DTSBD551 +02187 ' RCV DTE: ' WORK-PARM-RECEIVED-DATE. DTSBD551 +02188 P1111-EXIT. DTSBD551 +02189 EXIT. DTSBD551 +02190 DTSBD551 +02191 P1120-SAVE-TYPE-A. DTSBD551 +02192 * DISPLAY 'P1120-TYEP A ' DTSBD551 +02193 *& DTSBD551 +02194 DISPLAY 'TYPE A OK ' A-FEDERAL-EIN ' ' A-NAME. DTSBD551 +02195 *& DTSBD551 +02196 MOVE A-FEDERAL-EIN TO W-SUBM-FEIN DTSBD551 +02197 X210-FEIN. DTSBD551 +02198 MOVE A-NAME TO W-SUBM-NAME DTSBD551 +02199 X210-NAME. DTSBD551 +02200 MOVE A-STREET TO W-SUBM-STREET DTSBD551 +02201 X210-STREET. DTSBD551 +02202 MOVE A-CITY TO W-SUBM-CITY DTSBD551 +02203 X210-CITY. DTSBD551 +02204 MOVE A-STATE TO W-SUBM-STATE DTSBD551 +02205 X210-STATE. DTSBD551 +02206 MOVE A-ZIP-CODE TO W-SUBM-ZIP DTSBD551 +02207 W-ZIP5. DTSBD551 +02208 MOVE A-ZIP-CODE-EXT TO W-SUBM-ZIP-EXT DTSBD551 +02209 W-ZIP-PLUS4. DTSBD551 +02210 MOVE W-ZIP TO X210-ZIP. DTSBD551 +02211 MOVE A-CONTACT TO W-SUBM-CONTACT-NAME DTSBD551 +02212 X210-CONTACT-NAME. DTSBD551 +02213 MOVE A-CONTACT-PHONE TO W-SUBM-CONTACT-PHONE DTSBD551 +02214 X210-CONTACT-PHONE. DTSBD551 +02215 MOVE A-PHONE-BOX TO W-SUBM-CONTACT-PHONE-EXT DTSBD551 +02216 X210-CONTACT-PHONE-EXT. DTSBD551 +02217 *** MOVE A-REMITT-AMOUNT TO W-SUBM-REMIT-AMT-X DTSBD551 +02218 MOVE A-MEDIA-DATE TO L001-CAL-8-DATE-X. DTSBD551 +02219 PERFORM S001-FROM-CAL-8 THRU S001-EXIT DTSBD551 +02220 MOVE L001-SLASH-8-DATE TO X210-ESTB-DATE. DTSBD551 +02221 DTSBD551 +02222 MOVE L005-SLASH-8-DATE TO X210-RUN-DATE. DTSBD551 +02223 MOVE L005-DISPLAY-TIME TO X210-RUN-TIME. DTSBD551 +02224 DTSBD551 +02225 INSPECT X210-NAME REPLACING ALL ',' BY SPACE. DTSBD551 +02226 INSPECT X210-STREET REPLACING ALL ',' BY SPACE. DTSBD551 +02227 INSPECT X210-CITY REPLACING ALL ',' BY SPACE. DTSBD551 +02228 INSPECT X210-STATE REPLACING ALL ',' BY SPACE. DTSBD551 +02229 INSPECT X210-CONTACT-NAME DTSBD551 +02230 REPLACING ALL ',' BY SPACE. DTSBD551 +02231 DTSBD551 +02232 *** WRITE MOVED TO T1110 DTSBD551 +02233 *** WRITE SUBMITTER-REC FROM W-SUBMITTER-REC. DTSBD551 +02234 * IF SUBMITTER-STATUS-OK-88 DTSBD551 +02235 * NEXT SENTENCE DTSBD551 +02236 * ELSE DTSBD551 +02237 * SET W-ERROR-YES-88 TO TRUE DTSBD551 +02238 * DISPLAY 'CANNOT WRITE SUBMITTER FILE: ' DTSBD551 +02239 * SUBMITTER-STATUS DTSBD551 +02240 *** END-IF. DTSBD551 +02241 DTSBD551 +02242 P1120-EXIT. DTSBD551 +02243 EXIT. DTSBD551 +02244 DTSBD551 +02245 P1199-FATAL-ERROR. DTSBD551 +02246 DTSBD551 +02247 IF A-FEDERAL-EIN NUMERIC DTSBD551 +02248 MOVE A-FEDERAL-EIN TO R551-SUBMITTER-FEIN DTSBD551 +02249 ELSE DTSBD551 +02250 MOVE ZERO TO R551-SUBMITTER-FEIN DTSBD551 +02251 END-IF. DTSBD551 +02252 DTSBD551 +02253 IF W-PARM-BYPASS-ERR-YES-88 DTSBD551 +02254 NEXT SENTENCE DTSBD551 +02255 ELSE DTSBD551 +02256 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD551 +02257 MOVE A-NAME TO R551-SUBMITTER-NAME DTSBD551 +02258 MOVE A-CONTACT TO R551-CONTACT-NAME DTSBD551 +02259 MOVE A-CONTACT-PHONE TO R551-CONTACT-PHONE DTSBD551 +02260 MOVE A-PHONE-BOX TO R551-CONTACT-PHONE-EXT DTSBD551 +02261 MOVE W-INPUT-READ-CNT TO R551-REC-NO DTSBD551 +02262 SET R551-RPT-TYPE-FATAL-88 TO TRUE DTSBD551 +02263 MOVE ICESA-REC-TYPE TO R551-ICESA-REC-TYPE DTSBD551 +02264 MOVE R551-REC TO RSKL-REC DTSBD551 +02265 PERFORM S946-RPT-1 THRU S946-EXIT DTSBD551 +02266 END-IF. DTSBD551 +02267 DTSBD551 +02268 DISPLAY 'P1199 ' W-FATAL-ERROR-IND ' ' DTSBD551 +02269 W-PARM-BYPASS-ERR-IND. DTSBD551 +02270 P1199-EXIT. DTSBD551 +02271 EXIT. DTSBD551 +02272 DTSBD551 +02273 P1200-TYPE-B. DTSBD551 +02274 * DISPLAY 'P1200-TYEP B ' DTSBD551 +02275 MOVE ICESA-REC TO WAGE-RECORD-B. DTSBD551 +02276 *& DTSBD551 +02277 * DISPLAY 'TYPE B '. DTSBD551 +02278 *& DTSBD551 +02279 P1200-EXIT. DTSBD551 +02280 EXIT. DTSBD551 +02281 DTSBD551 +02282 P1300-TYPE-E. DTSBD551 +02283 * DISPLAY 'P1300-TYEP E ' DTSBD551 +02284 * DISPLAY ' ERROR IND ' W-ERROR-IND. DTSBD551 +02285 * DISPLAY ' FATAL IND ' W-FATAL-ERROR-IND DTSBD551 +02286 MOVE ICESA-REC TO WAGE-RECORD-E. DTSBD551 +02287 *& DTSBD551 +02288 DISPLAY 'TYPE E ' WAGE-RECORD-E (1:60). DTSBD551 +02289 *& DTSBD551 +02290 DTSBD551 +02291 * DISPLAY SPACE. DTSBD551 +02292 * IF E-ACCOUNT-NO = '121131' DTSBD551 +02293 * DISPLAY 'EMPLOYER ACCT ' E-ACCOUNT-NO DTSBD551 +02294 * ' FEIN ' E-FEDERAL-EIN. DTSBD551 +02295 DTSBD551 +02296 SET W-WAGES-EXPECTED-NO-88 TO TRUE. DTSBD551 +02297 MOVE SPACES TO L601-RETURN-CODE. DTSBD551 +02298 SET W-EMP-FOUND-YES-88 TO TRUE. DTSBD551 +02299 SET W-LIABLE-YES-88 TO TRUE. DTSBD551 +02300 SET W-DUP-RPT-NO-88 TO TRUE. DTSBD551 +02301 SET W-ANNUAL-QTR-NO-88 TO TRUE. DTSBD551 +02302 ** SET W-SUCCESSOR-NO-88 TO TRUE. DTSBD551 +02303 MOVE ZERO TO W-EMP-NO DTSBD551 +02304 W-FEIN-EMP-NO DTSBD551 +02305 W-FINAL-FEIN DTSBD551 +02306 W-PRED-NO DTSBD551 +02307 W-EMP-TOT-WAGE DTSBD551 +02308 W-EMP-TAX-WAGE DTSBD551 +02309 W-EMP-WAGE-CNT DTSBD551 +02310 W-UI-RATE DTSBD551 +02311 W-EDITED-E-ACCT DTSBD551 +02312 W-EDITED-S-ACCT. DTSBD551 +02313 MOVE E-NAME TO W-EMP-NAME. DTSBD551 +02314 DTSBD551 +02315 IF W-PSEUDO-ITEM-NO < 999 DTSBD551 +02316 ADD 1 TO W-PSEUDO-ITEM-NO DTSBD551 +02317 ELSE DTSBD551 +02318 ADD 1 TO W-PSEUDO-BATCH-NO DTSBD551 +02319 MOVE 1 TO W-PSEUDO-ITEM-NO DTSBD551 +02320 END-IF. DTSBD551 +02321 DTSBD551 +02322 SET W-MNTE-STARTED-NO-88 TO TRUE. DTSBD551 +02323 PERFORM DTSBD551 +02324 VARYING W-MNTE-TEXT-CNT FROM +1 BY +1 DTSBD551 +02325 UNTIL W-MNTE-TEXT-CNT > W-MNTE-TEXT-MAX DTSBD551 +02326 MOVE SPACES TO W-MNTE-TEXT (W-MNTE-TEXT-CNT) DTSBD551 +02327 END-PERFORM. DTSBD551 +02328 MOVE +0 TO W-MNTE-TEXT-CNT. DTSBD551 +02329 DTSBD551 +02330 INITIALIZE T028-REC. DTSBD551 +02331 DTSBD551 +02332 IF W-PREV-REC-TYPE-A-88 DTSBD551 +02333 OR W-PREV-REC-TYPE-T-88 DTSBD551 +02334 SET W-PREV-REC-TYPE-E-88 TO TRUE DTSBD551 +02335 ELSE DTSBD551 +02336 DISPLAY 'TYPE E: PREVIOUS REC TYPE NOT A OR T: ' DTSBD551 +02337 W-PREV-REC-TYPE DTSBD551 +02338 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02339 MOVE W-PREV-REC-TYPE TO MSG-E10-REC-TYPE DTSBD551 +02340 MOVE MSG-E10 TO R551-MSG-TEXT DTSBD551 +02341 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02342 GO TO P1300-EXIT DTSBD551 +02343 END-IF. DTSBD551 +02344 DTSBD551 +02345 SET WAGE-TEMP-REQ-OPEN-OUT-88 TO TRUE. DTSBD551 +02346 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 +02347 IF W-ERROR-YES-88 DTSBD551 +02348 NEXT SENTENCE DTSBD551 +02349 ELSE DTSBD551 +02350 PERFORM P1310-EDIT-TYPE-E THRU P1310-EXIT DTSBD551 +02351 DISPLAY ' P1310 ERROR IND ' W-ERROR-IND DTSBD551 +02352 IF W-ERROR-NO-88 DTSBD551 +02353 SET W-PREV-REC-TYPE-E-88 TO TRUE DTSBD551 +02354 PERFORM P1320-FORMAT-T028 THRU P1320-EXIT DTSBD551 +02355 IF W-EMP-FOUND-NO-88 DTSBD551 +02356 MOVE W-PSEUDO-BATCH-NO TO MSG-E2-BATCH DTSBD551 +02357 MOVE W-PSEUDO-ITEM-NO TO MSG-E2-ITEM DTSBD551 +02358 MOVE MSG-E2 TO R551-MSG-TEXT DTSBD551 +02359 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 +02360 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02361 END-IF DTSBD551 +02362 END-IF DTSBD551 +02363 END-IF. DTSBD551 +02364 DTSBD551 +02365 DTSBD551 +02366 P1300-EXIT. DTSBD551 +02367 EXIT. DTSBD551 +02368 DTSBD551 +02369 P1310-EDIT-TYPE-E. DTSBD551 +02370 * DISPLAY 'P1310-TYEP E ' DTSBD551 +02371 * DISPLAY ' ERROR IND ' W-ERROR-IND. DTSBD551 +02372 * DISPLAY ' FATAL IND ' W-FATAL-ERROR-IND DTSBD551 +02373 IF E-FEDERAL-EIN NOT NUMERIC DTSBD551 +02374 DISPLAY 'TYPE E: NON-NUMERIC FEIN ' E-FEDERAL-EIN DTSBD551 +02375 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02376 MOVE E-FEDERAL-EIN TO MSG-E11-FEIN DTSBD551 +02377 MOVE MSG-E11 TO R551-MSG-TEXT DTSBD551 +02378 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02379 ELSE DTSBD551 +02380 MOVE E-FEDERAL-EIN TO W-FINAL-FEIN DTSBD551 +02381 END-IF. DTSBD551 +02382 DTSBD551 +02383 IF E-NAME = SPACES DTSBD551 +02384 DISPLAY 'TYPE E: EMPLOYER NAME MISSING' DTSBD551 +02385 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02386 MOVE MSG-E12 TO R551-MSG-TEXT DTSBD551 +02387 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02388 END-IF. DTSBD551 +02389 DTSBD551 +02390 IF E-STREET = SPACES DTSBD551 +02391 OR E-CITY = SPACES DTSBD551 +02392 OR E-STATE = SPACES DTSBD551 +02393 DISPLAY 'TYPE E: EMPLOYER ADDRESS MISSING' DTSBD551 +02394 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02395 MOVE MSG-E13 TO R551-MSG-TEXT DTSBD551 +02396 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02397 *** PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02398 END-IF. DTSBD551 +02399 DTSBD551 +02400 IF E-ZIP-CODE = SPACES DTSBD551 +02401 * DISPLAY 'TYPE E: EMPLOYER ZIP CODE MISSING' DTSBD551 +02402 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02403 MOVE MSG-E14 TO R551-MSG-TEXT DTSBD551 +02404 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02405 *** PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02406 END-IF. DTSBD551 +02407 DTSBD551 +02408 * DISPLAY ' P1310 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 +02409 MOVE E-YEAR TO W-REPORT-CCYY. DTSBD551 +02410 MOVE E-REPORT-PERIOD TO W-REPORT-MM-X. DTSBD551 +02411 PERFORM S2100-REPORT-QTR THRU S2100-EXIT. DTSBD551 +02412 * DISPLAY ' P13101 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 +02413 * PERFORM S2130-RECEIVED-DATE THRU S2130-EXIT. DTSBD551 +02414 * DISPLAY ' P13102 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 +02415 DTSBD551 +02416 IF E-STATE-CODE NOT = '11' DTSBD551 +02417 DISPLAY 'TYPE E: STATE CODE NOT DC ' E-STATE-CODE DTSBD551 +02418 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02419 MOVE E-STATE-CODE TO MSG-E15-STATE-CODE DTSBD551 +02420 MOVE MSG-E15 TO R551-MSG-TEXT DTSBD551 +02421 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02422 END-IF. DTSBD551 +02423 DTSBD551 +02424 IF E-WORKER-WAGE = 0 OR 1 DTSBD551 +02425 MOVE E-WORKER-WAGE TO W-WAGES-EXPECTED-IND DTSBD551 +02426 ELSE DTSBD551 +02427 DISPLAY 'TYPE E: INVALID WORKER/WAGE CODE ' DTSBD551 +02428 E-WORKER-WAGE DTSBD551 +02429 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02430 MOVE E-WORKER-WAGE TO MSG-E16-WORKER-WAGE DTSBD551 +02431 MOVE MSG-E16 TO R551-MSG-TEXT DTSBD551 +02432 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02433 END-IF. DTSBD551 +02434 DTSBD551 +02435 * DISPLAY ' P1310E ERROR IND ' W-ERROR-IND DTSBD551 +02436 IF W-ERROR-NO-88 DTSBD551 +02437 MOVE E-ACCOUNT-NO TO W-ACCT-NBR-IN DTSBD551 +02438 PERFORM P1311-TYPE-E-ACCT-NBR THRU P1311-EXIT DTSBD551 +02439 PERFORM P1312-CHK-FOR-MNTE THRU P1312-EXIT DTSBD551 +02440 END-IF. DTSBD551 +02441 DTSBD551 +02442 *& IF W-EMP-NO NOT = ZERO DTSBD551 +02443 * PERFORM P1313-CHECK-ADDR-CHANGE THRU P1313-EXIT DTSBD551 +02444 *& END-IF. DTSBD551 +02445 DTSBD551 +02446 P1310-EXIT. DTSBD551 +02447 EXIT. DTSBD551 +02448 DTSBD551 +02449 ******================***************************************** DTSBD551 +02450 * EDIT ACCOUNT NUMBER DTSBD551 +02451 * INPUT: W-ACCT-NBR-IN, SET IN P1311 DTSBD551 +02452 * OUTPUT: W-EMP-NO DTSBD551 +02453 * DTSBD551 +02454 * IF ACCOUNT NUMBER IS INVALID, SEARCH FOR A VALID EMPLOYER DTSBD551 +02455 * USING THE FEIN. DTSBD551 +02456 * IF THE EMPLOYER IS INACTIVE, SEARCH FOR AN ACTIVE DTSBD551 +02457 * SUCCESSOR. DTSBD551 +02458 * ONCE THE ACCOUNT NUMBER IS VALIDATED, CHECK WHETHER THE DTSBD551 +02459 * EMPLOYER IS LIABLE FOR THE QUARTER AND HAS A UI RATE. DTSBD551 +02460 * DTSBD551 +02461 * IF THE EMPLOYER IS NOT LIABLE FOR THE QUARTER, BUILD DTSBD551 +02462 * REPORT AND WAGE TRANSACTIONS, BUT SET 'PASSED EDITS' TO NO. DTSBD551 +02463 * IF THERE IS NO RECORD OF THE EMPLOYER, BUILD DTSBD551 +02464 * REPORT AND WAGE TRANSACTIONS, BUT SET 'PASSED EDITS' TO NO DTSBD551 +02465 * AND SET UP A POTENTIAL EMPLOYER. DTSBD551 +02466 * DTSBD551 +02467 * W-EDITED-E-ACCT SAVES THE E-RECORD ACCOUNT NUMBER AFTER DTSBD551 +02468 * SPACES, HYPHENS, ETC. ARE REMOVED. IT IS USED IN S2200 DTSBD551 +02469 * TO ENSURE THAT THE SAME ACCOUNT NUMBER IS USED ON THE DTSBD551 +02470 * BOTH THE S-RECORDS AND E-RECORDS. DTSBD551 +02471 *************************************************************** DTSBD551 +02472 P1311-TYPE-E-ACCT-NBR. DTSBD551 +02473 * DISPLAY 'P1311-TYEP E ' DTSBD551 +02474 * DISPLAY ' ERROR IND ' W-ERROR-IND. DTSBD551 +02475 * DISPLAY ' FATAL IND ' W-FATAL-ERROR-IND DTSBD551 +02476 MOVE ZERO TO SUB2. DTSBD551 +02477 MOVE SPACES TO W-ACCT-NBR-OUT. DTSBD551 +02478 SET W-ACCT-NBR-ERR-NO-88 TO TRUE. DTSBD551 +02479 DTSBD551 +02480 PERFORM DTSBD551 +02481 VARYING SUB1 FROM +1 BY +1 DTSBD551 +02482 UNTIL SUB1 > +15 DTSBD551 +02483 IF W-ACCT-NBR-IN-X (SUB1) >= '0' DTSBD551 +02484 AND W-ACCT-NBR-IN-X (SUB1) <= '9' DTSBD551 +02485 IF SUB2 < W-ACCT-NBR-LEN DTSBD551 +02486 ADD +1 TO SUB2 DTSBD551 +02487 MOVE W-ACCT-NBR-IN-X (SUB1) DTSBD551 +02488 TO W-ACCT-NBR-OUT-X (SUB2) DTSBD551 +02489 ** ELSE DTSBD551 +02490 ** SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 +02491 END-IF DTSBD551 +02492 END-IF DTSBD551 +02493 END-PERFORM. DTSBD551 +02494 DTSBD551 +02495 IF W-ACCT-NBR-OUT = SPACES DTSBD551 +02496 SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 +02497 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02498 MOVE W-ACCT-NBR-IN TO MSG-E6-ACCT-NO DTSBD551 +02499 MOVE MSG-E6 TO R551-MSG-TEXT DTSBD551 +02500 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +02501 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02502 ELSE DTSBD551 +02503 IF W-ACCT-NBR-9 NOT NUMERIC DTSBD551 +02504 SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 +02505 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02506 MOVE W-ACCT-NBR-IN TO MSG-E6-ACCT-NO DTSBD551 +02507 MOVE MSG-E6 TO R551-MSG-TEXT DTSBD551 +02508 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +02509 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02510 ELSE DTSBD551 +02511 ** IF W-ACCT-NBR-ERR-YES-88 DTSBD551 +02512 IF SUB2 < 6 DTSBD551 +02513 DISPLAY 'TYPE E: ACCT NUMBER NOT 6 DIGITS ' DTSBD551 +02514 W-ACCT-NBR-IN DTSBD551 +02515 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02516 MOVE W-ACCT-NBR-IN TO MSG-E6-ACCT-NO DTSBD551 +02517 MOVE MSG-E6 TO R551-MSG-TEXT DTSBD551 +02518 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +02519 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02520 END-IF DTSBD551 +02521 END-IF DTSBD551 +02522 END-IF. DTSBD551 +02523 DTSBD551 +02524 MOVE W-ACCT-NBR-9 TO W-EDITED-E-ACCT. DTSBD551 +02525 DTSBD551 +02526 IF W-ACCT-NBR-ERR-YES-88 DTSBD551 +02527 PERFORM S2050-ACCT-FROM-FEIN THRU S2050-EXIT DTSBD551 +02528 IF W-FEIN-EMP-NO > ZERO DTSBD551 +02529 ADD +1 TO W-ACCT-FROM-FEIN-CNT DTSBD551 +02530 MOVE W-FEIN-EMP-NO TO W-EMP-NO DTSBD551 +02531 PERFORM S2000-EMP-LIABILITY THRU S2000-EXIT DTSBD551 +02532 PERFORM S2300-DUP-REPORT THRU S2300-EXIT DTSBD551 +02533 ELSE DTSBD551 +02534 SET W-EMP-FOUND-NO-88 TO TRUE DTSBD551 +02535 ADD +1 TO W-ACCT-NOT-FOUND-CNT DTSBD551 +02536 END-IF DTSBD551 +02537 ELSE DTSBD551 +02538 MOVE W-ACCT-NBR-9 TO W-EMP-NO DTSBD551 +02539 PERFORM S2000-EMP-LIABILITY THRU S2000-EXIT DTSBD551 +02540 PERFORM S2300-DUP-REPORT THRU S2300-EXIT DTSBD551 +02541 END-IF. DTSBD551 +02542 DTSBD551 +02543 IF W-FEIN-EMP-NO > ZERO DTSBD551 +02544 OR L601-SUCCESSOR-FOUND-88 DTSBD551 +02545 OR W-EMP-FOUND-NO-88 DTSBD551 +02546 NEXT SENTENCE DTSBD551 +02547 ELSE DTSBD551 +02548 IF E-FEDERAL-EIN NOT = MPRF-FEIN DTSBD551 +02549 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02550 MSG-E9D-RPT-FEIN DTSBD551 +02551 MOVE MPRF-FEIN TO MSG-E9D-TAX-FEIN DTSBD551 +02552 MOVE MSG-E9D TO R551-MSG-TEXT DTSBD551 +02553 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +02554 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02555 END-IF DTSBD551 +02556 END-IF. DTSBD551 +02557 DTSBD551 +02558 P1311-EXIT. DTSBD551 +02559 EXIT. DTSBD551 +02560 DTSBD551 +02561 P1312-CHK-FOR-MNTE. DTSBD551 +02562 IF W-FEIN-EMP-NO > ZERO DTSBD551 +02563 MOVE W-EMP-NO TO MSG-E7-ACCT-NO DTSBD551 +02564 MOVE E-FEDERAL-EIN TO MSG-E7-FEIN DTSBD551 +02565 MOVE MSG-E7 TO R551-MSG-TEXT DTSBD551 +02566 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +02567 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02568 PERFORM P1397-ADD-MNTE THRU P1397-EXIT DTSBD551 +02569 IF L601-SUCCESSOR-FOUND-88 DTSBD551 +02570 MOVE W-PRED-NO TO MSG-E8-ACCT-NO DTSBD551 +02571 MOVE W-EMP-NO TO MSG-E8-SUCCESSOR DTSBD551 +02572 MOVE MSG-E8 TO R551-MSG-TEXT DTSBD551 +02573 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +02574 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02575 PERFORM P1397-ADD-MNTE THRU P1397-EXIT DTSBD551 +02576 END-IF DTSBD551 +02577 ELSE DTSBD551 +02578 IF L601-SUCCESSOR-FOUND-88 DTSBD551 +02579 MOVE W-PRED-NO TO MSG-E8-ACCT-NO DTSBD551 +02580 MOVE W-EMP-NO TO MSG-E8-SUCCESSOR DTSBD551 +02581 MOVE MSG-E8 TO R551-MSG-TEXT DTSBD551 +02582 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +02583 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02584 PERFORM P1397-ADD-MNTE THRU P1397-EXIT DTSBD551 +02585 END-IF DTSBD551 +02586 END-IF. DTSBD551 +02587 DTSBD551 +02588 P1312-EXIT. DTSBD551 +02589 EXIT. DTSBD551 +02590 DTSBD551 +02591 P1313-CHECK-ADDR-CHANGE. DTSBD551 +02592 * PERFORM P1313A-VERIFY-ADDR THRU P1313A-EXIT. DTSBD551 +02593 * IF L072-ADDRESS-NOT-VALID-88 DTSBD551 +02594 * GO TO P1313-EXIT DTSBD551 +02595 * END-IF. DTSBD551 +02596 DTSBD551 +02597 MOVE LOW-VALUE TO MTAD-KEY-AREA. DTSBD551 +02598 MOVE W-EMP-NO TO MTAD-EMP-NO. DTSBD551 +02599 SET MTAD-TAD-88 TO TRUE. DTSBD551 +02600 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBD551 +02601 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 +02602 DTSBD551 +02603 PERFORM S910-READ THRU S910-EXIT. DTSBD551 +02604 IF L910-NO-REC-88 DTSBD551 +02605 GO TO P1313-EXIT DTSBD551 +02606 ELSE DTSBD551 +02607 MOVE MSKL-REC TO MTAD-REC DTSBD551 +02608 END-IF. DTSBD551 +02609 DTSBD551 +02610 MOVE MTAD-ZIP TO W-ZIP. DTSBD551 +02611 IF W-ZIP5 NOT = E-ZIP-CODE DTSBD551 +02612 *** DISPLAY 'ZIP1 ' W-EMP-NO ' ' MTAD-ZIP ' ' E-ZIP-CODE DTSBD551 +02613 * IF MTAD-ST = E-STATE DTSBD551 +02614 **** IF MTAD-ZIP NOT = L072-ZIP DTSBD551 +02615 PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 +02616 END-IF. DTSBD551 +02617 * IF MTAD-ST = L072-ST DTSBD551 +02618 * IF MTAD-CITY = L072-CITY DTSBD551 +02619 * IF MTAD-DELIV-LINE-2 = L072-DELIV-LINE-2 DTSBD551 +02620 * NEXT SENTENCE DTSBD551 +02621 * ELSE DTSBD551 +02622 * PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 +02623 * END-IF DTSBD551 +02624 * ELSE DTSBD551 +02625 * PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 +02626 * END-IF DTSBD551 +02627 * ELSE DTSBD551 +02628 * PERFORM P1313B-LOCAL-ADDR THRU P1313B-EXIT DTSBD551 +02629 * END-IF. DTSBD551 +02630 P1313-EXIT. DTSBD551 +02631 EXIT. DTSBD551 +02632 DTSBD551 +02633 P1313A-VERIFY-ADDR. DTSBD551 +02634 * SET L072-CASS-EDITS-88 TO TRUE. DTSBD551 +02635 * SET L072-MTAD-88 TO TRUE. DTSBD551 +02636 * MOVE MPRF-PRIMARY-NAME TO L072-NAME. DTSBD551 +02637 * DTSBD551 +02638 * MOVE SPACES TO L072-ADDRESS. DTSBD551 +02639 * MOVE E-STREET TO L072-DELIV-LINE-2. DTSBD551 +02640 * MOVE E-CITY TO L072-CITY. DTSBD551 +02641 * MOVE E-STATE TO L072-ST. DTSBD551 +02642 * MOVE E-ZIP-CODE TO L072-ZIP. DTSBD551 +02643 DTSBD551 +02644 * PERFORM S072-ADDRESS THRU S072-EXIT. DTSBD551 +02645 DTSBD551 +02646 * IF L072-ADDRESS-NOT-VALID-88 DTSBD551 +02647 * MOVE W-EMP-NO TO MSG-E9A-ACCT-NO DTSBD551 +02648 * MOVE MSG-E9A TO R551-MSG-TEXT DTSBD551 +02649 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +02650 * ADD +1 TO W-INVALID-NEW-ADDR-CNT DTSBD551 +02651 *** DISPLAY 'NEW ADDR FOR ' W-EMP-NO ' CANNOT VERIFY' DTSBD551 +02652 * END-IF. DTSBD551 +02653 DTSBD551 +02654 P1313A-EXIT. DTSBD551 +02655 EXIT. DTSBD551 +02656 DTSBD551 +02657 P1313B-LOCAL-ADDR. DTSBD551 +02658 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBD551 +02659 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 +02660 PERFORM S910-READ THRU S910-EXIT. DTSBD551 +02661 IF L910-NO-REC-88 DTSBD551 +02662 PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 +02663 GO TO P1313B-EXIT DTSBD551 +02664 ELSE DTSBD551 +02665 MOVE MSKL-REC TO MTAD-REC DTSBD551 +02666 END-IF. DTSBD551 +02667 DTSBD551 +02668 MOVE MTAD-ZIP TO W-ZIP. DTSBD551 +02669 IF W-ZIP5 NOT = E-ZIP-CODE DTSBD551 +02670 *** DISPLAY 'ZIP2 ' W-EMP-NO ' ' MTAD-ZIP ' ' E-ZIP-CODE DTSBD551 +02671 * IF MTAD-ST = E-STATE DTSBD551 +02672 **** IF MTAD-ZIP NOT = L072-ZIP DTSBD551 +02673 PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 +02674 END-IF. DTSBD551 +02675 * IF MTAD-ST = L072-ST DTSBD551 +02676 * IF MTAD-CITY = L072-CITY DTSBD551 +02677 * IF MTAD-DELIV-LINE-2 = L072-DELIV-LINE-2 DTSBD551 +02678 * NEXT SENTENCE DTSBD551 +02679 * ELSE DTSBD551 +02680 * PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 +02681 * END-IF DTSBD551 +02682 * ELSE DTSBD551 +02683 * PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 +02684 * END-IF DTSBD551 +02685 * ELSE DTSBD551 +02686 * PERFORM P1313C-ADDR-ERROR THRU P1313C-EXIT DTSBD551 +02687 * END-IF. DTSBD551 +02688 P1313B-EXIT. DTSBD551 +02689 EXIT. DTSBD551 +02690 DTSBD551 +02691 P1313C-ADDR-ERROR. DTSBD551 +02692 MOVE W-EMP-NO TO MSG-E9B-ACCT-NO. DTSBD551 +02693 MOVE MSG-E9B TO R551-MSG-TEXT. DTSBD551 +02694 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE. DTSBD551 +02695 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT. DTSBD551 +02696 ADD +1 TO W-VALID-NEW-ADDR-CNT. DTSBD551 +02697 *** DISPLAY 'ADDR ERROR FOR ' W-EMP-NO. DTSBD551 +02698 DTSBD551 +02699 P1313C-EXIT. DTSBD551 +02700 EXIT. DTSBD551 +02701 DTSBD551 +02702 DTSBD551 +02703 P1320-FORMAT-T028. DTSBD551 +02704 MOVE W-EMP-NO TO T028-EMP-NO. DTSBD551 +02705 MOVE 'MAG UC30' TO T028-ORIGIN. DTSBD551 +02706 MOVE L005-DATE TO T028-SYS-DATE. DTSBD551 +02707 MOVE L005-TIME TO T028-SYS-TIME. DTSBD551 +02708 SET T028-ICESA-88 TO TRUE. DTSBD551 +02709 DTSBD551 +02710 *** IF W-PSEUDO-ITEM-NO < 999 DTSBD551 +02711 * ADD 1 TO W-PSEUDO-ITEM-NO DTSBD551 +02712 * ELSE DTSBD551 +02713 * ADD 1 TO W-PSEUDO-BATCH-NO DTSBD551 +02714 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSBD551 +02715 *** END-IF. DTSBD551 +02716 DTSBD551 +02717 ** MOVE W-PSEUDO-BATCH-NO TO T028-PSEUDO-BATCH-NO. DTSBD551 +02718 ** MOVE W-PSEUDO-ITEM-NO TO T028-PSEUDO-ITEM-NO. DTSBD551 +02719 DTSBD551 +02720 MOVE W-EMP-NAME (1:4) TO T028-NAME-CHECK. DTSBD551 +02721 *** MOVE MPRF-PRIMARY-NAME (1:4) TO T028-NAME-CHECK. DTSBD551 +02722 SET T028-ORIG-88 TO TRUE. DTSBD551 +02723 MOVE W-RPT-QTR TO T028-YRQ. DTSBD551 +02724 MOVE ZERO TO T028-TOT-WAGE DTSBD551 +02725 T028-EXCESS-WAGE DTSBD551 +02726 T028-TAX-WAGE DTSBD551 +02727 T028-REMIT-AMT. DTSBD551 +02728 DTSBD551 +02729 SET T028-WAIVE-BOTH-NO-88 TO TRUE. DTSBD551 +02730 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBD551 +02731 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBD551 +02732 MOVE ZERO TO T028-1ST-MTH-EMPL-CNT DTSBD551 +02733 T028-2ND-MTH-EMPL-CNT DTSBD551 +02734 T028-3RD-MTH-EMPL-CNT DTSBD551 +02735 T028-TOTAL-EMPL-CNT. DTSBD551 +02736 MOVE W-RECEIVED-DATE TO T028-RECEIVED-DATE. DTSBD551 +02737 *& DTSBD551 +02738 * IF W-EMP-NO = 153766 DTSBD551 +02739 * OR W-SUBM-CREATE-DATE NOT = W-RECEIVED-DATE DTSBD551 +02740 * DISPLAY 'EMP ' W-EMP-NO ' ' W-RECEIVED-DATE DTSBD551 +02741 * ' ' W-SUBM-CREATE-DATE DTSBD551 +02742 * END-IF. DTSBD551 +02743 *& DTSBD551 +02744 DTSBD551 +02745 MOVE W-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBD551 +02746 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 +02747 DTSBD551 +02748 SET L003-NOT-WORK-DAY TO TRUE. DTSBD551 +02749 PERFORM P1321-WORK-DAY-LOOP THRU P1321-EXIT DTSBD551 +02750 UNTIL L003-IS-WORK-DAY. DTSBD551 +02751 MOVE L001-FED-8-DATE-9 TO T028-DEPOSIT-DATE. DTSBD551 +02752 DTSBD551 +02753 MOVE ZERO TO T028-TRACE-NO. DTSBD551 +02754 DTSBD551 +02755 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBD551 +02756 MOVE 'MAG UC30' TO T028-RESPONSIBLE-OP-ID. DTSBD551 +02757 DTSBD551 +02758 P1320-EXIT. DTSBD551 +02759 EXIT. DTSBD551 +02760 DTSBD551 +02761 P1321-WORK-DAY-LOOP. DTSBD551 +02762 ADD +1 TO L001-JUL-ABS-DAY. DTSBD551 +02763 DTSBD551 +02764 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBD551 +02765 DTSBD551 +02766 MOVE L001-FED-8-DATE-9 TO L003-DATE. DTSBD551 +02767 DTSBD551 +02768 PERFORM S003-AGENCY-DAY THRU S003-EXIT. DTSBD551 +02769 DTSBD551 +02770 P1321-EXIT. DTSBD551 +02771 EXIT. DTSBD551 +02772 DTSBD551 +02773 DTSBD551 +02774 P1397-ADD-MNTE. DTSBD551 +02775 IF W-MNTE-STARTED-YES-88 DTSBD551 +02776 PERFORM P1397B-ADD-MSG THRU P1397B-EXIT DTSBD551 +02777 ELSE DTSBD551 +02778 PERFORM P1397A-INIT-MNTE THRU P1397A-EXIT DTSBD551 +02779 PERFORM P1397B-ADD-MSG THRU P1397B-EXIT DTSBD551 +02780 END-IF. DTSBD551 +02781 P1397-EXIT. DTSBD551 +02782 EXIT. DTSBD551 +02783 DTSBD551 +02784 P1397A-INIT-MNTE. DTSBD551 +02785 *& DTSBD551 +02786 * DISPLAY 'P1397 INIT MNTE ' W-EMP-NO. DTSBD551 +02787 *& DTSBD551 +02788 SET W-MNTE-STARTED-YES-88 TO TRUE. DTSBD551 +02789 DTSBD551 +02790 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBD551 +02791 MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBD551 +02792 SET MNTE-NTE-88 TO TRUE. DTSBD551 +02793 MOVE +0 TO MNTE-PURGE-DATE. DTSBD551 +02794 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBD551 +02795 DTSBD551 +02796 MOVE W-CURR-DATE TO MNTE-ESTB-DATE DTSBD551 +02797 MNTE-CHNG-DATE. DTSBD551 +02798 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBD551 +02799 MNTE-DATA-ESTB-ABSTIME DTSBD551 +02800 MNTE-CHNG-ABSTIME. DTSBD551 +02801 MOVE 'MAG UC30' TO MNTE-ESTB-OP-ID DTSBD551 +02802 MNTE-CHNG-OP-ID. DTSBD551 +02803 DTSBD551 +02804 MOVE W-MNTE-SUBJECT-ACCT TO MNTE-SUBJECT. DTSBD551 +02805 DTSBD551 +02806 P1397A-EXIT. DTSBD551 +02807 EXIT. DTSBD551 +02808 DTSBD551 +02809 P1397B-ADD-MSG. DTSBD551 +02810 ADD +1 TO W-MNTE-TEXT-CNT. DTSBD551 +02811 MOVE R551-MSG-TEXT TO W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 +02812 IF MNTE-SUBJECT = W-MNTE-SUBJECT-SSN DTSBD551 +02813 MOVE W-MNTE-SUBJECT-BOTH TO MNTE-SUBJECT DTSBD551 +02814 END-IF. DTSBD551 +02815 *& DTSBD551 +02816 * DISPLAY 'P1397B ADD ' W-EMP-NO DTSBD551 +02817 * ' ' W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 +02818 *& DTSBD551 +02819 DTSBD551 +02820 P1397B-EXIT. DTSBD551 +02821 EXIT. DTSBD551 +02822 DTSBD551 +02823 P1398-NON-FATAL-ERROR. DTSBD551 +02824 IF A-FEDERAL-EIN NUMERIC DTSBD551 +02825 MOVE A-FEDERAL-EIN TO R551-SUBMITTER-FEIN DTSBD551 +02826 ELSE DTSBD551 +02827 MOVE ZERO TO R551-SUBMITTER-FEIN DTSBD551 +02828 END-IF. DTSBD551 +02829 DTSBD551 +02830 MOVE A-NAME TO R551-SUBMITTER-NAME. DTSBD551 +02831 MOVE A-CONTACT TO R551-CONTACT-NAME. DTSBD551 +02832 MOVE A-CONTACT-PHONE TO R551-CONTACT-PHONE. DTSBD551 +02833 MOVE A-PHONE-BOX TO R551-CONTACT-PHONE-EXT. DTSBD551 +02834 DTSBD551 +02835 ** SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE. DTSBD551 +02836 MOVE ICESA-REC-TYPE TO R551-ICESA-REC-TYPE. DTSBD551 +02837 MOVE W-INPUT-READ-CNT TO R551-REC-NO. DTSBD551 +02838 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN. DTSBD551 +02839 MOVE E-NAME TO R551-EMP-NAME. DTSBD551 +02840 MOVE E-STREET TO R551-EMP-STREET. DTSBD551 +02841 MOVE E-CITY TO R551-EMP-CITY. DTSBD551 +02842 MOVE E-STATE TO R551-EMP-STATE. DTSBD551 +02843 MOVE E-ZIP-CODE TO R551-EMP-ZIP. DTSBD551 +02844 MOVE E-ZIP-CODE-EXT TO R551-EMP-ZIP-EXT. DTSBD551 +02845 DTSBD551 +02846 *** WRITE REPORT RECORD DTSBD551 +02847 MOVE R551-REC TO RSKL-REC. DTSBD551 +02848 PERFORM S946-RPT-1 THRU S946-EXIT. DTSBD551 +02849 DTSBD551 +02850 MOVE W-PSEUDO-BATCH-NO TO X216-PSEUDO-BATCH. DTSBD551 +02851 MOVE W-PSEUDO-ITEM-NO TO X216-PSEUDO-ITEM. DTSBD551 +02852 MOVE R551-SUBMITTER-NAME TO X216-SUBMITTER-NAME. DTSBD551 +02853 MOVE R551-SUBMITTER-FEIN TO X216-SUBMITTER-FEIN. DTSBD551 +02854 MOVE R551-CONTACT-NAME TO X216-CONTACT-NAME. DTSBD551 +02855 MOVE R551-CONTACT-PHONE TO X216-CONTACT-PHONE. DTSBD551 +02856 MOVE R551-CONTACT-PHONE-EXT TO X216-CONTACT-PHONE-EXT. DTSBD551 +02857 MOVE R551-ICESA-REC-TYPE TO X216-ICESA-REC-TYPE. DTSBD551 +02858 MOVE R551-MSG-TEXT TO X216-MSG-TEXT. DTSBD551 +02859 MOVE R551-EMP-FEIN TO X216-EMP-FEIN. DTSBD551 +02860 MOVE R551-EMP-NAME TO X216-EMP-NAME. DTSBD551 +02861 MOVE R551-EMP-STREET TO X216-EMP-STREET. DTSBD551 +02862 MOVE R551-EMP-CITY TO X216-EMP-CITY. DTSBD551 +02863 MOVE R551-EMP-STATE TO X216-EMP-STATE. DTSBD551 +02864 MOVE R551-EMP-ZIP TO X216-EMP-ZIP. DTSBD551 +02865 MOVE R551-EMP-ZIP-EXT TO X216-EMP-ZIP-EXT. DTSBD551 +02866 DTSBD551 +02867 INSPECT X216-SUBMITTER-NAME REPLACING ALL ',' BY ' '. DTSBD551 +02868 INSPECT X216-CONTACT-NAME REPLACING ALL ',' BY ' '. DTSBD551 +02869 INSPECT X216-MSG-TEXT REPLACING ALL ',' BY ' '. DTSBD551 +02870 INSPECT X216-EMP-NAME REPLACING ALL ',' BY ' '. DTSBD551 +02871 INSPECT X216-EMP-STREET REPLACING ALL ',' BY ' '. DTSBD551 +02872 INSPECT X216-EMP-CITY REPLACING ALL ',' BY ' '. DTSBD551 +02873 INSPECT X216-EMP-STATE REPLACING ALL ',' BY ' '. DTSBD551 +02874 DTSBD551 +02875 WRITE MESSAGE-REC FROM W-MESSAGE-REC. DTSBD551 +02876 IF MSG-STATUS-OK-88 DTSBD551 +02877 NEXT SENTENCE DTSBD551 +02878 ELSE DTSBD551 +02879 SET W-ERROR-YES-88 TO TRUE DTSBD551 +02880 DISPLAY 'CANNOT WRITE MESSAGE FILE: ' DTSBD551 +02881 MSG-STATUS DTSBD551 +02882 END-IF. DTSBD551 +02883 DTSBD551 +02884 P1398-EXIT. DTSBD551 +02885 EXIT. DTSBD551 +02886 DTSBD551 +02887 P1400-TYPE-S. DTSBD551 +02888 MOVE ICESA-REC TO WAGE-RECORD-S. DTSBD551 +02889 ADD +1 TO W-EMP-WAGE-CNT DTSBD551 +02890 W-ALL-WAGE-CNT. DTSBD551 +02891 *& DTSBD551 +02892 * DISPLAY 'TYPE S ' WAGE-RECORD-S (1:60). DTSBD551 +02893 *& DTSBD551 +02894 DTSBD551 +02895 IF W-PREV-REC-TYPE-E-88 DTSBD551 +02896 IF W-WAGES-EXPECTED-NO-88 DTSBD551 +02897 * DISPLAY 'TYPE S: WAGES NOT EXPECTED: ' DTSBD551 +02898 * W-WAGES-EXPECTED-IND DTSBD551 +02899 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02900 MOVE W-WAGES-EXPECTED-IND TO MSG-S1-WAGES-EXP-IND DTSBD551 +02901 MOVE MSG-S1 TO R551-MSG-TEXT DTSBD551 +02902 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02903 GO TO P1400-EXIT DTSBD551 +02904 END-IF DTSBD551 +02905 ELSE DTSBD551 +02906 IF W-PREV-REC-TYPE-S-88 DTSBD551 +02907 NEXT SENTENCE DTSBD551 +02908 ELSE DTSBD551 +02909 * DISPLAY 'TYPE S: PREVIOUS REC TYPE NOT E OR S: ' DTSBD551 +02910 * W-PREV-REC-TYPE DTSBD551 +02911 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02912 MOVE W-PREV-REC-TYPE TO MSG-S2-REC-TYPE DTSBD551 +02913 MOVE MSG-S2 TO R551-MSG-TEXT DTSBD551 +02914 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02915 GO TO P1400-EXIT DTSBD551 +02916 END-IF DTSBD551 +02917 END-IF. DTSBD551 +02918 SET W-PREV-REC-TYPE-S-88 TO TRUE. DTSBD551 +02919 DTSBD551 +02920 IF W-ERROR-NO-88 DTSBD551 +02921 PERFORM P1410-EDIT-TYPE-S THRU P1410-EXIT DTSBD551 +02922 IF W-ERROR-NO-88 DTSBD551 +02923 PERFORM P1420-FORMAT-W001 THRU P1420-EXIT DTSBD551 +02924 ELSE DTSBD551 +02925 ADD +1 TO W-WAGE-ERROR-CNT DTSBD551 +02926 END-IF DTSBD551 +02927 END-IF. DTSBD551 +02928 DTSBD551 +02929 P1400-EXIT. DTSBD551 +02930 EXIT. DTSBD551 +02931 DTSBD551 +02932 P1410-EDIT-TYPE-S. DTSBD551 +02933 * DISPLAY 'P1410-TYEP S ' DTSBD551 +02934 MOVE S-SSN TO W-SSN-IN. DTSBD551 +02935 PERFORM P1411-TYPE-S-SSN THRU P1411-EXIT. DTSBD551 +02936 DTSBD551 +02937 *** IF S-SSN NOT NUMERIC DTSBD551 +02938 * DISPLAY 'TYPE S: NON-NUMERIC SSN ' S-SSN DTSBD551 +02939 * MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02940 * MOVE S-SSN TO MSG-S3-SSN DTSBD551 +02941 * MOVE MSG-S3 TO R551-MSG-TEXT DTSBD551 +02942 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02943 *** END-IF. DTSBD551 +02944 DTSBD551 +02945 IF S-STATE-CODE NOT = '11' DTSBD551 +02946 * DISPLAY 'TYPE S: STATE CODE NOT DC ' DTSBD551 +02947 * S-STATE-CODE DTSBD551 +02948 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02949 MOVE S-STATE-CODE TO MSG-S5-STATE-CODE DTSBD551 +02950 MOVE MSG-S5 TO R551-MSG-TEXT DTSBD551 +02951 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02952 END-IF. DTSBD551 +02953 DTSBD551 +02954 IF S-UNEMP-WAGE NOT NUMERIC DTSBD551 +02955 * DISPLAY 'TYPE S: NON-NUMERIC TOT WAGE ' S-UNEMP-WAGE DTSBD551 +02956 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02957 * MOVE S-UNEMP-WAGE TO MSG-S6-UNEMP-WAGE DTSBD551 +02958 MOVE S-SSN TO MSG-S6-SSN DTSBD551 +02959 MOVE W-EMP-NO TO MSG-S6-EMP-NO DTSBD551 +02960 MOVE MSG-S6 TO R551-MSG-TEXT DTSBD551 +02961 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02962 ELSE DTSBD551 +02963 MOVE S-UNEMP-WAGE TO W-TYPE-S-TOT-WAGE DTSBD551 +02964 ADD W-TYPE-S-TOT-WAGE TO W-EMP-TOT-WAGE DTSBD551 +02965 W-ALL-TOT-WAGE DTSBD551 +02966 IF W-TYPE-S-TOT-WAGE = ZERO DTSBD551 +02967 DISPLAY W-EMP-NO ' ' S-SSN ' TOT WAGE = 0' DTSBD551 +02968 GO TO P1410-EXIT DTSBD551 +02969 END-IF DTSBD551 +02970 END-IF. DTSBD551 +02971 DTSBD551 +02972 IF S-TAXABLE-WAGE NOT NUMERIC DTSBD551 +02973 * DISPLAY 'TYPE S: NON-NUMERIC TAX WAGE ' S-TAXABLE-WAGE DTSBD551 +02974 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02975 * MOVE S-TAXABLE-WAGE TO MSG-S7-TAXABLE-WAGE DTSBD551 +02976 MOVE S-SSN TO MSG-S7-SSN DTSBD551 +02977 MOVE W-EMP-NO TO MSG-S7-EMP-NO DTSBD551 +02978 MOVE MSG-S7 TO R551-MSG-TEXT DTSBD551 +02979 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02980 ELSE DTSBD551 +02981 MOVE S-TAXABLE-WAGE TO W-TYPE-S-TAX-WAGE DTSBD551 +02982 ADD W-TYPE-S-TAX-WAGE TO W-EMP-TAX-WAGE DTSBD551 +02983 END-IF. DTSBD551 +02984 DTSBD551 +02985 MOVE S-ACCOUNT-NO TO W-ACCT-NBR-IN. DTSBD551 +02986 PERFORM S2200-TYPE-S-ACCT-NBR THRU S2200-EXIT. DTSBD551 +02987 DTSBD551 +02988 MOVE S-REPT-CNTRY TO W-REPORT-CC. DTSBD551 +02989 MOVE S-REPT-YR TO W-REPORT-YY. DTSBD551 +02990 MOVE S-REPT-MTH TO W-REPORT-MM-X. DTSBD551 +02991 PERFORM S2100-REPORT-QTR THRU S2100-EXIT. DTSBD551 +02992 DTSBD551 +02993 IF S-EMPLOYEE-INFO = LOW-VALUES OR SPACES DTSBD551 +02994 * DISPLAY 'TYPE S: WORKER NAME MISSING' DTSBD551 +02995 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +02996 MOVE MSG-S4 TO R551-MSG-TEXT DTSBD551 +02997 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +02998 END-IF. DTSBD551 +02999 DTSBD551 +03000 P1410-EXIT. DTSBD551 +03001 EXIT. DTSBD551 +03002 DTSBD551 +03003 P1411-TYPE-S-SSN. DTSBD551 +03004 MOVE ZERO TO SUB2. DTSBD551 +03005 MOVE SPACES TO W-SSN-OUT. DTSBD551 +03006 SET W-SSN-ERR-NO-88 TO TRUE. DTSBD551 +03007 DTSBD551 +03008 PERFORM DTSBD551 +03009 VARYING SUB1 FROM +1 BY +1 DTSBD551 +03010 UNTIL SUB1 > W-SSN-LEN DTSBD551 +03011 IF W-SSN-IN-X (SUB1) >= '0' DTSBD551 +03012 AND W-SSN-IN-X (SUB1) <= '9' DTSBD551 +03013 IF SUB2 < W-SSN-LEN DTSBD551 +03014 ADD +1 TO SUB2 DTSBD551 +03015 MOVE W-SSN-IN-X (SUB1) TO W-SSN-OUT-X (SUB2) DTSBD551 +03016 END-IF DTSBD551 +03017 ELSE DTSBD551 +03018 DISPLAY 'BAD SSN ' W-INPUT-READ-CNT DTSBD551 +03019 ' ' S-SSN DTSBD551 +03020 END-IF DTSBD551 +03021 END-PERFORM. DTSBD551 +03022 DTSBD551 +03023 IF SUB2 = ZERO DTSBD551 +03024 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03025 MOVE S-SSN TO MSG-S11-SSN DTSBD551 +03026 MOVE W-EMP-NO TO MSG-S11-EMP-NO DTSBD551 +03027 MOVE MSG-S11 TO R551-MSG-TEXT DTSBD551 +03028 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +03029 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +03030 PERFORM P1497-ADD-MNTE THRU P1497-EXIT DTSBD551 +03031 MOVE ZERO TO S-SSN DTSBD551 +03032 ELSE DTSBD551 +03033 IF SUB2 < W-SSN-LEN DTSBD551 +03034 SET W-SSN-ERR-YES-88 TO TRUE DTSBD551 +03035 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03036 MOVE S-SSN TO MSG-S12-SSN DTSBD551 +03037 MOVE W-EMP-NO TO MSG-S12-EMP-NO DTSBD551 +03038 MOVE MSG-S12 TO R551-MSG-TEXT DTSBD551 +03039 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +03040 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +03041 PERFORM P1497-ADD-MNTE THRU P1497-EXIT DTSBD551 +03042 MOVE ZERO TO S-SSN DTSBD551 +03043 END-IF DTSBD551 +03044 END-IF. DTSBD551 +03045 DTSBD551 +03046 P1411-EXIT. DTSBD551 +03047 EXIT. DTSBD551 +03048 DTSBD551 +03049 P1420-FORMAT-W001. DTSBD551 +03050 IF W-TYPE-S-TOT-WAGE = ZERO DTSBD551 +03051 ADD +1 TO W-ZERO-WAGE-CNT DTSBD551 +03052 * DISPLAY 'TYPE S: BYPASSING ZERO WAGE RECORD ' DTSBD551 +03053 * ' SSN: ' S-SSN ' EMP: ' W-EMP-NO DTSBD551 +03054 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03055 MOVE S-SSN TO MSG-S8-SSN DTSBD551 +03056 MOVE W-EMP-NO TO MSG-S8-EMP-NO DTSBD551 +03057 MOVE MSG-S8 TO R551-MSG-TEXT DTSBD551 +03058 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +03059 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +03060 GO TO P1420-EXIT DTSBD551 +03061 END-IF. DTSBD551 +03062 DTSBD551 +03063 ************************************************************ DTSBD551 +03064 * MODIFIED TO WRITE TRANSACTIONS WHEN THE SSN = ZERO. DTSBD551 +03065 * DTSBD551 +03066 ************************************************************ DTSBD551 +03067 IF S-SSN = ZERO DTSBD551 +03068 ADD +1 TO W-MISSING-SSN-CNT DTSBD551 +03069 *** GO TO P1420-EXIT DTSBD551 +03070 END-IF. DTSBD551 +03071 DTSBD551 +03072 MOVE W-PSEUDO-BATCH-NO TO W001-BATCH-NO. DTSBD551 +03073 MOVE W-PSEUDO-ITEM-NO TO W001-ITEM-NO. DTSBD551 +03074 ADD 1 TO W-SEQ-NO. DTSBD551 +03075 MOVE W-SEQ-NO TO W001-SEQ-NO. DTSBD551 +03076 MOVE W-EMP-NO TO W001-EMP-NO. DTSBD551 +03077 MOVE S-SSN TO W001-SSN. DTSBD551 +03078 SET W001-SSN-VALID-88 TO TRUE. DTSBD551 +03079 MOVE S-FIRST-NAME TO W001-FIRST-NAME. DTSBD551 +03080 MOVE S-MIDDLE-INIT TO W001-MID-INIT. DTSBD551 +03081 MOVE S-LAST-NAME TO W001-LAST-NAME. DTSBD551 +03082 INSPECT W001-LAST-NAME REPLACING ALL ',' BY ' '. DTSBD551 +03083 INSPECT W001-FIRST-NAME REPLACING ALL ',' BY ' '. DTSBD551 +03084 INSPECT W001-MID-INIT REPLACING ALL ',' BY ' '. DTSBD551 +03085 SET W001-NAME-VALID-88 TO TRUE. DTSBD551 +03086 MOVE W-RPT-QTR TO W001-YRQ. DTSBD551 +03087 MOVE W-TYPE-S-TOT-WAGE TO W001-WAGE-CHNG. DTSBD551 +03088 MOVE W-TYPE-S-TAX-WAGE TO W001-TAX-WAGE. DTSBD551 +03089 SET W001-WAGE-VALID-88 TO TRUE. DTSBD551 +03090 MOVE ZERO TO W001-CURR-WAGE DTSBD551 +03091 W001-PRIOR-WAGE. DTSBD551 +03092 MOVE T028-RECEIVED-DATE TO W001-RECEIVED-DATE. DTSBD551 +03093 MOVE L005-TIME TO W001-RECEIVED-TIME. DTSBD551 +03094 MOVE 'MAG UC30' TO W001-RESPONSIBLE-OP-ID. DTSBD551 +03095 SET W001-ICESA-88 TO TRUE. DTSBD551 +03096 DTSBD551 +03097 SET WAGE-TEMP-REQ-WRITE-88 TO TRUE. DTSBD551 +03098 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT. DTSBD551 +03099 DTSBD551 +03100 P1420-EXIT. DTSBD551 +03101 EXIT. DTSBD551 +03102 DTSBD551 +03103 P1497-ADD-MNTE. DTSBD551 +03104 IF W-MNTE-STARTED-YES-88 DTSBD551 +03105 PERFORM P1497B-ADD-MSG THRU P1497B-EXIT DTSBD551 +03106 ELSE DTSBD551 +03107 PERFORM P1497A-INIT-MNTE THRU P1497A-EXIT DTSBD551 +03108 PERFORM P1497B-ADD-MSG THRU P1497B-EXIT DTSBD551 +03109 END-IF. DTSBD551 +03110 P1497-EXIT. DTSBD551 +03111 EXIT. DTSBD551 +03112 DTSBD551 +03113 P1497A-INIT-MNTE. DTSBD551 +03114 *& DTSBD551 +03115 * DISPLAY 'P1497 INIT MNTE ' W-EMP-NO. DTSBD551 +03116 *& DTSBD551 +03117 SET W-MNTE-STARTED-YES-88 TO TRUE. DTSBD551 +03118 DTSBD551 +03119 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBD551 +03120 MOVE W-EMP-NO TO MNTE-EMP-NO. DTSBD551 +03121 SET MNTE-NTE-88 TO TRUE. DTSBD551 +03122 MOVE +0 TO MNTE-PURGE-DATE. DTSBD551 +03123 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBD551 +03124 DTSBD551 +03125 MOVE W-CURR-DATE TO MNTE-ESTB-DATE DTSBD551 +03126 MNTE-CHNG-DATE. DTSBD551 +03127 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBD551 +03128 MNTE-DATA-ESTB-ABSTIME DTSBD551 +03129 MNTE-CHNG-ABSTIME. DTSBD551 +03130 MOVE 'MAG UC30' TO MNTE-ESTB-OP-ID DTSBD551 +03131 MNTE-CHNG-OP-ID. DTSBD551 +03132 DTSBD551 +03133 MOVE W-MNTE-SUBJECT-SSN TO MNTE-SUBJECT. DTSBD551 +03134 DTSBD551 +03135 P1497A-EXIT. DTSBD551 +03136 EXIT. DTSBD551 +03137 DTSBD551 +03138 P1497B-ADD-MSG. DTSBD551 +03139 ADD +1 TO W-MNTE-TEXT-CNT. DTSBD551 +03140 MOVE R551-MSG-TEXT TO W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 +03141 IF MNTE-SUBJECT = W-MNTE-SUBJECT-ACCT DTSBD551 +03142 MOVE W-MNTE-SUBJECT-BOTH TO MNTE-SUBJECT DTSBD551 +03143 END-IF. DTSBD551 +03144 *& DTSBD551 +03145 * DISPLAY 'P1497B ADD ' W-EMP-NO DTSBD551 +03146 * ' ' W-MNTE-TEXT (W-MNTE-TEXT-CNT). DTSBD551 +03147 *& DTSBD551 +03148 DTSBD551 +03149 P1497B-EXIT. DTSBD551 +03150 EXIT. DTSBD551 +03151 DTSBD551 +03152 P1500-TYPE-T. DTSBD551 +03153 *& DTSBD551 +03154 * DISPLAY 'P1500-TYEP T ' DTSBD551 +03155 IF E-FEDERAL-EIN = 232720862 OR 383271169 DTSBD551 +03156 DISPLAY 'P1500 ' E-FEDERAL-EIN DTSBD551 +03157 ' ' T-TOT-PMT-DUE ' ' T-TAX-DUE DTSBD551 +03158 ' ' T-EMPLOYER-ASSESS-AMT DTSBD551 +03159 END-IF. DTSBD551 +03160 *& DTSBD551 +03161 MOVE ICESA-REC TO WAGE-RECORD-T. DTSBD551 +03162 ADD +1 TO W-ALL-EMP-CNT. DTSBD551 +03163 MOVE ZERO TO W-TYPE-T-TAX-DUE. DTSBD551 +03164 *& DTSBD551 +03165 * IF E-ACCOUNT-NO = '025391' DTSBD551 +03166 * DISPLAY 'TYPE T ' WAGE-RECORD-T (1:60). DTSBD551 +03167 *& DTSBD551 +03168 DTSBD551 +03169 IF W-PREV-REC-TYPE-E-88 DTSBD551 +03170 OR W-PREV-REC-TYPE-S-88 DTSBD551 +03171 SET W-PREV-REC-TYPE-T-88 TO TRUE DTSBD551 +03172 ELSE DTSBD551 +03173 DISPLAY 'TYPE T: PREVIOUS REC TYPE NOT E OR S: ' DTSBD551 +03174 W-PREV-REC-TYPE DTSBD551 +03175 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03176 MOVE W-PREV-REC-TYPE TO MSG-T1-REC-TYPE DTSBD551 +03177 MOVE MSG-T1 TO R551-MSG-TEXT DTSBD551 +03178 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03179 GO TO P1500-EXIT DTSBD551 +03180 END-IF. DTSBD551 +03181 DTSBD551 +03182 IF W-ERROR-YES-88 DTSBD551 +03183 GO TO P1500-EXIT DTSBD551 +03184 END-IF. DTSBD551 +03185 DTSBD551 +03186 *& DTSBD551 +03187 * IF E-ACCOUNT-NO = '025391' DTSBD551 +03188 * DISPLAY ' TYPE T ' W-EMP-TOT-WAGE DTSBD551 +03189 * ' LIAB ' W-LIABLE-IND DTSBD551 +03190 * ' FND ' W-EMP-FOUND-IND DTSBD551 +03191 * ' DUP ' W-DUP-RPT-IND. DTSBD551 +03192 *& DTSBD551 +03193 IF T-TOT-PMT-DUE NOT = ZERO DTSBD551 +03194 OR T-TAX-DUE NOT = ZERO DTSBD551 +03195 OR T-EMPLOYER-ASSESS-AMT NOT = ZERO DTSBD551 +03196 NEXT SENTENCE DTSBD551 +03197 ELSE DTSBD551 +03198 IF W-EMP-TOT-WAGE = ZERO DTSBD551 +03199 IF W-LIABLE-NO-88 DTSBD551 +03200 OR W-EMP-FOUND-NO-88 DTSBD551 +03201 OR W-DUP-RPT-YES-88 DTSBD551 +03202 ** OR W-SUCCESSOR-YES-88 DTSBD551 +03203 PERFORM P1580-ZERO-WAGE THRU P1580-EXIT DTSBD551 +03204 GO TO P1500-EXIT DTSBD551 +03205 END-IF DTSBD551 +03206 END-IF DTSBD551 +03207 END-IF. DTSBD551 +03208 DTSBD551 +03209 PERFORM P1510-EDIT-TYPE-T THRU P1510-EXIT DTSBD551 +03210 IF W-ERROR-NO-88 DTSBD551 +03211 PERFORM P1520-SET-WAGE-FILES THRU P1520-EXIT DTSBD551 +03212 IF W-ERROR-NO-88 DTSBD551 +03213 PERFORM P1530-COPY-WAGES THRU P1530-EXIT DTSBD551 +03214 IF W-ERROR-NO-88 DTSBD551 +03215 PERFORM P1540-WRITE-T028 THRU P1540-EXIT DTSBD551 +03216 PERFORM P1550-CONTACT THRU P1550-EXIT DTSBD551 +03217 PERFORM P1560-MNTE THRU P1560-EXIT DTSBD551 +03218 *** PERFORM P1570-UPD-LOG THRU P1570-EXIT DTSBD551 +03219 PERFORM P1590-EMP-RPT-REC THRU P1590-EXIT DTSBD551 +03220 END-IF DTSBD551 +03221 END-IF DTSBD551 +03222 ELSE DTSBD551 +03223 ADD +1 TO W-EMP-ERROR-CNT DTSBD551 +03224 END-IF. DTSBD551 +03225 DTSBD551 +03226 P1500-EXIT. DTSBD551 +03227 EXIT. DTSBD551 +03228 DTSBD551 +03229 P1510-EDIT-TYPE-T. DTSBD551 +03230 IF T-TOT-EMPLOYEE NOT NUMERIC DTSBD551 +03231 DISPLAY 'TYPE T: NON-NUMERIC TOT WORKERS ' DTSBD551 +03232 T-TOT-EMPLOYEE DTSBD551 +03233 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03234 MOVE T-TOT-EMPLOYEE TO MSG-T2-TOT-EMPLOYEE DTSBD551 +03235 MOVE MSG-T2 TO R551-MSG-TEXT DTSBD551 +03236 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03237 ELSE DTSBD551 +03238 MOVE T-TOT-EMPLOYEE TO W-TYPE-T-TOT-WORKER DTSBD551 +03239 END-IF. DTSBD551 +03240 DTSBD551 +03241 IF T-TOTAL-WAGE NOT NUMERIC DTSBD551 +03242 * DISPLAY 'TYPE T: NON-NUMERIC TOT WAGE ' T-TOTAL-WAGE DTSBD551 +03243 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03244 MOVE E-ACCOUNT-NO TO MSG-T3-EMP-NO DTSBD551 +03245 MOVE MSG-T3 TO R551-MSG-TEXT DTSBD551 +03246 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03247 ELSE DTSBD551 +03248 MOVE T-TOTAL-WAGE TO W-TYPE-T-TOT-WAGE DTSBD551 +03249 END-IF. DTSBD551 +03250 DTSBD551 +03251 IF T-TAXABLE-WAGE NOT NUMERIC DTSBD551 +03252 * DISPLAY 'TYPE T: NON-NUMERIC TAX WAGE ' T-TAXABLE-WAGE DTSBD551 +03253 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03254 MOVE E-ACCOUNT-NO TO MSG-T4-EMP-NO DTSBD551 +03255 MOVE MSG-T4 TO R551-MSG-TEXT DTSBD551 +03256 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03257 ELSE DTSBD551 +03258 MOVE T-TAXABLE-WAGE TO W-TYPE-T-TAX-WAGE DTSBD551 +03259 END-IF. DTSBD551 +03260 DTSBD551 +03261 MOVE T-TAX-RATE TO W-TYPE-T-RATE-X. DTSBD551 +03262 IF W-TYPE-T-RATE-9 NOT NUMERIC DTSBD551 +03263 IF MPRF-CLASS-SELF-INS-88 DTSBD551 +03264 NEXT SENTENCE DTSBD551 +03265 ELSE DTSBD551 +03266 * DISPLAY 'TYPE T: NON-NUMERIC TAX RATE IGNORED ' DTSBD551 +03267 * T-TAX-RATE DTSBD551 +03268 MOVE SPACES TO W-TYPE-T-RATE-X DTSBD551 +03269 END-IF DTSBD551 +03270 ELSE DTSBD551 +03271 COMPUTE W-EMP-TAX-RATE = (W-TYPE-T-RATE-9 / 100000) DTSBD551 +03272 END-IF. DTSBD551 +03273 DTSBD551 +03274 INSPECT T-MONTH-1 REPLACING ALL SPACE BY ZERO. DTSBD551 +03275 IF T-MONTH-1 NOT NUMERIC DTSBD551 +03276 * DISPLAY 'TYPE T: NON-NUMERIC MONTH 1 ' T-MONTH-1 DTSBD551 +03277 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03278 MOVE T-MONTH-1 TO MSG-T9-NON-NUM-MONTH1 DTSBD551 +03279 MOVE MSG-T9 TO R551-MSG-TEXT DTSBD551 +03280 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03281 ELSE DTSBD551 +03282 MOVE T-MONTH-1 TO W-MONTH-1-CNT-X DTSBD551 +03283 END-IF. DTSBD551 +03284 DTSBD551 +03285 INSPECT T-MONTH-2 REPLACING ALL SPACE BY ZERO. DTSBD551 +03286 IF T-MONTH-2 NOT NUMERIC DTSBD551 +03287 * DISPLAY 'TYPE T: NON-NUMERIC MONTH 2 ' T-MONTH-2 DTSBD551 +03288 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03289 MOVE T-MONTH-2 TO MSG-T10-NON-NUM-MONTH2 DTSBD551 +03290 MOVE MSG-T10 TO R551-MSG-TEXT DTSBD551 +03291 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03292 ELSE DTSBD551 +03293 MOVE T-MONTH-2 TO W-MONTH-2-CNT-X DTSBD551 +03294 END-IF. DTSBD551 +03295 DTSBD551 +03296 INSPECT T-MONTH-3 REPLACING ALL SPACE BY ZERO. DTSBD551 +03297 IF T-MONTH-3 NOT NUMERIC DTSBD551 +03298 * DISPLAY 'TYPE T: NON-NUMERIC MONTH 3 ' T-MONTH-3 DTSBD551 +03299 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03300 MOVE T-MONTH-3 TO MSG-T11-NON-NUM-MONTH3 DTSBD551 +03301 MOVE MSG-T11 TO R551-MSG-TEXT DTSBD551 +03302 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03303 ELSE DTSBD551 +03304 MOVE T-MONTH-3 TO W-MONTH-3-CNT-X DTSBD551 +03305 END-IF. DTSBD551 +03306 DTSBD551 +03307 IF W-ERROR-NO-88 DTSBD551 +03308 PERFORM P1511-CROSS-EDITS THRU P1511-EXIT DTSBD551 +03309 END-IF. DTSBD551 +03310 DTSBD551 +03311 PERFORM P1512-PAYMENT THRU P1512-EXIT. DTSBD551 +03312 DTSBD551 +03313 P1510-EXIT. DTSBD551 +03314 EXIT. DTSBD551 +03315 DTSBD551 +03316 P1511-CROSS-EDITS. DTSBD551 +03317 * DISPLAY 'P1511-TYEP T ' DTSBD551 +03318 IF W-TYPE-T-TOT-WAGE NOT = W-EMP-TOT-WAGE DTSBD551 +03319 COMPUTE W-DIFFERENCE = DTSBD551 +03320 (W-TYPE-T-TOT-WAGE - W-EMP-TOT-WAGE) DTSBD551 +03321 IF W-DIFFERENCE > +0.99 DTSBD551 +03322 OR W-DIFFERENCE < -0.99 DTSBD551 +03323 * DISPLAY 'TYPE T: TOT WAGE NOT = TYPE S SUM ' DTSBD551 +03324 * DISPLAY ' TYPE T: ' W-TYPE-T-TOT-WAGE DTSBD551 +03325 * ' TYPE S: ' W-EMP-TOT-WAGE DTSBD551 +03326 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03327 MOVE W-TYPE-T-TOT-WAGE TO MSG-T12-TOT-WAGES DTSBD551 +03328 MOVE W-EMP-TOT-WAGE TO MSG-T12-S-SUM DTSBD551 +03329 MOVE MSG-T12 TO R551-MSG-TEXT DTSBD551 +03330 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03331 END-IF DTSBD551 +03332 END-IF. DTSBD551 +03333 DTSBD551 +03334 IF W-TYPE-T-TAX-WAGE NOT = W-EMP-TAX-WAGE DTSBD551 +03335 COMPUTE W-DIFFERENCE = DTSBD551 +03336 (W-TYPE-T-TAX-WAGE - W-EMP-TAX-WAGE) DTSBD551 +03337 IF W-DIFFERENCE > +0.99 DTSBD551 +03338 OR W-DIFFERENCE < -0.99 DTSBD551 +03339 * DISPLAY 'TYPE T: TAX WAGE NOT = TYPE S SUM ' DTSBD551 +03340 * DISPLAY ' TYPE T: ' W-TYPE-T-TAX-WAGE DTSBD551 +03341 * ' TYPE S: ' W-EMP-TAX-WAGE DTSBD551 +03342 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03343 MOVE W-TYPE-T-TAX-WAGE TO MSG-T13-TAX-WAGES DTSBD551 +03344 MOVE W-EMP-TAX-WAGE TO MSG-T13-S-SUM DTSBD551 +03345 MOVE MSG-T13 TO R551-MSG-TEXT DTSBD551 +03346 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03347 END-IF DTSBD551 +03348 END-IF. DTSBD551 +03349 DTSBD551 +03350 IF W-EMP-TAX-WAGE > W-EMP-TOT-WAGE DTSBD551 +03351 * DISPLAY 'TYPE T: TAX WAGE > TOT WAGE ' DTSBD551 +03352 * DISPLAY ' TOT: ' W-EMP-TOT-WAGE DTSBD551 +03353 * ' TAX: ' W-EMP-TAX-WAGE DTSBD551 +03354 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03355 MOVE W-EMP-TAX-WAGE TO MSG-T14-TAX-WAGES DTSBD551 +03356 MOVE W-EMP-TOT-WAGE TO MSG-T14-TOT-WAGES DTSBD551 +03357 MOVE MSG-T14 TO R551-MSG-TEXT DTSBD551 +03358 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03359 END-IF. DTSBD551 +03360 DTSBD551 +03361 IF W-TYPE-T-TOT-WORKER NOT = W-EMP-WAGE-CNT DTSBD551 +03362 *** IF W-TYPE-T-TOT-WORKER NOT = W-ALL-WAGE-CNT DTSBD551 +03363 * DISPLAY 'TYPE T: WORKER COUNTS INCONSISTENT ' DTSBD551 +03364 * DISPLAY ' TYPE T TOTAL: ' W-TYPE-T-TOT-WORKER DTSBD551 +03365 * ' SUM OF TYPE S: ' W-EMP-WAGE-CNT DTSBD551 +03366 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03367 MOVE W-TYPE-T-TOT-WORKER TO MSG-T15-T-COUNT DTSBD551 +03368 MOVE W-EMP-WAGE-CNT TO MSG-T15-S-COUNT DTSBD551 +03369 MOVE MSG-T15 TO R551-MSG-TEXT DTSBD551 +03370 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03371 END-IF. DTSBD551 +03372 DTSBD551 +03373 P1511-EXIT. DTSBD551 +03374 EXIT. DTSBD551 +03375 DTSBD551 +03376 P1512-PAYMENT. DTSBD551 +03377 IF MPRF-CLASS-SELF-INS-88 DTSBD551 +03378 PERFORM P1512A-SELF-INS THRU P1512A-EXIT DTSBD551 +03379 ELSE DTSBD551 +03380 PERFORM P1512B-RATED THRU P1512B-EXIT DTSBD551 +03381 END-IF. DTSBD551 +03382 DTSBD551 +03383 P1512-EXIT. DTSBD551 +03384 EXIT. DTSBD551 +03385 DTSBD551 +03386 P1512A-SELF-INS. DTSBD551 +03387 MOVE ZERO TO W-TYPE-T-PMT-DUE DTSBD551 +03388 W-TYPE-T-TAX-DUE DTSBD551 +03389 W-TYPE-T-ASSESS DTSBD551 +03390 W-CALC-EMP-REMITTANCE. DTSBD551 +03391 DTSBD551 +03392 IF T-TOT-PMT-DUE NUMERIC DTSBD551 +03393 MOVE T-TOT-PMT-DUE TO W-TYPE-T-PMT-DUE DTSBD551 +03394 END-IF. DTSBD551 +03395 DTSBD551 +03396 IF T-TAX-DUE NUMERIC DTSBD551 +03397 MOVE T-TAX-DUE TO W-TYPE-T-TAX-DUE DTSBD551 +03398 END-IF. DTSBD551 +03399 DTSBD551 +03400 IF W-TYPE-T-PMT-DUE > ZERO DTSBD551 +03401 MOVE W-TYPE-T-PMT-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 +03402 ADD W-TYPE-T-PMT-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03403 ELSE DTSBD551 +03404 MOVE W-TYPE-T-TAX-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 +03405 ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03406 MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X DTSBD551 +03407 IF W-TYPE-T-ASSESS NUMERIC DTSBD551 +03408 ADD W-TYPE-T-ASSESS TO W-CALC-TOT-REMITTANCE DTSBD551 +03409 W-CALC-EMP-REMITTANCE DTSBD551 +03410 END-IF DTSBD551 +03411 END-IF. DTSBD551 +03412 DTSBD551 +03413 IF W-CALC-EMP-REMITTANCE > ZERO DTSBD551 +03414 MOVE T-TOT-PMT-DUE TO W-TYPE-T-TAX-DUE DTSBD551 +03415 MOVE W-EMP-NO TO MSG-T16-EMP-NO DTSBD551 +03416 MOVE T-TAX-DUE TO MSG-T16-REMIT DTSBD551 +03417 MOVE MSG-T16 TO R551-MSG-TEXT DTSBD551 +03418 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +03419 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +03420 ADD +1 TO W-SI-WITH-REMIT-CNT DTSBD551 +03421 END-IF. DTSBD551 +03422 DTSBD551 +03423 * MOVE W-CALC-EMP-REMITTANCE TO W-AMT-DISP1. DTSBD551 +03424 * DISPLAY 'P1512A SI: ' T028-EMP-NO ' ' W-AMT-DISP1. DTSBD551 +03425 * IF T-TOT-PMT-DUE NUMERIC DTSBD551 +03426 * IF T-TOT-PMT-DUE > ZERO DTSBD551 +03427 * MOVE T-TOT-PMT-DUE TO W-TYPE-T-TAX-DUE DTSBD551 +03428 * ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03429 * MOVE W-EMP-NO TO MSG-T16-EMP-NO DTSBD551 +03430 * MOVE T-TAX-DUE TO MSG-T16-REMIT DTSBD551 +03431 * MOVE MSG-T16 TO R551-MSG-TEXT DTSBD551 +03432 * SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +03433 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +03434 * ADD +1 TO W-SI-WITH-REMIT-CNT DTSBD551 +03435 * END-IF DTSBD551 +03436 * ELSE DTSBD551 +03437 * IF T-TAX-DUE NUMERIC DTSBD551 +03438 * IF T-TAX-DUE > ZERO DTSBD551 +03439 * MOVE T-TAX-DUE TO W-TYPE-T-TAX-DUE DTSBD551 +03440 * ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03441 * MOVE W-EMP-NO TO MSG-T16-EMP-NO DTSBD551 +03442 * MOVE T-TAX-DUE TO MSG-T16-REMIT DTSBD551 +03443 * MOVE MSG-T16 TO R551-MSG-TEXT DTSBD551 +03444 * SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +03445 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +03446 * ADD +1 TO W-SI-WITH-REMIT-CNT DTSBD551 +03447 * END-IF DTSBD551 +03448 * END-IF DTSBD551 +03449 * END-IF. DTSBD551 +03450 * DTSBD551 +03451 * MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X. DTSBD551 +03452 ** IF W-TYPE-T-ASSESS NUMERIC DTSBD551 +03453 * IF W-TYPE-T-ASSESS > ZERO DTSBD551 +03454 *& ADD W-TYPE-T-ASSESS TO W-TYPE-T-TAX-DUE DTSBD551 +03455 *& ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03456 * MOVE W-TYPE-T-ASSESS TO W-AMT-DISP1 DTSBD551 +03457 * DISPLAY 'P1512A SI ASSESSMENT ' W-EMP-NO DTSBD551 +03458 * ' ' W-AMT-DISP1 DTSBD551 +03459 * END-IF DTSBD551 +03460 ** END-IF. DTSBD551 +03461 DTSBD551 +03462 P1512A-EXIT. DTSBD551 +03463 EXIT. DTSBD551 +03464 DTSBD551 +03465 P1512B-RATED. DTSBD551 +03466 * DISPLAY 'P1512B-TYEP T ' DTSBD551 +03467 MOVE ZERO TO W-TYPE-T-PMT-DUE DTSBD551 +03468 W-TYPE-T-TAX-DUE DTSBD551 +03469 W-TYPE-T-ASSESS DTSBD551 +03470 W-CALC-EMP-REMITTANCE. DTSBD551 +03471 DTSBD551 +03472 IF T-TOT-PMT-DUE NUMERIC DTSBD551 +03473 MOVE T-TOT-PMT-DUE TO W-TYPE-T-PMT-DUE DTSBD551 +03474 ELSE DTSBD551 +03475 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03476 MOVE MSG-T8 TO R551-MSG-TEXT DTSBD551 +03477 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03478 GO TO P1512B-EXIT DTSBD551 +03479 END-IF. DTSBD551 +03480 DTSBD551 +03481 IF T-TAX-DUE NUMERIC DTSBD551 +03482 MOVE T-TAX-DUE TO W-TYPE-T-TAX-DUE DTSBD551 +03483 ELSE DTSBD551 +03484 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03485 MOVE MSG-T8 TO R551-MSG-TEXT DTSBD551 +03486 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03487 GO TO P1512B-EXIT DTSBD551 +03488 END-IF. DTSBD551 +03489 DTSBD551 +03490 IF W-TYPE-T-PMT-DUE > ZERO DTSBD551 +03491 MOVE W-TYPE-T-PMT-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 +03492 ADD W-TYPE-T-PMT-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03493 ELSE DTSBD551 +03494 MOVE W-TYPE-T-TAX-DUE TO W-CALC-EMP-REMITTANCE DTSBD551 +03495 ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03496 MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X DTSBD551 +03497 IF W-TYPE-T-ASSESS NUMERIC DTSBD551 +03498 ADD W-TYPE-T-ASSESS TO W-CALC-TOT-REMITTANCE DTSBD551 +03499 W-CALC-EMP-REMITTANCE DTSBD551 +03500 END-IF DTSBD551 +03501 END-IF. DTSBD551 +03502 DTSBD551 +03503 ** MOVE W-TYPE-T-PMT-DUE TO W-AMT-DISP1. DTSBD551 +03504 * MOVE W-TYPE-T-TAX-DUE TO W-AMT-DISP2. DTSBD551 +03505 * MOVE W-CALC-EMP-REMITTANCE TO W-AMT-DISP3. DTSBD551 +03506 * DISPLAY ' PMT-DUE: ' W-AMT-DISP1. DTSBD551 +03507 * DISPLAY ' TAX-DUE: ' W-AMT-DISP2. DTSBD551 +03508 * DISPLAY ' ADMIN : ' W-TYPE-T-ASSESS-X. DTSBD551 +03509 * DISPLAY ' REMIT : ' W-AMT-DISP3. DTSBD551 +03510 * MOVE W-CALC-TOT-REMITTANCE TO W-AMT-DISP3. DTSBD551 +03511 ** DISPLAY ' TOTAL : ' W-AMT-DISP3. DTSBD551 +03512 DTSBD551 +03513 ** MOVE T-EMPLOYER-ASSESS-AMT TO W-TYPE-T-ASSESS-X. DTSBD551 +03514 * IF W-TYPE-T-ASSESS NUMERIC DTSBD551 +03515 * IF W-TYPE-T-ASSESS > ZERO DTSBD551 +03516 *& ADD W-TYPE-T-ASSESS TO W-TYPE-T-TAX-DUE DTSBD551 +03517 *& ADD W-TYPE-T-TAX-DUE TO W-CALC-TOT-REMITTANCE DTSBD551 +03518 * MOVE W-TYPE-T-ASSESS TO W-AMT-DISP1 DTSBD551 +03519 * DISPLAY 'P1512B ASSESSMENT ' W-EMP-NO DTSBD551 +03520 * ' ' W-AMT-DISP1 DTSBD551 +03521 * END-IF DTSBD551 +03522 ** END-IF. DTSBD551 +03523 DTSBD551 +03524 P1512B-EXIT. DTSBD551 +03525 EXIT. DTSBD551 +03526 DTSBD551 +03527 P1520-SET-WAGE-FILES. DTSBD551 +03528 IF W-ERROR-YES-88 DTSBD551 +03529 SET WAGE-TEMP-REQ-CLOSE-88 TO TRUE DTSBD551 +03530 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 +03531 ELSE DTSBD551 +03532 SET WAGE-TEMP-REQ-CLOSE-88 TO TRUE DTSBD551 +03533 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 +03534 IF W-ERROR-NO-88 DTSBD551 +03535 SET WAGE-TEMP-REQ-OPEN-INP-88 TO TRUE DTSBD551 +03536 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT DTSBD551 +03537 END-IF DTSBD551 +03538 END-IF. DTSBD551 +03539 DTSBD551 +03540 P1520-EXIT. DTSBD551 +03541 EXIT. DTSBD551 +03542 DTSBD551 +03543 P1530-COPY-WAGES. DTSBD551 +03544 PERFORM DTSBD551 +03545 UNTIL WAGE-TEMP-STATUS-EOF-88 DTSBD551 +03546 READ WAGE-FILE-TEMP INTO W001-REC DTSBD551 +03547 IF WAGE-TEMP-STATUS-EOF-88 DTSBD551 +03548 NEXT SENTENCE DTSBD551 +03549 ELSE DTSBD551 +03550 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 +03551 WRITE WAGE-OUT-REC FROM W001-REC DTSBD551 +03552 IF NOT WAGE-OUT-STATUS-OK-88 DTSBD551 +03553 PERFORM P1531-ERROR THRU P1531-EXIT DTSBD551 +03554 ELSE DTSBD551 +03555 ADD +1 TO W-W001-WRITE-CNT DTSBD551 +03556 END-IF DTSBD551 +03557 ELSE DTSBD551 +03558 PERFORM P1532-ERROR THRU P1532-EXIT DTSBD551 +03559 END-IF DTSBD551 +03560 END-IF DTSBD551 +03561 END-PERFORM. DTSBD551 +03562 DTSBD551 +03563 SET WAGE-TEMP-REQ-CLOSE-88 TO TRUE. DTSBD551 +03564 PERFORM S1000-WAGE-TEMP-IO THRU S1000-EXIT. DTSBD551 +03565 DTSBD551 +03566 P1530-EXIT. DTSBD551 +03567 EXIT. DTSBD551 +03568 DTSBD551 +03569 P1531-ERROR. DTSBD551 +03570 DISPLAY 'P1500: CANNOT WRITE WAGE-OUT ' DTSBD551 +03571 WAGE-OUT-STATUS ' ' E-FEDERAL-EIN ' ' W001-SSN DTSBD551 +03572 SET WAGE-TEMP-STATUS-EOF-88 TO TRUE DTSBD551 +03573 SET W-ERROR-YES-88 TO TRUE. DTSBD551 +03574 DTSBD551 +03575 P1531-EXIT. DTSBD551 +03576 EXIT. DTSBD551 +03577 DTSBD551 +03578 P1532-ERROR. DTSBD551 +03579 DISPLAY 'P1500: ERROR READING WAGE TEMP ' DTSBD551 +03580 WAGE-TEMP-STATUS ' ' E-FEDERAL-EIN ' ' W001-SSN DTSBD551 +03581 SET WAGE-TEMP-STATUS-EOF-88 TO TRUE DTSBD551 +03582 SET W-ERROR-YES-88 TO TRUE. DTSBD551 +03583 DTSBD551 +03584 P1532-EXIT. DTSBD551 +03585 EXIT. DTSBD551 +03586 DTSBD551 +03587 P1540-WRITE-T028. DTSBD551 +03588 *& IF W-EMP-TOT-WAGE > ZERO DTSBD551 +03589 * MOVE W-EMP-NO TO ZW-SUB DTSBD551 +03590 * SET ZW-ZERO-WAGE-NO-88 (ZW-SUB) TO TRUE DTSBD551 +03591 *& END-IF. DTSBD551 +03592 DTSBD551 +03593 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBD551 +03594 MOVE '028' TO T028-REC-TYPE. DTSBD551 +03595 DTSBD551 +03596 MOVE W-PSEUDO-BATCH-NO TO T028-PSEUDO-BATCH-NO. DTSBD551 +03597 MOVE W-PSEUDO-ITEM-NO TO T028-PSEUDO-ITEM-NO. DTSBD551 +03598 DTSBD551 +03599 MOVE W-EMP-TOT-WAGE TO T028-TOT-WAGE. DTSBD551 +03600 DTSBD551 +03601 IF MPRF-CLASS-SELF-INS-88 DTSBD551 +03602 MOVE ZERO TO T028-TAX-WAGE DTSBD551 +03603 T028-EXCESS-WAGE DTSBD551 +03604 ELSE DTSBD551 +03605 MOVE W-EMP-TAX-WAGE TO T028-TAX-WAGE DTSBD551 +03606 COMPUTE T028-EXCESS-WAGE = DTSBD551 +03607 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBD551 +03608 END-IF. DTSBD551 +03609 DTSBD551 +03610 MOVE W-EMP-WAGE-CNT TO T028-TOTAL-EMPL-CNT. DTSBD551 +03611 MOVE W-MONTH-1-CNT-9 TO T028-1ST-MTH-EMPL-CNT. DTSBD551 +03612 MOVE W-MONTH-2-CNT-9 TO T028-2ND-MTH-EMPL-CNT. DTSBD551 +03613 MOVE W-MONTH-3-CNT-9 TO T028-3RD-MTH-EMPL-CNT. DTSBD551 +03614 DTSBD551 +03615 MOVE W-CALC-EMP-REMITTANCE TO T028-REMIT-AMT. DTSBD551 +03616 *** MOVE W-TYPE-T-TAX-DUE TO T028-REMIT-AMT. DTSBD551 +03617 DTSBD551 +03618 IF W-LIABLE-NO-88 DTSBD551 +03619 OR W-EMP-FOUND-NO-88 DTSBD551 +03620 OR W-DUP-RPT-YES-88 DTSBD551 +03621 OR W-ANNUAL-QTR-YES-88 DTSBD551 +03622 SET T028-PASSED-FULL-EDITS-NO-88 TO TRUE DTSBD551 +03623 ADD +1 TO W-FAILED-FULL-EDITS-CNT DTSBD551 +03624 ELSE DTSBD551 +03625 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBD551 +03626 END-IF. DTSBD551 +03627 DTSBD551 +03628 MOVE W-LOG-NO TO W-LOG-NO-9. DTSBD551 +03629 MOVE W-LOG-NO-X TO T028-LOG-NBR. DTSBD551 +03630 DTSBD551 +03631 MOVE T028-REC TO TSKL-REC. DTSBD551 +03632 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD551 +03633 ADD +1 TO W-T028-WRITE-CNT. DTSBD551 +03634 DTSBD551 +03635 *& DTSBD551 +03636 * IF E-ACCOUNT-NO = '025391' DTSBD551 +03637 * DISPLAY SPACE DTSBD551 +03638 * DISPLAY 'EMP COMPLETE: ' T028-EMP-NO DTSBD551 +03639 * DISPLAY ' WAGE ITEMS ' W-EMP-WAGE-CNT DTSBD551 +03640 * ' TOT WAGES ' T028-TOT-WAGE DTSBD551 +03641 * END-IF. DTSBD551 +03642 *& DTSBD551 +03643 DTSBD551 +03644 P1540-EXIT. DTSBD551 +03645 EXIT. DTSBD551 +03646 DTSBD551 +03647 P1550-CONTACT. DTSBD551 +03648 IF W-EMP-FOUND-NO-88 DTSBD551 +03649 GO TO P1550-EXIT DTSBD551 +03650 END-IF. DTSBD551 +03651 DTSBD551 +03652 *** PERFORM P1551-FIND-MOPO THRU P1551-EXIT. DTSBD551 +03653 PERFORM P1552-BUILD-T002 THRU P1552-EXIT. DTSBD551 +03654 DTSBD551 +03655 P1550-EXIT. DTSBD551 +03656 EXIT. DTSBD551 +03657 DTSBD551 +03658 P1551-FIND-MOPO. DTSBD551 +03659 SET W-MOPO-FOUND-NO-88 TO TRUE. DTSBD551 +03660 DTSBD551 +03661 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBD551 +03662 MOVE W-EMP-NO TO MOPO-EMP-NO. DTSBD551 +03663 SET MOPO-OPO-88 TO TRUE. DTSBD551 +03664 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 +03665 DTSBD551 +03666 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD551 +03667 IF L910-NO-REC-88 DTSBD551 +03668 NEXT SENTENCE DTSBD551 +03669 ELSE DTSBD551 +03670 PERFORM DTSBD551 +03671 UNTIL L910-NO-REC-88 DTSBD551 +03672 OR W-MOPO-FOUND-YES-88 DTSBD551 +03673 MOVE MSKL-REC TO MOPO-REC DTSBD551 +03674 IF MOPO-TYPE-RPT-BSNS-88 DTSBD551 +03675 SET W-MOPO-FOUND-YES-88 TO TRUE DTSBD551 +03676 ELSE DTSBD551 +03677 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD551 +03678 END-IF DTSBD551 +03679 END-PERFORM DTSBD551 +03680 END-IF. DTSBD551 +03681 DTSBD551 +03682 P1551-EXIT. DTSBD551 +03683 EXIT. DTSBD551 +03684 DTSBD551 +03685 P1552-BUILD-T002. DTSBD551 +03686 SET T002-LENGTH-CONTACT-88 TO TRUE. DTSBD551 +03687 MOVE '002' TO T002-REC-TYPE. DTSBD551 +03688 MOVE MPRF-EMP-NO TO T002-EMP-NO. DTSBD551 +03689 MOVE 'MAG UC30 ' TO T002-ORIGIN. DTSBD551 +03690 MOVE L005-DATE TO T002-SYS-DATE. DTSBD551 +03691 MOVE L005-TIME TO T002-SYS-TIME. DTSBD551 +03692 DTSBD551 +03693 SET Y120-CONTACT-RPT-BSNS-88 TO TRUE. DTSBD551 +03694 DTSBD551 +03695 MOVE W-SUBM-NAME TO Y120-CONTACT-NAME. DTSBD551 +03696 MOVE W-SUBM-CONTACT-PHONE-AREA DTSBD551 +03697 TO Y120-CONTACT-VOICE. DTSBD551 +03698 MOVE ZEROS TO Y120-CONTACT-SSN DTSBD551 +03699 MOVE SPACES TO Y120-CONTACT-ADDR DTSBD551 +03700 MOVE SPACES TO Y120-CONTACT-TITLE DTSBD551 +03701 MOVE SPACES TO Y120-CONTACT-FAX DTSBD551 +03702 MOVE SPACES TO Y120-CONTACT-EMAIL DTSBD551 +03703 DTSBD551 +03704 MOVE Y120-DATA-AREA TO T002-DATA-AREA DTSBD551 +03705 SET T002-CONTACT-88 TO TRUE. DTSBD551 +03706 DTSBD551 +03707 MOVE T002-REC TO TSKL-REC. DTSBD551 +03708 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD551 +03709 ADD +1 TO W-T002-CONTACT-CNT. DTSBD551 +03710 DTSBD551 +03711 P1552-EXIT. DTSBD551 +03712 EXIT. DTSBD551 +03713 DTSBD551 +03714 P1560-MNTE. DTSBD551 +03715 IF W-MNTE-STARTED-NO-88 DTSBD551 +03716 GO TO P1560-EXIT DTSBD551 +03717 END-IF. DTSBD551 +03718 DTSBD551 +03719 SET W-MNTE-STARTED-NO-88 TO TRUE. DTSBD551 +03720 MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBD551 +03721 MOVE '003' TO T003-REC-TYPE. DTSBD551 +03722 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBD551 +03723 MOVE 'MAG UC30 ' TO T003-ORIGIN. DTSBD551 +03724 MOVE L005-DATE TO T003-SYS-DATE. DTSBD551 +03725 MOVE L005-TIME TO T003-SYS-TIME. DTSBD551 +03726 SET T003-ADD-MNTE-88 TO TRUE. DTSBD551 +03727 MOVE W-MNTE-TEXT-CNT TO MNTE-TEXT-CNT. DTSBD551 +03728 MOVE W-MNTE-TEXT-AREA TO MNTE-TEXT-AREA. DTSBD551 +03729 MOVE MNTE-REC TO T003-MNTE-REC. DTSBD551 +03730 DTSBD551 +03731 MOVE T003-REC TO TSKL-REC. DTSBD551 +03732 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD551 +03733 ADD +1 TO W-T003-MNTE-CNT. DTSBD551 +03734 DTSBD551 +03735 *& DTSBD551 +03736 * DISPLAY 'P1560B WRITE ' W-EMP-NO. DTSBD551 +03737 *& DTSBD551 +03738 P1560-EXIT. DTSBD551 +03739 EXIT. DTSBD551 +03740 DTSBD551 +03741 *P1570-UPD-LOG. DTSBD551 +03742 * SET L200-CMD-EMP-COMPLETE-88 TO TRUE. DTSBD551 +03743 * MOVE W-EMP-NO TO L200-EMP-NO. DTSBD551 +03744 * MOVE W-RPT-DATE TO L200-REPORTING-DATE. DTSBD551 +03745 * MOVE W-EMP-WAGE-CNT TO L200-TOT-CNT DTSBD551 +03746 * L200-SUCCESS-CNT. DTSBD551 +03747 * PERFORM S201-UPD-LOG THRU S201-EXIT. DTSBD551 +03748 * DTSBD551 +03749 *P1570-EXIT. DTSBD551 +03750 * EXIT. DTSBD551 +03751 DTSBD551 +03752 P1580-ZERO-WAGE. DTSBD551 +03753 *& DTSBD551 +03754 * IF W-SUCCESSOR-YES-88 DTSBD551 +03755 * DISPLAY ' P1580 ' E-ACCOUNT-NO ' ' W-EMP-TOT-WAGE DTSBD551 +03756 * ' ' W-EMP-NO. DTSBD551 +03757 *& DTSBD551 +03758 ADD +1 TO W-EMP-ERROR-CNT. DTSBD551 +03759 ADD +1 TO W-BYPASS-0-WAGE-RPT-CNT. DTSBD551 +03760 MOVE W-EMP-NO TO MSG-E9C-ACCT-NO. DTSBD551 +03761 IF W-LIABLE-NO-88 DTSBD551 +03762 MOVE 'NOT LIABLE ' TO MSG-E9C-REASON DTSBD551 +03763 ELSE DTSBD551 +03764 IF W-EMP-FOUND-NO-88 DTSBD551 +03765 MOVE 'NOT FOUND ' TO MSG-E9C-REASON DTSBD551 +03766 ELSE DTSBD551 +03767 IF W-DUP-RPT-YES-88 DTSBD551 +03768 MOVE 'DUP REPORT ' TO MSG-E9C-REASON DTSBD551 +03769 END-IF DTSBD551 +03770 END-IF DTSBD551 +03771 END-IF. DTSBD551 +03772 MOVE MSG-E9C TO R551-MSG-TEXT. DTSBD551 +03773 SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE. DTSBD551 +03774 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT. DTSBD551 +03775 DTSBD551 +03776 DISPLAY '*** ZERO WAGE ' MSG-E9C-REASON DTSBD551 +03777 ' ' W-EMP-NO ' ' E-NAME. DTSBD551 +03778 P1580-EXIT. DTSBD551 +03779 EXIT. DTSBD551 +03780 DTSBD551 +03781 P1590-EMP-RPT-REC. DTSBD551 +03782 MOVE W-EMP-NO TO X212-EMP-NBR. DTSBD551 +03783 MOVE W-ACCT-NBR-9 TO X212-ORIG-EMP-NBR. DTSBD551 +03784 IF E-FEDERAL-EIN NUMERIC DTSBD551 +03785 MOVE E-FEDERAL-EIN TO X212-ORIG-FEIN DTSBD551 +03786 ELSE DTSBD551 +03787 MOVE ZEROS TO X212-ORIG-FEIN DTSBD551 +03788 END-IF. DTSBD551 +03789 MOVE W-FINAL-FEIN TO X212-FEIN. DTSBD551 +03790 MOVE W-SUBM-FEIN TO X212-SUBMITTER-FEIN. DTSBD551 +03791 MOVE W-RPT-QTR TO L004-QTR-5-9. DTSBD551 +03792 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD551 +03793 MOVE L004-SLASH-5-QTR TO X212-QTR. DTSBD551 +03794 MOVE W-PSEUDO-BATCH-NO TO X212-BATCH. DTSBD551 +03795 MOVE W-PSEUDO-ITEM-NO TO X212-ITEM. DTSBD551 +03796 MOVE W-CALC-EMP-REMITTANCE TO X212-REMITTANCE. DTSBD551 +03797 *** MOVE W-TYPE-T-TAX-DUE TO X212-REMITTANCE. DTSBD551 +03798 MOVE W-CURR-DATE TO L001-FED-8-DATE-9. DTSBD551 +03799 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 +03800 MOVE L001-SLASH-8-DATE TO X212-PROCESS-DT. DTSBD551 +03801 MOVE T028-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBD551 +03802 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 +03803 MOVE L001-SLASH-8-DATE TO X212-RECEIVED-DT. DTSBD551 +03804 MOVE T028-DEPOSIT-DATE TO L001-FED-8-DATE-9. DTSBD551 +03805 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD551 +03806 MOVE L001-SLASH-8-DATE TO X212-DEPOSIT-DT. DTSBD551 +03807 DTSBD551 +03808 WRITE EMP-RPT-REC FROM W-EMP-RPT-REC. DTSBD551 +03809 IF EMP-RPT-STATUS-OK-88 DTSBD551 +03810 NEXT SENTENCE DTSBD551 +03811 ELSE DTSBD551 +03812 SET W-ERROR-YES-88 TO TRUE DTSBD551 +03813 DISPLAY 'CANNOT WRITE EMP RPT FILE: ' DTSBD551 +03814 EMP-RPT-STATUS DTSBD551 +03815 END-IF. DTSBD551 +03816 DTSBD551 +03817 P1590-EXIT. DTSBD551 +03818 EXIT. DTSBD551 +03819 DTSBD551 +03820 P1600-TYPE-F. DTSBD551 +03821 MOVE ICESA-REC TO WAGE-RECORD-F. DTSBD551 +03822 DTSBD551 +03823 *& DTSBD551 +03824 DISPLAY 'TYPE F ' WAGE-RECORD-F (1:60). DTSBD551 +03825 *& DTSBD551 +03826 DTSBD551 +03827 IF W-PREV-REC-TYPE-T-88 DTSBD551 +03828 SET W-PREV-REC-TYPE-F-88 TO TRUE DTSBD551 +03829 ELSE DTSBD551 +03830 * DISPLAY 'TYPE F: PREVIOUS REC TYPE NOT T: ' DTSBD551 +03831 * W-PREV-REC-TYPE DTSBD551 +03832 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03833 MOVE W-PREV-REC-TYPE TO MSG-F1-REC-TYPE DTSBD551 +03834 MOVE MSG-F1 TO R551-MSG-TEXT DTSBD551 +03835 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03836 GO TO P1600-EXIT DTSBD551 +03837 END-IF. DTSBD551 +03838 DTSBD551 +03839 IF W-ERROR-NO-88 DTSBD551 +03840 PERFORM P1610-EDIT-TYPE-F THRU P1610-EXIT DTSBD551 +03841 IF W-ERROR-NO-88 DTSBD551 +03842 PERFORM P1620-VALIDATE-TOTALS THRU P1620-EXIT DTSBD551 +03843 END-IF DTSBD551 +03844 END-IF. DTSBD551 +03845 DTSBD551 +03846 P1600-EXIT. DTSBD551 +03847 EXIT. DTSBD551 +03848 DTSBD551 +03849 P1610-EDIT-TYPE-F. DTSBD551 +03850 IF F-TOT-EMPLOYEE NOT NUMERIC DTSBD551 +03851 DISPLAY 'TYPE F: NON-NUMERIC TOT WORKERS ' DTSBD551 +03852 F-TOT-EMPLOYEE DTSBD551 +03853 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03854 MOVE F-TOT-EMPLOYEE TO MSG-F2-TOT-EMPLOYEE DTSBD551 +03855 MOVE MSG-F2 TO R551-MSG-TEXT DTSBD551 +03856 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03857 ELSE DTSBD551 +03858 MOVE F-TOT-EMPLOYEE TO W-TYPE-F-TOT-WORKER DTSBD551 +03859 END-IF. DTSBD551 +03860 DTSBD551 +03861 IF F-TOT-EMPLOYER NOT NUMERIC DTSBD551 +03862 DISPLAY 'TYPE F: NON-NUMERIC TOT EMPLOYERS ' DTSBD551 +03863 F-TOT-EMPLOYER DTSBD551 +03864 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03865 MOVE F-TOT-EMPLOYER TO MSG-F3-TOT-EMPLOYER DTSBD551 +03866 MOVE MSG-F3 TO R551-MSG-TEXT DTSBD551 +03867 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03868 ELSE DTSBD551 +03869 MOVE F-TOT-EMPLOYER TO W-TYPE-F-TOT-EMP DTSBD551 +03870 END-IF. DTSBD551 +03871 DTSBD551 +03872 IF F-TOTAL-WAGE NOT NUMERIC DTSBD551 +03873 DISPLAY 'TYPE F: NON-NUMERIC TOT WAGE ' F-TOTAL-WAGE DTSBD551 +03874 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03875 * MOVE F-TOTAL-WAGE TO MSG-F4-TOT-WAGES DTSBD551 +03876 MOVE MSG-F4 TO R551-MSG-TEXT DTSBD551 +03877 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03878 ELSE DTSBD551 +03879 MOVE F-TOTAL-WAGE TO W-TYPE-F-TOT-WAGE DTSBD551 +03880 END-IF. DTSBD551 +03881 DTSBD551 +03882 P1610-EXIT. DTSBD551 +03883 EXIT. DTSBD551 +03884 DTSBD551 +03885 P1620-VALIDATE-TOTALS. DTSBD551 +03886 IF W-TYPE-F-TOT-WORKER NOT = W-ALL-WAGE-CNT DTSBD551 +03887 DISPLAY 'TYPE F: INVALID TOT WORKERS ' DTSBD551 +03888 W-TYPE-F-TOT-WORKER DTSBD551 +03889 ' ACTUAL ' W-ALL-WAGE-CNT DTSBD551 +03890 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03891 MOVE W-TYPE-F-TOT-WORKER TO MSG-F5-TOT-WORKERS DTSBD551 +03892 MOVE W-ALL-WAGE-CNT TO MSG-F5-ALL-WAGE-CNT DTSBD551 +03893 MOVE MSG-F5 TO R551-MSG-TEXT DTSBD551 +03894 *& PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +03895 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03896 END-IF. DTSBD551 +03897 DTSBD551 +03898 IF W-TYPE-F-TOT-EMP NOT = W-ALL-EMP-CNT DTSBD551 +03899 DISPLAY 'TYPE F: INVALID TOT EMPLOYERS ' DTSBD551 +03900 W-TYPE-F-TOT-EMP DTSBD551 +03901 ' ACTUAL ' W-ALL-EMP-CNT DTSBD551 +03902 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03903 MOVE W-TYPE-F-TOT-EMP TO MSG-F6-TOT-EMPLOYER DTSBD551 +03904 MOVE W-ALL-EMP-CNT TO MSG-F6-ALL-EMPL-CNT DTSBD551 +03905 MOVE MSG-F6 TO R551-MSG-TEXT DTSBD551 +03906 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03907 END-IF. DTSBD551 +03908 DTSBD551 +03909 IF W-TYPE-F-TOT-WAGE NOT = W-ALL-TOT-WAGE DTSBD551 +03910 DISPLAY 'TYPE F: INVALID TOT WAGE ' DTSBD551 +03911 W-TYPE-F-TOT-WAGE DTSBD551 +03912 ' ACTUAL ' W-ALL-TOT-WAGE DTSBD551 +03913 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03914 MOVE W-TYPE-F-TOT-WAGE TO MSG-F7-TOT-WAGE DTSBD551 +03915 MOVE W-ALL-TOT-WAGE TO MSG-F7-ALL-TOT-WAGE DTSBD551 +03916 MOVE MSG-F7 TO R551-MSG-TEXT DTSBD551 +03917 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03918 END-IF. DTSBD551 +03919 DTSBD551 +03920 COMPUTE W-DIFF = DTSBD551 +03921 (W-CALC-TOT-REMITTANCE - W-PARM-DEPOSIT-REMIT). DTSBD551 +03922 IF W-DIFF > 0.99 OR < -0.99 DTSBD551 +03923 MOVE W-PARM-DEPOSIT-REMIT TO W-AMT-DISP1 DTSBD551 +03924 MOVE W-CALC-TOT-REMITTANCE TO W-AMT-DISP2 DTSBD551 +03925 MOVE W-DIFF TO W-AMT-DISP3 DTSBD551 +03926 DISPLAY 'TYPE F: CALC REMIT NOT = PARM REMIT ' DTSBD551 +03927 DISPLAY ' CALC: ' W-AMT-DISP2 DTSBD551 +03928 ' CHECK ' W-AMT-DISP1 DTSBD551 +03929 ' DIFFERENCE ' W-AMT-DISP3 DTSBD551 +03930 MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03931 MOVE W-AMT-DISP2 TO MSG-F8-CALC-REMIT DTSBD551 +03932 MOVE W-AMT-DISP1 TO MSG-F8-PARM-REMIT DTSBD551 +03933 MOVE MSG-F8 TO R551-MSG-TEXT DTSBD551 +03934 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03935 END-IF. DTSBD551 +03936 DTSBD551 +03937 *** MOVE W-CALC-TOT-REMITTANCE TO W-CALC-TOT-REMITTANCE-INT. DTSBD551 +03938 * IF W-CALC-TOT-REMITTANCE-INT NOT = W-PARM-TOT-REMITTANCE DTSBD551 +03939 * DISPLAY 'TYPE F: CALC REMIT NOT = PARM REMIT ' DTSBD551 +03940 * W-PARM-TOT-REMITTANCE DTSBD551 +03941 * ' ACTUAL ' W-CALC-TOT-REMITTANCE-INT DTSBD551 +03942 *& DTSBD551 +03943 * MOVE W-CALC-TOT-REMITTANCE TO W-AMT-DISP1 DTSBD551 +03944 * MOVE W-PARM-REMIT-DECIMAL TO W-AMT-DISP2 DTSBD551 +03945 * DISPLAY ' CALC ' W-AMT-DISP1 ' ACT ' W-AMT-DISP2 DTSBD551 +03946 *& DTSBD551 +03947 * MOVE A-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +03948 * MOVE W-CALC-TOT-REMITTANCE-INT TO MSG-F8-CALC-REMIT DTSBD551 +03949 * MOVE W-PARM-TOT-REMITTANCE TO MSG-F8-PARM-REMIT DTSBD551 +03950 * MOVE MSG-F8 TO R551-MSG-TEXT DTSBD551 +03951 * PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +03952 *** END-IF. DTSBD551 +03953 P1620-EXIT. DTSBD551 +03954 EXIT. DTSBD551 +03955 DTSBD551 +03956 DTSBD551 +03957 T0000-TERMINATE. DTSBD551 +03958 DISPLAY ' '. DTSBD551 +03959 DTSBD551 +03960 DISPLAY '*** DTSBD551 TERMINATION STATISTICS ***'. DTSBD551 +03961 DTSBD551 +03962 DISPLAY ' '. DTSBD551 +03963 DTSBD551 +03964 IF W-ERROR-YES-88 DTSBD551 +03965 OR W-FATAL-ERROR-YES-88 DTSBD551 +03966 NEXT SENTENCE DTSBD551 +03967 ELSE DTSBD551 +03968 PERFORM T0100-DELETE-0-WAGE-DUPS THRU T0100-EXIT DTSBD551 +03969 PERFORM T1000-UPDATE-ARCHIVE-DD THRU T1000-EXIT DTSBD551 +03970 PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT DTSBD551 +03971 PERFORM T1110-WRITE-X210-REC THRU T1110-EXIT DTSBD551 +03972 PERFORM T1120-WRITE-R202-REC THRU T1120-EXIT DTSBD551 +03973 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT DTSBD551 +03974 *** PERFORM T0200-UPD-LOG-SUCCESS THRU T0200-EXIT DTSBD551 +03975 END-IF. DTSBD551 +03976 DTSBD551 +03977 CLOSE ICESA-FILE DTSBD551 +03978 WAGE-FILE-TEMP DTSBD551 +03979 WAGE-FILE-OUT DTSBD551 +03980 CURR-BATCH-NO DTSBD551 +03981 SUBMITTER-FILE DTSBD551 +03982 EMP-RPT-FILE DTSBD551 +03983 MESSAGE-FILE. DTSBD551 +03984 DTSBD551 +03985 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD551 +03986 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD551 +03987 *** PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBD551 +03988 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD551 +03989 DTSBD551 +03990 DTSBD551 +03991 T0000-EXIT. DTSBD551 +03992 EXIT. DTSBD551 +03993 DTSBD551 +03994 T0100-DELETE-0-WAGE-DUPS. DTSBD551 +03995 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBD551 +03996 DTSBD551 +03997 *& OPEN I-O RPT-FILE. DTSBD551 +03998 * IF RPT-STATUS-OK-88 DTSBD551 +03999 * NEXT SENTENCE DTSBD551 +04000 * ELSE DTSBD551 +04001 * DISPLAY 'T0100: CANNOT OPEN RPT-FILE: ' DTSBD551 +04002 * RPT-STATUS DTSBD551 +04003 * GO TO T0100-EXIT DTSBD551 +04004 * END-IF. DTSBD551 +04005 * DTSBD551 +04006 * READ RPT-FILE. DTSBD551 +04007 * PERFORM UNTIL EMP-RPT-STATUS-EOF-88 DTSBD551 +04008 * MOVE RSK1-REC TO T028-REC DTSBD551 +04009 * IF T028-TOT-WAGE = ZERO DTSBD551 +04010 * IF ZW-ZERO-WAGE-NO-88 (ZW-SUB) DTSBD551 +04011 * DELETE RPT-FILE DTSBD551 +04012 * DISPLAY 'T0100 ' T028-EMP-NO ' ' T028-TOT-WAGE DTSBD551 +04013 * MOVE T028-EMP-NO TO MSG-T17-EMP-NO DTSBD551 +04014 * MOVE MSG-T17 TO R551-MSG-TEXT DTSBD551 +04015 * SET R551-RPT-TYPE-NON-FATAL-88 TO TRUE DTSBD551 +04016 * PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +04017 * END-IF DTSBD551 +04018 * END-IF DTSBD551 +04019 * READ RPT-FILE DTSBD551 +04020 *& END-PERFORM. DTSBD551 +04021 DTSBD551 +04022 T0100-EXIT. DTSBD551 +04023 EXIT. DTSBD551 +04024 DTSBD551 +04025 *T0300-UPD-LOG-FAILED. DTSBD551 +04026 * SET L200-CMD-TERMINATE-88 TO TRUE. DTSBD551 +04027 * MOVE ZERO TO L200-EMP-NO DTSBD551 +04028 * L200-REPORTING-DATE DTSBD551 +04029 * L200-TOT-CNT DTSBD551 +04030 * L200-SUCCESS-CNT. DTSBD551 +04031 * PERFORM S201-UPD-LOG THRU S201-EXIT. DTSBD551 +04032 * DTSBD551 +04033 *T0300-EXIT. DTSBD551 +04034 * EXIT. DTSBD551 +04035 DTSBD551 +04036 *T0400-UPD-LOG-SUCCESS. DTSBD551 +04037 * SET L200-CMD-TERMINATE-88 TO TRUE. DTSBD551 +04038 * MOVE W-EMP-NO TO L200-EMP-NO. DTSBD551 +04039 * MOVE W-RPT-DATE TO L200-REPORTING-DATE. DTSBD551 +04040 * MOVE W-ALL-EMP-CNT TO L200-TOT-CNT DTSBD551 +04041 * L200-SUCCESS-CNT. DTSBD551 +04042 * PERFORM S201-UPD-LOG THRU S201-EXIT. DTSBD551 +04043 * DTSBD551 +04044 *T0400-EXIT. DTSBD551 +04045 * EXIT. DTSBD551 +04046 DTSBD551 +04047 T1000-UPDATE-ARCHIVE-DD. DTSBD551 +04048 OPEN OUTPUT UC30-ARCHIVE-DD. DTSBD551 +04049 IF ARCHIVE-STATUS-OK-88 DTSBD551 +04050 NEXT SENTENCE DTSBD551 +04051 ELSE DTSBD551 +04052 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04053 DISPLAY 'CANNOT OPEN ARCHIVE FILE ' ARCHIVE-STATUS DTSBD551 +04054 GO TO T1000-EXIT DTSBD551 +04055 END-IF. DTSBD551 +04056 DTSBD551 +04057 DISPLAY 'T1000 ' W-SUBM-CREATE-DATE. DTSBD551 +04058 DISPLAY ' ' W-SUBM-CREATE-CCYY. DTSBD551 +04059 DTSBD551 +04060 PERFORM T1010-START-JOB THRU T1010-EXIT. DTSBD551 +04061 DTSBD551 +04062 IF W-SUBM-CREATE-CCYY > W-ARCHIVE-CURR-YEAR DTSBD551 +04063 OR W-SUBM-CREATE-CCYY < W-ARCHIVE-FIRST-YEAR DTSBD551 +04064 PERFORM T1020-WRITE-NEW-DD THRU T1020-EXIT DTSBD551 +04065 PERFORM T1035-WRITE-BACKUP-DD THRU T1035-EXIT DTSBD551 +04066 ELSE DTSBD551 +04067 PERFORM T1030-WRITE-OLD-DD THRU T1030-EXIT DTSBD551 +04068 PERFORM T1031-WRITE-UNCATLG-DD THRU T1031-EXIT DTSBD551 +04069 PERFORM T1035-WRITE-BACKUP-DD THRU T1035-EXIT DTSBD551 +04070 END-IF. DTSBD551 +04071 DTSBD551 +04072 PERFORM T1040-END-JOB THRU T1040-EXIT. DTSBD551 +04073 DTSBD551 +04074 CLOSE UC30-ARCHIVE-DD. DTSBD551 +04075 DTSBD551 +04076 T1000-EXIT. DTSBD551 +04077 EXIT. DTSBD551 +04078 DTSBD551 +04079 T1010-START-JOB. DTSBD551 +04080 MOVE DD-LINE-1-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04081 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04082 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04083 GO TO T1010-EXIT DTSBD551 +04084 END-IF. DTSBD551 +04085 DTSBD551 +04086 MOVE DD-LINE-2-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04087 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04088 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04089 GO TO T1010-EXIT DTSBD551 +04090 END-IF. DTSBD551 +04091 DTSBD551 +04092 MOVE DD-LINE-3-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04093 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04094 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04095 GO TO T1010-EXIT DTSBD551 +04096 END-IF. DTSBD551 +04097 DTSBD551 +04098 MOVE DD-LINE-3A-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04099 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04100 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04101 GO TO T1010-EXIT DTSBD551 +04102 END-IF. DTSBD551 +04103 DTSBD551 +04104 MOVE DD-LINE-3B-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04105 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04106 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04107 GO TO T1010-EXIT DTSBD551 +04108 END-IF. DTSBD551 +04109 DTSBD551 +04110 MOVE DD-LINE-3C-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04111 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04112 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04113 GO TO T1010-EXIT DTSBD551 +04114 END-IF. DTSBD551 +04115 DTSBD551 +04116 MOVE DD-LINE-3D-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04117 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04118 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04119 GO TO T1010-EXIT DTSBD551 +04120 END-IF. DTSBD551 +04121 DTSBD551 +04122 MOVE DD-LINE-3E-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04123 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04124 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04125 GO TO T1010-EXIT DTSBD551 +04126 END-IF. DTSBD551 +04127 DTSBD551 +04128 MOVE DD-LINE-3F-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04129 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04130 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04131 GO TO T1010-EXIT DTSBD551 +04132 END-IF. DTSBD551 +04133 DTSBD551 +04134 MOVE DD-LINE-3G-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04135 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04136 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04137 GO TO T1010-EXIT DTSBD551 +04138 END-IF. DTSBD551 +04139 DTSBD551 +04140 MOVE DD-LINE-4-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04141 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04142 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04143 GO TO T1010-EXIT DTSBD551 +04144 END-IF. DTSBD551 +04145 DTSBD551 +04146 MOVE DD-LINE-5-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04147 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04148 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04149 GO TO T1010-EXIT DTSBD551 +04150 END-IF. DTSBD551 +04151 DTSBD551 +04152 MOVE DD-LINE-6-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04153 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04154 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04155 GO TO T1010-EXIT DTSBD551 +04156 END-IF. DTSBD551 +04157 DTSBD551 +04158 MOVE DD-LINE-7-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04159 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04160 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04161 GO TO T1010-EXIT DTSBD551 +04162 END-IF. DTSBD551 +04163 DTSBD551 +04164 T1010-EXIT. DTSBD551 +04165 EXIT. DTSBD551 +04166 DTSBD551 +04167 T1020-WRITE-NEW-DD. DTSBD551 +04168 DTSBD551 +04169 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-NEW-YEAR. DTSBD551 +04170 DTSBD551 +04171 MOVE DD-LINE-1-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 +04172 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04173 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04174 GO TO T1020-EXIT DTSBD551 +04175 END-IF. DTSBD551 +04176 DTSBD551 +04177 MOVE DD-LINE-2-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 +04178 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04179 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04180 GO TO T1020-EXIT DTSBD551 +04181 END-IF. DTSBD551 +04182 DTSBD551 +04183 MOVE DD-LINE-3-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 +04184 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04185 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04186 GO TO T1020-EXIT DTSBD551 +04187 END-IF. DTSBD551 +04188 DTSBD551 +04189 DTSBD551 +04190 MOVE DD-LINE-4-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 +04191 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04192 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04193 GO TO T1020-EXIT DTSBD551 +04194 END-IF. DTSBD551 +04195 DTSBD551 +04196 DTSBD551 +04197 MOVE DD-LINE-5-NEW TO UC30-ARCHIVE-DD-REC. DTSBD551 +04198 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04199 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04200 GO TO T1020-EXIT DTSBD551 +04201 END-IF. DTSBD551 +04202 DTSBD551 +04203 T1020-EXIT. DTSBD551 +04204 EXIT. DTSBD551 +04205 DTSBD551 +04206 T1030-WRITE-OLD-DD. DTSBD551 +04207 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-OLD-YEAR. DTSBD551 +04208 DTSBD551 +04209 MOVE DD-LINE-1-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 +04210 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04211 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04212 GO TO T1030-EXIT DTSBD551 +04213 END-IF. DTSBD551 +04214 DTSBD551 +04215 MOVE DD-LINE-2-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 +04216 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04217 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04218 GO TO T1030-EXIT DTSBD551 +04219 END-IF. DTSBD551 +04220 DTSBD551 +04221 MOVE DD-LINE-3-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 +04222 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04223 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04224 GO TO T1030-EXIT DTSBD551 +04225 END-IF. DTSBD551 +04226 DTSBD551 +04227 MOVE DD-LINE-4-OLD TO UC30-ARCHIVE-DD-REC. DTSBD551 +04228 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04229 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04230 GO TO T1030-EXIT DTSBD551 +04231 END-IF. DTSBD551 +04232 DTSBD551 +04233 DTSBD551 +04234 MOVE DD-LINE-8-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04235 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04236 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04237 GO TO T1010-EXIT DTSBD551 +04238 END-IF. DTSBD551 +04239 DTSBD551 +04240 MOVE DD-LINE-9-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04241 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04242 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04243 GO TO T1010-EXIT DTSBD551 +04244 END-IF. DTSBD551 +04245 DTSBD551 +04246 MOVE DD-LINE-11-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04247 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04248 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04249 GO TO T1010-EXIT DTSBD551 +04250 END-IF. DTSBD551 +04251 DTSBD551 +04252 T1030-EXIT. DTSBD551 +04253 EXIT. DTSBD551 +04254 DTSBD551 +04255 T1031-WRITE-UNCATLG-DD. DTSBD551 +04256 DTSBD551 +04257 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-UNCATLG-YEAR. DTSBD551 +04258 DTSBD551 +04259 MOVE DD-LINE-1-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 +04260 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04261 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04262 GO TO T1031-EXIT DTSBD551 +04263 END-IF. DTSBD551 +04264 DTSBD551 +04265 MOVE DD-LINE-2-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 +04266 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04267 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04268 GO TO T1031-EXIT DTSBD551 +04269 END-IF. DTSBD551 +04270 DTSBD551 +04271 MOVE DD-LINE-3-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 +04272 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04273 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04274 GO TO T1031-EXIT DTSBD551 +04275 END-IF. DTSBD551 +04276 DTSBD551 +04277 MOVE DD-LINE-4-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 +04278 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04279 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04280 GO TO T1031-EXIT DTSBD551 +04281 END-IF. DTSBD551 +04282 DTSBD551 +04283 MOVE DD-LINE-5-UNCATLG TO UC30-ARCHIVE-DD-REC. DTSBD551 +04284 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04285 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04286 GO TO T1031-EXIT DTSBD551 +04287 END-IF. DTSBD551 +04288 DTSBD551 +04289 T1031-EXIT. DTSBD551 +04290 EXIT. DTSBD551 +04291 DTSBD551 +04292 T1035-WRITE-BACKUP-DD. DTSBD551 +04293 DTSBD551 +04294 MOVE W-SUBM-CREATE-CCYY TO W-ARCHIVE-BACKUP-YEAR-I DTSBD551 +04295 W-ARCHIVE-BACKUP-YEAR-O. DTSBD551 +04296 DTSBD551 +04297 MOVE DD-LINE-1-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04298 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04299 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04300 GO TO T1035-EXIT DTSBD551 +04301 END-IF. DTSBD551 +04302 DTSBD551 +04303 MOVE DD-LINE-2-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04304 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04305 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04306 GO TO T1035-EXIT DTSBD551 +04307 END-IF. DTSBD551 +04308 DTSBD551 +04309 MOVE DD-LINE-3-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04310 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04311 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04312 GO TO T1035-EXIT DTSBD551 +04313 END-IF. DTSBD551 +04314 DTSBD551 +04315 MOVE DD-LINE-4-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04316 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04317 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04318 GO TO T1035-EXIT DTSBD551 +04319 END-IF. DTSBD551 +04320 DTSBD551 +04321 MOVE DD-LINE-5-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04322 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04323 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04324 GO TO T1035-EXIT DTSBD551 +04325 END-IF. DTSBD551 +04326 DTSBD551 +04327 MOVE DD-LINE-6-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04328 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04329 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04330 GO TO T1035-EXIT DTSBD551 +04331 END-IF. DTSBD551 +04332 DTSBD551 +04333 MOVE DD-LINE-7-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04334 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04335 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04336 GO TO T1035-EXIT DTSBD551 +04337 END-IF. DTSBD551 +04338 DTSBD551 +04339 MOVE DD-LINE-8-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04340 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04341 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04342 GO TO T1035-EXIT DTSBD551 +04343 END-IF. DTSBD551 +04344 DTSBD551 +04345 MOVE DD-LINE-9-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04346 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04347 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04348 GO TO T1035-EXIT DTSBD551 +04349 END-IF. DTSBD551 +04350 DTSBD551 +04351 MOVE DD-LINE-10-BACKUP TO UC30-ARCHIVE-DD-REC. DTSBD551 +04352 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04353 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04354 GO TO T1035-EXIT DTSBD551 +04355 END-IF. DTSBD551 +04356 DTSBD551 +04357 T1035-EXIT. DTSBD551 +04358 EXIT. DTSBD551 +04359 DTSBD551 +04360 T1040-END-JOB. DTSBD551 +04361 DTSBD551 +04362 MOVE DD-LINE-10-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04363 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04364 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04365 GO TO T1040-EXIT DTSBD551 +04366 END-IF. DTSBD551 +04367 DTSBD551 +04368 MOVE DD-LINE-12-JOB TO UC30-ARCHIVE-DD-REC. DTSBD551 +04369 PERFORM S3000-WRITE-ARCHIVE THRU S3000-EXIT. DTSBD551 +04370 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +04371 GO TO T1040-EXIT DTSBD551 +04372 END-IF. DTSBD551 +04373 DTSBD551 +04374 T1040-EXIT. DTSBD551 +04375 EXIT. DTSBD551 +04376 DTSBD551 +04377 T1100-UPDATE-CURR-BATCH. DTSBD551 +04378 MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBD551 +04379 W-END-BATCH. DTSBD551 +04380 MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBD551 +04381 MOVE W-SUBM-CREATE-CCYY TO CURRENT-ARCHIVE-YEAR. DTSBD551 +04382 DISPLAY 'REWRITING CURRENT BATCH ' DTSBD551 +04383 W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBD551 +04384 ' ' CURRENT-ARCHIVE-YEAR. DTSBD551 +04385 REWRITE CURR-BATCH-NO-REC. DTSBD551 +04386 IF BATCH-STATUS-OK-88 DTSBD551 +04387 NEXT SENTENCE DTSBD551 +04388 ELSE DTSBD551 +04389 DISPLAY 'T1000 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBD551 +04390 BATCH-STATUS DTSBD551 +04391 END-IF. DTSBD551 +04392 DTSBD551 +04393 T1100-EXIT. DTSBD551 +04394 EXIT. DTSBD551 +04395 DTSBD551 +04396 T1110-WRITE-X210-REC. DTSBD551 +04397 MOVE W-START-BATCH TO X210-START-BATCH. DTSBD551 +04398 MOVE W-END-BATCH TO X210-END-BATCH. DTSBD551 +04399 DTSBD551 +04400 WRITE SUBMITTER-REC FROM W-SUBMITTER-REC. DTSBD551 +04401 IF SUBMITTER-STATUS-OK-88 DTSBD551 +04402 NEXT SENTENCE DTSBD551 +04403 ELSE DTSBD551 +04404 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04405 DISPLAY 'CANNOT WRITE SUBMITTER FILE: ' DTSBD551 +04406 SUBMITTER-STATUS DTSBD551 +04407 END-IF. DTSBD551 +04408 DTSBD551 +04409 T1110-EXIT. DTSBD551 +04410 EXIT. DTSBD551 +04411 DTSBD551 +04412 T1120-WRITE-R202-REC. DTSBD551 +04413 IF W-PARM-DEPOSIT-REMIT NOT > ZERO DTSBD551 +04414 DISPLAY 'REMITTANCE = 0 NO R202 WRITTEN ' DTSBD551 +04415 GO TO T1120-EXIT DTSBD551 +04416 END-IF. DTSBD551 +04417 DTSBD551 +04418 MOVE W-START-BATCH TO R202-BATCH-NO. DTSBD551 +04419 SET R202-BATCH-ICESA-88 TO TRUE. DTSBD551 +04420 MOVE W-PARM-DEPOSIT-REMIT TO R202-CONTROL-REMIT-AMT. DTSBD551 +04421 MOVE W-T028-WRITE-CNT TO R202-CONTROL-TRAN-CNT. DTSBD551 +04422 MOVE L005-DATE TO R202-BATCH-ESTB-DATE DTSBD551 +04423 R202-APPROVED-DATE. DTSBD551 +04424 MOVE 'MAG UC30' TO R202-APPROVED-OPID. DTSBD551 +04425 DTSBD551 +04426 MOVE R202-REC TO RSKL-REC. DTSBD551 +04427 PERFORM S947-RPT-2 THRU S947-EXIT. DTSBD551 +04428 DTSBD551 +04429 T1120-EXIT. DTSBD551 +04430 EXIT. DTSBD551 +04431 DTSBD551 +04432 T2000-DISPLAY-TOTALS. DTSBD551 +04433 DISPLAY 'TOTAL EMPLOYERS ' DTSBD551 +04434 W-ALL-EMP-CNT. DTSBD551 +04435 DTSBD551 +04436 DISPLAY 'TOTAL EMPLOYER ERRORS ' DTSBD551 +04437 W-EMP-ERROR-CNT. DTSBD551 +04438 DTSBD551 +04439 DISPLAY 'FULL EDITS FAILED ' DTSBD551 +04440 W-FAILED-FULL-EDITS-CNT. DTSBD551 +04441 DTSBD551 +04442 DISPLAY 'ZERO WAGE RPTS BYPASSED ' DTSBD551 +04443 W-BYPASS-0-WAGE-RPT-CNT. DTSBD551 +04444 DTSBD551 +04445 DISPLAY 'EMPLOYER NOT FOUND ' DTSBD551 +04446 W-ACCT-NOT-FOUND-CNT. DTSBD551 +04447 DTSBD551 +04448 DISPLAY 'EMPLOYER ACCOUNT NUMBERS FOUND FROM FEIN ' DTSBD551 +04449 W-ACCT-FROM-FEIN-CNT. DTSBD551 +04450 DTSBD551 +04451 DISPLAY 'EMPLOYER ACCOUNT NUMBERS FOUND FROM SUCCESSOR ' DTSBD551 +04452 W-ACCT-FROM-SUCC-CNT. DTSBD551 +04453 DTSBD551 +04454 DISPLAY 'TOTAL T028 RECORDS WRITTEN ' DTSBD551 +04455 W-T028-WRITE-CNT. DTSBD551 +04456 DTSBD551 +04457 DISPLAY 'TOTAL T002 RECORDS WRITTEN ' DTSBD551 +04458 W-T002-CONTACT-CNT. DTSBD551 +04459 DTSBD551 +04460 DISPLAY 'TOTAL T003 RECORDS WRITTEN ' DTSBD551 +04461 W-T003-MNTE-CNT. DTSBD551 +04462 DTSBD551 +04463 DISPLAY 'SELF-INS EMPLOYERS WITH CHECKS ' DTSBD551 +04464 W-SI-WITH-REMIT-CNT. DTSBD551 +04465 DTSBD551 +04466 *** DISPLAY 'NEW ADDRESS VERIFIED ' DTSBD551 +04467 * W-VALID-NEW-ADDR-CNT. DTSBD551 +04468 * DTSBD551 +04469 * DISPLAY 'NEW ADDRESS NOT VERIFIED ' DTSBD551 +04470 *** W-INVALID-NEW-ADDR-CNT. DTSBD551 +04471 DTSBD551 +04472 DISPLAY SPACE. DTSBD551 +04473 DTSBD551 +04474 MOVE W-CALC-TOT-REMITTANCE TO DISP-CALC-TOT-REMITTANCE. DTSBD551 +04475 DISPLAY 'TOTAL REMITTANCE ' DTSBD551 +04476 DISP-CALC-TOT-REMITTANCE. DTSBD551 +04477 DTSBD551 +04478 DISPLAY SPACE. DTSBD551 +04479 DTSBD551 +04480 DISPLAY 'TOTAL WAGE RECORDS ' DTSBD551 +04481 W-ALL-WAGE-CNT. DTSBD551 +04482 DTSBD551 +04483 DISPLAY 'TOTAL WAGE ERRORS ' DTSBD551 +04484 W-WAGE-ERROR-CNT. DTSBD551 +04485 DTSBD551 +04486 DISPLAY 'TOTAL ZERO WAGE RECORDS EXCLUDED ' DTSBD551 +04487 W-ZERO-WAGE-CNT. DTSBD551 +04488 DTSBD551 +04489 DISPLAY 'WAGE RECORDS WITH MISSING SSNS EXCLUDED ' DTSBD551 +04490 W-MISSING-SSN-CNT. DTSBD551 +04491 DTSBD551 +04492 DISPLAY 'TOTAL W001 RECORDS WRITTEN ' DTSBD551 +04493 W-W001-WRITE-CNT. DTSBD551 +04494 DTSBD551 +04495 T2000-EXIT. DTSBD551 +04496 EXIT. DTSBD551 +04497 DTSBD551 +04498 S001-FROM-FED-8. DTSBD551 +04499 SET L001-FROM-FED-8 TO TRUE. DTSBD551 +04500 GO TO S001-DATE. DTSBD551 +04501 DTSBD551 +04502 S001-FROM-CAL-8. DTSBD551 +04503 SET L001-FROM-CAL-8 TO TRUE. DTSBD551 +04504 GO TO S001-DATE. DTSBD551 +04505 DTSBD551 +04506 S001-FROM-CAL-6. DTSBD551 +04507 SET L001-FROM-CAL-6 TO TRUE. DTSBD551 +04508 GO TO S001-DATE. DTSBD551 +04509 DTSBD551 +04510 S001-FROM-ABS-DAY. DTSBD551 +04511 SET L001-FROM-ABS-DAY TO TRUE. DTSBD551 +04512 GO TO S001-DATE. DTSBD551 +04513 DTSBD551 +04514 S001-DATE. DTSBD551 +04515 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD551 +04516 S001-EXIT. DTSBD551 +04517 EXIT. DTSBD551 +04518 DTSBD551 +04519 S003-AGENCY-DAY. DTSBD551 +04520 SET L003-AGENCY-DAY TO TRUE. DTSBD551 +04521 GO TO S003-WORK-DAY. DTSBD551 +04522 DTSBD551 +04523 S003-WORK-DAY. DTSBD551 +04524 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBD551 +04525 S003-EXIT. DTSBD551 +04526 EXIT. DTSBD551 +04527 DTSBD551 +04528 S004-FROM-5. DTSBD551 +04529 SET L004-FROM-5 TO TRUE. DTSBD551 +04530 GO TO S004-YRQ. DTSBD551 +04531 DTSBD551 +04532 S004-FROM-DATE. DTSBD551 +04533 SET L004-FROM-DATE TO TRUE. DTSBD551 +04534 GO TO S004-YRQ. DTSBD551 +04535 DTSBD551 +04536 S004-FROM-ABS. DTSBD551 +04537 SET L004-FROM-ABS TO TRUE. DTSBD551 +04538 GO TO S004-YRQ. DTSBD551 +04539 DTSBD551 +04540 S004-YRQ. DTSBD551 +04541 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD551 +04542 DTSBD551 +04543 S004-EXIT. DTSBD551 +04544 EXIT. DTSBD551 +04545 DTSBD551 +04546 S005-FROM-SYS. DTSBD551 +04547 SET L005-FROM-SYS TO TRUE. DTSBD551 +04548 GO TO S005-ABSTIME. DTSBD551 +04549 DTSBD551 +04550 S005-ABSTIME. DTSBD551 +04551 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD551 +04552 S005-EXIT. DTSBD551 +04553 EXIT. DTSBD551 +04554 DTSBD551 +04555 S072-ADDRESS. DTSBD551 +04556 CALL 'DTSBU072' USING L072-LINK-AREA. DTSBD551 +04557 DTSBD551 +04558 S072-EXIT. DTSBD551 +04559 EXIT. DTSBD551 +04560 DTSBD551 +04561 S516-LIABILITY-INFO. DTSBD551 +04562 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD551 +04563 MPRF-REC. DTSBD551 +04564 S516-EXIT. DTSBD551 +04565 EXIT. DTSBD551 +04566 DTSBD551 +04567 *S200-INIT-LOG. DTSBD551 +04568 * CALL 'DESBD201' USING L200-LINK-AREA C202-MSG-TABLE. DTSBD551 +04569 *S200-EXIT. DTSBD551 +04570 * EXIT. DTSBD551 +04571 * DTSBD551 +04572 *S201-UPD-LOG. DTSBD551 +04573 * MOVE W-LOG-NO TO L200-LOG-NO. DTSBD551 +04574 * MOVE W-MOD-NAME TO L200-PROG-NAME. DTSBD551 +04575 * CALL 'DESBD201' USING L200-LINK-AREA C202-MSG-TABLE. DTSBD551 +04576 *S201-EXIT. DTSBD551 +04577 * EXIT. DTSBD551 +04578 DTSBD551 +04579 S601-CALL-BU601. DTSBD551 +04580 CALL 'DTSBU601' USING L601-LINK-AREA. DTSBD551 +04581 S601-EXIT. DTSBD551 +04582 EXIT. DTSBD551 +04583 DTSBD551 +04584 S910-OPEN-READ. DTSBD551 +04585 SET L910-OPEN-READ-88 TO TRUE. DTSBD551 +04586 GO TO S910-MSTR-IO. DTSBD551 +04587 DTSBD551 +04588 S910-READ. DTSBD551 +04589 SET L910-READ-88 TO TRUE. DTSBD551 +04590 GO TO S910-MSTR-IO. DTSBD551 +04591 DTSBD551 +04592 S910-START-BROWSE. DTSBD551 +04593 SET L910-START-BROWSE-88 TO TRUE. DTSBD551 +04594 GO TO S910-MSTR-IO. DTSBD551 +04595 DTSBD551 +04596 S910-READ-NEXT. DTSBD551 +04597 SET L910-READ-NEXT-88 TO TRUE. DTSBD551 +04598 GO TO S910-MSTR-IO. DTSBD551 +04599 DTSBD551 +04600 S910-CLOSE. DTSBD551 +04601 SET L910-CLOSE-88 TO TRUE. DTSBD551 +04602 GO TO S910-MSTR-IO. DTSBD551 +04603 DTSBD551 +04604 S910-MSTR-IO. DTSBD551 +04605 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD551 +04606 MSKL-REC. DTSBD551 +04607 S910-EXIT. DTSBD551 +04608 EXIT. DTSBD551 +04609 DTSBD551 +04610 S921-OPEN-READ. DTSBD551 +04611 SET L921-OPEN-READ-88 TO TRUE. DTSBD551 +04612 GO TO S921-AIX-IO. DTSBD551 +04613 DTSBD551 +04614 S921-READ. DTSBD551 +04615 SET L921-READ-88 TO TRUE. DTSBD551 +04616 GO TO S921-AIX-IO. DTSBD551 +04617 DTSBD551 +04618 S921-START-BROWSE. DTSBD551 +04619 SET L921-START-BROWSE-88 TO TRUE. DTSBD551 +04620 GO TO S921-AIX-IO. DTSBD551 +04621 DTSBD551 +04622 S921-READ-NEXT. DTSBD551 +04623 SET L921-READ-NEXT-88 TO TRUE. DTSBD551 +04624 GO TO S921-AIX-IO. DTSBD551 +04625 DTSBD551 +04626 S921-CLOSE. DTSBD551 +04627 SET L921-CLOSE-88 TO TRUE. DTSBD551 +04628 GO TO S921-AIX-IO. DTSBD551 +04629 DTSBD551 +04630 S921-AIX-IO. DTSBD551 +04631 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD551 +04632 ISKL-REC. DTSBD551 +04633 S921-EXIT. DTSBD551 +04634 EXIT. DTSBD551 +04635 DTSBD551 +04636 S927A-OPEN. DTSBD551 +04637 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBD551 +04638 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD551 +04639 DTSBD551 +04640 S927A-EXIT. DTSBD551 +04641 EXIT. DTSBD551 +04642 DTSBD551 +04643 S927B-WRITE. DTSBD551 +04644 SET L927-WRITE-88 TO TRUE. DTSBD551 +04645 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD551 +04646 DTSBD551 +04647 S927B-EXIT. DTSBD551 +04648 EXIT. DTSBD551 +04649 DTSBD551 +04650 S927C-CLOSE. DTSBD551 +04651 SET L927-CLOSE-88 TO TRUE. DTSBD551 +04652 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD551 +04653 DTSBD551 +04654 S927C-EXIT. DTSBD551 +04655 EXIT. DTSBD551 +04656 DTSBD551 +04657 S927Z-IO. DTSBD551 +04658 CALL 'DTSBU927' USING L927-LINK-AREA DTSBD551 +04659 TSKL-REC. DTSBD551 +04660 S927Z-EXIT. DTSBD551 +04661 EXIT. DTSBD551 +04662 DTSBD551 +04663 S931-OPEN-READ. DTSBD551 +04664 SET L931-OPEN-READ-88 TO TRUE. DTSBD551 +04665 GO TO S931-REF-IO. DTSBD551 +04666 DTSBD551 +04667 S931-CLOSE. DTSBD551 +04668 SET L931-CLOSE-88 TO TRUE. DTSBD551 +04669 GO TO S931-REF-IO. DTSBD551 +04670 DTSBD551 +04671 S931-REF-IO. DTSBD551 +04672 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD551 +04673 FSKL-REC. DTSBD551 +04674 S931-EXIT. DTSBD551 +04675 EXIT. DTSBD551 +04676 DTSBD551 +04677 S946-RPT-1. DTSBD551 +04678 CALL 'DTSBU946' USING RSKL-REC. DTSBD551 +04679 DTSBD551 +04680 S946-EXIT. DTSBD551 +04681 EXIT. DTSBD551 +04682 DTSBD551 +04683 S947-RPT-2. DTSBD551 +04684 CALL 'DTSBU947' USING RSKL-REC. DTSBD551 +04685 DTSBD551 +04686 S947-EXIT. DTSBD551 +04687 EXIT. DTSBD551 +04688 DTSBD551 +04689 S1000-WAGE-TEMP-IO. DTSBD551 +04690 EVALUATE TRUE DTSBD551 +04691 WHEN WAGE-TEMP-REQ-OPEN-OUT-88 DTSBD551 +04692 IF WAGE-TEMP-CLOSED-88 DTSBD551 +04693 PERFORM S1010-OPEN-WAGE-TEMP-OUT THRU S1010-EXIT DTSBD551 +04694 ELSE DTSBD551 +04695 *** DISPLAY 'WAGE TEMP ALREADY OPEN ' E-FEDERAL-EIN DTSBD551 +04696 PERFORM S1020-CLOSE-WAGE-TEMP THRU S1020-EXIT DTSBD551 +04697 IF W-ERROR-NO-88 DTSBD551 +04698 PERFORM S1010-OPEN-WAGE-TEMP-OUT THRU S1010-EXIT DTSBD551 +04699 END-IF DTSBD551 +04700 END-IF DTSBD551 +04701 DTSBD551 +04702 WHEN WAGE-TEMP-REQ-CLOSE-88 DTSBD551 +04703 IF WAGE-TEMP-OPEN-88 DTSBD551 +04704 PERFORM S1020-CLOSE-WAGE-TEMP THRU S1020-EXIT DTSBD551 +04705 ELSE DTSBD551 +04706 DISPLAY 'WAGE TEMP ALREADY CLOSED ' E-FEDERAL-EIN DTSBD551 +04707 END-IF DTSBD551 +04708 DTSBD551 +04709 WHEN WAGE-TEMP-REQ-WRITE-88 DTSBD551 +04710 IF WAGE-TEMP-OPEN-88 DTSBD551 +04711 PERFORM S1030-WRITE-WAGE-TEMP THRU S1030-EXIT DTSBD551 +04712 ELSE DTSBD551 +04713 DISPLAY 'WAGE TEMP NOT OPEN, CANONOT WRITE ' DTSBD551 +04714 E-FEDERAL-EIN DTSBD551 +04715 END-IF DTSBD551 +04716 DTSBD551 +04717 WHEN WAGE-TEMP-REQ-OPEN-INP-88 DTSBD551 +04718 IF WAGE-TEMP-CLOSED-88 DTSBD551 +04719 PERFORM S1040-OPEN-WAGE-TEMP-INP THRU S1040-EXIT DTSBD551 +04720 ELSE DTSBD551 +04721 DISPLAY 'WAGE TEMP STILL OPEN ' E-FEDERAL-EIN DTSBD551 +04722 PERFORM S1020-CLOSE-WAGE-TEMP THRU S1020-EXIT DTSBD551 +04723 IF W-ERROR-NO-88 DTSBD551 +04724 PERFORM S1040-OPEN-WAGE-TEMP-INP THRU S1040-EXIT DTSBD551 +04725 END-IF DTSBD551 +04726 END-IF DTSBD551 +04727 DTSBD551 +04728 END-EVALUATE. DTSBD551 +04729 DTSBD551 +04730 SET WAGE-TEMP-REQ-NULL-88 TO TRUE. DTSBD551 +04731 DTSBD551 +04732 S1000-EXIT. DTSBD551 +04733 EXIT. DTSBD551 +04734 DTSBD551 +04735 S1010-OPEN-WAGE-TEMP-OUT. DTSBD551 +04736 OPEN OUTPUT WAGE-FILE-TEMP. DTSBD551 +04737 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 +04738 SET WAGE-TEMP-OPEN-88 TO TRUE DTSBD551 +04739 *& DISPLAY 'TEMP WAGE FILE OPENED ' E-FEDERAL-EIN DTSBD551 +04740 ELSE DTSBD551 +04741 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04742 DISPLAY 'CANNOT OPEN WAGE TEMP FILE: ' DTSBD551 +04743 WAGE-TEMP-STATUS DTSBD551 +04744 END-IF. DTSBD551 +04745 DTSBD551 +04746 S1010-EXIT. DTSBD551 +04747 EXIT. DTSBD551 +04748 DTSBD551 +04749 S1020-CLOSE-WAGE-TEMP. DTSBD551 +04750 CLOSE WAGE-FILE-TEMP. DTSBD551 +04751 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 +04752 SET WAGE-TEMP-CLOSED-88 TO TRUE DTSBD551 +04753 *& DISPLAY 'TEMP WAGE FILE CLOSED ' E-FEDERAL-EIN DTSBD551 +04754 ELSE DTSBD551 +04755 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04756 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBD551 +04757 WAGE-TEMP-STATUS DTSBD551 +04758 END-IF. DTSBD551 +04759 DTSBD551 +04760 S1020-EXIT. DTSBD551 +04761 EXIT. DTSBD551 +04762 DTSBD551 +04763 S1030-WRITE-WAGE-TEMP. DTSBD551 +04764 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBD551 +04765 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 +04766 NEXT SENTENCE DTSBD551 +04767 ELSE DTSBD551 +04768 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04769 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBD551 +04770 WAGE-TEMP-STATUS DTSBD551 +04771 END-IF. DTSBD551 +04772 DTSBD551 +04773 S1030-EXIT. DTSBD551 +04774 EXIT. DTSBD551 +04775 DTSBD551 +04776 S1040-OPEN-WAGE-TEMP-INP. DTSBD551 +04777 OPEN INPUT WAGE-FILE-TEMP. DTSBD551 +04778 IF WAGE-TEMP-STATUS-OK-88 DTSBD551 +04779 SET WAGE-TEMP-OPEN-88 TO TRUE DTSBD551 +04780 *& DISPLAY 'WAGE FILE OPENED INP ' E-FEDERAL-EIN DTSBD551 +04781 ELSE DTSBD551 +04782 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04783 DISPLAY 'CANNOT OPEN WAGE TEMP FILE: ' DTSBD551 +04784 WAGE-TEMP-STATUS DTSBD551 +04785 END-IF. DTSBD551 +04786 DTSBD551 +04787 S1040-EXIT. DTSBD551 +04788 EXIT. DTSBD551 +04789 DTSBD551 +04790 S1500-OPEN-WAGE-OUT. DTSBD551 +04791 OPEN OUTPUT WAGE-FILE-OUT. DTSBD551 +04792 IF WAGE-OUT-STATUS-OK-88 DTSBD551 +04793 NEXT SENTENCE DTSBD551 +04794 *& DISPLAY 'WAGE FILE OPENED ' E-FEDERAL-EIN DTSBD551 +04795 ELSE DTSBD551 +04796 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04797 DISPLAY 'CANNOT OPEN WAGE OUT FILE: ' DTSBD551 +04798 WAGE-OUT-STATUS DTSBD551 +04799 END-IF. DTSBD551 +04800 DTSBD551 +04801 S1500-EXIT. DTSBD551 +04802 EXIT. DTSBD551 +04803 DTSBD551 +04804 S1600-CLOSE-WAGE-OUT. DTSBD551 +04805 CLOSE WAGE-FILE-OUT. DTSBD551 +04806 IF WAGE-OUT-STATUS-OK-88 DTSBD551 +04807 NEXT SENTENCE DTSBD551 +04808 *& DISPLAY 'OUT WAGE FILE CLOSED ' E-FEDERAL-EIN DTSBD551 +04809 ELSE DTSBD551 +04810 SET W-ERROR-YES-88 TO TRUE DTSBD551 +04811 DISPLAY 'CANNOT CLOSE WAGE OUT FILE: ' DTSBD551 +04812 WAGE-OUT-STATUS DTSBD551 +04813 END-IF. DTSBD551 +04814 DTSBD551 +04815 S1600-EXIT. DTSBD551 +04816 EXIT. DTSBD551 +04817 DTSBD551 +04818 S2000-EMP-LIABILITY. DTSBD551 +04819 *& DTSBD551 +04820 * IF E-FEDERAL-EIN = 941245885 DTSBD551 +04821 * DISPLAY 'S2000 ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 +04822 * END-IF. DTSBD551 +04823 *& DTSBD551 +04824 PERFORM S2010-FIND-MPRF THRU S2010-EXIT. DTSBD551 +04825 IF W-EMP-FOUND-NO-88 DTSBD551 +04826 NEXT SENTENCE DTSBD551 +04827 ELSE DTSBD551 +04828 IF W-ERROR-NO-88 DTSBD551 +04829 PERFORM S2020-QTR-LIABILITY THRU S2020-EXIT DTSBD551 +04830 IF L516-NOT-LIABLE-88 DTSBD551 +04831 PERFORM S2030-FIND-SUCCESSOR THRU S2030-EXIT DTSBD551 +04832 END-IF DTSBD551 +04833 END-IF DTSBD551 +04834 END-IF. DTSBD551 +04835 DTSBD551 +04836 DTSBD551 +04837 S2000-EXIT. DTSBD551 +04838 EXIT. DTSBD551 +04839 DTSBD551 +04840 S2010-FIND-MPRF. DTSBD551 +04841 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD551 +04842 MOVE W-EMP-NO TO MSKL-EMP-NO. DTSBD551 +04843 SET MSKL-PRF-88 TO TRUE. DTSBD551 +04844 DTSBD551 +04845 PERFORM S910-READ THRU S910-EXIT. DTSBD551 +04846 IF L910-NO-REC-88 DTSBD551 +04847 MOVE ZERO TO W-EMP-NO DTSBD551 +04848 PERFORM S2050-ACCT-FROM-FEIN THRU S2050-EXIT DTSBD551 +04849 IF W-FEIN-EMP-NO > ZERO DTSBD551 +04850 ADD +1 TO W-ACCT-FROM-FEIN-CNT DTSBD551 +04851 MOVE W-FEIN-EMP-NO TO W-EMP-NO DTSBD551 +04852 ELSE DTSBD551 +04853 SET W-EMP-FOUND-NO-88 TO TRUE DTSBD551 +04854 ADD +1 TO W-ACCT-NOT-FOUND-CNT DTSBD551 +04855 END-IF DTSBD551 +04856 ELSE DTSBD551 +04857 MOVE MSKL-REC TO MPRF-REC DTSBD551 +04858 MOVE MPRF-PRIMARY-NAME TO W-EMP-NAME DTSBD551 +04859 END-IF. DTSBD551 +04860 DTSBD551 +04861 S2010-EXIT. DTSBD551 +04862 EXIT. DTSBD551 +04863 DTSBD551 +04864 S2020-QTR-LIABILITY. DTSBD551 +04865 *& DTSBD551 +04866 * IF E-FEDERAL-EIN = 941245885 DTSBD551 +04867 * DISPLAY 'S2020 ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 +04868 * END-IF. DTSBD551 +04869 *& DTSBD551 +04870 MOVE W-RPT-QTR TO L516-YRQ DTSBD551 +04871 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSBD551 +04872 IF L516-NOT-LIABLE-88 DTSBD551 +04873 NEXT SENTENCE DTSBD551 +04874 ELSE DTSBD551 +04875 IF MPRF-CLASS-SELF-INS-88 DTSBD551 +04876 MOVE ZERO TO W-UI-RATE DTSBD551 +04877 ELSE DTSBD551 +04878 IF L516-NO-RATE-88 DTSBD551 +04879 SET W-LIABLE-NO-88 TO TRUE DTSBD551 +04880 MOVE MSG-E3 TO R551-MSG-TEXT DTSBD551 +04881 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 +04882 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +04883 * DISPLAY 'TYPE E: NO UI RATE FOR QUARTER ' W-EMP-NO DTSBD551 +04884 * DISPLAY ' TRANSACTION WILL FAIL EDITS' DTSBD551 +04885 ELSE DTSBD551 +04886 MOVE L516-UI-RATE TO W-UI-RATE DTSBD551 +04887 END-IF DTSBD551 +04888 IF L516-ANN-SCHED-88 DTSBD551 +04889 SET W-ANNUAL-QTR-YES-88 TO TRUE DTSBD551 +04890 MOVE MSG-E9E TO R551-MSG-TEXT DTSBD551 +04891 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 +04892 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +04893 DISPLAY 'TYPE E: ANNUAL QUARTER ' W-EMP-NO DTSBD551 +04894 DISPLAY ' TRANSACTION WILL FAIL EDITS' DTSBD551 +04895 END-IF DTSBD551 +04896 END-IF DTSBD551 +04897 END-IF. DTSBD551 +04898 DTSBD551 +04899 S2020-EXIT. DTSBD551 +04900 EXIT. DTSBD551 +04901 DTSBD551 +04902 S2030-FIND-SUCCESSOR. DTSBD551 +04903 *& DTSBD551 +04904 * IF E-FEDERAL-EIN = 941245885 DTSBD551 +04905 * DISPLAY 'S2030 ' E-FEDERAL-EIN ' ' MPRF-EMP-NO DTSBD551 +04906 * END-IF. DTSBD551 +04907 *& DTSBD551 +04908 MOVE MPRF-EMP-NO TO L601-EMP-NO. DTSBD551 +04909 MOVE 99999999 TO L601-EXP-TRN-EFF-DATE. DTSBD551 +04910 PERFORM S601-CALL-BU601 THRU S601-EXIT. DTSBD551 +04911 IF L601-SUCCESSOR-FOUND-88 DTSBD551 +04912 PERFORM S2031-SUCCESSOR-FOUND THRU S2031-EXIT DTSBD551 +04913 ELSE DTSBD551 +04914 SET W-LIABLE-NO-88 TO TRUE DTSBD551 +04915 IF L601-PARTIAL-TRANSFER-88 DTSBD551 +04916 MOVE W-REPORT-CCYY TO MSG-E4A-REPORT-CCYY DTSBD551 +04917 MOVE W-REPORT-MM-X TO MSG-E4A-REPORT-MM-X DTSBD551 +04918 MOVE MSG-E4A TO R551-MSG-TEXT DTSBD551 +04919 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 +04920 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +04921 ELSE DTSBD551 +04922 MOVE W-REPORT-CCYY TO MSG-E4-REPORT-CCYY DTSBD551 +04923 MOVE W-REPORT-MM-X TO MSG-E4-REPORT-MM-X DTSBD551 +04924 MOVE MSG-E4 TO R551-MSG-TEXT DTSBD551 +04925 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 +04926 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +04927 END-IF DTSBD551 +04928 END-IF. DTSBD551 +04929 DTSBD551 +04930 S2030-EXIT. DTSBD551 +04931 EXIT. DTSBD551 +04932 DTSBD551 +04933 S2031-SUCCESSOR-FOUND. DTSBD551 +04934 ** SET W-SUCCESSOR-YES-88 TO TRUE. DTSBD551 +04935 MOVE L601-ULTIMATE-SUCCESSOR TO W-EMP-NO DTSBD551 +04936 *& DTSBD551 +04937 * IF E-FEDERAL-EIN = 941245885 DTSBD551 +04938 * DISPLAY 'S2031 ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 +04939 * END-IF. DTSBD551 +04940 *& DTSBD551 +04941 MOVE MPRF-EMP-NO TO W-PRED-NO DTSBD551 +04942 *** DISPLAY 'TYPE E: USING SUCCESSOR ACCOUNT ' W-EMP-NO DTSBD551 +04943 PERFORM S2010-FIND-MPRF THRU S2010-EXIT DTSBD551 +04944 IF W-ERROR-NO-88 DTSBD551 +04945 ADD +1 TO W-ACCT-FROM-SUCC-CNT DTSBD551 +04946 MOVE MPRF-FEIN TO W-FINAL-FEIN DTSBD551 +04947 PERFORM S2020-QTR-LIABILITY THRU S2020-EXIT DTSBD551 +04948 IF L516-NOT-LIABLE-88 DTSBD551 +04949 SET W-LIABLE-NO-88 TO TRUE DTSBD551 +04950 MOVE W-REPORT-CCYY TO MSG-E4-REPORT-CCYY DTSBD551 +04951 MOVE W-REPORT-MM-X TO MSG-E4-REPORT-MM-X DTSBD551 +04952 MOVE MSG-E4 TO R551-MSG-TEXT DTSBD551 +04953 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 +04954 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +04955 END-IF DTSBD551 +04956 END-IF. DTSBD551 +04957 DTSBD551 +04958 S2031-EXIT. DTSBD551 +04959 EXIT. DTSBD551 +04960 DTSBD551 +04961 S2050-ACCT-FROM-FEIN. DTSBD551 +04962 *& DTSBD551 +04963 *** DISPLAY 'FIND ACCT FROM FEIN ' E-FEDERAL-EIN ' ' W-EMP-NO DTSBD551 +04964 *& DTSBD551 +04965 MOVE ZERO TO W-FEIN-EMP-NO. DTSBD551 +04966 DTSBD551 +04967 MOVE LOW-VALUE TO IEIN-KEY-AREA DTSBD551 +04968 SET IEIN-EIN-88 TO TRUE DTSBD551 +04969 MOVE E-FEDERAL-EIN TO IEIN-FEIN DTSBD551 +04970 MOVE +0 TO IEIN-EMP-NO DTSBD551 +04971 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBD551 +04972 PERFORM S921-START-BROWSE THRU S921-EXIT DTSBD551 +04973 MOVE ISKL-REC TO IEIN-REC DTSBD551 +04974 PERFORM DTSBD551 +04975 UNTIL L921-NO-REC-88 DTSBD551 +04976 OR W-FEIN-EMP-NO > ZERO DTSBD551 +04977 IF IEIN-FEIN = E-FEDERAL-EIN DTSBD551 +04978 PERFORM S2051-FIND-MPRF THRU S2051-EXIT DTSBD551 +04979 IF W-FEIN-EMP-NO = ZERO DTSBD551 +04980 PERFORM S921-READ-NEXT THRU S921-EXIT DTSBD551 +04981 MOVE ISKL-REC TO IEIN-REC DTSBD551 +04982 END-IF DTSBD551 +04983 ELSE DTSBD551 +04984 SET L921-NO-REC-88 TO TRUE DTSBD551 +04985 END-IF DTSBD551 +04986 END-PERFORM. DTSBD551 +04987 DTSBD551 +04988 S2050-EXIT. DTSBD551 +04989 EXIT. DTSBD551 +04990 DTSBD551 +04991 S2051-FIND-MPRF. DTSBD551 +04992 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD551 +04993 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBD551 +04994 SET MSKL-PRF-88 TO TRUE. DTSBD551 +04995 DTSBD551 +04996 PERFORM S910-READ THRU S910-EXIT. DTSBD551 +04997 IF L910-NO-REC-88 DTSBD551 +04998 NEXT SENTENCE DTSBD551 +04999 ELSE DTSBD551 +05000 MOVE MSKL-REC TO MPRF-REC DTSBD551 +05001 MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DTSBD551 +05002 MOVE MPRF-PRIMARY-NAME TO W-EMP-NAME DTSBD551 +05003 END-IF. DTSBD551 +05004 DTSBD551 +05005 S2051-EXIT. DTSBD551 +05006 EXIT. DTSBD551 +05007 DTSBD551 +05008 S2100-REPORT-QTR. DTSBD551 +05009 * DISPLAY ' S2100 FATAL IND ' W-FATAL-ERROR-IND DTSBD551 +05010 IF W-REPORT-CC NOT NUMERIC DTSBD551 +05011 OR W-REPORT-YY NOT NUMERIC DTSBD551 +05012 OR W-REPORT-MM-X NOT NUMERIC DTSBD551 +05013 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05014 ': REPORT QUARTER NOT NUMERIC ' DTSBD551 +05015 W-REPORT-CCYY ' ' W-REPORT-MM-X DTSBD551 +05016 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +05017 MOVE W-REPORT-CCYY TO MSG-E20-REPORT-CCYY DTSBD551 +05018 MOVE W-REPORT-MM-X TO MSG-E20-REPORT-MM-X DTSBD551 +05019 MOVE MSG-E20 TO R551-MSG-TEXT DTSBD551 +05020 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +05021 GO TO S2100-EXIT DTSBD551 +05022 END-IF. DTSBD551 +05023 DTSBD551 +05024 MOVE W-REPORT-CCYY-9 TO L004-QTR-5-YR. DTSBD551 +05025 EVALUATE TRUE DTSBD551 +05026 WHEN W-REPORT-MM-9 = 3 DTSBD551 +05027 MOVE 1 TO L004-QTR-5-Q DTSBD551 +05028 DTSBD551 +05029 WHEN W-REPORT-MM-9 = 6 DTSBD551 +05030 MOVE 2 TO L004-QTR-5-Q DTSBD551 +05031 DTSBD551 +05032 WHEN W-REPORT-MM-9 = 9 DTSBD551 +05033 MOVE 3 TO L004-QTR-5-Q DTSBD551 +05034 DTSBD551 +05035 WHEN W-REPORT-MM-9 = 12 DTSBD551 +05036 MOVE 4 TO L004-QTR-5-Q DTSBD551 +05037 DTSBD551 +05038 WHEN OTHER DTSBD551 +05039 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05040 ': INVALID REPORT QTR ' W-REPORT-MM-9 DTSBD551 +05041 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +05042 MOVE W-REPORT-MM-9 TO MSG-E21-REPORT-MM-9 DTSBD551 +05043 MOVE MSG-E21 TO R551-MSG-TEXT DTSBD551 +05044 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +05045 GO TO S2100-EXIT DTSBD551 +05046 DTSBD551 +05047 END-EVALUATE. DTSBD551 +05048 DTSBD551 +05049 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD551 +05050 IF L004-INVALID-QTR DTSBD551 +05051 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05052 ': INVALID REPORT QUARTER ' DTSBD551 +05053 W-REPORT-CCYY ' ' W-REPORT-MM-9 DTSBD551 +05054 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +05055 MOVE W-REPORT-CCYY TO MSG-E22-REPORT-CCYY DTSBD551 +05056 MOVE W-REPORT-MM-X TO MSG-E22-REPORT-MM-X DTSBD551 +05057 MOVE MSG-E22 TO R551-MSG-TEXT DTSBD551 +05058 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +05059 ELSE DTSBD551 +05060 MOVE L004-QTR-5-9 TO W-RPT-QTR DTSBD551 +05061 MOVE L004-QTR-END-DATE TO W-RPT-DATE DTSBD551 +05062 IF WORK-PARM-RUN-TYPE-ANY-88 DTSBD551 +05063 PERFORM S2110-ANY-QTR THRU S2110-EXIT DTSBD551 +05064 ELSE DTSBD551 +05065 PERFORM S2120-LAST-3-YRS THRU S2120-EXIT DTSBD551 +05066 END-IF DTSBD551 +05067 END-IF. DTSBD551 +05068 DTSBD551 +05069 S2100-EXIT. DTSBD551 +05070 EXIT. DTSBD551 +05071 DTSBD551 +05072 S2110-ANY-QTR. DTSBD551 +05073 IF W-RPT-QTR < W-EARLIEST-QTR DTSBD551 +05074 * DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05075 * ': REPORT MORE THAN 3 YEARS OLD ACCEPTED: ' DTSBD551 +05076 * W-RPT-QTR DTSBD551 +05077 NEXT SENTENCE DTSBD551 +05078 ELSE DTSBD551 +05079 IF W-RPT-QTR >= W-CURR-QTR DTSBD551 +05080 * DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05081 * ': REPORT REJECTED - QTR > CURRENT QTR: ' DTSBD551 +05082 * W-RPT-QTR DTSBD551 +05083 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +05084 MOVE W-RPT-QTR TO MSG-E23-RPT-QTR DTSBD551 +05085 MOVE W-CURR-QTR TO MSG-E23-CURR-QTR DTSBD551 +05086 MOVE MSG-E23 TO R551-MSG-TEXT DTSBD551 +05087 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +05088 END-IF DTSBD551 +05089 END-IF. DTSBD551 +05090 DTSBD551 +05091 S2110-EXIT. DTSBD551 +05092 EXIT. DTSBD551 +05093 DTSBD551 +05094 S2120-LAST-3-YRS. DTSBD551 +05095 IF W-RPT-QTR < W-EARLIEST-QTR DTSBD551 +05096 ** SET W-ERROR-YES-88 TO TRUE DTSBD551 +05097 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05098 ': REPORT QTR MORE THAN 3 YEARS OLD-ACCEPTED: ' W-RPT-QTR DTSBD551 +05099 ELSE DTSBD551 +05100 IF W-RPT-QTR >= W-CURR-QTR DTSBD551 +05101 * DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05102 * ': REPORT REJECTED - QTR > CURRENT QTR: ' DTSBD551 +05103 * W-RPT-QTR DTSBD551 +05104 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +05105 MOVE W-RPT-QTR TO MSG-E23-RPT-QTR DTSBD551 +05106 MOVE W-CURR-QTR TO MSG-E23-CURR-QTR DTSBD551 +05107 MOVE MSG-E23 TO R551-MSG-TEXT DTSBD551 +05108 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +05109 END-IF DTSBD551 +05110 END-IF. DTSBD551 +05111 DTSBD551 +05112 S2120-EXIT. DTSBD551 +05113 EXIT. DTSBD551 +05114 DTSBD551 +05115 S2130-RECEIVED-DATE. DTSBD551 +05116 MOVE W-RPT-QTR TO L004-QTR-5-9. DTSBD551 +05117 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD551 +05118 MOVE L004-QTR-DEFAULT-DUE-DATE TO W-DEFAULT-RCVD-DT. DTSBD551 +05119 DTSBD551 +05120 IF W-PARM-TIMELY-YES-88 DTSBD551 +05121 IF W-SUBM-CREATE-DATE > W-DEFAULT-RCVD-DT DTSBD551 +05122 MOVE W-DEFAULT-RCVD-DT TO W-RECEIVED-DATE DTSBD551 +05123 ELSE DTSBD551 +05124 MOVE W-SUBM-CREATE-DATE TO W-RECEIVED-DATE DTSBD551 +05125 END-IF DTSBD551 +05126 ELSE DTSBD551 +05127 MOVE W-PARM-RECEIVED-DATE TO W-RECEIVED-DATE DTSBD551 +05128 END-IF. DTSBD551 +05129 DTSBD551 +05130 S2130-EXIT. DTSBD551 +05131 EXIT. DTSBD551 +05132 DTSBD551 +05133 ************************************************************** DTSBD551 +05134 * W-EDITED-E-ACCT SAVES THE E-RECORD ACCOUNT NUMBER AFTER DTSBD551 +05135 * SPACES, HYPHENS, ETC. ARE REMOVED. IT IS USED HERE DTSBD551 +05136 * TO ENSURE THAT THE SAME ACCOUNT NUMBER IS USED ON THE DTSBD551 +05137 * BOTH THE S-RECORDS AND E-RECORDS. DTSBD551 +05138 ************************************************************** DTSBD551 +05139 S2200-TYPE-S-ACCT-NBR. DTSBD551 +05140 ** EDIT ACCOUNT NUMBER FROM TYPE S RECORD. DTSBD551 +05141 ** DTSBD551 +05142 DTSBD551 +05143 IF W-FEIN-EMP-NO NOT = ZERO DTSBD551 +05144 * DISPLAY 'TYPE S: USING ACCOUNT NUMBER FROM FEIN ' DTSBD551 +05145 * W-FEIN-EMP-NO DTSBD551 +05146 NEXT SENTENCE DTSBD551 +05147 ELSE DTSBD551 +05148 PERFORM S2210-FORMAT-ACCT-NO THRU S2210-EXIT DTSBD551 +05149 *** IF W-ACCT-NBR-ERR-YES-88 DTSBD551 +05150 IF W-ACCT-NBR-OUT = SPACES DTSBD551 +05151 OR W-ACCT-NBR-9 NOT NUMERIC DTSBD551 +05152 OR SUB2 < 6 DTSBD551 +05153 * DISPLAY 'TYPE S: ACCOUNT NUMBER INVALID, USING TYPE E 'DTSBD551 +05154 * DISPLAY ' TYPE S: ' S-ACCOUNT-NO DTSBD551 +05155 * ' TYPE E: ' W-EMP-NO DTSBD551 +05156 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +05157 MOVE S-ACCOUNT-NO TO MSG-S9-S-EMP-NO DTSBD551 +05158 MOVE W-EMP-NO TO MSG-S9-E-EMP-NO DTSBD551 +05159 MOVE MSG-S9 TO R551-MSG-TEXT DTSBD551 +05160 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +05161 ELSE DTSBD551 +05162 MOVE W-ACCT-NBR-9 TO W-EDITED-S-ACCT DTSBD551 +05163 IF W-EDITED-E-ACCT NOT = W-EDITED-S-ACCT DTSBD551 +05164 *** IF W-ACCT-NBR-9 NOT = W-EMP-NO DTSBD551 +05165 * DISPLAY 'TYPE S: ACCT NBR DIFFERENT FROM TYPE E ' DTSBD551 +05166 * DISPLAY ' USING TYPE E ACCT NBR ' DTSBD551 +05167 * DISPLAY ' TYPE S: ' W-ACCT-NBR-9 DTSBD551 +05168 * ' TYPE E: ' W-EMP-NO DTSBD551 +05169 MOVE E-FEDERAL-EIN TO R551-EMP-FEIN DTSBD551 +05170 MOVE W-ACCT-NBR-9 TO MSG-S10-S-EMP-NO DTSBD551 +05171 MOVE W-EMP-NO TO MSG-S10-E-EMP-NO DTSBD551 +05172 MOVE MSG-S10 TO R551-MSG-TEXT DTSBD551 +05173 PERFORM P1199-FATAL-ERROR THRU P1199-EXIT DTSBD551 +05174 END-IF DTSBD551 +05175 END-IF. DTSBD551 +05176 DTSBD551 +05177 S2200-EXIT. DTSBD551 +05178 EXIT. DTSBD551 +05179 DTSBD551 +05180 S2210-FORMAT-ACCT-NO. DTSBD551 +05181 IF FIRST-6-ALL-ZERO-88 DTSBD551 +05182 ** DISPLAY 'S2210 RIGHT JUST ' W-ACCT-NBR-IN DTSBD551 +05183 MOVE +10 TO SUB1-INIT DTSBD551 +05184 ELSE DTSBD551 +05185 MOVE +1 TO SUB1-INIT DTSBD551 +05186 END-IF. DTSBD551 +05187 DTSBD551 +05188 MOVE ZERO TO SUB2. DTSBD551 +05189 MOVE SPACES TO W-ACCT-NBR-OUT. DTSBD551 +05190 SET W-ACCT-NBR-ERR-NO-88 TO TRUE. DTSBD551 +05191 DTSBD551 +05192 PERFORM DTSBD551 +05193 VARYING SUB1 FROM SUB1-INIT BY +1 DTSBD551 +05194 UNTIL SUB1 > +15 DTSBD551 +05195 *** IF SUB1 > +6 DTSBD551 +05196 * IF W-ACCT-NBR-IN-X (SUB1) >= '0' DTSBD551 +05197 * NEXT SENTENCE DTSBD551 +05198 * END-IF DTSBD551 +05199 *** END-IF DTSBD551 +05200 IF W-ACCT-NBR-IN-X (SUB1) >= '0' DTSBD551 +05201 AND W-ACCT-NBR-IN-X (SUB1) <= '9' DTSBD551 +05202 IF SUB2 < W-ACCT-NBR-LEN DTSBD551 +05203 ADD +1 TO SUB2 DTSBD551 +05204 MOVE W-ACCT-NBR-IN-X (SUB1) DTSBD551 +05205 TO W-ACCT-NBR-OUT-X (SUB2) DTSBD551 +05206 *** ELSE DTSBD551 +05207 *** SET W-ACCT-NBR-ERR-YES-88 TO TRUE DTSBD551 +05208 END-IF DTSBD551 +05209 END-IF DTSBD551 +05210 END-PERFORM. DTSBD551 +05211 DTSBD551 +05212 S2210-EXIT. DTSBD551 +05213 EXIT. DTSBD551 +05214 DTSBD551 +05215 S2300-DUP-REPORT. DTSBD551 +05216 IF W-LIABLE-NO-88 DTSBD551 +05217 GO TO S2300-EXIT DTSBD551 +05218 END-IF. DTSBD551 +05219 DTSBD551 +05220 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD551 +05221 MOVE W-EMP-NO TO MQTR-EMP-NO. DTSBD551 +05222 MOVE W-RPT-QTR TO MQTR-YRQ. DTSBD551 +05223 SET MQTR-QTR-88 TO TRUE. DTSBD551 +05224 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD551 +05225 DTSBD551 +05226 PERFORM S910-READ THRU S910-EXIT. DTSBD551 +05227 IF L910-NO-REC-88 DTSBD551 +05228 NEXT SENTENCE DTSBD551 +05229 ELSE DTSBD551 +05230 MOVE MSKL-REC TO MQTR-REC DTSBD551 +05231 IF MQTR-CURR-RCVD-88 DTSBD551 +05232 SET W-DUP-RPT-YES-88 TO TRUE DTSBD551 +05233 MOVE W-EMP-NO TO MSG-E5-ACCT-NO DTSBD551 +05234 MOVE W-REPORT-CCYY TO MSG-E5-REPORT-CCYY DTSBD551 +05235 MOVE W-REPORT-MM-X TO MSG-E5-REPORT-MM-X DTSBD551 +05236 MOVE MSG-E5 TO R551-MSG-TEXT DTSBD551 +05237 SET R551-RPT-TYPE-FAIL-EDITS-88 TO TRUE DTSBD551 +05238 PERFORM P1398-NON-FATAL-ERROR THRU P1398-EXIT DTSBD551 +05239 *RW1 DISPLAY 'TYPE ' ICESA-REC-TYPE DTSBD551 +05240 * ': REPORT ALREADY ON FILE FOR THIS EMP/QTR: ' DTSBD551 +05241 *RW2 W-EMP-NO ' / ' W-RPT-QTR DTSBD551 +05242 END-IF DTSBD551 +05243 END-IF. DTSBD551 +05244 DTSBD551 +05245 S2300-EXIT. DTSBD551 +05246 EXIT. DTSBD551 +05247 DTSBD551 +05248 S3000-WRITE-ARCHIVE. DTSBD551 +05249 WRITE UC30-ARCHIVE-DD-REC. DTSBD551 +05250 IF NOT ARCHIVE-STATUS-OK-88 DTSBD551 +05251 DISPLAY 'CANNOT WRITE ARCHIVE DD ' ARCHIVE-STATUS DTSBD551 +05252 END-IF. DTSBD551 +05253 DTSBD551 +05254 S3000-EXIT. DTSBD551 +05255 EXIT. DTSBD551 +05256 DTSBD551 +05257 DTSBD551 +05258 S999-ABEND. DTSBD551 +05259 CALL 'DTSBU999' USING W-ABEND-CD. DTSBD551 +05260 S999-EXIT. DTSBD551 +05261 EXIT. DTSBD551 +05262 DTSBD551 diff --git a/Batch/DTSBE433.cob b/Batch/DTSBE433.cob new file mode 100644 index 0000000..f82ae81 --- /dev/null +++ b/Batch/DTSBE433.cob @@ -0,0 +1,680 @@ +00001 IDENTIFICATION DIVISION. 09/13/10 +00002 PROGRAM-ID. DTSBE433. DTSBE433 +00003 AUTHOR. NGC LV007 +00004 DATE-WRITTEN. MAY 2009. DTSBE433 +00005 DATE-COMPILED. DTSBE433 +00006 SKIP3 DTSBE433 +00007 ***** DTSBE433 +00008 * DTSBE433 +00009 * FUNCTION: GENERATE SECOND NOTICE TO SELF-INSURED DTSBE433 +00010 * EMPLOYERS WITH A BALANCE DUE IN UI TAX. DTSBE433 +00011 * DTSBE433 +00012 * DTSBE433 +00013 * MODIFICATION LOG: DTSBE433 +00014 * DTSBE433 +00015 * 05/20/2009 INITIAL DEVELOPMENT. DTSBE433 +00016 * WORK ORDER: PROGRAMMER: GD DTSBE433 +00017 * DTSBE433 +00018 * 09/10/2010 CHANGED REQUIREMENT THAT SECOND NOTICE BE DTSBE433 +00019 * GENERATED 30 DAYS FOLLOWING DUE DATE. DTSBE433 +00020 * TENTATIVELY CHANGED TO 7 DAYS, PENDING DTSBE433 +00021 * STAFF APPROVAL IN ORDER TO RUN TPS EXTRACT. DTSBE433 +00022 * WORK ORDER: PROGRAMMER: GD DTSBE433 +00023 * DTSBE433 +00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE433 +00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE433 +00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE433 +00027 * DTSBE433 +00028 * DESCRIPTION: DTSBE433 +00029 * DTSBE433 +00030 * DTSBE433 +00031 * INITIATION: DTSBE433 +00032 * DTSBE433 +00033 * EDIT AND DEFAULT PARAMETERS. YEAR/QTR INPUT PARM DTSBE433 +00034 * DTSBE433 +00035 * DTSBE433 +00036 * PROCESSING: DTSBE433 +00037 * DTSBE433 +00038 * DTSBE433 +00039 * DTSBE433 +00040 * TERMINATION: DTSBE433 +00041 * DTSBE433 +00042 * DTSBE433 +00043 * DTSBE433 +00044 * DTSBE433 +00045 * RECORDS READ: DTSBE433 +00046 * DTSBE433 +00047 * MASTER: DTSBE433 +00048 * DTSBE433 +00049 * MPRF DTSBE433 +00050 * MQTR DTSBE433 +00051 * DTSBE433 +00052 * DTSBE433 +00053 * ALTERNATE INDEX: DTSBE433 +00054 * DTSBE433 +00055 * NONE. DTSBE433 +00056 * DTSBE433 +00057 * DTSBE433 +00058 * REFERENCE: DTSBE433 +00059 * DTSBE433 +00060 * NONE DTSBE433 +00061 * DTSBE433 +00062 * DTSBE433 +00063 * RECORDS UPDATED: DTSBE433 +00064 * DTSBE433 +00065 * MEVL (WRITE) DTSBE433 +00066 * DTSBE433 +00067 * DTSBE433 +00068 * REPORT RECORDS WRITTEN: DTSBE433 +00069 * DTSBE433 +00070 * R907 UNUSUAL CONDITION ENCOUNTERED. DTSBE433 +00071 * DTSBE433 +00072 * DTSBE433 +00073 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE433 +00074 * DTSBE433 +00075 * NONE. DTSBE433 +00076 * DTSBE433 +00077 * DTSBE433 +00078 * MODULES CALLED: DTSBE433 +00079 * DTSBE433 +00080 * DTSBU001 DATE CONVERSION/EDIT. DTSBE433 +00081 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE433 +00082 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE433 +00083 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE433 +00084 * DTSBE433 +00085 ***** DTSBE433 +00086 SKIP3 DTSBE433 +00087 ENVIRONMENT DIVISION. DTSBE433 +00088 DTSBE433 +00089 INPUT-OUTPUT SECTION. DTSBE433 +00090 DTSBE433 +00091 FILE-CONTROL. DTSBE433 +00092 DTSBE433 +00093 * SELECT EMP-DELNQ-FILE ASSIGN TO DTSIX430 DTSBE433 +00094 * FILE STATUS IS EMP-DELNQ-STATUS. DTSBE433 +00095 DTSBE433 +00096 DATA DIVISION. DTSBE433 +00097 DTSBE433 +00098 FILE SECTION. DTSBE433 +00099 DTSBE433 +00100 *FD EMP-DELNQ-FILE DTSBE433 +00101 * RECORDING MODE IS F DTSBE433 +00102 * BLOCK CONTAINS 0 RECORDS DTSBE433 +00103 * LABEL RECORDS ARE OMITTED. DTSBE433 +00104 * DTSBE433 +00105 *01 EMP-DELNQ-REC PIC X(51). DTSBE433 +00106 DTSBE433 +00107 EJECT DTSBE433 +00108 WORKING-STORAGE SECTION. DTSBE433 +001085 77 PAN-VALET PICTURE X(24) VALUE '007DTSBE433 09/13/10'. DTSBE433 +00109 SKIP3 DTSBE433 +00110 01 WRK-AREA. DTSBE433 +00111 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +433.DTSBE433 +00112 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE433'.DTSBE433 +00113 05 ABEND-MSG PIC X(60). DTSBE433 +00114 DTSBE433 +00115 05 EMP-DELNQ-STATUS PIC X(02). DTSBE433 +00116 88 EMP-DELNQ-STATUS-OK-88 VALUE '00'. DTSBE433 +00117 88 EMP-DELNQ-STATUS-EOF-88 VALUE '10'. DTSBE433 +00118 DTSBE433 +00119 05 WRK-UI-TAX PIC S9(09)V99 COMP-3. DTSBE433 +00120 05 WRK-SUR-TAX PIC S9(09)V99 COMP-3. DTSBE433 +00121 05 WRK-PEN PIC S9(09)V99 COMP-3. DTSBE433 +00122 05 WRK-INT PIC S9(09)V99 COMP-3. DTSBE433 +00123 05 WRK-INT-TOT PIC S9(09)V99 COMP-3. DTSBE433 +00124 05 WRK-MIN-DUE PIC S9(09)V99 COMP-3 DTSBE433 +00125 VALUE +10.00. DTSBE433 +00126 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE433 +00127 05 WRK-SUBJECT-SLASH-QTR PIC X(04). DTSBE433 +00128 05 WRK-EVL-SLASH-5-QTR PIC X(06) VALUE SPACES. DTSBE433 +00129 05 WRK-INT-COMP-DATE PIC S9(09) COMP-3. DTSBE433 +00130 DTSBE433 +00131 05 BYPASS-REC PIC 9(01) VALUE 0. DTSBE433 +00132 05 WRK-R433-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE433 +00133 05 WRK-MEVL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE433 +00134 DTSBE433 +00135 05 EVL-TEXT. DTSBE433 +00136 10 FILLER PIC X(40) DTSBE433 +00137 VALUE 'SECOND NOTICE: SELF-INS UI TAX DUE '. DTSBE433 +00138 10 EVL-SLASH-5-QTR PIC X(06). DTSBE433 +00139 DTSBE433 +00140 05 AMT-DISP1 PIC --------9.99. DTSBE433 +00141 DTSBE433 +00142 01 MSG-AREA. DTSBE433 +00143 05 MSG1-AREA. DTSBE433 +00144 10 MSG1-ID PIC X(03) VALUE '433'. DTSBE433 +00145 10 MSG1-TEXT. DTSBE433 +00146 15 FILLER PIC X(40) DTSBE433 +00147 VALUE 'MPRF RETURN-MAIL INDICATOR = "YES" AND A'. DTSBE433 +00148 15 FILLER PIC X(33) DTSBE433 +00149 VALUE 'LSO THE MPRF-PURSUED-RPT-CNT = +1'. DTSBE433 +00150 DTSBE433 +00151 05 MSG2-AREA. DTSBE433 +00152 10 MSG2-ID PIC X(03) VALUE '433'. DTSBE433 +00153 10 MSG2-TEXT. DTSBE433 +00154 15 FILLER PIC X(40) DTSBE433 +00155 VALUE 'MASTER FILE MQTR RECORD NOT FOUND ON THI'. DTSBE433 +00156 15 FILLER PIC X(29) DTSBE433 +00157 VALUE 'S EMPLOYER ACCOUNT: YRQ = '. DTSBE433 +00158 15 MSG2-SLASHED-YRQ PIC X(04). DTSBE433 +00159 DTSBE433 +00160 05 MSG3-AREA. DTSBE433 +00161 10 MSG3-ID PIC X(03) VALUE '433'. DTSBE433 +00162 10 MSG3-TEXT. DTSBE433 +00163 15 FILLER PIC X(40) DTSBE433 +00164 VALUE 'MASTER FILE MQTR PURSUED REPORT INDICATO'. DTSBE433 +00165 15 FILLER PIC X(29) DTSBE433 +00166 VALUE 'R WAS "NOT" PURSUED. YRQ = '. DTSBE433 +00167 15 MSG3-SLASHED-YRQ PIC X(04). DTSBE433 +00168 DTSBE433 +00169 05 MSG4-AREA. DTSBE433 +00170 10 MSG4-ID PIC X(03) VALUE '434'. DTSBE433 +00171 10 MSG4-TEXT. DTSBE433 +00172 15 FILLER PIC X(40) DTSBE433 +00173 VALUE 'MQTR MISS REPORT CUTOFF CODE INDICATED T'. DTSBE433 +00174 15 FILLER PIC X(29) DTSBE433 +00175 VALUE 'HE LETTER "NOT" SENT. YRQ = '. DTSBE433 +00176 15 MSG4-SLASHED-YRQ PIC X(04). DTSBE433 +00177 DTSBE433 +00178 EJECT DTSBE433 +00179 01 WRK-EMP-DELNQ-REC. DTSBE433 +00180 ++INCLUDE DTSIX430 DTSBE433 +00181 SKIP3 DTSBE433 +00182 01 L001-LINK-AREA. DTSBE433 +00183 ++INCLUDE DTSIL001 DTSBE433 +00184 SKIP3 DTSBE433 +00185 01 L004-LINK-AREA. DTSBE433 +00186 ++INCLUDE DTSIL004 DTSBE433 +00187 SKIP3 DTSBE433 +00188 01 L005-LINK-AREA. DTSBE433 +00189 ++INCLUDE DTSIL005 DTSBE433 +00190 SKIP3 DTSBE433 +00191 01 L101-LINK-AREA. DTSBE433 +00192 ++INCLUDE DTSIL101 DTSBE433 +00193 DTSBE433 +00194 01 L111-LINK-AREA. DTSBE433 +00195 ++INCLUDE DTSIL111 DTSBE433 +00196 DTSBE433 +00197 01 L112-LINK-AREA. DTSBE433 +00198 ++INCLUDE DTSIL112 DTSBE433 +00199 DTSBE433 +00200 01 L910-LINK-AREA. DTSBE433 +00201 ++INCLUDE DTSIL910 DTSBE433 +00202 SKIP3 DTSBE433 +00203 01 MSKL-REC. DTSBE433 +00204 ++INCLUDE DTSIMSKL DTSBE433 +00205 SKIP3 DTSBE433 +00206 01 MQTR-REC. DTSBE433 +00207 ++INCLUDE DTSIMQTR DTSBE433 +00208 SKIP3 DTSBE433 +00209 01 MEVL-REC. DTSBE433 +00210 ++INCLUDE DTSIMEVL DTSBE433 +00211 SKIP3 DTSBE433 +00212 01 L931-LINK-AREA. DTSBE433 +00213 ++INCLUDE DTSIL931 DTSBE433 +00214 SKIP3 DTSBE433 +00215 01 FSKL-REC. DTSBE433 +00216 ++INCLUDE DTSIFSKL DTSBE433 +00217 SKIP3 DTSBE433 +00218 01 FQTR-REC. DTSBE433 +00219 ++INCLUDE DTSIFQTR DTSBE433 +00220 SKIP3 DTSBE433 +00221 01 R433-REC. DTSBE433 +00222 ++INCLUDE DTSIR433 DTSBE433 +00223 DTSBE433 +00224 01 R907-REC. DTSBE433 +00225 ++INCLUDE DTSIR907 DTSBE433 +00226 SKIP3 DTSBE433 +00227 LINKAGE SECTION. DTSBE433 +00228 SKIP3 DTSBE433 +00229 01 LECM-LINK-AREA. DTSBE433 +00230 ++INCLUDE DTSILECM DTSBE433 +00231 SKIP3 DTSBE433 +00232 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE433 +00233 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE433 +00234 15 FILLER PIC X(65). DTSBE433 +00235 EJECT DTSBE433 +00236 01 MPRF-LINK-REC. DTSBE433 +00237 ++INCLUDE DTSIMPRF DTSBE433 +00238 EJECT DTSBE433 +00239 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE433 +00240 MPRF-LINK-REC. DTSBE433 +00241 DTSBE433 +00242 EVALUATE TRUE DTSBE433 +00243 WHEN LECM-PROCESS-88 DTSBE433 +00244 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE433 +00245 DTSBE433 +00246 WHEN LECM-INITIALIZE-88 DTSBE433 +00247 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE433 +00248 DTSBE433 +00249 WHEN LECM-TERMINATE-88 DTSBE433 +00250 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE433 +00251 DTSBE433 +00252 WHEN OTHER DTSBE433 +00253 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE433 +00254 TO ABEND-MSG DTSBE433 +00255 PERFORM S999-ABEND THRU S999-EXIT DTSBE433 +00256 END-EVALUATE. DTSBE433 +00257 DTSBE433 +00258 GOBACK. DTSBE433 +00259 EJECT DTSBE433 +00260 I0000-INITIALIZE. DTSBE433 +00261 DTSBE433 +00262 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE433 +00263 DTSBE433 +00264 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE433 +00265 R907-MODULE-NAME. DTSBE433 +00266 DTSBE433 +00267 ** OPEN OUTPUT EMP-DELNQ-FILE. DTSBE433 +00268 * IF EMP-DELNQ-STATUS-OK-88 DTSBE433 +00269 * NEXT SENTENCE DTSBE433 +00270 * ELSE DTSBE433 +00271 * DISPLAY 'RMP-DELNQ-FILE STATUS IS : ' EMP-DELNQ-STATUS DTSBE433 +00272 * MOVE 'CANNOT OPEN OUTPUT EMP-DELNQ-FILE ' TO ABEND-MSG DTSBE433 +00273 * PERFORM S999-ABEND THRU S999-EXIT DTSBE433 +00274 ** END-IF. DTSBE433 +00275 DTSBE433 +00276 MOVE LENGTH OF R433-REC TO R433-LENGTH. DTSBE433 +00277 DTSBE433 +00278 MOVE '433' TO R433-REC-TYPE. DTSBE433 +00279 DTSBE433 +00280 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE433 +00281 DTSBE433 +00282 MOVE '907' TO R907-REC-TYPE. DTSBE433 +00283 DTSBE433 +00284 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE433 +00285 DTSBE433 +00286 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE433 +00287 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE433 +00288 DTSBE433 +00289 I0000-EXIT. DTSBE433 +00290 EXIT. DTSBE433 +00291 SKIP3 DTSBE433 +00292 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE433 +00293 PERFORM I1100-SUBJECT-YRQ THRU I1100-EXIT DTSBE433 +00294 PERFORM I1200-RUN-DATE THRU I1200-EXIT. DTSBE433 +00295 PERFORM I1300-INT-COMP-DATE THRU I1300-EXIT. DTSBE433 +00296 DTSBE433 +00297 I1000-EXIT. DTSBE433 +00298 EXIT. DTSBE433 +00299 DTSBE433 +00300 I1100-SUBJECT-YRQ. DTSBE433 +00301 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE433 +00302 MOVE LECM-CURR-RUN-DATE TO L004-DATE DTSBE433 +00303 PERFORM S004-FROM-DATE THRU S004-EXIT DTSBE433 +00304 SUBTRACT +1 FROM L004-ABS-QTR DTSBE433 +00305 PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE433 +00306 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE433 +00307 MOVE L004-SLASH-5-QTR TO WRK-EVL-SLASH-5-QTR DTSBE433 +00308 ELSE DTSBE433 +00309 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3-X DTSBE433 +00310 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE433 +00311 IF L004-VALID-QTR DTSBE433 +00312 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE433 +00313 ELSE DTSBE433 +00314 MOVE 'PARM-SUBJECT-YRQ NOT VALID' DTSBE433 +00315 TO ABEND-MSG DTSBE433 +00316 PERFORM S999-ABEND THRU S999-EXIT DTSBE433 +00317 END-IF DTSBE433 +00318 END-IF. DTSBE433 +00319 DTSBE433 +00320 DISPLAY SPACES. DTSBE433 +00321 DISPLAY '*** SUBJECT QUARTER: ' WRK-EVL-SLASH-5-QTR. DTSBE433 +00322 DTSBE433 +00323 DTSBE433 +00324 I1100-EXIT. DTSBE433 +00325 EXIT. DTSBE433 +00326 DTSBE433 +00327 I1200-RUN-DATE. DTSBE433 +00328 MOVE 0 TO BYPASS-REC DTSBE433 +00329 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSBE433 +00330 SET FQTR-QTR-88 TO TRUE. DTSBE433 +00331 MOVE WRK-PARM-SUBJECT-YRQ TO FQTR-YRQ. DTSBE433 +00332 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA. DTSBE433 +00333 DTSBE433 +00334 PERFORM S931-READ THRU S931-EXIT. DTSBE433 +00335 IF L931-OK-88 DTSBE433 +00336 MOVE FSKL-REC TO FQTR-REC DTSBE433 +00337 ELSE DTSBE433 +00338 MOVE 'FQTR RECORD MISSING' TO ABEND-MSG DTSBE433 +00339 PERFORM S999-ABEND THRU S999-EXIT DTSBE433 +00340 END-IF. DTSBE433 +00341 DTSBE433 +00342 IF FQTR-SELF-INS-2ND-LETTER-DATE > +0 DTSBE433 +00343 DISPLAY '2ND LETTER ALREADY GENERATED ' DTSBE433 +00344 FQTR-SELF-INS-2ND-LETTER-DATE DTSBE433 +00345 MOVE 1 TO BYPASS-REC DTSBE433 +00346 GO TO I1200-EXIT. DTSBE433 +00347 DTSBE433 +00348 MOVE FQTR-SELF-INS-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBE433 +00349 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE433 +00350 DISPLAY 'SELF-INS TAX DUE DATE: ' L001-SLASH-8-DATE. DTSBE433 +00351 DTSBE433 +00352 ** ADD +30 TO L001-JUL-ABS-DAY. DTSBE433 +00353 ADD +7 TO L001-JUL-ABS-DAY. DTSBE433 +00354 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBE433 +00355 DISPLAY 'MIN RUN DATE : ' L001-SLASH-8-DATE. DTSBE433 +00356 DTSBE433 +00357 IF LECM-CURR-RUN-DATE < L001-FED-8-DATE-9 DTSBE433 +00358 ** DISPLAY '< 30 DAYS AFTER TAX DUE DATE ' DTSBE433 +00359 DISPLAY '< 7 DAYS AFTER TAX DUE DATE ' DTSBE433 +00360 DISPLAY 'RUN ' LECM-CURR-RUN-DATE DTSBE433 +00361 ' DUE ' L001-SLASH-8-DATE DTSBE433 +00362 ** DISPLAY 'BE433 MUST RUN 30 DAYS AFTER TAX DUE DATE' DTSBE433 +00363 DISPLAY 'BE433 MUST RUN 7 DAYS AFTER TAX DUE DATE' DTSBE433 +00364 MOVE 1 TO BYPASS-REC DTSBE433 +00365 END-IF. DTSBE433 +00366 DTSBE433 +00367 I1200-EXIT. DTSBE433 +00368 EXIT. DTSBE433 +00369 DTSBE433 +00370 I1300-INT-COMP-DATE. DTSBE433 +00371 MOVE LECM-CURR-MAIL-DATE TO L001-FED-8-DATE-9. DTSBE433 +00372 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE433 +00373 ADD +14 TO L001-JUL-ABS-DAY DTSBE433 +00374 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE433 +00375 MOVE L001-FED-8-DATE-9 TO WRK-INT-COMP-DATE. DTSBE433 +00376 DTSBE433 +00377 DISPLAY 'INTEREST COMP DATE ' L001-SLASH-8-DATE. DTSBE433 +00378 DTSBE433 +00379 I1300-EXIT. DTSBE433 +00380 EXIT. DTSBE433 +00381 DTSBE433 +00382 P0000-PROCESS. DTSBE433 +00383 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE433 +00384 DTSBE433 +00385 IF BYPASS-REC = 1 DTSBE433 +00386 GO TO P0000-EXIT. DTSBE433 +00387 DTSBE433 +00388 IF MPRF-CLASS-SELF-INS-88 DTSBE433 +00389 NEXT SENTENCE DTSBE433 +00390 ELSE DTSBE433 +00391 GO TO P0000-EXIT DTSBE433 +00392 END-IF. DTSBE433 +00393 DTSBE433 +00394 IF MPRF-RETURN-MAIL-YES-88 DTSBE433 +00395 GO TO P0000-EXIT DTSBE433 +00396 END-IF. DTSBE433 +00397 DTSBE433 +00398 MOVE ZERO TO WRK-UI-TAX DTSBE433 +00399 WRK-PEN DTSBE433 +00400 WRK-SUR-TAX DTSBE433 +00401 WRK-INT. DTSBE433 +00402 DTSBE433 +00403 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE433 +00404 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE433 +00405 SET MQTR-QTR-88 TO TRUE. DTSBE433 +00406 MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ. DTSBE433 +00407 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE433 +00408 DTSBE433 +00409 PERFORM S910-READ THRU S910-EXIT. DTSBE433 +00410 DTSBE433 +00411 IF L910-NO-REC-88 DTSBE433 +00412 GO TO P0000-EXIT DTSBE433 +00413 END-IF. DTSBE433 +00414 DTSBE433 +00415 MOVE MSKL-REC TO MQTR-REC. DTSBE433 +00416 DTSBE433 +00417 PERFORM DTSBE433 +00418 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBE433 +00419 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE433 +00420 EVALUATE TRUE DTSBE433 +00421 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE433 +00422 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-UI-TAX DTSBE433 +00423 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE433 +00424 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-SUR-TAX DTSBE433 +00425 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE433 +00426 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-PEN DTSBE433 +00427 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE433 +00428 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-INT DTSBE433 +00429 END-EVALUATE DTSBE433 +00430 END-PERFORM. DTSBE433 +00431 DTSBE433 +00432 IF WRK-UI-TAX > WRK-MIN-DUE DTSBE433 +00433 PERFORM P1000-INTEREST THRU P1000-EXIT DTSBE433 +00434 PERFORM P1100-WRITE-R433 THRU P1100-EXIT DTSBE433 +00435 IF L111-ADDR-FOUND-88 DTSBE433 +00436 PERFORM P1200-WRITE-MEVL THRU P1200-EXIT DTSBE433 +00437 END-IF DTSBE433 +00438 END-IF. DTSBE433 +00439 DTSBE433 +00440 P0000-EXIT. DTSBE433 +00441 EXIT. DTSBE433 +00442 DTSBE433 +00443 P1000-INTEREST. DTSBE433 +00444 COMPUTE WRK-INT-TOT = WRK-UI-TAX + WRK-SUR-TAX. DTSBE433 +00445 MOVE WRK-INT-TOT TO L101-PAID-CHNG. DTSBE433 +00446 MOVE WRK-INT-COMP-DATE TO L101-RECEIVED-DATE. DTSBE433 +00447 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBE433 +00448 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBE433 +00449 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBE433 +00450 DTSBE433 +00451 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBE433 +00452 DTSBE433 +00453 ADD L101-INT-CHARGE-CHNG TO WRK-INT. DTSBE433 +00454 DTSBE433 +00455 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-INT. DTSBE433 +00456 DTSBE433 +00457 MOVE WRK-INT TO AMT-DISP1. DTSBE433 +00458 DISPLAY 'INTEREST ' MPRF-EMP-NO ' ' AMT-DISP1. DTSBE433 +00459 P1000-EXIT. DTSBE433 +00460 EXIT. DTSBE433 +00461 DTSBE433 +00462 P1100-WRITE-R433. DTSBE433 +00463 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSBE433 +00464 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE433 +00465 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE433 +00466 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBE433 +00467 DTSBE433 +00468 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE433 +00469 DTSBE433 +00470 IF NOT L111-ADDR-FOUND-88 DTSBE433 +00471 DISPLAY 'NO MAILING ADDRESS ' MPRF-EMP-NO DTSBE433 +00472 GO TO P1100-EXIT DTSBE433 +00473 END-IF. DTSBE433 +00474 DTSBE433 +00475 SET L112-TAD-ADDR-88 TO TRUE DTSBE433 +00476 SET L112-ANCHOR-FIRST-88 TO TRUE DTSBE433 +00477 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE433 +00478 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE433 +00479 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE433 +00480 DTSBE433 +00481 MOVE L112-MAILING-ADDRESS TO R433-FMT-ADDR. DTSBE433 +00482 MOVE L112-ZIP TO R433-ZIP. DTSBE433 +00483 MOVE L112-ADVANCED-BARCODE TO R433-ADVANCED-BARCODE. DTSBE433 +00484 DTSBE433 +00485 MOVE MPRF-EMP-NO TO R433-EMP-NO. DTSBE433 +00486 MOVE L111-ZIP TO R433-SORT-ZIP. DTSBE433 +00487 MOVE WRK-PARM-SUBJECT-YRQ TO R433-QTR. DTSBE433 +00488 MOVE MPRF-FEIN TO R433-FEIN. DTSBE433 +00489 MOVE WRK-UI-TAX TO R433-UI-TAX. DTSBE433 +00490 MOVE WRK-SUR-TAX TO R433-SUR-TAX. DTSBE433 +00491 MOVE WRK-PEN TO R433-PENALTY. DTSBE433 +00492 MOVE WRK-INT TO R433-INTEREST. DTSBE433 +00493 MOVE LECM-CURR-MAIL-DATE TO R433-STMT-DATE. DTSBE433 +00494 MOVE WRK-INT-COMP-DATE TO R433-COMP-DATE. DTSBE433 +00495 DTSBE433 +00496 PERFORM S946-WRITE-R433 THRU S946-EXIT. DTSBE433 +00497 ADD +1 TO WRK-R433-CNT. DTSBE433 +00498 DTSBE433 +00499 P1100-EXIT. DTSBE433 +00500 EXIT. DTSBE433 +00501 DTSBE433 +00502 P1200-WRITE-MEVL. DTSBE433 +00503 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE433 +00504 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE433 +00505 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE433 +00506 DTSBE433 +00507 MOVE LOW-VALUES TO MEVL-REC. DTSBE433 +00508 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE433 +00509 SET MEVL-EVL-88 TO TRUE. DTSBE433 +00510 MOVE L005-DATE TO MEVL-DATE. DTSBE433 +00511 MOVE L005-TIME TO MEVL-TIME. DTSBE433 +00512 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBE433 +00513 MOVE WRK-EVL-SLASH-5-QTR TO EVL-SLASH-5-QTR. DTSBE433 +00514 MOVE EVL-TEXT TO MEVL-TEXT. DTSBE433 +00515 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE433 +00516 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE433 +00517 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE433 +00518 MEVL-CHNG-DATE. DTSBE433 +00519 MOVE MEVL-REC TO MSKL-REC. DTSBE433 +00520 DTSBE433 +00521 PERFORM S910-WRITE THRU S910-EXIT. DTSBE433 +00522 ADD +1 TO WRK-MEVL-CNT. DTSBE433 +00523 DTSBE433 +00524 P1200-EXIT. DTSBE433 +00525 EXIT. DTSBE433 +00526 DTSBE433 +00527 T0000-TERMINATE. DTSBE433 +00528 DISPLAY SPACE. DTSBE433 +00529 DISPLAY '*****************************************'. DTSBE433 +00530 DISPLAY '** DTSBE433 COUNTS **'. DTSBE433 +00531 DISPLAY '** **'. DTSBE433 +00532 DISPLAY '** R433 RECS WRITTEN: ' WRK-R433-CNT DTSBE433 +00533 ' **'. DTSBE433 +00534 DISPLAY '** **'. DTSBE433 +00535 DISPLAY '** MEVL RECS WRITTEN: ' WRK-MEVL-CNT DTSBE433 +00536 ' **'. DTSBE433 +00537 DISPLAY '** **'. DTSBE433 +00538 DISPLAY '*****************************************'. DTSBE433 +00539 DTSBE433 +00540 ** CLOSE EMP-DELNQ-FILE. DTSBE433 +00541 IF WRK-R433-CNT = ZEROS DTSBE433 +00542 GO TO T0000-EXIT. DTSBE433 +00543 DTSBE433 +00544 MOVE LECM-CURR-RUN-DATE TO FQTR-SELF-INS-2ND-LETTER-DATE DTSBE433 +00545 MOVE FQTR-REC TO FSKL-REC. DTSBE433 +00546 PERFORM S931-REWRITE THRU S931-EXIT. DTSBE433 +00547 T0000-EXIT. DTSBE433 +00548 EXIT. DTSBE433 +00549 EJECT DTSBE433 +00550 S001-FROM-FED-8. DTSBE433 +00551 SET L001-FROM-FED-8 TO TRUE. DTSBE433 +00552 GO TO S001-DATE. DTSBE433 +00553 DTSBE433 +00554 S001-FROM-CAL-6. DTSBE433 +00555 SET L001-FROM-CAL-6 TO TRUE. DTSBE433 +00556 GO TO S001-DATE. DTSBE433 +00557 DTSBE433 +00558 S001-FROM-ABS-DAY. DTSBE433 +00559 SET L001-FROM-ABS-DAY TO TRUE. DTSBE433 +00560 GO TO S001-DATE. DTSBE433 +00561 DTSBE433 +00562 S001-DATE. DTSBE433 +00563 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE433 +00564 S001-EXIT. DTSBE433 +00565 EXIT. DTSBE433 +00566 DTSBE433 +00567 S004-FROM-5. DTSBE433 +00568 SET L004-FROM-5 TO TRUE. DTSBE433 +00569 GO TO S004-QTR. DTSBE433 +00570 DTSBE433 +00571 S004-FROM-3. DTSBE433 +00572 SET L004-FROM-3 TO TRUE. DTSBE433 +00573 GO TO S004-QTR. DTSBE433 +00574 DTSBE433 +00575 S004-FROM-ABS. DTSBE433 +00576 SET L004-FROM-ABS TO TRUE. DTSBE433 +00577 GO TO S004-QTR. DTSBE433 +00578 DTSBE433 +00579 S004-FROM-DATE. DTSBE433 +00580 SET L004-FROM-DATE TO TRUE. DTSBE433 +00581 GO TO S004-QTR. DTSBE433 +00582 DTSBE433 +00583 S004-QTR. DTSBE433 +00584 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE433 +00585 S004-EXIT. DTSBE433 +00586 EXIT. DTSBE433 +00587 DTSBE433 +00588 S005-FROM-ABSTIME. DTSBE433 +00589 SET L005-FROM-ABSTIME TO TRUE. DTSBE433 +00590 GO TO S005-ABSTIME. DTSBE433 +00591 DTSBE433 +00592 S005-ABSTIME. DTSBE433 +00593 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE433 +00594 S005-EXIT. DTSBE433 +00595 EXIT. DTSBE433 +00596 DTSBE433 +00597 S101-PER-MONTH-NO. DTSBE433 +00598 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBE433 +00599 GO TO S101-INT-CHARGE. DTSBE433 +00600 DTSBE433 +00601 S101-INT-CHARGE. DTSBE433 +00602 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBE433 +00603 S101-EXIT. DTSBE433 +00604 EXIT. DTSBE433 +00605 DTSBE433 +00606 S111-LOOKUP-ADDR. DTSBE433 +00607 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE433 +00608 S111-EXIT. DTSBE433 +00609 EXIT. DTSBE433 +00610 SKIP3 DTSBE433 +00611 S112-FORMAT-ADDR. DTSBE433 +00612 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE433 +00613 S112-EXIT. DTSBE433 +00614 EXIT. DTSBE433 +00615 DTSBE433 +00616 S910-READ. DTSBE433 +00617 SET L910-READ-88 TO TRUE. DTSBE433 +00618 GO TO S910-MSTR-IO. DTSBE433 +00619 DTSBE433 +00620 S910-START-BROWSE. DTSBE433 +00621 SET L910-START-BROWSE-88 TO TRUE. DTSBE433 +00622 GO TO S910-MSTR-IO. DTSBE433 +00623 DTSBE433 +00624 S910-READ-NEXT. DTSBE433 +00625 SET L910-READ-NEXT-88 TO TRUE. DTSBE433 +00626 GO TO S910-MSTR-IO. DTSBE433 +00627 DTSBE433 +00628 S910-WRITE. DTSBE433 +00629 SET L910-WRITE-88 TO TRUE. DTSBE433 +00630 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE433 +00631 GO TO S910-MSTR-IO. DTSBE433 +00632 DTSBE433 +00633 S910-MSTR-IO. DTSBE433 +00634 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE433 +00635 MSKL-REC. DTSBE433 +00636 S910-EXIT. DTSBE433 +00637 EXIT. DTSBE433 +00638 DTSBE433 +00639 S931-READ. DTSBE433 +00640 SET L931-READ-88 TO TRUE. DTSBE433 +00641 GO TO S931-REF-I. DTSBE433 +00642 DTSBE433 +00643 S931-START-BROWSE. DTSBE433 +00644 SET L931-START-BROWSE-88 TO TRUE. DTSBE433 +00645 GO TO S931-REF-I. DTSBE433 +00646 DTSBE433 +00647 S931-READ-NEXT. DTSBE433 +00648 SET L931-READ-NEXT-88 TO TRUE. DTSBE433 +00649 GO TO S931-REF-I. DTSBE433 +00650 DTSBE433 +00651 S931-REWRITE. DTSBE433 +00652 SET L931-REWRITE-88 TO TRUE. DTSBE433 +00653 GO TO S931-REF-I. DTSBE433 +00654 DTSBE433 +00655 S931-REF-I. DTSBE433 +00656 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE433 +00657 FSKL-REC. DTSBE433 +00658 S931-EXIT. DTSBE433 +00659 EXIT. DTSBE433 +00660 DTSBE433 +00661 S946-WRITE-R907. DTSBE433 +00662 CALL 'DTSBU946' USING R907-REC. DTSBE433 +00663 GO TO S946-EXIT. DTSBE433 +00664 DTSBE433 +00665 S946-WRITE-R433. DTSBE433 +00666 CALL 'DTSBU946' USING R433-REC. DTSBE433 +00667 GO TO S946-EXIT. DTSBE433 +00668 DTSBE433 +00669 S946-EXIT. DTSBE433 +00670 EXIT. DTSBE433 +00671 DTSBE433 +00672 S999-ABEND. DTSBE433 +00673 DISPLAY '*** DTSBE433 ABENDING. ' DTSBE433 +00674 ABEND-MSG. DTSBE433 +00675 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE433 +00676 DTSBE433 +00677 S999-EXIT. DTSBE433 +00678 EXIT. DTSBE433 +00679 DTSBE433 diff --git a/Batch/DTSBE712.cob b/Batch/DTSBE712.cob new file mode 100644 index 0000000..a372ef6 --- /dev/null +++ b/Batch/DTSBE712.cob @@ -0,0 +1,384 @@ +00001 IDENTIFICATION DIVISION. 09/25/02 +00002 PROGRAM-ID. DTSBE712. DTSBE712 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV023 +00004 DATE-WRITTEN. SEPTEMBER 1994. DTSBE712 +00005 DATE-COMPILED. DTSBE712 +00006 SKIP3 DTSBE712 +00007 ***** DTSBE712 +00008 * DTSBE712 +00009 * FUNCTION: REQUEST FOR FEDERAL ID LETTER. DTSBE712 +00010 * DTSBE712 +00011 * DTSBE712 +00012 * MODIFICATION LOG: DTSBE712 +00013 * DTSBE712 +00014 * 02/25/99 MODIFIED TO MEET DUTAS PROGRAM SPECIFICATIONS. DTSBE712 +00015 * WORK ORDER: PROGRAMMER: DVS DTSBE712 +00016 * DTSBE712 +00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE712 +00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE712 +00019 * WORK ORDER: PROGRAMMER: XXX DTSBE712 +00020 * DTSBE712 +00021 * DTSBE712 +00022 * DESCRIPTION: DTSBE712 +00023 * DTSBE712 +00024 * DTSBE712 +00025 * INITIATION: DTSBE712 +00026 * DTSBE712 +00027 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE712 +00028 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE712 +00029 * DTSBE712 +00030 * EDIT AND DEFAULT PARAMETERS. SEE PRINTED OUTPUT, DTSBE712 +00031 * DESCRIPTION AND LAYOUTS (71241). DTSBE712 +00032 * DTSBE712 +00033 * PROCESSING: DTSBE712 +00034 * DTSBE712 +00035 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (712R1). DTSBE712 +00036 * DTSBE712 +00037 * DTSBE712 +00038 * TERMINATION: DTSBE712 +00039 * DTSBE712 +00040 * NONE. DTSBE712 +00041 * DTSBE712 +00042 * DTSBE712 +00043 * RECORDS READ: DTSBE712 +00044 * DTSBE712 +00045 * MASTER: DTSBE712 +00046 * DTSBE712 +00047 * MSOL DTSBE712 +00048 * DTSBE712 +00049 * DTSBE712 +00050 * ALTERNATE INDEX: DTSBE712 +00051 * DTSBE712 +00052 * NONE. DTSBE712 +00053 * DTSBE712 +00054 * DTSBE712 +00055 * REFERENCE: DTSBE712 +00056 * DTSBE712 +00057 * NONE. DTSBE712 +00058 * DTSBE712 +00059 * DTSBE712 +00060 * RECORDS UPDATED: DTSBE712 +00061 * DTSBE712 +00062 * NONE. DTSBE712 +00063 * DTSBE712 +00064 * DTSBE712 +00065 * REPORT RECORDS WRITTEN: DTSBE712 +00066 * DTSBE712 +00067 * R712 REQUEST FOR FEDERAL ID LETTER. DTSBE712 +00068 * DTSBE712 +00069 * DTSBE712 +00070 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE712 +00071 * DTSBE712 +00072 * NONE. DTSBE712 +00073 * DTSBE712 +00074 * DTSBE712 +00075 * MODULES CALLED: DTSBE712 +00076 * DTSBE712 +00077 * DTSBU082 OPERATOR ID EDIT/LOOKUP. DTSBE712 +00078 * DTSBU111 ADDRESS LOOKUP. DTSBE712 +00079 * DTSBU112 ADDRESS FORMAT. DTSBE712 +00080 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE712 +00081 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE712 +00082 * DTSBE712 +00083 * DTSBE712 +00084 * VERMONT REFERENCE: DTSBE712 +00085 * DTSBE712 +00086 * TXBE306 DTSBE712 +00087 * DTSBE712 +00088 ***** DTSBE712 +00089 SKIP3 DTSBE712 +00090 ENVIRONMENT DIVISION. DTSBE712 +00091 EJECT DTSBE712 +00092 DATA DIVISION. DTSBE712 +00093 SKIP3 DTSBE712 +00094 WORKING-STORAGE SECTION. DTSBE712 +000945 77 PAN-VALET PICTURE X(24) VALUE '023DTSBE712 09/25/02'. DTSBE712 +00095 SKIP3 DTSBE712 +00096 01 WRK-AREA. DTSBE712 +00097 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +712.DTSBE712 +00098 SKIP1 DTSBE712 +00099 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE712'.DTSBE712 +00100 SKIP3 DTSBE712 +00101 05 ABEND-MSG PIC X(60). DTSBE712 +00102 SKIP3 DTSBE712 +00103 05 WRK-PARM-RESP-OP-ID PIC X(08). DTSBE712 +00104 DTSBE712 +00105 05 WRK-PARM-MSOL-CUTOFF-DATE PIC S9(09) COMP-3. DTSBE712 +00106 SKIP3 DTSBE712 +00107 05 MSOL-WITHIN-CUTOFF-IND PIC X(01). DTSBE712 +00108 88 MSOL-WITHIN-CUTOFF-88 VALUE 'Y'. DTSBE712 +00109 88 MSOL-NOT-WITHIN-CUTOFF-88 VALUE 'N'. DTSBE712 +00110 DTSBE712 +00111 05 WRK-EDIT-STATUS-IND PIC X(01). DTSBE712 +00112 88 WRK-EDIT-PASSED-88 VALUE 'Y'. DTSBE712 +00113 88 WRK-EDIT-FAILED-88 VALUE 'N'. DTSBE712 +00114 DTSBE712 +00115 EJECT DTSBE712 +00116 01 L001-LINK-AREA. DTSBE712 +00117 ++INCLUDE DTSIL001 DTSBE712 +00118 SKIP3 DTSBE712 +00119 01 L082-LINK-AREA. DTSBE712 +00120 ++INCLUDE DTSIL082 DTSBE712 +00121 SKIP3 DTSBE712 +00122 01 L111-LINK-AREA. DTSBE712 +00123 ++INCLUDE DTSIL111 DTSBE712 +00124 SKIP3 DTSBE712 +00125 01 L112-LINK-AREA. DTSBE712 +00126 ++INCLUDE DTSIL112 DTSBE712 +00127 EJECT DTSBE712 +00128 01 L910-LINK-AREA. DTSBE712 +00129 ++INCLUDE DTSIL910 DTSBE712 +00130 SKIP3 DTSBE712 +00131 01 MSKL-REC. DTSBE712 +00132 ++INCLUDE DTSIMSKL DTSBE712 +00133 SKIP3 DTSBE712 +00134 01 MSOL-REC. DTSBE712 +00135 ++INCLUDE DTSIMSOL DTSBE712 +00136 EJECT DTSBE712 +00137 01 R712-REC. DTSBE712 +00138 ++INCLUDE DTSIR712 DTSBE712 +00139 EJECT DTSBE712 +00140 LINKAGE SECTION. DTSBE712 +00141 SKIP3 DTSBE712 +00142 01 LECM-LINK-AREA. DTSBE712 +00143 ++INCLUDE DTSILECM DTSBE712 +00144 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE712 +00145 15 LECM-PARM-RESP-OP-ID PIC X(08). DTSBE712 +00146 15 FILLER PIC X(01). DTSBE712 +00147 15 LECM-PARM-MSOL-CUTOFF-DATE PIC X(06). DTSBE712 +00148 15 FILLER PIC X(51). DTSBE712 +00149 EJECT DTSBE712 +00150 01 MPRF-LINK-REC. DTSBE712 +00151 ++INCLUDE DTSIMPRF DTSBE712 +00152 EJECT DTSBE712 +00153 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE712 +00154 MPRF-LINK-REC. DTSBE712 +00155 SKIP2 DTSBE712 +00156 MOVE LENGTH OF R712-REC TO R712-LENGTH. DTSBE712 +00157 MOVE '712' TO R712-REC-TYPE. DTSBE712 +00158 EVALUATE TRUE DTSBE712 +00159 WHEN LECM-PROCESS-88 DTSBE712 +00160 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE712 +00161 DTSBE712 +00162 WHEN LECM-INITIALIZE-88 DTSBE712 +00163 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE712 +00164 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE712 +00165 IF WRK-EDIT-FAILED-88 DTSBE712 +00166 PERFORM S999-ABEND THRU S999-EXIT DTSBE712 +00167 END-IF DTSBE712 +00168 DTSBE712 +00169 WHEN LECM-TERMINATE-88 DTSBE712 +00170 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE712 +00171 DTSBE712 +00172 WHEN OTHER DTSBE712 +00173 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE712 +00174 TO ABEND-MSG DTSBE712 +00175 PERFORM S999-ABEND THRU S999-EXIT. DTSBE712 +00176 GOBACK. DTSBE712 +00177 EJECT DTSBE712 +00178 I0000-INITIALIZE. DTSBE712 +00179 SKIP2 DTSBE712 +00180 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE712 +00181 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE712 +00182 DTSBE712 +00183 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE712 +00184 DTSBE712 +00185 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE712 +00186 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE712 +00187 SKIP2 DTSBE712 +00188 I0000-EXIT. DTSBE712 +00189 EXIT. DTSBE712 +00190 ++INCLUDE OJRPE712 DTSBE712 +00191 SKIP3 DTSBE712 +00192 *************************************************************** DTSBE712 +00193 * THIS IS THE PROCESS PARAGRAPH FOR THE FEDEAL ID LETTERS. DTSBE712 +00194 *************************************************************** DTSBE712 +00195 DTSBE712 +00196 P0000-PROCESS. DTSBE712 +00197 DTSBE712 +00198 IF MPRF-STATUS-ACT-88 DTSBE712 +00199 NEXT SENTENCE DTSBE712 +00200 ELSE DTSBE712 +00201 GO TO P0000-EXIT. DTSBE712 +00202 DTSBE712 +00203 IF MPRF-FEIN = +0 DTSBE712 +00204 NEXT SENTENCE DTSBE712 +00205 ELSE DTSBE712 +00206 GO TO P0000-EXIT. DTSBE712 +00207 DTSBE712 +00208 IF MPRF-FEIN-HARASS-YES-88 DTSBE712 +00209 NEXT SENTENCE DTSBE712 +00210 ELSE DTSBE712 +00211 GO TO P0000-EXIT. DTSBE712 +00212 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE712 +00213 SET MSOL-SOL-88 TO TRUE. DTSBE712 +00214 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE712 +00215 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE712 +00216 SET MSOL-NOT-WITHIN-CUTOFF-88 TO TRUE. DTSBE712 +00217 DTSBE712 +00218 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE712 +00219 DTSBE712 +00220 PERFORM P1000-SCAN-MSOL THRU P1000-EXIT DTSBE712 +00221 UNTIL L910-NO-REC-88 OR DTSBE712 +00222 MSOL-WITHIN-CUTOFF-88. DTSBE712 +00223 DTSBE712 +00224 IF MSOL-NOT-WITHIN-CUTOFF-88 DTSBE712 +00225 PERFORM P2000-SETUP-R712 THRU P2000-EXIT. DTSBE712 +00226 DTSBE712 +00227 P0000-EXIT. DTSBE712 +00228 EXIT. DTSBE712 +00229 EJECT DTSBE712 +00230 *************************************************************** DTSBE712 +00231 * THIS PARAGRAPH SCANS THE MSOL RECORDS. DTSBE712 +00232 *************************************************************** DTSBE712 +00233 DTSBE712 +00234 P1000-SCAN-MSOL. DTSBE712 +00235 DTSBE712 +00236 MOVE MSKL-REC TO MSOL-REC. DTSBE712 +00237 DTSBE712 +00238 IF MSOL-LIAB-MAIL-DATE LESS THAN WRK-PARM-MSOL-CUTOFF-DATE DTSBE712 +00239 NEXT SENTENCE DTSBE712 +00240 ELSE DTSBE712 +00241 SET MSOL-WITHIN-CUTOFF-88 TO TRUE DTSBE712 +00242 GO TO P1000-EXIT. DTSBE712 +00243 DTSBE712 +00244 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE712 +00245 DTSBE712 +00246 P1000-EXIT. DTSBE712 +00247 EXIT. DTSBE712 +00248 EJECT DTSBE712 +00249 *************************************************************** DTSBE712 +00250 * THIS PARAGRAPH WILL SETUP THE R712 EXTRACT RECORDS. DTSBE712 +00251 *************************************************************** DTSBE712 +00252 DTSBE712 +00253 P2000-SETUP-R712. DTSBE712 +00254 DTSBE712 +00255 MOVE MSOL-EMP-NO TO R712-EMP-NO DTSBE712 +00256 DTSBE712 +00257 PERFORM P2100-LOOKUP-ADDR THRU P2100-EXIT DTSBE712 +00258 DTSBE712 +00259 IF L111-ADDR-FOUND-88 DTSBE712 +00260 MOVE WRK-PARM-RESP-OP-ID TO R712-OP-ID DTSBE712 +00261 MOVE LECM-PRIOR-MAIL-DATE TO R712-MAIL-DATE DTSBE712 +00262 PERFORM S946-WRITE-R712 THRU S946-EXIT. DTSBE712 +00263 DTSBE712 +00264 P2000-EXIT. DTSBE712 +00265 EXIT. DTSBE712 +00266 EJECT DTSBE712 +00267 *************************************************************** DTSBE712 +00268 * THIS PARAGRAPH WILL LOOK UP THE TAX ADDRESS. DTSBE712 +00269 *************************************************************** DTSBE712 +00270 DTSBE712 +00271 P2100-LOOKUP-ADDR. DTSBE712 +00272 DTSBE712 +00273 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE712 +00274 DTSBE712 +00275 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE712 +00276 DTSBE712 +00277 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBE712 +00278 DTSBE712 +00279 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE712 +00280 DTSBE712 +00281 IF L111-ADDR-FOUND-88 DTSBE712 +00282 PERFORM P2110-FORMAT-ADDR THRU P2110-EXIT DTSBE712 +00283 ELSE DTSBE712 +00284 MOVE ALL '?' TO L112-NAME-ADDRESS-AREA. DTSBE712 +00285 DTSBE712 +00286 MOVE L112-MAILING-ADDRESS TO R712-FMT-ADDR. DTSBE712 +00287 MOVE L112-ZIP TO R712-ZIP. DTSBE712 +00288 MOVE L112-ADVANCED-BARCODE TO R712-ADVANCED-BARCODE. DTSBE712 +00289 DTSBE712 +00290 P2100-EXIT. DTSBE712 +00291 EXIT. DTSBE712 +00292 SKIP3 DTSBE712 +00293 *************************************************************** DTSBE712 +00294 * THIS PARAGRAPH WILL FORMAT THE TAX ADDRESS. DTSBE712 +00295 *************************************************************** DTSBE712 +00296 DTSBE712 +00297 P2110-FORMAT-ADDR. DTSBE712 +00298 DTSBE712 +00299 SET L112-TAD-ADDR-88 TO TRUE. DTSBE712 +00300 SET L112-ANCHOR-LAST-88 TO TRUE. DTSBE712 +00301 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME DTSBE712 +00302 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE712 +00303 DTSBE712 +00304 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE712 +00305 DTSBE712 +00306 DTSBE712 +00307 P2110-EXIT. DTSBE712 +00308 EXIT. DTSBE712 +00309 EJECT DTSBE712 +00310 T0000-TERMINATE. DTSBE712 +00311 SKIP2 DTSBE712 +00312 SKIP2 DTSBE712 +00313 T0000-EXIT. DTSBE712 +00314 EXIT. DTSBE712 +00315 EJECT DTSBE712 +00316 S001-FROM-FED-8. DTSBE712 +00317 SET L001-FROM-FED-8 TO TRUE. DTSBE712 +00318 GO TO S001-DATE. DTSBE712 +00319 SKIP1 DTSBE712 +00320 S001-FROM-ABS-DAY. DTSBE712 +00321 SET L001-FROM-ABS-DAY TO TRUE. DTSBE712 +00322 GO TO S001-DATE. DTSBE712 +00323 SKIP1 DTSBE712 +00324 S001-FROM-CAL-6. DTSBE712 +00325 SET L001-FROM-CAL-6 TO TRUE. DTSBE712 +00326 GO TO S001-DATE. DTSBE712 +00327 SKIP1 DTSBE712 +00328 S001-DATE. DTSBE712 +00329 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE712 +00330 S001-EXIT. DTSBE712 +00331 EXIT. DTSBE712 +00332 SKIP3 DTSBE712 +00333 S082-LOOKUP-OP-ID. DTSBE712 +00334 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBE712 +00335 S082-EXIT. DTSBE712 +00336 EXIT. DTSBE712 +00337 SKIP3 DTSBE712 +00338 S111-LOOKUP-ADDR. DTSBE712 +00339 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE712 +00340 S111-EXIT. DTSBE712 +00341 EXIT. DTSBE712 +00342 SKIP3 DTSBE712 +00343 S112-FORMAT-ADDR. DTSBE712 +00344 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE712 +00345 S112-EXIT. DTSBE712 +00346 EXIT. DTSBE712 +00347 SKIP3 DTSBE712 +00348 S910-READ. DTSBE712 +00349 SET L910-READ-88 TO TRUE. DTSBE712 +00350 GO TO S910-MSTR-IO. DTSBE712 +00351 SKIP1 DTSBE712 +00352 S910-START-BROWSE. DTSBE712 +00353 SET L910-START-BROWSE-88 TO TRUE. DTSBE712 +00354 GO TO S910-MSTR-IO. DTSBE712 +00355 SKIP1 DTSBE712 +00356 S910-READ-NEXT. DTSBE712 +00357 SET L910-READ-NEXT-88 TO TRUE. DTSBE712 +00358 GO TO S910-MSTR-IO. DTSBE712 +00359 SKIP1 DTSBE712 +00360 S910-COUNT. DTSBE712 +00361 SET L910-COUNT-88 TO TRUE. DTSBE712 +00362 GO TO S910-MSTR-IO. DTSBE712 +00363 SKIP1 DTSBE712 +00364 S910-MSTR-IO. DTSBE712 +00365 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE712 +00366 MSKL-REC. DTSBE712 +00367 S910-EXIT. DTSBE712 +00368 EXIT. DTSBE712 +00369 SKIP3 DTSBE712 +00370 S946-WRITE-R712. DTSBE712 +00371 CALL 'DTSBU946' USING R712-REC. DTSBE712 +00372 GO TO S946-EXIT. DTSBE712 +00373 SKIP1 DTSBE712 +00374 S946-EXIT. DTSBE712 +00375 EXIT. DTSBE712 +00376 SKIP3 DTSBE712 +00377 S999-ABEND. DTSBE712 +00378 DISPLAY '*** DTSBE712 ABENDING. ' DTSBE712 +00379 ABEND-MSG. DTSBE712 +00380 SKIP1 DTSBE712 +00381 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE712 +00382 S999-EXIT. DTSBE712 +00383 EXIT. DTSBE712 diff --git a/Batch/DTSBR135.cob b/Batch/DTSBR135.cob new file mode 100644 index 0000000..676fe5e --- /dev/null +++ b/Batch/DTSBR135.cob @@ -0,0 +1,420 @@ +00001 IDENTIFICATION DIVISION. 04/05/04 +00002 PROGRAM-ID. DTSBR135. DTSBR135 +00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV001 +00004 DATE-WRITTEN. JUNE 2003. DTSBR135 +00005 DATE-COMPILED. DTSBR135 +00006 SKIP3 DTSBR135 +00007 ***** DTSBR135 +00008 * CALLING SEQUENCE: DTSBD311 WRITES DTSIR135 RECORDS DTSBR135 +00009 * DTSBD800 CALLS DTSBR135 WHICH DTSBR135 +00010 * PRODUCES EFT LETTER AND APPLICATION. DTSBR135 +00011 * DTSBR135 +00012 * DTSBR135 +00013 * FUNCTION: PRINT EFT SOLICITATION LETTER AND APPLICATION DTSBR135 +00014 * DTSBR135 +00015 * DTSBR135 +00016 * MODIFICATION HISTORY: DTSBR135 +00017 * DTSBR135 +00018 * 09-17-94 INITIAL DEVELOPMENT. COPIED FROM DTSBR902 DTSBR135 +00019 * REFERENCE DC DEVELOPMENT AUTHOR OF CHANGE - ZL1 DTSBR135 +00020 * DTSBR135 +00021 * DTSBR135 +00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR135 +00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR135 +00024 * REFERENCE RFP #**** PROGRAMMER: XXX DTSBR135 +00025 * DTSBR135 +00026 * DTSBR135 +00027 * DESCRIPTION: DTSBR135 +00028 * DTSBR135 +00029 * THIS MODULE PRINTS THE ELECTRONIC FUNDS TRANSFER DTSBR135 +00030 * APPLICATION FORM AND SOLICITATION LETTER WHEN EMPLOYER DTSBR135 +00031 * BECOMES LIABLE. DTSBR135 +00032 * DTSBR135 +00033 * RECORDS READ: DTSBR135 +00034 * DTSBR135 +00035 * NONE. DTSBR135 +00036 * DTSBR135 +00037 * DTSBR135 +00038 * PRINTED OUTPUTS: DTSBR135 +00039 * DTSBR135 +00040 * 135R1 EFT LETTER AND APPLICATION FORM DTSBR135 +00041 * DTSBR135 +00042 * DTSBR135 +00043 * RECORDS WRITTEN: DTSBR135 +00044 * DTSBR135 +00045 * NONE. DTSBR135 +00046 * DTSBR135 +00047 * DTSBR135 +00048 * MODULES CALLED: DTSBR135 +00049 * DTSBR135 +00050 * DTSBU004 DATE EDIT/CONVERSION MODULE DTSBR135 +00051 * DTSBU009 TRANSLATE TO UPPER CASE MODULE DTSBR135 +00052 * DTSBU071 NAME EDIT/CONVERSION MODULE DTSBR135 +00053 * DTSBU082 OPERATOR ID EDIT/LOOKUP MODULE DTSBR135 +00054 * DTSBU119 AGENCY FACTS MODULE DTSBR135 +00055 * DTSBR135 +00056 * DTSBR135 +00057 ***** DTSBR135 +00058 EJECT DTSBR135 +00059 ENVIRONMENT DIVISION. DTSBR135 +00060 DTSBR135 +00061 CONFIGURATION SECTION. DTSBR135 +00062 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR135 +00063 DTSBR135 +00064 INPUT-OUTPUT SECTION. DTSBR135 +00065 DTSBR135 +00066 FILE-CONTROL. DTSBR135 +00067 SELECT PRT-FILE1 ASSIGN TO RPT135R1. DTSBR135 +00068 DTSBR135 +00069 DATA DIVISION. DTSBR135 +00070 DTSBR135 +00071 FILE SECTION. DTSBR135 +00072 DTSBR135 +00073 FD PRT-FILE1 DTSBR135 +00074 RECORDING MODE IS F. DTSBR135 +00075 01 T135R1 PIC X(133). DTSBR135 +00076 DTSBR135 +00077 WORKING-STORAGE SECTION. DTSBR135 +000775 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR135 04/05/04'. DTSBR135 +00078 DTSBR135 +00079 01 WRK-AREA. DTSBR135 +00080 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +135.DTSBR135 +00081 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR135 +00082 05 WS-DAILY-OP-ID-HOLD PIC X(08) VALUE SPACES.DTSBR135 +00083 05 WS-BLANK-LINE PIC X(133) VALUE SPACES.DTSBR135 +00084 05 WS-YRQ-UNPACK PIC 9(05) VALUE ZEROS. DTSBR135 +00085 05 WS-EMP-CLASS PIC X(01). DTSBR135 +00086 88 WS-RATED-88 VALUE 'R'. DTSBR135 +00087 88 WS-SELF-INS-88 VALUE 'S'. DTSBR135 +00088 DTSBR135 +00089 05 WS-BREAK-LINE1 PIC X(40) VALUE DTSBR135 +00090 '********************************* '. DTSBR135 +00091 05 WS-BREAK-LINE2 PIC X(40) VALUE DTSBR135 +00092 '* ROUTE FOLLOWING FORMS TO: * '. DTSBR135 +00093 05 WS-OPR-NAME PIC X(40) VALUE SPACES. DTSBR135 +00094 05 WS-OPR-UNIT-NAME PIC X(40) VALUE SPACES. DTSBR135 +00095 DTSBR135 +00096 EJECT DTSBR135 +00097 ++INCLUDE DTSXL135 DTSBR135 +00098 EJECT DTSBR135 +00099 01 L001-LINK-AREA. DTSBR135 +00100 ++INCLUDE DTSIL001 DTSBR135 +00101 EJECT DTSBR135 +00102 01 L002-LINK-AREA. DTSBR135 +00103 ++INCLUDE DTSIL002 DTSBR135 +00104 EJECT DTSBR135 +00105 01 L004-LINK-AREA. DTSBR135 +00106 ++INCLUDE DTSIL004 DTSBR135 +00107 EJECT DTSBR135 +00108 01 L008-LINK-AREA. DTSBR135 +00109 ++INCLUDE DTSIL008 DTSBR135 +00110 EJECT DTSBR135 +00111 01 L009-LINK-AREA. DTSBR135 +00112 ++INCLUDE DTSIL009 DTSBR135 +00113 EJECT DTSBR135 +00114 01 L071-LINK-AREA. DTSBR135 +00115 ++INCLUDE DTSIL071 DTSBR135 +00116 EJECT DTSBR135 +00117 01 L082-LINK-AREA. DTSBR135 +00118 ++INCLUDE DTSIL082 DTSBR135 +00119 EJECT DTSBR135 +00120 *01 L109-LINK-AREA. DTSBR135 +00121 **+INCLUDE DTSIL109 DTSBR135 +00122 ** EJECT DTSBR135 +00123 01 L119-LINK-AREA. DTSBR135 +00124 ++INCLUDE DTSIL119 DTSBR135 +00125 EJECT DTSBR135 +00126 01 ROUTE-INFO-AREA. DTSBR135 +00127 05 RTE-LINE-1. DTSBR135 +00128 10 FILLER PIC X(27) VALUE SPACES. DTSBR135 +00129 10 FILLER PIC X(33) DTSBR135 +00130 VALUE '************ DTSP135 ***********'. DTSBR135 +00131 05 RTE-LINE-2. DTSBR135 +00132 10 FILLER PIC X(27) VALUE SPACES. DTSBR135 +00133 10 FILLER PIC X(13) DTSBR135 +00134 VALUE '************ '. DTSBR135 +00135 10 RTE-SYS-DATE PIC X(08) VALUE SPACES. DTSBR135 +00136 10 FILLER PIC X(13) DTSBR135 +00137 VALUE ' *********** '. DTSBR135 +00138 05 RTE-LINE-3. DTSBR135 +00139 10 FILLER PIC X(27) VALUE SPACES. DTSBR135 +00140 10 FILLER PIC X(33) DTSBR135 +00141 VALUE '************ DTSP135 ***********'. DTSBR135 +00142 DTSBR135 +00143 01 EFTF-APPL. DTSBR135 +00144 05 EFTF-LINE-2. DTSBR135 +00145 10 FILLER PIC X(05) VALUE SPACES. DTSBR135 +00146 10 EFTF-EMP-NO PIC 999B999. DTSBR135 +00147 10 FILLER PIC X(17) VALUE SPACES. DTSBR135 +00148 10 EFTF-EMP-NAME PIC X(40) VALUE SPACES. DTSBR135 +00149 05 EFTF-LINE-3. DTSBR135 +00150 10 FILLER PIC X(05) VALUE SPACES. DTSBR135 +00151 10 EFTF-EMP-FEIN PIC 99B9999999. DTSBR135 +00152 10 FILLER PIC X(14) VALUE SPACES. DTSBR135 +00153 10 EFTF-EMP-ADDR1 PIC X(40) VALUE SPACES. DTSBR135 +00154 10 FILLER PIC X(15) VALUE SPACES. DTSBR135 +00155 05 EFTF-LINE-4. DTSBR135 +00156 10 FILLER PIC X(29) VALUE SPACES. DTSBR135 +00157 10 EFTF-EMP-ADDR2 PIC X(40) VALUE SPACES. DTSBR135 +00158 10 FILLER PIC X(15) VALUE SPACES. DTSBR135 +00159 05 EFTF-LINE-5. DTSBR135 +00160 10 FILLER PIC X(29) VALUE SPACES. DTSBR135 +00161 10 EFTF-EMP-ADDR5 PIC X(40) VALUE SPACES. DTSBR135 +00162 10 FILLER PIC X(05) VALUE SPACES. DTSBR135 +00163 10 EFTF-EMP-ZIP PIC X(10) VALUE SPACES. DTSBR135 +00164 DTSBR135 +00165 01 EFTL-LETT. DTSBR135 +00166 05 EFTL-LINE-1. DTSBR135 +00167 10 FILLER PIC X(70) VALUE SPACES. DTSBR135 +00168 10 EFTL-DATE PIC X(10) VALUE SPACES. DTSBR135 +00169 05 EFTL-LINE-2. DTSBR135 +00170 10 FILLER PIC X(29) VALUE SPACES. DTSBR135 +00171 10 EFTL-EMP-ADDR1 PIC X(40) VALUE SPACES. DTSBR135 +00172 10 FILLER PIC X(15) VALUE SPACES. DTSBR135 +00173 05 EFTL-LINE-3. DTSBR135 +00174 10 FILLER PIC X(29) VALUE SPACES. DTSBR135 +00175 10 EFTL-EMP-ADDR2 PIC X(40) VALUE SPACES. DTSBR135 +00176 10 FILLER PIC X(15) VALUE SPACES. DTSBR135 +00177 05 EFTL-LINE-4. DTSBR135 +00178 10 FILLER PIC X(29) VALUE SPACES. DTSBR135 +00179 10 EFTL-EMP-ADDR3 PIC X(40) VALUE SPACES. DTSBR135 +00180 10 FILLER PIC X(15) VALUE SPACES. DTSBR135 +00181 05 EFTL-LINE-5. DTSBR135 +00182 10 FILLER PIC X(29) VALUE SPACES. DTSBR135 +00183 10 EFTL-EMP-ADDR4 PIC X(40) VALUE SPACES. DTSBR135 +00184 10 FILLER PIC X(15) VALUE SPACES. DTSBR135 +00185 05 EFTL-LINE-6. DTSBR135 +00186 10 FILLER PIC X(29) VALUE SPACES. DTSBR135 +00187 10 EFTL-EMP-ADDR5 PIC X(40) VALUE SPACES. DTSBR135 +00188 10 FILLER PIC X(15) VALUE SPACES. DTSBR135 +00189 05 EFTL-LINE-7. DTSBR135 +00190 10 FILLER PIC X(20) VALUE SPACES. DTSBR135 +00191 10 EFTL-EMP-NO2 PIC 999B999. DTSBR135 +00192 10 FILLER PIC X(10) VALUE SPACES. DTSBR135 +00193 DTSBR135 +00194 DTSBR135 +00195 DTSBR135 +00196 EJECT DTSBR135 +00197 LINKAGE SECTION. DTSBR135 +00198 DTSBR135 +00199 01 LRCM-LINK-AREA. DTSBR135 +00200 ++INCLUDE DTSILRCM DTSBR135 +00201 EJECT DTSBR135 +00202 01 R135-REC. DTSBR135 +00203 ++INCLUDE DTSIR135 DTSBR135 +00204 EJECT DTSBR135 +00205 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR135 +00206 R135-REC. DTSBR135 +00207 IF FIRST-TIME-IND = 'Y' DTSBR135 +00208 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR135 +00209 MOVE 'N' TO FIRST-TIME-IND. DTSBR135 +00210 DTSBR135 +00211 IF LRCM-EOR-88 DTSBR135 +00212 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR135 +00213 ELSE DTSBR135 +00214 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR135 +00215 DTSBR135 +00216 GOBACK. DTSBR135 +00217 EJECT DTSBR135 +00218 I1000-INITIATE. DTSBR135 +00219 DTSBR135 +00220 OPEN OUTPUT PRT-FILE1. DTSBR135 +00221 MOVE SPACES TO T135R1. DTSBR135 +00222 MOVE SPACES TO WS-DAILY-OP-ID-HOLD. DTSBR135 +00223 MOVE LRCM-SYS-DATE TO RTE-SYS-DATE. DTSBR135 +00224 WRITE T135R1 FROM WS-BLANK-LINE AFTER TOP-OF-PAGE. DTSBR135 +00225 WRITE T135R1 FROM RTE-LINE-1 AFTER 10. DTSBR135 +00226 WRITE T135R1 FROM RTE-LINE-2 AFTER 1. DTSBR135 +00227 WRITE T135R1 FROM RTE-LINE-3 AFTER 1. DTSBR135 +00228 DTSBR135 +00229 I1000-EXIT. DTSBR135 +00230 EXIT. DTSBR135 +00231 DTSBR135 +00232 P1000-PROCESS. DTSBR135 +00233 DTSBR135 +00234 PERFORM P4000-BREAK-USERID THRU P4000-EXIT DTSBR135 +00235 IF R135-RPT-EFT-LETT-88 DTSBR135 +00236 PERFORM P3000-EFT-LETTER THRU P3000-EXIT DTSBR135 +00237 ELSE DTSBR135 +00238 PERFORM P3100-EFT-APPL-FORM THRU P3100-EXIT. DTSBR135 +00239 DTSBR135 +00240 P1000-EXIT. DTSBR135 +00241 EXIT. DTSBR135 +00242 EJECT DTSBR135 +00243 P3000-EFT-LETTER. DTSBR135 +00244 DTSBR135 +00245 MOVE LRCM-SYS-8-DATE TO EFTL-DATE. DTSBR135 +00246 MOVE R135-EMP-NO TO EFTL-EMP-NO2. DTSBR135 +00247 DTSBR135 +00248 MOVE R135-FMT-LINE (1) TO EFTL-EMP-ADDR1. DTSBR135 +00249 MOVE R135-FMT-LINE (2) TO EFTL-EMP-ADDR2. DTSBR135 +00250 MOVE R135-FMT-LINE (3) TO EFTL-EMP-ADDR3. DTSBR135 +00251 MOVE R135-FMT-LINE (4) TO EFTL-EMP-ADDR4. DTSBR135 +00252 MOVE R135-FMT-LINE (5) TO EFTL-EMP-ADDR5. DTSBR135 +00253 DTSBR135 +00254 PERFORM P4030-GENERATE-LETT-REPORT THRU P4030-EXIT. DTSBR135 +00255 DTSBR135 +00256 P3000-EXIT. DTSBR135 +00257 EXIT. DTSBR135 +00258 P3100-EFT-APPL-FORM. DTSBR135 +00259 DTSBR135 +00260 MOVE R135-EMP-NO TO EFTF-EMP-NO DTSBR135 +00261 MOVE R135-EMP-FEIN TO EFTF-EMP-FEIN. DTSBR135 +00262 DTSBR135 +00263 MOVE R135-FMT-LINE (1) TO EFTF-EMP-NAME. DTSBR135 +00264 MOVE R135-FMT-LINE (2) TO EFTF-EMP-ADDR1. DTSBR135 +00265 MOVE R135-FMT-LINE (3) TO EFTF-EMP-ADDR2. DTSBR135 +00266 MOVE R135-FMT-LINE (4) TO EFTF-EMP-ADDR5. DTSBR135 +00267 MOVE R135-FMT-LINE (5) TO EFTF-EMP-ZIP. DTSBR135 +00268 DTSBR135 +00269 PERFORM P4040-GENERATE-APPL-REPORT THRU P4040-EXIT. DTSBR135 +00270 DTSBR135 +00271 P3100-EXIT. DTSBR135 +00272 EXIT. DTSBR135 +00273 DTSBR135 +00274 P4000-BREAK-USERID. DTSBR135 +00275 DTSBR135 +00276 IF R135-OP-ID NOT = WS-DAILY-OP-ID-HOLD DTSBR135 +00277 MOVE R135-OP-ID TO WS-DAILY-OP-ID-HOLD DTSBR135 +00278 PERFORM P4020-OPID-BREAK THRU P4020-EXIT DTSBR135 +00279 PERFORM P4030-GENERATE-LETT-REPORT THRU P4030-EXIT DTSBR135 +00280 END-IF. DTSBR135 +00281 DTSBR135 +00282 P4000-EXIT. DTSBR135 +00283 EXIT. DTSBR135 +00284 EJECT DTSBR135 +00285 P4020-OPID-BREAK. DTSBR135 +00286 DTSBR135 +00287 MOVE R135-OP-ID TO L082-OP-ID DTSBR135 +00288 DTSBR135 +00289 PERFORM S082-OP-ID-INFO THRU S082-EXIT DTSBR135 +00290 MOVE L082-NAME TO L071-NAM DTSBR135 +00291 MOVE 2 TO L071-NAME-FORMAT DTSBR135 +00292 PERFORM S071-DESLASH-NAME THRU S071-EXIT DTSBR135 +00293 MOVE L071-NAM TO L009-DATA DTSBR135 +00294 DTSBR135 +00295 PERFORM S009-UPPER-CASE-TRANSLATE THRU S009-EXIT DTSBR135 +00296 MOVE L009-DATA TO WS-OPR-NAME DTSBR135 +00297 MOVE L082-UNIT-NAME TO L009-DATA DTSBR135 +00298 DTSBR135 +00299 PERFORM S009-UPPER-CASE-TRANSLATE THRU S009-EXIT DTSBR135 +00300 MOVE L009-DATA TO WS-OPR-UNIT-NAME. DTSBR135 +00301 DTSBR135 +00302 MOVE SPACES TO EFTL-LINE-1 DTSBR135 +00303 EFTL-LINE-2 DTSBR135 +00304 EFTL-LINE-3 DTSBR135 +00305 EFTL-LINE-4 DTSBR135 +00306 EFTL-LINE-5 DTSBR135 +00307 EFTL-LINE-6 DTSBR135 +00308 EFTL-LINE-7. DTSBR135 +00309 MOVE WS-BREAK-LINE1 TO EFTL-EMP-ADDR1. DTSBR135 +00310 MOVE WS-BREAK-LINE2 TO EFTL-EMP-ADDR2. DTSBR135 +00311 MOVE WS-OPR-NAME TO EFTL-EMP-ADDR3. DTSBR135 +00312 MOVE WS-OPR-UNIT-NAME TO EFTL-EMP-ADDR4. DTSBR135 +00313 MOVE WS-BREAK-LINE1 TO EFTL-EMP-ADDR5. DTSBR135 +00314 DTSBR135 +00315 P4020-EXIT. DTSBR135 +00316 EXIT. DTSBR135 +00317 P4030-GENERATE-LETT-REPORT. DTSBR135 +00318 DTSBR135 +00319 WRITE T135R1 FROM XEROX-CNTL-LINE AFTER TOP-OF-PAGE. DTSBR135 +00320 WRITE T135R1 FROM EFTL-LINE-1 AFTER ADVANCING 7 LINE. DTSBR135 +00321 WRITE T135R1 FROM EFTL-LINE-2 AFTER ADVANCING 2 LINE. DTSBR135 +00322 WRITE T135R1 FROM EFTL-LINE-3 AFTER ADVANCING 1 LINE. DTSBR135 +00323 WRITE T135R1 FROM EFTL-LINE-4 AFTER ADVANCING 1 LINE. DTSBR135 +00324 WRITE T135R1 FROM EFTL-LINE-5 AFTER ADVANCING 1 LINE. DTSBR135 +00325 WRITE T135R1 FROM EFTL-LINE-6 AFTER ADVANCING 1 LINE. DTSBR135 +00326 WRITE T135R1 FROM EFTL-LINE-7 AFTER ADVANCING 3 LINE. DTSBR135 +00327 DTSBR135 +00328 P4030-EXIT. DTSBR135 +00329 EXIT. DTSBR135 +00330 P4040-GENERATE-APPL-REPORT. DTSBR135 +00331 DTSBR135 +00332 WRITE T135R1 FROM XEROX-CNTL-LINE2 AFTER TOP-OF-PAGE. DTSBR135 +00333 WRITE T135R1 FROM EFTF-LINE-2 AFTER ADVANCING 11 LINE. DTSBR135 +00334 WRITE T135R1 FROM EFTF-LINE-3 AFTER ADVANCING 2 LINE. DTSBR135 +00335 WRITE T135R1 FROM EFTF-LINE-4 AFTER ADVANCING 2 LINE. DTSBR135 +00336 WRITE T135R1 FROM EFTF-LINE-5 AFTER ADVANCING 2 LINE. DTSBR135 +00337 DTSBR135 +00338 P4040-EXIT. DTSBR135 +00339 EXIT. DTSBR135 +00340 DTSBR135 +00341 T1000-TERMINATE. DTSBR135 +00342 DTSBR135 +00343 CLOSE PRT-FILE1. DTSBR135 +00344 DTSBR135 +00345 T1000-EXIT. DTSBR135 +00346 EXIT. DTSBR135 +00347 DTSBR135 +00348 S001-DATE. DTSBR135 +00349 DTSBR135 +00350 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR135 +00351 DTSBR135 +00352 S001-EXIT. DTSBR135 +00353 EXIT. DTSBR135 +00354 DTSBR135 +00355 S002-DATE. DTSBR135 +00356 DTSBR135 +00357 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR135 +00358 DTSBR135 +00359 S002-EXIT. DTSBR135 +00360 EXIT. DTSBR135 +00361 DTSBR135 +00362 S004-DATE. DTSBR135 +00363 DTSBR135 +00364 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR135 +00365 DTSBR135 +00366 S004-EXIT. DTSBR135 +00367 EXIT. DTSBR135 +00368 DTSBR135 +00369 S008-YRQ-ALPHA. DTSBR135 +00370 DTSBR135 +00371 CALL 'DTSBU008' USING L008-LINK-AREA. DTSBR135 +00372 DTSBR135 +00373 S008-EXIT. DTSBR135 +00374 EXIT. DTSBR135 +00375 DTSBR135 +00376 S009-UPPER-CASE-TRANSLATE. DTSBR135 +00377 DTSBR135 +00378 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR135 +00379 DTSBR135 +00380 S009-EXIT. DTSBR135 +00381 EXIT. DTSBR135 +00382 DTSBR135 +00383 DTSBR135 +00384 S071-DESLASH-NAME. DTSBR135 +00385 DTSBR135 +00386 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR135 +00387 DTSBR135 +00388 S071-EXIT. DTSBR135 +00389 EXIT. DTSBR135 +00390 DTSBR135 +00391 S082-OP-ID-INFO. DTSBR135 +00392 DTSBR135 +00393 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR135 +00394 DTSBR135 +00395 S082-EXIT. DTSBR135 +00396 EXIT. DTSBR135 +00397 DTSBR135 +00398 *S109-SUR-RATE. DTSBR135 +00399 * DTSBR135 +00400 * CALL 'DTSBU109' USING L109-LINK-AREA. DTSBR135 +00401 * DTSBR135 +00402 *S109-EXIT. DTSBR135 +00403 EXIT. DTSBR135 +00404 DTSBR135 +00405 S119-AGENCY-FACTS. DTSBR135 +00406 DTSBR135 +00407 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR135 +00408 DTSBR135 +00409 S119-EXIT. DTSBR135 +00410 EXIT. DTSBR135 +00411 DTSBR135 +00412 DTSBR135 +00413 *S999-ABEND. DTSBR135 +00414 * DTSBR135 +00415 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR135 +00416 * DTSBR135 +00417 *S999-EXIT. DTSBR135 +00418 * EXIT. DTSBR135 +00419 DTSBR135 diff --git a/Batch/DTSBR403.cob b/Batch/DTSBR403.cob index 93ae473..f3518d7 100644 --- a/Batch/DTSBR403.cob +++ b/Batch/DTSBR403.cob @@ -1,10 +1,10 @@ -00001 IDENTIFICATION DIVISION. 05/08/08 +00001 IDENTIFICATION DIVISION. 08/21/24 00002 PROGRAM-ID. DTSBR403. DTSBR403 -00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV150 +00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV011 00004 DATE-WRITTEN. OCTOBER 1994. DTSBR403 00005 DATE-COMPILED. DTSBR403 00006 SKIP3 DTSBR403 -00007 ***** DTSBR403 +00007 ***** NO CHANGE TESTING PRINT CL**7 00008 * DTSBR403 00009 * FUNCTION: LIEN PACKAGES DTSBR403 00010 * DTSBR403 @@ -116,692 +116,704 @@ 00116 05 XEROX-RPT PIC X(133). DTSBR403 00117 EJECT DTSBR403 00118 WORKING-STORAGE SECTION. DTSBR403 -001185 77 PAN-VALET PICTURE X(24) VALUE '150DTSBR403 05/08/08'. DTSBR403 -00119 DTSBR403 -00120 01 WRK-AREA. DTSBR403 -00121 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +403.DTSBR403 -00122 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR403 -00123 05 WRK-YRQ-AREA. DTSBR403 -00124 10 WRK-YRQ OCCURS 20 PIC X(04) VALUE SPACES. DTSBR403 -00125 DTSBR403 -00126 05 WS-FORM-PAGE PIC S9(03) COMP-3 VALUE +0. DTSBR403 -00127 05 WS-FORM-TOTAL-PAGES PIC S9(03) COMP-3 VALUE +0. DTSBR403 -00128 05 WS-PAGE-OCCUR-CNT PIC S9(04) COMP VALUE +0. DTSBR403 -00129 05 WS-FORM-QTR-LEFTOVER-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR403 -00130 05 WS-TOTAL-TAX-BALANCE-AMT PIC 9(09)V99 VALUE 0. DTSBR403 -00131 05 WS-TOTAL-SUR-TAX-BALANCE-AMT PIC 9(09)V99 VALUE 0. DTSBR403 -00132 05 WS-TOTAL-INT-BALANCE-AMT PIC 9(09)V99 VALUE 0. DTSBR403 -00133 05 WS-TOTAL-LP-NP-MP-BALANCE PIC 9(09)V99 VALUE 0. DTSBR403 -00134 05 WS-TOTAL-TOTAL-LIEN-AMT PIC 9(09)V99 VALUE 0. DTSBR403 -00135 DTSBR403 -00136 05 WS-FORM-ID PIC X(12) VALUE SPACES. DTSBR403 -00137 05 WS-REPORT-NO1 PIC X(12) VALUE DTSBR403 -00138 'RPT403R1.FAC'. DTSBR403 -00139 05 WS-CERTIFICATE-NO PIC 9(08) VALUE 0. DTSBR403 -00140 05 WS-EMPLOYER-NO PIC 9(06) VALUE 0. DTSBR403 -00141 05 WS-TOTAL-LIEN-AMT PIC 9(09)V99 VALUE ZERO. DTSBR403 -00142 DTSBR403 -00143 05 WS-COMP-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 -00144 05 WS-CERT-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 -00145 05 WS-STMT-DATE-TEXT PIC X(18) VALUE SPACES. DTSBR403 -00146 SKIP1 DTSBR403 -00147 05 WS-LIEN-FORM-QTR-LINE-TBL PIC X(1500) VALUE SPACES. DTSBR403 -00148 05 FILLER REDEFINES WS-LIEN-FORM-QTR-LINE-TBL. DTSBR403 -00149 10 WS-LIEN-FORM-QTR-LINE OCCURS 20 TIMES. DTSBR403 -00150 15 WS-QTR-END-DATE-SLASH. DTSBR403 -00151 20 WS-YEAR-ONLY PIC X(02). DTSBR403 -00152 20 WS-SLASH-ONLY PIC X(01). DTSBR403 -00153 20 WS-QTR-ONLY PIC X(01). DTSBR403 -00154 15 FILLER PIC X(01). DTSBR403 -00155 15 WS-LEGAL-IND PIC X. DTSBR403 -00156 15 FILLER PIC X(01). DTSBR403 -00157 15 WS-ESTIMATED-TAX-IND PIC X. DTSBR403 -00158 15 FILLER PIC X(01). DTSBR403 -00159 15 WS-UNUSED-IND PIC X. DTSBR403 -00160 15 FILLER PIC X(04). DTSBR403 -00161 15 WS-FORM-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00162 15 FILLER PIC X(01). DTSBR403 -00163 15 WS-FORM-SUR-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00164 15 FILLER PIC X(01). DTSBR403 -00165 15 WS-FORM-INT-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00166 15 FILLER PIC X(01). DTSBR403 -00167 15 WS-FORM-LP-NP-MP-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00168 15 FILLER PIC X(01). DTSBR403 -00169 15 WS-FORM-TOTAL-LIEN-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00170 DTSBR403 -00171 05 WS-LIEN-FORM-TOTAL-DISPLAY PIC X(97) VALUE SPACES. DTSBR403 -00172 05 FILLER REDEFINES WS-LIEN-FORM-TOTAL-DISPLAY. DTSBR403 -00173 15 T-FORM-TOTAL-DESCRIPTION PIC X(15). DTSBR403 -00174 15 T-FORM-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00175 15 FILLER PIC X(01). DTSBR403 -00176 15 T-FORM-SUR-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00177 15 FILLER PIC X(01). DTSBR403 -00178 15 T-FORM-INT-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00179 15 FILLER PIC X(01). DTSBR403 -00180 15 T-FORM-LP-NP-MP-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00181 15 T-FORM-TOTAL-LIEN-AMT PIC $$$,$$$,$$9.99. DTSBR403 -00182 DTSBR403 -00183 05 WS-TOTAL-AMT-STRING PIC X(15) VALUE SPACES. DTSBR403 -00184 05 WS-TOTAL-AMT-EDIT PIC X(14) VALUE SPACES. DTSBR403 -00185 05 WS-TOTAL-AMT-EDIT-R REDEFINES WS-TOTAL-AMT-EDIT DTSBR403 -00186 PIC ZZZ,ZZZ,ZZ9.99. DTSBR403 -00187 05 WS-TOTAL-AMT-FIRST-CHAR PIC S9(04) COMP VALUE +0. DTSBR403 -00188 05 WS-TOTAL-AMT-LENGTH PIC S9(04) COMP VALUE +0. DTSBR403 -00189 DTSBR403 -00190 05 WS-OP-ID-HOLD PIC X(08) VALUE SPACES. DTSBR403 -00191 05 WS-OPR-NAME-CAPS PIC X(32) VALUE SPACES. DTSBR403 -00192 05 WS-OPR-UNIT-NAME-CAPS PIC X(50) VALUE SPACES. DTSBR403 -00193 05 WS-OPR-NAME-MIXED PIC X(32) VALUE SPACES. DTSBR403 -00194 05 WS-OPR-UNIT-NAME-MIXED PIC X(50) VALUE SPACES. DTSBR403 -00195 DTSBR403 -00196 05 WS-OPR-VOICE. DTSBR403 -00197 10 WS-OPR-VOICE-AREA PIC X(03) VALUE SPACES. DTSBR403 -00198 10 WS-OPR-VOICE-1 PIC X(03) VALUE SPACES. DTSBR403 -00199 10 WS-OPR-VOICE-2 PIC X(04) VALUE SPACES. DTSBR403 -00200 10 WS-OPR-VOICE-EXT PIC X(04) VALUE SPACES. DTSBR403 -00201 DTSBR403 -00202 05 WS-FLD-VOICE. DTSBR403 -00203 10 FILLER PIC X(01) VALUE '('. DTSBR403 -00204 10 WS-FLD-VOICE-AREA PIC X(03) VALUE SPACES. DTSBR403 -00205 10 FILLER PIC X(01) VALUE ')'. DTSBR403 -00206 10 WS-FLD-VOICE-1 PIC X(03) VALUE SPACES. DTSBR403 -00207 10 FILLER PIC X(01) VALUE '-'. DTSBR403 -00208 10 WS-FLD-VOICE-2 PIC X(04) VALUE SPACES. DTSBR403 -00209 DTSBR403 -00210 01 BLANK-LINE PIC X(133) VALUE SPACES. DTSBR403 -00211 DTSBR403 -00212 01 FORM-DETAIL. DTSBR403 -00213 05 FMD-LINE-6. DTSBR403 -00214 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 -00215 10 WS-FMD-FMT-LINE-1 PIC X(30) VALUE SPACES. DTSBR403 -00216 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 -00217 05 FMD-LINE-7. DTSBR403 -00218 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 -00219 10 WS-FMD-FMT-LINE-2 PIC X(30) VALUE SPACES. DTSBR403 -00220 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 -00221 05 FMD-LINE-8. DTSBR403 -00222 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 -00223 10 WS-FMD-FMT-LINE-3 PIC X(30) VALUE SPACES. DTSBR403 -00224 10 FILLER PIC X(24) VALUE SPACES. DTSBR403 -00225 10 WS-FMD-CERT-NO PIC 99999999. DTSBR403 -00226 10 FILLER PIC X(76) VALUE SPACES. DTSBR403 -00227 05 FMD-LINE-9. DTSBR403 -00228 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 -00229 10 WS-FMD-FMT-LINE-4 PIC X(30) VALUE SPACES. DTSBR403 -00230 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 -00231 05 FMD-LINE-10. DTSBR403 -00232 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 -00233 10 WS-FMD-FMT-LINE-5 PIC X(30) VALUE SPACES. DTSBR403 -00234 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 -00235 05 FMD-LINE-11. DTSBR403 -00236 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 -00237 10 FILLER PIC X(50) VALUE SPACES. DTSBR403 -00238 10 WS-FMD-CERT-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 -00239 10 FILLER PIC X(72) VALUE SPACES. DTSBR403 -00240 05 FMD-LINE-12 PIC X(133) VALUE SPACES. DTSBR403 -00241 05 FMD-LINE-13. DTSBR403 -00242 10 FILLER PIC X(02) VALUE SPACE. DTSBR403 -00243 10 WS-FMD-EMP-STATUS PIC X VALUE SPACE. DTSBR403 -00244 10 FILLER PIC X(06) VALUE SPACES. DTSBR403 -00245 10 WS-FMD-EMP-NO PIC 999B999. DTSBR403 -00246 10 FILLER PIC X(55) VALUE SPACES. DTSBR403 -00247 10 WS-FMD-COMP-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 -00248 10 FILLER PIC X(62) VALUE SPACES. DTSBR403 -00249 05 FMD-LINE-14 PIC X(133) VALUE SPACES. DTSBR403 -00250 05 FMD-LINE-15 PIC X(133) VALUE SPACES. DTSBR403 -00251 05 FMD-LINE-16 PIC X(133) VALUE SPACES. DTSBR403 -00252 05 FMD-LINE-17 PIC X(133) VALUE SPACES. DTSBR403 -00253 05 FMD-LINE-18. DTSBR403 -00254 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00255 10 WS-LIEN-FORM-QTR-LINE-1 PIC X(88) VALUE SPACES. DTSBR403 -00256 05 FMD-LINE-19. DTSBR403 -00257 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00258 10 WS-LIEN-FORM-QTR-LINE-2 PIC X(88) VALUE SPACES. DTSBR403 -00259 05 FMD-LINE-20. DTSBR403 -00260 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00261 10 WS-LIEN-FORM-QTR-LINE-3 PIC X(88) VALUE SPACES. DTSBR403 -00262 05 FMD-LINE-21. DTSBR403 -00263 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00264 10 WS-LIEN-FORM-QTR-LINE-4 PIC X(88) VALUE SPACES. DTSBR403 -00265 05 FMD-LINE-22. DTSBR403 -00266 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00267 10 WS-LIEN-FORM-QTR-LINE-5 PIC X(88) VALUE SPACES. DTSBR403 -00268 05 FMD-LINE-23. DTSBR403 -00269 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00270 10 WS-LIEN-FORM-QTR-LINE-6 PIC X(88) VALUE SPACES. DTSBR403 -00271 05 FMD-LINE-24. DTSBR403 -00272 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00273 10 WS-LIEN-FORM-QTR-LINE-7 PIC X(88) VALUE SPACES. DTSBR403 -00274 05 FMD-LINE-25. DTSBR403 -00275 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00276 10 WS-LIEN-FORM-QTR-LINE-8 PIC X(88) VALUE SPACES. DTSBR403 -00277 05 FMD-LINE-26. DTSBR403 -00278 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00279 10 WS-LIEN-FORM-QTR-LINE-9 PIC X(88) VALUE SPACES. DTSBR403 -00280 05 FMD-LINE-27. DTSBR403 -00281 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00282 10 WS-LIEN-FORM-QTR-LINE-10 PIC X(88) VALUE SPACES. DTSBR403 -00283 05 FMD-LINE-28. DTSBR403 -00284 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00285 10 WS-LIEN-FORM-QTR-LINE-11 PIC X(88) VALUE SPACES. DTSBR403 -00286 05 FMD-LINE-29. DTSBR403 -00287 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00288 10 WS-LIEN-FORM-QTR-LINE-12 PIC X(88) VALUE SPACES. DTSBR403 -00289 05 FMD-LINE-30. DTSBR403 -00290 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00291 10 WS-LIEN-FORM-QTR-LINE-13 PIC X(88) VALUE SPACES. DTSBR403 -00292 05 FMD-LINE-31. DTSBR403 -00293 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00294 10 WS-LIEN-FORM-QTR-LINE-14 PIC X(88) VALUE SPACES. DTSBR403 -00295 05 FMD-LINE-32. DTSBR403 -00296 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00297 10 WS-LIEN-FORM-QTR-LINE-15 PIC X(88) VALUE SPACES. DTSBR403 -00298 05 FMD-LINE-33. DTSBR403 -00299 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00300 10 WS-LIEN-FORM-QTR-LINE-16 PIC X(88) VALUE SPACES. DTSBR403 -00301 05 FMD-LINE-34. DTSBR403 -00302 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00303 10 WS-LIEN-FORM-QTR-LINE-17 PIC X(88) VALUE SPACES. DTSBR403 -00304 05 FMD-LINE-35. DTSBR403 -00305 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00306 10 WS-LIEN-FORM-QTR-LINE-18 PIC X(88) VALUE SPACES. DTSBR403 -00307 05 FMD-LINE-36. DTSBR403 -00308 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 -00309 10 WS-LIEN-FORM-QTR-LINE-19 PIC X(88) VALUE SPACES. DTSBR403 -00310 05 FMD-LINE-37. DTSBR403 -00311 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 -00312 10 WS-LIEN-FORM-TOTAL-DIS PIC X(90) VALUE SPACES. DTSBR403 -00313 DTSBR403 -00314 05 FMD-LINE-57. DTSBR403 -00315 10 FILLER PIC X(03) VALUE SPACES. DTSBR403 -00316 10 FILLER PIC X(32) VALUE DTSBR403 -00317 'FOR INFORMATION PLEASE CONTACT: '. DTSBR403 -00318 10 WS-LIEN-FLD-REP-NAME PIC X(32) VALUE SPACES. DTSBR403 -00319 10 FILLER PIC X(30) VALUE SPACES. DTSBR403 -00320 DTSBR403 -00321 05 FMD-LINE-58. DTSBR403 -00322 10 FILLER PIC X(03) VALUE SPACES. DTSBR403 -00323 10 FILLER PIC X(32) VALUE DTSBR403 -00324 ' PHONE: '. DTSBR403 -00325 10 WS-LIEN-FLD-REP-PHONE PIC X(15) VALUE SPACES. DTSBR403 -00326 10 FILLER PIC X(50) VALUE SPACES. DTSBR403 -00327 DTSBR403 -00328 01 FORM-LETTER. DTSBR403 -00329 05 FML-LINE-8. DTSBR403 -00330 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 -00331 10 WS-FML-FMT-LINE-1 PIC X(40) VALUE SPACES. DTSBR403 -00332 10 FILLER PIC X(92) VALUE SPACES. DTSBR403 -00333 05 FML-LINE-9. DTSBR403 -00334 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 -00335 10 WS-FML-FMT-LINE-2 PIC X(40) VALUE SPACES. DTSBR403 -00336 10 FILLER PIC X(23) VALUE SPACES. DTSBR403 -00337 10 WS-FML-EMP-NO PIC 999B999. DTSBR403 -00338 10 FILLER PIC X(70) VALUE SPACES. DTSBR403 -00339 05 FML-LINE-10. DTSBR403 -00340 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 -00341 10 WS-FML-FMT-LINE-3 PIC X(40) VALUE SPACES. DTSBR403 -00342 10 FILLER PIC X(92) VALUE SPACES. DTSBR403 -00343 05 FML-LINE-11. DTSBR403 -00344 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 -00345 10 WS-FML-FMT-LINE-4 PIC X(40) VALUE SPACES. DTSBR403 -00346 10 FILLER PIC X(92) VALUE SPACES. DTSBR403 -00347 05 FML-LINE-12. DTSBR403 -00348 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 -00349 10 WS-FML-FMT-LINE-5 PIC X(40) VALUE SPACES. DTSBR403 -00350 10 FILLER PIC X(23) VALUE SPACES. DTSBR403 -00351 10 WS-FML-EMP-STATUS PIC X(10) VALUE SPACES. DTSBR403 -00352 10 FILLER PIC X(75) VALUE SPACES. DTSBR403 -00353 DTSBR403 -00354 05 FML-LINE-55. DTSBR403 -00355 10 FILLER PIC X(05) VALUE SPACES. DTSBR403 -00356 10 FILLER PIC X(16) VALUE DTSBR403 -00357 'PLEASE CONTACT: '. DTSBR403 -00358 10 WS-FML-FLD-REP-NAME PIC X(25) VALUE SPACES. DTSBR403 -00359 10 FILLER PIC X(05) VALUE SPACES. DTSBR403 -00360 10 FILLER PIC X(07) VALUE 'PHONE: '. DTSBR403 -00361 10 WS-FML-FLD-REP-PHONE PIC X(15) VALUE SPACES. DTSBR403 -00362 DTSBR403 -00363 DTSBR403 -00364 EJECT DTSBR403 -00365 01 L001-LINK-AREA. DTSBR403 -00366 ++INCLUDE DTSIL001 DTSBR403 -00367 EJECT DTSBR403 -00368 01 L002-LINK-AREA. DTSBR403 -00369 ++INCLUDE DTSIL002 DTSBR403 -00370 EJECT DTSBR403 -00371 01 L004-LINK-AREA. DTSBR403 -00372 ++INCLUDE DTSIL004 DTSBR403 +001185 77 PAN-VALET PICTURE X(24) VALUE '011DTSBR403 08/21/24'. DTSBR403 +00119 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR403 04/04/11'. DTSBR403 +00120 DTSBR403 +00121 01 WRK-AREA. DTSBR403 +00122 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +403.DTSBR403 +00123 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR403 +00124 05 WRK-YRQ-AREA. DTSBR403 +00125 10 WRK-YRQ OCCURS 20 PIC X(04) VALUE SPACES. DTSBR403 +00126 DTSBR403 +00127 05 WS-FORM-PAGE PIC S9(03) COMP-3 VALUE +0. DTSBR403 +00128 05 WS-FORM-TOTAL-PAGES PIC S9(03) COMP-3 VALUE +0. DTSBR403 +00129 05 WS-PAGE-OCCUR-CNT PIC S9(04) COMP VALUE +0. DTSBR403 +00130 05 WS-FORM-QTR-LEFTOVER-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR403 +00131 05 WS-TOTAL-TAX-BALANCE-AMT PIC 9(09)V99 VALUE 0. DTSBR403 +00132 05 WS-TOTAL-SUR-TAX-BALANCE-AMT PIC 9(09)V99 VALUE 0. DTSBR403 +00133 05 WS-TOTAL-INT-BALANCE-AMT PIC 9(09)V99 VALUE 0. DTSBR403 +00134 05 WS-TOTAL-LP-NP-MP-BALANCE PIC 9(09)V99 VALUE 0. DTSBR403 +00135 05 WS-TOTAL-TOTAL-LIEN-AMT PIC 9(09)V99 VALUE 0. DTSBR403 +00136 DTSBR403 +00137 05 WS-FORM-ID PIC X(12) VALUE SPACES. DTSBR403 +00138 05 WS-REPORT-NO1 PIC X(12) VALUE DTSBR403 +00139 'RPT403R1.FAC'. DTSBR403 +00140 05 WS-CERTIFICATE-NO PIC 9(08) VALUE 0. DTSBR403 +00141 05 WS-EMPLOYER-NO PIC 9(06) VALUE 0. DTSBR403 +00142 05 WS-TOTAL-LIEN-AMT PIC 9(09)V99 VALUE ZERO. DTSBR403 +00143 DTSBR403 +00144 05 WS-COMP-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 +00145 05 WS-CERT-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 +00146 05 WS-STMT-DATE-TEXT PIC X(18) VALUE SPACES. DTSBR403 +00147 SKIP1 DTSBR403 +00148 05 WS-LIEN-FORM-QTR-LINE-TBL PIC X(1500) VALUE SPACES. DTSBR403 +00149 05 FILLER REDEFINES WS-LIEN-FORM-QTR-LINE-TBL. DTSBR403 +00150 10 WS-LIEN-FORM-QTR-LINE OCCURS 20 TIMES. DTSBR403 +00151 15 WS-QTR-END-DATE-SLASH. DTSBR403 +00152 20 WS-YEAR-ONLY PIC X(02). DTSBR403 +00153 20 WS-SLASH-ONLY PIC X(01). DTSBR403 +00154 20 WS-QTR-ONLY PIC X(01). DTSBR403 +00155 15 FILLER PIC X(01). DTSBR403 +00156 15 WS-LEGAL-IND PIC X. DTSBR403 +00157 15 FILLER PIC X(01). DTSBR403 +00158 15 WS-ESTIMATED-TAX-IND PIC X. DTSBR403 +00159 15 FILLER PIC X(01). DTSBR403 +00160 15 WS-UNUSED-IND PIC X. DTSBR403 +00161 15 FILLER PIC X(04). DTSBR403 +00162 15 WS-FORM-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00163 15 FILLER PIC X(01). DTSBR403 +00164 15 WS-FORM-SUR-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00165 15 FILLER PIC X(01). DTSBR403 +00166 15 WS-FORM-INT-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00167 15 FILLER PIC X(01). DTSBR403 +00168 15 WS-FORM-LP-NP-MP-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00169 15 FILLER PIC X(01). DTSBR403 +00170 15 WS-FORM-TOTAL-LIEN-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00171 DTSBR403 +00172 05 WS-LIEN-FORM-TOTAL-DISPLAY PIC X(97) VALUE SPACES. DTSBR403 +00173 05 FILLER REDEFINES WS-LIEN-FORM-TOTAL-DISPLAY. DTSBR403 +00174 15 T-FORM-TOTAL-DESCRIPTION PIC X(15). DTSBR403 +00175 15 T-FORM-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00176 15 FILLER PIC X(01). DTSBR403 +00177 15 T-FORM-SUR-TAX-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00178 15 FILLER PIC X(01). DTSBR403 +00179 15 T-FORM-INT-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00180 15 FILLER PIC X(01). DTSBR403 +00181 15 T-FORM-LP-NP-MP-BALANCE-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00182 15 T-FORM-TOTAL-LIEN-AMT PIC $$$,$$$,$$9.99. DTSBR403 +00183 DTSBR403 +00184 05 WS-TOTAL-AMT-STRING PIC X(15) VALUE SPACES. DTSBR403 +00185 05 WS-TOTAL-AMT-EDIT PIC X(14) VALUE SPACES. DTSBR403 +00186 05 WS-TOTAL-AMT-EDIT-R REDEFINES WS-TOTAL-AMT-EDIT DTSBR403 +00187 PIC ZZZ,ZZZ,ZZ9.99. DTSBR403 +00188 05 WS-TOTAL-AMT-FIRST-CHAR PIC S9(04) COMP VALUE +0. DTSBR403 +00189 05 WS-TOTAL-AMT-LENGTH PIC S9(04) COMP VALUE +0. DTSBR403 +00190 DTSBR403 +00191 05 WS-OP-ID-HOLD PIC X(08) VALUE SPACES. DTSBR403 +00192 05 WS-OPR-NAME-CAPS PIC X(32) VALUE SPACES. DTSBR403 +00193 05 WS-OPR-UNIT-NAME-CAPS PIC X(50) VALUE SPACES. DTSBR403 +00194 05 WS-OPR-NAME-MIXED PIC X(32) VALUE SPACES. DTSBR403 +00195 05 WS-OPR-UNIT-NAME-MIXED PIC X(50) VALUE SPACES. DTSBR403 +00196 DTSBR403 +00197 05 WS-OPR-VOICE. DTSBR403 +00198 10 WS-OPR-VOICE-AREA PIC X(03) VALUE SPACES. DTSBR403 +00199 10 WS-OPR-VOICE-1 PIC X(03) VALUE SPACES. DTSBR403 +00200 10 WS-OPR-VOICE-2 PIC X(04) VALUE SPACES. DTSBR403 +00201 10 WS-OPR-VOICE-EXT PIC X(04) VALUE SPACES. DTSBR403 +00202 DTSBR403 +00203 05 WS-FLD-VOICE. DTSBR403 +00204 10 FILLER PIC X(01) VALUE '('. DTSBR403 +00205 10 WS-FLD-VOICE-AREA PIC X(03) VALUE SPACES. DTSBR403 +00206 10 FILLER PIC X(01) VALUE ')'. DTSBR403 +00207 10 WS-FLD-VOICE-1 PIC X(03) VALUE SPACES. DTSBR403 +00208 10 FILLER PIC X(01) VALUE '-'. DTSBR403 +00209 10 WS-FLD-VOICE-2 PIC X(04) VALUE SPACES. DTSBR403 +00210 DTSBR403 +00211 01 BLANK-LINE PIC X(133) VALUE SPACES. DTSBR403 +00212 DTSBR403 +00213 01 FORM-DETAIL. DTSBR403 +00214 05 FMD-LINE-6. DTSBR403 +00215 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 +00216 10 WS-FMD-FMT-LINE-1 PIC X(30) VALUE SPACES. DTSBR403 +00217 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 +00218 05 FMD-LINE-7. DTSBR403 +00219 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 +00220 10 WS-FMD-FMT-LINE-2 PIC X(30) VALUE SPACES. DTSBR403 +00221 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 +00222 05 FMD-LINE-8. DTSBR403 +00223 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 +00224 10 WS-FMD-FMT-LINE-3 PIC X(30) VALUE SPACES. DTSBR403 +00225 10 FILLER PIC X(24) VALUE SPACES. DTSBR403 +00226 10 WS-FMD-CERT-NO PIC 99999999. DTSBR403 +00227 10 FILLER PIC X(76) VALUE SPACES. DTSBR403 +00228 05 FMD-LINE-9. DTSBR403 +00229 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 +00230 10 WS-FMD-FMT-LINE-4 PIC X(30) VALUE SPACES. DTSBR403 +00231 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 +00232 05 FMD-LINE-10. DTSBR403 +00233 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 +00234 10 WS-FMD-FMT-LINE-5 PIC X(30) VALUE SPACES. DTSBR403 +00235 10 FILLER PIC X(102) VALUE SPACES. DTSBR403 +00236 05 FMD-LINE-11. DTSBR403 +00237 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 +00238 10 FILLER PIC X(50) VALUE SPACES. DTSBR403 +00239 10 WS-FMD-CERT-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 +00240 10 FILLER PIC X(72) VALUE SPACES. DTSBR403 +00241 05 FMD-LINE-12 PIC X(133) VALUE SPACES. DTSBR403 +00242 05 FMD-LINE-13. DTSBR403 +00243 10 FILLER PIC X(02) VALUE SPACE. DTSBR403 +00244 10 WS-FMD-EMP-STATUS PIC X VALUE SPACE. DTSBR403 +00245 10 FILLER PIC X(06) VALUE SPACES. DTSBR403 +00246 10 WS-FMD-EMP-NO PIC 999B999. DTSBR403 +00247 10 FILLER PIC X(55) VALUE SPACES. DTSBR403 +00248 10 WS-FMD-COMP-DATE-SLASH PIC X(10) VALUE SPACES. DTSBR403 +00249 10 FILLER PIC X(62) VALUE SPACES. DTSBR403 +00250 05 FMD-LINE-14 PIC X(133) VALUE SPACES. DTSBR403 +00251 05 FMD-LINE-15 PIC X(133) VALUE SPACES. DTSBR403 +00252 05 FMD-LINE-16 PIC X(133) VALUE SPACES. DTSBR403 +00253 05 FMD-LINE-17 PIC X(133) VALUE SPACES. DTSBR403 +00254 05 FMD-LINE-18. DTSBR403 +00255 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00256 10 WS-LIEN-FORM-QTR-LINE-1 PIC X(88) VALUE SPACES. DTSBR403 +00257 05 FMD-LINE-19. DTSBR403 +00258 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00259 10 WS-LIEN-FORM-QTR-LINE-2 PIC X(88) VALUE SPACES. DTSBR403 +00260 05 FMD-LINE-20. DTSBR403 +00261 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00262 10 WS-LIEN-FORM-QTR-LINE-3 PIC X(88) VALUE SPACES. DTSBR403 +00263 05 FMD-LINE-21. DTSBR403 +00264 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00265 10 WS-LIEN-FORM-QTR-LINE-4 PIC X(88) VALUE SPACES. DTSBR403 +00266 05 FMD-LINE-22. DTSBR403 +00267 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00268 10 WS-LIEN-FORM-QTR-LINE-5 PIC X(88) VALUE SPACES. DTSBR403 +00269 05 FMD-LINE-23. DTSBR403 +00270 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00271 10 WS-LIEN-FORM-QTR-LINE-6 PIC X(88) VALUE SPACES. DTSBR403 +00272 05 FMD-LINE-24. DTSBR403 +00273 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00274 10 WS-LIEN-FORM-QTR-LINE-7 PIC X(88) VALUE SPACES. DTSBR403 +00275 05 FMD-LINE-25. DTSBR403 +00276 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00277 10 WS-LIEN-FORM-QTR-LINE-8 PIC X(88) VALUE SPACES. DTSBR403 +00278 05 FMD-LINE-26. DTSBR403 +00279 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00280 10 WS-LIEN-FORM-QTR-LINE-9 PIC X(88) VALUE SPACES. DTSBR403 +00281 05 FMD-LINE-27. DTSBR403 +00282 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00283 10 WS-LIEN-FORM-QTR-LINE-10 PIC X(88) VALUE SPACES. DTSBR403 +00284 05 FMD-LINE-28. DTSBR403 +00285 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00286 10 WS-LIEN-FORM-QTR-LINE-11 PIC X(88) VALUE SPACES. DTSBR403 +00287 05 FMD-LINE-29. DTSBR403 +00288 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00289 10 WS-LIEN-FORM-QTR-LINE-12 PIC X(88) VALUE SPACES. DTSBR403 +00290 05 FMD-LINE-30. DTSBR403 +00291 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00292 10 WS-LIEN-FORM-QTR-LINE-13 PIC X(88) VALUE SPACES. DTSBR403 +00293 05 FMD-LINE-31. DTSBR403 +00294 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00295 10 WS-LIEN-FORM-QTR-LINE-14 PIC X(88) VALUE SPACES. DTSBR403 +00296 05 FMD-LINE-32. DTSBR403 +00297 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00298 10 WS-LIEN-FORM-QTR-LINE-15 PIC X(88) VALUE SPACES. DTSBR403 +00299 05 FMD-LINE-33. DTSBR403 +00300 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00301 10 WS-LIEN-FORM-QTR-LINE-16 PIC X(88) VALUE SPACES. DTSBR403 +00302 05 FMD-LINE-34. DTSBR403 +00303 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00304 10 WS-LIEN-FORM-QTR-LINE-17 PIC X(88) VALUE SPACES. DTSBR403 +00305 05 FMD-LINE-35. DTSBR403 +00306 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00307 10 WS-LIEN-FORM-QTR-LINE-18 PIC X(88) VALUE SPACES. DTSBR403 +00308 05 FMD-LINE-36. DTSBR403 +00309 10 FILLER PIC X(02) VALUE SPACES. DTSBR403 +00310 10 WS-LIEN-FORM-QTR-LINE-19 PIC X(88) VALUE SPACES. DTSBR403 +00311 05 FMD-LINE-37. DTSBR403 +00312 10 FILLER PIC X(01) VALUE SPACE. DTSBR403 +00313 10 WS-LIEN-FORM-TOTAL-DIS PIC X(90) VALUE SPACES. DTSBR403 +00314 DTSBR403 +00315 05 FMD-LINE-57. DTSBR403 +00316 10 FILLER PIC X(03) VALUE SPACES. CL**6 +00317 10 FILLER PIC X(32) VALUE CL**4 +00318 'COLLECTION UNIT: '. CL*10 +00319 * 10 WS-LIEN-FLD-REP-NAME PIC X(32) VALUE SPACES. CL*10 +00320 10 FILLER PIC X(62) VALUE SPACES. CL*10 +00321 DTSBR403 +00322 05 FMD-LINE-58. DTSBR403 +00323 10 FILLER PIC X(03) VALUE SPACES. CL**6 +00324 10 FILLER PIC X(45) VALUE CL*10 +00325 'EMAIL ADDRESS: UITAX.COLLECTIONS@DC.GOV '. CL*10 +00326 10 FILLER PIC X(19) VALUE CL*10 +00327 'PHONE: 202.698.7550'. CL*10 +00328 * 10 WS-LIEN-FLD-REP-PHONE PIC X(15) VALUE SPACES. CL*10 +00329 10 FILLER PIC X(50) VALUE SPACES. CL**4 +00330 DTSBR403 +00331 01 FORM-LETTER. DTSBR403 +00332 05 FML-LINE-8. DTSBR403 +00333 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 +00334 10 WS-FML-FMT-LINE-1 PIC X(40) VALUE SPACES. DTSBR403 +00335 10 FILLER PIC X(92) VALUE SPACES. DTSBR403 +00336 05 FML-LINE-9. DTSBR403 +00337 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 +00338 10 WS-FML-FMT-LINE-2 PIC X(40) VALUE SPACES. DTSBR403 +00339 10 FILLER PIC X(23) VALUE SPACES. DTSBR403 +00340 10 WS-FML-EMP-NO PIC 999B999. DTSBR403 +00341 10 FILLER PIC X(70) VALUE SPACES. DTSBR403 +00342 05 FML-LINE-10. DTSBR403 +00343 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 +00344 10 WS-FML-FMT-LINE-3 PIC X(40) VALUE SPACES. DTSBR403 +00345 10 FILLER PIC X(92) VALUE SPACES. DTSBR403 +00346 05 FML-LINE-11. DTSBR403 +00347 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 +00348 10 WS-FML-FMT-LINE-4 PIC X(40) VALUE SPACES. DTSBR403 +00349 10 FILLER PIC X(92) VALUE SPACES. DTSBR403 +00350 05 FML-LINE-12. DTSBR403 +00351 10 FILLER PIC X(04) VALUE SPACES. DTSBR403 +00352 10 WS-FML-FMT-LINE-5 PIC X(40) VALUE SPACES. DTSBR403 +00353 10 FILLER PIC X(23) VALUE SPACES. DTSBR403 +00354 10 WS-FML-EMP-STATUS PIC X(10) VALUE SPACES. DTSBR403 +00355 10 FILLER PIC X(75) VALUE SPACES. DTSBR403 +00356 DTSBR403 +00357 05 FML-LINE-55. DTSBR403 +00358 10 FILLER PIC X(05) VALUE SPACES. CL**6 +00359 * 10 FILLER PIC X(16) VALUE CL*10 +00360 * 'PLEASE CONTACT: '. CL*10 +00361 * 10 WS-FML-FLD-REP-NAME PIC X(25) VALUE SPACES. CL*10 +00362 * 10 FILLER PIC X(05) VALUE SPACES. CL*10 +00363 * 10 FILLER PIC X(07) VALUE 'PHONE: '. CL*10 +00364 * 10 WS-FML-FLD-REP-PHONE PIC X(15) VALUE SPACES. CL*10 +00365 10 FILLER PIC X(45) VALUE CL*10 +00366 'EMAIL ADDRESS: UITAX.COLLECTIONS@DC.GOV '. CL*10 +00367 10 FILLER PIC X(19) VALUE CL*10 +00368 'PHONE: 202.698.7550'. CL*10 +00369 * 10 WS-LIEN-FLD-REP-PHONE PIC X(15) VALUE SPACES. CL*10 +00370 * 10 FILLER PIC X(50) VALUE SPACES. CL*10 +00371 DTSBR403 +00372 DTSBR403 00373 EJECT DTSBR403 -00374 01 L009-LINK-AREA. DTSBR403 -00375 ++INCLUDE DTSIL009 DTSBR403 +00374 01 L001-LINK-AREA. DTSBR403 +00375 ++INCLUDE DTSIL001 DTSBR403 00376 EJECT DTSBR403 -00377 01 L071-LINK-AREA. DTSBR403 -00378 ++INCLUDE DTSIL071 DTSBR403 +00377 01 L002-LINK-AREA. DTSBR403 +00378 ++INCLUDE DTSIL002 DTSBR403 00379 EJECT DTSBR403 -00380 01 L082-LINK-AREA. DTSBR403 -00381 ++INCLUDE DTSIL082 DTSBR403 +00380 01 L004-LINK-AREA. DTSBR403 +00381 ++INCLUDE DTSIL004 DTSBR403 00382 EJECT DTSBR403 -00383 01 L119-LINK-AREA. DTSBR403 -00384 ++INCLUDE DTSIL119 DTSBR403 +00383 01 L009-LINK-AREA. DTSBR403 +00384 ++INCLUDE DTSIL009 DTSBR403 00385 EJECT DTSBR403 -00386 ++INCLUDE DTSXL403 DTSBR403 -00387 EJECT DTSBR403 -00388 LINKAGE SECTION. DTSBR403 -00389 SKIP3 DTSBR403 -00390 01 LRCM-LINK-AREA. DTSBR403 -00391 ++INCLUDE DTSILRCM DTSBR403 -00392 EJECT DTSBR403 -00393 01 R403-REC. DTSBR403 -00394 ++INCLUDE DTSIR403 DTSBR403 -00395 EJECT DTSBR403 -00396 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR403 -00397 R403-REC. DTSBR403 -00398 SKIP2 DTSBR403 -00399 IF FIRST-TIME-IND = 'Y' DTSBR403 -00400 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR403 -00401 MOVE 'N' TO FIRST-TIME-IND. DTSBR403 -00402 SKIP1 DTSBR403 -00403 IF LRCM-EOR-88 DTSBR403 -00404 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR403 -00405 ELSE DTSBR403 -00406 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR403 -00407 END-IF. DTSBR403 -00408 SKIP2 DTSBR403 -00409 GOBACK. DTSBR403 -00410 I1000-INITIATE. DTSBR403 +00386 01 L071-LINK-AREA. DTSBR403 +00387 ++INCLUDE DTSIL071 DTSBR403 +00388 EJECT DTSBR403 +00389 01 L082-LINK-AREA. DTSBR403 +00390 ++INCLUDE DTSIL082 DTSBR403 +00391 EJECT DTSBR403 +00392 01 L119-LINK-AREA. DTSBR403 +00393 ++INCLUDE DTSIL119 DTSBR403 +00394 EJECT DTSBR403 +00395 ++INCLUDE DTSXL403 DTSBR403 +00396 EJECT DTSBR403 +00397 LINKAGE SECTION. DTSBR403 +00398 SKIP3 DTSBR403 +00399 01 LRCM-LINK-AREA. DTSBR403 +00400 ++INCLUDE DTSILRCM DTSBR403 +00401 EJECT DTSBR403 +00402 01 R403-REC. DTSBR403 +00403 ++INCLUDE DTSIR403 DTSBR403 +00404 EJECT DTSBR403 +00405 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR403 +00406 R403-REC. DTSBR403 +00407 SKIP2 DTSBR403 +00408 IF FIRST-TIME-IND = 'Y' DTSBR403 +00409 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR403 +00410 MOVE 'N' TO FIRST-TIME-IND. DTSBR403 00411 SKIP1 DTSBR403 -00412 OPEN OUTPUT PRT-FILE1. DTSBR403 -00413 MOVE SPACES TO XEROX-REPORT. DTSBR403 -00414 WRITE XEROX-REPORT FROM BLANK-LINE DTSBR403 -00415 AFTER ADVANCING TOP-OF-PAGE. DTSBR403 -00416 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 18. DTSBR403 -00417 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE20 DTSBR403 -00418 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE21. DTSBR403 -00419 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE22. DTSBR403 -00420 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE23. DTSBR403 -00421 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE24. DTSBR403 -00422 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL1. DTSBR403 -00423 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL2. DTSBR403 -00424 DTSBR403 -00425 SKIP1 DTSBR403 -00426 MOVE R403-STMT-DATE TO L002-DATE DTSBR403 -00427 SET L002-MIXED-CASE TO TRUE. DTSBR403 -00428 PERFORM S002-DATE THRU S002-EXIT. DTSBR403 -00429 MOVE L002-LONG-TEXT-AREA TO WS-STMT-DATE-TEXT DTSBR403 -00430 DTSBR403 -00431 MOVE R403-OP-ID TO WS-OP-ID-HOLD. DTSBR403 -00432 PERFORM P3000-OPERATOR-LOOKUP THRU P3000-EXIT. DTSBR403 -00433 MOVE R403-EMP-NO TO WS-EMPLOYER-NO. DTSBR403 -00434 DTSBR403 -00435 I1000-EXIT. DTSBR403 -00436 EXIT. DTSBR403 -00437 EJECT DTSBR403 -00438 P1000-PROCESS. DTSBR403 +00412 IF LRCM-EOR-88 DTSBR403 +00413 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR403 +00414 ELSE DTSBR403 +00415 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR403 +00416 END-IF. DTSBR403 +00417 SKIP2 DTSBR403 +00418 GOBACK. DTSBR403 +00419 I1000-INITIATE. DTSBR403 +00420 SKIP1 DTSBR403 +00421 OPEN OUTPUT PRT-FILE1. DTSBR403 +00422 MOVE SPACES TO XEROX-REPORT. DTSBR403 +00423 WRITE XEROX-REPORT FROM BLANK-LINE DTSBR403 +00424 AFTER ADVANCING TOP-OF-PAGE. DTSBR403 +00425 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 18. DTSBR403 +00426 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE20 DTSBR403 +00427 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE21. DTSBR403 +00428 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE22. DTSBR403 +00429 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE23. DTSBR403 +00430 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE24. DTSBR403 +00431 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL1. DTSBR403 +00432 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL2. DTSBR403 +00433 DTSBR403 +00434 SKIP1 DTSBR403 +00435 MOVE R403-STMT-DATE TO L002-DATE DTSBR403 +00436 SET L002-MIXED-CASE TO TRUE. DTSBR403 +00437 PERFORM S002-DATE THRU S002-EXIT. DTSBR403 +00438 MOVE L002-LONG-TEXT-AREA TO WS-STMT-DATE-TEXT DTSBR403 00439 DTSBR403 -00440 PERFORM P3000-OPERATOR-LOOKUP THRU P3000-EXIT. DTSBR403 -00441 DTSBR403 +00440 MOVE R403-OP-ID TO WS-OP-ID-HOLD. DTSBR403 +00441 PERFORM P3000-OPERATOR-LOOKUP THRU P3000-EXIT. CL**4 00442 MOVE R403-EMP-NO TO WS-EMPLOYER-NO. DTSBR403 -00443 MOVE R403-FORM-COMP-DATE TO L001-FED-8-DATE-9. DTSBR403 -00444 SET L001-FROM-FED-8 TO TRUE. DTSBR403 -00445 PERFORM S001-DATE THRU S001-EXIT. DTSBR403 -00446 MOVE L001-SLASH-8-DATE TO WS-COMP-DATE-SLASH. DTSBR403 -00447 DTSBR403 -00448 MOVE R403-CERTIFICATE-NO TO WS-CERTIFICATE-NO. DTSBR403 -00449 MOVE R403-CERTIFICATE-DATE TO L001-FED-8-DATE-9. DTSBR403 -00450 SET L001-FROM-FED-8 TO TRUE. DTSBR403 -00451 PERFORM S001-DATE THRU S001-EXIT. DTSBR403 -00452 IF L001-VALID-DATE DTSBR403 -00453 MOVE L001-SLASH-8-DATE TO WS-CERT-DATE-SLASH DTSBR403 -00454 ELSE DTSBR403 -00455 MOVE SPACES TO WS-CERT-DATE-SLASH. DTSBR403 +00443 DTSBR403 +00444 I1000-EXIT. DTSBR403 +00445 EXIT. DTSBR403 +00446 EJECT DTSBR403 +00447 P1000-PROCESS. DTSBR403 +00448 DTSBR403 +00449 PERFORM P3000-OPERATOR-LOOKUP THRU P3000-EXIT. CL**4 +00450 DTSBR403 +00451 MOVE R403-EMP-NO TO WS-EMPLOYER-NO. DTSBR403 +00452 MOVE R403-FORM-COMP-DATE TO L001-FED-8-DATE-9. DTSBR403 +00453 SET L001-FROM-FED-8 TO TRUE. DTSBR403 +00454 PERFORM S001-DATE THRU S001-EXIT. DTSBR403 +00455 MOVE L001-SLASH-8-DATE TO WS-COMP-DATE-SLASH. DTSBR403 00456 DTSBR403 -00457 MOVE R403-LETTER-TOTAL-AMT TO WS-TOTAL-AMT-EDIT-R. DTSBR403 -00458 MOVE +0 TO WS-TOTAL-AMT-FIRST-CHAR. DTSBR403 -00459 INSPECT WS-TOTAL-AMT-EDIT DTSBR403 -00460 TALLYING WS-TOTAL-AMT-FIRST-CHAR DTSBR403 -00461 FOR LEADING SPACES. DTSBR403 -00462 SUBTRACT WS-TOTAL-AMT-FIRST-CHAR FROM 14 DTSBR403 -00463 GIVING WS-TOTAL-AMT-LENGTH. DTSBR403 -00464 ADD +1 TO WS-TOTAL-AMT-FIRST-CHAR. DTSBR403 -00465 MOVE SPACES TO WS-TOTAL-AMT-STRING. DTSBR403 -00466 STRING WS-TOTAL-AMT-EDIT DTSBR403 -00467 (WS-TOTAL-AMT-FIRST-CHAR:WS-TOTAL-AMT-LENGTH) DTSBR403 -00468 DELIMITED BY SIZE DTSBR403 -00469 '.' DELIMITED BY SIZE DTSBR403 -00470 INTO DTSBR403 -00471 WS-TOTAL-AMT-STRING. DTSBR403 -00472 DTSBR403 -00473 PERFORM P2000-LIEN-FORM-PROCESS THRU P2000-EXIT. DTSBR403 -00474 DTSBR403 -00475 P1000-EXIT. DTSBR403 -00476 EXIT. DTSBR403 -00477 EJECT DTSBR403 -00478 P2000-LIEN-FORM-PROCESS. DTSBR403 -00479 DTSBR403 -00480 DIVIDE R403-FORM-QTR-CNT BY 20 GIVING WS-FORM-TOTAL-PAGES DTSBR403 -00481 REMAINDER WS-FORM-QTR-LEFTOVER-CNT. DTSBR403 -00482 IF WS-FORM-QTR-LEFTOVER-CNT > +0 DTSBR403 -00483 ADD +1 TO WS-FORM-TOTAL-PAGES. DTSBR403 -00484 MOVE +0 TO WS-PAGE-OCCUR-CNT DTSBR403 -00485 WS-FORM-PAGE. DTSBR403 -00486 MOVE SPACES TO WS-LIEN-FORM-QTR-LINE-TBL. DTSBR403 -00487 MOVE ZEROES TO WS-TOTAL-TAX-BALANCE-AMT DTSBR403 -00488 WS-TOTAL-SUR-TAX-BALANCE-AMT DTSBR403 -00489 WS-TOTAL-INT-BALANCE-AMT DTSBR403 -00490 WS-TOTAL-LP-NP-MP-BALANCE DTSBR403 -00491 WS-TOTAL-TOTAL-LIEN-AMT. DTSBR403 -00492 PERFORM P2100-PROCESS-FORM-QTR THRU P2100-EXIT DTSBR403 -00493 VARYING R403-FORM-QTR-IDX FROM +1 BY +1 DTSBR403 -00494 UNTIL R403-FORM-QTR-IDX > R403-FORM-QTR-CNT. DTSBR403 -00495 INITIALIZE WS-LIEN-FORM-TOTAL-DISPLAY. DTSBR403 -00496 * MOVE 'TOTAL ON QTRS ' TO T-FORM-TOTAL-DESCRIPTION. DTSBR403 -00497 MOVE SPACES TO T-FORM-TOTAL-DESCRIPTION. DTSBR403 -00498 MOVE WS-TOTAL-TAX-BALANCE-AMT TO T-FORM-TAX-BALANCE-AMT. DTSBR403 -00499 MOVE WS-TOTAL-SUR-TAX-BALANCE-AMT TO DTSBR403 -00500 T-FORM-SUR-TAX-BALANCE-AMT. DTSBR403 -00501 MOVE WS-TOTAL-INT-BALANCE-AMT TO T-FORM-INT-BALANCE-AMT. DTSBR403 -00502 MOVE WS-TOTAL-LP-NP-MP-BALANCE TO DTSBR403 -00503 T-FORM-LP-NP-MP-BALANCE-AMT. DTSBR403 -00504 MOVE WS-TOTAL-TOTAL-LIEN-AMT TO T-FORM-TOTAL-LIEN-AMT. DTSBR403 -00505 ADD +1 TO WS-FORM-PAGE. DTSBR403 -00506 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT. DTSBR403 -00507 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT. DTSBR403 -00508 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT. DTSBR403 -00509 PERFORM P5000-PRINT-FORM-LETTER THRU P5000-EXIT. DTSBR403 -00510 DTSBR403 -00511 P2000-EXIT. DTSBR403 -00512 EXIT. DTSBR403 -00513 EJECT DTSBR403 -00514 P2100-PROCESS-FORM-QTR. DTSBR403 -00515 DTSBR403 -00516 ADD +1 TO WS-PAGE-OCCUR-CNT. DTSBR403 -00517 PERFORM P2105-PICKUP-YRQ THRU P2105-EXIT. DTSBR403 -00518 MOVE R403-FORM-LEGAL-IND (R403-FORM-QTR-IDX) DTSBR403 -00519 TO WS-LEGAL-IND (WS-PAGE-OCCUR-CNT). DTSBR403 -00520 MOVE R403-FORM-ESTIMATED-IND (R403-FORM-QTR-IDX) DTSBR403 -00521 TO WS-ESTIMATED-TAX-IND (WS-PAGE-OCCUR-CNT). DTSBR403 -00522 MOVE R403-FORM-UNUSED-IND (R403-FORM-QTR-IDX) DTSBR403 -00523 TO WS-UNUSED-IND (WS-PAGE-OCCUR-CNT). DTSBR403 -00524 MOVE R403-FORM-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 -00525 TO WS-FORM-TAX-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 -00526 MOVE R403-FORM-SUR-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 -00527 TO WS-FORM-SUR-TAX-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 -00528 MOVE R403-FORM-INT-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 -00529 TO WS-FORM-INT-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 -00530 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 -00531 TO WS-FORM-LP-NP-MP-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 -00532 MOVE ZEROS TO WS-TOTAL-LIEN-AMT. DTSBR403 -00533 COMPUTE WS-TOTAL-LIEN-AMT = DTSBR403 -00534 R403-FORM-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) + DTSBR403 -00535 R403-FORM-SUR-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) + DTSBR403 -00536 R403-FORM-INT-BALANCE-AMT (R403-FORM-QTR-IDX) + DTSBR403 -00537 R403-FORM-LP-NP-MP-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 -00538 MOVE WS-TOTAL-LIEN-AMT DTSBR403 -00539 TO WS-FORM-TOTAL-LIEN-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 -00540 COMPUTE WS-TOTAL-TAX-BALANCE-AMT = WS-TOTAL-TAX-BALANCE-AMT +DTSBR403 -00541 R403-FORM-TAX-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 -00542 COMPUTE WS-TOTAL-SUR-TAX-BALANCE-AMT = DTSBR403 -00543 WS-TOTAL-SUR-TAX-BALANCE-AMT + DTSBR403 -00544 R403-FORM-SUR-TAX-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 -00545 COMPUTE WS-TOTAL-INT-BALANCE-AMT = WS-TOTAL-INT-BALANCE-AMT +DTSBR403 -00546 R403-FORM-INT-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 -00547 COMPUTE WS-TOTAL-LP-NP-MP-BALANCE = WS-TOTAL-LP-NP-MP-BALANCEDTSBR403 -00548 + R403-FORM-LP-NP-MP-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 -00549 COMPUTE WS-TOTAL-TOTAL-LIEN-AMT = WS-TOTAL-TOTAL-LIEN-AMT + DTSBR403 -00550 WS-TOTAL-LIEN-AMT. DTSBR403 -00551 IF WS-PAGE-OCCUR-CNT = +20 DTSBR403 -00552 IF R403-FORM-QTR-IDX = R403-FORM-QTR-CNT DTSBR403 -00553 GO TO P2100-EXIT DTSBR403 -00554 ELSE DTSBR403 -00555 ADD +1 TO WS-FORM-PAGE DTSBR403 -00556 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT DTSBR403 -00557 MOVE +0 TO WS-PAGE-OCCUR-CNT DTSBR403 -00558 MOVE SPACES TO WS-LIEN-FORM-QTR-LINE-TBL. DTSBR403 -00559 DTSBR403 -00560 P2100-EXIT. DTSBR403 -00561 EXIT. DTSBR403 -00562 DTSBR403 -00563 P2105-PICKUP-YRQ. DTSBR403 -00564 IF LRCM-PICKUP-YRQ = R403-FORM-QTR (R403-FORM-QTR-IDX) DTSBR403 -00565 MOVE 'PU ' TO WS-QTR-END-DATE-SLASH (WS-PAGE-OCCUR-CNT) DTSBR403 -00566 ELSE DTSBR403 -00567 MOVE R403-FORM-QTR (R403-FORM-QTR-IDX) TO L004-QTR-5-9 DTSBR403 -00568 SET L004-FROM-5 TO TRUE DTSBR403 -00569 PERFORM S004-CONVERT-QTR THRU S004-EXIT DTSBR403 -00570 MOVE L004-SLASH-QTR DTSBR403 -00571 TO WS-QTR-END-DATE-SLASH (WS-PAGE-OCCUR-CNT) DTSBR403 -00572 MOVE SPACE TO WS-SLASH-ONLY (WS-PAGE-OCCUR-CNT) DTSBR403 -00573 END-IF. DTSBR403 -00574 P2105-EXIT. DTSBR403 -00575 EXIT. DTSBR403 -00576 EJECT DTSBR403 -00577 P3000-OPERATOR-LOOKUP. DTSBR403 -00578 DTSBR403 -00579 MOVE R403-OP-ID TO L082-OP-ID. DTSBR403 -00580 PERFORM S082-OP-ID-INFO THRU S082-EXIT. DTSBR403 -00581 IF L082-NOT-VALID-OP OR L082-INTERNAL-88 DTSBR403 -00582 MOVE SPACES TO WS-OPR-NAME-MIXED DTSBR403 -00583 WS-OPR-NAME-CAPS DTSBR403 -00584 MOVE LRCM-DEFAULT-NAME TO WS-OPR-UNIT-NAME-MIXED DTSBR403 -00585 MOVE LRCM-DEFAULT-VOICE TO WS-OPR-VOICE DTSBR403 -00586 ELSE DTSBR403 -00587 MOVE L082-UNIT-NAME TO WS-OPR-UNIT-NAME-MIXED DTSBR403 -00588 MOVE L082-VOICE-1 TO WS-OPR-VOICE DTSBR403 -00589 MOVE L082-NAME TO L071-NAM DTSBR403 -00590 MOVE 2 TO L071-NAME-FORMAT DTSBR403 -00591 PERFORM S071-DESLASH-NAME THRU S071-EXIT DTSBR403 -00592 MOVE L071-NAM TO WS-OPR-NAME-MIXED DTSBR403 -00593 MOVE WS-OPR-NAME-MIXED TO L009-DATA DTSBR403 -00594 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT DTSBR403 -00595 MOVE L009-DATA TO WS-OPR-NAME-CAPS. DTSBR403 -00596 DTSBR403 -00597 MOVE WS-OPR-VOICE-AREA TO WS-FLD-VOICE-AREA. DTSBR403 -00598 MOVE WS-OPR-VOICE-1 TO WS-FLD-VOICE-1. DTSBR403 -00599 MOVE WS-OPR-VOICE-2 TO WS-FLD-VOICE-2. DTSBR403 -00600 MOVE WS-FLD-VOICE TO WS-FML-FLD-REP-PHONE DTSBR403 -00601 WS-LIEN-FLD-REP-PHONE. DTSBR403 -00602 MOVE WS-OPR-NAME-CAPS TO WS-FML-FLD-REP-NAME DTSBR403 -00603 WS-LIEN-FLD-REP-NAME. DTSBR403 -00604 MOVE WS-OPR-UNIT-NAME-MIXED TO L009-DATA. DTSBR403 -00605 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR403 -00606 MOVE L009-DATA TO WS-OPR-UNIT-NAME-CAPS. DTSBR403 -00607 DTSBR403 -00608 P3000-EXIT. DTSBR403 -00609 EXIT. DTSBR403 -00610 EJECT DTSBR403 -00611 DTSBR403 -00612 P4000-PRINT-FORM-DETAIL. DTSBR403 -00613 MOVE R403-FMT-LINE (1) TO WS-FMD-FMT-LINE-1. DTSBR403 -00614 MOVE R403-FMT-LINE (2) TO WS-FMD-FMT-LINE-2. DTSBR403 -00615 MOVE R403-FMT-LINE (3) TO WS-FMD-FMT-LINE-3. DTSBR403 -00616 MOVE R403-FMT-LINE (4) TO WS-FMD-FMT-LINE-4. DTSBR403 -00617 MOVE R403-FMT-LINE (5) TO WS-FMD-FMT-LINE-5. DTSBR403 -00618 MOVE R403-EMP-STATUS TO WS-FMD-EMP-STATUS. DTSBR403 -00619 MOVE WS-CERTIFICATE-NO TO WS-FMD-CERT-NO. DTSBR403 -00620 MOVE WS-CERT-DATE-SLASH TO WS-FMD-CERT-DATE-SLASH. DTSBR403 -00621 MOVE WS-EMPLOYER-NO TO WS-FMD-EMP-NO. DTSBR403 -00622 MOVE WS-COMP-DATE-SLASH TO WS-FMD-COMP-DATE-SLASH. DTSBR403 -00623 MOVE WS-LIEN-FORM-QTR-LINE (1) TO WS-LIEN-FORM-QTR-LINE-1. DTSBR403 -00624 PERFORM P6000-EVAL-QTR-DATA THRU P6000-EXIT. DTSBR403 -00625 MOVE WS-LIEN-FORM-TOTAL-DISPLAY TO WS-LIEN-FORM-TOTAL-DIS. DTSBR403 -00626 WRITE XEROX-REPORT FROM BLANK-LINE DTSBR403 -00627 AFTER ADVANCING TOP-OF-PAGE. DTSBR403 -00628 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 4 LINE. DTSBR403 -00629 WRITE XEROX-REPORT FROM FMD-LINE-6 AFTER ADVANCING 1 LINE. DTSBR403 -00630 WRITE XEROX-REPORT FROM FMD-LINE-7 AFTER ADVANCING 1 LINE. DTSBR403 -00631 WRITE XEROX-REPORT FROM FMD-LINE-8 AFTER ADVANCING 1 LINE. DTSBR403 -00632 WRITE XEROX-REPORT FROM FMD-LINE-9 AFTER ADVANCING 1 LINE. DTSBR403 -00633 WRITE XEROX-REPORT FROM FMD-LINE-10 AFTER ADVANCING 1 LINE. DTSBR403 -00634 WRITE XEROX-REPORT FROM FMD-LINE-11 AFTER ADVANCING 1 LINE. DTSBR403 -00635 WRITE XEROX-REPORT FROM FMD-LINE-12 AFTER ADVANCING 1 LINE. DTSBR403 -00636 WRITE XEROX-REPORT FROM FMD-LINE-13 AFTER ADVANCING 1 LINE. DTSBR403 -00637 WRITE XEROX-REPORT FROM FMD-LINE-14 AFTER ADVANCING 1 LINE. DTSBR403 -00638 WRITE XEROX-REPORT FROM FMD-LINE-15 AFTER ADVANCING 1 LINE. DTSBR403 -00639 WRITE XEROX-REPORT FROM FMD-LINE-16 AFTER ADVANCING 1 LINE. DTSBR403 -00640 WRITE XEROX-REPORT FROM FMD-LINE-17 AFTER ADVANCING 1 LINE. DTSBR403 -00641 WRITE XEROX-REPORT FROM FMD-LINE-18 AFTER ADVANCING 1 LINE. DTSBR403 -00642 WRITE XEROX-REPORT FROM FMD-LINE-19 AFTER ADVANCING 1 LINE. DTSBR403 -00643 WRITE XEROX-REPORT FROM FMD-LINE-20 AFTER ADVANCING 1 LINE. DTSBR403 -00644 WRITE XEROX-REPORT FROM FMD-LINE-21 AFTER ADVANCING 1 LINE. DTSBR403 -00645 WRITE XEROX-REPORT FROM FMD-LINE-22 AFTER ADVANCING 1 LINE. DTSBR403 -00646 WRITE XEROX-REPORT FROM FMD-LINE-23 AFTER ADVANCING 1 LINE. DTSBR403 -00647 WRITE XEROX-REPORT FROM FMD-LINE-24 AFTER ADVANCING 1 LINE. DTSBR403 -00648 WRITE XEROX-REPORT FROM FMD-LINE-25 AFTER ADVANCING 1 LINE. DTSBR403 -00649 WRITE XEROX-REPORT FROM FMD-LINE-26 AFTER ADVANCING 1 LINE. DTSBR403 -00650 WRITE XEROX-REPORT FROM FMD-LINE-27 AFTER ADVANCING 1 LINE. DTSBR403 -00651 WRITE XEROX-REPORT FROM FMD-LINE-28 AFTER ADVANCING 1 LINE. DTSBR403 -00652 WRITE XEROX-REPORT FROM FMD-LINE-29 AFTER ADVANCING 1 LINE. DTSBR403 -00653 WRITE XEROX-REPORT FROM FMD-LINE-30 AFTER ADVANCING 1 LINE. DTSBR403 -00654 WRITE XEROX-REPORT FROM FMD-LINE-31 AFTER ADVANCING 1 LINE. DTSBR403 -00655 WRITE XEROX-REPORT FROM FMD-LINE-32 AFTER ADVANCING 1 LINE. DTSBR403 -00656 WRITE XEROX-REPORT FROM FMD-LINE-33 AFTER ADVANCING 1 LINE. DTSBR403 -00657 WRITE XEROX-REPORT FROM FMD-LINE-34 AFTER ADVANCING 1 LINE. DTSBR403 -00658 WRITE XEROX-REPORT FROM FMD-LINE-35 AFTER ADVANCING 1 LINE. DTSBR403 -00659 WRITE XEROX-REPORT FROM FMD-LINE-36 AFTER ADVANCING 1 LINE. DTSBR403 -00660 WRITE XEROX-REPORT FROM FMD-LINE-37 AFTER ADVANCING 1 LINE. DTSBR403 -00661 WRITE XEROX-REPORT FROM FMD-LINE-57 AFTER ADVANCING 20 LINE. DTSBR403 -00662 WRITE XEROX-REPORT FROM FMD-LINE-58 AFTER ADVANCING 1 LINE. DTSBR403 -00663 MOVE SPACES TO FMD-LINE-18 FMD-LINE-19 FMD-LINE-20 DTSBR403 -00664 FMD-LINE-21 FMD-LINE-22 FMD-LINE-23 DTSBR403 -00665 FMD-LINE-24 FMD-LINE-25 FMD-LINE-26 DTSBR403 -00666 FMD-LINE-27 FMD-LINE-28 FMD-LINE-29 DTSBR403 -00667 FMD-LINE-30 FMD-LINE-31 FMD-LINE-32 DTSBR403 -00668 FMD-LINE-33 FMD-LINE-34 FMD-LINE-35 DTSBR403 -00669 FMD-LINE-36 FMD-LINE-37. DTSBR403 -00670 DTSBR403 -00671 P4000-EXIT. DTSBR403 -00672 EXIT. DTSBR403 -00673 DTSBR403 -00674 P5000-PRINT-FORM-LETTER. DTSBR403 -00675 MOVE R403-FMT-LINE (1) TO WS-FML-FMT-LINE-1. DTSBR403 -00676 MOVE R403-FMT-LINE (2) TO WS-FML-FMT-LINE-2. DTSBR403 -00677 MOVE R403-FMT-LINE (3) TO WS-FML-FMT-LINE-3. DTSBR403 -00678 MOVE R403-FMT-LINE (4) TO WS-FML-FMT-LINE-4. DTSBR403 -00679 MOVE R403-FMT-LINE (5) TO WS-FML-FMT-LINE-5. DTSBR403 -00680 DTSBR403 -00681 IF R403-EMP-STATUS-ACTIVE-88 DTSBR403 -00682 MOVE 'ACTIVE ' TO WS-FML-EMP-STATUS DTSBR403 -00683 ELSE DTSBR403 -00684 MOVE 'INACTIVE ' TO WS-FML-EMP-STATUS. DTSBR403 -00685 DTSBR403 -00686 MOVE WS-EMPLOYER-NO TO WS-FML-EMP-NO. DTSBR403 -00687 WRITE XEROX-REPORT FROM BLANK-LINE AFTER DTSBR403 -00688 ADVANCING TOP-OF-PAGE. DTSBR403 -00689 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 9 LINE. DTSBR403 -00690 WRITE XEROX-REPORT FROM FML-LINE-8 AFTER ADVANCING 1 LINE. DTSBR403 -00691 WRITE XEROX-REPORT FROM FML-LINE-9 AFTER ADVANCING 1 LINE. DTSBR403 -00692 WRITE XEROX-REPORT FROM FML-LINE-10 AFTER ADVANCING 1 LINE. DTSBR403 -00693 WRITE XEROX-REPORT FROM FML-LINE-11 AFTER ADVANCING 1 LINE. DTSBR403 -00694 WRITE XEROX-REPORT FROM FML-LINE-12 AFTER ADVANCING 1 LINE. DTSBR403 -00695 WRITE XEROX-REPORT FROM FML-LINE-55 AFTER ADVANCING 40 LINE. DTSBR403 +00457 MOVE R403-CERTIFICATE-NO TO WS-CERTIFICATE-NO. DTSBR403 +00458 MOVE R403-CERTIFICATE-DATE TO L001-FED-8-DATE-9. DTSBR403 +00459 SET L001-FROM-FED-8 TO TRUE. DTSBR403 +00460 PERFORM S001-DATE THRU S001-EXIT. DTSBR403 +00461 IF L001-VALID-DATE DTSBR403 +00462 MOVE L001-SLASH-8-DATE TO WS-CERT-DATE-SLASH DTSBR403 +00463 ELSE DTSBR403 +00464 MOVE SPACES TO WS-CERT-DATE-SLASH. DTSBR403 +00465 DTSBR403 +00466 MOVE R403-LETTER-TOTAL-AMT TO WS-TOTAL-AMT-EDIT-R. DTSBR403 +00467 MOVE +0 TO WS-TOTAL-AMT-FIRST-CHAR. DTSBR403 +00468 INSPECT WS-TOTAL-AMT-EDIT DTSBR403 +00469 TALLYING WS-TOTAL-AMT-FIRST-CHAR DTSBR403 +00470 FOR LEADING SPACES. DTSBR403 +00471 SUBTRACT WS-TOTAL-AMT-FIRST-CHAR FROM 14 DTSBR403 +00472 GIVING WS-TOTAL-AMT-LENGTH. DTSBR403 +00473 ADD +1 TO WS-TOTAL-AMT-FIRST-CHAR. DTSBR403 +00474 MOVE SPACES TO WS-TOTAL-AMT-STRING. DTSBR403 +00475 STRING WS-TOTAL-AMT-EDIT DTSBR403 +00476 (WS-TOTAL-AMT-FIRST-CHAR:WS-TOTAL-AMT-LENGTH) DTSBR403 +00477 DELIMITED BY SIZE DTSBR403 +00478 '.' DELIMITED BY SIZE DTSBR403 +00479 INTO DTSBR403 +00480 WS-TOTAL-AMT-STRING. DTSBR403 +00481 DTSBR403 +00482 PERFORM P2000-LIEN-FORM-PROCESS THRU P2000-EXIT. DTSBR403 +00483 DTSBR403 +00484 P1000-EXIT. DTSBR403 +00485 EXIT. DTSBR403 +00486 EJECT DTSBR403 +00487 P2000-LIEN-FORM-PROCESS. DTSBR403 +00488 DTSBR403 +00489 DIVIDE R403-FORM-QTR-CNT BY 20 GIVING WS-FORM-TOTAL-PAGES DTSBR403 +00490 REMAINDER WS-FORM-QTR-LEFTOVER-CNT. DTSBR403 +00491 IF WS-FORM-QTR-LEFTOVER-CNT > +0 DTSBR403 +00492 ADD +1 TO WS-FORM-TOTAL-PAGES. DTSBR403 +00493 MOVE +0 TO WS-PAGE-OCCUR-CNT DTSBR403 +00494 WS-FORM-PAGE. DTSBR403 +00495 MOVE SPACES TO WS-LIEN-FORM-QTR-LINE-TBL. DTSBR403 +00496 MOVE ZEROES TO WS-TOTAL-TAX-BALANCE-AMT DTSBR403 +00497 WS-TOTAL-SUR-TAX-BALANCE-AMT DTSBR403 +00498 WS-TOTAL-INT-BALANCE-AMT DTSBR403 +00499 WS-TOTAL-LP-NP-MP-BALANCE DTSBR403 +00500 WS-TOTAL-TOTAL-LIEN-AMT. DTSBR403 +00501 PERFORM P2100-PROCESS-FORM-QTR THRU P2100-EXIT DTSBR403 +00502 VARYING R403-FORM-QTR-IDX FROM +1 BY +1 DTSBR403 +00503 UNTIL R403-FORM-QTR-IDX > R403-FORM-QTR-CNT. DTSBR403 +00504 INITIALIZE WS-LIEN-FORM-TOTAL-DISPLAY. DTSBR403 +00505 * MOVE 'TOTAL ON QTRS ' TO T-FORM-TOTAL-DESCRIPTION. DTSBR403 +00506 MOVE SPACES TO T-FORM-TOTAL-DESCRIPTION. DTSBR403 +00507 MOVE WS-TOTAL-TAX-BALANCE-AMT TO T-FORM-TAX-BALANCE-AMT. DTSBR403 +00508 MOVE WS-TOTAL-SUR-TAX-BALANCE-AMT TO DTSBR403 +00509 T-FORM-SUR-TAX-BALANCE-AMT. DTSBR403 +00510 MOVE WS-TOTAL-INT-BALANCE-AMT TO T-FORM-INT-BALANCE-AMT. DTSBR403 +00511 MOVE WS-TOTAL-LP-NP-MP-BALANCE TO DTSBR403 +00512 T-FORM-LP-NP-MP-BALANCE-AMT. DTSBR403 +00513 MOVE WS-TOTAL-TOTAL-LIEN-AMT TO T-FORM-TOTAL-LIEN-AMT. DTSBR403 +00514 ADD +1 TO WS-FORM-PAGE. DTSBR403 +00515 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT. DTSBR403 +00516 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT. DTSBR403 +00517 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT. DTSBR403 +00518 PERFORM P5000-PRINT-FORM-LETTER THRU P5000-EXIT. DTSBR403 +00519 DTSBR403 +00520 P2000-EXIT. DTSBR403 +00521 EXIT. DTSBR403 +00522 EJECT DTSBR403 +00523 P2100-PROCESS-FORM-QTR. DTSBR403 +00524 DTSBR403 +00525 ADD +1 TO WS-PAGE-OCCUR-CNT. DTSBR403 +00526 PERFORM P2105-PICKUP-YRQ THRU P2105-EXIT. DTSBR403 +00527 MOVE R403-FORM-LEGAL-IND (R403-FORM-QTR-IDX) DTSBR403 +00528 TO WS-LEGAL-IND (WS-PAGE-OCCUR-CNT). DTSBR403 +00529 MOVE R403-FORM-ESTIMATED-IND (R403-FORM-QTR-IDX) DTSBR403 +00530 TO WS-ESTIMATED-TAX-IND (WS-PAGE-OCCUR-CNT). DTSBR403 +00531 MOVE R403-FORM-UNUSED-IND (R403-FORM-QTR-IDX) DTSBR403 +00532 TO WS-UNUSED-IND (WS-PAGE-OCCUR-CNT). DTSBR403 +00533 MOVE R403-FORM-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 +00534 TO WS-FORM-TAX-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 +00535 MOVE R403-FORM-SUR-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 +00536 TO WS-FORM-SUR-TAX-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 +00537 MOVE R403-FORM-INT-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 +00538 TO WS-FORM-INT-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 +00539 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT (R403-FORM-QTR-IDX) DTSBR403 +00540 TO WS-FORM-LP-NP-MP-BALANCE-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 +00541 MOVE ZEROS TO WS-TOTAL-LIEN-AMT. DTSBR403 +00542 COMPUTE WS-TOTAL-LIEN-AMT = DTSBR403 +00543 R403-FORM-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) + DTSBR403 +00544 R403-FORM-SUR-TAX-BALANCE-AMT (R403-FORM-QTR-IDX) + DTSBR403 +00545 R403-FORM-INT-BALANCE-AMT (R403-FORM-QTR-IDX) + DTSBR403 +00546 R403-FORM-LP-NP-MP-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 +00547 MOVE WS-TOTAL-LIEN-AMT DTSBR403 +00548 TO WS-FORM-TOTAL-LIEN-AMT (WS-PAGE-OCCUR-CNT). DTSBR403 +00549 COMPUTE WS-TOTAL-TAX-BALANCE-AMT = WS-TOTAL-TAX-BALANCE-AMT +DTSBR403 +00550 R403-FORM-TAX-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 +00551 COMPUTE WS-TOTAL-SUR-TAX-BALANCE-AMT = DTSBR403 +00552 WS-TOTAL-SUR-TAX-BALANCE-AMT + DTSBR403 +00553 R403-FORM-SUR-TAX-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 +00554 COMPUTE WS-TOTAL-INT-BALANCE-AMT = WS-TOTAL-INT-BALANCE-AMT +DTSBR403 +00555 R403-FORM-INT-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 +00556 COMPUTE WS-TOTAL-LP-NP-MP-BALANCE = WS-TOTAL-LP-NP-MP-BALANCEDTSBR403 +00557 + R403-FORM-LP-NP-MP-BALANCE-AMT (R403-FORM-QTR-IDX). DTSBR403 +00558 COMPUTE WS-TOTAL-TOTAL-LIEN-AMT = WS-TOTAL-TOTAL-LIEN-AMT + DTSBR403 +00559 WS-TOTAL-LIEN-AMT. DTSBR403 +00560 IF WS-PAGE-OCCUR-CNT = +20 DTSBR403 +00561 IF R403-FORM-QTR-IDX = R403-FORM-QTR-CNT DTSBR403 +00562 GO TO P2100-EXIT DTSBR403 +00563 ELSE DTSBR403 +00564 ADD +1 TO WS-FORM-PAGE DTSBR403 +00565 PERFORM P4000-PRINT-FORM-DETAIL THRU P4000-EXIT DTSBR403 +00566 MOVE +0 TO WS-PAGE-OCCUR-CNT DTSBR403 +00567 MOVE SPACES TO WS-LIEN-FORM-QTR-LINE-TBL. DTSBR403 +00568 DTSBR403 +00569 P2100-EXIT. DTSBR403 +00570 EXIT. DTSBR403 +00571 DTSBR403 +00572 P2105-PICKUP-YRQ. DTSBR403 +00573 IF LRCM-PICKUP-YRQ = R403-FORM-QTR (R403-FORM-QTR-IDX) DTSBR403 +00574 MOVE 'PU ' TO WS-QTR-END-DATE-SLASH (WS-PAGE-OCCUR-CNT) DTSBR403 +00575 ELSE DTSBR403 +00576 MOVE R403-FORM-QTR (R403-FORM-QTR-IDX) TO L004-QTR-5-9 DTSBR403 +00577 SET L004-FROM-5 TO TRUE DTSBR403 +00578 PERFORM S004-CONVERT-QTR THRU S004-EXIT DTSBR403 +00579 MOVE L004-SLASH-QTR DTSBR403 +00580 TO WS-QTR-END-DATE-SLASH (WS-PAGE-OCCUR-CNT) DTSBR403 +00581 MOVE SPACE TO WS-SLASH-ONLY (WS-PAGE-OCCUR-CNT) DTSBR403 +00582 END-IF. DTSBR403 +00583 P2105-EXIT. DTSBR403 +00584 EXIT. DTSBR403 +00585 EJECT DTSBR403 +00586 P3000-OPERATOR-LOOKUP. DTSBR403 +00587 DTSBR403 +00588 MOVE R403-OP-ID TO L082-OP-ID. DTSBR403 +00589 PERFORM S082-OP-ID-INFO THRU S082-EXIT. DTSBR403 +00590 IF L082-NOT-VALID-OP OR L082-INTERNAL-88 DTSBR403 +00591 MOVE SPACES TO WS-OPR-NAME-MIXED DTSBR403 +00592 WS-OPR-NAME-CAPS DTSBR403 +00593 MOVE LRCM-DEFAULT-NAME TO WS-OPR-UNIT-NAME-MIXED DTSBR403 +00594 MOVE LRCM-DEFAULT-VOICE TO WS-OPR-VOICE DTSBR403 +00595 ELSE DTSBR403 +00596 MOVE L082-UNIT-NAME TO WS-OPR-UNIT-NAME-MIXED DTSBR403 +00597 MOVE L082-VOICE-1 TO WS-OPR-VOICE DTSBR403 +00598 MOVE L082-NAME TO L071-NAM DTSBR403 +00599 MOVE 2 TO L071-NAME-FORMAT DTSBR403 +00600 PERFORM S071-DESLASH-NAME THRU S071-EXIT DTSBR403 +00601 MOVE L071-NAM TO WS-OPR-NAME-MIXED DTSBR403 +00602 MOVE WS-OPR-NAME-MIXED TO L009-DATA DTSBR403 +00603 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT DTSBR403 +00604 MOVE L009-DATA TO WS-OPR-NAME-CAPS. DTSBR403 +00605 DTSBR403 +00606 MOVE WS-OPR-VOICE-AREA TO WS-FLD-VOICE-AREA. DTSBR403 +00607 MOVE WS-OPR-VOICE-1 TO WS-FLD-VOICE-1. DTSBR403 +00608 MOVE WS-OPR-VOICE-2 TO WS-FLD-VOICE-2. DTSBR403 +00609 * MOVE WS-FLD-VOICE TO WS-FML-FLD-REP-PHONE CL*11 +00610 * WS-LIEN-FLD-REP-PHONE. CL*11 +00611 * MOVE WS-OPR-NAME-CAPS TO WS-FML-FLD-REP-NAME CL*11 +00612 * WS-LIEN-FLD-REP-NAME. CL*11 +00613 MOVE WS-OPR-UNIT-NAME-MIXED TO L009-DATA. DTSBR403 +00614 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR403 +00615 MOVE L009-DATA TO WS-OPR-UNIT-NAME-CAPS. CL**5 +00616 DTSBR403 +00617 P3000-EXIT. DTSBR403 +00618 EXIT. DTSBR403 +00619 EJECT DTSBR403 +00620 DTSBR403 +00621 P4000-PRINT-FORM-DETAIL. DTSBR403 +00622 MOVE R403-FMT-LINE (1) TO WS-FMD-FMT-LINE-1. DTSBR403 +00623 MOVE R403-FMT-LINE (2) TO WS-FMD-FMT-LINE-2. DTSBR403 +00624 MOVE R403-FMT-LINE (3) TO WS-FMD-FMT-LINE-3. DTSBR403 +00625 MOVE R403-FMT-LINE (4) TO WS-FMD-FMT-LINE-4. DTSBR403 +00626 MOVE R403-FMT-LINE (5) TO WS-FMD-FMT-LINE-5. DTSBR403 +00627 MOVE R403-EMP-STATUS TO WS-FMD-EMP-STATUS. DTSBR403 +00628 MOVE WS-CERTIFICATE-NO TO WS-FMD-CERT-NO. DTSBR403 +00629 MOVE WS-CERT-DATE-SLASH TO WS-FMD-CERT-DATE-SLASH. DTSBR403 +00630 MOVE WS-EMPLOYER-NO TO WS-FMD-EMP-NO. DTSBR403 +00631 MOVE WS-COMP-DATE-SLASH TO WS-FMD-COMP-DATE-SLASH. DTSBR403 +00632 MOVE WS-LIEN-FORM-QTR-LINE (1) TO WS-LIEN-FORM-QTR-LINE-1. DTSBR403 +00633 PERFORM P6000-EVAL-QTR-DATA THRU P6000-EXIT. DTSBR403 +00634 MOVE WS-LIEN-FORM-TOTAL-DISPLAY TO WS-LIEN-FORM-TOTAL-DIS. DTSBR403 +00635 WRITE XEROX-REPORT FROM BLANK-LINE DTSBR403 +00636 AFTER ADVANCING TOP-OF-PAGE. DTSBR403 +00637 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 4 LINE. DTSBR403 +00638 WRITE XEROX-REPORT FROM FMD-LINE-6 AFTER ADVANCING 1 LINE. DTSBR403 +00639 WRITE XEROX-REPORT FROM FMD-LINE-7 AFTER ADVANCING 1 LINE. DTSBR403 +00640 WRITE XEROX-REPORT FROM FMD-LINE-8 AFTER ADVANCING 1 LINE. DTSBR403 +00641 WRITE XEROX-REPORT FROM FMD-LINE-9 AFTER ADVANCING 1 LINE. DTSBR403 +00642 WRITE XEROX-REPORT FROM FMD-LINE-10 AFTER ADVANCING 1 LINE. DTSBR403 +00643 WRITE XEROX-REPORT FROM FMD-LINE-11 AFTER ADVANCING 1 LINE. DTSBR403 +00644 WRITE XEROX-REPORT FROM FMD-LINE-12 AFTER ADVANCING 1 LINE. DTSBR403 +00645 WRITE XEROX-REPORT FROM FMD-LINE-13 AFTER ADVANCING 1 LINE. DTSBR403 +00646 WRITE XEROX-REPORT FROM FMD-LINE-14 AFTER ADVANCING 1 LINE. DTSBR403 +00647 WRITE XEROX-REPORT FROM FMD-LINE-15 AFTER ADVANCING 1 LINE. DTSBR403 +00648 WRITE XEROX-REPORT FROM FMD-LINE-16 AFTER ADVANCING 1 LINE. DTSBR403 +00649 WRITE XEROX-REPORT FROM FMD-LINE-17 AFTER ADVANCING 1 LINE. DTSBR403 +00650 WRITE XEROX-REPORT FROM FMD-LINE-18 AFTER ADVANCING 1 LINE. DTSBR403 +00651 WRITE XEROX-REPORT FROM FMD-LINE-19 AFTER ADVANCING 1 LINE. DTSBR403 +00652 WRITE XEROX-REPORT FROM FMD-LINE-20 AFTER ADVANCING 1 LINE. DTSBR403 +00653 WRITE XEROX-REPORT FROM FMD-LINE-21 AFTER ADVANCING 1 LINE. DTSBR403 +00654 WRITE XEROX-REPORT FROM FMD-LINE-22 AFTER ADVANCING 1 LINE. DTSBR403 +00655 WRITE XEROX-REPORT FROM FMD-LINE-23 AFTER ADVANCING 1 LINE. DTSBR403 +00656 WRITE XEROX-REPORT FROM FMD-LINE-24 AFTER ADVANCING 1 LINE. DTSBR403 +00657 WRITE XEROX-REPORT FROM FMD-LINE-25 AFTER ADVANCING 1 LINE. DTSBR403 +00658 WRITE XEROX-REPORT FROM FMD-LINE-26 AFTER ADVANCING 1 LINE. DTSBR403 +00659 WRITE XEROX-REPORT FROM FMD-LINE-27 AFTER ADVANCING 1 LINE. DTSBR403 +00660 WRITE XEROX-REPORT FROM FMD-LINE-28 AFTER ADVANCING 1 LINE. DTSBR403 +00661 WRITE XEROX-REPORT FROM FMD-LINE-29 AFTER ADVANCING 1 LINE. DTSBR403 +00662 WRITE XEROX-REPORT FROM FMD-LINE-30 AFTER ADVANCING 1 LINE. DTSBR403 +00663 WRITE XEROX-REPORT FROM FMD-LINE-31 AFTER ADVANCING 1 LINE. DTSBR403 +00664 WRITE XEROX-REPORT FROM FMD-LINE-32 AFTER ADVANCING 1 LINE. DTSBR403 +00665 WRITE XEROX-REPORT FROM FMD-LINE-33 AFTER ADVANCING 1 LINE. DTSBR403 +00666 WRITE XEROX-REPORT FROM FMD-LINE-34 AFTER ADVANCING 1 LINE. DTSBR403 +00667 WRITE XEROX-REPORT FROM FMD-LINE-35 AFTER ADVANCING 1 LINE. DTSBR403 +00668 WRITE XEROX-REPORT FROM FMD-LINE-36 AFTER ADVANCING 1 LINE. DTSBR403 +00669 WRITE XEROX-REPORT FROM FMD-LINE-37 AFTER ADVANCING 1 LINE. DTSBR403 +00670 WRITE XEROX-REPORT FROM FMD-LINE-57 AFTER ADVANCING 20 LINE. CL*10 +00671 WRITE XEROX-REPORT FROM FMD-LINE-58 AFTER ADVANCING 1 LINE. CL*10 +00672 * WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 20 LINE. CL*10 +00673 * WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 1 LINE. CL*10 +00674 MOVE SPACES TO FMD-LINE-18 FMD-LINE-19 FMD-LINE-20 DTSBR403 +00675 FMD-LINE-21 FMD-LINE-22 FMD-LINE-23 DTSBR403 +00676 FMD-LINE-24 FMD-LINE-25 FMD-LINE-26 DTSBR403 +00677 FMD-LINE-27 FMD-LINE-28 FMD-LINE-29 DTSBR403 +00678 FMD-LINE-30 FMD-LINE-31 FMD-LINE-32 DTSBR403 +00679 FMD-LINE-33 FMD-LINE-34 FMD-LINE-35 DTSBR403 +00680 FMD-LINE-36 FMD-LINE-37. DTSBR403 +00681 DTSBR403 +00682 P4000-EXIT. DTSBR403 +00683 EXIT. DTSBR403 +00684 DTSBR403 +00685 P5000-PRINT-FORM-LETTER. DTSBR403 +00686 MOVE R403-FMT-LINE (1) TO WS-FML-FMT-LINE-1. DTSBR403 +00687 MOVE R403-FMT-LINE (2) TO WS-FML-FMT-LINE-2. DTSBR403 +00688 MOVE R403-FMT-LINE (3) TO WS-FML-FMT-LINE-3. DTSBR403 +00689 MOVE R403-FMT-LINE (4) TO WS-FML-FMT-LINE-4. DTSBR403 +00690 MOVE R403-FMT-LINE (5) TO WS-FML-FMT-LINE-5. DTSBR403 +00691 DTSBR403 +00692 IF R403-EMP-STATUS-ACTIVE-88 DTSBR403 +00693 MOVE 'ACTIVE ' TO WS-FML-EMP-STATUS DTSBR403 +00694 ELSE DTSBR403 +00695 MOVE 'INACTIVE ' TO WS-FML-EMP-STATUS. DTSBR403 00696 DTSBR403 -00697 P5000-EXIT. DTSBR403 -00698 EXIT. DTSBR403 -00699 DTSBR403 -00700 P6000-EVAL-QTR-DATA. DTSBR403 -00701 DTSBR403 -00702 IF R403-FORM-QTR-CNT > 1 DTSBR403 -00703 MOVE WS-LIEN-FORM-QTR-LINE (2) TO WS-LIEN-FORM-QTR-LINE-2. DTSBR403 -00704 IF R403-FORM-QTR-CNT > 2 DTSBR403 -00705 MOVE WS-LIEN-FORM-QTR-LINE (3) TO WS-LIEN-FORM-QTR-LINE-3. DTSBR403 -00706 IF R403-FORM-QTR-CNT > 3 DTSBR403 -00707 MOVE WS-LIEN-FORM-QTR-LINE (4) TO WS-LIEN-FORM-QTR-LINE-4. DTSBR403 -00708 IF R403-FORM-QTR-CNT > 4 DTSBR403 -00709 MOVE WS-LIEN-FORM-QTR-LINE (5) TO WS-LIEN-FORM-QTR-LINE-5. DTSBR403 -00710 IF R403-FORM-QTR-CNT > 5 DTSBR403 -00711 MOVE WS-LIEN-FORM-QTR-LINE (6) TO WS-LIEN-FORM-QTR-LINE-6. DTSBR403 -00712 IF R403-FORM-QTR-CNT > 6 DTSBR403 -00713 MOVE WS-LIEN-FORM-QTR-LINE (7) TO WS-LIEN-FORM-QTR-LINE-7. DTSBR403 -00714 IF R403-FORM-QTR-CNT > 7 DTSBR403 -00715 MOVE WS-LIEN-FORM-QTR-LINE (8) TO WS-LIEN-FORM-QTR-LINE-8. DTSBR403 -00716 IF R403-FORM-QTR-CNT > 8 DTSBR403 -00717 MOVE WS-LIEN-FORM-QTR-LINE (9) TO WS-LIEN-FORM-QTR-LINE-9. DTSBR403 -00718 IF R403-FORM-QTR-CNT > 9 DTSBR403 -00719 MOVE WS-LIEN-FORM-QTR-LINE (10) TO WS-LIEN-FORM-QTR-LINE-10.DTSBR403 -00720 IF R403-FORM-QTR-CNT > 10 DTSBR403 -00721 MOVE WS-LIEN-FORM-QTR-LINE (11) TO WS-LIEN-FORM-QTR-LINE-11.DTSBR403 -00722 IF R403-FORM-QTR-CNT > 11 DTSBR403 -00723 MOVE WS-LIEN-FORM-QTR-LINE (12) TO WS-LIEN-FORM-QTR-LINE-12.DTSBR403 -00724 IF R403-FORM-QTR-CNT > 12 DTSBR403 -00725 MOVE WS-LIEN-FORM-QTR-LINE (13) TO WS-LIEN-FORM-QTR-LINE-13.DTSBR403 -00726 IF R403-FORM-QTR-CNT > 13 DTSBR403 -00727 MOVE WS-LIEN-FORM-QTR-LINE (14) TO WS-LIEN-FORM-QTR-LINE-14.DTSBR403 -00728 IF R403-FORM-QTR-CNT > 14 DTSBR403 -00729 MOVE WS-LIEN-FORM-QTR-LINE (15) TO WS-LIEN-FORM-QTR-LINE-15.DTSBR403 -00730 IF R403-FORM-QTR-CNT > 15 DTSBR403 -00731 MOVE WS-LIEN-FORM-QTR-LINE (16) TO WS-LIEN-FORM-QTR-LINE-16.DTSBR403 -00732 IF R403-FORM-QTR-CNT > 16 DTSBR403 -00733 MOVE WS-LIEN-FORM-QTR-LINE (17) TO WS-LIEN-FORM-QTR-LINE-17.DTSBR403 -00734 IF R403-FORM-QTR-CNT > 17 DTSBR403 -00735 MOVE WS-LIEN-FORM-QTR-LINE (18) TO WS-LIEN-FORM-QTR-LINE-18.DTSBR403 -00736 IF R403-FORM-QTR-CNT > 18 DTSBR403 -00737 MOVE WS-LIEN-FORM-QTR-LINE (19) TO WS-LIEN-FORM-QTR-LINE-19.DTSBR403 -00738 * IF R403-FORM-QTR-CNT > 19 DTSBR403 -00739 * MOVE WS-LIEN-FORM-QTR-LINE (20) TO WS-LIEN-FORM-QTR-LINE-20.DTSBR403 -00740 DTSBR403 -00741 P6000-EXIT. DTSBR403 -00742 EXIT. DTSBR403 -00743 DTSBR403 -00744 T1000-TERMINATE. DTSBR403 -00745 SKIP1 DTSBR403 -00746 CLOSE PRT-FILE1. DTSBR403 -00747 SKIP2 DTSBR403 -00748 T1000-EXIT. DTSBR403 -00749 EXIT. DTSBR403 -00750 EJECT DTSBR403 -00751 S001-DATE. DTSBR403 +00697 MOVE WS-EMPLOYER-NO TO WS-FML-EMP-NO. DTSBR403 +00698 WRITE XEROX-REPORT FROM BLANK-LINE AFTER DTSBR403 +00699 ADVANCING TOP-OF-PAGE. DTSBR403 +00700 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 9 LINE. DTSBR403 +00701 WRITE XEROX-REPORT FROM FML-LINE-8 AFTER ADVANCING 1 LINE. DTSBR403 +00702 WRITE XEROX-REPORT FROM FML-LINE-9 AFTER ADVANCING 1 LINE. DTSBR403 +00703 WRITE XEROX-REPORT FROM FML-LINE-10 AFTER ADVANCING 1 LINE. DTSBR403 +00704 WRITE XEROX-REPORT FROM FML-LINE-11 AFTER ADVANCING 1 LINE. DTSBR403 +00705 WRITE XEROX-REPORT FROM FML-LINE-12 AFTER ADVANCING 1 LINE. DTSBR403 +00706 WRITE XEROX-REPORT FROM FML-LINE-55 AFTER ADVANCING 40 LINE. CL*10 +00707 * WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 40 LINE. CL*10 +00708 DTSBR403 +00709 P5000-EXIT. DTSBR403 +00710 EXIT. DTSBR403 +00711 DTSBR403 +00712 P6000-EVAL-QTR-DATA. DTSBR403 +00713 DTSBR403 +00714 IF R403-FORM-QTR-CNT > 1 DTSBR403 +00715 MOVE WS-LIEN-FORM-QTR-LINE (2) TO WS-LIEN-FORM-QTR-LINE-2. DTSBR403 +00716 IF R403-FORM-QTR-CNT > 2 DTSBR403 +00717 MOVE WS-LIEN-FORM-QTR-LINE (3) TO WS-LIEN-FORM-QTR-LINE-3. DTSBR403 +00718 IF R403-FORM-QTR-CNT > 3 DTSBR403 +00719 MOVE WS-LIEN-FORM-QTR-LINE (4) TO WS-LIEN-FORM-QTR-LINE-4. DTSBR403 +00720 IF R403-FORM-QTR-CNT > 4 DTSBR403 +00721 MOVE WS-LIEN-FORM-QTR-LINE (5) TO WS-LIEN-FORM-QTR-LINE-5. DTSBR403 +00722 IF R403-FORM-QTR-CNT > 5 DTSBR403 +00723 MOVE WS-LIEN-FORM-QTR-LINE (6) TO WS-LIEN-FORM-QTR-LINE-6. DTSBR403 +00724 IF R403-FORM-QTR-CNT > 6 DTSBR403 +00725 MOVE WS-LIEN-FORM-QTR-LINE (7) TO WS-LIEN-FORM-QTR-LINE-7. DTSBR403 +00726 IF R403-FORM-QTR-CNT > 7 DTSBR403 +00727 MOVE WS-LIEN-FORM-QTR-LINE (8) TO WS-LIEN-FORM-QTR-LINE-8. DTSBR403 +00728 IF R403-FORM-QTR-CNT > 8 DTSBR403 +00729 MOVE WS-LIEN-FORM-QTR-LINE (9) TO WS-LIEN-FORM-QTR-LINE-9. DTSBR403 +00730 IF R403-FORM-QTR-CNT > 9 DTSBR403 +00731 MOVE WS-LIEN-FORM-QTR-LINE (10) TO WS-LIEN-FORM-QTR-LINE-10.DTSBR403 +00732 IF R403-FORM-QTR-CNT > 10 DTSBR403 +00733 MOVE WS-LIEN-FORM-QTR-LINE (11) TO WS-LIEN-FORM-QTR-LINE-11.DTSBR403 +00734 IF R403-FORM-QTR-CNT > 11 DTSBR403 +00735 MOVE WS-LIEN-FORM-QTR-LINE (12) TO WS-LIEN-FORM-QTR-LINE-12.DTSBR403 +00736 IF R403-FORM-QTR-CNT > 12 DTSBR403 +00737 MOVE WS-LIEN-FORM-QTR-LINE (13) TO WS-LIEN-FORM-QTR-LINE-13.DTSBR403 +00738 IF R403-FORM-QTR-CNT > 13 DTSBR403 +00739 MOVE WS-LIEN-FORM-QTR-LINE (14) TO WS-LIEN-FORM-QTR-LINE-14.DTSBR403 +00740 IF R403-FORM-QTR-CNT > 14 DTSBR403 +00741 MOVE WS-LIEN-FORM-QTR-LINE (15) TO WS-LIEN-FORM-QTR-LINE-15.DTSBR403 +00742 IF R403-FORM-QTR-CNT > 15 DTSBR403 +00743 MOVE WS-LIEN-FORM-QTR-LINE (16) TO WS-LIEN-FORM-QTR-LINE-16.DTSBR403 +00744 IF R403-FORM-QTR-CNT > 16 DTSBR403 +00745 MOVE WS-LIEN-FORM-QTR-LINE (17) TO WS-LIEN-FORM-QTR-LINE-17.DTSBR403 +00746 IF R403-FORM-QTR-CNT > 17 DTSBR403 +00747 MOVE WS-LIEN-FORM-QTR-LINE (18) TO WS-LIEN-FORM-QTR-LINE-18.DTSBR403 +00748 IF R403-FORM-QTR-CNT > 18 DTSBR403 +00749 MOVE WS-LIEN-FORM-QTR-LINE (19) TO WS-LIEN-FORM-QTR-LINE-19.DTSBR403 +00750 * IF R403-FORM-QTR-CNT > 19 DTSBR403 +00751 * MOVE WS-LIEN-FORM-QTR-LINE (20) TO WS-LIEN-FORM-QTR-LINE-20.DTSBR403 00752 DTSBR403 -00753 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR403 -00754 DTSBR403 -00755 S001-EXIT. DTSBR403 -00756 EXIT. DTSBR403 -00757 DTSBR403 -00758 S002-DATE. DTSBR403 -00759 DTSBR403 -00760 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR403 -00761 DTSBR403 -00762 S002-EXIT. DTSBR403 -00763 EXIT. DTSBR403 +00753 P6000-EXIT. DTSBR403 +00754 EXIT. DTSBR403 +00755 DTSBR403 +00756 T1000-TERMINATE. DTSBR403 +00757 SKIP1 DTSBR403 +00758 CLOSE PRT-FILE1. DTSBR403 +00759 SKIP2 DTSBR403 +00760 T1000-EXIT. DTSBR403 +00761 EXIT. DTSBR403 +00762 EJECT DTSBR403 +00763 S001-DATE. DTSBR403 00764 DTSBR403 -00765 S004-CONVERT-QTR. DTSBR403 +00765 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR403 00766 DTSBR403 -00767 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR403 -00768 DTSBR403 -00769 S004-EXIT. DTSBR403 -00770 EXIT. DTSBR403 +00767 S001-EXIT. DTSBR403 +00768 EXIT. DTSBR403 +00769 DTSBR403 +00770 S002-DATE. DTSBR403 00771 DTSBR403 -00772 S009-CONVERT-TO-CAPS. DTSBR403 +00772 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR403 00773 DTSBR403 -00774 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR403 -00775 DTSBR403 -00776 S009-EXIT. DTSBR403 -00777 EXIT. DTSBR403 +00774 S002-EXIT. DTSBR403 +00775 EXIT. DTSBR403 +00776 DTSBR403 +00777 S004-CONVERT-QTR. DTSBR403 00778 DTSBR403 -00779 S071-DESLASH-NAME. DTSBR403 +00779 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR403 00780 DTSBR403 -00781 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR403 -00782 DTSBR403 -00783 S071-EXIT. DTSBR403 -00784 EXIT. DTSBR403 +00781 S004-EXIT. DTSBR403 +00782 EXIT. DTSBR403 +00783 DTSBR403 +00784 S009-CONVERT-TO-CAPS. DTSBR403 00785 DTSBR403 -00786 S082-OP-ID-INFO. DTSBR403 +00786 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR403 00787 DTSBR403 -00788 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR403 -00789 DTSBR403 -00790 S082-EXIT. DTSBR403 -00791 EXIT. DTSBR403 +00788 S009-EXIT. DTSBR403 +00789 EXIT. DTSBR403 +00790 DTSBR403 +00791 S071-DESLASH-NAME. DTSBR403 00792 DTSBR403 -00793 S119-AGENCY-FACTS. DTSBR403 +00793 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR403 00794 DTSBR403 -00795 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR403 -00796 DTSBR403 -00797 S119-EXIT. DTSBR403 -00798 EXIT. DTSBR403 +00795 S071-EXIT. DTSBR403 +00796 EXIT. DTSBR403 +00797 DTSBR403 +00798 S082-OP-ID-INFO. DTSBR403 00799 DTSBR403 -00800 *S999-ABEND. DTSBR403 -00801 * DTSBR403 -00802 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR403 -00803 * DTSBR403 -00804 *S999-EXIT. DTSBR403 -00805 * EXIT. DTSBR403 +00800 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR403 +00801 DTSBR403 +00802 S082-EXIT. DTSBR403 +00803 EXIT. DTSBR403 +00804 DTSBR403 +00805 S119-AGENCY-FACTS. DTSBR403 00806 DTSBR403 +00807 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR403 +00808 DTSBR403 +00809 S119-EXIT. DTSBR403 +00810 EXIT. DTSBR403 +00811 DTSBR403 +00812 *S999-ABEND. DTSBR403 +00813 * DTSBR403 +00814 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR403 +00815 * DTSBR403 +00816 *S999-EXIT. DTSBR403 +00817 * EXIT. DTSBR403 +00818 DTSBR403 diff --git a/Batch/DTSBR405.cob b/Batch/DTSBR405.cob index 9c18dea..bcbee3b 100644 --- a/Batch/DTSBR405.cob +++ b/Batch/DTSBR405.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 04/11/13 +00001 IDENTIFICATION DIVISION. 05/31/24 00002 PROGRAM-ID. DTSBR405. DTSBR405 -00003 AUTHOR. TRICOASTAL CONSULTING LTD LV080 +00003 AUTHOR. TRICOASTAL CONSULTING LTD LV005 00004 MODIFIED BY TRW S&ITG. DTSBR405 00005 DATE-WRITTEN. DECEMBER 1994. DTSBR405 00006 DATE-COMPILED. DTSBR405 @@ -88,583 +88,584 @@ 00088 DTSBR405 00089 EJECT DTSBR405 00090 WORKING-STORAGE SECTION. DTSBR405 -000905 77 PAN-VALET PICTURE X(24) VALUE '080DTSBR405 04/11/13'. DTSBR405 -00091 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR405 04/03/13'. DTSBR405 -00092 77 PAN-VALET PICTURE X(24) VALUE '008DTSBR405 06/13/12'. DTSBR405 -00093 DTSBR405 -00094 01 WRK-AREA. DTSBR405 -00095 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +405.DTSBR405 -00096 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR405 -00097 05 WRK-TODAYS-DATE. DTSBR405 -00098 10 WRK-TODAY-MONTH PIC 9(02) VALUE ZERO. DTSBR405 -00099 10 FILLER PIC X VALUE SPACE. DTSBR405 -00100 10 WRK-TODAY-DAY PIC 9(02) VALUE ZERO. DTSBR405 -00101 10 FILLER REDEFINES WRK-TODAY-DAY. DTSBR405 -00102 15 WRK-DAY-1 PIC 9. DTSBR405 -00103 15 WRK-DAY-2 PIC 9. DTSBR405 -00104 10 FILLER PIC X VALUE SPACE. DTSBR405 -00105 10 WRK-TODAY-YEAR PIC 9(04) VALUE ZERO. DTSBR405 -00106 05 WRK-MONTH-YEAR PIC X(16) VALUE SPACE. DTSBR405 -00107 05 WRK-DAY-SFX PIC X(02) VALUE SPACE. DTSBR405 -00108 DTSBR405 -00109 05 WS-REC-DEEDS-NO. DTSBR405 -00110 10 WS-FIRST3-DIGITS PIC X(03) VALUE SPACES. DTSBR405 -00111 10 WS-LAST7-DIGITS PIC X(07) VALUE SPACES. DTSBR405 -00112 05 WS-FOOT-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR405 -00113 05 WS-FOOT-NUMBER-TWO PIC S9(03) COMP-3 VALUE +0. DTSBR405 -00114 05 WS-SUM-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR405 -00115 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR405 -00116 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR405 -00117 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR405 -00118 05 WS-OP-ID-HOLD PIC X(08) VALUE SPACES. DTSBR405 -00119 05 WS-OPR-NAME-CAPS PIC X(32) VALUE SPACES. DTSBR405 -00120 05 WS-OPR-UNIT-NAME-CAPS PIC X(50) VALUE SPACES. DTSBR405 -00121 05 WS-OPR-NAME-MIXED PIC X(32) VALUE SPACES. DTSBR405 -00122 05 WS-OPR-UNIT-NAME-MIXED PIC X(50) VALUE SPACES. DTSBR405 -00123 DTSBR405 -00124 05 WS-OPR-VOICE. DTSBR405 -00125 10 WS-OPR-VOICE-AREA PIC X(03) VALUE SPACES. DTSBR405 -00126 10 WS-OPR-VOICE-1 PIC X(03) VALUE SPACES. DTSBR405 -00127 10 WS-OPR-VOICE-2 PIC X(04) VALUE SPACES. DTSBR405 -00128 10 WS-OPR-VOICE-EXT PIC X(04) VALUE SPACES. DTSBR405 -00129 DTSBR405 -00130 ++INCLUDE DTSIC405 DTSBR405 -00131 05 WRK-FILING-DATE PIC X(10) VALUE SPACE. DTSBR405 -00132 EJECT DTSBR405 -00133 01 L119-LINK-AREA. DTSBR405 -00134 ++INCLUDE DTSIL119 DTSBR405 -00135 EJECT DTSBR405 -00136 01 L001-LINK-AREA. DTSBR405 -00137 ++INCLUDE DTSIL001 DTSBR405 -00138 EJECT DTSBR405 -00139 01 L009-LINK-AREA. DTSBR405 -00140 ++INCLUDE DTSIL009 DTSBR405 -00141 EJECT DTSBR405 -00142 01 L071-LINK-AREA. DTSBR405 -00143 ++INCLUDE DTSIL071 DTSBR405 -00144 EJECT DTSBR405 -00145 01 L082-LINK-AREA. DTSBR405 -00146 ++INCLUDE DTSIL082 DTSBR405 -00147 EJECT DTSBR405 -00148 ++INCLUDE DTSXL405 DTSBR405 -00149 DTSBR405 -00150 01 PAGE-HEADING1. DTSBR405 -00151 05 HDR1-LINE-1. DTSBR405 -00152 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00153 10 FILLER PIC X(05) DTSBR405 -00154 VALUE '405R1'. DTSBR405 -00155 10 FILLER PIC X(35) VALUE SPACES. DTSBR405 -00156 10 HDR1-AGY-NAME-LINE1 PIC X(50) VALUE SPACE. DTSBR405 -00157 10 FILLER PIC X(28) VALUE SPACES. DTSBR405 -00158 10 FILLER PIC X(05) DTSBR405 -00159 VALUE 'DATE:'. DTSBR405 -00160 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00161 10 HDR1-SYS-DATE PIC X(08) VALUE SPACE. DTSBR405 -00162 05 HDR1-LINE-2. DTSBR405 -00163 10 FILLER PIC X(41) VALUE SPACES. DTSBR405 -00164 10 HDR1-AGY-NAME-LINE2 PIC X(50) VALUE SPACE. DTSBR405 -00165 10 FILLER PIC X(28) VALUE SPACES. DTSBR405 -00166 10 FILLER PIC X(05) DTSBR405 -00167 VALUE 'TIME:'. DTSBR405 -00168 10 FILLER PIC X(41) VALUE SPACES. DTSBR405 -00169 10 HDR1-SYS-TIME PIC X(08) VALUE SPACE. DTSBR405 -00170 05 HDR1-LINE-3. DTSBR405 -00171 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00172 10 FILLER PIC X(35) DTSBR405 -00173 VALUE 'ROUTE TO: ENFORCEMENT UNIT '. DTSBR405 -00174 10 FILLER PIC X(83) VALUE SPACES. DTSBR405 -00175 10 FILLER PIC X(05) DTSBR405 -00176 VALUE 'PAGE:'. DTSBR405 -00177 10 FILLER PIC X(03) VALUE SPACES. DTSBR405 -00178 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DTSBR405 -00179 05 HDR1-LINE-4. DTSBR405 -00180 10 FILLER PIC X(53) VALUE SPACES. DTSBR405 -00181 10 FILLER PIC X(27) DTSBR405 -00182 VALUE ' LIEN RELEASE LIST '. DTSBR405 -00183 05 HDR1-LINE-5 PIC X(133) VALUE SPACES. DTSBR405 -00184 05 HDR1-LINE-6 PIC X(133) VALUE SPACES. DTSBR405 -00185 05 HDR1-LINE-7. DTSBR405 -00186 10 FILLER PIC X(13) VALUE SPACES. DTSBR405 -00187 10 FILLER PIC X(06) DTSBR405 -00188 VALUE 'EMP NO'. DTSBR405 -00189 10 FILLER PIC X(08) VALUE SPACES. DTSBR405 -00190 10 FILLER PIC X(13) DTSBR405 -00191 VALUE 'PRIMARY NAME '. DTSBR405 -00192 10 FILLER PIC X(34) VALUE SPACES. DTSBR405 -00193 10 FILLER PIC X(11) DTSBR405 -00194 VALUE 'OUC NO. '. DTSBR405 -00195 10 FILLER PIC X(04) VALUE SPACES. DTSBR405 -00196 10 FILLER PIC X(11) DTSBR405 -00197 VALUE 'RECORDER # '. DTSBR405 -00198 10 FILLER PIC X(06) VALUE SPACES. DTSBR405 -00199 10 FILLER PIC X(11) DTSBR405 -00200 VALUE 'LIEN DATE'. DTSBR405 -00201 DTSBR405 -00202 01 DETAIL-LINE1. DTSBR405 -00203 05 DTL1-LINE-2. DTSBR405 -00204 10 FILLER PIC X(13) VALUE SPACES. DTSBR405 -00205 10 DTL1-EMP-NO PIC 999B999. DTSBR405 -00206 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 -00207 10 DTL1-PRIMARY-NAME PIC X(40) VALUE SPACE. DTSBR405 -00208 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 -00209 10 DTL1-CERT-NO PIC X(10). DTSBR405 -00210 10 DTL1-CERT-NO-9 REDEFINES DTL1-CERT-NO. DTSBR405 -00211 15 DTL1-CERT-NO-6 PIC 99B9999. DTSBR405 -00212 15 DTL1-REST-3 PIC X(03). DTSBR405 -00213 10 FILLER PIC X(05) VALUE SPACES. DTSBR405 -00214 10 DTL1-DEED-NO PIC X(10). DTSBR405 -00215 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 -00216 10 DTL1-SLASH-DATE PIC X(10) VALUE SPACE. DTSBR405 -00217 DTSBR405 -00218 01 CONTROL-FOOTING-FINAL. DTSBR405 -00219 05 CFF-LINE-3. DTSBR405 -00220 10 FILLER PIC X(31) VALUE SPACES. DTSBR405 -00221 10 CFF-NUMBER-ONE PIC ZZ,ZZ9. DTSBR405 -00222 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00223 10 FILLER PIC X(12) DTSBR405 -00224 VALUE 'LIENS LISTED'. DTSBR405 -00225 EJECT DTSBR405 -00226 DTSBR405 -00227 01 PAGE-HEADING2. DTSBR405 -00228 05 HDR2-LINE-9. DTSBR405 -00229 10 FILLER PIC X(30) VALUE SPACES. DTSBR405 -00230 10 FILLER PIC X(24) DTSBR405 -00231 VALUE 'RECORDER OF DEEDS OF THE'. DTSBR405 -00232 05 HDR2-LINE-10. DTSBR405 -00233 10 FILLER PIC X(32) VALUE SPACES. DTSBR405 -00234 10 FILLER PIC X(20) DTSBR405 -00235 VALUE 'DISTRICT OF COLUMBIA'. DTSBR405 -00236 05 HDR2-LINE-11 PIC X(133) VALUE SPACES. DTSBR405 -00237 05 HDR2-LINE-12 PIC X(133) VALUE SPACES. DTSBR405 -00238 05 HDR2-LINE-13 PIC X(133) VALUE SPACES. DTSBR405 -00239 05 HDR2-LINE-14. DTSBR405 -00240 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00241 10 FILLER PIC X(20) DTSBR405 -00242 VALUE 'District of Columbia'. DTSBR405 -00243 10 FILLER PIC X(22) VALUE SPACES. DTSBR405 -00244 10 FILLER PIC X(01) DTSBR405 -00245 VALUE ')'. DTSBR405 -00246 05 HDR2-LINE-15. DTSBR405 -00247 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00248 10 FILLER PIC X(34) DTSBR405 -00249 VALUE 'Department of Employment Services'. DTSBR405 -00250 10 FILLER PIC X(08) VALUE SPACES. DTSBR405 -00251 10 FILLER PIC X(01) DTSBR405 -00252 VALUE ')'. DTSBR405 -00253 05 HDR2-LINE-16. DTSBR405 -00254 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00255 10 FILLER PIC X(35) DTSBR405 -00256 VALUE 'Office of Unemployment Compensation'. DTSBR405 -00257 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 -00258 10 FILLER PIC X(01) DTSBR405 -00259 VALUE ')'. DTSBR405 -00260 05 HDR2-LINE-17. DTSBR405 -00261 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00262 10 HDR2-MAIL1-PHYS1-STRING PIC X(40). DTSBR405 -00263 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00264 10 FILLER PIC X(01) DTSBR405 -00265 VALUE ')'. DTSBR405 -00266 05 HDR2-LINE-18. DTSBR405 -00267 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00268 10 HDR2-AGY-MAIL2-NO-CAPS PIC X(40) VALUE SPACE. DTSBR405 -00269 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00270 10 FILLER PIC X(01) DTSBR405 -00271 VALUE ')'. DTSBR405 -00272 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00273 10 FILLER PIC X(22) DTSBR405 -00274 VALUE 'EMPLOYER ACCOUNT NO: '. DTSBR405 -00275 10 HDR2-EMP-NO PIC 999B999. DTSBR405 -00276 05 HDR2-LINE-19. DTSBR405 -00277 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 -00278 10 FILLER PIC X(01) DTSBR405 -00279 VALUE ')'. DTSBR405 -00280 05 HDR2-LINE-20. DTSBR405 -00281 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 -00282 10 FILLER PIC X(01) DTSBR405 -00283 VALUE ')'. DTSBR405 -00284 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00285 10 FILLER PIC X(22) DTSBR405 -00286 VALUE 'OUC CERTIFICATE NO: '. DTSBR405 -00287 10 HDR2-CERT-NO PIC X(10). DTSBR405 -00288 10 HDR2-CERT-NO-9 REDEFINES HDR2-CERT-NO. DTSBR405 -00289 15 HDR2-CERT-NO-6 PIC 99b9999. DTSBR405 -00290 15 HDR2-REST-3 PIC X(03). DTSBR405 -00291 05 HDR2-LINE-21. DTSBR405 -00292 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 -00293 10 FILLER PIC X(01) DTSBR405 -00294 VALUE ')'. DTSBR405 -00295 05 HDR2-LINE-22. DTSBR405 -00296 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 -00297 10 FILLER PIC X(01) DTSBR405 -00298 VALUE ')'. DTSBR405 -00299 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00300 10 FILLER PIC X(22) DTSBR405 -00301 VALUE 'RECORDER OF DEEDS NO: '. DTSBR405 -00302 10 HDR2-DEED-NO PIC X(10). DTSBR405 -00303 05 HDR2-LINE-23. DTSBR405 -00304 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 -00305 10 FILLER PIC X(01) DTSBR405 -00306 VALUE ')'. DTSBR405 -00307 05 HDR2-LINE-24. DTSBR405 -00308 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00309 10 HDR2-PRIMARY-NAME PIC X(40) VALUE SPACE. DTSBR405 -00310 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00311 10 FILLER PIC X(01) DTSBR405 -00312 VALUE ')'. DTSBR405 -00313 05 HDR2-LINE-25. DTSBR405 -00314 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 -00315 10 FILLER PIC X(01) DTSBR405 -00316 VALUE ')'. DTSBR405 -00317 05 HDR2-LINE-26. DTSBR405 -00318 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00319 10 FILLER PIC X(08) DTSBR405 -00320 VALUE 'ADDRESS:'. DTSBR405 -00321 10 FILLER PIC X(34) VALUE SPACES. DTSBR405 -00322 10 FILLER PIC X(01) DTSBR405 -00323 VALUE ')'. DTSBR405 -00324 05 HDR2-LINE-27. DTSBR405 -00325 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00326 10 HDR2-FMT-LINE-1 PIC X(40) VALUE SPACE. DTSBR405 -00327 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00328 10 FILLER PIC X(01) DTSBR405 -00329 VALUE ')'. DTSBR405 -00330 05 HDR2-LINE-28. DTSBR405 -00331 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00332 10 HDR2-FMT-LINE-2 PIC X(40) VALUE SPACE. DTSBR405 -00333 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00334 10 fILLER PIC X(01) DTSBR405 -00335 VALUE ')'. DTSBR405 -00336 05 HDR2-LINE-29. DTSBR405 -00337 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00338 10 HDR2-FMT-LINE-3 PIC X(40) VALUE SPACE. DTSBR405 -00339 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00340 10 FILLER PIC X(01) DTSBR405 -00341 VALUE ')'. DTSBR405 -00342 05 HDR2-LINE-30. DTSBR405 -00343 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00344 10 HDR2-FMT-LINE-4 PIC X(40) VALUE SPACE. DTSBR405 -00345 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00346 10 FILLER PIC X(01) DTSBR405 -00347 VALUE ')'. DTSBR405 -00348 05 HDR2-LINE-31. DTSBR405 -00349 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 -00350 10 HDR2-FMT-LINE-5 PIC X(40) VALUE SPACE. DTSBR405 -00351 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 -00352 10 FILLER PIC X(01) DTSBR405 -00353 VALUE ')'. DTSBR405 -00354 05 HDR2-LINE-32 PIC X(133) VALUE SPACES. DTSBR405 -00355 05 HDR2-LINE-33 PIC X(133) VALUE SPACES. DTSBR405 -00356 05 HDR2-LINE-34. DTSBR405 -00357 10 FILLER PIC X(21) VALUE SPACES. DTSBR405 -00358 10 FILLER PIC X(30) DTSBR405 -00359 VALUE 'CERTIFICATE OF RELEASE OF LIEN'. DTSBR405 -00360 05 HDR2-LINE-35 PIC X(133) VALUE SPACES. DTSBR405 -00361 05 HDR2-LINE-36 PIC X(133) VALUE SPACES. DTSBR405 -00362 DTSBR405 -00363 ++INCLUDE DTSIZ405 DTSBR405 -00364 EJECT DTSBR405 -00365 LINKAGE SECTION. DTSBR405 -00366 DTSBR405 -00367 01 LRCM-LINK-AREA. DTSBR405 -00368 ++INCLUDE DTSILRCM DTSBR405 -00369 EJECT DTSBR405 -00370 01 R405-REC. DTSBR405 -00371 ++INCLUDE DTSIR405 DTSBR405 -00372 EJECT DTSBR405 -00373 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR405 -00374 R405-REC. DTSBR405 -00375 DTSBR405 -00376 IF FIRST-TIME-IND = 'Y' DTSBR405 -00377 PERFORM I1000-INITIATE DTSBR405 -00378 THRU I1000-EXIT DTSBR405 -00379 MOVE 'N' TO FIRST-TIME-IND. DTSBR405 -00380 DTSBR405 -00381 IF LRCM-EOR-88 DTSBR405 -00382 PERFORM T1000-TERMINATE DTSBR405 -00383 THRU T1000-EXIT DTSBR405 -00384 ELSE DTSBR405 -00385 PERFORM P1000-PROCESS DTSBR405 -00386 THRU P1000-EXIT. DTSBR405 -00387 DTSBR405 -00388 GOBACK. DTSBR405 -00389 EJECT DTSBR405 -00390 I1000-INITIATE. DTSBR405 -00391 DTSBR405 -00392 OPEN OUTPUT PRT-FILE1. DTSBR405 -00393 OPEN OUTPUT PRT-FILE2. DTSBR405 -00394 DTSBR405 -00395 MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE. DTSBR405 -00396 MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME. DTSBR405 -00397 MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1. DTSBR405 -00398 MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2. DTSBR405 -00399 MOVE SPACES TO PRT-RECORD. DTSBR405 -00400 DTSBR405 -00401 MOVE SPACES TO XEROX-REPORT. DTSBR405 -00402 * MOVE 'XXXXXXXX' TO REPORT-NUMBER. DTSBR405 -00403 DTSBR405 -00404 WRITE XEROX-REPORT FROM BLANK-LINE DTSBR405 -00405 AFTER ADVANCING TOP-OF-PAGE. DTSBR405 -00406 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL1 AFTER 1. DTSBR405 -00407 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL2 AFTER 1. DTSBR405 -00408 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 8. DTSBR405 -00409 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE13 AFTER 1. DTSBR405 -00410 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE14 AFTER 1. DTSBR405 -00411 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE15 AFTEr 1. DTSBR405 -00412 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE16 AFTER 1. DTSBR405 -00413 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE17 AFTER 1. DTSBR405 -00414 DTSBR405 -00415 SET L119-REQ-MIXED-88 TO TRUE. DTSBR405 -00416 SET L119-REQ-NO-UNIT-88 TO TRUE. DTSBR405 -00417 DTSBR405 -00418 PERFORM S119-AGENCY-FACTS DTSBR405 -00419 THRU S119-EXIT. DTSBR405 -00420 DTSBR405 -00421 MOVE L119-AGY-MAIL2 TO WS-AGY-MAIL2-NO-CAPS DTSBR405 -00422 HDR2-AGY-MAIL2-NO-CAPS. DTSBR405 -00423 MOVE L119-AGY-MAIL1 TO WS-MAIL1-PHYS1-STRING DTSBR405 -00424 HDR2-MAIL1-PHYS1-STRING. DTSBR405 -00425 I1000-EXIT. DTSBR405 -00426 EXIT. DTSBR405 -00427 EJECT DTSBR405 -00428 P1000-PROCESS. DTSBR405 -00429 DTSBR405 -00430 MOVE LRCM-SYS-8-DATE TO WRK-TODAYS-DATE. DTSBR405 -00431 DTSBR405 -00432 IF WRK-DAY-2 = 1 AND WRK-DAY-1 NOT = 1 DTSBR405 -00433 MOVE WRK-ST TO WRK-DAY-SFX DTSBR405 -00434 ELSE DTSBR405 -00435 IF WRK-DAY-2 = 2 AND WRK-DAY-1 NOT = 1 DTSBR405 -00436 MOVE WRK-ND TO WRK-DAY-SFX DTSBR405 -00437 ELSE DTSBR405 -00438 IF WRK-DAY-2 = 3 AND WRK-DAY-1 NOT = 1 DTSBR405 -00439 MOVE WRK-RD TO WRK-DAY-SFX DTSBR405 -00440 ELSE DTSBR405 -00441 MOVE WRK-TH TO WRK-DAY-SFX. DTSBR405 -00442 MOVE SPACES TO WRK-MONTH-YEAR. DTSBR405 -00443 STRING WRK-MONTH-NAME (WRK-TODAY-MONTH) DELIMITED BY SPACE DTSBR405 -00444 ', ' DELIMITED BY SIZE DTSBR405 -00445 WRK-TODAY-YEAR DELIMITED BY SIZE DTSBR405 -00446 '.' DELIMITED BY SIZE DTSBR405 -00447 INTO WRK-MONTH-YEAR. DTSBR405 -00448 * MOVE R405-STMT-DATE TO L001-FED-8-DATE-9. DTSBR405 -00449 MOVE R405-CERTIFICATE-DATE TO L001-FED-8-DATE-9. DTSBR405 -00450 DTSBR405 -00451 PERFORM S001-FROM-FED-8 DTSBR405 -00452 THRU S001-EXIT. DTSBR405 -00453 DTSBR405 -00454 MOVE L001-SLASH-8-DATE TO WS-SLASH-DATE DTL1-SLASH-DATE. DTSBR405 -00455 DTSBR405 -00456 MOVE R405-REC-DEEDS-NO TO WS-REC-DEEDS-NO. DTSBR405 -00457 * IF WS-FIRST3-DIGITS = 'CNV' DTSBR405 -00458 * MOVE R405-CERTIFICATE-NO TO wS-CERT-NO-C DTL1-CERT-NO-6 DTSBR405 -00459 * HDR2-CERT-NO-6 DTSBR405 -00460 * MOVE SPACES TO DTL1-REST-3 DTSBR405 -00461 * MOVE SPACES TO HDR2-REST-3 DTSBR405 -00462 * ELSE DTSBR405 -00463 MOVE R405-CERTIFICATE-NO TO WS-CERT-NO-R DTL1-CERT-NO DTSBR405 -00464 HDR2-CERT-NO. DTSBR405 -00465 * END-IF. DTSBR405 -00466 DTSBR405 -00467 *** MOVE R405-REC-DEEDS-NO TO WS-CERT-NO-R DTSBR405 -00468 MOVE R405-REC-DEEDS-NO TO DTL1-DEED-NO DTSBR405 -00469 HDR2-DEED-NO. DTSBR405 -00470 DTSBR405 -00471 MOVE R405-PRIMARY-NAME TO HDR2-PRIMARY-NAME DTSBR405 -00472 DTL1-PRIMARY-NAME. DTSBR405 -00473 MOVE R405-FMT-LINE (1) TO HDR2-FMT-LINE-1. DTSBR405 -00474 MOVE R405-FMT-LINE (2) TO HDR2-FMT-LINE-2. DTSBR405 -00475 MOVE R405-FMT-LINE (3) TO HDR2-FMT-LINE-3. DTSBR405 -00476 MOVE R405-FMT-LINE (4) TO HDR2-FMT-LINE-4. DTSBR405 -00477 MOVE R405-FMT-LINE (5) TO HDR2-FMT-LINE-5. DTSBR405 -00478 * DTSBR405 -00479 MOVE R405-EMP-NO TO DTL1-EMP-NO DTSBR405 -00480 HDR2-EMP-NO. DTSBR405 -00481 ADD +1 TO WS-FOOT-NUMBER-ONE. DTSBR405 -00482 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR405 -00483 WRITE PRT-RECORD FROM DTL1-LINE-2 AFTER 2. DTSBR405 -00484 ADD +2 TO WS-LINE-CNT2. DTSBR405 -00485 ADD +1 TO WS-SUM-NUMBER-ONE. DTSBR405 -00486 * DTSBR405 -00487 PERFORM P4000-LOOKUP-OPID THRU P4000-EXIT. DTSBR405 -00488 PERFORM P3000-PRINT-XEROX THRU P3000-EXIT. DTSBR405 -00489 DTSBR405 -00490 P1000-EXIT. DTSBR405 -00491 EXIT. DTSBR405 -00492 DTSBR405 -00493 P2000-PRINT-HEADER. DTSBR405 -00494 IF WS-LINE-CNT GREATER 58 OR DTSBR405 -00495 WS-LINE-CNT2 GREATER 58 DTSBR405 -00496 MOVE +0 TO WS-LINE-CNT DTSBR405 -00497 MOVE +0 TO WS-LINE-CNT2 DTSBR405 -00498 ADD +1 TO WS-PAGE-CNT DTSBR405 -00499 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR405 -00500 WRITE PRT-RECORD FROM HDR1-LINE-1 AFTER TOP-OF-PAGE DTSBR405 -00501 WRITE PRT-RECORD FROM HDR1-LINE-2 AFTER 1 DTSBR405 -00502 WRITE PRT-RECORD FROM HDR1-LINE-3 AFTER 1 DTSBR405 -00503 WRITE PRT-RECORD FROM HDR1-LINE-4 AFTER 1 DTSBR405 -00504 WRITE PRT-RECORD FROM HDR1-LINE-5 AFTER 1 DTSBR405 -00505 WRITE PRT-RECORD FROM HDR1-LINE-6 AFTER 1 DTSBR405 -00506 WRITE PRT-RECORD FROM HDR1-LINE-7 AFTER 1 DTSBR405 -00507 ADD +7 TO WS-LINE-CNT2. DTSBR405 -00508 P2000-EXIT. DTSBR405 -00509 EXIT. DTSBR405 -00510 DTSBR405 -00511 P3000-PRINT-XEROX. DTSBR405 -00512 DTSBR405 -00513 WRITE XEROX-REPORT FROM BLANK-LINE AFTER TOP-OF-PAGE. DTSBR405 -00514 WRITE XEROX-REPORT FROM HDR2-LINE-9 AFTER 8. DTSBR405 -00515 WRITE XEROX-REPORT FROM HDR2-LINE-10 AFTER 1. DTSBR405 -00516 WRITE XEROX-REPORT FROM HDR2-LINE-11 AFTER 1. DTSBR405 -00517 WRITE XEROX-REPORT FROM HDR2-LINE-12 AFTER 1. DTSBR405 -00518 WRITE XEROX-REPORT FROM HDR2-LINE-13 AFTER 1. DTSBR405 -00519 WRITE XEROX-REPORT FROM HDR2-LINE-14 AFTER 1. DTSBR405 -00520 WRITE XEROX-REPORT FROM HDR2-LINE-15 AFTER 1. DTSBR405 -00521 WRITE XEROX-REPORT FROM HDR2-LINE-16 AFTER 1. DTSBR405 -00522 WRITE XEROX-REPORT FROM HDR2-LINE-17 AFTER 1. DTSBR405 -00523 WRITE XEROX-REPORT FROM HDR2-LINE-18 AFTER 1. DTSBR405 -00524 WRITE XEROX-REPORT FROM HDR2-LINE-19 AFTER 1. DTSBR405 -00525 WRITE XEROX-REPORT FROM HDR2-LINE-20 AFTER 1. DTSBR405 -00526 WRITE XEROX-REPORT FROM HDR2-LINE-21 AFTER 1. DTSBR405 -00527 WRITE XEROX-REPORT FROM HDR2-LINE-22 AFTER 1. DTSBR405 -00528 WRITE XEROX-REPORT FROM HDR2-LINE-23 AFTER 1. DTSBR405 -00529 WRITE XEROX-REPORT FROM HDR2-LINE-24 AFTER 1. DTSBR405 -00530 WRITE XEROX-REPORT FROM HDR2-LINE-25 AFTER 1. DTSBR405 -00531 WRITE XEROX-REPORT FROM HDR2-LINE-26 AFTER 1. DTSBR405 -00532 WRITE XEROX-REPORT FROM HDR2-LINE-27 AFTER 1. DTSBR405 -00533 WRITE XEROX-REPORT FROM HDR2-LINE-28 AFTER 1. DTSBR405 -00534 WRITE XEROX-REPORT FROM HDR2-LINE-29 AFTER 1. DTSBR405 -00535 WRITE XEROX-REPORT FROM HDR2-LINE-30 AFTER 1. DTSBR405 -00536 WRITE XEROX-REPORT FROM HDR2-LINE-31 AFTER 1. DTSBR405 -00537 WRITE XEROX-REPORT FROM HDR2-LINE-32 AFTER 1. DTSBR405 -00538 WRITE XEROX-REPORT FROM HDR2-LINE-33 AFTER 1. DTSBR405 -00539 WRITE XEROX-REPORT FROM HDR2-LINE-34 AFTER 1. DTSBR405 -00540 WRITE XEROX-REPORT FROM HDR2-LINE-35 AFTER 1. DTSBR405 -00541 WRITE XEROX-REPORT FROM HDR2-LINE-36 AFTER 1. DTSBR405 -00542 WRITE XEROX-REPORT FROM DTL-LINE-2 AFTER 1. DTSBR405 -00543 WRITE XEROX-REPORT FROM DTL-LINE-2B AFTER 1. DTSBR405 -00544 WRITE XEROX-REPORT FROM DTL-LINE-3 AFTER 1. DTSBR405 -00545 WRITE XEROX-REPORT FROM DTL-LINE-4 AFTER 1. DTSBR405 -00546 WRITE XEROX-REPORT FROM DTL-LINE-5 AFTER 1. DTSBR405 -00547 WRITE XEROX-REPORT FROM DTL-LINE-6 AFTER 1. DTSBR405 -00548 WRITE XEROX-REPORT FROM DTL-LINE-7 AFTER 1. DTSBR405 -00549 * IF WS-FIRST3-DIGITS = 'CNV' DTSBR405 -00550 * WRITE XEROX-REPORT FROM DTL-LINE-8-A AFTER 1 DTSBR405 -00551 * ELSE DTSBR405 -00552 * WRITE XEROX-REPORT FROM DTL-LINE-8 AFTER 1. DTSBR405 -00553 WRITE XEROX-REPORT FROM DTL-LINE-9 AFTER 1. DTSBR405 -00554 WRITE XEROX-REPORT FROM DTL-LINE-10 AFTER 1. DTSBR405 -00555 DTSBR405 -00556 IF WRK-TODAY-DAY > 9 DTSBR405 -00557 MOVE WRK-TODAY-DAY TO WRK-TODAY-DAY-LINE-12 DTSBR405 -00558 MOVE WRK-DAY-SFX TO WRK-DAY-SFX-LINE-12 DTSBR405 -00559 MOVE WRK-MONTH-YEAR TO WRK-MONTH-YEAR-LINE-12 DTSBR405 -00560 WRITE XEROX-REPORT FROM DTL-LINE-12 AFTER 1 DTSBR405 -00561 ELSE DTSBR405 -00562 MOVE WRK-TODAY-DAY TO WRK-TODAY-DAY-LINE-11 DTSBR405 -00563 MOVE WRK-DAY-SFX TO WRK-DAY-SFX-LINE-11 DTSBR405 -00564 MOVE WRK-MONTH-YEAR TO WRK-MONTH-YEAR-LINE-11 DTSBR405 -00565 WRITE XEROX-REPORT FROM DTL-LINE-11 AFTER 1. DTSBR405 -00566 DTSBR405 -00567 WRITE XEROX-REPORT FROM DTL-LINE-13 AFTER 1. DTSBR405 -00568 WRITE XEROX-REPORT FROM DTL-LINE-14 AFTER 1. DTSBR405 -00569 WRITE XEROX-REPORT FROM DTL-LINE-15 AFTER 1. DTSBR405 -00570 WRITE XEROX-REPORT FROM DTL-LINE-16 AFTER 1. DTSBR405 -00571 WRITE XEROX-REPORT FROM DTL-LINE-16-1 AFTER 1. DTSBR405 -00572 WRITE XEROX-REPORT FROM DTL-LINE-17 AFTER 1. DTSBR405 -00573 WRITE XEROX-REPORT FROM DTL-LINE-18 AFTER 1. DTSBR405 -00574 WRITE XEROX-REPORT FROM DTL-LINE-19 AFTER 1. DTSBR405 -00575 WRITE XEROX-REPORT FROM DTL-LINE-20 AFTER 1. DTSBR405 -00576 WRITE XEROX-REPORT FROM DTL-LINE-21 AFTER 1. DTSBR405 -00577 WRITE XEROX-REPORT FROM DTL-LINE-22 AFTER 1. DTSBR405 -00578 * WRITE XEROX-REPORT FROM DTL-LINE-23 AFTER 1. DTSBR405 -00579 WRITE XEROX-REPORT FROM DTL-LINE-24 AFTER 1. DTSBR405 -00580 WRITE XEROX-REPORT FROM DTL-LINE-25 AFTER 1. DTSBR405 -00581 WRITE XEROX-REPORT FROM DTL-LINE-26 AFTER 1. DTSBR405 -00582 * ADD +13 TO WS-LINE-CNT2. DTSBR405 -00583 DTSBR405 -00584 P3000-EXIT. DTSBR405 -00585 EXIT. DTSBR405 -00586 P4000-LOOKUP-OPID. DTSBR405 -00587 MOVE R405-OP-ID TO L082-OP-ID. DTSBR405 -00588 PERFORM S082-OP-ID-INFO THRU S082-EXIT. DTSBR405 -00589 IF L082-NOT-VALID-OP OR L082-INTERNAL-88 DTSBR405 -00590 MOVE SPACES TO WS-OPR-NAME-MIXED DTSBR405 -00591 WS-OPR-NAME-CAPS DTSBR405 -00592 MOVE LRCM-DEFAULT-NAME TO WS-OPR-NAME-CAPS DTSBR405 -00593 MOVE LRCM-DEFAULT-VOICE TO WS-OPR-VOICE DTSBR405 -00594 ELSE DTSBR405 -00595 MOVE L082-UNIT-NAME TO WS-OPR-UNIT-NAME-MIXED DTSBR405 -00596 MOVE L082-VOICE-1 TO WS-OPR-VOICE DTSBR405 -00597 MOVE L082-NAME TO L071-NAM DTSBR405 -00598 MOVE 2 TO L071-NAME-FORMAT DTSBR405 -00599 PERFORM S071-DESLASH-NAME THRU S071-EXIT DTSBR405 -00600 MOVE L071-NAM TO WS-OPR-NAME-MIXED DTSBR405 -00601 MOVE WS-OPR-NAME-MIXED TO L009-DATA DTSBR405 -00602 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT DTSBR405 -00603 MOVE L009-DATA TO WS-OPR-NAME-CAPS. DTSBR405 -00604 DTSBR405 -00605 MOVE WS-OPR-VOICE-AREA TO WS-FLD-VOICE-AREA. DTSBR405 -00606 MOVE WS-OPR-VOICE-1 TO WS-FLD-VOICE-1. DTSBR405 -00607 MOVE WS-OPR-VOICE-2 TO WS-FLD-VOICE-2. DTSBR405 -00608 MOVE WS-OPR-NAME-CAPS TO WS-FLD-REP-NAME. DTSBR405 -00609 DTSBR405 -00610 P4000-EXIT. EXIT. DTSBR405 -00611 EJECT DTSBR405 -00612 DTSBR405 +000905 77 PAN-VALET PICTURE X(24) VALUE '005DTSBR405 05/31/24'. DTSBR405 +00091 77 PAN-VALET PICTURE X(24) VALUE '080DTSBR405 04/11/13'. DTSBR405 +00092 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR405 04/03/13'. DTSBR405 +00093 77 PAN-VALET PICTURE X(24) VALUE '008DTSBR405 06/13/12'. DTSBR405 +00094 DTSBR405 +00095 01 WRK-AREA. DTSBR405 +00096 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +405.DTSBR405 +00097 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR405 +00098 05 WRK-TODAYS-DATE. DTSBR405 +00099 10 WRK-TODAY-MONTH PIC 9(02) VALUE ZERO. DTSBR405 +00100 10 FILLER PIC X VALUE SPACE. DTSBR405 +00101 10 WRK-TODAY-DAY PIC 9(02) VALUE ZERO. DTSBR405 +00102 10 FILLER REDEFINES WRK-TODAY-DAY. DTSBR405 +00103 15 WRK-DAY-1 PIC 9. DTSBR405 +00104 15 WRK-DAY-2 PIC 9. DTSBR405 +00105 10 FILLER PIC X VALUE SPACE. DTSBR405 +00106 10 WRK-TODAY-YEAR PIC 9(04) VALUE ZERO. DTSBR405 +00107 05 WRK-MONTH-YEAR PIC X(16) VALUE SPACE. DTSBR405 +00108 05 WRK-DAY-SFX PIC X(02) VALUE SPACE. DTSBR405 +00109 DTSBR405 +00110 05 WS-REC-DEEDS-NO. DTSBR405 +00111 10 WS-FIRST3-DIGITS PIC X(03) VALUE SPACES. DTSBR405 +00112 10 WS-LAST7-DIGITS PIC X(07) VALUE SPACES. DTSBR405 +00113 05 WS-FOOT-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR405 +00114 05 WS-FOOT-NUMBER-TWO PIC S9(03) COMP-3 VALUE +0. DTSBR405 +00115 05 WS-SUM-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. DTSBR405 +00116 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR405 +00117 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR405 +00118 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR405 +00119 05 WS-OP-ID-HOLD PIC X(08) VALUE SPACES. DTSBR405 +00120 05 WS-OPR-NAME-CAPS PIC X(32) VALUE SPACES. DTSBR405 +00121 05 WS-OPR-UNIT-NAME-CAPS PIC X(50) VALUE SPACES. DTSBR405 +00122 05 WS-OPR-NAME-MIXED PIC X(32) VALUE SPACES. DTSBR405 +00123 05 WS-OPR-UNIT-NAME-MIXED PIC X(50) VALUE SPACES. DTSBR405 +00124 DTSBR405 +00125 05 WS-OPR-VOICE. DTSBR405 +00126 10 WS-OPR-VOICE-AREA PIC X(03) VALUE SPACES. DTSBR405 +00127 10 WS-OPR-VOICE-1 PIC X(03) VALUE SPACES. DTSBR405 +00128 10 WS-OPR-VOICE-2 PIC X(04) VALUE SPACES. DTSBR405 +00129 10 WS-OPR-VOICE-EXT PIC X(04) VALUE SPACES. DTSBR405 +00130 DTSBR405 +00131 ++INCLUDE DTSIC405 DTSBR405 +00132 05 WRK-FILING-DATE PIC X(10) VALUE SPACE. DTSBR405 +00133 EJECT DTSBR405 +00134 01 L119-LINK-AREA. DTSBR405 +00135 ++INCLUDE DTSIL119 DTSBR405 +00136 EJECT DTSBR405 +00137 01 L001-LINK-AREA. DTSBR405 +00138 ++INCLUDE DTSIL001 DTSBR405 +00139 EJECT DTSBR405 +00140 01 L009-LINK-AREA. DTSBR405 +00141 ++INCLUDE DTSIL009 DTSBR405 +00142 EJECT DTSBR405 +00143 01 L071-LINK-AREA. DTSBR405 +00144 ++INCLUDE DTSIL071 DTSBR405 +00145 EJECT DTSBR405 +00146 01 L082-LINK-AREA. DTSBR405 +00147 ++INCLUDE DTSIL082 DTSBR405 +00148 EJECT DTSBR405 +00149 ++INCLUDE DTSXL405 DTSBR405 +00150 DTSBR405 +00151 01 PAGE-HEADING1. DTSBR405 +00152 05 HDR1-LINE-1. DTSBR405 +00153 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00154 10 FILLER PIC X(05) DTSBR405 +00155 VALUE '405R1'. DTSBR405 +00156 10 FILLER PIC X(35) VALUE SPACES. DTSBR405 +00157 10 HDR1-AGY-NAME-LINE1 PIC X(50) VALUE SPACE. DTSBR405 +00158 10 FILLER PIC X(28) VALUE SPACES. DTSBR405 +00159 10 FILLER PIC X(05) DTSBR405 +00160 VALUE 'DATE:'. DTSBR405 +00161 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00162 10 HDR1-SYS-DATE PIC X(08) VALUE SPACE. DTSBR405 +00163 05 HDR1-LINE-2. DTSBR405 +00164 10 FILLER PIC X(41) VALUE SPACES. DTSBR405 +00165 10 HDR1-AGY-NAME-LINE2 PIC X(50) VALUE SPACE. DTSBR405 +00166 10 FILLER PIC X(28) VALUE SPACES. DTSBR405 +00167 10 FILLER PIC X(05) DTSBR405 +00168 VALUE 'TIME:'. DTSBR405 +00169 10 FILLER PIC X(41) VALUE SPACES. DTSBR405 +00170 10 HDR1-SYS-TIME PIC X(08) VALUE SPACE. DTSBR405 +00171 05 HDR1-LINE-3. DTSBR405 +00172 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00173 10 FILLER PIC X(35) DTSBR405 +00174 VALUE 'ROUTE TO: ENFORCEMENT UNIT '. DTSBR405 +00175 10 FILLER PIC X(83) VALUE SPACES. DTSBR405 +00176 10 FILLER PIC X(05) DTSBR405 +00177 VALUE 'PAGE:'. DTSBR405 +00178 10 FILLER PIC X(03) VALUE SPACES. DTSBR405 +00179 10 HDR1-PAGE-CNT PIC ZZ,ZZ9. DTSBR405 +00180 05 HDR1-LINE-4. DTSBR405 +00181 10 FILLER PIC X(53) VALUE SPACES. DTSBR405 +00182 10 FILLER PIC X(27) DTSBR405 +00183 VALUE ' LIEN RELEASE LIST '. DTSBR405 +00184 05 HDR1-LINE-5 PIC X(133) VALUE SPACES. DTSBR405 +00185 05 HDR1-LINE-6 PIC X(133) VALUE SPACES. DTSBR405 +00186 05 HDR1-LINE-7. DTSBR405 +00187 10 FILLER PIC X(13) VALUE SPACES. DTSBR405 +00188 10 FILLER PIC X(06) DTSBR405 +00189 VALUE 'EMP NO'. DTSBR405 +00190 10 FILLER PIC X(08) VALUE SPACES. DTSBR405 +00191 10 FILLER PIC X(13) DTSBR405 +00192 VALUE 'PRIMARY NAME '. DTSBR405 +00193 10 FILLER PIC X(34) VALUE SPACES. DTSBR405 +00194 10 FILLER PIC X(11) DTSBR405 +00195 VALUE 'OUC NO. '. DTSBR405 +00196 10 FILLER PIC X(04) VALUE SPACES. DTSBR405 +00197 10 FILLER PIC X(11) DTSBR405 +00198 VALUE 'RECORDER # '. DTSBR405 +00199 10 FILLER PIC X(06) VALUE SPACES. DTSBR405 +00200 10 FILLER PIC X(11) DTSBR405 +00201 VALUE 'LIEN DATE'. DTSBR405 +00202 DTSBR405 +00203 01 DETAIL-LINE1. DTSBR405 +00204 05 DTL1-LINE-2. DTSBR405 +00205 10 FILLER PIC X(13) VALUE SPACES. DTSBR405 +00206 10 DTL1-EMP-NO PIC 999B999. DTSBR405 +00207 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 +00208 10 DTL1-PRIMARY-NAME PIC X(40) VALUE SPACE. DTSBR405 +00209 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 +00210 10 DTL1-CERT-NO PIC X(10). DTSBR405 +00211 10 DTL1-CERT-NO-9 REDEFINES DTL1-CERT-NO. DTSBR405 +00212 15 DTL1-CERT-NO-6 PIC 99B9999. DTSBR405 +00213 15 DTL1-REST-3 PIC X(03). DTSBR405 +00214 10 FILLER PIC X(05) VALUE SPACES. DTSBR405 +00215 10 DTL1-DEED-NO PIC X(10). DTSBR405 +00216 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 +00217 10 DTL1-SLASH-DATE PIC X(10) VALUE SPACE. DTSBR405 +00218 DTSBR405 +00219 01 CONTROL-FOOTING-FINAL. DTSBR405 +00220 05 CFF-LINE-3. DTSBR405 +00221 10 FILLER PIC X(31) VALUE SPACES. DTSBR405 +00222 10 CFF-NUMBER-ONE PIC ZZ,ZZ9. DTSBR405 +00223 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00224 10 FILLER PIC X(12) DTSBR405 +00225 VALUE 'LIENS LISTED'. DTSBR405 +00226 EJECT DTSBR405 +00227 DTSBR405 +00228 01 PAGE-HEADING2. DTSBR405 +00229 05 HDR2-LINE-9. DTSBR405 +00230 10 FILLER PIC X(30) VALUE SPACES. DTSBR405 +00231 10 FILLER PIC X(24) DTSBR405 +00232 VALUE 'RECORDER OF DEEDS OF THE'. DTSBR405 +00233 05 HDR2-LINE-10. DTSBR405 +00234 10 FILLER PIC X(32) VALUE SPACES. DTSBR405 +00235 10 FILLER PIC X(20) DTSBR405 +00236 VALUE 'DISTRICT OF COLUMBIA'. DTSBR405 +00237 05 HDR2-LINE-11 PIC X(133) VALUE SPACES. DTSBR405 +00238 05 HDR2-LINE-12 PIC X(133) VALUE SPACES. DTSBR405 +00239 05 HDR2-LINE-13 PIC X(133) VALUE SPACES. DTSBR405 +00240 05 HDR2-LINE-14. DTSBR405 +00241 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00242 10 FILLER PIC X(20) DTSBR405 +00243 VALUE 'District of Columbia'. DTSBR405 +00244 10 FILLER PIC X(22) VALUE SPACES. DTSBR405 +00245 10 FILLER PIC X(01) DTSBR405 +00246 VALUE ')'. DTSBR405 +00247 05 HDR2-LINE-15. DTSBR405 +00248 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00249 10 FILLER PIC X(34) DTSBR405 +00250 VALUE 'Department of Employment Services'. DTSBR405 +00251 10 FILLER PIC X(08) VALUE SPACES. DTSBR405 +00252 10 FILLER PIC X(01) DTSBR405 +00253 VALUE ')'. DTSBR405 +00254 05 HDR2-LINE-16. DTSBR405 +00255 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00256 10 FILLER PIC X(35) DTSBR405 +00257 VALUE 'Office of Unemployment Compensation'. DTSBR405 +00258 10 FILLER PIC X(07) VALUE SPACES. DTSBR405 +00259 10 FILLER PIC X(01) DTSBR405 +00260 VALUE ')'. DTSBR405 +00261 05 HDR2-LINE-17. DTSBR405 +00262 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00263 10 HDR2-MAIL1-PHYS1-STRING PIC X(40). DTSBR405 +00264 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00265 10 FILLER PIC X(01) DTSBR405 +00266 VALUE ')'. DTSBR405 +00267 05 HDR2-LINE-18. DTSBR405 +00268 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00269 10 HDR2-AGY-MAIL2-NO-CAPS PIC X(40) VALUE SPACE. DTSBR405 +00270 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00271 10 FILLER PIC X(01) DTSBR405 +00272 VALUE ')'. DTSBR405 +00273 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00274 10 FILLER PIC X(22) DTSBR405 +00275 VALUE 'EMPLOYER ACCOUNT NO: '. DTSBR405 +00276 10 HDR2-EMP-NO PIC 999B999. DTSBR405 +00277 05 HDR2-LINE-19. DTSBR405 +00278 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 +00279 10 FILLER PIC X(01) DTSBR405 +00280 VALUE ')'. DTSBR405 +00281 05 HDR2-LINE-20. DTSBR405 +00282 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 +00283 10 FILLER PIC X(01) DTSBR405 +00284 VALUE ')'. DTSBR405 +00285 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00286 10 FILLER PIC X(22) DTSBR405 +00287 VALUE 'OUC CERTIFICATE NO: '. DTSBR405 +00288 10 HDR2-CERT-NO PIC X(10). DTSBR405 +00289 10 HDR2-CERT-NO-9 REDEFINES HDR2-CERT-NO. DTSBR405 +00290 15 HDR2-CERT-NO-6 PIC 99b9999. DTSBR405 +00291 15 HDR2-REST-3 PIC X(03). DTSBR405 +00292 05 HDR2-LINE-21. DTSBR405 +00293 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 +00294 10 FILLER PIC X(01) DTSBR405 +00295 VALUE ')'. DTSBR405 +00296 05 HDR2-LINE-22. DTSBR405 +00297 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 +00298 10 FILLER PIC X(01) DTSBR405 +00299 VALUE ')'. DTSBR405 +00300 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00301 10 FILLER PIC X(22) DTSBR405 +00302 VALUE 'RECORDER OF DEEDS NO: '. DTSBR405 +00303 10 HDR2-DEED-NO PIC X(10). DTSBR405 +00304 05 HDR2-LINE-23. DTSBR405 +00305 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 +00306 10 FILLER PIC X(01) DTSBR405 +00307 VALUE ')'. DTSBR405 +00308 05 HDR2-LINE-24. DTSBR405 +00309 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00310 10 HDR2-PRIMARY-NAME PIC X(40) VALUE SPACE. DTSBR405 +00311 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00312 10 FILLER PIC X(01) DTSBR405 +00313 VALUE ')'. DTSBR405 +00314 05 HDR2-LINE-25. DTSBR405 +00315 10 FILLER PIC X(43) VALUE SPACES. DTSBR405 +00316 10 FILLER PIC X(01) DTSBR405 +00317 VALUE ')'. DTSBR405 +00318 05 HDR2-LINE-26. DTSBR405 +00319 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00320 10 FILLER PIC X(08) DTSBR405 +00321 VALUE 'ADDRESS:'. DTSBR405 +00322 10 FILLER PIC X(34) VALUE SPACES. DTSBR405 +00323 10 FILLER PIC X(01) DTSBR405 +00324 VALUE ')'. DTSBR405 +00325 05 HDR2-LINE-27. DTSBR405 +00326 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00327 10 HDR2-FMT-LINE-1 PIC X(40) VALUE SPACE. DTSBR405 +00328 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00329 10 FILLER PIC X(01) DTSBR405 +00330 VALUE ')'. DTSBR405 +00331 05 HDR2-LINE-28. DTSBR405 +00332 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00333 10 HDR2-FMT-LINE-2 PIC X(40) VALUE SPACE. DTSBR405 +00334 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00335 10 fILLER PIC X(01) DTSBR405 +00336 VALUE ')'. DTSBR405 +00337 05 HDR2-LINE-29. DTSBR405 +00338 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00339 10 HDR2-FMT-LINE-3 PIC X(40) VALUE SPACE. DTSBR405 +00340 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00341 10 FILLER PIC X(01) DTSBR405 +00342 VALUE ')'. DTSBR405 +00343 05 HDR2-LINE-30. DTSBR405 +00344 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00345 10 HDR2-FMT-LINE-4 PIC X(40) VALUE SPACE. DTSBR405 +00346 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00347 10 FILLER PIC X(01) DTSBR405 +00348 VALUE ')'. DTSBR405 +00349 05 HDR2-LINE-31. DTSBR405 +00350 10 FILLER PIC X(01) VALUE SPACE. DTSBR405 +00351 10 HDR2-FMT-LINE-5 PIC X(40) VALUE SPACE. DTSBR405 +00352 10 FILLER PIC X(02) VALUE SPACES. DTSBR405 +00353 10 FILLER PIC X(01) DTSBR405 +00354 VALUE ')'. DTSBR405 +00355 05 HDR2-LINE-32 PIC X(133) VALUE SPACES. DTSBR405 +00356 05 HDR2-LINE-33 PIC X(133) VALUE SPACES. DTSBR405 +00357 05 HDR2-LINE-34. DTSBR405 +00358 10 FILLER PIC X(21) VALUE SPACES. DTSBR405 +00359 10 FILLER PIC X(30) DTSBR405 +00360 VALUE 'CERTIFICATE OF RELEASE OF LIEN'. DTSBR405 +00361 05 HDR2-LINE-35 PIC X(133) VALUE SPACES. DTSBR405 +00362 05 HDR2-LINE-36 PIC X(133) VALUE SPACES. DTSBR405 +00363 DTSBR405 +00364 ++INCLUDE DTSIZ405 DTSBR405 +00365 EJECT DTSBR405 +00366 LINKAGE SECTION. DTSBR405 +00367 DTSBR405 +00368 01 LRCM-LINK-AREA. DTSBR405 +00369 ++INCLUDE DTSILRCM DTSBR405 +00370 EJECT DTSBR405 +00371 01 R405-REC. DTSBR405 +00372 ++INCLUDE DTSIR405 DTSBR405 +00373 EJECT DTSBR405 +00374 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR405 +00375 R405-REC. DTSBR405 +00376 DTSBR405 +00377 IF FIRST-TIME-IND = 'Y' DTSBR405 +00378 PERFORM I1000-INITIATE DTSBR405 +00379 THRU I1000-EXIT DTSBR405 +00380 MOVE 'N' TO FIRST-TIME-IND. DTSBR405 +00381 DTSBR405 +00382 IF LRCM-EOR-88 DTSBR405 +00383 PERFORM T1000-TERMINATE DTSBR405 +00384 THRU T1000-EXIT DTSBR405 +00385 ELSE DTSBR405 +00386 PERFORM P1000-PROCESS DTSBR405 +00387 THRU P1000-EXIT. DTSBR405 +00388 DTSBR405 +00389 GOBACK. DTSBR405 +00390 EJECT DTSBR405 +00391 I1000-INITIATE. DTSBR405 +00392 DTSBR405 +00393 OPEN OUTPUT PRT-FILE1. DTSBR405 +00394 OPEN OUTPUT PRT-FILE2. DTSBR405 +00395 DTSBR405 +00396 MOVE LRCM-SYS-DATE TO HDR1-SYS-DATE. DTSBR405 +00397 MOVE LRCM-SYS-TIME TO HDR1-SYS-TIME. DTSBR405 +00398 MOVE LRCM-AGY-NAME-LINE1 TO HDR1-AGY-NAME-LINE1. DTSBR405 +00399 MOVE LRCM-AGY-NAME-LINE2 TO HDR1-AGY-NAME-LINE2. DTSBR405 +00400 MOVE SPACES TO PRT-RECORD. DTSBR405 +00401 DTSBR405 +00402 MOVE SPACES TO XEROX-REPORT. DTSBR405 +00403 * MOVE 'XXXXXXXX' TO REPORT-NUMBER. DTSBR405 +00404 DTSBR405 +00405 WRITE XEROX-REPORT FROM BLANK-LINE DTSBR405 +00406 AFTER ADVANCING TOP-OF-PAGE. DTSBR405 +00407 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL1 AFTER 1. DTSBR405 +00408 WRITE XEROX-REPORT FROM XEROX-XMOM-CNTL2 AFTER 1. DTSBR405 +00409 WRITE XEROX-REPORT FROM BLANK-LINE AFTER ADVANCING 8. DTSBR405 +00410 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE13 AFTER 1. DTSBR405 +00411 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE14 AFTER 1. DTSBR405 +00412 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE15 AFTEr 1. DTSBR405 +00413 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE16 AFTER 1. DTSBR405 +00414 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE17 AFTER 1. DTSBR405 +00415 DTSBR405 +00416 SET L119-REQ-MIXED-88 TO TRUE. DTSBR405 +00417 SET L119-REQ-NO-UNIT-88 TO TRUE. DTSBR405 +00418 DTSBR405 +00419 PERFORM S119-AGENCY-FACTS DTSBR405 +00420 THRU S119-EXIT. DTSBR405 +00421 DTSBR405 +00422 MOVE L119-AGY-MAIL2 TO WS-AGY-MAIL2-NO-CAPS DTSBR405 +00423 HDR2-AGY-MAIL2-NO-CAPS. DTSBR405 +00424 MOVE L119-AGY-MAIL1 TO WS-MAIL1-PHYS1-STRING DTSBR405 +00425 HDR2-MAIL1-PHYS1-STRING. DTSBR405 +00426 I1000-EXIT. DTSBR405 +00427 EXIT. DTSBR405 +00428 EJECT DTSBR405 +00429 P1000-PROCESS. DTSBR405 +00430 DTSBR405 +00431 MOVE LRCM-SYS-8-DATE TO WRK-TODAYS-DATE. DTSBR405 +00432 DTSBR405 +00433 IF WRK-DAY-2 = 1 AND WRK-DAY-1 NOT = 1 DTSBR405 +00434 MOVE WRK-ST TO WRK-DAY-SFX DTSBR405 +00435 ELSE DTSBR405 +00436 IF WRK-DAY-2 = 2 AND WRK-DAY-1 NOT = 1 DTSBR405 +00437 MOVE WRK-ND TO WRK-DAY-SFX DTSBR405 +00438 ELSE DTSBR405 +00439 IF WRK-DAY-2 = 3 AND WRK-DAY-1 NOT = 1 DTSBR405 +00440 MOVE WRK-RD TO WRK-DAY-SFX DTSBR405 +00441 ELSE DTSBR405 +00442 MOVE WRK-TH TO WRK-DAY-SFX. DTSBR405 +00443 MOVE SPACES TO WRK-MONTH-YEAR. DTSBR405 +00444 STRING WRK-MONTH-NAME (WRK-TODAY-MONTH) DELIMITED BY SPACE DTSBR405 +00445 ', ' DELIMITED BY SIZE DTSBR405 +00446 WRK-TODAY-YEAR DELIMITED BY SIZE DTSBR405 +00447 '.' DELIMITED BY SIZE DTSBR405 +00448 INTO WRK-MONTH-YEAR. DTSBR405 +00449 * MOVE R405-STMT-DATE TO L001-FED-8-DATE-9. DTSBR405 +00450 MOVE R405-CERTIFICATE-DATE TO L001-FED-8-DATE-9. DTSBR405 +00451 DTSBR405 +00452 PERFORM S001-FROM-FED-8 DTSBR405 +00453 THRU S001-EXIT. DTSBR405 +00454 DTSBR405 +00455 MOVE L001-SLASH-8-DATE TO WS-SLASH-DATE DTL1-SLASH-DATE. DTSBR405 +00456 DTSBR405 +00457 MOVE R405-REC-DEEDS-NO TO WS-REC-DEEDS-NO. DTSBR405 +00458 * IF WS-FIRST3-DIGITS = 'CNV' DTSBR405 +00459 * MOVE R405-CERTIFICATE-NO TO wS-CERT-NO-C DTL1-CERT-NO-6 DTSBR405 +00460 * HDR2-CERT-NO-6 DTSBR405 +00461 * MOVE SPACES TO DTL1-REST-3 DTSBR405 +00462 * MOVE SPACES TO HDR2-REST-3 DTSBR405 +00463 * ELSE DTSBR405 +00464 MOVE R405-CERTIFICATE-NO TO WS-CERT-NO-R DTL1-CERT-NO DTSBR405 +00465 HDR2-CERT-NO. DTSBR405 +00466 * END-IF. DTSBR405 +00467 DTSBR405 +00468 *** MOVE R405-REC-DEEDS-NO TO WS-CERT-NO-R DTSBR405 +00469 MOVE R405-REC-DEEDS-NO TO DTL1-DEED-NO DTSBR405 +00470 HDR2-DEED-NO. DTSBR405 +00471 DTSBR405 +00472 MOVE R405-PRIMARY-NAME TO HDR2-PRIMARY-NAME DTSBR405 +00473 DTL1-PRIMARY-NAME. DTSBR405 +00474 MOVE R405-FMT-LINE (1) TO HDR2-FMT-LINE-1. DTSBR405 +00475 MOVE R405-FMT-LINE (2) TO HDR2-FMT-LINE-2. DTSBR405 +00476 MOVE R405-FMT-LINE (3) TO HDR2-FMT-LINE-3. DTSBR405 +00477 MOVE R405-FMT-LINE (4) TO HDR2-FMT-LINE-4. DTSBR405 +00478 MOVE R405-FMT-LINE (5) TO HDR2-FMT-LINE-5. DTSBR405 +00479 * DTSBR405 +00480 MOVE R405-EMP-NO TO DTL1-EMP-NO DTSBR405 +00481 HDR2-EMP-NO. DTSBR405 +00482 ADD +1 TO WS-FOOT-NUMBER-ONE. DTSBR405 +00483 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT. DTSBR405 +00484 WRITE PRT-RECORD FROM DTL1-LINE-2 AFTER 2. DTSBR405 +00485 ADD +2 TO WS-LINE-CNT2. DTSBR405 +00486 ADD +1 TO WS-SUM-NUMBER-ONE. DTSBR405 +00487 * DTSBR405 +00488 PERFORM P4000-LOOKUP-OPID THRU P4000-EXIT. DTSBR405 +00489 PERFORM P3000-PRINT-XEROX THRU P3000-EXIT. DTSBR405 +00490 DTSBR405 +00491 P1000-EXIT. DTSBR405 +00492 EXIT. DTSBR405 +00493 DTSBR405 +00494 P2000-PRINT-HEADER. DTSBR405 +00495 IF WS-LINE-CNT GREATER 58 OR DTSBR405 +00496 WS-LINE-CNT2 GREATER 58 DTSBR405 +00497 MOVE +0 TO WS-LINE-CNT DTSBR405 +00498 MOVE +0 TO WS-LINE-CNT2 DTSBR405 +00499 ADD +1 TO WS-PAGE-CNT DTSBR405 +00500 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT DTSBR405 +00501 WRITE PRT-RECORD FROM HDR1-LINE-1 AFTER TOP-OF-PAGE DTSBR405 +00502 WRITE PRT-RECORD FROM HDR1-LINE-2 AFTER 1 DTSBR405 +00503 WRITE PRT-RECORD FROM HDR1-LINE-3 AFTER 1 DTSBR405 +00504 WRITE PRT-RECORD FROM HDR1-LINE-4 AFTER 1 DTSBR405 +00505 WRITE PRT-RECORD FROM HDR1-LINE-5 AFTER 1 DTSBR405 +00506 WRITE PRT-RECORD FROM HDR1-LINE-6 AFTER 1 DTSBR405 +00507 WRITE PRT-RECORD FROM HDR1-LINE-7 AFTER 1 DTSBR405 +00508 ADD +7 TO WS-LINE-CNT2. DTSBR405 +00509 P2000-EXIT. DTSBR405 +00510 EXIT. DTSBR405 +00511 DTSBR405 +00512 P3000-PRINT-XEROX. DTSBR405 +00513 DTSBR405 +00514 WRITE XEROX-REPORT FROM BLANK-LINE AFTER TOP-OF-PAGE. DTSBR405 +00515 WRITE XEROX-REPORT FROM HDR2-LINE-9 AFTER 8. DTSBR405 +00516 WRITE XEROX-REPORT FROM HDR2-LINE-10 AFTER 1. DTSBR405 +00517 WRITE XEROX-REPORT FROM HDR2-LINE-11 AFTER 1. DTSBR405 +00518 WRITE XEROX-REPORT FROM HDR2-LINE-12 AFTER 1. DTSBR405 +00519 WRITE XEROX-REPORT FROM HDR2-LINE-13 AFTER 1. DTSBR405 +00520 WRITE XEROX-REPORT FROM HDR2-LINE-14 AFTER 1. DTSBR405 +00521 WRITE XEROX-REPORT FROM HDR2-LINE-15 AFTER 1. DTSBR405 +00522 WRITE XEROX-REPORT FROM HDR2-LINE-16 AFTER 1. DTSBR405 +00523 WRITE XEROX-REPORT FROM HDR2-LINE-17 AFTER 1. DTSBR405 +00524 WRITE XEROX-REPORT FROM HDR2-LINE-18 AFTER 1. DTSBR405 +00525 WRITE XEROX-REPORT FROM HDR2-LINE-19 AFTER 1. DTSBR405 +00526 WRITE XEROX-REPORT FROM HDR2-LINE-20 AFTER 1. DTSBR405 +00527 WRITE XEROX-REPORT FROM HDR2-LINE-21 AFTER 1. DTSBR405 +00528 WRITE XEROX-REPORT FROM HDR2-LINE-22 AFTER 1. DTSBR405 +00529 WRITE XEROX-REPORT FROM HDR2-LINE-23 AFTER 1. DTSBR405 +00530 WRITE XEROX-REPORT FROM HDR2-LINE-24 AFTER 1. DTSBR405 +00531 WRITE XEROX-REPORT FROM HDR2-LINE-25 AFTER 1. DTSBR405 +00532 WRITE XEROX-REPORT FROM HDR2-LINE-26 AFTER 1. DTSBR405 +00533 WRITE XEROX-REPORT FROM HDR2-LINE-27 AFTER 1. DTSBR405 +00534 WRITE XEROX-REPORT FROM HDR2-LINE-28 AFTER 1. DTSBR405 +00535 WRITE XEROX-REPORT FROM HDR2-LINE-29 AFTER 1. DTSBR405 +00536 WRITE XEROX-REPORT FROM HDR2-LINE-30 AFTER 1. DTSBR405 +00537 WRITE XEROX-REPORT FROM HDR2-LINE-31 AFTER 1. DTSBR405 +00538 WRITE XEROX-REPORT FROM HDR2-LINE-32 AFTER 1. DTSBR405 +00539 WRITE XEROX-REPORT FROM HDR2-LINE-33 AFTER 1. DTSBR405 +00540 WRITE XEROX-REPORT FROM HDR2-LINE-34 AFTER 1. DTSBR405 +00541 WRITE XEROX-REPORT FROM HDR2-LINE-35 AFTER 1. DTSBR405 +00542 WRITE XEROX-REPORT FROM HDR2-LINE-36 AFTER 1. DTSBR405 +00543 WRITE XEROX-REPORT FROM DTL-LINE-2 AFTER 1. DTSBR405 +00544 WRITE XEROX-REPORT FROM DTL-LINE-2B AFTER 1. DTSBR405 +00545 WRITE XEROX-REPORT FROM DTL-LINE-3 AFTER 1. DTSBR405 +00546 WRITE XEROX-REPORT FROM DTL-LINE-4 AFTER 1. DTSBR405 +00547 WRITE XEROX-REPORT FROM DTL-LINE-5 AFTER 1. DTSBR405 +00548 WRITE XEROX-REPORT FROM DTL-LINE-6 AFTER 1. DTSBR405 +00549 WRITE XEROX-REPORT FROM DTL-LINE-7 AFTER 1. DTSBR405 +00550 * IF WS-FIRST3-DIGITS = 'CNV' DTSBR405 +00551 * WRITE XEROX-REPORT FROM DTL-LINE-8-A AFTER 1 DTSBR405 +00552 * ELSE DTSBR405 +00553 * WRITE XEROX-REPORT FROM DTL-LINE-8 AFTER 1. DTSBR405 +00554 WRITE XEROX-REPORT FROM DTL-LINE-9 AFTER 1. DTSBR405 +00555 WRITE XEROX-REPORT FROM DTL-LINE-10 AFTER 1. DTSBR405 +00556 DTSBR405 +00557 IF WRK-TODAY-DAY > 9 DTSBR405 +00558 MOVE WRK-TODAY-DAY TO WRK-TODAY-DAY-LINE-12 DTSBR405 +00559 MOVE WRK-DAY-SFX TO WRK-DAY-SFX-LINE-12 DTSBR405 +00560 MOVE WRK-MONTH-YEAR TO WRK-MONTH-YEAR-LINE-12 DTSBR405 +00561 WRITE XEROX-REPORT FROM DTL-LINE-12 AFTER 1 DTSBR405 +00562 ELSE DTSBR405 +00563 MOVE WRK-TODAY-DAY TO WRK-TODAY-DAY-LINE-11 DTSBR405 +00564 MOVE WRK-DAY-SFX TO WRK-DAY-SFX-LINE-11 DTSBR405 +00565 MOVE WRK-MONTH-YEAR TO WRK-MONTH-YEAR-LINE-11 DTSBR405 +00566 WRITE XEROX-REPORT FROM DTL-LINE-11 AFTER 1. DTSBR405 +00567 DTSBR405 +00568 WRITE XEROX-REPORT FROM DTL-LINE-13 AFTER 1. DTSBR405 +00569 WRITE XEROX-REPORT FROM DTL-LINE-14 AFTER 1. DTSBR405 +00570 WRITE XEROX-REPORT FROM DTL-LINE-15 AFTER 1. DTSBR405 +00571 WRITE XEROX-REPORT FROM DTL-LINE-16 AFTER 1. DTSBR405 +00572 WRITE XEROX-REPORT FROM DTL-LINE-16-1 AFTER 1. DTSBR405 +00573 WRITE XEROX-REPORT FROM DTL-LINE-17 AFTER 1. CL**3 +00574 WRITE XEROX-REPORT FROM DTL-LINE-18 AFTER 1. DTSBR405 +00575 WRITE XEROX-REPORT FROM DTL-LINE-19 AFTER 1. DTSBR405 +00576 WRITE XEROX-REPORT FROM DTL-LINE-20 AFTER 1. DTSBR405 +00577 WRITE XEROX-REPORT FROM DTL-LINE-21 AFTER 1. DTSBR405 +00578 WRITE XEROX-REPORT FROM DTL-LINE-22 AFTER 1. DTSBR405 +00579 * WRITE XEROX-REPORT FROM DTL-LINE-23 AFTER 1. DTSBR405 +00580 WRITE XEROX-REPORT FROM DTL-LINE-24 AFTER 1. DTSBR405 +00581 WRITE XEROX-REPORT FROM DTL-LINE-25 AFTER 1. DTSBR405 +00582 * WRITE XEROX-REPORT FROM DTL-LINE-26 AFTER 1. CL**5 +00583 * ADD +13 TO WS-LINE-CNT2. DTSBR405 +00584 DTSBR405 +00585 P3000-EXIT. DTSBR405 +00586 EXIT. DTSBR405 +00587 P4000-LOOKUP-OPID. DTSBR405 +00588 MOVE R405-OP-ID TO L082-OP-ID. DTSBR405 +00589 PERFORM S082-OP-ID-INFO THRU S082-EXIT. DTSBR405 +00590 IF L082-NOT-VALID-OP OR L082-INTERNAL-88 DTSBR405 +00591 MOVE SPACES TO WS-OPR-NAME-MIXED DTSBR405 +00592 WS-OPR-NAME-CAPS DTSBR405 +00593 MOVE LRCM-DEFAULT-NAME TO WS-OPR-NAME-CAPS DTSBR405 +00594 MOVE LRCM-DEFAULT-VOICE TO WS-OPR-VOICE DTSBR405 +00595 ELSE DTSBR405 +00596 MOVE L082-UNIT-NAME TO WS-OPR-UNIT-NAME-MIXED DTSBR405 +00597 MOVE L082-VOICE-1 TO WS-OPR-VOICE DTSBR405 +00598 MOVE L082-NAME TO L071-NAM DTSBR405 +00599 MOVE 2 TO L071-NAME-FORMAT DTSBR405 +00600 PERFORM S071-DESLASH-NAME THRU S071-EXIT DTSBR405 +00601 MOVE L071-NAM TO WS-OPR-NAME-MIXED DTSBR405 +00602 MOVE WS-OPR-NAME-MIXED TO L009-DATA DTSBR405 +00603 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT DTSBR405 +00604 MOVE L009-DATA TO WS-OPR-NAME-CAPS. DTSBR405 +00605 DTSBR405 +00606 MOVE WS-OPR-VOICE-AREA TO WS-FLD-VOICE-AREA. DTSBR405 +00607 MOVE WS-OPR-VOICE-1 TO WS-FLD-VOICE-1. DTSBR405 +00608 MOVE WS-OPR-VOICE-2 TO WS-FLD-VOICE-2. DTSBR405 +00609 MOVE WS-OPR-NAME-CAPS TO WS-FLD-REP-NAME. DTSBR405 +00610 DTSBR405 +00611 P4000-EXIT. EXIT. DTSBR405 +00612 EJECT DTSBR405 00613 DTSBR405 -00614 T1000-TERMINATE. DTSBR405 -00615 DTSBR405 -00616 IF WS-LINE-CNT2 > 52 DTSBR405 -00617 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR405 -00618 END-IF. DTSBR405 -00619 DTSBR405 -00620 MOVE WS-FOOT-NUMBER-ONE TO CFF-NUMBER-ONE. DTSBR405 -00621 WRITE PRT-RECORD FROM CFF-LINE-3 AFTER 3. DTSBR405 -00622 DTSBR405 -00623 CLOSE PRT-FILE1. DTSBR405 -00624 CLOSE PRT-FILE2. DTSBR405 -00625 DTSBR405 -00626 T1000-EXIT. DTSBR405 -00627 EXIT. DTSBR405 -00628 EJECT DTSBR405 -00629 S001-FROM-FED-8. DTSBR405 -00630 SET L001-FROM-FED-8 TO TRUE. DTSBR405 -00631 DTSBR405 -00632 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR405 -00633 S001-EXIT. DTSBR405 -00634 EXIT. DTSBR405 -00635 DTSBR405 -00636 S009-CONVERT-TO-CAPS. DTSBR405 -00637 DTSBR405 -00638 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR405 -00639 S009-EXIT. DTSBR405 -00640 EXIT. DTSBR405 -00641 DTSBR405 -00642 S071-DESLASH-NAME. DTSBR405 -00643 DTSBR405 -00644 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR405 -00645 DTSBR405 -00646 S071-EXIT. DTSBR405 -00647 EXIT. DTSBR405 -00648 DTSBR405 -00649 S082-OP-ID-INFO. DTSBR405 -00650 DTSBR405 -00651 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR405 -00652 DTSBR405 -00653 S082-EXIT. DTSBR405 -00654 EXIT. DTSBR405 -00655 DTSBR405 +00614 DTSBR405 +00615 T1000-TERMINATE. DTSBR405 +00616 DTSBR405 +00617 IF WS-LINE-CNT2 > 52 DTSBR405 +00618 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT DTSBR405 +00619 END-IF. DTSBR405 +00620 DTSBR405 +00621 MOVE WS-FOOT-NUMBER-ONE TO CFF-NUMBER-ONE. DTSBR405 +00622 WRITE PRT-RECORD FROM CFF-LINE-3 AFTER 3. DTSBR405 +00623 DTSBR405 +00624 CLOSE PRT-FILE1. DTSBR405 +00625 CLOSE PRT-FILE2. DTSBR405 +00626 DTSBR405 +00627 T1000-EXIT. DTSBR405 +00628 EXIT. DTSBR405 +00629 EJECT DTSBR405 +00630 S001-FROM-FED-8. DTSBR405 +00631 SET L001-FROM-FED-8 TO TRUE. DTSBR405 +00632 DTSBR405 +00633 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR405 +00634 S001-EXIT. DTSBR405 +00635 EXIT. DTSBR405 +00636 DTSBR405 +00637 S009-CONVERT-TO-CAPS. DTSBR405 +00638 DTSBR405 +00639 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR405 +00640 S009-EXIT. DTSBR405 +00641 EXIT. DTSBR405 +00642 DTSBR405 +00643 S071-DESLASH-NAME. DTSBR405 +00644 DTSBR405 +00645 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR405 +00646 DTSBR405 +00647 S071-EXIT. DTSBR405 +00648 EXIT. DTSBR405 +00649 DTSBR405 +00650 S082-OP-ID-INFO. DTSBR405 +00651 DTSBR405 +00652 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR405 +00653 DTSBR405 +00654 S082-EXIT. DTSBR405 +00655 EXIT. DTSBR405 00656 DTSBR405 -00657 S119-AGENCY-FACTS. DTSBR405 -00658 DTSBR405 -00659 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR405 -00660 DTSBR405 -00661 S119-EXIT. DTSBR405 -00662 EXIT. DTSBR405 -00663 DTSBR405 -00664 *S999-ABEND. DTSBR405 -00665 * DTSBR405 -00666 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR405 -00667 * DTSBR405 -00668 *S999-EXIT. DTSBR405 -00669 * EXIT. DTSBR405 +00657 DTSBR405 +00658 S119-AGENCY-FACTS. DTSBR405 +00659 DTSBR405 +00660 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR405 +00661 DTSBR405 +00662 S119-EXIT. DTSBR405 +00663 EXIT. DTSBR405 +00664 DTSBR405 +00665 *S999-ABEND. DTSBR405 +00666 * DTSBR405 +00667 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR405 +00668 * DTSBR405 +00669 *S999-EXIT. DTSBR405 +00670 * EXIT. DTSBR405 diff --git a/Batch/DTSBR414.cob b/Batch/DTSBR414.cob index 4d3ca22..120b2f9 100644 --- a/Batch/DTSBR414.cob +++ b/Batch/DTSBR414.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 04/06/17 +00001 IDENTIFICATION DIVISION. 07/02/24 00002 PROGRAM-ID. DTSBR414. DTSBR414 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV181 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV040 00004 DATE-WRITTEN. NOV 2002. DTSBR414 00005 DATE-COMPILED. DTSBR414 00006 SKIP3 DTSBR414 @@ -73,7 +73,7 @@ 00073 DTSBR414 00074 FILE-CONTROL. DTSBR414 00075 SELECT PRT-FILE1 ASSIGN TO RPT414R1. DTSBR414 -00076 SELECT PRT-FILE2 ASSIGN TO RPT414R2. DTSBR414 +00076 SELECT PRT-FILE2 ASSIGN TO RPT414R2. CL**6 00077 SELECT PRT-FILE4 ASSIGN TO RPT414R4. DTSBR414 00078 SELECT PRT-FILE6 ASSIGN TO RPT414R6. DTSBR414 00079 SKIP3 DTSBR414 @@ -86,10 +86,10 @@ 00086 01 PRT-REC1. DTSBR414 00087 05 FILLER PIC X(132). DTSBR414 00088 SKIP3 DTSBR414 -00089 FD PRT-FILE2 DTSBR414 -00090 LABEL RECORDS ARE STANDARD. DTSBR414 -00091 01 PRT-REC2. DTSBR414 -00092 05 FILLER PIC X(132). DTSBR414 +00089 FD PRT-FILE2 CL**6 +00090 LABEL RECORDS ARE STANDARD. CL**6 +00091 01 PRT-REC2. CL**6 +00092 05 FILLER PIC X(132). CL**6 00093 FD PRT-FILE4 DTSBR414 00094 LABEL RECORDS ARE STANDARD. DTSBR414 00095 01 PRT-REC4. DTSBR414 @@ -100,1038 +100,1056 @@ 00100 05 FILLER PIC X(132). DTSBR414 00101 SKIP3 DTSBR414 00102 WORKING-STORAGE SECTION. DTSBR414 -001025 77 PAN-VALET PICTURE X(24) VALUE '181DTSBR414 04/06/17'. DTSBR414 -00103 77 PAN-VALET PICTURE X(24) VALUE '014DTSBR414 04/06/17'. DTSBR414 -00104 77 PAN-VALET PICTURE X(24) VALUE '179DTSBR414 07/10/14'. DTSBR414 -00105 77 PAN-VALET PICTURE X(24) VALUE '039DTSBR414 07/08/14'. DTSBR414 -00106 SKIP3 DTSBR414 -00107 01 WRK-AREA-CONSTANTS. DTSBR414 -00108 05 WRK-ABEND-CD PIC S9(04) COMP DTSBR414 -00109 VALUE +414. DTSBR414 -00110 DTSBR414 -00111 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR414 -00112 DTSBR414 -00113 05 TOT-LINE-CNT PIC S9(04) COMP VALUE +47. DTSBR414 -00114 05 MAX-QTR-PRINT PIC S9(04) COMP VALUE +6. DTSBR414 -00115 05 LINE-CNT PIC S9(04) COMP VALUE +0. DTSBR414 -00116 05 WS-REPT-CNT PIC S9(05) COMP VALUE +0. DTSBR414 -00117 05 REC2-LINE-CNT PIC S9(04) COMP VALUE +55. DTSBR414 -00118 05 REC2-PAGE-CNT PIC S9(04) COMP VALUE +0. DTSBR414 -00119 05 WS-FLD-REP-ID PIC X(02) VALUE SPACES. DTSBR414 -00120 05 WS-qtr4-FLD-REP-ID PIC X(02) VALUE SPACES. DTSBR414 -00121 05 REC3-LINE-CNT PIC S9(04) COMP VALUE +55. DTSBR414 -00122 05 REC3-PAGE-CNT PIC S9(04) COMP VALUE +0. DTSBR414 -00123 DTSBR414 -00124 05 ABEND-MSG PIC X(60) VALUE SPACE. DTSBR414 -00125 05 BLKLINE PIC X(133) VALUE SPACE. DTSBR414 -00126 DTSBR414 -00127 05 PRT-FILE1-PAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBR414 -00128 DTSBR414 -00129 05 DISPLAY-CNT PIC X(09) VALUE ZEROS. DTSBR414 -00130 05 DISPLAY-CNT-Z REDEFINES DISPLAY-CNT DTSBR414 -00131 PIC Z,ZZZ,ZZ9. DTSBR414 -00132 05 WS-WRK-QTR PIC 9(05) VALUE ZEROS. DTSBR414 -00133 05 WS-WRK-QTR-X REDEFINES WS-WRK-QTR. DTSBR414 -00134 10 WRK-QTR-YR PIC 9(04). DTSBR414 -00135 10 WRK-QTR-Q PIC 9(01). DTSBR414 -00136 DTSBR414 -00137 05 WS-PRT-QTR. DTSBR414 -00138 10 WRK-PRT-YR PIC X(04) VALUE SPACES. DTSBR414 -00139 10 WRK-PRT-SLASH PIC X(01) VALUE SPACES. DTSBR414 -00140 10 WRK-PRT-Q PIC X(01) VALUE SPACES. DTSBR414 -00141 DTSBR414 -00142 05 WS-EMP-NAME. DTSBR414 -00143 10 WRK-FIRST-4 PIC X(04) VALUE SPACES. DTSBR414 -00144 10 WRK-LAST-36 PIC X(36) VALUE SPACES. DTSBR414 -00145 DTSBR414 -00146 SKIP3 DTSBR414 -00147 05 WS-REC PIC X(132) VALUE SPACES. DTSBR414 -00148 05 WS-XREC PIC X(132) VALUE SPACES. DTSBR414 -00149 DTSBR414 -00150 05 AMT-DISPLAYED-IND PIC X(01). DTSBR414 -00151 88 AMT-DISPLAYED-NO-88 VALUE 'N'. DTSBR414 -00152 88 AMT-DISPLAYED-YES-88 VALUE 'Y'. DTSBR414 -00153 DTSBR414 -00154 05 PRINT-PRIOR-QTRS-IND PIC X(01). DTSBR414 -00155 88 PRINT-PRIOR-QTRS-NO-88 VALUE 'N'. DTSBR414 -00156 88 PRINT-PRIOR-QTRS-YES-88 VALUE 'Y'. DTSBR414 -00157 DTSBR414 -00158 05 PRINT-STMT-IND PIC X(01). DTSBR414 -00159 88 PRINT-STMT-NO-88 VALUE 'N'. DTSBR414 -00160 88 PRINT-STMT-YES-88 VALUE 'Y'. DTSBR414 -00161 DTSBR414 -00162 05 PRINT-BILL-IND PIC X(01). DTSBR414 -00163 88 PRINT-BILL-NO-88 VALUE 'N'. DTSBR414 -00164 88 PRINT-BILL-YES-88 VALUE 'Y'. DTSBR414 -00165 DTSBR414 -00166 05 PRINT-FNOTE1-IND PIC X(01). DTSBR414 -00167 88 PRINT-FNOTE1-NO-88 VALUE 'N'. DTSBR414 -00168 88 PRINT-FNOTE1-YES-88 VALUE 'Y'. DTSBR414 -00169 DTSBR414 -00170 05 PRINT-FNOTE2-IND PIC X(01). DTSBR414 -00171 88 PRINT-FNOTE2-NO-88 VALUE 'N'. DTSBR414 -00172 88 PRINT-FNOTE2-YES-88 VALUE 'Y'. DTSBR414 -00173 DTSBR414 -00174 05 PRINT-FNOTE3-IND PIC X(01). DTSBR414 -00175 88 PRINT-FNOTE3-NO-88 VALUE 'N'. DTSBR414 -00176 88 PRINT-FNOTE3-YES-88 VALUE 'Y'. DTSBR414 -00177 DTSBR414 -00178 05 PRINT-FNOTE4-IND PIC X(01). DTSBR414 -00179 88 PRINT-FNOTE4-NO-88 VALUE 'N'. DTSBR414 -00180 88 PRINT-FNOTE4-YES-88 VALUE 'Y'. DTSBR414 -00181 DTSBR414 -00182 05 SUM-PRIOR-QTRS-IND PIC X(01). DTSBR414 -00183 88 SUM-PRIOR-QTRS-NO-88 VALUE 'N'. DTSBR414 -00184 88 SUM-PRIOR-QTRS-YES-88 VALUE 'Y'. DTSBR414 -00185 DTSBR414 -00186 SKIP3 DTSBR414 -00187 05 WS-TOTAL-CONTRIB-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00188 VALUE +0. DTSBR414 -00189 05 WS-TOTAL-INTEREST-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00190 VALUE +0. DTSBR414 -00191 05 WS-TOTAL-SURCHARG-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00192 VALUE +0. DTSBR414 -00193 05 WS-TOTAL-PENALTY-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00194 VALUE +0. DTSBR414 -00195 05 WS-TOTAL-BALANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00196 VALUE +0. DTSBR414 -00197 05 WS-STUB-BALANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00198 VALUE +0. DTSBR414 -00199 05 WS-max-camt PIC S9(09)V9(02) COMP-3 DTSBR414 -00200 VALUE +0. DTSBR414 -00201 05 WS-max-iamt PIC S9(09)V9(02) COMP-3 DTSBR414 -00202 VALUE +0. DTSBR414 -00203 05 WS-max-samt PIC S9(09)V9(02) COMP-3 DTSBR414 -00204 VALUE +0. DTSBR414 -00205 05 WS-max-PAMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00206 VALUE +0. DTSBR414 -00207 05 ws-max-BAMT PIC S9(09)V9(02) COMP-3 DTSBR414 -00208 VALUE +0. DTSBR414 -00209 05 WS-QTR-PLUS20 PIC 9(3) VALUE ZERO. DTSBR414 -00210 05 WS-QTR4-cnt PIC 9(3) VALUE ZERO. DTSBR414 -00211 05 WS-QTR-CNT PIC 9(3) VALUE ZERO. DTSBR414 -00212 05 WS-QTR-IDX PIC 9(3) VALUE ZERO. DTSBR414 -00213 05 WRK-CNT PIC 9(3) DTSBR414 -00214 VALUE ZERO. DTSBR414 -00215 05 WRK-CTR PIC S9(04) COMP DTSBR414 -00216 VALUE +0. DTSBR414 -00217 05 WS-QTR-FNOTE PIC X(7) VALUE SPACES. DTSBR414 -00218 05 WS-QTR-FNOTEX REDEFINES WS-QTR-FNOTE. DTSBR414 -00219 10 WFNOTE1 PIC X(03). DTSBR414 -00220 10 WFNOTE2 PIC X(03). DTSBR414 -00221 10 FILLER PIC X. DTSBR414 -00222 EJECT DTSBR414 -00223 ** DTSBR414 -00224 ++INCLUDE DTSXL414 DTSBR414 -00225 SKIP3 DTSBR414 -00226 05 CONVERT-BARCODE-LINE. DTSBR414 -00227 10 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR414 -00228 DTSBR414 -00229 05 WS-BARC-LINE. DTSBR414 -00230 10 FILLER PIC X(40) VALUE SPACES. DTSBR414 -00231 10 CONVERTED-BARCODE PIC X(50). DTSBR414 -00232 10 FILLER PIC X(30) VALUE SPACES. DTSBR414 -00233 ** DTSBR414 -00234 05 STUB-LINE. DTSBR414 -00235 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00236 10 STUB-EMP-NO PIC 999B999. DTSBR414 -00237 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00238 10 STUB-EMP-FEIN PIC 99B9999999. DTSBR414 -00239 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00240 10 STUB-STMT-DATE PIC X(10). DTSBR414 -00241 10 FILLER PIC X(06) VALUE SPACES. DTSBR414 -00242 10 STUB-COMP-DATE PIC X(10). DTSBR414 -00243 10 FILLER PIC X(07) VALUE SPACES. DTSBR414 -00244 10 STUB-AMT PIC $,$$$,$$$.$$. DTSBR414 -00245 DTSBR414 -00246 05 ADDR01. DTSBR414 -00247 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 -00248 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 -00249 10 STUB-ADDR-LINE1 PIC X(40). DTSBR414 -00250 10 FILLER PIC X(23) value spaces. DTSBR414 -00251 DTSBR414 -00252 05 ADDR02. DTSBR414 -00253 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 -00254 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 -00255 10 STUB-ADDR-LINE2 PIC X(40). DTSBR414 -00256 10 FILLER PIC X(23) value spaces. DTSBR414 -00257 DTSBR414 -00258 05 ADDR03. DTSBR414 -00259 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 -00260 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 -00261 10 STUB-ADDR-LINE3 PIC X(40). DTSBR414 -00262 10 FILLER PIC X(23) value spaces. DTSBR414 -00263 DTSBR414 -00264 05 ADDR04. DTSBR414 -00265 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 -00266 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 -00267 10 STUB-ADDR-LINE4 PIC X(40). DTSBR414 -00268 10 FILLER PIC X(32) VALUE SPACES. DTSBR414 -00269 DTSBR414 -00270 05 ADDR05. DTSBR414 -00271 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 -00272 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 -00273 10 STUB-ADDR-LINE5 PIC X(40). DTSBR414 -00274 10 FILLER PIC X(32) VALUE SPACES. DTSBR414 -00275 DTSBR414 -00276 05 STMT-LINE2. DTSBR414 -00277 10 FILLER PIC X(63) VALUE SPACE. DTSBR414 -00278 10 STMT-LAST-ACCT-UPDATE-DATE DTSBR414 -00279 PIC X(10). DTSBR414 -00280 10 FILLER PIC X(02) VALUE '. '. DTSBR414 -00281 DTSBR414 -00282 05 STMT-LINE1. DTSBR414 -00283 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00284 10 STMT-EMP-NO PIC 999B999. DTSBR414 -00285 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00286 10 STMT-NAME-CHEK PIC X(04). DTSBR414 -00287 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00288 10 STMT-EMP-FEIN PIC 99B9999999. DTSBR414 -00289 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00290 10 STMT-STMT-DATE PIC X(10). DTSBR414 -00291 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00292 10 STMT-COMP-DATE PIC X(10). DTSBR414 -00293 10 FILLER PIC X(06) VALUE SPACES. DTSBR414 -00294 DTSBR414 -00295 05 STMT-QTR-DETAIL. DTSBR414 -00296 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 -00297 10 QTR-DET-YR. DTSBR414 -00298 15 QTR-DET-YR1 PIC X(06). DTSBR414 -00299 15 QTR-DET-YR2 PIC X(03). DTSBR414 -00300 10 QTR-DET-FNOTE. DTSBR414 -00301 15 QTR-DET-FNOTE1 PIC X(06). DTSBR414 -00302 15 QTR-DET-FNOTE2 PIC X(01). DTSBR414 -00303 10 FILLER PIC X(02). DTSBR414 -00304 10 QTR-DET-CONTRIB-AMT PIC ZZZ,ZZZ,ZZZ.ZZ. DTSBR414 -00305 * 10 FILLER PIC X(04). DTSBR414 -00306 10 QTR-DET-INTEREST-AMT PIC ZZZ,ZZZ,ZZZ.ZZ. DTSBR414 -00307 * 10 FILLER PIC X(03). DTSBR414 -00308 10 QTR-DET-PENALTY-AMT PIC Z,ZZZ,ZZZ.ZZ. DTSBR414 -00309 * 10 FILLER PIC X(03). DTSBR414 -00310 10 QTR-DET-SURCHARG-AMT PIC Z,ZZZ,ZZZ.ZZ. DTSBR414 -00311 10 FILLER PIC X(02). DTSBR414 -00312 10 QTR-DET-BALANCE-AMT PIC ZZZ,ZZZ,ZZZ.ZZ. DTSBR414 -00313 10 FILLER PIC X(02). DTSBR414 -00314 DTSBR414 -00315 05 STMT-TOTAL-LINE. DTSBR414 -00316 10 FILLER PIC X(21) VALUE SPACE. DTSBR414 -00317 10 TOTAL-CONTRIB-AMT PIC $$$,$$$,$$$.$$. DTSBR414 -00318 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00319 10 TOTAL-INTEREST-AMT PIC $$$,$$$,$$$.$$. DTSBR414 -00320 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00321 10 TOTAL-PENALTY-AMT PIC $,$$$,$$$.$$. DTSBR414 -00322 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00323 10 TOTAL-SURCHARG-AMT PIC $$,$$$,$$$.$$. DTSBR414 -00324 10 FILLER PIC X(01) VALUE SPACES. DTSBR414 -00325 10 TOTAL-BALANCE-AMT PIC $$$,$$$,$$$.$$. DTSBR414 -00326 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00327 DTSBR414 -00328 05 FNOTE1. DTSBR414 -00329 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 -00330 10 FILLER PIC X(31) VALUE DTSBR414 -00331 '(a) = estimated report on file'. DTSBR414 -00332 DTSBR414 -00333 05 FNOTE2. DTSBR414 -00334 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 -00335 10 FILLER PIC X(31) VALUE DTSBR414 -00336 '(b) = report missing '. DTSBR414 -00337 DTSBR414 -00338 05 FNOTE3. DTSBR414 -00339 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 -00340 10 FILLER PIC X(31) VALUE DTSBR414 -00341 '(c) = annual report '. DTSBR414 -00342 DTSBR414 -00343 05 FNOTE4. DTSBR414 -00344 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 -00345 10 FILLER PIC X(31) VALUE DTSBR414 -00346 '(d) = appeal pending '. DTSBR414 -00347 DTSBR414 -00348 05 FNOTE-MISSING-RPT. DTSBR414 -00349 10 FILLER PIC X(33) VALUE SPACE. DTSBR414 -00350 10 FILLER PIC X(57) VALUE DTSBR414 -00351 'Balance Due does not include charges for missing reports'. DTSBR414 -00352 DTSBR414 +001025 77 PAN-VALET PICTURE X(24) VALUE '040DTSBR414 07/02/24'. DTSBR414 +00103 77 PAN-VALET PICTURE X(24) VALUE '181DTSBR414 04/06/17'. DTSBR414 +00104 77 PAN-VALET PICTURE X(24) VALUE '014DTSBR414 04/06/17'. DTSBR414 +00105 77 PAN-VALET PICTURE X(24) VALUE '179DTSBR414 07/10/14'. DTSBR414 +00106 77 PAN-VALET PICTURE X(24) VALUE '039DTSBR414 07/08/14'. DTSBR414 +00107 SKIP3 DTSBR414 +00108 01 WRK-AREA-CONSTANTS. DTSBR414 +00109 05 WRK-ABEND-CD PIC S9(04) COMP DTSBR414 +00110 VALUE +414. DTSBR414 +00111 DTSBR414 +00112 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR414 +00113 DTSBR414 +00114 05 TOT-LINE-CNT PIC S9(04) COMP VALUE +47. DTSBR414 +00115 05 MAX-QTR-PRINT PIC S9(04) COMP VALUE +6. DTSBR414 +00116 05 LINE-CNT PIC S9(04) COMP VALUE +0. DTSBR414 +00117 05 WS-REPT-CNT PIC S9(05) COMP VALUE +0. DTSBR414 +00118 05 REC2-LINE-CNT PIC S9(04) COMP VALUE +55. DTSBR414 +00119 05 REC2-PAGE-CNT PIC S9(04) COMP VALUE +0. DTSBR414 +00120 05 WS-FLD-REP-ID PIC X(02) VALUE SPACES. DTSBR414 +00121 05 WS-qtr4-FLD-REP-ID PIC X(02) VALUE SPACES. DTSBR414 +00122 05 REC3-LINE-CNT PIC S9(04) COMP VALUE +55. DTSBR414 +00123 05 REC3-PAGE-CNT PIC S9(04) COMP VALUE +0. DTSBR414 +00124 DTSBR414 +00125 05 ABEND-MSG PIC X(60) VALUE SPACE. DTSBR414 +00126 05 BLKLINE PIC X(133) VALUE SPACE. DTSBR414 +00127 DTSBR414 +00128 05 PRT-FILE1-PAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBR414 +00129 DTSBR414 +00130 05 DISPLAY-CNT PIC X(09) VALUE ZEROS. DTSBR414 +00131 05 DISPLAY-CNT-Z REDEFINES DISPLAY-CNT DTSBR414 +00132 PIC Z,ZZZ,ZZ9. DTSBR414 +00133 05 WS-WRK-QTR PIC 9(05) VALUE ZEROS. DTSBR414 +00134 05 WS-WRK-QTR-X REDEFINES WS-WRK-QTR. DTSBR414 +00135 10 WRK-QTR-YR PIC 9(04). DTSBR414 +00136 10 WRK-QTR-Q PIC 9(01). DTSBR414 +00137 DTSBR414 +00138 05 WS-PRT-QTR. DTSBR414 +00139 10 WRK-PRT-YR PIC X(04) VALUE SPACES. DTSBR414 +00140 10 WRK-PRT-SLASH PIC X(01) VALUE SPACES. DTSBR414 +00141 10 WRK-PRT-Q PIC X(01) VALUE SPACES. DTSBR414 +00142 DTSBR414 +00143 05 WS-EMP-NAME. DTSBR414 +00144 10 WRK-FIRST-4 PIC X(04) VALUE SPACES. DTSBR414 +00145 10 WRK-LAST-36 PIC X(36) VALUE SPACES. DTSBR414 +00146 DTSBR414 +00147 SKIP3 DTSBR414 +00148 05 WS-REC PIC X(132) VALUE SPACES. DTSBR414 +00149 05 WS-XREC PIC X(132) VALUE SPACES. DTSBR414 +00150 DTSBR414 +00151 05 AMT-DISPLAYED-IND PIC X(01). DTSBR414 +00152 88 AMT-DISPLAYED-NO-88 VALUE 'N'. DTSBR414 +00153 88 AMT-DISPLAYED-YES-88 VALUE 'Y'. DTSBR414 +00154 DTSBR414 +00155 05 PRINT-PRIOR-QTRS-IND PIC X(01). DTSBR414 +00156 88 PRINT-PRIOR-QTRS-NO-88 VALUE 'N'. DTSBR414 +00157 88 PRINT-PRIOR-QTRS-YES-88 VALUE 'Y'. DTSBR414 +00158 DTSBR414 +00159 05 PRINT-STMT-IND PIC X(01). DTSBR414 +00160 88 PRINT-STMT-NO-88 VALUE 'N'. DTSBR414 +00161 88 PRINT-STMT-YES-88 VALUE 'Y'. DTSBR414 +00162 DTSBR414 +00163 05 PRINT-BILL-IND PIC X(01). DTSBR414 +00164 88 PRINT-BILL-NO-88 VALUE 'N'. DTSBR414 +00165 88 PRINT-BILL-YES-88 VALUE 'Y'. DTSBR414 +00166 DTSBR414 +00167 05 PRINT-FNOTE1-IND PIC X(01). DTSBR414 +00168 88 PRINT-FNOTE1-NO-88 VALUE 'N'. DTSBR414 +00169 88 PRINT-FNOTE1-YES-88 VALUE 'Y'. DTSBR414 +00170 DTSBR414 +00171 05 PRINT-FNOTE2-IND PIC X(01). DTSBR414 +00172 88 PRINT-FNOTE2-NO-88 VALUE 'N'. DTSBR414 +00173 88 PRINT-FNOTE2-YES-88 VALUE 'Y'. DTSBR414 +00174 DTSBR414 +00175 05 PRINT-FNOTE3-IND PIC X(01). DTSBR414 +00176 88 PRINT-FNOTE3-NO-88 VALUE 'N'. DTSBR414 +00177 88 PRINT-FNOTE3-YES-88 VALUE 'Y'. DTSBR414 +00178 DTSBR414 +00179 05 PRINT-FNOTE4-IND PIC X(01). DTSBR414 +00180 88 PRINT-FNOTE4-NO-88 VALUE 'N'. DTSBR414 +00181 88 PRINT-FNOTE4-YES-88 VALUE 'Y'. DTSBR414 +00182 DTSBR414 +00183 05 SUM-PRIOR-QTRS-IND PIC X(01). DTSBR414 +00184 88 SUM-PRIOR-QTRS-NO-88 VALUE 'N'. DTSBR414 +00185 88 SUM-PRIOR-QTRS-YES-88 VALUE 'Y'. DTSBR414 +00186 DTSBR414 +00187 SKIP3 DTSBR414 +00188 05 WS-TOTAL-CONTRIB-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00189 VALUE +0. DTSBR414 +00190 05 WS-TOTAL-INTEREST-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00191 VALUE +0. DTSBR414 +00192 05 WS-TOTAL-SURCHARG-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00193 VALUE +0. DTSBR414 +00194 05 WS-TOTAL-PENALTY-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00195 VALUE +0. DTSBR414 +00196 05 WS-TOTAL-BALANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00197 VALUE +0. DTSBR414 +00198 05 WS-STUB-BALANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00199 VALUE +0. DTSBR414 +00200 05 WS-max-camt PIC S9(09)V9(02) COMP-3 DTSBR414 +00201 VALUE +0. DTSBR414 +00202 05 WS-max-iamt PIC S9(09)V9(02) COMP-3 DTSBR414 +00203 VALUE +0. DTSBR414 +00204 05 WS-max-samt PIC S9(09)V9(02) COMP-3 DTSBR414 +00205 VALUE +0. DTSBR414 +00206 05 WS-max-PAMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00207 VALUE +0. DTSBR414 +00208 05 ws-max-BAMT PIC S9(09)V9(02) COMP-3 DTSBR414 +00209 VALUE +0. DTSBR414 +00210 05 WS-QTR-PLUS20 PIC 9(3) VALUE ZERO. DTSBR414 +00211 05 WS-QTR4-cnt PIC 9(3) VALUE ZERO. DTSBR414 +00212 05 WS-QTR-CNT PIC 9(3) VALUE ZERO. DTSBR414 +00213 05 WS-QTR-IDX PIC 9(3) VALUE ZERO. DTSBR414 +00214 05 WRK-CNT PIC 9(3) DTSBR414 +00215 VALUE ZERO. DTSBR414 +00216 05 WRK-CTR PIC S9(04) COMP DTSBR414 +00217 VALUE +0. DTSBR414 +00218 05 WS-QTR-FNOTE PIC X(7) VALUE SPACES. DTSBR414 +00219 05 WS-QTR-FNOTEX REDEFINES WS-QTR-FNOTE. DTSBR414 +00220 10 WFNOTE1 PIC X(03). DTSBR414 +00221 10 WFNOTE2 PIC X(03). DTSBR414 +00222 10 FILLER PIC X. DTSBR414 +00223 EJECT DTSBR414 +00224 ** DTSBR414 +00225 ++INCLUDE DTSXL414 DTSBR414 +00226 SKIP3 DTSBR414 +00227 05 CONVERT-BARCODE-LINE. DTSBR414 +00228 10 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR414 +00229 DTSBR414 +00230 05 WS-BARC-LINE. DTSBR414 +00231 10 FILLER PIC X(40) VALUE SPACES. DTSBR414 +00232 10 CONVERTED-BARCODE PIC X(50). DTSBR414 +00233 10 FILLER PIC X(30) VALUE SPACES. DTSBR414 +00234 ** DTSBR414 +00235 05 STUB-LINE. DTSBR414 +00236 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00237 10 STUB-EMP-NO PIC 999B999. DTSBR414 +00238 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00239 10 STUB-EMP-FEIN PIC 99B9999999. DTSBR414 +00240 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00241 10 STUB-STMT-DATE PIC X(10). DTSBR414 +00242 10 FILLER PIC X(06) VALUE SPACES. DTSBR414 +00243 10 STUB-COMP-DATE PIC X(10). DTSBR414 +00244 10 FILLER PIC X(07) VALUE SPACES. DTSBR414 +00245 10 STUB-AMT PIC $,$$$,$$$.$$. DTSBR414 +00246 DTSBR414 +00247 05 ADDR01. DTSBR414 +00248 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 +00249 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 +00250 10 STUB-ADDR-LINE1 PIC X(40). DTSBR414 +00251 10 FILLER PIC X(23) value spaces. DTSBR414 +00252 DTSBR414 +00253 05 ADDR02. DTSBR414 +00254 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 +00255 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 +00256 10 STUB-ADDR-LINE2 PIC X(40). DTSBR414 +00257 10 FILLER PIC X(23) value spaces. DTSBR414 +00258 DTSBR414 +00259 05 ADDR03. DTSBR414 +00260 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 +00261 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 +00262 10 STUB-ADDR-LINE3 PIC X(40). DTSBR414 +00263 10 FILLER PIC X(23) value spaces. DTSBR414 +00264 DTSBR414 +00265 05 ADDR04. DTSBR414 +00266 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 +00267 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 +00268 10 STUB-ADDR-LINE4 PIC X(40). DTSBR414 +00269 10 FILLER PIC X(32) VALUE SPACES. DTSBR414 +00270 DTSBR414 +00271 05 ADDR05. DTSBR414 +00272 10 FILLER PIC X(01) VALUE SPACE. DTSBR414 +00273 10 FILLER PIC X(27) VALUE SPACES. DTSBR414 +00274 10 STUB-ADDR-LINE5 PIC X(40). DTSBR414 +00275 10 FILLER PIC X(32) VALUE SPACES. DTSBR414 +00276 DTSBR414 +00277 05 STMT-LINE2. DTSBR414 +00278 10 FILLER PIC X(63) VALUE SPACE. DTSBR414 +00279 10 STMT-LAST-ACCT-UPDATE-DATE DTSBR414 +00280 PIC X(10). DTSBR414 +00281 10 FILLER PIC X(02) VALUE '. '. DTSBR414 +00282 DTSBR414 +00283 05 STMT-LINE1. DTSBR414 +00284 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00285 10 STMT-EMP-NO PIC 999B999. DTSBR414 +00286 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00287 10 STMT-NAME-CHEK PIC X(04). DTSBR414 +00288 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00289 10 STMT-EMP-FEIN PIC 99B9999999. DTSBR414 +00290 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00291 10 STMT-STMT-DATE PIC X(10). DTSBR414 +00292 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00293 10 STMT-COMP-DATE PIC X(10). DTSBR414 +00294 10 FILLER PIC X(06) VALUE SPACES. DTSBR414 +00295 DTSBR414 +00296 05 STMT-QTR-DETAIL. DTSBR414 +00297 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 +00298 10 QTR-DET-YR. DTSBR414 +00299 15 QTR-DET-YR1 PIC X(06). DTSBR414 +00300 15 QTR-DET-YR2 PIC X(03). DTSBR414 +00301 10 QTR-DET-FNOTE. DTSBR414 +00302 15 QTR-DET-FNOTE1 PIC X(06). DTSBR414 +00303 15 QTR-DET-FNOTE2 PIC X(01). DTSBR414 +00304 10 FILLER PIC X(02). DTSBR414 +00305 10 QTR-DET-CONTRIB-AMT PIC ZZZ,ZZZ,ZZZ.ZZ. DTSBR414 +00306 * 10 FILLER PIC X(04). DTSBR414 +00307 10 QTR-DET-INTEREST-AMT PIC ZZZ,ZZZ,ZZZ.ZZ. DTSBR414 +00308 * 10 FILLER PIC X(03). DTSBR414 +00309 10 QTR-DET-PENALTY-AMT PIC Z,ZZZ,ZZZ.ZZ. DTSBR414 +00310 * 10 FILLER PIC X(03). DTSBR414 +00311 10 QTR-DET-SURCHARG-AMT PIC Z,ZZZ,ZZZ.ZZ. DTSBR414 +00312 10 FILLER PIC X(02). DTSBR414 +00313 10 QTR-DET-BALANCE-AMT PIC ZZZ,ZZZ,ZZZ.ZZ. DTSBR414 +00314 10 FILLER PIC X(02). DTSBR414 +00315 DTSBR414 +00316 05 STMT-TOTAL-LINE. DTSBR414 +00317 10 FILLER PIC X(21) VALUE SPACE. DTSBR414 +00318 10 TOTAL-CONTRIB-AMT PIC $$$,$$$,$$$.$$. DTSBR414 +00319 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00320 10 TOTAL-INTEREST-AMT PIC $$$,$$$,$$$.$$. DTSBR414 +00321 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00322 10 TOTAL-PENALTY-AMT PIC $,$$$,$$$.$$. DTSBR414 +00323 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00324 10 TOTAL-SURCHARG-AMT PIC $$,$$$,$$$.$$. DTSBR414 +00325 10 FILLER PIC X(01) VALUE SPACES. DTSBR414 +00326 10 TOTAL-BALANCE-AMT PIC $$$,$$$,$$$.$$. DTSBR414 +00327 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00328 DTSBR414 +00329 05 FNOTE1. DTSBR414 +00330 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 +00331 10 FILLER PIC X(31) VALUE DTSBR414 +00332 '(a) = estimated report on file'. DTSBR414 +00333 DTSBR414 +00334 05 FNOTE2. DTSBR414 +00335 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 +00336 10 FILLER PIC X(31) VALUE DTSBR414 +00337 '(b) = report missing '. DTSBR414 +00338 DTSBR414 +00339 05 FNOTE3. DTSBR414 +00340 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 +00341 10 FILLER PIC X(31) VALUE DTSBR414 +00342 '(c) = annual report '. DTSBR414 +00343 DTSBR414 +00344 05 FNOTE4. DTSBR414 +00345 10 FILLER PIC X(03) VALUE SPACE. DTSBR414 +00346 10 FILLER PIC X(31) VALUE DTSBR414 +00347 '(d) = appeal pending '. DTSBR414 +00348 DTSBR414 +00349 05 FNOTE-MISSING-RPT. DTSBR414 +00350 10 FILLER PIC X(33) VALUE SPACE. DTSBR414 +00351 10 FILLER PIC X(57) VALUE DTSBR414 +00352 'Balance Due does not include charges for missing reports'. DTSBR414 00353 DTSBR414 -00354 01 HEADER1. DTSBR414 -00355 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 -00356 05 HDR1-RPT PIC X(05). DTSBR414 -00357 05 FILLER PIC X(44) VALUE SPACES. DTSBR414 -00358 05 FILLER PIC X(60) VALUE DTSBR414 -00359 'DISTRICT OF COLUMBIA'. DTSBR414 -00360 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR414 -00361 05 HDR1-DATE PIC X(08). DTSBR414 -00362 DTSBR414 +00354 DTSBR414 +00355 01 HEADER1. DTSBR414 +00356 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 +00357 05 HDR1-RPT PIC X(05). DTSBR414 +00358 05 FILLER PIC X(44) VALUE SPACES. DTSBR414 +00359 05 FILLER PIC X(60) VALUE DTSBR414 +00360 'DISTRICT OF COLUMBIA'. DTSBR414 +00361 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR414 +00362 05 HDR1-DATE PIC X(08). DTSBR414 00363 DTSBR414 -00364 01 HEADER2. DTSBR414 -00365 05 FILLER PIC X(54) VALUE SPACES. DTSBR414 -00366 05 FILLER PIC X(56) VALUE DTSBR414 -00367 'TAX DIVISION'. DTSBR414 -00368 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR414 -00369 05 HDR2-TIME PIC X(08). DTSBR414 -00370 DTSBR414 -00371 01 HEADER3. DTSBR414 -00372 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 -00373 05 FILLER PIC X(14) VALUE DTSBR414 -00374 'FIELD REP ID: '. DTSBR414 -00375 05 HDR3-ID PIC X(2). DTSBR414 -00376 05 FILLER PIC X(18) VALUE SPACES. DTSBR414 -00377 05 FILLER PIC X(43) VALUE DTSBR414 -00378 'EMPLOYERS WITH GREATER THAN FOUR DELINQUENT'. DTSBR414 -00379 05 FILLER PIC X(09) VALUE DTSBR414 -00380 ' QUARTERS'. DTSBR414 -00381 05 FILLER PIC X(23) VALUE SPACES. DTSBR414 -00382 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR414 -00383 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR414 -00384 01 HEADER4. DTSBR414 -00385 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 -00386 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00387 05 FILLER PIC X(06) VALUE DTSBR414 -00388 'EMP NO'. DTSBR414 -00389 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 -00390 05 FILLER PIC X(12) VALUE DTSBR414 -00391 'PRIMARY NAME'. DTSBR414 -00392 05 FILLER PIC X(09) VALUE SPACES. DTSBR414 -00393 05 FILLER PIC X(05) VALUE ' DELQ'. DTSBR414 -00394 05 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00395 05 FILLER PIC X(13) VALUE DTSBR414 -00396 'CONTRIBUTIONS'. DTSBR414 -00397 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00398 05 FILLER PIC X(12) VALUE DTSBR414 -00399 ' INTEREST'. DTSBR414 -00400 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00401 05 FILLER PIC X(13) VALUE DTSBR414 -00402 ' PENALTY '. DTSBR414 -00403 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00404 05 FILLER PIC X(06) VALUE DTSBR414 -00405 'ADMIN.'. DTSBR414 -00406 05 FILLER PIC X(09) VALUE SPACES. DTSBR414 -00407 05 FILLER PIC X(14) VALUE DTSBR414 -00408 'BALANCE '. DTSBR414 -00409 DTSBR414 -00410 01 HEADER45. DTSBR414 -00411 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 -00412 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00413 05 FILLER PIC X(06) VALUE DTSBR414 -00414 'EMP NO'. DTSBR414 -00415 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 -00416 05 FILLER PIC X(12) VALUE DTSBR414 -00417 'PRIMARY NAME'. DTSBR414 -00418 05 FILLER PIC X(08) VALUE SPACES. DTSBR414 -00419 05 FILLER PIC X(05) VALUE ' YR/Q'. DTSBR414 -00420 05 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00421 05 FILLER PIC X(13) VALUE DTSBR414 -00422 'CONTRIBUTIONS'. DTSBR414 -00423 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00424 05 FILLER PIC X(12) VALUE DTSBR414 -00425 ' INTEREST'. DTSBR414 -00426 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00427 05 FILLER PIC X(13) VALUE DTSBR414 -00428 ' PENALTY '. DTSBR414 -00429 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00430 05 FILLER PIC X(06) VALUE DTSBR414 -00431 'ADMIN.'. DTSBR414 -00432 05 FILLER PIC X(09) VALUE SPACES. DTSBR414 -00433 05 FILLER PIC X(14) VALUE DTSBR414 -00434 'BALANCE '. DTSBR414 -00435 * 05 FILLER PIC X(15) VALUE DTSBR414 -00436 * 'last update'. DTSBR414 -00437 01 HEADER5. DTSBR414 -00438 05 FILLER PIC X(30) VALUE SPACES. DTSBR414 -00439 05 FILLER PIC X(13) VALUE DTSBR414 -00440 ' QTRS '. DTSBR414 -00441 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 -00442 05 FILLER PIC X(13) VALUE DTSBR414 -00443 ' DUE '. DTSBR414 -00444 05 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00445 05 FILLER PIC X(11) VALUE DTSBR414 -00446 ' OWED '. DTSBR414 -00447 05 FILLER PIC X(09) VALUE DTSBR414 -00448 ' OWED '. DTSBR414 -00449 05 FILLER PIC X(13) VALUE DTSBR414 -00450 'ASSESSMENT '. DTSBR414 -00451 05 FILLER PIC X(08) VALUE SPACES. DTSBR414 -00452 05 FILLER PIC X(10) VALUE DTSBR414 -00453 'DUE '. DTSBR414 -00454 01 HEADER55. DTSBR414 -00455 05 FILLER PIC X(30) VALUE SPACES. DTSBR414 -00456 05 FILLER PIC X(13) VALUE DTSBR414 -00457 ' '. DTSBR414 -00458 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 -00459 05 FILLER PIC X(13) VALUE DTSBR414 -00460 ' DUE '. DTSBR414 -00461 05 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00462 05 FILLER PIC X(11) VALUE DTSBR414 -00463 ' OWED '. DTSBR414 -00464 05 FILLER PIC X(09) VALUE DTSBR414 -00465 ' OWED '. DTSBR414 -00466 05 FILLER PIC X(13) VALUE DTSBR414 -00467 'ASSESSMENT '. DTSBR414 -00468 05 FILLER PIC X(08) VALUE SPACES. DTSBR414 -00469 05 FILLER PIC X(10) VALUE DTSBR414 -00470 'DUE '. DTSBR414 -00471 * 05 FILLER PIC X(15) VALUE DTSBR414 -00472 * ' date '. DTSBR414 -00473 DTSBR414 -00474 01 REPT-STMT-LINE. DTSBR414 -00475 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00476 10 rept-EMP-NO PIC 999B999. DTSBR414 -00477 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00478 10 rept-EMP-NAME PIC X(20). DTSBR414 -00479 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00480 10 rept-QTR-CNT PIC Z9. DTSBR414 -00481 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00482 10 rept-CONTRIB-AMT PIC $$$,$$$,$$$.$$. DTSBR414 -00483 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00484 10 rept-INTEREST-AMT PIC $$$,$$$,$$$.$$. DTSBR414 -00485 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00486 10 rept-PENALTY-AMT PIC $,$$$,$$$.$$. DTSBR414 -00487 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00488 10 rept-SURCHARG-AMT PIC $$$,$$$.$$. DTSBR414 -00489 10 FILLER PIC X(05) VALUE SPACES. DTSBR414 -00490 10 rept-BALANCE-AMT PIC $,$$$,$$$.$$. DTSBR414 -00491 EJECT DTSBR414 -00492 01 REPT-qtr4-LINE. DTSBR414 -00493 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00494 10 QTR4-EMP-NO PIC 999B999. DTSBR414 -00495 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00496 10 QTR4-EMP-NAME PIC X(20). DTSBR414 -00497 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00498 10 QTR4-QTR-CNT PIC x(6). DTSBR414 -00499 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 -00500 10 QTR4-CONTRIB-AMT PIC $$$,$$$,$$$.$$. DTSBR414 -00501 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00502 10 QTR4-INTEREST-AMT PIC $$$,$$$,$$$.$$. DTSBR414 -00503 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 -00504 10 QTR4-PENALTY-AMT PIC $,$$$,$$$.$$. DTSBR414 -00505 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 -00506 10 QTR4-SURCHARG-AMT PIC $$$,$$$.$$. DTSBR414 -00507 10 FILLER PIC X(05) VALUE SPACES. DTSBR414 -00508 10 QTR4-BALANCE-AMT PIC $,$$$,$$$.$$. DTSBR414 -00509 * 10 FILLER PIC X(05) VALUE SPACES. DTSBR414 -00510 * 10 QTR4-last-upd-date PIC x(10). DTSBR414 -00511 01 excl-STMT-LINE. DTSBR414 -00512 10 excl-EMP-NO PIC 999B999. DTSBR414 -00513 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00514 10 excl-EMP-NAME PIC X(20). DTSBR414 -00515 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00516 10 excl-QTR-CNT PIC Z9. DTSBR414 -00517 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00518 10 excl-CONTRIB-AMT PIC ----------.99. DTSBR414 -00519 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00520 10 excl-INTEREST-AMT PIC ----------.99. DTSBR414 -00521 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00522 10 excl-PENALTY-AMT PIC ---------.99. DTSBR414 -00523 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00524 10 excl-SURCHARG-AMT PIC -------.99. DTSBR414 -00525 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00526 10 excl-BALANCE-AMT PIC ---------.99. DTSBR414 -00527 EJECT DTSBR414 -00528 01 excl-qtr4-LINE. DTSBR414 -00529 10 excl-qtr4-EMP-NO PIC 999B999. DTSBR414 -00530 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00531 10 excl-qtr4-EMP-NAME PIC X(20). DTSBR414 -00532 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00533 10 excl-qtr4-QTR-CNT PIC x(6). DTSBR414 -00534 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00535 10 excl-qtr4-CONTRIB-AMT PIC -----------.99. DTSBR414 -00536 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00537 10 excl-qtr4-INTEREST-AMT PIC -----------.99. DTSBR414 -00538 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00539 10 excl-qtr4-PENALTY-AMT PIC ---------.99. DTSBR414 -00540 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00541 10 excl-qtr4-SURCHARG-AMT PIC -------.99. DTSBR414 -00542 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00543 10 excl-qtr4-BALANCE-AMT PIC ---------.99. DTSBR414 -00544 * 10 excl-qtr4-last-upd-date PIC x(10). DTSBR414 -00545 01 excl-rec6-LINE. DTSBR414 -00546 10 excl-rec6-EMP-NO PIC 999B999. DTSBR414 -00547 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00548 10 excl-rec6-EMP-NAME PIC X(20). DTSBR414 -00549 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00550 10 excl-rec6-QTR-CNT PIC x(6). DTSBR414 -00551 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00552 10 excl-rec6-CONTRIB-AMT PIC -----------.99. DTSBR414 -00553 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00554 10 excl-rec6-INTEREST-AMT PIC -----------.99. DTSBR414 -00555 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00556 10 excl-rec6-PENALTY-AMT PIC ---------.99. DTSBR414 -00557 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00558 10 excl-rec6-SURCHARG-AMT PIC -------.99. DTSBR414 -00559 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00560 10 excl-rec6-BALANCE-AMT PIC ---------.99. DTSBR414 -00561 10 FILLER PIC X(01) VALUE ','. DTSBR414 -00562 10 excl-rec6-miss-rpt PIC x(6). DTSBR414 -00563 * 10 excl-rec6-last-upd-date PIC x(10). DTSBR414 -00564 01 L001-LINK-AREA. DTSBR414 -00565 ++INCLUDE DTSIL001 DTSBR414 -00566 EJECT DTSBR414 -00567 01 L005-LINK-AREA. DTSBR414 -00568 ++INCLUDE DTSIL005 DTSBR414 -00569 DTSBR414 -00570 01 BARI-LINK-AREA. DTSBR414 -00571 ++INCLUDE BARIL599 DTSBR414 -00572 DTSBR414 -00573 LINKAGE SECTION. DTSBR414 -00574 SKIP3 DTSBR414 -00575 01 LRCM-LINK-AREA. DTSBR414 -00576 ++INCLUDE DTSILRCM DTSBR414 -00577 EJECT DTSBR414 -00578 01 R414-REC. DTSBR414 -00579 ++INCLUDE DTSIR414 DTSBR414 -00580 EJECT DTSBR414 -00581 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR414 -00582 R414-REC. DTSBR414 -00583 SKIP2 DTSBR414 -00584 IF FIRST-TIME-IND = 'Y' DTSBR414 -00585 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR414 -00586 MOVE 'N' TO FIRST-TIME-IND. DTSBR414 -00587 DTSBR414 -00588 IF LRCM-EOR-88 DTSBR414 -00589 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR414 -00590 ELSE DTSBR414 -00591 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR414 +00364 DTSBR414 +00365 01 HEADER2. DTSBR414 +00366 05 FILLER PIC X(54) VALUE SPACES. DTSBR414 +00367 05 FILLER PIC X(56) VALUE DTSBR414 +00368 'TAX DIVISION'. DTSBR414 +00369 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR414 +00370 05 HDR2-TIME PIC X(08). DTSBR414 +00371 DTSBR414 +00372 01 HEADER3. DTSBR414 +00373 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 +00374 05 FILLER PIC X(14) VALUE DTSBR414 +00375 'FIELD REP ID: '. DTSBR414 +00376 05 HDR3-ID PIC X(2). DTSBR414 +00377 05 FILLER PIC X(18) VALUE SPACES. DTSBR414 +00378 05 FILLER PIC X(43) VALUE DTSBR414 +00379 'EMPLOYERS WITH GREATER THAN FOUR DELINQUENT'. DTSBR414 +00380 05 FILLER PIC X(09) VALUE DTSBR414 +00381 ' QUARTERS'. DTSBR414 +00382 05 FILLER PIC X(23) VALUE SPACES. DTSBR414 +00383 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR414 +00384 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR414 +00385 01 HEADER4. DTSBR414 +00386 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 +00387 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00388 05 FILLER PIC X(06) VALUE DTSBR414 +00389 'EMP NO'. DTSBR414 +00390 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 +00391 05 FILLER PIC X(12) VALUE DTSBR414 +00392 'PRIMARY NAME'. DTSBR414 +00393 05 FILLER PIC X(09) VALUE SPACES. DTSBR414 +00394 05 FILLER PIC X(05) VALUE ' DELQ'. DTSBR414 +00395 05 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00396 05 FILLER PIC X(13) VALUE DTSBR414 +00397 'CONTRIBUTIONS'. DTSBR414 +00398 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00399 05 FILLER PIC X(12) VALUE DTSBR414 +00400 ' INTEREST'. DTSBR414 +00401 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00402 05 FILLER PIC X(13) VALUE DTSBR414 +00403 ' PENALTY '. DTSBR414 +00404 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00405 05 FILLER PIC X(06) VALUE DTSBR414 +00406 'ADMIN.'. DTSBR414 +00407 05 FILLER PIC X(09) VALUE SPACES. DTSBR414 +00408 05 FILLER PIC X(14) VALUE DTSBR414 +00409 'BALANCE '. DTSBR414 +00410 DTSBR414 +00411 01 HEADER45. DTSBR414 +00412 05 FILLER PIC X(01) VALUE SPACES. DTSBR414 +00413 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00414 05 FILLER PIC X(06) VALUE DTSBR414 +00415 'EMP NO'. DTSBR414 +00416 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 +00417 05 FILLER PIC X(12) VALUE DTSBR414 +00418 'PRIMARY NAME'. DTSBR414 +00419 05 FILLER PIC X(08) VALUE SPACES. DTSBR414 +00420 05 FILLER PIC X(05) VALUE ' YR/Q'. DTSBR414 +00421 05 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00422 05 FILLER PIC X(13) VALUE DTSBR414 +00423 'CONTRIBUTIONS'. DTSBR414 +00424 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00425 05 FILLER PIC X(12) VALUE DTSBR414 +00426 ' INTEREST'. DTSBR414 +00427 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00428 05 FILLER PIC X(13) VALUE DTSBR414 +00429 ' PENALTY '. DTSBR414 +00430 05 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00431 05 FILLER PIC X(06) VALUE DTSBR414 +00432 'ADMIN.'. DTSBR414 +00433 05 FILLER PIC X(09) VALUE SPACES. DTSBR414 +00434 05 FILLER PIC X(14) VALUE DTSBR414 +00435 'BALANCE '. DTSBR414 +00436 * 05 FILLER PIC X(15) VALUE DTSBR414 +00437 * 'last update'. DTSBR414 +00438 01 HEADER5. DTSBR414 +00439 05 FILLER PIC X(30) VALUE SPACES. DTSBR414 +00440 05 FILLER PIC X(13) VALUE DTSBR414 +00441 ' QTRS '. DTSBR414 +00442 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 +00443 05 FILLER PIC X(13) VALUE DTSBR414 +00444 ' DUE '. DTSBR414 +00445 05 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00446 05 FILLER PIC X(11) VALUE DTSBR414 +00447 ' OWED '. DTSBR414 +00448 05 FILLER PIC X(09) VALUE DTSBR414 +00449 ' OWED '. DTSBR414 +00450 05 FILLER PIC X(13) VALUE DTSBR414 +00451 'ASSESSMENT '. DTSBR414 +00452 05 FILLER PIC X(08) VALUE SPACES. DTSBR414 +00453 05 FILLER PIC X(10) VALUE DTSBR414 +00454 'DUE '. DTSBR414 +00455 01 HEADER55. DTSBR414 +00456 05 FILLER PIC X(30) VALUE SPACES. DTSBR414 +00457 05 FILLER PIC X(13) VALUE DTSBR414 +00458 ' '. DTSBR414 +00459 05 FILLER PIC X(05) VALUE SPACES. DTSBR414 +00460 05 FILLER PIC X(13) VALUE DTSBR414 +00461 ' DUE '. DTSBR414 +00462 05 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00463 05 FILLER PIC X(11) VALUE DTSBR414 +00464 ' OWED '. DTSBR414 +00465 05 FILLER PIC X(09) VALUE DTSBR414 +00466 ' OWED '. DTSBR414 +00467 05 FILLER PIC X(13) VALUE DTSBR414 +00468 'ASSESSMENT '. DTSBR414 +00469 05 FILLER PIC X(08) VALUE SPACES. DTSBR414 +00470 05 FILLER PIC X(10) VALUE DTSBR414 +00471 'DUE '. DTSBR414 +00472 * 05 FILLER PIC X(15) VALUE DTSBR414 +00473 * ' date '. DTSBR414 +00474 DTSBR414 +00475 01 REPT-STMT-LINE. DTSBR414 +00476 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00477 10 rept-EMP-NO PIC 999B999. DTSBR414 +00478 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00479 10 rept-EMP-NAME PIC X(20). DTSBR414 +00480 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00481 10 rept-QTR-CNT PIC Z9. DTSBR414 +00482 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00483 10 rept-CONTRIB-AMT PIC $$$,$$$,$$$.$$. DTSBR414 +00484 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00485 10 rept-INTEREST-AMT PIC $$$,$$$,$$$.$$. DTSBR414 +00486 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00487 10 rept-PENALTY-AMT PIC $,$$$,$$$.$$. DTSBR414 +00488 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00489 10 rept-SURCHARG-AMT PIC $$$,$$$.$$. DTSBR414 +00490 10 FILLER PIC X(05) VALUE SPACES. DTSBR414 +00491 10 rept-BALANCE-AMT PIC $,$$$,$$$.$$. DTSBR414 +00492 EJECT DTSBR414 +00493 01 REPT-qtr4-LINE. DTSBR414 +00494 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00495 10 QTR4-EMP-NO PIC 999B999. DTSBR414 +00496 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00497 10 QTR4-EMP-NAME PIC X(20). DTSBR414 +00498 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00499 10 QTR4-QTR-CNT PIC x(6). DTSBR414 +00500 10 FILLER PIC X(02) VALUE SPACES. DTSBR414 +00501 10 QTR4-CONTRIB-AMT PIC $$$,$$$,$$$.$$. DTSBR414 +00502 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00503 10 QTR4-INTEREST-AMT PIC $$$,$$$,$$$.$$. DTSBR414 +00504 * 10 FILLER PIC X(03) VALUE SPACES. DTSBR414 +00505 10 QTR4-PENALTY-AMT PIC $,$$$,$$$.$$. DTSBR414 +00506 * 10 FILLER PIC X(04) VALUE SPACES. DTSBR414 +00507 10 QTR4-SURCHARG-AMT PIC $$$,$$$.$$. DTSBR414 +00508 10 FILLER PIC X(05) VALUE SPACES. DTSBR414 +00509 10 QTR4-BALANCE-AMT PIC $,$$$,$$$.$$. DTSBR414 +00510 * 10 FILLER PIC X(05) VALUE SPACES. DTSBR414 +00511 * 10 QTR4-last-upd-date PIC x(10). DTSBR414 +00512 01 excl-STMT-LINE. DTSBR414 +00513 10 excl-EMP-NO PIC 999B999. DTSBR414 +00514 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00515 10 excl-EMP-NAME PIC X(20). DTSBR414 +00516 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00517 10 excl-QTR-CNT PIC Z9. DTSBR414 +00518 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00519 10 excl-CONTRIB-AMT PIC ----------.99. DTSBR414 +00520 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00521 10 excl-INTEREST-AMT PIC ----------.99. DTSBR414 +00522 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00523 10 excl-PENALTY-AMT PIC ---------.99. DTSBR414 +00524 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00525 10 excl-SURCHARG-AMT PIC -------.99. DTSBR414 +00526 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00527 10 excl-BALANCE-AMT PIC ---------.99. DTSBR414 +00528 EJECT DTSBR414 +00529 01 excl-qtr4-LINE. DTSBR414 +00530 10 excl-qtr4-EMP-NO PIC 999B999. DTSBR414 +00531 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00532 10 excl-qtr4-EMP-NAME PIC X(20). DTSBR414 +00533 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00534 10 excl-qtr4-QTR-CNT PIC x(6). DTSBR414 +00535 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00536 10 excl-qtr4-CONTRIB-AMT PIC -----------.99. DTSBR414 +00537 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00538 10 excl-qtr4-INTEREST-AMT PIC -----------.99. DTSBR414 +00539 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00540 10 excl-qtr4-PENALTY-AMT PIC ---------.99. DTSBR414 +00541 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00542 10 excl-qtr4-SURCHARG-AMT PIC -------.99. DTSBR414 +00543 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00544 10 excl-qtr4-BALANCE-AMT PIC ---------.99. DTSBR414 +00545 * 10 excl-qtr4-last-upd-date PIC x(10). DTSBR414 +00546 01 excl-rec6-LINE. DTSBR414 +00547 10 excl-rec6-EMP-NO PIC 999999. CL*19 +00548 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00549 10 excl-rec6-EMP-NAME PIC X(20). DTSBR414 +00550 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00551 10 excl-rec6-QTR-CNT PIC x(6). DTSBR414 +00552 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00553 10 excl-rec6-CONTRIB-AMT PIC -----------.99. DTSBR414 +00554 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00555 10 excl-rec6-INTEREST-AMT PIC -----------.99. DTSBR414 +00556 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00557 10 excl-rec6-PENALTY-AMT PIC ---------.99. DTSBR414 +00558 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00559 10 excl-rec6-SURCHARG-AMT PIC -------.99. DTSBR414 +00560 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00561 10 excl-rec6-BALANCE-AMT PIC ---------.99. DTSBR414 +00562 10 FILLER PIC X(01) VALUE ','. DTSBR414 +00563 10 excl-rec6-field-rep PIC x(2). CL*32 +00564 10 FILLER PIC X(01) VALUE ','. CL*20 +00565 10 excl-rec6-status PIC x(01). CL*25 +00566 10 FILLER PIC X(01) VALUE ','. CL*29 +00567 10 excl-rec6-class PIC x(01). CL*29 +00568 10 FILLER PIC X(01) VALUE ','. CL*35 +00569 10 excl-rec6-lien PIC x(01). CL*37 +00570 10 FILLER PIC X(01) VALUE ','. CL*39 +00571 10 excl-rec6-pursued pic 9(02). CL*39 +00572 * CL*25 +00573 01 L001-LINK-AREA. DTSBR414 +00574 ++INCLUDE DTSIL001 DTSBR414 +00575 EJECT DTSBR414 +00576 01 L005-LINK-AREA. DTSBR414 +00577 ++INCLUDE DTSIL005 DTSBR414 +00578 DTSBR414 +00579 01 BARI-LINK-AREA. DTSBR414 +00580 ++INCLUDE BARIL599 DTSBR414 +00581 DTSBR414 +00582 LINKAGE SECTION. DTSBR414 +00583 SKIP3 DTSBR414 +00584 01 LRCM-LINK-AREA. DTSBR414 +00585 ++INCLUDE DTSILRCM DTSBR414 +00586 EJECT DTSBR414 +00587 01 R414-REC. DTSBR414 +00588 ++INCLUDE DTSIR414 DTSBR414 +00589 EJECT DTSBR414 +00590 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR414 +00591 R414-REC. DTSBR414 00592 SKIP2 DTSBR414 -00593 GOBACK. DTSBR414 -00594 EJECT DTSBR414 -00595 I1000-INITIATE. DTSBR414 -00596 OPEN OUTPUT PRT-FILE1 PRT-FILE2 PRT-FILE4 DTSBR414 -00597 PRT-FILE6. DTSBR414 -00598 DTSBR414 -00599 MOVE +0 TO PRT-FILE1-PAGE-CNT. DTSBR414 -00600 DTSBR414 -00601 MOVE 0 TO STMT-EMP-NO DTSBR414 -00602 STUB-EMP-NO DTSBR414 -00603 STUB-EMP-FEIN DTSBR414 -00604 STMT-EMP-FEIN DTSBR414 -00605 rept-emp-no. DTSBR414 -00606 MOVE SPACES TO STMT-STMT-DATE DTSBR414 -00607 STMT-COMP-DATE. DTSBR414 +00593 IF FIRST-TIME-IND = 'Y' DTSBR414 +00594 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR414 +00595 MOVE 'N' TO FIRST-TIME-IND. DTSBR414 +00596 DTSBR414 +00597 IF LRCM-EOR-88 DTSBR414 +00598 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR414 +00599 ELSE DTSBR414 +00600 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR414 +00601 SKIP2 DTSBR414 +00602 GOBACK. DTSBR414 +00603 EJECT DTSBR414 +00604 I1000-INITIATE. DTSBR414 +00605 OPEN OUTPUT PRT-FILE1 PRT-FILE2 PRT-FILE4 CL**6 +00606 ** OPEN OUTPUT PRT-FILE1 PRT-FILE4 PRT-FILE6. CL**6 +00607 PRT-FILE6. CL**6 00608 DTSBR414 -00609 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBR414 -00610 MOVE L005-SLASH-DATE TO HDR1-DATE DTSBR414 -00611 MOVE L005-DISPLAY-TIME TO HDR2-TIME. DTSBR414 -00612 DTSBR414 -00613 I1000-EXIT. DTSBR414 -00614 EXIT. DTSBR414 -00615 SKIP3 DTSBR414 -00616 P1000-PROCESS. DTSBR414 -00617 if r414-emp-no = 022647 DTSBR414 -00618 display 'br414 p0 ' r414-emp-no DTSBR414 -00619 end-if. DTSBR414 -00620 DTSBR414 -00621 SET PRINT-FNOTE1-NO-88 TO TRUE. DTSBR414 -00622 SET PRINT-FNOTE2-NO-88 TO TRUE. DTSBR414 -00623 SET PRINT-FNOTE3-NO-88 TO TRUE. DTSBR414 -00624 SET PRINT-FNOTE4-NO-88 TO TRUE. DTSBR414 -00625 SET PRINT-BILL-NO-88 TO TRUE. DTSBR414 -00626 MOVE SPACES TO WS-REC. DTSBR414 -00627 DTSBR414 -00628 MOVE +0 TO WS-TOTAL-CONTRIB-AMT DTSBR414 -00629 WS-TOTAL-PENALTY-AMT DTSBR414 -00630 WS-TOTAL-INTEREST-AMT DTSBR414 -00631 WS-TOTAL-SURCHARG-AMT DTSBR414 -00632 WS-STUB-BALANCE-AMT DTSBR414 -00633 WS-TOTAL-BALANCE-AMT. DTSBR414 -00634 DTSBR414 -00635 IF R414-QTR-CNT > 60 DTSBR414 -00636 PERFORM P2000-PRINT-REPORT THRU P2000-EXIT DTSBR414 -00637 **testing the printing of all quarters DTSBR414 -00638 GO TO P1000-EXIT. DTSBR414 -00639 DTSBR414 -00640 DTSBR414 -00641 PERFORM P1100-STUB-STMT-TOTALS THRU P1100-EXIT DTSBR414 -00642 VARYING R414-QTR-IDX FROM 1 BY 1 DTSBR414 -00643 UNTIL R414-QTR-IDX > R414-QTR-CNT. DTSBR414 +00609 MOVE +0 TO PRT-FILE1-PAGE-CNT. DTSBR414 +00610 DTSBR414 +00611 MOVE 0 TO STMT-EMP-NO DTSBR414 +00612 STUB-EMP-NO DTSBR414 +00613 STUB-EMP-FEIN DTSBR414 +00614 STMT-EMP-FEIN DTSBR414 +00615 rept-emp-no. DTSBR414 +00616 MOVE SPACES TO STMT-STMT-DATE DTSBR414 +00617 STMT-COMP-DATE. DTSBR414 +00618 DTSBR414 +00619 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBR414 +00620 MOVE L005-SLASH-DATE TO HDR1-DATE DTSBR414 +00621 MOVE L005-DISPLAY-TIME TO HDR2-TIME. DTSBR414 +00622 DTSBR414 +00623 I1000-EXIT. DTSBR414 +00624 EXIT. DTSBR414 +00625 SKIP3 DTSBR414 +00626 P1000-PROCESS. DTSBR414 +00627 if r414-emp-no = 022647 DTSBR414 +00628 display 'br414 p0 ' r414-emp-no DTSBR414 +00629 end-if. DTSBR414 +00630 DTSBR414 +00631 SET PRINT-FNOTE1-NO-88 TO TRUE. DTSBR414 +00632 SET PRINT-FNOTE2-NO-88 TO TRUE. DTSBR414 +00633 SET PRINT-FNOTE3-NO-88 TO TRUE. DTSBR414 +00634 SET PRINT-FNOTE4-NO-88 TO TRUE. DTSBR414 +00635 SET PRINT-BILL-NO-88 TO TRUE. DTSBR414 +00636 MOVE SPACES TO WS-REC. DTSBR414 +00637 DTSBR414 +00638 MOVE +0 TO WS-TOTAL-CONTRIB-AMT DTSBR414 +00639 WS-TOTAL-PENALTY-AMT DTSBR414 +00640 WS-TOTAL-INTEREST-AMT DTSBR414 +00641 WS-TOTAL-SURCHARG-AMT DTSBR414 +00642 WS-STUB-BALANCE-AMT DTSBR414 +00643 WS-TOTAL-BALANCE-AMT. DTSBR414 00644 DTSBR414 -00645 MOVE R414-EMP-NO TO STUB-EMP-NO DTSBR414 -00646 STMT-EMP-NO DTSBR414 -00647 BARC-EMP-NO. DTSBR414 -00648 MOVE R414-EMP-FEIN TO STUB-EMP-FEIN DTSBR414 -00649 STMT-EMP-FEIN. DTSBR414 -00650 MOVE WS-STUB-BALANCE-AMT TO STUB-AMT. DTSBR414 -00651 DTSBR414 -00652 MOVE R414-STMT-DATE TO L001-FED-8-DATE-9. DTSBR414 -00653 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR414 -00654 MOVE L001-SLASH-8-DATE TO STUB-STMT-DATE DTSBR414 -00655 STMT-STMT-DATE. DTSBR414 -00656 DTSBR414 -00657 MOVE R414-COMP-DATE TO L001-FED-8-DATE-9. DTSBR414 -00658 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR414 -00659 IF L001-INVALID-DATE DTSBR414 -00660 MOVE SPACES TO STUB-COMP-DATE DTSBR414 -00661 STMT-COMP-DATE DTSBR414 -00662 ELSE DTSBR414 -00663 MOVE L001-SLASH-8-DATE TO STUB-COMP-DATE DTSBR414 -00664 STMT-COMP-DATE. DTSBR414 +00645 IF R414-QTR-CNT > 70 CL*17 +00646 PERFORM P2000-PRINT-REPORT THRU P2000-EXIT CL*12 +00647 **testing the printing of all quarters DTSBR414 +00648 GO TO P1000-EXIT. CL*12 +00649 DTSBR414 +00650 PERFORM P1100-STUB-STMT-TOTALS THRU P1100-EXIT DTSBR414 +00651 VARYING R414-QTR-IDX FROM 1 BY 1 DTSBR414 +00652 UNTIL R414-QTR-IDX > R414-QTR-CNT. DTSBR414 +00653 DTSBR414 +00654 MOVE R414-EMP-NO TO STUB-EMP-NO DTSBR414 +00655 STMT-EMP-NO DTSBR414 +00656 BARC-EMP-NO. DTSBR414 +00657 MOVE R414-EMP-FEIN TO STUB-EMP-FEIN DTSBR414 +00658 STMT-EMP-FEIN. DTSBR414 +00659 MOVE WS-STUB-BALANCE-AMT TO STUB-AMT. DTSBR414 +00660 DTSBR414 +00661 MOVE R414-STMT-DATE TO L001-FED-8-DATE-9. DTSBR414 +00662 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR414 +00663 MOVE L001-SLASH-8-DATE TO STUB-STMT-DATE DTSBR414 +00664 STMT-STMT-DATE. DTSBR414 00665 DTSBR414 -00666 MOVE R414-FMT-LINE (1) TO STUB-ADDR-LINE1 DTSBR414 -00667 MAIL-ADDR-LINE1 DTSBR414 -00668 WS-EMP-NAME. DTSBR414 -00669 DTSBR414 -00670 MOVE R414-FMT-LINE (2) TO STUB-ADDR-LINE2 DTSBR414 -00671 MAIL-ADDR-LINE2. DTSBR414 -00672 DTSBR414 -00673 MOVE R414-FMT-LINE (3) TO STUB-ADDR-LINE3 DTSBR414 -00674 MAIL-ADDR-LINE3. DTSBR414 -00675 DTSBR414 -00676 MOVE R414-FMT-LINE (4) TO STUB-ADDR-LINE4 DTSBR414 -00677 MAIL-ADDR-LINE4. DTSBR414 +00666 MOVE R414-COMP-DATE TO L001-FED-8-DATE-9. DTSBR414 +00667 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR414 +00668 IF L001-INVALID-DATE DTSBR414 +00669 MOVE SPACES TO STUB-COMP-DATE DTSBR414 +00670 STMT-COMP-DATE DTSBR414 +00671 ELSE DTSBR414 +00672 MOVE L001-SLASH-8-DATE TO STUB-COMP-DATE DTSBR414 +00673 STMT-COMP-DATE. DTSBR414 +00674 DTSBR414 +00675 MOVE R414-FMT-LINE (1) TO STUB-ADDR-LINE1 DTSBR414 +00676 MAIL-ADDR-LINE1 DTSBR414 +00677 WS-EMP-NAME. DTSBR414 00678 DTSBR414 -00679 MOVE R414-FMT-LINE (5) TO STUB-ADDR-LINE5 DTSBR414 -00680 MAIL-ADDR-LINE5. DTSBR414 +00679 MOVE R414-FMT-LINE (2) TO STUB-ADDR-LINE2 DTSBR414 +00680 MAIL-ADDR-LINE2. DTSBR414 00681 DTSBR414 -00682 MOVE WRK-FIRST-4 TO STMT-NAME-CHEK. DTSBR414 -00683 DTSBR414 -00684 MOVE R414-LAST-ACCT-UPDATE-DATE TO L001-FED-8-DATE-9. DTSBR414 -00685 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR414 -00686 MOVE L001-SLASH-8-DATE TO STMT-LAST-ACCT-UPDATE-DATE. DTSBR414 +00682 MOVE R414-FMT-LINE (3) TO STUB-ADDR-LINE3 DTSBR414 +00683 MAIL-ADDR-LINE3. DTSBR414 +00684 DTSBR414 +00685 MOVE R414-FMT-LINE (4) TO STUB-ADDR-LINE4 DTSBR414 +00686 MAIL-ADDR-LINE4. DTSBR414 00687 DTSBR414 -00688 IF PRINT-BILL-YES-88 DTSBR414 -00689 PERFORM P1200-PRINT-STUB-MAILR THRU P1200-EXIT. DTSBR414 +00688 MOVE R414-FMT-LINE (5) TO STUB-ADDR-LINE5 DTSBR414 +00689 MAIL-ADDR-LINE5. DTSBR414 00690 DTSBR414 -00691 * IF PRT-FILE1-PAGE-CNT > 10 DTSBR414 -00692 * SET LRCM-EOR-88 TO TRUE DTSBR414 -00693 * GO TO P1000-EXIT. DTSBR414 -00694 DTSBR414 -00695 MOVE 24 TO LINE-CNT. DTSBR414 +00691 MOVE WRK-FIRST-4 TO STMT-NAME-CHEK. DTSBR414 +00692 DTSBR414 +00693 MOVE R414-LAST-ACCT-UPDATE-DATE TO L001-FED-8-DATE-9. DTSBR414 +00694 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR414 +00695 MOVE L001-SLASH-8-DATE TO STMT-LAST-ACCT-UPDATE-DATE. DTSBR414 00696 DTSBR414 -00697 SET AMT-DISPLAYED-NO-88 TO TRUE. DTSBR414 -00698 SET SUM-PRIOR-QTRS-NO-88 TO TRUE. DTSBR414 -00699 SET PRINT-PRIOR-QTRS-NO-88 TO TRUE. DTSBR414 -00700 DTSBR414 -00701 MOVE 0 TO WS-QTR-PLUS20 DTSBR414 -00702 WS-QTR-CNT. DTSBR414 -00703 **nh testing DTSBR414 -00704 MOVE +0 TO WS-TOTAL-CONTRIB-AMT DTSBR414 -00705 WS-TOTAL-PENALTY-AMT DTSBR414 -00706 WS-TOTAL-INTEREST-AMT DTSBR414 -00707 WS-TOTAL-SURCHARG-AMT DTSBR414 -00708 WS-STUB-BALANCE-AMT DTSBR414 -00709 WS-TOTAL-BALANCE-AMT. DTSBR414 -00710 DTSBR414 -00711 PERFORM P1300-DISPLAY-QTR THRU P1300-EXIT DTSBR414 -00712 VARYING R414-QTR-IDX FROM 1 BY 1 DTSBR414 -00713 UNTIL R414-QTR-IDX > R414-QTR-CNT. DTSBR414 -00714 DTSBR414 -00715 MOVE SPACES TO WS-REC DTSBR414 -00716 DTSBR414 -00717 IF PRINT-BILL-NO-88 DTSBR414 -00718 GO TO P1000-EXIT. DTSBR414 +00697 IF PRINT-BILL-YES-88 DTSBR414 +00698 PERFORM P1200-PRINT-STUB-MAILR THRU P1200-EXIT. DTSBR414 +00699 DTSBR414 +00700 * IF PRT-FILE1-PAGE-CNT > 10 DTSBR414 +00701 * SET LRCM-EOR-88 TO TRUE DTSBR414 +00702 * GO TO P1000-EXIT. DTSBR414 +00703 DTSBR414 +00704 MOVE 24 TO LINE-CNT. DTSBR414 +00705 DTSBR414 +00706 SET AMT-DISPLAYED-NO-88 TO TRUE. DTSBR414 +00707 SET SUM-PRIOR-QTRS-NO-88 TO TRUE. DTSBR414 +00708 SET PRINT-PRIOR-QTRS-NO-88 TO TRUE. DTSBR414 +00709 DTSBR414 +00710 MOVE 0 TO WS-QTR-PLUS20 DTSBR414 +00711 WS-QTR-CNT. DTSBR414 +00712 **nh testing DTSBR414 +00713 MOVE +0 TO WS-TOTAL-CONTRIB-AMT DTSBR414 +00714 WS-TOTAL-PENALTY-AMT DTSBR414 +00715 WS-TOTAL-INTEREST-AMT DTSBR414 +00716 WS-TOTAL-SURCHARG-AMT DTSBR414 +00717 WS-STUB-BALANCE-AMT DTSBR414 +00718 WS-TOTAL-BALANCE-AMT. DTSBR414 00719 DTSBR414 -00720 IF AMT-DISPLAYED-YES-88 DTSBR414 -00721 *** IF AMT-DISPLAYED-YES-88 and DTSBR414 -00722 *** ws-total-balance-amt > +5.00 DTSBR414 -00723 MOVE WS-TOTAL-CONTRIB-AMT TO TOTAL-CONTRIB-AMT DTSBR414 -00724 MOVE WS-TOTAL-INTEREST-AMT TO TOTAL-INTEREST-AMT DTSBR414 -00725 MOVE WS-TOTAL-SURCHARG-AMT TO TOTAL-SURCHARG-AMT DTSBR414 -00726 MOVE WS-TOTAL-PENALTY-AMT TO TOTAL-PENALTY-AMT DTSBR414 -00727 MOVE WS-TOTAL-BALANCE-AMT TO TOTAL-BALANCE-AMT. DTSBR414 -00728 ** else DTSBR414 -00729 ** GO TO P1000-EXIT DTSBR414 -00730 ** end-if. DTSBR414 -00731 **nh DTSBR414 -00732 ** COMPUTE WRK-CTR = TOT-LINE-CNT - LINE-CNT. DTSBR414 -00733 COMPUTE WRK-CTR = TOT-LINE-CNT - LINE-CNT - 2. DTSBR414 -00734 DTSBR414 -00735 IF AMT-DISPLAYED-YES-88 DTSBR414 -00736 MOVE STMT-TOTAL-LINE TO WS-REC DTSBR414 -00737 ELSE DTSBR414 -00738 MOVE SPACES TO WS-REC. DTSBR414 -00739 DTSBR414 -00740 WRITE PRT-REC1 FROM WS-REC DTSBR414 -00741 AFTER ADVANCING WRK-CTR LINES. DTSBR414 -00742 DTSBR414 -00743 MOVE SPACES TO WS-REC DTSBR414 -00744 DTSBR414 -00745 DTSBR414 -00746 IF PRINT-FNOTE2-YES-88 DTSBR414 -00747 WRITE PRT-REC1 FROM FNOTE-MISSING-RPT DTSBR414 -00748 AFTER ADVANCING 1 LINES DTSBR414 -00749 WRITE PRT-REC1 FROM WS-REC DTSBR414 -00750 AFTER ADVANCING 1 LINES DTSBR414 -00751 ELSE DTSBR414 -00752 WRITE PRT-REC1 FROM WS-REC DTSBR414 -00753 AFTER ADVANCING 1 LINES. DTSBR414 +00720 PERFORM P1300-DISPLAY-QTR THRU P1300-EXIT DTSBR414 +00721 VARYING R414-QTR-IDX FROM 1 BY 1 DTSBR414 +00722 UNTIL R414-QTR-IDX > R414-QTR-CNT. DTSBR414 +00723 DTSBR414 +00724 MOVE SPACES TO WS-REC DTSBR414 +00725 DTSBR414 +00726 ** IF PRINT-BILL-NO-88 CL*30 +00727 ** GO TO P1000-EXIT. CL*30 +00728 DTSBR414 +00729 IF AMT-DISPLAYED-YES-88 DTSBR414 +00730 *** IF AMT-DISPLAYED-YES-88 and DTSBR414 +00731 *** ws-total-balance-amt > +5.00 DTSBR414 +00732 MOVE WS-TOTAL-CONTRIB-AMT TO TOTAL-CONTRIB-AMT DTSBR414 +00733 MOVE WS-TOTAL-INTEREST-AMT TO TOTAL-INTEREST-AMT DTSBR414 +00734 MOVE WS-TOTAL-SURCHARG-AMT TO TOTAL-SURCHARG-AMT DTSBR414 +00735 MOVE WS-TOTAL-PENALTY-AMT TO TOTAL-PENALTY-AMT DTSBR414 +00736 MOVE WS-TOTAL-BALANCE-AMT TO TOTAL-BALANCE-AMT. DTSBR414 +00737 ** else DTSBR414 +00738 ** GO TO P1000-EXIT DTSBR414 +00739 ** end-if. DTSBR414 +00740 **nh DTSBR414 +00741 ** COMPUTE WRK-CTR = TOT-LINE-CNT - LINE-CNT. DTSBR414 +00742 COMPUTE WRK-CTR = TOT-LINE-CNT - LINE-CNT - 2. DTSBR414 +00743 DTSBR414 +00744 IF AMT-DISPLAYED-YES-88 DTSBR414 +00745 MOVE STMT-TOTAL-LINE TO WS-REC DTSBR414 +00746 ELSE DTSBR414 +00747 MOVE SPACES TO WS-REC. DTSBR414 +00748 DTSBR414 +00749 WRITE PRT-REC1 FROM WS-REC DTSBR414 +00750 AFTER ADVANCING WRK-CTR LINES. DTSBR414 +00751 DTSBR414 +00752 MOVE SPACES TO WS-REC DTSBR414 +00753 DTSBR414 00754 DTSBR414 -00755 IF PRINT-FNOTE1-YES-88 DTSBR414 -00756 WRITE PRT-REC1 FROM FNOTE1 DTSBR414 -00757 AFTER ADVANCING 1 LINES. DTSBR414 -00758 DTSBR414 -00759 IF PRINT-FNOTE2-YES-88 DTSBR414 -00760 WRITE PRT-REC1 FROM FNOTE2 DTSBR414 -00761 AFTER ADVANCING 1 LINES. DTSBR414 -00762 DTSBR414 -00763 IF PRINT-FNOTE3-YES-88 DTSBR414 -00764 WRITE PRT-REC1 FROM FNOTE3 DTSBR414 -00765 AFTER ADVANCING 1 LINES. DTSBR414 -00766 DTSBR414 -00767 IF PRINT-FNOTE4-YES-88 DTSBR414 -00768 WRITE PRT-REC1 FROM FNOTE4 DTSBR414 -00769 AFTER ADVANCING 1 LINES. DTSBR414 -00770 DTSBR414 +00755 IF PRINT-FNOTE2-YES-88 DTSBR414 +00756 WRITE PRT-REC1 FROM FNOTE-MISSING-RPT DTSBR414 +00757 AFTER ADVANCING 1 LINES DTSBR414 +00758 WRITE PRT-REC1 FROM WS-REC DTSBR414 +00759 AFTER ADVANCING 1 LINES DTSBR414 +00760 ELSE DTSBR414 +00761 WRITE PRT-REC1 FROM WS-REC DTSBR414 +00762 AFTER ADVANCING 1 LINES. DTSBR414 +00763 DTSBR414 +00764 IF PRINT-FNOTE1-YES-88 DTSBR414 +00765 WRITE PRT-REC1 FROM FNOTE1 DTSBR414 +00766 AFTER ADVANCING 1 LINES. DTSBR414 +00767 DTSBR414 +00768 IF PRINT-FNOTE2-YES-88 DTSBR414 +00769 WRITE PRT-REC1 FROM FNOTE2 DTSBR414 +00770 AFTER ADVANCING 1 LINES. DTSBR414 00771 DTSBR414 -00772 MOVE SPACES TO WS-XREC DTSBR414 -00773 DTSBR414 -00774 PERFORM P1500-PRINT-MAILR-ADDR THRU P1500-EXIT. DTSBR414 +00772 IF PRINT-FNOTE3-YES-88 DTSBR414 +00773 WRITE PRT-REC1 FROM FNOTE3 DTSBR414 +00774 AFTER ADVANCING 1 LINES. DTSBR414 00775 DTSBR414 -00776 PERFORM P1600-excel-MAILR-sent THRU P1600-EXIT. DTSBR414 -00777 DTSBR414 -00778 P1000-EXIT. DTSBR414 -00779 EXIT. DTSBR414 -00780 SKIP3 DTSBR414 -00781 DTSBR414 -00782 P1100-STUB-STMT-TOTALS. DTSBR414 -00783 DTSBR414 -00784 SET PRINT-BILL-YES-88 TO TRUE. DTSBR414 -00785 DTSBR414 -00786 IF R414-BALANCE-AMT (R414-QTR-IDX) > ZEROS DTSBR414 -00787 ADD R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 -00788 TO WS-STUB-BALANCE-AMT. DTSBR414 -00789 DTSBR414 -00790 P1100-EXIT. DTSBR414 -00791 EXIT. DTSBR414 -00792 SKIP3 DTSBR414 -00793 DTSBR414 -00794 P1200-PRINT-STUB-MAILR. DTSBR414 -00795 ** DTSBR414 -00796 PERFORM S599-BARCODE THRU S599-EXIT. DTSBR414 -00797 DTSBR414 -00798 IF L599-SETB-FONT1 DTSBR414 -00799 MOVE 'MODIFY=TAXSM1,' TO XEROX-CME DTSBR414 -00800 ELSE DTSBR414 -00801 IF L599-SETB-FONT2 DTSBR414 -00802 MOVE 'MODIFY=TAXSM2,' TO XEROX-CME DTSBR414 -00803 ELSE DTSBR414 -00804 MOVE 'MODIFY=TAXSM1,' TO XEROX-CME. DTSBR414 -00805 DTSBR414 -00806 MOVE XEROX-8X11-LINE TO WS-REC. DTSBR414 -00807 WRITE PRT-REC1 FROM WS-REC DTSBR414 -00808 AFTER ADVANCING PAGE. DTSBR414 -00809 DTSBR414 -00810 MOVE XEROX-CNTL-LINE2 TO WS-REC. DTSBR414 -00811 WRITE PRT-REC1 FROM WS-REC DTSBR414 -00812 AFTER ADVANCING 1. DTSBR414 -00813 ** DTSBR414 -00814 ADD +1 TO PRT-FILE1-PAGE-CNT DTSBR414 -00815 MOVE SPACES TO WS-REC DTSBR414 -00816 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 09 LINES DTSBR414 -00817 MOVE STUB-LINE TO WS-REC DTSBR414 -00818 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 -00819 MOVE ADDR01 TO WS-REC DTSBR414 -00820 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 -00821 MOVE ADDR02 TO WS-REC DTSBR414 -00822 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 -00823 MOVE ADDR03 TO WS-REC DTSBR414 -00824 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 -00825 MOVE ADDR04 TO WS-REC DTSBR414 -00826 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 -00827 MOVE ADDR05 TO WS-REC DTSBR414 -00828 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 -00829 MOVE STMT-LINE1 TO WS-REC DTSBR414 -00830 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 4 LINES DTSBR414 -00831 ** WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 7 LINES DTSBR414 -00832 MOVE STMT-LINE2 TO WS-REC DTSBR414 -00833 ** WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 5 LINES. DTSBR414 -00834 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 7 LINES. DTSBR414 -00835 MOVE SPACES TO WS-REC. DTSBR414 -00836 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 3 LINES. DTSBR414 -00837 P1200-EXIT. DTSBR414 -00838 EXIT. DTSBR414 -00839 SKIP3 DTSBR414 -00840 P1300-DISPLAY-QTR. DTSBR414 -00841 DTSBR414 -00842 MOVE SPACES TO STMT-QTR-DETAIL DTSBR414 -00843 WS-QTR-FNOTE. DTSBR414 -00844 IF LRCM-PICKUP-YRQ = R414-QTR (R414-QTR-IDX) DTSBR414 -00845 MOVE 'PRIOR TO ' TO QTR-DET-YR DTSBR414 -00846 MOVE '1995/4' TO QTR-DET-FNOTE DTSBR414 -00847 ELSE DTSBR414 -00848 MOVE R414-QTR (R414-QTR-IDX) TO WS-WRK-QTR DTSBR414 -00849 IF R414-ANN-FILER-YES-88 (R414-QTR-IDX) DTSBR414 -00850 MOVE SPACES TO WRK-PRT-Q DTSBR414 -00851 MOVE WRK-QTR-YR TO WRK-PRT-YR DTSBR414 -00852 MOVE SPACES TO WRK-PRT-SLASH DTSBR414 -00853 MOVE WS-PRT-QTR TO QTR-DET-YR1 DTSBR414 -00854 MOVE SPACES TO QTR-DET-YR2 DTSBR414 -00855 ELSE DTSBR414 -00856 MOVE WRK-QTR-Q TO WRK-PRT-Q DTSBR414 -00857 MOVE WRK-QTR-YR TO WRK-PRT-YR DTSBR414 -00858 MOVE '/' TO WRK-PRT-SLASH DTSBR414 -00859 MOVE WS-PRT-QTR TO QTR-DET-YR1 DTSBR414 -00860 MOVE SPACES TO QTR-DET-YR2. DTSBR414 -00861 IF R414-BALANCE-AMT (R414-QTR-IDX) > +0 DTSBR414 -00862 SET AMT-DISPLAYED-YES-88 TO TRUE DTSBR414 -00863 MOVE R414-CONTRIB-AMT (R414-QTR-IDX) DTSBR414 -00864 TO QTR-DET-CONTRIB-AMT DTSBR414 -00865 ADD R414-CONTRIB-AMT (R414-QTR-IDX) DTSBR414 -00866 TO WS-TOTAL-CONTRIB-AMT DTSBR414 -00867 ADD R414-INTEREST-AMT (R414-QTR-IDX) DTSBR414 -00868 TO WS-TOTAL-INTEREST-AMT DTSBR414 -00869 MOVE R414-INTEREST-AMT (R414-QTR-IDX) DTSBR414 -00870 TO QTR-DET-INTEREST-AMT DTSBR414 -00871 ADD R414-PENALTY-AMT (R414-QTR-IDX) DTSBR414 -00872 TO WS-TOTAL-PENALTY-AMT DTSBR414 -00873 MOVE R414-PENALTY-AMT (R414-QTR-IDX) DTSBR414 -00874 TO QTR-DET-PENALTY-AMT DTSBR414 -00875 ADD R414-SURCHARG-AMT (R414-QTR-IDX) DTSBR414 -00876 TO WS-TOTAL-SURCHARG-AMT DTSBR414 -00877 MOVE R414-SURCHARG-AMT (R414-QTR-IDX) DTSBR414 -00878 TO QTR-DET-SURCHARG-AMT DTSBR414 -00879 ADD R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 -00880 TO WS-TOTAL-BALANCE-AMT DTSBR414 -00881 MOVE R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 -00882 TO QTR-DET-BALANCE-AMT. DTSBR414 -00883 DTSBR414 -00884 IF LRCM-PICKUP-YRQ = R414-QTR (R414-QTR-IDX) DTSBR414 -00885 SET R414-ANN-FILER-NO-88 (R414-QTR-IDX) TO TRUE DTSBR414 -00886 SET R414-RPT-MISSING-NO-88 (R414-QTR-IDX) TO TRUE DTSBR414 -00887 SET R414-QTR-EST-RPT-NO-88 (R414-QTR-IDX) TO TRUE DTSBR414 -00888 SET R414-QTR-APPEAL-NO-88 (R414-QTR-IDX) TO TRUE. DTSBR414 -00889 DTSBR414 -00890 IF R414-QTR-APPEAL-YES-88 (R414-QTR-IDX) DTSBR414 -00891 SET PRINT-FNOTE4-YES-88 TO TRUE DTSBR414 -00892 MOVE '(d)' TO WFNOTE1 DTSBR414 -00893 ELSE DTSBR414 -00894 IF R414-QTR-EST-RPT-YES-88 (R414-QTR-IDX) DTSBR414 -00895 SET PRINT-FNOTE1-YES-88 TO TRUE DTSBR414 -00896 MOVE '(a)' TO WFNOTE1 DTSBR414 -00897 ELSE DTSBR414 -00898 IF R414-RPT-MISSING-YES-88 (R414-QTR-IDX) DTSBR414 -00899 SET PRINT-FNOTE2-YES-88 TO TRUE DTSBR414 -00900 MOVE '(b)' TO WFNOTE1. DTSBR414 -00901 DTSBR414 -00902 IF R414-ANN-FILER-YES-88 (R414-QTR-IDX) DTSBR414 -00903 SET PRINT-FNOTE3-YES-88 TO TRUE DTSBR414 -00904 IF WFNOTE1 = SPACES DTSBR414 -00905 MOVE '(c)' TO WFNOTE1 DTSBR414 -00906 ELSE DTSBR414 -00907 MOVE '(c)' TO WFNOTE2. DTSBR414 -00908 DTSBR414 -00909 DTSBR414 -00910 IF WS-QTR-FNOTE > SPACES DTSBR414 -00911 MOVE WS-QTR-FNOTE TO QTR-DET-FNOTE. DTSBR414 -00912 DTSBR414 -00913 ** ADD 1 TO LINE-CNT. DTSBR414 -00914 ** MOVE STMT-QTR-DETAIL TO WS-REC. DTSBR414 -00915 ** WRITE PRT-REC1 FROM WS-REC AFTER 1. DTSBR414 -00916 ***testing all bill printing DTSBR414 -00917 If line-cnt < 44 and R414-QTR-IDX <= R414-QTR-CNT DTSBR414 -00918 ADD 1 TO LINE-CNT DTSBR414 -00919 MOVE STMT-QTR-DETAIL TO WS-REC DTSBR414 -00920 WRITE PRT-REC1 FROM WS-REC AFTER 1 DTSBR414 -00921 else DTSBR414 -00922 add r414-contrib-amt(r414-qtr-idx) to ws-max-camt DTSBR414 -00923 add r414-interest-amt(r414-qtr-idx) to ws-max-iamt DTSBR414 -00924 add r414-penalty-amt(r414-qtr-idx) to ws-max-pamt DTSBR414 -00925 add r414-surcharg-amt(r414-qtr-idx) to ws-max-samt DTSBR414 -00926 add r414-balance-amt(r414-qtr-idx) to ws-max-bamt DTSBR414 -00927 move spaces to ws-rec DTSBR414 -00928 if r414-qtr-idx = r414-qtr-cnt DTSBR414 -00929 move 'Sub To' to qtr-det-yr1 DTSBR414 -00930 move 'tal' to qtr-det-yr2 DTSBR414 -00931 move spaces to QTR-DET-FNOTE1 DTSBR414 -00932 QTR-DET-FNOTE2 DTSBR414 -00933 move ws-max-camt to qtr-det-contrib-amt DTSBR414 -00934 move ws-max-iamt to qtr-det-interest-amt DTSBR414 -00935 move ws-max-pamt to qtr-det-penalty-amt DTSBR414 -00936 move ws-max-samt to qtr-det-surcharg-amt DTSBR414 -00937 move ws-max-bamt to qtr-det-balance-amt DTSBR414 -00938 MOVE STMT-QTR-DETAIL TO WS-REC DTSBR414 -00939 WRITE PRT-REC1 FROM WS-REC after 1 DTSBR414 -00940 add 1 to line-cnt DTSBR414 -00941 move zeros to ws-max-camt DTSBR414 -00942 ws-max-iamt DTSBR414 -00943 ws-max-pamt DTSBR414 -00944 ws-max-samt DTSBR414 -00945 ws-max-bamt DTSBR414 -00946 end-if DTSBR414 -00947 end-if. DTSBR414 -00948 DTSBR414 -00949 p1300-EXIT. DTSBR414 -00950 eXIT. DTSBR414 -00951 DTSBR414 -00952 ** DTSBR414 -00953 P1500-PRINT-MAILR-ADDR. DTSBR414 -00954 ** DTSBR414 -00955 MOVE L599-BARCODED-DATA TO converted-barcode. DTSBR414 -00956 DTSBR414 -00957 MOVE spaces TO WS-REC. DTSBR414 -00958 WRITE PRT-REC1 FROM WS-REC DTSBR414 -00959 AFTER ADVANCING PAGE. DTSBR414 -00960 DTSBR414 -00961 WRITE PRT-REC1 FROM WS-BARC-LINE AFTER 04. DTSBR414 +00776 IF PRINT-FNOTE4-YES-88 DTSBR414 +00777 WRITE PRT-REC1 FROM FNOTE4 DTSBR414 +00778 AFTER ADVANCING 1 LINES. DTSBR414 +00779 DTSBR414 +00780 DTSBR414 +00781 MOVE SPACES TO WS-XREC DTSBR414 +00782 DTSBR414 +00783 PERFORM P1500-PRINT-MAILR-ADDR THRU P1500-EXIT. DTSBR414 +00784 DTSBR414 +00785 PERFORM P1600-excel-MAILR-sent THRU P1600-EXIT. DTSBR414 +00786 DTSBR414 +00787 P1000-EXIT. DTSBR414 +00788 EXIT. DTSBR414 +00789 SKIP3 DTSBR414 +00790 DTSBR414 +00791 P1100-STUB-STMT-TOTALS. DTSBR414 +00792 DTSBR414 +00793 SET PRINT-BILL-YES-88 TO TRUE. DTSBR414 +00794 DTSBR414 +00795 IF R414-BALANCE-AMT (R414-QTR-IDX) > ZEROS DTSBR414 +00796 ADD R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 +00797 TO WS-STUB-BALANCE-AMT. DTSBR414 +00798 CL*17 +00799 P1100-EXIT. DTSBR414 +00800 EXIT. DTSBR414 +00801 SKIP3 DTSBR414 +00802 DTSBR414 +00803 P1200-PRINT-STUB-MAILR. DTSBR414 +00804 ** DTSBR414 +00805 PERFORM S599-BARCODE THRU S599-EXIT. DTSBR414 +00806 DTSBR414 +00807 IF L599-SETB-FONT1 DTSBR414 +00808 MOVE 'MODIFY=TAXSM1,' TO XEROX-CME DTSBR414 +00809 ELSE DTSBR414 +00810 IF L599-SETB-FONT2 DTSBR414 +00811 MOVE 'MODIFY=TAXSM2,' TO XEROX-CME DTSBR414 +00812 ELSE DTSBR414 +00813 MOVE 'MODIFY=TAXSM1,' TO XEROX-CME. DTSBR414 +00814 DTSBR414 +00815 MOVE XEROX-8X11-LINE TO WS-REC. DTSBR414 +00816 WRITE PRT-REC1 FROM WS-REC DTSBR414 +00817 AFTER ADVANCING PAGE. DTSBR414 +00818 DTSBR414 +00819 MOVE XEROX-CNTL-LINE2 TO WS-REC. DTSBR414 +00820 WRITE PRT-REC1 FROM WS-REC DTSBR414 +00821 AFTER ADVANCING 1. DTSBR414 +00822 ** DTSBR414 +00823 ADD +1 TO PRT-FILE1-PAGE-CNT DTSBR414 +00824 MOVE SPACES TO WS-REC DTSBR414 +00825 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 09 LINES DTSBR414 +00826 MOVE STUB-LINE TO WS-REC DTSBR414 +00827 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 +00828 MOVE ADDR01 TO WS-REC DTSBR414 +00829 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 +00830 MOVE ADDR02 TO WS-REC DTSBR414 +00831 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 +00832 MOVE ADDR03 TO WS-REC DTSBR414 +00833 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 +00834 MOVE ADDR04 TO WS-REC DTSBR414 +00835 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 +00836 MOVE ADDR05 TO WS-REC DTSBR414 +00837 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINES DTSBR414 +00838 MOVE STMT-LINE1 TO WS-REC DTSBR414 +00839 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 4 LINES DTSBR414 +00840 ** WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 7 LINES DTSBR414 +00841 MOVE STMT-LINE2 TO WS-REC DTSBR414 +00842 ** WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 5 LINES. DTSBR414 +00843 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 7 LINES. DTSBR414 +00844 MOVE SPACES TO WS-REC. DTSBR414 +00845 WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 3 LINES. DTSBR414 +00846 P1200-EXIT. DTSBR414 +00847 EXIT. DTSBR414 +00848 SKIP3 DTSBR414 +00849 P1300-DISPLAY-QTR. DTSBR414 +00850 DTSBR414 +00851 MOVE SPACES TO STMT-QTR-DETAIL DTSBR414 +00852 WS-QTR-FNOTE. DTSBR414 +00853 IF LRCM-PICKUP-YRQ = R414-QTR (R414-QTR-IDX) DTSBR414 +00854 MOVE 'PRIOR TO ' TO QTR-DET-YR DTSBR414 +00855 MOVE '1995/4' TO QTR-DET-FNOTE DTSBR414 +00856 ELSE DTSBR414 +00857 MOVE R414-QTR (R414-QTR-IDX) TO WS-WRK-QTR DTSBR414 +00858 IF R414-ANN-FILER-YES-88 (R414-QTR-IDX) DTSBR414 +00859 MOVE SPACES TO WRK-PRT-Q DTSBR414 +00860 MOVE WRK-QTR-YR TO WRK-PRT-YR DTSBR414 +00861 MOVE SPACES TO WRK-PRT-SLASH DTSBR414 +00862 MOVE WS-PRT-QTR TO QTR-DET-YR1 DTSBR414 +00863 MOVE SPACES TO QTR-DET-YR2 DTSBR414 +00864 ELSE DTSBR414 +00865 MOVE WRK-QTR-Q TO WRK-PRT-Q DTSBR414 +00866 MOVE WRK-QTR-YR TO WRK-PRT-YR DTSBR414 +00867 MOVE '/' TO WRK-PRT-SLASH DTSBR414 +00868 MOVE WS-PRT-QTR TO QTR-DET-YR1 DTSBR414 +00869 MOVE SPACES TO QTR-DET-YR2. DTSBR414 +00870 CL*27 +00871 IF R414-BALANCE-AMT (R414-QTR-IDX) > +0 DTSBR414 +00872 SET AMT-DISPLAYED-YES-88 TO TRUE DTSBR414 +00873 MOVE R414-CONTRIB-AMT (R414-QTR-IDX) DTSBR414 +00874 TO QTR-DET-CONTRIB-AMT DTSBR414 +00875 ADD R414-CONTRIB-AMT (R414-QTR-IDX) DTSBR414 +00876 TO WS-TOTAL-CONTRIB-AMT DTSBR414 +00877 ADD R414-INTEREST-AMT (R414-QTR-IDX) DTSBR414 +00878 TO WS-TOTAL-INTEREST-AMT DTSBR414 +00879 MOVE R414-INTEREST-AMT (R414-QTR-IDX) DTSBR414 +00880 TO QTR-DET-INTEREST-AMT DTSBR414 +00881 ADD R414-PENALTY-AMT (R414-QTR-IDX) DTSBR414 +00882 TO WS-TOTAL-PENALTY-AMT DTSBR414 +00883 MOVE R414-PENALTY-AMT (R414-QTR-IDX) DTSBR414 +00884 TO QTR-DET-PENALTY-AMT DTSBR414 +00885 ADD R414-SURCHARG-AMT (R414-QTR-IDX) DTSBR414 +00886 TO WS-TOTAL-SURCHARG-AMT DTSBR414 +00887 MOVE R414-SURCHARG-AMT (R414-QTR-IDX) DTSBR414 +00888 TO QTR-DET-SURCHARG-AMT DTSBR414 +00889 ADD R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 +00890 TO WS-TOTAL-BALANCE-AMT DTSBR414 +00891 MOVE R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 +00892 TO QTR-DET-BALANCE-AMT. DTSBR414 +00893 DTSBR414 +00894 IF LRCM-PICKUP-YRQ = R414-QTR (R414-QTR-IDX) DTSBR414 +00895 SET R414-ANN-FILER-NO-88 (R414-QTR-IDX) TO TRUE DTSBR414 +00896 SET R414-RPT-MISSING-NO-88 (R414-QTR-IDX) TO TRUE DTSBR414 +00897 SET R414-QTR-EST-RPT-NO-88 (R414-QTR-IDX) TO TRUE DTSBR414 +00898 SET R414-QTR-APPEAL-NO-88 (R414-QTR-IDX) TO TRUE. DTSBR414 +00899 DTSBR414 +00900 IF R414-QTR-APPEAL-YES-88 (R414-QTR-IDX) DTSBR414 +00901 SET PRINT-FNOTE4-YES-88 TO TRUE DTSBR414 +00902 MOVE '(d)' TO WFNOTE1 DTSBR414 +00903 ELSE DTSBR414 +00904 IF R414-QTR-EST-RPT-YES-88 (R414-QTR-IDX) DTSBR414 +00905 SET PRINT-FNOTE1-YES-88 TO TRUE DTSBR414 +00906 MOVE '(a)' TO WFNOTE1 DTSBR414 +00907 ELSE DTSBR414 +00908 IF R414-RPT-MISSING-YES-88 (R414-QTR-IDX) DTSBR414 +00909 SET PRINT-FNOTE2-YES-88 TO TRUE DTSBR414 +00910 MOVE '(b)' TO WFNOTE1. DTSBR414 +00911 DTSBR414 +00912 IF R414-ANN-FILER-YES-88 (R414-QTR-IDX) DTSBR414 +00913 SET PRINT-FNOTE3-YES-88 TO TRUE DTSBR414 +00914 IF WFNOTE1 = SPACES DTSBR414 +00915 MOVE '(c)' TO WFNOTE1 DTSBR414 +00916 ELSE DTSBR414 +00917 MOVE '(c)' TO WFNOTE2. DTSBR414 +00918 DTSBR414 +00919 DTSBR414 +00920 IF WS-QTR-FNOTE > SPACES DTSBR414 +00921 MOVE WS-QTR-FNOTE TO QTR-DET-FNOTE. DTSBR414 +00922 DTSBR414 +00923 ** ADD 1 TO LINE-CNT. DTSBR414 +00924 ** MOVE STMT-QTR-DETAIL TO WS-REC. DTSBR414 +00925 ** WRITE PRT-REC1 FROM WS-REC AFTER 1. DTSBR414 +00926 ***testing all bill printing DTSBR414 +00927 If line-cnt < 44 and R414-QTR-IDX <= R414-QTR-CNT DTSBR414 +00928 ADD 1 TO LINE-CNT DTSBR414 +00929 MOVE STMT-QTR-DETAIL TO WS-REC DTSBR414 +00930 WRITE PRT-REC1 FROM WS-REC AFTER 1 DTSBR414 +00931 else DTSBR414 +00932 add r414-contrib-amt(r414-qtr-idx) to ws-max-camt DTSBR414 +00933 add r414-interest-amt(r414-qtr-idx) to ws-max-iamt DTSBR414 +00934 add r414-penalty-amt(r414-qtr-idx) to ws-max-pamt DTSBR414 +00935 add r414-surcharg-amt(r414-qtr-idx) to ws-max-samt DTSBR414 +00936 add r414-balance-amt(r414-qtr-idx) to ws-max-bamt DTSBR414 +00937 move spaces to ws-rec DTSBR414 +00938 if r414-qtr-idx = r414-qtr-cnt DTSBR414 +00939 move 'Sub To' to qtr-det-yr1 DTSBR414 +00940 move 'tal' to qtr-det-yr2 DTSBR414 +00941 move spaces to QTR-DET-FNOTE1 DTSBR414 +00942 QTR-DET-FNOTE2 DTSBR414 +00943 move ws-max-camt to qtr-det-contrib-amt DTSBR414 +00944 move ws-max-iamt to qtr-det-interest-amt DTSBR414 +00945 move ws-max-pamt to qtr-det-penalty-amt DTSBR414 +00946 move ws-max-samt to qtr-det-surcharg-amt DTSBR414 +00947 move ws-max-bamt to qtr-det-balance-amt DTSBR414 +00948 MOVE STMT-QTR-DETAIL TO WS-REC DTSBR414 +00949 WRITE PRT-REC1 FROM WS-REC after 1 DTSBR414 +00950 add 1 to line-cnt DTSBR414 +00951 move zeros to ws-max-camt DTSBR414 +00952 ws-max-iamt DTSBR414 +00953 ws-max-pamt DTSBR414 +00954 ws-max-samt DTSBR414 +00955 ws-max-bamt DTSBR414 +00956 end-if DTSBR414 +00957 end-if. DTSBR414 +00958 DTSBR414 +00959 p1300-EXIT. DTSBR414 +00960 eXIT. DTSBR414 +00961 DTSBR414 00962 ** DTSBR414 -00963 MOVE LINE-ADDR-17 TO WS-XREC DTSBR414 -00964 WRITE PRT-REC1 FROM WS-XREC DTSBR414 -00965 AFTER ADVANCING 13 lines DTSBR414 -00966 MOVE LINE-ADDR-18 TO WS-XREC DTSBR414 -00967 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR414 -00968 MOVE LINE-ADDR-19 TO WS-XREC DTSBR414 -00969 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR414 -00970 MOVE LINE-ADDR-20 TO WS-XREC DTSBR414 -00971 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR414 -00972 MOVE LINE-ADDR-21 TO WS-XREC DTSBR414 -00973 WRITE PRT-REC1 FROM WS-XREC AFTER 1. DTSBR414 -00974 P1500-EXIT. DTSBR414 -00975 EXIT. DTSBR414 -00976 SKIP3 DTSBR414 -00977 ** DTSBR414 -00978 P1600-excel-mailr-sent. DTSBR414 -00979 DTSBR414 -00980 MOVE R414-EMP-NO TO EXCL-REC6-EMP-NO. DTSBR414 -00981 MOVE R414-QTR-CNT TO EXCL-REC6-QTR-CNT DTSBR414 -00982 MOVE R414-FMT-LINE (1) TO EXCL-REC6-EMP-NAME. DTSBR414 -00983 DTSBR414 -00984 inspect excl-REC6-emp-name replacing all ',' by spaces DTSBR414 -00985 DTSBR414 -00986 IF AMT-DISPLAYED-YES-88 DTSBR414 -00987 MOVE WS-TOTAL-CONTRIB-AMT TO EXCL-rec6-CONTRIB-AMT DTSBR414 -00988 MOVE WS-TOTAL-INTEREST-AMT TO EXCL-rec6-INTEREST-AMT DTSBR414 -00989 MOVE WS-TOTAL-SURCHARG-AMT TO EXCL-rec6-SURCHARG-AMT DTSBR414 -00990 MOVE WS-TOTAL-PENALTY-AMT TO EXCL-rec6-PENALTY-AMT DTSBR414 -00991 MOVE WS-TOTAL-BALANCE-AMT TO EXCL-rec6-BALANCE-AMT DTSBR414 -00992 ELSE DTSBR414 -00993 MOVE ZEROS TO EXCL-rec6-CONTRIB-AMT DTSBR414 -00994 EXCL-rec6-INTEREST-AMT DTSBR414 -00995 EXCL-rec6-SURCHARG-AMT DTSBR414 -00996 EXCL-rec6-PENALTY-AMT DTSBR414 -00997 EXCL-rec6-BALANCE-AMT. DTSBR414 -00998 DTSBR414 -00999 WRITE PRT-REC6 FROM EXCL-REC6-LINE AFTER 1. DTSBR414 -01000 P1600-EXIT. DTSBR414 -01001 EXIT. DTSBR414 -01002 SKIP3 DTSBR414 -01003 P2000-PRINT-REPORT. DTSBR414 -01004 IF R414-FLD-REP-ID NOT = WS-FLD-REP-ID DTSBR414 -01005 MOVE R414-FLD-REP-ID TO WS-FLD-REP-ID DTSBR414 -01006 HDR3-ID DTSBR414 -01007 PERFORM P2500-PRINT-HEADERS THRU P2500-EXIT DTSBR414 -01008 ELSE DTSBR414 -01009 IF REC2-LINE-CNT > 51 DTSBR414 -01010 PERFORM P2500-PRINT-HEADERS THRU P2500-EXIT. DTSBR414 -01011 DTSBR414 -01012 MOVE R414-EMP-NO TO REPT-EMP-NO DTSBR414 -01013 excl-EMP-NO. DTSBR414 -01014 MOVE R414-QTR-CNT TO REPT-QTR-CNT DTSBR414 -01015 excl-QTR-CNT DTSBR414 -01016 MOVE R414-FMT-LINE (1) TO REPT-EMP-NAME DTSBR414 -01017 excl-EMP-NAME. DTSBR414 -01018 inspect rept-emp-name replacing all ',' by spaces DTSBR414 -01019 inspect excl-emp-name replacing all ',' by spaces DTSBR414 -01020 ****nh DTSBR414 -01021 MOVE +0 TO WS-TOTAL-CONTRIB-AMT DTSBR414 -01022 WS-TOTAL-PENALTY-AMT DTSBR414 -01023 WS-TOTAL-INTEREST-AMT DTSBR414 -01024 WS-TOTAL-SURCHARG-AMT DTSBR414 -01025 WS-STUB-BALANCE-AMT DTSBR414 -01026 WS-TOTAL-BALANCE-AMT. DTSBR414 -01027 ***nh DTSBR414 -01028 DTSBR414 -01029 PERFORM P2100-REPT-STMT-TOTALS THRU P2100-EXIT DTSBR414 -01030 VARYING R414-QTR-IDX FROM 1 BY 1 DTSBR414 -01031 UNTIL R414-QTR-IDX > R414-QTR-CNT. DTSBR414 -01032 DTSBR414 -01033 MOVE WS-TOTAL-CONTRIB-AMT TO REPT-CONTRIB-AMT DTSBR414 -01034 excl-CONTRIB-AMT. DTSBR414 -01035 MOVE WS-TOTAL-INTEREST-AMT TO REPT-INTEREST-AMT DTSBR414 -01036 excl-INTEREST-AMT. DTSBR414 -01037 MOVE WS-TOTAL-PENALTY-AMT TO REPT-PENALTY-AMT DTSBR414 -01038 excl-PENALTY-AMT. DTSBR414 -01039 MOVE WS-TOTAL-SURCHARG-AMT TO REPT-SURCHARG-AMT DTSBR414 -01040 excl-SURCHARG-AMT. DTSBR414 -01041 MOVE WS-TOTAL-BALANCE-AMT TO REPT-BALANCE-AMT DTSBR414 -01042 excl-BALANCE-AMT. DTSBR414 -01043 DTSBR414 -01044 WRITE PRT-REC2 FROM REPT-STMT-LINE AFTER 1. DTSBR414 -01045 WRITE PRT-REC4 FROM excl-STMT-LINE AFTER 1. DTSBR414 -01046 ADD 1 TO REC2-LINE-CNT DTSBR414 -01047 WS-REPT-CNT. DTSBR414 -01048 P2000-EXIT. DTSBR414 -01049 EXIT. DTSBR414 -01050 DTSBR414 -01051 P2100-REPT-STMT-TOTALS. DTSBR414 -01052 IF R414-BALANCE-AMT (R414-QTR-IDX) > +0 DTSBR414 -01053 ADD R414-CONTRIB-AMT (R414-QTR-IDX) DTSBR414 -01054 TO WS-TOTAL-CONTRIB-AMT DTSBR414 -01055 ADD R414-INTEREST-AMT (R414-QTR-IDX) DTSBR414 -01056 TO WS-TOTAL-INTEREST-AMT DTSBR414 -01057 ADD R414-PENALTY-AMT (R414-QTR-IDX) DTSBR414 -01058 TO WS-TOTAL-PENALTY-AMT DTSBR414 -01059 ADD R414-SURCHARG-AMT (R414-QTR-IDX) DTSBR414 -01060 TO WS-TOTAL-SURCHARG-AMT DTSBR414 -01061 ADD R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 -01062 TO WS-TOTAL-BALANCE-AMT. DTSBR414 -01063 P2100-EXIT. DTSBR414 -01064 EXIT. DTSBR414 -01065 DTSBR414 +00963 P1500-PRINT-MAILR-ADDR. DTSBR414 +00964 ** DTSBR414 +00965 MOVE L599-BARCODED-DATA TO converted-barcode. DTSBR414 +00966 DTSBR414 +00967 MOVE spaces TO WS-REC. DTSBR414 +00968 WRITE PRT-REC1 FROM WS-REC DTSBR414 +00969 AFTER ADVANCING PAGE. DTSBR414 +00970 DTSBR414 +00971 WRITE PRT-REC1 FROM WS-BARC-LINE AFTER 04. DTSBR414 +00972 ** DTSBR414 +00973 MOVE LINE-ADDR-17 TO WS-XREC DTSBR414 +00974 WRITE PRT-REC1 FROM WS-XREC DTSBR414 +00975 AFTER ADVANCING 13 lines DTSBR414 +00976 MOVE LINE-ADDR-18 TO WS-XREC DTSBR414 +00977 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR414 +00978 MOVE LINE-ADDR-19 TO WS-XREC DTSBR414 +00979 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR414 +00980 MOVE LINE-ADDR-20 TO WS-XREC DTSBR414 +00981 WRITE PRT-REC1 FROM WS-XREC AFTER 1 DTSBR414 +00982 MOVE LINE-ADDR-21 TO WS-XREC DTSBR414 +00983 WRITE PRT-REC1 FROM WS-XREC AFTER 1. DTSBR414 +00984 P1500-EXIT. DTSBR414 +00985 EXIT. DTSBR414 +00986 SKIP3 DTSBR414 +00987 ** DTSBR414 +00988 P1600-excel-mailr-sent. DTSBR414 +00989 DTSBR414 +00990 MOVE R414-EMP-NO TO EXCL-REC6-EMP-NO. DTSBR414 +00991 MOVE R414-QTR-CNT TO EXCL-REC6-QTR-CNT DTSBR414 +00992 MOVE R414-FMT-LINE (1) TO EXCL-REC6-EMP-NAME. DTSBR414 +00993 move r414-status to excl-rec6-status. CL*24 +00994 move r414-class to excl-rec6-class. CL*28 +00995 move r414-field-rep to excl-rec6-field-rep. CL*33 +00996 move r414-lien to excl-rec6-lien. CL*36 +00997 move r414-pursued to excl-rec6-pursued. CL*38 +00998 inspect excl-REC6-emp-name replacing all ',' by spaces DTSBR414 +00999 DTSBR414 +01000 IF AMT-DISPLAYED-YES-88 DTSBR414 +01001 MOVE WS-TOTAL-CONTRIB-AMT TO EXCL-rec6-CONTRIB-AMT DTSBR414 +01002 MOVE WS-TOTAL-INTEREST-AMT TO EXCL-rec6-INTEREST-AMT DTSBR414 +01003 MOVE WS-TOTAL-SURCHARG-AMT TO EXCL-rec6-SURCHARG-AMT DTSBR414 +01004 MOVE WS-TOTAL-PENALTY-AMT TO EXCL-rec6-PENALTY-AMT DTSBR414 +01005 MOVE WS-TOTAL-BALANCE-AMT TO EXCL-rec6-BALANCE-AMT DTSBR414 +01006 ELSE DTSBR414 +01007 MOVE ZEROS TO EXCL-rec6-CONTRIB-AMT DTSBR414 +01008 EXCL-rec6-INTEREST-AMT DTSBR414 +01009 EXCL-rec6-SURCHARG-AMT DTSBR414 +01010 EXCL-rec6-PENALTY-AMT DTSBR414 +01011 EXCL-rec6-BALANCE-AMT. DTSBR414 +01012 DTSBR414 +01013 WRITE PRT-REC6 FROM EXCL-REC6-LINE AFTER 1. DTSBR414 +01014 P1600-EXIT. DTSBR414 +01015 EXIT. DTSBR414 +01016 SKIP3 DTSBR414 +01017 P2000-PRINT-REPORT. DTSBR414 +01018 IF R414-FLD-REP-ID NOT = WS-FLD-REP-ID CL**8 +01019 MOVE R414-FLD-REP-ID TO WS-FLD-REP-ID CL**8 +01020 HDR3-ID CL**8 +01021 PERFORM P2500-PRINT-HEADERS THRU P2500-EXIT CL**8 +01022 ELSE CL**8 +01023 IF REC2-LINE-CNT > 51 CL**8 +01024 PERFORM P2500-PRINT-HEADERS THRU P2500-EXIT. CL**8 +01025 DTSBR414 +01026 MOVE R414-EMP-NO TO REPT-EMP-NO DTSBR414 +01027 excl-EMP-NO. DTSBR414 +01028 MOVE R414-QTR-CNT TO REPT-QTR-CNT DTSBR414 +01029 excl-QTR-CNT DTSBR414 +01030 MOVE R414-FMT-LINE (1) TO REPT-EMP-NAME DTSBR414 +01031 excl-EMP-NAME. DTSBR414 +01032 inspect rept-emp-name replacing all ',' by spaces DTSBR414 +01033 inspect excl-emp-name replacing all ',' by spaces DTSBR414 +01034 ****nh DTSBR414 +01035 MOVE +0 TO WS-TOTAL-CONTRIB-AMT DTSBR414 +01036 WS-TOTAL-PENALTY-AMT DTSBR414 +01037 WS-TOTAL-INTEREST-AMT DTSBR414 +01038 WS-TOTAL-SURCHARG-AMT DTSBR414 +01039 WS-STUB-BALANCE-AMT DTSBR414 +01040 WS-TOTAL-BALANCE-AMT. DTSBR414 +01041 ***nh DTSBR414 +01042 if r414-emp-no = 122959 CL*40 +01043 go to P2000-EXIT. CL*40 +01044 ***nh CL*40 +01045 PERFORM P2100-REPT-STMT-TOTALS THRU P2100-EXIT DTSBR414 +01046 VARYING R414-QTR-IDX FROM 1 BY 1 DTSBR414 +01047 UNTIL R414-QTR-IDX > R414-QTR-CNT. DTSBR414 +01048 DTSBR414 +01049 MOVE WS-TOTAL-CONTRIB-AMT TO REPT-CONTRIB-AMT DTSBR414 +01050 excl-CONTRIB-AMT. DTSBR414 +01051 MOVE WS-TOTAL-INTEREST-AMT TO REPT-INTEREST-AMT DTSBR414 +01052 excl-INTEREST-AMT. DTSBR414 +01053 MOVE WS-TOTAL-PENALTY-AMT TO REPT-PENALTY-AMT DTSBR414 +01054 excl-PENALTY-AMT. DTSBR414 +01055 MOVE WS-TOTAL-SURCHARG-AMT TO REPT-SURCHARG-AMT DTSBR414 +01056 excl-SURCHARG-AMT. DTSBR414 +01057 MOVE WS-TOTAL-BALANCE-AMT TO REPT-BALANCE-AMT DTSBR414 +01058 excl-BALANCE-AMT. DTSBR414 +01059 DTSBR414 +01060 WRITE PRT-REC2 FROM REPT-STMT-LINE AFTER 1. CL**8 +01061 WRITE PRT-REC4 FROM excl-STMT-LINE AFTER 1. DTSBR414 +01062 ADD 1 TO REC2-LINE-CNT DTSBR414 +01063 WS-REPT-CNT. DTSBR414 +01064 P2000-EXIT. DTSBR414 +01065 EXIT. DTSBR414 01066 DTSBR414 -01067 P2500-PRINT-HEADERS. DTSBR414 -01068 ADD 1 TO REC2-PAGE-CNT. DTSBR414 -01069 move REC2-PAGE-CNT to hdr3-page. DTSBR414 -01070 WRITE PRT-REC2 FROM HEADER1 AFTER ADVANCING PAGE. DTSBR414 -01071 WRITE PRT-REC2 FROM HEADER2 AFTER ADVANCING 1 DTSBR414 -01072 WRITE PRT-REC2 FROM HEADER3 AFTER ADVANCING 1 DTSBR414 -01073 WRITE PRT-REC2 FROM HEADER4 AFTER ADVANCING 1 DTSBR414 -01074 WRITE PRT-REC2 FROM HEADER5 AFTER ADVANCING 1 DTSBR414 -01075 WRITE PRT-REC2 FROM BLKLINE AFTER ADVANCING 1 DTSBR414 -01076 MOVE 6 TO REC2-LINE-CNT. DTSBR414 -01077 P2500-EXIT. DTSBR414 -01078 EXIT. DTSBR414 -01079 T1000-TERMINATE. DTSBR414 -01080 CLOSE PRT-FILE1 PRT-FILE2 PRT-FILE4 DTSBR414 -01081 PRT-FILE6. DTSBR414 +01067 P2100-REPT-STMT-TOTALS. DTSBR414 +01068 IF R414-BALANCE-AMT (R414-QTR-IDX) > +0 DTSBR414 +01069 ADD R414-CONTRIB-AMT (R414-QTR-IDX) DTSBR414 +01070 TO WS-TOTAL-CONTRIB-AMT DTSBR414 +01071 ADD R414-INTEREST-AMT (R414-QTR-IDX) DTSBR414 +01072 TO WS-TOTAL-INTEREST-AMT DTSBR414 +01073 ADD R414-PENALTY-AMT (R414-QTR-IDX) DTSBR414 +01074 TO WS-TOTAL-PENALTY-AMT DTSBR414 +01075 ADD R414-SURCHARG-AMT (R414-QTR-IDX) DTSBR414 +01076 TO WS-TOTAL-SURCHARG-AMT DTSBR414 +01077 ADD R414-BALANCE-AMT (R414-QTR-IDX) DTSBR414 +01078 TO WS-TOTAL-BALANCE-AMT. DTSBR414 +01079 display 'r414-emp-no ' r414-emp-no. CL*27 +01080 P2100-EXIT. DTSBR414 +01081 EXIT. DTSBR414 01082 DTSBR414 -01083 DISPLAY '***'. DTSBR414 -01084 DTSBR414 -01085 DISPLAY '*** DTSBR414 (STATEMENT OF ACCOUNTS ) ' DTSBR414 -01086 'TERMINATION STATISTICS'. DTSBR414 -01087 DTSBR414 -01088 DISPLAY '***'. DTSBR414 -01089 DTSBR414 -01090 MOVE PRT-FILE1-PAGE-CNT TO DISPLAY-CNT-Z. DTSBR414 -01091 DISPLAY '*** ' DTSBR414 -01092 DISPLAY-CNT DTSBR414 -01093 ' -8X11 PAGE STATEMENTS PRINTED'. DTSBR414 -01094 DTSBR414 -01095 DISPLAY ' '. DTSBR414 -01096 DISPLAY ' EMPLOYERS WITH > 6 DELQ QTRS: ' WS-REPT-CNT. DTSBR414 -01097 DTSBR414 -01098 DISPLAY '***END JOB****'. DTSBR414 -01099 DTSBR414 -01100 T1000-EXIT. DTSBR414 -01101 EXIT. DTSBR414 -01102 EJECT DTSBR414 -01103 S001-FROM-FED-8. DTSBR414 -01104 SET L001-FROM-FED-8 TO TRUE. DTSBR414 -01105 GO TO S001-DATE. DTSBR414 -01106 DTSBR414 -01107 S001-DATE. DTSBR414 -01108 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR414 -01109 S001-EXIT. DTSBR414 -01110 EXIT. DTSBR414 -01111 SKIP3 DTSBR414 -01112 S005-FROM-SYS. DTSBR414 -01113 SET L005-FROM-SYS TO TRUE. DTSBR414 -01114 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBR414 -01115 S005-EXIT. DTSBR414 -01116 EXIT. DTSBR414 -01117 SKIP3 DTSBR414 -01118 DTSBR414 -01119 S599-BARCODE. DTSBR414 -01120 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR414 -01121 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR414 -01122 MOVE 'TAX' TO L599-SYSTEM. DTSBR414 -01123 DTSBR414 -01124 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR414 -01125 DTSBR414 -01126 IF L599-NOT-CONVERTED DTSBR414 -01127 PERFORM S999-ABEND THRU S999-EXIT. DTSBR414 -01128 S599-EXIT. DTSBR414 -01129 EXIT. DTSBR414 -01130 DTSBR414 -01131 S999-ABEND. DTSBR414 -01132 DISPLAY ABEND-MSG. DTSBR414 -01133 DTSBR414 -01134 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR414 -01135 S999-EXIT. DTSBR414 -01136 EXIT. DTSBR414 +01083 DTSBR414 +01084 P2500-PRINT-HEADERS. CL**8 +01085 ADD 1 TO REC2-PAGE-CNT. CL**8 +01086 move REC2-PAGE-CNT to hdr3-page. CL**8 +01087 WRITE PRT-REC2 FROM HEADER1 AFTER ADVANCING PAGE. CL**8 +01088 WRITE PRT-REC2 FROM HEADER2 AFTER ADVANCING 1 CL**8 +01089 WRITE PRT-REC2 FROM HEADER3 AFTER ADVANCING 1 CL**8 +01090 WRITE PRT-REC2 FROM HEADER4 AFTER ADVANCING 1 CL**8 +01091 WRITE PRT-REC2 FROM HEADER5 AFTER ADVANCING 1 CL**8 +01092 WRITE PRT-REC2 FROM BLKLINE AFTER ADVANCING 1 CL**8 +01093 MOVE 6 TO REC2-LINE-CNT. CL**8 +01094 P2500-EXIT. CL**8 +01095 EXIT. CL**8 +01096 T1000-TERMINATE. DTSBR414 +01097 ** CLOSE PRT-FILE1 PRT-FILE2 PRT-FILE4 CL**2 +01098 CLOSE PRT-FILE1 PRT-FILE4 PRT-FILE6 CL**2 +01099 ** PRT-FILE6. CL**2 +01100 DTSBR414 +01101 DISPLAY '***'. DTSBR414 +01102 DTSBR414 +01103 DISPLAY '*** DTSBR414 (STATEMENT OF ACCOUNTS ) ' DTSBR414 +01104 'TERMINATION STATISTICS'. DTSBR414 +01105 DTSBR414 +01106 DISPLAY '***'. DTSBR414 +01107 DTSBR414 +01108 MOVE PRT-FILE1-PAGE-CNT TO DISPLAY-CNT-Z. DTSBR414 +01109 DISPLAY '*** ' DTSBR414 +01110 DISPLAY-CNT DTSBR414 +01111 ' -8X11 PAGE STATEMENTS PRINTED'. DTSBR414 +01112 DTSBR414 +01113 DISPLAY ' '. DTSBR414 +01114 DISPLAY ' EMPLOYERS WITH > 6 DELQ QTRS: ' WS-REPT-CNT. DTSBR414 +01115 DTSBR414 +01116 DISPLAY '***END JOB****'. DTSBR414 +01117 DTSBR414 +01118 T1000-EXIT. DTSBR414 +01119 EXIT. DTSBR414 +01120 EJECT DTSBR414 +01121 S001-FROM-FED-8. DTSBR414 +01122 SET L001-FROM-FED-8 TO TRUE. DTSBR414 +01123 GO TO S001-DATE. DTSBR414 +01124 DTSBR414 +01125 S001-DATE. DTSBR414 +01126 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR414 +01127 S001-EXIT. DTSBR414 +01128 EXIT. DTSBR414 +01129 SKIP3 DTSBR414 +01130 S005-FROM-SYS. DTSBR414 +01131 SET L005-FROM-SYS TO TRUE. DTSBR414 +01132 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBR414 +01133 S005-EXIT. DTSBR414 +01134 EXIT. DTSBR414 +01135 SKIP3 DTSBR414 +01136 DTSBR414 +01137 S599-BARCODE. DTSBR414 +01138 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR414 +01139 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR414 +01140 MOVE 'TAX' TO L599-SYSTEM. DTSBR414 +01141 DTSBR414 +01142 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR414 +01143 DTSBR414 +01144 IF L599-NOT-CONVERTED DTSBR414 +01145 PERFORM S999-ABEND THRU S999-EXIT. DTSBR414 +01146 S599-EXIT. DTSBR414 +01147 EXIT. DTSBR414 +01148 DTSBR414 +01149 S999-ABEND. DTSBR414 +01150 DISPLAY ABEND-MSG. DTSBR414 +01151 DTSBR414 +01152 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR414 +01153 S999-EXIT. DTSBR414 +01154 EXIT. DTSBR414 diff --git a/Batch/DTSBR417.cob b/Batch/DTSBR417.cob index 7bf7cef..52141a2 100644 --- a/Batch/DTSBR417.cob +++ b/Batch/DTSBR417.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 02/26/14 +00001 IDENTIFICATION DIVISION. 02/21/20 00002 PROGRAM-ID. DTSBR417. DTSBR417 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV054 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV012 00004 MODIFIED BY TRW S&ITG. DTSBR417 00005 DATE-WRITTEN. JANUARY 1995. DTSBR417 00006 DATE-COMPILED. DTSBR417 @@ -22,622 +22,635 @@ 00022 * 11-28-97 RECOMPILED FOR MODIFIED DTSIL119. DTSBR417 00023 * REFERENCE RFP #RAP AUTHOR OF CHANGE - EHH DTSBR417 00024 * DTSBR417 -00025 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR417 -00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR417 -00027 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR417 -00028 * DTSBR417 -00029 * DTSBR417 -00030 * DESCRIPTION: DTSBR417 -00031 * DTSBR417 -00032 * THIS MODULE PRINTS A "DELINQUENT REPORT NOTICE". DTSBR417 +00025 * CL**2 +00026 * 03-25-15 RECOMPILED FOR NEW VERSION OF DELINQUENCY LETTER CL**2 +00027 * REFERENCE RFP #RAP AUTHOR OF CHANGE - ZL1 CL**2 +00028 * CL**2 +00029 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR417 +00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR417 +00031 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR417 +00032 * DTSBR417 00033 * DTSBR417 -00034 * DTSBR417 -00035 * RECORDS READ: DTSBR417 -00036 * DTSBR417 -00037 * NONE. DTSBR417 +00034 * DESCRIPTION: DTSBR417 +00035 * DTSBR417 +00036 * THIS MODULE PRINTS A "DELINQUENT REPORT NOTICE". DTSBR417 +00037 * DTSBR417 00038 * DTSBR417 -00039 * DTSBR417 -00040 * PRINTED OUTPUTS: DTSBR417 -00041 * DTSBR417 -00042 * 417R1 DELINQUENT REPORT NOTICE. DTSBR417 +00039 * RECORDS READ: DTSBR417 +00040 * DTSBR417 +00041 * NONE. DTSBR417 +00042 * DTSBR417 00043 * DTSBR417 -00044 * DTSBR417 -00045 * RECORDS WRITTEN: DTSBR417 -00046 * DTSBR417 -00047 * NONE. DTSBR417 +00044 * PRINTED OUTPUTS: DTSBR417 +00045 * DTSBR417 +00046 * 417R1 DELINQUENT REPORT NOTICE. DTSBR417 +00047 * DTSBR417 00048 * DTSBR417 -00049 * DTSBR417 -00050 * MODULES CALLED: DTSBR417 -00051 * DTSBR417 -00052 * DTSBU002 DATE ALPHA CONVERSION MODULE. DTSBR417 -00053 * DTSBU004 YEAR/QUARTER CONVERSION. DTSBR417 -00054 * DTSBU008 DISPLAY QUARTER IN TEXT FORMAT. DTSBR417 -00055 * DTSBU056 RATE DISPLAY. DTSBR417 -00056 * DTSBU090 PARAGRAPH FORMATTING MODULE. DTSBR417 -00057 * DTSBU119 AGENCY FACTS. DTSBR417 -00058 * DTSBR417 -00059 * DTSBR417 -00060 ***** DTSBR417 -00061 EJECT DTSBR417 -00062 ENVIRONMENT DIVISION. DTSBR417 -00063 DTSBR417 -00064 CONFIGURATION SECTION. DTSBR417 -00065 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR417 -00066 DTSBR417 -00067 INPUT-OUTPUT SECTION. DTSBR417 -00068 DTSBR417 -00069 FILE-CONTROL. DTSBR417 -00070 SELECT PRT-FILE ASSIGN TO RPT417R1. DTSBR417 -00071 DTSBR417 -00072 DATA DIVISION. DTSBR417 -00073 DTSBR417 -00074 FILE SECTION. DTSBR417 +00049 * RECORDS WRITTEN: DTSBR417 +00050 * DTSBR417 +00051 * NONE. DTSBR417 +00052 * DTSBR417 +00053 * DTSBR417 +00054 * MODULES CALLED: DTSBR417 +00055 * DTSBR417 +00056 * DTSBU002 DATE ALPHA CONVERSION MODULE. DTSBR417 +00057 * DTSBU004 YEAR/QUARTER CONVERSION. DTSBR417 +00058 * DTSBU008 DISPLAY QUARTER IN TEXT FORMAT. DTSBR417 +00059 * DTSBU056 RATE DISPLAY. DTSBR417 +00060 * DTSBU090 PARAGRAPH FORMATTING MODULE. DTSBR417 +00061 * DTSBU119 AGENCY FACTS. DTSBR417 +00062 * DTSBR417 +00063 * DTSBR417 +00064 ***** DTSBR417 +00065 EJECT DTSBR417 +00066 ENVIRONMENT DIVISION. DTSBR417 +00067 DTSBR417 +00068 CONFIGURATION SECTION. DTSBR417 +00069 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR417 +00070 DTSBR417 +00071 INPUT-OUTPUT SECTION. DTSBR417 +00072 DTSBR417 +00073 FILE-CONTROL. DTSBR417 +00074 SELECT PRT-FILE ASSIGN TO RPT417R1. DTSBR417 00075 DTSBR417 -00076 FD PRT-FILE DTSBR417 -00077 RECORDING MODE IS F DTSBR417 -00078 BLOCK CONTAINS 0 RECORDS DTSBR417 -00079 LABEL RECORDS ARE OMITTED. DTSBR417 -00080 DTSBR417 -00081 01 XEROX-REPORT. DTSBR417 -00082 05 FILLER PIC X(1). DTSBR417 -00083 05 XEROX-RPT PIC X(132). DTSBR417 +00076 DATA DIVISION. DTSBR417 +00077 DTSBR417 +00078 FILE SECTION. DTSBR417 +00079 DTSBR417 +00080 FD PRT-FILE DTSBR417 +00081 RECORDING MODE IS F DTSBR417 +00082 BLOCK CONTAINS 0 RECORDS DTSBR417 +00083 LABEL RECORDS ARE OMITTED. DTSBR417 00084 DTSBR417 -00085 EJECT DTSBR417 -00086 WORKING-STORAGE SECTION. DTSBR417 -000865 77 PAN-VALET PICTURE X(24) VALUE '054DTSBR417 02/26/14'. DTSBR417 -00087 77 PAN-VALET PICTURE X(24) VALUE '024DTSBR417 02/04/14'. DTSBR417 -00088 77 PAN-VALET PICTURE X(24) VALUE '052DTSBR417 11/14/13'. DTSBR417 -00089 77 PAN-VALET PICTURE X(24) VALUE '010DTSBR417 11/14/13'. DTSBR417 -00090 77 PAN-VALET PICTURE X(24) VALUE '050DTSBR417 06/03/13'. DTSBR417 -00091 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR417 04/12/13'. DTSBR417 -00092 77 PAN-VALET PICTURE X(24) VALUE '048DTSBR417 04/03/13'. DTSBR417 -00093 77 PAN-VALET PICTURE X(24) VALUE '026DTSBR417 03/29/13'. DTSBR417 -00094 DTSBR417 -00095 01 WRK-AREA. DTSBR417 -00096 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +417.DTSBR417 -00097 05 WRK-COUNTER PIC 9(1). DTSBR417 -00098 05 WS-YRQ-UNPACK PIC 9(5) VALUE 0. DTSBR417 +00085 01 XEROX-REPORT. DTSBR417 +00086 05 FILLER PIC X(1). DTSBR417 +00087 05 XEROX-RPT PIC X(132). DTSBR417 +00088 DTSBR417 +00089 EJECT DTSBR417 +00090 WORKING-STORAGE SECTION. DTSBR417 +000905 77 PAN-VALET PICTURE X(24) VALUE '012DTSBR417 02/21/20'. DTSBR417 +00091 77 PAN-VALET PICTURE X(24) VALUE '054DTSBR417 02/26/14'. DTSBR417 +00092 77 PAN-VALET PICTURE X(24) VALUE '024DTSBR417 02/04/14'. DTSBR417 +00093 77 PAN-VALET PICTURE X(24) VALUE '052DTSBR417 11/14/13'. DTSBR417 +00094 77 PAN-VALET PICTURE X(24) VALUE '010DTSBR417 11/14/13'. DTSBR417 +00095 77 PAN-VALET PICTURE X(24) VALUE '050DTSBR417 06/03/13'. DTSBR417 +00096 77 PAN-VALET PICTURE X(24) VALUE '001DTSBR417 04/12/13'. DTSBR417 +00097 77 PAN-VALET PICTURE X(24) VALUE '048DTSBR417 04/03/13'. DTSBR417 +00098 77 PAN-VALET PICTURE X(24) VALUE '026DTSBR417 03/29/13'. DTSBR417 00099 DTSBR417 -00100 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR417 -00101 DTSBR417 -00102 05 ABEND-MSG PIC X(60). DTSBR417 -00103 DTSBR417 -00104 05 WS-UNIT-TEL. DTSBR417 -00105 10 WS-UNIT-AREA-CD PIC X(03). DTSBR417 -00106 10 WS-UNIT-PREFIX PIC X(03). DTSBR417 -00107 10 WS-UNIT-SUFFIX PIC X(04). DTSBR417 -00108 10 WS-UNIT-EXTENSION PIC X(04). DTSBR417 -00109 DTSBR417 -00110 05 DISP-TEL. DTSBR417 -00111 10 DISP-TEL-FILLER-1 PIC X(01) VALUE '('. DTSBR417 -00112 10 DISP-TEL-AREA-CD PIC X(03). DTSBR417 -00113 10 DISP-TEL-FILLER-2 PIC X(02) VALUE ') '. DTSBR417 -00114 10 DISP-TEL-PREFIX PIC X(03). DTSBR417 -00115 10 DISP-TEL-FILLER-3 PIC X(01) VALUE '-'. DTSBR417 -00116 10 DISP-TEL-SUFFIX PIC X(04). DTSBR417 -00117 10 FILLER PIC X(01) VALUE '.'. DTSBR417 -00118 DTSBR417 -00119 05 WS-START-POS PIC S9(04) COMP. DTSBR417 -00120 DTSBR417 -00121 * 05 WS-LONG-TEXT-MAIL-DATE PIC X(18). DTSBR417 -00122 DTSBR417 -00123 05 WS-UC-SHORT-MONTHS. DTSBR417 -00124 10 WS-UC-SHORT-MONTH-1 PIC X(03). DTSBR417 -00125 10 WS-UC-SHORT-MONTH-2 PIC X(03). DTSBR417 -00126 10 WS-UC-SHORT-MONTH-3 PIC X(03). DTSBR417 +00100 01 WRK-AREA. DTSBR417 +00101 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +417.DTSBR417 +00102 05 WRK-COUNTER PIC 9(1). DTSBR417 +00103 05 WS-YRQ-UNPACK PIC 9(5) VALUE 0. DTSBR417 +00104 DTSBR417 +00105 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR417 +00106 DTSBR417 +00107 05 ABEND-MSG PIC X(60). DTSBR417 +00108 DTSBR417 +00109 05 WS-UNIT-TEL. DTSBR417 +00110 10 WS-UNIT-AREA-CD PIC X(03). DTSBR417 +00111 10 WS-UNIT-PREFIX PIC X(03). DTSBR417 +00112 10 WS-UNIT-SUFFIX PIC X(04). DTSBR417 +00113 10 WS-UNIT-EXTENSION PIC X(04). DTSBR417 +00114 DTSBR417 +00115 05 DISP-TEL. DTSBR417 +00116 10 DISP-TEL-FILLER-1 PIC X(01) VALUE '('. DTSBR417 +00117 10 DISP-TEL-AREA-CD PIC X(03). DTSBR417 +00118 10 DISP-TEL-FILLER-2 PIC X(02) VALUE ') '. DTSBR417 +00119 10 DISP-TEL-PREFIX PIC X(03). DTSBR417 +00120 10 DISP-TEL-FILLER-3 PIC X(01) VALUE '-'. DTSBR417 +00121 10 DISP-TEL-SUFFIX PIC X(04). DTSBR417 +00122 10 FILLER PIC X(01) VALUE '.'. DTSBR417 +00123 DTSBR417 +00124 05 WS-START-POS PIC S9(04) COMP. DTSBR417 +00125 DTSBR417 +00126 * 05 WS-LONG-TEXT-MAIL-DATE PIC X(18). DTSBR417 00127 DTSBR417 -00128 05 WS-MC-QTR-LONG-DSCR PIC X(06). DTSBR417 -00129 DTSBR417 -00130 05 WS-SHORT-YEAR PIC X(02). DTSBR417 -00131 DTSBR417 -00132 05 WS-LONG-YEAR PIC X(04). DTSBR417 -00133 DTSBR417 -00134 * 05 WS-DISP-RATE PIC X(07). DTSBR417 -00135 DTSBR417 -00136 * 05 WS-SLASH-DUE-DATE PIC X(10). DTSBR417 -00137 DTSBR417 -00138 05 WS-LONG-TEXT-DUE-DATE PIC X(18). DTSBR417 -00139 DTSBR417 -00140 * 05 WS-TEXT-LINE-1 PIC X(70). DTSBR417 -00141 DTSBR417 -00142 * 05 WS-TEXT-LINE-2 PIC X(33). DTSBR417 -00143 DTSBR417 -00144 * 05 WS-TEXT-LINE-3A PIC X(70). DTSBR417 -00145 DTSBR417 -00146 * 05 WS-TEXT-LINE-3B PIC X(70). DTSBR417 -00147 DTSBR417 -00148 * 05 WS-TEXT-LINE-3C PIC X(70). DTSBR417 -00149 DTSBR417 -00150 * 05 WS-TEXT-LINE-4 PIC X(70). DTSBR417 -00151 DTSBR417 -00152 05 DETAIL-2-LINE-CNT PIC S9(04) COMP. DTSBR417 -00153 DTSBR417 -00154 05 DETAIL-2-BLANK-LINE-CNT PIC S9(04) COMP. DTSBR417 -00155 DTSBR417 -00156 05 WS-YRQ-SUB PIC S9(04) COMP. DTSBR417 -00157 05 ADDR-FMT-AREA PIC X(200). DTSBR417 -00158 05 ADDR-FMT-AREA-X REDEFINES ADDR-FMT-AREA. DTSBR417 -00159 10 ADDR-FMT-LINE OCCURS 5 TIMES PIC X(40). DTSBR417 +00128 05 WS-UC-SHORT-MONTHS. DTSBR417 +00129 10 WS-UC-SHORT-MONTH-1 PIC X(03). DTSBR417 +00130 10 WS-UC-SHORT-MONTH-2 PIC X(03). DTSBR417 +00131 10 WS-UC-SHORT-MONTH-3 PIC X(03). DTSBR417 +00132 DTSBR417 +00133 05 WS-MC-QTR-LONG-DSCR PIC X(06). DTSBR417 +00134 DTSBR417 +00135 05 WS-SHORT-YEAR PIC X(02). DTSBR417 +00136 DTSBR417 +00137 05 WS-LONG-YEAR PIC X(04). DTSBR417 +00138 DTSBR417 +00139 * 05 WS-DISP-RATE PIC X(07). DTSBR417 +00140 DTSBR417 +00141 * 05 WS-SLASH-DUE-DATE PIC X(10). DTSBR417 +00142 DTSBR417 +00143 05 WS-LONG-TEXT-DUE-DATE PIC X(18). DTSBR417 +00144 DTSBR417 +00145 * 05 WS-TEXT-LINE-1 PIC X(70). DTSBR417 +00146 DTSBR417 +00147 * 05 WS-TEXT-LINE-2 PIC X(33). DTSBR417 +00148 DTSBR417 +00149 * 05 WS-TEXT-LINE-3A PIC X(70). DTSBR417 +00150 DTSBR417 +00151 * 05 WS-TEXT-LINE-3B PIC X(70). DTSBR417 +00152 DTSBR417 +00153 * 05 WS-TEXT-LINE-3C PIC X(70). DTSBR417 +00154 DTSBR417 +00155 * 05 WS-TEXT-LINE-4 PIC X(70). DTSBR417 +00156 DTSBR417 +00157 05 DETAIL-2-LINE-CNT PIC S9(04) COMP. DTSBR417 +00158 DTSBR417 +00159 05 DETAIL-2-BLANK-LINE-CNT PIC S9(04) COMP. DTSBR417 00160 DTSBR417 -00161 05 WS-REC PIC X(132) VALUE SPACES. DTSBR417 -00162 01 VSCA-LINE. DTSBR417 -00163 05 VSCA-DATA PIC X(133) VALUE SPACES. DTSBR417 -00164 DTSBR417 -00165 EJECT DTSBR417 -00166 01 MIXED-CASE-LITERALS. DTSBR417 -00167 ++INCLUDE DTSIZ41D DTSBR417 -00168 EJECT DTSBR417 -00169 01 L001-LINK-AREA. DTSBR417 -00170 ++INCLUDE DTSIL001 DTSBR417 -00171 EJECT DTSBR417 -00172 01 L002-LINK-AREA. DTSBR417 -00173 ++INCLUDE DTSIL002 DTSBR417 -00174 EJECT DTSBR417 -00175 01 L004-LINK-AREA. DTSBR417 -00176 ++INCLUDE DTSIL004 DTSBR417 -00177 EJECT DTSBR417 -00178 01 L008-LINK-AREA. DTSBR417 -00179 ++INCLUDE DTSIL008 DTSBR417 -00180 EJECT DTSBR417 -00181 01 L056-LINK-AREA. DTSBR417 -00182 ++INCLUDE DTSIL056 DTSBR417 -00183 EJECT DTSBR417 -00184 01 L090-LINK-AREA. DTSBR417 -00185 ++INCLUDE DTSIL090 DTSBR417 -00186 EJECT DTSBR417 -00187 01 L119-LINK-AREA. DTSBR417 -00188 ++INCLUDE DTSIL119 DTSBR417 -00189 EJECT DTSBR417 -00190 ++INCLUDE DTSIZ41C DTSBR417 -00191 SKIP3 DTSBR417 -00192 ++INCLUDE DTSXL417 DTSBR417 -00193 SKIP3 DTSBR417 -00194 *RW1 DTSBR417 -00195 01 CONVERT-BARCODE-LINE. DTSBR417 -00196 05 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR417 -00197 DTSBR417 -00198 01 WS-BARC-LINE. DTSBR417 -00199 05 FILLER PIC X(40) VALUE SPACES. DTSBR417 -00200 05 CONVERTED-BARCODE PIC X(50). DTSBR417 -00201 05 FILLER PIC X(30) VALUE SPACES. DTSBR417 +00161 05 WS-YRQ-SUB PIC S9(04) COMP. DTSBR417 +00162 05 ADDR-FMT-AREA PIC X(200). DTSBR417 +00163 05 ADDR-FMT-AREA-X REDEFINES ADDR-FMT-AREA. DTSBR417 +00164 10 ADDR-FMT-LINE OCCURS 5 TIMES PIC X(40). DTSBR417 +00165 DTSBR417 +00166 05 WS-REC PIC X(132) VALUE SPACES. DTSBR417 +00167 01 VSCA-LINE. DTSBR417 +00168 05 VSCA-DATA PIC X(133) VALUE SPACES. DTSBR417 +00169 DTSBR417 +00170 EJECT DTSBR417 +00171 01 MIXED-CASE-LITERALS. DTSBR417 +00172 ++INCLUDE DTSIZ41D DTSBR417 +00173 EJECT DTSBR417 +00174 01 L001-LINK-AREA. DTSBR417 +00175 ++INCLUDE DTSIL001 DTSBR417 +00176 EJECT DTSBR417 +00177 01 L002-LINK-AREA. DTSBR417 +00178 ++INCLUDE DTSIL002 DTSBR417 +00179 EJECT DTSBR417 +00180 01 L004-LINK-AREA. DTSBR417 +00181 ++INCLUDE DTSIL004 DTSBR417 +00182 EJECT DTSBR417 +00183 01 L008-LINK-AREA. DTSBR417 +00184 ++INCLUDE DTSIL008 DTSBR417 +00185 EJECT DTSBR417 +00186 01 L056-LINK-AREA. DTSBR417 +00187 ++INCLUDE DTSIL056 DTSBR417 +00188 EJECT DTSBR417 +00189 01 L090-LINK-AREA. DTSBR417 +00190 ++INCLUDE DTSIL090 DTSBR417 +00191 EJECT DTSBR417 +00192 01 L119-LINK-AREA. DTSBR417 +00193 ++INCLUDE DTSIL119 DTSBR417 +00194 EJECT DTSBR417 +00195 ++INCLUDE DTSIZ41C DTSBR417 +00196 SKIP3 DTSBR417 +00197 ++INCLUDE DTSXL417 DTSBR417 +00198 SKIP3 DTSBR417 +00199 *RW1 DTSBR417 +00200 01 CONVERT-BARCODE-LINE. DTSBR417 +00201 05 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR417 00202 DTSBR417 -00203 01 BARI-LINK-AREA. DTSBR417 -00204 ++INCLUDE BARIL599 DTSBR417 -00205 SKIP3 DTSBR417 -00206 *RW2 DTSBR417 -00207 EJECT DTSBR417 -00208 LINKAGE SECTION. DTSBR417 -00209 SKIP3 DTSBR417 -00210 01 LRCM-LINK-AREA. DTSBR417 -00211 ++INCLUDE DTSILRCM DTSBR417 +00203 01 WS-BARC-LINE. DTSBR417 +00204 05 FILLER PIC X(40) VALUE SPACES. DTSBR417 +00205 05 CONVERTED-BARCODE PIC X(50). DTSBR417 +00206 05 FILLER PIC X(30) VALUE SPACES. DTSBR417 +00207 DTSBR417 +00208 01 BARI-LINK-AREA. DTSBR417 +00209 ++INCLUDE BARIL599 DTSBR417 +00210 SKIP3 DTSBR417 +00211 *RW2 DTSBR417 00212 EJECT DTSBR417 -00213 01 R417-REC. DTSBR417 -00214 ++INCLUDE DTSIR417 DTSBR417 -00215 EJECT DTSBR417 -00216 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR417 -00217 R417-REC. DTSBR417 -00218 SKIP2 DTSBR417 -00219 IF FIRST-TIME-IND = 'Y' DTSBR417 -00220 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR417 -00221 MOVE 'N' TO FIRST-TIME-IND DTSBR417 -00222 MOVE 0 TO WRK-COUNTER. DTSBR417 -00223 DTSBR417 -00224 *BO IF WRK-COUNTER > 1 DTSBR417 -00225 * GOBACK. DTSBR417 -00226 DTSBR417 -00227 IF LRCM-EOR-88 DTSBR417 -00228 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR417 -00229 ELSE DTSBR417 -00230 ADD 1 TO WRK-COUNTER DTSBR417 -00231 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR417 -00232 SKIP2 DTSBR417 -00233 GOBACK. DTSBR417 -00234 EJECT DTSBR417 -00235 I1000-INITIATE. DTSBR417 -00236 DTSBR417 -00237 OPEN OUTPUT PRT-FILE. DTSBR417 -00238 MOVE SPACES TO XEROX-REPORT. DTSBR417 -00239 DTSBR417 -00240 WRITE XEROX-REPORT FROM VSCA-LINE DTSBR417 -00241 AFTER ADVANCING TOP-OF-PAGE. DTSBR417 -00242 WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 11. DTSBR417 -00243 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE13 DTSBR417 -00244 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE14. DTSBR417 -00245 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE15. DTSBR417 -00246 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE16. DTSBR417 -00247 * WRITE XEROX-REPORT FROM ROUTE-INFO-LINE17. DTSBR417 -00248 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE18. DTSBR417 -00249 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE19. DTSBR417 -00250 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE20. DTSBR417 -00251 DTSBR417 -00252 *BO SET L119-REQ-DEL-RPT-88 TO TRUE. DTSBR417 -00253 SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSBR417 -00254 PERFORM S119-REQ-MIXED THRU S119-EXIT. DTSBR417 -00255 MOVE L119-UNIT-VOICE TO WS-UNIT-TEL. DTSBR417 -00256 I1000-EXIT. DTSBR417 -00257 EXIT. DTSBR417 -00258 EJECT DTSBR417 -00259 P1000-PROCESS. DTSBR417 -00260 DISPLAY 'EMP NO ' R417-EMP-NO. DTSBR417 -00261 * MOVE '(' TO DISP-TEL-FILLER-1. DTSBR417 -00262 * MOVE WS-UNIT-AREA-CD TO DISP-TEL-AREA-CD. DTSBR417 -00263 * MOVE ') ' TO DISP-TEL-FILLER-2. DTSBR417 -00264 * MOVE WS-UNIT-PREFIX TO DISP-TEL-PREFIX. DTSBR417 -00265 * MOVE '-' TO DISP-TEL-FILLER-3. DTSBR417 -00266 * MOVE WS-UNIT-SUFFIX TO DISP-TEL-SUFFIX. DTSBR417 -00267 ** MOVE DISP-TEL TO WS-TEXT-LINE-2. DTSBR417 -00268 * MOVE 20130901 TO R417-MAIL-DATE. DTSBR417 -00269 * MOVE 20130911 TO R417-RETURN-BY-DATE. DTSBR417 -00270 * DISPLAY ' MAIL DTE ' R417-MAIL-DATE DTSBR417 -00271 * MOVE ZEROS TO L002-DATE. DTSBR417 -00272 MOVE R417-MAIL-DATE TO L002-DATE. DTSBR417 -00273 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 -00274 DTSBR417 -00275 COMPUTE WS-START-POS = (18 - L002-LONG-TEXT-CNT) / 2. DTSBR417 -00276 DTSBR417 -00277 ADD +1 TO WS-START-POS. DTSBR417 -00278 DTSBR417 -00279 IF (WS-START-POS > +0) DTSBR417 -00280 AND DTSBR417 -00281 (WS-START-POS < +18) DTSBR417 -00282 MOVE SPACES TO WS-LONG-TEXT-MAIL-DATE DTSBR417 -00283 MOVE L002-LONG-TEXT-AREA DTSBR417 -00284 TO WS-LONG-TEXT-MAIL-DATE (WS-START-POS:) DTSBR417 -00285 ELSE DTSBR417 -00286 MOVE L002-LONG-TEXT-AREA TO WS-LONG-TEXT-MAIL-DATE. DTSBR417 -00287 DTSBR417 -00288 MOVE R417-TOTAL-RATE TO L056-RATE. DTSBR417 -00289 PERFORM S056-DISP1-LEFT-PCT THRU S056-EXIT. DTSBR417 -00290 MOVE L056-DISP-RATE TO WS-DISP-RATE. DTSBR417 -00291 DTSBR417 -00292 MOVE R417-YRQ TO L008-YRQ. DTSBR417 -00293 PERFORM S008-UPPER-CASE THRU S008-EXIT. DTSBR417 -00294 MOVE L008-SHORT-MONTHS TO WS-UC-SHORT-MONTHS. DTSBR417 -00295 DTSBR417 -00296 PERFORM S008-MIXED-CASE THRU S008-EXIT. DTSBR417 -00297 MOVE L008-SHORT-DSCR TO DTL-UC-SHORT-QTR-3. DTSBR417 -00298 DTSBR417 -00299 MOVE L008-YEAR (3:2) TO WS-SHORT-YEAR. DTSBR417 -00300 DTSBR417 -00301 MOVE L008-YEAR TO WS-LONG-YEAR DTL-LONG-YEAR3. DTSBR417 -00302 DTSBR417 -00303 MOVE R417-DUE-DATE TO L001-FED-8-DATE-9. DTSBR417 -00304 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR417 -00305 MOVE L001-SLASH-8-DATE TO WS-SLASH-DUE-DATE. DTSBR417 +00213 LINKAGE SECTION. DTSBR417 +00214 SKIP3 DTSBR417 +00215 01 LRCM-LINK-AREA. DTSBR417 +00216 ++INCLUDE DTSILRCM DTSBR417 +00217 EJECT DTSBR417 +00218 01 R417-REC. DTSBR417 +00219 ++INCLUDE DTSIR417 DTSBR417 +00220 EJECT DTSBR417 +00221 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR417 +00222 R417-REC. DTSBR417 +00223 SKIP2 DTSBR417 +00224 IF FIRST-TIME-IND = 'Y' DTSBR417 +00225 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR417 +00226 MOVE 'N' TO FIRST-TIME-IND DTSBR417 +00227 MOVE 0 TO WRK-COUNTER. DTSBR417 +00228 DTSBR417 +00229 *BO IF WRK-COUNTER > 1 DTSBR417 +00230 * GOBACK. DTSBR417 +00231 DTSBR417 +00232 IF LRCM-EOR-88 DTSBR417 +00233 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR417 +00234 ELSE DTSBR417 +00235 ADD 1 TO WRK-COUNTER DTSBR417 +00236 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR417 +00237 SKIP2 DTSBR417 +00238 GOBACK. DTSBR417 +00239 EJECT DTSBR417 +00240 I1000-INITIATE. DTSBR417 +00241 DTSBR417 +00242 OPEN OUTPUT PRT-FILE. DTSBR417 +00243 MOVE SPACES TO XEROX-REPORT. DTSBR417 +00244 DTSBR417 +00245 WRITE XEROX-REPORT FROM VSCA-LINE DTSBR417 +00246 AFTER ADVANCING TOP-OF-PAGE. DTSBR417 +00247 WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 11. DTSBR417 +00248 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE13 DTSBR417 +00249 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE14. DTSBR417 +00250 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE15. DTSBR417 +00251 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE16. DTSBR417 +00252 * WRITE XEROX-REPORT FROM ROUTE-INFO-LINE17. DTSBR417 +00253 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE18. DTSBR417 +00254 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE19. DTSBR417 +00255 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE20. DTSBR417 +00256 DTSBR417 +00257 *BO SET L119-REQ-DEL-RPT-88 TO TRUE. DTSBR417 +00258 SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSBR417 +00259 PERFORM S119-REQ-MIXED THRU S119-EXIT. DTSBR417 +00260 MOVE L119-UNIT-VOICE TO WS-UNIT-TEL. DTSBR417 +00261 I1000-EXIT. DTSBR417 +00262 EXIT. DTSBR417 +00263 EJECT DTSBR417 +00264 P1000-PROCESS. DTSBR417 +00265 DISPLAY 'EMP NO ' R417-EMP-NO. DTSBR417 +00266 * MOVE '(' TO DISP-TEL-FILLER-1. DTSBR417 +00267 * MOVE WS-UNIT-AREA-CD TO DISP-TEL-AREA-CD. DTSBR417 +00268 * MOVE ') ' TO DISP-TEL-FILLER-2. DTSBR417 +00269 * MOVE WS-UNIT-PREFIX TO DISP-TEL-PREFIX. DTSBR417 +00270 * MOVE '-' TO DISP-TEL-FILLER-3. DTSBR417 +00271 * MOVE WS-UNIT-SUFFIX TO DISP-TEL-SUFFIX. DTSBR417 +00272 ** MOVE DISP-TEL TO WS-TEXT-LINE-2. DTSBR417 +00273 * MOVE 20151020 TO R417-MAIL-DATE. CL**4 +00274 * MOVE 20151030 TO R417-RETURN-BY-DATE. CL**4 +00275 DISPLAY ' MAIL DTE ' R417-MAIL-DATE CL*12 +00276 MOVE ZEROS TO L002-DATE. CL*12 +00277 MOVE R417-MAIL-DATE TO L002-DATE. DTSBR417 +00278 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 +00279 DTSBR417 +00280 COMPUTE WS-START-POS = (18 - L002-LONG-TEXT-CNT) / 2. DTSBR417 +00281 DTSBR417 +00282 ADD +1 TO WS-START-POS. DTSBR417 +00283 DTSBR417 +00284 IF (WS-START-POS > +0) DTSBR417 +00285 AND DTSBR417 +00286 (WS-START-POS < +18) DTSBR417 +00287 MOVE SPACES TO WS-LONG-TEXT-MAIL-DATE DTSBR417 +00288 MOVE L002-LONG-TEXT-AREA DTSBR417 +00289 TO WS-LONG-TEXT-MAIL-DATE (WS-START-POS:) DTSBR417 +00290 ELSE DTSBR417 +00291 MOVE L002-LONG-TEXT-AREA TO WS-LONG-TEXT-MAIL-DATE. DTSBR417 +00292 DISPLAY 'LONG MAIL DATE: ' WS-LONG-TEXT-MAIL-DATE. CL*12 +00293 DTSBR417 +00294 MOVE R417-TOTAL-RATE TO L056-RATE. DTSBR417 +00295 PERFORM S056-DISP1-LEFT-PCT THRU S056-EXIT. DTSBR417 +00296 MOVE L056-DISP-RATE TO WS-DISP-RATE. DTSBR417 +00297 DTSBR417 +00298 MOVE R417-YRQ TO L008-YRQ. DTSBR417 +00299 PERFORM S008-UPPER-CASE THRU S008-EXIT. DTSBR417 +00300 MOVE L008-SHORT-MONTHS TO WS-UC-SHORT-MONTHS. DTSBR417 +00301 DTSBR417 +00302 PERFORM S008-MIXED-CASE THRU S008-EXIT. DTSBR417 +00303 * MOVE L008-SHORT-DSCR TO DTL-UC-SHORT-QTR-3. CL**9 +00304 DTSBR417 +00305 MOVE L008-YEAR (3:2) TO WS-SHORT-YEAR. DTSBR417 00306 DTSBR417 -00307 * MOVE 20130731 TO R417-DUE-DATE. DTSBR417 -00308 DISPLAY ' DUE DATE ' R417-DUE-DATE DTSBR417 -00309 MOVE R417-DUE-DATE TO L002-DATE. DTSBR417 -00310 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 -00311 * MOVE L002-LONG-TEXT-AREA TO WS-LONG-TEXT-DUE-DATE. DTSBR417 -00312 DTSBR417 -00313 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT. DTSBR417 -00314 DTSBR417 -00315 MOVE +130 TO L090-DESIRED-LINE-LIMIT. DTSBR417 -00316 MOVE +3 TO L090-PHRASE-CNT. DTSBR417 -00317 MOVE MC-LIT-WAS-DUE-BY TO L090-PHRASE (1). DTSBR417 -00318 MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR417 -00319 * MOVE WS-LONG-TEXT-DUE-DATE TO L090-PHRASE (2). DTSBR417 -00320 * MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 -00321 MOVE SPACES TO L090-PHRASE (2). DTSBR417 -00322 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR417 -00323 '.' DELIMITED BY SIZE DTSBR417 -00324 INTO L090-PHRASE (2). DTSBR417 -00325 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 -00326 MOVE MC-LIT-IS-NOW-DEL TO L090-PHRASE (3). DTSBR417 -00327 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR417 -00328 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR417 -00329 DISPLAY 'L90 ' L090-PARAGRAPH-LINE-CNT DTSBR417 -00330 IF (L090-UNSUCCESSFUL-88) DTSBR417 -00331 OR DTSBR417 -00332 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR417 -00333 MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG DTSBR417 -00334 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 -00335 MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-1. DTSBR417 -00336 DTSBR417 -00337 DTSBR417 -00338 MOVE +130 TO L090-DESIRED-LINE-LIMIT. DTSBR417 -00339 MOVE +3 TO L090-PHRASE-CNT. DTSBR417 -00340 MOVE MC-LIT-NOTICE-TO-US TO L090-PHRASE (1). DTSBR417 -00341 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR417 -00342 SET L004-FROM-5 TO TRUE. DTSBR417 -00343 MOVE R417-YRQ TO WS-YRQ-UNPACK. DTSBR417 -00344 MOVE WS-YRQ-UNPACK TO L004-QTR-5-AREA. DTSBR417 -00345 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBR417 -00346 MOVE L004-QTR-END-DATE TO L002-DATE. DTSBR417 -00347 DTSBR417 -00348 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 -00349 MOVE SPACES TO L090-PHRASE (2). DTSBR417 -00350 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR417 -00351 ',' DELIMITED BY SIZE DTSBR417 -00352 INTO L090-PHRASE (2). DTSBR417 -00353 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 -00354 MOVE MC-LIT-NOTICE-TO-US1 TO L090-PHRASE (3). DTSBR417 -00355 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR417 -00356 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR417 -00357 DISPLAY 'L903 ' L090-PARAGRAPH-LINE-CNT DTSBR417 -00358 DISPLAY ' LIN ' L090-PARAGRAPH-LINE (1) DTSBR417 -00359 IF (L090-UNSUCCESSFUL-88) DTSBR417 -00360 OR DTSBR417 -00361 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR417 -00362 MOVE 'LOGIC ERROR P1000-3' TO ABEND-MSG DTSBR417 -00363 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 -00364 MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-3. DTSBR417 -00365 DTSBR417 -00366 DTSBR417 -00367 MOVE +130 TO L090-DESIRED-LINE-LIMIT. DTSBR417 -00368 MOVE +3 TO L090-PHRASE-CNT. DTSBR417 -00369 MOVE MC-LIT-NOTICE-TO-US2 TO L090-PHRASE (1). DTSBR417 -00370 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR417 -00371 DISPLAY ' RTN BYE DATE ' R417-RETURN-BY-DATE. DTSBR417 -00372 MOVE R417-RETURN-BY-DATE TO L002-DATE. DTSBR417 -00373 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 -00374 MOVE SPACES TO L090-PHRASE (2). DTSBR417 -00375 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR417 -00376 ',' DELIMITED BY SIZE DTSBR417 -00377 INTO L090-PHRASE (2). DTSBR417 -00378 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 -00379 MOVE MC-LIT-NOTICE-TO-US3 TO L090-PHRASE (3). DTSBR417 -00380 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR417 -00381 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR417 -00382 DISPLAY 'L904 ' L090-PARAGRAPH-LINE-CNT DTSBR417 -00383 DISPLAY ' LIN ' L090-PARAGRAPH-LINE (1) DTSBR417 -00384 IF (L090-UNSUCCESSFUL-88) DTSBR417 -00385 OR DTSBR417 -00386 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR417 -00387 MOVE 'LOGIC ERROR P1000-4' TO ABEND-MSG DTSBR417 -00388 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 -00389 MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-4. DTSBR417 -00390 DTSBR417 -00391 PERFORM P4000-PRINT-DETAIL-1 THRU P4000-EXIT. DTSBR417 -00392 DTSBR417 -00393 MOVE +0 TO DETAIL-2-LINE-CNT. DTSBR417 -00394 DTSBR417 -00395 PERFORM P2000-SELF-MAILER-RTN THRU P2000-EXIT. DTSBR417 -00396 P1000-EXIT. DTSBR417 -00397 EXIT. DTSBR417 -00398 EJECT DTSBR417 -00399 P2000-SELF-MAILER-RTN. DTSBR417 -00400 MOVE R417-FMT-LINE (1) TO WS-ADDR-FMT-LINE-1. DTSBR417 -00401 MOVE R417-FMT-LINE (2) TO WS-ADDR-FMT-LINE-2. DTSBR417 -00402 MOVE R417-FMT-LINE (3) TO WS-ADDR-FMT-LINE-3. DTSBR417 -00403 MOVE R417-FMT-LINE (4) TO WS-ADDR-FMT-LINE-4. DTSBR417 -00404 MOVE R417-FMT-LINE (5) TO WS-ADDR-FMT-LINE-5. DTSBR417 -00405 *RW1 DTSBR417 -00406 * MOVE R417-EMP-NO TO BARC-EMP-NO. DTSBR417 -00407 * PERFORM S599-BARCODE THRU S599-EXIT. DTSBR417 -00408 *RW2 DTSBR417 -00409 PERFORM P8000-PRINT-VSCA-ADDR THRU P8000-EXIT. DTSBR417 -00410 DTSBR417 -00411 P2000-EXIT. DTSBR417 -00412 EXIT. DTSBR417 -00413 EJECT DTSBR417 -00414 P1100-ADDITIONAL-RPTS. DTSBR417 -00415 MOVE +66 TO L090-DESIRED-LINE-LIMIT. DTSBR417 -00416 MOVE 'ADDITIONAL DELINQUENT REPORTS DUE:' DTSBR417 -00417 TO L090-PHRASE (1). DTSBR417 -00418 * SET L090-PHRASE-UNDERLINE-88 (1) TO TRUE. DTSBR417 -00419 SET L090-PHRASE-BOLD-88 (1) TO TRUE. DTSBR417 -00420 MOVE SPACES TO L090-PHRASE (2). DTSBR417 -00421 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 -00422 DTSBR417 -00423 MOVE +2 TO L090-PHRASE-CNT. DTSBR417 -00424 DTSBR417 -00425 PERFORM DTSBR417 -00426 VARYING R417-YRQ-IDX FROM 1 BY 1 DTSBR417 -00427 UNTIL R417-YRQ-IDX > R417-ADDITIONAL-RPT-CNT DTSBR417 -00428 MOVE R417-ADDITIONAL-RPT-YRQ (R417-YRQ-IDX) DTSBR417 -00429 TO L004-QTR-5-9 DTSBR417 -00430 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR417 -00431 ADD +1 TO L090-PHRASE-CNT DTSBR417 -00432 MOVE SPACES DTSBR417 -00433 TO L090-PHRASE (L090-PHRASE-CNT) DTSBR417 -00434 MOVE SPACES DTSBR417 -00435 TO L090-PHRASE-OVERSTRIKE-IND (L090-PHRASE-CNT) DTSBR417 -00436 SET WS-YRQ-SUB TO R417-YRQ-IDX DTSBR417 -00437 IF WS-YRQ-SUB = R417-ADDITIONAL-RPT-CNT DTSBR417 -00438 STRING L004-SLASH-QTR DELIMITED BY SIZE DTSBR417 -00439 '.' DELIMITED BY SIZE DTSBR417 -00440 INTO L090-PHRASE (L090-PHRASE-CNT) DTSBR417 -00441 ELSE DTSBR417 -00442 STRING L004-SLASH-QTR DELIMITED BY SIZE DTSBR417 -00443 ',' DELIMITED BY SIZE DTSBR417 -00444 INTO L090-PHRASE (L090-PHRASE-CNT) DTSBR417 -00445 END-IF DTSBR417 -00446 END-PERFORM. DTSBR417 -00447 DTSBR417 -00448 P3000-PRINT-HEADER. DTSBR417 -00449 MOVE R417-EMP-NO TO BARC-EMP-NO. DTSBR417 -00450 PERFORM S599-BARCODE THRU S599-EXIT. DTSBR417 -00451 DTSBR417 -00452 IF L599-SETB-FONT1 DTSBR417 -00453 MOVE 'MODIFY=TAXSM1,' TO CNTL1-CME DTSBR417 -00454 ELSE DTSBR417 -00455 IF L599-SETB-FONT2 DTSBR417 -00456 MOVE 'MODIFY=TAXSM2,' TO CNTL1-CME DTSBR417 -00457 ELSE DTSBR417 -00458 MOVE 'MODIFY=TAXSM1,' TO CNTL1-CME. DTSBR417 -00459 DTSBR417 -00460 MOVE 'MODIFY=CME418,' TO CNTL1-CME. DTSBR417 -00461 WRITE XEROX-REPORT FROM XEROX-CNTL-LINE18 DTSBR417 -00462 AFTER ADVANCING TOP-OF-PAGE. DTSBR417 -00463 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE19. DTSBR417 -00464 WRITE XEROX-REPORT FROM XEROX-CNTL-LINE20. DTSBR417 -00465 DTSBR417 -00466 MOVE R417-FMT-LINE (1) TO HDR-FMT-LINE-1. DTSBR417 -00467 MOVE R417-FMT-LINE (2) TO HDR-FMT-LINE-2. DTSBR417 -00468 MOVE R417-FMT-LINE (3) TO HDR-FMT-LINE-3. DTSBR417 -00469 MOVE R417-FMT-LINE (4) TO HDR-FMT-LINE-4. DTSBR417 -00470 MOVE R417-FMT-LINE (5) TO HDR-FMT-LINE-5. DTSBR417 -00471 MOVE R417-EMP-NO TO HDR-EMP-NO. DTSBR417 -00472 MOVE WS-UC-SHORT-MONTH-1 TO HDR-UC-SHORT-MONTH-1. DTSBR417 -00473 MOVE WS-UC-SHORT-MONTH-2 TO HDR-UC-SHORT-MONTH-2. DTSBR417 -00474 MOVE WS-UC-SHORT-MONTH-3 TO HDR-UC-SHORT-MONTH-3. DTSBR417 -00475 MOVE WS-LONG-YEAR TO HDR-LONG-YEAR. DTSBR417 -00476 * WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING TOP-OF-PAGEDTSBR417 -00477 WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 8 LINE. DTSBR417 -00478 * WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 10 LINE. DTSBR417 -00479 WRITE XEROX-REPORT FROM HDR-LINE-10 AFTER ADVANCING 1 LINE. DTSBR417 -00480 WRITE XEROX-REPORT FROM HDR-LINE-11 AFTER ADVANCING 2 LINE. DTSBR417 -00481 WRITE XEROX-REPORT FROM HDR-LINE-12 AFTER ADVANCING 1 LINE. DTSBR417 -00482 WRITE XEROX-REPORT FROM HDR-LINE-13 AFTER ADVANCING 1 LINE. DTSBR417 -00483 WRITE XEROX-REPORT FROM HDR-LINE-14 AFTER ADVANCING 1 LINE. DTSBR417 -00484 WRITE XEROX-REPORT FROM HDR-LINE-15 AFTER ADVANCING 1 LINE. DTSBR417 -00485 * WRITE XEROX-REPORT FROM HDR-LINE-16 AFTER ADVANCING 1 LINE. DTSBR417 -00486 * WRITE XEROX-REPORT FROM HDR-LINE-17 AFTER ADVANCING 1 LINE. DTSBR417 -00487 DTSBR417 -00488 P3000-EXIT. DTSBR417 -00489 EXIT. DTSBR417 -00490 DTSBR417 -00491 P4000-PRINT-DETAIL-1. DTSBR417 -00492 MOVE WS-UC-SHORT-MONTH-1 TO DTL-UC-SHORT-MONTH-1. DTSBR417 -00493 MOVE WS-UC-SHORT-MONTH-2 TO DTL-UC-SHORT-MONTH-2. DTSBR417 -00494 MOVE WS-UC-SHORT-MONTH-3 TO DTL-UC-SHORT-MONTH-3. DTSBR417 -00495 MOVE WS-LONG-YEAR TO DTL-LONG-YEAR. DTSBR417 -00496 WRITE XEROX-REPORT FROM DTL-LINE-2 AFTER ADVANCING 2 LINE. DTSBR417 -00497 WRITE XEROX-REPORT FROM DTL-LINE-3 AFTER ADVANCING 1 LINE. DTSBR417 -00498 * WRITE XEROX-REPORT FROM DTL-LINE-4 AFTER ADVANCING 1 LINE. DTSBR417 -00499 WRITE XEROX-REPORT FROM DTL-LINE-5 AFTER ADVANCING 1 LINE. DTSBR417 -00500 WRITE XEROX-REPORT FROM DTL-LINE-6 AFTER ADVANCING 1 LINE. DTSBR417 -00501 WRITE XEROX-REPORT FROM DTL-LINE-6A AFTER ADVANCING 1 LINE. DTSBR417 -00502 WRITE XEROX-REPORT FROM DTL-LINE-7 AFTER ADVANCING 2 LINE. DTSBR417 -00503 WRITE XEROX-REPORT FROM DTL-LINE-7A AFTER ADVANCING 1 LINE. DTSBR417 -00504 WRITE XEROX-REPORT FROM DTL-LINE-8 AFTER ADVANCING 1 LINE. DTSBR417 -00505 WRITE XEROX-REPORT FROM DTL-LINE-8A AFTER ADVANCING 1 LINE. DTSBR417 -00506 WRITE XEROX-REPORT FROM DTL-LINE-9 AFTER ADVANCING 1 LINE. DTSBR417 -00507 WRITE XEROX-REPORT FROM DTL-LINE-11 AFTER ADVANCING 1 LINE. DTSBR417 -00508 WRITE XEROX-REPORT FROM DTL-LINE-12 AFTER ADVANCING 1 LINE. DTSBR417 -00509 DTSBR417 -00510 P4000-EXIT. DTSBR417 -00511 EXIT. DTSBR417 -00512 DTSBR417 -00513 P8000-PRINT-VSCA-ADDR. DTSBR417 -00514 *RW1 DTSBR417 -00515 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR417 -00516 DTSBR417 -00517 MOVE SPACES TO WS-REC. DTSBR417 -00518 WRITE XEROX-REPORT FROM WS-REC DTSBR417 -00519 AFTER ADVANCING TOP-OF-PAGE. DTSBR417 -00520 DTSBR417 -00521 * WRITE XEROX-REPORT FROM WS-BARC-LINE AFTER 04. DTSBR417 +00307 * MOVE L008-YEAR TO WS-LONG-YEAR DTL-LONG-YEAR3. CL**9 +00308 MOVE L008-YEAR TO WS-LONG-YEAR. CL*10 +00309 DTSBR417 +00310 MOVE R417-DUE-DATE TO L001-FED-8-DATE-9. DTSBR417 +00311 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR417 +00312 MOVE L001-SLASH-8-DATE TO WS-SLASH-DUE-DATE. DTSBR417 +00313 DTSBR417 +00314 * MOVE 20130731 TO R417-DUE-DATE. DTSBR417 +00315 DISPLAY ' DUE DATE ' R417-DUE-DATE DTSBR417 +00316 MOVE R417-DUE-DATE TO L002-DATE. DTSBR417 +00317 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 +00318 * MOVE L002-LONG-TEXT-AREA TO WS-LONG-TEXT-DUE-DATE. DTSBR417 +00319 DTSBR417 +00320 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT. DTSBR417 +00321 DTSBR417 +00322 MOVE +130 TO L090-DESIRED-LINE-LIMIT. DTSBR417 +00323 MOVE +3 TO L090-PHRASE-CNT. DTSBR417 +00324 MOVE MC-LIT-WAS-DUE-BY TO L090-PHRASE (1). DTSBR417 +00325 MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR417 +00326 * MOVE WS-LONG-TEXT-DUE-DATE TO L090-PHRASE (2). DTSBR417 +00327 * MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 +00328 MOVE SPACES TO L090-PHRASE (2). DTSBR417 +00329 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR417 +00330 '.' DELIMITED BY SIZE DTSBR417 +00331 INTO L090-PHRASE (2). DTSBR417 +00332 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 +00333 MOVE MC-LIT-IS-NOW-DEL TO L090-PHRASE (3). DTSBR417 +00334 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR417 +00335 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR417 +00336 DISPLAY 'L90 ' L090-PARAGRAPH-LINE-CNT DTSBR417 +00337 IF (L090-UNSUCCESSFUL-88) DTSBR417 +00338 OR DTSBR417 +00339 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR417 +00340 MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG DTSBR417 +00341 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 +00342 * MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-1. CL**7 +00343 DTSBR417 +00344 DTSBR417 +00345 MOVE +130 TO L090-DESIRED-LINE-LIMIT. DTSBR417 +00346 MOVE +3 TO L090-PHRASE-CNT. DTSBR417 +00347 MOVE MC-LIT-NOTICE-TO-US TO L090-PHRASE (1). DTSBR417 +00348 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR417 +00349 SET L004-FROM-5 TO TRUE. DTSBR417 +00350 MOVE R417-YRQ TO WS-YRQ-UNPACK. DTSBR417 +00351 MOVE WS-YRQ-UNPACK TO L004-QTR-5-AREA. DTSBR417 +00352 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBR417 +00353 MOVE L004-QTR-END-DATE TO L002-DATE. DTSBR417 +00354 DTSBR417 +00355 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 +00356 MOVE SPACES TO L090-PHRASE (2). DTSBR417 +00357 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR417 +00358 ',' DELIMITED BY SIZE DTSBR417 +00359 INTO L090-PHRASE (2). DTSBR417 +00360 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 +00361 MOVE MC-LIT-NOTICE-TO-US1 TO L090-PHRASE (3). DTSBR417 +00362 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR417 +00363 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR417 +00364 DISPLAY 'L903 ' L090-PARAGRAPH-LINE-CNT DTSBR417 +00365 DISPLAY ' LIN ' L090-PARAGRAPH-LINE (1) DTSBR417 +00366 IF (L090-UNSUCCESSFUL-88) DTSBR417 +00367 OR DTSBR417 +00368 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR417 +00369 MOVE 'LOGIC ERROR P1000-3' TO ABEND-MSG DTSBR417 +00370 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 +00371 * MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-3. CL**7 +00372 DTSBR417 +00373 DTSBR417 +00374 MOVE +130 TO L090-DESIRED-LINE-LIMIT. DTSBR417 +00375 MOVE +3 TO L090-PHRASE-CNT. DTSBR417 +00376 MOVE MC-LIT-NOTICE-TO-US2 TO L090-PHRASE (1). DTSBR417 +00377 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR417 +00378 DISPLAY ' RTN BYE DATE ' R417-RETURN-BY-DATE. DTSBR417 +00379 MOVE R417-RETURN-BY-DATE TO L002-DATE. DTSBR417 +00380 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR417 +00381 MOVE SPACES TO L090-PHRASE (2). DTSBR417 +00382 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR417 +00383 ',' DELIMITED BY SIZE DTSBR417 +00384 INTO L090-PHRASE (2). DTSBR417 +00385 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 +00386 MOVE MC-LIT-NOTICE-TO-US3 TO L090-PHRASE (3). DTSBR417 +00387 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR417 +00388 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR417 +00389 DISPLAY 'L904 ' L090-PARAGRAPH-LINE-CNT DTSBR417 +00390 DISPLAY ' LIN ' L090-PARAGRAPH-LINE (1) DTSBR417 +00391 IF (L090-UNSUCCESSFUL-88) DTSBR417 +00392 OR DTSBR417 +00393 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR417 +00394 MOVE 'LOGIC ERROR P1000-4' TO ABEND-MSG DTSBR417 +00395 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 +00396 * MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-4. CL**7 +00397 DTSBR417 +00398 PERFORM P4000-PRINT-DETAIL-1 THRU P4000-EXIT. DTSBR417 +00399 DTSBR417 +00400 MOVE +0 TO DETAIL-2-LINE-CNT. DTSBR417 +00401 DTSBR417 +00402 PERFORM P2000-SELF-MAILER-RTN THRU P2000-EXIT. DTSBR417 +00403 P1000-EXIT. DTSBR417 +00404 EXIT. DTSBR417 +00405 EJECT DTSBR417 +00406 P2000-SELF-MAILER-RTN. DTSBR417 +00407 MOVE R417-FMT-LINE (1) TO WS-ADDR-FMT-LINE-1. DTSBR417 +00408 MOVE R417-FMT-LINE (2) TO WS-ADDR-FMT-LINE-2. DTSBR417 +00409 MOVE R417-FMT-LINE (3) TO WS-ADDR-FMT-LINE-3. DTSBR417 +00410 MOVE R417-FMT-LINE (4) TO WS-ADDR-FMT-LINE-4. DTSBR417 +00411 MOVE R417-FMT-LINE (5) TO WS-ADDR-FMT-LINE-5. DTSBR417 +00412 *RW1 DTSBR417 +00413 * MOVE R417-EMP-NO TO BARC-EMP-NO. DTSBR417 +00414 * PERFORM S599-BARCODE THRU S599-EXIT. DTSBR417 +00415 *RW2 DTSBR417 +00416 PERFORM P8000-PRINT-VSCA-ADDR THRU P8000-EXIT. DTSBR417 +00417 DTSBR417 +00418 P2000-EXIT. DTSBR417 +00419 EXIT. DTSBR417 +00420 EJECT DTSBR417 +00421 P1100-ADDITIONAL-RPTS. DTSBR417 +00422 MOVE +66 TO L090-DESIRED-LINE-LIMIT. DTSBR417 +00423 MOVE 'ADDITIONAL DELINQUENT REPORTS DUE:' DTSBR417 +00424 TO L090-PHRASE (1). DTSBR417 +00425 * SET L090-PHRASE-UNDERLINE-88 (1) TO TRUE. DTSBR417 +00426 SET L090-PHRASE-BOLD-88 (1) TO TRUE. DTSBR417 +00427 MOVE SPACES TO L090-PHRASE (2). DTSBR417 +00428 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR417 +00429 DTSBR417 +00430 MOVE +2 TO L090-PHRASE-CNT. DTSBR417 +00431 DTSBR417 +00432 PERFORM DTSBR417 +00433 VARYING R417-YRQ-IDX FROM 1 BY 1 DTSBR417 +00434 UNTIL R417-YRQ-IDX > R417-ADDITIONAL-RPT-CNT DTSBR417 +00435 MOVE R417-ADDITIONAL-RPT-YRQ (R417-YRQ-IDX) DTSBR417 +00436 TO L004-QTR-5-9 DTSBR417 +00437 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR417 +00438 ADD +1 TO L090-PHRASE-CNT DTSBR417 +00439 MOVE SPACES DTSBR417 +00440 TO L090-PHRASE (L090-PHRASE-CNT) DTSBR417 +00441 MOVE SPACES DTSBR417 +00442 TO L090-PHRASE-OVERSTRIKE-IND (L090-PHRASE-CNT) DTSBR417 +00443 SET WS-YRQ-SUB TO R417-YRQ-IDX DTSBR417 +00444 IF WS-YRQ-SUB = R417-ADDITIONAL-RPT-CNT DTSBR417 +00445 STRING L004-SLASH-QTR DELIMITED BY SIZE DTSBR417 +00446 '.' DELIMITED BY SIZE DTSBR417 +00447 INTO L090-PHRASE (L090-PHRASE-CNT) DTSBR417 +00448 ELSE DTSBR417 +00449 STRING L004-SLASH-QTR DELIMITED BY SIZE DTSBR417 +00450 ',' DELIMITED BY SIZE DTSBR417 +00451 INTO L090-PHRASE (L090-PHRASE-CNT) DTSBR417 +00452 END-IF DTSBR417 +00453 END-PERFORM. DTSBR417 +00454 DTSBR417 +00455 P3000-PRINT-HEADER. DTSBR417 +00456 MOVE R417-EMP-NO TO BARC-EMP-NO. DTSBR417 +00457 PERFORM S599-BARCODE THRU S599-EXIT. DTSBR417 +00458 DTSBR417 +00459 IF L599-SETB-FONT1 DTSBR417 +00460 MOVE 'MODIFY=TAXSM1,' TO CNTL1-CME DTSBR417 +00461 ELSE DTSBR417 +00462 IF L599-SETB-FONT2 DTSBR417 +00463 MOVE 'MODIFY=TAXSM2,' TO CNTL1-CME DTSBR417 +00464 ELSE DTSBR417 +00465 MOVE 'MODIFY=TAXSM1,' TO CNTL1-CME. DTSBR417 +00466 DTSBR417 +00467 MOVE 'MODIFY=CME418,' TO CNTL1-CME. DTSBR417 +00468 WRITE XEROX-REPORT FROM XEROX-CNTL-LINE18 DTSBR417 +00469 AFTER ADVANCING TOP-OF-PAGE. DTSBR417 +00470 * WRITE XEROX-REPORT FROM XEROX-CNTL-LINE19. DTSBR417 +00471 WRITE XEROX-REPORT FROM XEROX-CNTL-LINE20. DTSBR417 +00472 DTSBR417 +00473 MOVE R417-FMT-LINE (1) TO HDR-FMT-LINE-1. DTSBR417 +00474 MOVE R417-FMT-LINE (2) TO HDR-FMT-LINE-2. DTSBR417 +00475 MOVE R417-FMT-LINE (3) TO HDR-FMT-LINE-3. DTSBR417 +00476 MOVE R417-FMT-LINE (4) TO HDR-FMT-LINE-4. DTSBR417 +00477 MOVE R417-FMT-LINE (5) TO HDR-FMT-LINE-5. DTSBR417 +00478 MOVE R417-EMP-NO TO HDR-EMP-NO. DTSBR417 +00479 MOVE WS-UC-SHORT-MONTH-1 TO HDR-UC-SHORT-MONTH-1. DTSBR417 +00480 MOVE WS-UC-SHORT-MONTH-2 TO HDR-UC-SHORT-MONTH-2. DTSBR417 +00481 MOVE WS-UC-SHORT-MONTH-3 TO HDR-UC-SHORT-MONTH-3. DTSBR417 +00482 MOVE WS-LONG-YEAR TO HDR-LONG-YEAR. DTSBR417 +00483 * WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING TOP-OF-PAGEDTSBR417 +00484 WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 8 LINE. DTSBR417 +00485 * WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 10 LINE. DTSBR417 +00486 WRITE XEROX-REPORT FROM HDR-LINE-10 AFTER ADVANCING 1 LINE. CL**8 +00487 WRITE XEROX-REPORT FROM HDR-LINE-11 AFTER ADVANCING 2 LINE. CL**8 +00488 WRITE XEROX-REPORT FROM HDR-LINE-12 AFTER ADVANCING 1 LINE. DTSBR417 +00489 WRITE XEROX-REPORT FROM HDR-LINE-13 AFTER ADVANCING 1 LINE. DTSBR417 +00490 WRITE XEROX-REPORT FROM HDR-LINE-14 AFTER ADVANCING 1 LINE. DTSBR417 +00491 WRITE XEROX-REPORT FROM HDR-LINE-15 AFTER ADVANCING 1 LINE. DTSBR417 +00492 * WRITE XEROX-REPORT FROM HDR-LINE-16 AFTER ADVANCING 1 LINE. DTSBR417 +00493 * WRITE XEROX-REPORT FROM HDR-LINE-17 AFTER ADVANCING 1 LINE. DTSBR417 +00494 DTSBR417 +00495 P3000-EXIT. DTSBR417 +00496 EXIT. DTSBR417 +00497 DTSBR417 +00498 P4000-PRINT-DETAIL-1. DTSBR417 +00499 MOVE WS-UC-SHORT-MONTH-1 TO DTL-UC-SHORT-MONTH-1. DTSBR417 +00500 MOVE WS-UC-SHORT-MONTH-2 TO DTL-UC-SHORT-MONTH-2. DTSBR417 +00501 MOVE WS-UC-SHORT-MONTH-3 TO DTL-UC-SHORT-MONTH-3. DTSBR417 +00502 MOVE WS-LONG-YEAR TO DTL-LONG-YEAR. DTSBR417 +00503 WRITE XEROX-REPORT FROM DTL-LINE-2 AFTER ADVANCING 2 LINE. DTSBR417 +00504 WRITE XEROX-REPORT FROM DTL-LINE-3 AFTER ADVANCING 1 LINE. DTSBR417 +00505 WRITE XEROX-REPORT FROM DTL-LINE-4 AFTER ADVANCING 1 LINE. CL**6 +00506 WRITE XEROX-REPORT FROM DTL-LINE-5 AFTER ADVANCING 1 LINE. DTSBR417 +00507 WRITE XEROX-REPORT FROM DTL-LINE-6 AFTER ADVANCING 1 LINE. DTSBR417 +00508 WRITE XEROX-REPORT FROM DTL-LINE-7 AFTER ADVANCING 1 LINE. CL**5 +00509 WRITE XEROX-REPORT FROM DTL-LINE-8 AFTER ADVANCING 1 LINE. CL**8 +00510 WRITE XEROX-REPORT FROM DTL-LINE-9 AFTER ADVANCING 1 LINE. CL**5 +00511 WRITE XEROX-REPORT FROM DTL-LINE-9A AFTER ADVANCING 1 LINE. CL*11 +00512 WRITE XEROX-REPORT FROM DTL-LINE-10 AFTER ADVANCING 2 LINE. CL**8 +00513 WRITE XEROX-REPORT FROM DTL-LINE-11 AFTER ADVANCING 1 LINE. CL**6 +00514 WRITE XEROX-REPORT FROM DTL-LINE-12 AFTER ADVANCING 1 LINE. CL**6 +00515 WRITE XEROX-REPORT FROM DTL-LINE-13 AFTER ADVANCING 1 LINE. CL**6 +00516 WRITE XEROX-REPORT FROM DTL-LINE-14 AFTER ADVANCING 1 LINE. CL**6 +00517 WRITE XEROX-REPORT FROM DTL-LINE-15 AFTER ADVANCING 1 LINE. CL**6 +00518 WRITE XEROX-REPORT FROM DTL-LINE-16 AFTER ADVANCING 1 LINE. CL**6 +00519 WRITE XEROX-REPORT FROM DTL-LINE-17 AFTER ADVANCING 1 LINE. CL**6 +00520 WRITE XEROX-REPORT FROM DTL-LINE-18 AFTER ADVANCING 1 LINE. CL**6 +00521 * WRITE XEROX-REPORT FROM DTL-LINE-19 AFTER ADVANCING 1 LINE. CL**6 00522 DTSBR417 -00523 * WRITE XEROX-REPORT FROM VSCA-LINE DTSBR417 -00524 * AFTER ADVANCING TOP-OF-PAGE. DTSBR417 -00525 WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 16 LINE. DTSBR417 -00526 * WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 13 LINE. DTSBR417 -00527 *RW2 DTSBR417 -00528 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-17 DTSBR417 -00529 AFTER ADVANCING 1 LINE. DTSBR417 -00530 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-18 DTSBR417 -00531 AFTER ADVANCING 1 LINE. DTSBR417 -00532 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-19 DTSBR417 -00533 AFTER ADVANCING 1 LINE. DTSBR417 -00534 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-20 DTSBR417 -00535 AFTER ADVANCING 1 LINE. DTSBR417 -00536 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-21 DTSBR417 -00537 AFTER ADVANCING 1 LINE. DTSBR417 -00538 DTSBR417 -00539 P8000-EXIT. DTSBR417 -00540 EXIT. DTSBR417 -00541 DTSBR417 -00542 T1000-TERMINATE. DTSBR417 -00543 CLOSE PRT-FILE. DTSBR417 -00544 T1000-EXIT. DTSBR417 -00545 EXIT. DTSBR417 -00546 EJECT DTSBR417 -00547 S001-FROM-FED-8. DTSBR417 -00548 SET L001-FROM-FED-8 TO TRUE. DTSBR417 -00549 GO TO S001-DATE. DTSBR417 -00550 DTSBR417 -00551 S001-DATE. DTSBR417 -00552 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR417 -00553 S001-EXIT. DTSBR417 -00554 EXIT. DTSBR417 -00555 SKIP3 DTSBR417 -00556 S002-UPPER-CASE. DTSBR417 -00557 SET L002-UPPER-CASE TO TRUE. DTSBR417 -00558 GO TO S002-DATE-ALPHA. DTSBR417 -00559 DTSBR417 -00560 S002-MIXED-CASE. DTSBR417 -00561 SET L002-MIXED-CASE TO TRUE. DTSBR417 -00562 GO TO S002-DATE-ALPHA. DTSBR417 +00523 P4000-EXIT. DTSBR417 +00524 EXIT. DTSBR417 +00525 DTSBR417 +00526 P8000-PRINT-VSCA-ADDR. DTSBR417 +00527 *RW1 DTSBR417 +00528 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR417 +00529 DTSBR417 +00530 MOVE SPACES TO WS-REC. DTSBR417 +00531 WRITE XEROX-REPORT FROM WS-REC DTSBR417 +00532 AFTER ADVANCING TOP-OF-PAGE. DTSBR417 +00533 DTSBR417 +00534 * WRITE XEROX-REPORT FROM WS-BARC-LINE AFTER 04. DTSBR417 +00535 DTSBR417 +00536 * WRITE XEROX-REPORT FROM VSCA-LINE DTSBR417 +00537 * AFTER ADVANCING TOP-OF-PAGE. DTSBR417 +00538 WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 16 LINE. DTSBR417 +00539 * WRITE XEROX-REPORT FROM VSCA-LINE AFTER ADVANCING 13 LINE. DTSBR417 +00540 *RW2 DTSBR417 +00541 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-17 DTSBR417 +00542 AFTER ADVANCING 1 LINE. DTSBR417 +00543 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-18 DTSBR417 +00544 AFTER ADVANCING 1 LINE. DTSBR417 +00545 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-19 DTSBR417 +00546 AFTER ADVANCING 1 LINE. DTSBR417 +00547 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-20 DTSBR417 +00548 AFTER ADVANCING 1 LINE. DTSBR417 +00549 WRITE XEROX-REPORT FROM VSCA-ADDR-LINE-21 DTSBR417 +00550 AFTER ADVANCING 1 LINE. DTSBR417 +00551 DTSBR417 +00552 P8000-EXIT. DTSBR417 +00553 EXIT. DTSBR417 +00554 DTSBR417 +00555 T1000-TERMINATE. DTSBR417 +00556 CLOSE PRT-FILE. DTSBR417 +00557 T1000-EXIT. DTSBR417 +00558 EXIT. DTSBR417 +00559 EJECT DTSBR417 +00560 S001-FROM-FED-8. DTSBR417 +00561 SET L001-FROM-FED-8 TO TRUE. DTSBR417 +00562 GO TO S001-DATE. DTSBR417 00563 DTSBR417 -00564 S002-DATE-ALPHA. DTSBR417 -00565 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR417 -00566 S002-EXIT. DTSBR417 +00564 S001-DATE. DTSBR417 +00565 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR417 +00566 S001-EXIT. DTSBR417 00567 EXIT. DTSBR417 00568 SKIP3 DTSBR417 -00569 S004-FROM-5. DTSBR417 -00570 SET L004-FROM-5 TO TRUE. DTSBR417 -00571 GO TO S004-QUARTER. DTSBR417 +00569 S002-UPPER-CASE. DTSBR417 +00570 SET L002-UPPER-CASE TO TRUE. DTSBR417 +00571 GO TO S002-DATE-ALPHA. DTSBR417 00572 DTSBR417 -00573 S004-QUARTER. DTSBR417 -00574 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR417 -00575 S004-EXIT. DTSBR417 -00576 EXIT. DTSBR417 -00577 SKIP3 DTSBR417 -00578 S008-UPPER-CASE. DTSBR417 -00579 SET L008-UPPER-CASE TO TRUE. DTSBR417 -00580 GO TO S008-QUARTER-ALPHA. DTSBR417 -00581 DTSBR417 -00582 S008-MIXED-CASE. DTSBR417 -00583 SET L008-MIXED-CASE TO TRUE. DTSBR417 -00584 GO TO S008-QUARTER-ALPHA. DTSBR417 +00573 S002-MIXED-CASE. DTSBR417 +00574 SET L002-MIXED-CASE TO TRUE. DTSBR417 +00575 GO TO S002-DATE-ALPHA. DTSBR417 +00576 DTSBR417 +00577 S002-DATE-ALPHA. DTSBR417 +00578 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR417 +00579 S002-EXIT. DTSBR417 +00580 EXIT. DTSBR417 +00581 SKIP3 DTSBR417 +00582 S004-FROM-5. DTSBR417 +00583 SET L004-FROM-5 TO TRUE. DTSBR417 +00584 GO TO S004-QUARTER. DTSBR417 00585 DTSBR417 -00586 S008-QUARTER-ALPHA. DTSBR417 -00587 CALL 'DTSBU008' USING L008-LINK-AREA. DTSBR417 -00588 S008-EXIT. DTSBR417 +00586 S004-QUARTER. DTSBR417 +00587 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR417 +00588 S004-EXIT. DTSBR417 00589 EXIT. DTSBR417 00590 SKIP3 DTSBR417 -00591 S056-DISP1-LEFT-PCT. DTSBR417 -00592 SET L056-DISP1-LEFT-PCT-88 TO TRUE. DTSBR417 -00593 GO TO S056-RATE-DISPLAY. DTSBR417 +00591 S008-UPPER-CASE. DTSBR417 +00592 SET L008-UPPER-CASE TO TRUE. DTSBR417 +00593 GO TO S008-QUARTER-ALPHA. DTSBR417 00594 DTSBR417 -00595 S056-RATE-DISPLAY. DTSBR417 -00596 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR417 -00597 S056-EXIT. DTSBR417 -00598 EXIT. DTSBR417 -00599 SKIP3 DTSBR417 -00600 S090-PARAGRAPH-FORMAT. DTSBR417 -00601 MOVE +0 TO L090-INDENT. DTSBR417 -00602 SET L090-SPECIAL-CHAR-STD-88 TO TRUE. DTSBR417 -00603 DTSBR417 -00604 CALL 'DTSBU090' USING L090-LINK-AREA. DTSBR417 -00605 S090-EXIT. DTSBR417 -00606 EXIT. DTSBR417 -00607 SKIP3 DTSBR417 -00608 S119-REQ-CAPS. DTSBR417 -00609 SET L119-REQ-CAPS-88 TO TRUE. DTSBR417 -00610 GO TO S119-AGENCY-FACTS. DTSBR417 -00611 DTSBR417 -00612 S119-REQ-MIXED. DTSBR417 -00613 SET L119-REQ-MIXED-88 TO TRUE. DTSBR417 -00614 GO TO S119-AGENCY-FACTS. DTSBR417 -00615 DTSBR417 -00616 S119-AGENCY-FACTS. DTSBR417 -00617 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR417 -00618 S119-EXIT. DTSBR417 +00595 S008-MIXED-CASE. DTSBR417 +00596 SET L008-MIXED-CASE TO TRUE. DTSBR417 +00597 GO TO S008-QUARTER-ALPHA. DTSBR417 +00598 DTSBR417 +00599 S008-QUARTER-ALPHA. DTSBR417 +00600 CALL 'DTSBU008' USING L008-LINK-AREA. DTSBR417 +00601 S008-EXIT. DTSBR417 +00602 EXIT. DTSBR417 +00603 SKIP3 DTSBR417 +00604 S056-DISP1-LEFT-PCT. DTSBR417 +00605 SET L056-DISP1-LEFT-PCT-88 TO TRUE. DTSBR417 +00606 GO TO S056-RATE-DISPLAY. DTSBR417 +00607 DTSBR417 +00608 S056-RATE-DISPLAY. DTSBR417 +00609 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR417 +00610 S056-EXIT. DTSBR417 +00611 EXIT. DTSBR417 +00612 SKIP3 DTSBR417 +00613 S090-PARAGRAPH-FORMAT. DTSBR417 +00614 MOVE +0 TO L090-INDENT. DTSBR417 +00615 SET L090-SPECIAL-CHAR-STD-88 TO TRUE. DTSBR417 +00616 DTSBR417 +00617 CALL 'DTSBU090' USING L090-LINK-AREA. DTSBR417 +00618 S090-EXIT. DTSBR417 00619 EXIT. DTSBR417 00620 SKIP3 DTSBR417 -00621 S599-BARCODE. DTSBR417 -00622 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR417 -00623 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR417 -00624 MOVE 'TAX' TO L599-SYSTEM. DTSBR417 -00625 DTSBR417 -00626 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR417 -00627 DTSBR417 -00628 IF L599-NOT-CONVERTED DTSBR417 -00629 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 -00630 S599-EXIT. DTSBR417 -00631 EXIT. DTSBR417 -00632 SKIP3 DTSBR417 -00633 S999-ABEND. DTSBR417 -00634 DISPLAY '***'. DTSBR417 -00635 DISPLAY '*** ' DTSBR417 -00636 ABEND-MSG. DTSBR417 -00637 DISPLAY '***'. DTSBR417 +00621 S119-REQ-CAPS. DTSBR417 +00622 SET L119-REQ-CAPS-88 TO TRUE. DTSBR417 +00623 GO TO S119-AGENCY-FACTS. DTSBR417 +00624 DTSBR417 +00625 S119-REQ-MIXED. DTSBR417 +00626 SET L119-REQ-MIXED-88 TO TRUE. DTSBR417 +00627 GO TO S119-AGENCY-FACTS. DTSBR417 +00628 DTSBR417 +00629 S119-AGENCY-FACTS. DTSBR417 +00630 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR417 +00631 S119-EXIT. DTSBR417 +00632 EXIT. DTSBR417 +00633 SKIP3 DTSBR417 +00634 S599-BARCODE. DTSBR417 +00635 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR417 +00636 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR417 +00637 MOVE 'TAX' TO L599-SYSTEM. DTSBR417 00638 DTSBR417 -00639 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR417 -00640 S999-EXIT. DTSBR417 -00641 EXIT. DTSBR417 -00642 DTSBR417 +00639 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR417 +00640 DTSBR417 +00641 IF L599-NOT-CONVERTED DTSBR417 +00642 PERFORM S999-ABEND THRU S999-EXIT. DTSBR417 +00643 S599-EXIT. DTSBR417 +00644 EXIT. DTSBR417 +00645 SKIP3 DTSBR417 +00646 S999-ABEND. DTSBR417 +00647 DISPLAY '***'. DTSBR417 +00648 DISPLAY '*** ' DTSBR417 +00649 ABEND-MSG. DTSBR417 +00650 DISPLAY '***'. DTSBR417 +00651 DTSBR417 +00652 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR417 +00653 S999-EXIT. DTSBR417 +00654 EXIT. DTSBR417 +00655 DTSBR417 diff --git a/Batch/DTSBR439.cob b/Batch/DTSBR439.cob new file mode 100644 index 0000000..336b4ac --- /dev/null +++ b/Batch/DTSBR439.cob @@ -0,0 +1,410 @@ +00001 IDENTIFICATION DIVISION. 05/19/21 +00002 PROGRAM-ID. DTSBR439. DTSBR439 +00003 AUTHOR. TRW/RW1. LV023 +00004 DATE-WRITTEN. APRIL 2002. DTSBR439 +00005 DATE-COMPILED. DTSBR439 +00006 DTSBR439 +00007 *** CL*20 +00008 * DTSBR439 +00009 * CALLING SEQUENCE: DTSBD400 CALLS DTSBR439 +00010 * DTSBE439 WHICH UPDATES DTSIR439 DTSBR439 +00011 * DTSBR439 READS DTSIR439 RECORDS. DTSBR439 +00012 * DTSBR439 +00013 * FUNCTION: REPORT EMPLOYERS WITH BALANCE DUE WHO HAVE BEEN DTSBR439 +00014 * INACTIVE FOR AT LEAST THREE YEARS AND WHO DO NOT DTSBR439 +00015 * HAVE A SUCCESSOR. DTSBR439 +00016 * DTSBR439 +00017 * MODIFICATION HISTORY: DTSBR439 +00018 * DTSBR439 +00019 * 04-09-02 INITIAL DEVELOPMENT DTSBR439 +00020 * REFERENCE RFP #RAP AUTHOR OF CHANGE - RW1 DTSBR439 +00021 * DTSBR439 +00022 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR439 +00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR439 +00024 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR439 +00025 * DTSBR439 +00026 * DTSBR439 +00027 * DESCRIPTION: DTSBR439 +00028 * DTSBR439 +00029 * THIS MODULE ATTEMPTS TO WRITE-OFF CANDIDATES WITH A DTSBR439 +00030 * BALANCE DUE WHO HAVE BEEN INACTIVE AT LEAST 3 YEARS. DTSBR439 +00031 * DTSBR439 +00032 * DTSBR439 +00033 * RECORDS READ: DTSBR439 +00034 * DTSBR439 +00035 * NONE. DTSBR439 +00036 * DTSBR439 +00037 * DTSBR439 +00038 * PRINTED OUTPUTS: DTSBR439 +00039 * DTSBR439 +00040 * 430R1 WRITE-OFF CANDIDATES AS REQUEST'S REPORT. DTSBR439 +00041 * DTSBR439 +00042 * DTSBR439 +00043 * RECORDS WRITTEN: DTSBR439 +00044 * DTSBR439 +00045 * NONE. DTSBR439 +00046 * DTSBR439 +00047 * DTSBR439 +00048 * MODULES CALLED: DTSBR439 +00049 * DTSBR439 +00050 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBR439 +00051 * DTSBR439 +00052 * DTSBR439 +00053 ***** DTSBR439 +00054 EJECT DTSBR439 +00055 ENVIRONMENT DIVISION. DTSBR439 +00056 DTSBR439 +00057 CONFIGURATION SECTION. DTSBR439 +00058 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR439 +00059 DTSBR439 +00060 INPUT-OUTPUT SECTION. DTSBR439 +00061 DTSBR439 +00062 FILE-CONTROL. DTSBR439 +00063 SELECT PRT-FILE1 ASSIGN TO RPT439R1. DTSBR439 +00064 SELECT PRT-FILE2 ASSIGN TO RPT439R2. CL**3 +00065 DTSBR439 +00066 DATA DIVISION. DTSBR439 +00067 DTSBR439 +00068 FILE SECTION. DTSBR439 +00069 DTSBR439 +00070 FD PRT-FILE1 DTSBR439 +00071 RECORDING MODE IS F. DTSBR439 +00072 01 PRT-CREDITS PIC X(133). CL**3 +00073 EJECT DTSBR439 +00074 DTSBR439 +00075 FD PRT-FILE2 CL**3 +00076 RECORDING MODE IS F. CL**3 +00077 01 PRT-DEBITS PIC X(133). CL**3 +00078 EJECT CL**3 +00079 CL**3 +00080 WORKING-STORAGE SECTION. DTSBR439 +000805 77 PAN-VALET PICTURE X(24) VALUE '023DTSBR439 05/19/21'. DTSBR439 +00081 77 PAN-VALET PICTURE X(24) VALUE '022DTSBR439 10/02/07'. DTSBR439 +00082 DTSBR439 +00083 01 WRK-AREA. DTSBR439 +00084 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +439.DTSBR439 +00085 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBR439 +00086 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR439 +00087 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR439 +00088 05 WS-DNUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL**5 +00089 05 WS-TOTAL-CDT-AMT PIC S9(11)V99 COMP-3 VALUE +0. CL*19 +00090 05 WS-TOTAL-DBT-AMT PIC S9(11)V99 COMP-3 VALUE +0. CL*19 +00091 DTSBR439 +00092 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR439 +00093 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR439 +00094 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBR439 +00095 05 WS-DLINE-CNT PIC S9(02) COMP-3 VALUE 60. CL**5 +00096 05 WS-DLINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL**5 +00097 05 WS-DPAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL**5 +00098 DTSBR439 +00099 05 WRK-START-YRQ PIC 9(05). DTSBR439 +00100 05 FILLER REDEFINES WRK-START-YRQ. DTSBR439 +00101 10 WRK-START-YRQ-Y PIC X(04). DTSBR439 +00102 10 WRK-START-YRQ-Q PIC X(01). DTSBR439 +00103 DTSBR439 +00104 EJECT DTSBR439 +00105 01 L001-LINK-AREA. DTSBR439 +00106 ++INCLUDE DTSIL001 DTSBR439 +00107 EJECT DTSBR439 +00108 01 L004-LINK-AREA. DTSBR439 +00109 ++INCLUDE DTSIL004 DTSBR439 +00110 DTSBR439 +00111 01 HEADER-VAR. CL**5 +00112 05 HDR-CREDITS PIC X(50) VALUE CL**3 +00113 ' WRITE OFF CANDIDATES LIST - CREDITS '. CL**3 +00114 CL**3 +00115 05 HDR-DEBITS PIC X(50) VALUE CL**3 +00116 ' WRITE OFF CANDIDATES LIST - DEBITS '. CL**3 +00117 CL**3 +00118 05 FOOTING-CREDITS PIC X(45) VALUE CL**3 +00119 'CREDITS WRITE OFF CANDIDATES '. CL*19 +00120 CL**3 +00121 05 FOOTING-DEBITS PIC X(45) VALUE CL**3 +00122 'DEBITS WRITE OFF CANDIDATES '. CL*19 +00123 CL**3 +00124 01 HEADER-1. CL**5 +00125 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00126 05 FILLER PIC X(49) VALUE '439R1'. CL**5 +00127 05 FILLER PIC X(60) VALUE CL**5 +00128 'DISTRICT OF COLUMBIA'. CL**5 +00129 05 FILLER PIC X(06) VALUE 'DATE:'. CL**5 +00130 05 HDR1-LRCM-SYS-DATE PIC X(08). CL**5 +00131 CL**5 +00132 01 HEADER-2. CL**5 +00133 05 FILLER PIC X(54) VALUE SPACES. CL**5 +00134 05 FILLER PIC X(56) VALUE CL**5 +00135 'TAX DIVISION'. CL**5 +00136 05 FILLER PIC X(06) VALUE 'TIME:'. CL**5 +00137 05 HDR2-LRCM-SYS-TIME PIC X(08). CL**5 +00138 CL**5 +00139 01 HEADER-3. DTSBR439 +00140 05 FILLER PIC X(01) VALUE SPACES. DTSBR439 +00141 05 FILLER PIC X(38) VALUE DTSBR439 +00142 'ROUTE TO: ACCOUNTING UNIT'. DTSBR439 +00143 05 HDR3-LITERAL PIC X(50) VALUE SPACES. CL**6 +00144 05 FILLER PIC X(21) VALUE SPACES. DTSBR439 +00145 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR439 +00146 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR439 +00147 DTSBR439 +00148 01 HEADER-4. DTSBR439 +00149 05 FILLER PIC X(01) VALUE SPACES. DTSBR439 +00150 05 FILLER PIC X(25) VALUE DTSBR439 +00151 'INACTIVITY CUTOFF YRQ : '. DTSBR439 +00152 05 HDR4-CUTOFF-YRQ PIC X(06). DTSBR439 +00153 05 FILLER PIC X(101) VALUE SPACES. DTSBR439 +00154 DTSBR439 +00155 01 HEADER-5. DTSBR439 +00156 05 FILLER PIC X(01) VALUE SPACES. DTSBR439 +00157 05 FILLER PIC X(132) VALUE SPACES. DTSBR439 +00158 DTSBR439 +00159 01 HEADER-6. DTSBR439 +00160 05 FILLER PIC X(01) VALUE SPACES. DTSBR439 +00161 05 FILLER PIC X(55) VALUE SPACES. CL**9 +00162 05 FILLER PIC X(05) VALUE 'FIELD'. DTSBR439 +00163 05 FILLER PIC X(05) VALUE SPACES. DTSBR439 +00164 05 FILLER PIC X(14) VALUE DTSBR439 +00165 ' BALANCE '. CL*11 +00166 05 FILLER PIC X(03) VALUE SPACES. CL*14 +00167 05 FILLER PIC X(11) VALUE DTSBR439 +00168 ' MISS '. CL*15 +00169 05 FILLER PIC X(12) VALUE SPACES. CL*14 +00170 05 FILLER PIC X(11) VALUE CL*11 +00171 'LAST '. CL*11 +00172 05 FILLER PIC X(04) VALUE SPACES. CL*12 +00173 05 FILLER PIC X(11) VALUE CL*12 +00174 'LAST '. CL*12 +00175 DTSBR439 +00176 01 HEADER-7. DTSBR439 +00177 05 FILLER PIC X(01) VALUE SPACES. DTSBR439 +00178 05 FILLER PIC X(05) VALUE SPACES. DTSBR439 +00179 05 FILLER PIC X(06) VALUE DTSBR439 +00180 'EMP NO'. DTSBR439 +00181 05 FILLER PIC X(05) VALUE SPACES. DTSBR439 +00182 05 FILLER PIC X(12) VALUE DTSBR439 +00183 'PRIMARY NAME'. DTSBR439 +00184 05 FILLER PIC X(27) VALUE SPACES. CL*14 +00185 05 FILLER PIC X(04) VALUE 'CODE'. DTSBR439 +00186 05 FILLER PIC X(15) VALUE SPACES. CL*14 +00187 05 FILLER PIC X(03) VALUE 'DUE'. DTSBR439 +00188 05 FILLER PIC X(07) VALUE SPACES. CL*17 +00189 05 FILLER PIC X(05) VALUE CL*18 +00190 'RPT '. CL*14 +00191 05 FILLER PIC X(01) VALUE SPACES. CL*14 +00192 05 FILLER PIC X(03) VALUE 'DPC'. DTSBR439 +00193 05 FILLER PIC X(02) VALUE SPACES. CL*16 +00194 05 FILLER PIC X(04) VALUE 'LIEN'. DTSBR439 +00195 05 FILLER PIC X(03) VALUE SPACES. CL*18 +00196 05 FILLER PIC X(07) VALUE 'LIA-YRQ'. CL**8 +00197 05 FILLER PIC X(08) VALUE SPACES. CL*19 +00198 05 FILLER PIC X(07) VALUE 'UPD-DTE'. CL*14 +00199 DTSBR439 +00200 01 HEADER-8. DTSBR439 +00201 05 FILLER PIC X(01) VALUE SPACES. DTSBR439 +00202 05 FILLER PIC X(132) VALUE SPACES. DTSBR439 +00203 DTSBR439 +00204 01 DETAIL-LINE-1. DTSBR439 +00205 05 FILLER PIC X(05) VALUE SPACES. DTSBR439 +00206 05 WS-EMP-NO PIC 999B999. DTSBR439 +00207 05 FILLER PIC X(02) VALUE SPACES. DTSBR439 +00208 05 WS-PRIMARY-NAME PIC X(36). CL**8 +00209 05 FILLER PIC X(02) VALUE SPACES. CL**2 +00210 05 WS-EMP-STATUS PIC X(04). CL**2 +00211 05 FILLER PIC X(02) VALUE SPACES. CL**2 +00212 05 WS-FIELD-CODE PIC X(02). DTSBR439 +00213 05 FILLER PIC X(05) VALUE SPACES. DTSBR439 +00214 05 WS-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR439 +00215 05 FILLER PIC X(05) VALUE SPACES. CL**8 +00216 05 WS-PURSUED-RPT PIC ZZ9. DTSBR439 +00217 05 FILLER PIC X(05) VALUE SPACES. CL**8 +00218 05 WS-DPC PIC X(01). DTSBR439 +00219 05 FILLER PIC X(05) VALUE SPACES. CL**8 +00220 05 WS-LIEN PIC X(03). CL*10 +00221 05 FILLER PIC X(02) VALUE SPACES. CL**2 +00222 05 WS-LIAB-YRQ PIC X(06) VALUE SPACES. CL**7 +00223 05 FILLER PIC X(05). CL*10 +00224 05 WS-LAST-DTE PIC X(10) VALUE SPACES. CL**7 +00225 DTSBR439 +00226 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSBR439 +00227 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSBR439 +00228 DTSBR439 +00229 01 FOOTING-LINE-3. DTSBR439 +00230 05 FILLER PIC X(25) VALUE SPACES. DTSBR439 +00231 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSBR439 +00232 05 FILLER PIC X(02) VALUE SPACES. DTSBR439 +00233 05 WS-FOOTING-CRE-DBT PIC X(33) VALUE SPACES. CL*19 +00234 05 WS-FOOTING-TOT-AMT PIC $$$,$$$,$$9.99-. CL*19 +00235 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. DTSBR439 +00236 01 FOOTING-LINE-5 PIC X(133) VALUE SPACES. DTSBR439 +00237 01 FOOTING-LINE-6. DTSBR439 +00238 05 FILLER PIC X(25) VALUE SPACES. DTSBR439 +00239 05 FILLER PIC X(17) VALUE DTSBR439 +00240 '*** END OF REPORT'. DTSBR439 +00241 EJECT DTSBR439 +00242 LINKAGE SECTION. DTSBR439 +00243 DTSBR439 +00244 01 LRCM-LINK-AREA. DTSBR439 +00245 ++INCLUDE DTSILRCM DTSBR439 +00246 EJECT DTSBR439 +00247 01 R439-REC. DTSBR439 +00248 ++INCLUDE DTSIR439 DTSBR439 +00249 EJECT DTSBR439 +00250 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR439 +00251 R439-REC. DTSBR439 +00252 DTSBR439 +00253 IF FIRST-TIME-IND = 'Y' DTSBR439 +00254 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR439 +00255 MOVE 'N' TO FIRST-TIME-IND. DTSBR439 +00256 DTSBR439 +00257 IF LRCM-EOR-88 DTSBR439 +00258 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR439 +00259 ELSE DTSBR439 +00260 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBR439 +00261 DTSBR439 +00262 GOBACK. DTSBR439 +00263 EJECT DTSBR439 +00264 I1000-INITIATE. DTSBR439 +00265 DTSBR439 +00266 OPEN OUTPUT PRT-FILE1 CL*21 +00267 PRT-FILE2. CL*21 +00268 MOVE LRCM-SYS-DATE TO HDR1-LRCM-SYS-DATE. DTSBR439 +00269 MOVE LRCM-SYS-TIME TO HDR2-LRCM-SYS-TIME. DTSBR439 +00270 DTSBR439 +00271 MOVE R439-CUTOFF-YRQ TO L004-QTR-5-9. DTSBR439 +00272 PERFORM S004-FROM-FIVE THRU S004-EXIT. DTSBR439 +00273 MOVE L004-SLASH-5-QTR TO HDR4-CUTOFF-YRQ. DTSBR439 +00274 DTSBR439 +00275 MOVE SPACES TO PRT-CREDITS PRT-DEBITS. CL**3 +00276 DTSBR439 +00277 I1000-EXIT. DTSBR439 +00278 EXIT. DTSBR439 +00279 EJECT DTSBR439 +00280 DTSBR439 +00281 P0000-PROCESS. DTSBR439 +00282 DTSBR439 +00283 MOVE R439-EMP-NO TO WS-EMP-NO. DTSBR439 +00284 MOVE R439-PRIMARY-NAME TO WS-PRIMARY-NAME. DTSBR439 +00285 MOVE R439-FLD-REP-ID TO WS-FIELD-CODE. DTSBR439 +00286 MOVE R439-TOT-BALANCE-AMT TO WS-BALANCE-AMT. DTSBR439 +00287 MOVE R439-PURSUED-RPT-CNT TO WS-PURSUED-RPT. DTSBR439 +00288 MOVE R439-MDPC-IND TO WS-DPC. DTSBR439 +00289 MOVE R439-MLIN-IND TO WS-LIEN. DTSBR439 +00290 MOVE R439-LAST-LIAB-YRQ TO WS-LIAB-YRQ. CL**4 +00291 MOVE R439-LAST-UPD-DATE TO WS-LAST-DTE. CL**4 +00292 IF R439-DEBIT-RPT-88 CL**4 +00293 MOVE HDR-DEBITS TO HDR3-LITERAL CL**5 +00294 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT CL**9 +00295 WRITE PRT-DEBITS FROM DETAIL-LINE-1 AFTER 1 CL**4 +00296 ADD R439-TOT-BALANCE-AMT TO WS-TOTAL-DBT-AMT CL*19 +00297 ADD 1 TO WS-DLINE-CNT2 CL*22 +00298 ADD +1 TO WS-DNUMBER-ONE CL*22 +00299 ELSE CL**4 +00300 MOVE HDR-DEBITS TO HDR3-LITERAL CL*23 +00301 PERFORM P1000-PRINT-HEADER THRU P1000-EXIT CL**9 +00302 WRITE PRT-CREDITS FROM DETAIL-LINE-1 AFTER 1 CL**4 +00303 ADD R439-TOT-BALANCE-AMT TO WS-TOTAL-CDT-AMT CL*19 +00304 ADD 1 TO WS-LINE-CNT2 CL*22 +00305 ADD +1 TO WS-NUMBER-ONE. CL*22 +00306 DTSBR439 +00307 P0000-EXIT. DTSBR439 +00308 EXIT. DTSBR439 +00309 DTSBR439 +00310 P1000-PRINT-HEADER. DTSBR439 +00311 IF WS-LINE-CNT GREATER 58 OR DTSBR439 +00312 WS-LINE-CNT2 GREATER 58 DTSBR439 +00313 MOVE +0 TO WS-LINE-CNT DTSBR439 +00314 MOVE +0 TO WS-LINE-CNT2 DTSBR439 +00315 ADD +1 TO WS-PAGE-CNT DTSBR439 +00316 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSBR439 +00317 WRITE PRT-CREDITS FROM HEADER-1 AFTER TOP-OF-PAGE CL**5 +00318 WRITE PRT-CREDITS FROM HEADER-2 AFTER 1 CL**5 +00319 WRITE PRT-CREDITS FROM HEADER-3 AFTER 1 CL**5 +00320 WRITE PRT-CREDITS FROM HEADER-4 AFTER 1 CL**5 +00321 WRITE PRT-CREDITS FROM HEADER-5 AFTER 1 CL**5 +00322 WRITE PRT-CREDITS FROM HEADER-6 AFTER 1 CL**5 +00323 WRITE PRT-CREDITS FROM HEADER-7 AFTER 1 CL**5 +00324 WRITE PRT-CREDITS FROM HEADER-8 AFTER 1 CL**5 +00325 ADD +8 TO WS-LINE-CNT2. DTSBR439 +00326 P1000-EXIT. DTSBR439 +00327 EXIT. DTSBR439 +00328 DTSBR439 +00329 CL**5 +00330 P2000-PRINT-HEADER. CL**5 +00331 IF WS-DLINE-CNT GREATER 58 OR CL**5 +00332 WS-DLINE-CNT2 GREATER 58 CL**5 +00333 MOVE +0 TO WS-DLINE-CNT CL**5 +00334 MOVE +0 TO WS-DLINE-CNT2 CL**5 +00335 ADD +1 TO WS-DPAGE-CNT CL**5 +00336 MOVE WS-DPAGE-CNT TO HDR3-PAGE CL**5 +00337 WRITE PRT-DEBITS FROM HEADER-1 AFTER TOP-OF-PAGE CL**5 +00338 WRITE PRT-DEBITS FROM HEADER-2 AFTER 1 CL**5 +00339 WRITE PRT-DEBITS FROM HEADER-3 AFTER 1 CL**5 +00340 WRITE PRT-DEBITS FROM HEADER-4 AFTER 1 CL**5 +00341 WRITE PRT-DEBITS FROM HEADER-5 AFTER 1 CL**5 +00342 WRITE PRT-DEBITS FROM HEADER-6 AFTER 1 CL**5 +00343 WRITE PRT-DEBITS FROM HEADER-7 AFTER 1 CL**5 +00344 WRITE PRT-DEBITS FROM HEADER-8 AFTER 1 CL**5 +00345 ADD +8 TO WS-DLINE-CNT2. CL**5 +00346 P2000-EXIT. CL**6 +00347 EXIT. CL**5 +00348 CL**5 +00349 T1000-TERMINATE. DTSBR439 +00350 DTSBR439 +00351 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO DTSBR439 +00352 PERFORM P1000-PRINT-HEADER THRU P1000-EXIT DTSBR439 +00353 END-IF. DTSBR439 +00354 MOVE FOOTING-CREDITS TO WS-FOOTING-CRE-DBT. CL**5 +00355 MOVE WS-TOTAL-CDT-AMT TO WS-FOOTING-TOT-AMT CL*19 +00356 MOVE WS-NUMBER-ONE TO WS-FOOTING-CNT. DTSBR439 +00357 WRITE PRT-CREDITS FROM FOOTING-LINE-1 AFTER 1. CL**5 +00358 WRITE PRT-CREDITS FROM FOOTING-LINE-2 AFTER 1. CL**5 +00359 WRITE PRT-CREDITS FROM FOOTING-LINE-3 AFTER 1. CL**5 +00360 WRITE PRT-CREDITS FROM FOOTING-LINE-4 AFTER 1. CL**5 +00361 WRITE PRT-CREDITS FROM FOOTING-LINE-5 AFTER 1. CL**5 +00362 WRITE PRT-CREDITS FROM FOOTING-LINE-6 AFTER 1. CL**5 +00363 DTSBR439 +00364 IF WS-DLINE-CNT2 > 52 OR WS-DNUMBER-ONE = ZERO CL**5 +00365 PERFORM P2000-PRINT-HEADER THRU P2000-EXIT CL**5 +00366 END-IF. CL**5 +00367 MOVE WS-DNUMBER-ONE TO WS-FOOTING-CNT. CL**5 +00368 MOVE FOOTING-DEBITS TO WS-FOOTING-CRE-DBT. CL**5 +00369 MOVE WS-TOTAL-DBT-AMT TO WS-FOOTING-TOT-AMT CL*19 +00370 WRITE PRT-DEBITS FROM FOOTING-LINE-1 AFTER 1. CL**5 +00371 WRITE PRT-DEBITS FROM FOOTING-LINE-2 AFTER 1. CL**5 +00372 WRITE PRT-DEBITS FROM FOOTING-LINE-3 AFTER 1. CL**5 +00373 WRITE PRT-DEBITS FROM FOOTING-LINE-4 AFTER 1. CL**5 +00374 WRITE PRT-DEBITS FROM FOOTING-LINE-5 AFTER 1. CL**5 +00375 WRITE PRT-DEBITS FROM FOOTING-LINE-6 AFTER 1. CL**5 +00376 CL**5 +00377 CLOSE PRT-FILE1 PRT-FILE2. CL**3 +00378 DTSBR439 +00379 T1000-EXIT. DTSBR439 +00380 EXIT. DTSBR439 +00381 EJECT DTSBR439 +00382 DTSBR439 +00383 S001-DATE. DTSBR439 +00384 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR439 +00385 S001-EXIT. DTSBR439 +00386 EXIT. DTSBR439 +00387 DTSBR439 +00388 S004-FROM-DATE. DTSBR439 +00389 SET L004-FROM-DATE TO TRUE. DTSBR439 +00390 GO TO S004-YRQ. DTSBR439 +00391 DTSBR439 +00392 S004-FROM-FIVE. DTSBR439 +00393 SET L004-FROM-5 TO TRUE. DTSBR439 +00394 GO TO S004-YRQ. DTSBR439 +00395 DTSBR439 +00396 S004-YRQ. DTSBR439 +00397 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR439 +00398 S004-EXIT. DTSBR439 +00399 EXIT. DTSBR439 +00400 DTSBR439 +00401 S999-ABEND. DTSBR439 +00402 DTSBR439 +00403 DISPLAY '*** DTSBR439 ABENDING. ' DTSBR439 +00404 WRK-ABEND-MSG. DTSBR439 +00405 DTSBR439 +00406 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR439 +00407 DTSBR439 +00408 S999-EXIT. DTSBR439 +00409 EXIT. DTSBR439 diff --git a/Batch/DTSBR451.cob b/Batch/DTSBR451.cob index b0ccce9..3ca611c 100644 --- a/Batch/DTSBR451.cob +++ b/Batch/DTSBR451.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 05/17/13 +00001 IDENTIFICATION DIVISION. 05/05/20 00002 PROGRAM-ID. DTSBR451. DTSBR451 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV015 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV025 00004 MODIFIED BY TRW S&ITG. DTSBR451 00005 DATE-WRITTEN. AUGUST 2002. DTSBR451 00006 DATE-COMPILED. DTSBR451 @@ -83,386 +83,390 @@ 00083 DTSBR451 00084 EJECT DTSBR451 00085 WORKING-STORAGE SECTION. DTSBR451 -000855 77 PAN-VALET PICTURE X(24) VALUE '015DTSBR451 05/17/13'. DTSBR451 -00086 77 PAN-VALET PICTURE X(24) VALUE '022DTSBR451 05/03/13'. DTSBR451 -00087 77 PAN-VALET PICTURE X(24) VALUE '013DTSBR451 06/18/07'. DTSBR451 -00088 DTSBR451 -00089 01 WRK-AREA. DTSBR451 -00090 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +451.DTSBR451 -00091 05 WRK-COUNTER PIC 9(1). DTSBR451 -00092 DTSBR451 -00093 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR451 -00094 DTSBR451 -00095 05 ABEND-MSG PIC X(60). DTSBR451 -00096 01 VSCA-LINE. DTSBR451 -00097 05 VSCA-DATA PIC X(133). DTSBR451 -00098 DTSBR451 -00099 05 WS-UNIT-TEL. DTSBR451 -00100 10 WS-UNIT-AREA-CD PIC X(03). DTSBR451 -00101 10 WS-UNIT-PREFIX PIC X(03). DTSBR451 -00102 10 WS-UNIT-SUFFIX PIC X(04). DTSBR451 -00103 10 WS-UNIT-EXTENSION PIC X(04). DTSBR451 -00104 DTSBR451 -00105 05 DISP-TEL. DTSBR451 -00106 10 DISP-TEL-FILLER-1 PIC X(01) VALUE '('. DTSBR451 -00107 10 DISP-TEL-AREA-CD PIC X(03). DTSBR451 -00108 10 DISP-TEL-FILLER-2 PIC X(02) VALUE ')-'. DTSBR451 -00109 10 DISP-TEL-PREFIX PIC X(03). DTSBR451 -00110 10 DISP-TEL-FILLER-3 PIC X(01) VALUE '-'. DTSBR451 -00111 10 DISP-TEL-SUFFIX PIC X(04). DTSBR451 -00112 SKIP3 DTSBR451 -00113 DTSBR451 -00114 01 T451-ADDR-AREA. DTSBR451 -00115 ++INCLUDE DTSXMAIL DTSBR451 -00116 EJECT DTSBR451 -00117 *01 T451-REPT-HDR. DTSBR451 -00118 *++INCLUDE DTSXAHDR DTSBR451 -00119 EJECT DTSBR451 -00120 ++INCLUDE DTSIZ51A DTSBR451 -00121 EJECT DTSBR451 -00122 ++INCLUDE DTSIZ51B DTSBR451 -00123 EJECT DTSBR451 -00124 01 L001-LINK-AREA. DTSBR451 -00125 ++INCLUDE DTSIL001 DTSBR451 -00126 EJECT DTSBR451 -00127 01 L002-LINK-AREA. DTSBR451 -00128 ++INCLUDE DTSIL002 DTSBR451 -00129 EJECT DTSBR451 -00130 01 L004-LINK-AREA. DTSBR451 -00131 ++INCLUDE DTSIL004 DTSBR451 -00132 EJECT DTSBR451 -00133 01 L008-LINK-AREA. DTSBR451 -00134 ++INCLUDE DTSIL008 DTSBR451 -00135 EJECT DTSBR451 -00136 01 L056-LINK-AREA. DTSBR451 -00137 ++INCLUDE DTSIL056 DTSBR451 -00138 EJECT DTSBR451 -00139 01 L090-LINK-AREA. DTSBR451 -00140 ++INCLUDE DTSIL090 DTSBR451 -00141 EJECT DTSBR451 -00142 01 L119-LINK-AREA. DTSBR451 -00143 ++INCLUDE DTSIL119 DTSBR451 -00144 EJECT DTSBR451 -00145 ++INCLUDE DTSXL451 DTSBR451 -00146 SKIP3 DTSBR451 -00147 *RW1 DTSBR451 -00148 01 CONVERT-BARCODE-LINE. DTSBR451 -00149 05 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR451 -00150 DTSBR451 -00151 01 WS-BARC-LINE. DTSBR451 -00152 05 FILLER PIC X(40) VALUE SPACES. DTSBR451 -00153 05 CONVERTED-BARCODE PIC X(50). DTSBR451 -00154 05 FILLER PIC X(30) VALUE SPACES. DTSBR451 -00155 DTSBR451 -00156 01 BARI-LINK-AREA. DTSBR451 -00157 ++INCLUDE BARIL599 DTSBR451 -00158 SKIP3 DTSBR451 -00159 *RW2 DTSBR451 -00160 LINKAGE SECTION. DTSBR451 -00161 SKIP3 DTSBR451 -00162 01 LRCM-LINK-AREA. DTSBR451 -00163 ++INCLUDE DTSILRCM DTSBR451 -00164 EJECT DTSBR451 -00165 01 R451-REC. DTSBR451 -00166 ++INCLUDE DTSIR451 DTSBR451 -00167 EJECT DTSBR451 -00168 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR451 -00169 R451-REC. DTSBR451 -00170 SKIP2 DTSBR451 -00171 IF FIRST-TIME-IND = 'Y' DTSBR451 -00172 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR451 -00173 MOVE 'N' TO FIRST-TIME-IND DTSBR451 -00174 MOVE 0 TO WRK-COUNTER. DTSBR451 -00175 DTSBR451 -00176 IF LRCM-EOR-88 DTSBR451 -00177 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR451 -00178 ELSE DTSBR451 -00179 ADD 1 TO WRK-COUNTER DTSBR451 -00180 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR451 -00181 SKIP2 DTSBR451 -00182 GOBACK. DTSBR451 -00183 EJECT DTSBR451 -00184 I1000-INITIATE. DTSBR451 -00185 DTSBR451 -00186 OPEN OUTPUT PRT-FILE. DTSBR451 -00187 MOVE SPACES TO XEROX-T451RW. DTSBR451 -00188 DTSBR451 -00189 * WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 -00190 * AFTER ADVANCING TOP-OF-PAGE. DTSBR451 -00191 *RW1 DTSBR451 -00192 ** WRITE XEROX-T451RW FROM XEROX-CNTL-LINE DTSBR451 -00193 ** AFTER ADVANCING TOP-OF-PAGE. DTSBR451 -00194 *RW2 DTSBR451 -00195 * WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 -00196 * AFTER ADVANCING TOP-OF-PAGE. DTSBR451 -00197 * WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 -00198 * AFTER ADVANCING TOP-OF-PAGE. DTSBR451 -00199 DTSBR451 -00200 SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSBR451 -00201 PERFORM S119-REQ-MIXED THRU S119-EXIT. DTSBR451 -00202 MOVE L119-UNIT-VOICE TO WS-UNIT-TEL. DTSBR451 -00203 I1000-EXIT. DTSBR451 -00204 EXIT. DTSBR451 -00205 EJECT DTSBR451 -00206 P1000-PROCESS. DTSBR451 -00207 MOVE R451-EMP-NO TO HDR-EMP-NO. DTSBR451 -00208 MOVE R451-FMT-LINE (1) TO HDR-FMT-LINE-1 DTSBR451 -00209 MAIL-ADDR-LINE1. DTSBR451 -00210 MOVE R451-FMT-LINE (2) TO HDR-FMT-LINE-2 DTSBR451 -00211 MAIL-ADDR-LINE2. DTSBR451 -00212 MOVE R451-FMT-LINE (3) TO HDR-FMT-LINE-3 DTSBR451 -00213 MAIL-ADDR-LINE3. DTSBR451 -00214 MOVE R451-FMT-LINE (4) TO HDR-FMT-LINE-4 DTSBR451 -00215 MAIL-ADDR-LINE4. DTSBR451 -00216 MOVE R451-FMT-LINE (5) TO HDR-FMT-LINE-5 DTSBR451 -00217 MAIL-ADDR-LINE5. DTSBR451 -00218 DTSBR451 -00219 DTSBR451 -00220 MOVE '(' TO DISP-TEL-FILLER-1. DTSBR451 -00221 MOVE WS-UNIT-AREA-CD TO DISP-TEL-AREA-CD. DTSBR451 -00222 MOVE ') ' TO DISP-TEL-FILLER-2. DTSBR451 -00223 MOVE WS-UNIT-PREFIX TO DISP-TEL-PREFIX. DTSBR451 -00224 MOVE '-' TO DISP-TEL-FILLER-3. DTSBR451 -00225 MOVE WS-UNIT-SUFFIX TO DISP-TEL-SUFFIX. DTSBR451 -00226 DTSBR451 -00227 MOVE R451-MAIL-DATE TO L002-DATE. DTSBR451 -00228 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR451 -00229 DTSBR451 -00230 MOVE L002-LONG-TEXT-AREA TO WS-LONG-TEXT-MAIL-DATE. DTSBR451 -00231 DTSBR451 -00232 MOVE R451-TOTAL-RATE TO L056-RATE. DTSBR451 -00233 PERFORM S056-DISP1-LEFT-PCT THRU S056-EXIT. DTSBR451 -00234 MOVE L056-DISP-RATE TO WS-DISP-RATE. DTSBR451 -00235 DTSBR451 -00236 DTSBR451 -00237 MOVE R451-YRQ TO L008-YRQ. DTSBR451 -00238 PERFORM S008-MIXED-CASE THRU S008-EXIT. DTSBR451 -00239 MOVE L008-YEAR TO HDR-LONG-YEAR DTL-LONG-YEAR. DTSBR451 -00240 DTSBR451 -00241 MOVE R451-DUE-DATE TO L001-FED-8-DATE-9. DTSBR451 -00242 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR451 -00243 MOVE L001-SLASH-8-DATE TO WS-SLASH-DUE-DATE. DTSBR451 -00244 DTSBR451 -00245 MOVE R451-DUE-DATE TO L002-DATE. DTSBR451 -00246 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR451 +000855 77 PAN-VALET PICTURE X(24) VALUE '025DTSBR451 05/05/20'. DTSBR451 +00086 77 PAN-VALET PICTURE X(24) VALUE '015DTSBR451 05/17/13'. DTSBR451 +00087 77 PAN-VALET PICTURE X(24) VALUE '022DTSBR451 05/03/13'. DTSBR451 +00088 77 PAN-VALET PICTURE X(24) VALUE '013DTSBR451 06/18/07'. DTSBR451 +00089 DTSBR451 +00090 01 WRK-AREA. DTSBR451 +00091 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +451.DTSBR451 +00092 05 WRK-COUNTER PIC 9(1). DTSBR451 +00093 DTSBR451 +00094 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR451 +00095 DTSBR451 +00096 05 ABEND-MSG PIC X(60). DTSBR451 +00097 01 VSCA-LINE. DTSBR451 +00098 05 VSCA-DATA PIC X(133). DTSBR451 +00099 DTSBR451 +00100 05 WS-UNIT-TEL. DTSBR451 +00101 10 WS-UNIT-AREA-CD PIC X(03). DTSBR451 +00102 10 WS-UNIT-PREFIX PIC X(03). DTSBR451 +00103 10 WS-UNIT-SUFFIX PIC X(04). DTSBR451 +00104 10 WS-UNIT-EXTENSION PIC X(04). DTSBR451 +00105 DTSBR451 +00106 05 DISP-TEL. DTSBR451 +00107 10 DISP-TEL-FILLER-1 PIC X(01) VALUE '('. DTSBR451 +00108 10 DISP-TEL-AREA-CD PIC X(03). DTSBR451 +00109 10 DISP-TEL-FILLER-2 PIC X(02) VALUE ')-'. DTSBR451 +00110 10 DISP-TEL-PREFIX PIC X(03). DTSBR451 +00111 10 DISP-TEL-FILLER-3 PIC X(01) VALUE '-'. DTSBR451 +00112 10 DISP-TEL-SUFFIX PIC X(04). DTSBR451 +00113 SKIP3 DTSBR451 +00114 DTSBR451 +00115 01 T451-ADDR-AREA. DTSBR451 +00116 ++INCLUDE DTSXMAIL DTSBR451 +00117 EJECT DTSBR451 +00118 *01 T451-REPT-HDR. DTSBR451 +00119 *++INCLUDE DTSXAHDR DTSBR451 +00120 EJECT DTSBR451 +00121 ++INCLUDE DTSIZ51A CL*12 +00122 EJECT CL*12 +00123 *++INCLUDE DTSIZ51B CL**6 +00124 * EJECT CL**6 +00125 01 L001-LINK-AREA. DTSBR451 +00126 ++INCLUDE DTSIL001 DTSBR451 +00127 EJECT DTSBR451 +00128 01 L002-LINK-AREA. DTSBR451 +00129 ++INCLUDE DTSIL002 DTSBR451 +00130 EJECT DTSBR451 +00131 01 L004-LINK-AREA. DTSBR451 +00132 ++INCLUDE DTSIL004 DTSBR451 +00133 EJECT DTSBR451 +00134 01 L008-LINK-AREA. DTSBR451 +00135 ++INCLUDE DTSIL008 DTSBR451 +00136 EJECT DTSBR451 +00137 01 L056-LINK-AREA. DTSBR451 +00138 ++INCLUDE DTSIL056 DTSBR451 +00139 EJECT DTSBR451 +00140 01 L090-LINK-AREA. DTSBR451 +00141 ++INCLUDE DTSIL090 DTSBR451 +00142 EJECT DTSBR451 +00143 01 L119-LINK-AREA. DTSBR451 +00144 ++INCLUDE DTSIL119 DTSBR451 +00145 EJECT DTSBR451 +00146 ++INCLUDE DTSXL451 DTSBR451 +00147 SKIP3 DTSBR451 +00148 *RW1 DTSBR451 +00149 01 CONVERT-BARCODE-LINE. DTSBR451 +00150 05 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR451 +00151 DTSBR451 +00152 01 WS-BARC-LINE. DTSBR451 +00153 05 FILLER PIC X(40) VALUE SPACES. DTSBR451 +00154 05 CONVERTED-BARCODE PIC X(50). DTSBR451 +00155 05 FILLER PIC X(30) VALUE SPACES. DTSBR451 +00156 DTSBR451 +00157 01 BARI-LINK-AREA. DTSBR451 +00158 ++INCLUDE BARIL599 DTSBR451 +00159 SKIP3 DTSBR451 +00160 *RW2 DTSBR451 +00161 LINKAGE SECTION. DTSBR451 +00162 SKIP3 DTSBR451 +00163 01 LRCM-LINK-AREA. DTSBR451 +00164 ++INCLUDE DTSILRCM DTSBR451 +00165 EJECT DTSBR451 +00166 01 R451-REC. DTSBR451 +00167 ++INCLUDE DTSIR451 DTSBR451 +00168 EJECT DTSBR451 +00169 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR451 +00170 R451-REC. DTSBR451 +00171 SKIP2 DTSBR451 +00172 IF FIRST-TIME-IND = 'Y' DTSBR451 +00173 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR451 +00174 MOVE 'N' TO FIRST-TIME-IND DTSBR451 +00175 MOVE 0 TO WRK-COUNTER. DTSBR451 +00176 DTSBR451 +00177 IF LRCM-EOR-88 DTSBR451 +00178 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR451 +00179 ELSE DTSBR451 +00180 ADD 1 TO WRK-COUNTER DTSBR451 +00181 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR451 +00182 SKIP2 DTSBR451 +00183 GOBACK. DTSBR451 +00184 EJECT DTSBR451 +00185 I1000-INITIATE. DTSBR451 +00186 DTSBR451 +00187 OPEN OUTPUT PRT-FILE. DTSBR451 +00188 MOVE SPACES TO XEROX-T451RW. DTSBR451 +00189 DTSBR451 +00190 * WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 +00191 * AFTER ADVANCING TOP-OF-PAGE. DTSBR451 +00192 *RW1 DTSBR451 +00193 ** WRITE XEROX-T451RW FROM XEROX-CNTL-LINE DTSBR451 +00194 ** AFTER ADVANCING TOP-OF-PAGE. DTSBR451 +00195 *RW2 DTSBR451 +00196 * WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 +00197 * AFTER ADVANCING TOP-OF-PAGE. DTSBR451 +00198 * WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 +00199 * AFTER ADVANCING TOP-OF-PAGE. DTSBR451 +00200 DTSBR451 +00201 SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSBR451 +00202 PERFORM S119-REQ-MIXED THRU S119-EXIT. DTSBR451 +00203 MOVE L119-UNIT-VOICE TO WS-UNIT-TEL. DTSBR451 +00204 I1000-EXIT. DTSBR451 +00205 EXIT. DTSBR451 +00206 EJECT DTSBR451 +00207 P1000-PROCESS. DTSBR451 +00208 **NH TESTING NEW DELINQ NOTICE CL**7 +00209 MOVE R451-EMP-NO TO HDR-EMP-NO. CL*13 +00210 MOVE R451-FMT-LINE (1) TO HDR-FMT-LINE-1 CL*13 +00211 MOVE R451-FMT-LINE (1) TO MAIL-ADDR-LINE1. CL**8 +00212 MOVE R451-FMT-LINE (2) TO HDR-FMT-LINE-2 CL*13 +00213 MOVE R451-FMT-LINE (2) TO MAIL-ADDR-LINE2. CL**8 +00214 MOVE R451-FMT-LINE (3) TO HDR-FMT-LINE-3 CL*13 +00215 MOVE R451-FMT-LINE (3) TO MAIL-ADDR-LINE3. CL**8 +00216 MOVE R451-FMT-LINE (4) TO HDR-FMT-LINE-4 CL*13 +00217 MOVE R451-FMT-LINE (4) TO MAIL-ADDR-LINE4. CL**8 +00218 MOVE R451-FMT-LINE (5) TO HDR-FMT-LINE-5 CL*13 +00219 MOVE R451-FMT-LINE (5) TO MAIL-ADDR-LINE5. CL**8 +00220 DTSBR451 +00221 DTSBR451 +00222 MOVE '(' TO DISP-TEL-FILLER-1. DTSBR451 +00223 MOVE WS-UNIT-AREA-CD TO DISP-TEL-AREA-CD. DTSBR451 +00224 MOVE ') ' TO DISP-TEL-FILLER-2. DTSBR451 +00225 MOVE WS-UNIT-PREFIX TO DISP-TEL-PREFIX. DTSBR451 +00226 MOVE '-' TO DISP-TEL-FILLER-3. DTSBR451 +00227 MOVE WS-UNIT-SUFFIX TO DISP-TEL-SUFFIX. DTSBR451 +00228 DTSBR451 +00229 * MOVE 20200621 TO R451-MAIL-DATE CL*25 +00230 MOVE R451-MAIL-DATE TO L002-DATE. CL*22 +00231 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR451 +00232 DTSBR451 +00233 MOVE L002-LONG-TEXT-AREA TO WS-LONG-TEXT-MAIL-DATE. CL*13 +00234 DTSBR451 +00235 MOVE R451-TOTAL-RATE TO L056-RATE. DTSBR451 +00236 PERFORM S056-DISP1-LEFT-PCT THRU S056-EXIT. DTSBR451 +00237 MOVE L056-DISP-RATE TO WS-DISP-RATE. CL*13 +00238 DTSBR451 +00239 DTSBR451 +00240 MOVE R451-YRQ TO L008-YRQ. DTSBR451 +00241 PERFORM S008-MIXED-CASE THRU S008-EXIT. DTSBR451 +00242 MOVE L008-YEAR TO HDR-LONG-YEAR DTL-LONG-YEAR. CL*13 +00243 DTSBR451 +00244 MOVE R451-DUE-DATE TO L001-FED-8-DATE-9. DTSBR451 +00245 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR451 +00246 MOVE L001-SLASH-8-DATE TO WS-SLASH-DUE-DATE. CL*13 00247 DTSBR451 -00248 * STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR451 -00249 * ',' DELIMITED BY SIZE DTSBR451 -00250 * INTO WS-LONG-TEXT-DUE-DATE. DTSBR451 -00251 DTSBR451 -00252 * MOVE DISP-TEL TO RPT-CALL-PHONE. DTSBR451 -00253 DTSBR451 -00254 * MOVE R451-RETURN-BY-DATE TO L002-DATE. DTSBR451 -00255 * PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR451 +00248 MOVE R451-DUE-DATE TO L002-DATE. DTSBR451 +00249 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR451 +00250 DTSBR451 +00251 * STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR451 +00252 * ',' DELIMITED BY SIZE DTSBR451 +00253 * INTO WS-LONG-TEXT-DUE-DATE. DTSBR451 +00254 DTSBR451 +00255 * MOVE DISP-TEL TO RPT-CALL-PHONE. DTSBR451 00256 DTSBR451 -00257 PERFORM P2000-REPT-HEADER-RTN THRU P2000-EXIT. DTSBR451 -00258 DTSBR451 -00259 MOVE +90 TO L090-DESIRED-LINE-LIMIT. DTSBR451 -00260 MOVE +3 TO L090-PHRASE-CNT. DTSBR451 -00261 MOVE MC-LIT-WAS-DUE-BY TO L090-PHRASE (1). DTSBR451 -00262 MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR451 -00263 * MOVE WS-LONG-TEXT-DUE-DATE TO L090-PHRASE (2). DTSBR451 -00264 * MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR451 -00265 MOVE SPACES TO L090-PHRASE (2). DTSBR451 -00266 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR451 -00267 ',' DELIMITED BY SIZE DTSBR451 -00268 INTO L090-PHRASE (2). DTSBR451 -00269 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR451 -00270 MOVE MC-LIT-IS-NOW-DEL TO L090-PHRASE (3). DTSBR451 -00271 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR451 -00272 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR451 -00273 DISPLAY 'L90 ' L090-PARAGRAPH-LINE-CNT DTSBR451 -00274 IF (L090-UNSUCCESSFUL-88) DTSBR451 -00275 OR DTSBR451 -00276 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR451 -00277 MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG DTSBR451 -00278 PERFORM S999-ABEND THRU S999-EXIT. DTSBR451 -00279 MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-1. DTSBR451 -00280 DTSBR451 -00281 MOVE +120 TO L090-DESIRED-LINE-LIMIT. DTSBR451 -00282 MOVE +3 TO L090-PHRASE-CNT. DTSBR451 -00283 MOVE MC-LIT-NOTICE-TO-US TO L090-PHRASE (1). DTSBR451 -00284 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (1). DTSBR451 -00285 MOVE R451-RETURN-BY-DATE TO L002-DATE. DTSBR451 -00286 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR451 -00287 MOVE SPACES TO L090-PHRASE (2). DTSBR451 -00288 STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' DTSBR451 -00289 ',' DELIMITED BY SIZE DTSBR451 -00290 INTO L090-PHRASE (2). DTSBR451 -00291 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). DTSBR451 -00292 MOVE MC-LIT-NOTICE-TO-US1 TO L090-PHRASE (3). DTSBR451 -00293 MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). DTSBR451 -00294 PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. DTSBR451 -00295 DISPLAY 'L91 ' L090-PARAGRAPH-LINE-CNT DTSBR451 -00296 IF (L090-UNSUCCESSFUL-88) DTSBR451 -00297 OR DTSBR451 -00298 (L090-PARAGRAPH-LINE-CNT NOT = +1) DTSBR451 -00299 MOVE 'LOGIC ERROR P1000-3' TO ABEND-MSG DTSBR451 -00300 PERFORM S999-ABEND THRU S999-EXIT. DTSBR451 -00301 MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-3. DTSBR451 -00302 DTSBR451 -00303 WRITE XEROX-T451RW FROM DTL-LINE-2 AFTER ADVANCING 2 LINE DTSBR451 -00304 WRITE XEROX-T451RW FROM DTL-LINE-3 AFTER ADVANCING 1 LINE DTSBR451 -00305 WRITE XEROX-T451RW FROM DTL-LINE-4 AFTER ADVANCING 1 LINE DTSBR451 -00306 * WRITE XEROX-T451RW FROM DTL-LINE-5 AFTER ADVANCING 1 LINE DTSBR451 -00307 WRITE XEROX-T451RW FROM DTL-LINE-6 AFTER ADVANCING 1 LINE DTSBR451 -00308 WRITE XEROX-T451RW FROM DTL-LINE-7 AFTER ADVANCING 1 LINE DTSBR451 -00309 WRITE XEROX-T451RW FROM DTL-LINE-8 AFTER ADVANCING 1 LINE DTSBR451 -00310 WRITE XEROX-T451RW FROM DTL-LINE-9 AFTER ADVANCING 1 LINE DTSBR451 -00311 WRITE XEROX-T451RW FROM DTL-LINE-11 AFTER ADVANCING 2 LINE DTSBR451 -00312 WRITE XEROX-T451RW FROM DTL-LINE-12 AFTER ADVANCING 1 LINE. DTSBR451 -00313 DTSBR451 -00314 PERFORM P3000-SELF-MAILER-RTN THRU P3000-EXIT. DTSBR451 -00315 P1000-EXIT. DTSBR451 -00316 EXIT. DTSBR451 -00317 EJECT DTSBR451 -00318 P2000-REPT-HEADER-RTN. DTSBR451 -00319 *RW1 DTSBR451 -00320 * MOVE R451-EMP-NO TO BARC-EMP-NO. DTSBR451 -00321 * PERFORM S599-BARCODE THRU S599-EXIT. DTSBR451 -00322 * DTSBR451 -00323 * IF L599-SETB-FONT1 DTSBR451 -00324 * MOVE 'MODIFY=TAXSM1,' TO XEROX-CME DTSBR451 -00325 * ELSE DTSBR451 -00326 * IF L599-SETB-FONT2 DTSBR451 -00327 * MOVE 'MODIFY=TAXSM2,' TO XEROX-CME DTSBR451 +00257 * MOVE R451-RETURN-BY-DATE TO L002-DATE. DTSBR451 +00258 * PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR451 +00259 DTSBR451 +00260 PERFORM P2000-REPT-HEADER-RTN THRU P2000-EXIT. DTSBR451 +00261 DTSBR451 +00262 ** MOVE +90 TO L090-DESIRED-LINE-LIMIT. CL*16 +00263 ** MOVE +3 TO L090-PHRASE-CNT. CL*16 +00264 * MOVE MC-LIT-WAS-DUE-BY TO L090-PHRASE (1). CL**9 +00265 ** MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (1). CL*16 +00266 ** MOVE WS-LONG-TEXT-DUE-DATE TO L090-PHRASE (2). CL*16 +00267 ** MOVE SPACE TO L090-PHRASE-OVERSTRIKE-IND (2). CL*16 +00268 ** MOVE SPACES TO L090-PHRASE (2). CL*16 +00269 * STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' CL*16 +00270 ** ',' DELIMITED BY SIZE CL*16 +00271 ** INTO L090-PHRASE (2). CL*16 +00272 ** MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). CL*16 +00273 ** MOVE MC-LIT-IS-NOW-DEL TO L090-PHRASE (3). CL**9 +00274 * MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). CL*16 +00275 ** PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. CL*16 +00276 ** DISPLAY 'L90 ' L090-PARAGRAPH-LINE-CNT CL*16 +00277 ** IF (L090-UNSUCCESSFUL-88) CL*16 +00278 ** OR CL*16 +00279 * (L090-PARAGRAPH-LINE-CNT NOT = +1) CL*16 +00280 ** MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG CL*16 +00281 ** PERFORM S999-ABEND THRU S999-EXIT. CL*16 +00282 ** MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-1. CL*10 +00283 ** CL*16 +00284 * MOVE +120 TO L090-DESIRED-LINE-LIMIT. CL*16 +00285 ** MOVE +3 TO L090-PHRASE-CNT. CL*16 +00286 ** MOVE MC-LIT-NOTICE-TO-US TO L090-PHRASE (1). CL**9 +00287 ** MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (1). CL*16 +00288 ** MOVE R451-RETURN-BY-DATE TO L002-DATE. CL*16 +00289 * PERFORM S002-MIXED-CASE THRU S002-EXIT. CL*16 +00290 ** MOVE SPACES TO L090-PHRASE (2). CL*16 +00291 ** STRING L002-LONG-TEXT-AREA DELIMITED BY ' ' CL*16 +00292 ** ',' DELIMITED BY SIZE CL*16 +00293 ** INTO L090-PHRASE (2). CL*16 +00294 * MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (2). CL*16 +00295 ** MOVE MC-LIT-NOTICE-TO-US1 TO L090-PHRASE (3). CL**9 +00296 ** MOVE SPACES TO L090-PHRASE-OVERSTRIKE-IND (3). CL*16 +00297 ** PERFORM S090-PARAGRAPH-FORMAT THRU S090-EXIT. CL*16 +00298 ** DISPLAY 'L91 ' L090-PARAGRAPH-LINE-CNT CL*16 +00299 * IF (L090-UNSUCCESSFUL-88) CL*16 +00300 ** OR CL*16 +00301 ** (L090-PARAGRAPH-LINE-CNT NOT = +1) CL*16 +00302 ** MOVE 'LOGIC ERROR P1000-3' TO ABEND-MSG CL*16 +00303 ** PERFORM S999-ABEND THRU S999-EXIT. CL*16 +00304 * MOVE L090-PARAGRAPH-LINE (1) TO WS-TEXT-LINE-3. CL*16 +00305 ** CL*16 +00306 ** WRITE XEROX-T451RW FROM DTL-LINE-2 AFTER ADVANCING 2 LINE CL**9 +00307 ** WRITE XEROX-T451RW FROM DTL-LINE-3 AFTER ADVANCING 1 LINE CL**9 +00308 ** WRITE XEROX-T451RW FROM DTL-LINE-4 AFTER ADVANCING 1 LINE CL**9 +00309 * WRITE XEROX-T451RW FROM DTL-LINE-5 AFTER ADVANCING 1 LINE DTSBR451 +00310 ** WRITE XEROX-T451RW FROM DTL-LINE-6 AFTER ADVANCING 1 LINE CL**9 +00311 ** WRITE XEROX-T451RW FROM DTL-LINE-7 AFTER ADVANCING 1 LINE CL**9 +00312 ** WRITE XEROX-T451RW FROM DTL-LINE-8 AFTER ADVANCING 1 LINE CL**9 +00313 ** WRITE XEROX-T451RW FROM DTL-LINE-9 AFTER ADVANCING 1 LINE CL**9 +00314 ** WRITE XEROX-T451RW FROM DTL-LINE-11 AFTER ADVANCING 2 LINE CL**9 +00315 ** WRITE XEROX-T451RW FROM DTL-LINE-12 AFTER ADVANCING 1 LINE. CL**9 +00316 DTSBR451 +00317 PERFORM P3000-SELF-MAILER-RTN THRU P3000-EXIT. DTSBR451 +00318 P1000-EXIT. DTSBR451 +00319 EXIT. DTSBR451 +00320 EJECT DTSBR451 +00321 P2000-REPT-HEADER-RTN. DTSBR451 +00322 *RW1 DTSBR451 +00323 * MOVE R451-EMP-NO TO BARC-EMP-NO. DTSBR451 +00324 * PERFORM S599-BARCODE THRU S599-EXIT. DTSBR451 +00325 * DTSBR451 +00326 * IF L599-SETB-FONT1 DTSBR451 +00327 * MOVE 'MODIFY=TAXSM1,' TO XEROX-CME DTSBR451 00328 * ELSE DTSBR451 -00329 * MOVE 'MODIFY=TAXSM1,' TO XEROX-CME. DTSBR451 -00330 DTSBR451 -00331 WRITE XEROX-T451RW FROM XEROX-CNTL-LINE18 DTSBR451 -00332 AFTER ADVANCING TOP-OF-PAGE. DTSBR451 -00333 WRITE XEROX-T451RW FROM XEROX-CNTL-LINE20. DTSBR451 -00334 WRITE XEROX-T451RW FROM VSCA-LINE AFTER 5 LINE. DTSBR451 -00335 DTSBR451 -00336 WRITE XEROX-T451RW FROM HDR-LINE-10 AFTER 5 LINE. DTSBR451 -00337 WRITE XEROX-T451RW FROM HDR-LINE-11 AFTER 2 LINE. DTSBR451 -00338 WRITE XEROX-T451RW FROM HDR-LINE-12 AFTER 1 LINE. DTSBR451 -00339 WRITE XEROX-T451RW FROM HDR-LINE-13 AFTER 1 LINE. DTSBR451 -00340 WRITE XEROX-T451RW FROM HDR-LINE-14 AFTER 1 LINE. DTSBR451 -00341 WRITE XEROX-T451RW FROM HDR-LINE-15 AFTER 1 LINE. DTSBR451 -00342 WRITE XEROX-T451RW FROM HDR-LINE-16 AFTER 2 LINE. DTSBR451 -00343 P2000-EXIT. DTSBR451 -00344 EXIT. DTSBR451 -00345 EJECT DTSBR451 -00346 P3000-SELF-MAILER-RTN. DTSBR451 -00347 *RW1 DTSBR451 -00348 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR451 -00349 WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 -00350 AFTER ADVANCING TOP-OF-PAGE. DTSBR451 -00351 * WRITE XEROX-T451RW FROM WS-BARC-LINE AFTER 04. DTSBR451 -00352 * DTSBR451 -00353 WRITE XEROX-T451RW FROM VSCA-LINE AFTER ADVANCING 16 LINE. DTSBR451 -00354 * WRITE XEROX-T451RW FROM MAIL-ADDR1 AFTER ADVANCING 6 LINE. DTSBR451 -00355 WRITE XEROX-T451RW FROM MAIL-ADDR1 AFTER 1 LINE. DTSBR451 -00356 *RW2 DTSBR451 -00357 WRITE XEROX-T451RW FROM MAIL-ADDR2 AFTER 1 LINE. DTSBR451 -00358 WRITE XEROX-T451RW FROM MAIL-ADDR3 AFTER 1 LINE. DTSBR451 -00359 WRITE XEROX-T451RW FROM MAIL-ADDR4 AFTER 1 LINE. DTSBR451 -00360 WRITE XEROX-T451RW FROM MAIL-ADDR5 AFTER 1 LINE. DTSBR451 -00361 DTSBR451 -00362 P3000-EXIT. DTSBR451 -00363 EXIT. DTSBR451 -00364 EJECT DTSBR451 +00329 * IF L599-SETB-FONT2 DTSBR451 +00330 * MOVE 'MODIFY=TAXSM2,' TO XEROX-CME DTSBR451 +00331 * ELSE DTSBR451 +00332 * MOVE 'MODIFY=TAXSM1,' TO XEROX-CME. DTSBR451 +00333 DTSBR451 +00334 WRITE XEROX-T451RW FROM XEROX-CNTL-LINE18 DTSBR451 +00335 AFTER ADVANCING TOP-OF-PAGE. DTSBR451 +00336 WRITE XEROX-T451RW FROM XEROX-CNTL-LINE20. DTSBR451 +00337 WRITE XEROX-T451RW FROM VSCA-LINE AFTER 6 LINE. CL*19 +00338 DTSBR451 +00339 * WRITE XEROX-T451RW FROM HDR-LINE-10 AFTER 5 LINE. CL**4 +00340 WRITE XEROX-T451RW FROM HDR-LINE-10 AFTER 4 LINE. CL*21 +00341 WRITE XEROX-T451RW FROM HDR-LINE-11 AFTER 2 LINE. CL*13 +00342 WRITE XEROX-T451RW FROM HDR-LINE-12 AFTER 1 LINE. CL*13 +00343 WRITE XEROX-T451RW FROM HDR-LINE-13 AFTER 1 LINE. CL*13 +00344 WRITE XEROX-T451RW FROM HDR-LINE-14 AFTER 1 LINE. CL*13 +00345 WRITE XEROX-T451RW FROM HDR-LINE-15 AFTER 1 LINE. CL*13 +00346 WRITE XEROX-T451RW FROM HDR-LINE-16 AFTER 2 LINE. CL*13 +00347 P2000-EXIT. DTSBR451 +00348 EXIT. DTSBR451 +00349 EJECT DTSBR451 +00350 P3000-SELF-MAILER-RTN. DTSBR451 +00351 *RW1 DTSBR451 +00352 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR451 +00353 WRITE XEROX-T451RW FROM BLANK-LINE DTSBR451 +00354 AFTER ADVANCING TOP-OF-PAGE. DTSBR451 +00355 * WRITE XEROX-T451RW FROM WS-BARC-LINE AFTER 04. DTSBR451 +00356 * DTSBR451 +00357 WRITE XEROX-T451RW FROM VSCA-LINE AFTER ADVANCING 16 LINE. DTSBR451 +00358 * WRITE XEROX-T451RW FROM MAIL-ADDR1 AFTER ADVANCING 6 LINE. DTSBR451 +00359 WRITE XEROX-T451RW FROM MAIL-ADDR1 AFTER 1 LINE. DTSBR451 +00360 *RW2 DTSBR451 +00361 WRITE XEROX-T451RW FROM MAIL-ADDR2 AFTER 1 LINE. DTSBR451 +00362 WRITE XEROX-T451RW FROM MAIL-ADDR3 AFTER 1 LINE. DTSBR451 +00363 WRITE XEROX-T451RW FROM MAIL-ADDR4 AFTER 1 LINE. DTSBR451 +00364 WRITE XEROX-T451RW FROM MAIL-ADDR5 AFTER 1 LINE. DTSBR451 00365 DTSBR451 -00366 DTSBR451 -00367 T1000-TERMINATE. DTSBR451 -00368 CLOSE PRT-FILE. DTSBR451 -00369 T1000-EXIT. DTSBR451 -00370 EXIT. DTSBR451 -00371 EJECT DTSBR451 -00372 S001-FROM-FED-8. DTSBR451 -00373 SET L001-FROM-FED-8 TO TRUE. DTSBR451 -00374 GO TO S001-DATE. DTSBR451 -00375 DTSBR451 -00376 S001-DATE. DTSBR451 -00377 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR451 -00378 S001-EXIT. DTSBR451 -00379 EXIT. DTSBR451 -00380 SKIP3 DTSBR451 -00381 S002-UPPER-CASE. DTSBR451 -00382 SET L002-UPPER-CASE TO TRUE. DTSBR451 -00383 GO TO S002-DATE-ALPHA. DTSBR451 -00384 DTSBR451 -00385 S002-MIXED-CASE. DTSBR451 -00386 SET L002-MIXED-CASE TO TRUE. DTSBR451 +00366 P3000-EXIT. DTSBR451 +00367 EXIT. DTSBR451 +00368 EJECT DTSBR451 +00369 DTSBR451 +00370 DTSBR451 +00371 T1000-TERMINATE. DTSBR451 +00372 CLOSE PRT-FILE. DTSBR451 +00373 T1000-EXIT. DTSBR451 +00374 EXIT. DTSBR451 +00375 EJECT DTSBR451 +00376 S001-FROM-FED-8. DTSBR451 +00377 SET L001-FROM-FED-8 TO TRUE. DTSBR451 +00378 GO TO S001-DATE. DTSBR451 +00379 DTSBR451 +00380 S001-DATE. DTSBR451 +00381 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR451 +00382 S001-EXIT. DTSBR451 +00383 EXIT. DTSBR451 +00384 SKIP3 DTSBR451 +00385 S002-UPPER-CASE. DTSBR451 +00386 SET L002-UPPER-CASE TO TRUE. DTSBR451 00387 GO TO S002-DATE-ALPHA. DTSBR451 00388 DTSBR451 -00389 S002-DATE-ALPHA. DTSBR451 -00390 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR451 -00391 S002-EXIT. DTSBR451 -00392 EXIT. DTSBR451 -00393 SKIP3 DTSBR451 -00394 S004-FROM-5. DTSBR451 -00395 SET L004-FROM-5 TO TRUE. DTSBR451 -00396 GO TO S004-QUARTER. DTSBR451 -00397 DTSBR451 -00398 S004-QUARTER. DTSBR451 -00399 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR451 -00400 S004-EXIT. DTSBR451 -00401 EXIT. DTSBR451 -00402 SKIP3 DTSBR451 -00403 S008-UPPER-CASE. DTSBR451 -00404 SET L008-UPPER-CASE TO TRUE. DTSBR451 -00405 GO TO S008-QUARTER-ALPHA. DTSBR451 -00406 DTSBR451 -00407 S008-MIXED-CASE. DTSBR451 -00408 SET L008-MIXED-CASE TO TRUE. DTSBR451 +00389 S002-MIXED-CASE. DTSBR451 +00390 SET L002-MIXED-CASE TO TRUE. DTSBR451 +00391 GO TO S002-DATE-ALPHA. DTSBR451 +00392 DTSBR451 +00393 S002-DATE-ALPHA. DTSBR451 +00394 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR451 +00395 S002-EXIT. DTSBR451 +00396 EXIT. DTSBR451 +00397 SKIP3 DTSBR451 +00398 S004-FROM-5. DTSBR451 +00399 SET L004-FROM-5 TO TRUE. DTSBR451 +00400 GO TO S004-QUARTER. DTSBR451 +00401 DTSBR451 +00402 S004-QUARTER. DTSBR451 +00403 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR451 +00404 S004-EXIT. DTSBR451 +00405 EXIT. DTSBR451 +00406 SKIP3 DTSBR451 +00407 S008-UPPER-CASE. DTSBR451 +00408 SET L008-UPPER-CASE TO TRUE. DTSBR451 00409 GO TO S008-QUARTER-ALPHA. DTSBR451 00410 DTSBR451 -00411 S008-QUARTER-ALPHA. DTSBR451 -00412 CALL 'DTSBU008' USING L008-LINK-AREA. DTSBR451 -00413 S008-EXIT. DTSBR451 -00414 EXIT. DTSBR451 -00415 SKIP3 DTSBR451 -00416 S056-DISP1-LEFT-PCT. DTSBR451 -00417 SET L056-DISP1-LEFT-PCT-88 TO TRUE. DTSBR451 -00418 GO TO S056-RATE-DISPLAY. DTSBR451 -00419 DTSBR451 -00420 S056-RATE-DISPLAY. DTSBR451 -00421 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR451 -00422 S056-EXIT. DTSBR451 -00423 EXIT. DTSBR451 -00424 SKIP3 DTSBR451 -00425 S090-PARAGRAPH-FORMAT. DTSBR451 -00426 MOVE +0 TO L090-INDENT. DTSBR451 -00427 SET L090-SPECIAL-CHAR-STD-88 TO TRUE. DTSBR451 -00428 DTSBR451 -00429 CALL 'DTSBU090' USING L090-LINK-AREA. DTSBR451 -00430 S090-EXIT. DTSBR451 -00431 EXIT. DTSBR451 -00432 SKIP3 DTSBR451 -00433 S119-REQ-CAPS. DTSBR451 -00434 SET L119-REQ-CAPS-88 TO TRUE. DTSBR451 -00435 GO TO S119-AGENCY-FACTS. DTSBR451 -00436 DTSBR451 -00437 S119-REQ-MIXED. DTSBR451 -00438 SET L119-REQ-MIXED-88 TO TRUE. DTSBR451 +00411 S008-MIXED-CASE. DTSBR451 +00412 SET L008-MIXED-CASE TO TRUE. DTSBR451 +00413 GO TO S008-QUARTER-ALPHA. DTSBR451 +00414 DTSBR451 +00415 S008-QUARTER-ALPHA. DTSBR451 +00416 CALL 'DTSBU008' USING L008-LINK-AREA. DTSBR451 +00417 S008-EXIT. DTSBR451 +00418 EXIT. DTSBR451 +00419 SKIP3 DTSBR451 +00420 S056-DISP1-LEFT-PCT. DTSBR451 +00421 SET L056-DISP1-LEFT-PCT-88 TO TRUE. DTSBR451 +00422 GO TO S056-RATE-DISPLAY. DTSBR451 +00423 DTSBR451 +00424 S056-RATE-DISPLAY. DTSBR451 +00425 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR451 +00426 S056-EXIT. DTSBR451 +00427 EXIT. DTSBR451 +00428 SKIP3 DTSBR451 +00429 S090-PARAGRAPH-FORMAT. DTSBR451 +00430 MOVE +0 TO L090-INDENT. DTSBR451 +00431 SET L090-SPECIAL-CHAR-STD-88 TO TRUE. DTSBR451 +00432 DTSBR451 +00433 CALL 'DTSBU090' USING L090-LINK-AREA. DTSBR451 +00434 S090-EXIT. DTSBR451 +00435 EXIT. DTSBR451 +00436 SKIP3 DTSBR451 +00437 S119-REQ-CAPS. DTSBR451 +00438 SET L119-REQ-CAPS-88 TO TRUE. DTSBR451 00439 GO TO S119-AGENCY-FACTS. DTSBR451 00440 DTSBR451 -00441 S119-AGENCY-FACTS. DTSBR451 -00442 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR451 -00443 S119-EXIT. DTSBR451 -00444 EXIT. DTSBR451 -00445 SKIP3 DTSBR451 -00446 S599-BARCODE. DTSBR451 -00447 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR451 -00448 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR451 -00449 MOVE 'TAX' TO L599-SYSTEM. DTSBR451 -00450 DTSBR451 -00451 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR451 -00452 DTSBR451 -00453 IF L599-NOT-CONVERTED DTSBR451 -00454 PERFORM S999-ABEND THRU S999-EXIT. DTSBR451 -00455 S599-EXIT. DTSBR451 -00456 EXIT. DTSBR451 -00457 SKIP3 DTSBR451 -00458 S999-ABEND. DTSBR451 -00459 DISPLAY '***'. DTSBR451 -00460 DISPLAY '*** ' DTSBR451 -00461 ABEND-MSG. DTSBR451 -00462 DISPLAY '***'. DTSBR451 -00463 DTSBR451 -00464 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR451 -00465 S999-EXIT. DTSBR451 -00466 EXIT. DTSBR451 +00441 S119-REQ-MIXED. DTSBR451 +00442 SET L119-REQ-MIXED-88 TO TRUE. DTSBR451 +00443 GO TO S119-AGENCY-FACTS. DTSBR451 +00444 DTSBR451 +00445 S119-AGENCY-FACTS. DTSBR451 +00446 CALL 'DTSBU119' USING L119-LINK-AREA. DTSBR451 +00447 S119-EXIT. DTSBR451 +00448 EXIT. DTSBR451 +00449 SKIP3 DTSBR451 +00450 S599-BARCODE. DTSBR451 +00451 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR451 +00452 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR451 +00453 MOVE 'TAX' TO L599-SYSTEM. DTSBR451 +00454 DTSBR451 +00455 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR451 +00456 DTSBR451 +00457 IF L599-NOT-CONVERTED DTSBR451 +00458 PERFORM S999-ABEND THRU S999-EXIT. DTSBR451 +00459 S599-EXIT. DTSBR451 +00460 EXIT. DTSBR451 +00461 SKIP3 DTSBR451 +00462 S999-ABEND. DTSBR451 +00463 DISPLAY '***'. DTSBR451 +00464 DISPLAY '*** ' DTSBR451 +00465 ABEND-MSG. DTSBR451 +00466 DISPLAY '***'. DTSBR451 00467 DTSBR451 +00468 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR451 +00469 S999-EXIT. DTSBR451 +00470 EXIT. DTSBR451 +00471 DTSBR451 diff --git a/Batch/DTSBR503.cob b/Batch/DTSBR503.cob index 3aaebc6..cf2f068 100644 --- a/Batch/DTSBR503.cob +++ b/Batch/DTSBR503.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 12/13/13 +00001 IDENTIFICATION DIVISION. 08/06/19 00002 PROGRAM-ID. DTSBR503. DTSBR503 -00003 AUTHOR. BDM. LV212 +00003 AUTHOR. BDM. LV019 00004 DTSBR503 00005 ***** DTSBR503 00006 * DTSBR503 @@ -26,420 +26,489 @@ 00026 * 04-16-08 MODIFIED TO INCLUDE MINUS SIGN ON COMPENSATION. DTSBR503 00027 * REFERENCE AUTHOR OF CHANGE - ZL1. DTSBR503 00028 * DTSBR503 -00029 * XX-XX-XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR503 -00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR503 -00031 * DTSBR503 -00032 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR503 -00033 ***** DTSBR503 -00034 ENVIRONMENT DIVISION. DTSBR503 -00035 CONFIGURATION SECTION. DTSBR503 -00036 SPECIAL-NAMES. DTSBR503 -00037 C01 IS TOP-OF-PAGE. DTSBR503 -00038 INPUT-OUTPUT SECTION. DTSBR503 -00039 FILE-CONTROL. DTSBR503 -00040 SELECT PRT-FILE1 ASSIGN TO RPT503R1. DTSBR503 -00041 SELECT PRT-FILE2 ASSIGN TO RPT503R2. DTSBR503 -00042 DATA DIVISION. DTSBR503 -00043 FILE SECTION. DTSBR503 -00044 DTSBR503 -00045 FD PRT-FILE1 DTSBR503 -00046 RECORDING MODE IS F DTSBR503 -00047 LABEL RECORDS ARE OMITTED. DTSBR503 -00048 DTSBR503 -00049 01 PRT-R632-REC PIC X(133). DTSBR503 +00029 * CL*12 +00030 * 07-11-19 MODIFIED TO CREATE RATE FILE FOR ESSP. CL*12 +00031 * REFERENCE AUTHOR OF CHANGE - ZL1. CL*12 +00032 * CL*12 +00033 * CL**6 +00034 * XX-XX-XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR503 +00035 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR503 +00036 * DTSBR503 +00037 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR503 +00038 ***** DTSBR503 +00039 ENVIRONMENT DIVISION. DTSBR503 +00040 CONFIGURATION SECTION. DTSBR503 +00041 SPECIAL-NAMES. DTSBR503 +00042 C01 IS TOP-OF-PAGE. DTSBR503 +00043 INPUT-OUTPUT SECTION. DTSBR503 +00044 FILE-CONTROL. DTSBR503 +00045 SELECT PRT-FILE1 ASSIGN TO RPT503R1. DTSBR503 +00046 SELECT PRT-FILE2 ASSIGN TO RPT503R2. DTSBR503 +00047 SELECT PRT-FILE3 ASSIGN TO RPT503R3. CL**5 +00048 DATA DIVISION. DTSBR503 +00049 FILE SECTION. DTSBR503 00050 DTSBR503 -00051 FD PRT-FILE2 DTSBR503 +00051 FD PRT-FILE1 DTSBR503 00052 RECORDING MODE IS F DTSBR503 00053 LABEL RECORDS ARE OMITTED. DTSBR503 00054 DTSBR503 -00055 01 PRT-R632A-REC PIC X(133). DTSBR503 +00055 01 PRT-R632-REC PIC X(133). DTSBR503 00056 DTSBR503 -00057 WORKING-STORAGE SECTION. DTSBR503 -000575 77 PAN-VALET PICTURE X(24) VALUE '212DTSBR503 12/13/13'. DTSBR503 -00058 77 PAN-VALET PICTURE X(24) VALUE '002DTSBR503 12/13/13'. DTSBR503 -00059 77 PAN-VALET PICTURE X(24) VALUE '210DTSBR503 07/22/12'. DTSBR503 +00057 FD PRT-FILE2 DTSBR503 +00058 RECORDING MODE IS F DTSBR503 +00059 LABEL RECORDS ARE OMITTED. DTSBR503 00060 DTSBR503 -00061 01 VSCA-ADDRESS-LINE. DTSBR503 -00062 03 VSCA-DATA. DTSBR503 -00063 05 PRT1 PIC X(132) VALUE SPACES. DTSBR503 -00064 03 FILLER PIC X VALUE '1'. DTSBR503 -00065 DTSBR503 -00066 01 VSCA-LINE PIC X(133) VALUE SPACES. DTSBR503 -00067 01 WS-REC PIC X(132) VALUE SPACES. DTSBR503 -00068 01 BLANK-LINE PIC X(133) VALUE SPACES. DTSBR503 -00069 01 WRK-DATE PIC 9(08) VALUE ZEROS. DTSBR503 -00070 01 WRK-DATE-Z REDEFINES WRK-DATE. DTSBR503 -00071 05 WRK-YR PIC 9(04). DTSBR503 -00072 05 WRK-MM PIC 9(02). DTSBR503 -00073 05 WRK-DA PIC 9(02). DTSBR503 -00074 01 WRK-AREA. DTSBR503 -00075 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR503 -00076 05 WS-503R2-RECORDS PIC X(01) VALUE 'Y'. DTSBR503 -00077 88 WS-503R2-RECORDS-88 VALUE 'Y'. DTSBR503 +00061 01 PRT-R632A-REC PIC X(133). DTSBR503 +00062 DTSBR503 +00063 FD PRT-FILE3 CL**4 +00064 RECORDING MODE IS F CL**4 +00065 LABEL RECORDS ARE OMITTED. CL**4 +00066 CL**4 +00067 01 PRT-X108-REC PIC X(24). CL**6 +00068 CL**6 +00069 WORKING-STORAGE SECTION. DTSBR503 +000695 77 PAN-VALET PICTURE X(24) VALUE '019DTSBR503 08/06/19'. DTSBR503 +00070 77 PAN-VALET PICTURE X(24) VALUE '212DTSBR503 12/13/13'. DTSBR503 +00071 77 PAN-VALET PICTURE X(24) VALUE '002DTSBR503 12/13/13'. DTSBR503 +00072 77 PAN-VALET PICTURE X(24) VALUE '210DTSBR503 07/22/12'. DTSBR503 +00073 DTSBR503 +00074 01 VSCA-ADDRESS-LINE. DTSBR503 +00075 03 VSCA-DATA. DTSBR503 +00076 05 PRT1 PIC X(132) VALUE SPACES. DTSBR503 +00077 03 FILLER PIC X VALUE '1'. DTSBR503 00078 DTSBR503 -00079 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +503.DTSBR503 -00080 05 ABEND-MSG PIC X(60). DTSBR503 -00081 DTSBR503 -00082 01 WS-TEMPS. DTSBR503 -00083 05 WT-RATIO PIC S99V9(05). DTSBR503 -00084 05 WTC-RATE PIC S9V9999. DTSBR503 -00085 DTSBR503 -00086 01 632-DATE-LINE. DTSBR503 -00087 03 FILLER PIC X(86) VALUE SPACES. DTSBR503 -00088 03 DATE-632. DTSBR503 -00089 05 DATE-632-MM PIC 99. DTSBR503 -00090 05 FILLER PIC X VALUE '/'. DTSBR503 -00091 05 DATE-632-DA PIC 99. DTSBR503 -00092 05 FILLER PIC X VALUE '/'. DTSBR503 -00093 05 DATE-632-YY PIC 9999. DTSBR503 +00079 01 VSCA-LINE PIC X(133) VALUE SPACES. DTSBR503 +00080 01 WS-REC PIC X(132) VALUE SPACES. DTSBR503 +00081 01 BLANK-LINE PIC X(133) VALUE SPACES. DTSBR503 +00082 01 WRK-DATE PIC 9(08) VALUE ZEROS. DTSBR503 +00083 01 WRK-DATE-Z REDEFINES WRK-DATE. DTSBR503 +00084 05 WRK-YR PIC 9(04). DTSBR503 +00085 05 WRK-MM PIC 9(02). DTSBR503 +00086 05 WRK-DA PIC 9(02). DTSBR503 +00087 01 WRK-AREA. DTSBR503 +00088 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR503 +00089 05 WS-503R2-RECORDS PIC X(01) VALUE 'Y'. DTSBR503 +00090 88 WS-503R2-RECORDS-88 VALUE 'Y'. DTSBR503 +00091 DTSBR503 +00092 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +503.DTSBR503 +00093 05 ABEND-MSG PIC X(60). DTSBR503 00094 DTSBR503 -00095 01 632A-DATE-LINE. DTSBR503 -00096 03 FILLER PIC X(86) VALUE SPACES. DTSBR503 -00097 03 DATE-632A. DTSBR503 -00098 05 DATE-632-MMA PIC 99. DTSBR503 -00099 05 FILLER PIC X VALUE '/'. DTSBR503 -00100 05 DATE-632-DAA PIC 99. DTSBR503 -00101 05 FILLER PIC X VALUE '/'. DTSBR503 -00102 05 DATE-632-YYA PIC 9999. DTSBR503 -00103 DTSBR503 -00104 01 632-DETAIL-LINE1. DTSBR503 -00105 03 FILLER PIC X. DTSBR503 -00106 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 -00107 03 ACCOUNT PIC 999B999. DTSBR503 -00108 03 FILLER PIC X(09) VALUE SPACES. DTSBR503 -00109 03 RATE1 PIC X(07). DTSBR503 -00110 03 FILLER PIC X(21) VALUE SPACES. DTSBR503 -00111 03 ONLY-YR PIC X(4). DTSBR503 -00112 03 FILLER PIC X(08) VALUE SPACES. DTSBR503 -00113 03 COMPDTE PIC 99/99/9999. DTSBR503 -00114 03 FILLER PIC X(1) VALUE SPACES. DTSBR503 -00115 03 AAPAY PIC $$$,$$$,$$9.99. DTSBR503 -00116 03 FILLER PIC X(05) VALUE SPACES. DTSBR503 -00117 03 RESRATIO PIC X(05). DTSBR503 -00118 03 PER-CENT PIC X(01) VALUE '%'. DTSBR503 -00119 DTSBR503 -00120 01 632-DETAIL-LINE2. DTSBR503 -00121 03 FILLER PIC X(01) VALUE SPACES. DTSBR503 -00122 03 PREVIOUS PIC $$$$,$$$,$$9.99-. DTSBR503 -00123 03 FILLER PIC X(5) VALUE SPACES. DTSBR503 -00124 03 TRUST PIC $$,$$$,$$9.99. DTSBR503 -00125 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 -00126 03 CONTRIBUTION PIC $$$,$$$,$$9.99-. DTSBR503 -00127 03 FILLER PIC X(07) VALUE SPACES. DTSBR503 -00128 03 BENEFITS PIC $$$$,$$$,$$9.99-. DTSBR503 -00129 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 -00130 03 CURRENT-RESV PIC $$$$,$$$,$$9.99-. DTSBR503 -00131 DTSBR503 -00132 01 632-DETAIL-LINE3. DTSBR503 -00133 03 FILLER PIC X(94) VALUE SPACES. DTSBR503 -00134 03 RPT-TABLE PIC X(5) VALUE SPACES. DTSBR503 -00135 03 FILLER PIC X(35) VALUE SPACES. DTSBR503 -00136 DTSBR503 -00137 01 632A-DETAIL-LINE1. DTSBR503 -00138 03 FILLER PIC X. DTSBR503 -00139 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 -00140 03 UNACCT PIC 999B999. DTSBR503 -00141 03 FILLER PIC X(15) VALUE SPACES. DTSBR503 -00142 03 RATE PIC X(07). DTSBR503 -00143 03 FILLER PIC X(33) VALUE SPACES. DTSBR503 -00144 03 UNONLY PIC X(4). DTSBR503 -00145 03 FILLER PIC X(14) VALUE SPACES. DTSBR503 -00146 03 UNCOMPDTE PIC 99/99/9999. DTSBR503 -00147 DTSBR503 -00148 01 632A-DETAIL-LINE2. DTSBR503 -00149 03 FILLER PIC X(2) VALUE SPACES. DTSBR503 -00150 03 UNPREV PIC $$$,$$$,$$9.99-. DTSBR503 -00151 03 FILLER PIC X(5) VALUE SPACES. DTSBR503 -00152 03 UNTRUST PIC $$$,$$$,$$9.99. DTSBR503 -00153 03 FILLER PIC X(6) VALUE SPACES. DTSBR503 -00154 03 UNCONT PIC $$$,$$$,$$9.99-. DTSBR503 -00155 03 FILLER PIC X(6) VALUE SPACES. DTSBR503 -00156 03 BCHARGED PIC $$$,$$$,$$9.99-. DTSBR503 -00157 03 FILLER PIC X(5) VALUE SPACES. DTSBR503 -00158 03 UNCURR PIC $$$,$$$,$$9.99-. DTSBR503 -00159 DTSBR503 -00160 EJECT DTSBR503 -00161 01 L001-LINK-AREA. DTSBR503 -00162 ++INCLUDE DTSIL001 DTSBR503 -00163 EJECT DTSBR503 -00164 01 L056-LINK-AREA. DTSBR503 -00165 ++INCLUDE DTSIL056 DTSBR503 -00166 EJECT DTSBR503 -00167 DTSBR503 -00168 01 L057-LINK-AREA. DTSBR503 -00169 ++INCLUDE DTSIL057 DTSBR503 -00170 EJECT DTSBR503 -00171 DTSBR503 -00172 ++INCLUDE DTSXL503 DTSBR503 -00173 EJECT DTSBR503 -00174 *RW1 DTSBR503 -00175 01 CONVERT-BARCODE-LINE. DTSBR503 -00176 05 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR503 -00177 DTSBR503 -00178 01 WS-BARC-LINE. DTSBR503 -00179 05 FILLER PIC X(40) VALUE SPACES. DTSBR503 -00180 05 CONVERTED-BARCODE PIC X(50). DTSBR503 -00181 05 FILLER PIC X(30) VALUE SPACES. DTSBR503 -00182 DTSBR503 -00183 01 BARI-LINK-AREA. DTSBR503 -00184 ++INCLUDE BARIL599 DTSBR503 -00185 EJECT DTSBR503 -00186 *RW2 DTSBR503 -00187 LINKAGE SECTION. DTSBR503 -00188 SKIP3 DTSBR503 -00189 01 LRCM-LINK-AREA. DTSBR503 -00190 ++INCLUDE DTSILRCM DTSBR503 +00095 01 WS-TEMPS. DTSBR503 +00096 05 WT-RATIO PIC S99V9(05). DTSBR503 +00097 05 WTC-RATE PIC S9V9999. DTSBR503 +00098 DTSBR503 +00099 01 632-DATE-LINE. DTSBR503 +00100 03 FILLER PIC X(86) VALUE SPACES. DTSBR503 +00101 03 DATE-632. DTSBR503 +00102 05 DATE-632-MM PIC 99. DTSBR503 +00103 05 FILLER PIC X VALUE '/'. DTSBR503 +00104 05 DATE-632-DA PIC 99. DTSBR503 +00105 05 FILLER PIC X VALUE '/'. DTSBR503 +00106 05 DATE-632-YY PIC 9999. DTSBR503 +00107 DTSBR503 +00108 01 632A-DATE-LINE. DTSBR503 +00109 03 FILLER PIC X(86) VALUE SPACES. DTSBR503 +00110 03 DATE-632A. DTSBR503 +00111 05 DATE-632-MMA PIC 99. DTSBR503 +00112 05 FILLER PIC X VALUE '/'. DTSBR503 +00113 05 DATE-632-DAA PIC 99. DTSBR503 +00114 05 FILLER PIC X VALUE '/'. DTSBR503 +00115 05 DATE-632-YYA PIC 9999. DTSBR503 +00116 DTSBR503 +00117 01 632-DETAIL-LINE1. DTSBR503 +00118 03 FILLER PIC X. DTSBR503 +00119 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 +00120 03 ACCOUNT PIC 999B999. DTSBR503 +00121 03 FILLER PIC X(09) VALUE SPACES. DTSBR503 +00122 03 RATE1 PIC X(07). DTSBR503 +00123 03 FILLER PIC X(21) VALUE SPACES. DTSBR503 +00124 03 ONLY-YR PIC X(4). DTSBR503 +00125 03 FILLER PIC X(08) VALUE SPACES. DTSBR503 +00126 03 COMPDTE PIC 99/99/9999. DTSBR503 +00127 03 FILLER PIC X(1) VALUE SPACES. DTSBR503 +00128 03 AAPAY PIC $$$,$$$,$$9.99. DTSBR503 +00129 03 FILLER PIC X(05) VALUE SPACES. DTSBR503 +00130 03 RESRATIO PIC X(05). DTSBR503 +00131 03 PER-CENT PIC X(01) VALUE '%'. DTSBR503 +00132 DTSBR503 +00133 01 632-DETAIL-LINE2. DTSBR503 +00134 03 FILLER PIC X(01) VALUE SPACES. DTSBR503 +00135 03 PREVIOUS PIC $$$$,$$$,$$9.99-. DTSBR503 +00136 03 FILLER PIC X(5) VALUE SPACES. DTSBR503 +00137 03 TRUST PIC $$,$$$,$$9.99. DTSBR503 +00138 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 +00139 03 CONTRIBUTION PIC $$$,$$$,$$9.99-. DTSBR503 +00140 03 FILLER PIC X(07) VALUE SPACES. DTSBR503 +00141 03 BENEFITS PIC $$$$,$$$,$$9.99-. DTSBR503 +00142 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 +00143 03 CURRENT-RESV PIC $$$$,$$$,$$9.99-. DTSBR503 +00144 DTSBR503 +00145 01 632-DETAIL-LINE3. DTSBR503 +00146 03 FILLER PIC X(94) VALUE SPACES. DTSBR503 +00147 03 RPT-TABLE PIC X(5) VALUE SPACES. DTSBR503 +00148 03 FILLER PIC X(35) VALUE SPACES. DTSBR503 +00149 DTSBR503 +00150 01 632A-DETAIL-LINE1. DTSBR503 +00151 03 FILLER PIC X. DTSBR503 +00152 03 FILLER PIC X(06) VALUE SPACES. DTSBR503 +00153 03 UNACCT PIC 999B999. DTSBR503 +00154 03 FILLER PIC X(15) VALUE SPACES. DTSBR503 +00155 03 RATE PIC X(07). DTSBR503 +00156 03 FILLER PIC X(33) VALUE SPACES. DTSBR503 +00157 03 UNONLY PIC X(4). DTSBR503 +00158 03 FILLER PIC X(14) VALUE SPACES. DTSBR503 +00159 03 UNCOMPDTE PIC 99/99/9999. DTSBR503 +00160 DTSBR503 +00161 01 632A-DETAIL-LINE2. DTSBR503 +00162 03 FILLER PIC X(2) VALUE SPACES. DTSBR503 +00163 03 UNPREV PIC $$$,$$$,$$9.99-. DTSBR503 +00164 03 FILLER PIC X(5) VALUE SPACES. DTSBR503 +00165 03 UNTRUST PIC $$$,$$$,$$9.99. DTSBR503 +00166 03 FILLER PIC X(6) VALUE SPACES. DTSBR503 +00167 03 UNCONT PIC $$$,$$$,$$9.99-. DTSBR503 +00168 03 FILLER PIC X(6) VALUE SPACES. DTSBR503 +00169 03 BCHARGED PIC $$$,$$$,$$9.99-. DTSBR503 +00170 03 FILLER PIC X(5) VALUE SPACES. DTSBR503 +00171 03 UNCURR PIC $$$,$$$,$$9.99-. DTSBR503 +00172 DTSBR503 +00173 01 X108-REC. CL*12 +00174 ++INCLUDE DTSIX108 CL*12 +00175 EJECT DTSBR503 +00176 01 L001-LINK-AREA. DTSBR503 +00177 ++INCLUDE DTSIL001 DTSBR503 +00178 EJECT DTSBR503 +00179 01 L009-LINK-AREA. CL**3 +00180 ++INCLUDE DTSIL009 CL**3 +00181 EJECT CL**3 +00182 01 L056-LINK-AREA. DTSBR503 +00183 ++INCLUDE DTSIL056 DTSBR503 +00184 EJECT DTSBR503 +00185 DTSBR503 +00186 01 L057-LINK-AREA. DTSBR503 +00187 ++INCLUDE DTSIL057 DTSBR503 +00188 EJECT DTSBR503 +00189 DTSBR503 +00190 ++INCLUDE DTSXL503 DTSBR503 00191 EJECT DTSBR503 -00192 01 R503-REC. DTSBR503 -00193 ++INCLUDE DTSIR503 DTSBR503 -00194 EJECT DTSBR503 -00195 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR503 -00196 R503-REC. DTSBR503 -00197 DTSBR503 -00198 IF FIRST-TIME-IND = 'Y' DTSBR503 -00199 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR503 -00200 MOVE 'N' TO FIRST-TIME-IND. DTSBR503 -00201 DTSBR503 -00202 IF LRCM-EOR-88 DTSBR503 -00203 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR503 -00204 ELSE DTSBR503 -00205 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR503 -00206 GOBACK. DTSBR503 -00207 DTSBR503 -00208 EXIT. DTSBR503 +00192 *RW1 DTSBR503 +00193 01 CONVERT-BARCODE-LINE. DTSBR503 +00194 05 BARC-EMP-NO PIC 9(06) VALUE ZEROS. DTSBR503 +00195 DTSBR503 +00196 01 WS-BARC-LINE. DTSBR503 +00197 05 FILLER PIC X(40) VALUE SPACES. DTSBR503 +00198 05 CONVERTED-BARCODE PIC X(50). DTSBR503 +00199 05 FILLER PIC X(30) VALUE SPACES. DTSBR503 +00200 DTSBR503 +00201 01 BARI-LINK-AREA. DTSBR503 +00202 ++INCLUDE BARIL599 DTSBR503 +00203 EJECT DTSBR503 +00204 *RW2 DTSBR503 +00205 LINKAGE SECTION. DTSBR503 +00206 SKIP3 DTSBR503 +00207 01 LRCM-LINK-AREA. DTSBR503 +00208 ++INCLUDE DTSILRCM DTSBR503 00209 EJECT DTSBR503 -00210 DTSBR503 -00211 DTSBR503 -00212 I1000-INITIATE. DTSBR503 -00213 OPEN OUTPUT PRT-FILE1 PRT-FILE2. DTSBR503 -00214 DTSBR503 -00215 MOVE R503-NOTICE-DATE TO WRK-DATE. DTSBR503 -00216 MOVE WRK-DA TO DATE-632-DAA DATE-632-DA DTSBR503 -00217 MOVE WRK-MM TO DATE-632-MMA DATE-632-MM DTSBR503 -00218 MOVE WRK-YR TO DATE-632-YYA DATE-632-YY. DTSBR503 +00210 01 R503-REC. DTSBR503 +00211 ++INCLUDE DTSIR503 DTSBR503 +00212 EJECT DTSBR503 +00213 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR503 +00214 R503-REC. DTSBR503 +00215 DTSBR503 +00216 IF FIRST-TIME-IND = 'Y' DTSBR503 +00217 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR503 +00218 MOVE 'N' TO FIRST-TIME-IND. DTSBR503 00219 DTSBR503 -00220 MOVE 13 TO DATE-632-DAA DATE-632-DA DTSBR503 -00221 MOVE 12 TO DATE-632-MMA DATE-632-MM DTSBR503 -00222 MOVE 2013 TO DATE-632-YYA DATE-632-YY. DTSBR503 -00223 DTSBR503 -00224 WRITE PRT-R632-REC FROM BLANK-LINE DTSBR503 -00225 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 -00226 DTSBR503 -00227 WRITE PRT-R632-REC FROM LINE-13 AFTER DTSBR503 -00228 ADVANCING 15 LINES. DTSBR503 -00229 WRITE PRT-R632-REC FROM LINE-14 AFTER 1. DTSBR503 -00230 WRITE PRT-R632-REC FROM LINE-15. DTSBR503 -00231 WRITE PRT-R632-REC FROM LINE-16. DTSBR503 -00232 WRITE PRT-R632-REC FROM LINE-17. DTSBR503 -00233 DTSBR503 -00234 WRITE PRT-R632-REC FROM BLANK-LINE DTSBR503 -00235 AFTER ADVANCING PAGE. DTSBR503 -00236 DTSBR503 -00237 WRITE PRT-R632A-REC FROM BLANK-LINE DTSBR503 -00238 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 -00239 DTSBR503 -00240 WRITE PRT-R632A-REC FROM LINE-13 AFTER DTSBR503 -00241 ADVANCING 15 LINES. DTSBR503 -00242 WRITE PRT-R632A-REC FROM LINE-14 AFTER 1. DTSBR503 -00243 WRITE PRT-R632A-REC FROM LINE-15. DTSBR503 -00244 WRITE PRT-R632A-REC FROM LINE-16. DTSBR503 -00245 WRITE PRT-R632A-REC FROM LINE-17. DTSBR503 -00246 DTSBR503 -00247 WRITE PRT-R632A-REC FROM BLANK-LINE DTSBR503 -00248 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 -00249 I1000-EXIT. DTSBR503 -00250 EXIT. DTSBR503 -00251 P1000-PROCESS. DTSBR503 -00252 SKIP1 DTSBR503 -00253 MOVE R503-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSBR503 -00254 SET L001-FROM-FED-8 TO TRUE. DTSBR503 -00255 PERFORM S001-DATE THRU S001-EXIT. DTSBR503 -00256 DTSBR503 -00257 MOVE R503-UI-RATE TO L056-RATE. DTSBR503 -00258 SET L056-DISP1-LEFT-PCT-88 TO TRUE. DTSBR503 -00259 PERFORM S056-RATE-DISPLAY THRU S056-EXIT. DTSBR503 -00260 DTSBR503 -00261 DTSBR503 -00262 MOVE R503-RESERVE-RATIO TO L057-RATIO. DTSBR503 -00263 PERFORM S057-DISP-RATIO THRU S057-EXIT. DTSBR503 -00264 *RW1 DTSBR503 -00265 MOVE R503-EMP-NO TO BARC-EMP-NO. DTSBR503 -00266 PERFORM S599-BARCODE THRU S599-EXIT. DTSBR503 -00267 DTSBR503 -00268 IF L599-SETB-FONT1 DTSBR503 -00269 MOVE 'MODIFY=TAXSM1,' TO X1-CA-CME XA-CA-CME DTSBR503 -00270 ELSE DTSBR503 -00271 IF L599-SETB-FONT2 DTSBR503 -00272 MOVE 'MODIFY=TAXSM2,' TO X1-CA-CME XA-CA-CME DTSBR503 -00273 ELSE DTSBR503 -00274 MOVE 'MODIFY=TAXSM1,' TO X1-CA-CME XA-CA-CME. DTSBR503 -00275 *RW2 DTSBR503 -00276 MOVE R503-FMT-LINE(1) TO FMT-ADDR-LINE1. DTSBR503 -00277 MOVE R503-FMT-LINE(2) TO FMT-ADDR-LINE2. DTSBR503 -00278 MOVE R503-FMT-LINE(3) TO FMT-ADDR-LINE3. DTSBR503 -00279 MOVE R503-FMT-LINE(4) TO FMT-ADDR-LINE4. DTSBR503 -00280 MOVE R503-FMT-LINE(5) TO FMT-ADDR-LINE5. DTSBR503 -00281 DTSBR503 -00282 IF R503-CLASSIFIED-88 DTSBR503 -00283 WRITE PRT-R632-REC FROM XF-CA-CNTL-L632 DTSBR503 -00284 AFTER ADVANCING TOP-OF-PAGE DTSBR503 -00285 WRITE PRT-R632-REC FROM X2-CA-CNTL-LINE AFTER 1 DTSBR503 -00286 WRITE PRT-R632-REC FROM X3-CA-CNTL-LINE AFTER 1 DTSBR503 -00287 PERFORM P1100-R632 THRU P1100-EXIT DTSBR503 +00220 IF LRCM-EOR-88 DTSBR503 +00221 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR503 +00222 ELSE DTSBR503 +00223 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR503 +00224 GOBACK. DTSBR503 +00225 DTSBR503 +00226 EXIT. DTSBR503 +00227 EJECT DTSBR503 +00228 DTSBR503 +00229 DTSBR503 +00230 I1000-INITIATE. DTSBR503 +00231 OPEN OUTPUT PRT-FILE1 PRT-FILE2 PRT-FILE3. CL*13 +00232 DTSBR503 +00233 MOVE R503-NOTICE-DATE TO WRK-DATE. DTSBR503 +00234 MOVE WRK-DA TO DATE-632-DAA DATE-632-DA DTSBR503 +00235 MOVE WRK-MM TO DATE-632-MMA DATE-632-MM DTSBR503 +00236 MOVE WRK-YR TO DATE-632-YYA DATE-632-YY. DTSBR503 +00237 DTSBR503 +00238 * MOVE 13 TO DATE-632-DAA DATE-632-DA CL**2 +00239 * MOVE 12 TO DATE-632-MMA DATE-632-MM CL**2 +00240 * MOVE 2013 TO DATE-632-YYA DATE-632-YY. CL**2 +00241 DTSBR503 +00242 WRITE PRT-R632-REC FROM BLANK-LINE DTSBR503 +00243 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 +00244 DTSBR503 +00245 WRITE PRT-R632-REC FROM LINE-13 AFTER DTSBR503 +00246 ADVANCING 15 LINES. DTSBR503 +00247 WRITE PRT-R632-REC FROM LINE-14 AFTER 1. DTSBR503 +00248 WRITE PRT-R632-REC FROM LINE-15. DTSBR503 +00249 WRITE PRT-R632-REC FROM LINE-16. DTSBR503 +00250 WRITE PRT-R632-REC FROM LINE-17. DTSBR503 +00251 DTSBR503 +00252 WRITE PRT-R632-REC FROM BLANK-LINE DTSBR503 +00253 AFTER ADVANCING PAGE. DTSBR503 +00254 DTSBR503 +00255 WRITE PRT-R632A-REC FROM BLANK-LINE DTSBR503 +00256 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 +00257 DTSBR503 +00258 WRITE PRT-R632A-REC FROM LINE-13 AFTER DTSBR503 +00259 ADVANCING 15 LINES. DTSBR503 +00260 WRITE PRT-R632A-REC FROM LINE-14 AFTER 1. DTSBR503 +00261 WRITE PRT-R632A-REC FROM LINE-15. DTSBR503 +00262 WRITE PRT-R632A-REC FROM LINE-16. DTSBR503 +00263 WRITE PRT-R632A-REC FROM LINE-17. DTSBR503 +00264 DTSBR503 +00265 WRITE PRT-R632A-REC FROM BLANK-LINE DTSBR503 +00266 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 +00267 I1000-EXIT. DTSBR503 +00268 EXIT. DTSBR503 +00269 P1000-PROCESS. DTSBR503 +00270 SKIP1 DTSBR503 +00271 MOVE R503-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSBR503 +00272 SET L001-FROM-FED-8 TO TRUE. DTSBR503 +00273 PERFORM S001-DATE THRU S001-EXIT. DTSBR503 +00274 DTSBR503 +00275 MOVE R503-UI-RATE TO L056-RATE. DTSBR503 +00276 SET L056-DISP1-LEFT-PCT-88 TO TRUE. DTSBR503 +00277 PERFORM S056-RATE-DISPLAY THRU S056-EXIT. DTSBR503 +00278 DTSBR503 +00279 DTSBR503 +00280 MOVE R503-RESERVE-RATIO TO L057-RATIO. DTSBR503 +00281 PERFORM S057-DISP-RATIO THRU S057-EXIT. DTSBR503 +00282 *RW1 DTSBR503 +00283 MOVE R503-EMP-NO TO BARC-EMP-NO. DTSBR503 +00284 PERFORM S599-BARCODE THRU S599-EXIT. DTSBR503 +00285 DTSBR503 +00286 IF L599-SETB-FONT1 DTSBR503 +00287 MOVE 'MODIFY=TAXSM1,' TO X1-CA-CME XA-CA-CME DTSBR503 00288 ELSE DTSBR503 -00289 IF R503-NONCLASSIFIED-88 DTSBR503 -00290 IF WS-503R2-RECORDS-88 DTSBR503 -00291 MOVE 'N' TO WS-503R2-RECORDS DTSBR503 -00292 WRITE PRT-R632A-REC FROM XF-CA-CNTL-L632A DTSBR503 -00293 AFTER ADVANCING PAGE DTSBR503 -00294 WRITE PRT-R632A-REC FROM X2-CA-CNTL-LINE DTSBR503 -00295 WRITE PRT-R632A-REC FROM X3-CA-CNTL-LINE DTSBR503 -00296 PERFORM P1200-R632A THRU P1200-EXIT DTSBR503 -00297 ELSE DTSBR503 -00298 WRITE PRT-R632A-REC FROM X2-CA-CNTL-LINE DTSBR503 -00299 AFTER ADVANCING PAGE DTSBR503 -00300 WRITE PRT-R632A-REC FROM X3-CA-CNTL-LINE AFTER 1 DTSBR503 -00301 PERFORM P1200-R632A THRU P1200-EXIT DTSBR503 -00302 END-IF DTSBR503 -00303 ELSE DTSBR503 -00304 DISPLAY ' INVALID RECORD TYPE ' R503-REC-TYPE DTSBR503 -00305 DISPLAY ' INVALID EMPLOYER ' R503-EMP-NO. DTSBR503 -00306 P1000-EXIT. DTSBR503 -00307 EXIT. DTSBR503 -00308 EJECT DTSBR503 -00309 DTSBR503 -00310 P1100-R632. DTSBR503 -00311 WRITE PRT-R632-REC FROM 632-DATE-LINE AFTER 11. DTSBR503 -00312 MOVE R503-EMP-NO TO ACCOUNT. DTSBR503 -00313 MOVE L056-DISP-RATE TO RATE1. DTSBR503 -00314 MOVE R503-RATE-YEAR TO ONLY-YR. DTSBR503 -00315 MOVE L001-CAL-8-DATE-9 TO COMPDTE. DTSBR503 -00316 MOVE R503-AVG-TAX-WAGE TO AAPAY. DTSBR503 -00317 MOVE L057-DISP-RATIO TO RESRATIO. DTSBR503 -00318 MOVE R503-RATE-TABLE TO RPT-TABLE. DTSBR503 -00319 INSPECT RPT-TABLE REPLACING FIRST ' ' BY '.'. DTSBR503 -00320 WRITE PRT-R632-REC FROM 632-DETAIL-LINE1 AFTER 5. DTSBR503 -00321 DTSBR503 -00322 MOVE R503-PRIOR-RESERVE-AMT TO PREVIOUS. DTSBR503 -00323 MOVE R503-TRUST-FUND-INTEREST-AMT TO TRUST. DTSBR503 -00324 MOVE R503-UI-TAX-PAID-AMT TO CONTRIBUTION. DTSBR503 -00325 MOVE R503-BENEFITS-CHARGED-AMT TO BENEFITS DTSBR503 -00326 MOVE R503-CURRENT-RESERVE-AMT TO CURRENT-RESV DTSBR503 -00327 WRITE PRT-R632-REC FROM 632-DETAIL-LINE2 AFTER 7. DTSBR503 -00328 WRITE PRT-R632-REC FROM 632-DETAIL-LINE3 AFTER 48. DTSBR503 -00329 *RW1 DTSBR503 -00330 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR503 -00331 DTSBR503 -00332 MOVE SPACES TO WS-REC. DTSBR503 -00333 WRITE PRT-R632-REC FROM WS-REC DTSBR503 -00334 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 -00335 DTSBR503 -00336 WRITE PRT-R632-REC FROM WS-BARC-LINE AFTER 04. DTSBR503 -00337 DTSBR503 -00338 * WRITE PRT-R632-REC FROM BLANK-LINE DTSBR503 -00339 * AFTER ADVANCING TOP-OF-PAGE. DTSBR503 -00340 * WRITE PRT-R632-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 -00341 * 24 LINES. DTSBR503 -00342 WRITE PRT-R632-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 -00343 20 LINES. DTSBR503 -00344 *RW2 DTSBR503 -00345 WRITE PRT-R632-REC FROM LINE-ADDR-18 AFTER 1. DTSBR503 -00346 WRITE PRT-R632-REC FROM LINE-ADDR-19 AFTER 1. DTSBR503 -00347 WRITE PRT-R632-REC FROM LINE-ADDR-20 AFTER 1. DTSBR503 -00348 WRITE PRT-R632-REC FROM LINE-ADDR-21 AFTER 1. DTSBR503 -00349 DTSBR503 -00350 P1100-EXIT. DTSBR503 -00351 EXIT. DTSBR503 -00352 EJECT DTSBR503 -00353 DTSBR503 -00354 P1200-R632A. DTSBR503 -00355 WRITE PRT-R632A-REC FROM 632A-DATE-LINE AFTER 12. DTSBR503 -00356 MOVE R503-EMP-NO TO UNACCT. DTSBR503 -00357 MOVE L056-DISP-RATE TO RATE. DTSBR503 -00358 MOVE R503-RATE-YEAR TO UNONLY. DTSBR503 -00359 MOVE L001-CAL-8-DATE-9 TO UNCOMPDTE. DTSBR503 -00360 WRITE PRT-R632A-REC FROM 632A-DETAIL-LINE1 AFTER 5. DTSBR503 -00361 DTSBR503 -00362 MOVE R503-PRIOR-RESERVE-AMT TO UNPREV. DTSBR503 -00363 MOVE R503-TRUST-FUND-INTEREST-AMT TO UNTRUST. DTSBR503 -00364 MOVE R503-UI-TAX-PAID-AMT TO UNCONT. DTSBR503 -00365 MOVE R503-BENEFITS-CHARGED-AMT TO BCHARGED. DTSBR503 -00366 MOVE R503-CURRENT-RESERVE-AMT TO UNCURR. DTSBR503 -00367 WRITE PRT-R632A-REC FROM 632A-DETAIL-LINE2 AFTER 6. DTSBR503 -00368 *RW1 DTSBR503 -00369 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR503 -00370 DTSBR503 -00371 MOVE SPACES TO WS-REC. DTSBR503 -00372 WRITE PRT-R632A-REC FROM WS-REC DTSBR503 -00373 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 -00374 DTSBR503 -00375 WRITE PRT-R632A-REC FROM WS-BARC-LINE AFTER 04. DTSBR503 -00376 DTSBR503 -00377 * WRITE PRT-R632A-REC FROM BLANK-LINE DTSBR503 -00378 * AFTER ADVANCING TOP-OF-PAGE. DTSBR503 -00379 * WRITE PRT-R632A-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 -00380 * 24 LINES. DTSBR503 -00381 WRITE PRT-R632A-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 -00382 20 LINES. DTSBR503 -00383 *RW2 DTSBR503 -00384 WRITE PRT-R632A-REC FROM LINE-ADDR-18 AFTER 1. DTSBR503 -00385 WRITE PRT-R632A-REC FROM LINE-ADDR-19 AFTER 1. DTSBR503 -00386 WRITE PRT-R632A-REC FROM LINE-ADDR-20 AFTER 1. DTSBR503 -00387 WRITE PRT-R632A-REC FROM LINE-ADDR-21 AFTER 1. DTSBR503 +00289 IF L599-SETB-FONT2 DTSBR503 +00290 MOVE 'MODIFY=TAXSM2,' TO X1-CA-CME XA-CA-CME DTSBR503 +00291 ELSE DTSBR503 +00292 MOVE 'MODIFY=TAXSM1,' TO X1-CA-CME XA-CA-CME. DTSBR503 +00293 CL**3 +00294 IF R503-FMT-LINE(1) > SPACES CL**3 +00295 MOVE R503-FMT-LINE(1) TO L009-DATA CL**3 +00296 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL**3 +00297 MOVE L009-DATA TO FMT-ADDR-LINE1 CL**3 +00298 ELSE CL**3 +00299 MOVE SPACES TO FMT-ADDR-LINE1. CL**3 +00300 CL**3 +00301 IF R503-FMT-LINE(2) > SPACES CL**3 +00302 MOVE R503-FMT-LINE(2) TO L009-DATA CL**3 +00303 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL**3 +00304 MOVE L009-DATA TO FMT-ADDR-LINE2 CL**3 +00305 ELSE CL**3 +00306 MOVE SPACES TO FMT-ADDR-LINE2. CL**3 +00307 CL**3 +00308 IF R503-FMT-LINE(3) > SPACES CL**3 +00309 MOVE R503-FMT-LINE(3) TO L009-DATA CL**3 +00310 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL**3 +00311 MOVE L009-DATA TO FMT-ADDR-LINE3 CL**3 +00312 ELSE CL**3 +00313 MOVE SPACES TO FMT-ADDR-LINE3. CL**3 +00314 CL**3 +00315 DTSBR503 +00316 IF R503-FMT-LINE(4) > SPACES CL**3 +00317 MOVE R503-FMT-LINE(4) TO L009-DATA CL**3 +00318 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL**3 +00319 MOVE L009-DATA TO FMT-ADDR-LINE4 CL**3 +00320 ELSE CL**3 +00321 MOVE SPACES TO FMT-ADDR-LINE4. CL**3 +00322 CL**3 +00323 IF R503-FMT-LINE(5) > SPACES CL**3 +00324 MOVE R503-FMT-LINE(5) TO L009-DATA CL**3 +00325 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL**3 +00326 MOVE L009-DATA TO FMT-ADDR-LINE5 CL**3 +00327 ELSE CL**3 +00328 MOVE SPACES TO FMT-ADDR-LINE5. CL**3 +00329 CL**3 +00330 IF R503-CLASSIFIED-88 DTSBR503 +00331 WRITE PRT-R632-REC FROM XF-CA-CNTL-L632 DTSBR503 +00332 AFTER ADVANCING TOP-OF-PAGE DTSBR503 +00333 WRITE PRT-R632-REC FROM X2-CA-CNTL-LINE AFTER 1 DTSBR503 +00334 WRITE PRT-R632-REC FROM X3-CA-CNTL-LINE AFTER 1 DTSBR503 +00335 PERFORM P1100-R632 THRU P1100-EXIT DTSBR503 +00336 ELSE DTSBR503 +00337 IF R503-NONCLASSIFIED-88 DTSBR503 +00338 IF WS-503R2-RECORDS-88 DTSBR503 +00339 MOVE 'N' TO WS-503R2-RECORDS DTSBR503 +00340 WRITE PRT-R632A-REC FROM XF-CA-CNTL-L632A DTSBR503 +00341 AFTER ADVANCING PAGE DTSBR503 +00342 WRITE PRT-R632A-REC FROM X2-CA-CNTL-LINE DTSBR503 +00343 WRITE PRT-R632A-REC FROM X3-CA-CNTL-LINE DTSBR503 +00344 PERFORM P1200-R632A THRU P1200-EXIT DTSBR503 +00345 ELSE DTSBR503 +00346 WRITE PRT-R632A-REC FROM X2-CA-CNTL-LINE DTSBR503 +00347 AFTER ADVANCING PAGE DTSBR503 +00348 WRITE PRT-R632A-REC FROM X3-CA-CNTL-LINE AFTER 1 DTSBR503 +00349 PERFORM P1200-R632A THRU P1200-EXIT DTSBR503 +00350 END-IF DTSBR503 +00351 ELSE DTSBR503 +00352 DISPLAY ' INVALID RECORD TYPE ' R503-REC-TYPE DTSBR503 +00353 DISPLAY ' INVALID EMPLOYER ' R503-EMP-NO. DTSBR503 +00354 CL*12 +00355 PERFORM P1300-ESSP-RATE THRU P1300-EXIT. CL*12 +00356 CL*12 +00357 P1000-EXIT. DTSBR503 +00358 EXIT. DTSBR503 +00359 EJECT DTSBR503 +00360 DTSBR503 +00361 P1100-R632. DTSBR503 +00362 WRITE PRT-R632-REC FROM 632-DATE-LINE AFTER 11. DTSBR503 +00363 MOVE R503-EMP-NO TO ACCOUNT. DTSBR503 +00364 MOVE L056-DISP-RATE TO RATE1. DTSBR503 +00365 MOVE R503-RATE-YEAR TO ONLY-YR. DTSBR503 +00366 MOVE L001-CAL-8-DATE-9 TO COMPDTE. DTSBR503 +00367 MOVE R503-AVG-TAX-WAGE TO AAPAY. DTSBR503 +00368 MOVE L057-DISP-RATIO TO RESRATIO. DTSBR503 +00369 MOVE R503-RATE-TABLE TO RPT-TABLE. DTSBR503 +00370 INSPECT RPT-TABLE REPLACING FIRST ' ' BY '.'. DTSBR503 +00371 WRITE PRT-R632-REC FROM 632-DETAIL-LINE1 AFTER 5. DTSBR503 +00372 DTSBR503 +00373 MOVE R503-PRIOR-RESERVE-AMT TO PREVIOUS. DTSBR503 +00374 MOVE R503-TRUST-FUND-INTEREST-AMT TO TRUST. DTSBR503 +00375 MOVE R503-UI-TAX-PAID-AMT TO CONTRIBUTION. DTSBR503 +00376 MOVE R503-BENEFITS-CHARGED-AMT TO BENEFITS DTSBR503 +00377 MOVE R503-CURRENT-RESERVE-AMT TO CURRENT-RESV DTSBR503 +00378 WRITE PRT-R632-REC FROM 632-DETAIL-LINE2 AFTER 7. DTSBR503 +00379 WRITE PRT-R632-REC FROM 632-DETAIL-LINE3 AFTER 48. DTSBR503 +00380 *RW1 DTSBR503 +00381 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR503 +00382 DTSBR503 +00383 MOVE SPACES TO WS-REC. DTSBR503 +00384 WRITE PRT-R632-REC FROM WS-REC DTSBR503 +00385 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 +00386 DTSBR503 +00387 WRITE PRT-R632-REC FROM WS-BARC-LINE AFTER 04. DTSBR503 00388 DTSBR503 -00389 DTSBR503 -00390 P1200-EXIT. DTSBR503 -00391 EXIT. DTSBR503 -00392 EJECT DTSBR503 -00393 S001-DATE. DTSBR503 -00394 DTSBR503 -00395 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR503 -00396 DTSBR503 -00397 S001-EXIT. DTSBR503 -00398 EXIT. DTSBR503 -00399 SKIP3 DTSBR503 +00389 * WRITE PRT-R632-REC FROM BLANK-LINE DTSBR503 +00390 * AFTER ADVANCING TOP-OF-PAGE. DTSBR503 +00391 * WRITE PRT-R632-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 +00392 * 24 LINES. DTSBR503 +00393 WRITE PRT-R632-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 +00394 20 LINES. DTSBR503 +00395 *RW2 DTSBR503 +00396 WRITE PRT-R632-REC FROM LINE-ADDR-18 AFTER 1. DTSBR503 +00397 WRITE PRT-R632-REC FROM LINE-ADDR-19 AFTER 1. DTSBR503 +00398 WRITE PRT-R632-REC FROM LINE-ADDR-20 AFTER 1. DTSBR503 +00399 WRITE PRT-R632-REC FROM LINE-ADDR-21 AFTER 1. DTSBR503 00400 DTSBR503 -00401 S056-RATE-DISPLAY. DTSBR503 -00402 SKIP1 DTSBR503 -00403 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR503 -00404 SKIP2 DTSBR503 -00405 S056-EXIT. DTSBR503 -00406 EXIT. DTSBR503 -00407 SKIP3 DTSBR503 -00408 S057-DISP-RATIO. DTSBR503 -00409 SKIP1 DTSBR503 -00410 CALL 'DTSBU057' USING L057-LINK-AREA. DTSBR503 -00411 SKIP2 DTSBR503 -00412 S057-EXIT. DTSBR503 -00413 EXIT. DTSBR503 -00414 SKIP3 DTSBR503 -00415 S599-BARCODE. DTSBR503 -00416 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR503 -00417 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR503 -00418 MOVE 'TAX' TO L599-SYSTEM. DTSBR503 -00419 DTSBR503 -00420 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR503 +00401 P1100-EXIT. DTSBR503 +00402 EXIT. DTSBR503 +00403 EJECT DTSBR503 +00404 DTSBR503 +00405 P1200-R632A. DTSBR503 +00406 WRITE PRT-R632A-REC FROM 632A-DATE-LINE AFTER 12. DTSBR503 +00407 MOVE R503-EMP-NO TO UNACCT. DTSBR503 +00408 MOVE L056-DISP-RATE TO RATE. DTSBR503 +00409 MOVE R503-RATE-YEAR TO UNONLY. DTSBR503 +00410 MOVE L001-CAL-8-DATE-9 TO UNCOMPDTE. DTSBR503 +00411 WRITE PRT-R632A-REC FROM 632A-DETAIL-LINE1 AFTER 5. DTSBR503 +00412 DTSBR503 +00413 MOVE R503-PRIOR-RESERVE-AMT TO UNPREV. DTSBR503 +00414 MOVE R503-TRUST-FUND-INTEREST-AMT TO UNTRUST. DTSBR503 +00415 MOVE R503-UI-TAX-PAID-AMT TO UNCONT. DTSBR503 +00416 MOVE R503-BENEFITS-CHARGED-AMT TO BCHARGED. DTSBR503 +00417 MOVE R503-CURRENT-RESERVE-AMT TO UNCURR. DTSBR503 +00418 WRITE PRT-R632A-REC FROM 632A-DETAIL-LINE2 AFTER 6. DTSBR503 +00419 *RW1 DTSBR503 +00420 MOVE L599-BARCODED-DATA TO CONVERTED-BARCODE. DTSBR503 00421 DTSBR503 -00422 IF L599-NOT-CONVERTED DTSBR503 -00423 MOVE 'BAR CODES CONVERTED FAILED' TO ABEND-MSG DTSBR503 -00424 PERFORM S999-ABEND THRU S999-EXIT. DTSBR503 +00422 MOVE SPACES TO WS-REC. DTSBR503 +00423 WRITE PRT-R632A-REC FROM WS-REC DTSBR503 +00424 AFTER ADVANCING TOP-OF-PAGE. DTSBR503 00425 DTSBR503 -00426 S599-EXIT. DTSBR503 -00427 EXIT. DTSBR503 -00428 SKIP3 DTSBR503 -00429 T1000-TERMINATE. DTSBR503 -00430 CLOSE PRT-FILE1 PRT-FILE2. DTSBR503 -00431 DTSBR503 -00432 T1000-EXIT. DTSBR503 -00433 EXIT. DTSBR503 -00434 SKIP3 DTSBR503 -00435 S999-ABEND. DTSBR503 -00436 DISPLAY '***'. DTSBR503 -00437 DISPLAY '*** ' DTSBR503 -00438 ABEND-MSG. DTSBR503 -00439 DISPLAY '***'. DTSBR503 +00426 WRITE PRT-R632A-REC FROM WS-BARC-LINE AFTER 04. DTSBR503 +00427 DTSBR503 +00428 * WRITE PRT-R632A-REC FROM BLANK-LINE DTSBR503 +00429 * AFTER ADVANCING TOP-OF-PAGE. DTSBR503 +00430 * WRITE PRT-R632A-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 +00431 * 24 LINES. DTSBR503 +00432 WRITE PRT-R632A-REC FROM LINE-ADDR-17 AFTER ADVANCING DTSBR503 +00433 20 LINES. DTSBR503 +00434 *RW2 DTSBR503 +00435 WRITE PRT-R632A-REC FROM LINE-ADDR-18 AFTER 1. DTSBR503 +00436 WRITE PRT-R632A-REC FROM LINE-ADDR-19 AFTER 1. DTSBR503 +00437 WRITE PRT-R632A-REC FROM LINE-ADDR-20 AFTER 1. DTSBR503 +00438 WRITE PRT-R632A-REC FROM LINE-ADDR-21 AFTER 1. DTSBR503 +00439 DTSBR503 00440 DTSBR503 -00441 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR503 -00442 S999-EXIT. DTSBR503 -00443 EXIT. DTSBR503 -00444 DTSBR503 +00441 P1200-EXIT. DTSBR503 +00442 EXIT. DTSBR503 +00443 P1300-ESSP-RATE. CL*12 +00444 MOVE R503-EMP-NO TO X108-EMP-NO. CL*12 +00445 MOVE R503-UI-RATE TO L056-RATE. CL*18 +00446 SET L056-DISP1-LEFT-88 TO TRUE. CL*18 +00447 PERFORM S056-RATE-DISPLAY THRU S056-EXIT. CL*18 +00448 CL*18 +00449 MOVE L056-DISP-RATE TO X108-RATE-X. CL*19 +00450 MOVE R503-RATE-YEAR TO X108-RATE-YR. CL*12 +00451 WRITE PRT-X108-REC FROM X108-REC. CL*12 +00452 CL*12 +00453 P1300-EXIT. CL*12 +00454 EXIT. CL*12 +00455 EJECT DTSBR503 +00456 S001-DATE. DTSBR503 +00457 DTSBR503 +00458 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR503 +00459 DTSBR503 +00460 S001-EXIT. DTSBR503 +00461 EXIT. DTSBR503 +00462 SKIP3 DTSBR503 +00463 S009-CONVERT-TO-CAPS. CL**3 +00464 CL**3 +00465 CALL 'DTSBU009' USING L009-LINK-AREA. CL**3 +00466 CL**3 +00467 S009-EXIT. CL**3 +00468 EXIT. CL**3 +00469 DTSBR503 +00470 S056-RATE-DISPLAY. DTSBR503 +00471 SKIP1 DTSBR503 +00472 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR503 +00473 SKIP2 DTSBR503 +00474 S056-EXIT. DTSBR503 +00475 EXIT. DTSBR503 +00476 SKIP3 DTSBR503 +00477 S057-DISP-RATIO. DTSBR503 +00478 SKIP1 DTSBR503 +00479 CALL 'DTSBU057' USING L057-LINK-AREA. DTSBR503 +00480 SKIP2 DTSBR503 +00481 S057-EXIT. DTSBR503 +00482 EXIT. DTSBR503 +00483 SKIP3 DTSBR503 +00484 S599-BARCODE. DTSBR503 +00485 MOVE CONVERT-BARCODE-LINE TO L599-INPUT-DATA. DTSBR503 +00486 MOVE LENGTH OF CONVERT-BARCODE-LINE TO L599-REC-LENGTH. DTSBR503 +00487 MOVE 'TAX' TO L599-SYSTEM. DTSBR503 +00488 DTSBR503 +00489 CALL 'DTSBU599' USING BARI-LINK-AREA. DTSBR503 +00490 DTSBR503 +00491 IF L599-NOT-CONVERTED DTSBR503 +00492 MOVE 'BAR CODES CONVERTED FAILED' TO ABEND-MSG DTSBR503 +00493 PERFORM S999-ABEND THRU S999-EXIT. DTSBR503 +00494 DTSBR503 +00495 S599-EXIT. DTSBR503 +00496 EXIT. DTSBR503 +00497 SKIP3 DTSBR503 +00498 T1000-TERMINATE. DTSBR503 +00499 CLOSE PRT-FILE1 PRT-FILE2 PRT-FILE3. CL*12 +00500 DTSBR503 +00501 T1000-EXIT. DTSBR503 +00502 EXIT. DTSBR503 +00503 SKIP3 DTSBR503 +00504 S999-ABEND. DTSBR503 +00505 DISPLAY '***'. DTSBR503 +00506 DISPLAY '*** ' DTSBR503 +00507 ABEND-MSG. DTSBR503 +00508 DISPLAY '***'. DTSBR503 +00509 DTSBR503 +00510 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR503 +00511 S999-EXIT. DTSBR503 +00512 EXIT. DTSBR503 +00513 DTSBR503 diff --git a/Batch/DTSBR515.cob b/Batch/DTSBR515.cob index a9d8c43..a930b5b 100644 --- a/Batch/DTSBR515.cob +++ b/Batch/DTSBR515.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 12/24/02 +00001 IDENTIFICATION DIVISION. 12/04/23 00002 PROGRAM-ID. DTSBR515. DTSBR515 -00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV051 +00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV018 00004 DATE-WRITTEN. DECEMBER 1994. DTSBR515 00005 DATE-COMPILED. DTSBR515 00006 SKIP3 DTSBR515 @@ -28,578 +28,653 @@ 00028 * AND FINAL. DTSBR515 00029 * REFERENCE - HOUSEHOLD DEVL. AUTHOR OF CHANGE - RW1 DTSBR515 00030 * DTSBR515 -00031 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR515 -00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR515 -00033 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR515 -00034 * DTSBR515 -00035 * DTSBR515 -00036 * DESCRIPTION: DTSBR515 -00037 * DTSBR515 -00038 * THIS MODULE PRINTS THE DETAIL INFORMATION FOR THE RATE DTSBR515 -00039 * ASSIGNMENT JOB OF THE ANNUAL RATING PROCESS. DTSBR515 -00040 * DTSBR515 -00041 * DTSBR515 -00042 * RECORDS READ: DTSBR515 -00043 * DTSBR515 -00044 * NONE. DTSBR515 -00045 * DTSBR515 +00031 * CL**4 +00032 * 07-31-17 MODIFIED TO DISPLAY RESERVE RATIO TO MATCH REPORT CL**4 +00033 * 503 (RATE NOTICES) AND SCREEN (52). CL**4 +00034 * CL**4 +00035 * REFERENCE - HOUSEHOLD DEVL. AUTHOR OF CHANGE - ZL1 CL**4 +00036 * CL**4 +00037 * CL*11 +00038 * 10-08-19 MODIFIED TO DISPLAY NEGATIVE CHARGED AMOUNTS, REPORT CL*11 +00039 * SHOWED ZEROS IF AMOUNT WAS NEGATIVE. CL*11 +00040 * CL*11 +00041 * REFERENCE - T11636 AUTHOR OF CHANGE - ZL1 CL*11 +00042 * CL*11 +00043 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR515 +00044 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR515 +00045 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR515 00046 * DTSBR515 -00047 * PRINTED OUTPUTS: DTSBR515 -00048 * DTSBR515 -00049 * 515R1 REGULAR RATE ASSIGNMENT DETAIL LIST. DTSBR515 -00050 * 515R2 ESTIMATED RATE ASSIGNMENT DETAIL LIST. DTSBR515 -00051 * 515R3 FINAL RATE ASSIGNMENT DETAIL LIST. DTSBR515 +00047 * DTSBR515 +00048 * DESCRIPTION: DTSBR515 +00049 * DTSBR515 +00050 * THIS MODULE PRINTS THE DETAIL INFORMATION FOR THE RATE DTSBR515 +00051 * ASSIGNMENT JOB OF THE ANNUAL RATING PROCESS. DTSBR515 00052 * DTSBR515 00053 * DTSBR515 -00054 * RECORDS WRITTEN: DTSBR515 +00054 * RECORDS READ: DTSBR515 00055 * DTSBR515 00056 * NONE. DTSBR515 00057 * DTSBR515 00058 * DTSBR515 -00059 * MODULES CALLED: DTSBR515 +00059 * PRINTED OUTPUTS: DTSBR515 00060 * DTSBR515 -00061 * DTSBU004 QUARTER CONVERSION MODULE DTSBR515 -00062 * DTSBU055 UI RATE EXPERIENCE PERIOD MODULE DTSBR515 -00063 * DTSBU056 RATE DISPLAY MODULE DTSBR515 -00064 * DTSBR515 +00061 * 515R1 REGULAR RATE ASSIGNMENT DETAIL LIST. DTSBR515 +00062 * 515R2 ESTIMATED RATE ASSIGNMENT DETAIL LIST. DTSBR515 +00063 * 515R3 FINAL RATE ASSIGNMENT DETAIL LIST. DTSBR515 +00064 * 515R4 EXPORT FILE TO XCEL FOR DETAIL LIST. CL**9 00065 * DTSBR515 -00066 ***** DTSBR515 -00067 EJECT DTSBR515 -00068 ENVIRONMENT DIVISION. DTSBR515 -00069 DTSBR515 -00070 CONFIGURATION SECTION. DTSBR515 -00071 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR515 -00072 DTSBR515 -00073 DTSBR515 -00074 INPUT-OUTPUT SECTION. DTSBR515 -00075 DTSBR515 -00076 FILE-CONTROL. DTSBR515 -00077 SELECT PRT-FILE1 ASSIGN TO RPT515R1. DTSBR515 -00078 SELECT PRT-FILE2 ASSIGN TO RPT515R2. DTSBR515 -00079 SELECT PRT-FILE3 ASSIGN TO RPT515R3. DTSBR515 -00080 DTSBR515 -00081 DATA DIVISION. DTSBR515 -00082 DTSBR515 -00083 FILE SECTION. DTSBR515 -00084 DTSBR515 -00085 FD PRT-FILE1 DTSBR515 -00086 RECORDING MODE IS F. DTSBR515 -00087 01 PRT-RECORD1 PIC X(133). DTSBR515 -00088 DTSBR515 -00089 FD PRT-FILE2 DTSBR515 -00090 RECORDING MODE IS F. DTSBR515 -00091 01 PRT-RECORD2 PIC X(133). DTSBR515 -00092 DTSBR515 -00093 FD PRT-FILE3 DTSBR515 -00094 RECORDING MODE IS F. DTSBR515 -00095 01 PRT-RECORD3 PIC X(133). DTSBR515 -00096 DTSBR515 -00097 EJECT DTSBR515 -00098 WORKING-STORAGE SECTION. DTSBR515 -000985 77 PAN-VALET PICTURE X(24) VALUE '051DTSBR515 12/24/02'. DTSBR515 +00066 * DTSBR515 +00067 * RECORDS WRITTEN: DTSBR515 +00068 * DTSBR515 +00069 * NONE. DTSBR515 +00070 * DTSBR515 +00071 * DTSBR515 +00072 * MODULES CALLED: DTSBR515 +00073 * DTSBR515 +00074 * DTSBU004 QUARTER CONVERSION MODULE DTSBR515 +00075 * DTSBU055 UI RATE EXPERIENCE PERIOD MODULE DTSBR515 +00076 * DTSBU056 RATE DISPLAY MODULE DTSBR515 +00077 * DTSBU057 RESERVE RATIO DISPLAY CL**4 +00078 * DTSBR515 +00079 * DTSBR515 +00080 ***** DTSBR515 +00081 EJECT DTSBR515 +00082 ENVIRONMENT DIVISION. DTSBR515 +00083 DTSBR515 +00084 CONFIGURATION SECTION. DTSBR515 +00085 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR515 +00086 DTSBR515 +00087 DTSBR515 +00088 INPUT-OUTPUT SECTION. DTSBR515 +00089 DTSBR515 +00090 FILE-CONTROL. DTSBR515 +00091 SELECT PRT-FILE1 ASSIGN TO RPT515R1. DTSBR515 +00092 SELECT PRT-FILE2 ASSIGN TO RPT515R2. DTSBR515 +00093 SELECT PRT-FILE3 ASSIGN TO RPT515R3. DTSBR515 +00094 SELECT PRT-FILE4 ASSIGN TO RPT515R4. CL**4 +00095 DTSBR515 +00096 DATA DIVISION. DTSBR515 +00097 DTSBR515 +00098 FILE SECTION. DTSBR515 00099 DTSBR515 -00100 01 WRK-AREA. DTSBR515 -00101 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +515.DTSBR515 -00102 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBR515 -00103 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR515 -00104 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR515 -00105 05 WS-NUMBER-TWO PIC S9(05) COMP-3 VALUE +0. DTSBR515 -00106 05 WS-NUMBER-THREE PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00100 FD PRT-FILE1 DTSBR515 +00101 RECORDING MODE IS F. DTSBR515 +00102 01 PRT-RECORD1 PIC X(133). DTSBR515 +00103 DTSBR515 +00104 FD PRT-FILE2 DTSBR515 +00105 RECORDING MODE IS F. DTSBR515 +00106 01 PRT-RECORD2 PIC X(133). DTSBR515 00107 DTSBR515 -00108 05 WS-LINE-CNT1 PIC S9(02) COMP-3 VALUE 60. DTSBR515 -00109 05 WS-LINE-COUNT1 PIC S9(02) COMP-3 VALUE +0. DTSBR515 -00110 05 WS-PAGE-CNT1 PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00108 FD PRT-FILE3 DTSBR515 +00109 RECORDING MODE IS F. DTSBR515 +00110 01 PRT-RECORD3 PIC X(133). DTSBR515 00111 DTSBR515 -00112 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE 60. DTSBR515 -00113 05 WS-LINE-COUNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR515 -00114 05 WS-PAGE-CNT2 PIC S9(05) COMP-3 VALUE +0. DTSBR515 -00115 DTSBR515 -00116 05 WS-LINE-CNT3 PIC S9(02) COMP-3 VALUE 60. DTSBR515 -00117 05 WS-LINE-COUNT3 PIC S9(02) COMP-3 VALUE +0. DTSBR515 -00118 05 WS-PAGE-CNT3 PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00112 FD PRT-FILE4 CL**4 +00113 RECORDING MODE IS F. CL**4 +00114 01 PRT-RECORD4 PIC X(200). CL*16 +00115 CL**4 +00116 EJECT DTSBR515 +00117 WORKING-STORAGE SECTION. DTSBR515 +001175 77 PAN-VALET PICTURE X(24) VALUE '018DTSBR515 12/04/23'. DTSBR515 +00118 77 PAN-VALET PICTURE X(24) VALUE '051DTSBR515 12/24/02'. DTSBR515 00119 DTSBR515 -00120 05 WS-REG-EFF-QTR PIC 9(05). DTSBR515 -00121 05 WS-REG-EXP-YR-DISP1 PIC X(04). DTSBR515 -00122 05 WS-REG-EXP-YR-DISP2 PIC X(04). DTSBR515 -00123 05 WS-TAX-QTR-FROM PIC X(04). DTSBR515 -00124 05 WS-TAX-QTR-THRU PIC X(04). DTSBR515 -00125 05 WS-REG-EXP-YR-DISP3 PIC X(04). DTSBR515 -00126 05 WS-REG-RATE-TYPE PIC X(08). DTSBR515 -00127 05 WS-REG-RESERVE PIC S9(02)V9. DTSBR515 -00128 DTSBR515 -00129 05 WS-GOV-EFF-QTR PIC 9(05). DTSBR515 -00130 05 WS-GOV-COMPUTED-RATE PIC X(07). DTSBR515 -00131 EJECT DTSBR515 -00132 01 L004-LINK-AREA. DTSBR515 -00133 ++INCLUDE DTSIL004 DTSBR515 -00134 01 L055-LINK-AREA. DTSBR515 -00135 ++INCLUDE DTSIL055 DTSBR515 -00136 EJECT DTSBR515 -00137 01 L056-LINK-AREA. DTSBR515 -00138 ++INCLUDE DTSIL056 DTSBR515 -00139 EJECT DTSBR515 -00140 01 PAGE-HEADING. DTSBR515 -00141 05 HDR-LINE-1. DTSBR515 -00142 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00143 10 HDR-RPT-NO PIC X(05) VALUE SPACES. DTSBR515 -00144 10 FILLER PIC X(34) VALUE SPACES. DTSBR515 -00145 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBR515 -00146 10 FILLER PIC X(28) VALUE SPACES. DTSBR515 -00147 10 FILLER PIC X(05) DTSBR515 -00148 VALUE 'DATE:'. DTSBR515 -00149 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00150 10 HDR-SYS-DATE PIC X(08). DTSBR515 -00151 05 HDR-LINE-2. DTSBR515 -00152 10 FILLER PIC X(40) VALUE SPACES. DTSBR515 -00153 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBR515 -00154 10 FILLER PIC X(28) VALUE SPACES. DTSBR515 -00155 10 FILLER PIC X(05) DTSBR515 -00156 VALUE 'TIME:'. DTSBR515 -00157 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00158 10 HDR-SYS-TIME PIC X(08). DTSBR515 -00159 05 HDR-LINE-3. DTSBR515 -00160 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00161 10 FILLER PIC X(35) DTSBR515 -00162 VALUE 'ROUTE TO: REGISTRATION AND RATES'. DTSBR515 -00163 10 FILLER PIC X(82) VALUE SPACES. DTSBR515 -00164 10 FILLER PIC X(05) DTSBR515 -00165 VALUE 'PAGE:'. DTSBR515 -00166 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 -00167 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBR515 -00168 05 HDR-LINE-4. DTSBR515 -00169 10 FILLER PIC X(39) VALUE SPACES. DTSBR515 -00170 10 HDR-ASSIGMENT-HEADING PIC X(38) VALUE SPACES. DTSBR515 -00171 10 FILLER PIC X(04) DTSBR515 -00172 VALUE '--- '. DTSBR515 -00173 10 WS-EMPLOYER-RATING PIC X(15). DTSBR515 -00174 10 FILLER PIC X(37) VALUE SPACES. DTSBR515 -00175 05 HDR-LINE-5 PIC X(133) VALUE SPACES. DTSBR515 -00176 05 HDR-LINE-6. DTSBR515 -00177 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00178 10 FILLER PIC X(20) DTSBR515 -00179 VALUE 'RATE EFFECTIVE QTR: '. DTSBR515 -00180 10 HDR-REG-EFF-QTR PIC 99/9. DTSBR515 -00181 DTSBR515 -00182 01 DETAIL-LINES. DTSBR515 -00183 05 DTL-LINE-2. DTSBR515 -00184 10 FILLER PIC X(64) VALUE SPACES. DTSBR515 -00185 10 FILLER PIC X(40) DTSBR515 -00186 VALUE '-------------TAXABLE WAGES--------------'. DTSBR515 -00187 10 FILLER PIC X(09) VALUE SPACES. DTSBR515 -00188 10 FILLER PIC X(07) DTSBR515 -00189 VALUE 'AVERAGE'. DTSBR515 -00190 05 DTL-LINE-3. DTSBR515 -00191 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00192 10 FILLER PIC X(26) DTSBR515 -00193 VALUE 'EMP NO PRIMARY NAME'. DTSBR515 -00194 10 FILLER PIC X(33) VALUE SPACES. DTSBR515 -00195 10 WS-TAX-WAGES1-FROM PIC X(04). DTSBR515 -00196 10 FILLER PIC X DTSBR515 -00197 VALUE '-'. DTSBR515 -00198 10 WS-TAX-WAGES1-THRU PIC X(04). DTSBR515 -00199 10 FILLER PIC X(09) VALUE SPACES. DTSBR515 -00200 10 WS-TAX-WAGES2-FROM PIC X(04). DTSBR515 -00201 10 FILLER PIC X DTSBR515 -00202 VALUE '-'. DTSBR515 -00203 10 WS-TAX-WAGES2-THRU PIC X(04). DTSBR515 -00204 10 FILLER PIC X(09) VALUE SPACES. DTSBR515 -00205 10 WS-TAX-WAGES3-FROM PIC X(04). DTSBR515 -00206 10 FILLER PIC X DTSBR515 -00207 VALUE '-'. DTSBR515 -00208 10 WS-TAX-WAGES3-THRU PIC X(04). DTSBR515 -00209 10 FILLER PIC X(05) VALUE SPACES. DTSBR515 -00210 10 FILLER PIC X(21) DTSBR515 -00211 VALUE 'TAXABLE WAGES RATE'. DTSBR515 -00212 05 DTL-LINE-4. DTSBR515 +00120 01 WRK-AREA. DTSBR515 +00121 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +515.DTSBR515 +00122 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBR515 +00123 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR515 +00124 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00125 05 WS-NUMBER-TWO PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00126 05 WS-NUMBER-THREE PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00127 DTSBR515 +00128 05 WS-LINE-CNT1 PIC S9(02) COMP-3 VALUE 60. DTSBR515 +00129 05 WS-LINE-COUNT1 PIC S9(02) COMP-3 VALUE +0. DTSBR515 +00130 05 WS-PAGE-CNT1 PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00131 DTSBR515 +00132 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE 60. DTSBR515 +00133 05 WS-LINE-COUNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR515 +00134 05 WS-PAGE-CNT2 PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00135 DTSBR515 +00136 05 WS-LINE-CNT3 PIC S9(02) COMP-3 VALUE 60. DTSBR515 +00137 05 WS-LINE-COUNT3 PIC S9(02) COMP-3 VALUE +0. DTSBR515 +00138 05 WS-PAGE-CNT3 PIC S9(05) COMP-3 VALUE +0. DTSBR515 +00139 DTSBR515 +00140 05 WS-REG-EFF-QTR PIC 9(05). DTSBR515 +00141 05 WS-REG-EXP-YR-DISP1 PIC X(04). DTSBR515 +00142 05 WS-REG-EXP-YR-DISP2 PIC X(04). DTSBR515 +00143 05 WS-TAX-QTR-FROM PIC X(04). DTSBR515 +00144 05 WS-TAX-QTR-THRU PIC X(04). DTSBR515 +00145 05 WS-REG-EXP-YR-DISP3 PIC X(04). DTSBR515 +00146 05 WS-REG-RATE-TYPE PIC X(08). DTSBR515 +00147 05 WS-REG-RESERVE PIC S9(02)V9. DTSBR515 +00148 DTSBR515 +00149 05 WS-GOV-EFF-QTR PIC 9(05). DTSBR515 +00150 05 WS-GOV-COMPUTED-RATE PIC X(07). DTSBR515 +00151 EJECT DTSBR515 +00152 01 L004-LINK-AREA. DTSBR515 +00153 ++INCLUDE DTSIL004 DTSBR515 +00154 01 L055-LINK-AREA. DTSBR515 +00155 ++INCLUDE DTSIL055 DTSBR515 +00156 EJECT DTSBR515 +00157 01 L056-LINK-AREA. DTSBR515 +00158 ++INCLUDE DTSIL056 DTSBR515 +00159 01 L057-LINK-AREA. CL**2 +00160 ++INCLUDE DTSIL057 CL**2 +00161 EJECT DTSBR515 +00162 01 PAGE-HEADING. DTSBR515 +00163 05 HDR-LINE-1. DTSBR515 +00164 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 +00165 10 HDR-RPT-NO PIC X(05) VALUE SPACES. DTSBR515 +00166 10 FILLER PIC X(34) VALUE SPACES. DTSBR515 +00167 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBR515 +00168 10 FILLER PIC X(28) VALUE SPACES. DTSBR515 +00169 10 FILLER PIC X(05) DTSBR515 +00170 VALUE 'DATE:'. DTSBR515 +00171 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 +00172 10 HDR-SYS-DATE PIC X(08). DTSBR515 +00173 05 HDR-LINE-2. DTSBR515 +00174 10 FILLER PIC X(40) VALUE SPACES. DTSBR515 +00175 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBR515 +00176 10 FILLER PIC X(28) VALUE SPACES. DTSBR515 +00177 10 FILLER PIC X(05) DTSBR515 +00178 VALUE 'TIME:'. DTSBR515 +00179 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 +00180 10 HDR-SYS-TIME PIC X(08). DTSBR515 +00181 05 HDR-LINE-3. DTSBR515 +00182 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 +00183 10 FILLER PIC X(35) DTSBR515 +00184 VALUE 'ROUTE TO: REGISTRATION AND RATES'. DTSBR515 +00185 10 FILLER PIC X(82) VALUE SPACES. DTSBR515 +00186 10 FILLER PIC X(05) DTSBR515 +00187 VALUE 'PAGE:'. DTSBR515 +00188 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 +00189 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBR515 +00190 05 HDR-LINE-4. DTSBR515 +00191 10 FILLER PIC X(39) VALUE SPACES. DTSBR515 +00192 10 HDR-ASSIGMENT-HEADING PIC X(38) VALUE SPACES. DTSBR515 +00193 10 FILLER PIC X(04) DTSBR515 +00194 VALUE '--- '. DTSBR515 +00195 10 WS-EMPLOYER-RATING PIC X(15). DTSBR515 +00196 10 FILLER PIC X(37) VALUE SPACES. DTSBR515 +00197 05 HDR-LINE-5 PIC X(133) VALUE SPACES. DTSBR515 +00198 05 HDR-LINE-6. DTSBR515 +00199 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 +00200 10 FILLER PIC X(20) DTSBR515 +00201 VALUE 'RATE EFFECTIVE QTR: '. DTSBR515 +00202 10 HDR-REG-EFF-QTR PIC 99/9. DTSBR515 +00203 DTSBR515 +00204 01 DETAIL-LINES. DTSBR515 +00205 05 DTL-LINE-2. DTSBR515 +00206 10 FILLER PIC X(64) VALUE SPACES. DTSBR515 +00207 10 FILLER PIC X(40) DTSBR515 +00208 VALUE '-------------TAXABLE WAGES--------------'. DTSBR515 +00209 10 FILLER PIC X(09) VALUE SPACES. DTSBR515 +00210 10 FILLER PIC X(07) DTSBR515 +00211 VALUE 'AVERAGE'. DTSBR515 +00212 05 DTL-LINE-3. DTSBR515 00213 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00214 10 DTL-EMP-NO PIC 999B999. DTSBR515 -00215 10 FILLER PIC X(05) VALUE SPACES. DTSBR515 -00216 10 DTL-PRIMARY-NAME PIC X(40). DTSBR515 -00217 10 WS-REG-TAXABLE-WAGES1 PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 -00218 10 FILLER PIC X(02) VALUE SPACES. DTSBR515 -00219 10 WS-REG-TAXABLE-WAGES2 PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 -00220 10 FILLER PIC X(02) VALUE SPACES. DTSBR515 -00221 10 WS-REG-TAXABLE-WAGES3 PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 -00222 10 FILLER PIC X(02) VALUE SPACES. DTSBR515 -00223 10 DTL-AVG-TAX-WAGE PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 -00224 10 FILLER PIC X(04) VALUE SPACES. DTSBR515 -00225 10 WS-REG-COMPUTED-RATE PIC X(06). DTSBR515 -00226 05 DTL-LINE-5. DTSBR515 -00227 10 FILLER PIC X(11) VALUE SPACES. DTSBR515 -00228 10 FILLER PIC X(40) DTSBR515 -00229 VALUE ' PRIOR RESERVE UI TAX PAID'. DTSBR515 -00230 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 -00231 10 FILLER PIC X(15) DTSBR515 -00232 VALUE ' TRUST FUND INT'. DTSBR515 -00233 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 -00234 10 FILLER PIC X(15) DTSBR515 -00235 VALUE ' BENEFITS CHGD'. DTSBR515 -00236 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 -00237 10 FILLER PIC X(15) DTSBR515 -00238 VALUE 'CURRENT RESERVE'. DTSBR515 -00239 10 FILLER PIC X(02) VALUE SPACE. DTSBR515 -00240 10 FILLER PIC X(17) DTSBR515 -00241 VALUE ' RSVR RATIO '. DTSBR515 -00242 10 FILLER PIC X(05) VALUE SPACES. DTSBR515 -00243 10 WS-REG-PENALTY-RATE PIC X(06). DTSBR515 -00244 05 DTL-LINE-6. DTSBR515 -00245 10 FILLER PIC X(12) VALUE SPACES. DTSBR515 -00246 10 DTL-PRIOR-RESERVE-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 -00247 10 FILLER PIC X(06) VALUE SPACES. DTSBR515 -00248 10 DTL-UI-TAX-PAID-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 -00249 10 FILLER PIC X(07) VALUE SPACES. DTSBR515 -00250 10 DTL-TRUST-FUND-INT-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 -00251 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 -00252 10 DTL-BENEFITS-CHARGED-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 -00253 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 -00254 10 DTL-CURR-RESERVE-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 -00255 10 FILLER PIC X(08) VALUE SPACES. DTSBR515 -00256 10 DTL-RESERVE-RATIO PIC -Z9.9. DTSBR515 -00257 10 FILLER PIC X DTSBR515 -00258 VALUE '%'. DTSBR515 -00259 DTSBR515 -00260 01 CONTROL-FOOTING-FINAL. DTSBR515 -00261 05 CFF-LINE-4. DTSBR515 -00262 10 FILLER PIC X(10) VALUE SPACES. DTSBR515 -00263 10 CFF-NUMBER-ONE PIC ZZ,ZZ9. DTSBR515 -00264 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 -00265 10 CFF-LITERAL PIC X(40) VALUE SPACES. DTSBR515 -00266 05 CFF-LINE-8. DTSBR515 -00267 10 FILLER PIC X(25) VALUE SPACES. DTSBR515 -00268 10 FILLER PIC X(17) DTSBR515 -00269 VALUE '*** END OF REPORT'. DTSBR515 -00270 EJECT DTSBR515 -00271 LINKAGE SECTION. DTSBR515 -00272 DTSBR515 -00273 01 LRCM-LINK-AREA. DTSBR515 -00274 ++INCLUDE DTSILRCM DTSBR515 -00275 EJECT DTSBR515 -00276 01 R515-REC. DTSBR515 -00277 ++INCLUDE DTSIR515 DTSBR515 -00278 EJECT DTSBR515 -00279 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR515 -00280 R515-REC. DTSBR515 -00281 IF FIRST-TIME-IND = 'Y' DTSBR515 -00282 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR515 -00283 MOVE 'N' TO FIRST-TIME-IND. DTSBR515 -00284 DTSBR515 -00285 IF LRCM-EOR-88 DTSBR515 -00286 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR515 -00287 ELSE DTSBR515 -00288 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBR515 -00289 DTSBR515 -00290 GOBACK. DTSBR515 -00291 EJECT DTSBR515 -00292 I1000-INITIATE. DTSBR515 -00293 DTSBR515 -00294 OPEN OUTPUT PRT-FILE1 PRT-FILE2 PRT-FILE3. DTSBR515 -00295 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DTSBR515 -00296 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DTSBR515 -00297 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DTSBR515 -00298 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DTSBR515 -00299 MOVE SPACES TO PRT-RECORD1 PRT-RECORD2 PRT-RECORD3. DTSBR515 -00300 DTSBR515 -00301 MOVE ZEROES TO WS-REG-EFF-QTR WS-GOV-EFF-QTR. DTSBR515 -00302 PERFORM S1000-INIT THRU S1000-EXIT. DTSBR515 -00303 DTSBR515 -00304 I1000-EXIT. DTSBR515 -00305 EXIT. DTSBR515 -00306 EJECT DTSBR515 -00307 P0000-PROCESS. DTSBR515 -00308 DTSBR515 -00309 EVALUATE TRUE DTSBR515 -00310 WHEN R515-RPT-TYPE-REG-88 DTSBR515 -00311 MOVE ' REGULAR RATE ASSIGNMENT DETAIL LIST -' TO DTSBR515 -00312 HDR-ASSIGMENT-HEADING DTSBR515 -00313 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR515 -00314 WHEN R515-RPT-TYPE-ESTIM-88 DTSBR515 -00315 MOVE 'ESTIMATED RATE ASSIGNMENT DETAIL LIST ' TO DTSBR515 -00316 HDR-ASSIGMENT-HEADING DTSBR515 -00317 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR515 -00318 WHEN R515-RPT-TYPE-FINAL-88 DTSBR515 -00319 MOVE ' FINAL RATE ASSIGNMENT DETAIL LIST --' TO DTSBR515 -00320 HDR-ASSIGMENT-HEADING DTSBR515 -00321 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR515 -00322 WHEN OTHER DTSBR515 -00323 MOVE 'R515 REPORT TYPE NOT REG, ESTIM, OR FINAL ' DTSBR515 -00324 TO WRK-ABEND-MSG DTSBR515 -00325 PERFORM S999-ABEND THRU S999-EXIT DTSBR515 -00326 END-EVALUATE. DTSBR515 -00327 DTSBR515 -00328 P0000-EXIT. DTSBR515 -00329 EXIT. DTSBR515 -00330 DTSBR515 -00331 P1000-PROCESS. DTSBR515 -00332 DTSBR515 -00333 IF WS-REG-EFF-QTR = ZEROES DTSBR515 -00334 PERFORM S1000-INIT THRU S1000-EXIT. DTSBR515 -00335 DTSBR515 -00336 IF R515-RATE-CLASSIFIED-88 DTSBR515 -00337 MOVE 'CLASSIFIED ' TO WS-EMPLOYER-RATING DTSBR515 -00338 END-IF. DTSBR515 -00339 DTSBR515 -00340 IF R515-RATE-NONCLASSIFIED-88 DTSBR515 -00341 MOVE 'NOT CLASSIFIED' TO WS-EMPLOYER-RATING DTSBR515 -00342 END-IF. DTSBR515 -00343 DTSBR515 -00344 MOVE R515-RESERVE-RATIO TO L056-RATE. DTSBR515 -00345 SET L056-DISP1-LEFT-88 TO TRUE. DTSBR515 -00346 PERFORM S056-RATE-DISPLAY THRU S056-EXIT. DTSBR515 -00347 MOVE L056-DISP-RATE TO WS-REG-RESERVE. DTSBR515 -00348 DTSBR515 -00349 IF R515-PENALTY-RATE = ZEROES DTSBR515 -00350 MOVE SPACES TO WS-REG-PENALTY-RATE DTSBR515 -00351 MOVE R515-COMPUTED-RATE TO L056-RATE DTSBR515 -00352 SET L056-DISP1-LEFT-88 TO TRUE DTSBR515 -00353 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSBR515 -00354 MOVE SPACES TO WS-REG-COMPUTED-RATE DTSBR515 -00355 STRING ' ' DELIMITED BY SIZE DTSBR515 -00356 L056-DISP-RATE DELIMITED BY SIZE DTSBR515 -00357 INTO DTSBR515 -00358 WS-REG-COMPUTED-RATE DTSBR515 -00359 ELSE DTSBR515 -00360 MOVE R515-PENALTY-RATE TO L056-RATE DTSBR515 -00361 SET L056-DISP1-LEFT-88 TO TRUE DTSBR515 -00362 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSBR515 -00363 MOVE L056-DISP-RATE TO WS-REG-PENALTY-RATE DTSBR515 -00364 MOVE R515-COMPUTED-RATE TO L056-RATE DTSBR515 -00365 SET L056-DISP1-LEFT-88 TO TRUE DTSBR515 -00366 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSBR515 -00367 MOVE SPACES TO WS-REG-COMPUTED-RATE DTSBR515 -00368 STRING '(' DELIMITED BY SIZE DTSBR515 -00369 L056-DISP-RATE DELIMITED BY SPACE DTSBR515 -00370 ')' DELIMITED BY SIZE DTSBR515 -00371 INTO DTSBR515 -00372 WS-REG-COMPUTED-RATE. DTSBR515 -00373 DTSBR515 -00374 PERFORM P2100-TAX-WAGES THRU P2100-EXIT VARYING DTSBR515 -00375 R515-WAGES-IDX FROM 1 BY 1 UNTIL DTSBR515 -00376 R515-WAGES-IDX > 3. DTSBR515 -00377 DTSBR515 -00378 MOVE R515-EMP-NO TO DTL-EMP-NO. DTSBR515 -00379 MOVE R515-PRIMARY-NAME TO DTL-PRIMARY-NAME. DTSBR515 -00380 MOVE R515-AVG-TAX-WAGE TO DTL-AVG-TAX-WAGE. DTSBR515 -00381 MOVE R515-PRIOR-RESERVE-AMT TO DTL-PRIOR-RESERVE-AMT. DTSBR515 -00382 MOVE R515-UI-TAX-PAID-AMT TO DTL-UI-TAX-PAID-AMT. DTSBR515 -00383 MOVE R515-TRUST-FUND-INTEREST-AMT TO DTL-TRUST-FUND-INT-AMT. DTSBR515 -00384 DTSBR515 -00385 IF R515-BENEFITS-CHARGED-AMT > +0 DTSBR515 -00386 MOVE R515-BENEFITS-CHARGED-AMT TO DTSBR515 -00387 DTL-BENEFITS-CHARGED-AMT DTSBR515 -00388 ELSE DTSBR515 -00389 MOVE ZERO TO DTSBR515 -00390 DTL-BENEFITS-CHARGED-AMT DTSBR515 +00214 10 FILLER PIC X(26) DTSBR515 +00215 VALUE 'EMP NO PRIMARY NAME'. DTSBR515 +00216 10 FILLER PIC X(33) VALUE SPACES. DTSBR515 +00217 10 WS-TAX-WAGES1-FROM PIC X(04). DTSBR515 +00218 10 FILLER PIC X DTSBR515 +00219 VALUE '-'. DTSBR515 +00220 10 WS-TAX-WAGES1-THRU PIC X(04). DTSBR515 +00221 10 FILLER PIC X(09) VALUE SPACES. DTSBR515 +00222 10 WS-TAX-WAGES2-FROM PIC X(04). DTSBR515 +00223 10 FILLER PIC X DTSBR515 +00224 VALUE '-'. DTSBR515 +00225 10 WS-TAX-WAGES2-THRU PIC X(04). DTSBR515 +00226 10 FILLER PIC X(09) VALUE SPACES. DTSBR515 +00227 10 WS-TAX-WAGES3-FROM PIC X(04). DTSBR515 +00228 10 FILLER PIC X DTSBR515 +00229 VALUE '-'. DTSBR515 +00230 10 WS-TAX-WAGES3-THRU PIC X(04). DTSBR515 +00231 10 FILLER PIC X(05) VALUE SPACES. DTSBR515 +00232 10 FILLER PIC X(21) DTSBR515 +00233 VALUE 'TAXABLE WAGES RATE'. DTSBR515 +00234 05 DTL-LINE-4. DTSBR515 +00235 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 +00236 10 DTL-EMP-NO PIC 999B999. DTSBR515 +00237 10 FILLER PIC X(05) VALUE SPACES. DTSBR515 +00238 10 DTL-PRIMARY-NAME PIC X(40). DTSBR515 +00239 10 WS-REG-TAXABLE-WAGES1 PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 +00240 10 FILLER PIC X(02) VALUE SPACES. DTSBR515 +00241 10 WS-REG-TAXABLE-WAGES2 PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 +00242 10 FILLER PIC X(02) VALUE SPACES. DTSBR515 +00243 10 WS-REG-TAXABLE-WAGES3 PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 +00244 10 FILLER PIC X(02) VALUE SPACES. DTSBR515 +00245 10 DTL-AVG-TAX-WAGE PIC ZZZZZ,ZZZ,ZZ9.99. DTSBR515 +00246 10 FILLER PIC X(04) VALUE SPACES. DTSBR515 +00247 10 WS-REG-COMPUTED-RATE PIC X(06). DTSBR515 +00248 05 DTL-LINE-5. DTSBR515 +00249 10 FILLER PIC X(11) VALUE SPACES. DTSBR515 +00250 10 FILLER PIC X(40) DTSBR515 +00251 VALUE ' PRIOR RESERVE UI TAX PAID'. DTSBR515 +00252 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 +00253 10 FILLER PIC X(15) DTSBR515 +00254 VALUE ' TRUST FUND INT'. DTSBR515 +00255 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 +00256 10 FILLER PIC X(15) DTSBR515 +00257 VALUE ' BENEFITS CHGD'. DTSBR515 +00258 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 +00259 10 FILLER PIC X(15) DTSBR515 +00260 VALUE 'CURRENT RESERVE'. DTSBR515 +00261 10 FILLER PIC X(02) VALUE SPACE. DTSBR515 +00262 10 FILLER PIC X(17) DTSBR515 +00263 VALUE ' RSVR RATIO '. DTSBR515 +00264 10 FILLER PIC X(05) VALUE SPACES. DTSBR515 +00265 10 WS-REG-PENALTY-RATE PIC X(06). DTSBR515 +00266 05 DTL-LINE-6. DTSBR515 +00267 10 FILLER PIC X(12) VALUE SPACES. DTSBR515 +00268 10 DTL-PRIOR-RESERVE-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 +00269 10 FILLER PIC X(06) VALUE SPACES. DTSBR515 +00270 10 DTL-UI-TAX-PAID-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 +00271 10 FILLER PIC X(07) VALUE SPACES. DTSBR515 +00272 10 DTL-TRUST-FUND-INT-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 +00273 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 +00274 10 DTL-BENEFITS-CHARGED-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 +00275 10 FILLER PIC X(03) VALUE SPACES. DTSBR515 +00276 10 DTL-CURR-RESERVE-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBR515 +00277 10 FILLER PIC X(08) VALUE SPACES. DTSBR515 +00278 10 DTL-RESERVE-RATIO PIC X(05). CL**2 +00279 10 FILLER PIC X DTSBR515 +00280 VALUE '%'. DTSBR515 +00281 DTSBR515 +00282 01 CONTROL-FOOTING-FINAL. DTSBR515 +00283 05 CFF-LINE-4. DTSBR515 +00284 10 FILLER PIC X(10) VALUE SPACES. DTSBR515 +00285 10 CFF-NUMBER-ONE PIC ZZ,ZZ9. DTSBR515 +00286 10 FILLER PIC X(01) VALUE SPACE. DTSBR515 +00287 10 CFF-LITERAL PIC X(40) VALUE SPACES. DTSBR515 +00288 05 CFF-LINE-8. DTSBR515 +00289 10 FILLER PIC X(25) VALUE SPACES. DTSBR515 +00290 10 FILLER PIC X(17) DTSBR515 +00291 VALUE '*** END OF REPORT'. DTSBR515 +00292 05 DTL-EXPORT. CL**4 +00293 10 FILLER PIC X(01) VALUE SPACE. CL**4 +00294 10 EXP-EMP-NO PIC 999B999. CL**4 +00295 10 FILLER PIC X(02) VALUE '| '. CL*18 +00296 10 EXP-PRIMARY-NAME PIC X(15). CL**5 +00297 10 FILLER PIC X(02) VALUE '| '. CL*18 +00298 10 WS-EXP-TAXABLE-WAGES1 PIC ZZZZZ,ZZZ,ZZ9.99. CL**4 +00299 10 FILLER PIC X(02) VALUE '| '. CL*18 +00300 10 WS-EXP-TAXABLE-WAGES2 PIC ZZZZZ,ZZZ,ZZ9.99. CL**4 +00301 10 FILLER PIC X(02) VALUE '| '. CL*18 +00302 10 WS-EXP-TAXABLE-WAGES3 PIC ZZZZZ,ZZZ,ZZ9.99. CL**4 +00303 10 FILLER PIC X(02) VALUE '| '. CL*18 +00304 10 EXP-AVG-TAX-WAGE PIC ZZZZZ,ZZZ,ZZ9.99. CL**4 +00305 10 FILLER PIC X(02) VALUE '| '. CL*18 +00306 10 WS-EXP-COMPUTED-RATE PIC X(06). CL**4 +00307 10 FILLER PIC X(02) VALUE '| '. CL*18 +00308 10 EXP-PRIOR-RESERVE-AMT PIC ZZZ,ZZZ,ZZ9.99-. CL**5 +00309 10 FILLER PIC X(02) VALUE '| '. CL*18 +00310 10 EXP-UI-TAX-PAID-AMT PIC ZZZ,ZZZ,ZZ9.99-. CL**4 +00311 10 FILLER PIC X(02) VALUE '| '. CL*18 +00312 10 EXP-TRUST-FUND-INT-AMT PIC ZZZ,ZZZ,ZZ9.99-. CL**4 +00313 10 FILLER PIC X(02) VALUE '| '. CL*18 +00314 10 EXP-BENEFITS-CHARGED-AMT PIC ZZZ,ZZZ,ZZ9.99-. CL**4 +00315 10 FILLER PIC X(02) VALUE '| '. CL*18 +00316 10 EXP-CURR-RESERVE-AMT PIC ZZZ,ZZZ,ZZ9.99-. CL**4 +00317 10 FILLER PIC X(02) VALUE '| '. CL*18 +00318 10 EXP-RESERVE-RATIO PIC X(05). CL**4 +00319 10 FILLER PIC X CL**4 +00320 VALUE '%'. CL**4 +00321 10 FILLER PIC X(02) VALUE SPACES. CL*17 +00322 CL**4 +00323 EJECT DTSBR515 +00324 LINKAGE SECTION. DTSBR515 +00325 DTSBR515 +00326 01 LRCM-LINK-AREA. DTSBR515 +00327 ++INCLUDE DTSILRCM DTSBR515 +00328 EJECT DTSBR515 +00329 01 R515-REC. DTSBR515 +00330 ++INCLUDE DTSIR515 DTSBR515 +00331 EJECT DTSBR515 +00332 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR515 +00333 R515-REC. DTSBR515 +00334 IF FIRST-TIME-IND = 'Y' DTSBR515 +00335 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR515 +00336 MOVE 'N' TO FIRST-TIME-IND. DTSBR515 +00337 DTSBR515 +00338 IF LRCM-EOR-88 DTSBR515 +00339 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR515 +00340 ELSE DTSBR515 +00341 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBR515 +00342 DTSBR515 +00343 GOBACK. DTSBR515 +00344 EJECT DTSBR515 +00345 I1000-INITIATE. DTSBR515 +00346 DTSBR515 +00347 OPEN OUTPUT PRT-FILE1 PRT-FILE2 PRT-FILE3 PRT-FILE4. CL**8 +00348 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DTSBR515 +00349 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DTSBR515 +00350 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DTSBR515 +00351 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DTSBR515 +00352 MOVE SPACES TO PRT-RECORD1 PRT-RECORD2 PRT-RECORD3. DTSBR515 +00353 DTSBR515 +00354 MOVE ZEROES TO WS-REG-EFF-QTR WS-GOV-EFF-QTR. DTSBR515 +00355 PERFORM S1000-INIT THRU S1000-EXIT. DTSBR515 +00356 DTSBR515 +00357 I1000-EXIT. DTSBR515 +00358 EXIT. DTSBR515 +00359 EJECT DTSBR515 +00360 P0000-PROCESS. DTSBR515 +00361 DTSBR515 +00362 EVALUATE TRUE DTSBR515 +00363 WHEN R515-RPT-TYPE-REG-88 DTSBR515 +00364 MOVE ' REGULAR RATE ASSIGNMENT DETAIL LIST -' TO DTSBR515 +00365 HDR-ASSIGMENT-HEADING DTSBR515 +00366 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR515 +00367 WHEN R515-RPT-TYPE-ESTIM-88 DTSBR515 +00368 MOVE 'ESTIMATED RATE ASSIGNMENT DETAIL LIST ' TO DTSBR515 +00369 HDR-ASSIGMENT-HEADING DTSBR515 +00370 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR515 +00371 WHEN R515-RPT-TYPE-FINAL-88 DTSBR515 +00372 MOVE ' FINAL RATE ASSIGNMENT DETAIL LIST --' TO DTSBR515 +00373 HDR-ASSIGMENT-HEADING DTSBR515 +00374 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBR515 +00375 WHEN OTHER DTSBR515 +00376 MOVE 'R515 REPORT TYPE NOT REG, ESTIM, OR FINAL ' DTSBR515 +00377 TO WRK-ABEND-MSG DTSBR515 +00378 PERFORM S999-ABEND THRU S999-EXIT DTSBR515 +00379 END-EVALUATE. DTSBR515 +00380 DTSBR515 +00381 P0000-EXIT. DTSBR515 +00382 EXIT. DTSBR515 +00383 DTSBR515 +00384 P1000-PROCESS. DTSBR515 +00385 DTSBR515 +00386 IF WS-REG-EFF-QTR = ZEROES DTSBR515 +00387 PERFORM S1000-INIT THRU S1000-EXIT. DTSBR515 +00388 DTSBR515 +00389 IF R515-RATE-CLASSIFIED-88 DTSBR515 +00390 MOVE 'CLASSIFIED ' TO WS-EMPLOYER-RATING DTSBR515 00391 END-IF. DTSBR515 00392 DTSBR515 -00393 MOVE R515-CURRENT-RESERVE-AMT TO DTL-CURR-RESERVE-AMT. DTSBR515 -00394 MOVE R515-RESERVE-RATIO TO DTL-RESERVE-RATIO. DTSBR515 -00395 DTSBR515 -00396 IF R515-RPT-TYPE-REG-88 DTSBR515 -00397 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT DTSBR515 -00398 WRITE PRT-RECORD1 FROM DTL-LINE-2 AFTER 2 DTSBR515 -00399 WRITE PRT-RECORD1 FROM DTL-LINE-3 AFTER 1 DTSBR515 -00400 WRITE PRT-RECORD1 FROM DTL-LINE-4 AFTER 1 DTSBR515 -00401 WRITE PRT-RECORD1 FROM DTL-LINE-5 AFTER 1 DTSBR515 -00402 WRITE PRT-RECORD1 FROM DTL-LINE-6 AFTER 1 DTSBR515 -00403 ADD +6 TO WS-LINE-COUNT1 DTSBR515 -00404 ADD +1 TO WS-NUMBER-ONE. DTSBR515 -00405 DTSBR515 -00406 IF R515-RPT-TYPE-ESTIM-88 DTSBR515 -00407 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR515 -00408 WRITE PRT-RECORD2 FROM DTL-LINE-2 AFTER 2 DTSBR515 -00409 WRITE PRT-RECORD2 FROM DTL-LINE-3 AFTER 1 DTSBR515 -00410 WRITE PRT-RECORD2 FROM DTL-LINE-4 AFTER 1 DTSBR515 -00411 WRITE PRT-RECORD2 FROM DTL-LINE-5 AFTER 1 DTSBR515 -00412 WRITE PRT-RECORD2 FROM DTL-LINE-6 AFTER 1 DTSBR515 -00413 ADD +6 TO WS-LINE-COUNT2 DTSBR515 -00414 ADD +1 TO WS-NUMBER-TWO. DTSBR515 -00415 DTSBR515 -00416 IF R515-RPT-TYPE-FINAL-88 DTSBR515 -00417 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR515 -00418 WRITE PRT-RECORD3 FROM DTL-LINE-2 AFTER 2 DTSBR515 -00419 WRITE PRT-RECORD3 FROM DTL-LINE-3 AFTER 1 DTSBR515 -00420 WRITE PRT-RECORD3 FROM DTL-LINE-4 AFTER 1 DTSBR515 -00421 WRITE PRT-RECORD3 FROM DTL-LINE-5 AFTER 1 DTSBR515 -00422 WRITE PRT-RECORD3 FROM DTL-LINE-6 AFTER 1 DTSBR515 -00423 ADD +6 TO WS-LINE-COUNT3 DTSBR515 -00424 ADD +1 TO WS-NUMBER-THREE. DTSBR515 -00425 DTSBR515 -00426 P1000-EXIT. DTSBR515 -00427 EXIT. DTSBR515 -00428 DTSBR515 -00429 P2100-TAX-WAGES. DTSBR515 -00430 DTSBR515 -00431 IF R515-WAGES-FROM-YRQ (R515-WAGES-IDX) GREATER ZEROS DTSBR515 -00432 MOVE R515-WAGES-FROM-YRQ (R515-WAGES-IDX) TO L004-QTR-5-9 DTSBR515 -00433 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR515 -00434 MOVE L004-SLASH-QTR TO WS-TAX-QTR-FROM DTSBR515 -00435 ELSE DTSBR515 -00436 MOVE SPACES TO WS-TAX-QTR-FROM DTSBR515 -00437 END-IF. DTSBR515 -00438 IF R515-WAGES-THRU-YRQ (R515-WAGES-IDX) GREATER ZEROS DTSBR515 -00439 MOVE R515-WAGES-THRU-YRQ (R515-WAGES-IDX) TO L004-QTR-5-9 DTSBR515 -00440 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR515 -00441 MOVE L004-SLASH-QTR TO WS-TAX-QTR-THRU DTSBR515 -00442 ELSE DTSBR515 -00443 MOVE SPACES TO WS-TAX-QTR-THRU DTSBR515 -00444 END-IF. DTSBR515 +00393 IF R515-RATE-NONCLASSIFIED-88 DTSBR515 +00394 MOVE 'NOT CLASSIFIED' TO WS-EMPLOYER-RATING DTSBR515 +00395 END-IF. DTSBR515 +00396 DTSBR515 +00397 MOVE R515-RESERVE-RATIO TO L057-RATIO CL**2 +00398 * SET L056-DISP1-LEFT-88 TO TRUE. CL**2 +00399 PERFORM S057-DISP-RATIO THRU S057-EXIT. CL**3 +00400 MOVE L057-DISP-RATIO TO DTL-RESERVE-RATIO CL**5 +00401 EXP-RESERVE-RATIO. CL**5 +00402 DTSBR515 +00403 IF R515-PENALTY-RATE = ZEROES DTSBR515 +00404 MOVE SPACES TO WS-REG-PENALTY-RATE DTSBR515 +00405 MOVE R515-COMPUTED-RATE TO L056-RATE DTSBR515 +00406 SET L056-DISP1-LEFT-88 TO TRUE DTSBR515 +00407 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSBR515 +00408 MOVE SPACES TO WS-REG-COMPUTED-RATE DTSBR515 +00409 STRING ' ' DELIMITED BY SIZE DTSBR515 +00410 L056-DISP-RATE DELIMITED BY SIZE DTSBR515 +00411 INTO DTSBR515 +00412 WS-REG-COMPUTED-RATE DTSBR515 +00413 ELSE DTSBR515 +00414 MOVE R515-PENALTY-RATE TO L056-RATE DTSBR515 +00415 SET L056-DISP1-LEFT-88 TO TRUE DTSBR515 +00416 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSBR515 +00417 MOVE L056-DISP-RATE TO WS-REG-PENALTY-RATE DTSBR515 +00418 MOVE R515-COMPUTED-RATE TO L056-RATE DTSBR515 +00419 SET L056-DISP1-LEFT-88 TO TRUE DTSBR515 +00420 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSBR515 +00421 MOVE SPACES TO WS-REG-COMPUTED-RATE DTSBR515 +00422 STRING '(' DELIMITED BY SIZE DTSBR515 +00423 L056-DISP-RATE DELIMITED BY SPACE DTSBR515 +00424 ')' DELIMITED BY SIZE DTSBR515 +00425 INTO DTSBR515 +00426 WS-REG-COMPUTED-RATE. DTSBR515 +00427 DTSBR515 +00428 MOVE WS-REG-COMPUTED-RATE TO WS-EXP-COMPUTED-RATE. CL**6 +00429 PERFORM P2100-TAX-WAGES THRU P2100-EXIT VARYING DTSBR515 +00430 R515-WAGES-IDX FROM 1 BY 1 UNTIL DTSBR515 +00431 R515-WAGES-IDX > 3. DTSBR515 +00432 DTSBR515 +00433 MOVE R515-EMP-NO TO DTL-EMP-NO CL**5 +00434 EXP-EMP-NO. CL**5 +00435 MOVE R515-PRIMARY-NAME TO DTL-PRIMARY-NAME CL**5 +00436 EXP-PRIMARY-NAME. CL**5 +00437 MOVE R515-AVG-TAX-WAGE TO DTL-AVG-TAX-WAGE CL**5 +00438 EXP-AVG-TAX-WAGE. CL**5 +00439 MOVE R515-PRIOR-RESERVE-AMT TO DTL-PRIOR-RESERVE-AMT CL**6 +00440 EXP-PRIOR-RESERVE-AMT. CL**6 +00441 MOVE R515-UI-TAX-PAID-AMT TO DTL-UI-TAX-PAID-AMT CL**6 +00442 EXP-UI-TAX-PAID-AMT. CL*10 +00443 MOVE R515-TRUST-FUND-INTEREST-AMT TO DTL-TRUST-FUND-INT-AMT CL**6 +00444 EXP-TRUST-FUND-INT-AMT. CL**6 00445 DTSBR515 -00446 EVALUATE TRUE DTSBR515 -00447 WHEN R515-WAGES-IDX = 1 DTSBR515 -00448 MOVE R515-TAX-WAGE (R515-WAGES-IDX) TO DTSBR515 -00449 WS-REG-TAXABLE-WAGES1 DTSBR515 -00450 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGES1-FROM DTSBR515 -00451 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGES1-THRU DTSBR515 -00452 WHEN R515-WAGES-IDX = 2 DTSBR515 -00453 MOVE R515-TAX-WAGE (R515-WAGES-IDX) TO DTSBR515 -00454 WS-REG-TAXABLE-WAGES2 DTSBR515 -00455 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGES2-FROM DTSBR515 -00456 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGES2-THRU DTSBR515 -00457 WHEN R515-WAGES-IDX = 3 DTSBR515 -00458 MOVE R515-TAX-WAGE (R515-WAGES-IDX) TO DTSBR515 -00459 WS-REG-TAXABLE-WAGES3 DTSBR515 -00460 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGES3-FROM DTSBR515 -00461 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGES3-THRU DTSBR515 -00462 END-EVALUATE. DTSBR515 -00463 P2100-EXIT. DTSBR515 -00464 EXIT. DTSBR515 -00465 DTSBR515 -00466 P3000-PRINT-HEADER. DTSBR515 -00467 IF WS-LINE-CNT1 GREATER 58 OR DTSBR515 -00468 WS-LINE-COUNT1 GREATER 58 DTSBR515 -00469 MOVE +0 TO WS-LINE-CNT1 DTSBR515 -00470 MOVE +0 TO WS-LINE-COUNT1 DTSBR515 -00471 ADD +1 TO WS-PAGE-CNT1 DTSBR515 -00472 MOVE WS-PAGE-CNT1 TO HDR-PAGE-CNT DTSBR515 -00473 MOVE '515R1' TO HDR-RPT-NO DTSBR515 -00474 WRITE PRT-RECORD1 FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR515 -00475 WRITE PRT-RECORD1 FROM HDR-LINE-2 AFTER 1 DTSBR515 -00476 WRITE PRT-RECORD1 FROM HDR-LINE-3 AFTER 1 DTSBR515 -00477 WRITE PRT-RECORD1 FROM HDR-LINE-4 AFTER 1 DTSBR515 -00478 WRITE PRT-RECORD1 FROM HDR-LINE-5 AFTER 1 DTSBR515 -00479 WRITE PRT-RECORD1 FROM HDR-LINE-6 AFTER 1 DTSBR515 -00480 ADD +6 TO WS-LINE-COUNT1. DTSBR515 -00481 P3000-EXIT. DTSBR515 -00482 EXIT. DTSBR515 -00483 DTSBR515 -00484 P4000-PRINT-HEADER. DTSBR515 -00485 IF WS-LINE-CNT2 GREATER 58 OR DTSBR515 -00486 WS-LINE-COUNT2 GREATER 58 DTSBR515 -00487 MOVE +0 TO WS-LINE-CNT2 DTSBR515 -00488 MOVE +0 TO WS-LINE-COUNT2 DTSBR515 -00489 ADD +1 TO WS-PAGE-CNT2 DTSBR515 -00490 MOVE WS-PAGE-CNT2 TO HDR-PAGE-CNT DTSBR515 -00491 MOVE '515R2' TO HDR-RPT-NO DTSBR515 -00492 WRITE PRT-RECORD2 FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR515 -00493 WRITE PRT-RECORD2 FROM HDR-LINE-2 AFTER 1 DTSBR515 -00494 WRITE PRT-RECORD2 FROM HDR-LINE-3 AFTER 1 DTSBR515 -00495 WRITE PRT-RECORD2 FROM HDR-LINE-4 AFTER 1 DTSBR515 -00496 WRITE PRT-RECORD2 FROM HDR-LINE-5 AFTER 1 DTSBR515 -00497 WRITE PRT-RECORD2 FROM HDR-LINE-6 AFTER 1 DTSBR515 -00498 ADD +6 TO WS-LINE-COUNT2. DTSBR515 -00499 P4000-EXIT. DTSBR515 -00500 EXIT. DTSBR515 -00501 DTSBR515 -00502 P5000-PRINT-HEADER. DTSBR515 -00503 IF WS-LINE-CNT3 GREATER 58 OR DTSBR515 -00504 WS-LINE-COUNT3 GREATER 58 DTSBR515 -00505 MOVE +0 TO WS-LINE-CNT3 DTSBR515 -00506 MOVE +0 TO WS-LINE-COUNT3 DTSBR515 -00507 ADD +1 TO WS-PAGE-CNT3 DTSBR515 -00508 MOVE WS-PAGE-CNT3 TO HDR-PAGE-CNT DTSBR515 -00509 MOVE '515R3' TO HDR-RPT-NO DTSBR515 -00510 WRITE PRT-RECORD3 FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR515 -00511 WRITE PRT-RECORD3 FROM HDR-LINE-2 AFTER 1 DTSBR515 -00512 WRITE PRT-RECORD3 FROM HDR-LINE-3 AFTER 1 DTSBR515 -00513 WRITE PRT-RECORD3 FROM HDR-LINE-4 AFTER 1 DTSBR515 -00514 WRITE PRT-RECORD3 FROM HDR-LINE-5 AFTER 1 DTSBR515 -00515 WRITE PRT-RECORD3 FROM HDR-LINE-6 AFTER 1 DTSBR515 -00516 ADD +6 TO WS-LINE-COUNT3. DTSBR515 -00517 P5000-EXIT. DTSBR515 -00518 EXIT. DTSBR515 -00519 DTSBR515 -00520 T1000-TERMINATE. DTSBR515 -00521 DTSBR515 -00522 PERFORM S3000-TERM-R1 THRU S3000-EXIT. DTSBR515 -00523 DTSBR515 -00524 T1000-EXIT. DTSBR515 -00525 EXIT. DTSBR515 -00526 DTSBR515 -00527 S1000-INIT. DTSBR515 -00528 DTSBR515 -00529 MOVE R515-EFF-QTR TO WS-REG-EFF-QTR. DTSBR515 -00530 MOVE WS-REG-EFF-QTR (3:3) TO HDR-REG-EFF-QTR. DTSBR515 -00531 DTSBR515 -00532 S1000-EXIT. DTSBR515 -00533 EXIT. DTSBR515 -00534 DTSBR515 -00535 S3000-TERM-R1. DTSBR515 -00536 DTSBR515 -00537 IF WS-NUMBER-ONE > ZEROS DTSBR515 -00538 IF WS-LINE-COUNT1 > 50 DTSBR515 -00539 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT DTSBR515 -00540 END-IF DTSBR515 -00541 MOVE WS-NUMBER-ONE TO CFF-NUMBER-ONE DTSBR515 -00542 MOVE 'RATE NOTICES PRINTED ' TO CFF-LITERAL DTSBR515 -00543 WRITE PRT-RECORD1 FROM CFF-LINE-4 AFTER 4 DTSBR515 -00544 WRITE PRT-RECORD1 FROM CFF-LINE-8 AFTER 4 DTSBR515 -00545 END-IF. DTSBR515 -00546 DTSBR515 -00547 IF WS-NUMBER-TWO > ZEROS DTSBR515 -00548 IF WS-LINE-COUNT2 > 50 DTSBR515 -00549 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR515 -00550 END-IF DTSBR515 -00551 MOVE WS-NUMBER-TWO TO CFF-NUMBER-ONE DTSBR515 -00552 MOVE 'ESTIMATED RATES ASSIGNED' TO CFF-LITERAL DTSBR515 -00553 WRITE PRT-RECORD2 FROM CFF-LINE-4 AFTER 4 DTSBR515 -00554 WRITE PRT-RECORD2 FROM CFF-LINE-8 AFTER 4 DTSBR515 -00555 END-IF. DTSBR515 -00556 DTSBR515 -00557 IF WS-NUMBER-THREE > ZEROS DTSBR515 -00558 IF WS-LINE-COUNT3 > 50 DTSBR515 -00559 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR515 -00560 END-IF DTSBR515 -00561 MOVE WS-NUMBER-THREE TO CFF-NUMBER-ONE DTSBR515 -00562 MOVE 'RATE NOTICES PRINTED ' TO CFF-LITERAL DTSBR515 -00563 WRITE PRT-RECORD3 FROM CFF-LINE-4 AFTER 4 DTSBR515 -00564 WRITE PRT-RECORD3 FROM CFF-LINE-8 AFTER 4 DTSBR515 -00565 END-IF. DTSBR515 -00566 DTSBR515 -00567 CLOSE PRT-FILE1 PRT-FILE2 PRT-FILE3. DTSBR515 -00568 DTSBR515 -00569 S3000-EXIT. DTSBR515 -00570 EXIT. DTSBR515 -00571 DTSBR515 -00572 S004-FROM-5. DTSBR515 -00573 DTSBR515 -00574 SET L004-FROM-5 TO TRUE. DTSBR515 -00575 DTSBR515 -00576 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR515 -00577 DTSBR515 -00578 S004-EXIT. DTSBR515 -00579 EXIT. DTSBR515 -00580 DTSBR515 -00581 ** S055-EXPERIENCE-PERIOD. DTSBR515 -00582 ** SKIP1 DTSBR515 -00583 ** CALL 'DTSBU055' USING L055-LINK-AREA. DTSBR515 -00584 ** DTSBR515 -00585 ** S055-EXIT. DTSBR515 -00586 ** EXIT. DTSBR515 +00446 * IF R515-BENEFITS-CHARGED-AMT > +0 CL*11 +00447 MOVE R515-BENEFITS-CHARGED-AMT TO DTSBR515 +00448 DTL-BENEFITS-CHARGED-AMT DTSBR515 +00449 EXP-BENEFITS-CHARGED-AMT CL**6 +00450 * ELSE CL*11 +00451 * MOVE ZERO TO CL*11 +00452 * DTL-BENEFITS-CHARGED-AMT CL*11 +00453 * EXP-BENEFITS-CHARGED-AMT CL*11 +00454 * END-IF. CL*11 +00455 DTSBR515 +00456 MOVE R515-CURRENT-RESERVE-AMT TO DTL-CURR-RESERVE-AMT CL**7 +00457 EXP-CURR-RESERVE-AMT. CL**6 +00458 * MOVE R515-RESERVE-RATIO TO DTL-RESERVE-RATIO. CL**2 +00459 DTSBR515 +00460 IF R515-RPT-TYPE-REG-88 DTSBR515 +00461 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT DTSBR515 +00462 WRITE PRT-RECORD1 FROM DTL-LINE-2 AFTER 2 DTSBR515 +00463 WRITE PRT-RECORD1 FROM DTL-LINE-3 AFTER 1 DTSBR515 +00464 WRITE PRT-RECORD1 FROM DTL-LINE-4 AFTER 1 DTSBR515 +00465 WRITE PRT-RECORD1 FROM DTL-LINE-5 AFTER 1 DTSBR515 +00466 WRITE PRT-RECORD1 FROM DTL-LINE-6 AFTER 1 DTSBR515 +00467 ADD +6 TO WS-LINE-COUNT1 DTSBR515 +00468 ADD +1 TO WS-NUMBER-ONE. DTSBR515 +00469 DTSBR515 +00470 IF R515-RPT-TYPE-ESTIM-88 DTSBR515 +00471 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR515 +00472 WRITE PRT-RECORD2 FROM DTL-LINE-2 AFTER 2 DTSBR515 +00473 WRITE PRT-RECORD2 FROM DTL-LINE-3 AFTER 1 DTSBR515 +00474 WRITE PRT-RECORD2 FROM DTL-LINE-4 AFTER 1 DTSBR515 +00475 WRITE PRT-RECORD2 FROM DTL-LINE-5 AFTER 1 DTSBR515 +00476 WRITE PRT-RECORD2 FROM DTL-LINE-6 AFTER 1 DTSBR515 +00477 ADD +6 TO WS-LINE-COUNT2 DTSBR515 +00478 ADD +1 TO WS-NUMBER-TWO. DTSBR515 +00479 DTSBR515 +00480 IF R515-RPT-TYPE-FINAL-88 DTSBR515 +00481 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR515 +00482 WRITE PRT-RECORD3 FROM DTL-LINE-2 AFTER 2 DTSBR515 +00483 WRITE PRT-RECORD3 FROM DTL-LINE-3 AFTER 1 DTSBR515 +00484 WRITE PRT-RECORD3 FROM DTL-LINE-4 AFTER 1 DTSBR515 +00485 WRITE PRT-RECORD3 FROM DTL-LINE-5 AFTER 1 DTSBR515 +00486 WRITE PRT-RECORD3 FROM DTL-LINE-6 AFTER 1 DTSBR515 +00487 ADD +6 TO WS-LINE-COUNT3 DTSBR515 +00488 ADD +1 TO WS-NUMBER-THREE. DTSBR515 +00489 DTSBR515 +00490 WRITE PRT-RECORD4 FROM DTL-EXPORT. CL**8 +00491 P1000-EXIT. DTSBR515 +00492 EXIT. DTSBR515 +00493 DTSBR515 +00494 P2100-TAX-WAGES. DTSBR515 +00495 DTSBR515 +00496 IF R515-WAGES-FROM-YRQ (R515-WAGES-IDX) GREATER ZEROS DTSBR515 +00497 MOVE R515-WAGES-FROM-YRQ (R515-WAGES-IDX) TO L004-QTR-5-9 DTSBR515 +00498 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR515 +00499 MOVE L004-SLASH-QTR TO WS-TAX-QTR-FROM DTSBR515 +00500 ELSE DTSBR515 +00501 MOVE SPACES TO WS-TAX-QTR-FROM DTSBR515 +00502 END-IF. DTSBR515 +00503 IF R515-WAGES-THRU-YRQ (R515-WAGES-IDX) GREATER ZEROS DTSBR515 +00504 MOVE R515-WAGES-THRU-YRQ (R515-WAGES-IDX) TO L004-QTR-5-9 DTSBR515 +00505 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR515 +00506 MOVE L004-SLASH-QTR TO WS-TAX-QTR-THRU DTSBR515 +00507 ELSE DTSBR515 +00508 MOVE SPACES TO WS-TAX-QTR-THRU DTSBR515 +00509 END-IF. DTSBR515 +00510 DTSBR515 +00511 EVALUATE TRUE DTSBR515 +00512 WHEN R515-WAGES-IDX = 1 DTSBR515 +00513 MOVE R515-TAX-WAGE (R515-WAGES-IDX) TO DTSBR515 +00514 WS-REG-TAXABLE-WAGES1 DTSBR515 +00515 WS-EXP-TAXABLE-WAGES1 CL**6 +00516 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGES1-FROM DTSBR515 +00517 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGES1-THRU DTSBR515 +00518 WHEN R515-WAGES-IDX = 2 DTSBR515 +00519 MOVE R515-TAX-WAGE (R515-WAGES-IDX) TO DTSBR515 +00520 WS-REG-TAXABLE-WAGES2 DTSBR515 +00521 WS-EXP-TAXABLE-WAGES2 CL**6 +00522 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGES2-FROM DTSBR515 +00523 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGES2-THRU DTSBR515 +00524 WHEN R515-WAGES-IDX = 3 DTSBR515 +00525 MOVE R515-TAX-WAGE (R515-WAGES-IDX) TO DTSBR515 +00526 WS-REG-TAXABLE-WAGES3 DTSBR515 +00527 WS-EXP-TAXABLE-WAGES3 CL**6 +00528 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGES3-FROM DTSBR515 +00529 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGES3-THRU DTSBR515 +00530 END-EVALUATE. DTSBR515 +00531 P2100-EXIT. DTSBR515 +00532 EXIT. DTSBR515 +00533 DTSBR515 +00534 P3000-PRINT-HEADER. DTSBR515 +00535 IF WS-LINE-CNT1 GREATER 58 OR DTSBR515 +00536 WS-LINE-COUNT1 GREATER 58 DTSBR515 +00537 MOVE +0 TO WS-LINE-CNT1 DTSBR515 +00538 MOVE +0 TO WS-LINE-COUNT1 DTSBR515 +00539 ADD +1 TO WS-PAGE-CNT1 DTSBR515 +00540 MOVE WS-PAGE-CNT1 TO HDR-PAGE-CNT DTSBR515 +00541 MOVE '515R1' TO HDR-RPT-NO DTSBR515 +00542 WRITE PRT-RECORD1 FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR515 +00543 WRITE PRT-RECORD1 FROM HDR-LINE-2 AFTER 1 DTSBR515 +00544 WRITE PRT-RECORD1 FROM HDR-LINE-3 AFTER 1 DTSBR515 +00545 WRITE PRT-RECORD1 FROM HDR-LINE-4 AFTER 1 DTSBR515 +00546 WRITE PRT-RECORD1 FROM HDR-LINE-5 AFTER 1 DTSBR515 +00547 WRITE PRT-RECORD1 FROM HDR-LINE-6 AFTER 1 DTSBR515 +00548 ADD +6 TO WS-LINE-COUNT1. DTSBR515 +00549 P3000-EXIT. DTSBR515 +00550 EXIT. DTSBR515 +00551 DTSBR515 +00552 P4000-PRINT-HEADER. DTSBR515 +00553 IF WS-LINE-CNT2 GREATER 58 OR DTSBR515 +00554 WS-LINE-COUNT2 GREATER 58 DTSBR515 +00555 MOVE +0 TO WS-LINE-CNT2 DTSBR515 +00556 MOVE +0 TO WS-LINE-COUNT2 DTSBR515 +00557 ADD +1 TO WS-PAGE-CNT2 DTSBR515 +00558 MOVE WS-PAGE-CNT2 TO HDR-PAGE-CNT DTSBR515 +00559 MOVE '515R2' TO HDR-RPT-NO DTSBR515 +00560 WRITE PRT-RECORD2 FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR515 +00561 WRITE PRT-RECORD2 FROM HDR-LINE-2 AFTER 1 DTSBR515 +00562 WRITE PRT-RECORD2 FROM HDR-LINE-3 AFTER 1 DTSBR515 +00563 WRITE PRT-RECORD2 FROM HDR-LINE-4 AFTER 1 DTSBR515 +00564 WRITE PRT-RECORD2 FROM HDR-LINE-5 AFTER 1 DTSBR515 +00565 WRITE PRT-RECORD2 FROM HDR-LINE-6 AFTER 1 DTSBR515 +00566 ADD +6 TO WS-LINE-COUNT2. DTSBR515 +00567 P4000-EXIT. DTSBR515 +00568 EXIT. DTSBR515 +00569 DTSBR515 +00570 P5000-PRINT-HEADER. DTSBR515 +00571 IF WS-LINE-CNT3 GREATER 58 OR DTSBR515 +00572 WS-LINE-COUNT3 GREATER 58 DTSBR515 +00573 MOVE +0 TO WS-LINE-CNT3 DTSBR515 +00574 MOVE +0 TO WS-LINE-COUNT3 DTSBR515 +00575 ADD +1 TO WS-PAGE-CNT3 DTSBR515 +00576 MOVE WS-PAGE-CNT3 TO HDR-PAGE-CNT DTSBR515 +00577 MOVE '515R3' TO HDR-RPT-NO DTSBR515 +00578 WRITE PRT-RECORD3 FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR515 +00579 WRITE PRT-RECORD3 FROM HDR-LINE-2 AFTER 1 DTSBR515 +00580 WRITE PRT-RECORD3 FROM HDR-LINE-3 AFTER 1 DTSBR515 +00581 WRITE PRT-RECORD3 FROM HDR-LINE-4 AFTER 1 DTSBR515 +00582 WRITE PRT-RECORD3 FROM HDR-LINE-5 AFTER 1 DTSBR515 +00583 WRITE PRT-RECORD3 FROM HDR-LINE-6 AFTER 1 DTSBR515 +00584 ADD +6 TO WS-LINE-COUNT3. DTSBR515 +00585 P5000-EXIT. DTSBR515 +00586 EXIT. DTSBR515 00587 DTSBR515 -00588 S056-RATE-DISPLAY. DTSBR515 +00588 T1000-TERMINATE. DTSBR515 00589 DTSBR515 -00590 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR515 +00590 PERFORM S3000-TERM-R1 THRU S3000-EXIT. DTSBR515 00591 DTSBR515 -00592 S056-EXIT. DTSBR515 +00592 T1000-EXIT. DTSBR515 00593 EXIT. DTSBR515 00594 DTSBR515 -00595 S999-ABEND. DTSBR515 +00595 S1000-INIT. DTSBR515 00596 DTSBR515 -00597 DISPLAY '*** DTSBR515 ABENDING. ' DTSBR515 -00598 WRK-ABEND-MSG. DTSBR515 +00597 MOVE R515-EFF-QTR TO WS-REG-EFF-QTR. DTSBR515 +00598 MOVE WS-REG-EFF-QTR (3:3) TO HDR-REG-EFF-QTR. DTSBR515 00599 DTSBR515 -00600 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR515 -00601 DTSBR515 -00602 S999-EXIT. DTSBR515 -00603 EXIT. DTSBR515 +00600 S1000-EXIT. DTSBR515 +00601 EXIT. DTSBR515 +00602 DTSBR515 +00603 S3000-TERM-R1. DTSBR515 00604 DTSBR515 +00605 IF WS-NUMBER-ONE > ZEROS DTSBR515 +00606 IF WS-LINE-COUNT1 > 50 DTSBR515 +00607 PERFORM P3000-PRINT-HEADER THRU P3000-EXIT DTSBR515 +00608 END-IF DTSBR515 +00609 MOVE WS-NUMBER-ONE TO CFF-NUMBER-ONE DTSBR515 +00610 MOVE 'RATE NOTICES PRINTED ' TO CFF-LITERAL DTSBR515 +00611 WRITE PRT-RECORD1 FROM CFF-LINE-4 AFTER 4 DTSBR515 +00612 WRITE PRT-RECORD1 FROM CFF-LINE-8 AFTER 4 DTSBR515 +00613 END-IF. DTSBR515 +00614 DTSBR515 +00615 IF WS-NUMBER-TWO > ZEROS DTSBR515 +00616 IF WS-LINE-COUNT2 > 50 DTSBR515 +00617 PERFORM P4000-PRINT-HEADER THRU P4000-EXIT DTSBR515 +00618 END-IF DTSBR515 +00619 MOVE WS-NUMBER-TWO TO CFF-NUMBER-ONE DTSBR515 +00620 MOVE 'ESTIMATED RATES ASSIGNED' TO CFF-LITERAL DTSBR515 +00621 WRITE PRT-RECORD2 FROM CFF-LINE-4 AFTER 4 DTSBR515 +00622 WRITE PRT-RECORD2 FROM CFF-LINE-8 AFTER 4 DTSBR515 +00623 END-IF. DTSBR515 +00624 DTSBR515 +00625 IF WS-NUMBER-THREE > ZEROS DTSBR515 +00626 IF WS-LINE-COUNT3 > 50 DTSBR515 +00627 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR515 +00628 END-IF DTSBR515 +00629 MOVE WS-NUMBER-THREE TO CFF-NUMBER-ONE DTSBR515 +00630 MOVE 'RATE NOTICES PRINTED ' TO CFF-LITERAL DTSBR515 +00631 WRITE PRT-RECORD3 FROM CFF-LINE-4 AFTER 4 DTSBR515 +00632 WRITE PRT-RECORD3 FROM CFF-LINE-8 AFTER 4 DTSBR515 +00633 END-IF. DTSBR515 +00634 DTSBR515 +00635 CLOSE PRT-FILE1 PRT-FILE2 PRT-FILE3 PRT-FILE4. CL**6 +00636 DTSBR515 +00637 S3000-EXIT. DTSBR515 +00638 EXIT. DTSBR515 +00639 DTSBR515 +00640 S004-FROM-5. DTSBR515 +00641 DTSBR515 +00642 SET L004-FROM-5 TO TRUE. DTSBR515 +00643 DTSBR515 +00644 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR515 +00645 DTSBR515 +00646 S004-EXIT. DTSBR515 +00647 EXIT. DTSBR515 +00648 DTSBR515 +00649 ** S055-EXPERIENCE-PERIOD. DTSBR515 +00650 ** SKIP1 DTSBR515 +00651 ** CALL 'DTSBU055' USING L055-LINK-AREA. DTSBR515 +00652 ** DTSBR515 +00653 ** S055-EXIT. DTSBR515 +00654 ** EXIT. DTSBR515 +00655 DTSBR515 +00656 S056-RATE-DISPLAY. DTSBR515 +00657 DTSBR515 +00658 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR515 +00659 DTSBR515 +00660 S056-EXIT. DTSBR515 +00661 EXIT. DTSBR515 +00662 CL**2 +00663 S057-DISP-RATIO. CL**2 +00664 CL**2 +00665 CALL 'DTSBU057' USING L057-LINK-AREA. CL**2 +00666 CL**2 +00667 S057-EXIT. CL**2 +00668 EXIT. CL**2 +00669 DTSBR515 +00670 S999-ABEND. DTSBR515 +00671 DTSBR515 +00672 DISPLAY '*** DTSBR515 ABENDING. ' DTSBR515 +00673 WRK-ABEND-MSG. DTSBR515 +00674 DTSBR515 +00675 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR515 +00676 DTSBR515 +00677 S999-EXIT. DTSBR515 +00678 EXIT. DTSBR515 +00679 DTSBR515 diff --git a/Batch/DTSBR521.cob b/Batch/DTSBR521.cob index 59295aa..cc728c4 100644 --- a/Batch/DTSBR521.cob +++ b/Batch/DTSBR521.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 11/28/01 +00001 IDENTIFICATION DIVISION. 12/18/23 00002 PROGRAM-ID. DTSBR521. DTSBR521 -00003 AUTHOR. D.SHEPPERSON LV223 +00003 AUTHOR. D.SHEPPERSON LV013 00004 DATE-WRITTEN. MAY 1999. DTSBR521 00005 DATE-COMPILED. DTSBR521 00006 SKIP3 DTSBR521 @@ -72,822 +72,880 @@ 00072 DTSBR521 00073 FD PRT-FILE DTSBR521 00074 RECORDING MODE IS F. DTSBR521 -00075 01 PRT-RECORD PIC X(133). DTSBR521 +00075 01 PRT-RECORD PIC X(165). CL*11 00076 DTSBR521 00077 EJECT DTSBR521 00078 WORKING-STORAGE SECTION. DTSBR521 -000785 77 PAN-VALET PICTURE X(24) VALUE '223DTSBR521 11/28/01'. DTSBR521 -00079 DTSBR521 -00080 01 WRK-AREA. DTSBR521 -00081 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +521.DTSBR521 -00082 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR521 -00083 05 ABEND-MSG PIC X(60). DTSBR521 -00084 DTSBR521 -00085 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR521 -00086 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR521 -00087 05 WS-PAGE-CNT PIC S9(05) COMP-3 VALUE +0. DTSBR521 -00088 DTSBR521 -00089 05 WS-SUB PIC S9(04) COMP. DTSBR521 -00090 05 WS-OUTPUT-HEADING PIC X(55). DTSBR521 -00091 05 WS-FUIR-MIN-RATIO PIC S9(02)V9(05). DTSBR521 -00092 05 WS-FUIR-MAX-RATIO PIC S9(02)V9(05). DTSBR521 -00093 05 WS-FUIR-UI-RATE PIC S9(01)V9999 DTSBR521 -00094 COMP-3 VALUE 0. DTSBR521 -00095 05 WS-FUIR-UI-RATE-D PIC X(07). DTSBR521 -00096 05 WS-EFF-QTR-UNPACK PIC 9(05). DTSBR521 -00097 05 WS-OUT-TAXABLE-WAGES1 PIC S9(11)V99. DTSBR521 -00098 05 WS-OUT-TAXABLE-WAGES2 PIC S9(11)V99. DTSBR521 -00099 05 WS-UI-RATE-CATEGORY PIC X. DTSBR521 -00100 05 WS-TAX-QTR-FROM PIC X(04). DTSBR521 -00101 05 WS-TAX-QTR-THRU PIC X(04). DTSBR521 -00102 05 WS-TAX-PD-FROM-THRU. DTSBR521 -00103 10 WS-TAX-PD-FROM-DT PIC X(04). DTSBR521 -00104 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00105 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +000785 77 PAN-VALET PICTURE X(24) VALUE '013DTSBR521 12/18/23'. DTSBR521 +00079 77 PAN-VALET PICTURE X(24) VALUE '223DTSBR521 11/28/01'. DTSBR521 +00080 DTSBR521 +00081 01 WRK-AREA. DTSBR521 +00082 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +521.DTSBR521 +00083 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR521 +00084 05 ABEND-MSG PIC X(60). DTSBR521 +00085 DTSBR521 +00086 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBR521 +00087 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBR521 +00088 05 WS-PAGE-CNT PIC S9(05) COMP-3 VALUE +0. DTSBR521 +00089 DTSBR521 +00090 05 WS-SUB PIC S9(04) COMP. DTSBR521 +00091 05 WS-OUTPUT-HEADING PIC X(55). DTSBR521 +00092 05 WS-FUIR-MIN-RATIO PIC S9(02)V9(05). DTSBR521 +00093 05 WS-FUIR-MAX-RATIO PIC S9(02)V9(05). DTSBR521 +00094 05 WS-FUIR-UI-RATE PIC S9(01)V9999 DTSBR521 +00095 COMP-3 VALUE 0. DTSBR521 +00096 05 WS-FUIR-UI-RATE-D PIC X(07). DTSBR521 +00097 05 WS-EFF-QTR-UNPACK PIC 9(05). DTSBR521 +00098 05 WS-OUT-TAXABLE-WAGES1 PIC S9(11)V99. DTSBR521 +00099 05 WS-OUT-TAXABLE-WAGES2 PIC S9(11)V99. DTSBR521 +00100 05 WS-OUT-TAXABLE-WAGES3 PIC S9(11)V99. CL**2 +00101 05 WS-UI-RATE-CATEGORY PIC X. DTSBR521 +00102 05 WS-TAX-QTR-FROM PIC X(04). DTSBR521 +00103 05 WS-TAX-QTR-THRU PIC X(04). DTSBR521 +00104 05 WS-TAX-PD-FROM-THRU. DTSBR521 +00105 10 WS-TAX-PD-FROM-DT PIC X(04). DTSBR521 00106 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00107 10 WS-TAX-PD-THRU-DT PIC X(04). DTSBR521 -00108 05 WS-TRUST-FND-FROM-THRU. DTSBR521 -00109 10 WS-TRUST-FROM-DT PIC X(04). DTSBR521 -00110 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00111 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00107 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00108 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00109 10 WS-TAX-PD-THRU-DT PIC X(04). DTSBR521 +00110 05 WS-TRUST-FND-FROM-THRU. DTSBR521 +00111 10 WS-TRUST-FROM-DT PIC X(04). DTSBR521 00112 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00113 10 WS-TRUST-THRU-DT PIC X(04). DTSBR521 -00114 05 WS-BENEFIT-CHG-FROM-THRU. DTSBR521 -00115 10 WS-BENEF-FROM-DT PIC X(04). DTSBR521 -00116 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00117 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00113 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00114 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00115 10 WS-TRUST-THRU-DT PIC X(04). DTSBR521 +00116 05 WS-BENEFIT-CHG-FROM-THRU. DTSBR521 +00117 10 WS-BENEF-FROM-DT PIC X(04). DTSBR521 00118 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00119 10 WS-BENEF-THRU-DT PIC X(04). DTSBR521 -00120 05 WS-TAX-WAGE1-FROM-THRU. DTSBR521 -00121 10 WS-TAX-WAGE1-FROM PIC X(04). DTSBR521 -00122 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00123 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00119 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00120 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00121 10 WS-BENEF-THRU-DT PIC X(04). DTSBR521 +00122 05 WS-TAX-WAGE1-FROM-THRU. DTSBR521 +00123 10 WS-TAX-WAGE1-FROM PIC X(04). DTSBR521 00124 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00125 10 WS-TAX-WAGE1-THRU PIC X(04). DTSBR521 -00126 05 WS-TAX-WAGE2-FROM-THRU. DTSBR521 -00127 10 WS-TAX-WAGE2-FROM PIC X(04). DTSBR521 -00128 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00129 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00125 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00126 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00127 10 WS-TAX-WAGE1-THRU PIC X(04). DTSBR521 +00128 05 WS-TAX-WAGE2-FROM-THRU. DTSBR521 +00129 10 WS-TAX-WAGE2-FROM PIC X(04). DTSBR521 00130 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00131 10 WS-TAX-WAGE2-THRU PIC X(04). DTSBR521 -00132 EJECT DTSBR521 -00133 01 WS-OUTPUT-LINE. DTSBR521 -00134 10 WS-REG-UI-RATE PIC S9V9999 COMP-3. DTSBR521 -00135 10 WS-REG-UI-RATE-D PIC X(07). DTSBR521 -00136 10 WS-REG-TRUST-FUND-INT PIC S9(09)V99 COMP-3. DTSBR521 -00137 10 WS-REG-BENEFITS-CHGD PIC S9(09)V99 COMP-3. DTSBR521 -00138 10 WS-REG-MIN-RATIO PIC S9(02)V99. DTSBR521 -00139 10 WS-REG-MAX-RATIO PIC S9(02)V99. DTSBR521 -00140 10 WS-REG-EMPL-COUNT PIC S9(07) COMP-3. DTSBR521 -00141 10 WS-REG-UI-TAX-PAID PIC S9(09)V99 COMP-3. DTSBR521 -00142 10 WS-REG-CURRENT-RESERVE PIC S9(09)V99 COMP-3. DTSBR521 -00143 10 WS-REG-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 -00144 10 WS-REG-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 -00145 EJECT DTSBR521 -00146 01 WS-OUTPUT-CLASSIFIED. DTSBR521 -00147 05 WS-CLASSF-FIELDS. DTSBR521 -00148 10 WS-CLS-TRUST-FUND-INT PIC S9(09)V99 COMP-3. DTSBR521 -00149 10 WS-CLS-BENEFITS-CHGD PIC S9(09)V99 COMP-3. DTSBR521 -00150 10 WS-CLS-EMPL-COUNT PIC S9(07) COMP-3. DTSBR521 -00151 10 WS-CLS-UI-RATE PIC 99V9. DTSBR521 -00152 10 WS-CLS-UI-TAX-PAID PIC S9(09)V99 COMP-3. DTSBR521 -00153 10 WS-CLS-CURRENT-RESERVE PIC S9(09)V99 COMP-3. DTSBR521 -00154 10 WS-CLS-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 -00155 10 WS-CLS-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 -00156 EJECT DTSBR521 -00157 01 WS-EMPLR-AREA. DTSBR521 -00158 05 WS-EMPLR-FIELDS. DTSBR521 -00159 10 WS-EMP-UI-TAX-PAID PIC S9(09)V99 COMP-3. DTSBR521 -00160 10 WS-EMP-TRUST-FUND-INT PIC S9(09)V99 COMP-3. DTSBR521 -00161 10 WS-EMP-BENEFITS-CHGD PIC S9(09)V99 COMP-3. DTSBR521 -00162 10 WS-EMP-EMPL-COUNT PIC S9(07) COMP-3. DTSBR521 -00163 10 WS-EMP-UI-RATE PIC X(07). DTSBR521 -00164 10 WS-EMP-CURRENT-RESERVE PIC S9(09)V99 COMP-3. DTSBR521 -00165 10 WS-EMP-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 -00166 10 WS-EMP-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 -00167 DTSBR521 -00168 01 WS-GRAND-AREA. DTSBR521 -00169 05 WS-GRAND-TOTAL-FIELDS. DTSBR521 -00170 10 WS-GRD-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 -00171 10 WS-GRD-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 -00172 10 WS-GRD-TRUST-FUND-INT PIC S9(09)V99 COMP-3. DTSBR521 -00173 10 WS-GRD-BENEFITS-CHGD PIC S9(09)V99 COMP-3. DTSBR521 -00174 10 WS-GRD-EMPLR-COUNT PIC S9(07) COMP-3. DTSBR521 -00175 10 WS-GRD-UI-TAX-PAID PIC S9(09)V99 COMP-3. DTSBR521 -00176 10 WS-GRD-CURRENT-RESERVE PIC S9(09)V99 COMP-3. DTSBR521 -00177 EJECT DTSBR521 -00178 01 FUIR-REC. DTSBR521 -00179 ++INCLUDE DTSIFUIR DTSBR521 -00180 EJECT DTSBR521 -00181 01 L001-LINK-AREA. DTSBR521 -00182 ++INCLUDE DTSIL001 DTSBR521 -00183 EJECT DTSBR521 -00184 01 L004-LINK-AREA. DTSBR521 -00185 ++INCLUDE DTSIL004 DTSBR521 -00186 EJECT DTSBR521 -00187 01 L056-LINK-AREA. DTSBR521 -00188 ++INCLUDE DTSIL056 DTSBR521 +00131 10 FILLER PIC X(01) VALUE '-'. DTSBR521 +00132 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00133 10 WS-TAX-WAGE2-THRU PIC X(04). DTSBR521 +00134 05 WS-TAX-WAGE3-FROM-THRU. CL**2 +00135 10 WS-TAX-WAGE3-FROM PIC X(04). CL**2 +00136 10 FILLER PIC X(01) VALUE SPACE. CL**2 +00137 10 FILLER PIC X(01) VALUE '-'. CL**2 +00138 10 FILLER PIC X(01) VALUE SPACE. CL**2 +00139 10 WS-TAX-WAGE3-THRU PIC X(04). CL**2 +00140 EJECT DTSBR521 +00141 01 WS-OUTPUT-LINE. DTSBR521 +00142 10 WS-REG-UI-RATE PIC S9V9999 COMP-3. DTSBR521 +00143 10 WS-REG-UI-RATE-D PIC X(07). DTSBR521 +00144 10 WS-REG-TRUST-FUND-INT PIC S9(11)V99 COMP-3. CL**6 +00145 10 WS-REG-BENEFITS-CHGD PIC S9(11)V99 COMP-3. CL**6 +00146 10 WS-REG-MIN-RATIO PIC S9(02)V99. DTSBR521 +00147 10 WS-REG-MAX-RATIO PIC S9(02)V99. DTSBR521 +00148 10 WS-REG-EMPL-COUNT PIC S9(07) COMP-3. DTSBR521 +00149 10 WS-REG-UI-TAX-PAID PIC S9(11)V99 COMP-3. CL**6 +00150 10 WS-REG-CURRENT-RESERVE PIC S9(11)V99 COMP-3. CL**6 +00151 10 WS-REG-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 +00152 10 WS-REG-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 +00153 10 WS-REG-TAXABLE-WAGES3 PIC S9(11)V99 COMP-3. CL**2 +00154 EJECT DTSBR521 +00155 01 WS-OUTPUT-CLASSIFIED. DTSBR521 +00156 05 WS-CLASSF-FIELDS. DTSBR521 +00157 10 WS-CLS-TRUST-FUND-INT PIC S9(11)V99 COMP-3. CL**6 +00158 10 WS-CLS-BENEFITS-CHGD PIC S9(11)V99 COMP-3. CL**6 +00159 10 WS-CLS-EMPL-COUNT PIC S9(07) COMP-3. DTSBR521 +00160 10 WS-CLS-UI-RATE PIC 99V9. DTSBR521 +00161 10 WS-CLS-UI-TAX-PAID PIC S9(11)V99 COMP-3. CL**6 +00162 10 WS-CLS-CURRENT-RESERVE PIC S9(11)V99 COMP-3. CL**6 +00163 10 WS-CLS-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 +00164 10 WS-CLS-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 +00165 10 WS-CLS-TAXABLE-WAGES3 PIC S9(11)V99 COMP-3. CL**2 +00166 EJECT DTSBR521 +00167 01 WS-EMPLR-AREA. DTSBR521 +00168 05 WS-EMPLR-FIELDS. DTSBR521 +00169 10 WS-EMP-UI-TAX-PAID PIC S9(11)V99 COMP-3. CL**6 +00170 10 WS-EMP-TRUST-FUND-INT PIC S9(11)V99 COMP-3. CL**6 +00171 10 WS-EMP-BENEFITS-CHGD PIC S9(11)V99 COMP-3. CL**6 +00172 10 WS-EMP-EMPL-COUNT PIC S9(07) COMP-3. DTSBR521 +00173 10 WS-EMP-UI-RATE PIC X(07). DTSBR521 +00174 10 WS-EMP-CURRENT-RESERVE PIC S9(11)V99 COMP-3. CL**6 +00175 10 WS-EMP-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 +00176 10 WS-EMP-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 +00177 10 WS-EMP-TAXABLE-WAGES3 PIC S9(11)V99 COMP-3. CL**2 +00178 DTSBR521 +00179 01 WS-GRAND-AREA. DTSBR521 +00180 05 WS-GRAND-TOTAL-FIELDS. DTSBR521 +00181 10 WS-GRD-TAXABLE-WAGES1 PIC S9(11)V99 COMP-3. DTSBR521 +00182 10 WS-GRD-TAXABLE-WAGES2 PIC S9(11)V99 COMP-3. DTSBR521 +00183 10 WS-GRD-TAXABLE-WAGES3 PIC S9(11)V99 COMP-3. CL**2 +00184 10 WS-GRD-TRUST-FUND-INT PIC S9(11)V99 COMP-3. CL**6 +00185 10 WS-GRD-BENEFITS-CHGD PIC S9(11)V99 COMP-3. CL**6 +00186 10 WS-GRD-EMPLR-COUNT PIC S9(07) COMP-3. DTSBR521 +00187 10 WS-GRD-UI-TAX-PAID PIC S9(11)V99 COMP-3. CL**6 +00188 10 WS-GRD-CURRENT-RESERVE PIC S9(11)V99 COMP-3. CL**6 00189 EJECT DTSBR521 -00190 01 L057-LINK-AREA. DTSBR521 -00191 ++INCLUDE DTSIL057 DTSBR521 +00190 01 FUIR-REC. DTSBR521 +00191 ++INCLUDE DTSIFUIR DTSBR521 00192 EJECT DTSBR521 -00193 01 L931-LINK-AREA. DTSBR521 -00194 ++INCLUDE DTSIL931 DTSBR521 +00193 01 L001-LINK-AREA. DTSBR521 +00194 ++INCLUDE DTSIL001 DTSBR521 00195 EJECT DTSBR521 -00196 01 FSKL-REC. DTSBR521 -00197 ++INCLUDE DTSIFSKL DTSBR521 +00196 01 L004-LINK-AREA. DTSBR521 +00197 ++INCLUDE DTSIL004 DTSBR521 00198 EJECT DTSBR521 -00199 01 PAGE-HEADING. DTSBR521 -00200 05 HDR-LINE-1. DTSBR521 -00201 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00202 10 FILLER PIC X(05) DTSBR521 -00203 VALUE '521R1'. DTSBR521 -00204 10 FILLER PIC X(34) VALUE SPACES. DTSBR521 -00205 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBR521 -00206 10 FILLER PIC X(28) VALUE SPACES. DTSBR521 -00207 10 FILLER PIC X(05) DTSBR521 -00208 VALUE 'DATE:'. DTSBR521 -00209 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00210 10 HDR-SYS-DATE PIC X(08). DTSBR521 -00211 05 HDR-LINE-2. DTSBR521 -00212 10 FILLER PIC X(40) VALUE SPACES. DTSBR521 -00213 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBR521 -00214 10 FILLER PIC X(28) VALUE SPACES. DTSBR521 -00215 10 FILLER PIC X(05) DTSBR521 -00216 VALUE 'TIME:'. DTSBR521 -00217 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00218 10 HDR-SYS-TIME PIC X(08). DTSBR521 -00219 05 HDR-LINE-3. DTSBR521 -00220 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00221 10 FILLER PIC X(33) DTSBR521 -00222 VALUE 'ROUTE TO: REGISTRATION AND RATES'. DTSBR521 -00223 10 FILLER PIC X(84) VALUE SPACES. DTSBR521 -00224 10 FILLER PIC X(05) DTSBR521 -00225 VALUE 'PAGE:'. DTSBR521 -00226 10 FILLER PIC X(03) VALUE SPACES. DTSBR521 -00227 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBR521 -00228 05 HDR-LINE-4. DTSBR521 -00229 10 FILLER PIC X(11) VALUE SPACES. DTSBR521 -00230 10 FILLER PIC X(20) DTSBR521 -00231 VALUE ' '. DTSBR521 -00232 10 FILLER PIC X(17) VALUE SPACES. DTSBR521 -00233 10 FILLER PIC X(32) DTSBR521 -00234 VALUE ' RATE ASSIGNMENT SUMMARY REPORT '. DTSBR521 -00235 05 HDR-LINE-5. DTSBR521 -00236 10 FILLER PIC X(60) VALUE SPACES. DTSBR521 -00237 10 FILLER PIC X(06) DTSBR521 -00238 VALUE 'TABLE '. DTSBR521 -00239 10 WS-FUIR-RATE-TABLE PIC X(05). DTSBR521 -00240 05 HDR-LINE-6 PIC X(133) VALUE SPACES. DTSBR521 -00241 05 HDR-LINE-7. DTSBR521 -00242 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00243 10 FILLER PIC X(20) DTSBR521 -00244 VALUE 'RATE EFFECTIVE QTR: '. DTSBR521 -00245 10 HDR-EFF-QTR-UNPACK PIC 99/9. DTSBR521 -00246 05 HDR-LINE-8 PIC X(133) VALUE SPACES. DTSBR521 -00247 05 HDR-LINE-9. DTSBR521 -00248 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00249 10 FILLER PIC X(40) DTSBR521 -00250 VALUE ' MIN MAX UI EMPLYR UI TAX PAI'. DTSBR521 -00251 10 FILLER PIC X(40) DTSBR521 -00252 VALUE 'D TRUST FUND INT BENFTS CHRGD CUR'. DTSBR521 -00253 10 FILLER PIC X(40) DTSBR521 -00254 VALUE 'RENT RESERVE TAXABLE WAGES TA'. DTSBR521 -00255 10 FILLER PIC X(11) DTSBR521 -00256 VALUE 'XABLE WAGES'. DTSBR521 -00257 05 HDR-LINE-10. DTSBR521 -00258 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00259 10 FILLER PIC X(27) DTSBR521 -00260 VALUE 'RATIO RATIO RATE COUNT '. DTSBR521 -00261 10 FILLER PIC X(03) VALUE SPACES. DTSBR521 -00262 10 HDR-TAX-PD-FROM-THRU PIC X(11). DTSBR521 -00263 10 FILLER PIC X(05) VALUE SPACES. DTSBR521 -00264 10 HDR-TRUST-FND-FROM-THRU PIC X(11). DTSBR521 -00265 10 FILLER PIC X(05) VALUE SPACES. DTSBR521 -00266 10 HDR-BENEF-CHG-FROM-THRU PIC X(11). DTSBR521 -00267 10 FILLER PIC X(11) VALUE SPACES. DTSBR521 -00268 10 WS-CURR-RESERVE-DT PIC X(08). DTSBR521 -00269 10 FILLER PIC X(09) VALUE SPACES. DTSBR521 -00270 10 HDR-TAX-WAGE1-FROM-THRU PIC X(11). DTSBR521 -00271 10 FILLER PIC X(08) VALUE SPACES. DTSBR521 -00272 10 HDR-TAX-WAGE2-FROM-THRU PIC X(11). DTSBR521 -00273 DTSBR521 -00274 01 DETAIL-LINE. DTSBR521 -00275 05 DTL-LINE-2. DTSBR521 -00276 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00277 10 WS-FUIR-MIN-RATIO-D PIC X(05). DTSBR521 -00278 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00279 10 WS-FUIR-MAX-RATIO-D PIC X(05). DTSBR521 -00280 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 -00281 10 DTL-REG-UI-RATE-D PIC X(04). DTSBR521 -00282 10 FILLER PIC X(02) VALUE SPACE. DTSBR521 -00283 10 DTL-REG-EMPL-COUNT PIC ZZZ,ZZ9. DTSBR521 -00284 10 DTL-REG-UI-TAX-PAID PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00285 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00286 10 DTL-REG-TRUST-FUND-INT PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00287 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00288 10 DTL-REG-BENEFITS-CHGD PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00289 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00290 10 DTL-REG-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00291 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 -00292 10 DTL-REG-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00293 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00294 10 DTL-REG-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00295 SKIP2 DTSBR521 -00296 01 CLASSIFIED-TOTALS. DTSBR521 -00297 05 DTL-CLS-LINE-3. DTSBR521 -00298 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00299 10 FILLER PIC X(18) DTSBR521 -00300 VALUE 'CLASSIFIED TOTAL '. DTSBR521 +00199 01 L056-LINK-AREA. DTSBR521 +00200 ++INCLUDE DTSIL056 DTSBR521 +00201 EJECT DTSBR521 +00202 01 L057-LINK-AREA. DTSBR521 +00203 ++INCLUDE DTSIL057 DTSBR521 +00204 EJECT DTSBR521 +00205 01 L931-LINK-AREA. DTSBR521 +00206 ++INCLUDE DTSIL931 DTSBR521 +00207 EJECT DTSBR521 +00208 01 FSKL-REC. DTSBR521 +00209 ++INCLUDE DTSIFSKL DTSBR521 +00210 EJECT DTSBR521 +00211 01 PAGE-HEADING. DTSBR521 +00212 05 HDR-LINE-1. DTSBR521 +00213 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00214 10 FILLER PIC X(05) DTSBR521 +00215 VALUE '521R1'. DTSBR521 +00216 10 FILLER PIC X(34) VALUE SPACES. DTSBR521 +00217 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBR521 +00218 10 FILLER PIC X(28) VALUE SPACES. DTSBR521 +00219 10 FILLER PIC X(05) DTSBR521 +00220 VALUE 'DATE:'. DTSBR521 +00221 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00222 10 HDR-SYS-DATE PIC X(08). DTSBR521 +00223 05 HDR-LINE-2. DTSBR521 +00224 10 FILLER PIC X(40) VALUE SPACES. DTSBR521 +00225 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBR521 +00226 10 FILLER PIC X(28) VALUE SPACES. DTSBR521 +00227 10 FILLER PIC X(05) DTSBR521 +00228 VALUE 'TIME:'. DTSBR521 +00229 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00230 10 HDR-SYS-TIME PIC X(08). DTSBR521 +00231 05 HDR-LINE-3. DTSBR521 +00232 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00233 10 FILLER PIC X(33) DTSBR521 +00234 VALUE 'ROUTE TO: REGISTRATION AND RATES'. DTSBR521 +00235 10 FILLER PIC X(84) VALUE SPACES. DTSBR521 +00236 10 FILLER PIC X(05) DTSBR521 +00237 VALUE 'PAGE:'. DTSBR521 +00238 10 FILLER PIC X(03) VALUE SPACES. DTSBR521 +00239 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBR521 +00240 05 HDR-LINE-4. DTSBR521 +00241 10 FILLER PIC X(11) VALUE SPACES. DTSBR521 +00242 10 FILLER PIC X(20) DTSBR521 +00243 VALUE ' '. DTSBR521 +00244 10 FILLER PIC X(17) VALUE SPACES. DTSBR521 +00245 10 FILLER PIC X(32) DTSBR521 +00246 VALUE ' RATE ASSIGNMENT SUMMARY REPORT '. DTSBR521 +00247 05 HDR-LINE-5. DTSBR521 +00248 10 FILLER PIC X(60) VALUE SPACES. DTSBR521 +00249 10 FILLER PIC X(06) DTSBR521 +00250 VALUE 'TABLE '. DTSBR521 +00251 10 WS-FUIR-RATE-TABLE PIC X(05). DTSBR521 +00252 05 HDR-LINE-6 PIC X(133) VALUE SPACES. DTSBR521 +00253 05 HDR-LINE-7. DTSBR521 +00254 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00255 10 FILLER PIC X(20) DTSBR521 +00256 VALUE 'RATE EFFECTIVE QTR: '. DTSBR521 +00257 10 HDR-EFF-QTR-UNPACK PIC 99/9. DTSBR521 +00258 05 HDR-LINE-8 PIC X(133) VALUE SPACES. DTSBR521 +00259 05 HDR-LINE-9. DTSBR521 +00260 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00261 10 FILLER PIC X(43) CL**7 +00262 VALUE ' MIN MAX UI EMPLYR UI TAX PAI'. CL**8 +00263 10 FILLER PIC X(46) CL*11 +00264 VALUE 'D TRUST FUND INT BENFTS CHRGD CUR'. CL*11 +00265 10 FILLER PIC X(40) DTSBR521 +00266 VALUE 'RENT RESERVE TAXABLE WAGES TA'. CL*10 +00267 10 FILLER PIC X(11) DTSBR521 +00268 VALUE 'XABLE WAGES'. CL**9 +00269 10 FILLER PIC X(19) CL**5 +00270 VALUE ' TAXABLE WAGES'. CL**5 +00271 05 HDR-LINE-10. DTSBR521 +00272 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00273 10 FILLER PIC X(27) DTSBR521 +00274 VALUE 'RATIO RATIO RATE COUNT '. DTSBR521 +00275 10 FILLER PIC X(06) VALUE SPACES. CL*12 +00276 10 HDR-TAX-PD-FROM-THRU PIC X(11). DTSBR521 +00277 10 FILLER PIC X(08) VALUE SPACES. CL*13 +00278 10 HDR-TRUST-FND-FROM-THRU PIC X(11). DTSBR521 +00279 10 FILLER PIC X(08) VALUE SPACES. CL*13 +00280 10 HDR-BENEF-CHG-FROM-THRU PIC X(11). DTSBR521 +00281 10 FILLER PIC X(11) VALUE SPACES. DTSBR521 +00282 10 WS-CURR-RESERVE-DT PIC X(08). DTSBR521 +00283 10 FILLER PIC X(09) VALUE SPACES. DTSBR521 +00284 10 HDR-TAX-WAGE1-FROM-THRU PIC X(11). DTSBR521 +00285 10 FILLER PIC X(08) VALUE SPACES. DTSBR521 +00286 10 HDR-TAX-WAGE2-FROM-THRU PIC X(11). DTSBR521 +00287 10 FILLER PIC X(08) VALUE SPACES. CL**2 +00288 10 HDR-TAX-WAGE3-FROM-THRU PIC X(11). CL**2 +00289 DTSBR521 +00290 01 DETAIL-LINE. DTSBR521 +00291 05 DTL-LINE-2. DTSBR521 +00292 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00293 10 WS-FUIR-MIN-RATIO-D PIC X(05). DTSBR521 +00294 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00295 10 WS-FUIR-MAX-RATIO-D PIC X(05). DTSBR521 +00296 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 +00297 10 DTL-REG-UI-RATE-D PIC X(04). DTSBR521 +00298 10 FILLER PIC X(02) VALUE SPACE. DTSBR521 +00299 10 DTL-REG-EMPL-COUNT PIC ZZZ,ZZ9. DTSBR521 +00300 10 DTL-REG-UI-TAX-PAID PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 00301 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00302 10 DTL-CLS-EMPL-COUNT PIC ZZZ,ZZ9. DTSBR521 -00303 10 DTL-CLS-UI-TAX-PAID PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00304 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00305 10 DTL-CLS-TRUST-FUND-INT PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00306 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00307 10 DTL-CLS-BENEFITS-CHGD PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00308 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00309 10 DTL-CLS-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00310 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 -00311 10 DTL-CLS-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00312 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00313 10 DTL-CLS-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00314 DTSBR521 -00315 01 NONCLASSIF-TOTALS. DTSBR521 -00316 05 DTL-EMP-LINE-3. DTSBR521 -00317 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00318 10 FILLER PIC X(13) DTSBR521 -00319 VALUE 'NEW EMPLOYER '. DTSBR521 -00320 10 DTL-EMP-UI-RATE PIC X(04). DTSBR521 -00321 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 -00322 10 DTL-EMP-EMPL-COUNT PIC ZZZ,ZZ9. DTSBR521 -00323 10 DTL-EMP-UI-TAX-PAID PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 +00302 10 DTL-REG-TRUST-FUND-INT PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 +00303 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00304 10 DTL-REG-BENEFITS-CHGD PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 +00305 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00306 10 DTL-REG-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00307 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 +00308 10 DTL-REG-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00309 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00310 10 DTL-REG-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00311 10 FILLER PIC X(01) VALUE SPACE. CL**2 +00312 10 DTL-REG-TAXABLE-WAGES3 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**2 +00313 SKIP2 DTSBR521 +00314 01 CLASSIFIED-TOTALS. DTSBR521 +00315 05 DTL-CLS-LINE-3. DTSBR521 +00316 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00317 10 FILLER PIC X(18) DTSBR521 +00318 VALUE 'CLASSIFIED TOTAL '. DTSBR521 +00319 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00320 10 DTL-CLS-EMPL-COUNT PIC ZZZ,ZZ9. DTSBR521 +00321 10 DTL-CLS-UI-TAX-PAID PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 +00322 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00323 10 DTL-CLS-TRUST-FUND-INT PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 00324 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00325 10 DTL-EMP-TRUST-FUND-INT PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 +00325 10 DTL-CLS-BENEFITS-CHGD PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 00326 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00327 10 DTL-EMP-BENEFITS-CHGD PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00328 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00329 10 DTL-EMP-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00330 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 -00331 10 DTL-EMP-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00332 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00333 10 DTL-EMP-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00334 01 CONTROL-FOOTING-FINAL. DTSBR521 -00335 05 CFF-GRD-LINE-3. DTSBR521 -00336 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00337 10 FILLER PIC X(14) DTSBR521 -00338 VALUE 'GRAND TOTAL '. DTSBR521 -00339 10 FILLER PIC X(05) VALUE SPACES. DTSBR521 -00340 10 CFF-GRD-EMPLR-COUNT PIC ZZZ,ZZ9. DTSBR521 -00341 10 CFF-GRD-UI-TAX-PAID PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 -00342 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00343 10 CFF-GRD-TRUST-FUND-INT PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 +00327 10 DTL-CLS-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00328 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 +00329 10 DTL-CLS-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00330 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00331 10 DTL-CLS-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00332 10 FILLER PIC X(01) VALUE SPACE. CL**2 +00333 10 DTL-CLS-TAXABLE-WAGES3 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**2 +00334 DTSBR521 +00335 01 NONCLASSIF-TOTALS. DTSBR521 +00336 05 DTL-EMP-LINE-3. DTSBR521 +00337 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00338 10 FILLER PIC X(13) DTSBR521 +00339 VALUE 'NEW EMPLOYER '. DTSBR521 +00340 10 DTL-EMP-UI-RATE PIC X(04). DTSBR521 +00341 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 +00342 10 DTL-EMP-EMPL-COUNT PIC ZZZ,ZZ9. DTSBR521 +00343 10 DTL-EMP-UI-TAX-PAID PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 00344 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00345 10 CFF-GRD-BENEFITS-CHGD PIC -ZZZ,ZZZ,ZZ9.99. DTSBR521 +00345 10 DTL-EMP-TRUST-FUND-INT PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 00346 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00347 10 CFF-GRD-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00348 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 -00349 10 CFF-GRD-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00350 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 -00351 10 CFF-GRD-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 -00352 EJECT DTSBR521 -00353 LINKAGE SECTION. DTSBR521 -00354 SKIP3 DTSBR521 -00355 01 LRCM-LINK-AREA. DTSBR521 -00356 ++INCLUDE DTSILRCM DTSBR521 -00357 EJECT DTSBR521 -00358 01 R521-REC. DTSBR521 -00359 ++INCLUDE DTSIR521 DTSBR521 -00360 EJECT DTSBR521 -00361 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR521 -00362 R521-REC. DTSBR521 -00363 IF FIRST-TIME-IND = 'Y' DTSBR521 -00364 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR521 -00365 MOVE 'N' TO FIRST-TIME-IND. DTSBR521 -00366 DTSBR521 -00367 IF LRCM-EOR-88 DTSBR521 -00368 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR521 -00369 ELSE DTSBR521 -00370 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR521 -00371 DTSBR521 -00372 GOBACK. DTSBR521 -00373 EJECT DTSBR521 -00374 I1000-INITIATE. DTSBR521 -00375 DTSBR521 -00376 OPEN OUTPUT PRT-FILE. DTSBR521 -00377 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DTSBR521 -00378 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DTSBR521 -00379 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DTSBR521 -00380 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DTSBR521 -00381 MOVE SPACES TO PRT-RECORD. DTSBR521 -00382 DTSBR521 -00383 MOVE R521-EFF-QTR TO WS-EFF-QTR-UNPACK. DTSBR521 -00384 MOVE WS-EFF-QTR-UNPACK (3:3) TO HDR-EFF-QTR-UNPACK. DTSBR521 -00385 DTSBR521 -00386 MOVE R521-COMPUTED-RATE TO WS-FUIR-UI-RATE. DTSBR521 -00387 MOVE R521-UI-RATE-CATEGORY TO WS-UI-RATE-CATEGORY. DTSBR521 -00388 DTSBR521 -00389 PERFORM I2000-SET-FUIR-AREA THRU I2000-EXIT. DTSBR521 +00347 10 DTL-EMP-BENEFITS-CHGD PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 +00348 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00349 10 DTL-EMP-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00350 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 +00351 10 DTL-EMP-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00352 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00353 10 DTL-EMP-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00354 10 FILLER PIC X(01) VALUE SPACE. CL**2 +00355 10 DTL-EMP-TAXABLE-WAGES3 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**2 +00356 01 CONTROL-FOOTING-FINAL. DTSBR521 +00357 05 CFF-GRD-LINE-3. DTSBR521 +00358 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00359 10 FILLER PIC X(14) DTSBR521 +00360 VALUE 'GRAND TOTAL '. DTSBR521 +00361 10 FILLER PIC X(05) VALUE SPACES. DTSBR521 +00362 10 CFF-GRD-EMPLR-COUNT PIC ZZZ,ZZ9. DTSBR521 +00363 10 CFF-GRD-UI-TAX-PAID PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 +00364 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00365 10 CFF-GRD-TRUST-FUND-INT PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 +00366 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00367 10 CFF-GRD-BENEFITS-CHGD PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**6 +00368 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00369 10 CFF-GRD-CURRENT-RESERVE PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00370 10 FILLER PIC X(02) VALUE SPACES. DTSBR521 +00371 10 CFF-GRD-TAXABLE-WAGES1 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00372 10 FILLER PIC X(01) VALUE SPACE. DTSBR521 +00373 10 CFF-GRD-TAXABLE-WAGES2 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. DTSBR521 +00374 10 FILLER PIC X(01) VALUE SPACE. CL**2 +00375 10 CFF-GRD-TAXABLE-WAGES3 PIC -ZZ,ZZZ,ZZZ,ZZ9.99. CL**2 +00376 EJECT DTSBR521 +00377 LINKAGE SECTION. DTSBR521 +00378 SKIP3 DTSBR521 +00379 01 LRCM-LINK-AREA. DTSBR521 +00380 ++INCLUDE DTSILRCM DTSBR521 +00381 EJECT DTSBR521 +00382 01 R521-REC. DTSBR521 +00383 ++INCLUDE DTSIR521 DTSBR521 +00384 EJECT DTSBR521 +00385 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR521 +00386 R521-REC. DTSBR521 +00387 IF FIRST-TIME-IND = 'Y' DTSBR521 +00388 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR521 +00389 MOVE 'N' TO FIRST-TIME-IND. DTSBR521 00390 DTSBR521 -00391 PERFORM I2200-INITIALIZE-RTN THRU I2200-EXIT. DTSBR521 -00392 DTSBR521 -00393 PERFORM I3000-INIT-DATES THRU I3000-EXIT. DTSBR521 -00394 DTSBR521 -00395 PERFORM I2100-SET-RATIO THRU I2100-EXIT DTSBR521 -00396 VARYING FUIR-RATE-IDX FROM 1 BY 1 UNTIL DTSBR521 -00397 FUIR-RATE-IDX GREATER FUIR-RATE-CNT DTSBR521 -00398 DTSBR521 -00399 INITIALIZE WS-CLS-TRUST-FUND-INT DTSBR521 -00400 WS-CLS-BENEFITS-CHGD DTSBR521 -00401 WS-CLS-EMPL-COUNT DTSBR521 -00402 WS-CLS-UI-TAX-PAID DTSBR521 -00403 WS-CLS-CURRENT-RESERVE DTSBR521 -00404 WS-CLS-TAXABLE-WAGES1 DTSBR521 -00405 WS-CLS-TAXABLE-WAGES2. DTSBR521 +00391 IF LRCM-EOR-88 DTSBR521 +00392 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR521 +00393 ELSE DTSBR521 +00394 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR521 +00395 DTSBR521 +00396 GOBACK. DTSBR521 +00397 EJECT DTSBR521 +00398 I1000-INITIATE. DTSBR521 +00399 DTSBR521 +00400 OPEN OUTPUT PRT-FILE. DTSBR521 +00401 MOVE LRCM-SYS-DATE TO HDR-SYS-DATE. DTSBR521 +00402 MOVE LRCM-SYS-TIME TO HDR-SYS-TIME. DTSBR521 +00403 MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1. DTSBR521 +00404 MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2. DTSBR521 +00405 MOVE SPACES TO PRT-RECORD. DTSBR521 00406 DTSBR521 -00407 INITIALIZE WS-EMP-UI-TAX-PAID DTSBR521 -00408 WS-EMP-TRUST-FUND-INT DTSBR521 -00409 WS-EMP-BENEFITS-CHGD DTSBR521 -00410 WS-EMP-EMPL-COUNT DTSBR521 -00411 WS-EMP-UI-RATE DTSBR521 -00412 WS-EMP-CURRENT-RESERVE DTSBR521 -00413 WS-EMP-TAXABLE-WAGES1 DTSBR521 -00414 WS-EMP-TAXABLE-WAGES2. DTSBR521 -00415 DTSBR521 -00416 INITIALIZE WS-GRD-TAXABLE-WAGES1 DTSBR521 -00417 WS-GRD-TAXABLE-WAGES2 DTSBR521 -00418 WS-GRD-TRUST-FUND-INT DTSBR521 -00419 WS-GRD-BENEFITS-CHGD DTSBR521 -00420 WS-GRD-EMPLR-COUNT DTSBR521 -00421 WS-GRD-UI-TAX-PAID DTSBR521 -00422 WS-GRD-CURRENT-RESERVE. DTSBR521 -00423 I1000-EXIT. DTSBR521 -00424 EXIT. DTSBR521 -00425 DTSBR521 -00426 I2000-SET-FUIR-AREA. DTSBR521 -00427 DTSBR521 -00428 MOVE LOW-VALUES TO FUIR-KEY-AREA. DTSBR521 -00429 DTSBR521 -00430 SET FUIR-UIR-88 TO TRUE. DTSBR521 +00407 MOVE R521-EFF-QTR TO WS-EFF-QTR-UNPACK. DTSBR521 +00408 MOVE WS-EFF-QTR-UNPACK (3:3) TO HDR-EFF-QTR-UNPACK. DTSBR521 +00409 DTSBR521 +00410 MOVE R521-COMPUTED-RATE TO WS-FUIR-UI-RATE. DTSBR521 +00411 MOVE R521-UI-RATE-CATEGORY TO WS-UI-RATE-CATEGORY. DTSBR521 +00412 DTSBR521 +00413 PERFORM I2000-SET-FUIR-AREA THRU I2000-EXIT. DTSBR521 +00414 DTSBR521 +00415 PERFORM I2200-INITIALIZE-RTN THRU I2200-EXIT. DTSBR521 +00416 DTSBR521 +00417 PERFORM I3000-INIT-DATES THRU I3000-EXIT. DTSBR521 +00418 DTSBR521 +00419 PERFORM I2100-SET-RATIO THRU I2100-EXIT DTSBR521 +00420 VARYING FUIR-RATE-IDX FROM 1 BY 1 UNTIL DTSBR521 +00421 FUIR-RATE-IDX GREATER FUIR-RATE-CNT DTSBR521 +00422 DTSBR521 +00423 INITIALIZE WS-CLS-TRUST-FUND-INT DTSBR521 +00424 WS-CLS-BENEFITS-CHGD DTSBR521 +00425 WS-CLS-EMPL-COUNT DTSBR521 +00426 WS-CLS-UI-TAX-PAID DTSBR521 +00427 WS-CLS-CURRENT-RESERVE DTSBR521 +00428 WS-CLS-TAXABLE-WAGES1 DTSBR521 +00429 WS-CLS-TAXABLE-WAGES2 CL**2 +00430 WS-CLS-TAXABLE-WAGES3. CL**2 00431 DTSBR521 -00432 MOVE R521-EFF-QTR TO FUIR-EFF-YRQ. DTSBR521 -00433 DTSBR521 -00434 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBR521 -00435 DTSBR521 -00436 PERFORM S931-READ THRU S931-EXIT. DTSBR521 -00437 DTSBR521 -00438 IF L931-NO-REC-88 DTSBR521 -00439 MOVE 'NO FUIR RECORD OCCURRENCE FOR RATE YEAR' DTSBR521 -00440 TO ABEND-MSG DTSBR521 -00441 PERFORM S999-ABEND THRU S999-EXIT. DTSBR521 -00442 DTSBR521 -00443 MOVE FSKL-REC TO FUIR-REC. DTSBR521 -00444 DTSBR521 -00445 MOVE FUIR-RATE-TABLE TO WS-FUIR-RATE-TABLE. DTSBR521 -00446 DTSBR521 -00447 I2000-EXIT. DTSBR521 -00448 EXIT. DTSBR521 -00449 DTSBR521 -00450 I2100-SET-RATIO. DTSBR521 -00451 MOVE ZEROES TO WS-FUIR-UI-RATE . DTSBR521 -00452 MOVE ZEROES TO WS-FUIR-MIN-RATIO. DTSBR521 -00453 MOVE ZEROES TO WS-FUIR-MAX-RATIO. DTSBR521 +00432 INITIALIZE WS-EMP-UI-TAX-PAID DTSBR521 +00433 WS-EMP-TRUST-FUND-INT DTSBR521 +00434 WS-EMP-BENEFITS-CHGD DTSBR521 +00435 WS-EMP-EMPL-COUNT DTSBR521 +00436 WS-EMP-UI-RATE DTSBR521 +00437 WS-EMP-CURRENT-RESERVE DTSBR521 +00438 WS-EMP-TAXABLE-WAGES1 DTSBR521 +00439 WS-EMP-TAXABLE-WAGES2 CL**2 +00440 WS-EMP-TAXABLE-WAGES3. CL**2 +00441 DTSBR521 +00442 INITIALIZE WS-GRD-TAXABLE-WAGES1 DTSBR521 +00443 WS-GRD-TAXABLE-WAGES2 DTSBR521 +00444 WS-GRD-TAXABLE-WAGES3 CL**2 +00445 WS-GRD-TRUST-FUND-INT DTSBR521 +00446 WS-GRD-BENEFITS-CHGD DTSBR521 +00447 WS-GRD-EMPLR-COUNT DTSBR521 +00448 WS-GRD-UI-TAX-PAID DTSBR521 +00449 WS-GRD-CURRENT-RESERVE. DTSBR521 +00450 I1000-EXIT. DTSBR521 +00451 EXIT. DTSBR521 +00452 DTSBR521 +00453 I2000-SET-FUIR-AREA. DTSBR521 00454 DTSBR521 -00455 IF R521-RATE-NONCLASSIFIED-88 DTSBR521 -00456 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WS-FUIR-UI-RATE DTSBR521 -00457 PERFORM I2300-CNV-RATIO THRU I2300-EXIT DTSBR521 -00458 MOVE WS-FUIR-UI-RATE-D TO WS-EMP-UI-RATE DTSBR521 -00459 SET FUIR-RATE-IDX TO FUIR-RATE-CNT DTSBR521 -00460 ELSE DTSBR521 -00461 IF FUIR-UI-RATE (FUIR-RATE-IDX) = R521-COMPUTED-RATE DTSBR521 -00462 MOVE FUIR-MIN-RATIO (FUIR-RATE-IDX) TO DTSBR521 -00463 WS-FUIR-MIN-RATIO DTSBR521 -00464 MOVE FUIR-MAX-RATIO (FUIR-RATE-IDX) TO DTSBR521 -00465 WS-FUIR-MAX-RATIO DTSBR521 -00466 MOVE FUIR-UI-RATE (FUIR-RATE-IDX) TO DTSBR521 -00467 WS-FUIR-UI-RATE DTSBR521 -00468 PERFORM I2300-CNV-RATIO THRU I2300-EXIT DTSBR521 -00469 SET FUIR-RATE-IDX TO FUIR-RATE-CNT DTSBR521 -00470 END-IF. DTSBR521 -00471 I2100-EXIT. DTSBR521 -00472 EXIT. DTSBR521 +00455 MOVE LOW-VALUES TO FUIR-KEY-AREA. DTSBR521 +00456 DTSBR521 +00457 SET FUIR-UIR-88 TO TRUE. DTSBR521 +00458 DTSBR521 +00459 MOVE R521-EFF-QTR TO FUIR-EFF-YRQ. DTSBR521 +00460 DTSBR521 +00461 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBR521 +00462 DTSBR521 +00463 PERFORM S931-READ THRU S931-EXIT. DTSBR521 +00464 DTSBR521 +00465 IF L931-NO-REC-88 DTSBR521 +00466 MOVE 'NO FUIR RECORD OCCURRENCE FOR RATE YEAR' DTSBR521 +00467 TO ABEND-MSG DTSBR521 +00468 PERFORM S999-ABEND THRU S999-EXIT. DTSBR521 +00469 DTSBR521 +00470 MOVE FSKL-REC TO FUIR-REC. DTSBR521 +00471 DTSBR521 +00472 MOVE FUIR-RATE-TABLE TO WS-FUIR-RATE-TABLE. DTSBR521 00473 DTSBR521 -00474 I2200-INITIALIZE-RTN. DTSBR521 -00475 INITIALIZE WS-REG-TRUST-FUND-INT DTSBR521 -00476 WS-REG-BENEFITS-CHGD DTSBR521 -00477 WS-REG-EMPL-COUNT DTSBR521 -00478 WS-REG-UI-RATE DTSBR521 -00479 WS-REG-UI-RATE-D DTSBR521 -00480 WS-REG-UI-TAX-PAID DTSBR521 -00481 WS-REG-CURRENT-RESERVE DTSBR521 -00482 WS-REG-TAXABLE-WAGES1 DTSBR521 -00483 WS-REG-TAXABLE-WAGES2. DTSBR521 -00484 I2200-EXIT. DTSBR521 -00485 EXIT. DTSBR521 -00486 DTSBR521 -00487 I2300-CNV-RATIO. DTSBR521 -00488 IF WS-FUIR-UI-RATE > 0 DTSBR521 -00489 MOVE WS-FUIR-UI-RATE TO L056-RATE DTSBR521 -00490 SET L056-DISP1-RIGHT-88 TO TRUE DTSBR521 -00491 PERFORM S056-RATE-DISPLAY DTSBR521 -00492 THRU S056-EXIT DTSBR521 -00493 MOVE L056-DISP-RATE TO WS-FUIR-UI-RATE-D DTSBR521 -00494 DTSBR521 -00495 MOVE WS-FUIR-MIN-RATIO TO L057-RATIO DTSBR521 -00496 PERFORM S057-RATIO-DISPLAY DTSBR521 -00497 THRU S057-EXIT DTSBR521 -00498 MOVE L057-DISP-RATIO TO WS-FUIR-MIN-RATIO-D DTSBR521 -00499 DTSBR521 -00500 MOVE WS-FUIR-MAX-RATIO TO L057-RATIO DTSBR521 -00501 PERFORM S057-RATIO-DISPLAY DTSBR521 -00502 THRU S057-EXIT DTSBR521 -00503 MOVE L057-DISP-RATIO TO WS-FUIR-MAX-RATIO-D DTSBR521 -00504 DTSBR521 -00505 ELSE DTSBR521 -00506 MOVE 'UI RATES NOT LOADED CORRECTLY' DTSBR521 -00507 TO ABEND-MSG DTSBR521 -00508 PERFORM S999-ABEND THRU S999-EXIT. DTSBR521 -00509 I2300-EXIT. DTSBR521 -00510 EXIT. DTSBR521 -00511 DTSBR521 -00512 I3000-INIT-DATES. DTSBR521 -00513 SKIP1 DTSBR521 -00514 MOVE R521-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSBR521 -00515 SET L001-FROM-FED-8 TO TRUE. DTSBR521 -00516 PERFORM S001-DATE THRU S001-EXIT. DTSBR521 -00517 MOVE L001-SLASH-DATE TO WS-CURR-RESERVE-DT. DTSBR521 -00518 SKIP1 DTSBR521 -00519 IF R521-UI-TAX-PAID-FROM-YRQ GREATER ZEROS DTSBR521 -00520 MOVE R521-UI-TAX-PAID-FROM-YRQ TO DTSBR521 -00521 L004-QTR-5-9 DTSBR521 -00522 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00523 MOVE L004-SLASH-QTR TO WS-TAX-PD-FROM-DT DTSBR521 -00524 ELSE DTSBR521 -00525 MOVE SPACES TO WS-TAX-PD-FROM-DT DTSBR521 -00526 END-IF. DTSBR521 +00474 I2000-EXIT. DTSBR521 +00475 EXIT. DTSBR521 +00476 DTSBR521 +00477 I2100-SET-RATIO. DTSBR521 +00478 MOVE ZEROES TO WS-FUIR-UI-RATE . DTSBR521 +00479 MOVE ZEROES TO WS-FUIR-MIN-RATIO. DTSBR521 +00480 MOVE ZEROES TO WS-FUIR-MAX-RATIO. DTSBR521 +00481 DTSBR521 +00482 IF R521-RATE-NONCLASSIFIED-88 DTSBR521 +00483 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WS-FUIR-UI-RATE DTSBR521 +00484 PERFORM I2300-CNV-RATIO THRU I2300-EXIT DTSBR521 +00485 MOVE WS-FUIR-UI-RATE-D TO WS-EMP-UI-RATE DTSBR521 +00486 SET FUIR-RATE-IDX TO FUIR-RATE-CNT DTSBR521 +00487 ELSE DTSBR521 +00488 IF FUIR-UI-RATE (FUIR-RATE-IDX) = R521-COMPUTED-RATE DTSBR521 +00489 MOVE FUIR-MIN-RATIO (FUIR-RATE-IDX) TO DTSBR521 +00490 WS-FUIR-MIN-RATIO DTSBR521 +00491 MOVE FUIR-MAX-RATIO (FUIR-RATE-IDX) TO DTSBR521 +00492 WS-FUIR-MAX-RATIO DTSBR521 +00493 MOVE FUIR-UI-RATE (FUIR-RATE-IDX) TO DTSBR521 +00494 WS-FUIR-UI-RATE DTSBR521 +00495 PERFORM I2300-CNV-RATIO THRU I2300-EXIT DTSBR521 +00496 SET FUIR-RATE-IDX TO FUIR-RATE-CNT DTSBR521 +00497 END-IF. DTSBR521 +00498 I2100-EXIT. DTSBR521 +00499 EXIT. DTSBR521 +00500 DTSBR521 +00501 I2200-INITIALIZE-RTN. DTSBR521 +00502 INITIALIZE WS-REG-TRUST-FUND-INT DTSBR521 +00503 WS-REG-BENEFITS-CHGD DTSBR521 +00504 WS-REG-EMPL-COUNT DTSBR521 +00505 WS-REG-UI-RATE DTSBR521 +00506 WS-REG-UI-RATE-D DTSBR521 +00507 WS-REG-UI-TAX-PAID DTSBR521 +00508 WS-REG-CURRENT-RESERVE DTSBR521 +00509 WS-REG-TAXABLE-WAGES1 DTSBR521 +00510 WS-REG-TAXABLE-WAGES2 CL**2 +00511 WS-REG-TAXABLE-WAGES3. CL**2 +00512 I2200-EXIT. DTSBR521 +00513 EXIT. DTSBR521 +00514 DTSBR521 +00515 I2300-CNV-RATIO. DTSBR521 +00516 IF WS-FUIR-UI-RATE > 0 DTSBR521 +00517 MOVE WS-FUIR-UI-RATE TO L056-RATE DTSBR521 +00518 SET L056-DISP1-RIGHT-88 TO TRUE DTSBR521 +00519 PERFORM S056-RATE-DISPLAY DTSBR521 +00520 THRU S056-EXIT DTSBR521 +00521 MOVE L056-DISP-RATE TO WS-FUIR-UI-RATE-D DTSBR521 +00522 DTSBR521 +00523 MOVE WS-FUIR-MIN-RATIO TO L057-RATIO DTSBR521 +00524 PERFORM S057-RATIO-DISPLAY DTSBR521 +00525 THRU S057-EXIT DTSBR521 +00526 MOVE L057-DISP-RATIO TO WS-FUIR-MIN-RATIO-D DTSBR521 00527 DTSBR521 -00528 IF R521-UI-TAX-PAID-THRU-YRQ GREATER ZEROS DTSBR521 -00529 MOVE R521-UI-TAX-PAID-THRU-YRQ TO DTSBR521 -00530 L004-QTR-5-9 DTSBR521 -00531 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00532 MOVE L004-SLASH-QTR TO WS-TAX-PD-THRU-DT DTSBR521 -00533 ELSE DTSBR521 -00534 MOVE SPACES TO WS-TAX-PD-THRU-DT DTSBR521 -00535 END-IF. DTSBR521 -00536 DTSBR521 -00537 MOVE WS-TAX-PD-FROM-THRU TO HDR-TAX-PD-FROM-THRU. DTSBR521 -00538 DTSBR521 -00539 IF R521-TRUST-FUND-INT-FROM-YRQ GREATER ZEROES DTSBR521 -00540 MOVE R521-TRUST-FUND-INT-FROM-YRQ TO DTSBR521 -00541 L004-QTR-5-9 DTSBR521 -00542 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00543 MOVE L004-SLASH-QTR TO WS-TRUST-FROM-DT DTSBR521 -00544 ELSE DTSBR521 -00545 MOVE SPACES TO WS-TRUST-FROM-DT DTSBR521 -00546 END-IF. DTSBR521 -00547 IF R521-TRUST-FUND-INT-THRU-YRQ GREATER ZEROS DTSBR521 -00548 MOVE R521-TRUST-FUND-INT-THRU-YRQ TO DTSBR521 +00528 MOVE WS-FUIR-MAX-RATIO TO L057-RATIO DTSBR521 +00529 PERFORM S057-RATIO-DISPLAY DTSBR521 +00530 THRU S057-EXIT DTSBR521 +00531 MOVE L057-DISP-RATIO TO WS-FUIR-MAX-RATIO-D DTSBR521 +00532 DTSBR521 +00533 ELSE DTSBR521 +00534 MOVE 'UI RATES NOT LOADED CORRECTLY' DTSBR521 +00535 TO ABEND-MSG DTSBR521 +00536 PERFORM S999-ABEND THRU S999-EXIT. DTSBR521 +00537 I2300-EXIT. DTSBR521 +00538 EXIT. DTSBR521 +00539 DTSBR521 +00540 I3000-INIT-DATES. DTSBR521 +00541 SKIP1 DTSBR521 +00542 MOVE R521-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSBR521 +00543 SET L001-FROM-FED-8 TO TRUE. DTSBR521 +00544 PERFORM S001-DATE THRU S001-EXIT. DTSBR521 +00545 MOVE L001-SLASH-DATE TO WS-CURR-RESERVE-DT. DTSBR521 +00546 SKIP1 DTSBR521 +00547 IF R521-UI-TAX-PAID-FROM-YRQ GREATER ZEROS DTSBR521 +00548 MOVE R521-UI-TAX-PAID-FROM-YRQ TO DTSBR521 00549 L004-QTR-5-9 DTSBR521 00550 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00551 MOVE L004-SLASH-QTR TO WS-TRUST-THRU-DT DTSBR521 +00551 MOVE L004-SLASH-QTR TO WS-TAX-PD-FROM-DT DTSBR521 00552 ELSE DTSBR521 -00553 MOVE SPACES TO WS-TRUST-THRU-DT DTSBR521 +00553 MOVE SPACES TO WS-TAX-PD-FROM-DT DTSBR521 00554 END-IF. DTSBR521 00555 DTSBR521 -00556 MOVE WS-TRUST-FND-FROM-THRU TO HDR-TRUST-FND-FROM-THRU. DTSBR521 -00557 DTSBR521 -00558 IF R521-UI-BEN-CHGD-FROM-YRQ GREATER ZEROS DTSBR521 -00559 MOVE R521-UI-BEN-CHGD-FROM-YRQ TO DTSBR521 -00560 L004-QTR-5-9 DTSBR521 -00561 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00562 MOVE L004-SLASH-QTR TO WS-BENEF-FROM-DT DTSBR521 -00563 ELSE DTSBR521 -00564 MOVE SPACES TO WS-BENEF-FROM-DT DTSBR521 -00565 END-IF. DTSBR521 -00566 IF R521-UI-BEN-CHGD-FROM-YRQ GREATER ZEROS DTSBR521 -00567 MOVE R521-UI-BEN-CHGD-FROM-YRQ TO DTSBR521 -00568 L004-QTR-5-9 DTSBR521 -00569 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00570 MOVE L004-SLASH-QTR TO WS-BENEF-THRU-DT DTSBR521 -00571 ELSE DTSBR521 -00572 MOVE SPACES TO WS-BENEF-THRU-DT DTSBR521 -00573 END-IF. DTSBR521 -00574 DTSBR521 -00575 MOVE WS-BENEFIT-CHG-FROM-THRU TO HDR-BENEF-CHG-FROM-THRU. DTSBR521 -00576 DTSBR521 -00577 PERFORM P2000-TAX-QTRS THRU P2000-EXIT VARYING DTSBR521 -00578 R521-WAGES-YRQ-IDX FROM 1 BY 1 UNTIL DTSBR521 -00579 R521-WAGES-YRQ-IDX > 2. DTSBR521 -00580 I3000-EXIT. DTSBR521 -00581 EXIT. DTSBR521 -00582 EJECT DTSBR521 -00583 P1000-PROCESS. DTSBR521 -00584 DTSBR521 -00585 PERFORM P3000-TAX-WAGES THRU P3000-EXIT VARYING DTSBR521 -00586 R521-TAX-WAGE-IDX FROM 1 BY 1 UNTIL DTSBR521 -00587 R521-TAX-WAGE-IDX > 2. DTSBR521 -00588 DTSBR521 -00589 IF R521-COMPUTED-RATE = WS-FUIR-UI-RATE DTSBR521 -00590 IF R521-UI-RATE-CATEGORY = WS-UI-RATE-CATEGORY DTSBR521 -00591 MOVE WS-FUIR-UI-RATE-D TO WS-REG-UI-RATE-D DTSBR521 -00592 MOVE WS-REG-UI-RATE-D (4:4) TO DTL-REG-UI-RATE-D DTSBR521 -00593 ELSE DTSBR521 -00594 PERFORM P1200-EMPLR-CATEGORY THRU P1200-EXIT DTSBR521 -00595 PERFORM P1300-RESET-TOTALS THRU P1300-EXIT DTSBR521 -00596 ELSE DTSBR521 -00597 DTSBR521 -00598 MOVE WS-REG-EMPL-COUNT TO DTL-REG-EMPL-COUNT DTSBR521 -00599 MOVE WS-REG-UI-TAX-PAID TO DTL-REG-UI-TAX-PAID DTSBR521 -00600 MOVE WS-REG-TRUST-FUND-INT TO DTL-REG-TRUST-FUND-INT DTSBR521 -00601 MOVE WS-REG-BENEFITS-CHGD TO DTL-REG-BENEFITS-CHGD DTSBR521 -00602 MOVE WS-REG-CURRENT-RESERVE TO DTL-REG-CURRENT-RESERVE DTSBR521 -00603 MOVE WS-REG-TAXABLE-WAGES1 TO DTL-REG-TAXABLE-WAGES1 DTSBR521 -00604 MOVE WS-REG-TAXABLE-WAGES2 TO DTL-REG-TAXABLE-WAGES2 DTSBR521 -00605 DTSBR521 -00606 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 -00607 WRITE PRT-RECORD FROM DTL-LINE-2 AFTER 2 DTSBR521 -00608 ADD +2 TO WS-LINE-CNT2 DTSBR521 -00609 DTSBR521 -00610 MOVE R521-COMPUTED-RATE TO WS-FUIR-UI-RATE DTSBR521 -00611 MOVE R521-UI-RATE-CATEGORY TO WS-UI-RATE-CATEGORY DTSBR521 -00612 PERFORM P1300-RESET-TOTALS THRU P1300-EXIT DTSBR521 -00613 PERFORM I2100-SET-RATIO THRU I2100-EXIT DTSBR521 -00614 VARYING FUIR-RATE-IDX FROM 1 BY 1 UNTIL DTSBR521 -00615 FUIR-RATE-IDX GREATER FUIR-RATE-CNT DTSBR521 -00616 MOVE WS-FUIR-UI-RATE-D TO WS-REG-UI-RATE-D DTSBR521 -00617 MOVE WS-REG-UI-RATE-D (4:4) TO DTL-REG-UI-RATE-D DTSBR521 -00618 END-IF. DTSBR521 -00619 DTSBR521 -00620 PERFORM P1100-ADD-REGULAR THRU P1100-EXIT. DTSBR521 -00621 PERFORM P1050-EMPLR-CLASS THRU P1050-EXIT. DTSBR521 -00622 P1000-EXIT. DTSBR521 -00623 EXIT. DTSBR521 -00624 EJECT DTSBR521 -00625 P1050-EMPLR-CLASS. DTSBR521 -00626 IF R521-RATE-CLASSIFIED-88 DTSBR521 -00627 ADD R521-TRUST-FUND-INTEREST-AMT TO DTSBR521 -00628 WS-CLS-TRUST-FUND-INT DTSBR521 -00629 ADD R521-BENEFITS-CHARGED-AMT TO DTSBR521 -00630 WS-CLS-BENEFITS-CHGD DTSBR521 -00631 ADD R521-UI-TAX-PAID-AMT TO DTSBR521 -00632 WS-CLS-UI-TAX-PAID DTSBR521 -00633 ADD R521-CURRENT-RESERVE-AMT TO DTSBR521 -00634 WS-CLS-CURRENT-RESERVE DTSBR521 -00635 ADD WS-OUT-TAXABLE-WAGES1 TO DTSBR521 -00636 WS-CLS-TAXABLE-WAGES1 DTSBR521 -00637 ADD WS-OUT-TAXABLE-WAGES2 TO DTSBR521 -00638 WS-CLS-TAXABLE-WAGES2 DTSBR521 -00639 ADD 1 TO WS-CLS-EMPL-COUNT DTSBR521 -00640 END-IF. DTSBR521 -00641 DTSBR521 -00642 IF R521-RATE-NONCLASSIFIED-88 DTSBR521 -00643 ADD R521-TRUST-FUND-INTEREST-AMT TO DTSBR521 -00644 WS-EMP-TRUST-FUND-INT DTSBR521 -00645 ADD R521-BENEFITS-CHARGED-AMT TO DTSBR521 -00646 WS-EMP-BENEFITS-CHGD DTSBR521 -00647 ADD R521-UI-TAX-PAID-AMT TO DTSBR521 -00648 WS-EMP-UI-TAX-PAID DTSBR521 -00649 ADD R521-CURRENT-RESERVE-AMT TO DTSBR521 -00650 WS-EMP-CURRENT-RESERVE DTSBR521 -00651 ADD WS-OUT-TAXABLE-WAGES1 TO DTSBR521 -00652 WS-EMP-TAXABLE-WAGES1 DTSBR521 -00653 ADD WS-OUT-TAXABLE-WAGES2 TO DTSBR521 -00654 WS-EMP-TAXABLE-WAGES2 DTSBR521 -00655 ADD 1 TO WS-EMP-EMPL-COUNT DTSBR521 -00656 END-IF. DTSBR521 -00657 DTSBR521 -00658 P1050-EXIT. DTSBR521 -00659 EXIT. DTSBR521 -00660 DTSBR521 -00661 P1100-ADD-REGULAR. DTSBR521 -00662 ADD R521-TRUST-FUND-INTEREST-AMT TO DTSBR521 -00663 WS-REG-TRUST-FUND-INT. DTSBR521 -00664 ADD R521-BENEFITS-CHARGED-AMT TO DTSBR521 -00665 WS-REG-BENEFITS-CHGD. DTSBR521 -00666 ADD R521-UI-TAX-PAID-AMT TO DTSBR521 -00667 WS-REG-UI-TAX-PAID. DTSBR521 -00668 ADD R521-CURRENT-RESERVE-AMT TO DTSBR521 -00669 WS-REG-CURRENT-RESERVE. DTSBR521 -00670 ADD WS-OUT-TAXABLE-WAGES1 TO DTSBR521 -00671 WS-REG-TAXABLE-WAGES1. DTSBR521 -00672 ADD WS-OUT-TAXABLE-WAGES2 TO DTSBR521 -00673 WS-REG-TAXABLE-WAGES2. DTSBR521 -00674 ADD 1 TO WS-REG-EMPL-COUNT. DTSBR521 -00675 P1100-EXIT. DTSBR521 -00676 EXIT. DTSBR521 -00677 DTSBR521 -00678 P1200-EMPLR-CATEGORY. DTSBR521 -00679 MOVE R521-COMPUTED-RATE TO WS-FUIR-UI-RATE DTSBR521 -00680 MOVE R521-UI-RATE-CATEGORY TO WS-UI-RATE-CATEGORY. DTSBR521 -00681 P1200-EXIT. DTSBR521 -00682 EXIT. DTSBR521 -00683 DTSBR521 -00684 P1300-RESET-TOTALS. DTSBR521 -00685 INITIALIZE WS-REG-TRUST-FUND-INT DTSBR521 -00686 WS-REG-BENEFITS-CHGD DTSBR521 -00687 WS-REG-EMPL-COUNT DTSBR521 -00688 WS-REG-UI-TAX-PAID DTSBR521 -00689 WS-REG-CURRENT-RESERVE DTSBR521 -00690 WS-REG-TAXABLE-WAGES1 DTSBR521 -00691 WS-REG-TAXABLE-WAGES2. DTSBR521 -00692 P1300-EXIT. DTSBR521 -00693 EXIT. DTSBR521 -00694 DTSBR521 -00695 P2000-TAX-QTRS. DTSBR521 -00696 DTSBR521 -00697 IF R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) > 0 DTSBR521 -00698 MOVE R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) DTSBR521 -00699 TO L004-QTR-5-9 DTSBR521 -00700 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00701 MOVE L004-SLASH-QTR TO WS-TAX-QTR-FROM DTSBR521 -00702 ELSE DTSBR521 -00703 MOVE SPACES TO WS-TAX-QTR-FROM DTSBR521 -00704 END-IF. DTSBR521 -00705 IF R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) > 0 DTSBR521 -00706 MOVE R521-WAGES-THRU-YRQ (R521-WAGES-YRQ-IDX) DTSBR521 -00707 TO L004-QTR-5-9 DTSBR521 -00708 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 -00709 MOVE L004-SLASH-QTR TO WS-TAX-QTR-THRU DTSBR521 -00710 ELSE DTSBR521 -00711 MOVE SPACES TO WS-TAX-QTR-THRU DTSBR521 -00712 END-IF. DTSBR521 -00713 EVALUATE TRUE DTSBR521 -00714 WHEN R521-WAGES-YRQ-IDX = 1 DTSBR521 -00715 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGE1-FROM DTSBR521 -00716 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGE1-THRU DTSBR521 -00717 MOVE WS-TAX-WAGE1-FROM-THRU TO DTSBR521 -00718 HDR-TAX-WAGE1-FROM-THRU DTSBR521 -00719 WHEN R521-WAGES-YRQ-IDX = 2 DTSBR521 -00720 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGE2-FROM DTSBR521 -00721 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGE2-THRU DTSBR521 -00722 MOVE WS-TAX-WAGE2-FROM-THRU TO DTSBR521 -00723 HDR-TAX-WAGE2-FROM-THRU DTSBR521 -00724 END-EVALUATE. DTSBR521 -00725 DTSBR521 -00726 P2000-EXIT. DTSBR521 -00727 EXIT. DTSBR521 -00728 P3000-TAX-WAGES. DTSBR521 -00729 EVALUATE TRUE DTSBR521 -00730 WHEN R521-TAX-WAGE-IDX = 1 DTSBR521 -00731 MOVE R521-TAX-WAGE (R521-TAX-WAGE-IDX) TO DTSBR521 -00732 WS-OUT-TAXABLE-WAGES1 DTSBR521 -00733 WHEN R521-TAX-WAGE-IDX = 2 DTSBR521 -00734 MOVE R521-TAX-WAGE (R521-TAX-WAGE-IDX) TO DTSBR521 -00735 WS-OUT-TAXABLE-WAGES2 DTSBR521 -00736 END-EVALUATE. DTSBR521 -00737 P3000-EXIT. DTSBR521 -00738 EXIT. DTSBR521 -00739 DTSBR521 -00740 P4000-GRAND-TOTALS. DTSBR521 -00741 DTSBR521 -00742 ADD WS-CLS-EMPL-COUNT WS-EMP-EMPL-COUNT DTSBR521 -00743 GIVING WS-GRD-EMPLR-COUNT. DTSBR521 -00744 ADD WS-CLS-TRUST-FUND-INT WS-EMP-TRUST-FUND-INT DTSBR521 -00745 GIVING WS-GRD-TRUST-FUND-INT. DTSBR521 -00746 ADD WS-CLS-BENEFITS-CHGD WS-EMP-BENEFITS-CHGD DTSBR521 -00747 GIVING WS-GRD-BENEFITS-CHGD. DTSBR521 -00748 ADD WS-CLS-UI-TAX-PAID WS-EMP-UI-TAX-PAID DTSBR521 -00749 GIVING WS-GRD-UI-TAX-PAID. DTSBR521 -00750 ADD WS-CLS-CURRENT-RESERVE WS-EMP-CURRENT-RESERVE DTSBR521 -00751 GIVING WS-GRD-CURRENT-RESERVE. DTSBR521 -00752 ADD WS-CLS-TAXABLE-WAGES1 WS-EMP-TAXABLE-WAGES1 DTSBR521 -00753 GIVING WS-GRD-TAXABLE-WAGES1. DTSBR521 -00754 ADD WS-CLS-TAXABLE-WAGES2 WS-EMP-TAXABLE-WAGES2 DTSBR521 -00755 GIVING WS-GRD-TAXABLE-WAGES2. DTSBR521 -00756 DTSBR521 -00757 P4000-EXIT. DTSBR521 -00758 EXIT. DTSBR521 -00759 DTSBR521 -00760 P5000-PRINT-HEADER. DTSBR521 -00761 IF WS-LINE-CNT GREATER 58 OR DTSBR521 -00762 WS-LINE-CNT2 GREATER 58 DTSBR521 -00763 MOVE +0 TO WS-LINE-CNT DTSBR521 -00764 MOVE +0 TO WS-LINE-CNT2 DTSBR521 -00765 ADD +1 TO WS-PAGE-CNT DTSBR521 -00766 MOVE WS-PAGE-CNT TO HDR-PAGE-CNT DTSBR521 -00767 WRITE PRT-RECORD FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR521 -00768 WRITE PRT-RECORD FROM HDR-LINE-2 AFTER 1 DTSBR521 -00769 WRITE PRT-RECORD FROM HDR-LINE-3 AFTER 1 DTSBR521 -00770 WRITE PRT-RECORD FROM HDR-LINE-4 AFTER 1 DTSBR521 -00771 WRITE PRT-RECORD FROM HDR-LINE-5 AFTER 1 DTSBR521 -00772 WRITE PRT-RECORD FROM HDR-LINE-6 AFTER 1 DTSBR521 -00773 WRITE PRT-RECORD FROM HDR-LINE-7 AFTER 1 DTSBR521 -00774 WRITE PRT-RECORD FROM HDR-LINE-8 AFTER 1 DTSBR521 -00775 WRITE PRT-RECORD FROM HDR-LINE-9 AFTER 1 DTSBR521 -00776 WRITE PRT-RECORD FROM HDR-LINE-10 AFTER 1 DTSBR521 -00777 ADD +10 TO WS-LINE-CNT2. DTSBR521 -00778 P5000-EXIT. DTSBR521 -00779 EXIT. DTSBR521 -00780 DTSBR521 -00781 T1000-TERMINATE. DTSBR521 -00782 DTSBR521 -00783 IF WS-LINE-CNT2 > 52 DTSBR521 -00784 ADD +6 TO WS-LINE-CNT2 DTSBR521 -00785 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 -00786 END-IF. DTSBR521 -00787 DTSBR521 -00788 MOVE WS-REG-UI-RATE-D (4:4) TO DTL-REG-UI-RATE-D. DTSBR521 -00789 MOVE WS-REG-EMPL-COUNT TO DTL-REG-EMPL-COUNT. DTSBR521 -00790 MOVE WS-REG-UI-TAX-PAID TO DTL-REG-UI-TAX-PAID. DTSBR521 -00791 MOVE WS-REG-TRUST-FUND-INT TO DTL-REG-TRUST-FUND-INT. DTSBR521 -00792 MOVE WS-REG-BENEFITS-CHGD TO DTL-REG-BENEFITS-CHGD. DTSBR521 -00793 MOVE WS-REG-CURRENT-RESERVE TO DTL-REG-CURRENT-RESERVE. DTSBR521 -00794 MOVE WS-REG-TAXABLE-WAGES1 TO DTL-REG-TAXABLE-WAGES1. DTSBR521 -00795 MOVE WS-REG-TAXABLE-WAGES2 TO DTL-REG-TAXABLE-WAGES2. DTSBR521 -00796 WRITE PRT-RECORD FROM DTL-LINE-2 AFTER 2. DTSBR521 -00797 DTSBR521 -00798 IF WS-LINE-CNT2 > 52 DTSBR521 -00799 ADD +6 TO WS-LINE-CNT2 DTSBR521 -00800 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 -00801 END-IF. DTSBR521 -00802 DTSBR521 -00803 MOVE WS-CLS-EMPL-COUNT TO DTL-CLS-EMPL-COUNT. DTSBR521 -00804 MOVE WS-CLS-UI-TAX-PAID TO DTL-CLS-UI-TAX-PAID. DTSBR521 -00805 MOVE WS-CLS-TRUST-FUND-INT TO DTL-CLS-TRUST-FUND-INT. DTSBR521 -00806 MOVE WS-CLS-BENEFITS-CHGD TO DTL-CLS-BENEFITS-CHGD. DTSBR521 -00807 MOVE WS-CLS-CURRENT-RESERVE TO DTL-CLS-CURRENT-RESERVE. DTSBR521 -00808 MOVE WS-CLS-TAXABLE-WAGES1 TO DTL-CLS-TAXABLE-WAGES1. DTSBR521 -00809 MOVE WS-CLS-TAXABLE-WAGES2 TO DTL-CLS-TAXABLE-WAGES2. DTSBR521 -00810 WRITE PRT-RECORD FROM DTL-CLS-LINE-3 AFTER 3. DTSBR521 -00811 DTSBR521 -00812 IF WS-LINE-CNT2 > 52 DTSBR521 -00813 ADD +6 TO WS-LINE-CNT2 DTSBR521 -00814 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 -00815 END-IF. DTSBR521 -00816 DTSBR521 -00817 MOVE WS-EMP-UI-RATE (4:4) TO DTL-EMP-UI-RATE. DTSBR521 -00818 MOVE WS-EMP-EMPL-COUNT TO DTL-EMP-EMPL-COUNT. DTSBR521 -00819 MOVE WS-EMP-UI-TAX-PAID TO DTL-EMP-UI-TAX-PAID. DTSBR521 -00820 MOVE WS-EMP-TRUST-FUND-INT TO DTL-EMP-TRUST-FUND-INT. DTSBR521 -00821 MOVE WS-EMP-BENEFITS-CHGD TO DTL-EMP-BENEFITS-CHGD. DTSBR521 -00822 MOVE WS-EMP-CURRENT-RESERVE TO DTL-EMP-CURRENT-RESERVE. DTSBR521 -00823 MOVE WS-EMP-TAXABLE-WAGES1 TO DTL-EMP-TAXABLE-WAGES1. DTSBR521 -00824 MOVE WS-EMP-TAXABLE-WAGES2 TO DTL-EMP-TAXABLE-WAGES2. DTSBR521 -00825 WRITE PRT-RECORD FROM DTL-EMP-LINE-3 AFTER 3. DTSBR521 -00826 DTSBR521 -00827 IF WS-LINE-CNT2 > 52 DTSBR521 -00828 ADD +6 TO WS-LINE-CNT2 DTSBR521 -00829 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 -00830 END-IF. DTSBR521 -00831 DTSBR521 -00832 PERFORM P4000-GRAND-TOTALS THRU P4000-EXIT. DTSBR521 -00833 MOVE WS-GRD-EMPLR-COUNT TO CFF-GRD-EMPLR-COUNT. DTSBR521 -00834 MOVE WS-GRD-UI-TAX-PAID TO CFF-GRD-UI-TAX-PAID. DTSBR521 -00835 MOVE WS-GRD-TRUST-FUND-INT TO CFF-GRD-TRUST-FUND-INT. DTSBR521 -00836 MOVE WS-GRD-BENEFITS-CHGD TO CFF-GRD-BENEFITS-CHGD. DTSBR521 -00837 MOVE WS-GRD-CURRENT-RESERVE TO CFF-GRD-CURRENT-RESERVE. DTSBR521 -00838 MOVE WS-GRD-TAXABLE-WAGES1 TO CFF-GRD-TAXABLE-WAGES1. DTSBR521 -00839 MOVE WS-GRD-TAXABLE-WAGES2 TO CFF-GRD-TAXABLE-WAGES2. DTSBR521 -00840 WRITE PRT-RECORD FROM CFF-GRD-LINE-3 AFTER 3. DTSBR521 +00556 IF R521-UI-TAX-PAID-THRU-YRQ GREATER ZEROS DTSBR521 +00557 MOVE R521-UI-TAX-PAID-THRU-YRQ TO DTSBR521 +00558 L004-QTR-5-9 DTSBR521 +00559 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 +00560 MOVE L004-SLASH-QTR TO WS-TAX-PD-THRU-DT DTSBR521 +00561 ELSE DTSBR521 +00562 MOVE SPACES TO WS-TAX-PD-THRU-DT DTSBR521 +00563 END-IF. DTSBR521 +00564 DTSBR521 +00565 MOVE WS-TAX-PD-FROM-THRU TO HDR-TAX-PD-FROM-THRU. DTSBR521 +00566 DTSBR521 +00567 IF R521-TRUST-FUND-INT-FROM-YRQ GREATER ZEROES DTSBR521 +00568 MOVE R521-TRUST-FUND-INT-FROM-YRQ TO DTSBR521 +00569 L004-QTR-5-9 DTSBR521 +00570 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 +00571 MOVE L004-SLASH-QTR TO WS-TRUST-FROM-DT DTSBR521 +00572 ELSE DTSBR521 +00573 MOVE SPACES TO WS-TRUST-FROM-DT DTSBR521 +00574 END-IF. DTSBR521 +00575 IF R521-TRUST-FUND-INT-THRU-YRQ GREATER ZEROS DTSBR521 +00576 MOVE R521-TRUST-FUND-INT-THRU-YRQ TO DTSBR521 +00577 L004-QTR-5-9 DTSBR521 +00578 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 +00579 MOVE L004-SLASH-QTR TO WS-TRUST-THRU-DT DTSBR521 +00580 ELSE DTSBR521 +00581 MOVE SPACES TO WS-TRUST-THRU-DT DTSBR521 +00582 END-IF. DTSBR521 +00583 DTSBR521 +00584 MOVE WS-TRUST-FND-FROM-THRU TO HDR-TRUST-FND-FROM-THRU. DTSBR521 +00585 DTSBR521 +00586 IF R521-UI-BEN-CHGD-FROM-YRQ GREATER ZEROS DTSBR521 +00587 MOVE R521-UI-BEN-CHGD-FROM-YRQ TO DTSBR521 +00588 L004-QTR-5-9 DTSBR521 +00589 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 +00590 MOVE L004-SLASH-QTR TO WS-BENEF-FROM-DT DTSBR521 +00591 ELSE DTSBR521 +00592 MOVE SPACES TO WS-BENEF-FROM-DT DTSBR521 +00593 END-IF. DTSBR521 +00594 IF R521-UI-BEN-CHGD-THRU-YRQ GREATER ZEROS CL**4 +00595 MOVE R521-UI-BEN-CHGD-THRU-YRQ TO CL**4 +00596 L004-QTR-5-9 DTSBR521 +00597 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 +00598 MOVE L004-SLASH-QTR TO WS-BENEF-THRU-DT DTSBR521 +00599 ELSE DTSBR521 +00600 MOVE SPACES TO WS-BENEF-THRU-DT DTSBR521 +00601 END-IF. DTSBR521 +00602 DTSBR521 +00603 MOVE WS-BENEFIT-CHG-FROM-THRU TO HDR-BENEF-CHG-FROM-THRU. DTSBR521 +00604 DTSBR521 +00605 PERFORM P2000-TAX-QTRS THRU P2000-EXIT VARYING DTSBR521 +00606 R521-WAGES-YRQ-IDX FROM 1 BY 1 UNTIL DTSBR521 +00607 R521-WAGES-YRQ-IDX > 3. CL**2 +00608 I3000-EXIT. DTSBR521 +00609 EXIT. DTSBR521 +00610 EJECT DTSBR521 +00611 P1000-PROCESS. DTSBR521 +00612 DTSBR521 +00613 PERFORM P3000-TAX-WAGES THRU P3000-EXIT VARYING DTSBR521 +00614 R521-TAX-WAGE-IDX FROM 1 BY 1 UNTIL DTSBR521 +00615 R521-TAX-WAGE-IDX > 3. CL**2 +00616 DTSBR521 +00617 IF R521-COMPUTED-RATE = WS-FUIR-UI-RATE DTSBR521 +00618 IF R521-UI-RATE-CATEGORY = WS-UI-RATE-CATEGORY DTSBR521 +00619 MOVE WS-FUIR-UI-RATE-D TO WS-REG-UI-RATE-D DTSBR521 +00620 MOVE WS-REG-UI-RATE-D (4:4) TO DTL-REG-UI-RATE-D DTSBR521 +00621 ELSE DTSBR521 +00622 PERFORM P1200-EMPLR-CATEGORY THRU P1200-EXIT DTSBR521 +00623 PERFORM P1300-RESET-TOTALS THRU P1300-EXIT DTSBR521 +00624 ELSE DTSBR521 +00625 DTSBR521 +00626 MOVE WS-REG-EMPL-COUNT TO DTL-REG-EMPL-COUNT DTSBR521 +00627 MOVE WS-REG-UI-TAX-PAID TO DTL-REG-UI-TAX-PAID DTSBR521 +00628 MOVE WS-REG-TRUST-FUND-INT TO DTL-REG-TRUST-FUND-INT DTSBR521 +00629 MOVE WS-REG-BENEFITS-CHGD TO DTL-REG-BENEFITS-CHGD DTSBR521 +00630 MOVE WS-REG-CURRENT-RESERVE TO DTL-REG-CURRENT-RESERVE DTSBR521 +00631 MOVE WS-REG-TAXABLE-WAGES1 TO DTL-REG-TAXABLE-WAGES1 DTSBR521 +00632 MOVE WS-REG-TAXABLE-WAGES2 TO DTL-REG-TAXABLE-WAGES2 DTSBR521 +00633 MOVE WS-REG-TAXABLE-WAGES3 TO DTL-REG-TAXABLE-WAGES3 CL**2 +00634 DTSBR521 +00635 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 +00636 WRITE PRT-RECORD FROM DTL-LINE-2 AFTER 2 DTSBR521 +00637 ADD +2 TO WS-LINE-CNT2 DTSBR521 +00638 DTSBR521 +00639 MOVE R521-COMPUTED-RATE TO WS-FUIR-UI-RATE DTSBR521 +00640 MOVE R521-UI-RATE-CATEGORY TO WS-UI-RATE-CATEGORY DTSBR521 +00641 PERFORM P1300-RESET-TOTALS THRU P1300-EXIT DTSBR521 +00642 PERFORM I2100-SET-RATIO THRU I2100-EXIT DTSBR521 +00643 VARYING FUIR-RATE-IDX FROM 1 BY 1 UNTIL DTSBR521 +00644 FUIR-RATE-IDX GREATER FUIR-RATE-CNT DTSBR521 +00645 MOVE WS-FUIR-UI-RATE-D TO WS-REG-UI-RATE-D DTSBR521 +00646 MOVE WS-REG-UI-RATE-D (4:4) TO DTL-REG-UI-RATE-D DTSBR521 +00647 END-IF. DTSBR521 +00648 DTSBR521 +00649 PERFORM P1100-ADD-REGULAR THRU P1100-EXIT. DTSBR521 +00650 PERFORM P1050-EMPLR-CLASS THRU P1050-EXIT. DTSBR521 +00651 P1000-EXIT. DTSBR521 +00652 EXIT. DTSBR521 +00653 EJECT DTSBR521 +00654 P1050-EMPLR-CLASS. DTSBR521 +00655 IF R521-RATE-CLASSIFIED-88 DTSBR521 +00656 ADD R521-TRUST-FUND-INTEREST-AMT TO DTSBR521 +00657 WS-CLS-TRUST-FUND-INT DTSBR521 +00658 ADD R521-BENEFITS-CHARGED-AMT TO DTSBR521 +00659 WS-CLS-BENEFITS-CHGD DTSBR521 +00660 ADD R521-UI-TAX-PAID-AMT TO DTSBR521 +00661 WS-CLS-UI-TAX-PAID DTSBR521 +00662 ADD R521-CURRENT-RESERVE-AMT TO DTSBR521 +00663 WS-CLS-CURRENT-RESERVE DTSBR521 +00664 ADD WS-OUT-TAXABLE-WAGES1 TO DTSBR521 +00665 WS-CLS-TAXABLE-WAGES1 DTSBR521 +00666 ADD WS-OUT-TAXABLE-WAGES2 TO DTSBR521 +00667 WS-CLS-TAXABLE-WAGES2 DTSBR521 +00668 ADD WS-OUT-TAXABLE-WAGES3 TO CL**2 +00669 WS-CLS-TAXABLE-WAGES3 CL**2 +00670 ADD 1 TO WS-CLS-EMPL-COUNT DTSBR521 +00671 END-IF. DTSBR521 +00672 DTSBR521 +00673 IF R521-RATE-NONCLASSIFIED-88 DTSBR521 +00674 ADD R521-TRUST-FUND-INTEREST-AMT TO DTSBR521 +00675 WS-EMP-TRUST-FUND-INT DTSBR521 +00676 ADD R521-BENEFITS-CHARGED-AMT TO DTSBR521 +00677 WS-EMP-BENEFITS-CHGD DTSBR521 +00678 ADD R521-UI-TAX-PAID-AMT TO DTSBR521 +00679 WS-EMP-UI-TAX-PAID DTSBR521 +00680 ADD R521-CURRENT-RESERVE-AMT TO DTSBR521 +00681 WS-EMP-CURRENT-RESERVE DTSBR521 +00682 ADD WS-OUT-TAXABLE-WAGES1 TO DTSBR521 +00683 WS-EMP-TAXABLE-WAGES1 DTSBR521 +00684 ADD WS-OUT-TAXABLE-WAGES2 TO DTSBR521 +00685 WS-EMP-TAXABLE-WAGES2 DTSBR521 +00686 ADD WS-OUT-TAXABLE-WAGES3 TO CL**2 +00687 WS-EMP-TAXABLE-WAGES3 CL**2 +00688 ADD 1 TO WS-EMP-EMPL-COUNT DTSBR521 +00689 END-IF. DTSBR521 +00690 DTSBR521 +00691 P1050-EXIT. DTSBR521 +00692 EXIT. DTSBR521 +00693 DTSBR521 +00694 P1100-ADD-REGULAR. DTSBR521 +00695 ADD R521-TRUST-FUND-INTEREST-AMT TO DTSBR521 +00696 WS-REG-TRUST-FUND-INT. DTSBR521 +00697 ADD R521-BENEFITS-CHARGED-AMT TO DTSBR521 +00698 WS-REG-BENEFITS-CHGD. DTSBR521 +00699 ADD R521-UI-TAX-PAID-AMT TO DTSBR521 +00700 WS-REG-UI-TAX-PAID. DTSBR521 +00701 ADD R521-CURRENT-RESERVE-AMT TO DTSBR521 +00702 WS-REG-CURRENT-RESERVE. DTSBR521 +00703 ADD WS-OUT-TAXABLE-WAGES1 TO DTSBR521 +00704 WS-REG-TAXABLE-WAGES1. DTSBR521 +00705 ADD WS-OUT-TAXABLE-WAGES2 TO DTSBR521 +00706 WS-REG-TAXABLE-WAGES2. DTSBR521 +00707 ADD WS-OUT-TAXABLE-WAGES3 TO CL**2 +00708 WS-REG-TAXABLE-WAGES3. CL**2 +00709 ADD 1 TO WS-REG-EMPL-COUNT. DTSBR521 +00710 P1100-EXIT. DTSBR521 +00711 EXIT. DTSBR521 +00712 DTSBR521 +00713 P1200-EMPLR-CATEGORY. DTSBR521 +00714 MOVE R521-COMPUTED-RATE TO WS-FUIR-UI-RATE DTSBR521 +00715 MOVE R521-UI-RATE-CATEGORY TO WS-UI-RATE-CATEGORY. DTSBR521 +00716 P1200-EXIT. DTSBR521 +00717 EXIT. DTSBR521 +00718 DTSBR521 +00719 P1300-RESET-TOTALS. DTSBR521 +00720 INITIALIZE WS-REG-TRUST-FUND-INT DTSBR521 +00721 WS-REG-BENEFITS-CHGD DTSBR521 +00722 WS-REG-EMPL-COUNT DTSBR521 +00723 WS-REG-UI-TAX-PAID DTSBR521 +00724 WS-REG-CURRENT-RESERVE DTSBR521 +00725 WS-REG-TAXABLE-WAGES1 DTSBR521 +00726 WS-REG-TAXABLE-WAGES2 CL**2 +00727 WS-REG-TAXABLE-WAGES3. CL**2 +00728 P1300-EXIT. DTSBR521 +00729 EXIT. DTSBR521 +00730 DTSBR521 +00731 P2000-TAX-QTRS. DTSBR521 +00732 DTSBR521 +00733 IF R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) > 0 DTSBR521 +00734 MOVE R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) DTSBR521 +00735 TO L004-QTR-5-9 DTSBR521 +00736 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 +00737 MOVE L004-SLASH-QTR TO WS-TAX-QTR-FROM DTSBR521 +00738 ELSE DTSBR521 +00739 MOVE SPACES TO WS-TAX-QTR-FROM DTSBR521 +00740 END-IF. DTSBR521 +00741 IF R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) > 0 DTSBR521 +00742 MOVE R521-WAGES-THRU-YRQ (R521-WAGES-YRQ-IDX) DTSBR521 +00743 TO L004-QTR-5-9 DTSBR521 +00744 PERFORM S004-FROM-5 THRU S004-EXIT DTSBR521 +00745 MOVE L004-SLASH-QTR TO WS-TAX-QTR-THRU DTSBR521 +00746 ELSE DTSBR521 +00747 MOVE SPACES TO WS-TAX-QTR-THRU DTSBR521 +00748 END-IF. DTSBR521 +00749 IF R521-WAGES-FROM-YRQ (R521-WAGES-YRQ-IDX) > 0 CL**2 +00750 MOVE R521-WAGES-THRU-YRQ (R521-WAGES-YRQ-IDX) CL**2 +00751 TO L004-QTR-5-9 CL**2 +00752 PERFORM S004-FROM-5 THRU S004-EXIT CL**2 +00753 MOVE L004-SLASH-QTR TO WS-TAX-QTR-THRU CL**2 +00754 ELSE CL**2 +00755 MOVE SPACES TO WS-TAX-QTR-THRU CL**2 +00756 END-IF. CL**2 +00757 EVALUATE TRUE DTSBR521 +00758 WHEN R521-WAGES-YRQ-IDX = 1 DTSBR521 +00759 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGE1-FROM DTSBR521 +00760 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGE1-THRU DTSBR521 +00761 MOVE WS-TAX-WAGE1-FROM-THRU TO DTSBR521 +00762 HDR-TAX-WAGE1-FROM-THRU DTSBR521 +00763 WHEN R521-WAGES-YRQ-IDX = 2 DTSBR521 +00764 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGE2-FROM DTSBR521 +00765 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGE2-THRU DTSBR521 +00766 MOVE WS-TAX-WAGE2-FROM-THRU TO DTSBR521 +00767 HDR-TAX-WAGE2-FROM-THRU DTSBR521 +00768 WHEN R521-WAGES-YRQ-IDX = 3 CL**2 +00769 MOVE WS-TAX-QTR-FROM TO WS-TAX-WAGE3-FROM CL**2 +00770 MOVE WS-TAX-QTR-THRU TO WS-TAX-WAGE3-THRU CL**2 +00771 MOVE WS-TAX-WAGE3-FROM-THRU TO CL**2 +00772 HDR-TAX-WAGE3-FROM-THRU CL**2 +00773 END-EVALUATE. DTSBR521 +00774 DTSBR521 +00775 P2000-EXIT. DTSBR521 +00776 EXIT. DTSBR521 +00777 P3000-TAX-WAGES. DTSBR521 +00778 EVALUATE TRUE DTSBR521 +00779 WHEN R521-TAX-WAGE-IDX = 1 DTSBR521 +00780 MOVE R521-TAX-WAGE (R521-TAX-WAGE-IDX) TO DTSBR521 +00781 WS-OUT-TAXABLE-WAGES1 DTSBR521 +00782 WHEN R521-TAX-WAGE-IDX = 2 DTSBR521 +00783 MOVE R521-TAX-WAGE (R521-TAX-WAGE-IDX) TO DTSBR521 +00784 WS-OUT-TAXABLE-WAGES2 DTSBR521 +00785 WHEN R521-TAX-WAGE-IDX = 3 CL**2 +00786 MOVE R521-TAX-WAGE (R521-TAX-WAGE-IDX) TO CL**2 +00787 WS-OUT-TAXABLE-WAGES3 CL**2 +00788 END-EVALUATE. DTSBR521 +00789 P3000-EXIT. DTSBR521 +00790 EXIT. DTSBR521 +00791 DTSBR521 +00792 P4000-GRAND-TOTALS. DTSBR521 +00793 DTSBR521 +00794 ADD WS-CLS-EMPL-COUNT WS-EMP-EMPL-COUNT DTSBR521 +00795 GIVING WS-GRD-EMPLR-COUNT. DTSBR521 +00796 ADD WS-CLS-TRUST-FUND-INT WS-EMP-TRUST-FUND-INT DTSBR521 +00797 GIVING WS-GRD-TRUST-FUND-INT. DTSBR521 +00798 ADD WS-CLS-BENEFITS-CHGD WS-EMP-BENEFITS-CHGD DTSBR521 +00799 GIVING WS-GRD-BENEFITS-CHGD. DTSBR521 +00800 ADD WS-CLS-UI-TAX-PAID WS-EMP-UI-TAX-PAID DTSBR521 +00801 GIVING WS-GRD-UI-TAX-PAID. DTSBR521 +00802 ADD WS-CLS-CURRENT-RESERVE WS-EMP-CURRENT-RESERVE DTSBR521 +00803 GIVING WS-GRD-CURRENT-RESERVE. DTSBR521 +00804 ADD WS-CLS-TAXABLE-WAGES1 WS-EMP-TAXABLE-WAGES1 DTSBR521 +00805 GIVING WS-GRD-TAXABLE-WAGES1. DTSBR521 +00806 ADD WS-CLS-TAXABLE-WAGES2 WS-EMP-TAXABLE-WAGES2 DTSBR521 +00807 GIVING WS-GRD-TAXABLE-WAGES2. DTSBR521 +00808 ADD WS-CLS-TAXABLE-WAGES3 WS-EMP-TAXABLE-WAGES3 CL**2 +00809 GIVING WS-GRD-TAXABLE-WAGES3. CL**2 +00810 DTSBR521 +00811 P4000-EXIT. DTSBR521 +00812 EXIT. DTSBR521 +00813 DTSBR521 +00814 P5000-PRINT-HEADER. DTSBR521 +00815 IF WS-LINE-CNT GREATER 58 OR DTSBR521 +00816 WS-LINE-CNT2 GREATER 58 DTSBR521 +00817 MOVE +0 TO WS-LINE-CNT DTSBR521 +00818 MOVE +0 TO WS-LINE-CNT2 DTSBR521 +00819 ADD +1 TO WS-PAGE-CNT DTSBR521 +00820 MOVE WS-PAGE-CNT TO HDR-PAGE-CNT DTSBR521 +00821 WRITE PRT-RECORD FROM HDR-LINE-1 AFTER TOP-OF-PAGE DTSBR521 +00822 WRITE PRT-RECORD FROM HDR-LINE-2 AFTER 1 DTSBR521 +00823 WRITE PRT-RECORD FROM HDR-LINE-3 AFTER 1 DTSBR521 +00824 WRITE PRT-RECORD FROM HDR-LINE-4 AFTER 1 DTSBR521 +00825 WRITE PRT-RECORD FROM HDR-LINE-5 AFTER 1 DTSBR521 +00826 WRITE PRT-RECORD FROM HDR-LINE-6 AFTER 1 DTSBR521 +00827 WRITE PRT-RECORD FROM HDR-LINE-7 AFTER 1 DTSBR521 +00828 WRITE PRT-RECORD FROM HDR-LINE-8 AFTER 1 DTSBR521 +00829 WRITE PRT-RECORD FROM HDR-LINE-9 AFTER 1 DTSBR521 +00830 WRITE PRT-RECORD FROM HDR-LINE-10 AFTER 1 DTSBR521 +00831 ADD +10 TO WS-LINE-CNT2. DTSBR521 +00832 P5000-EXIT. DTSBR521 +00833 EXIT. DTSBR521 +00834 DTSBR521 +00835 T1000-TERMINATE. DTSBR521 +00836 DTSBR521 +00837 IF WS-LINE-CNT2 > 52 DTSBR521 +00838 ADD +6 TO WS-LINE-CNT2 DTSBR521 +00839 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 +00840 END-IF. DTSBR521 00841 DTSBR521 -00842 CLOSE PRT-FILE. DTSBR521 -00843 DTSBR521 -00844 T1000-EXIT. DTSBR521 -00845 EXIT. DTSBR521 -00846 EJECT DTSBR521 -00847 S001-DATE. DTSBR521 -00848 DTSBR521 -00849 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR521 -00850 DTSBR521 -00851 S001-EXIT. DTSBR521 -00852 EXIT. DTSBR521 -00853 DTSBR521 -00854 S004-FROM-5. DTSBR521 -00855 DTSBR521 -00856 SET L004-FROM-5 TO TRUE. DTSBR521 +00842 MOVE WS-REG-UI-RATE-D (4:4) TO DTL-REG-UI-RATE-D. DTSBR521 +00843 MOVE WS-REG-EMPL-COUNT TO DTL-REG-EMPL-COUNT. DTSBR521 +00844 MOVE WS-REG-UI-TAX-PAID TO DTL-REG-UI-TAX-PAID. DTSBR521 +00845 MOVE WS-REG-TRUST-FUND-INT TO DTL-REG-TRUST-FUND-INT. DTSBR521 +00846 MOVE WS-REG-BENEFITS-CHGD TO DTL-REG-BENEFITS-CHGD. DTSBR521 +00847 MOVE WS-REG-CURRENT-RESERVE TO DTL-REG-CURRENT-RESERVE. DTSBR521 +00848 MOVE WS-REG-TAXABLE-WAGES1 TO DTL-REG-TAXABLE-WAGES1. DTSBR521 +00849 MOVE WS-REG-TAXABLE-WAGES2 TO DTL-REG-TAXABLE-WAGES2. DTSBR521 +00850 MOVE WS-REG-TAXABLE-WAGES3 TO DTL-REG-TAXABLE-WAGES3. CL**2 +00851 WRITE PRT-RECORD FROM DTL-LINE-2 AFTER 2. DTSBR521 +00852 DTSBR521 +00853 IF WS-LINE-CNT2 > 52 DTSBR521 +00854 ADD +6 TO WS-LINE-CNT2 DTSBR521 +00855 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 +00856 END-IF. DTSBR521 00857 DTSBR521 -00858 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR521 -00859 DTSBR521 -00860 S004-EXIT. DTSBR521 -00861 EXIT. DTSBR521 -00862 DTSBR521 -00863 S056-RATE-DISPLAY. DTSBR521 -00864 DTSBR521 -00865 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR521 -00866 DTSBR521 -00867 S056-EXIT. DTSBR521 -00868 EXIT. DTSBR521 -00869 DTSBR521 -00870 S057-RATIO-DISPLAY. DTSBR521 -00871 DTSBR521 -00872 CALL 'DTSBU057' USING L057-LINK-AREA. DTSBR521 -00873 DTSBR521 -00874 S057-EXIT. DTSBR521 -00875 EXIT. DTSBR521 -00876 DTSBR521 -00877 S931-READ. DTSBR521 -00878 SET L931-READ-88 TO TRUE. DTSBR521 -00879 GO TO S931-REF-I. DTSBR521 -00880 DTSBR521 -00881 S931-REF-I. DTSBR521 -00882 CALL 'DTSBU931' USING L931-LINK-AREA DTSBR521 -00883 FSKL-REC. DTSBR521 -00884 S931-EXIT. DTSBR521 -00885 EXIT. DTSBR521 -00886 DTSBR521 -00887 S999-ABEND. DTSBR521 +00858 MOVE WS-CLS-EMPL-COUNT TO DTL-CLS-EMPL-COUNT. DTSBR521 +00859 MOVE WS-CLS-UI-TAX-PAID TO DTL-CLS-UI-TAX-PAID. DTSBR521 +00860 MOVE WS-CLS-TRUST-FUND-INT TO DTL-CLS-TRUST-FUND-INT. DTSBR521 +00861 MOVE WS-CLS-BENEFITS-CHGD TO DTL-CLS-BENEFITS-CHGD. DTSBR521 +00862 MOVE WS-CLS-CURRENT-RESERVE TO DTL-CLS-CURRENT-RESERVE. DTSBR521 +00863 MOVE WS-CLS-TAXABLE-WAGES1 TO DTL-CLS-TAXABLE-WAGES1. DTSBR521 +00864 MOVE WS-CLS-TAXABLE-WAGES2 TO DTL-CLS-TAXABLE-WAGES2. DTSBR521 +00865 MOVE WS-CLS-TAXABLE-WAGES3 TO DTL-CLS-TAXABLE-WAGES3. CL**2 +00866 WRITE PRT-RECORD FROM DTL-CLS-LINE-3 AFTER 3. DTSBR521 +00867 DTSBR521 +00868 IF WS-LINE-CNT2 > 52 DTSBR521 +00869 ADD +6 TO WS-LINE-CNT2 DTSBR521 +00870 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 +00871 END-IF. DTSBR521 +00872 DTSBR521 +00873 MOVE WS-EMP-UI-RATE (4:4) TO DTL-EMP-UI-RATE. DTSBR521 +00874 MOVE WS-EMP-EMPL-COUNT TO DTL-EMP-EMPL-COUNT. DTSBR521 +00875 MOVE WS-EMP-UI-TAX-PAID TO DTL-EMP-UI-TAX-PAID. DTSBR521 +00876 MOVE WS-EMP-TRUST-FUND-INT TO DTL-EMP-TRUST-FUND-INT. DTSBR521 +00877 MOVE WS-EMP-BENEFITS-CHGD TO DTL-EMP-BENEFITS-CHGD. DTSBR521 +00878 MOVE WS-EMP-CURRENT-RESERVE TO DTL-EMP-CURRENT-RESERVE. DTSBR521 +00879 MOVE WS-EMP-TAXABLE-WAGES1 TO DTL-EMP-TAXABLE-WAGES1. DTSBR521 +00880 MOVE WS-EMP-TAXABLE-WAGES2 TO DTL-EMP-TAXABLE-WAGES2. DTSBR521 +00881 MOVE WS-EMP-TAXABLE-WAGES3 TO DTL-EMP-TAXABLE-WAGES3. CL**2 +00882 WRITE PRT-RECORD FROM DTL-EMP-LINE-3 AFTER 3. DTSBR521 +00883 DTSBR521 +00884 IF WS-LINE-CNT2 > 52 DTSBR521 +00885 ADD +6 TO WS-LINE-CNT2 DTSBR521 +00886 PERFORM P5000-PRINT-HEADER THRU P5000-EXIT DTSBR521 +00887 END-IF. DTSBR521 00888 DTSBR521 -00889 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR521 -00890 DTSBR521 -00891 S999-EXIT. DTSBR521 -00892 EXIT. DTSBR521 +00889 PERFORM P4000-GRAND-TOTALS THRU P4000-EXIT. DTSBR521 +00890 MOVE WS-GRD-EMPLR-COUNT TO CFF-GRD-EMPLR-COUNT. DTSBR521 +00891 MOVE WS-GRD-UI-TAX-PAID TO CFF-GRD-UI-TAX-PAID. DTSBR521 +00892 MOVE WS-GRD-TRUST-FUND-INT TO CFF-GRD-TRUST-FUND-INT. DTSBR521 +00893 MOVE WS-GRD-BENEFITS-CHGD TO CFF-GRD-BENEFITS-CHGD. DTSBR521 +00894 MOVE WS-GRD-CURRENT-RESERVE TO CFF-GRD-CURRENT-RESERVE. DTSBR521 +00895 MOVE WS-GRD-TAXABLE-WAGES1 TO CFF-GRD-TAXABLE-WAGES1. DTSBR521 +00896 MOVE WS-GRD-TAXABLE-WAGES2 TO CFF-GRD-TAXABLE-WAGES2. DTSBR521 +00897 MOVE WS-GRD-TAXABLE-WAGES3 TO CFF-GRD-TAXABLE-WAGES3. CL**2 +00898 WRITE PRT-RECORD FROM CFF-GRD-LINE-3 AFTER 3. DTSBR521 +00899 DTSBR521 +00900 CLOSE PRT-FILE. DTSBR521 +00901 DTSBR521 +00902 T1000-EXIT. DTSBR521 +00903 EXIT. DTSBR521 +00904 EJECT DTSBR521 +00905 S001-DATE. DTSBR521 +00906 DTSBR521 +00907 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR521 +00908 DTSBR521 +00909 S001-EXIT. DTSBR521 +00910 EXIT. DTSBR521 +00911 DTSBR521 +00912 S004-FROM-5. DTSBR521 +00913 DTSBR521 +00914 SET L004-FROM-5 TO TRUE. DTSBR521 +00915 DTSBR521 +00916 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBR521 +00917 DTSBR521 +00918 S004-EXIT. DTSBR521 +00919 EXIT. DTSBR521 +00920 DTSBR521 +00921 S056-RATE-DISPLAY. DTSBR521 +00922 DTSBR521 +00923 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBR521 +00924 DTSBR521 +00925 S056-EXIT. DTSBR521 +00926 EXIT. DTSBR521 +00927 DTSBR521 +00928 S057-RATIO-DISPLAY. DTSBR521 +00929 DTSBR521 +00930 CALL 'DTSBU057' USING L057-LINK-AREA. DTSBR521 +00931 DTSBR521 +00932 S057-EXIT. DTSBR521 +00933 EXIT. DTSBR521 +00934 DTSBR521 +00935 S931-READ. DTSBR521 +00936 SET L931-READ-88 TO TRUE. DTSBR521 +00937 GO TO S931-REF-I. DTSBR521 +00938 DTSBR521 +00939 S931-REF-I. DTSBR521 +00940 CALL 'DTSBU931' USING L931-LINK-AREA DTSBR521 +00941 FSKL-REC. DTSBR521 +00942 S931-EXIT. DTSBR521 +00943 EXIT. DTSBR521 +00944 DTSBR521 +00945 S999-ABEND. DTSBR521 +00946 DTSBR521 +00947 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR521 +00948 DTSBR521 +00949 S999-EXIT. DTSBR521 +00950 EXIT. DTSBR521 diff --git a/Batch/DTSBR793.cob b/Batch/DTSBR793.cob index 07a8895..394a906 100644 --- a/Batch/DTSBR793.cob +++ b/Batch/DTSBR793.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 10/16/19 +00001 IDENTIFICATION DIVISION. 05/05/22 00002 PROGRAM-ID. DTSBR793. DTSBR793 -00003 AUTHOR. D.SHEPPERSON LV052 +00003 AUTHOR. D.SHEPPERSON LV003 00004 DATE-WRITTEN. JULY 1999. DTSBR793 00005 DATE-COMPILED. DTSBR793 00006 SKIP3 DTSBR793 @@ -21,511 +21,516 @@ 00021 * 04-04-2006 MODIFIED PROGRAM TO PRODUCE A DETAIL REPORT. DTSBR793 00022 * REFERENCE RFP AUTHOR OF CHANGE - ZL1 DTSBR793 00023 * DTSBR793 -00024 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR793 -00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR793 -00026 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR793 -00027 * DTSBR793 -00028 * DTSBR793 -00029 * DESCRIPTION: DTSBR793 +00024 * 05-05-2022 MODIFIED PROGRAM TO PRINT FEIN ON LETTER CL**3 +00025 * REFERENCE PROGRAM AUTHOR OF CHANGE - ZL1 CL**3 +00026 * CL**3 +00027 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR793 +00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR793 +00029 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR793 00030 * DTSBR793 -00031 * THIS MODULE GENERATES LETTERS TO BE SENT TO EMPLOYERS DTSBR793 -00032 * FEQUESTING THEIR FEDERAL IDENTIFICATION NUMBER (FEIN). DTSBR793 +00031 * DTSBR793 +00032 * DESCRIPTION: DTSBR793 00033 * DTSBR793 -00034 * DTSBR793 -00035 * RECORDS READ: DTSBR793 -00036 * DTSBR793 -00037 * NONE. DTSBR793 -00038 * DTSBR793 +00034 * THIS MODULE GENERATES LETTERS TO BE SENT TO EMPLOYERS DTSBR793 +00035 * BASED ON FUTA QUARTER FILE FROM IRS. POTENTIAL EMPLOYER CL**3 +00036 * TO DC UI PROGRAM. CL**3 +00037 * DTSBR793 +00038 * RECORDS READ: DTSBR793 00039 * DTSBR793 -00040 * PRINTED OUTPUTS: DTSBR793 +00040 * NONE. DTSBR793 00041 * DTSBR793 -00042 * 793R1 REQUEST FOR FEDERAL ID LETTER DTSBR793 -00043 * DTSBR793 +00042 * DTSBR793 +00043 * PRINTED OUTPUTS: DTSBR793 00044 * DTSBR793 -00045 * RECORDS WRITTEN: DTSBR793 +00045 * 793R1 REQUEST FOR FEDERAL ID LETTER DTSBR793 00046 * DTSBR793 -00047 * NONE. DTSBR793 -00048 * DTSBR793 +00047 * DTSBR793 +00048 * RECORDS WRITTEN: DTSBR793 00049 * DTSBR793 -00050 * MODULES CALLED: DTSBR793 +00050 * NONE. DTSBR793 00051 * DTSBR793 00052 * DTSBR793 -00053 * DTSBR793 -00054 ***** DTSBR793 -00055 EJECT DTSBR793 -00056 ENVIRONMENT DIVISION. DTSBR793 -00057 SKIP2 DTSBR793 -00058 CONFIGURATION SECTION. DTSBR793 -00059 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR793 -00060 INPUT-OUTPUT SECTION. DTSBR793 -00061 SKIP1 DTSBR793 -00062 FILE-CONTROL. DTSBR793 -00063 SELECT FEIN-FILE ASSIGN TO RPT793R1. DTSBR793 -00064 SELECT FEIN-FILE2 ASSIGN TO RPT793R2. DTSBR793 -00065 SELECT FEIN-FILE3 ASSIGN TO RPT793R3. DTSBR793 -00066 SKIP3 DTSBR793 -00067 DATA DIVISION. DTSBR793 -00068 SKIP3 DTSBR793 -00069 FILE SECTION. DTSBR793 -00070 SKIP2 DTSBR793 -00071 FD FEIN-FILE DTSBR793 -00072 LABEL RECORDS ARE OMITTED DTSBR793 -00073 DATA RECORD IS FEIN-LETTER. DTSBR793 -00074 01 FEIN-LETTER PIC X(133). DTSBR793 -00075 DTSBR793 -00076 FD FEIN-FILE2 DTSBR793 -00077 LABEL RECORDS ARE OMITTED DTSBR793 -00078 DATA RECORD IS FEIN-REPORT. DTSBR793 -00079 01 FEIN-REPORT PIC X(200). DTSBR793 -00080 DTSBR793 -00081 FD FEIN-FILE3 DTSBR793 -00082 LABEL RECORDS ARE OMITTED DTSBR793 -00083 DATA RECORD IS FEIN-REPORT. DTSBR793 -00084 01 FEIN-REPORT3 PIC X(133). DTSBR793 -00085 DTSBR793 -00086 EJECT DTSBR793 -00087 WORKING-STORAGE SECTION. DTSBR793 -000875 77 PAN-VALET PICTURE X(24) VALUE '052DTSBR793 10/16/19'. DTSBR793 -00088 77 PAN-VALET PICTURE X(24) VALUE '045DTSBR793 09/17/19'. DTSBR793 -00089 77 PAN-VALET PICTURE X(24) VALUE '050DTSBR793 01/15/14'. DTSBR793 -00090 77 PAN-VALET PICTURE X(24) VALUE '002DTSBR793 01/15/14'. DTSBR793 -00091 77 PAN-VALET PICTURE X(24) VALUE '048DTSBR793 01/09/07'. DTSBR793 -00092 SKIP3 DTSBR793 -00093 01 WRK-AREA. DTSBR793 -00094 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +793.DTSBR793 -00095 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR793 -00096 SKIP1 DTSBR793 -00097 05 WS-EMP-NO PIC 999B999. DTSBR793 -00098 05 WS-EMP-NO-DISPLAY REDEFINES DTSBR793 -00099 WS-EMP-NO PIC X(7). DTSBR793 -00100 05 WS-FEIN-NO PIC 99B9999999. DTSBR793 -00101 05 WS-FEIN-NO-DISPLAY REDEFINES DTSBR793 -00102 WS-FEIN-NO PIC X(10). DTSBR793 -00103 05 WS-PAGE-CNT PIC 9(02) VALUE ZERO. DTSBR793 -00104 05 WS-LINE-CNT PIC S9(02) VALUE +55. DTSBR793 -00105 05 WS-PAGE-CNT3 PIC 9(02) VALUE ZERO. DTSBR793 -00106 05 WS-LINE-CNT3 PIC S9(02) VALUE +55. DTSBR793 -00107 EJECT DTSBR793 -00108 01 R793-LETTER-DATE. DTSBR793 -00109 05 FILLER PIC X(50) VALUE SPACES. DTSBR793 -00110 05 LETTER-DATE PIC X(10). DTSBR793 -00111 DTSBR793 -00112 01 R793-LETTER-FEIN. DTSBR793 -00113 05 FILLER PIC X(79) VALUE SPACES. DTSBR793 -00114 05 LTR-FEIN-NO PIC 99B9999999. DTSBR793 -00115 01 R793-REPORT. DTSBR793 -00116 * 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 -00117 05 RPT-FEIN-NO PIC 99B9999999. DTSBR793 -00118 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00119 05 RPT-ADDR1 PIC X(35). DTSBR793 -00120 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00121 * 05 RPT-ADDR2 PIC X(35). DTSBR793 -00122 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00123 * 05 RPT-ADDR3 PIC X(35). DTSBR793 -00124 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00125 05 RPT-ADDR4 PIC X(35). DTSBR793 -00126 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00127 05 RPT-STREET PIC X(35). DTSBR793 -00128 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00129 05 RPT-CITY PIC X(10). DTSBR793 -00130 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00131 05 RPT-STATE PIC X(02). DTSBR793 -00132 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00133 05 RPT-ZIP PIC X(05). DTSBR793 -00134 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00135 05 RPT-ZIP4 PIC X(04). DTSBR793 -00136 DTSBR793 -00137 01 R793-REPORT3. DTSBR793 -00138 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 -00139 05 RPT-FEIN-NO3 PIC 99B9999999. DTSBR793 -00140 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00141 05 RPT-EMP-NO3 PIC 9(06). DTSBR793 -00142 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00143 05 RPT-EMP-NAME3 PIC X(30). DTSBR793 -00144 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00145 * 05 RPT-ADDR2 PIC X(15). DTSBR793 -00146 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00147 * 05 RPT-ADDR3 PIC X(25). DTSBR793 -00148 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00149 05 RPT-EMP-DATE3 PIC X(10). DTSBR793 -00150 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00151 05 RPT-EMP-CLASS3 PIC X(03). DTSBR793 -00152 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00153 05 RPT-EMP-STATUS3 PIC X(02). DTSBR793 -00154 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00155 05 RPT-EMP-ORG-TYPE3 PIC X(05). DTSBR793 -00156 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00157 05 RPT-RTN-MAIL3 PIC X(05). DTSBR793 -00158 05 FILLER PIC X(07) VALUE SPACES. DTSBR793 -00159 05 RPT-NEW-ACCT-IND PIC X(01). DTSBR793 -00160 05 FILLER PIC X(08) VALUE SPACES. DTSBR793 -00161 05 RPT-FEIN-CHNG-IND PIC X(01). DTSBR793 -00162 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00163 05 RPT-NAME-CHNG-IND PIC X(01). DTSBR793 -00164 05 FILLER PIC X(05) VALUE SPACES. DTSBR793 -00165 05 RPT-TRAN-DATE PIC X(10). DTSBR793 -00166 01 HEADER1. DTSBR793 -00167 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 -00168 05 HDR1-RPT PIC X(05). DTSBR793 -00169 05 FILLER PIC X(44) VALUE SPACES. DTSBR793 -00170 05 FILLER PIC X(60) VALUE DTSBR793 -00171 'DISTRICT OF COLUMBIA'. DTSBR793 -00172 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR793 -00173 05 HDR1-DATE PIC X(08). DTSBR793 -00174 01 HEADER2. DTSBR793 -00175 05 FILLER PIC X(56) VALUE SPACES. DTSBR793 -00176 05 FILLER PIC X(56) VALUE DTSBR793 -00177 'TAX DIVISION'. DTSBR793 -00178 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR793 -00179 05 HDR2-TIME PIC X(08). DTSBR793 -00180 DTSBR793 -00181 01 HEADER3. DTSBR793 -00182 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00183 05 FILLER PIC X(45) VALUE DTSBR793 -00184 'EMPLOYERS NOT IN DUTAS '. DTSBR793 -00185 05 FILLER PIC X(46) VALUE DTSBR793 -00186 'IRS (940) FUTA QUARTERLY - LETTER MAILED '. DTSBR793 -00187 05 FILLER PIC X(20) VALUE SPACES. DTSBR793 -00188 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR793 -00189 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR793 -00190 DTSBR793 -00191 DTSBR793 -00192 01 HEADER4. DTSBR793 -00193 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00194 05 FILLER PIC X(07) VALUE DTSBR793 -00195 'FEIN NO'. DTSBR793 -00196 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00197 05 FILLER PIC X(25) VALUE DTSBR793 -00198 ' EMP-NAME '. DTSBR793 -00199 05 FILLER PIC X(07) VALUE SPACES. DTSBR793 -00200 05 FILLER PIC X(25) VALUE DTSBR793 -00201 ' ATTENTION '. DTSBR793 -00202 05 FILLER PIC X(15) VALUE SPACES. DTSBR793 -00203 05 FILLER PIC X(25) VALUE DTSBR793 -00204 ' ADDR-LINE1 '. DTSBR793 -00205 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00206 05 FILLER PIC X(22) VALUE DTSBR793 -00207 ' CITY '. DTSBR793 -00208 05 FILLER PIC X(11) VALUE DTSBR793 -00209 'ST ZIP'. DTSBR793 -00210 01 HEADER31. DTSBR793 -00211 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 -00212 05 FILLER PIC X(45) VALUE DTSBR793 -00213 'EMPLOYERS FOUND -DUTAS '. DTSBR793 -00214 05 FILLER PIC X(46) VALUE DTSBR793 -00215 'IRS (940) FUTA QUARTERLY - CROSS MATCH '. DTSBR793 -00216 05 FILLER PIC X(20) VALUE SPACES. DTSBR793 -00217 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR793 -00218 05 HDR31-PAGE PIC ZZ,ZZ9. DTSBR793 -00219 DTSBR793 -00220 DTSBR793 -00221 01 HEADER41. DTSBR793 -00222 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 -00223 05 FILLER PIC X(07) VALUE DTSBR793 -00224 'FEIN NO'. DTSBR793 -00225 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00226 05 FILLER PIC X(25) VALUE DTSBR793 -00227 ' EMP-NO NAME '. DTSBR793 -00228 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 -00229 05 FILLER PIC X(32) VALUE DTSBR793 -00230 ' DATE REG CLS '. DTSBR793 -00231 * 05 FILLER PIC X(10) VALUE SPACES. DTSBR793 -00232 05 FILLER PIC X(26) VALUE DTSBR793 -00233 'STA ORG RTN-MAIL NEW-A'. DTSBR793 -00234 05 FILLER PIC X(23) VALUE DTSBR793 -00235 'CCT FEIN/NAME IRS-TRAN'. DTSBR793 -00236 05 FILLER PIC X(05) VALUE DTSBR793 -00237 '-DATE'. DTSBR793 -00238 01 L005-LINK-AREA. DTSBR793 -00239 ++INCLUDE DTSIL005 DTSBR793 -00240 EJECT DTSBR793 -00241 01 L009-LINK-AREA. DTSBR793 -00242 ++INCLUDE DTSIL009 DTSBR793 -00243 EJECT DTSBR793 -00244 01 L071-LINK-AREA. DTSBR793 -00245 ++INCLUDE DTSIL071 DTSBR793 -00246 EJECT DTSBR793 -00247 01 L082-LINK-AREA. DTSBR793 -00248 ++INCLUDE DTSIL082 DTSBR793 -00249 EJECT DTSBR793 -00250 ++INCLUDE DTSXL793 DTSBR793 +00053 * MODULES CALLED: DTSBR793 +00054 * DTSBR793 +00055 * DTSBR793 +00056 * DTSBR793 +00057 ***** DTSBR793 +00058 EJECT DTSBR793 +00059 ENVIRONMENT DIVISION. DTSBR793 +00060 SKIP2 DTSBR793 +00061 CONFIGURATION SECTION. DTSBR793 +00062 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR793 +00063 INPUT-OUTPUT SECTION. DTSBR793 +00064 SKIP1 DTSBR793 +00065 FILE-CONTROL. DTSBR793 +00066 SELECT FEIN-FILE ASSIGN TO RPT793R1. DTSBR793 +00067 SELECT FEIN-FILE2 ASSIGN TO RPT793R2. DTSBR793 +00068 SELECT FEIN-FILE3 ASSIGN TO RPT793R3. DTSBR793 +00069 SKIP3 DTSBR793 +00070 DATA DIVISION. DTSBR793 +00071 SKIP3 DTSBR793 +00072 FILE SECTION. DTSBR793 +00073 SKIP2 DTSBR793 +00074 FD FEIN-FILE DTSBR793 +00075 LABEL RECORDS ARE OMITTED DTSBR793 +00076 DATA RECORD IS FEIN-LETTER. DTSBR793 +00077 01 FEIN-LETTER PIC X(133). DTSBR793 +00078 DTSBR793 +00079 FD FEIN-FILE2 DTSBR793 +00080 LABEL RECORDS ARE OMITTED DTSBR793 +00081 DATA RECORD IS FEIN-REPORT. DTSBR793 +00082 01 FEIN-REPORT PIC X(200). DTSBR793 +00083 DTSBR793 +00084 FD FEIN-FILE3 DTSBR793 +00085 LABEL RECORDS ARE OMITTED DTSBR793 +00086 DATA RECORD IS FEIN-REPORT. DTSBR793 +00087 01 FEIN-REPORT3 PIC X(133). DTSBR793 +00088 DTSBR793 +00089 EJECT DTSBR793 +00090 WORKING-STORAGE SECTION. DTSBR793 +000905 77 PAN-VALET PICTURE X(24) VALUE '003DTSBR793 05/05/22'. DTSBR793 +00091 77 PAN-VALET PICTURE X(24) VALUE '052DTSBR793 10/16/19'. DTSBR793 +00092 77 PAN-VALET PICTURE X(24) VALUE '045DTSBR793 09/17/19'. DTSBR793 +00093 77 PAN-VALET PICTURE X(24) VALUE '050DTSBR793 01/15/14'. DTSBR793 +00094 77 PAN-VALET PICTURE X(24) VALUE '002DTSBR793 01/15/14'. DTSBR793 +00095 77 PAN-VALET PICTURE X(24) VALUE '048DTSBR793 01/09/07'. DTSBR793 +00096 SKIP3 DTSBR793 +00097 01 WRK-AREA. DTSBR793 +00098 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +793.DTSBR793 +00099 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR793 +00100 SKIP1 DTSBR793 +00101 05 WS-EMP-NO PIC 999B999. DTSBR793 +00102 05 WS-EMP-NO-DISPLAY REDEFINES DTSBR793 +00103 WS-EMP-NO PIC X(7). DTSBR793 +00104 05 WS-FEIN-NO PIC 99B9999999. DTSBR793 +00105 05 WS-FEIN-NO-DISPLAY REDEFINES DTSBR793 +00106 WS-FEIN-NO PIC X(10). DTSBR793 +00107 05 WS-PAGE-CNT PIC 9(02) VALUE ZERO. DTSBR793 +00108 05 WS-LINE-CNT PIC S9(02) VALUE +55. DTSBR793 +00109 05 WS-PAGE-CNT3 PIC 9(02) VALUE ZERO. DTSBR793 +00110 05 WS-LINE-CNT3 PIC S9(02) VALUE +55. DTSBR793 +00111 EJECT DTSBR793 +00112 01 R793-LETTER-DATE. DTSBR793 +00113 05 FILLER PIC X(50) VALUE SPACES. DTSBR793 +00114 05 LETTER-DATE PIC X(10). DTSBR793 +00115 DTSBR793 +00116 01 R793-LETTER-FEIN. DTSBR793 +00117 05 FILLER PIC X(72) VALUE SPACES. CL**3 +00118 05 FILLER PIC X(07) VALUE 'FEIN: '. CL**3 +00119 05 LTR-FEIN-NO PIC 99B9999999. DTSBR793 +00120 01 R793-REPORT. DTSBR793 +00121 * 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 +00122 05 RPT-FEIN-NO PIC 99B9999999. DTSBR793 +00123 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00124 05 RPT-ADDR1 PIC X(35). DTSBR793 +00125 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00126 * 05 RPT-ADDR2 PIC X(35). DTSBR793 +00127 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00128 * 05 RPT-ADDR3 PIC X(35). DTSBR793 +00129 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00130 05 RPT-ADDR4 PIC X(35). DTSBR793 +00131 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00132 05 RPT-STREET PIC X(35). DTSBR793 +00133 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00134 05 RPT-CITY PIC X(10). DTSBR793 +00135 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00136 05 RPT-STATE PIC X(02). DTSBR793 +00137 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00138 05 RPT-ZIP PIC X(05). DTSBR793 +00139 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00140 05 RPT-ZIP4 PIC X(04). DTSBR793 +00141 DTSBR793 +00142 01 R793-REPORT3. DTSBR793 +00143 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 +00144 05 RPT-FEIN-NO3 PIC 99B9999999. DTSBR793 +00145 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00146 05 RPT-EMP-NO3 PIC 9(06). DTSBR793 +00147 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00148 05 RPT-EMP-NAME3 PIC X(30). DTSBR793 +00149 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00150 * 05 RPT-ADDR2 PIC X(15). DTSBR793 +00151 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00152 * 05 RPT-ADDR3 PIC X(25). DTSBR793 +00153 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00154 05 RPT-EMP-DATE3 PIC X(10). DTSBR793 +00155 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00156 05 RPT-EMP-CLASS3 PIC X(03). DTSBR793 +00157 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00158 05 RPT-EMP-STATUS3 PIC X(02). DTSBR793 +00159 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00160 05 RPT-EMP-ORG-TYPE3 PIC X(05). DTSBR793 +00161 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00162 05 RPT-RTN-MAIL3 PIC X(05). DTSBR793 +00163 05 FILLER PIC X(07) VALUE SPACES. DTSBR793 +00164 05 RPT-NEW-ACCT-IND PIC X(01). DTSBR793 +00165 05 FILLER PIC X(08) VALUE SPACES. DTSBR793 +00166 05 RPT-FEIN-CHNG-IND PIC X(01). DTSBR793 +00167 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00168 05 RPT-NAME-CHNG-IND PIC X(01). DTSBR793 +00169 05 FILLER PIC X(05) VALUE SPACES. DTSBR793 +00170 05 RPT-TRAN-DATE PIC X(10). DTSBR793 +00171 01 HEADER1. DTSBR793 +00172 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 +00173 05 HDR1-RPT PIC X(05). DTSBR793 +00174 05 FILLER PIC X(44) VALUE SPACES. DTSBR793 +00175 05 FILLER PIC X(60) VALUE DTSBR793 +00176 'DISTRICT OF COLUMBIA'. DTSBR793 +00177 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR793 +00178 05 HDR1-DATE PIC X(08). DTSBR793 +00179 01 HEADER2. DTSBR793 +00180 05 FILLER PIC X(56) VALUE SPACES. DTSBR793 +00181 05 FILLER PIC X(56) VALUE DTSBR793 +00182 'TAX DIVISION'. DTSBR793 +00183 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR793 +00184 05 HDR2-TIME PIC X(08). DTSBR793 +00185 DTSBR793 +00186 01 HEADER3. DTSBR793 +00187 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00188 05 FILLER PIC X(45) VALUE DTSBR793 +00189 'EMPLOYERS NOT IN DUTAS '. DTSBR793 +00190 05 FILLER PIC X(46) VALUE DTSBR793 +00191 'IRS (940) FUTA QUARTERLY - LETTER MAILED '. DTSBR793 +00192 05 FILLER PIC X(20) VALUE SPACES. DTSBR793 +00193 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR793 +00194 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR793 +00195 DTSBR793 +00196 DTSBR793 +00197 01 HEADER4. DTSBR793 +00198 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00199 05 FILLER PIC X(07) VALUE DTSBR793 +00200 'FEIN NO'. DTSBR793 +00201 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00202 05 FILLER PIC X(25) VALUE DTSBR793 +00203 ' EMP-NAME '. DTSBR793 +00204 05 FILLER PIC X(07) VALUE SPACES. DTSBR793 +00205 05 FILLER PIC X(25) VALUE DTSBR793 +00206 ' ATTENTION '. DTSBR793 +00207 05 FILLER PIC X(15) VALUE SPACES. DTSBR793 +00208 05 FILLER PIC X(25) VALUE DTSBR793 +00209 ' ADDR-LINE1 '. DTSBR793 +00210 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00211 05 FILLER PIC X(22) VALUE DTSBR793 +00212 ' CITY '. DTSBR793 +00213 05 FILLER PIC X(11) VALUE DTSBR793 +00214 'ST ZIP'. DTSBR793 +00215 01 HEADER31. DTSBR793 +00216 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 +00217 05 FILLER PIC X(45) VALUE DTSBR793 +00218 'EMPLOYERS FOUND -DUTAS '. DTSBR793 +00219 05 FILLER PIC X(46) VALUE DTSBR793 +00220 'IRS (940) FUTA QUARTERLY - CROSS MATCH '. DTSBR793 +00221 05 FILLER PIC X(20) VALUE SPACES. DTSBR793 +00222 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR793 +00223 05 HDR31-PAGE PIC ZZ,ZZ9. DTSBR793 +00224 DTSBR793 +00225 DTSBR793 +00226 01 HEADER41. DTSBR793 +00227 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 +00228 05 FILLER PIC X(07) VALUE DTSBR793 +00229 'FEIN NO'. DTSBR793 +00230 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00231 05 FILLER PIC X(25) VALUE DTSBR793 +00232 ' EMP-NO NAME '. DTSBR793 +00233 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 +00234 05 FILLER PIC X(32) VALUE DTSBR793 +00235 ' DATE REG CLS '. DTSBR793 +00236 * 05 FILLER PIC X(10) VALUE SPACES. DTSBR793 +00237 05 FILLER PIC X(26) VALUE DTSBR793 +00238 'STA ORG RTN-MAIL NEW-A'. DTSBR793 +00239 05 FILLER PIC X(23) VALUE DTSBR793 +00240 'CCT FEIN/NAME IRS-TRAN'. DTSBR793 +00241 05 FILLER PIC X(05) VALUE DTSBR793 +00242 '-DATE'. DTSBR793 +00243 01 L005-LINK-AREA. DTSBR793 +00244 ++INCLUDE DTSIL005 DTSBR793 +00245 EJECT DTSBR793 +00246 01 L009-LINK-AREA. DTSBR793 +00247 ++INCLUDE DTSIL009 DTSBR793 +00248 EJECT DTSBR793 +00249 01 L071-LINK-AREA. DTSBR793 +00250 ++INCLUDE DTSIL071 DTSBR793 00251 EJECT DTSBR793 -00252 LINKAGE SECTION. DTSBR793 -00253 SKIP3 DTSBR793 -00254 01 LRCM-LINK-AREA. DTSBR793 -00255 ++INCLUDE DTSILRCM DTSBR793 +00252 01 L082-LINK-AREA. DTSBR793 +00253 ++INCLUDE DTSIL082 DTSBR793 +00254 EJECT DTSBR793 +00255 ++INCLUDE DTSXL793 DTSBR793 00256 EJECT DTSBR793 -00257 01 R793-REC. DTSBR793 -00258 ++INCLUDE DTSIR793 DTSBR793 -00259 EJECT DTSBR793 -00260 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR793 -00261 R793-REC. DTSBR793 -00262 SKIP2 DTSBR793 -00263 IF FIRST-TIME-IND = 'Y' DTSBR793 -00264 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR793 -00265 MOVE 'N' TO FIRST-TIME-IND. DTSBR793 -00266 SKIP1 DTSBR793 -00267 IF LRCM-EOR-88 DTSBR793 -00268 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR793 -00269 ELSE DTSBR793 -00270 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR793 -00271 SKIP2 DTSBR793 -00272 GOBACK. DTSBR793 -00273 EJECT DTSBR793 -00274 I1000-INITIATE. DTSBR793 -00275 SKIP1 DTSBR793 -00276 OPEN OUTPUT FEIN-FILE FEIN-FILE2 FEIN-FILE3. DTSBR793 -00277 WRITE FEIN-LETTER FROM XF-CA-CNTL-LIN0 AFTER DTSBR793 -00278 ADVANCING TOP-OF-PAGE. DTSBR793 -00279 WRITE FEIN-LETTER FROM XF-CA-CNTL-LINE. DTSBR793 -00280 SKIP2 DTSBR793 -00281 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBR793 -00282 MOVE L005-SLASH-DATE TO HDR1-DATE LETTER-DATE. DTSBR793 -00283 MOVE L005-DISPLAY-TIME TO HDR2-TIME. DTSBR793 -00284 DTSBR793 -00285 I1000-EXIT. DTSBR793 -00286 EXIT. DTSBR793 -00287 EJECT DTSBR793 -00288 P1000-PROCESS. DTSBR793 -00289 SKIP1 DTSBR793 -00290 MOVE SPACES TO R793-REPORT. DTSBR793 -00291 DTSBR793 -00292 MOVE R793-FEIN TO WS-FEIN-NO DTSBR793 -00293 MOVE WS-FEIN-NO TO RPT-FEIN-NO. DTSBR793 -00294 DTSBR793 -00295 IF R793-RPT-TYPE = '02' DTSBR793 -00296 PERFORM P2300-GENERATE-DUTA-REPORT THRU P2300-EXIT DTSBR793 -00297 ELSE DTSBR793 -00298 PERFORM P2100-GENERATE-FEIN-LETTER THRU P2100-EXIT DTSBR793 -00299 PERFORM P2200-GENERATE-FEIN-REPORT THRU P2200-EXIT. DTSBR793 -00300 SKIP2 DTSBR793 -00301 P1000-EXIT. DTSBR793 -00302 EXIT. DTSBR793 -00303 EJECT DTSBR793 -00304 P2000-FORMAT-OPR-NAME. DTSBR793 -00305 SKIP1 DTSBR793 -00306 * MOVE R793-OP-ID TO L082-OP-ID. DTSBR793 -00307 * PERFORM S082-OP-ID-INFO THRU S082-EXIT. DTSBR793 -00308 * MOVE L082-NAME TO L071-NAM. DTSBR793 -00309 * MOVE 2 TO L071-NAME-FORMAT. DTSBR793 -00310 * PERFORM S071-DESLASH-NAME THRU S071-EXIT. DTSBR793 -00311 * MOVE L071-NAM TO L009-DATA. DTSBR793 -00312 * PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR793 -00313 * MOVE L009-DATA TO WS-OPR-NAME. DTSBR793 -00314 * MOVE L082-UNIT-NAME TO L009-DATA. DTSBR793 -00315 * PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR793 -00316 * MOVE L009-DATA TO WS-OPR-UNIT-NAME. DTSBR793 -00317 SKIP2 DTSBR793 -00318 P2000-EXIT. DTSBR793 -00319 EXIT. DTSBR793 -00320 EJECT DTSBR793 -00321 P2100-GENERATE-FEIN-LETTER. DTSBR793 -00322 * MOVE SPACES TO PRT-REC. DTSBR793 -00323 * ADD 1 TO WS-PAGE-NO. DTSBR793 -00324 * MOVE LRCM-SYS-8-DATE TO FILA. DTSBR793 -00325 * MOVE WS-PAGE-NO TO FILD. DTSBR793 -00326 * WRITE PRT-REC FROM HEAD AFTER ADVANCING TOP-OF-PAGE. DTSBR793 -00327 * WRITE PRT-REC FROM HEADA AFTER ADVANCING 2 LINES. DTSBR793 -00328 * ADD 3 TO WS-LINE-CNT. DTSBR793 -00329 * MOVE R792-EMP-NO TO E-NUM. DTSBR793 -00330 * MOVE WS-FEIN-NO TO ID-NUM. DTSBR793 -00331 * MOVE R793-STATE-CODE TO CDE. DTSBR793 -00332 * MOVE R793-NAME-LINE-1 TO ADDR. DTSBR793 -00333 * WRITE PRT-REC FROM DETAIL1 AFTER ADVANCING 2 LINES. DTSBR793 -00334 * ADD 2 TO WS-LINE-CNT. DTSBR793 -00335 * MOVE R793-NAME-LINE-2 TO ADDR1 DTSBR793 -00336 * WRITE PRT-REC FROM DETAIL2 AFTER ADVANCING 1 LINES. DTSBR793 -00337 * MOVE R793-NAME-LINE-3 TO ADDR2 DTSBR793 -00338 * WRITE PRT-REC FROM DETAIL3 AFTER ADVANCING 1 LINES. DTSBR793 -00339 * MOVE R793-NAME-LINE-4 TO ADDR3 DTSBR793 -00340 * WRITE PRT-REC FROM DETAIL4 AFTER ADVANCING 1 LINES. DTSBR793 -00341 * MOVE R793-STREET-ADDRESS TO ADDR4. DTSBR793 -00342 * WRITE PRT-REC FROM DETAIL5 AFTER ADVANCING 1 LINES. DTSBR793 -00343 * MOVE R793-CITY TO ADDR-CITY OF DETAIL6 DTSBR793 -00344 * MOVE R793-STATE-CODE TO ADDR-STATE OF DETAIL6 DTSBR793 -00345 * MOVE R793-ZIP-CODE TO ADDR-ZIP OF DETAIL6 DTSBR793 -00346 * WRITE PRT-REC FROM DETAIL6 AFTER 1. DTSBR793 -00347 DTSBR793 -00348 **> DTSBR793 -00349 * WRITE FEIN-LETTER FROM X1-CA-CNTL-LINE. DTSBR793 -00350 WRITE FEIN-LETTER FROM X2-CA-CNTL-LINE. DTSBR793 -00351 WRITE FEIN-LETTER FROM X3-CA-CNTL-LINE. DTSBR793 +00257 LINKAGE SECTION. DTSBR793 +00258 SKIP3 DTSBR793 +00259 01 LRCM-LINK-AREA. DTSBR793 +00260 ++INCLUDE DTSILRCM DTSBR793 +00261 EJECT DTSBR793 +00262 01 R793-REC. DTSBR793 +00263 ++INCLUDE DTSIR793 DTSBR793 +00264 EJECT DTSBR793 +00265 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR793 +00266 R793-REC. DTSBR793 +00267 SKIP2 DTSBR793 +00268 IF FIRST-TIME-IND = 'Y' DTSBR793 +00269 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR793 +00270 MOVE 'N' TO FIRST-TIME-IND. DTSBR793 +00271 SKIP1 DTSBR793 +00272 IF LRCM-EOR-88 DTSBR793 +00273 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR793 +00274 ELSE DTSBR793 +00275 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR793 +00276 SKIP2 DTSBR793 +00277 GOBACK. DTSBR793 +00278 EJECT DTSBR793 +00279 I1000-INITIATE. DTSBR793 +00280 SKIP1 DTSBR793 +00281 OPEN OUTPUT FEIN-FILE FEIN-FILE2 FEIN-FILE3. DTSBR793 +00282 WRITE FEIN-LETTER FROM XF-CA-CNTL-LIN0 AFTER DTSBR793 +00283 ADVANCING TOP-OF-PAGE. DTSBR793 +00284 WRITE FEIN-LETTER FROM XF-CA-CNTL-LINE. DTSBR793 +00285 SKIP2 DTSBR793 +00286 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBR793 +00287 MOVE L005-SLASH-DATE TO HDR1-DATE LETTER-DATE. DTSBR793 +00288 MOVE L005-DISPLAY-TIME TO HDR2-TIME. DTSBR793 +00289 DTSBR793 +00290 I1000-EXIT. DTSBR793 +00291 EXIT. DTSBR793 +00292 EJECT DTSBR793 +00293 P1000-PROCESS. DTSBR793 +00294 SKIP1 DTSBR793 +00295 MOVE SPACES TO R793-REPORT. DTSBR793 +00296 DTSBR793 +00297 MOVE R793-FEIN TO WS-FEIN-NO DTSBR793 +00298 MOVE WS-FEIN-NO TO RPT-FEIN-NO. DTSBR793 +00299 DTSBR793 +00300 IF R793-RPT-TYPE = '02' DTSBR793 +00301 PERFORM P2300-GENERATE-DUTA-REPORT THRU P2300-EXIT DTSBR793 +00302 ELSE DTSBR793 +00303 PERFORM P2100-GENERATE-FEIN-LETTER THRU P2100-EXIT DTSBR793 +00304 PERFORM P2200-GENERATE-FEIN-REPORT THRU P2200-EXIT. DTSBR793 +00305 SKIP2 DTSBR793 +00306 P1000-EXIT. DTSBR793 +00307 EXIT. DTSBR793 +00308 EJECT DTSBR793 +00309 P2000-FORMAT-OPR-NAME. DTSBR793 +00310 SKIP1 DTSBR793 +00311 * MOVE R793-OP-ID TO L082-OP-ID. DTSBR793 +00312 * PERFORM S082-OP-ID-INFO THRU S082-EXIT. DTSBR793 +00313 * MOVE L082-NAME TO L071-NAM. DTSBR793 +00314 * MOVE 2 TO L071-NAME-FORMAT. DTSBR793 +00315 * PERFORM S071-DESLASH-NAME THRU S071-EXIT. DTSBR793 +00316 * MOVE L071-NAM TO L009-DATA. DTSBR793 +00317 * PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR793 +00318 * MOVE L009-DATA TO WS-OPR-NAME. DTSBR793 +00319 * MOVE L082-UNIT-NAME TO L009-DATA. DTSBR793 +00320 * PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR793 +00321 * MOVE L009-DATA TO WS-OPR-UNIT-NAME. DTSBR793 +00322 SKIP2 DTSBR793 +00323 P2000-EXIT. DTSBR793 +00324 EXIT. DTSBR793 +00325 EJECT DTSBR793 +00326 P2100-GENERATE-FEIN-LETTER. DTSBR793 +00327 * MOVE SPACES TO PRT-REC. DTSBR793 +00328 * ADD 1 TO WS-PAGE-NO. DTSBR793 +00329 * MOVE LRCM-SYS-8-DATE TO FILA. DTSBR793 +00330 * MOVE WS-PAGE-NO TO FILD. DTSBR793 +00331 * WRITE PRT-REC FROM HEAD AFTER ADVANCING TOP-OF-PAGE. DTSBR793 +00332 * WRITE PRT-REC FROM HEADA AFTER ADVANCING 2 LINES. DTSBR793 +00333 * ADD 3 TO WS-LINE-CNT. DTSBR793 +00334 * MOVE R792-EMP-NO TO E-NUM. DTSBR793 +00335 * MOVE WS-FEIN-NO TO ID-NUM. DTSBR793 +00336 * MOVE R793-STATE-CODE TO CDE. DTSBR793 +00337 * MOVE R793-NAME-LINE-1 TO ADDR. DTSBR793 +00338 * WRITE PRT-REC FROM DETAIL1 AFTER ADVANCING 2 LINES. DTSBR793 +00339 * ADD 2 TO WS-LINE-CNT. DTSBR793 +00340 * MOVE R793-NAME-LINE-2 TO ADDR1 DTSBR793 +00341 * WRITE PRT-REC FROM DETAIL2 AFTER ADVANCING 1 LINES. DTSBR793 +00342 * MOVE R793-NAME-LINE-3 TO ADDR2 DTSBR793 +00343 * WRITE PRT-REC FROM DETAIL3 AFTER ADVANCING 1 LINES. DTSBR793 +00344 * MOVE R793-NAME-LINE-4 TO ADDR3 DTSBR793 +00345 * WRITE PRT-REC FROM DETAIL4 AFTER ADVANCING 1 LINES. DTSBR793 +00346 * MOVE R793-STREET-ADDRESS TO ADDR4. DTSBR793 +00347 * WRITE PRT-REC FROM DETAIL5 AFTER ADVANCING 1 LINES. DTSBR793 +00348 * MOVE R793-CITY TO ADDR-CITY OF DETAIL6 DTSBR793 +00349 * MOVE R793-STATE-CODE TO ADDR-STATE OF DETAIL6 DTSBR793 +00350 * MOVE R793-ZIP-CODE TO ADDR-ZIP OF DETAIL6 DTSBR793 +00351 * WRITE PRT-REC FROM DETAIL6 AFTER 1. DTSBR793 00352 DTSBR793 -00353 MOVE SPACES TO FEIN-LETTER VSCA-DATA. DTSBR793 -00354 MOVE R793-CITY TO FEIN-CITY DTSBR793 -00355 MOVE R793-STATE-CODE TO FEIN-STATE DTSBR793 -00356 * MOVE R793-ZIP-CODE TO FEIN-ZIP DTSBR793 -00357 MOVE R793-ZIP-1-5 TO FEIN-ZIP-1-5 DTSBR793 -00358 MOVE R793-ZIP-6-9 TO FEIN-ZIP-6-9. DTSBR793 -00359 * MOVE R793-ZIP-10-12 TO FEIN-ZIP-10-12. DTSBR793 -00360 MOVE SPACES TO FEIN-ZIP-10-12. DTSBR793 -00361 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER TOP-OF-PAGE. DTSBR793 -00362 MOVE SPACES TO VSCA-DATA. DTSBR793 -00363 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE DTSBR793 -00364 AFTER ADVANCING 7 LINES DTSBR793 -00365 MOVE SPACES TO VSCA-DATA. DTSBR793 -00366 MOVE WS-FEIN-NO-DISPLAY TO PRTB. DTSBR793 -00367 * MOVE WS-FEIN-NO TO PRTB. DTSBR793 -00368 * PERFORM S060-FORM THRU S060-EXIT 27 TIMES. DTSBR793 -00369 * MOVE SPACES TO PRT1 PRT1-A. DTSBR793 -00370 DTSBR793 -00371 WRITE FEIN-LETTER FROM R793-LETTER-DATE AFTER 2 DTSBR793 -00372 * MOVE WS-FEIN-NO-DISPLAY TO LTR-FEIN-NO. DTSBR793 -00373 MOVE WS-FEIN-NO TO LTR-FEIN-NO. DTSBR793 -00374 WRITE FEIN-LETTER FROM R793-LETTER-FEIN AFTER 3 DTSBR793 +00353 **> DTSBR793 +00354 * WRITE FEIN-LETTER FROM X1-CA-CNTL-LINE. DTSBR793 +00355 WRITE FEIN-LETTER FROM X2-CA-CNTL-LINE. DTSBR793 +00356 WRITE FEIN-LETTER FROM X3-CA-CNTL-LINE. DTSBR793 +00357 DTSBR793 +00358 MOVE SPACES TO FEIN-LETTER VSCA-DATA. DTSBR793 +00359 MOVE R793-CITY TO FEIN-CITY DTSBR793 +00360 MOVE R793-STATE-CODE TO FEIN-STATE DTSBR793 +00361 * MOVE R793-ZIP-CODE TO FEIN-ZIP DTSBR793 +00362 MOVE R793-ZIP-1-5 TO FEIN-ZIP-1-5 DTSBR793 +00363 MOVE R793-ZIP-6-9 TO FEIN-ZIP-6-9. DTSBR793 +00364 * MOVE R793-ZIP-10-12 TO FEIN-ZIP-10-12. DTSBR793 +00365 MOVE SPACES TO FEIN-ZIP-10-12. DTSBR793 +00366 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER TOP-OF-PAGE. DTSBR793 +00367 MOVE SPACES TO VSCA-DATA. DTSBR793 +00368 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE DTSBR793 +00369 AFTER ADVANCING 7 LINES DTSBR793 +00370 MOVE SPACES TO VSCA-DATA. DTSBR793 +00371 MOVE WS-FEIN-NO-DISPLAY TO PRTB. DTSBR793 +00372 * MOVE WS-FEIN-NO TO PRTB. DTSBR793 +00373 * PERFORM S060-FORM THRU S060-EXIT 27 TIMES. DTSBR793 +00374 * MOVE SPACES TO PRT1 PRT1-A. DTSBR793 00375 DTSBR793 -00376 MOVE R793-NAME-LINE-1 TO PRT1 DTSBR793 -00377 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00378 DTSBR793 -00379 * IF R793-NAME-LINE-2 NOT = SPACES DTSBR793 -00380 * MOVE R793-NAME-LINE-2 TO PRT1 DTSBR793 -00381 * PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00382 DTSBR793 -00383 IF R793-NAME-LINE-3 NOT = SPACES DTSBR793 -00384 MOVE R793-NAME-LINE-3 TO PRT1 DTSBR793 -00385 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00386 DTSBR793 -00387 IF R793-NAME-LINE-4 NOT = SPACES DTSBR793 -00388 MOVE R793-NAME-LINE-4 TO PRT1 DTSBR793 -00389 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00390 DTSBR793 -00391 MOVE R793-STREET-ADDRESS TO PRT1. DTSBR793 -00392 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00393 DTSBR793 -00394 MOVE FEIN-DET7 TO PRT1. DTSBR793 -00395 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00396 ******************************************************************DTSBR793 -00397 * THIS AREA WILL MOVE THE ADDRESS FOR LETTER DTSBR793 -00398 ******************************************************************DTSBR793 -00399 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER TOP-OF-PAGE. DTSBR793 -00400 PERFORM S060-FORM THRU S060-EXIT 17 TIMES. DTSBR793 -00401 MOVE R793-NAME-LINE-1 TO PRT2. DTSBR793 -00402 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00403 DTSBR793 -00404 IF R793-NAME-LINE-2 NOT = SPACES DTSBR793 -00405 MOVE R793-NAME-LINE-2 TO PRT2 DTSBR793 -00406 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00407 DTSBR793 -00408 IF R793-NAME-LINE-3 NOT = SPACES DTSBR793 -00409 MOVE R793-NAME-LINE-3 TO PRT2 DTSBR793 -00410 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00411 DTSBR793 -00412 IF R793-NAME-LINE-4 NOT = SPACES DTSBR793 -00413 MOVE R793-NAME-LINE-4 TO PRT2 DTSBR793 -00414 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00415 DTSBR793 -00416 MOVE R793-STREET-ADDRESS TO PRT2. DTSBR793 -00417 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00418 DTSBR793 -00419 MOVE FEIN-DET7 TO PRT2. DTSBR793 -00420 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 -00421 P2100-EXIT. DTSBR793 -00422 EXIT. DTSBR793 -00423 P2200-GENERATE-FEIN-REPORT. DTSBR793 -00424 ADD 1 TO WS-LINE-CNT. DTSBR793 -00425 IF WS-LINE-CNT > 50 DTSBR793 -00426 ADD 1 TO WS-PAGE-CNT DTSBR793 -00427 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSBR793 -00428 MOVE '793R1' TO HDR1-RPT DTSBR793 -00429 WRITE FEIN-REPORT FROM HEADER1 DTSBR793 -00430 AFTER ADVANCING TOP-OF-PAGE DTSBR793 -00431 WRITE FEIN-REPORT FROM HEADER2 AFTER ADVANCING 1 DTSBR793 -00432 WRITE FEIN-REPORT FROM HEADER3 AFTER ADVANCING 1 DTSBR793 -00433 WRITE FEIN-REPORT FROM HEADER4 AFTER ADVANCING 1 DTSBR793 -00434 MOVE 1 TO WS-LINE-CNT. DTSBR793 -00435 DTSBR793 -00436 * MOVE SPACES TO FEIN-REPORT. DTSBR793 -00437 MOVE R793-FEIN TO RPT-FEIN-NO DTSBR793 -00438 MOVE R793-CITY TO RPT-CITY. DTSBR793 -00439 MOVE R793-STATE-CODE TO RPT-STATE DTSBR793 -00440 MOVE R793-ZIP-1-5 TO RPT-ZIP. DTSBR793 -00441 MOVE R793-ZIP-6-9 TO RPT-ZIP4. DTSBR793 -00442 MOVE R793-NAME-LINE-1 TO RPT-ADDR1. DTSBR793 -00443 * MOVE R793-NAME-LINE-2 TO RPT-ADDR2 DTSBR793 -00444 IF R793-NAME-LINE-3 > SPACES DTSBR793 -00445 MOVE R793-NAME-LINE-3 TO RPT-ADDR4 DTSBR793 -00446 ELSE DTSBR793 -00447 MOVE R793-NAME-LINE-4 TO RPT-ADDR4. DTSBR793 -00448 MOVE R793-STREET-ADDRESS TO RPT-STREET. DTSBR793 -00449 DTSBR793 -00450 WRITE FEIN-REPORT FROM R793-REPORT AFTER ADVANCING 1. DTSBR793 -00451 P2200-EXIT. DTSBR793 -00452 EXIT. DTSBR793 -00453 P2300-GENERATE-DUTA-REPORT. DTSBR793 -00454 ADD 1 TO WS-LINE-CNT3. DTSBR793 -00455 IF WS-LINE-CNT3 > 50 DTSBR793 -00456 ADD 1 TO WS-PAGE-CNT3 DTSBR793 -00457 MOVE WS-PAGE-CNT3 TO HDR31-PAGE DTSBR793 -00458 MOVE '793R2' TO HDR1-RPT DTSBR793 -00459 WRITE FEIN-REPORT3 FROM HEADER1 DTSBR793 -00460 AFTER ADVANCING TOP-OF-PAGE DTSBR793 -00461 WRITE FEIN-REPORT3 FROM HEADER2 AFTER ADVANCING 1 DTSBR793 -00462 WRITE FEIN-REPORT3 FROM HEADER31 AFTER ADVANCING 1 DTSBR793 -00463 WRITE FEIN-REPORT3 FROM HEADER41 AFTER ADVANCING 1 DTSBR793 -00464 MOVE 1 TO WS-LINE-CNT3. DTSBR793 -00465 DTSBR793 -00466 * MOVE SPACES TO FEIN-REPORT. DTSBR793 -00467 MOVE R793-FEIN TO RPT-FEIN-NO3 DTSBR793 -00468 MOVE R793-EMP-NO TO RPT-EMP-NO3 DTSBR793 -00469 MOVE R793-EMP-NAME TO RPT-EMP-NAME3 DTSBR793 -00470 MOVE R793-EMP-DATE TO RPT-EMP-DATE3 DTSBR793 -00471 MOVE R793-EMP-CLASS TO RPT-EMP-CLASS3 DTSBR793 -00472 MOVE R793-EMP-STATUS TO RPT-EMP-STATUS3 DTSBR793 -00473 MOVE R793-ORG-TYPE TO RPT-EMP-ORG-TYPE3 DTSBR793 -00474 MOVE R793-RTN-MAIL TO RPT-RTN-MAIL3 DTSBR793 -00475 MOVE R793-NEW-ACCT-IND TO RPT-NEW-ACCT-IND DTSBR793 -00476 MOVE R793-FEIN-CHNG-IND TO RPT-FEIN-CHNG-IND DTSBR793 -00477 MOVE R793-NAME-CHNG-IND TO RPT-NAME-CHNG-IND DTSBR793 -00478 MOVE R793-TRAN-DATE TO RPT-TRAN-DATE DTSBR793 -00479 DTSBR793 -00480 WRITE FEIN-REPORT3 FROM R793-REPORT3 AFTER ADVANCING 1. DTSBR793 -00481 P2300-EXIT. DTSBR793 -00482 EXIT. DTSBR793 -00483 EJECT DTSBR793 -00484 T1000-TERMINATE. DTSBR793 -00485 SKIP1 DTSBR793 -00486 WRITE FEIN-LETTER FROM X4-CA-END-LINE. DTSBR793 -00487 CLOSE FEIN-FILE FEIN-FILE2 FEIN-FILE3. DTSBR793 -00488 SKIP2 DTSBR793 -00489 T1000-EXIT. DTSBR793 -00490 EXIT. DTSBR793 -00491 EJECT DTSBR793 -00492 S060-FORM. DTSBR793 -00493 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER 1. DTSBR793 -00494 MOVE SPACES TO VSCA-DATA. DTSBR793 -00495 S060-EXIT. DTSBR793 -00496 EXIT. DTSBR793 -00497 S009-CONVERT-TO-CAPS. DTSBR793 -00498 SKIP1 DTSBR793 -00499 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR793 -00500 SKIP2 DTSBR793 -00501 S009-EXIT. DTSBR793 -00502 EXIT. DTSBR793 -00503 SKIP3 DTSBR793 -00504 S005-SYS-DATE. DTSBR793 -00505 SKIP1 DTSBR793 -00506 SET L005-FROM-SYS TO TRUE. DTSBR793 -00507 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBR793 -00508 SKIP2 DTSBR793 -00509 S005-EXIT. DTSBR793 -00510 EXIT. DTSBR793 -00511 S071-DESLASH-NAME. DTSBR793 -00512 SKIP1 DTSBR793 -00513 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR793 -00514 SKIP2 DTSBR793 -00515 S071-EXIT. DTSBR793 -00516 EXIT. DTSBR793 -00517 SKIP3 DTSBR793 -00518 S082-OP-ID-INFO. DTSBR793 -00519 SKIP1 DTSBR793 -00520 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR793 -00521 SKIP2 DTSBR793 -00522 S082-EXIT. DTSBR793 -00523 EXIT. DTSBR793 -00524 SKIP3 DTSBR793 -00525 S999-ABEND. DTSBR793 -00526 SKIP1 DTSBR793 -00527 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR793 -00528 SKIP2 DTSBR793 -00529 S999-EXIT. DTSBR793 -00530 EXIT. DTSBR793 +00376 WRITE FEIN-LETTER FROM R793-LETTER-DATE AFTER 2 DTSBR793 +00377 * MOVE WS-FEIN-NO-DISPLAY TO LTR-FEIN-NO. DTSBR793 +00378 MOVE WS-FEIN-NO TO LTR-FEIN-NO. DTSBR793 +00379 WRITE FEIN-LETTER FROM R793-LETTER-FEIN AFTER 2 CL**2 +00380 DTSBR793 +00381 MOVE R793-NAME-LINE-1 TO PRT1 DTSBR793 +00382 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00383 DTSBR793 +00384 * IF R793-NAME-LINE-2 NOT = SPACES DTSBR793 +00385 * MOVE R793-NAME-LINE-2 TO PRT1 DTSBR793 +00386 * PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00387 DTSBR793 +00388 IF R793-NAME-LINE-3 NOT = SPACES DTSBR793 +00389 MOVE R793-NAME-LINE-3 TO PRT1 DTSBR793 +00390 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00391 DTSBR793 +00392 IF R793-NAME-LINE-4 NOT = SPACES DTSBR793 +00393 MOVE R793-NAME-LINE-4 TO PRT1 DTSBR793 +00394 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00395 DTSBR793 +00396 MOVE R793-STREET-ADDRESS TO PRT1. DTSBR793 +00397 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00398 DTSBR793 +00399 MOVE FEIN-DET7 TO PRT1. DTSBR793 +00400 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00401 ******************************************************************DTSBR793 +00402 * THIS AREA WILL MOVE THE ADDRESS FOR LETTER DTSBR793 +00403 ******************************************************************DTSBR793 +00404 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER TOP-OF-PAGE. DTSBR793 +00405 PERFORM S060-FORM THRU S060-EXIT 17 TIMES. DTSBR793 +00406 MOVE R793-NAME-LINE-1 TO PRT2. DTSBR793 +00407 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00408 DTSBR793 +00409 IF R793-NAME-LINE-2 NOT = SPACES DTSBR793 +00410 MOVE R793-NAME-LINE-2 TO PRT2 DTSBR793 +00411 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00412 DTSBR793 +00413 IF R793-NAME-LINE-3 NOT = SPACES DTSBR793 +00414 MOVE R793-NAME-LINE-3 TO PRT2 DTSBR793 +00415 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00416 DTSBR793 +00417 IF R793-NAME-LINE-4 NOT = SPACES DTSBR793 +00418 MOVE R793-NAME-LINE-4 TO PRT2 DTSBR793 +00419 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00420 DTSBR793 +00421 MOVE R793-STREET-ADDRESS TO PRT2. DTSBR793 +00422 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00423 DTSBR793 +00424 MOVE FEIN-DET7 TO PRT2. DTSBR793 +00425 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 +00426 P2100-EXIT. DTSBR793 +00427 EXIT. DTSBR793 +00428 P2200-GENERATE-FEIN-REPORT. DTSBR793 +00429 ADD 1 TO WS-LINE-CNT. DTSBR793 +00430 IF WS-LINE-CNT > 50 DTSBR793 +00431 ADD 1 TO WS-PAGE-CNT DTSBR793 +00432 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSBR793 +00433 MOVE '793R1' TO HDR1-RPT DTSBR793 +00434 WRITE FEIN-REPORT FROM HEADER1 DTSBR793 +00435 AFTER ADVANCING TOP-OF-PAGE DTSBR793 +00436 WRITE FEIN-REPORT FROM HEADER2 AFTER ADVANCING 1 DTSBR793 +00437 WRITE FEIN-REPORT FROM HEADER3 AFTER ADVANCING 1 DTSBR793 +00438 WRITE FEIN-REPORT FROM HEADER4 AFTER ADVANCING 1 DTSBR793 +00439 MOVE 1 TO WS-LINE-CNT. DTSBR793 +00440 DTSBR793 +00441 * MOVE SPACES TO FEIN-REPORT. DTSBR793 +00442 MOVE R793-FEIN TO RPT-FEIN-NO DTSBR793 +00443 MOVE R793-CITY TO RPT-CITY. DTSBR793 +00444 MOVE R793-STATE-CODE TO RPT-STATE DTSBR793 +00445 MOVE R793-ZIP-1-5 TO RPT-ZIP. DTSBR793 +00446 MOVE R793-ZIP-6-9 TO RPT-ZIP4. DTSBR793 +00447 MOVE R793-NAME-LINE-1 TO RPT-ADDR1. DTSBR793 +00448 * MOVE R793-NAME-LINE-2 TO RPT-ADDR2 DTSBR793 +00449 IF R793-NAME-LINE-3 > SPACES DTSBR793 +00450 MOVE R793-NAME-LINE-3 TO RPT-ADDR4 DTSBR793 +00451 ELSE DTSBR793 +00452 MOVE R793-NAME-LINE-4 TO RPT-ADDR4. DTSBR793 +00453 MOVE R793-STREET-ADDRESS TO RPT-STREET. DTSBR793 +00454 DTSBR793 +00455 WRITE FEIN-REPORT FROM R793-REPORT AFTER ADVANCING 1. DTSBR793 +00456 P2200-EXIT. DTSBR793 +00457 EXIT. DTSBR793 +00458 P2300-GENERATE-DUTA-REPORT. DTSBR793 +00459 ADD 1 TO WS-LINE-CNT3. DTSBR793 +00460 IF WS-LINE-CNT3 > 50 DTSBR793 +00461 ADD 1 TO WS-PAGE-CNT3 DTSBR793 +00462 MOVE WS-PAGE-CNT3 TO HDR31-PAGE DTSBR793 +00463 MOVE '793R2' TO HDR1-RPT DTSBR793 +00464 WRITE FEIN-REPORT3 FROM HEADER1 DTSBR793 +00465 AFTER ADVANCING TOP-OF-PAGE DTSBR793 +00466 WRITE FEIN-REPORT3 FROM HEADER2 AFTER ADVANCING 1 DTSBR793 +00467 WRITE FEIN-REPORT3 FROM HEADER31 AFTER ADVANCING 1 DTSBR793 +00468 WRITE FEIN-REPORT3 FROM HEADER41 AFTER ADVANCING 1 DTSBR793 +00469 MOVE 1 TO WS-LINE-CNT3. DTSBR793 +00470 DTSBR793 +00471 * MOVE SPACES TO FEIN-REPORT. DTSBR793 +00472 MOVE R793-FEIN TO RPT-FEIN-NO3 DTSBR793 +00473 MOVE R793-EMP-NO TO RPT-EMP-NO3 DTSBR793 +00474 MOVE R793-EMP-NAME TO RPT-EMP-NAME3 DTSBR793 +00475 MOVE R793-EMP-DATE TO RPT-EMP-DATE3 DTSBR793 +00476 MOVE R793-EMP-CLASS TO RPT-EMP-CLASS3 DTSBR793 +00477 MOVE R793-EMP-STATUS TO RPT-EMP-STATUS3 DTSBR793 +00478 MOVE R793-ORG-TYPE TO RPT-EMP-ORG-TYPE3 DTSBR793 +00479 MOVE R793-RTN-MAIL TO RPT-RTN-MAIL3 DTSBR793 +00480 MOVE R793-NEW-ACCT-IND TO RPT-NEW-ACCT-IND DTSBR793 +00481 MOVE R793-FEIN-CHNG-IND TO RPT-FEIN-CHNG-IND DTSBR793 +00482 MOVE R793-NAME-CHNG-IND TO RPT-NAME-CHNG-IND DTSBR793 +00483 MOVE R793-TRAN-DATE TO RPT-TRAN-DATE DTSBR793 +00484 DTSBR793 +00485 WRITE FEIN-REPORT3 FROM R793-REPORT3 AFTER ADVANCING 1. DTSBR793 +00486 P2300-EXIT. DTSBR793 +00487 EXIT. DTSBR793 +00488 EJECT DTSBR793 +00489 T1000-TERMINATE. DTSBR793 +00490 SKIP1 DTSBR793 +00491 WRITE FEIN-LETTER FROM X4-CA-END-LINE. DTSBR793 +00492 CLOSE FEIN-FILE FEIN-FILE2 FEIN-FILE3. DTSBR793 +00493 SKIP2 DTSBR793 +00494 T1000-EXIT. DTSBR793 +00495 EXIT. DTSBR793 +00496 EJECT DTSBR793 +00497 S060-FORM. DTSBR793 +00498 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER 1. DTSBR793 +00499 MOVE SPACES TO VSCA-DATA. DTSBR793 +00500 S060-EXIT. DTSBR793 +00501 EXIT. DTSBR793 +00502 S009-CONVERT-TO-CAPS. DTSBR793 +00503 SKIP1 DTSBR793 +00504 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR793 +00505 SKIP2 DTSBR793 +00506 S009-EXIT. DTSBR793 +00507 EXIT. DTSBR793 +00508 SKIP3 DTSBR793 +00509 S005-SYS-DATE. DTSBR793 +00510 SKIP1 DTSBR793 +00511 SET L005-FROM-SYS TO TRUE. DTSBR793 +00512 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBR793 +00513 SKIP2 DTSBR793 +00514 S005-EXIT. DTSBR793 +00515 EXIT. DTSBR793 +00516 S071-DESLASH-NAME. DTSBR793 +00517 SKIP1 DTSBR793 +00518 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR793 +00519 SKIP2 DTSBR793 +00520 S071-EXIT. DTSBR793 +00521 EXIT. DTSBR793 +00522 SKIP3 DTSBR793 +00523 S082-OP-ID-INFO. DTSBR793 +00524 SKIP1 DTSBR793 +00525 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR793 +00526 SKIP2 DTSBR793 +00527 S082-EXIT. DTSBR793 +00528 EXIT. DTSBR793 +00529 SKIP3 DTSBR793 +00530 S999-ABEND. DTSBR793 +00531 SKIP1 DTSBR793 +00532 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR793 +00533 SKIP2 DTSBR793 +00534 S999-EXIT. DTSBR793 +00535 EXIT. DTSBR793 diff --git a/Batch/DTSBS411.cob b/Batch/DTSBS411.cob new file mode 100644 index 0000000..2a25af6 --- /dev/null +++ b/Batch/DTSBS411.cob @@ -0,0 +1,757 @@ +00001 IDENTIFICATION DIVISION. 09/04/24 +00002 PROGRAM-ID. DTSBS411. DTSBS411 +00003 AUTHOR. SC. LV135 +00004 DATE-WRITTEN. MAY 2024. CL*29 +00005 DATE-COMPILED. DTSBS411 +00006 SKIP3 DTSBS411 +00007 ***** DTSBS411 +00008 * DTSBS411 +00009 * FUNCTION: EXTRACT ALL THE ACCOUNTS CREATED YESTERDAY CL*29 +00010 * DTSBS411 +00011 * DTSBS411 +00012 * MODIFICATION LOG: DTSBS411 +00013 * DTSBS411 +00014 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS411 +00015 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS411 +00016 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBS411 +00017 * DTSBS411 +00018 * DTSBS411 +00019 * DESCRIPTION: DTSBS411 +00020 * DTSBS411 +00021 * DTSBS411 +00022 * INITIATION: DTSBS411 +00023 * DTSBS411 +00024 * DTSBS411 +00025 * DTSBS411 +00026 * PROCESSING: DTSBS411 +00027 * DTSBS411 +00028 * DTSBS411 +00029 * TERMINATION: DTSBS411 +00030 * DTSBS411 +00031 * DTSBS411 +00032 * DTSBS411 +00033 * RECORDS READ: DTSBS411 +00034 * DTSBS411 +00035 * MASTER: DTSBS411 +00036 * DTSBS411 +00037 * MSOL DTSBS411 +00038 * MQTR DTSBS411 +00039 * DTSBS411 +00040 * DTSBS411 +00041 * ALTERNATE INDEX: DTSBS411 +00042 * DTSBS411 +00043 * NONE. DTSBS411 +00044 * DTSBS411 +00045 * DTSBS411 +00046 * REFERENCE: DTSBS411 +00047 * DTSBS411 +00048 * DTSBS411 +00049 * DTSBS411 +00050 * RECORDS UPDATED: DTSBS411 +00051 * DTSBS411 +00052 * NONE DTSBS411 +00053 * DTSBS411 +00054 * DTSBS411 +00055 * OUTPUT RECORDS WRITTEN: DTSBS411 +00056 * DTSBS411 +00057 * DTSBS411 +00058 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBS411 +00059 * DTSBS411 +00060 * NONE. DTSBS411 +00061 * DTSBS411 +00062 * DTSBS411 +00063 * MODULES CALLED: DTSBS411 +00064 * DTSBS411 +00065 * DTSBU910 MASTER FILE I/O. DTSBS411 +00066 * DTSBS411 +00067 * DTSBS411 +00068 * DTSBS411 +00069 ***** DTSBS411 +00070 SKIP3 DTSBS411 +00071 ENVIRONMENT DIVISION. DTSBS411 +00072 INPUT-OUTPUT SECTION. DTSBS411 +00073 FILE-CONTROL. DTSBS411 +00074 SELECT CURR-PREV-FILE ASSIGN TO DTSFCPRE CL*90 +00075 FILE STATUS IS CURR-PREV-STATUS. CL*90 +00076 DTSBS411 +00077 SELECT CURR-MINI-FILE ASSIGN TO DTSFCURR CL*90 +00078 FILE STATUS IS CURR-MINI-STATUS. CL*90 +00079 CL*90 +00080 SELECT CURR-MINI-RPT ASSIGN TO DTSFCRPT CL114 +00081 FILE STATUS IS CURR-RPT-STATUS. CL114 +00082 CL114 +00083 SELECT SENT-MINI-FILE ASSIGN TO DTSFSENT CL*80 +00084 FILE STATUS IS SENT-MINI-STATUS. CL*82 +00085 CL114 +00086 SELECT SENT-MINI-RPT ASSIGN TO DTSFSRPT CL114 +00087 FILE STATUS IS SENT-RPT-STATUS. CL114 +00088 CL*80 +00089 DTSBS411 +00090 DATA DIVISION. DTSBS411 +00091 FILE SECTION. DTSBS411 +00092 FD CURR-PREV-FILE CL*90 +00093 RECORDING MODE IS F DTSBS411 +00094 LABEL RECORDS ARE STANDARD DTSBS411 +00095 BLOCK CONTAINS 0 CHARACTERS. DTSBS411 +00096 DTSBS411 +00097 01 CURR-PREV-REC PIC X(80). CL*90 +00098 CL*48 +00099 FD CURR-MINI-FILE CL*90 +00100 RECORDING MODE IS F CL*90 +00101 LABEL RECORDS ARE STANDARD CL*90 +00102 BLOCK CONTAINS 0 CHARACTERS. CL*90 +00103 CL*90 +00104 01 CURR-MINI-REC PIC X(80). CL*90 +00105 CL*90 +00106 FD CURR-MINI-RPT CL114 +00107 RECORDING MODE IS F CL114 +00108 LABEL RECORDS ARE STANDARD CL114 +00109 BLOCK CONTAINS 0 CHARACTERS. CL114 +00110 CL114 +00111 01 CURR-RPT-REC PIC X(80). CL114 +00112 CL114 +00113 FD SENT-MINI-FILE CL*70 +00114 RECORDING MODE IS F CL*70 +00115 LABEL RECORDS ARE STANDARD CL*70 +00116 BLOCK CONTAINS 0 CHARACTERS. CL*70 +00117 CL*70 +00118 01 SENT-MINI-REC PIC X(80). CL*70 +00119 CL*70 +00120 FD SENT-MINI-RPT CL114 +00121 RECORDING MODE IS F CL114 +00122 LABEL RECORDS ARE STANDARD CL114 +00123 BLOCK CONTAINS 0 CHARACTERS. CL114 +00124 CL114 +00125 01 SENT-RPT-REC PIC X(80). CL114 +00126 CL114 +00127 DTSBS411 +00128 WORKING-STORAGE SECTION. DTSBS411 +001285 77 PAN-VALET PICTURE X(24) VALUE '135DTSBS411 09/04/24'. DTSBS411 +00129 SKIP3 DTSBS411 +00130 01 W-AREA. DTSBS411 +00131 05 W-ABEND-CD PIC S9(04) COMP VALUE +340.DTSBS411 +00132 DTSBS411 +00133 05 W-TRACE-IND PIC X(01) VALUE SPACE. DTSBS411 +00134 05 W-MOD-NAME PIC X(08) VALUE 'DTSBSMIN'. CL*51 +00135 DTSBS411 +00136 05 ABEND-MSG PIC X(60). DTSBS411 +00137 DTSBS411 +00138 05 WS-HOLD-EMP-NO PIC 9(06) VALUE 0. CL*62 +00139 CL*45 +00140 05 WS-HOLD-LIAB-DATE PIC 9(08) VALUE 0. CL109 +00141 CL109 +00142 05 CURR-MINI-STATUS PIC X(02). CL*70 +00143 88 CURR-MINI-STATUS-OK-88 VALUE '00'. CL*70 +00144 DTSBS411 +00145 05 CURR-RPT-STATUS PIC X(02). CL114 +00146 88 CURR-RPT-STATUS-OK-88 VALUE '00'. CL114 +00147 CL114 +00148 05 CURR-PREV-STATUS PIC X(02). CL*90 +00149 88 CURR-PREV-STATUS-OK-88 VALUE '00'. CL*92 +00150 88 CURR-PREV-STATUS-EOF-88 VALUE '10'. CL*92 +00151 CL*90 +00152 05 SENT-MINI-STATUS PIC X(02). CL*70 +00153 88 SENT-MINI-STATUS-OK-88 VALUE '00'. CL*70 +00154 CL*70 +00155 05 SENT-RPT-STATUS PIC X(02). CL114 +00156 88 SENT-RPT-STATUS-OK-88 VALUE '00'. CL114 +00157 CL114 +00158 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBS411 +00159 88 W-ERROR-YES-88 VALUE 'Y'. DTSBS411 +00160 88 W-ERROR-NO-88 VALUE 'N'. DTSBS411 +00161 DTSBS411 +00162 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS411 +00163 05 W-CURR-PREV-CNT PIC S9(07) COMP-3 VALUE +0. CL*97 +00164 05 W-CURR-MINI-CNT PIC S9(07) COMP-3 VALUE +0. CL*97 +00165 05 W-SENT-MINI-CNT PIC S9(07) COMP-3 VALUE +0. CL*78 +00166 DTSBS411 +00167 01 WS-MINI-REC. CL*72 +00168 05 WS-MINI-EMP-NO PIC 9(06) VALUE 0. CL117 +00169 05 WS-MINI-EMP-STATUS PIC X(01) VALUE SPACES. CL117 +00170 05 WS-MINI-CURR-DATE PIC 9(08) VALUE 0. CL117 +00171 05 WS-MINI-LIAB-DATE PIC 9(08) VALUE 0. CL117 +00172 05 WS-MINI-ESTB-DATE PIC 9(08) VALUE 0. CL117 +00173 05 WS-MINI-CHNG-DATE PIC 9(08) VALUE 0. CL117 +00174 05 FILLER PIC X(41) VALUE SPACES. CL117 +00175 CL*40 +00176 01 WRK-CURR-PREV-REC. CL*93 +00177 05 WS-CURR-PREV-EMP-NO PIC 9(06) VALUE 0. CL117 +00178 05 WS-CURR-PREV-EMP-STATUS PIC X(01) VALUE SPACES. CL117 +00179 05 WS-CURR-PREV-CURR-DATE PIC 9(08) VALUE 0. CL117 +00180 05 WS-CURR-PREV-LIAB-DATE PIC 9(08) VALUE 0. CL117 +00181 05 WS-CURR-PREV-ESTB-DATE PIC 9(08) VALUE 0. CL117 +00182 05 WS-CURR-PREV-CHNG-DATE PIC 9(08) VALUE 0. CL117 +00183 05 FILLER PIC X(41) VALUE SPACES. CL117 +00184 CL*93 +00185 01 CURRENT-RPT-HEADER. CL117 +00186 05 FILLER PIC X(06) CL117 +00187 VALUE '***** '. CL117 +00188 05 FILLER PIC X(52) VALUE CL131 +00189 'ACCOUNTS PENDING FOR MINI CONV REGISTRATION IN DUTAS'. CL131 +00190 05 FILLER PIC X(06) CL124 +00191 VALUE ' *****'. CL117 +00192 05 FILLER PIC X(16) VALUE SPACES. CL131 +00193 CL117 +00194 01 SENT-RPT-HEADER. CL117 +00195 05 FILLER PIC X(06) CL117 +00196 VALUE '***** '. CL117 +00197 05 FILLER PIC X(48) VALUE CL133 +00198 'ACCOUNTS SENT TO ESSP FOR MINI CONV REGISTRATION'. CL131 +00199 05 FILLER PIC X(06) CL124 +00200 VALUE ' *****'. CL117 +00201 05 FILLER PIC X(20) VALUE SPACES. CL133 +00202 CL117 +00203 01 WS-BLANK-LINE PIC X(133) VALUE SPACES. CL117 +00204 CL117 +00205 01 WS-RPT-HDR1. CL117 +00206 05 WS-HDR-EMP-NO PIC X(07) VALUE 'EMP-NO|'. CL124 +00207 05 WS-HDR-EMP-STATUS PIC X(11) VALUE 'EMP-STATUS|'. CL124 +00208 05 WS-HDR-CURR-DATE PIC X(09) VALUE 'CURR-DT |'. CL124 +00209 05 WS-HDR-LIAB-DATE PIC X(09) VALUE 'LIAB-DT |'. CL124 +00210 05 WS-HDR-ESTB-DATE PIC X(09) VALUE 'ESTB-DT |'. CL124 +00211 05 WS-HDR-CHNG-DATE PIC X(07) VALUE 'CHNG-DT'. CL124 +00212 05 FILLER PIC X(28) VALUE SPACES. CL117 +00213 CL117 +00214 01 WS-RPT-DETAIL-REC. CL117 +00215 05 WS-RPT-EMP-NO PIC 9(06) VALUE 0. CL117 +00216 05 FILLER PIC X(01) VALUE '|'. CL117 +00217 05 WS-RPT-EMP-STATUS PIC X(01) VALUE SPACES. CL117 +00218 05 FILLER PIC X(10) VALUE ' |'. CL124 +00219 05 WS-RPT-CURR-DATE PIC 9(08) VALUE 0. CL117 +00220 05 FILLER PIC X(01) VALUE '|'. CL117 +00221 05 WS-RPT-LIAB-DATE PIC ZZZZZZZZ. CL135 +00222 05 FILLER PIC X(01) VALUE '|'. CL117 +00223 05 WS-RPT-ESTB-DATE PIC 9(08) VALUE 0. CL117 +00224 05 FILLER PIC X(01) VALUE '|'. CL117 +00225 05 WS-RPT-CHNG-DATE PIC 9(08) VALUE 0. CL117 +00226 05 FILLER PIC X(27) VALUE SPACES. CL117 +00227 CL117 +00228 CL117 +00229 EJECT DTSBS411 +00230 01 L910-LINK-AREA. DTSBS411 +00231 ++INCLUDE DTSIL910 DTSBS411 +00232 SKIP3 DTSBS411 +00233 01 MSKL-REC. DTSBS411 +00234 ++INCLUDE DTSIMSKL DTSBS411 +00235 SKIP3 DTSBS411 +00236 01 MHDR-REC. DTSBS411 +00237 ++INCLUDE DTSIMHDR DTSBS411 +00238 SKIP3 DTSBS411 +00239 01 MPRF-REC. DTSBS411 +00240 ++INCLUDE DTSIMPRF DTSBS411 +00241 SKIP3 CL*97 +00242 01 MSOL-REC. CL*98 +00243 ++INCLUDE DTSIMSOL CL*98 +00244 SKIP3 CL*98 +00245 01 L931-LINK-AREA. DTSBS411 +00246 ++INCLUDE DTSIL931 DTSBS411 +00247 DTSBS411 +00248 PROCEDURE DIVISION. CL*32 +00249 DTSBS411 +00250 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBS411 +00251 IF W-ERROR-NO-88 DTSBS411 +00252 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBS411 +00253 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBS411 +00254 END-IF. DTSBS411 +00255 DTSBS411 +00256 GOBACK. DTSBS411 +00257 DTSBS411 +00258 I0000-INITIALIZE. DTSBS411 +00259 SKIP2 DTSBS411 +00260 MOVE W-TRACE-IND TO L910-TRACE-IND. CL*70 +00261 MOVE W-MOD-NAME TO L910-MOD-NAME. CL*70 +00262 DTSBS411 +00263 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBS411 +00264 IF W-ERROR-YES-88 DTSBS411 +00265 GO TO I0000-EXIT DTSBS411 +00266 END-IF. DTSBS411 +00267 DTSBS411 +00268 PERFORM I3000-GET-MHDR THRU I3000-EXIT. CL*70 +00269 DTSBS411 +00270 PERFORM I3500-WRITE-HDR THRU I3500-EXIT. CL119 +00271 CL119 +00272 PERFORM I4000-PROCESS-CURR-PREV THRU I4000-EXIT. CL*92 +00273 CL*90 +00274 I0000-EXIT. DTSBS411 +00275 EXIT. DTSBS411 +00276 EJECT DTSBS411 +00277 DTSBS411 +00278 I2000-OPEN-FILES. DTSBS411 +00279 CL*70 +00280 OPEN INPUT CURR-PREV-FILE. CL*90 +00281 IF NOT CURR-PREV-STATUS-OK-88 CL*91 +00282 DISPLAY 'OPEN ERROR ON CURR PREV FILE ' CURR-PREV-STATUS CL*90 +00283 SET W-ERROR-YES-88 TO TRUE DTSBS411 +00284 GO TO I2000-EXIT DTSBS411 +00285 END-IF. DTSBS411 +00286 DTSBS411 +00287 OPEN OUTPUT CURR-MINI-FILE. CL*90 +00288 IF NOT CURR-MINI-STATUS-OK-88 CL*90 +00289 DISPLAY 'OPEN ERROR ON CURR MINI FILE ' CURR-MINI-STATUS CL*90 +00290 SET W-ERROR-YES-88 TO TRUE CL*90 +00291 GO TO I2000-EXIT CL*90 +00292 END-IF. CL*90 +00293 CL*90 +00294 OPEN OUTPUT CURR-MINI-RPT. CL124 +00295 IF NOT CURR-RPT-STATUS-OK-88 CL114 +00296 DISPLAY 'OPEN ERROR ON CURR RPT FILE ' CURR-RPT-STATUS CL114 +00297 SET W-ERROR-YES-88 TO TRUE CL114 +00298 GO TO I2000-EXIT CL114 +00299 END-IF. CL114 +00300 CL114 +00301 OPEN OUTPUT SENT-MINI-FILE. CL*70 +00302 IF NOT SENT-MINI-STATUS-OK-88 CL*70 +00303 DISPLAY 'OPEN ERROR ON SENT MINI FILE ' SENT-MINI-STATUS CL*84 +00304 SET W-ERROR-YES-88 TO TRUE CL*70 +00305 GO TO I2000-EXIT CL*70 +00306 END-IF. CL*70 +00307 CL*70 +00308 OPEN OUTPUT SENT-MINI-RPT. CL125 +00309 IF NOT SENT-RPT-STATUS-OK-88 CL114 +00310 DISPLAY 'OPEN ERROR ON SENT RPT FILE ' SENT-RPT-STATUS CL114 +00311 SET W-ERROR-YES-88 TO TRUE CL114 +00312 GO TO I2000-EXIT CL114 +00313 END-IF. CL114 +00314 CL114 +00315 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBS411 +00316 DTSBS411 +00317 I2000-EXIT. DTSBS411 +00318 EXIT. DTSBS411 +00319 DTSBS411 +00320 I3000-GET-MHDR. DTSBS411 +00321 MOVE LOW-VALUES TO MSKL-REC. DTSBS411 +00322 MOVE +0 TO MSKL-EMP-NO. CL*57 +00323 SET MSKL-HDR-88 TO TRUE. DTSBS411 +00324 DTSBS411 +00325 PERFORM S910-READ THRU S910-EXIT. DTSBS411 +00326 IF L910-NO-REC-88 DTSBS411 +00327 DISPLAY 'DTSBSMIN: MHDR RECORD IS MISSING' CL*50 +00328 SET W-ERROR-YES-88 TO TRUE DTSBS411 +00329 GO TO I3000-EXIT DTSBS411 +00330 ELSE DTSBS411 +00331 MOVE MSKL-REC TO MHDR-REC CL*47 +00332 CL*54 +00333 DISPLAY 'MHDR-CURR-RUN-DATE' MHDR-CURR-RUN-DATE CL*54 +00334 DISPLAY 'MHDR-PRIOR-RUN-DATE' MHDR-PRIOR-RUN-DATE CL*54 +00335 END-IF. DTSBS411 +00336 DTSBS411 +00337 I3000-EXIT. DTSBS411 +00338 EXIT. DTSBS411 +00339 CL119 +00340 I3500-WRITE-HDR. CL119 +00341 CL119 +00342 WRITE CURR-RPT-REC FROM CURRENT-RPT-HEADER CL119 +00343 WRITE CURR-RPT-REC FROM WS-BLANK-LINE CL119 +00344 WRITE CURR-RPT-REC FROM WS-RPT-HDR1 CL119 +00345 CL119 +00346 WRITE SENT-RPT-REC FROM SENT-RPT-HEADER CL119 +00347 WRITE SENT-RPT-REC FROM WS-BLANK-LINE CL119 +00348 WRITE SENT-RPT-REC FROM WS-RPT-HDR1. CL124 +00349 CL119 +00350 CL119 +00351 I3500-EXIT. CL119 +00352 EXIT. CL119 +00353 DTSBS411 +00354 I4000-PROCESS-CURR-PREV. CL*92 +00355 PERFORM S1010-READ-CURR-PREV THRU S1010-EXIT. CL*92 +00356 CL*91 +00357 IF CURR-PREV-STATUS-EOF-88 CL*92 +00358 DISPLAY 'CURR PREV FILE IS EMPTY' CL102 +00359 GO TO I4000-EXIT CL*92 +00360 END-IF. CL*91 +00361 CL*91 +00362 PERFORM UNTIL CURR-PREV-STATUS-EOF-88 CL*99 +00363 PERFORM I4100-CHK-EMPSTAT THRU I4100-EXIT CL*96 +00364 PERFORM S1010-READ-CURR-PREV THRU S1010-EXIT CL*97 +00365 END-PERFORM. CL*91 +00366 CL*91 +00367 I4000-EXIT. CL*91 +00368 EXIT. CL*91 +00369 CL*91 +00370 I4100-CHK-EMPSTAT. CL*96 +00371 CL127 +00372 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*92 +00373 MOVE WS-CURR-PREV-EMP-NO TO MSKL-EMP-NO. CL*94 +00374 CL*92 +00375 SET MSKL-PRF-88 TO TRUE. CL*92 +00376 CL*92 +00377 PERFORM S910-READ THRU S910-EXIT. CL*92 +00378 IF L910-OK-88 CL*92 +00379 MOVE MSKL-REC TO MPRF-REC CL105 +00380 MOVE MPRF-EMP-NO TO WS-RPT-EMP-NO CL126 +00381 MOVE MPRF-EMP-STATUS TO WS-CURR-PREV-EMP-STATUS CL126 +00382 WS-RPT-EMP-STATUS CL126 +00383 MOVE MHDR-CURR-RUN-DATE TO WS-CURR-PREV-CURR-DATE CL105 +00384 WS-RPT-CURR-DATE CL118 +00385 MOVE MPRF-ESTB-DATE TO WS-CURR-PREV-ESTB-DATE CL105 +00386 WS-RPT-ESTB-DATE CL118 +00387 MOVE MPRF-CHNG-DATE TO WS-CURR-PREV-CHNG-DATE CL105 +00388 WS-RPT-CHNG-DATE CL118 +00389 ELSE CL*92 +00390 DISPLAY 'EMP NO NOT IN USE ' MSKL-EMP-NO CL*92 +00391 PERFORM S999-ABEND THRU S999-EXIT CL100 +00392 END-IF. CL*92 +00393 CL100 +00394 IF MPRF-EMP-STATUS = 'A' CL*92 +00395 CL110 +00396 PERFORM P1200-READ-MSOL THRU P1200-EXIT CL110 +00397 CL110 +00398 MOVE WS-HOLD-LIAB-DATE TO WS-CURR-PREV-LIAB-DATE CL110 +00399 WS-RPT-LIAB-DATE CL118 +00400 CL110 +00401 WRITE SENT-MINI-REC FROM WRK-CURR-PREV-REC CL*94 +00402 ADD +1 TO W-SENT-MINI-CNT CL*92 +00403 CL118 +00404 WRITE SENT-RPT-REC FROM WS-RPT-DETAIL-REC CL118 +00405 ELSE CL*92 +00406 WRITE CURR-MINI-REC FROM WRK-CURR-PREV-REC CL*94 +00407 ADD +1 TO W-CURR-MINI-CNT CL*92 +00408 CL118 +00409 MOVE ZEROES TO WS-RPT-LIAB-DATE CL128 +00410 WRITE CURR-RPT-REC FROM WS-RPT-DETAIL-REC CL118 +00411 END-IF. CL*92 +00412 CL*92 +00413 I4100-EXIT. CL*96 +00414 EXIT. CL*92 +00415 CL*92 +00416 P0000-PROCESS. DTSBS411 +00417 DTSBS411 +00418 PERFORM P1000-CONVERT THRU P1000-EXIT. CL*43 +00419 DTSBS411 +00420 P0000-EXIT. DTSBS411 +00421 EXIT. DTSBS411 +00422 DTSBS411 +00423 P1000-CONVERT. DTSBS411 +00424 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBS411 +00425 MOVE +010021 TO MSKL-EMP-NO. CL*56 +00426 SET MSKL-PRF-88 TO TRUE. DTSBS411 +00427 DTSBS411 +00428 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBS411 +00429 IF NOT L910-OK-88 DTSBS411 +00430 DISPLAY 'CANNOT READ MASTER FILE ' DTSBS411 +00431 GO TO P1000-EXIT DTSBS411 +00432 END-IF. DTSBS411 +00433 DTSBS411 +00434 PERFORM DTSBS411 +00435 UNTIL L910-NO-REC-88 OR W-ERROR-YES-88 CL*71 +00436 CL*71 +00437 ADD +1 TO W-MPRF-CNT DTSBS411 +00438 MOVE MSKL-REC TO MPRF-REC DTSBS411 +00439 MOVE MPRF-EMP-NO TO WS-HOLD-EMP-NO CL*71 +00440 CL*71 +00441 PERFORM P1100-SELECT THRU P1100-EXIT DTSBS411 +00442 CL*29 +00443 MOVE MPRF-REC TO MSKL-REC DTSBS411 +00444 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBS411 +00445 END-PERFORM. DTSBS411 +00446 DTSBS411 +00447 P1000-EXIT. DTSBS411 +00448 EXIT. DTSBS411 +00449 DTSBS411 +00450 P1100-SELECT. DTSBS411 +00451 DTSBS411 +00452 IF MPRF-ESTB-DATE = MHDR-PRIOR-RUN-DATE AND CL*71 +00453 WS-HOLD-EMP-NO(1:3) = '186' CL*71 +00454 CL*44 +00455 MOVE MPRF-EMP-NO TO WS-MINI-EMP-NO CL*73 +00456 WS-RPT-EMP-NO CL121 +00457 MOVE MPRF-EMP-STATUS TO WS-MINI-EMP-STATUS CL*45 +00458 WS-RPT-EMP-STATUS CL121 +00459 MOVE MHDR-CURR-RUN-DATE TO WS-MINI-CURR-DATE CL*68 +00460 WS-RPT-CURR-DATE CL121 +00461 MOVE MPRF-ESTB-DATE TO WS-MINI-ESTB-DATE CL*68 +00462 WS-RPT-ESTB-DATE CL121 +00463 MOVE MPRF-CHNG-DATE TO WS-MINI-CHNG-DATE CL*68 +00464 WS-RPT-CHNG-DATE CL121 +00465 CL*58 +00466 DISPLAY 'MPRF-ESTB-DATE' MPRF-ESTB-DATE CL*58 +00467 DISPLAY 'WS-HOLD-EMP-NO' WS-HOLD-EMP-NO CL*61 +00468 DISPLAY 'MPRF-EMP-NO ' MPRF-EMP-NO CL*62 +00469 DISPLAY 'WS-HOLD-EMP-NO(1:3) ' WS-HOLD-EMP-NO(1:3) CL*63 +00470 CL*64 +00471 ELSE CL*64 +00472 CL*64 +00473 GO TO P1100-EXIT CL*64 +00474 CL*64 +00475 END-IF. CL*44 +00476 CL*61 +00477 IF MPRF-EMP-STATUS = 'A' CL*71 +00478 PERFORM P1200-READ-MSOL THRU P1200-EXIT CL*82 +00479 CL108 +00480 MOVE WS-HOLD-LIAB-DATE TO WS-MINI-LIAB-DATE CL109 +00481 WS-RPT-LIAB-DATE CL121 +00482 CL109 +00483 WRITE SENT-MINI-REC FROM WS-MINI-REC CL108 +00484 ADD +1 TO W-SENT-MINI-CNT CL112 +00485 CL121 +00486 WRITE SENT-RPT-REC FROM WS-RPT-DETAIL-REC CL121 +00487 ELSE CL*71 +00488 WRITE CURR-MINI-REC FROM WS-MINI-REC CL*71 +00489 ADD +1 TO W-CURR-MINI-CNT CL*78 +00490 CL121 +00491 MOVE ZEROES TO WS-RPT-LIAB-DATE CL128 +00492 WRITE CURR-RPT-REC FROM WS-RPT-DETAIL-REC CL128 +00493 END-IF. DTSBS411 +00494 DTSBS411 +00495 P1100-EXIT. DTSBS411 +00496 EXIT. DTSBS411 +00497 DTSBS411 +00498 P1200-READ-MSOL. CL*76 +00499 CL*76 +00500 MOVE LOW-VALUES TO MSOL-REC. CL*76 +00501 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*76 +00502 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. CL*76 +00503 SET MSOL-SOL-88 TO TRUE. CL*76 +00504 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. CL*76 +00505 CL*76 +00506 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL*76 +00507 CL*76 +00508 IF L910-OK-88 CL*76 +00509 PERFORM S910B-READ THRU S910B-EXIT CL*76 +00510 ELSE CL*76 +00511 PERFORM S999-ABEND THRU S999-EXIT. CL*76 +00512 CL*76 +00513 IF L910-OK-88 CL*76 +00514 PERFORM P1210-GET-LIAB-DATE THRU P1210-EXIT CL*86 +00515 UNTIL L910-NO-REC-88 CL*86 +00516 ELSE CL*76 +00517 PERFORM S999-ABEND THRU S999-EXIT. CL*76 +00518 CL*76 +00519 P1200-EXIT. CL*76 +00520 EXIT. CL*76 +00521 CL*76 +00522 P1210-GET-LIAB-DATE. CL*86 +00523 CL*86 +00524 MOVE MSKL-REC TO MSOL-REC CL*86 +00525 MOVE MSOL-LIAB-DATE TO WS-HOLD-LIAB-DATE CL109 +00526 CL*86 +00527 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*86 +00528 CL*86 +00529 P1210-EXIT. CL*86 +00530 EXIT. CL*86 +00531 CL*86 +00532 S1010-READ-CURR-PREV. CL*92 +00533 READ CURR-PREV-FILE INTO WRK-CURR-PREV-REC CL*93 +00534 IF CURR-PREV-STATUS-OK-88 CL*92 +00535 ADD +1 TO W-CURR-PREV-CNT CL*97 +00536 ELSE CL*92 +00537 IF CURR-PREV-STATUS-EOF-88 CL*92 +00538 DISPLAY 'CURRENT PREV - EOF' CL*92 +00539 ELSE CL*92 +00540 DISPLAY 'CANNOT READ CURR PREV FILE' CURR-PREV-STATUS CL*92 +00541 PERFORM S999-ABEND THRU S999-EXIT CL*92 +00542 END-IF CL*92 +00543 END-IF. CL*92 +00544 CL*92 +00545 S1010-EXIT. CL*92 +00546 EXIT. CL*92 +00547 CL*92 +00548 T0000-TERMINATE. DTSBS411 +00549 DTSBS411 +00550 CLOSE CURR-PREV-FILE CL*99 +00551 CURR-MINI-FILE CL*99 +00552 CURR-MINI-RPT CL124 +00553 SENT-MINI-FILE CL124 +00554 SENT-MINI-RPT. CL124 +00555 CL*79 +00556 PERFORM S910-CLOSE THRU S910-EXIT. DTSBS411 +00557 DTSBS411 +00558 DISPLAY '*********************************************'. DTSBS411 +00559 DISPLAY '** DTSBSMIN TERMINATION STATISTICS **'. CL105 +00560 DISPLAY '** **'. CL105 +00561 DISPLAY '** PROFILE RECORDS READ:' W-MPRF-CNT '**'. CL105 +00562 DISPLAY '** ACCOUNTS IN CURRENT: ' W-CURR-MINI-CNT'**'. CL105 +00563 DISPLAY '** ACCOUNTS IN SENT: ' W-SENT-MINI-CNT'**'. CL105 +00564 DISPLAY '*********************************************'. DTSBS411 +00565 DTSBS411 +00566 T0000-EXIT. DTSBS411 +00567 EXIT. DTSBS411 +00568 DTSBS411 +00569 *S001-FROM-FED-8. CL*87 +00570 * SET L001-FROM-FED-8 TO TRUE. CL*87 +00571 * GO TO S001-DATE. CL*87 +00572 * CL*87 +00573 *S001-FROM-ABS-DAY. CL*87 +00574 * SET L001-FROM-ABS-DAY TO TRUE. CL*87 +00575 * GO TO S001-DATE. CL*87 +00576 * CL*87 +00577 *S001-FROM-CAL-6. CL*87 +00578 * SET L001-FROM-CAL-6 TO TRUE. CL*87 +00579 * GO TO S001-DATE. CL*87 +00580 * CL*87 +00581 *S001-DATE. CL*87 +00582 * CALL 'DTSBU001' USING L001-LINK-AREA. CL*87 +00583 *S001-EXIT. CL*87 +00584 * EXIT. CL*87 +00585 * SKIP3 CL*87 +00586 *S004-FROM-5. CL*87 +00587 * SET L004-FROM-5 TO TRUE. CL*87 +00588 * GO TO S004-QTR. CL*87 +00589 * CL*87 +00590 *S004-FROM-ABS. CL*87 +00591 * SET L004-FROM-ABS TO TRUE. CL*87 +00592 * GO TO S004-QTR. CL*87 +00593 * CL*87 +00594 *S004-FROM-3. CL*87 +00595 * SET L004-FROM-3 TO TRUE. CL*87 +00596 * GO TO S004-QTR. CL*87 +00597 * CL*87 +00598 *S004-FROM-DATE. CL*87 +00599 * SET L004-FROM-DATE TO TRUE. CL*87 +00600 * GO TO S004-QTR. CL*87 +00601 * CL*87 +00602 *S004-QTR. CL*87 +00603 * CL*87 +00604 * CALL 'DTSBU004' USING L004-LINK-AREA. CL*87 +00605 * CL*87 +00606 *S004-EXIT. CL*87 +00607 * EXIT. CL*87 +00608 SKIP3 DTSBS411 +00609 *S005-FROM-SYS. CL*87 +00610 * CALL 'DTSBU005' USING L005-LINK-AREA. CL*87 +00611 *S005-EXIT. CL*87 +00612 * EXIT. CL*87 +00613 DTSBS411 +00614 *S341-STATUS. CL*87 +00615 * CALL 'DTSBX341' USING LX34-LINK-AREA CL*87 +00616 * MPRF-REC. CL*87 +00617 DTSBS411 +00618 *S341-EXIT. CL*87 +00619 * EXIT. CL*87 +00620 * CL*87 +00621 *S342-ACCT-DAILY. CL*87 +00622 * CALL 'DTSBX342' USING LX34-LINK-AREA CL*87 +00623 * MPRF-REC. CL*87 +00624 * CL*87 +00625 *S342-EXIT. CL*87 +00626 * EXIT. CL*87 +00627 * CL*87 +00628 *S355-ACCT-CONVERT. CL*87 +00629 * CALL 'DTSBX522' USING LX34-LINK-AREA CL*87 +00630 * MPRF-REC. CL*87 +00631 * CL*87 +00632 *S355-EXIT. CL*87 +00633 * EXIT. CL*87 +00634 * CL*87 +00635 *S344-DELINQ-COLL. CL*87 +00636 * CALL 'DTSBX344' USING LX34-LINK-AREA CL*87 +00637 * MPRF-REC. CL*87 +00638 * CL*87 +00639 *S344-EXIT. CL*87 +00640 * EXIT. CL*87 +00641 * CL*87 +00642 *S346-CHARGES. DTSBS411 +00643 * CALL 'DTSBX346' USING LX34-LINK-AREA DTSBS411 +00644 * MPRF-REC. DTSBS411 +00645 * DTSBS411 +00646 *S346-EXIT. DTSBS411 +00647 * EXIT. DTSBS411 +00648 * CL*87 +00649 * CL*87 +00650 *S348-HOLIDAYS. CL*87 +00651 * ADD +1 TO L001-JUL-ABS-DAY. CL*87 +00652 * CL*87 +00653 * PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. CL*87 +00654 * CL*87 +00655 * MOVE L001-FED-8-DATE-9 TO L003-DATE. CL*87 +00656 * CL*87 +00657 * MOVE '2' TO L003-OPTION. CL*87 +00658 * CALL 'DTSBU003' USING L003-LINK-AREA. CL*87 +00659 * CL*87 +00660 *S348-EXIT. CL*87 +00661 * EXIT. CL*87 +00662 CL*87 +00663 S910-OPEN-READ. DTSBS411 +00664 SET L910-OPEN-READ-88 TO TRUE. DTSBS411 +00665 GO TO S910-MSTR-IO. DTSBS411 +00666 DTSBS411 +00667 S910-READ. DTSBS411 +00668 SET L910-READ-88 TO TRUE. DTSBS411 +00669 GO TO S910-MSTR-IO. DTSBS411 +00670 DTSBS411 +00671 S910-START-BROWSE. DTSBS411 +00672 SET L910-START-BROWSE-88 TO TRUE. DTSBS411 +00673 GO TO S910-MSTR-IO. DTSBS411 +00674 DTSBS411 +00675 S910-READ-NEXT. DTSBS411 +00676 SET L910-READ-NEXT-88 TO TRUE. DTSBS411 +00677 GO TO S910-MSTR-IO. DTSBS411 +00678 DTSBS411 +00679 S910-COUNT. DTSBS411 +00680 SET L910-COUNT-88 TO TRUE. DTSBS411 +00681 GO TO S910-MSTR-IO. DTSBS411 +00682 DTSBS411 +00683 S910-REWRITE. DTSBS411 +00684 SET L910-REWRITE-88 TO TRUE. DTSBS411 +00685 GO TO S910-MSTR-IO. DTSBS411 +00686 DTSBS411 +00687 S910-CLOSE. DTSBS411 +00688 SET L910-CLOSE-88 TO TRUE. DTSBS411 +00689 GO TO S910-MSTR-IO. DTSBS411 +00690 DTSBS411 +00691 S910B-READ. CL*79 +00692 SET L910-READ-88 TO TRUE. CL*79 +00693 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. CL*79 +00694 CL*79 +00695 S910B-EXIT. CL*79 +00696 EXIT. CL*79 +00697 CL*79 +00698 S910C-START-BROWSE. CL*79 +00699 SET L910-START-BROWSE-88 TO TRUE. CL*79 +00700 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. CL*79 +00701 CL*79 +00702 S910C-EXIT. CL*79 +00703 EXIT. CL*79 +00704 CL*79 +00705 S910Z-MSTR-IO. CL*79 +00706 CALL 'DTSBU910' USING L910-LINK-AREA CL*79 +00707 MSKL-REC. CL*79 +00708 S910Z-EXIT. CL*79 +00709 EXIT. CL*79 +00710 CL*79 +00711 S910-MSTR-IO. DTSBS411 +00712 CALL 'DTSBU910' USING L910-LINK-AREA DTSBS411 +00713 MSKL-REC. DTSBS411 +00714 S910-EXIT. DTSBS411 +00715 EXIT. DTSBS411 +00716 SKIP3 DTSBS411 +00717 DTSBS411 +00718 *S931-OPEN-READ. CL*87 +00719 * SET L931-OPEN-READ-88 TO TRUE. CL*87 +00720 * GO TO S931-REF-IO. CL*87 +00721 * CL*87 +00722 *S931-READ. CL*87 +00723 * SET L931-READ-88 TO TRUE. CL*87 +00724 * GO TO S931-REF-IO. CL*87 +00725 * CL*87 +00726 *S931-CLOSE. CL*87 +00727 * SET L931-CLOSE-88 TO TRUE. CL*87 +00728 * GO TO S931-REF-IO. CL*87 +00729 * CL*87 +00730 *S931-REF-IO. CL*87 +00731 * CALL 'DTSBU931' USING L931-LINK-AREA CL*87 +00732 * FSKL-REC. CL*87 +00733 *S931-EXIT. CL*87 +00734 * EXIT. CL*87 +00735 * CL*87 +00736 *S921-OPEN-READ. CL*87 +00737 * SET L921-OPEN-READ-88 TO TRUE. CL*87 +00738 * GO TO S921-AIX-IO. CL*87 +00739 * CL*87 +00740 *S921-CLOSE. CL*87 +00741 * SET L921-CLOSE-88 TO TRUE. CL*87 +00742 * GO TO S921-AIX-IO. CL*87 +00743 * CL*87 +00744 *S921-AIX-IO. CL*87 +00745 * CALL 'DTSBU921' USING L921-LINK-AREA CL*87 +00746 * ISKL-REC. CL*87 +00747 *S921-EXIT. CL*87 +00748 * EXIT. CL*87 +00749 DTSBS411 +00750 S999-ABEND. DTSBS411 +00751 DISPLAY '*** DTSBX340 ABENDING. ' DTSBS411 +00752 ABEND-MSG. DTSBS411 +00753 DTSBS411 +00754 CALL 'DTSBU999' USING W-ABEND-CD. DTSBS411 +00755 S999-EXIT. DTSBS411 +00756 EXIT. DTSBS411 diff --git a/Batch/DTSBS412.cob b/Batch/DTSBS412.cob new file mode 100644 index 0000000..18e8eb5 --- /dev/null +++ b/Batch/DTSBS412.cob @@ -0,0 +1,2884 @@ +00001 IDENTIFICATION DIVISION. 07/04/24 +00002 PROGRAM-ID. DTSBS412. DTSBS412 +00003 AUTHOR. SC. LV147 +00004 DATE-WRITTEN. JUNE 2024. CL116 +00005 DATE-COMPILED. DTSBS412 +00006 SKIP3 DTSBS412 +00007 ***** DTSBS412 +00008 * DTSBS412 +00009 * DTSBS412 +00010 * FUNCTION: PROCESS NEW ACCOUNTS READY FOR MINI CONVERSION AND CL139 +00011 * PRODUCE THE OUTPUT FILES NEEDED FOR THE EMPLOYER CL139 +00012 * REPORTING APPLICATION. CL139 +00013 * DTSBS412 +00014 * DTSBS412 +00015 * MODIFICATION LOG: DTSBS412 +00016 * DTSBS412 +00017 * 06/01/2024 INITIAL DEVELOPMENT. CL140 +00018 * DTSBS412 +00019 * 08/26/2009 MODIFIED P3820: MOST RECENT AMOUNT PAID NOW DTSBS412 +00020 * EQUALS THE SUM OF ALL PAYMENTS MADE DURING THE DTSBS412 +00021 * DAY. DTSBS412 +00022 * REFERENCE: PROGRAMMER: GD DTSBS412 +00023 * DTSBS412 +00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS412 +00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBS412 +00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBS412 +00027 * DTSBS412 +00028 * DESCRIPTION: DTSBS412 +00029 * DTSBS412 +00030 * DTSBS412 +00031 * RECORDS READ: DTSBS412 +00032 * DTSBS412 +00033 * MASTER: DTSBS412 +00034 * DTSBS412 +00035 * MPRF DTSBS412 +00036 * MQTR DTSBS412 +00037 * DTSBS412 +00038 * ALTERNATE INDEX: DTSBS412 +00039 * DTSBS412 +00040 * NONE. DTSBS412 +00041 * DTSBS412 +00042 * REFERENCE: DTSBS412 +00043 * DTSBS412 +00044 * DTSBS412 +00045 * RECORDS UPDATED: DTSBS412 +00046 * DTSBS412 +00047 * NONE DTSBS412 +00048 * DTSBS412 +00049 * OUTPUT RECORDS WRITTEN: DTSBS412 +00050 * DTSBS412 +00051 * DTSBS412 +00052 * DTSBS412 +00053 * REPORT RECORDS WRITTEN: DTSBS412 +00054 * DTSBS412 +00055 * NONE. DTSBS412 +00056 * DTSBS412 +00057 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBS412 +00058 * DTSBS412 +00059 * NONE. DTSBS412 +00060 * DTSBS412 +00061 * DTSBS412 +00062 * MODULES CALLED: DTSBS412 +00063 * DTSBS412 +00064 * DTSBU910 MASTER FILE I/O DRIVER. DTSBS412 +00065 * DTSBU946 WRITE VARIABLE OUTPUT RECORD(S). DTSBS412 +00066 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBS412 +00067 * DTSBU516 DETERMINE LIABILITY, DUE DATE, DTSBS412 +00068 * AND RATE FOR A GIVEN QUARTER. DTSBS412 +00069 * DTSBU981 VSAM WAGES FILE I/O DRIVER. DTSBS412 +00070 * DTSBU982 VSAM SSN-NAME FILE I/O DRIVER. DTSBS412 +00071 * DTSBS412 +00072 ***** DTSBS412 +00073 DTSBS412 +00074 ENVIRONMENT DIVISION. DTSBS412 +00075 INPUT-OUTPUT SECTION. DTSBS412 +00076 DTSBS412 +00077 FILE-CONTROL. DTSBS412 +00078 DTSBS412 +00079 SELECT EMPLOYER-TEMP ASSIGN TO BX411TMP DTSBS412 +00080 FILE STATUS IS TEMP-STATUS. DTSBS412 +00081 DTSBS412 +00082 SELECT X100-REF-FILE ASSIGN TO EXPBX100 DTSBS412 +00083 FILE STATUS IS X100-STATUS. DTSBS412 +00084 DTSBS412 +00085 SELECT X102-PRF-FILE ASSIGN TO EXPBX102 DTSBS412 +00086 FILE STATUS IS X102-STATUS. DTSBS412 +00087 DTSBS412 +00088 SELECT X104-DETERM-FILE ASSIGN TO EXPBX104 CL**2 +00089 FILE STATUS IS X104-STATUS. CL**2 +00090 DTSBS412 +00091 SELECT X106-NAME-FILE ASSIGN TO EXPBX106 DTSBS412 +00092 FILE STATUS IS X106-STATUS. DTSBS412 +00093 DTSBS412 +00094 SELECT X108-RATE-FILE ASSIGN TO EXPBX108 CL**2 +00095 FILE STATUS IS X108-STATUS. CL**2 +00096 DTSBS412 +00097 SELECT X110-ADDR-FILE ASSIGN TO EXPBX110 DTSBS412 +00098 FILE STATUS IS X110-STATUS. DTSBS412 +00099 DTSBS412 +00100 SELECT X120-OPO-FILE ASSIGN TO EXPBX120 CL**2 +00101 FILE STATUS IS X120-STATUS. CL**2 +00102 DTSBS412 +00103 SELECT X131-REL-FILE ASSIGN TO EXPBX131 DTSBS412 +00104 FILE STATUS IS X131-STATUS. DTSBS412 +00105 DTSBS412 +00106 SELECT X140-REPORT-FILE ASSIGN TO EXPBX140 CL**2 +00107 FILE STATUS IS X140-STATUS. CL**2 +00108 DTSBS412 +00109 SELECT X141-QTR-STATUS-FILE ASSIGN TO EXPBX141 DTSBS412 +00110 FILE STATUS IS X141-STATUS. DTSBS412 +00111 DTSBS412 +00112 SELECT X142-LAST-RPT-PAY-FILE ASSIGN TO EXPBX142 DTSBS412 +00113 FILE STATUS IS X142-STATUS. DTSBS412 +00114 DTSBS412 +00115 SELECT X145-PAYMENT-FILE ASSIGN TO EXPBX145 CL**2 +00116 FILE STATUS IS X145-STATUS. CL**2 +00117 DTSBS412 +00118 SELECT SENT-MINI-FILE ASSIGN TO DTSFSENT CL116 +00119 FILE STATUS IS SENT-MINI-STATUS. CL116 +00120 CL116 +00121 DATA DIVISION. DTSBS412 +00122 FILE SECTION. DTSBS412 +00123 DTSBS412 +00124 FD EMPLOYER-TEMP DTSBS412 +00125 RECORDING MODE IS F. DTSBS412 +00126 01 EMPLOYER-TEMP-REC. DTSBS412 +00127 05 TEMP-REC-TYPE PIC X(03). DTSBS412 +00128 05 FILLER PIC X(01). DTSBS412 +00129 05 TEMP-EMP-NO PIC 9(06). DTSBS412 +00130 05 FILLER PIC X(502). DTSBS412 +00131 DTSBS412 +00132 FD X100-REF-FILE DTSBS412 +00133 RECORDING MODE IS F. DTSBS412 +00134 01 X100-REC PIC X(30). DTSBS412 +00135 DTSBS412 +00136 FD X102-PRF-FILE DTSBS412 +00137 RECORDING MODE IS F. DTSBS412 +00138 01 X102-REC PIC X(29). DTSBS412 +00139 DTSBS412 +00140 FD X104-DETERM-FILE CL**2 +00141 RECORDING MODE IS F. CL**2 +00142 01 X104-REC PIC X(119). CL*52 +00143 DTSBS412 +00144 FD X106-NAME-FILE DTSBS412 +00145 RECORDING MODE IS F. DTSBS412 +00146 01 X106-REC PIC X(53). DTSBS412 +00147 DTSBS412 +00148 FD X108-RATE-FILE CL**2 +00149 RECORDING MODE IS F. CL**2 +00150 01 X108-REC PIC X(24). CL**2 +00151 DTSBS412 +00152 FD X110-ADDR-FILE DTSBS412 +00153 RECORDING MODE IS F. DTSBS412 +00154 01 X110-REC PIC X(249). DTSBS412 +00155 DTSBS412 +00156 FD X120-OPO-FILE CL**2 +00157 RECORDING MODE IS F. CL**2 +00158 01 X120-REC PIC X(385). CL**2 +00159 DTSBS412 +00160 FD X131-REL-FILE DTSBS412 +00161 RECORDING MODE IS F. DTSBS412 +00162 01 X131-REC PIC X(28). DTSBS412 +00163 DTSBS412 +00164 FD X140-REPORT-FILE CL**2 +00165 RECORDING MODE IS F. CL**2 +00166 01 X140-REC PIC X(143). CL**2 +00167 DTSBS412 +00168 FD X141-QTR-STATUS-FILE DTSBS412 +00169 RECORDING MODE IS F. DTSBS412 +00170 01 X141-REC PIC X(102). DTSBS412 +00171 DTSBS412 +00172 FD X142-LAST-RPT-PAY-FILE DTSBS412 +00173 RECORDING MODE IS F. DTSBS412 +00174 01 X142-REC PIC X(54). DTSBS412 +00175 DTSBS412 +00176 FD X145-PAYMENT-FILE CL**2 +00177 RECORDING MODE IS F. CL**2 +00178 01 X145-REC PIC X(102). CL**2 +00179 DTSBS412 +00180 FD SENT-MINI-FILE CL116 +00181 RECORDING MODE IS F CL116 +00182 LABEL RECORDS ARE STANDARD CL116 +00183 BLOCK CONTAINS 0 CHARACTERS. CL116 +00184 CL116 +00185 01 SENT-MINI-REC PIC X(80). CL116 +00186 CL116 +00187 WORKING-STORAGE SECTION. DTSBS412 +001875 77 PAN-VALET PICTURE X(24) VALUE '147DTSBS412 07/04/24'. DTSBS412 +00188 77 PAN-VALET PICTURE X(24) VALUE '004DTSBX411 10/02/09'. DTSBS412 +00189 DTSBS412 +00190 01 WRK-AREA. DTSBS412 +00191 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +411.DTSBS412 +00192 05 ABEND-MSG PIC X(60). DTSBS412 +00193 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX411'.DTSBS412 +00194 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DTSBS412 +00195 DTSBS412 +00196 05 PSUB PIC S9(04) COMP. DTSBS412 +00197 05 PAY-MAX PIC S9(04) COMP DTSBS412 +00198 VALUE +500. DTSBS412 +00199 05 PAY-LAST PIC S9(04) COMP DTSBS412 +00200 VALUE +0. DTSBS412 +00201 05 MAX-PAY-DATE PIC S9(09) COMP-3. DTSBS412 +00202 05 MAX-PAY-BATCH PIC S9(05) COMP-3. DTSBS412 +00203 05 MAX-PAY-ITEM PIC S9(03) COMP-3. DTSBS412 +00204 05 MAX-PAY-AMT PIC S9(09)V99 COMP-3. DTSBS412 +00205 DTSBS412 +00206 05 PAY-TABLE OCCURS 500 TIMES. DTSBS412 +00207 10 PAY-BATCH PIC S9(05) COMP-3. DTSBS412 +00208 10 PAY-ITEM PIC S9(03) COMP-3. DTSBS412 +00209 10 PAY-RCVD-DATE PIC S9(09) COMP-3. DTSBS412 +00210 10 PAY-PROCESS-DATE PIC S9(09) COMP-3. DTSBS412 +00211 10 PAY-ORIG-AMT PIC S9(09)V99 COMP-3. DTSBS412 +00212 10 PAY-ADJ-AMT PIC S9(09)V99 COMP-3. DTSBS412 +00213 DTSBS412 +00214 05 RSUB PIC S9(04) COMP. DTSBS412 +00215 05 RPT-MAX PIC S9(04) COMP DTSBS412 +00216 VALUE +400. DTSBS412 +00217 05 MAX-RPT-DATE PIC S9(09) COMP-3. DTSBS412 +00218 05 MAX-RPT-YRQ PIC S9(05) COMP-3. DTSBS412 +00219 05 MAX-RPT-TYPE PIC X(02). DTSBS412 +00220 DTSBS412 +00221 05 RPT-TABLE OCCURS 400 TIMES. DTSBS412 +00222 10 RPT-YRQ PIC S9(05) COMP-3. DTSBS412 +00223 10 RPT-TYPE PIC X(02). DTSBS412 +00224 10 RPT-RCVD-DATE PIC S9(09) COMP-3. DTSBS412 +00225 10 RPT-PROCESS-DATE PIC S9(09) COMP-3. DTSBS412 +00226 DTSBS412 +00227 05 GLOBAL-DATA-AREA. DTSBS412 +00228 10 WRK-CURR-RUN-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00229 10 WRK-CURR-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00230 10 WRK-CURR-QTR-START PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00231 10 WRK-PRIOR-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00232 10 WRK-FIRST-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00233 10 WRK-FIRST-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00234 10 WRK-START-QTR PIC S9(04) COMP VALUE +0. DTSBS412 +00235 10 WRK-END-QTR PIC S9(04) COMP VALUE +0. DTSBS412 +00236 10 WRK-ABS-QTR PIC S9(04) COMP VALUE +0. DTSBS412 +00237 10 WRK-RATE-YRQ-1 PIC 9(05). DTSBS412 +00238 10 FILLER REDEFINES WRK-RATE-YRQ-1. DTSBS412 +00239 15 WRK-RATE-YRQ-1-CCYY PIC 9(04). DTSBS412 +00240 15 WRK-RATE-YRQ-1-Q PIC 9(01). DTSBS412 +00241 10 WRK-NEW-EMP-RATE-1 PIC 9.9999. DTSBS412 +00242 10 WRK-TAX-TABLE-1 PIC X(05). DTSBS412 +00243 10 WRK-TAX-WAGE-BASE-1 PIC 9(05).99. DTSBS412 +00244 10 WRK-RATE-YRQ-2 PIC 9(05). DTSBS412 +00245 10 FILLER REDEFINES WRK-RATE-YRQ-2. DTSBS412 +00246 15 WRK-RATE-YRQ-2-CCYY PIC 9(04). DTSBS412 +00247 15 WRK-RATE-YRQ-2-Q PIC 9(01). DTSBS412 +00248 10 WRK-NEW-EMP-RATE-2 PIC 9.9999. DTSBS412 +00249 10 WRK-TAX-TABLE-2 PIC X(05). DTSBS412 +00250 10 WRK-TAX-WAGE-BASE-2 PIC 9(05).99. DTSBS412 +00251 10 WRK-RATE-YRQ-3 PIC 9(05). DTSBS412 +00252 10 FILLER REDEFINES WRK-RATE-YRQ-3. DTSBS412 +00253 15 WRK-RATE-YRQ-3-CCYY PIC 9(04). DTSBS412 +00254 15 WRK-RATE-YRQ-3-Q PIC 9(01). DTSBS412 +00255 10 WRK-NEW-EMP-RATE-3 PIC 9.9999. DTSBS412 +00256 10 WRK-TAX-TABLE-3 PIC X(05). DTSBS412 +00257 10 WRK-TAX-WAGE-BASE-3 PIC 9(05).99. DTSBS412 +00258 DTSBS412 +00259 05 WRK-YRQ PIC 9(05). DTSBS412 +00260 05 FILLER REDEFINES WRK-YRQ. DTSBS412 +00261 10 WRK-YRQ-CCYY PIC 9(04). DTSBS412 +00262 10 WRK-YRQ-Q PIC 9(01). DTSBS412 +00263 DTSBS412 +00264 05 WRK-3-YEARS-AGO PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00265 05 WRK-3-YEARS-AGO-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00266 05 WRK-CURR-QTR-MINUS-8 PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00267 05 FIRST-QTR-WRK-DAY PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00268 05 WRK-LIAB-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00269 05 WRK-LIAB-ENTER-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00270 05 WRK-INACT-ENTR-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00271 05 WRK-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00272 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBS412 +00273 05 WRK-INACT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00274 05 WRK-INACT-CUTOFF PIC S9(09) COMP-3 VALUE +0. DTSBS412 +00275 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBS412 +00276 VALUE +999999999. DTSBS412 +00277 05 WRK-UI-RATE PIC S9V9(04) COMP-3. DTSBS412 +00278 DTSBS412 +00279 05 WRK-HOLD-EMP-NO PIC S9(07) COMP-3. DTSBS412 +00280 DTSBS412 +00281 05 WRK-LAST-RATE-YRQ PIC 9(05). DTSBS412 +00282 05 FILLER REDEFINES WRK-LAST-RATE-YRQ. DTSBS412 +00283 10 WRK-LAST-RATE-YEAR PIC 9(04). DTSBS412 +00284 10 WRK-LAST-RATE-QTR PIC 9(01). DTSBS412 +00285 DTSBS412 +00286 05 WRK-SOURCE-CD PIC X(02) VALUE ' '. DTSBS412 +00287 DTSBS412 +00288 05 WRK-LIAB-CD PIC X(02) VALUE ' '. DTSBS412 +00289 88 WRK-LIAB-RATED-REG-88 VALUE '01'. DTSBS412 +00290 88 WRK-LIAB-RATED-DOMESTIC-88 VALUE '04'. DTSBS412 +00291 88 WRK-LIAB-RATED-SUCC-88 VALUE '05'. DTSBS412 +00292 88 WRK-LIAB-RATED-FUTA-88 VALUE '06'. DTSBS412 +00293 88 WRK-LIAB-RATED-FOREIGN-88 VALUE '07'. DTSBS412 +00294 88 WRK-LIAB-RATED-VOLUNT-88 VALUE '08'. DTSBS412 +00295 88 WRK-LIAB-RATED-OTH-88 VALUE '09'. DTSBS412 +00296 88 WRK-LIAB-RATED-CONV-88 VALUE '10'. DTSBS412 +00297 88 WRK-LIAB-RATED-UNK-88 VALUE '11'. DTSBS412 +00298 88 WRK-LIAB-SELF-INS-SCHOOL-88 VALUE '21'. DTSBS412 +00299 88 WRK-LIAB-SELF-INS-CITY-88 VALUE '22'. DTSBS412 +00300 88 WRK-LIAB-SELF-INS-COUNTY-88 VALUE '23'. DTSBS412 +00301 88 WRK-LIAB-SELF-INS-STATE-88 VALUE '24'. DTSBS412 +00302 88 WRK-LIAB-SELF-INS-CHURCH-88 VALUE '25'. DTSBS412 +00303 88 WRK-LIAB-SELF-INS-NON-PROF-88 VALUE '26'. DTSBS412 +00304 88 WRK-LIAB-SELF-INS-OTH-88 VALUE '27'. DTSBS412 +00305 88 WRK-LIAB-SELF-INS-CONV-88 VALUE '28'. DTSBS412 +00306 88 WRK-LIAB-SELF-INS-UNK-88 VALUE '29'. DTSBS412 +00307 88 WRK-LIAB-SELF-INS-VOLUNT-88 VALUE '30'. DTSBS412 +00308 DTSBS412 +00309 05 WRK-ERROR-IND PIC X(01). DTSBS412 +00310 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBS412 +00311 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBS412 +00312 DTSBS412 +00313 05 WRK-SELECT-EMP-IND PIC X(01). DTSBS412 +00314 88 WRK-SELECT-EMP-ALL-88 VALUE '0'. DTSBS412 +00315 88 WRK-SELECT-EMP-PRF-88 VALUE '1'. DTSBS412 +00316 88 WRK-SELECT-EMP-NO-88 VALUE '2'. DTSBS412 +00317 DTSBS412 +00318 05 WRK-CURR-QTR-IND PIC X(01). DTSBS412 +00319 88 WRK-CURR-QTR-YES-88 VALUE 'Y'. DTSBS412 +00320 88 WRK-CURR-QTR-NO-88 VALUE 'N'. DTSBS412 +00321 DTSBS412 +00322 05 WRK-PRIOR-QTR-IND PIC X(01). DTSBS412 +00323 88 WRK-PRIOR-QTR-YES-88 VALUE 'Y'. DTSBS412 +00324 88 WRK-PRIOR-QTR-NO-88 VALUE 'N'. DTSBS412 +00325 DTSBS412 +00326 05 WRK-MOPO-IND PIC X(01). DTSBS412 +00327 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. DTSBS412 +00328 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. DTSBS412 +00329 DTSBS412 +00330 05 WRK-SUBJ-EMP-IND PIC X(01). DTSBS412 +00331 88 WRK-SUBJ-EMP-YES-88 VALUE 'Y'. DTSBS412 +00332 88 WRK-SUBJ-EMP-NO-88 VALUE 'N'. DTSBS412 +00333 DTSBS412 +00334 05 PARM-STATUS PIC X(02). DTSBS412 +00335 88 PARM-STATUS-OK-88 VALUE '00'. DTSBS412 +00336 05 TEMP-STATUS PIC X(02). DTSBS412 +00337 88 TEMP-STATUS-OK-88 VALUE '00'. DTSBS412 +00338 88 TEMP-STATUS-EOF-88 VALUE '10'. DTSBS412 +00339 05 X100-STATUS PIC X(02). DTSBS412 +00340 88 X100-STATUS-OK-88 VALUE '00'. DTSBS412 +00341 05 X102-STATUS PIC X(02). DTSBS412 +00342 88 X102-STATUS-OK-88 VALUE '00'. DTSBS412 +00343 05 X104-STATUS PIC X(02). DTSBS412 +00344 88 X104-STATUS-OK-88 VALUE '00'. DTSBS412 +00345 05 X106-STATUS PIC X(02). DTSBS412 +00346 88 X106-STATUS-OK-88 VALUE '00'. DTSBS412 +00347 05 X108-STATUS PIC X(02). DTSBS412 +00348 88 X108-STATUS-OK-88 VALUE '00'. DTSBS412 +00349 05 X110-STATUS PIC X(02). DTSBS412 +00350 88 X110-STATUS-OK-88 VALUE '00'. DTSBS412 +00351 05 X120-STATUS PIC X(02). DTSBS412 +00352 88 X120-STATUS-OK-88 VALUE '00'. DTSBS412 +00353 05 X130-STATUS PIC X(02). DTSBS412 +00354 88 X130-STATUS-OK-88 VALUE '00'. DTSBS412 +00355 05 X131-STATUS PIC X(02). DTSBS412 +00356 88 X131-STATUS-OK-88 VALUE '00'. DTSBS412 +00357 05 X140-STATUS PIC X(02). DTSBS412 +00358 88 X140-STATUS-OK-88 VALUE '00'. DTSBS412 +00359 05 X141-STATUS PIC X(02). DTSBS412 +00360 88 X141-STATUS-OK-88 VALUE '00'. DTSBS412 +00361 05 X142-STATUS PIC X(02). DTSBS412 +00362 88 X142-STATUS-OK-88 VALUE '00'. DTSBS412 +00363 05 X145-STATUS PIC X(02). DTSBS412 +00364 88 X145-STATUS-OK-88 VALUE '00'. DTSBS412 +00365 05 SENT-MINI-STATUS PIC X(02). CL116 +00366 88 SENT-MINI-STATUS-OK-88 VALUE '00'. CL116 +00367 88 SENT-MINI-STATUS-EOF-88 VALUE '10'. CL119 +00368 CL116 +00369 DTSBS412 +00370 05 WRK-ACQUIRED-IND PIC X(01). DTSBS412 +00371 88 WRK-ACQUIRED-YES-88 VALUE 'Y'. DTSBS412 +00372 88 WRK-ACQUIRED-NO-88 VALUE 'N'. DTSBS412 +00373 DTSBS412 +00374 05 WRK-MERGER-SPLIT-IND PIC X(01). DTSBS412 +00375 88 WRK-MERGER-SPLIT-YES-88 VALUE 'Y'. DTSBS412 +00376 88 WRK-MERGER-SPLIT-NO-88 VALUE 'N'. DTSBS412 +00377 DTSBS412 +00378 05 WRK-REORG-IND PIC X(01). DTSBS412 +00379 88 WRK-REORG-YES-88 VALUE 'Y'. DTSBS412 +00380 88 WRK-REORG-NO-88 VALUE 'N'. DTSBS412 +00381 DTSBS412 +00382 05 WRK-ADDRESS. DTSBS412 +00383 10 WRK-ATTN-LINE PIC X(40). DTSBS412 +00384 10 WRK-DELIV-LINE-1 PIC X(40). DTSBS412 +00385 10 WRK-DELIV-LINE-2 PIC X(40). DTSBS412 +00386 10 WRK-CITY PIC X(25). DTSBS412 +00387 10 WRK-ST PIC X(02). DTSBS412 +00388 10 WRK-ZIP PIC X(10). DTSBS412 +00389 10 WRK-ADVANCED-BARCODE DTSBS412 +00390 PIC X(14). DTSBS412 +00391 DTSBS412 +00392 05 WRK-PHONE PIC X(15). DTSBS412 +00393 05 WRK-FAX PIC X(15). DTSBS412 +00394 05 WRK-EMAIL PIC X(40). DTSBS412 +00395 DTSBS412 +00396 05 WRK-CURR-RATE PIC 9.9999. DTSBS412 +00397 DTSBS412 +00398 05 WRK-ANNUAL-STATUS. DTSBS412 +00399 10 WRK-ANN-YEAR PIC S9(04) COMP-3 VALUE +0.DTSBS412 +00400 10 WRK-FILING-SCHED PIC X(01). DTSBS412 +00401 88 WRK-FILE-QTRLY-88 VALUE '0'. DTSBS412 +00402 88 WRK-FILE-ANN-LIAB-88 VALUE '1'. DTSBS412 +00403 88 WRK-FILE-ANN-NOT-LIAB-88 VALUE '2'. DTSBS412 +00404 DTSBS412 +00405 05 WRK-TAX-BAL PIC S9(09)V99 COMP-3 DTSBS412 +00406 VALUE +0. DTSBS412 +00407 05 WRK-SUR-BAL PIC S9(09)V99 COMP-3 DTSBS412 +00408 VALUE +0. DTSBS412 +00409 05 WRK-INT-BAL PIC S9(09)V99 COMP-3 DTSBS412 +00410 VALUE +0. DTSBS412 +00411 05 WRK-PEN-BAL PIC S9(09)V99 COMP-3 DTSBS412 +00412 VALUE +0. DTSBS412 +00413 DTSBS412 +00414 05 WRK-LEN PIC S9(04) COMP VALUE +0. DTSBS412 +00415 DTSBS412 +00416 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00417 05 WRK-TEST-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00418 05 TEMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00419 05 X102-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00420 05 X104-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00421 05 X106-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00422 05 X110-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00423 05 X108-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00424 05 X120-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00425 05 X130-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00426 05 X131-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00427 05 X140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00428 05 X141-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00429 05 X142-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00430 05 X145-CNT PIC S9(07) COMP-3 VALUE +0. DTSBS412 +00431 05 W-SENT-MINI-CNT PIC S9(07) COMP-3 VALUE +0. CL125 +00432 DTSBS412 +00433 05 WRK-SSN-ERROR-DISP PIC --,---,--9. DTSBS412 +00434 05 WRK-AMT-DISP PIC --,---,---,--9.99. DTSBS412 +00435 05 WRK-AMT-DISP1 PIC --,---,---,--9.99. DTSBS412 +00436 05 WRK-PCT-DISP PIC ZZ9.9999-. DTSBS412 +00437 DTSBS412 +00438 DTSBS412 +00439 01 WS-SENT-REC. CL122 +00440 05 WS-SENT-EMP-NO PIC 9(06) VALUE 0. CL122 +00441 05 WS-SENT-EMP-STATUS PIC X(01) VALUE SPACES. CL122 +00442 05 WS-SENT-CURR-DATE PIC 9(08) VALUE 0. CL122 +00443 05 WS-SENT-LIAB-DATE PIC 9(08) VALUE 0. CL122 +00444 05 WS-SENT-ESTB-DATE PIC 9(08) VALUE 0. CL122 +00445 05 WS-SENT-CHNG-DATE PIC 9(08) VALUE 0. CL122 +00446 05 FILLER PIC X(41). CL122 +00447 CL122 +00448 01 MSG-AREA. DTSBS412 +00449 05 MSG1-AREA. DTSBS412 +00450 10 MSG1-ID PIC X(03) VALUE '800'. DTSBS412 +00451 10 MSG1-TEXT. DTSBS412 +00452 15 FILLER PIC X(40) DTSBS412 +00453 VALUE ' '. DTSBS412 +00454 15 FILLER PIC X(40) DTSBS412 +00455 VALUE ' '. DTSBS412 +00456 DTSBS412 +00457 01 TALLY-AREA. DTSBS412 +00458 05 SLASH-NAME. DTSBS412 +00459 10 SLASH-NAME-CHAR OCCURS 40 TIMES PIC X(01). DTSBS412 +00460 05 FIRST-NAME PIC X(40) VALUE SPACE. DTSBS412 +00461 05 MIDDLE-INIT PIC X(01) VALUE SPACE. DTSBS412 +00462 05 LAST-NAME PIC X(40) VALUE SPACE. DTSBS412 +00463 05 NSUB PIC S9(04) COMP. DTSBS412 +00464 05 FSUB PIC S9(04) COMP. DTSBS412 +00465 05 LSUB PIC S9(04) COMP. DTSBS412 +00466 05 LAST-NAME-COMPLETE-IND PIC X(01). DTSBS412 +00467 88 LAST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBS412 +00468 88 LAST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBS412 +00469 05 FIRST-NAME-COMPLETE-IND PIC X(01). DTSBS412 +00470 88 FIRST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBS412 +00471 88 FIRST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBS412 +00472 05 MID-INIT-COMPLETE-IND PIC X(01). DTSBS412 +00473 88 MID-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSBS412 +00474 88 MID-INIT-COMPLETE-NO-88 VALUE 'N'. DTSBS412 +00475 05 D-S PIC X(02) VALUE SPACE. DTSBS412 +00476 05 SLASH-TALLY PIC S9(04) COMP. DTSBS412 +00477 05 LAST-NAME-LEN PIC S9(04) COMP. DTSBS412 +00478 05 FIRST-MID-LEN PIC S9(04) COMP. DTSBS412 +00479 05 FIRST-NAME-LEN PIC S9(04) COMP. DTSBS412 +00480 05 TOTAL-LEN PIC S9(04) COMP. DTSBS412 +00481 EJECT DTSBS412 +00482 01 WRK-X100-REC. DTSBS412 +00483 ++INCLUDE DTSIX100 DTSBS412 +00484 DTSBS412 +00485 01 WRK-X102-REC. DTSBS412 +00486 ++INCLUDE DTSIX102 DTSBS412 +00487 DTSBS412 +00488 01 WRK-X104-REC. DTSBS412 +00489 ++INCLUDE DTSIX104 DTSBS412 +00490 DTSBS412 +00491 01 WRK-X106-REC. DTSBS412 +00492 ++INCLUDE DTSIX106 DTSBS412 +00493 DTSBS412 +00494 01 WRK-X108-REC. DTSBS412 +00495 ++INCLUDE DTSIX108 DTSBS412 +00496 DTSBS412 +00497 01 WRK-X110-REC. DTSBS412 +00498 ++INCLUDE DTSIX110 DTSBS412 +00499 DTSBS412 +00500 01 WRK-X120-REC. DTSBS412 +00501 ++INCLUDE DTSIX120 DTSBS412 +00502 DTSBS412 +00503 01 WRK-X131-REC. DTSBS412 +00504 ++INCLUDE DTSIX131 DTSBS412 +00505 DTSBS412 +00506 01 WRK-X140-REC. DTSBS412 +00507 ++INCLUDE DTSIX140 DTSBS412 +00508 DTSBS412 +00509 01 WRK-X141-REC. DTSBS412 +00510 ++INCLUDE DTSIX141 DTSBS412 +00511 DTSBS412 +00512 01 WRK-X142-REC. DTSBS412 +00513 ++INCLUDE DTSIX142 DTSBS412 +00514 DTSBS412 +00515 01 WRK-X145-REC. DTSBS412 +00516 ++INCLUDE DTSIX145 DTSBS412 +00517 DTSBS412 +00518 01 L001-LINK-AREA. DTSBS412 +00519 ++INCLUDE DTSIL001 DTSBS412 +00520 DTSBS412 +00521 01 L003-LINK-AREA. DTSBS412 +00522 ++INCLUDE DTSIL003 DTSBS412 +00523 DTSBS412 +00524 01 L004-LINK-AREA. DTSBS412 +00525 ++INCLUDE DTSIL004 DTSBS412 +00526 DTSBS412 +00527 01 L005-LINK-AREA. DTSBS412 +00528 ++INCLUDE DTSIL005 DTSBS412 +00529 DTSBS412 +00530 01 L410-LINK-AREA. DTSBS412 +00531 ++INCLUDE DTSIL410 DTSBS412 +00532 DTSBS412 +00533 01 L516-LINK-AREA. DTSBS412 +00534 ++INCLUDE DTSIL516 DTSBS412 +00535 DTSBS412 +00536 01 L600-LINK-AREA. DTSBS412 +00537 ++INCLUDE DTSIL600 DTSBS412 +00538 DTSBS412 +00539 01 L101-LINK-AREA. DTSBS412 +00540 ++INCLUDE DTSIL101 DTSBS412 +00541 DTSBS412 +00542 01 L910-LINK-AREA. DTSBS412 +00543 ++INCLUDE DTSIL910 DTSBS412 +00544 SKIP3 DTSBS412 +00545 01 MSKL-REC. DTSBS412 +00546 ++INCLUDE DTSIMSKL DTSBS412 +00547 SKIP3 DTSBS412 +00548 01 MHDR-REC. DTSBS412 +00549 ++INCLUDE DTSIMHDR DTSBS412 +00550 SKIP3 DTSBS412 +00551 01 MPRF-REC. DTSBS412 +00552 ++INCLUDE DTSIMPRF DTSBS412 +00553 DTSBS412 +00554 01 MSOL-REC. DTSBS412 +00555 ++INCLUDE DTSIMSOL DTSBS412 +00556 DTSBS412 +00557 01 MERA-REC. DTSBS412 +00558 ++INCLUDE DTSIMERA DTSBS412 +00559 DTSBS412 +00560 01 MQTR-REC. DTSBS412 +00561 ++INCLUDE DTSIMQTR DTSBS412 +00562 DTSBS412 +00563 01 MRPT-REC. DTSBS412 +00564 ++INCLUDE DTSIMRPT DTSBS412 +00565 DTSBS412 +00566 01 MPAY-REC. DTSBS412 +00567 ++INCLUDE DTSIMPAY DTSBS412 +00568 DTSBS412 +00569 01 MFAE-REC. DTSBS412 +00570 ++INCLUDE DTSIMFAE DTSBS412 +00571 DTSBS412 +00572 01 MOPO-REC. DTSBS412 +00573 ++INCLUDE DTSIMOPO DTSBS412 +00574 DTSBS412 +00575 01 MTAD-REC. DTSBS412 +00576 ++INCLUDE DTSIMTAD DTSBS412 +00577 DTSBS412 +00578 01 MTAA-REC. DTSBS412 +00579 ++INCLUDE DTSIMTAA DTSBS412 +00580 DTSBS412 +00581 01 MREL-REC. DTSBS412 +00582 ++INCLUDE DTSIMREL DTSBS412 +00583 DTSBS412 +00584 01 MRTE-REC. DTSBS412 +00585 ++INCLUDE DTSIMRTE DTSBS412 +00586 DTSBS412 +00587 01 L921-LINK-AREA. DTSBS412 +00588 ++INCLUDE DTSIL921 DTSBS412 +00589 DTSBS412 +00590 01 ISKL-REC. DTSBS412 +00591 ++INCLUDE DTSIISKL DTSBS412 +00592 DTSBS412 +00593 01 IEIN-REC. DTSBS412 +00594 ++INCLUDE DTSIIEIN DTSBS412 +00595 DTSBS412 +00596 01 L931-LINK-AREA. DTSBS412 +00597 ++INCLUDE DTSIL931 DTSBS412 +00598 EJECT DTSBS412 +00599 01 FSKL-REC. DTSBS412 +00600 ++INCLUDE DTSIFSKL DTSBS412 +00601 EJECT DTSBS412 +00602 01 FCYR-REC. DTSBS412 +00603 ++INCLUDE DTSIFCYR DTSBS412 +00604 DTSBS412 +00605 01 FUIR-REC. DTSBS412 +00606 ++INCLUDE DTSIFUIR DTSBS412 +00607 DTSBS412 +00608 DTSBS412 +00609 PROCEDURE DIVISION. DTSBS412 +00610 DTSBS412 +00611 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBS412 +00612 IF WRK-ERROR-NO-88 DTSBS412 +00613 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBS412 +00614 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBS412 +00615 END-IF. DTSBS412 +00616 DTSBS412 +00617 GOBACK. DTSBS412 +00618 EJECT DTSBS412 +00619 I0000-INITIALIZE. DTSBS412 +00620 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBS412 +00621 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBS412 +00622 SET WRK-ERROR-NO-88 TO TRUE. DTSBS412 +00623 DTSBS412 +00624 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBS412 +00625 IF WRK-ERROR-YES-88 DTSBS412 +00626 GO TO I0000-EXIT DTSBS412 +00627 END-IF. DTSBS412 +00628 DTSBS412 +00629 PERFORM I3000-GLOBAL-DATA THRU I3000-EXIT. DTSBS412 +00630 DTSBS412 +00631 I0000-EXIT. DTSBS412 +00632 EXIT. DTSBS412 +00633 DTSBS412 +00634 I2000-OPEN-FILES. DTSBS412 +00635 DTSBS412 +00636 OPEN OUTPUT EMPLOYER-TEMP. DTSBS412 +00637 IF TEMP-STATUS-OK-88 DTSBS412 +00638 NEXT SENTENCE DTSBS412 +00639 ELSE DTSBS412 +00640 DISPLAY 'OPEN ERROR ON TEMP FILE ' TEMP-STATUS DTSBS412 +00641 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00642 GO TO I2000-EXIT DTSBS412 +00643 END-IF. DTSBS412 +00644 DTSBS412 +00645 OPEN OUTPUT X100-REF-FILE. DTSBS412 +00646 IF X100-STATUS-OK-88 DTSBS412 +00647 NEXT SENTENCE DTSBS412 +00648 ELSE DTSBS412 +00649 DISPLAY 'OPEN ERROR ON X100 FILE ' X100-STATUS DTSBS412 +00650 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00651 GO TO I2000-EXIT DTSBS412 +00652 END-IF. DTSBS412 +00653 DTSBS412 +00654 OPEN OUTPUT X102-PRF-FILE. DTSBS412 +00655 IF X102-STATUS-OK-88 DTSBS412 +00656 NEXT SENTENCE DTSBS412 +00657 ELSE DTSBS412 +00658 DISPLAY 'OPEN ERROR ON X102 FILE ' X102-STATUS DTSBS412 +00659 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00660 GO TO I2000-EXIT DTSBS412 +00661 END-IF. DTSBS412 +00662 DTSBS412 +00663 OPEN OUTPUT X104-DETERM-FILE. CL**2 +00664 IF X104-STATUS-OK-88 CL**2 +00665 NEXT SENTENCE CL**2 +00666 ELSE CL**2 +00667 DISPLAY 'OPEN ERROR ON X104 FILE ' X104-STATUS CL**2 +00668 SET WRK-ERROR-YES-88 TO TRUE CL**2 +00669 GO TO I2000-EXIT CL**2 +00670 END-IF. CL**2 +00671 DTSBS412 +00672 OPEN OUTPUT X106-NAME-FILE. DTSBS412 +00673 IF X106-STATUS-OK-88 DTSBS412 +00674 NEXT SENTENCE DTSBS412 +00675 ELSE DTSBS412 +00676 DISPLAY 'OPEN ERROR ON X106 FILE ' X106-STATUS DTSBS412 +00677 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00678 GO TO I2000-EXIT DTSBS412 +00679 END-IF. DTSBS412 +00680 DTSBS412 +00681 OPEN OUTPUT X108-RATE-FILE. CL**2 +00682 IF X108-STATUS-OK-88 CL**2 +00683 NEXT SENTENCE CL**2 +00684 ELSE CL**2 +00685 DISPLAY 'OPEN ERROR ON X108 FILE ' X108-STATUS CL**2 +00686 SET WRK-ERROR-YES-88 TO TRUE CL**2 +00687 GO TO I2000-EXIT CL**2 +00688 END-IF. CL**4 +00689 DTSBS412 +00690 OPEN OUTPUT X110-ADDR-FILE. DTSBS412 +00691 IF X110-STATUS-OK-88 DTSBS412 +00692 NEXT SENTENCE DTSBS412 +00693 ELSE DTSBS412 +00694 DISPLAY 'OPEN ERROR ON X110 FILE ' X110-STATUS DTSBS412 +00695 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00696 GO TO I2000-EXIT DTSBS412 +00697 END-IF. DTSBS412 +00698 DTSBS412 +00699 OPEN OUTPUT X120-OPO-FILE. CL**2 +00700 IF X120-STATUS-OK-88 CL**2 +00701 NEXT SENTENCE CL**2 +00702 ELSE CL**2 +00703 DISPLAY 'OPEN ERROR ON X120 FILE ' X120-STATUS CL**2 +00704 SET WRK-ERROR-YES-88 TO TRUE CL**2 +00705 GO TO I2000-EXIT CL**2 +00706 END-IF. CL**2 +00707 DTSBS412 +00708 OPEN OUTPUT X131-REL-FILE. DTSBS412 +00709 IF X131-STATUS-OK-88 DTSBS412 +00710 NEXT SENTENCE DTSBS412 +00711 ELSE DTSBS412 +00712 DISPLAY 'OPEN ERROR ON X131 FILE ' X131-STATUS DTSBS412 +00713 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00714 GO TO I2000-EXIT DTSBS412 +00715 END-IF. DTSBS412 +00716 DTSBS412 +00717 OPEN OUTPUT X140-REPORT-FILE. CL**2 +00718 IF X140-STATUS-OK-88 CL**2 +00719 NEXT SENTENCE CL**2 +00720 ELSE CL**2 +00721 DISPLAY 'OPEN ERROR ON X140 FILE ' X140-STATUS CL**2 +00722 SET WRK-ERROR-YES-88 TO TRUE CL**2 +00723 GO TO I2000-EXIT CL**2 +00724 END-IF. CL**2 +00725 DTSBS412 +00726 OPEN OUTPUT X141-QTR-STATUS-FILE. DTSBS412 +00727 IF X141-STATUS-OK-88 DTSBS412 +00728 NEXT SENTENCE DTSBS412 +00729 ELSE DTSBS412 +00730 DISPLAY 'OPEN ERROR ON X141 FILE ' X141-STATUS DTSBS412 +00731 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00732 GO TO I2000-EXIT DTSBS412 +00733 END-IF. DTSBS412 +00734 DTSBS412 +00735 OPEN OUTPUT X142-LAST-RPT-PAY-FILE. DTSBS412 +00736 IF X142-STATUS-OK-88 DTSBS412 +00737 NEXT SENTENCE DTSBS412 +00738 ELSE DTSBS412 +00739 DISPLAY 'OPEN ERROR ON X142 FILE ' X142-STATUS DTSBS412 +00740 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00741 GO TO I2000-EXIT DTSBS412 +00742 END-IF. DTSBS412 +00743 DTSBS412 +00744 OPEN OUTPUT X145-PAYMENT-FILE. CL**2 +00745 IF X145-STATUS-OK-88 CL**2 +00746 NEXT SENTENCE CL**2 +00747 ELSE CL**2 +00748 DISPLAY 'OPEN ERROR ON X145 FILE ' X145-STATUS CL**2 +00749 SET WRK-ERROR-YES-88 TO TRUE CL**2 +00750 GO TO I2000-EXIT CL**2 +00751 END-IF. CL**2 +00752 DTSBS412 +00753 OPEN INPUT SENT-MINI-FILE. CL116 +00754 IF SENT-MINI-STATUS-OK-88 CL116 +00755 NEXT SENTENCE CL116 +00756 ELSE CL116 +00757 DISPLAY 'OPEN ERROR ON SENT MINI FILE ' SENT-MINI-STATUS CL116 +00758 SET WRK-ERROR-YES-88 TO TRUE CL116 +00759 GO TO I2000-EXIT CL116 +00760 END-IF. CL116 +00761 CL116 +00762 PERFORM S910A-OPEN-READ THRU S910A-EXIT. DTSBS412 +00763 PERFORM S921A-OPEN-READ THRU S921A-EXIT. DTSBS412 +00764 PERFORM S931A-OPEN-READ THRU S931A-EXIT. DTSBS412 +00765 DTSBS412 +00766 I2000-EXIT. DTSBS412 +00767 EXIT. DTSBS412 +00768 DTSBS412 +00769 I3000-GLOBAL-DATA. DTSBS412 +00770 PERFORM I3100-TAX-HEADER THRU I3100-EXIT. DTSBS412 +00771 IF WRK-ERROR-NO-88 DTSBS412 +00772 PERFORM I3200-TAX-REF THRU I3200-EXIT DTSBS412 +00773 IF WRK-ERROR-NO-88 DTSBS412 +00774 PERFORM I3300-BUILD-X100 THRU I3300-EXIT DTSBS412 +00775 END-IF DTSBS412 +00776 END-IF. DTSBS412 +00777 DTSBS412 +00778 I3000-EXIT. DTSBS412 +00779 EXIT. DTSBS412 +00780 DTSBS412 +00781 I3100-TAX-HEADER. DTSBS412 +00782 MOVE LOW-VALUES TO MSKL-REC. DTSBS412 +00783 MOVE +0 TO MSKL-EMP-NO. DTSBS412 +00784 SET MSKL-HDR-88 TO TRUE. DTSBS412 +00785 DTSBS412 +00786 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +00787 IF L910-NO-REC-88 DTSBS412 +00788 DISPLAY 'DTSBX411: MHDR RECORD IS MISSING' DTSBS412 +00789 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00790 GO TO I3100-EXIT DTSBS412 +00791 ELSE DTSBS412 +00792 MOVE MSKL-REC TO MHDR-REC DTSBS412 +00793 END-IF. DTSBS412 +00794 DTSBS412 +00795 MOVE MHDR-CURR-RUN-DATE TO WRK-CURR-RUN-DATE DTSBS412 +00796 L004-DATE. DTSBS412 +00797 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS412 +00798 MOVE L004-QTR-5-9 TO WRK-CURR-QTR. DTSBS412 +00799 MOVE L004-QTR-START-DATE TO WRK-CURR-QTR-START. DTSBS412 +00800 DTSBS412 +00801 MOVE MHDR-CURR-RUN-DATE TO L004-DATE. DTSBS412 +00802 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS412 +00803 SUBTRACT +8 FROM L004-ABS-QTR. DTSBS412 +00804 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS412 +00805 MOVE L004-QTR-5-9 TO WRK-CURR-QTR-MINUS-8. DTSBS412 +00806 DTSBS412 +00807 MOVE MHDR-CURR-RUN-DATE TO L004-DATE. DTSBS412 +00808 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS412 +00809 SUBTRACT +2 FROM L004-ABS-QTR. DTSBS412 +00810 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS412 +00811 MOVE L004-QTR-START-DATE TO WRK-INACT-CUTOFF. DTSBS412 +00812 DTSBS412 +00813 MOVE WRK-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBS412 +00814 SUBTRACT 4 FROM L001-FED-8-YR CL*27 +00815 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS412 +00816 MOVE L001-FED-8-DATE-9 TO WRK-3-YEARS-AGO DTSBS412 +00817 L004-DATE. DTSBS412 +00818 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS412 +00819 MOVE L004-QTR-5-9 TO WRK-3-YEARS-AGO-YRQ. DTSBS412 +00820 DTSBS412 +00821 MOVE MHDR-LAST-RATE-END-YRQ TO WRK-YRQ. DTSBS412 +00822 MOVE 1 TO WRK-YRQ-Q. DTSBS412 +00823 MOVE WRK-YRQ TO WRK-RATE-YRQ-1. DTSBS412 +00824 SUBTRACT 1 FROM WRK-YRQ-CCYY. DTSBS412 +00825 MOVE WRK-YRQ TO WRK-RATE-YRQ-2. DTSBS412 +00826 SUBTRACT 1 FROM WRK-YRQ-CCYY. DTSBS412 +00827 MOVE WRK-YRQ TO WRK-RATE-YRQ-3. DTSBS412 +00828 DTSBS412 +00829 ***** DTSBS412 +00830 ** WRK-PRIOR-QTR IS THE MOST RECENTLY COMPLETED DTSBS412 +00831 ** QUARTER. DTSBS412 +00832 ** WRK-CURR-QTR IS THE QUARTER IN WHICH DTSBS412 +00833 ** MHDR-CURR-RUN-DATE FALLS. DTSBS412 +00834 ** THESE FIELDS ARE USED IN P3700 WHICH EXTRACTS DTSBS412 +00835 ** QUARTER INFORMATION. DTSBS412 +00836 ***** DTSBS412 +00837 DTSBS412 +00838 MOVE MHDR-LAST-PEN-ASSESSED-YRQ DTSBS412 +00839 TO L004-QTR-5-9. DTSBS412 +00840 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS412 +00841 ADD +1 TO L004-ABS-QTR. DTSBS412 +00842 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS412 +00843 MOVE L004-QTR-5-9 TO WRK-PRIOR-QTR. DTSBS412 +00844 DTSBS412 +00845 MOVE MHDR-CURR-RUN-DATE TO L004-DATE. DTSBS412 +00846 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBS412 +00847 SUBTRACT +1 FROM L004-ABS-QTR. DTSBS412 +00848 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBS412 +00849 IF WRK-PRIOR-QTR < L004-QTR-5-9 DTSBS412 +00850 DISPLAY '>>> MORE THAN 1 QUARTER NOT DELINQUENT ' DTSBS412 +00851 WRK-PRIOR-QTR ' ' L004-QTR-5-9 DTSBS412 +00852 DISPLAY 'BX410 ABENDING ' DTSBS412 +00853 PERFORM S999-ABEND THRU S999-EXIT DTSBS412 +00854 END-IF. DTSBS412 +00855 DTSBS412 +00856 DISPLAY SPACE. DTSBS412 +00857 DISPLAY 'DTSBX411 DATES:' DTSBS412 +00858 DISPLAY ' CURR RUN DATE ' WRK-CURR-RUN-DATE. DTSBS412 +00859 DISPLAY ' 3 YEARS AGO ' WRK-3-YEARS-AGO. DTSBS412 +00860 DISPLAY ' 4 YEARS AGO QTR ' WRK-3-YEARS-AGO-YRQ. CL*27 +00861 DISPLAY ' RATE YEAR 1 ' WRK-RATE-YRQ-1. DTSBS412 +00862 DISPLAY ' RATE YEAR 2 ' WRK-RATE-YRQ-2. DTSBS412 +00863 DISPLAY ' RATE YEAR 3 ' WRK-RATE-YRQ-3. DTSBS412 +00864 DISPLAY ' START QTR ' WRK-FIRST-WAGE-QTR. DTSBS412 +00865 DISPLAY ' FIRST RPT QTR ' WRK-FIRST-RPT-QTR. DTSBS412 +00866 DTSBS412 +00867 I3100-EXIT. DTSBS412 +00868 EXIT. DTSBS412 +00869 DTSBS412 +00870 I3200-TAX-REF. DTSBS412 +00871 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBS412 +00872 SET FCYR-CYR-88 TO TRUE. DTSBS412 +00873 MOVE WRK-RATE-YRQ-3-CCYY TO FCYR-YR. DTSBS412 +00874 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBS412 +00875 DTSBS412 +00876 PERFORM S931B-START-BROWSE THRU S931B-EXIT. DTSBS412 +00877 IF L931-NO-REC-88 DTSBS412 +00878 DISPLAY 'DTSBX411: FCYR RECORD IS MISSING' DTSBS412 +00879 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00880 GO TO I3200-EXIT DTSBS412 +00881 ELSE DTSBS412 +00882 PERFORM DTSBS412 +00883 UNTIL L931-NO-REC-88 DTSBS412 +00884 MOVE FSKL-REC TO FCYR-REC DTSBS412 +00885 PERFORM I3210-WAGE-BASE THRU I3210-EXIT DTSBS412 +00886 PERFORM S931C-READ-NEXT THRU S931C-EXIT DTSBS412 +00887 END-PERFORM DTSBS412 +00888 END-IF. DTSBS412 +00889 DTSBS412 +00890 MOVE LOW-VALUE TO FUIR-KEY-AREA. DTSBS412 +00891 SET FUIR-UIR-88 TO TRUE. DTSBS412 +00892 MOVE WRK-RATE-YRQ-3 TO FUIR-EFF-YRQ. DTSBS412 +00893 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSBS412 +00894 PERFORM S931B-START-BROWSE THRU S931B-EXIT. DTSBS412 +00895 IF L931-OK-88 DTSBS412 +00896 PERFORM DTSBS412 +00897 UNTIL L931-NO-REC-88 DTSBS412 +00898 MOVE FSKL-REC TO FUIR-REC DTSBS412 +00899 PERFORM I3220-RATES THRU I3220-EXIT DTSBS412 +00900 PERFORM S931C-READ-NEXT THRU S931C-EXIT DTSBS412 +00901 END-PERFORM DTSBS412 +00902 END-IF. DTSBS412 +00903 DTSBS412 +00904 DISPLAY SPACE. DTSBS412 +00905 DISPLAY 'DTSBX411 RATES: ' DTSBS412 +00906 DISPLAY ' YEAR 1 ' WRK-RATE-YRQ-1 DTSBS412 +00907 ' ' WRK-NEW-EMP-RATE-1 DTSBS412 +00908 ' ' WRK-TAX-TABLE-1. DTSBS412 +00909 DISPLAY ' YEAR 2 ' WRK-RATE-YRQ-2 DTSBS412 +00910 ' ' WRK-NEW-EMP-RATE-2 DTSBS412 +00911 ' ' WRK-TAX-TABLE-3. DTSBS412 +00912 DISPLAY ' YEAR 3 ' WRK-RATE-YRQ-3 DTSBS412 +00913 ' ' WRK-NEW-EMP-RATE-3 DTSBS412 +00914 ' ' WRK-TAX-TABLE-3. DTSBS412 +00915 DTSBS412 +00916 I3200-EXIT. DTSBS412 +00917 EXIT. DTSBS412 +00918 DTSBS412 +00919 I3210-WAGE-BASE. DTSBS412 +00920 EVALUATE TRUE DTSBS412 +00921 WHEN FCYR-YR = WRK-RATE-YRQ-1-CCYY DTSBS412 +00922 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-1 DTSBS412 +00923 DTSBS412 +00924 WHEN FCYR-YR = WRK-RATE-YRQ-2-CCYY DTSBS412 +00925 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-2 DTSBS412 +00926 DTSBS412 +00927 WHEN FCYR-YR = WRK-RATE-YRQ-3-CCYY DTSBS412 +00928 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-3 DTSBS412 +00929 DTSBS412 +00930 END-EVALUATE. DTSBS412 +00931 DTSBS412 +00932 I3210-EXIT. DTSBS412 +00933 EXIT. DTSBS412 +00934 DTSBS412 +00935 I3220-RATES. DTSBS412 +00936 EVALUATE TRUE DTSBS412 +00937 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-1 DTSBS412 +00938 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-1 DTSBS412 +00939 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-1 DTSBS412 +00940 DTSBS412 +00941 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-2 DTSBS412 +00942 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-2 DTSBS412 +00943 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-2 DTSBS412 +00944 DTSBS412 +00945 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-3 DTSBS412 +00946 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-3 DTSBS412 +00947 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-3 DTSBS412 +00948 DTSBS412 +00949 END-EVALUATE. DTSBS412 +00950 DTSBS412 +00951 I3220-EXIT. DTSBS412 +00952 EXIT. DTSBS412 +00953 DTSBS412 +00954 I3300-BUILD-X100. DTSBS412 +00955 MOVE WRK-RATE-YRQ-1-CCYY TO X100-RATE-YEAR. DTSBS412 +00956 MOVE WRK-NEW-EMP-RATE-1 TO X100-NEW-EMP-RATE. DTSBS412 +00957 MOVE WRK-TAX-TABLE-1 TO X100-TAX-TABLE. DTSBS412 +00958 MOVE WRK-TAX-WAGE-BASE-1 TO X100-TAX-WAGE-BASE. DTSBS412 +00959 DTSBS412 +00960 WRITE X100-REC FROM WRK-X100-REC. DTSBS412 +00961 IF NOT X100-STATUS-OK-88 DTSBS412 +00962 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSBS412 +00963 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00964 END-IF. DTSBS412 +00965 DTSBS412 +00966 MOVE WRK-RATE-YRQ-2-CCYY TO X100-RATE-YEAR. DTSBS412 +00967 MOVE WRK-NEW-EMP-RATE-2 TO X100-NEW-EMP-RATE. DTSBS412 +00968 MOVE WRK-TAX-TABLE-2 TO X100-TAX-TABLE. DTSBS412 +00969 MOVE WRK-TAX-WAGE-BASE-2 TO X100-TAX-WAGE-BASE. DTSBS412 +00970 DTSBS412 +00971 WRITE X100-REC FROM WRK-X100-REC. DTSBS412 +00972 IF NOT X100-STATUS-OK-88 DTSBS412 +00973 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSBS412 +00974 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00975 END-IF. DTSBS412 +00976 DTSBS412 +00977 MOVE WRK-RATE-YRQ-3-CCYY TO X100-RATE-YEAR. DTSBS412 +00978 MOVE WRK-NEW-EMP-RATE-3 TO X100-NEW-EMP-RATE. DTSBS412 +00979 MOVE WRK-TAX-TABLE-3 TO X100-TAX-TABLE. DTSBS412 +00980 MOVE WRK-TAX-WAGE-BASE-3 TO X100-TAX-WAGE-BASE. DTSBS412 +00981 DTSBS412 +00982 WRITE X100-REC FROM WRK-X100-REC. DTSBS412 +00983 IF NOT X100-STATUS-OK-88 DTSBS412 +00984 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSBS412 +00985 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +00986 END-IF. DTSBS412 +00987 DTSBS412 +00988 I3300-EXIT. DTSBS412 +00989 EXIT. DTSBS412 +00990 DTSBS412 +00991 DTSBS412 +00992 P0000-PROCESS. DTSBS412 +00993 PERFORM S1010-READ-SENT-MINI THRU S1010-EXIT. CL119 +00994 CL119 +00995 IF SENT-MINI-STATUS-EOF-88 CL119 +00996 DISPLAY 'SENT MINI FILE IS EMPTY' CL119 +00997 GO TO P0000-EXIT CL119 +00998 END-IF. CL119 +00999 CL119 +01000 DTSBS412 +01001 PERFORM UNTIL SENT-MINI-STATUS-EOF-88 CL119 +01002 OR WRK-ERROR-YES-88 CL119 +01003 CL119 +01004 MOVE LOW-VALUES TO MSKL-KEY-AREA CL123 +01005 MOVE WS-SENT-EMP-NO TO MSKL-EMP-NO CL123 +01006 SET MSKL-PRF-88 TO TRUE CL123 +01007 CL120 +01008 PERFORM S910B-READ THRU S910B-EXIT CL123 +01009 CL119 +01010 IF L910-NO-REC-88 CL141 +01011 DISPLAY 'EMP NO NOT IN USE ' MSKL-EMP-NO CL119 +01012 PERFORM S999-ABEND THRU S999-EXIT CL126 +01013 END-IF CL126 +01014 CL126 +01015 PERFORM P1000-PROCESS-EMP THRU P1000-EXIT DTSBS412 +01016 PERFORM S1010-READ-SENT-MINI THRU S1010-EXIT CL122 +01017 CL119 +01018 END-PERFORM. DTSBS412 +01019 DTSBS412 +01020 P0000-EXIT. DTSBS412 +01021 EXIT. DTSBS412 +01022 DTSBS412 +01023 P1000-PROCESS-EMP. DTSBS412 +01024 MOVE MSKL-REC TO MPRF-REC. DTSBS412 +01025 DISPLAY ' MPRF-EMP-NO' MPRF-EMP-NO CL132 +01026 PERFORM P1005-INITIALIZE-EMP THRU P1005-EXIT. DTSBS412 +01027 DTSBS412 +01028 IF MPRF-CLASS-SUB-88 DTSBS412 +01029 PERFORM P1100-SELECT-EMP THRU P1100-EXIT DTSBS412 +01030 DISPLAY 'NANCY ' CL113 +01031 PERFORM P2000-PROFILE THRU P2000-EXIT DTSBS412 +01032 PERFORM P2100-NAMES THRU P2100-EXIT DTSBS412 +01033 PERFORM P2300-EMP-ADDR THRU P2300-EXIT DTSBS412 +01034 PERFORM P3600-REPORT THRU P3600-EXIT DTSBS412 +01035 PERFORM P3700-QTRS-DUE THRU P3700-EXIT DTSBS412 +01036 PERFORM P3800-PAYMENT THRU P3800-EXIT DTSBS412 +01037 PERFORM P3000-REL THRU P3000-EXIT CL**2 +01038 PERFORM P3200-DETERM THRU P3200-EXIT CL**2 +01039 PERFORM P2500-OPO THRU P2500-EXIT CL**2 +01040 PERFORM P3400-RATE THRU P3400-EXIT CL**2 +01041 END-IF. DTSBS412 +01042 DTSBS412 +01043 IF TEMP-CNT > ZERO DTSBS412 +01044 CLOSE EMPLOYER-TEMP DTSBS412 +01045 PERFORM P1010-WRITE-OUTPUT THRU P1010-EXIT DTSBS412 +01046 OPEN OUTPUT EMPLOYER-TEMP DTSBS412 +01047 IF NOT TEMP-STATUS-OK-88 DTSBS412 +01048 DISPLAY 'P1000 OPEN ERROR ON TEMP FILE ' DTSBS412 +01049 TEMP-STATUS DTSBS412 +01050 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01051 GO TO P1000-EXIT DTSBS412 +01052 END-IF DTSBS412 +01053 END-IF. DTSBS412 +01054 DTSBS412 +01055 IF X142-EMP-NO > ZERO DTSBS412 +01056 WRITE X142-REC FROM WRK-X142-REC DTSBS412 +01057 IF X142-STATUS-OK-88 DTSBS412 +01058 ADD +1 TO X142-CNT DTSBS412 +01059 ELSE DTSBS412 +01060 DISPLAY 'CANNOT WRITE X142 ' MPRF-EMP-NO DTSBS412 +01061 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01062 END-IF DTSBS412 +01063 END-IF. DTSBS412 +01064 DTSBS412 +01065 P1000-EXIT. DTSBS412 +01066 EXIT. DTSBS412 +01067 DTSBS412 +01068 P1005-INITIALIZE-EMP. DTSBS412 +01069 MOVE ZERO TO TEMP-CNT DTSBS412 +01070 WRK-LAST-LIAB-YRQ DTSBS412 +01071 WRK-INACT-DATE DTSBS412 +01072 WRK-INACT-ENTR-DATE. DTSBS412 +01073 DTSBS412 +01074 SET WRK-SELECT-EMP-ALL-88 TO TRUE. DTSBS412 +01075 DTSBS412 +01076 MOVE ZERO TO X142-EMP-NO DTSBS412 +01077 X142-PAY-DATE DTSBS412 +01078 X142-PAY-AMT. DTSBS412 +01079 MOVE SPACES TO X142-RPT-TYPE DTSBS412 +01080 X142-REPORT-QTR DTSBS412 +01081 X142-REPORT-YEAR. DTSBS412 +01082 DTSBS412 +01083 MOVE +0 TO PAY-LAST DTSBS412 +01084 MAX-PAY-DATE DTSBS412 +01085 MAX-PAY-BATCH DTSBS412 +01086 MAX-PAY-ITEM DTSBS412 +01087 MAX-PAY-AMT. DTSBS412 +01088 DTSBS412 +01089 PERFORM DTSBS412 +01090 VARYING PSUB FROM +1 BY +1 DTSBS412 +01091 UNTIL PSUB > PAY-MAX DTSBS412 +01092 MOVE +0 TO PAY-BATCH (PSUB) DTSBS412 +01093 PAY-ITEM (PSUB) DTSBS412 +01094 PAY-RCVD-DATE (PSUB) DTSBS412 +01095 PAY-PROCESS-DATE (PSUB) DTSBS412 +01096 PAY-ORIG-AMT (PSUB) DTSBS412 +01097 PAY-ADJ-AMT (PSUB) DTSBS412 +01098 END-PERFORM. DTSBS412 +01099 DTSBS412 +01100 MOVE +0 TO MAX-RPT-DATE DTSBS412 +01101 MAX-RPT-YRQ. DTSBS412 +01102 MOVE SPACES TO MAX-RPT-TYPE. DTSBS412 +01103 PERFORM DTSBS412 +01104 VARYING RSUB FROM +1 BY +1 DTSBS412 +01105 UNTIL RSUB > RPT-MAX DTSBS412 +01106 MOVE +0 TO RPT-YRQ (RSUB) DTSBS412 +01107 RPT-TYPE (RSUB) DTSBS412 +01108 RPT-RCVD-DATE (RSUB) DTSBS412 +01109 RPT-PROCESS-DATE (RSUB) DTSBS412 +01110 END-PERFORM. DTSBS412 +01111 DTSBS412 +01112 P1005-EXIT. DTSBS412 +01113 EXIT. DTSBS412 +01114 DTSBS412 +01115 P1010-WRITE-OUTPUT. DTSBS412 +01116 OPEN INPUT EMPLOYER-TEMP. DTSBS412 +01117 IF TEMP-STATUS-OK-88 DTSBS412 +01118 NEXT SENTENCE DTSBS412 +01119 ELSE DTSBS412 +01120 DISPLAY 'P1010 OPEN ERROR ON TEMP FILE ' DTSBS412 +01121 TEMP-STATUS DTSBS412 +01122 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01123 GO TO P1010-EXIT DTSBS412 +01124 END-IF. DTSBS412 +01125 DTSBS412 +01126 READ EMPLOYER-TEMP. DTSBS412 +01127 PERFORM DTSBS412 +01128 UNTIL TEMP-STATUS-EOF-88 DTSBS412 +01129 EVALUATE TRUE DTSBS412 +01130 WHEN TEMP-REC-TYPE = '102' DTSBS412 +01131 PERFORM P1010A-WRITE-102 THRU P1010A-EXIT DTSBS412 +01132 DTSBS412 +01133 WHEN TEMP-REC-TYPE = '104' CL**2 +01134 PERFORM P1010B-WRITE-104 THRU P1010B-EXIT CL**2 +01135 DTSBS412 +01136 WHEN TEMP-REC-TYPE = '106' DTSBS412 +01137 PERFORM P1010C-WRITE-106 THRU P1010C-EXIT DTSBS412 +01138 DTSBS412 +01139 WHEN TEMP-REC-TYPE = '108' CL**2 +01140 PERFORM P1010D-WRITE-108 THRU P1010D-EXIT CL**2 +01141 DTSBS412 +01142 WHEN TEMP-REC-TYPE = '110' DTSBS412 +01143 PERFORM P1010E-WRITE-110 THRU P1010E-EXIT DTSBS412 +01144 DTSBS412 +01145 WHEN TEMP-REC-TYPE = '120' CL**2 +01146 PERFORM P1010F-WRITE-120 THRU P1010F-EXIT CL**2 +01147 DTSBS412 +01148 WHEN TEMP-REC-TYPE = '140' CL**2 +01149 PERFORM P1010H-WRITE-140 THRU P1010H-EXIT CL**2 +01150 DTSBS412 +01151 WHEN TEMP-REC-TYPE = '141' DTSBS412 +01152 PERFORM P1010I-WRITE-141 THRU P1010I-EXIT DTSBS412 +01153 DTSBS412 +01154 WHEN TEMP-REC-TYPE = '131' DTSBS412 +01155 PERFORM P1010J-WRITE-131 THRU P1010J-EXIT DTSBS412 +01156 DTSBS412 +01157 WHEN TEMP-REC-TYPE = '142' CL**2 +01158 PERFORM P1010K-WRITE-142 THRU P1010K-EXIT CL**2 +01159 DTSBS412 +01160 END-EVALUATE DTSBS412 +01161 READ EMPLOYER-TEMP DTSBS412 +01162 END-PERFORM. DTSBS412 +01163 DTSBS412 +01164 CLOSE EMPLOYER-TEMP. DTSBS412 +01165 DTSBS412 +01166 P1010-EXIT. DTSBS412 +01167 EXIT. DTSBS412 +01168 DTSBS412 +01169 P1010A-WRITE-102. DTSBS412 +01170 MOVE LENGTH OF WRK-X102-REC TO WRK-LEN. DTSBS412 +01171 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X102-REC. DTSBS412 +01172 WRITE X102-REC. DTSBS412 +01173 IF X102-STATUS-OK-88 DTSBS412 +01174 ADD +1 TO X102-CNT DTSBS412 +01175 ELSE DTSBS412 +01176 DISPLAY 'CANNOT WRITE X102 ' MPRF-EMP-NO DTSBS412 +01177 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01178 END-IF. DTSBS412 +01179 DTSBS412 +01180 P1010A-EXIT. DTSBS412 +01181 EXIT. DTSBS412 +01182 DTSBS412 +01183 P1010B-WRITE-104. CL**2 +01184 MOVE LENGTH OF WRK-X104-REC TO WRK-LEN. CL**2 +01185 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X104-REC. CL**2 +01186 WRITE X104-REC. CL**2 +01187 IF X104-STATUS-OK-88 CL**2 +01188 ADD +1 TO X104-CNT CL**2 +01189 ELSE CL**2 +01190 DISPLAY 'CANNOT WRITE X104 ' MPRF-EMP-NO CL**2 +01191 SET WRK-ERROR-YES-88 TO TRUE CL**2 +01192 END-IF. CL**2 +01193 CL**2 +01194 P1010B-EXIT. CL**2 +01195 EXIT. CL**2 +01196 DTSBS412 +01197 P1010C-WRITE-106. DTSBS412 +01198 MOVE LENGTH OF WRK-X106-REC TO WRK-LEN. DTSBS412 +01199 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X106-REC. DTSBS412 +01200 WRITE X106-REC. DTSBS412 +01201 IF X106-STATUS-OK-88 DTSBS412 +01202 ADD +1 TO X106-CNT DTSBS412 +01203 ELSE DTSBS412 +01204 DISPLAY 'CANNOT WRITE X106 ' MPRF-EMP-NO DTSBS412 +01205 SET WRK-ERROR-YES-88 TO TRUE CL106 +01206 END-IF. DTSBS412 +01207 DTSBS412 +01208 P1010C-EXIT. DTSBS412 +01209 EXIT. DTSBS412 +01210 DTSBS412 +01211 P1010D-WRITE-108. CL**2 +01212 MOVE LENGTH OF WRK-X108-REC TO WRK-LEN. CL**2 +01213 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X108-REC. CL**2 +01214 WRITE X108-REC. CL**2 +01215 IF X108-STATUS-OK-88 CL**2 +01216 ADD +1 TO X108-CNT CL**2 +01217 ELSE CL**2 +01218 DISPLAY 'CANNOT WRITE X108 ' MPRF-EMP-NO CL**2 +01219 SET WRK-ERROR-YES-88 TO TRUE CL**2 +01220 END-IF. CL**2 +01221 CL**2 +01222 P1010D-EXIT. CL**2 +01223 EXIT. CL**2 +01224 DTSBS412 +01225 P1010E-WRITE-110. DTSBS412 +01226 MOVE LENGTH OF WRK-X110-REC TO WRK-LEN. DTSBS412 +01227 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X110-REC. DTSBS412 +01228 WRITE X110-REC. DTSBS412 +01229 IF X110-STATUS-OK-88 DTSBS412 +01230 ADD +1 TO X110-CNT DTSBS412 +01231 ELSE DTSBS412 +01232 DISPLAY X110-STATUS CL*91 +01233 DISPLAY X110-REC CL*91 +01234 DISPLAY 'CANNOT WRITE X110 ' MPRF-EMP-NO DTSBS412 +01235 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01236 END-IF. DTSBS412 +01237 DTSBS412 +01238 P1010E-EXIT. DTSBS412 +01239 EXIT. DTSBS412 +01240 DTSBS412 +01241 P1010F-WRITE-120. CL**2 +01242 MOVE LENGTH OF WRK-X120-REC TO WRK-LEN. CL**2 +01243 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X120-REC. CL**2 +01244 WRITE X120-REC. CL**2 +01245 IF X120-STATUS-OK-88 CL**2 +01246 ADD +1 TO X120-CNT CL**2 +01247 ELSE CL**2 +01248 DISPLAY 'CANNOT WRITE X120 ' MPRF-EMP-NO CL**2 +01249 DISPLAY X120-STATUS CL*92 +01250 SET WRK-ERROR-YES-88 TO TRUE CL**2 +01251 END-IF. CL**2 +01252 CL**2 +01253 P1010F-EXIT. CL**2 +01254 EXIT. CL**2 +01255 DTSBS412 +01256 P1010H-WRITE-140. CL**2 +01257 MOVE LENGTH OF WRK-X140-REC TO WRK-LEN. CL**2 +01258 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X140-REC. CL**2 +01259 WRITE X140-REC. CL**2 +01260 IF X140-STATUS-OK-88 CL**2 +01261 ADD +1 TO X140-CNT CL**2 +01262 ELSE CL**2 +01263 DISPLAY 'CANNOT WRITE X140 ' MPRF-EMP-NO CL**2 +01264 SET WRK-ERROR-YES-88 TO TRUE CL**2 +01265 END-IF. CL**2 +01266 CL**2 +01267 P1010H-EXIT. CL**2 +01268 EXIT. CL**2 +01269 DTSBS412 +01270 P1010I-WRITE-141. DTSBS412 +01271 MOVE LENGTH OF WRK-X141-REC TO WRK-LEN. DTSBS412 +01272 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X141-REC. DTSBS412 +01273 WRITE X141-REC. DTSBS412 +01274 IF X141-STATUS-OK-88 DTSBS412 +01275 ADD +1 TO X141-CNT DTSBS412 +01276 ELSE DTSBS412 +01277 DISPLAY 'CANNOT WRITE X141 ' MPRF-EMP-NO DTSBS412 +01278 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01279 END-IF. DTSBS412 +01280 DTSBS412 +01281 P1010I-EXIT. DTSBS412 +01282 EXIT. DTSBS412 +01283 DTSBS412 +01284 P1010J-WRITE-131. DTSBS412 +01285 MOVE LENGTH OF WRK-X131-REC TO WRK-LEN. DTSBS412 +01286 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X131-REC. DTSBS412 +01287 WRITE X131-REC. DTSBS412 +01288 IF X131-STATUS-OK-88 DTSBS412 +01289 ADD +1 TO X131-CNT DTSBS412 +01290 ELSE DTSBS412 +01291 DISPLAY 'CANNOT WRITE X131 ' MPRF-EMP-NO DTSBS412 +01292 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01293 END-IF. DTSBS412 +01294 DTSBS412 +01295 P1010J-EXIT. DTSBS412 +01296 EXIT. DTSBS412 +01297 DTSBS412 +01298 P1010K-WRITE-142. CL**2 +01299 MOVE LENGTH OF WRK-X142-REC TO WRK-LEN. CL**2 +01300 MOVE EMPLOYER-TEMP-REC (1:WRK-LEN) TO X142-REC. CL**2 +01301 WRITE X142-REC. CL**2 +01302 IF X142-STATUS-OK-88 CL**2 +01303 ADD +1 TO X142-CNT CL**2 +01304 ELSE CL**2 +01305 DISPLAY 'CANNOT WRITE X142 ' MPRF-EMP-NO CL**2 +01306 SET WRK-ERROR-YES-88 TO TRUE CL**2 +01307 END-IF. CL**2 +01308 CL**2 +01309 P1010K-EXIT. CL**2 +01310 EXIT. CL**2 +01311 DTSBS412 +01312 P1100-SELECT-EMP. DTSBS412 +01313 CL*97 +01314 IF MPRF-SUSPEND-COLL-YES-88 DTSBS412 +01315 OR MPRF-WRITE-OFF-DATE > ZERO DTSBS412 +01316 SET WRK-SELECT-EMP-NO-88 TO TRUE DTSBS412 +01317 GO TO P1100-EXIT DTSBS412 +01318 END-IF. DTSBS412 +01319 DTSBS412 +01320 IF MPRF-STATUS-ACT-88 CL109 +01321 SET WRK-SELECT-EMP-NO-88 TO TRUE CL110 +01322 GO TO P1100-EXIT CL109 +01323 END-IF. CL109 +01324 CL*27 +01325 CL*27 +01326 CL*27 +01327 IF MPRF-STATUS-INACT-88 DTSBS412 +01328 SET WRK-SELECT-EMP-ALL-88 TO TRUE DTSBS412 +01329 END-IF. DTSBS412 +01330 DTSBS412 +01331 IF (MPRF-STATUS-NEVERSUB-88 CL*33 +01332 OR MPRF-STATUS-UNK-88) CL*33 +01333 AND MPRF-FEIN > ZERO CL*33 +01334 PERFORM P1120-NOT-SUBJECT THRU P1120-EXIT CL*33 +01335 IF WRK-SUBJ-EMP-NO-88 CL*33 +01336 SET WRK-SELECT-EMP-NO-88 TO TRUE CL*35 +01337 END-IF CL*33 +01338 END-IF. CL*33 +01339 DTSBS412 +01340 P1100-EXIT. DTSBS412 +01341 EXIT. DTSBS412 +01342 DTSBS412 +01343 P1110-INACT-DATES. DTSBS412 +01344 MOVE LOW-VALUES TO MSOL-REC. DTSBS412 +01345 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBS412 +01346 SET MSOL-SOL-88 TO TRUE. DTSBS412 +01347 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01348 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +01349 DTSBS412 +01350 PERFORM UNTIL L910-NO-REC-88 DTSBS412 +01351 MOVE MSKL-REC TO MSOL-REC DTSBS412 +01352 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBS412 +01353 IF MSOL-INACT-INACTIVE-88 DTSBS412 +01354 IF MSOL-LAST-LIAB-YRQ > WRK-LAST-LIAB-YRQ DTSBS412 +01355 MOVE MSOL-LAST-LIAB-YRQ TO DTSBS412 +01356 WRK-LAST-LIAB-YRQ DTSBS412 +01357 MOVE MSOL-INACT-DATE TO WRK-INACT-DATE DTSBS412 +01358 MOVE MSOL-INACT-ENTER-DATE TO DTSBS412 +01359 WRK-INACT-ENTR-DATE DTSBS412 +01360 END-IF DTSBS412 +01361 END-IF DTSBS412 +01362 END-IF DTSBS412 +01363 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS412 +01364 END-PERFORM. DTSBS412 +01365 DTSBS412 +01366 P1110-EXIT. DTSBS412 +01367 EXIT. DTSBS412 +01368 DTSBS412 +01369 P1120-NOT-SUBJECT. DTSBS412 +01370 MOVE MPRF-EMP-NO TO WRK-HOLD-EMP-NO. DTSBS412 +01371 SET WRK-SUBJ-EMP-NO-88 TO TRUE. DTSBS412 +01372 DTSBS412 +01373 MOVE LOW-VALUE TO IEIN-KEY-AREA. DTSBS412 +01374 SET IEIN-EIN-88 TO TRUE DTSBS412 +01375 MOVE MPRF-FEIN TO IEIN-FEIN DTSBS412 +01376 MOVE +0 TO IEIN-EMP-NO DTSBS412 +01377 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBS412 +01378 PERFORM S921C-START-BROWSE THRU S921C-EXIT DTSBS412 +01379 MOVE ISKL-REC TO IEIN-REC DTSBS412 +01380 PERFORM DTSBS412 +01381 UNTIL L921-NO-REC-88 DTSBS412 +01382 OR WRK-SUBJ-EMP-YES-88 DTSBS412 +01383 IF IEIN-FEIN = MPRF-FEIN DTSBS412 +01384 PERFORM P1121-FIND-MPRF THRU P1121-EXIT DTSBS412 +01385 IF WRK-SUBJ-EMP-NO-88 DTSBS412 +01386 PERFORM S921D-READ-NEXT THRU S921D-EXIT DTSBS412 +01387 MOVE ISKL-REC TO IEIN-REC DTSBS412 +01388 END-IF DTSBS412 +01389 ELSE DTSBS412 +01390 SET L921-NO-REC-88 TO TRUE DTSBS412 +01391 END-IF DTSBS412 +01392 END-PERFORM. DTSBS412 +01393 DTSBS412 +01394 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBS412 +01395 MOVE WRK-HOLD-EMP-NO TO MSKL-EMP-NO. DTSBS412 +01396 SET MSKL-PRF-88 TO TRUE. DTSBS412 +01397 DTSBS412 +01398 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +01399 DTSBS412 +01400 P1120-EXIT. DTSBS412 +01401 EXIT. DTSBS412 +01402 DTSBS412 +01403 P1121-FIND-MPRF. DTSBS412 +01404 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBS412 +01405 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBS412 +01406 SET MSKL-PRF-88 TO TRUE. DTSBS412 +01407 DTSBS412 +01408 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +01409 IF L910-OK-88 DTSBS412 +01410 MOVE MSKL-REC TO MPRF-REC DTSBS412 +01411 IF MPRF-STATUS-SUB-88 DTSBS412 +01412 SET WRK-SUBJ-EMP-YES-88 TO TRUE DTSBS412 +01413 END-IF DTSBS412 +01414 END-IF. DTSBS412 +01415 DTSBS412 +01416 P1121-EXIT. DTSBS412 +01417 EXIT. DTSBS412 +01418 DTSBS412 +01419 DTSBS412 +01420 P2000-PROFILE. DTSBS412 +01421 PERFORM P2010-MERA THRU P2010-EXIT. DTSBS412 +01422 DTSBS412 +01423 MOVE MPRF-EMP-NO TO X102-EMP-NO. DTSBS412 +01424 MOVE MPRF-FEIN TO X102-EMP-FEIN. DTSBS412 +01425 MOVE MPRF-EMP-CLASS TO X102-EMP-CLASS. DTSBS412 +01426 MOVE MPRF-EMP-STATUS TO X102-EMP-STATUS. DTSBS412 +01427 MOVE WRK-SOURCE-CD TO X102-SOURCE-CD. DTSBS412 +01428 SET X102-ACTION-INSERT-88 TO TRUE. DTSBS412 +01429 DTSBS412 +01430 WRITE EMPLOYER-TEMP-REC FROM WRK-X102-REC. DTSBS412 +01431 IF TEMP-STATUS-OK-88 DTSBS412 +01432 ADD +1 TO TEMP-CNT DTSBS412 +01433 ELSE DTSBS412 +01434 DISPLAY 'CANNOT WRITE X102 TEMP ' MPRF-EMP-NO DTSBS412 +01435 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01436 END-IF. DTSBS412 +01437 DTSBS412 +01438 P2000-EXIT. DTSBS412 +01439 EXIT. DTSBS412 +01440 DTSBS412 +01441 P2010-MERA. DTSBS412 +01442 MOVE LOW-VALUES TO MERA-REC. DTSBS412 +01443 MOVE MPRF-EMP-NO TO MERA-EMP-NO. DTSBS412 +01444 SET MERA-ERA-88 TO TRUE. DTSBS412 +01445 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01446 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +01447 IF L910-OK-88 DTSBS412 +01448 MOVE MSKL-REC TO MERA-REC DTSBS412 +01449 IF MERA-SOURCE-OTH-88 DTSBS412 +01450 OR MERA-SOURCE-UNK-88 DTSBS412 +01451 OR MERA-SOURCE-CD = LOW-VALUES DTSBS412 +01452 OR MERA-SOURCE-CD = SPACES DTSBS412 +01453 MOVE '03' TO MERA-SOURCE-CD DTSBS412 +01454 END-IF DTSBS412 +01455 MOVE MERA-SOURCE-CD TO WRK-SOURCE-CD DTSBS412 +01456 ELSE DTSBS412 +01457 MOVE '03' TO WRK-SOURCE-CD DTSBS412 +01458 END-IF. DTSBS412 +01459 DTSBS412 +01460 P2010-EXIT. DTSBS412 +01461 EXIT. DTSBS412 +01462 DTSBS412 +01463 P2100-NAMES. DTSBS412 +01464 IF MPRF-ENTITY-NAME > SPACES CL137 +01465 SET X106-NAME-TYPE-ENTITY-88 TO TRUE DTSBS412 +01466 MOVE MPRF-ENTITY-NAME TO X106-EMP-NAME DTSBS412 +01467 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSBS412 +01468 ELSE CL*63 +01469 SET X106-NAME-TYPE-TRADE-88 TO TRUE CL*63 +01470 MOVE MPRF-PRIMARY-NAME TO X106-EMP-NAME CL*63 +01471 PERFORM P2190-WRITE-X106 THRU P2190-EXIT CL*63 +01472 END-IF. DTSBS412 +01473 DTSBS412 +01474 P2100-EXIT. DTSBS412 +01475 EXIT. DTSBS412 +01476 DTSBS412 +01477 P2110-ALT-NAMES. DTSBS412 +01478 MOVE LOW-VALUES TO MTAA-REC. DTSBS412 +01479 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBS412 +01480 SET MTAA-TAA-88 TO TRUE. DTSBS412 +01481 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01482 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +01483 PERFORM DTSBS412 +01484 UNTIL L910-NO-REC-88 DTSBS412 +01485 MOVE MSKL-REC TO MTAA-REC DTSBS412 +01486 IF MTAA-NAME > SPACES DTSBS412 +01487 SET X106-NAME-TYPE-TRADE-88 TO TRUE DTSBS412 +01488 MOVE MTAA-NAME TO X106-EMP-NAME DTSBS412 +01489 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSBS412 +01490 END-IF DTSBS412 +01491 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS412 +01492 END-PERFORM. DTSBS412 +01493 DTSBS412 +01494 P2110-EXIT. DTSBS412 +01495 EXIT. DTSBS412 +01496 DTSBS412 +01497 P2190-WRITE-X106. DTSBS412 +01498 MOVE MPRF-EMP-NO TO X106-EMP-NO. DTSBS412 +01499 INSPECT X106-EMP-NAME REPLACING ALL ',' BY SPACE. DTSBS412 +01500 DTSBS412 +01501 WRITE EMPLOYER-TEMP-REC FROM WRK-X106-REC. DTSBS412 +01502 IF TEMP-STATUS-OK-88 DTSBS412 +01503 ADD +1 TO TEMP-CNT DTSBS412 +01504 ELSE DTSBS412 +01505 DISPLAY 'CANNOT WRITE TEMP X106 ' MPRF-EMP-NO DTSBS412 +01506 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01507 END-IF. DTSBS412 +01508 DTSBS412 +01509 P2190-EXIT. DTSBS412 +01510 EXIT. DTSBS412 +01511 DTSBS412 +01512 P2300-EMP-ADDR. DTSBS412 +01513 PERFORM P2310-MTAD THRU P2310-EXIT. DTSBS412 +01514 P2300-EXIT. DTSBS412 +01515 EXIT. DTSBS412 +01516 DTSBS412 +01517 P2310-MTAD. DTSBS412 +01518 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBS412 +01519 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBS412 +01520 SET MTAD-TAD-88 TO TRUE. DTSBS412 +01521 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBS412 +01522 DTSBS412 +01523 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01524 DTSBS412 +01525 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +01526 DTSBS412 +01527 IF L910-NO-REC-88 DTSBS412 +01528 GO TO P2310-EXIT DTSBS412 +01529 ELSE DTSBS412 +01530 MOVE MSKL-REC TO MTAD-REC DTSBS412 +01531 MOVE MTAD-ADDRESS TO WRK-ADDRESS DTSBS412 +01532 SET X110-ADDR-TYPE-MAIL-88 TO TRUE DTSBS412 +01533 MOVE MTAD-VOICE-1 TO WRK-PHONE DTSBS412 +01534 MOVE MTAD-FAX TO WRK-FAX DTSBS412 +01535 MOVE MTAD-EMAIL-ADDRESS TO WRK-EMAIL DTSBS412 +01536 PERFORM P2390-WRITE-X110 THRU P2390-EXIT DTSBS412 +01537 END-IF. DTSBS412 +01538 DTSBS412 +01539 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. CL*56 +01540 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. CL*56 +01541 CL*56 +01542 PERFORM S910B-READ THRU S910B-EXIT. CL*56 +01543 CL*56 +01544 IF L910-NO-REC-88 CL*56 +01545 GO TO P2310-EXIT CL*56 +01546 ELSE CL*56 +01547 MOVE MSKL-REC TO MTAD-REC CL*56 +01548 MOVE MTAD-ADDRESS TO WRK-ADDRESS CL*56 +01549 SET X110-ADDR-TYPE-RECS-88 TO TRUE CL*56 +01550 MOVE MTAD-VOICE-1 TO WRK-PHONE CL*56 +01551 MOVE MTAD-FAX TO WRK-FAX CL*56 +01552 MOVE MTAD-EMAIL-ADDRESS TO WRK-EMAIL CL*56 +01553 PERFORM P2390-WRITE-X110 THRU P2390-EXIT CL*56 +01554 END-IF. CL*56 +01555 DTSBS412 +01556 P2310-EXIT. DTSBS412 +01557 EXIT. DTSBS412 +01558 DTSBS412 +01559 DTSBS412 +01560 P2390-WRITE-X110. DTSBS412 +01561 MOVE MPRF-EMP-NO TO X110-EMP-NO. DTSBS412 +01562 MOVE WRK-ATTN-LINE TO X110-ATTENTION. DTSBS412 +01563 MOVE WRK-DELIV-LINE-1 TO X110-STREET-1. DTSBS412 +01564 MOVE WRK-DELIV-LINE-2 TO X110-STREET-2. DTSBS412 +01565 MOVE WRK-CITY TO X110-CITY. DTSBS412 +01566 MOVE WRK-ST TO X110-STATE. DTSBS412 +01567 MOVE WRK-ZIP TO X110-ZIP. DTSBS412 +01568 MOVE WRK-PHONE TO X110-PHONE. DTSBS412 +01569 MOVE WRK-FAX TO X110-FAX. DTSBS412 +01570 IF WRK-EMAIL = LOW-VALUES DTSBS412 +01571 MOVE SPACES TO X110-EMAIL DTSBS412 +01572 ELSE DTSBS412 +01573 MOVE WRK-EMAIL TO X110-EMAIL DTSBS412 +01574 END-IF. DTSBS412 +01575 DTSBS412 +01576 INSPECT X110-ATTENTION REPLACING ALL ',' BY SPACE. DTSBS412 +01577 INSPECT X110-STREET-1 REPLACING ALL ',' BY SPACE. DTSBS412 +01578 INSPECT X110-STREET-2 REPLACING ALL ',' BY SPACE. DTSBS412 +01579 INSPECT X110-EMAIL REPLACING ALL ',' BY SPACE. DTSBS412 +01580 DTSBS412 +01581 WRITE EMPLOYER-TEMP-REC FROM WRK-X110-REC DTSBS412 +01582 IF TEMP-STATUS-OK-88 DTSBS412 +01583 ADD +1 TO TEMP-CNT DTSBS412 +01584 ELSE DTSBS412 +01585 DISPLAY 'CANNOT WRITE TEMP X110 ' MPRF-EMP-NO DTSBS412 +01586 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01587 END-IF. DTSBS412 +01588 DTSBS412 +01589 P2390-EXIT. DTSBS412 +01590 EXIT. DTSBS412 +01591 DTSBS412 +01592 P2500-OPO. DTSBS412 +01593 IF MSOL-LIAB-RATED-DOMESTIC-88 DTSBS412 +01594 GO TO P2500-EXIT DTSBS412 +01595 END-IF. DTSBS412 +01596 DTSBS412 +01597 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBS412 +01598 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBS412 +01599 SET MOPO-OPO-88 TO TRUE. DTSBS412 +01600 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01601 DTSBS412 +01602 SET WRK-MOPO-FOUND-NO-88 TO TRUE. DTSBS412 +01603 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +01604 IF L910-NO-REC-88 DTSBS412 +01605 NEXT SENTENCE DTSBS412 +01606 ELSE DTSBS412 +01607 PERFORM DTSBS412 +01608 UNTIL L910-NO-REC-88 DTSBS412 +01609 MOVE MSKL-REC TO MOPO-REC DTSBS412 +01610 PERFORM P2510-PARSE-NAME THRU P2510-EXIT DTSBS412 +01611 PERFORM P2590-WRITE-X120 THRU P2590-EXIT DTSBS412 +01612 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS412 +01613 END-PERFORM DTSBS412 +01614 END-IF. DTSBS412 +01615 DTSBS412 +01616 DTSBS412 +01617 P2500-EXIT. DTSBS412 +01618 EXIT. DTSBS412 +01619 DTSBS412 +01620 P2510-PARSE-NAME. DTSBS412 +01621 MOVE +0 TO FSUB DTSBS412 +01622 LSUB. DTSBS412 +01623 MOVE SPACES TO FIRST-NAME DTSBS412 +01624 MIDDLE-INIT DTSBS412 +01625 LAST-NAME. DTSBS412 +01626 SET FIRST-NAME-COMPLETE-NO-88 TO TRUE. DTSBS412 +01627 SET LAST-NAME-COMPLETE-NO-88 TO TRUE. DTSBS412 +01628 SET MID-INIT-COMPLETE-NO-88 TO TRUE. DTSBS412 +01629 DTSBS412 +01630 MOVE MOPO-NAME TO SLASH-NAME. DTSBS412 +01631 PERFORM DTSBS412 +01632 VARYING NSUB FROM +1 BY +1 DTSBS412 +01633 UNTIL NSUB > +40 DTSBS412 +01634 OR MID-INIT-COMPLETE-YES-88 DTSBS412 +01635 IF FIRST-NAME-COMPLETE-YES-88 DTSBS412 +01636 PERFORM P2513-MID-INIT THRU P2513-EXIT DTSBS412 +01637 ELSE DTSBS412 +01638 IF LAST-NAME-COMPLETE-YES-88 DTSBS412 +01639 PERFORM P2512-FIRST-NAME THRU P2512-EXIT DTSBS412 +01640 ELSE DTSBS412 +01641 PERFORM P2511-LAST-NAME THRU P2511-EXIT DTSBS412 +01642 END-IF DTSBS412 +01643 END-IF DTSBS412 +01644 END-PERFORM. DTSBS412 +01645 DTSBS412 +01646 DTSBS412 +01647 P2510-EXIT. DTSBS412 +01648 EXIT. DTSBS412 +01649 DTSBS412 +01650 P2511-LAST-NAME. DTSBS412 +01651 IF SLASH-NAME-CHAR (NSUB) = '/' DTSBS412 +01652 SET LAST-NAME-COMPLETE-YES-88 TO TRUE DTSBS412 +01653 GO TO P2511-EXIT DTSBS412 +01654 ELSE DTSBS412 +01655 IF LSUB < +40 DTSBS412 +01656 ADD +1 TO LSUB DTSBS412 +01657 MOVE SLASH-NAME-CHAR (NSUB) TO LAST-NAME (LSUB:1) DTSBS412 +01658 END-IF DTSBS412 +01659 END-IF. DTSBS412 +01660 DTSBS412 +01661 P2511-EXIT. DTSBS412 +01662 EXIT. DTSBS412 +01663 DTSBS412 +01664 P2512-FIRST-NAME. DTSBS412 +01665 IF SLASH-NAME-CHAR (NSUB) = SPACE DTSBS412 +01666 SET FIRST-NAME-COMPLETE-YES-88 TO TRUE DTSBS412 +01667 GO TO P2512-EXIT DTSBS412 +01668 ELSE DTSBS412 +01669 IF FSUB < +20 DTSBS412 +01670 ADD +1 TO FSUB DTSBS412 +01671 MOVE SLASH-NAME-CHAR (NSUB) TO FIRST-NAME (FSUB:1) DTSBS412 +01672 END-IF DTSBS412 +01673 END-IF. DTSBS412 +01674 DTSBS412 +01675 P2512-EXIT. DTSBS412 +01676 EXIT. DTSBS412 +01677 DTSBS412 +01678 P2513-MID-INIT. DTSBS412 +01679 IF MID-INIT-COMPLETE-NO-88 DTSBS412 +01680 MOVE SLASH-NAME-CHAR (NSUB) TO MIDDLE-INIT (1:1) DTSBS412 +01681 SET MID-INIT-COMPLETE-YES-88 TO TRUE DTSBS412 +01682 END-IF. DTSBS412 +01683 DTSBS412 +01684 P2513-EXIT. DTSBS412 +01685 EXIT. DTSBS412 +01686 DTSBS412 +01687 P2590-WRITE-X120. DTSBS412 +01688 IF LAST-NAME = SPACES DTSBS412 +01689 GO TO P2590-EXIT DTSBS412 +01690 END-IF. DTSBS412 +01691 DTSBS412 +01692 MOVE MPRF-EMP-NO TO X120-EMP-NO. DTSBS412 +01693 IF FIRST-NAME = SPACES DTSBS412 +01694 MOVE LAST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSBS412 +01695 MOVE LAST-NAME (21:1) TO X120-OPO-MID-INIT DTSBS412 +01696 MOVE LAST-NAME (22:19) TO X120-OPO-LAST-NAME DTSBS412 +01697 ELSE DTSBS412 +01698 MOVE FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSBS412 +01699 MOVE MIDDLE-INIT TO X120-OPO-MID-INIT DTSBS412 +01700 MOVE LAST-NAME (1:20) TO X120-OPO-LAST-NAME DTSBS412 +01701 END-IF. DTSBS412 +01702 MOVE SPACES TO X120-OPO-MEMBER-NAME. DTSBS412 +01703 MOVE MOPO-SSN TO X120-OPO-SSN. DTSBS412 +01704 MOVE MOPO-TITLE TO X120-OPO-TITLE. DTSBS412 +01705 MOVE MOPO-TYPE-IND TO X120-TYPE-IND. DTSBS412 +01706 IF MOPO-ATTN-LINE = LOW-VALUES DTSBS412 +01707 MOVE SPACES TO X120-OPO-ATTENTION DTSBS412 +01708 ELSE DTSBS412 +01709 MOVE MOPO-ATTN-LINE TO X120-OPO-ATTENTION DTSBS412 +01710 END-IF. DTSBS412 +01711 MOVE MOPO-DELIV-LINE-1 TO X120-OPO-STREET-1. DTSBS412 +01712 MOVE MOPO-DELIV-LINE-2 TO X120-OPO-STREET-2. DTSBS412 +01713 MOVE MOPO-CITY TO X120-OPO-CITY. DTSBS412 +01714 MOVE MOPO-ST TO X120-OPO-STATE. DTSBS412 +01715 MOVE MOPO-ZIP TO X120-OPO-ZIP. DTSBS412 +01716 MOVE MOPO-VOICE-1 TO X120-OPO-PHONE. DTSBS412 +01717 MOVE MOPO-FAX TO X120-OPO-FAX. DTSBS412 +01718 IF MOPO-EMAIL-ADDRESS = LOW-VALUES DTSBS412 +01719 MOVE SPACES TO X120-OPO-EMAIL DTSBS412 +01720 ELSE DTSBS412 +01721 MOVE MOPO-EMAIL-ADDRESS TO X120-OPO-EMAIL DTSBS412 +01722 END-IF. DTSBS412 +01723 DTSBS412 +01724 INSPECT X120-OPO-FIRST-NAME REPLACING ALL ',' BY SPACE. DTSBS412 +01725 INSPECT X120-OPO-MID-INIT REPLACING ALL ',' BY SPACE. DTSBS412 +01726 INSPECT X120-OPO-LAST-NAME REPLACING ALL ',' BY SPACE. DTSBS412 +01727 INSPECT X120-OPO-TITLE REPLACING ALL ',' BY SPACE. DTSBS412 +01728 INSPECT X120-OPO-ATTENTION REPLACING ALL ',' BY SPACE. DTSBS412 +01729 INSPECT X120-OPO-STREET-1 REPLACING ALL ',' BY SPACE. DTSBS412 +01730 INSPECT X120-OPO-STREET-2 REPLACING ALL ',' BY SPACE. DTSBS412 +01731 INSPECT X120-OPO-EMAIL REPLACING ALL ',' BY SPACE. DTSBS412 +01732 DTSBS412 +01733 WRITE EMPLOYER-TEMP-REC FROM WRK-X120-REC DTSBS412 +01734 IF TEMP-STATUS-OK-88 DTSBS412 +01735 ADD +1 TO TEMP-CNT DTSBS412 +01736 ELSE DTSBS412 +01737 DISPLAY 'CANNOT WRITE TEMP X120 ' MPRF-EMP-NO DTSBS412 +01738 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01739 END-IF. DTSBS412 +01740 DTSBS412 +01741 P2590-EXIT. DTSBS412 +01742 EXIT. DTSBS412 +01743 DTSBS412 +01744 P3000-REL. DTSBS412 +01745 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSBS412 +01746 MOVE MPRF-EMP-NO TO MREL-EMP-NO. DTSBS412 +01747 SET MREL-REL-88 TO TRUE. DTSBS412 +01748 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01749 DTSBS412 +01750 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +01751 IF L910-NO-REC-88 DTSBS412 +01752 NEXT SENTENCE DTSBS412 +01753 ELSE DTSBS412 +01754 PERFORM DTSBS412 +01755 UNTIL L910-NO-REC-88 DTSBS412 +01756 MOVE MSKL-REC TO MREL-REC DTSBS412 +01757 IF MREL-REL-REC-VOID-88 DTSBS412 +01758 OR MREL-REL-REC-TRNSF-88 DTSBS412 +01759 NEXT SENTENCE DTSBS412 +01760 ELSE DTSBS412 +01761 IF MREL-EXP-TRNSF-YES-88 DTSBS412 +01762 PERFORM P3010-WRITE-X131 THRU P3010-EXIT DTSBS412 +01763 END-IF DTSBS412 +01764 END-IF DTSBS412 +01765 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS412 +01766 END-PERFORM DTSBS412 +01767 END-IF. DTSBS412 +01768 P3000-EXIT. DTSBS412 +01769 EXIT. DTSBS412 +01770 DTSBS412 +01771 P3010-WRITE-X131. DTSBS412 +01772 MOVE MPRF-EMP-NO TO X131-SUCC-EMP-NO. DTSBS412 +01773 DTSBS412 +01774 MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9. DTSBS412 +01775 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS412 +01776 MOVE L001-SLASH-8-DATE TO X131-EFF-DATE. DTSBS412 +01777 DTSBS412 +01778 MOVE MREL-PRED-EMP-NO TO X131-PRED-EMP-NO. DTSBS412 +01779 DTSBS412 +01780 WRITE EMPLOYER-TEMP-REC FROM WRK-X131-REC DTSBS412 +01781 IF TEMP-STATUS-OK-88 DTSBS412 +01782 ADD +1 TO TEMP-CNT DTSBS412 +01783 ELSE DTSBS412 +01784 DISPLAY 'CANNOT WRITE TEMP X131 ' MPRF-EMP-NO DTSBS412 +01785 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01786 END-IF. DTSBS412 +01787 DTSBS412 +01788 P3010-EXIT. DTSBS412 +01789 EXIT. DTSBS412 +01790 DTSBS412 +01791 DTSBS412 +01792 P3200-DETERM. CL**2 +01793 MOVE LOW-VALUES TO MSOL-REC. CL**2 +01794 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. CL**2 +01795 SET MSOL-SOL-88 TO TRUE. CL**2 +01796 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. CL**2 +01797 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL**2 +01798 CL**2 +01799 PERFORM CL**2 +01800 UNTIL L910-NO-REC-88 CL**2 +01801 MOVE MSKL-REC TO MSOL-REC CL**2 +01802 IF NOT MSOL-INACT-WITHDRAWN-88 CL**2 +01803 PERFORM P3210-BUILD-X104 THRU P3210-EXIT CL**2 +01804 END-IF CL**2 +01805 PERFORM S910D-READ-NEXT THRU S910D-EXIT CL**2 +01806 END-PERFORM. CL**2 +01807 CL**2 +01808 P3200-EXIT. CL**2 +01809 EXIT. CL**2 +01810 CL**2 +01811 P3210-BUILD-X104. CL**2 +01812 MOVE MPRF-EMP-NO TO X104-EMP-NO. CL**2 +01813 CL**2 +01814 SET X104-STAFF-REVIEW-NO-88 TO TRUE. CL**2 +01815 CL**2 +01816 EVALUATE TRUE CL**2 +01817 WHEN MSOL-LIAB-RATED-REG-88 CL**2 +01818 OR MSOL-LIAB-RATED-NON-PROF-88 CL136 +01819 SET X104-ELIG-RATED-88 TO TRUE CL**2 +01820 CL**2 +01821 WHEN MSOL-LIAB-RATED-SUCC-88 CL**2 +01822 OR MSOL-LIAB-RATED-FUTA-88 CL**2 +01823 OR MSOL-LIAB-RATED-VOLUNT-88 CL**2 +01824 OR MSOL-LIAB-RATED-OTH-88 CL**2 +01825 OR MSOL-LIAB-RATED-CONV-88 CL**2 +01826 OR MSOL-LIAB-RATED-UNK-88 CL**2 +01827 SET MSOL-LIAB-RATED-REG-88 TO TRUE CL**2 +01828 SET X104-ELIG-RATED-88 TO TRUE CL**2 +01829 CL**2 +01830 WHEN MSOL-LIAB-RATED-DOMESTIC-88 CL**2 +01831 SET X104-ELIG-RATED-88 TO TRUE CL**2 +01832 CL**2 +01833 WHEN MSOL-LIAB-SELF-INS-OTH-88 CL**2 +01834 OR MSOL-LIAB-SELF-INS-CONV-88 CL**2 +01835 OR MSOL-LIAB-SELF-INS-UNK-88 CL**2 +01836 OR MSOL-LIAB-SELF-INS-VOLUNT-88 CL**2 +01837 SET MSOL-LIAB-SELF-INS-NON-PROF-88 TO TRUE CL**2 +01838 SET X104-ELIG-SELF-INS-88 TO TRUE CL**2 +01839 CL**2 +01840 WHEN MSOL-LIAB-SELF-INS-NON-PROF-88 CL**2 +01841 OR MSOL-LIAB-SELF-INS-SCHOOL-88 CL**2 +01842 OR MSOL-LIAB-SELF-INS-CITY-88 CL**2 +01843 OR MSOL-LIAB-SELF-INS-COUNTY-88 CL**2 +01844 OR MSOL-LIAB-SELF-INS-STATE-88 CL**2 +01845 OR MSOL-LIAB-SELF-INS-CHURCH-88 CL**2 +01846 SET X104-ELIG-SELF-INS-88 TO TRUE CL**2 +01847 END-EVALUATE. CL**2 +01848 CL**2 +01849 MOVE MSOL-LIAB-CD TO X104-LIAB-CD. CL**2 +01850 CL**2 +01851 MOVE MPRF-NAICS-CD TO X104-NAICS-CD. CL**2 +01852 CL**2 +01853 IF X104-ELIG-SELF-INS-88 CL**2 +01854 IF NOT MPRF-ORG-CORPORATION-88 CL**2 +01855 DISPLAY 'P3210 SI/ORG INCONSISTENT ' MPRF-EMP-NO CL**2 +01856 SET MPRF-ORG-CORPORATION-88 TO TRUE CL**2 +01857 END-IF CL**2 +01858 END-IF. CL**2 +01859 CL**2 +01860 MOVE MPRF-ORG-TYPE TO X104-ORG-TYPE. CL**2 +01861 CL**2 +01862 IF MSOL-LIAB-RATED-DOMESTIC-88 CL**2 +01863 PERFORM P3211-FILE-SCHED THRU P3211-EXIT CL**2 +01864 ELSE CL**2 +01865 MOVE SPACES TO X104-HOUSEHOLD-FILING CL**2 +01866 END-IF. CL**2 +01867 CL**2 +01868 MOVE SPACES TO X104-INCORP-STATE CL**2 +01869 X104-INCORP-DATE. CL**2 +01870 CL**2 +01871 CL**2 +01872 IF MSOL-LIAB-RATED-DOMESTIC-88 CL**2 +01873 MOVE SPACES TO X104-FIRST-WAGE-DT CL**2 +01874 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 CL**2 +01875 PERFORM S004-FROM-5 THRU S004-EXIT CL**2 +01876 MOVE L004-SLASH-5-QTR TO X104-FIRST-500-QTR CL**2 +01877 ELSE CL**2 +01878 MOVE SPACES TO X104-FIRST-500-QTR CL**2 +01879 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9 CL**2 +01880 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL**2 +01881 MOVE L001-SLASH-8-DATE TO X104-FIRST-WAGE-DT CL**2 +01882 END-IF. CL**2 +01883 CL**2 +01884 CL**2 +01885 MOVE WRK-ACQUIRED-IND TO X104-ACQUIRE-IND. CL**2 +01886 MOVE WRK-MERGER-SPLIT-IND TO X104-MERGER-SPLIT-IND. CL**2 +01887 MOVE WRK-REORG-IND TO X104-REORG-IND. CL**2 +01888 CL*55 +01889 IF MSOL-INACT-DATE > 0 CL*55 +01890 MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9 CL*55 +01891 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*55 +01892 MOVE L001-SLASH-8-DATE TO X104-INACTIVE-DATE CL*55 +01893 ELSE CL*55 +01894 MOVE ZEROS TO X104-INACTIVE-DATE CL*55 +01895 END-IF. CL*55 +01896 CL*55 +01897 SET X104-COMMON-OWN-NO-88 TO TRUE. CL**2 +01898 SET X104-SALE-TRANSFER-NO-88 TO TRUE. CL**2 +01899 SET X104-NOT-LIAB-NULL-88 TO TRUE. CL**2 +01900 CL**2 +01901 WRITE EMPLOYER-TEMP-REC FROM WRK-X104-REC. CL**2 +01902 IF TEMP-STATUS-OK-88 CL**2 +01903 ADD +1 TO TEMP-CNT CL**2 +01904 ELSE CL**2 +01905 DISPLAY 'CANNOT WRITE TEMP X104 ' MPRF-EMP-NO CL**2 +01906 SET WRK-ERROR-YES-88 TO TRUE CL**2 +01907 END-IF. CL**2 +01908 CL**2 +01909 P3210-EXIT. CL**2 +01910 EXIT. CL**2 +01911 CL**2 +01912 P3211-FILE-SCHED. CL**2 +01913 SET L410-MODE-INPUT-YRQ-88 TO TRUE CL**2 +01914 MOVE MPRF-EMP-NO TO L410-EMP-NO CL**2 +01915 MOVE WRK-CURR-QTR TO L410-YRQ CL**2 +01916 PERFORM S410-FILE-SCHED THRU S410-EXIT CL**2 +01917 IF L410-ANN-SCHED-88 CL**2 +01918 SET X104-HH-ANNUAL-88 TO TRUE CL**2 +01919 ELSE CL**2 +01920 SET X104-HH-QUARTERLY-88 TO TRUE CL**2 +01921 END-IF. CL**2 +01922 CL**2 +01923 P3211-EXIT. CL**2 +01924 EXIT. CL**2 +01925 DTSBS412 +01926 P3400-RATE. DTSBS412 +01927 IF NOT MPRF-CLASS-RATED-88 DTSBS412 +01928 GO TO P3400-EXIT DTSBS412 +01929 END-IF. DTSBS412 +01930 DTSBS412 +01931 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBS412 +01932 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBS412 +01933 MOVE WRK-RATE-YRQ-3 TO MRTE-EFF-YRQ. CL*30 +01934 SET MRTE-RTE-88 TO TRUE. DTSBS412 +01935 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01936 DTSBS412 +01937 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +01938 IF L910-NO-REC-88 DTSBS412 +01939 DISPLAY 'P3400 RATE MISSING ' MPRF-EMP-NO DTSBS412 +01940 SET WRK-SELECT-EMP-NO-88 TO TRUE DTSBS412 +01941 ELSE DTSBS412 +01942 PERFORM DTSBS412 +01943 UNTIL L910-NO-REC-88 DTSBS412 +01944 MOVE MSKL-REC TO MRTE-REC DTSBS412 +01945 PERFORM P3410-WRITE-X108 THRU P3410-EXIT DTSBS412 +01946 PERFORM S910D-READ-NEXT THRU S910D-EXIT CL*26 +01947 END-PERFORM DTSBS412 +01948 END-IF. DTSBS412 +01949 DTSBS412 +01950 P3400-EXIT. DTSBS412 +01951 EXIT. DTSBS412 +01952 DTSBS412 +01953 P3410-WRITE-X108. DTSBS412 +01954 MOVE MPRF-EMP-NO TO X108-EMP-NO. DTSBS412 +01955 DTSBS412 +01956 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSBS412 +01957 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS412 +01958 MOVE L004-SLASH-5-QTR TO X108-RATE-YEAR. DTSBS412 +01959 DTSBS412 +01960 COMPUTE MRTE-UI-RATE = (MRTE-UI-RATE * 100). DTSBS412 +01961 MOVE MRTE-UI-RATE TO X108-RATE. DTSBS412 +01962 DTSBS412 +01963 WRITE EMPLOYER-TEMP-REC FROM WRK-X108-REC. DTSBS412 +01964 IF TEMP-STATUS-OK-88 DTSBS412 +01965 ADD +1 TO TEMP-CNT DTSBS412 +01966 ELSE DTSBS412 +01967 DISPLAY 'CANNOT WRITE TEMP X108 ' MPRF-EMP-NO DTSBS412 +01968 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +01969 END-IF. DTSBS412 +01970 DTSBS412 +01971 P3410-EXIT. DTSBS412 +01972 EXIT. DTSBS412 +01973 DTSBS412 +01974 P3600-REPORT. DTSBS412 +01975 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBS412 +01976 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBS412 +01977 SET MRPT-RPT-88 TO TRUE. DTSBS412 +01978 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +01979 DTSBS412 +01980 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +01981 PERFORM UNTIL L910-NO-REC-88 DTSBS412 +01982 MOVE MSKL-REC TO MRPT-REC DTSBS412 +01983 IF NOT MRPT-ESTIM-88 DTSBS412 +01984 PERFORM P3620-RECENT-REPORT THRU P3620-EXIT DTSBS412 +01985 END-IF DTSBS412 +01986 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS412 +01987 END-PERFORM. DTSBS412 +01988 DTSBS412 +01989 PERFORM P3630-LAST-REPORT THRU P3630-EXIT. DTSBS412 +01990 DTSBS412 +01991 P3600-EXIT. DTSBS412 +01992 EXIT. DTSBS412 +01993 CL**2 +01994 P3610-WRITE-X140. CL**2 +01995 MOVE MPRF-EMP-NO TO X140-EMP-NO. CL**2 +01996 CL**2 +01997 MOVE MRPT-YRQ TO L004-QTR-5-9. CL**2 +01998 PERFORM S004-FROM-5 THRU S004-EXIT. CL**2 +01999 MOVE L004-SLASH-5-QTR TO X140-QUARTER. CL**2 +02000 CL**2 +02001 MOVE MRPT-BATCH-NO TO X140-PSEUDO-BATCH-NO. CL*10 +02002 MOVE MRPT-ITEM-NO TO X140-PSEUDO-ITEM-NO CL*10 +02003 MOVE MRPT-RPT-TYPE TO X140-REPORT-TYPE. CL*10 +02004 MOVE MRPT-TOT-WAGE TO X140-TOTAL-WAGES. CL**2 +02005 MOVE MRPT-TAX-WAGE TO X140-TAX-WAGES. CL**2 +02006 MOVE MRPT-REMIT-AMT TO X140-REMITTANCE. CL**2 +02007 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. CL**2 +02008 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**2 +02009 MOVE L001-SLASH-8-DATE TO X140-RCVD-DATE. CL**2 +02010 MOVE MRPT-1ST-MTH-EMPL-CNT TO X140-WRKR-CNT-1ST-MNTH. CL**2 +02011 MOVE MRPT-2ND-MTH-EMPL-CNT TO X140-WRKR-CNT-2ND-MNTH. CL**2 +02012 MOVE MRPT-3RD-MTH-EMPL-CNT TO X140-WRKR-CNT-3RD-MNTH. CL**2 +02013 CL**2 +02014 WRITE EMPLOYER-TEMP-REC FROM WRK-X140-REC. CL**2 +02015 IF TEMP-STATUS-OK-88 CL**2 +02016 ADD +1 TO TEMP-CNT CL**2 +02017 ELSE CL**2 +02018 DISPLAY 'CANNOT WRITE TEMP X140 ' MPRF-EMP-NO CL**2 +02019 SET WRK-ERROR-YES-88 TO TRUE CL**2 +02020 END-IF. CL**2 +02021 CL**2 +02022 P3610-EXIT. CL**2 +02023 EXIT. CL**2 +02024 DTSBS412 +02025 P3620-RECENT-REPORT. DTSBS412 +02026 MOVE MRPT-YRQ TO L004-QTR-5-9. DTSBS412 +02027 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS412 +02028 MOVE L004-ABS-QTR TO RSUB. DTSBS412 +02029 DTSBS412 +02030 IF MRPT-ESTB-DATE > RPT-PROCESS-DATE (RSUB) DTSBS412 +02031 MOVE MRPT-YRQ TO RPT-YRQ (RSUB) DTSBS412 +02032 MOVE MRPT-RPT-TYPE TO RPT-TYPE (RSUB) DTSBS412 +02033 MOVE MRPT-RECEIVED-DATE TO RPT-RCVD-DATE (RSUB) DTSBS412 +02034 MOVE MRPT-ESTB-DATE TO RPT-PROCESS-DATE (RSUB) DTSBS412 +02035 END-IF. DTSBS412 +02036 DTSBS412 +02037 P3620-EXIT. DTSBS412 +02038 EXIT. DTSBS412 +02039 DTSBS412 +02040 P3630-LAST-REPORT. DTSBS412 +02041 PERFORM DTSBS412 +02042 VARYING RSUB FROM +1 BY +1 DTSBS412 +02043 UNTIL RSUB > RPT-MAX DTSBS412 +02044 IF RPT-PROCESS-DATE (RSUB) > MAX-RPT-DATE DTSBS412 +02045 IF RPT-TYPE (RSUB) NOT = 'WD' DTSBS412 +02046 MOVE RPT-YRQ (RSUB) TO MAX-RPT-YRQ DTSBS412 +02047 MOVE RPT-PROCESS-DATE (RSUB) TO MAX-RPT-DATE DTSBS412 +02048 MOVE RPT-TYPE (RSUB) TO MAX-RPT-TYPE DTSBS412 +02049 END-IF DTSBS412 +02050 END-IF DTSBS412 +02051 END-PERFORM. DTSBS412 +02052 DTSBS412 +02053 IF MAX-RPT-DATE NOT = ZERO DTSBS412 +02054 MOVE MPRF-EMP-NO TO X142-EMP-NO DTSBS412 +02055 MOVE MAX-RPT-YRQ TO L004-QTR-5-9 DTSBS412 +02056 MOVE L004-QTR-5-YR TO X142-REPORT-YEAR DTSBS412 +02057 MOVE L004-QTR-5-Q TO X142-REPORT-QTR DTSBS412 +02058 MOVE MAX-RPT-DATE TO L001-FED-8-DATE-9 DTSBS412 +02059 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBS412 +02060 MOVE L001-SLASH-8-DATE TO X142-REPORT-DATE DTSBS412 +02061 IF MAX-RPT-TYPE = 'OR' DTSBS412 +02062 SET X142-RPT-TYPE-ORIG-88 TO TRUE DTSBS412 +02063 ELSE DTSBS412 +02064 SET X142-RPT-TYPE-AMND-88 TO TRUE DTSBS412 +02065 END-IF DTSBS412 +02066 END-IF. DTSBS412 +02067 DTSBS412 +02068 P3630-EXIT. DTSBS412 +02069 EXIT. DTSBS412 +02070 DTSBS412 +02071 P3700-QTRS-DUE. DTSBS412 +02072 SET WRK-CURR-QTR-NO-88 TO TRUE. DTSBS412 +02073 SET WRK-PRIOR-QTR-NO-88 TO TRUE. DTSBS412 +02074 DTSBS412 +02075 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBS412 +02076 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBS412 +02077 SET MQTR-QTR-88 TO TRUE. DTSBS412 +02078 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +02079 DTSBS412 +02080 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +02081 PERFORM UNTIL L910-NO-REC-88 DTSBS412 +02082 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02083 IF MQTR-YRQ > WRK-CURR-QTR-MINUS-8 DTSBS412 +02084 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS412 +02085 PERFORM P3705-HOUSEHOLD THRU P3705-EXIT DTSBS412 +02086 ELSE DTSBS412 +02087 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS412 +02088 END-IF DTSBS412 +02089 END-IF DTSBS412 +02090 IF L910-OK-88 DTSBS412 +02091 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS412 +02092 END-IF DTSBS412 +02093 END-PERFORM. DTSBS412 +02094 DTSBS412 +02095 PERFORM P3720-CURR-QUARTERS THRU P3720-EXIT. DTSBS412 +02096 DTSBS412 +02097 P3700-EXIT. DTSBS412 +02098 EXIT. DTSBS412 +02099 DTSBS412 +02100 P3705-HOUSEHOLD. DTSBS412 +02101 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBS412 +02102 DTSBS412 +02103 MOVE 1 TO L004-QTR-5-Q. DTSBS412 +02104 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02105 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02106 IF L516-ANN-SCHED-88 DTSBS412 +02107 NEXT SENTENCE DTSBS412 +02108 ELSE DTSBS412 +02109 SET WRK-FILE-QTRLY-88 TO TRUE DTSBS412 +02110 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS412 +02111 END-IF. DTSBS412 +02112 DTSBS412 +02113 IF L516-LIABLE-88 DTSBS412 +02114 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02115 ELSE DTSBS412 +02116 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02117 END-IF. DTSBS412 +02118 DTSBS412 +02119 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02120 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02121 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02122 IF L910-OK-88 DTSBS412 +02123 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02124 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS412 +02125 END-IF. DTSBS412 +02126 DTSBS412 +02127 MOVE 2 TO L004-QTR-5-Q. DTSBS412 +02128 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02129 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02130 IF L516-LIABLE-88 DTSBS412 +02131 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02132 ELSE DTSBS412 +02133 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02134 END-IF. DTSBS412 +02135 DTSBS412 +02136 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02137 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02138 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02139 IF L910-OK-88 DTSBS412 +02140 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02141 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS412 +02142 END-IF. DTSBS412 +02143 DTSBS412 +02144 MOVE 3 TO L004-QTR-5-Q. DTSBS412 +02145 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02146 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02147 IF L516-LIABLE-88 DTSBS412 +02148 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02149 ELSE DTSBS412 +02150 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02151 END-IF. DTSBS412 +02152 DTSBS412 +02153 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02154 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02155 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02156 IF L910-OK-88 DTSBS412 +02157 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02158 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS412 +02159 END-IF. DTSBS412 +02160 DTSBS412 +02161 MOVE 4 TO L004-QTR-5-Q. DTSBS412 +02162 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02163 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02164 IF L516-LIABLE-88 DTSBS412 +02165 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02166 ELSE DTSBS412 +02167 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02168 END-IF. DTSBS412 +02169 DTSBS412 +02170 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02171 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02172 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02173 IF L910-OK-88 DTSBS412 +02174 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02175 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSBS412 +02176 END-IF. DTSBS412 +02177 DTSBS412 +02178 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02179 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02180 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +02181 DTSBS412 +02182 P3705-EXIT. DTSBS412 +02183 EXIT. DTSBS412 +02184 DTSBS412 +02185 P3710-WRITE-X141. DTSBS412 +02186 IF MQTR-YRQ = WRK-PRIOR-QTR DTSBS412 +02187 SET WRK-PRIOR-QTR-YES-88 TO TRUE DTSBS412 +02188 ELSE DTSBS412 +02189 IF MQTR-YRQ = WRK-CURR-QTR DTSBS412 +02190 SET WRK-CURR-QTR-YES-88 TO TRUE DTSBS412 +02191 END-IF DTSBS412 +02192 END-IF. DTSBS412 +02193 DTSBS412 +02194 MOVE ZERO TO DTSBS412 +02195 WRK-TAX-BAL DTSBS412 +02196 WRK-SUR-BAL DTSBS412 +02197 WRK-INT-BAL DTSBS412 +02198 WRK-PEN-BAL. DTSBS412 +02199 DTSBS412 +02200 MOVE MPRF-EMP-NO TO X141-EMP-NO. DTSBS412 +02201 DTSBS412 +02202 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBS412 +02203 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS412 +02204 MOVE L004-SLASH-5-QTR TO X141-QUARTER. DTSBS412 +02205 DTSBS412 +02206 EVALUATE TRUE DTSBS412 +02207 WHEN MQTR-CURR-RCVD-88 DTSBS412 +02208 SET X141-QTR-RECEIVED-88 TO TRUE DTSBS412 +02209 WHEN MQTR-CURR-MISSING-88 DTSBS412 +02210 SET X141-QTR-DELINQUENT-88 TO TRUE DTSBS412 +02211 WHEN MQTR-CURR-NOT-LIABLE-88 DTSBS412 +02212 SET X141-QTR-NOT-LIABLE-88 TO TRUE DTSBS412 +02213 WHEN OTHER DTSBS412 +02214 SET X141-QTR-CURRENT-88 TO TRUE DTSBS412 +02215 END-EVALUATE. DTSBS412 +02216 DTSBS412 +02217 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS412 +02218 MOVE WRK-FILING-SCHED TO X141-FILING-SCHEDULE DTSBS412 +02219 ELSE DTSBS412 +02220 SET X141-FILE-QTRLY-88 TO TRUE DTSBS412 +02221 END-IF. DTSBS412 +02222 CL135 +02223 DISPLAY 'MQTR-UI-RATE-A' MQTR-UI-RATE CL135 +02224 CL135 +02225 IF MQTR-NO-UI-RATE-88 DTSBS412 +02226 DISPLAY 'MQTR-UI-RATE-B' MQTR-UI-RATE CL135 +02227 MOVE ZERO TO X141-RATE DTSBS412 +02228 ELSE DTSBS412 +02229 COMPUTE WRK-UI-RATE = (MQTR-UI-RATE * 100) DTSBS412 +02230 MOVE WRK-UI-RATE TO X141-RATE DTSBS412 +02231 END-IF. DTSBS412 +02232 DTSBS412 +02233 DTSBS412 +02234 PERFORM P3711-BALANCES THRU P3711-EXIT. DTSBS412 +02235 MOVE WRK-TAX-BAL TO X141-UI-TAX-BAL. DTSBS412 +02236 MOVE WRK-SUR-BAL TO X141-SUR-BAL. DTSBS412 +02237 MOVE WRK-INT-BAL TO X141-INT-BAL. DTSBS412 +02238 MOVE WRK-PEN-BAL TO X141-PEN-BAL. DTSBS412 +02239 DTSBS412 +02240 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBS412 +02241 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS412 +02242 MOVE L001-SLASH-8-DATE TO X141-REPORT-DUE-DATE. DTSBS412 +02243 DTSBS412 +02244 MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBS412 +02245 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS412 +02246 MOVE L001-SLASH-8-DATE TO X141-TAX-DUE-DATE. DTSBS412 +02247 DTSBS412 +02248 DTSBS412 +02249 WRITE EMPLOYER-TEMP-REC FROM WRK-X141-REC. DTSBS412 +02250 IF TEMP-STATUS-OK-88 DTSBS412 +02251 ADD +1 TO TEMP-CNT DTSBS412 +02252 ELSE DTSBS412 +02253 DISPLAY 'CANNOT WRITE TEMP X141 ' MPRF-EMP-NO DTSBS412 +02254 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +02255 END-IF. DTSBS412 +02256 DTSBS412 +02257 DTSBS412 +02258 P3710-EXIT. DTSBS412 +02259 EXIT. DTSBS412 +02260 DTSBS412 +02261 P3711-BALANCES. DTSBS412 +02262 PERFORM DTSBS412 +02263 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBS412 +02264 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBS412 +02265 EVALUATE TRUE DTSBS412 +02266 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBS412 +02267 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS412 +02268 TO WRK-TAX-BAL DTSBS412 +02269 DTSBS412 +02270 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBS412 +02271 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS412 +02272 TO WRK-SUR-BAL DTSBS412 +02273 DTSBS412 +02274 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBS412 +02275 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS412 +02276 TO WRK-PEN-BAL DTSBS412 +02277 DTSBS412 +02278 WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBS412 +02279 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS412 +02280 TO WRK-PEN-BAL DTSBS412 +02281 DTSBS412 +02282 WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBS412 +02283 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS412 +02284 TO WRK-PEN-BAL DTSBS412 +02285 DTSBS412 +02286 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBS412 +02287 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBS412 +02288 TO WRK-INT-BAL DTSBS412 +02289 DTSBS412 +02290 END-EVALUATE DTSBS412 +02291 END-PERFORM. DTSBS412 +02292 DTSBS412 +02293 P3711-EXIT. DTSBS412 +02294 EXIT. DTSBS412 +02295 DTSBS412 +02296 DTSBS412 +02297 P3720-CURR-QUARTERS. DTSBS412 +02298 MOVE ZERO TO WRK-ANN-YEAR. DTSBS412 +02299 DTSBS412 +02300 IF WRK-PRIOR-QTR-NO-88 DTSBS412 +02301 MOVE WRK-PRIOR-QTR TO L516-YRQ DTSBS412 +02302 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02303 IF L516-LIABLE-88 DTSBS412 +02304 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS412 +02305 PERFORM P3722-BUILD-HH THRU P3722-EXIT DTSBS412 +02306 ELSE DTSBS412 +02307 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS412 +02308 END-IF DTSBS412 +02309 END-IF DTSBS412 +02310 END-IF. DTSBS412 +02311 DTSBS412 +02312 IF MPRF-STATUS-INACT-88 DTSBS412 +02313 IF WRK-INACT-DATE > WRK-CURR-QTR-START DTSBS412 +02314 IF WRK-CURR-QTR-NO-88 DTSBS412 +02315 MOVE WRK-CURR-QTR TO L516-YRQ DTSBS412 +02316 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02317 IF L516-LIABLE-88 DTSBS412 +02318 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS412 +02319 DISPLAY 'P3720 INACT HH ' MPRF-EMP-NO DTSBS412 +02320 PERFORM P3722-BUILD-HH THRU P3722-EXIT DTSBS412 +02321 ELSE DTSBS412 +02322 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS412 +02323 END-IF DTSBS412 +02324 END-IF DTSBS412 +02325 END-IF DTSBS412 +02326 END-IF DTSBS412 +02327 END-IF. DTSBS412 +02328 DTSBS412 +02329 DTSBS412 +02330 P3720-EXIT. DTSBS412 +02331 EXIT. DTSBS412 +02332 DTSBS412 +02333 P3721-BUILD-QTR. DTSBS412 +02334 MOVE MPRF-EMP-NO TO X141-EMP-NO. DTSBS412 +02335 DTSBS412 +02336 MOVE L516-YRQ TO L004-QTR-5-9. DTSBS412 +02337 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBS412 +02338 MOVE L004-SLASH-5-QTR TO X141-QUARTER. DTSBS412 +02339 DTSBS412 +02340 SET X141-QTR-CURRENT-88 TO TRUE. DTSBS412 +02341 DTSBS412 +02342 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSBS412 +02343 MOVE WRK-FILING-SCHED TO X141-FILING-SCHEDULE DTSBS412 +02344 ELSE DTSBS412 +02345 SET X141-FILE-QTRLY-88 TO TRUE DTSBS412 +02346 END-IF. DTSBS412 +02347 DTSBS412 +02348 MOVE ZERO TO X141-UI-TAX-BAL DTSBS412 +02349 X141-SUR-BAL DTSBS412 +02350 X141-INT-BAL DTSBS412 +02351 X141-PEN-BAL. DTSBS412 +02352 DTSBS412 +02353 MOVE L516-DEFAULT-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBS412 +02354 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS412 +02355 MOVE L001-SLASH-8-DATE TO X141-REPORT-DUE-DATE. DTSBS412 +02356 DTSBS412 +02357 MOVE L516-DEFAULT-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBS412 +02358 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBS412 +02359 MOVE L001-SLASH-8-DATE TO X141-TAX-DUE-DATE. DTSBS412 +02360 DTSBS412 +02361 WRITE EMPLOYER-TEMP-REC FROM WRK-X141-REC. DTSBS412 +02362 IF TEMP-STATUS-OK-88 DTSBS412 +02363 ADD +1 TO TEMP-CNT DTSBS412 +02364 ELSE DTSBS412 +02365 DISPLAY 'CANNOT WRITE TEMP X141 ' MPRF-EMP-NO DTSBS412 +02366 SET WRK-ERROR-YES-88 TO TRUE DTSBS412 +02367 END-IF. DTSBS412 +02368 DTSBS412 +02369 P3721-EXIT. DTSBS412 +02370 EXIT. DTSBS412 +02371 DTSBS412 +02372 P3722-BUILD-HH. DTSBS412 +02373 MOVE L516-YRQ TO L004-QTR-5-9. DTSBS412 +02374 IF L004-QTR-5-YR = WRK-ANN-YEAR DTSBS412 +02375 GO TO P3722-EXIT DTSBS412 +02376 END-IF. DTSBS412 +02377 DTSBS412 +02378 IF MPRF-STATUS-INACT-88 DTSBS412 +02379 NEXT SENTENCE DTSBS412 +02380 ELSE DTSBS412 +02381 MOVE L516-DEFAULT-RPT-DUE-DATE TO L001-FED-8-DATE-9 DTSBS412 +02382 MOVE 01 TO L001-FED-8-MO DTSBS412 +02383 MOVE 01 TO L001-FED-8-DA DTSBS412 +02384 IF WRK-CURR-RUN-DATE < L001-FED-8-DATE-9 DTSBS412 +02385 ** REPORT CAN NOT YET BE FILED ** DTSBS412 +02386 GO TO P3722-EXIT DTSBS412 +02387 END-IF DTSBS412 +02388 END-IF. DTSBS412 +02389 DTSBS412 +02390 MOVE L516-YRQ TO L004-QTR-5-9. DTSBS412 +02391 MOVE L004-QTR-5-YR TO WRK-ANN-YEAR. DTSBS412 +02392 DTSBS412 +02393 MOVE 1 TO L004-QTR-5-Q. DTSBS412 +02394 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02395 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02396 IF L516-ANN-SCHED-88 DTSBS412 +02397 NEXT SENTENCE DTSBS412 +02398 ELSE DTSBS412 +02399 SET WRK-FILE-QTRLY-88 TO TRUE DTSBS412 +02400 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS412 +02401 END-IF. DTSBS412 +02402 DTSBS412 +02403 IF L516-LIABLE-88 DTSBS412 +02404 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02405 ELSE DTSBS412 +02406 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02407 END-IF. DTSBS412 +02408 DTSBS412 +02409 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02410 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02411 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02412 IF L910-OK-88 DTSBS412 +02413 NEXT SENTENCE DTSBS412 +02414 ELSE DTSBS412 +02415 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02416 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS412 +02417 END-IF. DTSBS412 +02418 DTSBS412 +02419 MOVE 2 TO L004-QTR-5-Q. DTSBS412 +02420 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02421 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02422 IF L516-LIABLE-88 DTSBS412 +02423 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02424 ELSE DTSBS412 +02425 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02426 END-IF. DTSBS412 +02427 DTSBS412 +02428 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02429 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02430 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02431 IF L910-OK-88 DTSBS412 +02432 NEXT SENTENCE DTSBS412 +02433 ELSE DTSBS412 +02434 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02435 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS412 +02436 END-IF. DTSBS412 +02437 DTSBS412 +02438 MOVE 3 TO L004-QTR-5-Q. DTSBS412 +02439 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02440 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02441 IF L516-LIABLE-88 DTSBS412 +02442 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02443 ELSE DTSBS412 +02444 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02445 END-IF. DTSBS412 +02446 DTSBS412 +02447 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02448 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02449 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02450 IF L910-OK-88 DTSBS412 +02451 NEXT SENTENCE DTSBS412 +02452 ELSE DTSBS412 +02453 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02454 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS412 +02455 END-IF. DTSBS412 +02456 DTSBS412 +02457 MOVE 4 TO L004-QTR-5-Q. DTSBS412 +02458 MOVE L004-QTR-5-9 TO L516-YRQ DTSBS412 +02459 PERFORM S516-LIABILITY THRU S516-EXIT DTSBS412 +02460 IF L516-LIABLE-88 DTSBS412 +02461 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSBS412 +02462 ELSE DTSBS412 +02463 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSBS412 +02464 END-IF. DTSBS412 +02465 DTSBS412 +02466 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBS412 +02467 MOVE MQTR-REC TO MSKL-REC. DTSBS412 +02468 PERFORM S910B-READ THRU S910B-EXIT. DTSBS412 +02469 IF L910-OK-88 DTSBS412 +02470 NEXT SENTENCE DTSBS412 +02471 ELSE DTSBS412 +02472 MOVE MSKL-REC TO MQTR-REC DTSBS412 +02473 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSBS412 +02474 END-IF. DTSBS412 +02475 DTSBS412 +02476 P3722-EXIT. DTSBS412 +02477 EXIT. DTSBS412 +02478 DTSBS412 +02479 P3750-REPORTS. CL**2 +02480 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL**2 +02481 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL**2 +02482 MOVE MQTR-YRQ TO MRPT-YRQ. CL**2 +02483 SET MRPT-RPT-88 TO TRUE. CL**2 +02484 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL**2 +02485 CL**2 +02486 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL**2 +02487 IF L910-NO-REC-88 CL**2 +02488 NEXT SENTENCE CL**2 +02489 ELSE CL**2 +02490 PERFORM CL**2 +02491 UNTIL L910-NO-REC-88 CL**2 +02492 MOVE MSKL-REC TO MRPT-REC CL**2 +02493 PERFORM P3751-WRITE-X140 THRU P3751-EXIT CL**2 +02494 PERFORM S910D-READ-NEXT THRU S910D-EXIT CL**2 +02495 END-PERFORM CL**2 +02496 END-IF. CL**2 +02497 CL**2 +02498 P3750-EXIT. CL**2 +02499 EXIT. CL**2 +02500 CL**2 +02501 P3751-WRITE-X140. CL**2 +02502 MOVE MPRF-EMP-NO TO X140-EMP-NO. CL**2 +02503 CL**2 +02504 MOVE MRPT-YRQ TO L004-QTR-5-9. CL**2 +02505 PERFORM S004-FROM-5 THRU S004-EXIT. CL**2 +02506 MOVE L004-SLASH-5-QTR TO X140-QUARTER. CL**2 +02507 CL**2 +02508 MOVE MRPT-BATCH-NO TO X140-PSEUDO-BATCH-NO CL*12 +02509 MOVE MRPT-ITEM-NO TO X140-PSEUDO-ITEM-NO. CL*12 +02510 MOVE MRPT-RPT-TYPE TO X140-REPORT-TYPE. CL*12 +02511 MOVE MRPT-TOT-WAGE TO X140-TOTAL-WAGES. CL**2 +02512 MOVE MRPT-TAX-WAGE TO X140-TAX-WAGES. CL**2 +02513 MOVE MRPT-REMIT-AMT TO X140-REMITTANCE. CL**2 +02514 MOVE MRPT-TRACE-NO TO X140-CONFIRMATION. CL**2 +02515 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. CL**2 +02516 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**2 +02517 MOVE L001-SLASH-8-DATE TO X140-RCVD-DATE. CL**2 +02518 MOVE MRPT-ESTB-DATE TO L001-FED-8-DATE-9. CL**2 +02519 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**2 +02520 MOVE L001-SLASH-8-DATE TO X140-RCVD-DATE. CL*11 +02521 MOVE MRPT-1ST-MTH-EMPL-CNT TO X140-WRKR-CNT-1ST-MNTH. CL**2 +02522 MOVE MRPT-2ND-MTH-EMPL-CNT TO X140-WRKR-CNT-2ND-MNTH. CL**2 +02523 MOVE MRPT-3RD-MTH-EMPL-CNT TO X140-WRKR-CNT-3RD-MNTH. CL**2 +02524 CL**2 +02525 WRITE EMPLOYER-TEMP-REC FROM WRK-X140-REC. CL**2 +02526 IF TEMP-STATUS-OK-88 CL**2 +02527 ADD +1 TO TEMP-CNT CL**2 +02528 ELSE CL**2 +02529 DISPLAY 'CANNOT WRITE TEMP X140 ' MPRF-EMP-NO CL**2 +02530 SET WRK-ERROR-YES-88 TO TRUE CL**2 +02531 END-IF. CL**2 +02532 CL**2 +02533 P3751-EXIT. CL**2 +02534 EXIT. CL**2 +02535 DTSBS412 +02536 P3800-PAYMENT. DTSBS412 +02537 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBS412 +02538 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBS412 +02539 SET MPAY-PAY-88 TO TRUE. DTSBS412 +02540 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBS412 +02541 DTSBS412 +02542 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSBS412 +02543 PERFORM UNTIL L910-NO-REC-88 DTSBS412 +02544 MOVE MSKL-REC TO MPAY-REC DTSBS412 +02545 PERFORM P3820-RECENT-PAYMENT THRU P3820-EXIT DTSBS412 +02546 IF L910-OK-88 DTSBS412 +02547 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSBS412 +02548 END-IF DTSBS412 +02549 END-PERFORM. DTSBS412 +02550 DTSBS412 +02551 IF PAY-LAST > ZERO DTSBS412 +02552 PERFORM P3830-UPDATE-X142 THRU P3830-EXIT DTSBS412 +02553 END-IF. DTSBS412 +02554 DTSBS412 +02555 P3800-EXIT. DTSBS412 +02556 EXIT. DTSBS412 +02557 DTSBS412 +02558 P3820-RECENT-PAYMENT. DTSBS412 +02559 IF MPAY-APPLIC-BATCH-NO = ZERO DTSBS412 +02560 AND MPAY-PAYMENT-88 DTSBS412 +02561 PERFORM P3821-PAYMENTS THRU P3821-EXIT DTSBS412 +02562 ELSE DTSBS412 +02563 PERFORM P3822-ADJUSTMENTS THRU P3822-EXIT DTSBS412 +02564 END-IF. DTSBS412 +02565 DTSBS412 +02566 P3820-EXIT. DTSBS412 +02567 EXIT. DTSBS412 +02568 DTSBS412 +02569 P3821-PAYMENTS. DTSBS412 +02570 IF PAY-LAST < PAY-MAX DTSBS412 +02571 ADD +1 TO PAY-LAST DTSBS412 +02572 MOVE PAY-LAST TO PSUB DTSBS412 +02573 ELSE DTSBS412 +02574 DISPLAY 'P3821 PAY TABLE LENGTH EXCEEDED' DTSBS412 +02575 GO TO P3821-EXIT DTSBS412 +02576 END-IF. DTSBS412 +02577 DTSBS412 +02578 MOVE MPAY-BATCH-NO TO PAY-BATCH (PSUB). DTSBS412 +02579 MOVE MPAY-ITEM-NO TO PAY-ITEM (PSUB). DTSBS412 +02580 MOVE MPAY-ESTB-DATE TO PAY-PROCESS-DATE (PSUB). DTSBS412 +02581 MOVE MPAY-RECEIVED-DATE TO PAY-RCVD-DATE (PSUB). DTSBS412 +02582 MOVE MPAY-REMIT-AMT TO PAY-ORIG-AMT (PSUB) DTSBS412 +02583 PAY-ADJ-AMT (PSUB). DTSBS412 +02584 DTSBS412 +02585 P3821-EXIT. DTSBS412 +02586 EXIT. DTSBS412 +02587 DTSBS412 +02588 P3822-ADJUSTMENTS. DTSBS412 +02589 PERFORM DTSBS412 +02590 VARYING PSUB FROM +1 BY +1 DTSBS412 +02591 UNTIL PSUB > PAY-LAST DTSBS412 +02592 IF MPAY-APPLIC-BATCH-NO = PAY-BATCH (PSUB) DTSBS412 +02593 AND MPAY-APPLIC-ITEM-NO = PAY-ITEM (PSUB) DTSBS412 +02594 ADD MPAY-REMIT-AMT TO PAY-ADJ-AMT (PSUB) DTSBS412 +02595 END-IF DTSBS412 +02596 END-PERFORM. DTSBS412 +02597 DTSBS412 +02598 P3822-EXIT. DTSBS412 +02599 EXIT. DTSBS412 +02600 DTSBS412 +02601 P3830-UPDATE-X142. DTSBS412 +02602 PERFORM DTSBS412 +02603 VARYING PSUB FROM +1 BY +1 DTSBS412 +02604 UNTIL PSUB > PAY-LAST DTSBS412 +02605 IF PAY-ADJ-AMT (PSUB) > ZERO DTSBS412 +02606 IF PAY-PROCESS-DATE (PSUB) > MAX-PAY-DATE DTSBS412 +02607 MOVE PAY-PROCESS-DATE (PSUB) TO MAX-PAY-DATE DTSBS412 +02608 END-IF DTSBS412 +02609 END-IF DTSBS412 +02610 END-PERFORM. DTSBS412 +02611 DTSBS412 +02612 IF MAX-PAY-DATE NOT = ZERO DTSBS412 +02613 PERFORM DTSBS412 +02614 VARYING PSUB FROM +1 BY +1 DTSBS412 +02615 UNTIL PSUB > PAY-LAST DTSBS412 +02616 IF PAY-PROCESS-DATE (PSUB) = MAX-PAY-DATE DTSBS412 +02617 ADD PAY-ADJ-AMT (PSUB) TO MAX-PAY-AMT DTSBS412 +02618 END-IF DTSBS412 +02619 END-PERFORM DTSBS412 +02620 MOVE MPRF-EMP-NO TO X142-EMP-NO DTSBS412 +02621 MOVE MAX-PAY-DATE TO L001-FED-8-DATE-9 DTSBS412 +02622 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBS412 +02623 MOVE L001-SLASH-8-DATE TO X142-PAY-DATE DTSBS412 +02624 MOVE MAX-PAY-AMT TO X142-PAY-AMT DTSBS412 +02625 END-IF. DTSBS412 +02626 DTSBS412 +02627 P3830-EXIT. DTSBS412 +02628 EXIT. DTSBS412 +02629 DTSBS412 +02630 S1010-READ-SENT-MINI. CL122 +02631 READ SENT-MINI-FILE INTO WS-SENT-REC CL122 +02632 IF SENT-MINI-STATUS-OK-88 CL122 +02633 ADD +1 TO W-SENT-MINI-CNT CL122 +02634 ELSE CL122 +02635 IF SENT-MINI-STATUS-EOF-88 CL122 +02636 DISPLAY 'SENT MINI EOF' CL122 +02637 ELSE CL122 +02638 DISPLAY 'CANNOT READ SENT MINI ' SENT-MINI-STATUS CL122 +02639 PERFORM S999-ABEND THRU S999-EXIT CL122 +02640 END-IF CL122 +02641 END-IF. CL122 +02642 CL122 +02643 S1010-EXIT. CL122 +02644 EXIT. CL122 +02645 CL122 +02646 T0000-TERMINATE. DTSBS412 +02647 DTSBS412 +02648 DISPLAY '*********************************************'. DTSBS412 +02649 DISPLAY '* DTSBS412 TERMINATION STATISTICS'. CL133 +02650 DISPLAY '* '. DTSBS412 +02651 DISPLAY '* MPRF RECORDS READ : ' DTSBS412 +02652 WRK-MPRF-CNT. DTSBS412 +02653 DISPLAY '* SEND FILE RECORDS READ : ' CL127 +02654 W-SENT-MINI-CNT. CL127 +02655 DISPLAY '* TEMP RECORDS WRITTEN : ' DTSBS412 +02656 TEMP-CNT. DTSBS412 +02657 DISPLAY '* PROFILE RECORDS WRITTEN : ' DTSBS412 +02658 X102-CNT. DTSBS412 +02659 DISPLAY '* NAME RECORDS WRITTEN : ' DTSBS412 +02660 X106-CNT. DTSBS412 +02661 DISPLAY '* EMP ADDRESS RECS WRITTEN : ' DTSBS412 +02662 X110-CNT. DTSBS412 +02663 DISPLAY '* EMP RATE RECS WRITTEN : ' CL**2 +02664 X108-CNT. CL**2 +02665 DISPLAY '* OPO RECORDS WRITTEN : ' CL**2 +02666 X120-CNT. CL**2 +02667 DISPLAY '* REL RECORDS WRITTEN : ' CL**2 +02668 X130-CNT. CL**2 +02669 DISPLAY '* RPT RECORDS WRITTEN : ' CL**2 +02670 X140-CNT. CL**2 +02671 DISPLAY '* REL RECORDS WRITTEN : ' DTSBS412 +02672 X131-CNT. DTSBS412 +02673 DISPLAY '* QTR STATUS RECS WRITTEN : ' DTSBS412 +02674 X141-CNT. DTSBS412 +02675 DISPLAY '* LAST RPT PAY RECS WRITTEN : ' DTSBS412 +02676 X142-CNT. DTSBS412 +02677 DISPLAY '*********************************************'. DTSBS412 +02678 DTSBS412 +02679 DTSBS412 +02680 CLOSE X100-REF-FILE DTSBS412 +02681 X102-PRF-FILE DTSBS412 +02682 X104-DETERM-FILE CL**2 +02683 X106-NAME-FILE DTSBS412 +02684 X110-ADDR-FILE DTSBS412 +02685 X108-RATE-FILE CL**2 +02686 X120-OPO-FILE CL**2 +02687 ** X130-REL-FILE CL*12 +02688 X140-REPORT-FILE CL**2 +02689 X131-REL-FILE DTSBS412 +02690 X141-QTR-STATUS-FILE DTSBS412 +02691 X142-LAST-RPT-PAY-FILE. DTSBS412 +02692 DTSBS412 +02693 PERFORM S910E-CLOSE THRU S910E-EXIT. DTSBS412 +02694 PERFORM S921E-CLOSE THRU S921E-EXIT. DTSBS412 +02695 PERFORM S931D-CLOSE THRU S931D-EXIT. DTSBS412 +02696 DTSBS412 +02697 T0000-EXIT. DTSBS412 +02698 EXIT. DTSBS412 +02699 DTSBS412 +02700 S001-FROM-FED-8. DTSBS412 +02701 SET L001-FROM-FED-8 TO TRUE. DTSBS412 +02702 GO TO S001-DATE. DTSBS412 +02703 DTSBS412 +02704 S001-FROM-ABS-DAY. DTSBS412 +02705 SET L001-FROM-ABS-DAY TO TRUE. DTSBS412 +02706 GO TO S001-DATE. DTSBS412 +02707 DTSBS412 +02708 S001-DATE. DTSBS412 +02709 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBS412 +02710 S001-EXIT. DTSBS412 +02711 EXIT. DTSBS412 +02712 DTSBS412 +02713 S003-AGENCY-DAY. DTSBS412 +02714 SET L003-AGENCY-DAY TO TRUE. DTSBS412 +02715 GO TO S003-WORK-DAY. DTSBS412 +02716 DTSBS412 +02717 S003-WORK-DAY. DTSBS412 +02718 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBS412 +02719 S003-EXIT. DTSBS412 +02720 EXIT. DTSBS412 +02721 DTSBS412 +02722 S004-FROM-DATE. DTSBS412 +02723 SET L004-FROM-DATE TO TRUE. DTSBS412 +02724 GO TO S004-QTR. DTSBS412 +02725 DTSBS412 +02726 S004-FROM-5. DTSBS412 +02727 SET L004-FROM-5 TO TRUE. DTSBS412 +02728 GO TO S004-QTR. DTSBS412 +02729 DTSBS412 +02730 S004-FROM-ABS. DTSBS412 +02731 SET L004-FROM-ABS TO TRUE. DTSBS412 +02732 GO TO S004-QTR. DTSBS412 +02733 DTSBS412 +02734 S004-FROM-3. DTSBS412 +02735 SET L004-FROM-3 TO TRUE. DTSBS412 +02736 GO TO S004-QTR. DTSBS412 +02737 DTSBS412 +02738 S004-QTR. DTSBS412 +02739 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBS412 +02740 S004-EXIT. DTSBS412 +02741 EXIT. DTSBS412 +02742 DTSBS412 +02743 S005-SYS-DATE. DTSBS412 +02744 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBS412 +02745 DTSBS412 +02746 S005-EXIT. DTSBS412 +02747 EXIT. DTSBS412 +02748 DTSBS412 +02749 S101-PER-MONTH-NO. DTSBS412 +02750 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBS412 +02751 GO TO S101-INT-CHARGE. DTSBS412 +02752 DTSBS412 +02753 S101-INT-CHARGE. DTSBS412 +02754 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBS412 +02755 S101-EXIT. DTSBS412 +02756 EXIT. DTSBS412 +02757 DTSBS412 +02758 S410-FILE-SCHED. DTSBS412 +02759 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBS412 +02760 S410-EXIT. DTSBS412 +02761 EXIT. DTSBS412 +02762 DTSBS412 +02763 S516-LIABILITY. DTSBS412 +02764 CALL 'DTSBU516' USING L516-LINK-AREA DTSBS412 +02765 MPRF-REC. DTSBS412 +02766 S516-EXIT. DTSBS412 +02767 EXIT. DTSBS412 +02768 DTSBS412 +02769 S910A-OPEN-READ. DTSBS412 +02770 SET L910-OPEN-READ-88 TO TRUE. DTSBS412 +02771 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS412 +02772 DTSBS412 +02773 S910A-EXIT. DTSBS412 +02774 EXIT. DTSBS412 +02775 DTSBS412 +02776 S910B-READ. DTSBS412 +02777 SET L910-READ-88 TO TRUE. DTSBS412 +02778 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS412 +02779 DTSBS412 +02780 S910B-EXIT. DTSBS412 +02781 EXIT. DTSBS412 +02782 DTSBS412 +02783 S910C-START-BROWSE. DTSBS412 +02784 SET L910-START-BROWSE-88 TO TRUE. DTSBS412 +02785 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS412 +02786 DTSBS412 +02787 S910C-EXIT. DTSBS412 +02788 EXIT. DTSBS412 +02789 DTSBS412 +02790 S910D-READ-NEXT. DTSBS412 +02791 SET L910-READ-NEXT-88 TO TRUE. DTSBS412 +02792 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS412 +02793 DTSBS412 +02794 S910D-EXIT. DTSBS412 +02795 EXIT. DTSBS412 +02796 DTSBS412 +02797 S910E-CLOSE. DTSBS412 +02798 SET L910-CLOSE-88 TO TRUE. DTSBS412 +02799 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBS412 +02800 DTSBS412 +02801 S910E-EXIT. DTSBS412 +02802 EXIT. DTSBS412 +02803 DTSBS412 +02804 S910Z-MSTR-IO. DTSBS412 +02805 CALL 'DTSBU910' USING L910-LINK-AREA DTSBS412 +02806 MSKL-REC. DTSBS412 +02807 S910Z-EXIT. DTSBS412 +02808 EXIT. DTSBS412 +02809 DTSBS412 +02810 S921A-OPEN-READ. DTSBS412 +02811 SET L921-OPEN-READ-88 TO TRUE. DTSBS412 +02812 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS412 +02813 DTSBS412 +02814 S921A-EXIT. DTSBS412 +02815 EXIT. DTSBS412 +02816 DTSBS412 +02817 S921C-START-BROWSE. DTSBS412 +02818 SET L921-START-BROWSE-88 TO TRUE. DTSBS412 +02819 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS412 +02820 DTSBS412 +02821 S921C-EXIT. DTSBS412 +02822 EXIT. DTSBS412 +02823 DTSBS412 +02824 S921D-READ-NEXT. DTSBS412 +02825 SET L921-READ-NEXT-88 TO TRUE. DTSBS412 +02826 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS412 +02827 DTSBS412 +02828 S921D-EXIT. DTSBS412 +02829 EXIT. DTSBS412 +02830 DTSBS412 +02831 S921E-CLOSE. DTSBS412 +02832 SET L921-CLOSE-88 TO TRUE. DTSBS412 +02833 PERFORM S921Z-AIX-IO THRU S921Z-EXIT. DTSBS412 +02834 DTSBS412 +02835 S921E-EXIT. DTSBS412 +02836 EXIT. DTSBS412 +02837 DTSBS412 +02838 S921Z-AIX-IO. DTSBS412 +02839 CALL 'DTSBU921' USING L921-LINK-AREA DTSBS412 +02840 ISKL-REC. DTSBS412 +02841 S921Z-EXIT. DTSBS412 +02842 EXIT. DTSBS412 +02843 DTSBS412 +02844 S931A-OPEN-READ. DTSBS412 +02845 SET L931-OPEN-READ-88 TO TRUE. DTSBS412 +02846 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS412 +02847 DTSBS412 +02848 S931A-EXIT. DTSBS412 +02849 EXIT. DTSBS412 +02850 DTSBS412 +02851 S931B-START-BROWSE. DTSBS412 +02852 SET L931-START-BROWSE-88 TO TRUE. DTSBS412 +02853 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS412 +02854 DTSBS412 +02855 S931B-EXIT. DTSBS412 +02856 EXIT. DTSBS412 +02857 DTSBS412 +02858 S931C-READ-NEXT. DTSBS412 +02859 SET L931-READ-NEXT-88 TO TRUE. DTSBS412 +02860 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS412 +02861 DTSBS412 +02862 S931C-EXIT. DTSBS412 +02863 EXIT. DTSBS412 +02864 DTSBS412 +02865 S931D-CLOSE. DTSBS412 +02866 SET L931-CLOSE-88 TO TRUE. DTSBS412 +02867 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBS412 +02868 DTSBS412 +02869 S931D-EXIT. DTSBS412 +02870 EXIT. DTSBS412 +02871 DTSBS412 +02872 S931Z-REF-IO. DTSBS412 +02873 CALL 'DTSBU931' USING L931-LINK-AREA DTSBS412 +02874 FSKL-REC. DTSBS412 +02875 S931Z-EXIT. EXIT. DTSBS412 +02876 DTSBS412 +02877 S999-ABEND. DTSBS412 +02878 DISPLAY '*** DTSBX411 ABENDING. ' DTSBS412 +02879 ABEND-MSG. DTSBS412 +02880 DTSBS412 +02881 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBS412 +02882 S999-EXIT. DTSBS412 +02883 EXIT. DTSBS412 diff --git a/Batch/DTSBS413.cob b/Batch/DTSBS413.cob index c742f83..83fc6ef 100644 --- a/Batch/DTSBS413.cob +++ b/Batch/DTSBS413.cob @@ -1,5 +1,5 @@ 00001 IDENTIFICATION DIVISION. 07/04/24 -00002 PROGRAM-ID. DTSBS413. DTSBS413 +00002 PROGRAM-ID. DTSBX413. DTSBS413 00003 AUTHOR. SC. LV139 00004 DATE-WRITTEN. JUNE 2024. CL129 00005 DATE-COMPILED. DTSBS413 diff --git a/Batch/DTSBS414.cob b/Batch/DTSBS414.cob new file mode 100644 index 0000000..4d54327 --- /dev/null +++ b/Batch/DTSBS414.cob @@ -0,0 +1,633 @@ +00001 IDENTIFICATION DIVISION. 08/16/24 +00002 PROGRAM-ID. DTSBS414. DTSBS414 +00003 AUTHOR. SRUJANI LV166 +00004 DATE-WRITTEN. AUG2024 CL155 +00005 DATE-COMPILED. DTSBS414 +00006 SKIP3 DTSBS414 +00007 ***** DTSBS414 +00008 * DTSBS414 +00009 * FUNCTION: ADD EVENT LOG FOR NEW ACCOUNT REGISTRATION CL156 +00010 * DTSBS414 +00011 * DTSBS414 +00012 ***** DTSBS414 +00013 SKIP3 DTSBS414 +00014 ENVIRONMENT DIVISION. DTSBS414 +00015 SKIP2 DTSBS414 +00016 CONFIGURATION SECTION. DTSBS414 +00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBS414 +00018 DTSBS414 +00019 INPUT-OUTPUT SECTION. DTSBS414 +00020 DTSBS414 +00021 FILE-CONTROL. DTSBS414 +00022 SELECT EMP-FILE1 ASSIGN TO EMPFILE1 CL122 +00023 FILE STATUS IS EXP-STATUS. DTSBS414 +00024 DTSBS414 +00025 CL*71 +00026 DATA DIVISION. DTSBS414 +00027 DTSBS414 +00028 FILE SECTION. DTSBS414 +00029 DTSBS414 +00030 FD EMP-FILE1 CL122 +00031 RECORDING MODE IS F. DTSBS414 +00032 01 EMP-REC1. CL122 +00033 05 IREC-TYPE PIC X(03). CL158 +00034 05 FILLER PIC X(01) VALUE ','. CL158 +00035 05 IEMP-NO PIC 9(06). CL158 +00036 05 FILLER PIC X(01) VALUE ','. CL158 +00037 05 IEMP-FEIN PIC 9(09). CL158 +00038 05 FILLER PIC X(01) VALUE ','. CL158 +00039 05 IEMP-CLASS PIC X(01). CL162 +00040 05 FILLER PIC X(01) VALUE ','. CL162 +00041 05 IEMP-STATUS PIC X(01). CL162 +00042 05 FILLER PIC X(01) VALUE ','. CL162 +00043 05 ISOURCE-CD PIC X(02). CL162 +00044 05 FILLER PIC X(01) VALUE ','. CL162 +00045 05 IACTION-CD PIC X(01). CL162 +00046 EJECT CL158 +00047 WORKING-STORAGE SECTION. DTSBS414 +000475 77 PAN-VALET PICTURE X(24) VALUE '166DTSBS414 08/16/24'. DTSBS414 +00048 SKIP3 DTSBS414 +00049 01 WRK-AREA. DTSBS414 +00050 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSBS414 +00051 DTSBS414 +00052 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'.DTSBS414 +00053 DTSBS414 +00054 05 WRK-MPRF-IND PIC X(01). DTSBS414 +00055 88 WRK-MPRF-OK VALUE 'Y'. DTSBS414 +00056 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBS414 +00057 05 WRK-MEVL-IND PIC X(01). DTSBS414 +00058 88 WRK-MEVL-OK VALUE 'Y'. DTSBS414 +00059 88 WRK-MEVL-NO-REC VALUE 'N'. DTSBS414 +00060 05 WRK-ERROR-IND PIC X(01). CL*31 +00061 88 WRK-ERROR-YES-88 VALUE 'Y'. CL*31 +00062 88 WRK-ERROR-NO-88 VALUE 'N'. CL*31 +00063 *RW1 DTSBS414 +00064 05 EXP-STATUS PIC X(02). CL*15 +00065 88 EXP-STATUS-OK-88 VALUE '00'. CL*15 +00066 CL*15 +00067 05 WRK-BAL PIC 9(09)V9(02). CL*77 +00068 05 FILE-END PIC X(01) VALUE 'N'. CL*23 +00069 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBS414 +00070 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBS414 +00071 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBS414 +00072 05 WRK-TRACE-IND PIC X(01). CL*28 +00073 CL136 +00074 05 WRK-MESS-LINE-1. CL*10 +00075 10 FILLER PIC X(43) VALUE CL165 +00076 'MINI CONVERSION - REGISTRATION SENT TO ESSP'. CL164 +00077 CL160 +00078 05 EVL-TEXT PIC X(50). CL**9 +00079 * CL190 +00080 *RW2 DTSBS414 +00081 DTSBS414 +00082 01 TSKL-REC. CL183 +00083 ++INCLUDE DTSITSKL CL183 +00084 EJECT CL183 +00085 01 T003-REC. CL183 +00086 ++INCLUDE DTSIT003 CL183 +00087 EJECT CL183 +00088 01 L001-LINK-AREA. DTSBS414 +00089 ++INCLUDE DTSIL001 DTSBS414 +00090 EJECT DTSBS414 +00091 01 L005-LINK-AREA. CL157 +00092 ++INCLUDE DTSIL005 DTSBS414 +00093 EJECT DTSBS414 +00094 01 L039-LINK-AREA. DTSBS414 +00095 ++INCLUDE DTSIL039 DTSBS414 +00096 EJECT DTSBS414 +00097 01 L101-LINK-AREA. CL*23 +00098 ++INCLUDE DTSIL101 CL*23 +00099 EJECT DTSBS414 +00100 01 L102-LINK-AREA. CL*23 +00101 ++INCLUDE DTSIL102 CL*23 +00102 EJECT CL*23 +00103 01 L109-LINK-AREA. CL*23 +00104 ++INCLUDE DTSIL109 CL*23 +00105 CL*23 +00106 01 L054-LINK-AREA. DTSBS414 +00107 ++INCLUDE DTSIL054 DTSBS414 +00108 EJECT DTSBS414 +00109 01 L410-LINK-AREA. DTSBS414 +00110 ++INCLUDE DTSIL410 DTSBS414 +00111 EJECT DTSBS414 +00112 01 L600-LINK-AREA. DTSBS414 +00113 ++INCLUDE DTSIL600 DTSBS414 +00114 EJECT DTSBS414 +00115 01 L910-LINK-AREA. DTSBS414 +00116 ++INCLUDE DTSIL910 DTSBS414 +00117 EJECT DTSBS414 +00118 01 MSKL-REC. DTSBS414 +00119 ++INCLUDE DTSIMSKL DTSBS414 +00120 EJECT DTSBS414 +00121 01 MNTE-REC. CL183 +00122 ++INCLUDE DTSIMNTE CL183 +00123 EJECT CL183 +00124 01 MHDR-REC. DTSBS414 +00125 ++INCLUDE DTSIMHDR DTSBS414 +00126 EJECT DTSBS414 +00127 01 MPRF-REC. CL164 +00128 ++INCLUDE DTSIMPRF CL164 +00129 EJECT CL164 +00130 01 MQTR-REC. DTSBS414 +00131 ++INCLUDE DTSIMQTR DTSBS414 +00132 EJECT DTSBS414 +00133 01 MRPT-REC. DTSBS414 +00134 ++INCLUDE DTSIMRPT DTSBS414 +00135 EJECT DTSBS414 +00136 01 MSOL-REC. DTSBS414 +00137 ++INCLUDE DTSIMSOL DTSBS414 +00138 EJECT DTSBS414 +00139 01 MRCT-REC. DTSBS414 +00140 ++INCLUDE DTSIMRCT DTSBS414 +00141 EJECT DTSBS414 +00142 01 MREL-REC. DTSBS414 +00143 ++INCLUDE DTSIMREL DTSBS414 +00144 EJECT DTSBS414 +00145 01 MEVL-REC. DTSBS414 +00146 ++INCLUDE DTSIMEVL DTSBS414 +00147 EJECT DTSBS414 +00148 01 MLIN-REC. DTSBS414 +00149 ++INCLUDE DTSIMLIN DTSBS414 +00150 EJECT DTSBS414 +00151 01 MRTE-REC. DTSBS414 +00152 ++INCLUDE DTSIMRTE DTSBS414 +00153 EJECT DTSBS414 +00154 01 MDST-REC. DTSBS414 +00155 ++INCLUDE DTSIMDST DTSBS414 +00156 EJECT DTSBS414 +00157 01 MPAY-REC. DTSBS414 +00158 ++INCLUDE DTSIMPAY DTSBS414 +00159 EJECT DTSBS414 +00160 01 MADJ-REC. DTSBS414 +00161 ++INCLUDE DTSIMADJ DTSBS414 +00162 EJECT DTSBS414 +00163 01 MJRN-REC. DTSBS414 +00164 ++INCLUDE DTSIMJRN DTSBS414 +00165 EJECT DTSBS414 +00166 01 MERA-REC. DTSBS414 +00167 ++INCLUDE DTSIMERA DTSBS414 +00168 EJECT DTSBS414 +00169 01 MCOL-REC. DTSBS414 +00170 ++INCLUDE DTSIMCOL DTSBS414 +00171 EJECT DTSBS414 +00172 01 MFAS-REC. DTSBS414 +00173 ++INCLUDE DTSIMFAS DTSBS414 +00174 01 MAUR-REC. DTSBS414 +00175 ++INCLUDE DTSIMAUR DTSBS414 +00176 EJECT DTSBS414 +00177 01 MFAE-REC. DTSBS414 +00178 ++INCLUDE DTSIMFAE DTSBS414 +00179 EJECT DTSBS414 +00180 01 MLOG-REC. DTSBS414 +00181 ++INCLUDE DTSIMLOG DTSBS414 +00182 EJECT DTSBS414 +00183 01 MOPO-REC. DTSBS414 +00184 ++INCLUDE DTSIMOPO DTSBS414 +00185 EJECT DTSBS414 +00186 01 MTAD-REC. DTSBS414 +00187 ++INCLUDE DTSIMTAD DTSBS414 +00188 EJECT DTSBS414 +00189 01 MTAA-REC. DTSBS414 +00190 ++INCLUDE DTSIMTAA DTSBS414 +00191 EJECT DTSBS414 +00192 01 MBAA-REC. DTSBS414 +00193 ++INCLUDE DTSIMBAA DTSBS414 +00194 EJECT DTSBS414 +00195 01 MFSC-REC. DTSBS414 +00196 ++INCLUDE DTSIMFSC DTSBS414 +00197 EJECT DTSBS414 +00198 01 MERD-REC. DTSBS414 +00199 ++INCLUDE DTSIMERD DTSBS414 +00200 EJECT DTSBS414 +00201 01 MDPC-REC. DTSBS414 +00202 ++INCLUDE DTSIMDPC DTSBS414 +00203 EJECT DTSBS414 +00204 01 L921-LINK-AREA. DTSBS414 +00205 ++INCLUDE DTSIL921 DTSBS414 +00206 EJECT DTSBS414 +00207 01 ISKL-REC. DTSBS414 +00208 ++INCLUDE DTSIISKL DTSBS414 +00209 EJECT DTSBS414 +00210 01 IPES-REC. DTSBS414 +00211 ++INCLUDE DTSIIPES DTSBS414 +00212 EJECT DTSBS414 +00213 01 L931-LINK-AREA. DTSBS414 +00214 ++INCLUDE DTSIL931 DTSBS414 +00215 EJECT DTSBS414 +00216 01 FSKL-REC. DTSBS414 +00217 ++INCLUDE DTSIFSKL DTSBS414 +00218 EJECT DTSBS414 +00219 01 FQTR-REC. DTSBS414 +00220 ++INCLUDE DTSIFQTR DTSBS414 +00221 EJECT DTSBS414 +00222 01 FFIS-REC. DTSBS414 +00223 ++INCLUDE DTSIFFIS DTSBS414 +00224 EJECT DTSBS414 +00225 01 FFAZ-REC. DTSBS414 +00226 ++INCLUDE DTSIFFAZ DTSBS414 +00227 EJECT DTSBS414 +00228 01 FOPR-REC. DTSBS414 +00229 ++INCLUDE DTSIFOPR DTSBS414 +00230 EJECT DTSBS414 +00231 01 L933-LINK-AREA. DTSBS414 +00232 ++INCLUDE DTSIL933 DTSBS414 +00233 EJECT DTSBS414 +00234 01 XSIC-REC. DTSBS414 +00235 ++INCLUDE DTSIXSIC DTSBS414 +00236 EJECT DTSBS414 +00237 01 L004-COMM-AREA. DTSBS414 +00238 ++INCLUDE DTSIL004 DTSBS414 +00239 DTSBS414 +00240 01 L061-LINK-AREA. DTSBS414 +00241 ++INCLUDE DTSIL061 DTSBS414 +00242 DTSBS414 +00243 01 L062-LINK-AREA. DTSBS414 +00244 ++INCLUDE DTSIL062 DTSBS414 +00245 DTSBS414 +00246 01 L516-LINK-AREA. DTSBS414 +00247 ++INCLUDE DTSIL516 DTSBS414 +00248 EJECT DTSBS414 +00249 01 LBCM-LINK-AREA. CL173 +00250 ++INCLUDE DTSILBCM CL173 +00251 EJECT CL154 +00252 01 L923-LINK-AREA. CL183 +00253 ++INCLUDE DTSIL923 CL183 +00254 EJECT CL183 +00255 01 ASKL-REC. CL183 +00256 ++INCLUDE DTSIASKL CL183 +00257 EJECT CL183 +00258 01 AHDR-REC. CL183 +00259 ++INCLUDE DTSIAHDR CL183 +00260 EJECT CL183 +00261 01 AADJ-REC. CL183 +00262 ++INCLUDE DTSIAADJ CL183 +00263 EJECT CL183 +00264 01 L927-LINK-AREA. CL183 +00265 ++INCLUDE DTSIL927 CL183 +00266 EJECT CL183 +00267 PROCEDURE DIVISION. CL173 +00268 CL164 +00269 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBS414 +00270 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBS414 +00271 UNTIL FILE-END = 'Y'. CL*17 +00272 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBS414 +00273 SKIP2 DTSBS414 +00274 GOBACK. DTSBS414 +00275 EJECT DTSBS414 +00276 I0000-INITIATE. DTSBS414 +00277 SKIP2 DTSBS414 +00278 MOVE 'N' TO WRK-TRACE-IND. DTSBS414 +00279 SET WRK-ERROR-NO-88 TO TRUE. DTSBS414 +00280 DTSBS414 +00281 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBS414 +00282 DTSBS414 +00283 CL120 +00284 I0000-EXIT. DTSBS414 +00285 EXIT. DTSBS414 +00286 I2000-OPEN-FILES-1. DTSBS414 +00287 OPEN INPUT EMP-FILE1. CL120 +00288 IF NOT EXP-STATUS-OK-88 DTSBS414 +00289 DISPLAY 'CANNOT OPEN EXP FILE ' EXP-STATUS DTSBS414 +00290 SET WRK-ERROR-YES-88 TO TRUE DTSBS414 +00291 GO TO I2000-EXIT. DTSBS414 +00292 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBS414 +00293 DTSBS414 +00294 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBS414 +00295 DTSBS414 +00296 PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL*40 +00297 * PERFORM S923-OPEN-UPDATE THRU S923-EXIT. CL*85 +00298 * PERFORM S927-OPEN-UPDATE THRU S927-EXIT. CL*25 +00299 DTSBS414 +00300 PERFORM S005-FROM-SYS THRU S005-EXIT. CL187 +00301 DTSBS414 +00302 * PERFORM S931-OPEN-UPDATE THRU S931-EXIT. CL*85 +00303 DTSBS414 +00304 MOVE WRK-MOD-NAME TO L933-MOD-NAME. DTSBS414 +00305 DTSBS414 +00306 MOVE 'N' TO FILE-END. CL*24 +00307 CL*89 +00308 READ EMP-FILE1 AT END MOVE 'Y' TO FILE-END. CL*88 +00309 CL*89 +00310 CL*89 +00311 I2000-EXIT. DTSBS414 +00312 EXIT. DTSBS414 +00313 DTSBS414 +00314 P0000-PROCESS. DTSBS414 +00315 CL*88 +00316 DISPLAY IEMP-NO CL*36 +00317 PERFORM S6000-WRITE-MEVL THRU S6000-EXIT. CL228 +00318 CL209 +00319 PERFORM P1000-READ-NEXT THRU P1000-EXIT. CL135 +00320 CL*89 +00321 P0000-EXIT. CL119 +00322 EXIT. DTSBS414 +00323 DTSBS414 +00324 P1000-READ-NEXT. CL*88 +00325 READ EMP-FILE1 AT END CL*91 +00326 MOVE 'Y' TO FILE-END CL*90 +00327 GO TO P1000-EXIT. CL*88 +00328 P1000-EXIT. CL*88 +00329 EXIT. CL*88 +00330 CL*88 +00331 S6000-WRITE-MEVL. CL154 +00332 MOVE LOW-VALUES TO MEVL-REC. CL165 +00333 CL173 +00334 MOVE ZERO TO LBCM-EMP-ABSTIME. CL173 +00335 MOVE IEMP-NO TO MEVL-EMP-NO. CL209 +00336 CL*62 +00337 SET MEVL-EVL-88 TO TRUE. CL165 +00338 CL154 +00339 PERFORM S005-FROM-SYS THRU S005-A-EXIT. CL217 +00340 MOVE L005-DATE TO MEVL-DATE. CL181 +00341 CL154 +00342 MOVE L005-TIME TO MEVL-TIME. CL181 +00343 CL154 +00344 MOVE ZEROS TO MEVL-PURGE-DATE. CL154 +00345 CL154 +00346 MOVE WRK-MESS-LINE-1 TO EVL-TEXT CL160 +00347 MOVE EVL-TEXT TO MEVL-TEXT. CL209 +00348 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. CL209 +00349 CL154 +00350 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL154 +00351 ** MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL*39 +00352 DISPLAY MEVL-REC. CL242 +00353 MOVE MEVL-REC TO MSKL-REC. CL242 +00354 CL154 +00355 PERFORM S910-WRITE THRU S910-EXIT. CL154 +00356 S6000-EXIT. CL154 +00357 EXIT. CL154 +00358 EJECT CL154 +00359 CL*95 +00360 SKIP3 CL183 +00361 T0000-TERMINATE. DTSBS414 +00362 DTSBS414 +00363 DISPLAY ' '. DTSBS414 +00364 DTSBS414 +00365 DISPLAY '*** DTSBZEVL TERMINATION STATISTICS ***'. CL154 +00366 DTSBS414 +00367 DISPLAY ' '. DTSBS414 +00368 DTSBS414 +00369 CL123 +00370 CLOSE EMP-FILE1. CL123 +00371 DTSBS414 +00372 T0000-EXIT. DTSBS414 +00373 EXIT. DTSBS414 +00374 EJECT DTSBS414 +00375 S001-FROM-FED-8. DTSBS414 +00376 SET L001-FROM-FED-8 TO TRUE. DTSBS414 +00377 GO TO S001-DATE. DTSBS414 +00378 DTSBS414 +00379 S001-FROM-ABS-DAY. DTSBS414 +00380 SET L001-FROM-ABS-DAY TO TRUE. DTSBS414 +00381 GO TO S001-DATE. DTSBS414 +00382 DTSBS414 +00383 S001-DATE. DTSBS414 +00384 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBS414 +00385 DTSBS414 +00386 S001-EXIT. DTSBS414 +00387 EXIT. DTSBS414 +00388 SKIP3 DTSBS414 +00389 S004-FROM-5. DTSBS414 +00390 SET L004-FROM-5 TO TRUE. DTSBS414 +00391 GO TO S004-EDIT-QTR. DTSBS414 +00392 DTSBS414 +00393 S004-FROM-ABS. DTSBS414 +00394 SET L004-FROM-ABS TO TRUE. DTSBS414 +00395 GO TO S004-EDIT-QTR. DTSBS414 +00396 DTSBS414 +00397 S004-EDIT-QTR. DTSBS414 +00398 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBS414 +00399 DTSBS414 +00400 S004-EXIT. DTSBS414 +00401 EXIT. DTSBS414 +00402 SKIP3 DTSBS414 +00403 DTSBS414 +00404 S005-FROM-SYS. CL187 +00405 SET L005-FROM-SYS TO TRUE. CL187 +00406 CALL 'DTSBU005' USING L005-LINK-AREA. CL187 +00407 CL187 +00408 S005-EXIT. CL187 +00409 EXIT. CL187 +00410 CL187 +00411 S005-FROM-ABSTIME. CL156 +00412 SET L005-FROM-ABSTIME TO TRUE. CL156 +00413 GO TO S005-ABSTIME. CL156 +00414 CL156 +00415 S005-ABSTIME. CL156 +00416 CALL 'DTSBU005' USING L005-LINK-AREA. CL156 +00417 S005-A-EXIT. CL156 +00418 EXIT. CL156 +00419 SKIP3 CL156 +00420 S910-WRITE. CL156 +00421 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL173 +00422 SET L910-WRITE-88 TO TRUE. CL156 +00423 GO TO S910-MSTR-IO. CL156 +00424 S039-SIC-EDIT. DTSBS414 +00425 CALL 'DTSBU039' USING L039-LINK-AREA. DTSBS414 +00426 S039-EXIT. DTSBS414 +00427 EXIT. DTSBS414 +00428 DTSBS414 +00429 S054-RATE-DETERMINATION. DTSBS414 +00430 CALL 'DTSBU054' USING L054-LINK-AREA DTSBS414 +00431 MRCT-REC. DTSBS414 +00432 DTSBS414 +00433 S054-EXIT. DTSBS414 +00434 EXIT. DTSBS414 +00435 SKIP3 DTSBS414 +00436 S061-FLD-REP-INFO. DTSBS414 +00437 SKIP1 DTSBS414 +00438 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBS414 +00439 SKIP2 DTSBS414 +00440 S061-EXIT. DTSBS414 +00441 EXIT. DTSBS414 +00442 DTSBS414 +00443 S062-FLD-REP-LOOKUP. DTSBS414 +00444 DTSBS414 +00445 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBS414 +00446 DTSBS414 +00447 S062-EXIT. DTSBS414 +00448 EXIT. DTSBS414 +00449 DTSBS414 +00450 S101-PER-MONTH-NO. CL*23 +00451 SET L101-PER-MONTH-NO-88 TO TRUE. CL*23 +00452 GO TO S101-INT-CHARGE. CL*23 +00453 CL*23 +00454 S101-INT-CHARGE. CL*23 +00455 CALL 'DTSBU101' USING L101-LINK-AREA. CL*23 +00456 S101-EXIT. CL*23 +00457 EXIT. CL*23 +00458 CL*23 +00459 S109-FIRST-PEN-INT-YRQ. CL*23 +00460 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. CL*23 +00461 CALL 'DTSBU109' USING L109-LINK-AREA. CL*23 +00462 S109-EXIT. CL*23 +00463 EXIT. CL*23 +00464 CL*23 +00465 S410-FILING-SCHED. DTSBS414 +00466 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBS414 +00467 DTSBS414 +00468 S410-EXIT. DTSBS414 +00469 EXIT. DTSBS414 +00470 SKIP3 DTSBS414 +00471 S516-LIABILITY. DTSBS414 +00472 CALL 'DTSBU516' USING L516-LINK-AREA DTSBS414 +00473 MPRF-REC. DTSBS414 +00474 DTSBS414 +00475 S516-EXIT. DTSBS414 +00476 EXIT. DTSBS414 +00477 SKIP3 DTSBS414 +00478 S910-OPEN-READ. DTSBS414 +00479 SET L910-OPEN-READ-88 TO TRUE. DTSBS414 +00480 GO TO S910-MSTR-IO. DTSBS414 +00481 DTSBS414 +00482 S910-OPEN-UPDATE-NO-AIX. DTSBS414 +00483 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBS414 +00484 GO TO S910-MSTR-IO. DTSBS414 +00485 DTSBS414 +00486 S910-READ. DTSBS414 +00487 SET L910-READ-88 TO TRUE. DTSBS414 +00488 GO TO S910-MSTR-IO. DTSBS414 +00489 DTSBS414 +00490 S910-START-BROWSE. DTSBS414 +00491 SET L910-START-BROWSE-88 TO TRUE. DTSBS414 +00492 GO TO S910-MSTR-IO. DTSBS414 +00493 DTSBS414 +00494 S910-READ-NEXT. DTSBS414 +00495 SET L910-READ-NEXT-88 TO TRUE. DTSBS414 +00496 GO TO S910-MSTR-IO. DTSBS414 +00497 DTSBS414 +00498 S910-COUNT. DTSBS414 +00499 SET L910-COUNT-88 TO TRUE. DTSBS414 +00500 GO TO S910-MSTR-IO. DTSBS414 +00501 DTSBS414 +00502 S910-REWRITE. DTSBS414 +00503 SET L910-REWRITE-88 TO TRUE. DTSBS414 +00504 GO TO S910-MSTR-IO. DTSBS414 +00505 DTSBS414 +00506 S910-DELETE. DTSBS414 +00507 SET L910-DELETE-88 TO TRUE. DTSBS414 +00508 GO TO S910-MSTR-IO. DTSBS414 +00509 DTSBS414 +00510 S910-CLOSE. DTSBS414 +00511 SET L910-CLOSE-88 TO TRUE. DTSBS414 +00512 GO TO S910-MSTR-IO. DTSBS414 +00513 DTSBS414 +00514 S910-MSTR-IO. DTSBS414 +00515 CALL 'DTSBU910' USING L910-LINK-AREA DTSBS414 +00516 MSKL-REC. DTSBS414 +00517 S910-EXIT. DTSBS414 +00518 EXIT. DTSBS414 +00519 SKIP3 DTSBS414 +00520 S921-OPEN-READ. DTSBS414 +00521 SET L921-OPEN-READ-88 TO TRUE. DTSBS414 +00522 GO TO S921-AIX-IO. DTSBS414 +00523 DTSBS414 +00524 S921-START-BROWSE. DTSBS414 +00525 SET L921-START-BROWSE-88 TO TRUE. DTSBS414 +00526 GO TO S921-AIX-IO. DTSBS414 +00527 DTSBS414 +00528 S921-CLOSE. DTSBS414 +00529 SET L921-CLOSE-88 TO TRUE. DTSBS414 +00530 GO TO S921-AIX-IO. DTSBS414 +00531 DTSBS414 +00532 S923-CLOSE. CL183 +00533 SET L923-CLOSE-88 TO TRUE. CL183 +00534 GO TO S923-ATC-IO. CL183 +00535 CL183 +00536 S923-ATC-IO. CL183 +00537 CALL 'DTSBU923' USING L923-LINK-AREA CL183 +00538 ASKL-REC. CL183 +00539 S923-EXIT. CL183 +00540 EXIT. CL183 +00541 SKIP3 CL183 +00542 S921-AIX-IO. DTSBS414 +00543 CALL 'DTSBU921' USING L921-LINK-AREA DTSBS414 +00544 ISKL-REC. DTSBS414 +00545 S921-EXIT. DTSBS414 +00546 EXIT. DTSBS414 +00547 SKIP3 DTSBS414 +00548 DTSBS414 +00549 S923-OPEN-UPDATE. CL183 +00550 SET L923-OPEN-UPDATE-88 TO TRUE. CL183 +00551 GO TO S923-ATC-IO. CL183 +00552 CL183 +00553 SKIP3 CL183 +00554 S927-OPEN-UPDATE. CL183 +00555 SET L927-OPEN-UPDATE-88 TO TRUE. CL183 +00556 GO TO S927-BTC-O. CL183 +00557 CL183 +00558 S927-WRITE. CL183 +00559 SET L927-WRITE-88 TO TRUE. CL183 +00560 GO TO S927-BTC-O. CL183 +00561 CL183 +00562 S927-CLOSE. CL183 +00563 SET L927-CLOSE-88 TO TRUE. CL183 +00564 GO TO S927-BTC-O. CL183 +00565 CL183 +00566 S927-BTC-O. CL183 +00567 CALL 'DTSBU927' USING L927-LINK-AREA CL183 +00568 TSKL-REC. CL183 +00569 S927-EXIT. CL183 +00570 EXIT. CL183 +00571 CL183 +00572 SKIP3 CL183 +00573 S931-OPEN-READ. DTSBS414 +00574 SET L931-OPEN-READ-88 TO TRUE. DTSBS414 +00575 GO TO S931-REF-IO. DTSBS414 +00576 DTSBS414 +00577 S931-OPEN-UPDATE. DTSBS414 +00578 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBS414 +00579 GO TO S931-REF-IO. DTSBS414 +00580 DTSBS414 +00581 S931-START-BROWSE. DTSBS414 +00582 SET L931-START-BROWSE-88 TO TRUE. DTSBS414 +00583 GO TO S931-REF-IO. DTSBS414 +00584 DTSBS414 +00585 S931-READ. DTSBS414 +00586 SET L931-READ-88 TO TRUE. DTSBS414 +00587 GO TO S931-REF-IO. DTSBS414 +00588 DTSBS414 +00589 S931-READ-NEXT. DTSBS414 +00590 SET L931-READ-NEXT-88 TO TRUE. DTSBS414 +00591 GO TO S931-REF-IO. DTSBS414 +00592 DTSBS414 +00593 S931-DELETE. DTSBS414 +00594 SET L931-DELETE-88 TO TRUE. DTSBS414 +00595 GO TO S931-REF-IO. DTSBS414 +00596 DTSBS414 +00597 S931-REWRITE. DTSBS414 +00598 SET L931-REWRITE-88 TO TRUE. DTSBS414 +00599 GO TO S931-REF-IO. DTSBS414 +00600 DTSBS414 +00601 S931-WRITE. DTSBS414 +00602 SET L931-WRITE-88 TO TRUE. DTSBS414 +00603 GO TO S931-REF-IO. DTSBS414 +00604 DTSBS414 +00605 S931-CLOSE. DTSBS414 +00606 SET L931-CLOSE-88 TO TRUE. DTSBS414 +00607 GO TO S931-REF-IO. DTSBS414 +00608 DTSBS414 +00609 S931-REF-IO. DTSBS414 +00610 CALL 'DTSBU931' USING L931-LINK-AREA DTSBS414 +00611 FSKL-REC. DTSBS414 +00612 S931-EXIT. DTSBS414 +00613 EXIT. DTSBS414 +00614 SKIP3 DTSBS414 +00615 S933-OPEN-READ. DTSBS414 +00616 SET L933-OPEN-READ-88 TO TRUE. DTSBS414 +00617 GO TO S933-SIC-I. DTSBS414 +00618 DTSBS414 +00619 S933-CLOSE. DTSBS414 +00620 SET L933-CLOSE-88 TO TRUE. DTSBS414 +00621 GO TO S933-SIC-I. DTSBS414 +00622 DTSBS414 +00623 S933-SIC-I. DTSBS414 +00624 CALL 'DTSBU933' USING L933-LINK-AREA DTSBS414 +00625 XSIC-REC. DTSBS414 +00626 S933-EXIT. DTSBS414 +00627 EXIT. DTSBS414 +00628 DTSBS414 +00629 S999-ABEND. DTSBS414 +00630 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBS414 +00631 S999-EXIT. DTSBS414 +00632 EXIT. DTSBS414 diff --git a/Batch/DTSBU003.cob b/Batch/DTSBU003.cob index 21fcd9b..d8a58b7 100644 --- a/Batch/DTSBU003.cob +++ b/Batch/DTSBU003.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 05/28/14 +00001 IDENTIFICATION DIVISION. 12/21/24 00002 PROGRAM-ID. DTSBU003. DTSBU003 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV020 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008 00004 DATE-WRITTEN. JULY 1994. DTSBU003 00005 DATE-COMPILED. DTSBU003 00006 SKIP3 DTSBU003 @@ -22,83 +22,83 @@ 00022 * EMNCIPATION DAY APRIL 16 DTSBU003 00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSBU003 00024 * DTSBU003 -00025 * 05/20/2012 REVIEWED AND MODIFIED FOR DC HOLIDAY DTSBU003 -00026 * EMNCIPATION DAY APRIL 16 DTSBU003 -00027 * REFERENCE: DC DEVELOPMENT PROGRAMMER: NH1 DTSBU003 -00028 * DTSBU003 -00029 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU003 -00030 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU003 -00031 * DTSBU003 +00025 * CL**2 +00026 * 06/10/2022 REVIEWED AND MODIFIED FOR FEDERAL HOLIDAY CL**2 +00027 * JUNETEENTH DAY JUNE 19 CL**2 +00028 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 CL**2 +00029 * CL**2 +00030 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU003 +00031 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU003 00032 * DTSBU003 -00033 * DESCRIPTION: DTSBU003 -00034 * DTSBU003 -00035 * DETERMINE WHETHER A GIVEN DATE IS AN AGENCY WORK DAY. DTSBU003 -00036 * DTSBU003 -00037 ***** DTSBU003 -00038 SKIP3 DTSBU003 -00039 ENVIRONMENT DIVISION. DTSBU003 -00040 INPUT-OUTPUT SECTION. DTSBU003 -00041 DTSBU003 -00042 FILE-CONTROL. DTSBU003 -00043 SELECT HDAY-FILE ASSIGN TO DTS003F1. DTSBU003 -00044 DTSBU003 -00045 DATA DIVISION. DTSBU003 -00046 DTSBU003 -00047 FILE SECTION. DTSBU003 -00048 FD HDAY-FILE DTSBU003 -00049 RECORDING MODE IS F. DTSBU003 -00050 01 HDAY-DATA PIC X(80). DTSBU003 -00051 DTSBU003 -00052 SKIP3 DTSBU003 -00053 WORKING-STORAGE SECTION. DTSBU003 -000535 77 PAN-VALET PICTURE X(24) VALUE '020DTSBU003 05/28/14'. DTSBU003 -00054 77 PAN-VALET PICTURE X(24) VALUE '024DTSBU003 05/28/14'. DTSBU003 -00055 SKIP3 DTSBU003 -00056 01 WRK-AREA. DTSBU003 -00057 05 WRK-HDAY-AREA. DTSBU003 -00058 10 HDAY-YEAR PIC 9(04). DTSBU003 -00059 10 FILLER PIC X(01) VALUE ','. DTSBU003 -00060 10 HDAY-DAY-FILLER PIC X(24). DTSBU003 -00061 10 HDAY-DAY PIC X(26). DTSBU003 -00062 10 FILLER PIC X(01) VALUE ','. DTSBU003 -00063 10 HDAY-DATE PIC X(10). DTSBU003 -00064 10 FILLER2 PIC X(14). DTSBU003 -00065 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +003. DTSBU003 -00066 DTSBU003 -00067 05 WRK-MODULE-NAME PIC X(08) VALUE 'DTSBU003'. DTSBU003 -00068 05 WRK-OPTION PIC X(01) VALUE SPACES. DTSBU003 -00069 DTSBU003 -00070 05 WRK-ABEND-MSG PIC X(60). DTSBU003 -00071 SKIP3 DTSBU003 -00072 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU003 -00073 SKIP3 DTSBU003 -00074 05 HOLIDAY-AREA. DTSBU003 -00075 10 HOLIDAY-YEAR PIC 9(04). DTSBU003 -00076 DTSBU003 -00077 10 HOLIDAYS-IN-YEAR. DTSBU003 -00078 15 NEW-YEARS-DAY PIC S9(09) COMP-3. DTSBU003 -00079 15 MARTIN-LUTHER-KING-DAY PIC S9(09) COMP-3. DTSBU003 -00080 15 PRESIDENTS-DAY PIC S9(09) COMP-3. DTSBU003 -00081 15 INAGURATION-DAY PIC S9(09) COMP-3. DTSBU003 -00082 15 MEMORIAL-DAY PIC S9(09) COMP-3. DTSBU003 -00083 ** 15 EMANCIPATION-DAY PIC S9(09) COMP-3. DTSBU003 -00084 15 INDEPENDENCE-DAY PIC S9(09) COMP-3. DTSBU003 -00085 15 LABOR-DAY PIC S9(09) COMP-3. DTSBU003 -00086 15 COLUMBUS-DAY PIC S9(09) COMP-3. DTSBU003 -00087 15 VETERANS-DAY PIC S9(09) COMP-3. DTSBU003 -00088 15 THANKSGIVING-DAY PIC S9(09) COMP-3. DTSBU003 -00089 15 CHRISTMAS-DAY PIC S9(09) COMP-3. DTSBU003 -00090 15 NEW-YEARS-EVE PIC S9(09) COMP-3. DTSBU003 -00091 DTSBU003 -00092 10 FILLER REDEFINES HOLIDAYS-IN-YEAR. DTSBU003 -00093 15 HOLIDAY-DATE DTSBU003 -00094 ** OCCURS 13 TIMES DTSBU003 -00095 OCCURS 12 TIMES DTSBU003 -00096 INDEXED BY HOLIDAY-IDX PIC S9(09) COMP-3. DTSBU003 -00097 DTSBU003 -00098 10 HOLIDAY-CNT PIC S9(04) COMP DTSBU003 -00099 ** VALUE +13. DTSBU003 -00100 VALUE +12. DTSBU003 +00033 * DTSBU003 +00034 * DESCRIPTION: DTSBU003 +00035 * DTSBU003 +00036 * DETERMINE WHETHER A GIVEN DATE IS AN AGENCY WORK DAY. DTSBU003 +00037 * DTSBU003 +00038 ***** DTSBU003 +00039 SKIP3 DTSBU003 +00040 ENVIRONMENT DIVISION. DTSBU003 +00041 INPUT-OUTPUT SECTION. DTSBU003 +00042 DTSBU003 +00043 FILE-CONTROL. DTSBU003 +00044 SELECT HDAY-FILE ASSIGN TO DTS003F1. DTSBU003 +00045 DTSBU003 +00046 DATA DIVISION. DTSBU003 +00047 DTSBU003 +00048 FILE SECTION. DTSBU003 +00049 FD HDAY-FILE DTSBU003 +00050 RECORDING MODE IS F. DTSBU003 +00051 01 HDAY-DATA PIC X(80). DTSBU003 +00052 DTSBU003 +00053 SKIP3 DTSBU003 +00054 WORKING-STORAGE SECTION. DTSBU003 +000545 77 PAN-VALET PICTURE X(24) VALUE '008DTSBU003 12/21/24'. DTSBU003 +00055 77 PAN-VALET PICTURE X(24) VALUE '016DTSBU003 02/13/12'. DTSBU003 +00056 SKIP3 DTSBU003 +00057 01 WRK-AREA. DTSBU003 +00058 05 WRK-HDAY-AREA. DTSBU003 +00059 10 HDAY-YEAR PIC 9(04). DTSBU003 +00060 10 FILLER PIC X(01) VALUE ','. DTSBU003 +00061 10 HDAY-DAY-FILLER PIC X(24). DTSBU003 +00062 10 HDAY-DAY PIC X(26). DTSBU003 +00063 10 FILLER PIC X(01) VALUE ','. DTSBU003 +00064 10 HDAY-DATE PIC X(10). DTSBU003 +00065 10 FILLER2 PIC X(14). DTSBU003 +00066 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +003. DTSBU003 +00067 DTSBU003 +00068 05 WRK-MODULE-NAME PIC X(08) VALUE 'DTSBU003'. DTSBU003 +00069 05 WRK-OPTION PIC X(01) VALUE SPACES. DTSBU003 +00070 DTSBU003 +00071 05 WRK-ABEND-MSG PIC X(60). DTSBU003 +00072 SKIP3 DTSBU003 +00073 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU003 +00074 SKIP3 DTSBU003 +00075 05 HOLIDAY-AREA. DTSBU003 +00076 10 HOLIDAY-YEAR PIC 9(04). DTSBU003 +00077 DTSBU003 +00078 10 HOLIDAYS-IN-YEAR. DTSBU003 +00079 15 NEW-YEARS-DAY PIC S9(09) COMP-3. DTSBU003 +00080 15 MARTIN-LUTHER-KING-DAY PIC S9(09) COMP-3. DTSBU003 +00081 15 PRESIDENTS-DAY PIC S9(09) COMP-3. DTSBU003 +00082 15 INAGURATION-DAY PIC S9(09) COMP-3. DTSBU003 +00083 15 MEMORIAL-DAY PIC S9(09) COMP-3. DTSBU003 +00084 15 JUNETEENTH-DAY PIC S9(09) COMP-3. CL**4 +00085 15 INDEPENDENCE-DAY PIC S9(09) COMP-3. DTSBU003 +00086 15 LABOR-DAY PIC S9(09) COMP-3. DTSBU003 +00087 15 COLUMBUS-DAY PIC S9(09) COMP-3. DTSBU003 +00088 15 VETERANS-DAY PIC S9(09) COMP-3. DTSBU003 +00089 15 THANKSGIVING-DAY PIC S9(09) COMP-3. DTSBU003 +00090 15 CHRISTMAS-EVE PIC S9(09) COMP-3. CL**6 +00091 15 CHRISTMAS-DAY PIC S9(09) COMP-3. CL**6 +00092 15 NEW-YEARS-EVE PIC S9(09) COMP-3. DTSBU003 +00093 DTSBU003 +00094 10 FILLER REDEFINES HOLIDAYS-IN-YEAR. DTSBU003 +00095 15 HOLIDAY-DATE DTSBU003 +00096 OCCURS 14 TIMES CL**6 +00097 INDEXED BY HOLIDAY-IDX PIC S9(09) COMP-3. DTSBU003 +00098 DTSBU003 +00099 10 HOLIDAY-CNT PIC S9(04) COMP DTSBU003 +00100 VALUE +14. CL**6 00101 SKIP3 DTSBU003 00102 05 WRK-RESULT PIC S9(05) COMP-3. DTSBU003 00103 DTSBU003 @@ -209,21 +209,21 @@ 00208 L001-SLASH-8-DATE. DTSBU003 00209 DTSBU003 00210 DTSBU003 -00211 ** MOVE EMANCIPATION-DAY TO L001-FED-8-DATE-9. DTSBU003 +00211 MOVE MEMORIAL-DAY TO L001-FED-8-DATE-9. DTSBU003 00212 DTSBU003 -00213 ** PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00213 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 00214 DTSBU003 -00215 ** DISPLAY ' EMANCIPATION DAY: ' DTSBU003 -00216 ** L001-SLASH-8-DATE. DTSBU003 +00215 DISPLAY ' MEMORIAL DAY: ' DTSBU003 +00216 L001-SLASH-8-DATE. DTSBU003 00217 DTSBU003 -00218 DTSBU003 -00219 MOVE MEMORIAL-DAY TO L001-FED-8-DATE-9. DTSBU003 -00220 DTSBU003 -00221 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00222 DTSBU003 -00223 DISPLAY ' MEMORIAL DAY: ' DTSBU003 -00224 L001-SLASH-8-DATE. DTSBU003 -00225 DTSBU003 +00218 CL**3 +00219 MOVE JUNETEENTH-DAY TO L001-FED-8-DATE-9. CL**3 +00220 CL**3 +00221 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**3 +00222 CL**3 +00223 DISPLAY ' JUNETEENTH DAY: ' CL**3 +00224 L001-SLASH-8-DATE. CL**3 +00225 CL**3 00226 DTSBU003 00227 MOVE INDEPENDENCE-DAY TO L001-FED-8-DATE-9. DTSBU003 00228 DTSBU003 @@ -265,574 +265,618 @@ 00264 L001-SLASH-8-DATE. DTSBU003 00265 DTSBU003 00266 DTSBU003 -00267 MOVE CHRISTMAS-DAY TO L001-FED-8-DATE-9. DTSBU003 +00267 MOVE CHRISTMAS-EVE TO L001-FED-8-DATE-9. CL**8 00268 DTSBU003 00269 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 00270 DTSBU003 -00271 DISPLAY ' CHRISTMAS DAY: ' DTSBU003 +00271 DISPLAY ' CHRISTMAS EVE: ' CL**8 00272 L001-SLASH-8-DATE. DTSBU003 00273 DTSBU003 -00274 DTSBU003 -00275 MOVE NEW-YEARS-EVE TO L001-FED-8-DATE-9. DTSBU003 -00276 DTSBU003 -00277 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00278 DTSBU003 -00279 DISPLAY ' NEW YEARS EVE: ' DTSBU003 -00280 L001-SLASH-8-DATE. DTSBU003 -00281 DTSBU003 +00274 CL**6 +00275 MOVE CHRISTMAS-DAY TO L001-FED-8-DATE-9. CL**8 +00276 CL**6 +00277 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**6 +00278 CL**6 +00279 DISPLAY ' CHRISTMAS DAY: ' CL**8 +00280 L001-SLASH-8-DATE. CL**6 +00281 CL**6 00282 DTSBU003 -00283 DISPLAY ' '. DTSBU003 +00283 MOVE NEW-YEARS-EVE TO L001-FED-8-DATE-9. DTSBU003 00284 DTSBU003 -00285 DISPLAY '*** IF ANY OF THE ABOVE DATES ARE NOT CORRECT, ' DTSBU003 -00286 'CONTACT UI TAX PROGRAMMER IMMEDIATELY.'. DTSBU003 -00287 I1000-EXIT. DTSBU003 -00288 EXIT. DTSBU003 -00289 EJECT DTSBU003 -00290 I1100-WRITE-HOLIDAYS. DTSBU003 -00291 MOVE SPACES TO HDAY-DAY-FILLER FILLER2. DTSBU003 -00292 MOVE NEW-YEARS-DAY TO L001-FED-8-DATE-9. DTSBU003 -00293 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00294 MOVE ' NEW YEARS DAY' TO HDAY-DAY DTSBU003 -00295 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00296 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 -00297 DTSBU003 -00298 MOVE MARTIN-LUTHER-KING-DAY TO L001-FED-8-DATE-9. DTSBU003 -00299 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00300 MOVE ' MARTIN LUTHER KING DAY' TO HDAY-DAY. DTSBU003 -00301 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00302 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 -00303 DTSBU003 -00304 MOVE INAGURATION-DAY TO L001-FED-8-DATE-9. DTSBU003 -00305 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00306 MOVE ' INAGURATION DAY' TO HDAY-DAY. DTSBU003 -00307 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00308 IF HDAY-DATE = '0000000000' DTSBU003 -00309 MOVE SPACES TO HDAY-DATE. DTSBU003 +00285 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00286 DTSBU003 +00287 DISPLAY ' NEW YEARS EVE: ' DTSBU003 +00288 L001-SLASH-8-DATE. DTSBU003 +00289 DTSBU003 +00290 DTSBU003 +00291 DISPLAY ' '. DTSBU003 +00292 DTSBU003 +00293 DISPLAY '*** IF ANY OF THE ABOVE DATES ARE NOT CORRECT, ' DTSBU003 +00294 'CONTACT UI TAX PROGRAMMER IMMEDIATELY.'. DTSBU003 +00295 I1000-EXIT. DTSBU003 +00296 EXIT. DTSBU003 +00297 EJECT DTSBU003 +00298 I1100-WRITE-HOLIDAYS. DTSBU003 +00299 MOVE SPACES TO HDAY-DAY-FILLER FILLER2. DTSBU003 +00300 MOVE NEW-YEARS-DAY TO L001-FED-8-DATE-9. DTSBU003 +00301 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00302 MOVE ' NEW YEARS DAY' TO HDAY-DAY DTSBU003 +00303 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00304 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00305 DTSBU003 +00306 MOVE MARTIN-LUTHER-KING-DAY TO L001-FED-8-DATE-9. DTSBU003 +00307 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00308 MOVE ' MARTIN LUTHER KING DAY' TO HDAY-DAY. DTSBU003 +00309 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 00310 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 00311 DTSBU003 -00312 MOVE PRESIDENTS-DAY TO L001-FED-8-DATE-9. DTSBU003 +00312 MOVE INAGURATION-DAY TO L001-FED-8-DATE-9. DTSBU003 00313 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00314 MOVE ' PRESIDENTS DAY' TO HDAY-DAY. DTSBU003 +00314 MOVE ' INAGURATION DAY' TO HDAY-DAY. DTSBU003 00315 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00316 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 -00317 DTSBU003 -00318 ** MOVE EMANCIPATION-DAY TO L001-FED-8-DATE-9. DTSBU003 -00319 ** PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00320 ** MOVE ' EMANCIPATION DAY' TO HDAY-DAY. DTSBU003 -00321 ** MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00322 ** IF HDAY-DATE = '0000000000' DTSBU003 -00323 ** MOVE SPACES TO HDAY-DATE. DTSBU003 -00324 ** WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00316 IF HDAY-DATE = '0000000000' DTSBU003 +00317 MOVE SPACES TO HDAY-DATE. DTSBU003 +00318 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00319 DTSBU003 +00320 MOVE PRESIDENTS-DAY TO L001-FED-8-DATE-9. DTSBU003 +00321 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00322 MOVE ' PRESIDENTS DAY' TO HDAY-DAY. DTSBU003 +00323 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00324 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 00325 DTSBU003 -00326 DTSBU003 -00327 MOVE MEMORIAL-DAY TO L001-FED-8-DATE-9. DTSBU003 -00328 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00329 MOVE ' MEMORIAL DAY' TO HDAY-DAY. DTSBU003 -00330 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00331 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 -00332 DTSBU003 -00333 DTSBU003 -00334 MOVE INDEPENDENCE-DAY TO L001-FED-8-DATE-9. DTSBU003 -00335 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00336 MOVE ' INDEPENDENCE DAY' TO HDAY-DAY. DTSBU003 -00337 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00338 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00326 MOVE MEMORIAL-DAY TO L001-FED-8-DATE-9. DTSBU003 +00327 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00328 MOVE ' MEMORIAL DAY' TO HDAY-DAY. DTSBU003 +00329 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00330 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00331 DTSBU003 +00332 CL**3 +00333 MOVE JUNETEENTH-DAY TO L001-FED-8-DATE-9. CL**3 +00334 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**3 +00335 MOVE ' JUNETEENTH DAY' TO HDAY-DAY. CL**3 +00336 MOVE L001-SLASH-8-DATE TO HDAY-DATE. CL**3 +00337 WRITE HDAY-DATA FROM WRK-HDAY-AREA. CL**3 +00338 CL**3 00339 DTSBU003 -00340 DTSBU003 -00341 MOVE LABOR-DAY TO L001-FED-8-DATE-9. DTSBU003 -00342 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00343 MOVE ' LABOR DAY' TO HDAY-DAY. DTSBU003 -00344 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00345 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00340 MOVE INDEPENDENCE-DAY TO L001-FED-8-DATE-9. DTSBU003 +00341 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00342 MOVE ' INDEPENDENCE DAY' TO HDAY-DAY. DTSBU003 +00343 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00344 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00345 DTSBU003 00346 DTSBU003 -00347 DTSBU003 -00348 MOVE COLUMBUS-DAY TO L001-FED-8-DATE-9. DTSBU003 -00349 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00350 MOVE ' COLUMBUS DAY' TO HDAY-DAY. DTSBU003 -00351 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00352 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00347 MOVE LABOR-DAY TO L001-FED-8-DATE-9. DTSBU003 +00348 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00349 MOVE ' LABOR DAY' TO HDAY-DAY. DTSBU003 +00350 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00351 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00352 DTSBU003 00353 DTSBU003 -00354 DTSBU003 -00355 MOVE VETERANS-DAY TO L001-FED-8-DATE-9. DTSBU003 -00356 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00357 MOVE ' VETERANS DAY' TO HDAY-DAY. DTSBU003 -00358 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00359 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00354 MOVE COLUMBUS-DAY TO L001-FED-8-DATE-9. DTSBU003 +00355 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00356 MOVE ' COLUMBUS DAY' TO HDAY-DAY. DTSBU003 +00357 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00358 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00359 DTSBU003 00360 DTSBU003 -00361 DTSBU003 -00362 MOVE THANKSGIVING-DAY TO L001-FED-8-DATE-9. DTSBU003 -00363 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00364 MOVE ' THANKSGIVING DAY' TO HDAY-DAY. DTSBU003 -00365 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00366 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00361 MOVE VETERANS-DAY TO L001-FED-8-DATE-9. DTSBU003 +00362 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00363 MOVE ' VETERANS DAY' TO HDAY-DAY. DTSBU003 +00364 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00365 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00366 DTSBU003 00367 DTSBU003 -00368 DTSBU003 -00369 MOVE CHRISTMAS-DAY TO L001-FED-8-DATE-9. DTSBU003 -00370 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00371 MOVE ' CHRISTMAS DAY' TO HDAY-DAY. DTSBU003 -00372 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00373 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00368 MOVE THANKSGIVING-DAY TO L001-FED-8-DATE-9. DTSBU003 +00369 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00370 MOVE ' THANKSGIVING DAY' TO HDAY-DAY. DTSBU003 +00371 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00372 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00373 DTSBU003 00374 DTSBU003 -00375 DTSBU003 -00376 MOVE NEW-YEARS-EVE TO L001-FED-8-DATE-9. DTSBU003 -00377 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00378 MOVE ' NEW YEARS EVE' TO HDAY-DAY. DTSBU003 -00379 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 -00380 IF HDAY-DATE = '0000000000' DTSBU003 -00381 MOVE SPACES TO HDAY-DATE. DTSBU003 -00382 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 -00383 CLOSE HDAY-FILE. DTSBU003 -00384 I1100-EXIT. DTSBU003 -00385 EXIT. DTSBU003 -00386 EJECT DTSBU003 -00387 P0000-PROCESS. DTSBU003 -00388 MOVE L003-DATE TO L001-FED-8-DATE-9. DTSBU003 -00389 DTSBU003 +00375 MOVE CHRISTMAS-EVE TO L001-FED-8-DATE-9. CL**6 +00376 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00377 MOVE ' CHRISTMAS EVE' TO HDAY-DAY. CL**6 +00378 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00379 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00380 DTSBU003 +00381 CL**6 +00382 MOVE CHRISTMAS-DAY TO L001-FED-8-DATE-9. CL**6 +00383 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**6 +00384 MOVE ' CHRISTMAS DAY' TO HDAY-DAY. CL**6 +00385 MOVE L001-SLASH-8-DATE TO HDAY-DATE. CL**6 +00386 WRITE HDAY-DATA FROM WRK-HDAY-AREA. CL**6 +00387 CL**6 +00388 DTSBU003 +00389 MOVE NEW-YEARS-EVE TO L001-FED-8-DATE-9. DTSBU003 00390 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00391 DTSBU003 -00392 IF L001-INVALID-DATE DTSBU003 -00393 MOVE 'L003-DATE IS NOT A VALID DATE' DTSBU003 -00394 TO WRK-ABEND-MSG DTSBU003 -00395 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00396 DTSBU003 -00397 DTSBU003 -00398 IF L001-SATURDAY OR L001-SUNDAY DTSBU003 -00399 SET L003-NOT-WORK-DAY TO TRUE DTSBU003 -00400 ELSE DTSBU003 -00401 SET L003-IS-WORK-DAY TO TRUE DTSBU003 -00402 PERFORM P1000-CHECK-FOR-HOLIDAY THRU P1000-EXIT. DTSBU003 -00403 P0000-EXIT. DTSBU003 -00404 EXIT. DTSBU003 -00405 EJECT DTSBU003 -00406 P1000-CHECK-FOR-HOLIDAY. DTSBU003 -00407 MOVE L003-DATE TO L001-FED-8-DATE-9. DTSBU003 -00408 DTSBU003 -00409 IF L001-FED-8-YR = HOLIDAY-YEAR DTSBU003 -00410 NEXT SENTENCE DTSBU003 -00411 ELSE DTSBU003 -00412 MOVE L001-FED-8-YR TO HOLIDAY-YEAR DTSBU003 -00413 PERFORM S1000-DETERMINE-HOLIDAYS THRU S1000-EXIT. DTSBU003 -00414 DTSBU003 -00415 PERFORM DTSBU003 -00416 VARYING HOLIDAY-IDX FROM 1 BY 1 DTSBU003 -00417 UNTIL HOLIDAY-IDX > HOLIDAY-CNT DTSBU003 -00418 IF HOLIDAY-DATE (HOLIDAY-IDX) = L003-DATE DTSBU003 -00419 SET L003-NOT-WORK-DAY TO TRUE DTSBU003 -00420 END-IF DTSBU003 -00421 END-PERFORM. DTSBU003 -00422 P1000-EXIT. DTSBU003 -00423 EXIT. DTSBU003 -00424 EJECT DTSBU003 -00425 S1000-DETERMINE-HOLIDAYS. DTSBU003 -00426 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00391 MOVE ' NEW YEARS EVE' TO HDAY-DAY. DTSBU003 +00392 MOVE L001-SLASH-8-DATE TO HDAY-DATE. DTSBU003 +00393 IF HDAY-DATE = '0000000000' DTSBU003 +00394 MOVE SPACES TO HDAY-DATE. DTSBU003 +00395 WRITE HDAY-DATA FROM WRK-HDAY-AREA. DTSBU003 +00396 CLOSE HDAY-FILE. DTSBU003 +00397 I1100-EXIT. DTSBU003 +00398 EXIT. DTSBU003 +00399 EJECT DTSBU003 +00400 P0000-PROCESS. DTSBU003 +00401 MOVE L003-DATE TO L001-FED-8-DATE-9. DTSBU003 +00402 DTSBU003 +00403 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00404 DTSBU003 +00405 IF L001-INVALID-DATE DTSBU003 +00406 MOVE 'L003-DATE IS NOT A VALID DATE' DTSBU003 +00407 TO WRK-ABEND-MSG DTSBU003 +00408 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00409 DTSBU003 +00410 DTSBU003 +00411 IF L001-SATURDAY OR L001-SUNDAY DTSBU003 +00412 SET L003-NOT-WORK-DAY TO TRUE DTSBU003 +00413 ELSE DTSBU003 +00414 SET L003-IS-WORK-DAY TO TRUE DTSBU003 +00415 PERFORM P1000-CHECK-FOR-HOLIDAY THRU P1000-EXIT. DTSBU003 +00416 P0000-EXIT. DTSBU003 +00417 EXIT. DTSBU003 +00418 EJECT DTSBU003 +00419 P1000-CHECK-FOR-HOLIDAY. DTSBU003 +00420 MOVE L003-DATE TO L001-FED-8-DATE-9. DTSBU003 +00421 DTSBU003 +00422 IF L001-FED-8-YR = HOLIDAY-YEAR DTSBU003 +00423 NEXT SENTENCE DTSBU003 +00424 ELSE DTSBU003 +00425 MOVE L001-FED-8-YR TO HOLIDAY-YEAR DTSBU003 +00426 PERFORM S1000-DETERMINE-HOLIDAYS THRU S1000-EXIT. DTSBU003 00427 DTSBU003 -00428 MOVE 01 TO L001-FED-8-MO. DTSBU003 -00429 DTSBU003 -00430 MOVE 01 TO L001-FED-8-DA. DTSBU003 -00431 DTSBU003 -00432 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00433 DTSBU003 -00434 IF L001-INVALID-DATE DTSBU003 -00435 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:001' DTSBU003 -00436 TO WRK-ABEND-MSG DTSBU003 -00437 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00438 DTSBU003 -00439 IF L001-SUNDAY DTSBU003 -00440 MOVE 02 TO L001-FED-8-DA DTSBU003 -00441 MOVE L001-FED-8-DATE-9 DTSBU003 -00442 TO NEW-YEARS-DAY DTSBU003 -00443 ELSE DTSBU003 -00444 IF L001-SATURDAY DTSBU003 -00445 MOVE 0 TO NEW-YEARS-DAY DTSBU003 -00446 ELSE DTSBU003 -00447 MOVE L001-FED-8-DATE-9 TO NEW-YEARS-DAY. DTSBU003 -00448 DTSBU003 -00449 DTSBU003 -00450 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00428 PERFORM DTSBU003 +00429 VARYING HOLIDAY-IDX FROM 1 BY 1 DTSBU003 +00430 UNTIL HOLIDAY-IDX > HOLIDAY-CNT DTSBU003 +00431 IF HOLIDAY-DATE (HOLIDAY-IDX) = L003-DATE DTSBU003 +00432 SET L003-NOT-WORK-DAY TO TRUE DTSBU003 +00433 END-IF DTSBU003 +00434 END-PERFORM. DTSBU003 +00435 P1000-EXIT. DTSBU003 +00436 EXIT. DTSBU003 +00437 EJECT DTSBU003 +00438 S1000-DETERMINE-HOLIDAYS. DTSBU003 +00439 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00440 DTSBU003 +00441 MOVE 01 TO L001-FED-8-MO. DTSBU003 +00442 DTSBU003 +00443 MOVE 01 TO L001-FED-8-DA. DTSBU003 +00444 DTSBU003 +00445 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00446 DTSBU003 +00447 IF L001-INVALID-DATE DTSBU003 +00448 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:001' DTSBU003 +00449 TO WRK-ABEND-MSG DTSBU003 +00450 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 00451 DTSBU003 -00452 MOVE 01 TO L001-FED-8-MO. DTSBU003 -00453 DTSBU003 -00454 MOVE 21 TO L001-FED-8-DA. DTSBU003 -00455 DTSBU003 -00456 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00457 DTSBU003 -00458 IF L001-INVALID-DATE DTSBU003 -00459 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:002' DTSBU003 -00460 TO WRK-ABEND-MSG DTSBU003 -00461 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00452 IF L001-SUNDAY DTSBU003 +00453 MOVE 02 TO L001-FED-8-DA DTSBU003 +00454 MOVE L001-FED-8-DATE-9 DTSBU003 +00455 TO NEW-YEARS-DAY DTSBU003 +00456 ELSE DTSBU003 +00457 IF L001-SATURDAY DTSBU003 +00458 MOVE 0 TO NEW-YEARS-DAY DTSBU003 +00459 ELSE DTSBU003 +00460 MOVE L001-FED-8-DATE-9 TO NEW-YEARS-DAY. DTSBU003 +00461 DTSBU003 00462 DTSBU003 -00463 IF L001-MONDAY DTSBU003 -00464 NEXT SENTENCE DTSBU003 -00465 ELSE DTSBU003 -00466 IF L001-SUNDAY DTSBU003 -00467 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 6 DTSBU003 -00468 ELSE DTSBU003 -00469 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00470 = L001-JUL-ABS-DAY - (L001-DAY-OF-WEEK - 2). DTSBU003 -00471 DTSBU003 -00472 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00473 DTSBU003 -00474 IF L001-INVALID-DATE DTSBU003 -00475 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:003' DTSBU003 -00476 TO WRK-ABEND-MSG DTSBU003 -00477 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00478 DTSBU003 -00479 MOVE L001-FED-8-DATE-9 TO MARTIN-LUTHER-KING-DAY. DTSBU003 -00480 DTSBU003 -00481 DTSBU003 -00482 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00483 DTSBU003 -00484 MOVE 01 TO L001-FED-8-MO. DTSBU003 -00485 DTSBU003 -00486 MOVE 20 TO L001-FED-8-DA. DTSBU003 -00487 DTSBU003 -00488 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00489 DTSBU003 -00490 IF L001-INVALID-DATE DTSBU003 -00491 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:004' DTSBU003 -00492 TO WRK-ABEND-MSG DTSBU003 -00493 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00463 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00464 DTSBU003 +00465 MOVE 01 TO L001-FED-8-MO. DTSBU003 +00466 DTSBU003 +00467 MOVE 21 TO L001-FED-8-DA. DTSBU003 +00468 DTSBU003 +00469 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00470 DTSBU003 +00471 IF L001-INVALID-DATE DTSBU003 +00472 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:002' DTSBU003 +00473 TO WRK-ABEND-MSG DTSBU003 +00474 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00475 DTSBU003 +00476 IF L001-MONDAY DTSBU003 +00477 NEXT SENTENCE DTSBU003 +00478 ELSE DTSBU003 +00479 IF L001-SUNDAY DTSBU003 +00480 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 6 DTSBU003 +00481 ELSE DTSBU003 +00482 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00483 = L001-JUL-ABS-DAY - (L001-DAY-OF-WEEK - 2). DTSBU003 +00484 DTSBU003 +00485 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00486 DTSBU003 +00487 IF L001-INVALID-DATE DTSBU003 +00488 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:003' DTSBU003 +00489 TO WRK-ABEND-MSG DTSBU003 +00490 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00491 DTSBU003 +00492 MOVE L001-FED-8-DATE-9 TO MARTIN-LUTHER-KING-DAY. DTSBU003 +00493 DTSBU003 00494 DTSBU003 -00495 DIVIDE L001-FED-8-YR BY 4 DTSBU003 -00496 GIVING WRK-RESULT DTSBU003 -00497 REMAINDER WRK-REMAINDER. DTSBU003 +00495 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00496 DTSBU003 +00497 MOVE 01 TO L001-FED-8-MO. DTSBU003 00498 DTSBU003 -00499 IF (WRK-REMAINDER NOT = 1) DTSBU003 -00500 OR DTSBU003 -00501 (L001-SATURDAY) DTSBU003 -00502 OR DTSBU003 -00503 (L001-SUNDAY) DTSBU003 -00504 OR DTSBU003 -00505 (L001-FED-8-DATE-9 = MARTIN-LUTHER-KING-DAY) DTSBU003 -00506 MOVE +0 TO INAGURATION-DAY DTSBU003 -00507 ELSE DTSBU003 -00508 MOVE L001-FED-8-DATE-9 TO INAGURATION-DAY. DTSBU003 -00509 DTSBU003 -00510 DTSBU003 -00511 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00512 DTSBU003 -00513 MOVE 02 TO L001-FED-8-MO. DTSBU003 -00514 DTSBU003 -00515 MOVE 01 TO L001-FED-8-DA. DTSBU003 -00516 DTSBU003 -00517 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00518 DTSBU003 -00519 IF L001-INVALID-DATE DTSBU003 -00520 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:005' DTSBU003 -00521 TO WRK-ABEND-MSG DTSBU003 -00522 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00499 MOVE 20 TO L001-FED-8-DA. DTSBU003 +00500 DTSBU003 +00501 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00502 DTSBU003 +00503 IF L001-INVALID-DATE DTSBU003 +00504 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:004' DTSBU003 +00505 TO WRK-ABEND-MSG DTSBU003 +00506 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00507 DTSBU003 +00508 DIVIDE L001-FED-8-YR BY 4 DTSBU003 +00509 GIVING WRK-RESULT DTSBU003 +00510 REMAINDER WRK-REMAINDER. DTSBU003 +00511 DTSBU003 +00512 IF (WRK-REMAINDER NOT = 1) DTSBU003 +00513 OR DTSBU003 +00514 (L001-SATURDAY) DTSBU003 +00515 OR DTSBU003 +00516 (L001-SUNDAY) DTSBU003 +00517 OR DTSBU003 +00518 (L001-FED-8-DATE-9 = MARTIN-LUTHER-KING-DAY) DTSBU003 +00519 MOVE +0 TO INAGURATION-DAY DTSBU003 +00520 ELSE DTSBU003 +00521 MOVE L001-FED-8-DATE-9 TO INAGURATION-DAY. DTSBU003 +00522 DTSBU003 00523 DTSBU003 -00524 IF L001-DAY-OF-WEEK < 3 DTSBU003 -00525 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00526 = L001-JUL-ABS-DAY + 16 - L001-DAY-OF-WEEK DTSBU003 -00527 ELSE DTSBU003 -00528 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00529 = L001-JUL-ABS-DAY + 23 - L001-DAY-OF-WEEK. DTSBU003 -00530 DTSBU003 -00531 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00532 DTSBU003 -00533 IF L001-INVALID-DATE DTSBU003 -00534 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:006' DTSBU003 -00535 TO WRK-ABEND-MSG DTSBU003 -00536 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00537 DTSBU003 -00538 MOVE L001-FED-8-DATE-9 TO PRESIDENTS-DAY. DTSBU003 -00539 DTSBU003 -00540 DTSBU003 -00541 ** MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00542 DTSBU003 -00543 ** MOVE 04 TO L001-FED-8-MO. DTSBU003 -00544 DTSBU003 -00545 ** MOVE 16 TO L001-FED-8-DA. DTSBU003 -00546 DTSBU003 -00547 ** PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00548 DTSBU003 -00549 ** IF L001-INVALID-DATE DTSBU003 -00550 ** MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:007' DTSBU003 -00551 ** TO WRK-ABEND-MSG DTSBU003 -00552 ** PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00524 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00525 DTSBU003 +00526 MOVE 02 TO L001-FED-8-MO. DTSBU003 +00527 DTSBU003 +00528 MOVE 01 TO L001-FED-8-DA. DTSBU003 +00529 DTSBU003 +00530 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00531 DTSBU003 +00532 IF L001-INVALID-DATE DTSBU003 +00533 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:005' DTSBU003 +00534 TO WRK-ABEND-MSG DTSBU003 +00535 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00536 DTSBU003 +00537 IF L001-DAY-OF-WEEK < 3 DTSBU003 +00538 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00539 = L001-JUL-ABS-DAY + 16 - L001-DAY-OF-WEEK DTSBU003 +00540 ELSE DTSBU003 +00541 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00542 = L001-JUL-ABS-DAY + 23 - L001-DAY-OF-WEEK. DTSBU003 +00543 DTSBU003 +00544 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00545 DTSBU003 +00546 IF L001-INVALID-DATE DTSBU003 +00547 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:006' DTSBU003 +00548 TO WRK-ABEND-MSG DTSBU003 +00549 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00550 DTSBU003 +00551 MOVE L001-FED-8-DATE-9 TO PRESIDENTS-DAY. DTSBU003 +00552 DTSBU003 00553 DTSBU003 -00554 DTSBU003 -00555 ** IF L001-SUNDAY DTSBU003 -00556 ** COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 DTSBU003 -00557 ** ELSE DTSBU003 -00558 ** IF L001-SATURDAY DTSBU003 -00559 ** COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. DTSBU003 -00560 DTSBU003 +00554 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00555 DTSBU003 +00556 MOVE 05 TO L001-FED-8-MO. DTSBU003 +00557 DTSBU003 +00558 MOVE 31 TO L001-FED-8-DA. DTSBU003 +00559 DTSBU003 +00560 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 00561 DTSBU003 -00562 ** PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00563 DTSBU003 -00564 ** IF L001-INVALID-DATE DTSBU003 -00565 ** MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:008' DTSBU003 -00566 ** TO WRK-ABEND-MSG DTSBU003 -00567 ** PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00568 DTSBU003 -00569 ** MOVE L001-FED-8-DATE-9 TO EMANCIPATION-DAY. DTSBU003 -00570 DTSBU003 -00571 DTSBU003 -00572 DTSBU003 -00573 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00574 DTSBU003 -00575 MOVE 05 TO L001-FED-8-MO. DTSBU003 -00576 DTSBU003 -00577 MOVE 31 TO L001-FED-8-DA. DTSBU003 -00578 DTSBU003 -00579 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00580 DTSBU003 -00581 IF L001-INVALID-DATE DTSBU003 -00582 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:007' DTSBU003 -00583 TO WRK-ABEND-MSG DTSBU003 -00584 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00585 DTSBU003 -00586 IF L001-MONDAY DTSBU003 -00587 NEXT SENTENCE DTSBU003 -00588 ELSE DTSBU003 -00589 IF L001-SUNDAY DTSBU003 -00590 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 6 DTSBU003 -00591 ELSE DTSBU003 -00592 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00593 = L001-JUL-ABS-DAY - (L001-DAY-OF-WEEK - 2). DTSBU003 -00594 DTSBU003 -00595 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00596 DTSBU003 -00597 IF L001-INVALID-DATE DTSBU003 -00598 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:008' DTSBU003 -00599 TO WRK-ABEND-MSG DTSBU003 -00600 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00601 DTSBU003 -00602 MOVE L001-FED-8-DATE-9 TO MEMORIAL-DAY. DTSBU003 -00603 DTSBU003 -00604 DTSBU003 -00605 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00606 DTSBU003 -00607 MOVE 07 TO L001-FED-8-MO. DTSBU003 -00608 DTSBU003 -00609 MOVE 04 TO L001-FED-8-DA. DTSBU003 -00610 DTSBU003 -00611 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00612 DTSBU003 -00613 IF L001-INVALID-DATE DTSBU003 -00614 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:009' DTSBU003 -00615 TO WRK-ABEND-MSG DTSBU003 -00616 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00562 IF L001-INVALID-DATE DTSBU003 +00563 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:007' DTSBU003 +00564 TO WRK-ABEND-MSG DTSBU003 +00565 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00566 DTSBU003 +00567 IF L001-MONDAY DTSBU003 +00568 NEXT SENTENCE DTSBU003 +00569 ELSE DTSBU003 +00570 IF L001-SUNDAY DTSBU003 +00571 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 6 DTSBU003 +00572 ELSE DTSBU003 +00573 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00574 = L001-JUL-ABS-DAY - (L001-DAY-OF-WEEK - 2). DTSBU003 +00575 DTSBU003 +00576 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00577 DTSBU003 +00578 IF L001-INVALID-DATE DTSBU003 +00579 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:008' DTSBU003 +00580 TO WRK-ABEND-MSG DTSBU003 +00581 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00582 DTSBU003 +00583 MOVE L001-FED-8-DATE-9 TO MEMORIAL-DAY. DTSBU003 +00584 DTSBU003 +00585 CL**2 +00586 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. CL**2 +00587 CL**2 +00588 MOVE 06 TO L001-FED-8-MO. CL**2 +00589 CL**2 +00590 MOVE 19 TO L001-FED-8-DA. CL**2 +00591 CL**2 +00592 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**2 +00593 CL**2 +00594 IF L001-INVALID-DATE CL**2 +00595 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:007' CL**2 +00596 TO WRK-ABEND-MSG CL**2 +00597 PERFORM S999-ABEND THRU S999-EXIT. CL**2 +00598 CL**2 +00599 CL**2 +00600 IF L001-SUNDAY CL**2 +00601 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 CL**2 +00602 ELSE CL**2 +00603 IF L001-SATURDAY CL**2 +00604 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. CL**2 +00605 CL**2 +00606 CL**2 +00607 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. CL**2 +00608 CL**2 +00609 IF L001-INVALID-DATE CL**2 +00610 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:008' CL**2 +00611 TO WRK-ABEND-MSG CL**2 +00612 PERFORM S999-ABEND THRU S999-EXIT. CL**2 +00613 CL**2 +00614 MOVE L001-FED-8-DATE-9 TO JUNETEENTH-DAY. CL**5 +00615 CL**2 +00616 CL**2 00617 DTSBU003 -00618 IF L001-SUNDAY DTSBU003 -00619 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 DTSBU003 -00620 ELSE DTSBU003 -00621 IF L001-SATURDAY DTSBU003 -00622 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. DTSBU003 +00618 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00619 DTSBU003 +00620 MOVE 07 TO L001-FED-8-MO. DTSBU003 +00621 DTSBU003 +00622 MOVE 04 TO L001-FED-8-DA. DTSBU003 00623 DTSBU003 -00624 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00624 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 00625 DTSBU003 00626 IF L001-INVALID-DATE DTSBU003 -00627 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:010' DTSBU003 +00627 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:009' DTSBU003 00628 TO WRK-ABEND-MSG DTSBU003 00629 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 00630 DTSBU003 -00631 MOVE L001-FED-8-DATE-9 TO INDEPENDENCE-DAY. DTSBU003 -00632 DTSBU003 -00633 DTSBU003 -00634 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00635 DTSBU003 -00636 MOVE 09 TO L001-FED-8-MO. DTSBU003 -00637 DTSBU003 -00638 MOVE 01 TO L001-FED-8-DA. DTSBU003 -00639 DTSBU003 -00640 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00641 DTSBU003 -00642 IF L001-INVALID-DATE DTSBU003 -00643 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:011' DTSBU003 -00644 TO WRK-ABEND-MSG DTSBU003 -00645 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00631 IF L001-SUNDAY DTSBU003 +00632 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 DTSBU003 +00633 ELSE DTSBU003 +00634 IF L001-SATURDAY DTSBU003 +00635 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. DTSBU003 +00636 DTSBU003 +00637 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00638 DTSBU003 +00639 IF L001-INVALID-DATE DTSBU003 +00640 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:010' DTSBU003 +00641 TO WRK-ABEND-MSG DTSBU003 +00642 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00643 DTSBU003 +00644 MOVE L001-FED-8-DATE-9 TO INDEPENDENCE-DAY. DTSBU003 +00645 DTSBU003 00646 DTSBU003 -00647 IF L001-DAY-OF-WEEK < 3 DTSBU003 -00648 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00649 = L001-JUL-ABS-DAY + 2 - L001-DAY-OF-WEEK DTSBU003 -00650 ELSE DTSBU003 -00651 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00652 = L001-JUL-ABS-DAY + 9 - L001-DAY-OF-WEEK. DTSBU003 -00653 DTSBU003 -00654 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00655 DTSBU003 -00656 IF L001-INVALID-DATE DTSBU003 -00657 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:012' DTSBU003 -00658 TO WRK-ABEND-MSG DTSBU003 -00659 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00660 DTSBU003 -00661 MOVE L001-FED-8-DATE-9 TO LABOR-DAY. DTSBU003 -00662 DTSBU003 -00663 DTSBU003 -00664 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00665 DTSBU003 -00666 MOVE 10 TO L001-FED-8-MO. DTSBU003 -00667 DTSBU003 -00668 MOVE 01 TO L001-FED-8-DA. DTSBU003 -00669 DTSBU003 -00670 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00671 DTSBU003 -00672 IF L001-INVALID-DATE DTSBU003 -00673 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:013' DTSBU003 -00674 TO WRK-ABEND-MSG DTSBU003 -00675 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00647 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00648 DTSBU003 +00649 MOVE 09 TO L001-FED-8-MO. DTSBU003 +00650 DTSBU003 +00651 MOVE 01 TO L001-FED-8-DA. DTSBU003 +00652 DTSBU003 +00653 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00654 DTSBU003 +00655 IF L001-INVALID-DATE DTSBU003 +00656 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:011' DTSBU003 +00657 TO WRK-ABEND-MSG DTSBU003 +00658 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00659 DTSBU003 +00660 IF L001-DAY-OF-WEEK < 3 DTSBU003 +00661 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00662 = L001-JUL-ABS-DAY + 2 - L001-DAY-OF-WEEK DTSBU003 +00663 ELSE DTSBU003 +00664 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00665 = L001-JUL-ABS-DAY + 9 - L001-DAY-OF-WEEK. DTSBU003 +00666 DTSBU003 +00667 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00668 DTSBU003 +00669 IF L001-INVALID-DATE DTSBU003 +00670 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:012' DTSBU003 +00671 TO WRK-ABEND-MSG DTSBU003 +00672 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00673 DTSBU003 +00674 MOVE L001-FED-8-DATE-9 TO LABOR-DAY. DTSBU003 +00675 DTSBU003 00676 DTSBU003 -00677 IF L001-DAY-OF-WEEK < 3 DTSBU003 -00678 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00679 = L001-JUL-ABS-DAY + 9 - L001-DAY-OF-WEEK DTSBU003 -00680 ELSE DTSBU003 -00681 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00682 = L001-JUL-ABS-DAY + 16 - L001-DAY-OF-WEEK. DTSBU003 -00683 DTSBU003 -00684 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00685 DTSBU003 -00686 IF L001-INVALID-DATE DTSBU003 -00687 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:012' DTSBU003 -00688 TO WRK-ABEND-MSG DTSBU003 -00689 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00690 DTSBU003 -00691 MOVE L001-FED-8-DATE-9 TO COLUMBUS-DAY. DTSBU003 -00692 DTSBU003 -00693 DTSBU003 -00694 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00695 DTSBU003 -00696 MOVE 11 TO L001-FED-8-MO. DTSBU003 -00697 DTSBU003 -00698 MOVE 11 TO L001-FED-8-DA. DTSBU003 -00699 DTSBU003 -00700 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00701 DTSBU003 -00702 IF L001-INVALID-DATE DTSBU003 -00703 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:014' DTSBU003 -00704 TO WRK-ABEND-MSG DTSBU003 -00705 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00677 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00678 DTSBU003 +00679 MOVE 10 TO L001-FED-8-MO. DTSBU003 +00680 DTSBU003 +00681 MOVE 01 TO L001-FED-8-DA. DTSBU003 +00682 DTSBU003 +00683 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00684 DTSBU003 +00685 IF L001-INVALID-DATE DTSBU003 +00686 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:013' DTSBU003 +00687 TO WRK-ABEND-MSG DTSBU003 +00688 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00689 DTSBU003 +00690 IF L001-DAY-OF-WEEK < 3 DTSBU003 +00691 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00692 = L001-JUL-ABS-DAY + 9 - L001-DAY-OF-WEEK DTSBU003 +00693 ELSE DTSBU003 +00694 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00695 = L001-JUL-ABS-DAY + 16 - L001-DAY-OF-WEEK. DTSBU003 +00696 DTSBU003 +00697 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00698 DTSBU003 +00699 IF L001-INVALID-DATE DTSBU003 +00700 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:012' DTSBU003 +00701 TO WRK-ABEND-MSG DTSBU003 +00702 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00703 DTSBU003 +00704 MOVE L001-FED-8-DATE-9 TO COLUMBUS-DAY. DTSBU003 +00705 DTSBU003 00706 DTSBU003 -00707 IF L001-SUNDAY DTSBU003 -00708 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 DTSBU003 -00709 ELSE DTSBU003 -00710 IF L001-SATURDAY DTSBU003 -00711 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. DTSBU003 +00707 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00708 DTSBU003 +00709 MOVE 11 TO L001-FED-8-MO. DTSBU003 +00710 DTSBU003 +00711 MOVE 11 TO L001-FED-8-DA. DTSBU003 00712 DTSBU003 -00713 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00713 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 00714 DTSBU003 00715 IF L001-INVALID-DATE DTSBU003 -00716 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:015' DTSBU003 +00716 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:014' DTSBU003 00717 TO WRK-ABEND-MSG DTSBU003 00718 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 00719 DTSBU003 -00720 MOVE L001-FED-8-DATE-9 TO VETERANS-DAY. DTSBU003 -00721 DTSBU003 -00722 DTSBU003 -00723 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00724 DTSBU003 -00725 MOVE 11 TO L001-FED-8-MO. DTSBU003 -00726 DTSBU003 -00727 MOVE 01 TO L001-FED-8-DA. DTSBU003 -00728 DTSBU003 -00729 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00730 DTSBU003 -00731 IF L001-INVALID-DATE DTSBU003 -00732 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:016' DTSBU003 -00733 TO WRK-ABEND-MSG DTSBU003 -00734 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00720 IF L001-SUNDAY DTSBU003 +00721 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 DTSBU003 +00722 ELSE DTSBU003 +00723 IF L001-SATURDAY DTSBU003 +00724 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. DTSBU003 +00725 DTSBU003 +00726 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00727 DTSBU003 +00728 IF L001-INVALID-DATE DTSBU003 +00729 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:015' DTSBU003 +00730 TO WRK-ABEND-MSG DTSBU003 +00731 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00732 DTSBU003 +00733 MOVE L001-FED-8-DATE-9 TO VETERANS-DAY. DTSBU003 +00734 DTSBU003 00735 DTSBU003 -00736 IF L001-DAY-OF-WEEK < 6 DTSBU003 -00737 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00738 = L001-JUL-ABS-DAY + 26 - L001-DAY-OF-WEEK DTSBU003 -00739 ELSE DTSBU003 -00740 COMPUTE L001-JUL-ABS-DAY DTSBU003 -00741 = L001-JUL-ABS-DAY + 33 - L001-DAY-OF-WEEK. DTSBU003 -00742 DTSBU003 -00743 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00744 DTSBU003 -00745 IF L001-INVALID-DATE DTSBU003 -00746 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:017' DTSBU003 -00747 TO WRK-ABEND-MSG DTSBU003 -00748 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00749 DTSBU003 -00750 MOVE L001-FED-8-DATE-9 TO THANKSGIVING-DAY. DTSBU003 -00751 DTSBU003 -00752 DTSBU003 -00753 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00754 DTSBU003 -00755 MOVE 12 TO L001-FED-8-MO. DTSBU003 -00756 DTSBU003 -00757 MOVE 25 TO L001-FED-8-DA. DTSBU003 -00758 DTSBU003 -00759 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00760 DTSBU003 -00761 IF L001-INVALID-DATE DTSBU003 -00762 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:018' DTSBU003 -00763 TO WRK-ABEND-MSG DTSBU003 -00764 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00765 DTSBU003 -00766 IF L001-SUNDAY DTSBU003 -00767 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 DTSBU003 -00768 ELSE DTSBU003 -00769 IF L001-SATURDAY DTSBU003 -00770 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. DTSBU003 -00771 DTSBU003 -00772 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 -00773 DTSBU003 -00774 IF L001-INVALID-DATE DTSBU003 -00775 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:019' DTSBU003 -00776 TO WRK-ABEND-MSG DTSBU003 -00777 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00778 DTSBU003 -00779 MOVE L001-FED-8-DATE-9 TO CHRISTMAS-DAY. DTSBU003 -00780 DTSBU003 -00781 DTSBU003 -00782 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 -00783 DTSBU003 -00784 ADD +1 TO L001-FED-8-YR. DTSBU003 +00736 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00737 DTSBU003 +00738 MOVE 11 TO L001-FED-8-MO. DTSBU003 +00739 DTSBU003 +00740 MOVE 01 TO L001-FED-8-DA. DTSBU003 +00741 DTSBU003 +00742 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00743 DTSBU003 +00744 IF L001-INVALID-DATE DTSBU003 +00745 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:016' DTSBU003 +00746 TO WRK-ABEND-MSG DTSBU003 +00747 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00748 DTSBU003 +00749 IF L001-DAY-OF-WEEK < 6 DTSBU003 +00750 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00751 = L001-JUL-ABS-DAY + 26 - L001-DAY-OF-WEEK DTSBU003 +00752 ELSE DTSBU003 +00753 COMPUTE L001-JUL-ABS-DAY DTSBU003 +00754 = L001-JUL-ABS-DAY + 33 - L001-DAY-OF-WEEK. DTSBU003 +00755 DTSBU003 +00756 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 +00757 DTSBU003 +00758 IF L001-INVALID-DATE DTSBU003 +00759 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:017' DTSBU003 +00760 TO WRK-ABEND-MSG DTSBU003 +00761 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00762 DTSBU003 +00763 MOVE L001-FED-8-DATE-9 TO THANKSGIVING-DAY. DTSBU003 +00764 DTSBU003 +00765 *CHRISTMAS EVE 2024 - FED HOLIDAY ZL1 CL**7 +00766 CL**7 +00767 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00768 DTSBU003 +00769 MOVE 12 TO L001-FED-8-MO. DTSBU003 +00770 DTSBU003 +00771 MOVE 24 TO L001-FED-8-DA. CL**7 +00772 DTSBU003 +00773 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00774 DTSBU003 +00775 IF L001-INVALID-DATE DTSBU003 +00776 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:018' DTSBU003 +00777 TO WRK-ABEND-MSG DTSBU003 +00778 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00779 DTSBU003 +00780 IF L001-SUNDAY DTSBU003 +00781 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 DTSBU003 +00782 ELSE DTSBU003 +00783 IF L001-SATURDAY DTSBU003 +00784 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. DTSBU003 00785 DTSBU003 -00786 MOVE 01 TO L001-FED-8-MO. DTSBU003 +00786 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBU003 00787 DTSBU003 -00788 MOVE 01 TO L001-FED-8-DA. DTSBU003 -00789 DTSBU003 -00790 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 -00791 DTSBU003 -00792 IF L001-INVALID-DATE DTSBU003 -00793 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:020' DTSBU003 -00794 TO WRK-ABEND-MSG DTSBU003 -00795 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 -00796 DTSBU003 -00797 IF L001-SATURDAY DTSBU003 -00798 MOVE HOLIDAY-YEAR TO L001-FED-8-YR DTSBU003 -00799 MOVE 12 TO L001-FED-8-MO DTSBU003 -00800 MOVE 31 TO L001-FED-8-DA DTSBU003 -00801 MOVE L001-FED-8-DATE-9 TO NEW-YEARS-EVE DTSBU003 -00802 ELSE DTSBU003 -00803 MOVE +0 TO NEW-YEARS-EVE. DTSBU003 -00804 S1000-EXIT. DTSBU003 -00805 EXIT. DTSBU003 -00806 EJECT DTSBU003 -00807 S001-FROM-FED-8. DTSBU003 -00808 SET L001-FROM-FED-8 TO TRUE. DTSBU003 -00809 GO TO S001-DATE-CONVERT. DTSBU003 -00810 DTSBU003 -00811 S001-FROM-ABS-DAY. DTSBU003 -00812 SET L001-FROM-ABS-DAY TO TRUE. DTSBU003 -00813 GO TO S001-DATE-CONVERT. DTSBU003 -00814 DTSBU003 -00815 S001-DATE-CONVERT. DTSBU003 -00816 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBU003 -00817 S001-EXIT. DTSBU003 -00818 EXIT. DTSBU003 -00819 SKIP3 DTSBU003 -00820 S005-FROM-SYS. DTSBU003 -00821 SET L005-FROM-SYS TO TRUE. DTSBU003 -00822 GO TO S005-ABSTIME. DTSBU003 -00823 DTSBU003 -00824 S005-ABSTIME. DTSBU003 -00825 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBU003 -00826 S005-EXIT. DTSBU003 -00827 EXIT. DTSBU003 -00828 SKIP3 DTSBU003 -00829 S999-ABEND. DTSBU003 -00830 DISPLAY '*** ' DTSBU003 -00831 WRK-MODULE-NAME DTSBU003 -00832 ' IS ABENDING: ' DTSBU003 -00833 WRK-ABEND-MSG. DTSBU003 -00834 DTSBU003 -00835 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU003 -00836 S999-EXIT. DTSBU003 -00837 EXIT. DTSBU003 +00788 IF L001-INVALID-DATE DTSBU003 +00789 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:019' DTSBU003 +00790 TO WRK-ABEND-MSG DTSBU003 +00791 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00792 DTSBU003 +00793 MOVE L001-FED-8-DATE-9 TO CHRISTMAS-EVE. CL**7 +00794 DTSBU003 +00795 DTSBU003 +00796 CL**7 +00797 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. CL**7 +00798 CL**7 +00799 MOVE 12 TO L001-FED-8-MO. CL**7 +00800 CL**7 +00801 MOVE 25 TO L001-FED-8-DA. CL**7 +00802 CL**7 +00803 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**7 +00804 CL**7 +00805 IF L001-INVALID-DATE CL**7 +00806 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:018' CL**7 +00807 TO WRK-ABEND-MSG CL**7 +00808 PERFORM S999-ABEND THRU S999-EXIT. CL**7 +00809 CL**7 +00810 IF L001-SUNDAY CL**7 +00811 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY + 1 CL**7 +00812 ELSE CL**7 +00813 IF L001-SATURDAY CL**7 +00814 COMPUTE L001-JUL-ABS-DAY = L001-JUL-ABS-DAY - 1. CL**7 +00815 CL**7 +00816 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. CL**7 +00817 CL**7 +00818 IF L001-INVALID-DATE CL**7 +00819 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:019' CL**7 +00820 TO WRK-ABEND-MSG CL**7 +00821 PERFORM S999-ABEND THRU S999-EXIT. CL**7 +00822 CL**7 +00823 MOVE L001-FED-8-DATE-9 TO CHRISTMAS-DAY. CL**7 +00824 CL**7 +00825 CL**7 +00826 MOVE HOLIDAY-YEAR TO L001-FED-8-YR. DTSBU003 +00827 DTSBU003 +00828 ADD +1 TO L001-FED-8-YR. DTSBU003 +00829 DTSBU003 +00830 MOVE 01 TO L001-FED-8-MO. DTSBU003 +00831 DTSBU003 +00832 MOVE 01 TO L001-FED-8-DA. DTSBU003 +00833 DTSBU003 +00834 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU003 +00835 DTSBU003 +00836 IF L001-INVALID-DATE DTSBU003 +00837 MOVE 'UNEXPECTED L001-INVALID-DATE AT S1000:020' DTSBU003 +00838 TO WRK-ABEND-MSG DTSBU003 +00839 PERFORM S999-ABEND THRU S999-EXIT. DTSBU003 +00840 DTSBU003 +00841 IF L001-SATURDAY DTSBU003 +00842 MOVE HOLIDAY-YEAR TO L001-FED-8-YR DTSBU003 +00843 MOVE 12 TO L001-FED-8-MO DTSBU003 +00844 MOVE 31 TO L001-FED-8-DA DTSBU003 +00845 MOVE L001-FED-8-DATE-9 TO NEW-YEARS-EVE DTSBU003 +00846 ELSE DTSBU003 +00847 MOVE +0 TO NEW-YEARS-EVE. DTSBU003 +00848 S1000-EXIT. DTSBU003 +00849 EXIT. DTSBU003 +00850 EJECT DTSBU003 +00851 S001-FROM-FED-8. DTSBU003 +00852 SET L001-FROM-FED-8 TO TRUE. DTSBU003 +00853 GO TO S001-DATE-CONVERT. DTSBU003 +00854 DTSBU003 +00855 S001-FROM-ABS-DAY. DTSBU003 +00856 SET L001-FROM-ABS-DAY TO TRUE. DTSBU003 +00857 GO TO S001-DATE-CONVERT. DTSBU003 +00858 DTSBU003 +00859 S001-DATE-CONVERT. DTSBU003 +00860 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBU003 +00861 S001-EXIT. DTSBU003 +00862 EXIT. DTSBU003 +00863 SKIP3 DTSBU003 +00864 S005-FROM-SYS. DTSBU003 +00865 SET L005-FROM-SYS TO TRUE. DTSBU003 +00866 GO TO S005-ABSTIME. DTSBU003 +00867 DTSBU003 +00868 S005-ABSTIME. DTSBU003 +00869 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBU003 +00870 S005-EXIT. DTSBU003 +00871 EXIT. DTSBU003 +00872 SKIP3 DTSBU003 +00873 S999-ABEND. DTSBU003 +00874 DISPLAY '*** ' DTSBU003 +00875 WRK-MODULE-NAME DTSBU003 +00876 ' IS ABENDING: ' DTSBU003 +00877 WRK-ABEND-MSG. DTSBU003 +00878 DTSBU003 +00879 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU003 +00880 S999-EXIT. DTSBU003 +00881 EXIT. DTSBU003 diff --git a/Batch/DTSBU031.cob b/Batch/DTSBU031.cob index 4bc13d0..3fbdad3 100644 --- a/Batch/DTSBU031.cob +++ b/Batch/DTSBU031.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 05/08/20 +00001 IDENTIFICATION DIVISION. 09/02/20 00002 PROGRAM-ID. DTSBU031. DTSBU031 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV030 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. SEPTEMBER 1998. DTSBU031 00005 DATE-COMPILED. DTSBU031 00006 SKIP3 DTSBU031 @@ -61,275 +61,279 @@ 00061 * 04/24/2020 RECOMPILED: ADDED ELIG CODES FOR PEUC DTSBU031 00062 * WORK ORDER: PANDEMIC PROGRAMMER: ZL1 DTSBU031 00063 * DTSBU031 -00064 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU031 -00065 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU031 -00066 * WORK ORDER: PROGRAMMER: XXX DTSBU031 -00067 * DTSBU031 -00068 * DTSBU031 -00069 * DESCRIPTION: DTSBU031 +00064 * 09/02/2020 RECOMPILED: ADDED ELIG CODES FOR LWA CL**2 +00065 * WORK ORDER: PANDEMIC PROGRAMMER: ZL1 CL**2 +00066 * CL**2 +00067 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU031 +00068 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU031 +00069 * WORK ORDER: PROGRAMMER: XXX DTSBU031 00070 * DTSBU031 -00071 * DTSBU031 EDITS EMPLOYER REGISTRATION CODES AND INDICATORS. DTSBU031 -00072 * DTSBU031 -00073 * DTSBU031 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION DTSBU031 -00074 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU031 -00075 * VALUE. DTSBU031 -00076 * DTSBU031 -00077 * IF L031-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSBU031 -00078 * ABEND CODE OF 'U031'. DTSBU031 +00071 * DTSBU031 +00072 * DESCRIPTION: DTSBU031 +00073 * DTSBU031 +00074 * DTSBU031 EDITS EMPLOYER REGISTRATION CODES AND INDICATORS. DTSBU031 +00075 * DTSBU031 +00076 * DTSBU031 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION DTSBU031 +00077 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU031 +00078 * VALUE. DTSBU031 00079 * DTSBU031 -00080 * GO TO DEPENDING ON L031-OPTION TO GET TO THE PARAGRAPH DTSBU031 -00081 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSBU031 -00082 * BY L031-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSBU031 -00083 * VALIDITY OF L031-CD-*. DTSBU031 -00084 * DTSBU031 -00085 * IF L031-CD-* IS A VALID VALUE DTSBU031 -00086 * MOVE '1' TO L031-RESULT-IND DTSBU031 -00087 * MOVE THE APPROPRIATE C031-*-SHORT-DSCR DTSBU031 -00088 * TO L031-SHORT-DSCR DTSBU031 -00089 * MOVE THE APPROPRIATE C031-*-LONG-DSCR DTSBU031 -00090 * TO L031-LONG-DSCR DTSBU031 -00091 * ELSE DTSBU031 -00092 * MOVE '2' TO L031-RESULT-IND DTSBU031 -00093 * MOVE 'NOT VALID' TO L031-SHORT-DSCR DTSBU031 -00094 * L031-LONG-DSCR. DTSBU031 -00095 * DTSBU031 -00096 * DTSBU031 -00097 ***** DTSBU031 -00098 SKIP3 DTSBU031 -00099 ENVIRONMENT DIVISION. DTSBU031 -00100 SKIP3 DTSBU031 -00101 DATA DIVISION. DTSBU031 -00102 SKIP3 DTSBU031 -00103 WORKING-STORAGE SECTION. DTSBU031 -001035 77 PAN-VALET PICTURE X(24) VALUE '030DTSBU031 05/08/20'. DTSBU031 -00104 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU031 05/08/20'. DTSBU031 -00105 77 PAN-VALET PICTURE X(24) VALUE '028DTSBU031 04/27/20'. DTSBU031 -00106 77 PAN-VALET PICTURE X(24) VALUE '005DTSBU031 04/25/20'. DTSBU031 -00107 77 PAN-VALET PICTURE X(24) VALUE '026DTSBU031 06/19/13'. DTSBU031 -00108 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU031 04/29/13'. DTSBU031 -00109 77 PAN-VALET PICTURE X(24) VALUE '024DTSBU031 05/09/12'. DTSBU031 -00110 SKIP3 DTSBU031 -00111 01 WRK-AREA. DTSBU031 -00112 05 WRK-ABEND-CODE PIC X(04) VALUE 'U031'. DTSBU031 -00113 EJECT DTSBU031 -00114 01 C031-LITERALS. DTSBU031 -00115 ++INCLUDE DTSIC031 DTSBU031 -00116 EJECT DTSBU031 -00117 LINKAGE SECTION. DTSBU031 -00118 01 L031-LINK-AREA. DTSBU031 -00119 ++INCLUDE DTSIL031 DTSBU031 +00080 * IF L031-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSBU031 +00081 * ABEND CODE OF 'U031'. DTSBU031 +00082 * DTSBU031 +00083 * GO TO DEPENDING ON L031-OPTION TO GET TO THE PARAGRAPH DTSBU031 +00084 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSBU031 +00085 * BY L031-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSBU031 +00086 * VALIDITY OF L031-CD-*. DTSBU031 +00087 * DTSBU031 +00088 * IF L031-CD-* IS A VALID VALUE DTSBU031 +00089 * MOVE '1' TO L031-RESULT-IND DTSBU031 +00090 * MOVE THE APPROPRIATE C031-*-SHORT-DSCR DTSBU031 +00091 * TO L031-SHORT-DSCR DTSBU031 +00092 * MOVE THE APPROPRIATE C031-*-LONG-DSCR DTSBU031 +00093 * TO L031-LONG-DSCR DTSBU031 +00094 * ELSE DTSBU031 +00095 * MOVE '2' TO L031-RESULT-IND DTSBU031 +00096 * MOVE 'NOT VALID' TO L031-SHORT-DSCR DTSBU031 +00097 * L031-LONG-DSCR. DTSBU031 +00098 * DTSBU031 +00099 * DTSBU031 +00100 ***** DTSBU031 +00101 SKIP3 DTSBU031 +00102 ENVIRONMENT DIVISION. DTSBU031 +00103 SKIP3 DTSBU031 +00104 DATA DIVISION. DTSBU031 +00105 SKIP3 DTSBU031 +00106 WORKING-STORAGE SECTION. DTSBU031 +001065 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU031 09/02/20'. DTSBU031 +00107 77 PAN-VALET PICTURE X(24) VALUE '030DTSBU031 05/08/20'. DTSBU031 +00108 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU031 05/08/20'. DTSBU031 +00109 77 PAN-VALET PICTURE X(24) VALUE '028DTSBU031 04/27/20'. DTSBU031 +00110 77 PAN-VALET PICTURE X(24) VALUE '005DTSBU031 04/25/20'. DTSBU031 +00111 77 PAN-VALET PICTURE X(24) VALUE '026DTSBU031 06/19/13'. DTSBU031 +00112 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU031 04/29/13'. DTSBU031 +00113 77 PAN-VALET PICTURE X(24) VALUE '024DTSBU031 05/09/12'. DTSBU031 +00114 SKIP3 DTSBU031 +00115 01 WRK-AREA. DTSBU031 +00116 05 WRK-ABEND-CODE PIC X(04) VALUE 'U031'. DTSBU031 +00117 EJECT DTSBU031 +00118 01 C031-LITERALS. DTSBU031 +00119 ++INCLUDE DTSIC031 DTSBU031 00120 EJECT DTSBU031 -00121 PROCEDURE DIVISION USING L031-LINK-AREA. DTSBU031 -00122 SKIP2 DTSBU031 -00123 MOVE '2' TO L031-RESULT-IND. DTSBU031 -00124 MOVE 'NOT VALID' TO L031-SHORT-DSCR DTSBU031 -00125 L031-LONG-DSCR. DTSBU031 -00126 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU031 -00127 DTSBU031 -00128 GOBACK. DTSBU031 -00129 DTSBU031 -00130 P1000-PROCESS. DTSBU031 -00131 GO TO P1000-01-MPRF-EMP-CLASS DTSBU031 -00132 P1000-02-MPRF-EMP-STATUS DTSBU031 -00133 P1000-03-MPRF-ELIGIBLE-CD DTSBU031 -00134 P1000-04-MPRF-ORG-TYPE DTSBU031 -00135 P1000-05-FISCAL-AGENT-CD DTSBU031 -00136 S999-ABEND DTSBU031 -00137 S999-ABEND DTSBU031 -00138 S999-ABEND DTSBU031 -00139 S999-ABEND DTSBU031 -00140 P1000-10-MERA-SOURCE-CD DTSBU031 -00141 P1000-11-MERA-STATUS-CD DTSBU031 -00142 P1000-12-MERA-LETTER-1-CD DTSBU031 +00121 LINKAGE SECTION. DTSBU031 +00122 01 L031-LINK-AREA. DTSBU031 +00123 ++INCLUDE DTSIL031 DTSBU031 +00124 EJECT DTSBU031 +00125 PROCEDURE DIVISION USING L031-LINK-AREA. DTSBU031 +00126 SKIP2 DTSBU031 +00127 MOVE '2' TO L031-RESULT-IND. DTSBU031 +00128 MOVE 'NOT VALID' TO L031-SHORT-DSCR DTSBU031 +00129 L031-LONG-DSCR. DTSBU031 +00130 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU031 +00131 DTSBU031 +00132 GOBACK. DTSBU031 +00133 DTSBU031 +00134 P1000-PROCESS. DTSBU031 +00135 GO TO P1000-01-MPRF-EMP-CLASS DTSBU031 +00136 P1000-02-MPRF-EMP-STATUS DTSBU031 +00137 P1000-03-MPRF-ELIGIBLE-CD DTSBU031 +00138 P1000-04-MPRF-ORG-TYPE DTSBU031 +00139 P1000-05-FISCAL-AGENT-CD DTSBU031 +00140 S999-ABEND DTSBU031 +00141 S999-ABEND DTSBU031 +00142 S999-ABEND DTSBU031 00143 S999-ABEND DTSBU031 -00144 S999-ABEND DTSBU031 -00145 S999-ABEND DTSBU031 -00146 S999-ABEND DTSBU031 -00147 P1000-17-MREL-RELATION-CD DTSBU031 -00148 P1000-18-MREL-SUTA-DUMPING-CD DTSBU031 +00144 P1000-10-MERA-SOURCE-CD DTSBU031 +00145 P1000-11-MERA-STATUS-CD DTSBU031 +00146 P1000-12-MERA-LETTER-1-CD DTSBU031 +00147 S999-ABEND DTSBU031 +00148 S999-ABEND DTSBU031 00149 S999-ABEND DTSBU031 00150 S999-ABEND DTSBU031 -00151 S999-ABEND DTSBU031 -00152 P1000-22-MSOL-LIAB-CD DTSBU031 -00153 P1000-23-MSOL-INACT-CD DTSBU031 -00154 DEPENDING ON L031-OPTION. DTSBU031 -00155 SKIP1 DTSBU031 -00156 PERFORM S999-ABEND THRU S999-EXIT. DTSBU031 -00157 SKIP3 DTSBU031 -00158 P1000-01-MPRF-EMP-CLASS. DTSBU031 -00159 SET C031-01-IDX TO 1. DTSBU031 -00160 SEARCH C031-01-ENTRY DTSBU031 -00161 VARYING DTSBU031 -00162 C031-01-IDX DTSBU031 -00163 WHEN L031-CD-1 = C031-01-CD (C031-01-IDX) DTSBU031 -00164 MOVE '1' TO L031-RESULT-IND DTSBU031 -00165 MOVE C031-01-SHORT-DSCR (C031-01-IDX) DTSBU031 -00166 TO L031-SHORT-DSCR DTSBU031 -00167 MOVE C031-01-LONG-DSCR (C031-01-IDX) DTSBU031 -00168 TO L031-LONG-DSCR. DTSBU031 -00169 SKIP1 DTSBU031 -00170 GO TO P1000-EXIT. DTSBU031 -00171 SKIP3 DTSBU031 -00172 P1000-02-MPRF-EMP-STATUS. DTSBU031 -00173 SET C031-02-IDX TO 1. DTSBU031 -00174 SEARCH C031-02-ENTRY DTSBU031 -00175 VARYING DTSBU031 -00176 C031-02-IDX DTSBU031 -00177 WHEN L031-CD-1 = C031-02-CD (C031-02-IDX) DTSBU031 -00178 MOVE '1' TO L031-RESULT-IND DTSBU031 -00179 MOVE C031-02-SHORT-DSCR (C031-02-IDX) DTSBU031 -00180 TO L031-SHORT-DSCR DTSBU031 -00181 MOVE C031-02-LONG-DSCR (C031-02-IDX) DTSBU031 -00182 TO L031-LONG-DSCR. DTSBU031 -00183 SKIP1 DTSBU031 -00184 GO TO P1000-EXIT. DTSBU031 -00185 SKIP3 DTSBU031 -00186 P1000-03-MPRF-ELIGIBLE-CD. DTSBU031 -00187 SET C031-03-IDX TO 1. DTSBU031 -00188 SEARCH C031-03-ENTRY DTSBU031 -00189 VARYING DTSBU031 -00190 C031-03-IDX DTSBU031 -00191 WHEN L031-CD-3 = C031-03-CD (C031-03-IDX) DTSBU031 -00192 MOVE '1' TO L031-RESULT-IND DTSBU031 -00193 MOVE C031-03-SHORT-DSCR (C031-03-IDX) DTSBU031 -00194 TO L031-SHORT-DSCR DTSBU031 -00195 MOVE C031-03-LONG-DSCR (C031-03-IDX) DTSBU031 -00196 TO L031-LONG-DSCR. DTSBU031 -00197 SKIP1 DTSBU031 -00198 GO TO P1000-EXIT. DTSBU031 -00199 SKIP3 DTSBU031 -00200 P1000-04-MPRF-ORG-TYPE. DTSBU031 -00201 SET C031-04-IDX TO 1. DTSBU031 -00202 SEARCH C031-04-ENTRY DTSBU031 -00203 VARYING DTSBU031 -00204 C031-04-IDX DTSBU031 -00205 WHEN L031-CD-3 = C031-04-CD (C031-04-IDX) DTSBU031 -00206 MOVE '1' TO L031-RESULT-IND DTSBU031 -00207 MOVE C031-04-SHORT-DSCR (C031-04-IDX) DTSBU031 -00208 TO L031-SHORT-DSCR DTSBU031 -00209 MOVE C031-04-LONG-DSCR (C031-04-IDX) DTSBU031 -00210 TO L031-LONG-DSCR. DTSBU031 -00211 SKIP1 DTSBU031 -00212 GO TO P1000-EXIT. DTSBU031 -00213 SKIP3 DTSBU031 -00214 P1000-05-FISCAL-AGENT-CD. DTSBU031 -00215 SET C031-05-IDX TO 1. DTSBU031 -00216 SEARCH C031-05-ENTRY DTSBU031 -00217 VARYING DTSBU031 -00218 C031-05-IDX DTSBU031 -00219 WHEN L031-CD-3 = C031-05-CD (C031-05-IDX) DTSBU031 -00220 MOVE '1' TO L031-RESULT-IND DTSBU031 -00221 MOVE C031-05-SHORT-DSCR (C031-05-IDX) DTSBU031 -00222 TO L031-SHORT-DSCR DTSBU031 -00223 MOVE C031-05-LONG-DSCR (C031-05-IDX) DTSBU031 -00224 TO L031-LONG-DSCR. DTSBU031 -00225 SKIP1 DTSBU031 -00226 GO TO P1000-EXIT. DTSBU031 -00227 SKIP3 DTSBU031 -00228 P1000-10-MERA-SOURCE-CD. DTSBU031 -00229 SET C031-10-IDX TO 1. DTSBU031 -00230 SEARCH C031-10-ENTRY DTSBU031 -00231 VARYING DTSBU031 -00232 C031-10-IDX DTSBU031 -00233 WHEN L031-CD-2 = C031-10-CD (C031-10-IDX) DTSBU031 -00234 MOVE '1' TO L031-RESULT-IND DTSBU031 -00235 MOVE C031-10-SHORT-DSCR (C031-10-IDX) DTSBU031 -00236 TO L031-SHORT-DSCR DTSBU031 -00237 MOVE C031-10-LONG-DSCR (C031-10-IDX) DTSBU031 -00238 TO L031-LONG-DSCR. DTSBU031 -00239 SKIP1 DTSBU031 -00240 GO TO P1000-EXIT. DTSBU031 -00241 SKIP3 DTSBU031 -00242 P1000-11-MERA-STATUS-CD. DTSBU031 -00243 SET C031-11-IDX TO 1. DTSBU031 -00244 SEARCH C031-11-ENTRY DTSBU031 -00245 VARYING DTSBU031 -00246 C031-11-IDX DTSBU031 -00247 WHEN L031-CD-2 = C031-11-CD (C031-11-IDX) DTSBU031 -00248 MOVE '1' TO L031-RESULT-IND DTSBU031 -00249 MOVE C031-11-SHORT-DSCR (C031-11-IDX) DTSBU031 -00250 TO L031-SHORT-DSCR DTSBU031 -00251 MOVE C031-11-LONG-DSCR (C031-11-IDX) DTSBU031 -00252 TO L031-LONG-DSCR. DTSBU031 -00253 SKIP1 DTSBU031 -00254 GO TO P1000-EXIT. DTSBU031 -00255 SKIP3 DTSBU031 -00256 P1000-12-MERA-LETTER-1-CD. DTSBU031 -00257 SET C031-12-IDX TO 1. DTSBU031 -00258 SEARCH C031-12-ENTRY DTSBU031 -00259 VARYING DTSBU031 -00260 C031-12-IDX DTSBU031 -00261 WHEN L031-CD-2 = C031-12-CD (C031-12-IDX) DTSBU031 -00262 MOVE '1' TO L031-RESULT-IND DTSBU031 -00263 MOVE C031-12-SHORT-DSCR (C031-12-IDX) DTSBU031 -00264 TO L031-SHORT-DSCR DTSBU031 -00265 MOVE C031-12-LONG-DSCR (C031-12-IDX) DTSBU031 -00266 TO L031-LONG-DSCR. DTSBU031 -00267 SKIP1 DTSBU031 -00268 GO TO P1000-EXIT. DTSBU031 -00269 SKIP3 DTSBU031 -00270 P1000-17-MREL-RELATION-CD. DTSBU031 -00271 SET C031-17-IDX TO 1. DTSBU031 -00272 SEARCH C031-17-ENTRY DTSBU031 -00273 VARYING DTSBU031 -00274 C031-17-IDX DTSBU031 -00275 WHEN L031-CD-2 = C031-17-CD (C031-17-IDX) DTSBU031 -00276 MOVE '1' TO L031-RESULT-IND DTSBU031 -00277 MOVE C031-17-SHORT-DSCR (C031-17-IDX) DTSBU031 -00278 TO L031-SHORT-DSCR DTSBU031 -00279 MOVE C031-17-LONG-DSCR (C031-17-IDX) DTSBU031 -00280 TO L031-LONG-DSCR. DTSBU031 -00281 SKIP1 DTSBU031 -00282 GO TO P1000-EXIT. DTSBU031 -00283 SKIP3 DTSBU031 -00284 P1000-18-MREL-SUTA-DUMPING-CD. DTSBU031 -00285 SET C031-18-IDX TO 1. DTSBU031 -00286 SEARCH C031-18-ENTRY DTSBU031 -00287 VARYING DTSBU031 -00288 C031-18-IDX DTSBU031 -00289 WHEN L031-CD-1 = C031-18-CD (C031-18-IDX) DTSBU031 -00290 MOVE '1' TO L031-RESULT-IND DTSBU031 -00291 MOVE C031-18-SHORT-DSCR (C031-18-IDX) DTSBU031 -00292 TO L031-SHORT-DSCR DTSBU031 -00293 MOVE C031-18-LONG-DSCR (C031-18-IDX) DTSBU031 -00294 TO L031-LONG-DSCR. DTSBU031 -00295 SKIP1 DTSBU031 -00296 GO TO P1000-EXIT. DTSBU031 -00297 SKIP3 DTSBU031 -00298 P1000-22-MSOL-LIAB-CD. DTSBU031 -00299 SET C031-22-IDX TO 1. DTSBU031 -00300 SEARCH C031-22-ENTRY DTSBU031 -00301 VARYING DTSBU031 -00302 C031-22-IDX DTSBU031 -00303 WHEN L031-CD-2 = C031-22-CD (C031-22-IDX) DTSBU031 -00304 MOVE '1' TO L031-RESULT-IND DTSBU031 -00305 MOVE C031-22-SHORT-DSCR (C031-22-IDX) DTSBU031 -00306 TO L031-SHORT-DSCR DTSBU031 -00307 MOVE C031-22-LONG-DSCR (C031-22-IDX) DTSBU031 -00308 TO L031-LONG-DSCR. DTSBU031 -00309 SKIP1 DTSBU031 -00310 GO TO P1000-EXIT. DTSBU031 -00311 SKIP3 DTSBU031 -00312 P1000-23-MSOL-INACT-CD. DTSBU031 -00313 SET C031-23-IDX TO 1. DTSBU031 -00314 SEARCH C031-23-ENTRY DTSBU031 -00315 VARYING DTSBU031 -00316 C031-23-IDX DTSBU031 -00317 WHEN L031-CD-2 = C031-23-CD (C031-23-IDX) DTSBU031 -00318 MOVE '1' TO L031-RESULT-IND DTSBU031 -00319 MOVE C031-23-SHORT-DSCR (C031-23-IDX) DTSBU031 -00320 TO L031-SHORT-DSCR DTSBU031 -00321 MOVE C031-23-LONG-DSCR (C031-23-IDX) DTSBU031 -00322 TO L031-LONG-DSCR. DTSBU031 -00323 SKIP1 DTSBU031 -00324 GO TO P1000-EXIT. DTSBU031 -00325 SKIP3 DTSBU031 -00326 P1000-EXIT. DTSBU031 -00327 EXIT. DTSBU031 -00328 EJECT DTSBU031 -00329 S999-ABEND. DTSBU031 -00330 SKIP1 DTSBU031 -00331 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU031 -00332 SKIP1 DTSBU031 -00333 S999-EXIT. DTSBU031 -00334 EXIT. DTSBU031 +00151 P1000-17-MREL-RELATION-CD DTSBU031 +00152 P1000-18-MREL-SUTA-DUMPING-CD DTSBU031 +00153 S999-ABEND DTSBU031 +00154 S999-ABEND DTSBU031 +00155 S999-ABEND DTSBU031 +00156 P1000-22-MSOL-LIAB-CD DTSBU031 +00157 P1000-23-MSOL-INACT-CD DTSBU031 +00158 DEPENDING ON L031-OPTION. DTSBU031 +00159 SKIP1 DTSBU031 +00160 PERFORM S999-ABEND THRU S999-EXIT. DTSBU031 +00161 SKIP3 DTSBU031 +00162 P1000-01-MPRF-EMP-CLASS. DTSBU031 +00163 SET C031-01-IDX TO 1. DTSBU031 +00164 SEARCH C031-01-ENTRY DTSBU031 +00165 VARYING DTSBU031 +00166 C031-01-IDX DTSBU031 +00167 WHEN L031-CD-1 = C031-01-CD (C031-01-IDX) DTSBU031 +00168 MOVE '1' TO L031-RESULT-IND DTSBU031 +00169 MOVE C031-01-SHORT-DSCR (C031-01-IDX) DTSBU031 +00170 TO L031-SHORT-DSCR DTSBU031 +00171 MOVE C031-01-LONG-DSCR (C031-01-IDX) DTSBU031 +00172 TO L031-LONG-DSCR. DTSBU031 +00173 SKIP1 DTSBU031 +00174 GO TO P1000-EXIT. DTSBU031 +00175 SKIP3 DTSBU031 +00176 P1000-02-MPRF-EMP-STATUS. DTSBU031 +00177 SET C031-02-IDX TO 1. DTSBU031 +00178 SEARCH C031-02-ENTRY DTSBU031 +00179 VARYING DTSBU031 +00180 C031-02-IDX DTSBU031 +00181 WHEN L031-CD-1 = C031-02-CD (C031-02-IDX) DTSBU031 +00182 MOVE '1' TO L031-RESULT-IND DTSBU031 +00183 MOVE C031-02-SHORT-DSCR (C031-02-IDX) DTSBU031 +00184 TO L031-SHORT-DSCR DTSBU031 +00185 MOVE C031-02-LONG-DSCR (C031-02-IDX) DTSBU031 +00186 TO L031-LONG-DSCR. DTSBU031 +00187 SKIP1 DTSBU031 +00188 GO TO P1000-EXIT. DTSBU031 +00189 SKIP3 DTSBU031 +00190 P1000-03-MPRF-ELIGIBLE-CD. DTSBU031 +00191 SET C031-03-IDX TO 1. DTSBU031 +00192 SEARCH C031-03-ENTRY DTSBU031 +00193 VARYING DTSBU031 +00194 C031-03-IDX DTSBU031 +00195 WHEN L031-CD-3 = C031-03-CD (C031-03-IDX) DTSBU031 +00196 MOVE '1' TO L031-RESULT-IND DTSBU031 +00197 MOVE C031-03-SHORT-DSCR (C031-03-IDX) DTSBU031 +00198 TO L031-SHORT-DSCR DTSBU031 +00199 MOVE C031-03-LONG-DSCR (C031-03-IDX) DTSBU031 +00200 TO L031-LONG-DSCR. DTSBU031 +00201 SKIP1 DTSBU031 +00202 GO TO P1000-EXIT. DTSBU031 +00203 SKIP3 DTSBU031 +00204 P1000-04-MPRF-ORG-TYPE. DTSBU031 +00205 SET C031-04-IDX TO 1. DTSBU031 +00206 SEARCH C031-04-ENTRY DTSBU031 +00207 VARYING DTSBU031 +00208 C031-04-IDX DTSBU031 +00209 WHEN L031-CD-3 = C031-04-CD (C031-04-IDX) DTSBU031 +00210 MOVE '1' TO L031-RESULT-IND DTSBU031 +00211 MOVE C031-04-SHORT-DSCR (C031-04-IDX) DTSBU031 +00212 TO L031-SHORT-DSCR DTSBU031 +00213 MOVE C031-04-LONG-DSCR (C031-04-IDX) DTSBU031 +00214 TO L031-LONG-DSCR. DTSBU031 +00215 SKIP1 DTSBU031 +00216 GO TO P1000-EXIT. DTSBU031 +00217 SKIP3 DTSBU031 +00218 P1000-05-FISCAL-AGENT-CD. DTSBU031 +00219 SET C031-05-IDX TO 1. DTSBU031 +00220 SEARCH C031-05-ENTRY DTSBU031 +00221 VARYING DTSBU031 +00222 C031-05-IDX DTSBU031 +00223 WHEN L031-CD-3 = C031-05-CD (C031-05-IDX) DTSBU031 +00224 MOVE '1' TO L031-RESULT-IND DTSBU031 +00225 MOVE C031-05-SHORT-DSCR (C031-05-IDX) DTSBU031 +00226 TO L031-SHORT-DSCR DTSBU031 +00227 MOVE C031-05-LONG-DSCR (C031-05-IDX) DTSBU031 +00228 TO L031-LONG-DSCR. DTSBU031 +00229 SKIP1 DTSBU031 +00230 GO TO P1000-EXIT. DTSBU031 +00231 SKIP3 DTSBU031 +00232 P1000-10-MERA-SOURCE-CD. DTSBU031 +00233 SET C031-10-IDX TO 1. DTSBU031 +00234 SEARCH C031-10-ENTRY DTSBU031 +00235 VARYING DTSBU031 +00236 C031-10-IDX DTSBU031 +00237 WHEN L031-CD-2 = C031-10-CD (C031-10-IDX) DTSBU031 +00238 MOVE '1' TO L031-RESULT-IND DTSBU031 +00239 MOVE C031-10-SHORT-DSCR (C031-10-IDX) DTSBU031 +00240 TO L031-SHORT-DSCR DTSBU031 +00241 MOVE C031-10-LONG-DSCR (C031-10-IDX) DTSBU031 +00242 TO L031-LONG-DSCR. DTSBU031 +00243 SKIP1 DTSBU031 +00244 GO TO P1000-EXIT. DTSBU031 +00245 SKIP3 DTSBU031 +00246 P1000-11-MERA-STATUS-CD. DTSBU031 +00247 SET C031-11-IDX TO 1. DTSBU031 +00248 SEARCH C031-11-ENTRY DTSBU031 +00249 VARYING DTSBU031 +00250 C031-11-IDX DTSBU031 +00251 WHEN L031-CD-2 = C031-11-CD (C031-11-IDX) DTSBU031 +00252 MOVE '1' TO L031-RESULT-IND DTSBU031 +00253 MOVE C031-11-SHORT-DSCR (C031-11-IDX) DTSBU031 +00254 TO L031-SHORT-DSCR DTSBU031 +00255 MOVE C031-11-LONG-DSCR (C031-11-IDX) DTSBU031 +00256 TO L031-LONG-DSCR. DTSBU031 +00257 SKIP1 DTSBU031 +00258 GO TO P1000-EXIT. DTSBU031 +00259 SKIP3 DTSBU031 +00260 P1000-12-MERA-LETTER-1-CD. DTSBU031 +00261 SET C031-12-IDX TO 1. DTSBU031 +00262 SEARCH C031-12-ENTRY DTSBU031 +00263 VARYING DTSBU031 +00264 C031-12-IDX DTSBU031 +00265 WHEN L031-CD-2 = C031-12-CD (C031-12-IDX) DTSBU031 +00266 MOVE '1' TO L031-RESULT-IND DTSBU031 +00267 MOVE C031-12-SHORT-DSCR (C031-12-IDX) DTSBU031 +00268 TO L031-SHORT-DSCR DTSBU031 +00269 MOVE C031-12-LONG-DSCR (C031-12-IDX) DTSBU031 +00270 TO L031-LONG-DSCR. DTSBU031 +00271 SKIP1 DTSBU031 +00272 GO TO P1000-EXIT. DTSBU031 +00273 SKIP3 DTSBU031 +00274 P1000-17-MREL-RELATION-CD. DTSBU031 +00275 SET C031-17-IDX TO 1. DTSBU031 +00276 SEARCH C031-17-ENTRY DTSBU031 +00277 VARYING DTSBU031 +00278 C031-17-IDX DTSBU031 +00279 WHEN L031-CD-2 = C031-17-CD (C031-17-IDX) DTSBU031 +00280 MOVE '1' TO L031-RESULT-IND DTSBU031 +00281 MOVE C031-17-SHORT-DSCR (C031-17-IDX) DTSBU031 +00282 TO L031-SHORT-DSCR DTSBU031 +00283 MOVE C031-17-LONG-DSCR (C031-17-IDX) DTSBU031 +00284 TO L031-LONG-DSCR. DTSBU031 +00285 SKIP1 DTSBU031 +00286 GO TO P1000-EXIT. DTSBU031 +00287 SKIP3 DTSBU031 +00288 P1000-18-MREL-SUTA-DUMPING-CD. DTSBU031 +00289 SET C031-18-IDX TO 1. DTSBU031 +00290 SEARCH C031-18-ENTRY DTSBU031 +00291 VARYING DTSBU031 +00292 C031-18-IDX DTSBU031 +00293 WHEN L031-CD-1 = C031-18-CD (C031-18-IDX) DTSBU031 +00294 MOVE '1' TO L031-RESULT-IND DTSBU031 +00295 MOVE C031-18-SHORT-DSCR (C031-18-IDX) DTSBU031 +00296 TO L031-SHORT-DSCR DTSBU031 +00297 MOVE C031-18-LONG-DSCR (C031-18-IDX) DTSBU031 +00298 TO L031-LONG-DSCR. DTSBU031 +00299 SKIP1 DTSBU031 +00300 GO TO P1000-EXIT. DTSBU031 +00301 SKIP3 DTSBU031 +00302 P1000-22-MSOL-LIAB-CD. DTSBU031 +00303 SET C031-22-IDX TO 1. DTSBU031 +00304 SEARCH C031-22-ENTRY DTSBU031 +00305 VARYING DTSBU031 +00306 C031-22-IDX DTSBU031 +00307 WHEN L031-CD-2 = C031-22-CD (C031-22-IDX) DTSBU031 +00308 MOVE '1' TO L031-RESULT-IND DTSBU031 +00309 MOVE C031-22-SHORT-DSCR (C031-22-IDX) DTSBU031 +00310 TO L031-SHORT-DSCR DTSBU031 +00311 MOVE C031-22-LONG-DSCR (C031-22-IDX) DTSBU031 +00312 TO L031-LONG-DSCR. DTSBU031 +00313 SKIP1 DTSBU031 +00314 GO TO P1000-EXIT. DTSBU031 +00315 SKIP3 DTSBU031 +00316 P1000-23-MSOL-INACT-CD. DTSBU031 +00317 SET C031-23-IDX TO 1. DTSBU031 +00318 SEARCH C031-23-ENTRY DTSBU031 +00319 VARYING DTSBU031 +00320 C031-23-IDX DTSBU031 +00321 WHEN L031-CD-2 = C031-23-CD (C031-23-IDX) DTSBU031 +00322 MOVE '1' TO L031-RESULT-IND DTSBU031 +00323 MOVE C031-23-SHORT-DSCR (C031-23-IDX) DTSBU031 +00324 TO L031-SHORT-DSCR DTSBU031 +00325 MOVE C031-23-LONG-DSCR (C031-23-IDX) DTSBU031 +00326 TO L031-LONG-DSCR. DTSBU031 +00327 SKIP1 DTSBU031 +00328 GO TO P1000-EXIT. DTSBU031 +00329 SKIP3 DTSBU031 +00330 P1000-EXIT. DTSBU031 +00331 EXIT. DTSBU031 +00332 EJECT DTSBU031 +00333 S999-ABEND. DTSBU031 +00334 SKIP1 DTSBU031 +00335 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU031 +00336 SKIP1 DTSBU031 +00337 S999-EXIT. DTSBU031 +00338 EXIT. DTSBU031 diff --git a/Batch/DTSBU076.cob b/Batch/DTSBU076.cob new file mode 100644 index 0000000..7cd8ae6 --- /dev/null +++ b/Batch/DTSBU076.cob @@ -0,0 +1,99 @@ +00001 IDENTIFICATION DIVISION. 04/05/04 +00002 PROGRAM-ID. DTSBU076. DTSBU076 +00003 LV001 +00004 AUTHOR. PROFESSIONAL CONSULTING CORPORATION. DTSBU076 +00005 DTSBU076 +00006 ******************************************************************DTSBU076 +00007 * DTSBU076 +00008 * FUNCTION: REFORMATS L076-NAM TO OPPOSITE FORMAT OF FORMAT DTSBU076 +00009 * RECEIVED. DTSBU076 +00010 * DTSBU076 +00011 * DTSBU076 +00012 * 10/03/03 EFT, COPIED FROM DTSIL071. DTSBU076 +00013 * WORK ORDER: PROGRAMMER: SCM. DTSBU076 +00014 * DTSBU076 +00015 * L076-NAM FORMATS PROCESSED: DTSBU076 +00016 * L076-FROM-LAST-NAME-FIRST DTSBU076 +00017 * LASTNAME/FIRSTNAME MIDDLENAME DTSBU076 +00018 * LASTNAME/FIRSTNAME DTSBU076 +00019 * DTSBU076 +00020 * DTSBU076 +00021 * RETURN CODES: DTSBU076 +00022 * 0 - SUCCESSFUL COMPLETION DTSBU076 +00023 * 8 - INVALID NAME DTSBU076 +00024 * DTSBU076 +00025 ******************************************************************DTSBU076 +00026 DTSBU076 +00027 ENVIRONMENT DIVISION. DTSBU076 +00028 SKIP3 DTSBU076 +00029 DATA DIVISION. DTSBU076 +00030 EJECT DTSBU076 +00031 WORKING-STORAGE SECTION. DTSBU076 +000315 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU076 04/05/04'. DTSBU076 +00032 SKIP3 DTSBU076 +00033 01 CONSTANTS-AREA. DTSBU076 +00034 05 WRK-ABEND-CODE PIC S9(04) COMP VALUE +073. DTSBU076 +00035 05 INPUT-AREA-SIZE PIC S9(04) COMP VALUE +34. DTSBU076 +00036 SKIP3 DTSBU076 +00037 01 WRK-AREA. DTSBU076 +00038 05 INPUT-AREA PIC X(34). DTSBU076 +00039 05 HOLD-AREA PIC X(34). DTSBU076 +00040 SKIP3 DTSBU076 +00041 01 TALLY-AREA. DTSBU076 +00042 05 D-S PIC X(02) VALUE SPACE. DTSBU076 +00043 05 SLASH-TALLY PIC S9(04) COMP. DTSBU076 +00044 05 LAST-NAME-LEN PIC S9(04) COMP. DTSBU076 +00045 05 FIRST-NAME-LEN PIC S9(04) COMP. DTSBU076 +00046 05 TOTAL-LEN PIC S9(04) COMP. DTSBU076 +00047 EJECT DTSBU076 +00048 LINKAGE SECTION. DTSBU076 +00049 01 L076-LINK-AREA. DTSBU076 +00050 ++INCLUDE DTSIL076 DTSBU076 +00051 EJECT DTSBU076 +00052 PROCEDURE DIVISION DTSBU076 +00053 USING L076-LINK-AREA. DTSBU076 +00054 DTSBU076 +00055 SET L076-NAME-CONVERTED TO TRUE. DTSBU076 +00056 DTSBU076 +00057 INITIALIZE WRK-AREA DTSBU076 +00058 TALLY-AREA. DTSBU076 +00059 DTSBU076 +00060 PERFORM P1000-STRING-NAME THRU P1000-EXIT. DTSBU076 +00061 DTSBU076 +00062 MAINLINE-EXIT. DTSBU076 +00063 DTSBU076 +00064 GOBACK. DTSBU076 +00065 EJECT DTSBU076 +00066 ******************************************************************DTSBU076 +00067 ** PROCESS LAST NAME FIRST **DTSBU076 +00068 ******************************************************************DTSBU076 +00069 P1000-STRING-NAME. DTSBU076 +00070 *-----------------------------------------------------------------DTSBU076 +00071 * ERROR CHECK. DTSBU076 +00072 *-----------------------------------------------------------------DTSBU076 +00073 IF L076-NAMEL (1:1) NOT GREATER SPACES DTSBU076 +00074 OR L076-NAMEF (1:1) NOT GREATER SPACES DTSBU076 +00075 SET L076-NAME-INVALID TO TRUE DTSBU076 +00076 GO TO P1000-EXIT. DTSBU076 +00077 DTSBU076 +00078 *-----------------------------------------------------------------DTSBU076 +00079 * REFORMAT. DTSBU076 +00080 *-----------------------------------------------------------------DTSBU076 +00081 INSPECT L076-NAMEL TALLYING DTSBU076 +00082 LAST-NAME-LEN FOR CHARACTERS BEFORE INITIAL D-S. DTSBU076 +00083 INSPECT L076-NAMEF TALLYING DTSBU076 +00084 FIRST-NAME-LEN FOR CHARACTERS BEFORE INITIAL D-S. DTSBU076 +00085 ADD LAST-NAME-LEN TO FIRST-NAME-LEN GIVING TOTAL-LEN. DTSBU076 +00086 SKIP3 DTSBU076 +00087 MOVE L076-NAMEL (1 : LAST-NAME-LEN) TO L076-NAM. DTSBU076 +00088 MOVE '/' TO L076-NAM (LAST-NAME-LEN + 1 : 1). DTSBU076 +00089 MOVE L076-NAMEF (1 : FIRST-NAME-LEN) TO DTSBU076 +00090 L076-NAM (LAST-NAME-LEN + 2 : FIRST-NAME-LEN). DTSBU076 +00091 MOVE L076-NAMEI TO L076-NAM (TOTAL-LEN + 3 : 1). DTSBU076 +00092 DTSBU076 +00093 P1000-EXIT. EXIT. DTSBU076 +00094 EJECT DTSBU076 +00095 S999-ABEND. DTSBU076 +00096 CALL 'DTSBU999' DTSBU076 +00097 USING WRK-ABEND-CODE. DTSBU076 +00098 S999-EXIT. EXIT. DTSBU076 diff --git a/Batch/DTSBU081.cob b/Batch/DTSBU081.cob new file mode 100644 index 0000000..2446582 --- /dev/null +++ b/Batch/DTSBU081.cob @@ -0,0 +1,256 @@ +00001 IDENTIFICATION DIVISION. 05/09/25 +00002 PROGRAM-ID. DTSBU081. DTSBU081 +00003 AUTHOR. TRW. LV023 +00004 DATE-WRITTEN. JUNE 2001. DTSBU081 +00005 DATE-COMPILED. DTSBU081 +00006 SKIP3 DTSBU081 +00007 ***** DTSBU081 +00008 * DTSBU081 +00009 * FUNCTION: CLAIMANT NAME LOOKUP. DTSBU081 +00010 * DTSBU081 +00011 * DTSBU081 +00012 * MODIFICATION LOG: DTSBU081 +00013 * DTSBU081 +00014 * 11/26/91 INITIAL DEVELOPMENT. DTSBU081 +00015 * WORK ORDER: PROGRAMMER: TCL DTSBU081 +00016 * DTSBU081 +00017 * 04/01/94 MODIFIED FOR MONTANA. DTSBU081 +00018 * WORK ORDER: PROGRAMMER: EHH DTSBU081 +00019 * DTSBU081 +00020 * 09/08/1998 THE LINK TO THE UI BENEFITS SYSTEM CLAIMANT DTSBU081 +00021 * MASTER FILE IS PLUGGED. WHEN THE UI BENEFITS DTSBU081 +00022 * SYSTEM CLAIMANT MASTER FILE IS AVAILABLE, THIS DTSBU081 +00023 * MODULE MUST BE REVISITED. DTSBU081 +00024 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU081 +00025 * DTSBU081 +00026 * 06/01/2002 MODED DTSCU081 TO THIS BATCH VERSION TO PICK DTSBU081 +00027 * UP THE CLAIMANT NAME FROM THE BENEFITS SYSTEM DTSBU081 +00028 * CLAIMANT MASTER FILE. DTSBU081 +00029 * REFERENCE: DC DEVELOPMENT PROGRAMMER: G-D DTSBU081 +00030 * DTSBU081 +00031 * 07/06/2004 CORRECTED PROBLEM WITH L081-CLAIMANT-SSN. DTSBU081 +00032 * THE BATCH PROGRAM WAS NOT CONSISTENT WITH DTSBU081 +00033 * THE CICS PROGRAM. DTSBU081 +00034 * THE PROGRAM WAS MOVING THIS 9 DIGIT FIELD TO DTSBU081 +00035 * THE 10 DIGIT VSAM-KEY (SSN PLUS SEQUENCE NUMBER).DTSBU081 +00036 * THE PROGRAM NOW BUILDS THE KEY IN WORKING-STORAGEDTSBU081 +00037 * AND MOVE THE FULL 10 DIGIT KEY. THE SEQUENCE DTSBU081 +00038 * NUMBER IS ALWAYS SET TO ZERO. DTSBU081 +00039 * REFERENCE: PROGRAMMER: GD DTSBU081 +00040 * DTSBU081 +00041 * 07/14/2004 REMOVED DISPLAYS. DTSBU081 +00042 * REFERENCE: PROGRAMMER: GD DTSBU081 +00043 * DTSBU081 +00044 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU081 +00045 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU081 +00046 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU081 +00047 * DTSBU081 +00048 * DTSBU081 +00049 * DESCRIPTION: DTSBU081 +00050 * DTSBU081 +00051 * DTSBU081 IS PASSED L081-CLAIMANT-SSN. DTSBU081 READS THE DTSBU081 +00052 * BENEFITS MASTER FILE. DTSBU081 +00053 * DTSBU081 +00054 * IF THE CLAIMANT IS FOUND, THEN L081-CLAIMANT-NAME IS RETURNED DTSBU081 +00055 ***** DTSBU081 +00056 SKIP3 DTSBU081 +00057 ENVIRONMENT DIVISION. DTSBU081 +00058 SKIP3 DTSBU081 +00059 DATA DIVISION. DTSBU081 +00060 SKIP3 DTSBU081 +00061 WORKING-STORAGE SECTION. DTSBU081 +000615 77 PAN-VALET PICTURE X(24) VALUE '023DTSBU081 05/09/25'. DTSBU081 +00062 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU081 01/05/10'. DTSBU081 +00063 SKIP3 DTSBU081 +00064 01 WRK-AREA. DTSBU081 +00065 05 WRK-ABEND-CODE PIC X(04) VALUE 'U081'. DTSBU081 +00066 DTSBU081 +00067 05 WRK-KEY PIC 9(10). DTSBU081 +00068 05 FILLER REDEFINES WRK-KEY. DTSBU081 +00069 10 WRK-SSN PIC 9(09). DTSBU081 +00070 10 WRK-SSN-SEQ PIC 9(01). DTSBU081 +00071 DTSBU081 +00072 05 WRK-FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU081 +00073 88 WRK-FIRST-TIME-YES-88 VALUE 'Y'. DTSBU081 +00074 88 WRK-FIRST-TIME-NO-88 VALUE 'N'. DTSBU081 +00075 DTSBU081 +00076 05 WRK-CLAIMANT-NAME PIC X(32) VALUE SPACES. CL*16 +00077 05 WRK-CZNAME PIC X(12) VALUE SPACES. CL*18 +00078 05 WRK-CFNAME. CL*18 +00079 15 WRK-CFNAMEA PIC X(01) VALUE '/'. CL*16 +00080 15 WRK-CFNAMEB PIC X(11) VALUE SPACES. CL*16 +00081 05 WRK-NAME. CL**2 +00082 10 WRK-LNAME PIC X(15) VALUE SPACES. CL*17 +00083 10 WRK-FNAME PIC X(12) VALUE SPACES. CL*17 +00084 10 WRK-INAME PIC X(01) VALUE SPACES. CL**2 +00085 CL**2 +00086 05 W-SSN PIC S9(09) COMP-3 VALUE 0. CL**5 +00087 CL**4 +00088 01 EMSG-LITERALS. DTSBU081 +00089 05 EMSG-NO-REC. DTSBU081 +00090 10 FILLER PIC X(31) DTSBU081 +00091 VALUE 'NO BENEFITS RECORD FOUND '. DTSBU081 +00092 10 FILLER PIC X(16) DTSBU081 +00093 VALUE SPACES. DTSBU081 +00094 05 EMSG-EOF. DTSBU081 +00095 10 FILLER PIC X(31) DTSBU081 +00096 VALUE 'END OF FILE '. DTSBU081 +00097 10 FILLER PIC X(16) DTSBU081 +00098 VALUE SPACES. DTSBU081 +00099 EJECT DTSBU081 +00100 01 L982-LINK-AREA. CL**3 +00101 ++INCLUDE DTSIL982 CL**3 +00102 CL**3 +00103 01 WNAM-REC. CL**5 +00104 ++INCLUDE DTSIWNAM CL**4 +00105 CL**4 +00106 LINKAGE SECTION. DTSBU081 +00107 SKIP3 DTSBU081 +00108 01 BU081-LINK-AREA. DTSBU081 +00109 ++INCLUDE DTSIL081 DTSBU081 +00110 CL**3 +00111 EJECT DTSBU081 +00112 PROCEDURE DIVISION USING BU081-LINK-AREA. DTSBU081 +00113 SKIP2 DTSBU081 +00114 IF WRK-FIRST-TIME-YES-88 DTSBU081 +00115 PERFORM I0000-INIT THRU I0000-EXIT DTSBU081 +00116 SET WRK-FIRST-TIME-NO-88 TO TRUE DTSBU081 +00117 PERFORM P0000-FIND-NAME THRU P0000-EXIT DTSBU081 +00118 ELSE DTSBU081 +00119 PERFORM P0000-FIND-NAME THRU P0000-EXIT. DTSBU081 +00120 DTSBU081 +00121 * PERFORM S982F-CLOSE THRU S982F-EXIT. CL*11 +00122 GOBACK. DTSBU081 +00123 EJECT DTSBU081 +00124 I0000-INIT. DTSBU081 +00125 * MOVE 'DTSBU081' TO DB-PROGRAM-NAME. CL*20 +00126 * SET DB-HEADER-RECORD TO TRUE. CL*20 +00127 * SET DB-RANDOM-PROCESSING TO TRUE. CL*20 +00128 * SET DB-OPEN-INPUT TO TRUE. CL*20 +00129 * MOVE ZEROS TO DB-KEY. CL*20 +00130 * CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL*20 +00131 * IF DB-SUCCESSFUL-COMPLETION CL*20 +00132 * NEXT SENTENCE CL*20 +00133 * ELSE CL*20 +00134 * DISPLAY 'CANNOT OPEN BENEFITS FILE' CL*20 +00135 * PERFORM S9999-ABEND THRU S9999-EXIT. CL*20 +00136 CL**3 +00137 PERFORM S982O-OPEN-READ THRU S982O-EXIT. CL**9 +00138 * PERFORM S981D-CLOSE THRU S981D-EXIT. CL**3 +00139 CL**3 +00140 DTSBU081 +00141 I0000-EXIT. DTSBU081 +00142 EXIT. DTSBU081 +00143 P0000-FIND-NAME. DTSBU081 +00144 SET L081-NAME-NOT-FOUND TO TRUE. DTSBU081 +00145 DTSBU081 +00146 MOVE SPACES TO L081-CLAIMANT-NAME DTSBU081 +00147 L081-MSG-AREA. DTSBU081 +00148 DTSBU081 +00149 * SET DB-RANDOM-PROCESSING TO TRUE. CL*20 +00150 * SET DB-CLAIMANT-PROFILE TO TRUE. CL*20 +00151 * SET DB-READ-SEGMENT TO TRUE. CL*20 +00152 * MOVE L081-CLAIMANT-SSN TO WRK-SSN. CL*20 +00153 * MOVE ZERO TO WRK-SSN-SEQ. CL*20 +00154 * MOVE WRK-KEY TO VSAM-KEY. CL*20 +00155 DTSBU081 +00156 * CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL*20 +00157 * IF DB-SUCCESSFUL-COMPLETION CL*20 +00158 * SET L081-NAME-FOUND TO TRUE CL*20 +00159 * MOVE CPD-NAME TO L081-CLAIMANT-NAME CL*20 +00160 * GO TO P0000-EXIT. CL*20 +00161 CL**2 +00162 * IF DB-NO-RECORD-FOUND CL*20 +00163 MOVE SPACES TO WRK-NAME CL**3 +00164 MOVE LOW-VALUE TO WNAM-REC CL**3 +00165 MOVE L081-CLAIMANT-SSN TO WNAM-SSN WRK-SSN CL**4 +00166 PERFORM P3000-READ-NAME THRU P3000-EXIT. CL*20 +00167 * ELSE CL*20 +00168 * PERFORM S9999-ABEND THRU S9999-EXIT. CL*20 +00169 CL**3 +00170 IF L982-OK-88 CL**3 +00171 SET L081-NAME-FOUND TO TRUE CL**3 +00172 MOVE WRK-LNAME TO WRK-CLAIMANT-NAME CL*13 +00173 INSPECT WRK-CLAIMANT-NAME REPLACING FIRST ' ' BY '/' CL*13 +00174 MOVE WRK-FNAME TO WRK-CFNAMEB CL*17 +00175 MOVE WRK-CFNAME TO WRK-CZNAME CL*18 +00176 INSPECT WRK-CLAIMANT-NAME REPLACING CL*14 +00177 FIRST '/ ' BY WRK-CZNAME CL*18 +00178 INSPECT WRK-CLAIMANT-NAME REPLACING FIRST ' ' BY ' @' CL*14 +00179 INSPECT WRK-CLAIMANT-NAME REPLACING CL*14 +00180 FIRST '@' BY WRK-INAME CL*15 +00181 MOVE WRK-CLAIMANT-NAME TO L081-CLAIMANT-NAME CL**3 +00182 DISPLAY ' NAME ' WRK-CLAIMANT-NAME CL*13 +00183 ELSE CL**3 +00184 SET L081-NAME-NOT-FOUND TO TRUE DTSBU081 +00185 DISPLAY '*SSNE NOT ON TAX NAME FILE ' L081-CLAIMANT-SSN CL*19 +00186 MOVE EMSG-NO-REC TO L081-MSG-TEXT CL*13 +00187 GO TO P0000-EXIT. CL*13 +00188 DTSBU081 +00189 P0000-EXIT. DTSBU081 +00190 EXIT. DTSBU081 +00191 P3000-READ-NAME. CL**3 +00192 ****************************************************************** CL**3 +00193 * SEARCH FOR NAME ON WAGE NAME FILE * CL**3 +00194 ****************************************************************** CL**3 +00195 CL**3 +00196 CL**3 +00197 PERFORM S982A-START-BROWSE THRU S982A-EXIT. CL**3 +00198 CL**3 +00199 IF NOT L982-OK-88 CL**3 +00200 SET L081-NAME-NOT-FOUND TO TRUE CL**3 +00201 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN CL**3 +00202 GO TO P3000-EXIT CL**3 +00203 END-IF. CL**3 +00204 CL**3 +00205 MOVE WNAM-SSN TO W-SSN. CL**3 +00206 CL**3 +00207 IF WRK-SSN = W-SSN CL**3 +00208 MOVE WNAM-LAST-NAME TO WRK-LNAME CL**3 +00209 MOVE WNAM-FIRST-NAME TO WRK-FNAME CL**3 +00210 MOVE WNAM-MID-INIT TO WRK-INAME CL**3 +00211 ELSE CL**3 +00212 SET L081-NAME-NOT-FOUND TO TRUE CL**3 +00213 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN. CL**3 +00214 P3000-EXIT. CL**3 +00215 EXIT. CL**3 +00216 CL**3 +00217 S982O-OPEN-READ. CL**3 +00218 SET L982-OPEN-READ-88 TO TRUE. CL**3 +00219 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00220 CL**3 +00221 S982O-EXIT. CL**3 +00222 EXIT. CL**3 +00223 CL**3 +00224 S982A-START-BROWSE. CL**3 +00225 SET L982-START-BROWSE-88 TO TRUE. CL**3 +00226 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00227 CL**3 +00228 S982A-EXIT. CL**3 +00229 EXIT. CL**3 +00230 S982B-READ-NEXT. CL**3 +00231 SET L982-READ-NEXT-88 TO TRUE. CL**3 +00232 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00233 CL**3 +00234 S982B-EXIT. CL**3 +00235 EXIT. CL**3 +00236 S982F-CLOSE. CL**3 +00237 SET L982-CLOSE-88 TO TRUE. CL**3 +00238 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00239 CL**3 +00240 S982F-EXIT. CL**3 +00241 EXIT. CL**3 +00242 CL**3 +00243 S982Z-WNAM-IO. CL**3 +00244 CALL 'DTSBU982' USING L982-LINK-AREA CL**3 +00245 WNAM-REC. CL**3 +00246 S982Z-EXIT. CL**3 +00247 EXIT. CL**3 +00248 CL**3 +00249 CL**3 +00250 S9999-ABEND. DTSBU081 +00251 SKIP1 DTSBU081 +00252 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU081 +00253 SKIP1 DTSBU081 +00254 S9999-EXIT. DTSBU081 +00255 EXIT. DTSBU081 diff --git a/Batch/DTSBU083.cob b/Batch/DTSBU083.cob new file mode 100644 index 0000000..697ad71 --- /dev/null +++ b/Batch/DTSBU083.cob @@ -0,0 +1,216 @@ +00001 IDENTIFICATION DIVISION. 08/13/04 +00002 PROGRAM-ID. DTSBU083. DTSBU083 +00003 AUTHOR. TRW. LV003 +00004 DATE-WRITTEN. JUNE 2001. DTSBU083 +00005 DATE-COMPILED. DTSBU083 +00006 SKIP3 DTSBU083 +00007 ***** DTSBU083 +00008 * DTSBU083 +00009 * FUNCTION: CLAIMANT NAME LOOKUP FROM IB6 FILE. DTSBU083 +00010 * DTSBU083 +00011 * DTSBU083 +00012 * MODIFICATION LOG: DTSBU083 +00013 * DTSBU083 +00014 * 07/22/2002 INITIAL DEVELOPMENT. DTSBU083 +00015 * WORK ORDER: PROGRAMMER: GD DTSBU083 +00016 * DTSBU083 +00017 * 07/22/2004 CORRECTED PROBLEM WITH L081-CLAIMANT-SSN. DTSBU083 +00018 * THE BATCH PROGRAM WAS NOT CONSISTENT WITH DTSBU083 +00019 * THE CICS PROGRAM. DTSBU083 +00020 * THE PROGRAM WAS MOVING THIS 9 DIGIT FIELD TO DTSBU083 +00021 * THE 10 DIGIT VSAM-KEY (SSN PLUS SEQUENCE NUMBER).DTSBU083 +00022 * THE PROGRAM NOW BUILDS THE KEY IN WORKING-STORAGEDTSBU083 +00023 * AND MOVE THE FULL 10 DIGIT KEY. THE SEQUENCE DTSBU083 +00024 * NUMBER IS ALWAYS SET TO ZERO. DTSBU083 +00025 * REFERENCE: PROGRAMMER: GD DTSBU083 +00026 * DTSBU083 +00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU083 +00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU083 +00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU083 +00030 * DTSBU083 +00031 * DTSBU083 +00032 * DESCRIPTION: DTSBU083 +00033 * DTSBU083 +00034 * DTSBU083 IS PASSED L081-CLAIMANT-SSN. DTSBU083 READS THE DTSBU083 +00035 * IB6 MASTER FILE. DTSBU083 +00036 * DTSBU083 +00037 * IF THE CLAIMANT IS FOUND, THEN L081-CLAIMANT-NAME IS RETURNED DTSBU083 +00038 ***** DTSBU083 +00039 SKIP3 DTSBU083 +00040 ENVIRONMENT DIVISION. DTSBU083 +00041 SKIP3 DTSBU083 +00042 DATA DIVISION. DTSBU083 +00043 SKIP3 DTSBU083 +00044 WORKING-STORAGE SECTION. DTSBU083 +000445 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU083 08/13/04'. DTSBU083 +00045 SKIP3 DTSBU083 +00046 01 WRK-AREA. DTSBU083 +00047 05 WRK-ABEND-CODE PIC X(04) VALUE 'U083'. DTSBU083 +00048 DTSBU083 +00049 05 WRK-FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU083 +00050 88 WRK-FIRST-TIME-YES-88 VALUE 'Y'. DTSBU083 +00051 88 WRK-FIRST-TIME-NO-88 VALUE 'N'. DTSBU083 +00052 DTSBU083 +00053 05 WRK-KEY PIC 9(10). DTSBU083 +00054 05 FILLER REDEFINES WRK-KEY. DTSBU083 +00055 10 WRK-SSN PIC 9(09). DTSBU083 +00056 10 WRK-SSN-SEQ PIC 9(01). DTSBU083 +00057 DTSBU083 +00058 05 WRK-SPACE-NEEDED-IND PIC X(01). DTSBU083 +00059 88 WRK-SPACE-NEEDED-YES-88 VALUE 'Y'. DTSBU083 +00060 88 WRK-SPACE-NEEDED-NO-88 VALUE 'N'. DTSBU083 +00061 DTSBU083 +00062 05 WRK-LEN PIC S9(04) COMP DTSBU083 +00063 VALUE +31. DTSBU083 +00064 05 SUB1 PIC S9(04) COMP. DTSBU083 +00065 05 SUB2 PIC S9(04) COMP. DTSBU083 +00066 DTSBU083 +00067 05 WRK-NAME. DTSBU083 +00068 10 WRK-FIRST-NAME PIC X(12). DTSBU083 +00069 10 WRK-MIDDLE-NAME PIC X(01). DTSBU083 +00070 10 WRK-LAST-NAME PIC X(18). DTSBU083 +00071 DTSBU083 +00072 05 WRK-NAME-OUT PIC X(32). DTSBU083 +00073 DTSBU083 +00074 01 EMSG-LITERALS. DTSBU083 +00075 05 EMSG-NO-REC. DTSBU083 +00076 10 FILLER PIC X(31) DTSBU083 +00077 VALUE 'NO BENEFITS RECORD FOUND '. DTSBU083 +00078 10 FILLER PIC X(16) DTSBU083 +00079 VALUE SPACES. DTSBU083 +00080 05 EMSG-EOF. DTSBU083 +00081 10 FILLER PIC X(31) DTSBU083 +00082 VALUE 'END OF FILE '. DTSBU083 +00083 10 FILLER PIC X(16) DTSBU083 +00084 VALUE SPACES. DTSBU083 +00085 EJECT DTSBU083 +00086 01 IB6-LINKAGE-SECTION. DTSBU083 +00087 ++INCLUDE IB6VSMCB DTSBU083 +00088 EJECT DTSBU083 +00089 ++INCLUDE ESPDATEW DTSBU083 +00090 EJECT DTSBU083 +00091 ++INCLUDE IB6SCCD DTSBU083 +00092 EJECT DTSBU083 +00093 ++INCLUDE ESPSTRER DTSBU083 +00094 EJECT DTSBU083 +00095 ++INCLUDE IB6SCSWA DTSBU083 +00096 EJECT DTSBU083 +00097 ++INCLUDE IB6SCTWA DTSBU083 +00098 EJECT DTSBU083 +00099 ++INCLUDE IB6SEG01 DTSBU083 +00100 EJECT DTSBU083 +00101 ++INCLUDE IB6SEG02 DTSBU083 +00102 EJECT DTSBU083 +00103 ++INCLUDE IB6SEG03 DTSBU083 +00104 EJECT DTSBU083 +00105 ++INCLUDE IB6TRAND DTSBU083 +00106 EJECT DTSBU083 +00107 ++INCLUDE IB6HEADR DTSBU083 +00108 EJECT DTSBU083 +00109 LINKAGE SECTION. DTSBU083 +00110 SKIP3 DTSBU083 +00111 01 BU081-LINK-AREA. DTSBU083 +00112 ++INCLUDE DTSIL081 DTSBU083 +00113 EJECT DTSBU083 +00114 PROCEDURE DIVISION USING BU081-LINK-AREA. DTSBU083 +00115 SKIP2 DTSBU083 +00116 IF WRK-FIRST-TIME-YES-88 DTSBU083 +00117 PERFORM I0000-INIT THRU I0000-EXIT DTSBU083 +00118 SET WRK-FIRST-TIME-NO-88 TO TRUE DTSBU083 +00119 PERFORM P0000-FIND-NAME THRU P0000-EXIT DTSBU083 +00120 ELSE DTSBU083 +00121 PERFORM P0000-FIND-NAME THRU P0000-EXIT. DTSBU083 +00122 DTSBU083 +00123 GOBACK. DTSBU083 +00124 EJECT DTSBU083 +00125 I0000-INIT. DTSBU083 +00126 MOVE 'DTSBU083' TO DB-PROGRAM-NAME. DTSBU083 +00127 SET DB-HEADER-RECORD TO TRUE. DTSBU083 +00128 SET DB-RANDOM-PROCESSING TO TRUE. DTSBU083 +00129 SET DB-OPEN-INPUT TO TRUE. DTSBU083 +00130 MOVE ZEROS TO DB-KEY. DTSBU083 +00131 DTSBU083 +00132 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DTSBU083 +00133 IF DB-SUCCESSFUL-COMPLETION DTSBU083 +00134 NEXT SENTENCE DTSBU083 +00135 ELSE DTSBU083 +00136 DISPLAY 'CANNOT OPEN IB6 FILE' DTSBU083 +00137 PERFORM S9999-ABEND THRU S9999-EXIT. DTSBU083 +00138 DTSBU083 +00139 I0000-EXIT. DTSBU083 +00140 EXIT. DTSBU083 +00141 P0000-FIND-NAME. DTSBU083 +00142 SET L081-NAME-NOT-FOUND TO TRUE. DTSBU083 +00143 DTSBU083 +00144 MOVE SPACES TO L081-CLAIMANT-NAME DTSBU083 +00145 L081-MSG-AREA. DTSBU083 +00146 DTSBU083 +00147 SET DB-RANDOM-PROCESSING TO TRUE. DTSBU083 +00148 SET DB-IB6-PROFILE TO TRUE. DTSBU083 +00149 SET DB-READ-SEGMENT TO TRUE. DTSBU083 +00150 MOVE L081-CLAIMANT-SSN TO WRK-SSN. DTSBU083 +00151 MOVE ZERO TO WRK-SSN-SEQ. DTSBU083 +00152 MOVE WRK-KEY TO VSAM-KEY. DTSBU083 +00153 DTSBU083 +00154 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DTSBU083 +00155 IF DB-SUCCESSFUL-COMPLETION DTSBU083 +00156 SET L081-NAME-FOUND TO TRUE DTSBU083 +00157 PERFORM P1000-FORMAT-NAME THRU P1000-EXIT DTSBU083 +00158 MOVE WRK-NAME-OUT TO L081-CLAIMANT-NAME DTSBU083 +00159 ELSE DTSBU083 +00160 IF DB-NO-RECORD-FOUND DTSBU083 +00161 SET L081-NAME-NOT-FOUND TO TRUE DTSBU083 +00162 MOVE EMSG-NO-REC TO L081-MSG-TEXT DTSBU083 +00163 ELSE DTSBU083 +00164 PERFORM S9999-ABEND THRU S9999-EXIT. DTSBU083 +00165 DTSBU083 +00166 P0000-EXIT. DTSBU083 +00167 EXIT. DTSBU083 +00168 DTSBU083 +00169 P1000-FORMAT-NAME. DTSBU083 +00170 MOVE SPACES TO WRK-NAME DTSBU083 +00171 WRK-NAME-OUT. DTSBU083 +00172 DTSBU083 +00173 MOVE IN1-CLAIM-FIRST-NAME TO WRK-FIRST-NAME. DTSBU083 +00174 MOVE IN1-CLAIM-MIDDLE-NAME TO WRK-MIDDLE-NAME DTSBU083 +00175 MOVE IN1-CLAIM-LAST-NAME TO WRK-LAST-NAME DTSBU083 +00176 DTSBU083 +00177 SET WRK-SPACE-NEEDED-YES-88 TO TRUE. DTSBU083 +00178 MOVE +0 TO SUB2. DTSBU083 +00179 PERFORM P1100-PARSE THRU P1100-EXIT. DTSBU083 +00180 DTSBU083 +00181 MOVE WRK-NAME-OUT TO L081-CLAIMANT-NAME. DTSBU083 +00182 DTSBU083 +00183 P1000-EXIT. DTSBU083 +00184 EXIT. DTSBU083 +00185 DTSBU083 +00186 P1100-PARSE. DTSBU083 +00187 PERFORM DTSBU083 +00188 VARYING SUB1 FROM +1 BY +1 DTSBU083 +00189 UNTIL SUB1 > WRK-LEN DTSBU083 +00190 IF WRK-NAME (SUB1:1) NOT = SPACE DTSBU083 +00191 SET WRK-SPACE-NEEDED-YES-88 TO TRUE DTSBU083 +00192 ADD +1 TO SUB2 DTSBU083 +00193 MOVE WRK-NAME (SUB1:1) TO WRK-NAME-OUT (SUB2:1) DTSBU083 +00194 IF SUB1 = +13 DTSBU083 +00195 ADD +1 TO SUB2 DTSBU083 +00196 MOVE SPACE TO WRK-NAME-OUT (SUB2:1) DTSBU083 +00197 END-IF DTSBU083 +00198 ELSE DTSBU083 +00199 IF WRK-SPACE-NEEDED-YES-88 DTSBU083 +00200 ADD +1 TO SUB2 DTSBU083 +00201 MOVE SPACE TO WRK-NAME-OUT (SUB2:1) DTSBU083 +00202 SET WRK-SPACE-NEEDED-NO-88 TO TRUE DTSBU083 +00203 END-IF DTSBU083 +00204 END-IF DTSBU083 +00205 END-PERFORM. DTSBU083 +00206 DTSBU083 +00207 P1100-EXIT. DTSBU083 +00208 EXIT. DTSBU083 +00209 DTSBU083 +00210 S9999-ABEND. DTSBU083 +00211 SKIP1 DTSBU083 +00212 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU083 +00213 SKIP1 DTSBU083 +00214 S9999-EXIT. DTSBU083 +00215 EXIT. DTSBU083 diff --git a/Batch/DTSBU203.cob b/Batch/DTSBU203.cob new file mode 100644 index 0000000..fef4cf6 --- /dev/null +++ b/Batch/DTSBU203.cob @@ -0,0 +1,125 @@ +00001 IDENTIFICATION DIVISION. 09/09/25 +00002 PROGRAM-ID. DTSBU203. DTSBU203 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 +00004 DATE-WRITTEN. SEPTEMBER 1998. DTSBU203 +00005 DATE-COMPILED. DTSBU203 +00006 SKIP3 DTSBU203 +00007 ***** DTSBU203 +00008 * TESTING RAINCODE CL**3 +00009 * FUNCTION: DETERMINE FIELD ZIP CODE AND FIELD STATE CODE DTSBU203 +00010 * DTSBU203 +00011 * DTSBU203 +00012 * MODIFICATION LOG: DTSBU203 +00013 * DTSBU203 +00014 * 09/02/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCU203. DTSBU203 +00015 * WORK ORDER: PROGRAMMER: GD DTSBU203 +00016 * DTSBU203 +00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU203 +00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU203 +00019 * WORK ORDER: PROGRAMMER: XXX DTSBU203 +00020 * DTSBU203 +00021 * DTSBU203 +00022 * DESCRIPTION: DTSBU203 +00023 * DTSBU203 +00024 * DTSCU203 DETERMINES THE FIELD ZIP CODE AND FIELD STATE CODE. DTSBU203 +00025 * DTSBU203 +00026 * DTSBU203 +00027 * SEE MPRF-FLD-ZIP, MPRF-FLD-STATE, MPRF-TAX-REC-ADDR-EXISTS-IN CL**2 +00028 * IN THE DATA ELEMENT DEFINITIONS FOR A DESCRIPTION OF DTSBU203 +00029 * THE REQUIRED LOGIC. DTSBU203 +00030 * DTSBU203 +00031 * DTSBU203 +00032 * IF A NECESSARY MTAD RECORD IS NOT FOUND, THEN RETURN DTSBU203 +00033 * L203-ADDR-NOT-FOUND-88. DTSBU203 +00034 * DTSBU203 +00035 * IF THE MASTER FILE IS NOT AVAILABLE, THEN RETURN DTSBU203 +00036 * L203-FILE-CLOSED-88. DTSBU203 +00037 * DTSBU203 +00038 ***** DTSBU203 +00039 SKIP3 DTSBU203 +00040 ENVIRONMENT DIVISION. DTSBU203 +00041 SKIP3 DTSBU203 +00042 DATA DIVISION. DTSBU203 +00043 SKIP3 DTSBU203 +00044 WORKING-STORAGE SECTION. DTSBU203 +000445 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU203 09/09/25'. DTSBU203 +00045 SKIP3 DTSBU203 +00046 01 WRK-AREA. DTSBU203 +00047 05 WRK-ABEND-CODE PIC X(04) VALUE 'U203'. DTSBU203 +00048 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU203 +00049 EJECT DTSBU203 +00050 01 L910-LINK-AREA. DTSBU203 +00051 05 L910-CONTROL-AREA. DTSBU203 +00052 ++INCLUDE DTSIL910 DTSBU203 +00053 SKIP3 DTSBU203 +00054 05 MSKL-REC. DTSBU203 +00055 ++INCLUDE DTSIMSKL DTSBU203 +00056 SKIP3 DTSBU203 +00057 05 MTAD-REC REDEFINES MSKL-REC. DTSBU203 +00058 ++INCLUDE DTSIMTAD DTSBU203 +00059 EJECT DTSBU203 +00060 LINKAGE SECTION. DTSBU203 +00061 SKIP3 DTSBU203 +00062 01 L203-LINK-AREA. DTSBU203 +00063 ++INCLUDE DTSIL203 DTSBU203 +00064 EJECT DTSBU203 +00065 PROCEDURE DIVISION USING L203-LINK-AREA. DTSBU203 +00066 SKIP2 DTSBU203 +00067 SET L203-OK-88 TO TRUE. DTSBU203 +00068 MOVE SPACE TO L203-FLD-ZIP DTSBU203 +00069 L203-FLD-STATE DTSBU203 +00070 L203-MSG-AREA. DTSBU203 +00071 SKIP1 DTSBU203 +00072 IF L203-TAX-REC-ADDR-NO-88 DTSBU203 +00073 PERFORM P1000-READ-INITIALIZE THRU P1000-EXIT DTSBU203 +00074 MOVE +001 TO MTAD-ID-NO DTSBU203 +00075 PERFORM P2000-FIND-ZIP THRU P2000-EXIT DTSBU203 +00076 ELSE DTSBU203 +00077 PERFORM P1000-READ-INITIALIZE THRU P1000-EXIT DTSBU203 +00078 MOVE +002 TO MTAD-ID-NO DTSBU203 +00079 PERFORM P2000-FIND-ZIP THRU P2000-EXIT. DTSBU203 +00080 SKIP1 DTSBU203 +00081 IF L203-OK-88 DTSBU203 +00082 IF L203-FLD-ZIP = SPACE DTSBU203 +00083 OR L203-FLD-STATE = SPACE DTSBU203 +00084 SET L203-ADDR-NOT-FOUND-88 TO TRUE. DTSBU203 +00085 SKIP2 DTSBU203 +00086 P0000-EXIT. DTSBU203 +00087 SKIP2 DTSBU203 +00088 GOBACK. DTSBU203 +00089 EJECT DTSBU203 +00090 P1000-READ-INITIALIZE. DTSBU203 +00091 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBU203 +00092 MOVE L203-EMP-NO TO MTAD-EMP-NO. DTSBU203 +00093 SET MTAD-TAD-88 TO TRUE. DTSBU203 +00094 P1000-EXIT. DTSBU203 +00095 EXIT. DTSBU203 +00096 SKIP1 DTSBU203 +00097 P2000-FIND-ZIP. DTSBU203 +00098 PERFORM S910-READ THRU S910-EXIT. DTSBU203 +00099 IF L910-OK-88 DTSBU203 +00100 MOVE MTAD-ZIP TO L203-FLD-ZIP DTSBU203 +00101 MOVE MTAD-ST TO L203-FLD-STATE. DTSBU203 +00102 P2000-EXIT. DTSBU203 +00103 EXIT. DTSBU203 +00104 SKIP1 DTSBU203 +00105 EJECT DTSBU203 +00106 S910-READ. DTSBU203 +00107 SET L910-READ-88 TO TRUE. DTSBU203 +00108 GO TO S910-MSTR-IO. DTSBU203 +00109 SKIP1 DTSBU203 +00110 S910-MSTR-IO. DTSBU203 +00111 SKIP1 DTSBU203 +00112 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU203 +00113 MSKL-REC. DTSBU203 +00114 SKIP1 DTSBU203 +00115 S910-EXIT. DTSBU203 +00116 EXIT. DTSBU203 +00117 SKIP3 DTSBU203 +00118 ****************** S899-ABEND NOT USED. DTSBU203 +00119 *S899-ABEND. DTSBU203 +00120 * SKIP1 DTSBU203 +00121 * CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU203 +00122 * SKIP1 DTSBU203 +00123 *S899-EXIT. DTSBU203 +00124 * EXIT. DTSBU203 diff --git a/Batch/DTSBU431.cob b/Batch/DTSBU431.cob new file mode 100644 index 0000000..43a2ada --- /dev/null +++ b/Batch/DTSBU431.cob @@ -0,0 +1,266 @@ +00001 IDENTIFICATION DIVISION. 09/23/24 +00002 PROGRAM-ID. DTSBU431. DTSBU431 +00003 AUTHOR. NGC LV014 +00004 DATE-WRITTEN. OCTOBER 2010. DTSBU431 +00005 DATE-COMPILED. DTSBU431 +00006 DTSBU431 +00007 ***** DTSBU431 +00008 * DTSBU431 +00009 * FUNCTION: GET COUNTS OF WAGE ITEMS NEEDED FOR DTSBU431 +00010 * ITEM 5 ON THE ETA 581 REPORT. DTSBU431 +00011 * DTSBU431 +00012 * NOTE: THIS PROGRAM USES SEVERAL BENEFIT MODULES THEREFORE DTSBU431 +00013 * THIS PROGRAM NEEDS THE BENEFIT COMPILE JCL(COB2BBEN) DTSBU431 +00014 * TO RESOLVE ALL THE NEEDED LOAD MODULES. DTSBU431 +00015 * DTSBU431 +00016 * MODIFICATION HISTORY: DTSBU431 +00017 * DTSBU431 +00018 * 10/01/2010 INITIAL DEVELOPMENT DTSBU431 +00019 * REFERENCE: PROGRAMMER: GD DTSBU431 +00020 * DTSBU431 +00021 * DTSBU431 +00022 * DTSBU431 +00023 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU431 +00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU431 +00025 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU431 +00026 * DTSBU431 +00027 * DESCRIPTION: DTSBU431 +00028 * DTSBU431 +00029 * DTSBU431 +00030 * RECORDS READ: DTSBU431 +00031 * WAGE MASTER FILE DTSBU431 +00032 * DTSBU431 +00033 * PRINTED OUTPUTS: DTSBU431 +00034 * NONE. DTSBU431 +00035 * DTSBU431 +00036 * RECORDS WRITTEN: DTSBU431 +00037 * DTSIWWGH EMPLOYER ORIENTED WAGE RECORD DTSBU431 +00038 * DTSBU431 +00039 * MODULES CALLED: DTSBU431 +00040 * EWG960R WAGE FILE ACCESS MODULE DTSBU431 +00041 * DTSBU004 YEAR/QUARTER CONVERSION MODULE DTSBU431 +00042 * DTSBU431 +00043 ***** DTSBU431 +00044 DTSBU431 +00045 ENVIRONMENT DIVISION. DTSBU431 +00046 SKIP2 DTSBU431 +00047 DATA DIVISION. DTSBU431 +00048 DTSBU431 +00049 WORKING-STORAGE SECTION. DTSBU431 +000495 77 PAN-VALET PICTURE X(24) VALUE '014DTSBU431 09/23/24'. DTSBU431 +00050 SKIP3 DTSBU431 +00051 01 WRK-AREA. DTSBU431 +00052 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +430.DTSBU431 +00053 05 WRK-ERROR-IND PIC X(01). DTSBU431 +00054 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBU431 +00055 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBU431 +00056 05 ABEND-CODE PIC S9(04) COMP CL**7 +00057 VALUE +431. CL**7 +00058 05 ABEND-MOD PIC X(08) CL**7 +00059 VALUE 'DTSBU999'. CL**7 +00060 05 ABEND-MSG PIC X(60). CL**7 +00061 CL**7 +00062 DTSBU431 +00063 05 WRK-START-DATE PIC S9(09) COMP-3 VALUE +0. DTSBU431 +00064 05 WRK-END-DATE PIC S9(09) COMP-3 VALUE +0. DTSBU431 +00065 DTSBU431 +00066 05 WRK-WAGE-ITEM-CNT PIC S9(07) COMP-3 VALUE +0. DTSBU431 +00067 DTSBU431 +00068 01 L004-LINK-AREA. DTSBU431 +00069 ++INCLUDE DTSIL004 DTSBU431 +00070 DTSBU431 +00071 CL*12 +00072 01 L981-LINK-AREA. CL*12 +00073 ++INCLUDE DTSIL981 CL*12 +00074 CL*12 +00075 01 WWGH-REC. CL*12 +00076 ++INCLUDE DTSIWWGH CL*12 +00077 LINKAGE SECTION. DTSBU431 +00078 DTSBU431 +00079 01 L430-LINK-AREA. DTSBU431 +00080 ++INCLUDE DTSIL430 DTSBU431 +00081 CL*11 +00082 DTSBU431 +00083 PROCEDURE DIVISION USING L430-LINK-AREA. DTSBU431 +00084 DTSBU431 +00085 SET WRK-ERROR-NO-88 TO TRUE. CL**8 +00086 EVALUATE TRUE CL**8 +00087 WHEN L430-CMND-INITIALIZE-88 CL**8 +00088 PERFORM I0000-INIT THRU I0000-EXIT DTSBU431 +00089 DTSBU431 +00090 WHEN L430-CMND-PROCESS-88 CL**8 +00091 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBU431 +00092 DTSBU431 +00093 WHEN L430-CMND-TERMINATE-88 CL**8 +00094 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBU431 +00095 DTSBU431 +00096 END-EVALUATE. CL**8 +00097 DTSBU431 +00098 GOBACK. DTSBU431 +00099 DTSBU431 +00100 I0000-INIT. DTSBU431 +00101 PERFORM I1000-SET-DATES THRU I1000-EXIT. DTSBU431 +00102 DTSBU431 +00103 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBU431 +00104 DTSBU431 +00105 DTSBU431 +00106 I0000-EXIT. DTSBU431 +00107 EXIT. DTSBU431 +00108 DTSBU431 +00109 I1000-SET-DATES. DTSBU431 +00110 MOVE L430-SUBJECT-YRQ TO L004-QTR-5-9. CL**4 +00111 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBU431 +00112 IF L004-VALID-QTR DTSBU431 +00113 MOVE L004-QTR-START-DATE TO WRK-START-DATE DTSBU431 +00114 MOVE L004-QTR-END-DATE TO WRK-END-DATE DTSBU431 +00115 ELSE DTSBU431 +00116 DISPLAY 'INVALID SUBJECT QUARTER ' DTSBU431 +00117 L430-SUBJECT-YRQ DTSBU431 +00118 PERFORM S999-ABEND THRU S999-EXIT DTSBU431 +00119 END-IF. DTSBU431 +00120 DTSBU431 +00121 DTSBU431 +00122 DISPLAY '**************************'. DTSBU431 +00123 DISPLAY '* DTSBU430' DTSBU431 +00124 DISPLAY '* ' DTSBU431 +00125 DISPLAY '* START: ' WRK-START-DATE. DTSBU431 +00126 DISPLAY '* END : ' WRK-END-DATE. DTSBU431 +00127 DISPLAY '**************************'. DTSBU431 +00128 DTSBU431 +00129 I1000-EXIT. DTSBU431 +00130 EXIT. DTSBU431 +00131 DTSBU431 +00132 I2000-OPEN-FILES. DTSBU431 +00133 PERFORM S981A1-OPEN-READ THRU S981A1-EXIT. CL**2 +00134 IF NOT L981-OK-88 CL**2 +00135 DISPLAY ' OPEN WWGH VSAM FAILED ' WWGH-KEY-AREA CL**2 +00136 PERFORM S999-ABEND THRU S999-EXIT. CL**2 +00137 CL**2 +00138 DTSBU431 +00139 I2000-EXIT. DTSBU431 +00140 EXIT. DTSBU431 +00141 DTSBU431 +00142 P0000-PROCESS. DTSBU431 +00143 MOVE LOW-VALUES TO WWGH-KEY-AREA. CL**2 +00144 CL**2 +00145 MOVE 010021 TO WWGH-EMP-NO. CL**2 +00146 MOVE 20221 TO WWGH-YRQ. CL**2 +00147 MOVE 000000000 TO WWGH-SSN. CL**2 +00148 CL**2 +00149 DISPLAY ' BEFORE BROWSE ********* ' WWGH-KEY-AREA CL*10 +00150 PERFORM S981X-START-BROWSE THRU S981X-EXIT. CL**2 +00151 DISPLAY ' AFTER BROWSE ********* ' WWGH-KEY-AREA CL*10 +00152 IF NOT L981-OK-88 CL**2 +00153 DISPLAY ' BROWSE FAILED ********* ' WWGH-KEY-AREA CL**2 +00154 PERFORM S999-ABEND THRU S999-EXIT. CL**2 +00155 CL**2 +00156 DISPLAY ' BEFORE READ ****** ' WWGH-KEY-AREA CL*10 +00157 * PERFORM S981C-READ THRU S981C-EXIT. CL*13 +00158 * IF NOT L981-OK-88 CL*13 +00159 * DISPLAY ' READ FAILED ********* ' WWGH-KEY-AREA CL*13 +00160 * PERFORM S999-ABEND THRU S999-EXIT. CL*13 +00161 CL**2 +00162 * DISPLAY ' AFTER READ ****** ' WWGH-KEY-AREA CL*13 +00163 CL**2 +00164 PERFORM P1000-FIND-QTR-WAGE THRU P1000-EXIT CL**2 +00165 UNTIL L981-NO-REC-88. CL**2 +00166 DTSBU431 +00167 DTSBU431 +00168 MOVE WRK-WAGE-ITEM-CNT TO L430-WAGE-ITEM-CNT. DTSBU431 +00169 DISPLAY ' WAGE COUNT WRK****** ' WRK-WAGE-ITEM-CNT. CL*14 +00170 DISPLAY ' WAGE COUNT 430****** ' L430-WAGE-ITEM-CNT. CL*14 +00171 DTSBU431 +00172 P0000-EXIT. DTSBU431 +00173 EXIT. DTSBU431 +00174 DTSBU431 +00175 DTSBU431 +00176 ************************************************************** DTSBU431 +00177 * P1200 FINDS ALL THE WAGE SEGMENT ASSOCIATED WITH THE SSN DTSBU431 +00178 * AND SELECTS THOSE FROM 2001. DTSBU431 +00179 ************************************************************** DTSBU431 +00180 DTSBU431 +00181 P1000-FIND-QTR-WAGE. CL**2 +00182 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. CL**2 +00183 * ADD 1 TO RECS-IN. CL**2 +00184 DTSBU431 +00185 IF WWGH-CHNG-DATE >= WRK-START-DATE CL**2 +00186 AND WWGH-CHNG-DATE <= WRK-END-DATE CL**2 +00187 ADD +1 TO WRK-WAGE-ITEM-CNT DTSBU431 +00188 END-IF. DTSBU431 +00189 DTSBU431 +00190 PERFORM S981C2-READ-NEXT THRU S981C2-EXIT. CL**2 +00191 P1000-EXIT. CL**2 +00192 EXIT. DTSBU431 +00193 DTSBU431 +00194 S004-FROM-5. DTSBU431 +00195 SET L004-FROM-5 TO TRUE. DTSBU431 +00196 GO TO S004-QTR. DTSBU431 +00197 DTSBU431 +00198 S004-QTR. DTSBU431 +00199 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU431 +00200 S004-EXIT. DTSBU431 +00201 EXIT. DTSBU431 +00202 CL**2 +00203 S981A1-OPEN-READ. CL**2 +00204 SET L981-OPEN-READ-88 TO TRUE. CL**2 +00205 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL**2 +00206 CL**2 +00207 S981A1-EXIT. CL**2 +00208 EXIT. CL**2 +00209 CL**2 +00210 S981C-READ. CL**2 +00211 SET L981-READ-88 TO TRUE. CL**2 +00212 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL**2 +00213 CL**2 +00214 S981C-EXIT. CL**2 +00215 EXIT. CL**2 +00216 S981X-START-BROWSE. CL**2 +00217 DISPLAY ' STARTING BROWSE' CL**2 +00218 SET L981-START-BROWSE-88 TO TRUE. CL**2 +00219 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL**2 +00220 DISPLAY ' BROWSE COMPLETE'. CL**2 +00221 CL**2 +00222 S981X-EXIT. CL**2 +00223 EXIT. CL**2 +00224 S981C2-READ-NEXT. CL**2 +00225 SET L981-READ-NEXT-88 TO TRUE. CL**2 +00226 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL**2 +00227 CL**2 +00228 S981C2-EXIT. CL**2 +00229 S981D-CLOSE. CL**2 +00230 SET L981-CLOSE-88 TO TRUE. CL**2 +00231 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL**2 +00232 CL**2 +00233 S981D-EXIT. CL**2 +00234 EXIT. CL**2 +00235 S981Z-WWGH-IO. CL**2 +00236 CALL 'DTSBU981' USING L981-LINK-AREA CL**2 +00237 WWGH-REC. CL**2 +00238 S981Z-EXIT. CL**2 +00239 EXIT. CL**2 +00240 CL**2 +00241 CL**6 +00242 S999-ABEND. CL**6 +00243 DISPLAY '**** DTSBU431 ABENDING ' CL**6 +00244 ABEND-MSG. CL**6 +00245 CALL ABEND-MOD USING ABEND-CODE. CL**6 +00246 CL**6 +00247 S999-EXIT. CL**6 +00248 EXIT. CL**6 +00249 CL**6 +00250 T0000-TERMINATE. DTSBU431 +00251 DTSBU431 +00252 DISPLAY ' '. DTSBU431 +00253 DISPLAY ' '. DTSBU431 +00254 DTSBU431 +00255 DISPLAY '*** DTSBU431 TERMINATION STATISTICS ***'. CL**2 +00256 DTSBU431 +00257 DISPLAY ' '. DTSBU431 +00258 DISPLAY 'TOTAL WAGES ITEMS FOR QTR :' CL**2 +00259 WRK-WAGE-ITEM-CNT. DTSBU431 +00260 PERFORM S981D-CLOSE THRU S981D-EXIT. CL**2 +00261 DTSBU431 +00262 DTSBU431 +00263 T0000-EXIT. DTSBU431 +00264 EXIT. DTSBU431 +00265 DTSBU431 diff --git a/Batch/DTSBU963.cob b/Batch/DTSBU963.cob new file mode 100644 index 0000000..ac124a7 --- /dev/null +++ b/Batch/DTSBU963.cob @@ -0,0 +1,246 @@ +00001 IDENTIFICATION DIVISION. 06/18/13 +00002 PROGRAM-ID. DTSBU963. DTSBU963 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 +00004 DATE-WRITTEN. OCTOBER 1994. DTSBU963 +00005 DATE-COMPILED. DTSBU963 +00006 SKIP3 DTSBU963 +00007 ***** DTSBU963 +00008 * DTSBU963 +00009 * FUNCTION: SEQUENTIAL MASTER FILE INPUT. DTSBU963 +00010 * DTSBU963 +00011 * >>> SPECIAL VERSION OF BU961. THE NAME OF THE <<< CL**3 +00012 * >>> INPUT FILE HAS BEEN CHANGED TO DTSFMSTO <<< CL**3 +00013 * DTSBU963 +00014 * MODIFICATION LOG: DTSBU963 +00015 * DTSBU963 +00016 * 12/03/98 INITIAL DEVELOPMENT. COPIED FROM MACBU961 DTSBU963 +00017 * WORK ORDER: PROGRAMMER: ZL1 DTSBU963 +00018 * DTSBU963 +00019 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU963 +00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU963 +00021 * REFERENCE RFP: #XXX PROGRAMMER: XXX DTSBU963 +00022 * DTSBU963 +00023 * DTSBU963 +00024 * DESCRIPTION: DTSBU963 +00025 * DTSBU963 +00026 * DTSBU961 PERFORMS ALL REQUIRED SEQUENTIAL (TAPE) DTSBU963 +00027 * MASTER FILE INPUT. DTSBU963 +00028 * DTSBU963 +00029 * THE "SEQUENTIAL" MASTER FILE WILL USUSALLY DTSBU963 +00030 * BE THE ARCHIVED MASTER FILE. DTSBU963 +00031 * DTSBU963 +00032 * RECORDS RESIDING ON THE SEQUENTIAL MASTER DTSBU963 +00033 * FILE ARE NOT STORED IN A COMPRESSED FORMAT. DTSBU963 +00034 * WITH COMPRESSION BUILT INTO THE TAPE SUBSYSTEM, DTSBU963 +00035 * COMPRESSION IN THE APPLICATION WOULD BE A DTSBU963 +00036 * WASTE OF CPU CYCLES. DTSBU963 +00037 * DTSBU963 +00038 * DTSBU963 +00039 * COMMAND SPECIFIC SPECIFICATIONS: DTSBU963 +00040 * DTSBU963 +00041 * OPEN READ DTSBU963 +00042 * OPEN INPUT. DTSBU963 +00043 * DTSBU963 +00044 * CLOSE DTSBU963 +00045 * DTSBU963 +00046 * READ NEXT DTSBU963 +00047 * DTSBU963 +00048 * DTSBU963 +00049 ***** DTSBU963 +00050 SKIP3 DTSBU963 +00051 ENVIRONMENT DIVISION. DTSBU963 +00052 SKIP2 DTSBU963 +00053 INPUT-OUTPUT SECTION. DTSBU963 +00054 DTSBU963 +00055 FILE-CONTROL. DTSBU963 +00056 SELECT MST-FILE ASSIGN TO DTSFMSTO CL**2 +00057 FILE STATUS IS FILE-STATUS. DTSBU963 +00058 SKIP3 DTSBU963 +00059 DATA DIVISION. DTSBU963 +00060 SKIP3 DTSBU963 +00061 FILE SECTION. DTSBU963 +00062 SKIP3 DTSBU963 +00063 FD MST-FILE DTSBU963 +00064 RECORDING MODE IS V DTSBU963 +00065 BLOCK CONTAINS 0 CHARACTERS DTSBU963 +00066 RECORD IS VARYING DEPENDING ON MST-REC-LEN. DTSBU963 +00067 DTSBU963 +00068 01 FILE-REC. DTSBU963 +00069 ++INCLUDE DTSIMSKL DTSBU963 +00070 DTSBU963 +00071 01 FILE-MIN-LENGTH-REC PIC X(21). DTSBU963 +00072 DTSBU963 +00073 01 FILE-MAX-LENGTH-REC PIC X(4092). DTSBU963 +00074 EJECT DTSBU963 +00075 WORKING-STORAGE SECTION. DTSBU963 +000755 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU963 06/18/13'. DTSBU963 +00076 77 PAN-VALET PICTURE X(24) VALUE '004DTSBU961 11/22/04'. DTSBU963 +00077 SKIP3 DTSBU963 +00078 01 WRK-AREA. DTSBU963 +00079 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +963. CL**3 +00080 DTSBU963 +00081 05 MST-REC-LEN PIC 9(04) COMP. DTSBU963 +00082 DTSBU963 +00083 05 WRK-REC-CNT PIC S9(07) COMP-3. DTSBU963 +00084 DTSBU963 +00085 05 FILE-STATUS PIC X(02). DTSBU963 +00086 88 FILE-OK-88 VALUE '00'. DTSBU963 +00087 88 FILE-NO-REC-88 VALUE '10'. DTSBU963 +00088 DTSBU963 +00089 05 WRK-REC-PREFIX PIC X(04). DTSBU963 +00090 EJECT DTSBU963 +00091 01 L991-LINK-AREA. DTSBU963 +00092 ++INCLUDE DTSIL991 DTSBU963 +00093 EJECT DTSBU963 +00094 01 MLEN-LENGTH-LITERALS. DTSBU963 +00095 ++INCLUDE DTSIMLEN DTSBU963 +00096 EJECT DTSBU963 +00097 LINKAGE SECTION. DTSBU963 +00098 SKIP3 DTSBU963 +00099 01 L961-LINK-AREA. DTSBU963 +00100 ++INCLUDE DTSIL961 DTSBU963 +00101 EJECT DTSBU963 +00102 01 LINK-REC. DTSBU963 +00103 ++INCLUDE DTSIMSKL DTSBU963 +00104 EJECT DTSBU963 +00105 PROCEDURE DIVISION USING L961-LINK-AREA DTSBU963 +00106 LINK-REC. DTSBU963 +00107 DTSBU963 +00108 DTSBU963 +00109 IF L961-TRACE-88 DTSBU963 +00110 PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT. DTSBU963 +00111 DTSBU963 +00112 SET L961-OK-88 TO TRUE. DTSBU963 +00113 DTSBU963 +00114 IF L961-READ-NEXT-88 DTSBU963 +00115 PERFORM P2300-READ-NEXT THRU P2300-EXIT DTSBU963 +00116 ELSE DTSBU963 +00117 IF L961-OPEN-READ-88 DTSBU963 +00118 PERFORM P1100-OPEN-READ THRU P1100-EXIT DTSBU963 +00119 ELSE DTSBU963 +00120 IF L961-CLOSE-88 DTSBU963 +00121 PERFORM P1200-CLOSE THRU P1200-EXIT DTSBU963 +00122 ELSE DTSBU963 +00123 PERFORM S999-ABEND THRU S999-EXIT. DTSBU963 +00124 DTSBU963 +00125 IF L961-TRACE-88 DTSBU963 +00126 PERFORM S9200-POST-DISPLAY THRU S9200-EXIT. DTSBU963 +00127 DTSBU963 +00128 DTSBU963 +00129 GOBACK. DTSBU963 +00130 EJECT DTSBU963 +00131 P1100-OPEN-READ. DTSBU963 +00132 OPEN INPUT MST-FILE. DTSBU963 +00133 DTSBU963 +00134 IF FILE-OK-88 DTSBU963 +00135 NEXT SENTENCE DTSBU963 +00136 ELSE DTSBU963 +00137 PERFORM S999-ABEND THRU S999-EXIT. DTSBU963 +00138 DTSBU963 +00139 MOVE +0 TO WRK-REC-CNT. DTSBU963 +00140 P1100-EXIT. DTSBU963 +00141 EXIT. DTSBU963 +00142 SKIP3 DTSBU963 +00143 P1200-CLOSE. DTSBU963 +00144 CLOSE MST-FILE. DTSBU963 +00145 DTSBU963 +00146 IF NOT FILE-OK-88 DTSBU963 +00147 PERFORM S999-ABEND THRU S999-EXIT. DTSBU963 +00148 DTSBU963 +00149 DISPLAY '*** ' DTSBU963 +00150 WRK-REC-CNT DTSBU963 +00151 ' DTSFMSTI RECORDS READ'. DTSBU963 +00152 P1200-EXIT. DTSBU963 +00153 EXIT. DTSBU963 +00154 EJECT DTSBU963 +00155 P2300-READ-NEXT. DTSBU963 +00156 READ MST-FILE. DTSBU963 +00157 DTSBU963 +00158 IF FILE-NO-REC-88 DTSBU963 +00159 SET L961-NO-REC-88 TO TRUE DTSBU963 +00160 GO TO P2300-EXIT. DTSBU963 +00161 DTSBU963 +00162 IF NOT FILE-OK-88 DTSBU963 +00163 PERFORM S999-ABEND THRU S999-EXIT. DTSBU963 +00164 DTSBU963 +00165 IF (MST-REC-LEN < MLEN-MSKL-NONDATA-LEN) DTSBU963 +00166 OR DTSBU963 +00167 (MST-REC-LEN DTSBU963 +00168 > MLEN-MAX-MSKL-DATA-LEN + MLEN-MSKL-NONDATA-LEN) DTSBU963 +00169 PERFORM S999-ABEND THRU S999-EXIT. DTSBU963 +00170 DTSBU963 +00171 ADD +1 TO WRK-REC-CNT. DTSBU963 +00172 DTSBU963 +00173 MOVE FILE-REC (1:MST-REC-LEN) DTSBU963 +00174 TO LINK-REC (1:MST-REC-LEN). DTSBU963 +00175 P2300-EXIT. DTSBU963 +00176 EXIT. DTSBU963 +00177 EJECT DTSBU963 +00178 S9100-PRE-DISPLAY. DTSBU963 +00179 DISPLAY ' '. DTSBU963 +00180 DISPLAY ' '. DTSBU963 +00181 DISPLAY '*** DTSBU961 PRE TRACE DISPLAY ***'. DTSBU963 +00182 DISPLAY L961-MOD-NAME DTSBU963 +00183 ' = L961-MOD-NAME'. DTSBU963 +00184 DISPLAY L961-CMND-CD DTSBU963 +00185 ' = L961-CMND-CD'. DTSBU963 +00186 S9100-EXIT. DTSBU963 +00187 EXIT. DTSBU963 +00188 SKIP3 DTSBU963 +00189 S9200-POST-DISPLAY. DTSBU963 +00190 DISPLAY ' '. DTSBU963 +00191 DISPLAY '*** DTSBU961 POST TRACE DISPLAY ***'. DTSBU963 +00192 DISPLAY L961-RESULT-IND DTSBU963 +00193 ' = L961-RESULT-IND'. DTSBU963 +00194 DTSBU963 +00195 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU963 +00196 S9200-EXIT. DTSBU963 +00197 EXIT. DTSBU963 +00198 SKIP3 DTSBU963 +00199 S9300-REC-DISPLAY. DTSBU963 +00200 DISPLAY ' '. DTSBU963 +00201 DTSBU963 +00202 IF (MSKL-REC-TYPE OF LINK-REC < +1) DTSBU963 +00203 OR DTSBU963 +00204 (MSKL-REC-TYPE OF LINK-REC > MLEN-MAX-REC-TYPE) DTSBU963 +00205 MOVE SPACES TO WRK-REC-PREFIX DTSBU963 +00206 ELSE DTSBU963 +00207 MOVE MLEN-PREFIX (MSKL-REC-TYPE OF LINK-REC) DTSBU963 +00208 TO WRK-REC-PREFIX. DTSBU963 +00209 DTSBU963 +00210 IF WRK-REC-PREFIX = SPACES DTSBU963 +00211 MOVE '????' TO WRK-REC-PREFIX. DTSBU963 +00212 DTSBU963 +00213 MOVE MLEN-MAX-KEY-LEN TO L991-REQ-CHAR-CNT. DTSBU963 +00214 DTSBU963 +00215 MOVE MSKL-KEY-AREA OF LINK-REC TO L991-REQ-AREA. DTSBU963 +00216 DTSBU963 +00217 PERFORM S991-HEX-FORMAT THRU S991-EXIT. DTSBU963 +00218 DTSBU963 +00219 DISPLAY 'REC TYPE = ' DTSBU963 +00220 WRK-REC-PREFIX. DTSBU963 +00221 DISPLAY 'KEY AREA = ' DTSBU963 +00222 L991-REPLY-HEX-1-AREA. DTSBU963 +00223 DISPLAY ' ' DTSBU963 +00224 L991-REPLY-HEX-2-AREA. DTSBU963 +00225 DISPLAY ' ' DTSBU963 +00226 L991-REPLY-AN-AREA. DTSBU963 +00227 S9300-EXIT. DTSBU963 +00228 EXIT. DTSBU963 +00229 EJECT DTSBU963 +00230 S991-HEX-FORMAT. DTSBU963 +00231 CALL 'DTSBU991' USING L991-LINK-AREA. DTSBU963 +00232 S991-EXIT. DTSBU963 +00233 EXIT. DTSBU963 +00234 SKIP3 DTSBU963 +00235 S999-ABEND. DTSBU963 +00236 DISPLAY '*** MASTER FILE SEQUENTIAL INPUT MODULE ABENDING'. DTSBU963 +00237 DISPLAY '*** CMND-CD = ' L961-CMND-CD. DTSBU963 +00238 DISPLAY '*** FILE-STATUS = ' FILE-STATUS. DTSBU963 +00239 DISPLAY '*** CALLING MODULE = ' L961-MOD-NAME. DTSBU963 +00240 DTSBU963 +00241 PERFORM S9300-REC-DISPLAY THRU S9300-EXIT. DTSBU963 +00242 DTSBU963 +00243 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU963 +00244 S999-EXIT. DTSBU963 +00245 EXIT. DTSBU963 diff --git a/Batch/DTSBX215.cob b/Batch/DTSBX215.cob index ac41680..2e032ab 100644 --- a/Batch/DTSBX215.cob +++ b/Batch/DTSBX215.cob @@ -1,12 +1,12 @@ -00001 IDENTIFICATION DIVISION. 05/08/09 +00001 IDENTIFICATION DIVISION. 04/06/20 00002 PROGRAM-ID. DTSBX215. DTSBX215 -00003 AUTHOR. NORTHROP GRUMMAN LV017 +00003 AUTHOR. NORTHROP GRUMMAN LV012 00004 DATE-WRITTEN. MAY 2005. DTSBX215 00005 *DATE-MODIFIED. DTSBX215 00006 DATE-COMPILED. DTSBX215 00007 DTSBX215 00008 ***** DTSBX215 -00009 * DTSBX215 +00009 *******TESTING SOC7 ZL1 4/3/20 CL**2 00010 * FUNCTION: EXTRACT R301 ACCOUNTING BATCH REPORT RECORDS DTSBX215 00011 * AND R906 ONLINE UPDATE LOG RECORDS DTSBX215 00012 * FOR DOWNLOAD TO SQL SERVER DATABASE DTSBX215 @@ -112,859 +112,869 @@ 00112 01 DEPOSIT-REC PIC X(103). DTSBX215 00113 DTSBX215 00114 WORKING-STORAGE SECTION. DTSBX215 -001145 77 PAN-VALET PICTURE X(24) VALUE '017DTSBX215 05/08/09'. DTSBX215 -00115 01 WRK-AREA. DTSBX215 -00116 05 FILE-STATUS PIC 9(02) VALUE ZEROS. DTSBX215 -00117 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX215'. DTSBX215 -00118 DTSBX215 -00119 05 WRK-ERROR-IND PIC X(01) VALUE 'N'. DTSBX215 -00120 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX215 -00121 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX215 -00122 DTSBX215 -00123 05 BX215-STATUS PIC X(02). DTSBX215 -00124 88 BX215-STATUS-OK-88 VALUE '00'. DTSBX215 -00125 05 BX220-STATUS PIC X(02). DTSBX215 -00126 88 BX220-STATUS-OK-88 VALUE '00'. DTSBX215 -00127 05 DEPOSIT-STATUS PIC X(02). DTSBX215 -00128 88 DEPOSIT-STATUS-OK-88 VALUE '00'. DTSBX215 -00129 DTSBX215 -00130 05 WRK-BYPASS-906-IND PIC X(01). DTSBX215 -00131 88 WRK-BYPASS-906-YES-88 VALUE 'Y'. DTSBX215 -00132 88 WRK-BYPASS-906-NO-88 VALUE 'N'. DTSBX215 -00133 DTSBX215 -00134 05 WRK-SELECT-FAS-IND PIC X(01). DTSBX215 -00135 88 WRK-SELECT-FAS-YES-88 VALUE 'Y'. DTSBX215 -00136 88 WRK-SELECT-FAS-NO-88 VALUE 'N'. DTSBX215 -00137 DTSBX215 -00138 05 WRK-SELECT-RPT-IND PIC X(01). DTSBX215 -00139 88 WRK-SELECT-RPT-YES-88 VALUE 'Y'. DTSBX215 -00140 88 WRK-SELECT-RPT-NO-88 VALUE 'N'. DTSBX215 -00141 DTSBX215 -00142 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +310.DTSBX215 -00143 05 WRK-PRIOR-RUN-DATE PIC S9(09) COMP-3. DTSBX215 -00144 05 WRK-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX215 -00145 05 WRK-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 -00146 05 WRK-X215-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 -00147 05 WRK-X220-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 -00148 05 WRK-DEPOSIT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 -00149 DTSBX215 -00150 05 WRK-906-OPID PIC X(08). DTSBX215 -00151 05 WRK-906-EMP PIC S9(07) COMP-3. DTSBX215 -00152 05 WRK-906-SCREEN PIC X(02). DTSBX215 -00153 05 WRK-906-DATE PIC S9(09) COMP-3. DTSBX215 -00154 05 WRK-906-TIME PIC S9(07) COMP-3. DTSBX215 -00155 DTSBX215 -00156 05 DISP-REMIT PIC --,---,---,--9.99. DTSBX215 -00157 05 DISP-WRK-READ-CNT PIC ZZ,ZZZ,ZZ9. DTSBX215 -00158 05 DISP-WRK-WRITE-CNT PIC ZZ,ZZZ,ZZ9. DTSBX215 -00159 DTSBX215 -00160 01 WRK-X215-REC. DTSBX215 -00161 ++INCLUDE DTSIX215 DTSBX215 -00162 DTSBX215 -00163 01 WRK-X220-REC. DTSBX215 -00164 ++INCLUDE DTSIX220 DTSBX215 -00165 DTSBX215 -00166 01 WRK-X220-CODES. DTSBX215 -00167 ++INCLUDE DTSIC220 DTSBX215 -00168 DTSBX215 -00169 01 L062-LINK-AREA. DTSBX215 -00170 ++INCLUDE DTSIL062 DTSBX215 -00171 DTSBX215 -00172 01 L001-LINK-AREA. DTSBX215 -00173 ++INCLUDE DTSIL001 DTSBX215 -00174 DTSBX215 -00175 01 L005-LINK-AREA. DTSBX215 -00176 ++INCLUDE DTSIL005 DTSBX215 -00177 DTSBX215 -00178 01 L910-LINK-AREA. DTSBX215 -00179 ++INCLUDE DTSIL910 DTSBX215 -00180 DTSBX215 -00181 01 MSKL-REC. DTSBX215 -00182 ++INCLUDE DTSIMSKL DTSBX215 -00183 DTSBX215 -00184 01 MHDR-REC. DTSBX215 -00185 ++INCLUDE DTSIMHDR DTSBX215 -00186 DTSBX215 -00187 01 MPRF-REC. DTSBX215 -00188 ++INCLUDE DTSIMPRF DTSBX215 -00189 DTSBX215 -00190 01 MFAS-REC. DTSBX215 -00191 ++INCLUDE DTSIMFAS DTSBX215 -00192 DTSBX215 -00193 01 MEVL-REC. DTSBX215 -00194 ++INCLUDE DTSIMEVL DTSBX215 -00195 DTSBX215 -00196 01 MRPT-REC. DTSBX215 -00197 ++INCLUDE DTSIMRPT DTSBX215 -00198 DTSBX215 -00199 01 L941-LINK-AREA. DTSBX215 -00200 ++INCLUDE DTSIL941 DTSBX215 -00201 DTSBX215 -00202 01 RSK3-REC. DTSBX215 -00203 ++INCLUDE DTSIRSK3 DTSBX215 -00204 DTSBX215 -00205 01 R301-REC. DTSBX215 -00206 ++INCLUDE DTSIR301 DTSBX215 -00207 DTSBX215 -00208 01 R906-REC. DTSBX215 -00209 ++INCLUDE DTSIR906 DTSBX215 -00210 DTSBX215 -00211 PROCEDURE DIVISION. DTSBX215 -00212 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX215 -00213 IF WRK-ERROR-NO-88 DTSBX215 -00214 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX215 -00215 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX215 -00216 END-IF. DTSBX215 -00217 DTSBX215 -00218 GOBACK. DTSBX215 -00219 DTSBX215 -00220 I0000-INITIATE. DTSBX215 -00221 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX215 -00222 IF WRK-ERROR-NO-88 DTSBX215 -00223 PERFORM I3000-READ-MHDR THRU I3000-EXIT DTSBX215 -00224 END-IF. DTSBX215 -00225 DTSBX215 -00226 I0000-EXIT. DTSBX215 -00227 EXIT. DTSBX215 -00228 DTSBX215 -00229 I2000-OPEN-FILES. DTSBX215 -00230 OPEN OUTPUT BX215-BATCH-FILE. DTSBX215 -00231 IF BX215-STATUS-OK-88 DTSBX215 -00232 NEXT SENTENCE DTSBX215 -00233 ELSE DTSBX215 -00234 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 -00235 DISPLAY 'CANNOT OPEN BX215 FILE ' BX215-STATUS DTSBX215 -00236 GO TO I2000-EXIT DTSBX215 -00237 END-IF. DTSBX215 -00238 DTSBX215 -00239 OPEN OUTPUT BX220-ACTIVITY-FILE. DTSBX215 -00240 IF BX220-STATUS-OK-88 DTSBX215 -00241 NEXT SENTENCE DTSBX215 -00242 ELSE DTSBX215 -00243 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 -00244 DISPLAY 'CANNOT OPEN BX220 FILE ' BX220-STATUS DTSBX215 -00245 GO TO I2000-EXIT DTSBX215 -00246 END-IF. DTSBX215 -00247 DTSBX215 -00248 OPEN OUTPUT DEPOSIT-FILE. DTSBX215 -00249 IF DEPOSIT-STATUS-OK-88 DTSBX215 -00250 NEXT SENTENCE DTSBX215 -00251 ELSE DTSBX215 -00252 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 -00253 DISPLAY 'CANNOT OPEN DEPOSIT FILE ' DEPOSIT-STATUS DTSBX215 -00254 GO TO I2000-EXIT DTSBX215 -00255 END-IF. DTSBX215 -00256 DTSBX215 +001145 77 PAN-VALET PICTURE X(24) VALUE '012DTSBX215 04/06/20'. DTSBX215 +00115 77 PAN-VALET PICTURE X(24) VALUE '017DTSBX215 05/08/09'. DTSBX215 +00116 01 WRK-AREA. DTSBX215 +00117 05 FILE-STATUS PIC 9(02) VALUE ZEROS. DTSBX215 +00118 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX215'. DTSBX215 +00119 DTSBX215 +00120 05 WRK-ERROR-IND PIC X(01) VALUE 'N'. DTSBX215 +00121 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX215 +00122 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX215 +00123 DTSBX215 +00124 05 BX215-STATUS PIC X(02). DTSBX215 +00125 88 BX215-STATUS-OK-88 VALUE '00'. DTSBX215 +00126 05 BX220-STATUS PIC X(02). DTSBX215 +00127 88 BX220-STATUS-OK-88 VALUE '00'. DTSBX215 +00128 05 DEPOSIT-STATUS PIC X(02). DTSBX215 +00129 88 DEPOSIT-STATUS-OK-88 VALUE '00'. DTSBX215 +00130 DTSBX215 +00131 05 WRK-BYPASS-906-IND PIC X(01). DTSBX215 +00132 88 WRK-BYPASS-906-YES-88 VALUE 'Y'. DTSBX215 +00133 88 WRK-BYPASS-906-NO-88 VALUE 'N'. DTSBX215 +00134 DTSBX215 +00135 05 WRK-SELECT-FAS-IND PIC X(01). DTSBX215 +00136 88 WRK-SELECT-FAS-YES-88 VALUE 'Y'. DTSBX215 +00137 88 WRK-SELECT-FAS-NO-88 VALUE 'N'. DTSBX215 +00138 DTSBX215 +00139 05 WRK-SELECT-RPT-IND PIC X(01). DTSBX215 +00140 88 WRK-SELECT-RPT-YES-88 VALUE 'Y'. DTSBX215 +00141 88 WRK-SELECT-RPT-NO-88 VALUE 'N'. DTSBX215 +00142 DTSBX215 +00143 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +310.DTSBX215 +00144 05 WRK-PRIOR-RUN-DATE PIC S9(09) COMP-3. DTSBX215 +00145 05 WRK-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX215 +00146 05 WRK-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 +00147 05 WRK-X215-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 +00148 05 WRK-X220-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 +00149 05 WRK-DEPOSIT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX215 +00150 DTSBX215 +00151 05 WRK-906-OPID PIC X(08). DTSBX215 +00152 05 WRK-906-EMP PIC S9(07) COMP-3. DTSBX215 +00153 05 WRK-906-SCREEN PIC X(02). DTSBX215 +00154 05 WRK-906-DATE PIC S9(09) COMP-3. DTSBX215 +00155 05 WRK-906-TIME PIC S9(07) COMP-3. DTSBX215 +00156 DTSBX215 +00157 05 DISP-REMIT PIC --,---,---,--9.99. DTSBX215 +00158 05 DISP-WRK-READ-CNT PIC ZZ,ZZZ,ZZ9. DTSBX215 +00159 05 DISP-WRK-WRITE-CNT PIC ZZ,ZZZ,ZZ9. DTSBX215 +00160 DTSBX215 +00161 01 WRK-X215-REC. DTSBX215 +00162 ++INCLUDE DTSIX215 DTSBX215 +00163 DTSBX215 +00164 01 WRK-X220-REC. DTSBX215 +00165 ++INCLUDE DTSIX220 DTSBX215 +00166 DTSBX215 +00167 01 WRK-X220-CODES. DTSBX215 +00168 ++INCLUDE DTSIC220 DTSBX215 +00169 DTSBX215 +00170 01 L062-LINK-AREA. DTSBX215 +00171 ++INCLUDE DTSIL062 DTSBX215 +00172 DTSBX215 +00173 01 L001-LINK-AREA. DTSBX215 +00174 ++INCLUDE DTSIL001 DTSBX215 +00175 DTSBX215 +00176 01 L005-LINK-AREA. DTSBX215 +00177 ++INCLUDE DTSIL005 DTSBX215 +00178 DTSBX215 +00179 01 L910-LINK-AREA. DTSBX215 +00180 ++INCLUDE DTSIL910 DTSBX215 +00181 DTSBX215 +00182 01 MSKL-REC. DTSBX215 +00183 ++INCLUDE DTSIMSKL DTSBX215 +00184 DTSBX215 +00185 01 MHDR-REC. DTSBX215 +00186 ++INCLUDE DTSIMHDR DTSBX215 +00187 DTSBX215 +00188 01 MPRF-REC. DTSBX215 +00189 ++INCLUDE DTSIMPRF DTSBX215 +00190 DTSBX215 +00191 01 MFAS-REC. DTSBX215 +00192 ++INCLUDE DTSIMFAS DTSBX215 +00193 DTSBX215 +00194 01 MEVL-REC. DTSBX215 +00195 ++INCLUDE DTSIMEVL DTSBX215 +00196 DTSBX215 +00197 01 MRPT-REC. DTSBX215 +00198 ++INCLUDE DTSIMRPT DTSBX215 +00199 DTSBX215 +00200 01 L941-LINK-AREA. DTSBX215 +00201 ++INCLUDE DTSIL941 DTSBX215 +00202 DTSBX215 +00203 01 RSK3-REC. DTSBX215 +00204 ++INCLUDE DTSIRSK3 DTSBX215 +00205 DTSBX215 +00206 01 R301-REC. DTSBX215 +00207 ++INCLUDE DTSIR301 DTSBX215 +00208 DTSBX215 +00209 01 R906-REC. DTSBX215 +00210 ++INCLUDE DTSIR906 DTSBX215 +00211 DTSBX215 +00212 PROCEDURE DIVISION. DTSBX215 +00213 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX215 +00214 IF WRK-ERROR-NO-88 DTSBX215 +00215 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX215 +00216 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX215 +00217 END-IF. DTSBX215 +00218 DTSBX215 +00219 GOBACK. DTSBX215 +00220 DTSBX215 +00221 I0000-INITIATE. DTSBX215 +00222 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX215 +00223 IF WRK-ERROR-NO-88 DTSBX215 +00224 PERFORM I3000-READ-MHDR THRU I3000-EXIT DTSBX215 +00225 END-IF. DTSBX215 +00226 DTSBX215 +00227 I0000-EXIT. DTSBX215 +00228 EXIT. DTSBX215 +00229 DTSBX215 +00230 I2000-OPEN-FILES. DTSBX215 +00231 OPEN OUTPUT BX215-BATCH-FILE. DTSBX215 +00232 IF BX215-STATUS-OK-88 DTSBX215 +00233 NEXT SENTENCE DTSBX215 +00234 ELSE DTSBX215 +00235 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 +00236 DISPLAY 'CANNOT OPEN BX215 FILE ' BX215-STATUS DTSBX215 +00237 GO TO I2000-EXIT DTSBX215 +00238 END-IF. DTSBX215 +00239 DTSBX215 +00240 OPEN OUTPUT BX220-ACTIVITY-FILE. DTSBX215 +00241 IF BX220-STATUS-OK-88 DTSBX215 +00242 NEXT SENTENCE DTSBX215 +00243 ELSE DTSBX215 +00244 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 +00245 DISPLAY 'CANNOT OPEN BX220 FILE ' BX220-STATUS DTSBX215 +00246 GO TO I2000-EXIT DTSBX215 +00247 END-IF. DTSBX215 +00248 DTSBX215 +00249 OPEN OUTPUT DEPOSIT-FILE. DTSBX215 +00250 IF DEPOSIT-STATUS-OK-88 DTSBX215 +00251 NEXT SENTENCE DTSBX215 +00252 ELSE DTSBX215 +00253 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 +00254 DISPLAY 'CANNOT OPEN DEPOSIT FILE ' DEPOSIT-STATUS DTSBX215 +00255 GO TO I2000-EXIT DTSBX215 +00256 END-IF. DTSBX215 00257 DTSBX215 -00258 MOVE 'N' TO L910-TRACE-IND DTSBX215 -00259 L941-TRACE-IND. DTSBX215 -00260 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBX215 -00261 L941-MOD-NAME. DTSBX215 -00262 DTSBX215 -00263 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX215 -00264 PERFORM S941-OPEN THRU S941-EXIT. DTSBX215 -00265 DTSBX215 -00266 I2000-EXIT. DTSBX215 -00267 EXIT. DTSBX215 -00268 DTSBX215 -00269 I3000-READ-MHDR. DTSBX215 -00270 MOVE LOW-VALUES TO MSKL-REC. DTSBX215 -00271 MOVE +0 TO MSKL-EMP-NO. DTSBX215 -00272 SET MSKL-HDR-88 TO TRUE. DTSBX215 -00273 DTSBX215 -00274 PERFORM S910-READ THRU S910-EXIT. DTSBX215 -00275 IF L910-NO-REC-88 DTSBX215 -00276 DISPLAY 'DTSBX215: MHDR RECORD IS MISSING' DTSBX215 -00277 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 -00278 GO TO I3000-EXIT DTSBX215 -00279 ELSE DTSBX215 -00280 MOVE MSKL-REC TO MHDR-REC DTSBX215 -00281 MOVE MHDR-PRIOR-RUN-DATE TO WRK-PRIOR-RUN-DATE DTSBX215 -00282 MOVE MHDR-CURR-RUN-DATE TO WRK-CURR-RUN-DATE DTSBX215 -00283 END-IF. DTSBX215 -00284 DTSBX215 +00258 DTSBX215 +00259 MOVE 'N' TO L910-TRACE-IND DTSBX215 +00260 L941-TRACE-IND. DTSBX215 +00261 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBX215 +00262 L941-MOD-NAME. DTSBX215 +00263 DTSBX215 +00264 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX215 +00265 PERFORM S941-OPEN THRU S941-EXIT. DTSBX215 +00266 DTSBX215 +00267 I2000-EXIT. DTSBX215 +00268 EXIT. DTSBX215 +00269 DTSBX215 +00270 I3000-READ-MHDR. DTSBX215 +00271 MOVE LOW-VALUES TO MSKL-REC. DTSBX215 +00272 MOVE +0 TO MSKL-EMP-NO. DTSBX215 +00273 SET MSKL-HDR-88 TO TRUE. DTSBX215 +00274 DTSBX215 +00275 PERFORM S910-READ THRU S910-EXIT. DTSBX215 +00276 IF L910-NO-REC-88 DTSBX215 +00277 DISPLAY 'DTSBX215: MHDR RECORD IS MISSING' DTSBX215 +00278 SET WRK-ERROR-YES-88 TO TRUE DTSBX215 +00279 GO TO I3000-EXIT DTSBX215 +00280 ELSE DTSBX215 +00281 MOVE MSKL-REC TO MHDR-REC DTSBX215 +00282 MOVE MHDR-PRIOR-RUN-DATE TO WRK-PRIOR-RUN-DATE DTSBX215 +00283 MOVE MHDR-CURR-RUN-DATE TO WRK-CURR-RUN-DATE DTSBX215 +00284 END-IF. DTSBX215 00285 DTSBX215 -00286 MOVE WRK-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 -00287 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 -00288 DISPLAY 'FINDING R301 RECORDS FROM ' L001-SLASH-8-DATE. DTSBX215 -00289 DTSBX215 -00290 MOVE WRK-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 -00291 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 -00292 DISPLAY 'FINDING R906 RECORDS FROM ' L001-SLASH-8-DATE. DTSBX215 -00293 DTSBX215 -00294 I3000-EXIT. DTSBX215 -00295 EXIT. DTSBX215 -00296 DTSBX215 -00297 P0000-PROCESS. DTSBX215 -00298 PERFORM P1000-FROM-RPTS THRU P1000-EXIT. DTSBX215 -00299 PERFORM P2000-FROM-EVL THRU P2000-EXIT. DTSBX215 -00300 DTSBX215 -00301 IF WRK-X215-CNT = ZERO DTSBX215 -00302 PERFORM P4000-WRITE-X215-DUMMY THRU P4000-EXIT DTSBX215 -00303 END-IF. DTSBX215 -00304 DTSBX215 -00305 IF WRK-X220-CNT = ZERO DTSBX215 -00306 PERFORM P4100-WRITE-X220-DUMMY THRU P4100-EXIT DTSBX215 -00307 END-IF. DTSBX215 -00308 DTSBX215 -00309 P0000-EXIT. DTSBX215 -00310 EXIT. DTSBX215 -00311 DTSBX215 -00312 P1000-FROM-RPTS. DTSBX215 -00313 PERFORM S941-READ-NEXT THRU S941-EXIT. DTSBX215 -00314 DTSBX215 -00315 PERFORM UNTIL L941-NO-REC-88 DTSBX215 -00316 EVALUATE RSK3-REC-TYPE DTSBX215 -00317 WHEN '301' DTSBX215 -00318 ADD +1 TO WRK-READ-CNT DTSBX215 -00319 MOVE RSK3-REC TO R301-REC DTSBX215 -00320 PERFORM P1100-PROCESS-R301 THRU P1100-EXIT DTSBX215 -00321 PERFORM P1300-DEPOSITS THRU P1300-EXIT DTSBX215 -00322 DTSBX215 -00323 WHEN '906' DTSBX215 -00324 ADD +1 TO WRK-READ-CNT DTSBX215 -00325 MOVE RSK3-REC TO R906-REC DTSBX215 -00326 PERFORM P1200-PROCESS-R906 THRU P1200-EXIT DTSBX215 -00327 END-EVALUATE DTSBX215 -00328 PERFORM S941-READ-NEXT THRU S941-EXIT DTSBX215 -00329 END-PERFORM. DTSBX215 -00330 DTSBX215 -00331 P1000-EXIT. DTSBX215 -00332 EXIT. DTSBX215 -00333 DTSBX215 -00334 P1100-PROCESS-R301. DTSBX215 -00335 *& IF R301-CURR-RUN-DATE < 20080723 DTSBX215 -00336 * GO TO P1100-EXIT DTSBX215 -00337 *& END-IF. DTSBX215 -00338 DTSBX215 -00339 IF R301-CURR-RUN-DATE = WRK-PRIOR-RUN-DATE DTSBX215 -00340 IF R301-CURR-RUN-DATE = R301-ESTB-DATE DTSBX215 -00341 OR R301-CURR-RUN-DATE = R301-CHNG-DATE DTSBX215 -00342 NEXT SENTENCE DTSBX215 -00343 ELSE DTSBX215 -00344 GO TO P1100-EXIT DTSBX215 -00345 END-IF DTSBX215 -00346 ELSE DTSBX215 -00347 GO TO P1100-EXIT DTSBX215 -00348 END-IF. DTSBX215 -00349 DTSBX215 -00350 MOVE R301-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 -00351 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 -00352 MOVE L001-SLASH-8-DATE TO X215-PROCESS-DT. DTSBX215 -00353 DTSBX215 -00354 MOVE R301-BATCH-NO TO X215-BATCH. DTSBX215 -00355 DTSBX215 -00356 MOVE R301-BATCH-BALANCED-IND TO X215-BALANCED-IND. DTSBX215 -00357 MOVE R301-BATCH-HELD-IND TO X215-HELD-IND. DTSBX215 -00358 DTSBX215 -00359 MOVE R301-CONTROL-TRAN-CNT TO X215-CONTROL-TRAN-CNT. DTSBX215 -00360 MOVE R301-CONTROL-REMIT-AMT TO X215-CONTROL-REMIT-AMT.DTSBX215 -00361 DTSBX215 -00362 MOVE R301-ATC-FILE-TRAN-CNT TO DTSBX215 -00363 X215-ATC-FILE-TRAN-CNT. DTSBX215 -00364 MOVE R301-ATC-FILE-REMIT-AMT TO DTSBX215 -00365 X215-ATC-FILE-REMIT-AMT. DTSBX215 -00366 DTSBX215 -00367 COMPUTE X215-PROCESSED-CNT = DTSBX215 -00368 (R301-SUCCEEDED-PREV-TRAN-CNT + DTSBX215 -00369 R301-SUCCEEDED-TODAY-TRAN-CNT). DTSBX215 -00370 DTSBX215 -00371 COMPUTE X215-PROCESSED-REMIT = DTSBX215 -00372 (R301-SUCCEEDED-PREV-REMIT-AMT + DTSBX215 -00373 R301-SUCCEEDED-TODAY-REMIT-AMT). DTSBX215 -00374 DTSBX215 -00375 MOVE R301-DEPOSIT-DATE TO L001-FED-8-DATE-9. DTSBX215 -00376 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 -00377 MOVE L001-SLASH-8-DATE TO X215-DEPOSIT-DATE. DTSBX215 -00378 DTSBX215 -00379 IF R301-CHNG-OP-ID = SPACES DTSBX215 -00380 MOVE R301-ESTB-OP-ID TO R301-CHNG-OP-ID DTSBX215 -00381 END-IF. DTSBX215 -00382 DTSBX215 -00383 IF R301-CHNG-OP-ID > SPACES DTSBX215 -00384 MOVE R301-CHNG-OP-ID TO X215-CHNG-OP-ID DTSBX215 -00385 ELSE DTSBX215 -00386 MOVE SPACES TO X215-CHNG-OP-ID DTSBX215 -00387 END-IF. DTSBX215 -00388 DTSBX215 -00389 MOVE R301-BANK-BATCH-NO TO X215-BANK-BATCH. DTSBX215 -00390 DTSBX215 -00391 WRITE BX215-REC FROM WRK-X215-REC. DTSBX215 -00392 ADD +1 TO WRK-X215-CNT. DTSBX215 -00393 DTSBX215 -00394 P1100-EXIT. DTSBX215 -00395 EXIT. DTSBX215 -00396 DTSBX215 -00397 P1200-PROCESS-R906. DTSBX215 -00398 IF R906-TASK-START-DATE NOT = WRK-PRIOR-RUN-DATE DTSBX215 -00399 GO TO P1200-EXIT DTSBX215 -00400 END-IF. DTSBX215 -00401 *& IF R906-TASK-START-DATE < 20080806 DTSBX215 -00402 * GO TO P1200-EXIT DTSBX215 -00403 *& END-IF. DTSBX215 -00404 DTSBX215 -00405 IF R906-OP-ID (1:4) = 'TDEC' DTSBX215 -00406 GO TO P1200-EXIT DTSBX215 -00407 END-IF. DTSBX215 -00408 DTSBX215 -00409 ********************************************************** DTSBX215 -00410 * BYPASS ANY MATCHING RECORDS ENTERED WITHIN 5 MINUTES OF DTSBX215 -00411 * EACHOTHER. DTSBX215 -00412 ********************************************************** DTSBX215 -00413 IF (R906-OP-ID = WRK-906-OPID DTSBX215 -00414 AND R906-EMP-NO = WRK-906-EMP DTSBX215 -00415 AND R906-SCR-ID = WRK-906-SCREEN DTSBX215 -00416 AND R906-TASK-START-DATE = WRK-906-DATE) DTSBX215 -00417 IF (R906-TASK-START-TIME - WRK-906-TIME) < 500 DTSBX215 -00418 *** DISPLAY 'WITHIN 5 MIN ' R906-OP-ID ' ' DTSBX215 -00419 *** R906-EMP-NO ' ' R906-TASK-START-DATE DTSBX215 -00420 PERFORM P1220-SAVE-KEY THRU P1220-EXIT DTSBX215 -00421 GO TO P1200-EXIT DTSBX215 -00422 END-IF DTSBX215 -00423 ELSE DTSBX215 -00424 PERFORM P1220-SAVE-KEY THRU P1220-EXIT DTSBX215 -00425 END-IF. DTSBX215 -00426 DTSBX215 -00427 SET WRK-BYPASS-906-NO-88 TO TRUE. DTSBX215 -00428 PERFORM P1210-ACTIVITY THRU P1210-EXIT. DTSBX215 -00429 IF WRK-BYPASS-906-YES-88 DTSBX215 -00430 GO TO P1200-EXIT DTSBX215 -00431 END-IF. DTSBX215 -00432 DTSBX215 -00433 MOVE R906-TASK-START-DATE TO L005-DATE. DTSBX215 -00434 MOVE R906-TASK-START-TIME TO L005-TIME. DTSBX215 -00435 SET L005-FROM-DATE-TIME TO TRUE. DTSBX215 -00436 PERFORM S005-DATE THRU S005-EXIT. DTSBX215 -00437 MOVE L005-SLASH-8-DATE TO X220-DATE. DTSBX215 -00438 MOVE L005-DISPLAY-TIME TO X220-TIME. DTSBX215 -00439 DTSBX215 -00440 MOVE R906-EMP-NO TO X220-EMP-NO. DTSBX215 -00441 DTSBX215 -00442 MOVE R906-OP-ID TO X220-OPID. DTSBX215 -00443 DTSBX215 -00444 MOVE R906-BATCH-NO TO X220-BATCH. DTSBX215 -00445 DTSBX215 -00446 MOVE R906-ITEM-NO TO X220-ITEM. DTSBX215 -00447 DTSBX215 -00448 MOVE C220-BUSINESS-AREA TO X220-BUSINESS-AREA. DTSBX215 -00449 MOVE C220-ACTIVITY-CODE TO X220-ACTIVITY. DTSBX215 -00450 *& DTSBX215 -00451 * IF X220-ACTIVITY = '020' DTSBX215 -00452 * NEXT SENTENCE DTSBX215 -00453 * ELSE DTSBX215 -00454 * GO TO P1200-EXIT DTSBX215 -00455 * END-IF. DTSBX215 -00456 *& DTSBX215 -00457 DTSBX215 -00458 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 -00459 ADD +1 TO WRK-X220-CNT. DTSBX215 +00286 DTSBX215 +00287 MOVE WRK-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 +00288 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 +00289 DISPLAY 'FINDING R301 RECORDS FROM ' L001-SLASH-8-DATE. DTSBX215 +00290 DTSBX215 +00291 MOVE WRK-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 +00292 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 +00293 DISPLAY 'FINDING R906 RECORDS FROM ' L001-SLASH-8-DATE. DTSBX215 +00294 DTSBX215 +00295 I3000-EXIT. DTSBX215 +00296 EXIT. DTSBX215 +00297 DTSBX215 +00298 P0000-PROCESS. DTSBX215 +00299 PERFORM P1000-FROM-RPTS THRU P1000-EXIT. DTSBX215 +00300 PERFORM P2000-FROM-EVL THRU P2000-EXIT. DTSBX215 +00301 DTSBX215 +00302 IF WRK-X215-CNT = ZERO DTSBX215 +00303 PERFORM P4000-WRITE-X215-DUMMY THRU P4000-EXIT DTSBX215 +00304 END-IF. DTSBX215 +00305 DTSBX215 +00306 IF WRK-X220-CNT = ZERO DTSBX215 +00307 PERFORM P4100-WRITE-X220-DUMMY THRU P4100-EXIT DTSBX215 +00308 END-IF. DTSBX215 +00309 DTSBX215 +00310 P0000-EXIT. DTSBX215 +00311 EXIT. DTSBX215 +00312 DTSBX215 +00313 P1000-FROM-RPTS. DTSBX215 +00314 PERFORM S941-READ-NEXT THRU S941-EXIT. DTSBX215 +00315 DTSBX215 +00316 PERFORM UNTIL L941-NO-REC-88 DTSBX215 +00317 EVALUATE RSK3-REC-TYPE DTSBX215 +00318 WHEN '301' DTSBX215 +00319 ADD +1 TO WRK-READ-CNT DTSBX215 +00320 MOVE RSK3-REC TO R301-REC DTSBX215 +00321 PERFORM P1100-PROCESS-R301 THRU P1100-EXIT DTSBX215 +00322 PERFORM P1300-DEPOSITS THRU P1300-EXIT DTSBX215 +00323 DTSBX215 +00324 WHEN '906' DTSBX215 +00325 ADD +1 TO WRK-READ-CNT DTSBX215 +00326 MOVE RSK3-REC TO R906-REC DTSBX215 +00327 PERFORM P1200-PROCESS-R906 THRU P1200-EXIT DTSBX215 +00328 END-EVALUATE DTSBX215 +00329 PERFORM S941-READ-NEXT THRU S941-EXIT DTSBX215 +00330 END-PERFORM. DTSBX215 +00331 DTSBX215 +00332 P1000-EXIT. DTSBX215 +00333 EXIT. DTSBX215 +00334 DTSBX215 +00335 P1100-PROCESS-R301. DTSBX215 +00336 *& IF R301-CURR-RUN-DATE < 20080723 DTSBX215 +00337 * GO TO P1100-EXIT DTSBX215 +00338 *& END-IF. DTSBX215 +00339 DTSBX215 +00340 IF R301-CURR-RUN-DATE = WRK-PRIOR-RUN-DATE DTSBX215 +00341 IF R301-CURR-RUN-DATE = R301-ESTB-DATE DTSBX215 +00342 OR R301-CURR-RUN-DATE = R301-CHNG-DATE DTSBX215 +00343 NEXT SENTENCE DTSBX215 +00344 ELSE DTSBX215 +00345 GO TO P1100-EXIT DTSBX215 +00346 END-IF DTSBX215 +00347 ELSE DTSBX215 +00348 GO TO P1100-EXIT DTSBX215 +00349 END-IF. DTSBX215 +00350 DTSBX215 +00351 MOVE R301-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 +00352 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 +00353 MOVE L001-SLASH-8-DATE TO X215-PROCESS-DT. DTSBX215 +00354 DTSBX215 +00355 MOVE R301-BATCH-NO TO X215-BATCH. DTSBX215 +00356 DTSBX215 +00357 MOVE R301-BATCH-BALANCED-IND TO X215-BALANCED-IND. DTSBX215 +00358 MOVE R301-BATCH-HELD-IND TO X215-HELD-IND. DTSBX215 +00359 DTSBX215 +00360 MOVE R301-CONTROL-TRAN-CNT TO X215-CONTROL-TRAN-CNT. DTSBX215 +00361 MOVE R301-CONTROL-REMIT-AMT TO X215-CONTROL-REMIT-AMT.DTSBX215 +00362 DTSBX215 +00363 MOVE R301-ATC-FILE-TRAN-CNT TO DTSBX215 +00364 X215-ATC-FILE-TRAN-CNT. DTSBX215 +00365 MOVE R301-ATC-FILE-REMIT-AMT TO DTSBX215 +00366 X215-ATC-FILE-REMIT-AMT. DTSBX215 +00367 DTSBX215 +00368 COMPUTE X215-PROCESSED-CNT = DTSBX215 +00369 (R301-SUCCEEDED-PREV-TRAN-CNT + DTSBX215 +00370 R301-SUCCEEDED-TODAY-TRAN-CNT). DTSBX215 +00371 DTSBX215 +00372 COMPUTE X215-PROCESSED-REMIT = DTSBX215 +00373 (R301-SUCCEEDED-PREV-REMIT-AMT + DTSBX215 +00374 R301-SUCCEEDED-TODAY-REMIT-AMT). DTSBX215 +00375 DTSBX215 +00376 MOVE R301-DEPOSIT-DATE TO L001-FED-8-DATE-9. DTSBX215 +00377 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 +00378 MOVE L001-SLASH-8-DATE TO X215-DEPOSIT-DATE. DTSBX215 +00379 DTSBX215 +00380 IF R301-CHNG-OP-ID = SPACES DTSBX215 +00381 MOVE R301-ESTB-OP-ID TO R301-CHNG-OP-ID DTSBX215 +00382 END-IF. DTSBX215 +00383 DTSBX215 +00384 IF R301-CHNG-OP-ID > SPACES DTSBX215 +00385 MOVE R301-CHNG-OP-ID TO X215-CHNG-OP-ID DTSBX215 +00386 ELSE DTSBX215 +00387 MOVE SPACES TO X215-CHNG-OP-ID DTSBX215 +00388 END-IF. DTSBX215 +00389 DTSBX215 +00390 MOVE R301-BANK-BATCH-NO TO X215-BANK-BATCH. DTSBX215 +00391 DTSBX215 +00392 WRITE BX215-REC FROM WRK-X215-REC. DTSBX215 +00393 ADD +1 TO WRK-X215-CNT. DTSBX215 +00394 DTSBX215 +00395 P1100-EXIT. DTSBX215 +00396 EXIT. DTSBX215 +00397 DTSBX215 +00398 P1200-PROCESS-R906. DTSBX215 +00399 IF R906-TASK-START-DATE NOT = WRK-PRIOR-RUN-DATE DTSBX215 +00400 GO TO P1200-EXIT DTSBX215 +00401 END-IF. DTSBX215 +00402 *& IF R906-TASK-START-DATE < 20080806 DTSBX215 +00403 * GO TO P1200-EXIT DTSBX215 +00404 *& END-IF. DTSBX215 +00405 DTSBX215 +00406 IF R906-OP-ID (1:4) = 'TDEC' DTSBX215 +00407 GO TO P1200-EXIT DTSBX215 +00408 END-IF. DTSBX215 +00409 DTSBX215 +00410 ********************************************************** DTSBX215 +00411 * BYPASS ANY MATCHING RECORDS ENTERED WITHIN 5 MINUTES OF DTSBX215 +00412 * EACHOTHER. DTSBX215 +00413 ********************************************************** DTSBX215 +00414 IF (R906-OP-ID = WRK-906-OPID DTSBX215 +00415 AND R906-EMP-NO = WRK-906-EMP DTSBX215 +00416 AND R906-SCR-ID = WRK-906-SCREEN DTSBX215 +00417 AND R906-TASK-START-DATE = WRK-906-DATE) DTSBX215 +00418 IF (R906-TASK-START-TIME - WRK-906-TIME) < 500 DTSBX215 +00419 *** DISPLAY 'WITHIN 5 MIN ' R906-OP-ID ' ' DTSBX215 +00420 *** R906-EMP-NO ' ' R906-TASK-START-DATE DTSBX215 +00421 PERFORM P1220-SAVE-KEY THRU P1220-EXIT DTSBX215 +00422 GO TO P1200-EXIT DTSBX215 +00423 END-IF DTSBX215 +00424 ELSE DTSBX215 +00425 PERFORM P1220-SAVE-KEY THRU P1220-EXIT DTSBX215 +00426 END-IF. DTSBX215 +00427 DTSBX215 +00428 SET WRK-BYPASS-906-NO-88 TO TRUE. DTSBX215 +00429 PERFORM P1210-ACTIVITY THRU P1210-EXIT. DTSBX215 +00430 IF WRK-BYPASS-906-YES-88 DTSBX215 +00431 GO TO P1200-EXIT DTSBX215 +00432 END-IF. DTSBX215 +00433 DTSBX215 +00434 MOVE R906-TASK-START-DATE TO L005-DATE. DTSBX215 +00435 MOVE R906-TASK-START-TIME TO L005-TIME. DTSBX215 +00436 SET L005-FROM-DATE-TIME TO TRUE. DTSBX215 +00437 PERFORM S005-DATE THRU S005-EXIT. DTSBX215 +00438 MOVE L005-SLASH-8-DATE TO X220-DATE. DTSBX215 +00439 MOVE L005-DISPLAY-TIME TO X220-TIME. DTSBX215 +00440 DTSBX215 +00441 MOVE R906-EMP-NO TO X220-EMP-NO. DTSBX215 +00442 DTSBX215 +00443 MOVE R906-OP-ID TO X220-OPID. DTSBX215 +00444 DTSBX215 +00445 ****ZL1 CL**3 +00446 MOVE ZEROS TO X220-BATCH X220-ITEM. CL**3 +00447 * MOVE R906-BATCH-NO TO X220-BATCH. CL**3 +00448 DTSBX215 +00449 * MOVE R906-ITEM-NO TO X220-ITEM. CL**3 +00450 DTSBX215 +00451 MOVE C220-BUSINESS-AREA TO X220-BUSINESS-AREA. DTSBX215 +00452 MOVE C220-ACTIVITY-CODE TO X220-ACTIVITY. DTSBX215 +00453 *& DTSBX215 +00454 * IF X220-ACTIVITY = '020' DTSBX215 +00455 * NEXT SENTENCE DTSBX215 +00456 * ELSE DTSBX215 +00457 * GO TO P1200-EXIT DTSBX215 +00458 * END-IF. DTSBX215 +00459 *& DTSBX215 00460 DTSBX215 -00461 P1200-EXIT. DTSBX215 -00462 EXIT. DTSBX215 +00461 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 +00462 ADD +1 TO WRK-X220-CNT. DTSBX215 00463 DTSBX215 -00464 P1210-ACTIVITY. DTSBX215 -00465 EVALUATE R906-SCR-ID DTSBX215 -00466 WHEN '1A' DTSBX215 -00467 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00468 IF R906-FUNCTION = 'A' DTSBX215 -00469 SET C220-EMP-REGISTERED-88 TO TRUE DTSBX215 -00470 ELSE DTSBX215 -00471 SET C220-OTHER-STATUS-88 TO TRUE DTSBX215 -00472 END-IF DTSBX215 -00473 DTSBX215 -00474 WHEN '1C' DTSBX215 -00475 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00476 SET C220-LIAB-DETERM-88 TO TRUE DTSBX215 -00477 DTSBX215 -00478 WHEN '13' DTSBX215 -00479 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00480 SET C220-ADDRESS-88 TO TRUE DTSBX215 -00481 DTSBX215 -00482 WHEN '15' DTSBX215 -00483 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00484 SET C220-OPO-88 TO TRUE DTSBX215 -00485 DTSBX215 -00486 WHEN '16' DTSBX215 -00487 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00488 SET C220-ADDRESS-88 TO TRUE DTSBX215 -00489 DTSBX215 -00490 WHEN '17' DTSBX215 -00491 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00492 SET C220-LIAB-DETERM-88 TO TRUE DTSBX215 -00493 DTSBX215 -00494 WHEN '19' DTSBX215 -00495 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00496 SET C220-RELATIONSHIP-88 TO TRUE DTSBX215 -00497 DTSBX215 -00498 WHEN '24' DTSBX215 -00499 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 -00500 *** PERFORM P1212-RPT THRU P1212-EXIT DTSBX215 -00501 * IF WRK-SELECT-RPT-NO-88 DTSBX215 -00502 * SET WRK-BYPASS-906-YES-88 TO TRUE DTSBX215 -00503 *** END-IF DTSBX215 -00504 IF R906-FUNCTION = 'A' DTSBX215 -00505 SET C220-REPORT-ADD-88 TO TRUE DTSBX215 -00506 ELSE DTSBX215 -00507 SET C220-REPORT-MOD-88 TO TRUE DTSBX215 -00508 END-IF DTSBX215 -00509 DTSBX215 -00510 WHEN '25' DTSBX215 -00511 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 -00512 IF R906-FUNCTION = 'A' DTSBX215 -00513 SET C220-PAY-ADD-88 TO TRUE DTSBX215 -00514 ELSE DTSBX215 -00515 SET C220-PAY-MOD-88 TO TRUE DTSBX215 -00516 END-IF DTSBX215 -00517 DTSBX215 -00518 WHEN '26' DTSBX215 -00519 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 -00520 IF R906-FUNCTION = 'A' DTSBX215 -00521 SET C220-ADJ-ADD-88 TO TRUE DTSBX215 -00522 ELSE DTSBX215 -00523 SET C220-ADJ-MOD-88 TO TRUE DTSBX215 -00524 END-IF DTSBX215 -00525 DTSBX215 -00526 WHEN '42' DTSBX215 -00527 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 -00528 SET C220-MISC-COLL-88 TO TRUE DTSBX215 -00529 DTSBX215 -00530 WHEN '44' DTSBX215 -00531 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 -00532 IF R906-FUNCTION = 'A' DTSBX215 -00533 SET C220-LIEN-ADD-88 TO TRUE DTSBX215 -00534 ELSE DTSBX215 -00535 SET C220-LIEN-MOD-88 TO TRUE DTSBX215 -00536 END-IF DTSBX215 -00537 DTSBX215 -00538 WHEN '45' DTSBX215 -00539 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 -00540 IF R906-FUNCTION = 'A' DTSBX215 -00541 SET C220-DPC-ADD-88 TO TRUE DTSBX215 -00542 ELSE DTSBX215 -00543 SET C220-DPC-MOD-88 TO TRUE DTSBX215 -00544 END-IF DTSBX215 -00545 DTSBX215 -00546 WHEN '47' DTSBX215 -00547 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 -00548 IF R906-FUNCTION = 'A' DTSBX215 -00549 SET C220-LEVY-ADD-88 TO TRUE DTSBX215 -00550 ELSE DTSBX215 -00551 SET C220-LEVY-MOD-88 TO TRUE DTSBX215 -00552 END-IF DTSBX215 -00553 DTSBX215 -00554 WHEN '51' DTSBX215 -00555 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00556 IF R906-FUNCTION = 'A' DTSBX215 -00557 SET C220-RATE-ADD-88 TO TRUE DTSBX215 -00558 ELSE DTSBX215 -00559 SET C220-RATE-MOD-88 TO TRUE DTSBX215 -00560 END-IF DTSBX215 -00561 DTSBX215 -00562 WHEN '52' DTSBX215 -00563 SET C220-BA-STATUS-88 TO TRUE DTSBX215 -00564 IF R906-FUNCTION = 'A' DTSBX215 -00565 SET C220-RATE-DATA-ADD-88 TO TRUE DTSBX215 -00566 ELSE DTSBX215 -00567 SET C220-RATE-DATA-MOD-88 TO TRUE DTSBX215 -00568 END-IF DTSBX215 -00569 DTSBX215 -00570 *& WHEN '61' DTSBX215 -00571 * PERFORM P1211-FAS THRU P1211-EXIT DTSBX215 -00572 * DTSBX215 -00573 * WHEN '62' DTSBX215 +00464 P1200-EXIT. DTSBX215 +00465 EXIT. DTSBX215 +00466 DTSBX215 +00467 P1210-ACTIVITY. DTSBX215 +00468 EVALUATE R906-SCR-ID DTSBX215 +00469 WHEN '1A' DTSBX215 +00470 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00471 IF R906-FUNCTION = 'A' DTSBX215 +00472 SET C220-EMP-REGISTERED-88 TO TRUE DTSBX215 +00473 ELSE DTSBX215 +00474 SET C220-OTHER-STATUS-88 TO TRUE DTSBX215 +00475 END-IF DTSBX215 +00476 DTSBX215 +00477 WHEN '1C' DTSBX215 +00478 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00479 SET C220-LIAB-DETERM-88 TO TRUE DTSBX215 +00480 DTSBX215 +00481 WHEN '13' DTSBX215 +00482 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00483 SET C220-ADDRESS-88 TO TRUE DTSBX215 +00484 DTSBX215 +00485 WHEN '15' DTSBX215 +00486 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00487 SET C220-OPO-88 TO TRUE DTSBX215 +00488 DTSBX215 +00489 WHEN '16' DTSBX215 +00490 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00491 SET C220-ADDRESS-88 TO TRUE DTSBX215 +00492 DTSBX215 +00493 WHEN '17' DTSBX215 +00494 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00495 SET C220-LIAB-DETERM-88 TO TRUE DTSBX215 +00496 DTSBX215 +00497 WHEN '19' DTSBX215 +00498 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00499 SET C220-RELATIONSHIP-88 TO TRUE DTSBX215 +00500 DTSBX215 +00501 WHEN '24' DTSBX215 +00502 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 +00503 *** PERFORM P1212-RPT THRU P1212-EXIT DTSBX215 +00504 * IF WRK-SELECT-RPT-NO-88 DTSBX215 +00505 * SET WRK-BYPASS-906-YES-88 TO TRUE DTSBX215 +00506 *** END-IF DTSBX215 +00507 IF R906-FUNCTION = 'A' DTSBX215 +00508 SET C220-REPORT-ADD-88 TO TRUE DTSBX215 +00509 ELSE DTSBX215 +00510 SET C220-REPORT-MOD-88 TO TRUE DTSBX215 +00511 END-IF DTSBX215 +00512 DTSBX215 +00513 WHEN '25' DTSBX215 +00514 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 +00515 IF R906-FUNCTION = 'A' DTSBX215 +00516 SET C220-PAY-ADD-88 TO TRUE DTSBX215 +00517 ELSE DTSBX215 +00518 SET C220-PAY-MOD-88 TO TRUE DTSBX215 +00519 END-IF DTSBX215 +00520 DTSBX215 +00521 WHEN '26' DTSBX215 +00522 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 +00523 IF R906-FUNCTION = 'A' DTSBX215 +00524 SET C220-ADJ-ADD-88 TO TRUE DTSBX215 +00525 ELSE DTSBX215 +00526 SET C220-ADJ-MOD-88 TO TRUE DTSBX215 +00527 END-IF DTSBX215 +00528 DTSBX215 +00529 WHEN '42' DTSBX215 +00530 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 +00531 SET C220-MISC-COLL-88 TO TRUE DTSBX215 +00532 DTSBX215 +00533 WHEN '44' DTSBX215 +00534 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 +00535 IF R906-FUNCTION = 'A' DTSBX215 +00536 SET C220-LIEN-ADD-88 TO TRUE DTSBX215 +00537 ELSE DTSBX215 +00538 SET C220-LIEN-MOD-88 TO TRUE DTSBX215 +00539 END-IF DTSBX215 +00540 DTSBX215 +00541 WHEN '45' DTSBX215 +00542 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 +00543 IF R906-FUNCTION = 'A' DTSBX215 +00544 SET C220-DPC-ADD-88 TO TRUE DTSBX215 +00545 ELSE DTSBX215 +00546 SET C220-DPC-MOD-88 TO TRUE DTSBX215 +00547 END-IF DTSBX215 +00548 DTSBX215 +00549 WHEN '47' DTSBX215 +00550 SET C220-BA-COLLECTIONS-88 TO TRUE DTSBX215 +00551 IF R906-FUNCTION = 'A' DTSBX215 +00552 SET C220-LEVY-ADD-88 TO TRUE DTSBX215 +00553 ELSE DTSBX215 +00554 SET C220-LEVY-MOD-88 TO TRUE DTSBX215 +00555 END-IF DTSBX215 +00556 DTSBX215 +00557 WHEN '51' DTSBX215 +00558 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00559 IF R906-FUNCTION = 'A' DTSBX215 +00560 SET C220-RATE-ADD-88 TO TRUE DTSBX215 +00561 ELSE DTSBX215 +00562 SET C220-RATE-MOD-88 TO TRUE DTSBX215 +00563 END-IF DTSBX215 +00564 DTSBX215 +00565 WHEN '52' DTSBX215 +00566 SET C220-BA-STATUS-88 TO TRUE DTSBX215 +00567 IF R906-FUNCTION = 'A' DTSBX215 +00568 SET C220-RATE-DATA-ADD-88 TO TRUE DTSBX215 +00569 ELSE DTSBX215 +00570 SET C220-RATE-DATA-MOD-88 TO TRUE DTSBX215 +00571 END-IF DTSBX215 +00572 DTSBX215 +00573 *& WHEN '61' DTSBX215 00574 * PERFORM P1211-FAS THRU P1211-EXIT DTSBX215 -00575 * IF WRK-SELECT-FAS-NO-88 DTSBX215 -00576 * SET WRK-BYPASS-906-YES-88 TO TRUE DTSBX215 -00577 * END-IF DTSBX215 -00578 * DTSBX215 -00579 * WHEN '63' DTSBX215 -00580 * SET C220-BA-AUDIT-88 TO TRUE DTSBX215 -00581 *& SET C220-AUDIT-REPORT-88 TO TRUE DTSBX215 -00582 DTSBX215 -00583 WHEN OTHER DTSBX215 -00584 SET WRK-BYPASS-906-YES-88 TO TRUE DTSBX215 -00585 * DISPLAY '** ' R906-EMP-NO ' ' R906-SCR-ID DTSBX215 -00586 * ' ' X220-DATE DTSBX215 -00587 END-EVALUATE. DTSBX215 -00588 DTSBX215 -00589 P1210-EXIT. DTSBX215 -00590 EXIT. DTSBX215 +00575 * DTSBX215 +00576 * WHEN '62' DTSBX215 +00577 * PERFORM P1211-FAS THRU P1211-EXIT DTSBX215 +00578 * IF WRK-SELECT-FAS-NO-88 DTSBX215 +00579 * SET WRK-BYPASS-906-YES-88 TO TRUE DTSBX215 +00580 * END-IF DTSBX215 +00581 * DTSBX215 +00582 * WHEN '63' DTSBX215 +00583 * SET C220-BA-AUDIT-88 TO TRUE DTSBX215 +00584 *& SET C220-AUDIT-REPORT-88 TO TRUE DTSBX215 +00585 DTSBX215 +00586 WHEN OTHER DTSBX215 +00587 SET WRK-BYPASS-906-YES-88 TO TRUE DTSBX215 +00588 * DISPLAY '** ' R906-EMP-NO ' ' R906-SCR-ID DTSBX215 +00589 * ' ' X220-DATE DTSBX215 +00590 END-EVALUATE. DTSBX215 00591 DTSBX215 -00592 *P1211-FAS. DTSBX215 -00593 ** DISPLAY 'P1211 ' R906-EMP-NO ' ' R906-OP-ID DTSBX215 -00594 ** ' ' R906-SCR-ID. DTSBX215 -00595 * SET WRK-SELECT-FAS-NO-88 TO TRUE. DTSBX215 -00596 * MOVE LOW-VALUES TO MFAS-REC. DTSBX215 -00597 * MOVE R906-EMP-NO TO MFAS-EMP-NO. DTSBX215 -00598 * SET MFAS-FAS-88 TO TRUE. DTSBX215 -00599 * MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 -00600 * PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 -00601 * PERFORM DTSBX215 -00602 * UNTIL L910-NO-REC-88 DTSBX215 -00603 * MOVE MSKL-REC TO MFAS-REC DTSBX215 -00604 * IF MFAS-COMPLETED-DATE = R906-TASK-START-DATE DTSBX215 -00605 * OR MFAS-PROCESSED-DATE = R906-TASK-START-DATE DTSBX215 -00606 * DISPLAY 'AUD ' MFAS-ASSIGN-NO DTSBX215 -00607 * ' ' MFAS-EMP-NO DTSBX215 -00608 * ' ' MFAS-STATUS-CD DTSBX215 -00609 * ' ' MFAS-FLD-REP-ID DTSBX215 -00610 * ' ' MFAS-COMPLETED-DATE DTSBX215 -00611 * SET WRK-SELECT-FAS-YES-88 TO TRUE DTSBX215 -00612 * SET C220-BA-AUDIT-88 TO TRUE DTSBX215 -00613 * SET C220-AUDIT-COMPLETE-88 TO TRUE DTSBX215 -00614 * SET L910-NO-REC-88 TO TRUE DTSBX215 -00615 * ELSE DTSBX215 -00616 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 -00617 * END-IF DTSBX215 -00618 * END-PERFORM. DTSBX215 -00619 * DTSBX215 -00620 *P1211-EXIT. DTSBX215 -00621 * EXIT. DTSBX215 -00622 DTSBX215 -00623 P1212-RPT. DTSBX215 -00624 ** DISPLAY 'P1212 ' R906-EMP-NO ' ' R906-OP-ID DTSBX215 -00625 ** ' ' R906-SCR-ID. DTSBX215 -00626 SET WRK-SELECT-RPT-NO-88 TO TRUE. DTSBX215 -00627 MOVE LOW-VALUES TO MRPT-REC. DTSBX215 -00628 MOVE R906-EMP-NO TO MRPT-EMP-NO. DTSBX215 -00629 SET MRPT-RPT-88 TO TRUE. DTSBX215 -00630 MOVE 20063 TO MRPT-YRQ. DTSBX215 -00631 MOVE R906-BATCH-NO TO MRPT-BATCH-NO. DTSBX215 -00632 MOVE R906-ITEM-NO TO MRPT-ITEM-NO. DTSBX215 -00633 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 -00634 PERFORM S910-READ THRU S910-EXIT. DTSBX215 -00635 IF L910-OK-88 DTSBX215 -00636 MOVE MSKL-REC TO MRPT-REC DTSBX215 -00637 DISPLAY 'P1212 ' MRPT-ESTB-DATE DTSBX215 -00638 IF MRPT-ESTB-DATE = R906-TASK-START-DATE DTSBX215 -00639 OR MRPT-CHNG-DATE = R906-TASK-START-DATE DTSBX215 -00640 SET WRK-SELECT-RPT-YES-88 TO TRUE DTSBX215 -00641 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 -00642 SET C220-REPORT-ADD-88 TO TRUE DTSBX215 -00643 SET L910-NO-REC-88 TO TRUE DTSBX215 -00644 END-IF DTSBX215 -00645 END-IF. DTSBX215 -00646 DTSBX215 -00647 P1212-EXIT. DTSBX215 -00648 EXIT. DTSBX215 +00592 P1210-EXIT. DTSBX215 +00593 EXIT. DTSBX215 +00594 DTSBX215 +00595 *P1211-FAS. DTSBX215 +00596 ** DISPLAY 'P1211 ' R906-EMP-NO ' ' R906-OP-ID DTSBX215 +00597 ** ' ' R906-SCR-ID. DTSBX215 +00598 * SET WRK-SELECT-FAS-NO-88 TO TRUE. DTSBX215 +00599 * MOVE LOW-VALUES TO MFAS-REC. DTSBX215 +00600 * MOVE R906-EMP-NO TO MFAS-EMP-NO. DTSBX215 +00601 * SET MFAS-FAS-88 TO TRUE. DTSBX215 +00602 * MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 +00603 * PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 +00604 * PERFORM DTSBX215 +00605 * UNTIL L910-NO-REC-88 DTSBX215 +00606 * MOVE MSKL-REC TO MFAS-REC DTSBX215 +00607 * IF MFAS-COMPLETED-DATE = R906-TASK-START-DATE DTSBX215 +00608 * OR MFAS-PROCESSED-DATE = R906-TASK-START-DATE DTSBX215 +00609 * DISPLAY 'AUD ' MFAS-ASSIGN-NO DTSBX215 +00610 * ' ' MFAS-EMP-NO DTSBX215 +00611 * ' ' MFAS-STATUS-CD DTSBX215 +00612 * ' ' MFAS-FLD-REP-ID DTSBX215 +00613 * ' ' MFAS-COMPLETED-DATE DTSBX215 +00614 * SET WRK-SELECT-FAS-YES-88 TO TRUE DTSBX215 +00615 * SET C220-BA-AUDIT-88 TO TRUE DTSBX215 +00616 * SET C220-AUDIT-COMPLETE-88 TO TRUE DTSBX215 +00617 * SET L910-NO-REC-88 TO TRUE DTSBX215 +00618 * ELSE DTSBX215 +00619 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 +00620 * END-IF DTSBX215 +00621 * END-PERFORM. DTSBX215 +00622 * DTSBX215 +00623 *P1211-EXIT. DTSBX215 +00624 * EXIT. DTSBX215 +00625 DTSBX215 +00626 P1212-RPT. DTSBX215 +00627 ** DISPLAY 'P1212 ' R906-EMP-NO ' ' R906-OP-ID DTSBX215 +00628 ** ' ' R906-SCR-ID. DTSBX215 +00629 SET WRK-SELECT-RPT-NO-88 TO TRUE. DTSBX215 +00630 MOVE LOW-VALUES TO MRPT-REC. DTSBX215 +00631 MOVE R906-EMP-NO TO MRPT-EMP-NO. DTSBX215 +00632 SET MRPT-RPT-88 TO TRUE. DTSBX215 +00633 MOVE 20063 TO MRPT-YRQ. DTSBX215 +00634 * MOVE R906-BATCH-NO TO MRPT-BATCH-NO. CL**3 +00635 * MOVE R906-ITEM-NO TO MRPT-ITEM-NO. CL**3 +00636 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 +00637 PERFORM S910-READ THRU S910-EXIT. DTSBX215 +00638 IF L910-OK-88 DTSBX215 +00639 MOVE MSKL-REC TO MRPT-REC DTSBX215 +00640 DISPLAY 'P1212 ' MRPT-ESTB-DATE DTSBX215 +00641 IF MRPT-ESTB-DATE = R906-TASK-START-DATE DTSBX215 +00642 OR MRPT-CHNG-DATE = R906-TASK-START-DATE DTSBX215 +00643 SET WRK-SELECT-RPT-YES-88 TO TRUE DTSBX215 +00644 SET C220-BA-ACCOUNTING-88 TO TRUE DTSBX215 +00645 SET C220-REPORT-ADD-88 TO TRUE DTSBX215 +00646 SET L910-NO-REC-88 TO TRUE DTSBX215 +00647 END-IF DTSBX215 +00648 END-IF. DTSBX215 00649 DTSBX215 -00650 P1220-SAVE-KEY. DTSBX215 -00651 ********************************************************** DTSBX215 -00652 * SAVE CURRENT RECORD TO CHECK FOR DUPLICATES - R906 RECORDS DTSBX215 -00653 * FOR THE SAME OPID, EMP, BUSINESS AREA, ACTIVITY. DTSBX215 -00654 * BYPASS ANY MATCHING RECORDS ENTERED WITHIN 5 MINUTES OF DTSBX215 -00655 * EACHOTHER. DTSBX215 -00656 ********************************************************** DTSBX215 -00657 MOVE R906-OP-ID TO WRK-906-OPID. DTSBX215 -00658 MOVE R906-EMP-NO TO WRK-906-EMP. DTSBX215 -00659 MOVE R906-SCR-ID TO WRK-906-SCREEN. DTSBX215 -00660 MOVE R906-TASK-START-DATE TO WRK-906-DATE. DTSBX215 -00661 MOVE R906-TASK-START-TIME TO WRK-906-TIME. DTSBX215 -00662 DTSBX215 -00663 P1220-EXIT. DTSBX215 -00664 EXIT. DTSBX215 +00650 P1212-EXIT. DTSBX215 +00651 EXIT. DTSBX215 +00652 DTSBX215 +00653 P1220-SAVE-KEY. DTSBX215 +00654 ********************************************************** DTSBX215 +00655 * SAVE CURRENT RECORD TO CHECK FOR DUPLICATES - R906 RECORDS DTSBX215 +00656 * FOR THE SAME OPID, EMP, BUSINESS AREA, ACTIVITY. DTSBX215 +00657 * BYPASS ANY MATCHING RECORDS ENTERED WITHIN 5 MINUTES OF DTSBX215 +00658 * EACHOTHER. DTSBX215 +00659 ********************************************************** DTSBX215 +00660 MOVE R906-OP-ID TO WRK-906-OPID. DTSBX215 +00661 MOVE R906-EMP-NO TO WRK-906-EMP. DTSBX215 +00662 MOVE R906-SCR-ID TO WRK-906-SCREEN. DTSBX215 +00663 MOVE R906-TASK-START-DATE TO WRK-906-DATE. DTSBX215 +00664 MOVE R906-TASK-START-TIME TO WRK-906-TIME. DTSBX215 00665 DTSBX215 -00666 P1300-DEPOSITS. DTSBX215 -00667 MOVE R301-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 -00668 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 -00669 MOVE L001-SLASH-8-DATE TO X215-PROCESS-DT. DTSBX215 -00670 DTSBX215 -00671 MOVE R301-BATCH-NO TO X215-BATCH. DTSBX215 -00672 DTSBX215 -00673 MOVE R301-BATCH-BALANCED-IND TO X215-BALANCED-IND. DTSBX215 -00674 MOVE R301-BATCH-HELD-IND TO X215-HELD-IND. DTSBX215 +00666 P1220-EXIT. DTSBX215 +00667 EXIT. DTSBX215 +00668 DTSBX215 +00669 P1300-DEPOSITS. DTSBX215 +00670 MOVE R301-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX215 +00671 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 +00672 MOVE L001-SLASH-8-DATE TO X215-PROCESS-DT. DTSBX215 +00673 DTSBX215 +00674 MOVE R301-BATCH-NO TO X215-BATCH. DTSBX215 00675 DTSBX215 -00676 MOVE R301-CONTROL-TRAN-CNT TO X215-CONTROL-TRAN-CNT. DTSBX215 -00677 MOVE R301-CONTROL-REMIT-AMT TO X215-CONTROL-REMIT-AMT.DTSBX215 +00676 MOVE R301-BATCH-BALANCED-IND TO X215-BALANCED-IND. DTSBX215 +00677 MOVE R301-BATCH-HELD-IND TO X215-HELD-IND. DTSBX215 00678 DTSBX215 -00679 MOVE R301-ATC-FILE-TRAN-CNT TO DTSBX215 -00680 X215-ATC-FILE-TRAN-CNT. DTSBX215 -00681 MOVE R301-ATC-FILE-REMIT-AMT TO DTSBX215 -00682 X215-ATC-FILE-REMIT-AMT. DTSBX215 -00683 DTSBX215 -00684 COMPUTE X215-PROCESSED-CNT = DTSBX215 -00685 (R301-SUCCEEDED-PREV-TRAN-CNT + DTSBX215 -00686 R301-SUCCEEDED-TODAY-TRAN-CNT). DTSBX215 -00687 DTSBX215 -00688 COMPUTE X215-PROCESSED-REMIT = DTSBX215 -00689 (R301-SUCCEEDED-PREV-REMIT-AMT + DTSBX215 -00690 R301-SUCCEEDED-TODAY-REMIT-AMT). DTSBX215 -00691 DTSBX215 -00692 MOVE R301-DEPOSIT-DATE TO L001-FED-8-DATE-9. DTSBX215 -00693 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 -00694 MOVE L001-SLASH-8-DATE TO X215-DEPOSIT-DATE. DTSBX215 -00695 DTSBX215 -00696 IF R301-CHNG-OP-ID = SPACES DTSBX215 -00697 MOVE R301-ESTB-OP-ID TO R301-CHNG-OP-ID DTSBX215 -00698 END-IF. DTSBX215 -00699 DTSBX215 -00700 IF R301-CHNG-OP-ID > SPACES DTSBX215 -00701 MOVE R301-CHNG-OP-ID TO X215-CHNG-OP-ID DTSBX215 -00702 ELSE DTSBX215 -00703 MOVE SPACES TO X215-CHNG-OP-ID DTSBX215 -00704 END-IF. DTSBX215 -00705 DTSBX215 -00706 MOVE R301-BANK-BATCH-NO TO X215-BANK-BATCH. DTSBX215 -00707 DTSBX215 -00708 WRITE DEPOSIT-REC FROM WRK-X215-REC. DTSBX215 -00709 ADD +1 TO WRK-DEPOSIT-CNT. DTSBX215 +00679 MOVE R301-CONTROL-TRAN-CNT TO X215-CONTROL-TRAN-CNT. DTSBX215 +00680 MOVE R301-CONTROL-REMIT-AMT TO X215-CONTROL-REMIT-AMT.DTSBX215 +00681 DTSBX215 +00682 MOVE R301-ATC-FILE-TRAN-CNT TO DTSBX215 +00683 X215-ATC-FILE-TRAN-CNT. DTSBX215 +00684 MOVE R301-ATC-FILE-REMIT-AMT TO DTSBX215 +00685 X215-ATC-FILE-REMIT-AMT. DTSBX215 +00686 DTSBX215 +00687 COMPUTE X215-PROCESSED-CNT = DTSBX215 +00688 (R301-SUCCEEDED-PREV-TRAN-CNT + DTSBX215 +00689 R301-SUCCEEDED-TODAY-TRAN-CNT). DTSBX215 +00690 DTSBX215 +00691 COMPUTE X215-PROCESSED-REMIT = DTSBX215 +00692 (R301-SUCCEEDED-PREV-REMIT-AMT + DTSBX215 +00693 R301-SUCCEEDED-TODAY-REMIT-AMT). DTSBX215 +00694 DTSBX215 +00695 MOVE R301-DEPOSIT-DATE TO L001-FED-8-DATE-9. DTSBX215 +00696 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX215 +00697 MOVE L001-SLASH-8-DATE TO X215-DEPOSIT-DATE. DTSBX215 +00698 DTSBX215 +00699 IF R301-CHNG-OP-ID = SPACES DTSBX215 +00700 MOVE R301-ESTB-OP-ID TO R301-CHNG-OP-ID DTSBX215 +00701 END-IF. DTSBX215 +00702 DTSBX215 +00703 IF R301-CHNG-OP-ID > SPACES DTSBX215 +00704 MOVE R301-CHNG-OP-ID TO X215-CHNG-OP-ID DTSBX215 +00705 ELSE DTSBX215 +00706 MOVE SPACES TO X215-CHNG-OP-ID DTSBX215 +00707 END-IF. DTSBX215 +00708 DTSBX215 +00709 MOVE R301-BANK-BATCH-NO TO X215-BANK-BATCH. DTSBX215 00710 DTSBX215 -00711 P1300-EXIT. DTSBX215 -00712 EXIT. DTSBX215 +00711 WRITE DEPOSIT-REC FROM WRK-X215-REC. DTSBX215 +00712 ADD +1 TO WRK-DEPOSIT-CNT. DTSBX215 00713 DTSBX215 -00714 P2000-FROM-EVL. DTSBX215 -00715 MOVE LOW-VALUES TO MPRF-REC. DTSBX215 -00716 MOVE ZERO TO MPRF-EMP-NO. DTSBX215 -00717 SET MPRF-PRF-88 TO TRUE. DTSBX215 -00718 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 -00719 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 -00720 PERFORM UNTIL L910-NO-REC-88 DTSBX215 -00721 MOVE MSKL-REC TO MPRF-REC DTSBX215 -00722 IF MPRF-CLASS-SUB-88 DTSBX215 -00723 PERFORM P2100-SCAN-MEVL THRU P2100-EXIT DTSBX215 -00724 END-IF DTSBX215 -00725 MOVE MPRF-REC TO MSKL-REC DTSBX215 -00726 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 -00727 END-PERFORM. DTSBX215 -00728 DTSBX215 -00729 P2000-EXIT. DTSBX215 -00730 EXIT. DTSBX215 +00714 P1300-EXIT. DTSBX215 +00715 EXIT. DTSBX215 +00716 DTSBX215 +00717 P2000-FROM-EVL. DTSBX215 +00718 MOVE LOW-VALUES TO MPRF-REC. DTSBX215 +00719 MOVE ZERO TO MPRF-EMP-NO. DTSBX215 +00720 SET MPRF-PRF-88 TO TRUE. DTSBX215 +00721 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 +00722 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 +00723 PERFORM UNTIL L910-NO-REC-88 DTSBX215 +00724 MOVE MSKL-REC TO MPRF-REC DTSBX215 +00725 IF MPRF-CLASS-SUB-88 DTSBX215 +00726 PERFORM P2100-SCAN-MEVL THRU P2100-EXIT DTSBX215 +00727 END-IF DTSBX215 +00728 MOVE MPRF-REC TO MSKL-REC DTSBX215 +00729 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 +00730 END-PERFORM. DTSBX215 00731 DTSBX215 -00732 P2100-SCAN-MEVL. DTSBX215 -00733 MOVE LOW-VALUES TO MEVL-REC. DTSBX215 -00734 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBX215 -00735 MOVE WRK-PRIOR-RUN-DATE TO MEVL-DATE. DTSBX215 -00736 MOVE ZERO TO MEVL-TIME. DTSBX215 -00737 SET MEVL-EVL-88 TO TRUE. DTSBX215 -00738 MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 -00739 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 -00740 PERFORM UNTIL L910-NO-REC-88 DTSBX215 -00741 MOVE MSKL-REC TO MEVL-REC DTSBX215 -00742 IF MEVL-ESTB-DATE = WRK-PRIOR-RUN-DATE DTSBX215 -00743 *& IF MEVL-ESTB-DATE > 20070305 DTSBX215 -00744 PERFORM P2110-BUILD-X220 THRU P2110-EXIT DTSBX215 -00745 END-IF DTSBX215 -00746 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 -00747 END-PERFORM. DTSBX215 -00748 P2100-EXIT. DTSBX215 -00749 EXIT. DTSBX215 -00750 DTSBX215 -00751 P2110-BUILD-X220. DTSBX215 -00752 IF MEVL-BUSINESS-AREA > '00' AND <= '99' DTSBX215 -00753 AND MEVL-ACTIVITY-CODE > '000' AND <= '999' DTSBX215 -00754 NEXT SENTENCE DTSBX215 -00755 ELSE DTSBX215 -00756 GO TO P2110-EXIT DTSBX215 -00757 END-IF. DTSBX215 -00758 DTSBX215 -00759 ** DISPLAY 'P2100 ' MPRF-EMP-NO ' ' MEVL-ESTB-DATE DTSBX215 -00760 ** ' ' MEVL-BUSINESS-AREA ' ' MEVL-ACTIVITY-CODE. DTSBX215 -00761 MOVE MEVL-DATE TO L005-DATE. DTSBX215 -00762 MOVE MEVL-TIME TO L005-TIME. DTSBX215 -00763 SET L005-FROM-DATE-TIME TO TRUE. DTSBX215 -00764 PERFORM S005-DATE THRU S005-EXIT. DTSBX215 -00765 MOVE L005-SLASH-8-DATE TO X220-DATE. DTSBX215 -00766 MOVE L005-DISPLAY-TIME TO X220-TIME. DTSBX215 -00767 DTSBX215 -00768 MOVE MEVL-EMP-NO TO X220-EMP-NO. DTSBX215 -00769 DTSBX215 -00770 MOVE MEVL-SOURCE TO X220-OPID. DTSBX215 -00771 DTSBX215 -00772 MOVE ZERO TO X220-BATCH DTSBX215 -00773 X220-ITEM. DTSBX215 -00774 DTSBX215 -00775 MOVE MEVL-BUSINESS-AREA TO X220-BUSINESS-AREA. DTSBX215 -00776 MOVE MEVL-ACTIVITY-CODE TO X220-ACTIVITY. DTSBX215 +00732 P2000-EXIT. DTSBX215 +00733 EXIT. DTSBX215 +00734 DTSBX215 +00735 P2100-SCAN-MEVL. DTSBX215 +00736 * IF MPRF-EMP-NO = 010171 OR 011867 CL*11 +00737 * GO TO P2100-EXIT. CL*11 +00738 DISPLAY 'PRF: ' MPRF-EMP-NO CL*11 +00739 MOVE LOW-VALUES TO MEVL-REC. DTSBX215 +00740 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBX215 +00741 MOVE WRK-PRIOR-RUN-DATE TO MEVL-DATE. DTSBX215 +00742 MOVE ZERO TO MEVL-TIME. DTSBX215 +00743 SET MEVL-EVL-88 TO TRUE. DTSBX215 +00744 MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 +00745 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 +00746 PERFORM UNTIL L910-NO-REC-88 DTSBX215 +00747 MOVE MSKL-REC TO MEVL-REC DTSBX215 +00748 DISPLAY 'ENO: ' MEVL-EMP-NO ' EVL: ' MEVL-ESTB-DATE CL*11 +00749 IF MEVL-ESTB-DATE NOT NUMERIC CL*12 +00750 MOVE 0 TO MEVL-ESTB-DATE CL*12 +00751 END-IF CL*12 +00752 IF MEVL-ESTB-DATE = WRK-PRIOR-RUN-DATE DTSBX215 +00753 *& IF MEVL-ESTB-DATE > 20070305 DTSBX215 +00754 PERFORM P2110-BUILD-X220 THRU P2110-EXIT DTSBX215 +00755 END-IF DTSBX215 +00756 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 +00757 END-PERFORM. DTSBX215 +00758 P2100-EXIT. DTSBX215 +00759 EXIT. DTSBX215 +00760 DTSBX215 +00761 P2110-BUILD-X220. DTSBX215 +00762 IF MEVL-BUSINESS-AREA > '00' AND <= '99' DTSBX215 +00763 AND MEVL-ACTIVITY-CODE > '000' AND <= '999' DTSBX215 +00764 NEXT SENTENCE DTSBX215 +00765 ELSE DTSBX215 +00766 GO TO P2110-EXIT DTSBX215 +00767 END-IF. DTSBX215 +00768 DTSBX215 +00769 ** DISPLAY 'P2100 ' MPRF-EMP-NO ' ' MEVL-ESTB-DATE DTSBX215 +00770 ** ' ' MEVL-BUSINESS-AREA ' ' MEVL-ACTIVITY-CODE. DTSBX215 +00771 MOVE MEVL-DATE TO L005-DATE. DTSBX215 +00772 MOVE MEVL-TIME TO L005-TIME. DTSBX215 +00773 SET L005-FROM-DATE-TIME TO TRUE. DTSBX215 +00774 PERFORM S005-DATE THRU S005-EXIT. DTSBX215 +00775 MOVE L005-SLASH-8-DATE TO X220-DATE. DTSBX215 +00776 MOVE L005-DISPLAY-TIME TO X220-TIME. DTSBX215 00777 DTSBX215 -00778 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 -00779 ADD +1 TO WRK-X220-CNT. DTSBX215 -00780 DTSBX215 -00781 P2110-EXIT. DTSBX215 -00782 EXIT. DTSBX215 -00783 DTSBX215 -00784 P3000-FROM-FAS. DTSBX215 -00785 MOVE LOW-VALUES TO MFAS-REC. DTSBX215 -00786 SET MFAS-FAS-88 TO TRUE. DTSBX215 -00787 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 -00788 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 -00789 PERFORM UNTIL L910-NO-REC-88 DTSBX215 -00790 MOVE MSKL-REC TO MFAS-REC DTSBX215 -00791 IF MFAS-ASSIGN-TYPE = '05' DTSBX215 -00792 AND MFAS-STATUS-PROCESSED-88 DTSBX215 -00793 *& IF MFAS-PROCESSED-DATE = WRK-PRIOR-RUN-DATE DTSBX215 -00794 AND MFAS-PROCESSED-DATE >= 20080601 DTSBX215 -00795 AND MFAS-PROCESSED-DATE < 20080701 DTSBX215 -00796 PERFORM P3100-ADD-AUDIT THRU P3100-EXIT DTSBX215 -00797 END-IF DTSBX215 -00798 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 -00799 END-PERFORM. DTSBX215 -00800 DTSBX215 -00801 P3000-EXIT. DTSBX215 -00802 EXIT. DTSBX215 -00803 DTSBX215 -00804 P3100-ADD-AUDIT. DTSBX215 -00805 DISPLAY 'AUD ' MFAS-ASSIGN-NO DTSBX215 -00806 ' ' MFAS-EMP-NO DTSBX215 -00807 ' ' MFAS-STATUS-CD DTSBX215 -00808 ' ' MFAS-FLD-REP-ID DTSBX215 -00809 ' ' MFAS-COMPLETED-DATE. DTSBX215 -00810 SET C220-BA-AUDIT-88 TO TRUE. DTSBX215 -00811 SET C220-AUDIT-COMPLETE-88 TO TRUE. DTSBX215 -00812 MOVE MFAS-PROCESSED-DATE TO L005-DATE. DTSBX215 -00813 MOVE ZERO TO L005-TIME. DTSBX215 -00814 SET L005-FROM-DATE-TIME TO TRUE. DTSBX215 -00815 PERFORM S005-DATE THRU S005-EXIT. DTSBX215 -00816 MOVE L005-SLASH-8-DATE TO X220-DATE. DTSBX215 -00817 MOVE L005-DISPLAY-TIME TO X220-TIME. DTSBX215 -00818 DTSBX215 -00819 MOVE MFAS-EMP-NO TO X220-EMP-NO. DTSBX215 -00820 DTSBX215 -00821 MOVE MFAS-FLD-REP-ID TO L062-FLD-REP-ID. DTSBX215 -00822 PERFORM S062-LOOKUP-FLD-REP THRU S062-EXIT. DTSBX215 -00823 MOVE L062-OP-ID TO X220-OPID. DTSBX215 -00824 DTSBX215 -00825 MOVE ZERO TO X220-BATCH DTSBX215 -00826 X220-ITEM. DTSBX215 -00827 DTSBX215 -00828 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 -00829 ADD +1 TO WRK-X220-CNT. DTSBX215 +00778 MOVE MEVL-EMP-NO TO X220-EMP-NO. DTSBX215 +00779 DTSBX215 +00780 MOVE MEVL-SOURCE TO X220-OPID. DTSBX215 +00781 DTSBX215 +00782 MOVE ZERO TO X220-BATCH DTSBX215 +00783 X220-ITEM. DTSBX215 +00784 DTSBX215 +00785 MOVE MEVL-BUSINESS-AREA TO X220-BUSINESS-AREA. DTSBX215 +00786 MOVE MEVL-ACTIVITY-CODE TO X220-ACTIVITY. DTSBX215 +00787 DTSBX215 +00788 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 +00789 ADD +1 TO WRK-X220-CNT. DTSBX215 +00790 DTSBX215 +00791 P2110-EXIT. DTSBX215 +00792 EXIT. DTSBX215 +00793 DTSBX215 +00794 P3000-FROM-FAS. DTSBX215 +00795 MOVE LOW-VALUES TO MFAS-REC. DTSBX215 +00796 SET MFAS-FAS-88 TO TRUE. DTSBX215 +00797 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBX215 +00798 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX215 +00799 PERFORM UNTIL L910-NO-REC-88 DTSBX215 +00800 MOVE MSKL-REC TO MFAS-REC DTSBX215 +00801 IF MFAS-ASSIGN-TYPE = '05' DTSBX215 +00802 AND MFAS-STATUS-PROCESSED-88 DTSBX215 +00803 *& IF MFAS-PROCESSED-DATE = WRK-PRIOR-RUN-DATE DTSBX215 +00804 AND MFAS-PROCESSED-DATE >= 20080601 DTSBX215 +00805 AND MFAS-PROCESSED-DATE < 20080701 DTSBX215 +00806 PERFORM P3100-ADD-AUDIT THRU P3100-EXIT DTSBX215 +00807 END-IF DTSBX215 +00808 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX215 +00809 END-PERFORM. DTSBX215 +00810 DTSBX215 +00811 P3000-EXIT. DTSBX215 +00812 EXIT. DTSBX215 +00813 DTSBX215 +00814 P3100-ADD-AUDIT. DTSBX215 +00815 DISPLAY 'AUD ' MFAS-ASSIGN-NO DTSBX215 +00816 ' ' MFAS-EMP-NO DTSBX215 +00817 ' ' MFAS-STATUS-CD DTSBX215 +00818 ' ' MFAS-FLD-REP-ID DTSBX215 +00819 ' ' MFAS-COMPLETED-DATE. DTSBX215 +00820 SET C220-BA-AUDIT-88 TO TRUE. DTSBX215 +00821 SET C220-AUDIT-COMPLETE-88 TO TRUE. DTSBX215 +00822 MOVE MFAS-PROCESSED-DATE TO L005-DATE. DTSBX215 +00823 MOVE ZERO TO L005-TIME. DTSBX215 +00824 SET L005-FROM-DATE-TIME TO TRUE. DTSBX215 +00825 PERFORM S005-DATE THRU S005-EXIT. DTSBX215 +00826 MOVE L005-SLASH-8-DATE TO X220-DATE. DTSBX215 +00827 MOVE L005-DISPLAY-TIME TO X220-TIME. DTSBX215 +00828 DTSBX215 +00829 MOVE MFAS-EMP-NO TO X220-EMP-NO. DTSBX215 00830 DTSBX215 -00831 P3100-EXIT. DTSBX215 -00832 EXIT. DTSBX215 -00833 DTSBX215 -00834 P4000-WRITE-X215-DUMMY. DTSBX215 -00835 MOVE SPACES TO X215-PROCESS-DT. DTSBX215 -00836 DTSBX215 -00837 MOVE ZEROS TO X215-BATCH. DTSBX215 -00838 DTSBX215 -00839 MOVE SPACES TO X215-BALANCED-IND DTSBX215 -00840 X215-HELD-IND. DTSBX215 -00841 DTSBX215 -00842 MOVE ZEROS TO X215-CONTROL-TRAN-CNT DTSBX215 -00843 X215-CONTROL-REMIT-AMT DTSBX215 -00844 X215-ATC-FILE-TRAN-CNT DTSBX215 -00845 X215-ATC-FILE-REMIT-AMTDTSBX215 -00846 X215-PROCESSED-CNT DTSBX215 -00847 X215-PROCESSED-REMIT. DTSBX215 +00831 MOVE MFAS-FLD-REP-ID TO L062-FLD-REP-ID. DTSBX215 +00832 PERFORM S062-LOOKUP-FLD-REP THRU S062-EXIT. DTSBX215 +00833 MOVE L062-OP-ID TO X220-OPID. DTSBX215 +00834 DTSBX215 +00835 MOVE ZERO TO X220-BATCH DTSBX215 +00836 X220-ITEM. DTSBX215 +00837 DTSBX215 +00838 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 +00839 ADD +1 TO WRK-X220-CNT. DTSBX215 +00840 DTSBX215 +00841 P3100-EXIT. DTSBX215 +00842 EXIT. DTSBX215 +00843 DTSBX215 +00844 P4000-WRITE-X215-DUMMY. DTSBX215 +00845 MOVE SPACES TO X215-PROCESS-DT. DTSBX215 +00846 DTSBX215 +00847 MOVE ZEROS TO X215-BATCH. DTSBX215 00848 DTSBX215 -00849 MOVE SPACES TO X215-DEPOSIT-DATE DTSBX215 -00850 X215-CHNG-OP-ID. DTSBX215 +00849 MOVE SPACES TO X215-BALANCED-IND DTSBX215 +00850 X215-HELD-IND. DTSBX215 00851 DTSBX215 -00852 MOVE ZEROS TO X215-BANK-BATCH. DTSBX215 -00853 DTSBX215 -00854 WRITE BX215-REC FROM WRK-X215-REC. DTSBX215 -00855 ADD +1 TO WRK-X215-CNT. DTSBX215 -00856 DTSBX215 -00857 P4000-EXIT. DTSBX215 -00858 EXIT. DTSBX215 -00859 DTSBX215 -00860 P4100-WRITE-X220-DUMMY. DTSBX215 -00861 MOVE ZEROS TO X220-EMP-NO. DTSBX215 -00862 DTSBX215 -00863 MOVE SPACES TO X220-OPID. DTSBX215 -00864 DTSBX215 -00865 MOVE ZEROS TO X220-BATCH DTSBX215 -00866 X220-ITEM. DTSBX215 -00867 DTSBX215 -00868 MOVE SPACES TO X220-BUSINESS-AREA DTSBX215 -00869 X220-ACTIVITY DTSBX215 -00870 X220-DATE DTSBX215 -00871 X220-TIME. DTSBX215 +00852 MOVE ZEROS TO X215-CONTROL-TRAN-CNT DTSBX215 +00853 X215-CONTROL-REMIT-AMT DTSBX215 +00854 X215-ATC-FILE-TRAN-CNT DTSBX215 +00855 X215-ATC-FILE-REMIT-AMTDTSBX215 +00856 X215-PROCESSED-CNT DTSBX215 +00857 X215-PROCESSED-REMIT. DTSBX215 +00858 DTSBX215 +00859 MOVE SPACES TO X215-DEPOSIT-DATE DTSBX215 +00860 X215-CHNG-OP-ID. DTSBX215 +00861 DTSBX215 +00862 MOVE ZEROS TO X215-BANK-BATCH. DTSBX215 +00863 DTSBX215 +00864 WRITE BX215-REC FROM WRK-X215-REC. DTSBX215 +00865 ADD +1 TO WRK-X215-CNT. DTSBX215 +00866 DTSBX215 +00867 P4000-EXIT. DTSBX215 +00868 EXIT. DTSBX215 +00869 DTSBX215 +00870 P4100-WRITE-X220-DUMMY. DTSBX215 +00871 MOVE ZEROS TO X220-EMP-NO. DTSBX215 00872 DTSBX215 -00873 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 -00874 ADD +1 TO WRK-X220-CNT. DTSBX215 -00875 DTSBX215 -00876 P4100-EXIT. DTSBX215 -00877 EXIT. DTSBX215 -00878 DTSBX215 -00879 S001-FROM-FED-8. DTSBX215 -00880 SET L001-FROM-FED-8 TO TRUE. DTSBX215 -00881 GO TO S001-DATE. DTSBX215 +00873 MOVE SPACES TO X220-OPID. DTSBX215 +00874 DTSBX215 +00875 MOVE ZEROS TO X220-BATCH DTSBX215 +00876 X220-ITEM. DTSBX215 +00877 DTSBX215 +00878 MOVE SPACES TO X220-BUSINESS-AREA DTSBX215 +00879 X220-ACTIVITY DTSBX215 +00880 X220-DATE DTSBX215 +00881 X220-TIME. DTSBX215 00882 DTSBX215 -00883 S001-DATE. DTSBX215 -00884 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX215 -00885 S001-EXIT. DTSBX215 -00886 EXIT. DTSBX215 -00887 DTSBX215 -00888 S005-DATE. DTSBX215 -00889 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX215 -00890 S005-EXIT. DTSBX215 -00891 EXIT. DTSBX215 +00883 WRITE BX220-REC FROM WRK-X220-REC. DTSBX215 +00884 ADD +1 TO WRK-X220-CNT. DTSBX215 +00885 DTSBX215 +00886 P4100-EXIT. DTSBX215 +00887 EXIT. DTSBX215 +00888 DTSBX215 +00889 S001-FROM-FED-8. DTSBX215 +00890 SET L001-FROM-FED-8 TO TRUE. DTSBX215 +00891 GO TO S001-DATE. DTSBX215 00892 DTSBX215 -00893 S062-LOOKUP-FLD-REP. DTSBX215 -00894 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBX215 -00895 S062-EXIT. DTSBX215 +00893 S001-DATE. DTSBX215 +00894 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX215 +00895 S001-EXIT. DTSBX215 00896 EXIT. DTSBX215 00897 DTSBX215 -00898 S910-OPEN-READ. DTSBX215 -00899 SET L910-OPEN-READ-88 TO TRUE. DTSBX215 -00900 GO TO S910-MSTR-IO. DTSBX215 -00901 DTSBX215 -00902 S910-READ. DTSBX215 -00903 SET L910-READ-88 TO TRUE. DTSBX215 -00904 GO TO S910-MSTR-IO. DTSBX215 -00905 DTSBX215 -00906 S910-START-BROWSE. DTSBX215 -00907 SET L910-START-BROWSE-88 TO TRUE. DTSBX215 -00908 GO TO S910-MSTR-IO. DTSBX215 -00909 DTSBX215 -00910 S910-READ-NEXT. DTSBX215 -00911 SET L910-READ-NEXT-88 TO TRUE. DTSBX215 -00912 GO TO S910-MSTR-IO. DTSBX215 -00913 DTSBX215 -00914 S910-CLOSE. DTSBX215 -00915 SET L910-CLOSE-88 TO TRUE. DTSBX215 -00916 GO TO S910-MSTR-IO. DTSBX215 -00917 DTSBX215 -00918 S910-MSTR-IO. DTSBX215 -00919 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX215 -00920 MSKL-REC. DTSBX215 -00921 S910-EXIT. DTSBX215 -00922 EXIT. DTSBX215 +00898 S005-DATE. DTSBX215 +00899 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX215 +00900 S005-EXIT. DTSBX215 +00901 EXIT. DTSBX215 +00902 DTSBX215 +00903 S062-LOOKUP-FLD-REP. DTSBX215 +00904 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBX215 +00905 S062-EXIT. DTSBX215 +00906 EXIT. DTSBX215 +00907 DTSBX215 +00908 S910-OPEN-READ. DTSBX215 +00909 SET L910-OPEN-READ-88 TO TRUE. DTSBX215 +00910 GO TO S910-MSTR-IO. DTSBX215 +00911 DTSBX215 +00912 S910-READ. DTSBX215 +00913 SET L910-READ-88 TO TRUE. DTSBX215 +00914 GO TO S910-MSTR-IO. DTSBX215 +00915 DTSBX215 +00916 S910-START-BROWSE. DTSBX215 +00917 SET L910-START-BROWSE-88 TO TRUE. DTSBX215 +00918 GO TO S910-MSTR-IO. DTSBX215 +00919 DTSBX215 +00920 S910-READ-NEXT. DTSBX215 +00921 SET L910-READ-NEXT-88 TO TRUE. DTSBX215 +00922 GO TO S910-MSTR-IO. DTSBX215 00923 DTSBX215 -00924 S941-OPEN. DTSBX215 -00925 SET L941-OPEN-READ-88 TO TRUE. DTSBX215 -00926 GO TO S941-I. DTSBX215 +00924 S910-CLOSE. DTSBX215 +00925 SET L910-CLOSE-88 TO TRUE. DTSBX215 +00926 GO TO S910-MSTR-IO. DTSBX215 00927 DTSBX215 -00928 S941-READ-NEXT. DTSBX215 -00929 SET L941-READ-NEXT-88 TO TRUE. DTSBX215 -00930 GO TO S941-I. DTSBX215 -00931 DTSBX215 -00932 S941-CLOSE. DTSBX215 -00933 SET L941-CLOSE-88 TO TRUE. DTSBX215 -00934 GO TO S941-I. DTSBX215 -00935 DTSBX215 -00936 S941-I. DTSBX215 -00937 CALL 'DTSBU941' USING L941-LINK-AREA, DTSBX215 -00938 RSK3-REC. DTSBX215 -00939 S941-EXIT. DTSBX215 -00940 EXIT. DTSBX215 +00928 S910-MSTR-IO. DTSBX215 +00929 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX215 +00930 MSKL-REC. DTSBX215 +00931 S910-EXIT. DTSBX215 +00932 EXIT. DTSBX215 +00933 DTSBX215 +00934 S941-OPEN. DTSBX215 +00935 SET L941-OPEN-READ-88 TO TRUE. DTSBX215 +00936 GO TO S941-I. DTSBX215 +00937 DTSBX215 +00938 S941-READ-NEXT. DTSBX215 +00939 SET L941-READ-NEXT-88 TO TRUE. DTSBX215 +00940 GO TO S941-I. DTSBX215 00941 DTSBX215 -00942 S999-ABEND. DTSBX215 -00943 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX215 -00944 SKIP2 DTSBX215 -00945 S999-EXIT. DTSBX215 -00946 EXIT. DTSBX215 -00947 DTSBX215 -00948 T0000-TERMINATE. DTSBX215 -00949 DTSBX215 -00950 DISPLAY ' '. DTSBX215 -00951 MOVE WRK-READ-CNT TO DISP-WRK-READ-CNT. DTSBX215 -00952 DISPLAY 'TOTAL R301 RECORDS READ = ' DISP-WRK-READ-CNT. DTSBX215 -00953 DTSBX215 -00954 MOVE WRK-X215-CNT TO DISP-WRK-WRITE-CNT. DTSBX215 -00955 DISPLAY 'TOTAL X215 RECORDS WRITTEN ' DISP-WRK-WRITE-CNT. DTSBX215 -00956 DTSBX215 -00957 MOVE WRK-X220-CNT TO DISP-WRK-WRITE-CNT. DTSBX215 -00958 DISPLAY 'TOTAL X220 RECORDS WRITTEN ' DISP-WRK-WRITE-CNT. DTSBX215 +00942 S941-CLOSE. DTSBX215 +00943 SET L941-CLOSE-88 TO TRUE. DTSBX215 +00944 GO TO S941-I. DTSBX215 +00945 DTSBX215 +00946 S941-I. DTSBX215 +00947 CALL 'DTSBU941' USING L941-LINK-AREA, DTSBX215 +00948 RSK3-REC. DTSBX215 +00949 S941-EXIT. DTSBX215 +00950 EXIT. DTSBX215 +00951 DTSBX215 +00952 S999-ABEND. DTSBX215 +00953 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX215 +00954 SKIP2 DTSBX215 +00955 S999-EXIT. DTSBX215 +00956 EXIT. DTSBX215 +00957 DTSBX215 +00958 T0000-TERMINATE. DTSBX215 00959 DTSBX215 -00960 DISPLAY 'TOTAL DEPOSIT RECS WRITTEN ' WRK-DEPOSIT-CNT. DTSBX215 -00961 DTSBX215 -00962 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX215 -00963 PERFORM S941-CLOSE THRU S941-EXIT. DTSBX215 -00964 CLOSE BX215-BATCH-FILE DTSBX215 -00965 BX220-ACTIVITY-FILE DTSBX215 -00966 DEPOSIT-FILE. DTSBX215 -00967 T0000-EXIT. DTSBX215 -00968 EXIT. DTSBX215 +00960 DISPLAY ' '. DTSBX215 +00961 MOVE WRK-READ-CNT TO DISP-WRK-READ-CNT. DTSBX215 +00962 DISPLAY 'TOTAL R301 RECORDS READ = ' DISP-WRK-READ-CNT. DTSBX215 +00963 DTSBX215 +00964 MOVE WRK-X215-CNT TO DISP-WRK-WRITE-CNT. DTSBX215 +00965 DISPLAY 'TOTAL X215 RECORDS WRITTEN ' DISP-WRK-WRITE-CNT. DTSBX215 +00966 DTSBX215 +00967 MOVE WRK-X220-CNT TO DISP-WRK-WRITE-CNT. DTSBX215 +00968 DISPLAY 'TOTAL X220 RECORDS WRITTEN ' DISP-WRK-WRITE-CNT. DTSBX215 00969 DTSBX215 +00970 DISPLAY 'TOTAL DEPOSIT RECS WRITTEN ' WRK-DEPOSIT-CNT. DTSBX215 +00971 DTSBX215 +00972 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX215 +00973 PERFORM S941-CLOSE THRU S941-EXIT. DTSBX215 +00974 CLOSE BX215-BATCH-FILE DTSBX215 +00975 BX220-ACTIVITY-FILE DTSBX215 +00976 DEPOSIT-FILE. DTSBX215 +00977 T0000-EXIT. DTSBX215 +00978 EXIT. DTSBX215 +00979 DTSBX215 diff --git a/Batch/DTSBX403.cob b/Batch/DTSBX403.cob new file mode 100644 index 0000000..1f350c8 --- /dev/null +++ b/Batch/DTSBX403.cob @@ -0,0 +1,777 @@ +00001 IDENTIFICATION DIVISION. 02/13/25 +00002 PROGRAM-ID. DTSBX403. DTSBX403 +00003 AUTHOR. SC. LV081 +00004 DATE-WRITTEN. JAN 2025. CL*49 +00005 *DATE-MODIFIED. DTSBX403 +00006 DATE-COMPILED. DTSBX403 +00007 DTSBX403 +00008 ***** DTSBX403 +00009 * FUNCTION: EXTRACT R403 RECORDS CL*13 +00010 * DTSBX403 +00011 * MODIFICATION HISTORY: DTSBX403 +00012 * DTSBX403 +00013 * 01-09-2025 INITIAL DEVELOPMENT. CL*13 +00014 * AUTHOR OF CHANGE - SC CL*13 +00015 * DTSBX403 +00016 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX403 +00017 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX403 +00018 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBX403 +00019 * RECORDS READ: DTSBX403 +00020 * DTSBX403 +00021 * EXTRACT R403 RECORDS FROM THE VARIABLE PACKED FILE AND CL*13 +00022 * CONVERT TO UNPACKED FIXED FILE. CL*13 +00023 * CL*13 +00024 * MODULES CALLED: DTSBX403 +00025 * DTSBX403 +00026 * DTSBU001 DATE EDIT/CONVERSION MODULE DTSBX403 +00027 * DTSBU005 DATE EDIT/CONVERSION MODULE DTSBX403 +00028 * DTSBU941 VARIABLE LENGTH RECORD READ DTSBX403 +00029 * DTSBX403 +00030 ***** DTSBX403 +00031 DTSBX403 +00032 ENVIRONMENT DIVISION. DTSBX403 +00033 DTSBX403 +00034 CONFIGURATION SECTION. DTSBX403 +00035 DTSBX403 +00036 INPUT-OUTPUT SECTION. DTSBX403 +00037 DTSBX403 +00038 FILE-CONTROL. DTSBX403 +00039 SELECT DTS-LN-OUT1 ASSIGN TO DTSLN403 CL*28 +00040 FILE STATUS IS DTSLN-OUT1-STATUS. CL*34 +00041 DTSBX403 +00042 SELECT DTS-LN-OUT2 ASSIGN TO DTSLN405 CL*28 +00043 FILE STATUS IS DTSLN-OUT2-STATUS. CL*34 +00044 CL*28 +00045 DATA DIVISION. DTSBX403 +00046 DTSBX403 +00047 FILE SECTION. DTSBX403 +00048 DTSBX403 +00049 FD DTS-LN-OUT1 CL*28 +00050 RECORDING MODE IS F DTSBX403 +00051 BLOCK CONTAINS 0 RECORDS DTSBX403 +00052 LABEL RECORDS ARE OMITTED. DTSBX403 +00053 DTSBX403 +00054 *01 LEIN-OUTREC1 PIC X(1640). CL*70 +00055 *01 LEIN-OUTREC1 PIC X(1721). CL*75 +00056 01 LEIN-OUTREC1 PIC X(1732). CL*75 +00057 DTSBX403 +00058 FD DTS-LN-OUT2 CL*28 +00059 RECORDING MODE IS F CL*28 +00060 BLOCK CONTAINS 0 RECORDS CL*28 +00061 LABEL RECORDS ARE OMITTED. CL*28 +00062 CL*28 +00063 *01 LEIN-OUTREC2 PIC X(312). CL*75 +00064 01 LEIN-OUTREC2 PIC X(323). CL*75 +00065 CL*28 +00066 WORKING-STORAGE SECTION. DTSBX403 +000665 77 PAN-VALET PICTURE X(24) VALUE '081DTSBX403 02/13/25'. DTSBX403 +00067 77 PAN-VALET PICTURE X(24) VALUE '017DTSBS403 05/08/09'. CL*15 +00068 01 WRK-AREA. DTSBX403 +00069 05 FILE-STATUS PIC 9(02) VALUE ZEROS. DTSBX403 +00070 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBS403'. CL*15 +00071 DTSBX403 +00072 05 WRK-ERROR-IND PIC X(01) VALUE 'N'. DTSBX403 +00073 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX403 +00074 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX403 +00075 DTSBX403 +00076 05 DTSLN-OUT1-STATUS PIC X(02). CL*32 +00077 88 LEIN-OUT1-OK-88 VALUE '00'. CL*32 +00078 CL*15 +00079 05 DTSLN-OUT2-STATUS PIC X(02). CL*32 +00080 88 LEIN-OUT2-OK-88 VALUE '00'. CL*32 +00081 CL*32 +00082 05 W-LEIN-403-IN-CNT PIC S9(07) COMP-3 VALUE +0. CL*18 +00083 05 W-LEIN-405-IN-CNT PIC S9(07) COMP-3 VALUE +0. CL*24 +00084 05 W-LEIN-403-OUT-CNT PIC S9(07) COMP-3 VALUE +0. CL*18 +00085 05 W-LEIN-405-OUT-CNT PIC S9(07) COMP-3 VALUE +0. CL*29 +00086 CL*18 +00087 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +310.DTSBX403 +00088 05 WRK-PRIOR-RUN-DATE PIC S9(09) COMP-3. DTSBX403 +00089 05 WRK-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX403 +00090 05 WRK-X215-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX403 +00091 05 WRK-X220-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX403 +00092 05 WRK-DEPOSIT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX403 +00093 DTSBX403 +00094 05 WRK-906-OPID PIC X(08). DTSBX403 +00095 05 WRK-906-EMP PIC S9(07) COMP-3. DTSBX403 +00096 05 WRK-906-SCREEN PIC X(02). DTSBX403 +00097 05 WRK-906-DATE PIC S9(09) COMP-3. DTSBX403 +00098 05 WRK-906-TIME PIC S9(07) COMP-3. DTSBX403 +00099 DTSBX403 +00100 05 DISP-REMIT PIC --,---,---,--9.99. DTSBX403 +00101 05 DISP-WRK-READ-CNT PIC ZZ,ZZZ,ZZ9. DTSBX403 +00102 05 DISP-WRK-WRITE-CNT PIC ZZ,ZZZ,ZZ9. DTSBX403 +00103 DTSBX403 +00104 05 WORK-HOLD-DATE PIC X(10) VALUE SPACE. CL*72 +00105 CL*72 +00106 05 WRK-INACT-SLASH-DT. CL*72 +00107 15 WRK-INACT-MM PIC X(02) VALUE SPACE. CL*72 +00108 15 FILLER PIC X(01) VALUE '/'. CL*72 +00109 15 WRK-INACT-DD PIC X(02) VALUE SPACE. CL*72 +00110 15 FILLER PIC X(01) VALUE '/'. CL*72 +00111 15 WRK-INACT-YYYY PIC X(04) VALUE SPACE. CL*72 +00112 CL*72 +00113 01 L062-LINK-AREA. DTSBX403 +00114 ++INCLUDE DTSIL062 DTSBX403 +00115 DTSBX403 +00116 01 L001-LINK-AREA. DTSBX403 +00117 ++INCLUDE DTSIL001 DTSBX403 +00118 DTSBX403 +00119 01 L005-LINK-AREA. DTSBX403 +00120 ++INCLUDE DTSIL005 DTSBX403 +00121 DTSBX403 +00122 01 L910-LINK-AREA. DTSBX403 +00123 ++INCLUDE DTSIL910 DTSBX403 +00124 DTSBX403 +00125 01 MSKL-REC. DTSBX403 +00126 ++INCLUDE DTSIMSKL DTSBX403 +00127 DTSBX403 +00128 01 MHDR-REC. DTSBX403 +00129 ++INCLUDE DTSIMHDR DTSBX403 +00130 DTSBX403 +00131 01 MPRF-REC. DTSBX403 +00132 ++INCLUDE DTSIMPRF DTSBX403 +00133 DTSBX403 +00134 01 MFAS-REC. DTSBX403 +00135 ++INCLUDE DTSIMFAS DTSBX403 +00136 DTSBX403 +00137 01 MEVL-REC. DTSBX403 +00138 ++INCLUDE DTSIMEVL DTSBX403 +00139 DTSBX403 +00140 01 MRPT-REC. DTSBX403 +00141 ++INCLUDE DTSIMRPT DTSBX403 +00142 DTSBX403 +00143 01 L941-LINK-AREA. DTSBX403 +00144 ++INCLUDE DTSIL941 DTSBX403 +00145 DTSBX403 +00146 01 RSK3-REC. DTSBX403 +00147 ++INCLUDE DTSIRSK3 DTSBX403 +00148 DTSBX403 +00149 01 R403-REC. CL*16 +00150 ++INCLUDE DTSIR403 CL*16 +00151 DTSBX403 +00152 01 W403-REC. CL*16 +00153 ++INCLUDE DTSIW403 CL*16 +00154 DTSBX403 +00155 01 R405-REC. CL*28 +00156 ++INCLUDE DTSIR405 CL*28 +00157 CL*28 +00158 01 W405-REC. CL*28 +00159 ++INCLUDE DTSIW405 CL*28 +00160 CL*28 +00161 PROCEDURE DIVISION. DTSBX403 +00162 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX403 +00163 IF WRK-ERROR-NO-88 DTSBX403 +00164 PERFORM P0000-PROCESS THRU P0000-EXIT CL*72 +00165 PERFORM T0000-TERMINATE THRU T0000-EXIT CL*72 +00166 END-IF. DTSBX403 +00167 DTSBX403 +00168 GOBACK. DTSBX403 +00169 DTSBX403 +00170 I0000-INITIATE. DTSBX403 +00171 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*72 +00172 PERFORM I3000-GET-MHDR THRU I3000-EXIT. CL*72 +00173 PERFORM I3500-MOVE-CURRDT THRU I3500-EXIT. CL*72 +00174 DTSBX403 +00175 I0000-EXIT. DTSBX403 +00176 EXIT. DTSBX403 +00177 DTSBX403 +00178 I2000-OPEN-FILES. DTSBX403 +00179 CL*16 +00180 OPEN OUTPUT DTS-LN-OUT1. CL*28 +00181 IF LEIN-OUT1-OK-88 CL*28 +00182 NEXT SENTENCE DTSBX403 +00183 ELSE DTSBX403 +00184 SET WRK-ERROR-YES-88 TO TRUE DTSBX403 +00185 DISPLAY 'CANNOT OPEN LEIN 403 FILE ' DTSLN-OUT1-STATUS CL*28 +00186 GO TO I2000-EXIT DTSBX403 +00187 END-IF. DTSBX403 +00188 DTSBX403 +00189 OPEN OUTPUT DTS-LN-OUT2. CL*28 +00190 IF LEIN-OUT2-OK-88 CL*28 +00191 NEXT SENTENCE CL*28 +00192 ELSE CL*28 +00193 SET WRK-ERROR-YES-88 TO TRUE CL*28 +00194 DISPLAY 'CANNOT OPEN LEIN 405 FILE ' DTSLN-OUT2-STATUS CL*64 +00195 GO TO I2000-EXIT CL*28 +00196 END-IF. CL*28 +00197 CL*28 +00198 DTSBX403 +00199 MOVE 'N' TO L910-TRACE-IND DTSBX403 +00200 L941-TRACE-IND. DTSBX403 +00201 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBX403 +00202 L941-MOD-NAME. DTSBX403 +00203 DTSBX403 +00204 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*79 +00205 PERFORM S941-OPEN THRU S941-EXIT. DTSBX403 +00206 DTSBX403 +00207 I2000-EXIT. DTSBX403 +00208 EXIT. DTSBX403 +00209 DTSBX403 +00210 I3000-GET-MHDR. CL*72 +00211 MOVE LOW-VALUES TO MSKL-REC. CL*72 +00212 MOVE +0 TO MSKL-EMP-NO. CL*72 +00213 SET MSKL-HDR-88 TO TRUE. CL*72 +00214 CL*72 +00215 PERFORM S910-READ THRU S910-EXIT. CL*72 +00216 IF L910-NO-REC-88 CL*72 +00217 DISPLAY 'DTSBS403: MHDR RECORD IS MISSING' CL*72 +00218 SET WRK-ERROR-YES-88 TO TRUE CL*77 +00219 GO TO I3000-EXIT CL*72 +00220 ELSE CL*72 +00221 MOVE MSKL-REC TO MHDR-REC CL*72 +00222 * MOVE MHDR-CURR-RUN-DATE TO WORK-HOLD-DATE CL*80 +00223 MOVE MHDR-PRIOR-RUN-DATE TO WORK-HOLD-DATE CL*80 +00224 DISPLAY 'MHDR-CURR-RUN-DATE' MHDR-CURR-RUN-DATE CL*72 +00225 END-IF. CL*72 +00226 CL*72 +00227 I3000-EXIT. CL*72 +00228 EXIT. CL*72 +00229 CL*72 +00230 I3500-MOVE-CURRDT. CL*72 +00231 CL*72 +00232 MOVE WORK-HOLD-DATE(2:4) TO WRK-INACT-YYYY CL*73 +00233 MOVE WORK-HOLD-DATE(6:2) TO WRK-INACT-MM CL*73 +00234 MOVE WORK-HOLD-DATE(8:2) TO WRK-INACT-DD CL*73 +00235 MOVE WRK-INACT-SLASH-DT TO W403-CURR-DATE CL*73 +00236 W405-CURR-DATE. CL*76 +00237 CL*72 +00238 I3500-EXIT. CL*72 +00239 EXIT. CL*72 +00240 CL*72 +00241 P0000-PROCESS. DTSBX403 +00242 PERFORM P1000-FROM-RPTS THRU P1000-EXIT. DTSBX403 +00243 DTSBX403 +00244 P0000-EXIT. DTSBX403 +00245 EXIT. DTSBX403 +00246 DTSBX403 +00247 P1000-FROM-RPTS. DTSBX403 +00248 PERFORM S941-READ-NEXT THRU S941-EXIT. DTSBX403 +00249 DTSBX403 +00250 PERFORM UNTIL L941-NO-REC-88 DTSBX403 +00251 EVALUATE RSK3-REC-TYPE DTSBX403 +00252 WHEN '403' CL*16 +00253 ADD +1 TO W-LEIN-403-IN-CNT CL*19 +00254 MOVE RSK3-REC TO R403-REC CL*16 +00255 PERFORM P1100-PROCESS-R403 THRU P1100-EXIT CL*16 +00256 DTSBX403 +00257 WHEN '405' CL*18 +00258 ADD +1 TO W-LEIN-405-IN-CNT CL*22 +00259 MOVE RSK3-REC TO R405-REC CL*28 +00260 PERFORM P1200-PROCESS-R405 THRU P1200-EXIT CL*28 +00261 END-EVALUATE DTSBX403 +00262 PERFORM S941-READ-NEXT THRU S941-EXIT DTSBX403 +00263 END-PERFORM. DTSBX403 +00264 DTSBX403 +00265 P1000-EXIT. DTSBX403 +00266 EXIT. DTSBX403 +00267 DTSBX403 +00268 P1100-PROCESS-R403. CL*18 +00269 DTSBX403 +00270 MOVE R403-LENGTH TO W403-LENGTH CL*39 +00271 MOVE R403-REC-TYPE TO W403-REC-TYPE CL*39 +00272 MOVE R403-OP-ID TO W403-OP-ID CL*39 +00273 MOVE R403-EMP-NO TO W403-EMP-NO CL*39 +00274 MOVE R403-CERTIFICATE-NO CL*38 +00275 TO W403-CERTIFICATE-NO CL*39 +00276 MOVE R403-CERTIFICATE-DATE TO L001-FED-8-DATE-9. CL*55 +00277 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*55 +00278 MOVE L001-SLASH-8-DATE TO W403-CERTIFICATE-DATE. CL*55 +00279 CL*55 +00280 MOVE R403-EMP-STATUS TO W403-EMP-STATUS CL*39 +00281 CL*55 +00282 MOVE R403-STMT-DATE TO L001-FED-8-DATE-9. CL*55 +00283 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*55 +00284 MOVE L001-SLASH-8-DATE TO W403-STMT-DATE. CL*55 +00285 CL*55 +00286 MOVE R403-PRIMARY-NAME TO W403-PRIMARY-NAME CL*39 +00287 MOVE R403-FMT-LINE(01) TO W403-FMT-LINE1 CL*61 +00288 MOVE R403-FMT-LINE(02) TO W403-FMT-LINE2 CL*61 +00289 MOVE R403-FMT-LINE(03) TO W403-FMT-LINE3 CL*61 +00290 MOVE R403-FMT-LINE(04) TO W403-FMT-LINE4 CL*61 +00291 MOVE R403-FMT-LINE(05) TO W403-FMT-LINE5 CL*61 +00292 MOVE R403-ZIP TO W403-ZIP CL*39 +00293 MOVE R403-ADVANCED-BARCODE CL*38 +00294 TO W403-ADVANCED-BARCODE CL*39 +00295 CL*55 +00296 MOVE R403-FORM-COMP-DATE TO L001-FED-8-DATE-9. CL*55 +00297 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*55 +00298 MOVE L001-SLASH-8-DATE TO W403-FORM-COMP-DATE. CL*55 +00299 CL*55 +00300 MOVE R403-FORM-QTR-CNT TO W403-FORM-QTR-CNT CL*39 +00301 CL*38 +00302 MOVE R403-LETTER-LICENSE-IND CL*67 +00303 TO W403-LETTER-LICENSE-IND CL*67 +00304 MOVE R403-LETTER-TOTAL-AMT CL*67 +00305 TO W403-LETTER-TOTAL-AMT CL*67 +00306 CL*67 +00307 MOVE R403-FORM-QTR(01) CL*38 +00308 TO W403-FORM-QTR1 CL*57 +00309 MOVE R403-FORM-TAX-BALANCE-AMT(01) CL*38 +00310 TO W403-FORM-TAX-BALANCE-AMT1 CL*57 +00311 MOVE R403-FORM-INT-BALANCE-AMT(01) CL*38 +00312 TO W403-FORM-INT-BALANCE-AMT1 CL*57 +00313 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(01) CL*38 +00314 TO W403-FORM-LP-NP-MP-BLNCE-AMT1 CL*62 +00315 MOVE R403-FORM-LEGAL-IND(01) CL*38 +00316 TO W403-FORM-LEGAL-IND1 CL*57 +00317 MOVE R403-FORM-ESTIMATED-IND(01) CL*38 +00318 TO W403-FORM-ESTIMATED-IND1 CL*57 +00319 MOVE R403-FORM-UNUSED-IND(01) CL*38 +00320 TO W403-FORM-UNUSED-IND1 CL*57 +00321 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(01) CL*38 +00322 TO W403-FORM-SUR-TAX-BLNCE-AMT1 CL*62 +00323 CL*38 +00324 MOVE R403-FORM-QTR(02) CL*42 +00325 TO W403-FORM-QTR2 CL*57 +00326 MOVE R403-FORM-TAX-BALANCE-AMT(02) CL*42 +00327 TO W403-FORM-TAX-BALANCE-AMT2 CL*57 +00328 MOVE R403-FORM-INT-BALANCE-AMT(02) CL*42 +00329 TO W403-FORM-INT-BALANCE-AMT2 CL*57 +00330 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(02) CL*42 +00331 TO W403-FORM-LP-NP-MP-BLNCE-AMT2 CL*62 +00332 MOVE R403-FORM-LEGAL-IND(02) CL*42 +00333 TO W403-FORM-LEGAL-IND2 CL*57 +00334 MOVE R403-FORM-ESTIMATED-IND(02) CL*42 +00335 TO W403-FORM-ESTIMATED-IND2 CL*57 +00336 MOVE R403-FORM-UNUSED-IND(02) CL*42 +00337 TO W403-FORM-UNUSED-IND2 CL*57 +00338 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(02) CL*42 +00339 TO W403-FORM-SUR-TAX-BLNCE-AMT2 CL*62 +00340 CL*42 +00341 MOVE R403-FORM-QTR(03) CL*42 +00342 TO W403-FORM-QTR3 CL*57 +00343 MOVE R403-FORM-TAX-BALANCE-AMT(03) CL*42 +00344 TO W403-FORM-TAX-BALANCE-AMT3 CL*57 +00345 MOVE R403-FORM-INT-BALANCE-AMT(03) CL*42 +00346 TO W403-FORM-INT-BALANCE-AMT3 CL*57 +00347 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(03) CL*42 +00348 TO W403-FORM-LP-NP-MP-BLNCE-AMT3 CL*62 +00349 MOVE R403-FORM-LEGAL-IND(03) CL*42 +00350 TO W403-FORM-LEGAL-IND3 CL*57 +00351 MOVE R403-FORM-ESTIMATED-IND(03) CL*42 +00352 TO W403-FORM-ESTIMATED-IND3 CL*57 +00353 MOVE R403-FORM-UNUSED-IND(03) CL*42 +00354 TO W403-FORM-UNUSED-IND3 CL*57 +00355 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(03) CL*42 +00356 TO W403-FORM-SUR-TAX-BLNCE-AMT3 CL*62 +00357 CL*42 +00358 MOVE R403-FORM-QTR(04) CL*42 +00359 TO W403-FORM-QTR4 CL*57 +00360 MOVE R403-FORM-TAX-BALANCE-AMT(04) CL*42 +00361 TO W403-FORM-TAX-BALANCE-AMT4 CL*57 +00362 MOVE R403-FORM-INT-BALANCE-AMT(04) CL*42 +00363 TO W403-FORM-INT-BALANCE-AMT4 CL*57 +00364 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(04) CL*42 +00365 TO W403-FORM-LP-NP-MP-BLNCE-AMT4 CL*62 +00366 MOVE R403-FORM-LEGAL-IND(04) CL*42 +00367 TO W403-FORM-LEGAL-IND4 CL*57 +00368 MOVE R403-FORM-ESTIMATED-IND(04) CL*42 +00369 TO W403-FORM-ESTIMATED-IND4 CL*57 +00370 MOVE R403-FORM-UNUSED-IND(04) CL*42 +00371 TO W403-FORM-UNUSED-IND4 CL*57 +00372 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(04) CL*42 +00373 TO W403-FORM-SUR-TAX-BLNCE-AMT4 CL*62 +00374 CL*42 +00375 MOVE R403-FORM-QTR(05) CL*42 +00376 TO W403-FORM-QTR5 CL*57 +00377 MOVE R403-FORM-TAX-BALANCE-AMT(05) CL*42 +00378 TO W403-FORM-TAX-BALANCE-AMT5 CL*57 +00379 MOVE R403-FORM-INT-BALANCE-AMT(05) CL*42 +00380 TO W403-FORM-INT-BALANCE-AMT5 CL*57 +00381 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(05) CL*42 +00382 TO W403-FORM-LP-NP-MP-BLNCE-AMT5 CL*62 +00383 MOVE R403-FORM-LEGAL-IND(05) CL*42 +00384 TO W403-FORM-LEGAL-IND5 CL*57 +00385 MOVE R403-FORM-ESTIMATED-IND(05) CL*42 +00386 TO W403-FORM-ESTIMATED-IND5 CL*57 +00387 MOVE R403-FORM-UNUSED-IND(05) CL*42 +00388 TO W403-FORM-UNUSED-IND5 CL*57 +00389 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(05) CL*42 +00390 TO W403-FORM-SUR-TAX-BLNCE-AMT5 CL*62 +00391 CL*42 +00392 MOVE R403-FORM-QTR(06) CL*42 +00393 TO W403-FORM-QTR6 CL*57 +00394 MOVE R403-FORM-TAX-BALANCE-AMT(06) CL*42 +00395 TO W403-FORM-TAX-BALANCE-AMT6 CL*57 +00396 MOVE R403-FORM-INT-BALANCE-AMT(06) CL*42 +00397 TO W403-FORM-INT-BALANCE-AMT6 CL*57 +00398 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(06) CL*42 +00399 TO W403-FORM-LP-NP-MP-BLNCE-AMT6 CL*62 +00400 MOVE R403-FORM-LEGAL-IND(06) CL*42 +00401 TO W403-FORM-LEGAL-IND6 CL*57 +00402 MOVE R403-FORM-ESTIMATED-IND(06) CL*42 +00403 TO W403-FORM-ESTIMATED-IND6 CL*57 +00404 MOVE R403-FORM-UNUSED-IND(06) CL*42 +00405 TO W403-FORM-UNUSED-IND6 CL*57 +00406 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(06) CL*42 +00407 TO W403-FORM-SUR-TAX-BLNCE-AMT6 CL*62 +00408 CL*42 +00409 MOVE R403-FORM-QTR(07) CL*42 +00410 TO W403-FORM-QTR7 CL*57 +00411 MOVE R403-FORM-TAX-BALANCE-AMT(07) CL*42 +00412 TO W403-FORM-TAX-BALANCE-AMT7 CL*57 +00413 MOVE R403-FORM-INT-BALANCE-AMT(07) CL*42 +00414 TO W403-FORM-INT-BALANCE-AMT7 CL*57 +00415 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(07) CL*42 +00416 TO W403-FORM-LP-NP-MP-BLNCE-AMT7 CL*62 +00417 MOVE R403-FORM-LEGAL-IND(07) CL*42 +00418 TO W403-FORM-LEGAL-IND7 CL*57 +00419 MOVE R403-FORM-ESTIMATED-IND(07) CL*42 +00420 TO W403-FORM-ESTIMATED-IND7 CL*57 +00421 MOVE R403-FORM-UNUSED-IND(07) CL*42 +00422 TO W403-FORM-UNUSED-IND7 CL*57 +00423 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(07) CL*42 +00424 TO W403-FORM-SUR-TAX-BLNCE-AMT7 CL*62 +00425 CL*42 +00426 MOVE R403-FORM-QTR(08) CL*42 +00427 TO W403-FORM-QTR8 CL*57 +00428 MOVE R403-FORM-TAX-BALANCE-AMT(08) CL*42 +00429 TO W403-FORM-TAX-BALANCE-AMT8 CL*57 +00430 MOVE R403-FORM-INT-BALANCE-AMT(08) CL*42 +00431 TO W403-FORM-INT-BALANCE-AMT8 CL*57 +00432 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(08) CL*42 +00433 TO W403-FORM-LP-NP-MP-BLNCE-AMT8 CL*62 +00434 MOVE R403-FORM-LEGAL-IND(08) CL*42 +00435 TO W403-FORM-LEGAL-IND8 CL*57 +00436 MOVE R403-FORM-ESTIMATED-IND(08) CL*42 +00437 TO W403-FORM-ESTIMATED-IND8 CL*57 +00438 MOVE R403-FORM-UNUSED-IND(08) CL*42 +00439 TO W403-FORM-UNUSED-IND8 CL*57 +00440 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(08) CL*63 +00441 TO W403-FORM-SUR-TAX-BLNCE-AMT8 CL*62 +00442 CL*42 +00443 MOVE R403-FORM-QTR(09) CL*42 +00444 TO W403-FORM-QTR9 CL*57 +00445 MOVE R403-FORM-TAX-BALANCE-AMT(09) CL*42 +00446 TO W403-FORM-TAX-BALANCE-AMT9 CL*57 +00447 MOVE R403-FORM-INT-BALANCE-AMT(09) CL*42 +00448 TO W403-FORM-INT-BALANCE-AMT9 CL*57 +00449 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(09) CL*42 +00450 TO W403-FORM-LP-NP-MP-BLNCE-AMT9 CL*62 +00451 MOVE R403-FORM-LEGAL-IND(09) CL*42 +00452 TO W403-FORM-LEGAL-IND9 CL*57 +00453 MOVE R403-FORM-ESTIMATED-IND(09) CL*42 +00454 TO W403-FORM-ESTIMATED-IND9 CL*57 +00455 MOVE R403-FORM-UNUSED-IND(09) CL*42 +00456 TO W403-FORM-UNUSED-IND9 CL*57 +00457 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(09) CL*42 +00458 TO W403-FORM-SUR-TAX-BLNCE-AMT9 CL*62 +00459 CL*42 +00460 MOVE R403-FORM-QTR(10) CL*42 +00461 TO W403-FORM-QTR10 CL*57 +00462 MOVE R403-FORM-TAX-BALANCE-AMT(10) CL*42 +00463 TO W403-FORM-TAX-BALANCE-AMT10 CL*57 +00464 MOVE R403-FORM-INT-BALANCE-AMT(10) CL*42 +00465 TO W403-FORM-INT-BALANCE-AMT10 CL*57 +00466 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(10) CL*42 +00467 TO W403-FORM-LP-NP-MP-BLNCE-AMT10 CL*62 +00468 MOVE R403-FORM-LEGAL-IND(10) CL*42 +00469 TO W403-FORM-LEGAL-IND10 CL*57 +00470 MOVE R403-FORM-ESTIMATED-IND(10) CL*42 +00471 TO W403-FORM-ESTIMATED-IND10 CL*57 +00472 MOVE R403-FORM-UNUSED-IND(10) CL*42 +00473 TO W403-FORM-UNUSED-IND10 CL*57 +00474 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(10) CL*42 +00475 TO W403-FORM-SUR-TAX-BLNCE-AMT10 CL*62 +00476 CL*42 +00477 MOVE R403-FORM-QTR(11) CL*42 +00478 TO W403-FORM-QTR11 CL*57 +00479 MOVE R403-FORM-TAX-BALANCE-AMT(11) CL*42 +00480 TO W403-FORM-TAX-BALANCE-AMT11 CL*57 +00481 MOVE R403-FORM-INT-BALANCE-AMT(11) CL*42 +00482 TO W403-FORM-INT-BALANCE-AMT11 CL*57 +00483 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(11) CL*42 +00484 TO W403-FORM-LP-NP-MP-BLNCE-AMT11 CL*62 +00485 MOVE R403-FORM-LEGAL-IND(11) CL*42 +00486 TO W403-FORM-LEGAL-IND11 CL*57 +00487 MOVE R403-FORM-ESTIMATED-IND(11) CL*42 +00488 TO W403-FORM-ESTIMATED-IND11 CL*58 +00489 MOVE R403-FORM-UNUSED-IND(11) CL*42 +00490 TO W403-FORM-UNUSED-IND11 CL*58 +00491 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(11) CL*42 +00492 TO W403-FORM-SUR-TAX-BLNCE-AMT11 CL*62 +00493 CL*42 +00494 MOVE R403-FORM-QTR(12) CL*42 +00495 TO W403-FORM-QTR12 CL*59 +00496 MOVE R403-FORM-TAX-BALANCE-AMT(12) CL*42 +00497 TO W403-FORM-TAX-BALANCE-AMT12 CL*59 +00498 MOVE R403-FORM-INT-BALANCE-AMT(12) CL*42 +00499 TO W403-FORM-INT-BALANCE-AMT12 CL*59 +00500 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(12) CL*42 +00501 TO W403-FORM-LP-NP-MP-BLNCE-AMT12 CL*62 +00502 MOVE R403-FORM-LEGAL-IND(12) CL*42 +00503 TO W403-FORM-LEGAL-IND12 CL*59 +00504 MOVE R403-FORM-ESTIMATED-IND(12) CL*42 +00505 TO W403-FORM-ESTIMATED-IND12 CL*59 +00506 MOVE R403-FORM-UNUSED-IND(12) CL*42 +00507 TO W403-FORM-UNUSED-IND12 CL*59 +00508 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(12) CL*42 +00509 TO W403-FORM-SUR-TAX-BLNCE-AMT12 CL*62 +00510 CL*42 +00511 MOVE R403-FORM-QTR(13) CL*43 +00512 TO W403-FORM-QTR13 CL*59 +00513 MOVE R403-FORM-TAX-BALANCE-AMT(13) CL*43 +00514 TO W403-FORM-TAX-BALANCE-AMT13 CL*59 +00515 MOVE R403-FORM-INT-BALANCE-AMT(13) CL*43 +00516 TO W403-FORM-INT-BALANCE-AMT13 CL*59 +00517 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(13) CL*43 +00518 TO W403-FORM-LP-NP-MP-BLNCE-AMT13 CL*62 +00519 MOVE R403-FORM-LEGAL-IND(13) CL*43 +00520 TO W403-FORM-LEGAL-IND13 CL*59 +00521 MOVE R403-FORM-ESTIMATED-IND(13) CL*43 +00522 TO W403-FORM-ESTIMATED-IND13 CL*59 +00523 MOVE R403-FORM-UNUSED-IND(13) CL*43 +00524 TO W403-FORM-UNUSED-IND13 CL*59 +00525 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(13) CL*43 +00526 TO W403-FORM-SUR-TAX-BLNCE-AMT13 CL*62 +00527 CL*42 +00528 MOVE R403-FORM-QTR(14) CL*43 +00529 TO W403-FORM-QTR14 CL*59 +00530 MOVE R403-FORM-TAX-BALANCE-AMT(14) CL*43 +00531 TO W403-FORM-TAX-BALANCE-AMT14 CL*59 +00532 MOVE R403-FORM-INT-BALANCE-AMT(14) CL*43 +00533 TO W403-FORM-INT-BALANCE-AMT14 CL*59 +00534 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(14) CL*43 +00535 TO W403-FORM-LP-NP-MP-BLNCE-AMT14 CL*62 +00536 MOVE R403-FORM-LEGAL-IND(14) CL*43 +00537 TO W403-FORM-LEGAL-IND14 CL*59 +00538 MOVE R403-FORM-ESTIMATED-IND(14) CL*43 +00539 TO W403-FORM-ESTIMATED-IND14 CL*59 +00540 MOVE R403-FORM-UNUSED-IND(14) CL*43 +00541 TO W403-FORM-UNUSED-IND14 CL*59 +00542 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(14) CL*43 +00543 TO W403-FORM-SUR-TAX-BLNCE-AMT14 CL*62 +00544 CL*43 +00545 MOVE R403-FORM-QTR(15) CL*43 +00546 TO W403-FORM-QTR15 CL*59 +00547 MOVE R403-FORM-TAX-BALANCE-AMT(15) CL*43 +00548 TO W403-FORM-TAX-BALANCE-AMT15 CL*59 +00549 MOVE R403-FORM-INT-BALANCE-AMT(15) CL*43 +00550 TO W403-FORM-INT-BALANCE-AMT15 CL*59 +00551 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(15) CL*43 +00552 TO W403-FORM-LP-NP-MP-BLNCE-AMT15 CL*62 +00553 MOVE R403-FORM-LEGAL-IND(15) CL*43 +00554 TO W403-FORM-LEGAL-IND15 CL*59 +00555 MOVE R403-FORM-ESTIMATED-IND(15) CL*43 +00556 TO W403-FORM-ESTIMATED-IND15 CL*59 +00557 MOVE R403-FORM-UNUSED-IND(15) CL*43 +00558 TO W403-FORM-UNUSED-IND15 CL*59 +00559 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(15) CL*43 +00560 TO W403-FORM-SUR-TAX-BLNCE-AMT15 CL*62 +00561 CL*43 +00562 MOVE R403-FORM-QTR(16) CL*43 +00563 TO W403-FORM-QTR16 CL*59 +00564 MOVE R403-FORM-TAX-BALANCE-AMT(16) CL*43 +00565 TO W403-FORM-TAX-BALANCE-AMT16 CL*59 +00566 MOVE R403-FORM-INT-BALANCE-AMT(16) CL*43 +00567 TO W403-FORM-INT-BALANCE-AMT16 CL*59 +00568 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(16) CL*43 +00569 TO W403-FORM-LP-NP-MP-BLNCE-AMT16 CL*62 +00570 MOVE R403-FORM-LEGAL-IND(16) CL*43 +00571 TO W403-FORM-LEGAL-IND16 CL*59 +00572 MOVE R403-FORM-ESTIMATED-IND(16) CL*43 +00573 TO W403-FORM-ESTIMATED-IND16 CL*59 +00574 MOVE R403-FORM-UNUSED-IND(16) CL*43 +00575 TO W403-FORM-UNUSED-IND16 CL*59 +00576 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(16) CL*43 +00577 TO W403-FORM-SUR-TAX-BLNCE-AMT16 CL*62 +00578 CL*43 +00579 MOVE R403-FORM-QTR(17) CL*43 +00580 TO W403-FORM-QTR17 CL*59 +00581 MOVE R403-FORM-TAX-BALANCE-AMT(17) CL*43 +00582 TO W403-FORM-TAX-BALANCE-AMT17 CL*59 +00583 MOVE R403-FORM-INT-BALANCE-AMT(17) CL*43 +00584 TO W403-FORM-INT-BALANCE-AMT17 CL*59 +00585 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(17) CL*43 +00586 TO W403-FORM-LP-NP-MP-BLNCE-AMT17 CL*62 +00587 MOVE R403-FORM-LEGAL-IND(17) CL*43 +00588 TO W403-FORM-LEGAL-IND17 CL*59 +00589 MOVE R403-FORM-ESTIMATED-IND(17) CL*59 +00590 TO W403-FORM-ESTIMATED-IND17 CL*59 +00591 MOVE R403-FORM-UNUSED-IND(17) CL*43 +00592 TO W403-FORM-UNUSED-IND17 CL*59 +00593 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(17) CL*43 +00594 TO W403-FORM-SUR-TAX-BLNCE-AMT17 CL*62 +00595 CL*43 +00596 MOVE R403-FORM-QTR(18) CL*43 +00597 TO W403-FORM-QTR18 CL*59 +00598 MOVE R403-FORM-TAX-BALANCE-AMT(18) CL*43 +00599 TO W403-FORM-TAX-BALANCE-AMT18 CL*59 +00600 MOVE R403-FORM-INT-BALANCE-AMT(18) CL*43 +00601 TO W403-FORM-INT-BALANCE-AMT18 CL*59 +00602 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(18) CL*43 +00603 TO W403-FORM-LP-NP-MP-BLNCE-AMT18 CL*62 +00604 MOVE R403-FORM-LEGAL-IND(18) CL*43 +00605 TO W403-FORM-LEGAL-IND18 CL*59 +00606 MOVE R403-FORM-ESTIMATED-IND(18) CL*43 +00607 TO W403-FORM-ESTIMATED-IND18 CL*59 +00608 MOVE R403-FORM-UNUSED-IND(18) CL*43 +00609 TO W403-FORM-UNUSED-IND18 CL*59 +00610 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(18) CL*43 +00611 TO W403-FORM-SUR-TAX-BLNCE-AMT18 CL*62 +00612 CL*43 +00613 MOVE R403-FORM-QTR(19) CL*43 +00614 TO W403-FORM-QTR19 CL*59 +00615 MOVE R403-FORM-TAX-BALANCE-AMT(19) CL*43 +00616 TO W403-FORM-TAX-BALANCE-AMT19 CL*59 +00617 MOVE R403-FORM-INT-BALANCE-AMT(19) CL*43 +00618 TO W403-FORM-INT-BALANCE-AMT19 CL*59 +00619 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(19) CL*43 +00620 TO W403-FORM-LP-NP-MP-BLNCE-AMT19 CL*62 +00621 MOVE R403-FORM-LEGAL-IND(19) CL*43 +00622 TO W403-FORM-LEGAL-IND19 CL*59 +00623 MOVE R403-FORM-ESTIMATED-IND(19) CL*43 +00624 TO W403-FORM-ESTIMATED-IND19 CL*59 +00625 MOVE R403-FORM-UNUSED-IND(19) CL*43 +00626 TO W403-FORM-UNUSED-IND19 CL*59 +00627 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(19) CL*43 +00628 TO W403-FORM-SUR-TAX-BLNCE-AMT19 CL*62 +00629 CL*43 +00630 MOVE R403-FORM-QTR(20) CL*43 +00631 TO W403-FORM-QTR20 CL*59 +00632 MOVE R403-FORM-TAX-BALANCE-AMT(20) CL*43 +00633 TO W403-FORM-TAX-BALANCE-AMT20 CL*59 +00634 MOVE R403-FORM-INT-BALANCE-AMT(20) CL*43 +00635 TO W403-FORM-INT-BALANCE-AMT20 CL*59 +00636 MOVE R403-FORM-LP-NP-MP-BALANCE-AMT(20) CL*43 +00637 TO W403-FORM-LP-NP-MP-BLNCE-AMT20 CL*62 +00638 MOVE R403-FORM-LEGAL-IND(20) CL*43 +00639 TO W403-FORM-LEGAL-IND20 CL*59 +00640 MOVE R403-FORM-ESTIMATED-IND(20) CL*43 +00641 TO W403-FORM-ESTIMATED-IND20 CL*59 +00642 MOVE R403-FORM-UNUSED-IND(20) CL*43 +00643 TO W403-FORM-UNUSED-IND20 CL*59 +00644 MOVE R403-FORM-SUR-TAX-BALANCE-AMT(20) CL*43 +00645 TO W403-FORM-SUR-TAX-BLNCE-AMT20 CL*62 +00646 CL*43 +00647 CL*38 +00648 WRITE LEIN-OUTREC1 FROM W403-REC. CL*29 +00649 ADD +1 TO W-LEIN-403-OUT-CNT. CL*29 +00650 DTSBX403 +00651 P1100-EXIT. DTSBX403 +00652 EXIT. DTSBX403 +00653 DTSBX403 +00654 P1200-PROCESS-R405. CL*28 +00655 CL*28 +00656 MOVE R405-LENGTH TO W405-LENGTH. CL*29 +00657 CL*28 +00658 MOVE R405-REC-TYPE TO W405-REC-TYPE. CL*35 +00659 MOVE R405-OP-ID TO W405-OP-ID. CL*35 +00660 MOVE R405-EMP-NO TO W405-EMP-NO. CL*35 +00661 CL*35 +00662 MOVE R405-PRIMARY-NAME TO W405-PRIMARY-NAME. CL*36 +00663 ** MOVE R405-STMT-DATE TO W405-STMT-DATE. CL*49 +00664 MOVE R405-STMT-DATE TO L001-FED-8-DATE-9. CL*49 +00665 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*49 +00666 MOVE L001-SLASH-8-DATE TO W405-STMT-DATE. CL*49 +00667 CL*49 +00668 MOVE R405-CERTIFICATE-NO TO W405-CERTIFICATE-NO. CL*36 +00669 MOVE R405-REC-DEEDS-NO TO W405-REC-DEEDS-NO. CL*36 +00670 ** MOVE R405-CERTIFICATE-DATE TO W405-CERTIFICATE-DATE. CL*49 +00671 MOVE R405-CERTIFICATE-DATE TO L001-FED-8-DATE-9. CL*49 +00672 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*49 +00673 MOVE L001-SLASH-8-DATE TO W405-CERTIFICATE-DATE. CL*49 +00674 CL*49 +00675 CL*36 +00676 MOVE R405-FMT-LINE(01) TO W405-FMT-LINE1. CL*51 +00677 MOVE R405-FMT-LINE(02) TO W405-FMT-LINE2. CL*51 +00678 MOVE R405-FMT-LINE(03) TO W405-FMT-LINE3. CL*51 +00679 MOVE R405-FMT-LINE(04) TO W405-FMT-LINE4. CL*51 +00680 MOVE R405-FMT-LINE(05) TO W405-FMT-LINE5. CL*51 +00681 CL*28 +00682 WRITE LEIN-OUTREC2 FROM W405-REC. CL*29 +00683 ADD +1 TO W-LEIN-405-OUT-CNT. CL*29 +00684 CL*28 +00685 P1200-EXIT. CL*29 +00686 EXIT. CL*28 +00687 CL*28 +00688 S001-FROM-FED-8. DTSBX403 +00689 SET L001-FROM-FED-8 TO TRUE. DTSBX403 +00690 GO TO S001-DATE. DTSBX403 +00691 DTSBX403 +00692 S001-DATE. DTSBX403 +00693 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX403 +00694 S001-EXIT. DTSBX403 +00695 EXIT. DTSBX403 +00696 DTSBX403 +00697 S005-DATE. DTSBX403 +00698 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX403 +00699 S005-EXIT. DTSBX403 +00700 EXIT. DTSBX403 +00701 DTSBX403 +00702 S062-LOOKUP-FLD-REP. DTSBX403 +00703 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBX403 +00704 S062-EXIT. DTSBX403 +00705 EXIT. DTSBX403 +00706 DTSBX403 +00707 S910-OPEN-READ. DTSBX403 +00708 SET L910-OPEN-READ-88 TO TRUE. DTSBX403 +00709 GO TO S910-MSTR-IO. DTSBX403 +00710 DTSBX403 +00711 S910-READ. DTSBX403 +00712 SET L910-READ-88 TO TRUE. DTSBX403 +00713 GO TO S910-MSTR-IO. DTSBX403 +00714 DTSBX403 +00715 S910-START-BROWSE. DTSBX403 +00716 SET L910-START-BROWSE-88 TO TRUE. DTSBX403 +00717 GO TO S910-MSTR-IO. DTSBX403 +00718 DTSBX403 +00719 S910-READ-NEXT. DTSBX403 +00720 SET L910-READ-NEXT-88 TO TRUE. DTSBX403 +00721 GO TO S910-MSTR-IO. DTSBX403 +00722 DTSBX403 +00723 S910-CLOSE. DTSBX403 +00724 SET L910-CLOSE-88 TO TRUE. DTSBX403 +00725 GO TO S910-MSTR-IO. DTSBX403 +00726 DTSBX403 +00727 S910-MSTR-IO. DTSBX403 +00728 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX403 +00729 MSKL-REC. DTSBX403 +00730 S910-EXIT. DTSBX403 +00731 EXIT. DTSBX403 +00732 DTSBX403 +00733 S941-OPEN. DTSBX403 +00734 SET L941-OPEN-READ-88 TO TRUE. DTSBX403 +00735 GO TO S941-I. DTSBX403 +00736 DTSBX403 +00737 S941-READ-NEXT. DTSBX403 +00738 SET L941-READ-NEXT-88 TO TRUE. DTSBX403 +00739 GO TO S941-I. DTSBX403 +00740 DTSBX403 +00741 S941-CLOSE. DTSBX403 +00742 SET L941-CLOSE-88 TO TRUE. DTSBX403 +00743 GO TO S941-I. DTSBX403 +00744 DTSBX403 +00745 S941-I. DTSBX403 +00746 CALL 'DTSBU941' USING L941-LINK-AREA, DTSBX403 +00747 RSK3-REC. DTSBX403 +00748 S941-EXIT. DTSBX403 +00749 EXIT. DTSBX403 +00750 DTSBX403 +00751 S999-ABEND. DTSBX403 +00752 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX403 +00753 SKIP2 DTSBX403 +00754 S999-EXIT. DTSBX403 +00755 EXIT. DTSBX403 +00756 DTSBX403 +00757 T0000-TERMINATE. DTSBX403 +00758 DTSBX403 +00759 DISPLAY ' '. DTSBX403 +00760 DISPLAY 'TOTAL R403 RECORDS READ = ' W-LEIN-403-IN-CNT. CL*24 +00761 DTSBX403 +00762 DISPLAY 'TOTAL R405 RECORDS READ = ' W-LEIN-405-IN-CNT. CL*24 +00763 DTSBX403 +00764 DISPLAY 'TOTAL R403 RECORDS WRITTEN ' W-LEIN-403-OUT-CNT. CL*29 +00765 DTSBX403 +00766 DISPLAY 'TOTAL R405 RECORDS WRITTEN ' W-LEIN-405-OUT-CNT CL*29 +00767 PERFORM S910-CLOSE THRU S910-EXIT. CL*79 +00768 PERFORM S941-CLOSE THRU S941-EXIT. DTSBX403 +00769 CL*18 +00770 CLOSE DTS-LN-OUT1 CL*30 +00771 DTS-LN-OUT2. CL*30 +00772 CL*30 +00773 CL*18 +00774 T0000-EXIT. DTSBX403 +00775 EXIT. DTSBX403 +00776 DTSBX403 diff --git a/Batch/DTSBX417.cob b/Batch/DTSBX417.cob new file mode 100644 index 0000000..b4506f3 --- /dev/null +++ b/Batch/DTSBX417.cob @@ -0,0 +1,2146 @@ +00001 IDENTIFICATION DIVISION. 05/23/19 +00002 PROGRAM-ID. DTSBX417. DTSBX417 +00003 AUTHOR. NGC. LV077 +00004 DATE-WRITTEN. APRIL 2005. DTSBX417 +00005 DATE-COMPILED. DTSBX417 +00006 SKIP3 DTSBX417 +00007 ***** DTSBX417 +00008 * DTSBX417 +00009 * FUNCTION: WEB REGISTRATION IMPORT DRIVER DTSBX417 +00010 * READ DATA PASSED FROM WEB APPLICATION SERVER DTSBX417 +00011 * AND CALL THE APPROPRIATE PROCESSING PROGRAM DTSBX417 +00012 * FOR REGISTRATIONS, REPORTS, PAYMENTS OR DTSBX417 +00013 * PROFILE UPDATES. DTSBX417 +00014 * DTSBX417 +00015 * ACCOUNTING BATCH HEADERS, REPORTS AND PAYMENTS DTSBX417 +00016 * COMING FROM THE IN-HOUSE CASHIERING PROCESS ARE DTSBX417 +00017 * PROCESSED LAST. IN THE SORT KEY, THE FIRST DTSBX417 +00018 * ELEMENT (USED FOR THE EMPLOYER NUMBER FOR OTHER DTSBX417 +00019 * PROCESSES) IS SET TO 999999. DTSBX417 +00020 * DTSBX417 +00021 * MODIFICATION HISTORY: DTSBX417 +00022 * DTSBX417 +00023 * 07-23-2007 INITIAL DEVELOPMENT DTSBX417 +00024 * REFERENCE RFP: WEB REPORTING DTSBX417 +00025 * DTSBX417 +00026 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSBX417 +00027 * THE NEW RECORD INCLUDES EMPLOYEE NAME. DTSBX417 +00028 * REFERENCE RFP: WEB REPORTING DTSBX417 +00029 * DTSBX417 +00030 * 05-28-2010 MODIFIED FOR IN-HOUSE CHECK-SCANNING AND DTSBX417 +00031 * CASHIERING PROCESS. DTSBX417 +00032 * REFERENCE RFP: GD DTSBX417 +00033 * DTSBX417 +00034 * CL*23 +00035 * 10-22-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00036 * CHANGED SORT SEQUENCE FOR PROCESS X104 RECORDS CL*23 +00037 * BEFORE PROCESSING NAMES X106. CL*23 +00038 * RECORDS 102 AND 106 MUST BE PRESENT TO ADD A CL*23 +00039 * NEW EMPLOYER TO DUTAS. IF X102 AND X104 PASS CL*23 +00040 * ALL EDITS THEN NAME RECORD X106 RATE X108 AND CL*23 +00041 * ADDRESS X110 MUST BE PRESENT FOR EMPLOYER TO ADD CL*23 +00042 * CL*23 +00043 * REFERENCE RFP: ZL1 CL*23 +00044 * CL*23 +00045 * DTSBX417 +00046 * 11-01-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00047 * MODIFIED PROGRAM TO CALL A NEW PROGRAM BX430 TO CL*23 +00048 * PROCESS REPORTS,WAGES AND PAYMENTS. CL*23 +00049 * REPORTS X140 COMING FROM ESSP CANNOT BE PROCESSED CL*23 +00050 * UNTIL A PAYMENT X145 IS PRESENT UNLESS IT IS A CL*23 +00051 * ZERO WAGE REPORT (REMIT AMT = 0). ALSO CHANGED CL*23 +00052 * THE SORT SEQ TO SORT PAYMENT X145 BEFORE X140 CL*23 +00053 * PREVIOUS SORT KEY WAS 30 NOW 19. CL*23 +00054 * REFERENCE RFP: ZL1 CL*23 +00055 * CL*23 +00056 * CL*23 +00057 * 11-24-2014 MODIFIED FOR ESSP INTERFACE CL*40 +00058 * MODIFIED PROGRAM TO MOVE ESSP IMPORT RECORDS TYPE CL*40 +00059 * X120 TO A WORKING COPY OF DUTAS X120 CL*40 +00060 * FIELDS ON THE INPUT RECORD IS LARGER THAT DUTAS CL*40 +00061 * FIELDS. WITH NO PHARSING FIELD LENGTHS ARE CL*40 +00062 * THE EDITS TO FAILING. CL*40 +00063 * REFERENCE RFP: ESSP REGISTRTION ZL1 CL*40 +00064 * CL*40 +00065 * CL*40 +00066 ***** DTSBX417 +00067 SKIP3 DTSBX417 +00068 ENVIRONMENT DIVISION. DTSBX417 +00069 SKIP2 DTSBX417 +00070 INPUT-OUTPUT SECTION. DTSBX417 +00071 DTSBX417 +00072 FILE-CONTROL. DTSBX417 +00073 DTSBX417 +00074 SELECT WEB-IMP-FILE ASSIGN TO WEBREG DTSBX417 +00075 FILE STATUS IS WEB-IMP-STATUS. DTSBX417 +00076 DTSBX417 +00077 ** SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBX417 +00078 ** FILE STATUS IS BATCH-STATUS. DTSBX417 +00079 DTSBX417 +00080 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSBX417 +00081 DTSBX417 +00082 DATA DIVISION. DTSBX417 +00083 DTSBX417 +00084 FILE SECTION. DTSBX417 +00085 DTSBX417 +00086 FD WEB-IMP-FILE DTSBX417 +00087 RECORDING MODE IS F DTSBX417 +00088 BLOCK CONTAINS 0 RECORDS DTSBX417 +00089 LABEL RECORDS ARE OMITTED. DTSBX417 +00090 DTSBX417 +00091 01 WEB-IMP-REC. DTSBX417 +00092 05 WEB-IMP-TYPE PIC X(03). DTSBX417 +00093 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. DTSBX417 +00094 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. DTSBX417 +00095 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. DTSBX417 +00096 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. DTSBX417 +00097 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. DTSBX417 +00098 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. DTSBX417 +00099 88 WEB-IMP-TYPE-REL-88 VALUE '130'. DTSBX417 +00100 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. DTSBX417 +00101 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. DTSBX417 +00102 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. DTSBX417 +00103 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. DTSBX417 +00104 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. DTSBX417 +00105 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' DTSBX417 +00106 '108' '130' '132'. DTSBX417 +00107 88 WEB-TYPE-RPT-88 VALUE '140' '144'. DTSBX417 +00108 88 WEB-TYPE-PAY-88 VALUE '145'. DTSBX417 +00109 88 WEB-TYPE-PRF-88 VALUE '110' '120'. DTSBX417 +00110 05 FILLER PIC X(01). DTSBX417 +00111 05 WEB-IMP-EMP-NO PIC 9(06). DTSBX417 +00112 05 FILLER PIC X(01). DTSBX417 +00113 05 WEB-IMP-QTR PIC X(06). DTSBX417 +00114 05 FILLER PIC X(495). DTSBX417 +00115 DTSBX417 +00116 *FD CURR-BATCH-NO DTSBX417 +00117 * RECORDING MODE IS F DTSBX417 +00118 * BLOCK CONTAINS 0 RECORDS DTSBX417 +00119 * LABEL RECORDS ARE OMITTED. DTSBX417 +00120 * DTSBX417 +00121 *01 CURR-BATCH-NO-REC. DTSBX417 +00122 * 05 CURRENT-BATCH-NO PIC 9(05). DTSBX417 +00123 * 05 CURRENT-ITEM-NO PIC 9(03). DTSBX417 +00124 * 05 FILLER PIC X(01). DTSBX417 +00125 * 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBX417 +00126 * 05 FILLER PIC X(01). DTSBX417 +00127 * 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBX417 +00128 * 05 FILLER PIC X(62). DTSBX417 +00129 DTSBX417 +00130 SD SORT-FILE. DTSBX417 +00131 DTSBX417 +00132 01 SORT-REC. DTSBX417 +00133 05 SORT-KEY. DTSBX417 +00134 10 SORT-EMP-NO PIC 9(06). DTSBX417 +00135 10 SORT-SEQ2 PIC X(16). DTSBX417 +00136 10 SORT-SEQ1 PIC S9(04) COMP. CL*60 +00137 05 RPT-PAY-SORT-KEY REDEFINES SORT-KEY. CL*57 +00138 10 SORT-PAY-EMP-NO PIC 9(06). CL*57 +00139 10 SORT-PAY-QTR PIC X(06). CL*57 +00140 10 SORT-FILLER PIC X(10). DTSBX417 +00141 10 SORT-PAY-SEQ1 PIC S9(04) COMP. CL*60 +00142 05 IN-HOUSE-SORT-KEY REDEFINES SORT-KEY. CL*57 +00143 10 SORT-IN-HOUSE-SEQ PIC 9(06). CL*57 +00144 10 SORT-BATCH PIC 9(05). CL*57 +00145 10 SORT-ITEM PIC 9(03). CL*57 +00146 10 SORT-FILLER PIC X(10). CL*57 +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 +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 +00153 01 WRK-AREA. DTSBX417 +00154 05 W-ABEND-CD PIC S9(04) COMP VALUE 420. DTSBX417 +00155 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX420'.DTSBX417 +00156 DTSBX417 +00157 05 WEB-IMP-STATUS PIC X(02). DTSBX417 +00158 88 WEB-IMP-STATUS-OK-88 VALUE '00'. DTSBX417 +00159 88 WEB-IMP-STATUS-EOF-88 VALUE '10'. DTSBX417 +00160 DTSBX417 +00161 ** 05 BATCH-STATUS PIC X(02). DTSBX417 +00162 * 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX417 +00163 ** 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX417 +00164 DTSBX417 +00165 05 SORT-EOF-IND PIC X(01). DTSBX417 +00166 88 SORT-OK-88 VALUE '0'. DTSBX417 +00167 88 SORT-EOF-88 VALUE '1'. DTSBX417 +00168 DTSBX417 +00169 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX417 +00170 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX417 +00171 88 W-ERROR-NO-88 VALUE 'N'. DTSBX417 +00172 DTSBX417 +00173 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX417 +00174 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX417 +00175 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX417 +00176 DTSBX417 +00177 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX417 +00178 05 W-PAY-QTR PIC X(06) VALUE SPACES. CL*57 +00179 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX417 +00180 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX417 +00181 05 W-LAST-RATE-YEAR PIC 9(04). DTSBX417 +00182 05 W-CURR-QTR PIC X(06) VALUE SPACES. CL*70 +00183 05 X102-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00184 DTSBX417 +00185 05 SUB PIC S9(04) COMP. DTSBX417 +00186 ** 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX417 +00187 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX417 +00188 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX417 +00189 ** 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX417 +00190 DTSBX417 +00191 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX417 +00192 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX417 +00193 DTSBX417 +00194 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX417 +00195 DTSBX417 +00196 05 W-500-DATE. DTSBX417 +00197 10 W-500-DATE-MM PIC XX. DTSBX417 +00198 10 FILLER PIC X. DTSBX417 +00199 10 W-500-DATE-DD PIC XX. DTSBX417 +00200 10 FILLER PIC X. DTSBX417 +00201 10 W-500-DATE-YY PIC XXXX. DTSBX417 +00202 DTSBX417 +00203 05 W-500-FQTR. DTSBX417 +00204 10 W-500-FQTR-YY PIC XXXX. DTSBX417 +00205 10 FILLER PIC X VALUE '/'. DTSBX417 +00206 10 W-500-FQTR-NO PIC X. DTSBX417 +00207 DTSBX417 +00208 05 W-INT-9 PIC 9(13). DTSBX417 +00209 05 W-INT-X REDEFINES W-INT-9 DTSBX417 +00210 PIC X(13). DTSBX417 +00211 05 W-INTEGER PIC S9(11) COMP-3. DTSBX417 +00212 05 W-FRACTION PIC SV9(11) COMP-3. DTSBX417 +00213 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBX417 +00214 DTSBX417 +00215 ** 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSBX417 +00216 * VALUE +0. DTSBX417 +00217 * 05 W-DIGIT PIC 9. DTSBX417 +00218 * 05 W-AMT PIC S9(09)V99 COMP-3 DTSBX417 +00219 * VALUE +0. DTSBX417 +00220 * DTSBX417 +00221 * 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX417 +00222 * 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX417 +00223 * 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX417 +00224 * DTSBX417 +00225 * 05 W-WAGES PIC S9(11)V99. DTSBX417 +00226 * 05 W-WAGES-X PIC X(14). DTSBX417 +00227 * 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX417 +00228 * PIC 9(11).99. DTSBX417 +00229 * 05 W-REMIT-X PIC X(12). DTSBX417 +00230 * 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX417 +00231 * PIC 9(09).99. DTSBX417 +00232 05 W-TRACE-X. DTSBX417 +00233 10 W-TRACE-A PIC X(05) VALUE '00000'. DTSBX417 +00234 10 W-TRACE-B PIC X(08) VALUE ZEROS. DTSBX417 +00235 05 W-TRACE-9 REDEFINES W-TRACE-X DTSBX417 +00236 PIC 9(13). DTSBX417 +00237 * 05 W-COUNT-X PIC X(07). DTSBX417 +00238 * 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX417 +00239 * PIC 9(07). DTSBX417 +00240 * 05 W-EARNINGS-X PIC X(12). DTSBX417 +00241 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX417 +00242 * PIC 9(09).99. DTSBX417 +00243 * 05 W-EARNINGS PIC S9(07)V99. DTSBX417 +00244 * 05 W-RATE PIC S9V9(04). DTSBX417 +00245 * 05 W-RATE-X PIC X(06). DTSBX417 +00246 * 05 W-RATE-9 REDEFINES W-RATE-X DTSBX417 +00247 * PIC 9.9999. DTSBX417 +00248 * DTSBX417 +00249 * 05 ISUB1 PIC S9(04) COMP. DTSBX417 +00250 * 05 ISUB2 PIC S9(04) COMP. DTSBX417 +00251 * 05 ISUB3 PIC S9(04) COMP. DTSBX417 +00252 * 05 ISUB4 PIC S9(04) COMP. DTSBX417 +00253 * 05 ISUB5 PIC S9(04) COMP. DTSBX417 +00254 * 05 ISUB6 PIC S9(04) COMP. DTSBX417 +00255 * 05 W-SLASH1 PIC S9(04) COMP. DTSBX417 +00256 * 05 W-SLASH2 PIC S9(04) COMP. DTSBX417 +00257 * 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX417 +00258 * 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX417 +00259 * 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX417 +00260 * 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX417 +00261 * VALUE +502. DTSBX417 +00262 * 05 W-INPUT-LINE PIC X(500). DTSBX417 +00263 * 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX417 +00264 * 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX417 +00265 * 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX417 +00266 * 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX417 +00267 * 05 W-CONV-LINE PIC X(32). DTSBX417 +00268 * DTSBX417 +00269 * 05 W-MDY PIC X(04). DTSBX417 +00270 * 05 FILLER REDEFINES W-MDY. DTSBX417 +00271 * 10 FILLER PIC X(02). DTSBX417 +00272 * 10 W-MDY-X-2 PIC X(02). DTSBX417 +00273 * 10 FILLER REDEFINES W-MDY-X-2. DTSBX417 +00274 * 15 FILLER PIC X(01). DTSBX417 +00275 ** 15 W-MDY-X-1 PIC X(01). DTSBX417 +00276 DTSBX417 +00277 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX417 +00278 05 W-102-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00279 05 W-104-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00280 05 W-106-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00281 05 W-108-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00282 05 W-110-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00283 05 W-120-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00284 05 W-140-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00285 05 W-144-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00286 05 W-145-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00287 DTSBX417 +00288 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX417 +00289 DTSBX417 +00290 05 W-AMT-DISP1 PIC ----------9.99. DTSBX417 +00291 05 W-AMT-DISP2 PIC ----------9.99. DTSBX417 +00292 05 W-AMT-DISP4 PIC -.99999999999. DTSBX417 +00293 05 W-AMT-DISP3 PIC ------------9. DTSBX417 +00294 DTSBX417 +00295 * PROFILE DTSBX417 +00296 01 X102-REC. DTSBX417 +00297 ++INCLUDE DTSIX102 DTSBX417 +00298 DTSBX417 +00299 * DETERMINATION DTSBX417 +00300 01 X104-REC. DTSBX417 +00301 ++INCLUDE DTSIX104 DTSBX417 +00302 DTSBX417 +00303 * NAME DTSBX417 +00304 01 X106-REC. DTSBX417 +00305 ++INCLUDE DTSIX106 DTSBX417 +00306 DTSBX417 +00307 * RATE DTSBX417 +00308 01 X108-REC. DTSBX417 +00309 ++INCLUDE DTSIX108 DTSBX417 +00310 DTSBX417 +00311 * ADDRESS DTSBX417 +00312 01 X110-REC. DTSBX417 +00313 ++INCLUDE DTSIX110 DTSBX417 +00314 DTSBX417 +00315 * OPO DTSBX417 +00316 01 X120-REC. DTSBX417 +00317 ++INCLUDE DTSIX120 DTSBX417 +00318 DTSBX417 +00319 * WORKING COPY OF X120 CL*41 +00320 01 W120-REC. CL*41 +00321 ++INCLUDE DTSWX120 CL*43 +00322 CL*41 +00323 * RELATIONSHIP DTSBX417 +00324 01 X130-REC. DTSBX417 +00325 ++INCLUDE DTSIX130 DTSBX417 +00326 DTSBX417 +00327 ** INDUSTRY DESCRIPTION DTSBX417 +00328 *01 X132-REC. DTSBX417 +00329 ***INCLUDE DTSIX132 DTSBX417 +00330 DTSBX417 +00331 * REPORT DTSBX417 +00332 01 X140-REC. DTSBX417 +00333 ++INCLUDE DTSIX140 DTSBX417 +00334 DTSBX417 +00335 * EMPLOYEE WAGES DTSBX417 +00336 01 X144-REC. DTSBX417 +00337 ++INCLUDE DTSIX144 DTSBX417 +00338 DTSBX417 +00339 * EMPLOYEE WAGES-WORK COPY CL*50 +00340 01 W144-REC. CL*50 +00341 ++INCLUDE DTSIW144 CL*50 +00342 CL*50 +00343 * PAYMENT DTSBX417 +00344 01 X145-REC. DTSBX417 +00345 ++INCLUDE DTSIX145 DTSBX417 +00346 DTSBX417 +00347 01 X149-REC. DTSBX417 +00348 ++INCLUDE DTSIX149 DTSBX417 +00349 DTSBX417 +00350 01 L001-LINK-AREA. DTSBX417 +00351 ++INCLUDE DTSIL001 DTSBX417 +00352 DTSBX417 +00353 01 L003-LINK-AREA. DTSBX417 +00354 ++INCLUDE DTSIL003 DTSBX417 +00355 DTSBX417 +00356 01 L004-LINK-AREA. DTSBX417 +00357 ++INCLUDE DTSIL004 DTSBX417 +00358 DTSBX417 +00359 01 L005-LINK-AREA. DTSBX417 +00360 ++INCLUDE DTSIL005 DTSBX417 +00361 DTSBX417 +00362 01 L205-LINK-AREA. DTSBX417 +00363 ++INCLUDE DTSIL205 DTSBX417 +00364 DTSBX417 +00365 01 LX42-LINK-AREA. DTSBX417 +00366 ++INCLUDE DTSILX42 CL*39 +00367 DTSBX417 +00368 01 L910-LINK-AREA. DTSBX417 +00369 ++INCLUDE DTSIL910 DTSBX417 +00370 01 MSKL-REC. DTSBX417 +00371 ++INCLUDE DTSIMSKL DTSBX417 +00372 DTSBX417 +00373 01 MHDR-REC. DTSBX417 +00374 ++INCLUDE DTSIMHDR DTSBX417 +00375 DTSBX417 +00376 01 MPRF-REC. DTSBX417 +00377 ++INCLUDE DTSIMPRF DTSBX417 +00378 DTSBX417 +00379 01 MSOL-REC. DTSBX417 +00380 ++INCLUDE DTSIMSOL DTSBX417 +00381 DTSBX417 +00382 01 MQTR-REC. DTSBX417 +00383 ++INCLUDE DTSIMQTR DTSBX417 +00384 DTSBX417 +00385 01 MOPO-REC. DTSBX417 +00386 ++INCLUDE DTSIMOPO DTSBX417 +00387 DTSBX417 +00388 01 MTAD-REC. DTSBX417 +00389 ++INCLUDE DTSIMTAD DTSBX417 +00390 DTSBX417 +00391 01 MNTE-REC. DTSBX417 +00392 ++INCLUDE DTSIMNTE DTSBX417 +00393 DTSBX417 +00394 01 L921-LINK-AREA. DTSBX417 +00395 ++INCLUDE DTSIL921 DTSBX417 +00396 SKIP3 DTSBX417 +00397 01 ISKL-REC. DTSBX417 +00398 ++INCLUDE DTSIISKL DTSBX417 +00399 SKIP3 DTSBX417 +00400 01 IEIN-REC. DTSBX417 +00401 ++INCLUDE DTSIIEIN DTSBX417 +00402 DTSBX417 +00403 01 L923-LINK-AREA. DTSBX417 +00404 ++INCLUDE DTSIL923 DTSBX417 +00405 EJECT DTSBX417 +00406 01 ASKL-REC. DTSBX417 +00407 ++INCLUDE DTSIASKL DTSBX417 +00408 EJECT DTSBX417 +00409 01 AHDR-REC. DTSBX417 +00410 ++INCLUDE DTSIAHDR DTSBX417 +00411 DTSBX417 +00412 01 ARPT-REC. DTSBX417 +00413 ++INCLUDE DTSIARPT DTSBX417 +00414 DTSBX417 +00415 01 APAY-REC. DTSBX417 +00416 ++INCLUDE DTSIAPAY DTSBX417 +00417 DTSBX417 +00418 DTSBX417 +00419 01 L927-LINK-AREA. DTSBX417 +00420 ++INCLUDE DTSIL927 DTSBX417 +00421 DTSBX417 +00422 01 TSKL-REC. DTSBX417 +00423 ++INCLUDE DTSITSKL DTSBX417 +00424 DTSBX417 +00425 01 L931-LINK-AREA. DTSBX417 +00426 ++INCLUDE DTSIL931 DTSBX417 +00427 DTSBX417 +00428 01 FSKL-REC. DTSBX417 +00429 ++INCLUDE DTSIFSKL DTSBX417 +00430 DTSBX417 +00431 PROCEDURE DIVISION. DTSBX417 +00432 DTSBX417 +00433 DTSBX420-MAIN. DTSBX417 +00434 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX417 +00435 IF W-FATAL-ERROR-YES-88 DTSBX417 +00436 GO TO DTSBX420-MAIN-EXIT DTSBX417 +00437 END-IF. DTSBX417 +00438 DTSBX417 +00439 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX417 +00440 DTSBX417 +00441 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX417 +00442 IF W-ERROR-YES-88 DTSBX417 +00443 MOVE +2 TO RETURN-CODE. DTSBX417 +00444 DTSBX420-MAIN-EXIT. DTSBX417 +00445 GOBACK. DTSBX417 +00446 EJECT DTSBX417 +00447 I0000-INITIATE. DTSBX417 +00448 SET W-ERROR-NO-88 TO TRUE. DTSBX417 +00449 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX417 +00450 DTSBX417 +00451 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX417 +00452 DTSBX417 +00453 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX417 +00454 IF W-FATAL-ERROR-YES-88 DTSBX417 +00455 GO TO I0000-EXIT DTSBX417 +00456 END-IF. DTSBX417 +00457 DTSBX417 +00458 PERFORM I3000-READ-HEADER THRU I3000-EXIT. DTSBX417 +00459 IF W-FATAL-ERROR-YES-88 DTSBX417 +00460 GO TO I0000-EXIT DTSBX417 +00461 END-IF. DTSBX417 +00462 DTSBX417 +00463 ** PERFORM I4000-CURRENT-BATCH THRU I4000-EXIT DTSBX417 +00464 * IF W-FATAL-ERROR-YES-88 DTSBX417 +00465 * GO TO I0000-EXIT DTSBX417 +00466 ** END-IF. DTSBX417 +00467 DTSBX417 +00468 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSBX417 +00469 DTSBX417 +00470 I0000-EXIT. DTSBX417 +00471 EXIT. DTSBX417 +00472 DTSBX417 +00473 I2000-OPEN-FILES. DTSBX417 +00474 OPEN INPUT WEB-IMP-FILE. DTSBX417 +00475 IF NOT WEB-IMP-STATUS-OK-88 DTSBX417 +00476 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX417 +00477 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX417 +00478 MOVE +3 TO RETURN-CODE DTSBX417 +00479 SET W-ERROR-YES-88 TO TRUE DTSBX417 +00480 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX417 +00481 WEB-IMP-STATUS DTSBX417 +00482 GO TO I2000-EXIT DTSBX417 +00483 END-IF. DTSBX417 +00484 DTSBX417 +00485 READ WEB-IMP-FILE. DTSBX417 +00486 IF NOT WEB-IMP-STATUS-OK-88 DTSBX417 +00487 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX417 +00488 DISPLAY 'NO ESSP FTP UPDATE FILES TO PROCESS' DTSBX417 +00489 MOVE +3 TO RETURN-CODE DTSBX417 +00490 SET W-ERROR-YES-88 TO TRUE DTSBX417 +00491 DISPLAY 'NO RECORDS ON WEB-IMP-FILE ' DTSBX417 +00492 WEB-IMP-STATUS DTSBX417 +00493 GO TO I2000-EXIT DTSBX417 +00494 END-IF. DTSBX417 +00495 CLOSE WEB-IMP-FILE. DTSBX417 +00496 OPEN INPUT WEB-IMP-FILE. DTSBX417 +00497 IF NOT WEB-IMP-STATUS-OK-88 DTSBX417 +00498 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX417 +00499 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX417 +00500 MOVE +3 TO RETURN-CODE DTSBX417 +00501 SET W-ERROR-YES-88 TO TRUE DTSBX417 +00502 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX417 +00503 WEB-IMP-STATUS DTSBX417 +00504 GO TO I2000-EXIT DTSBX417 +00505 END-IF. DTSBX417 +00506 DTSBX417 +00507 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX417 +00508 DTSBX417 +00509 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX417 +00510 DTSBX417 +00511 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBX417 +00512 DTSBX417 +00513 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX417 +00514 DTSBX417 +00515 * MOVE 'N' TO L927-TRACE-IND. CL*44 +00516 * MOVE W-MOD-NAME TO L927-MOD-NAME. CL*44 +00517 * PERFORM S927A-OPEN THRU S927A-EXIT. CL*44 +00518 DTSBX417 +00519 I2000-EXIT. DTSBX417 +00520 EXIT. DTSBX417 +00521 DTSBX417 +00522 I3000-READ-HEADER. DTSBX417 +00523 MOVE LOW-VALUES TO MSKL-REC. CL*74 +00524 MOVE +0 TO MSKL-EMP-NO. CL*74 +00525 SET MSKL-HDR-88 TO TRUE. CL*74 +00526 DTSBX417 +00527 PERFORM S910-READ THRU S910-EXIT. CL*74 +00528 IF L910-NO-REC-88 CL*74 +00529 DISPLAY 'DTSBX420: MHDR RECORD IS MISSING' DTSBX417 +00530 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX417 +00531 MOVE +6 TO RETURN-CODE DTSBX417 +00532 GO TO I3000-EXIT DTSBX417 +00533 ELSE CL*74 +00534 MOVE MSKL-REC TO MHDR-REC DTSBX417 +00535 END-IF. CL*74 +00536 DTSBX417 +00537 MOVE MHDR-CURR-RUN-DATE TO W-CURR-RUN-DATE. CL*74 +00538 DTSBX417 +00539 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. CL*74 +00540 MOVE L004-QTR-5-YR TO W-LAST-RATE-YEAR. CL*74 +00541 DISPLAY 'LAST RATE YEAR ' W-LAST-RATE-YEAR. CL*74 +00542 CL*69 +00543 MOVE MHDR-LAST-UC30-MASS-MAIL-YRQ TO L004-QTR-5-9. CL*77 +00544 CL*72 +00545 PERFORM S004-FROM-5 THRU S004-EXIT. CL*74 +00546 CL*72 +00547 MOVE L004-SLASH-5-QTR TO W-CURR-QTR. CL*74 +00548 DISPLAY 'CURRENT QTR: ' W-CURR-QTR. CL*74 +00549 DTSBX417 +00550 I3000-EXIT. DTSBX417 +00551 EXIT. DTSBX417 +00552 DTSBX417 +00553 *I4000-CURRENT-BATCH. DTSBX417 +00554 * OPEN I-O CURR-BATCH-NO. DTSBX417 +00555 * IF NOT BATCH-STATUS-OK-88 DTSBX417 +00556 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX417 +00557 * DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBX417 +00558 * BATCH-STATUS DTSBX417 +00559 * GO TO I4000-EXIT DTSBX417 +00560 * END-IF. DTSBX417 +00561 * DTSBX417 +00562 * READ CURR-BATCH-NO DTSBX417 +00563 * IF BATCH-STATUS-OK-88 DTSBX417 +00564 * DISPLAY 'OLD BATCH ' CURRENT-BATCH-NO DTSBX417 +00565 * COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBX417 +00566 * MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBX417 +00567 * MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBX417 +00568 * DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBX417 +00569 * DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBX417 +00570 * ELSE DTSBX417 +00571 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX417 +00572 * DISPLAY 'CANNOT READ CURR BATCH NUMBER FILE ' DTSBX417 +00573 * BATCH-STATUS DTSBX417 +00574 * GO TO I4000-EXIT DTSBX417 +00575 * END-IF. DTSBX417 +00576 * DTSBX417 +00577 *I4000-EXIT. DTSBX417 +00578 * EXIT. DTSBX417 +00579 DTSBX417 +00580 I5000-INITIAL-CALLS. DTSBX417 +00581 DISPLAY '!!!!! BX420- INITILIZE RECORDS START BX420' CL*12 +00582 SET LX42-INITIALIZE-88 TO TRUE. DTSBX417 +00583 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSBX417 +00584 MOVE L005-DATE TO LX42-SYS-DATE. DTSBX417 +00585 MOVE L005-TIME TO LX42-SYS-TIME. DTSBX417 +00586 MOVE W-CURR-QTR TO LX42-CURR-QTR CL*69 +00587 MOVE ZERO TO LX42-PSEUDO-BATCH-NO CL*69 +00588 LX42-LAST-DETERM-EMP DTSBX417 +00589 LX42-RPT-CNT DTSBX417 +00590 LX42-RPT-REMIT-AMT DTSBX417 +00591 LX42-PAY-CNT DTSBX417 +00592 LX42-PAY-REMIT-AMT. DTSBX417 +00593 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX417 +00594 SET LX42-ERROR-NO-88 TO TRUE. DTSBX417 +00595 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +00596 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX417 +00597 DTSBX417 +00598 DISPLAY 'X42 CURR QTR: 'LX42-CURR-QTR CL*76 +00599 MOVE ZERO TO W-102-IMP-CNT CL*38 +00600 W-104-IMP-CNT CL*38 +00601 W-106-IMP-CNT CL*38 +00602 W-108-IMP-CNT CL*38 +00603 W-110-IMP-CNT CL*38 +00604 W-120-IMP-CNT CL*38 +00605 W-140-IMP-CNT CL*38 +00606 W-144-IMP-CNT CL*38 +00607 W-145-IMP-CNT. CL*38 +00608 ** PERFORM S421-REGISTRATION THRU S421-EXIT. CL*66 +00609 PERFORM S422-REPORT-WAGES THRU S422-EXIT. CL*63 +00610 PERFORM S423-PAYMENTS THRU S423-EXIT. CL*63 +00611 ** PERFORM S424-PROFILE THRU S424-EXIT. CL*66 +00612 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX417 +00613 DTSBX417 +00614 I5000-EXIT. DTSBX417 +00615 EXIT. DTSBX417 +00616 DTSBX417 +00617 DTSBX417 +00618 P0000-PROCESS. DTSBX417 +00619 DISPLAY '!!!! BX420- START WEB IMPORT PRELIMINARY EDIT'. CL*12 +00620 DISPLAY SPACE. DTSBX417 +00621 DTSBX417 +00622 SET W-ERROR-NO-88 TO TRUE. DTSBX417 +00623 DTSBX417 +00624 SORT SORT-FILE DTSBX417 +00625 ON ASCENDING KEY SORT-KEY DTSBX417 +00626 INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT DTSBX417 +00627 OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT. DTSBX417 +00628 DTSBX417 +00629 IF SORT-RETURN NOT = +0 DTSBX417 +00630 DISPLAY 'SORT FAILED ' SORT-RETURN DTSBX417 +00631 END-IF. DTSBX417 +00632 DTSBX417 +00633 P0000-EXIT. DTSBX417 +00634 EXIT. DTSBX417 +00635 DTSBX417 +00636 DTSBX417 +00637 P1000-PRE-SORT. DTSBX417 +00638 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT. DTSBX417 +00639 PERFORM UNTIL WEB-IMP-STATUS-EOF-88 DTSBX417 +00640 PERFORM P1100-PARSE-IMPORT-REC THRU P1100-EXIT DTSBX417 +00641 PERFORM P1200-BUILD-SORT-REC THRU P1200-EXIT DTSBX417 +00642 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT DTSBX417 +00643 END-PERFORM. DTSBX417 +00644 DTSBX417 +00645 DISPLAY '!!!!! BX420- ENDOF INPUT SORT PROCEDURE ****'. CL*12 +00646 P1000-EXIT. DTSBX417 +00647 EXIT. DTSBX417 +00648 DTSBX417 +00649 P1100-PARSE-IMPORT-REC. DTSBX417 +00650 IF WEB-IMP-TYPE-BHDR-88 DTSBX417 +00651 DISPLAY 'BX420 P1000 HDR ' WEB-IMP-REC(1:14) DTSBX417 +00652 END-IF. DTSBX417 +00653 CL*20 +00654 * DISPLAY 'P1000 ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*21 +00655 DTSBX417 +00656 PERFORM DTSBX417 +00657 VARYING SUB FROM +1 BY +1 DTSBX417 +00658 UNTIL SUB > +100 DTSBX417 +00659 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX417 +00660 L205-INTEGER (SUB) DTSBX417 +00661 L205-FRACTION (SUB) DTSBX417 +00662 MOVE SPACES TO L205-TEXT (SUB) DTSBX417 +00663 L205-DATE (SUB) DTSBX417 +00664 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX417 +00665 END-PERFORM. DTSBX417 +00666 DTSBX417 +00667 EVALUATE TRUE DTSBX417 +00668 WHEN WEB-IMP-TYPE-PRF-88 DTSBX417 +00669 PERFORM P1100A-PRF THRU P1100A-EXIT DTSBX417 +00670 DTSBX417 +00671 WHEN WEB-IMP-TYPE-DETERM-88 DTSBX417 +00672 PERFORM P1100B-DETERM THRU P1100B-EXIT DTSBX417 +00673 DTSBX417 +00674 WHEN WEB-IMP-TYPE-NAME-88 DTSBX417 +00675 PERFORM P1100C-NAME THRU P1100C-EXIT DTSBX417 +00676 DTSBX417 +00677 WHEN WEB-IMP-TYPE-RATE-88 DTSBX417 +00678 PERFORM P1100D-RATE THRU P1100D-EXIT DTSBX417 +00679 DTSBX417 +00680 WHEN WEB-IMP-TYPE-ADDR-88 DTSBX417 +00681 PERFORM P1100E-ADDR THRU P1100E-EXIT DTSBX417 +00682 DTSBX417 +00683 WHEN WEB-IMP-TYPE-OPO-88 DTSBX417 +00684 PERFORM P1100F-OPO THRU P1100F-EXIT DTSBX417 +00685 DTSBX417 +00686 WHEN WEB-IMP-TYPE-REL-88 DTSBX417 +00687 PERFORM P1100G-REL THRU P1100G-EXIT DTSBX417 +00688 DTSBX417 +00689 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX417 +00690 * PERFORM P1100X-IND THRU P1100X-EXIT DTSBX417 +00691 * INITIALIZE X132-REC DTSBX417 +00692 * MOVE +4 TO L205-LAST-FIELD DTSBX417 +00693 *** MOVE +500 TO L205-LAST-FIELD-LEN DTSBX417 +00694 DTSBX417 +00695 WHEN WEB-IMP-TYPE-RPT-88 DTSBX417 +00696 PERFORM P1100H-RPT THRU P1100H-EXIT DTSBX417 +00697 DTSBX417 +00698 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX417 +00699 PERFORM P1100I-WAGE THRU P1100I-EXIT DTSBX417 +00700 DTSBX417 +00701 WHEN WEB-IMP-TYPE-PAY-88 DTSBX417 +00702 PERFORM P1100J-PAY THRU P1100J-EXIT DTSBX417 +00703 DTSBX417 +00704 * WHEN WEB-IMP-TYPE-BHDR-88 DTSBX417 +00705 * PERFORM P1100K-BATCH-HEADER THRU P1100K-EXIT DTSBX417 +00706 DTSBX417 +00707 END-EVALUATE. DTSBX417 +00708 DTSBX417 +00709 MOVE WEB-IMP-REC TO L205-INPUT-DATA. DTSBX417 +00710 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBX417 +00711 DTSBX417 +00712 P1100-EXIT. DTSBX417 +00713 EXIT. DTSBX417 +00714 DTSBX417 +00715 P1100A-PRF. DTSBX417 +00716 INITIALIZE X102-REC DTSBX417 +00717 MOVE +7 TO L205-LAST-FIELD DTSBX417 +00718 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX417 +00719 DTSBX417 +00720 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +00721 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +00722 DTSBX417 +00723 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +00724 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +00725 DTSBX417 +00726 MOVE +9 TO L205-FIELD-LENGTH (3). DTSBX417 +00727 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +00728 DTSBX417 +00729 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX417 +00730 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +00731 DTSBX417 +00732 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX417 +00733 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX417 +00734 DTSBX417 +00735 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX417 +00736 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBX417 +00737 DTSBX417 +00738 MOVE +1 TO L205-FIELD-LENGTH (7). DTSBX417 +00739 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX417 +00740 DTSBX417 +00741 P1100A-EXIT. DTSBX417 +00742 EXIT. DTSBX417 +00743 DTSBX417 +00744 P1100B-DETERM. DTSBX417 +00745 INITIALIZE X104-REC DTSBX417 +00746 MOVE +18 TO L205-LAST-FIELD DTSBX417 +00747 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX417 +00748 DTSBX417 +00749 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +00750 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +00751 DTSBX417 +00752 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +00753 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +00754 DTSBX417 +00755 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX417 +00756 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +00757 DTSBX417 +00758 MOVE +2 TO L205-FIELD-LENGTH (4). DTSBX417 +00759 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX417 +00760 DTSBX417 +00761 MOVE +2 TO L205-FIELD-LENGTH (5). DTSBX417 +00762 SET L205-TYPE-NUMBER-88 (5) TO TRUE. DTSBX417 +00763 DTSBX417 +00764 MOVE +6 TO L205-FIELD-LENGTH (6). DTSBX417 +00765 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX417 +00766 DTSBX417 +00767 MOVE +3 TO L205-FIELD-LENGTH (7). DTSBX417 +00768 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX417 +00769 DTSBX417 +00770 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX417 +00771 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX417 +00772 DTSBX417 +00773 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX417 +00774 SET L205-TYPE-DATE-88 (9) TO TRUE. DTSBX417 +00775 DTSBX417 +00776 MOVE +1 TO L205-FIELD-LENGTH (10). DTSBX417 +00777 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX417 +00778 DTSBX417 +00779 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX417 +00780 SET L205-TYPE-DATE-88 (11) TO TRUE. DTSBX417 +00781 DTSBX417 +00782 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX417 +00783 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX417 +00784 DTSBX417 +00785 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX417 +00786 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX417 +00787 DTSBX417 +00788 MOVE +1 TO L205-FIELD-LENGTH (14). DTSBX417 +00789 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX417 +00790 DTSBX417 +00791 MOVE +1 TO L205-FIELD-LENGTH (15). DTSBX417 +00792 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX417 +00793 DTSBX417 +00794 MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX417 +00795 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX417 +00796 DTSBX417 +00797 MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX417 +00798 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX417 +00799 DTSBX417 +00800 MOVE +1 TO L205-FIELD-LENGTH (18). DTSBX417 +00801 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX417 +00802 DTSBX417 +00803 P1100B-EXIT. DTSBX417 +00804 EXIT. DTSBX417 +00805 DTSBX417 +00806 P1100C-NAME. DTSBX417 +00807 INITIALIZE X106-REC DTSBX417 +00808 MOVE +4 TO L205-LAST-FIELD DTSBX417 +00809 MOVE +40 TO L205-LAST-FIELD-LEN DTSBX417 +00810 DTSBX417 +00811 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +00812 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +00813 DTSBX417 +00814 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +00815 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +00816 DTSBX417 +00817 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX417 +00818 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +00819 DTSBX417 +00820 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX417 +00821 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +00822 DTSBX417 +00823 P1100C-EXIT. DTSBX417 +00824 EXIT. DTSBX417 +00825 DTSBX417 +00826 P1100D-RATE. DTSBX417 +00827 ** DISPLAY 'RATE P1100D ' WEB-IMP-REC (1:23). DTSBX417 +00828 DTSBX417 +00829 INITIALIZE X108-REC. DTSBX417 +00830 MOVE +4 TO L205-LAST-FIELD. DTSBX417 +00831 MOVE +6 TO L205-LAST-FIELD-LEN. DTSBX417 +00832 DTSBX417 +00833 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +00834 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +00835 DTSBX417 +00836 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +00837 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +00838 DTSBX417 +00839 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX417 +00840 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +00841 DTSBX417 +00842 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX417 +00843 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX417 +00844 DTSBX417 +00845 P1100D-EXIT. DTSBX417 +00846 EXIT. DTSBX417 +00847 DTSBX417 +00848 P1100E-ADDR. DTSBX417 +00849 INITIALIZE X110-REC. DTSBX417 +00850 MOVE +14 TO L205-LAST-FIELD. DTSBX417 +00851 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX417 +00852 DTSBX417 +00853 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +00854 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +00855 DTSBX417 +00856 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +00857 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +00858 DTSBX417 +00859 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX417 +00860 SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBX417 +00861 DTSBX417 +00862 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX417 +00863 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +00864 DTSBX417 +00865 MOVE +40 TO L205-FIELD-LENGTH (5). DTSBX417 +00866 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX417 +00867 DTSBX417 +00868 MOVE +40 TO L205-FIELD-LENGTH (6). DTSBX417 +00869 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX417 +00870 DTSBX417 +00871 MOVE +25 TO L205-FIELD-LENGTH (7). DTSBX417 +00872 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX417 +00873 DTSBX417 +00874 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX417 +00875 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX417 +00876 DTSBX417 +00877 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX417 +00878 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX417 +00879 DTSBX417 +00880 MOVE +15 TO L205-FIELD-LENGTH (10). DTSBX417 +00881 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX417 +00882 DTSBX417 +00883 MOVE +15 TO L205-FIELD-LENGTH (11). DTSBX417 +00884 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX417 +00885 DTSBX417 +00886 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX417 +00887 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX417 +00888 DTSBX417 +00889 MOVE +40 TO L205-FIELD-LENGTH (13). DTSBX417 +00890 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX417 +00891 DTSBX417 +00892 MOVE +40 TO L205-FIELD-LENGTH (14). DTSBX417 +00893 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX417 +00894 DTSBX417 +00895 P1100E-EXIT. DTSBX417 +00896 EXIT. DTSBX417 +00897 DTSBX417 +00898 P1100F-OPO. DTSBX417 +00899 INITIALIZE X120-REC. DTSBX417 +00900 MOVE +18 TO L205-LAST-FIELD. DTSBX417 +00901 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX417 +00902 DTSBX417 +00903 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +00904 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +00905 DTSBX417 +00906 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +00907 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +00908 DTSBX417 +00909 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX417 +00910 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +00911 DTSBX417 +00912 MOVE +40 TO L205-FIELD-LENGTH (4). CL*22 +00913 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +00914 DTSBX417 +00915 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX417 +00916 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX417 +00917 DTSBX417 +00918 MOVE +40 TO L205-FIELD-LENGTH (6). CL*22 +00919 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX417 +00920 DTSBX417 +00921 MOVE +40 TO L205-FIELD-LENGTH (7). DTSBX417 +00922 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX417 +00923 DTSBX417 +00924 MOVE +9 TO L205-FIELD-LENGTH (8). DTSBX417 +00925 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX417 +00926 DTSBX417 +00927 MOVE +40 TO L205-FIELD-LENGTH (9). DTSBX417 +00928 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX417 +00929 DTSBX417 +00930 MOVE +40 TO L205-FIELD-LENGTH (10). DTSBX417 +00931 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX417 +00932 DTSBX417 +00933 MOVE +40 TO L205-FIELD-LENGTH (11). DTSBX417 +00934 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX417 +00935 DTSBX417 +00936 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX417 +00937 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX417 +00938 DTSBX417 +00939 MOVE +25 TO L205-FIELD-LENGTH (13). DTSBX417 +00940 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX417 +00941 DTSBX417 +00942 MOVE +2 TO L205-FIELD-LENGTH (14). DTSBX417 +00943 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX417 +00944 DTSBX417 +00945 MOVE +10 TO L205-FIELD-LENGTH (15). DTSBX417 +00946 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX417 +00947 DTSBX417 +00948 MOVE +15 TO L205-FIELD-LENGTH (16). DTSBX417 +00949 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX417 +00950 DTSBX417 +00951 MOVE +16 TO L205-FIELD-LENGTH (17). CL*22 +00952 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX417 +00953 DTSBX417 +00954 MOVE +40 TO L205-FIELD-LENGTH (18). DTSBX417 +00955 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX417 +00956 DTSBX417 +00957 P1100F-EXIT. DTSBX417 +00958 EXIT. DTSBX417 +00959 DTSBX417 +00960 P1100G-REL. DTSBX417 +00961 INITIALIZE X130-REC. DTSBX417 +00962 MOVE +16 TO L205-LAST-FIELD. DTSBX417 +00963 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX417 +00964 DTSBX417 +00965 P1100G-EXIT. DTSBX417 +00966 EXIT. DTSBX417 +00967 DTSBX417 +00968 P1100H-RPT. DTSBX417 +00969 * DISPLAY 'P1100H-RPT ' WEB-IMP-REC(1:126). CL*23 +00970 INITIALIZE X140-REC. DTSBX417 +00971 MOVE +16 TO L205-LAST-FIELD. CL*24 +00972 MOVE +14 TO L205-LAST-FIELD-LEN. CL*27 +00973 DTSBX417 +00974 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +00975 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +00976 DTSBX417 +00977 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +00978 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +00979 DTSBX417 +00980 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX417 +00981 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +00982 DTSBX417 +00983 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX417 +00984 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +00985 DTSBX417 +00986 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX417 +00987 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX417 +00988 DTSBX417 +00989 MOVE +8 TO L205-FIELD-LENGTH (6). DTSBX417 +00990 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX417 +00991 DTSBX417 +00992 MOVE +14 TO L205-FIELD-LENGTH (7). DTSBX417 +00993 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBX417 +00994 DTSBX417 +00995 MOVE +14 TO L205-FIELD-LENGTH (8). DTSBX417 +00996 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX417 +00997 DTSBX417 +00998 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX417 +00999 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX417 +01000 DTSBX417 +01001 MOVE +04 TO L205-FIELD-LENGTH (10). DTSBX417 +01002 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX417 +01003 DTSBX417 +01004 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX417 +01005 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX417 +01006 DTSBX417 +01007 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX417 +01008 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*48 +01009 DTSBX417 +01010 MOVE +8 TO L205-FIELD-LENGTH (13). DTSBX417 +01011 SET L205-TYPE-TEXT-88 (13) TO TRUE. CL*48 +01012 DTSBX417 +01013 MOVE +8 TO L205-FIELD-LENGTH (14). DTSBX417 +01014 SET L205-TYPE-TEXT-88 (14) TO TRUE. CL*48 +01015 DTSBX417 +01016 MOVE +4 TO L205-FIELD-LENGTH (15). DTSBX417 +01017 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX417 +01018 DTSBX417 +01019 MOVE +14 TO L205-FIELD-LENGTH (16). CL*27 +01020 SET L205-TYPE-NUMBER-88 (16) TO TRUE. CL*26 +01021 CL*24 +01022 ** MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX417 +01023 ** SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX417 +01024 DTSBX417 +01025 ** MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX417 +01026 ** SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSBX417 +01027 DTSBX417 +01028 ** MOVE +3 TO L205-FIELD-LENGTH (18). DTSBX417 +01029 ** SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSBX417 +01030 DTSBX417 +01031 ** MOVE +8 TO L205-FIELD-LENGTH (19). DTSBX417 +01032 ** SET L205-TYPE-TEXT-88 (21) TO TRUE. DTSBX417 +01033 ** DISPLAY 'NANCY '. CL*31 +01034 P1100H-EXIT. DTSBX417 +01035 EXIT. DTSBX417 +01036 DTSBX417 +01037 P1100I-WAGE. DTSBX417 +01038 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*10 +01039 INITIALIZE X144-REC. DTSBX417 +01040 MOVE +10 TO L205-LAST-FIELD. DTSBX417 +01041 MOVE +14 TO L205-LAST-FIELD-LEN. DTSBX417 +01042 DTSBX417 +01043 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +01044 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +01045 DTSBX417 +01046 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +01047 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +01048 DTSBX417 +01049 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX417 +01050 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +01051 DTSBX417 +01052 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX417 +01053 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +01054 DTSBX417 +01055 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX417 +01056 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX417 +01057 DTSBX417 +01058 MOVE +9 TO L205-FIELD-LENGTH (6). DTSBX417 +01059 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX417 +01060 DTSBX417 +01061 MOVE +30 TO L205-FIELD-LENGTH (7). DTSBX417 +01062 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX417 +01063 DTSBX417 +01064 MOVE +30 TO L205-FIELD-LENGTH (8). DTSBX417 +01065 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX417 +01066 DTSBX417 +01067 MOVE +1 TO L205-FIELD-LENGTH (9). DTSBX417 +01068 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX417 +01069 DTSBX417 +01070 MOVE +14 TO L205-FIELD-LENGTH (10). DTSBX417 +01071 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX417 +01072 P1100I-EXIT. DTSBX417 +01073 EXIT. DTSBX417 +01074 DTSBX417 +01075 P1100J-PAY. DTSBX417 +01076 * DISPLAY 'P1100J-PAY ' WEB-IMP-REC(1:84). CL*10 +01077 INITIALIZE X145-REC. DTSBX417 +01078 MOVE +12 TO L205-LAST-FIELD. DTSBX417 +01079 MOVE +8 TO L205-LAST-FIELD-LEN. DTSBX417 +01080 DTSBX417 +01081 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +01082 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +01083 DTSBX417 +01084 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX417 +01085 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX417 +01086 DTSBX417 +01087 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBX417 +01088 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +01089 DTSBX417 +01090 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX417 +01091 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +01092 DTSBX417 +01093 MOVE +3 TO L205-FIELD-LENGTH (5). DTSBX417 +01094 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX417 +01095 DTSBX417 +01096 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX417 +01097 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX417 +01098 DTSBX417 +01099 MOVE +2 TO L205-FIELD-LENGTH (7). DTSBX417 +01100 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX417 +01101 DTSBX417 +01102 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX417 +01103 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX417 +01104 DTSBX417 +01105 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX417 +01106 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX417 +01107 DTSBX417 +01108 MOVE +10 TO L205-FIELD-LENGTH (10). DTSBX417 +01109 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX417 +01110 DTSBX417 +01111 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX417 +01112 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX417 +01113 DTSBX417 +01114 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX417 +01115 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX417 +01116 DTSBX417 +01117 DTSBX417 +01118 P1100J-EXIT. DTSBX417 +01119 EXIT. DTSBX417 +01120 DTSBX417 +01121 P1100K-BATCH-HEADER. DTSBX417 +01122 ** DISPLAY 'BX420 P1100K-HDR ' WEB-IMP-REC(1:84). DTSBX417 +01123 INITIALIZE X149-REC. DTSBX417 +01124 MOVE +13 TO L205-LAST-FIELD. DTSBX417 +01125 MOVE +1 TO L205-LAST-FIELD-LEN. DTSBX417 +01126 DTSBX417 +01127 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX417 +01128 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX417 +01129 DTSBX417 +01130 MOVE +5 TO L205-FIELD-LENGTH (2). DTSBX417 +01131 SET L205-TYPE-TEXT-88(2) TO TRUE. DTSBX417 +01132 DTSBX417 +01133 MOVE +3 TO L205-FIELD-LENGTH (3). DTSBX417 +01134 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX417 +01135 DTSBX417 +01136 MOVE +8 TO L205-FIELD-LENGTH (4). DTSBX417 +01137 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX417 +01138 DTSBX417 +01139 MOVE +10 TO L205-FIELD-LENGTH (5). DTSBX417 +01140 SET L205-TYPE-DATE-88 (5) TO TRUE. DTSBX417 +01141 DTSBX417 +01142 MOVE +10 TO L205-FIELD-LENGTH (6). DTSBX417 +01143 SET L205-TYPE-DATE-88 (6) TO TRUE. DTSBX417 +01144 DTSBX417 +01145 MOVE +10 TO L205-FIELD-LENGTH (7). DTSBX417 +01146 SET L205-TYPE-DATE-88 (7) TO TRUE. DTSBX417 +01147 DTSBX417 +01148 MOVE +3 TO L205-FIELD-LENGTH (8). DTSBX417 +01149 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX417 +01150 DTSBX417 +01151 MOVE +3 TO L205-FIELD-LENGTH (9). DTSBX417 +01152 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX417 +01153 DTSBX417 +01154 MOVE +12 TO L205-FIELD-LENGTH (10). DTSBX417 +01155 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX417 +01156 DTSBX417 +01157 MOVE +3 TO L205-FIELD-LENGTH (11). DTSBX417 +01158 SET L205-TYPE-NUMBER-88 (11) TO TRUE. DTSBX417 +01159 DTSBX417 +01160 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX417 +01161 SET L205-TYPE-DATE-88 (12) TO TRUE. DTSBX417 +01162 DTSBX417 +01163 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX417 +01164 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX417 +01165 DTSBX417 +01166 P1100K-EXIT. DTSBX417 +01167 EXIT. DTSBX417 +01168 DTSBX417 +01169 P1200-BUILD-SORT-REC. DTSBX417 +01170 MOVE LOW-VALUES TO SORT-REC. DTSBX417 +01171 MOVE WEB-IMP-EMP-NO TO SORT-EMP-NO. DTSBX417 +01172 DTSBX417 +01173 EVALUATE TRUE DTSBX417 +01174 WHEN WEB-IMP-TYPE-PRF-88 DTSBX417 +01175 PERFORM P1200A-PRF THRU P1200A-EXIT DTSBX417 +01176 MOVE +1 TO SORT-SEQ1 DTSBX417 +01177 MOVE X102-REC TO SORT-DATA DTSBX417 +01178 CL*21 +01179 WHEN WEB-IMP-TYPE-DETERM-88 CL*21 +01180 PERFORM P1200B-DETERM THRU P1200B-EXIT CL*21 +01181 MOVE +2 TO SORT-SEQ1 CL*21 +01182 MOVE X104-REC TO SORT-DATA CL*21 +01183 CL*21 +01184 DTSBX417 +01185 WHEN WEB-IMP-TYPE-NAME-88 DTSBX417 +01186 * PERFORM P1200C-NAME THRU P1200C-EXIT CL*42 +01187 MOVE WEB-IMP-REC TO X106-REC CL*42 +01188 MOVE +3 TO SORT-SEQ1 CL*21 +01189 MOVE X106-NAME-TYPE TO SORT-SEQ2 DTSBX417 +01190 MOVE X106-REC TO SORT-DATA DTSBX417 +01191 CL*23 +01192 WHEN WEB-IMP-TYPE-RATE-88 DTSBX417 +01193 PERFORM P1200D-RATE THRU P1200D-EXIT DTSBX417 +01194 MOVE +4 TO SORT-SEQ1 DTSBX417 +01195 MOVE X108-REC TO SORT-DATA DTSBX417 +01196 DTSBX417 +01197 WHEN WEB-IMP-TYPE-ADDR-88 DTSBX417 +01198 * PERFORM P1200E-ADDR THRU P1200E-EXIT CL*27 +01199 MOVE WEB-IMP-REC TO X110-REC CL*28 +01200 MOVE +90 TO SORT-SEQ1 DTSBX417 +01201 MOVE X110-REC TO SORT-DATA DTSBX417 +01202 DTSBX417 +01203 WHEN WEB-IMP-TYPE-OPO-88 DTSBX417 +01204 PERFORM P1200F-OPO THRU P1200F-EXIT CL*40 +01205 * MOVE WEB-IMP-REC TO X120-REC CL*40 +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 +01213 DTSBX417 +01214 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX417 +01215 * MOVE +6 TO SORT-SEQ1 DTSBX417 +01216 *** MOVE X132-REC TO SORT-DATA DTSBX417 +01217 DTSBX417 +01218 WHEN WEB-IMP-TYPE-RPT-88 DTSBX417 +01219 * IF X140-IN-HOUSE-88 DTSBX417 +01220 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX417 +01221 ** MOVE X140-PSEUDO-BATCH-NO TO SORT-BATCH DTSBX417 +01222 ** MOVE X140-PSEUDO-ITEM-NO TO SORT-ITEM DTSBX417 +01223 * MOVE LOW-VALUES TO SORT-FILLER DTSBX417 +01224 * ELSE DTSBX417 +01225 PERFORM P1200H-RPT THRU P1200H-EXIT CL*33 +01226 MOVE +20 TO SORT-SEQ1 CL*33 +01227 MOVE X140-QUARTER TO SORT-SEQ2 CL*56 +01228 * STRING CL*56 +01229 * X140-QUARTER '0' DELIMITED BY SIZE CL*56 +01230 * INTO SORT-SEQ2 CL*56 +01231 * END-STRING CL*56 +01232 * END-IF CL*35 +01233 MOVE X140-REC TO SORT-DATA CL*36 +01234 DTSBX417 +01235 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX417 +01236 PERFORM P1200I-WAGE THRU P1200I-EXIT DTSBX417 +01237 MOVE +21 TO SORT-SEQ1 CL*61 +01238 MOVE X144-QUARTER TO SORT-SEQ2 CL*61 +01239 * STRING CL*61 +01240 * X140-QUARTER '1' CL*61 +01241 * DELIMITED BY SIZE CL*61 +01242 * INTO CL*61 +01243 * SORT-SEQ2 CL*61 +01244 * END-STRING CL*61 +01245 MOVE X144-REC TO SORT-DATA CL*36 +01246 DTSBX417 +01247 ************************************************************ CL*23 +01248 * CHANGED SORT SEQ FOR PAYMENT RECORDS FROM 30 TO 19 DUE TO ESSP CL*23 +01249 * REPORTS X140 CANNOT BE PROCESSED WITHOUT A PAYMENT TRANSACTION CL*23 +01250 * UNLESS IT IS A 0 WAGE REPORT = REMIT AMOUNT = 0 CL*23 +01251 ************************************************************ CL*23 +01252 CL*23 +01253 WHEN WEB-IMP-TYPE-PAY-88 DTSBX417 +01254 PERFORM P1200J-PAY THRU P1200J-EXIT DTSBX417 +01255 MOVE +19 TO SORT-SEQ1 CL*23 +01256 MOVE X145-QTR TO SORT-SEQ2 CL*56 +01257 MOVE X145-REC TO SORT-DATA DTSBX417 +01258 ** DISPLAY 'P2 PAY ' X145-REC DTSBX417 +01259 DTSBX417 +01260 DTSBX417 +01261 ** WHEN WEB-IMP-TYPE-BHDR-88 DTSBX417 +01262 * PERFORM P1200K-BATCH-HEADER THRU P1200K-EXIT DTSBX417 +01263 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX417 +01264 * MOVE X149-PSEUDO-BATCH TO SORT-BATCH DTSBX417 +01265 * MOVE X149-PSEUDO-ITEM TO SORT-ITEM DTSBX417 +01266 * MOVE LOW-VALUES TO SORT-FILLER DTSBX417 +01267 * MOVE X149-REC TO SORT-DATA DTSBX417 +01268 DTSBX417 +01269 END-EVALUATE. DTSBX417 +01270 DTSBX417 +01271 RELEASE SORT-REC. DTSBX417 +01272 DTSBX417 +01273 P1200-EXIT. DTSBX417 +01274 EXIT. DTSBX417 +01275 DTSBX417 +01276 P1200A-PRF. DTSBX417 +01277 MOVE L205-TEXT (1) (1:3) TO X102-REC-TYPE. DTSBX417 +01278 ** DISPLAY X102-REC-TYPE DTSBX417 +01279 MOVE L205-TEXT (2) (1:6) TO X102-EMP-NO. DTSBX417 +01280 ** DISPLAY X102-EMP-NO DTSBX417 +01281 DTSBX417 +01282 MOVE L205-TEXT (3) (1:9) TO X102-EMP-FEIN. DTSBX417 +01283 ** DISPLAY X102-EMP-FEIN DTSBX417 +01284 DTSBX417 +01285 MOVE L205-TEXT (4) (1:1) TO X102-EMP-CLASS. DTSBX417 +01286 ** DISPLAY X102-EMP-CLASS DTSBX417 +01287 DTSBX417 +01288 MOVE L205-TEXT (5) (1:1) TO X102-EMP-STATUS. DTSBX417 +01289 ** DISPLAY X102-EMP-STATUS DTSBX417 +01290 DTSBX417 +01291 MOVE L205-INTEGER (6) TO W-INT-9. DTSBX417 +01292 MOVE W-INT-X (12:2) TO X102-SOURCE-CD. DTSBX417 +01293 ** DISPLAY X102-SOURCE-CD DTSBX417 +01294 DTSBX417 +01295 ** DISPLAY X102-REC-TYPE DTSBX417 +01296 MOVE L205-TEXT (7) (1:1) TO X102-ACTION-CD. DTSBX417 +01297 ** DISPLAY X102-ACTION-CD. DTSBX417 +01298 DTSBX417 +01299 P1200A-EXIT. DTSBX417 +01300 EXIT. DTSBX417 +01301 DTSBX417 +01302 P1200B-DETERM. DTSBX417 +01303 MOVE L205-TEXT (1) (1:03) TO X104-REC-TYPE. DTSBX417 +01304 DTSBX417 +01305 MOVE L205-TEXT (2) (1:06) TO X104-EMP-NO. DTSBX417 +01306 DTSBX417 +01307 MOVE L205-TEXT (3) (1:01) TO X104-STAFF-REVIEW-IND. DTSBX417 +01308 DTSBX417 +01309 MOVE L205-INTEGER (4) TO W-INT-9. DTSBX417 +01310 MOVE W-INT-X (12:2) TO X104-LIAB-CD. DTSBX417 +01311 DTSBX417 +01312 MOVE L205-INTEGER (5) TO W-INT-9. DTSBX417 +01313 MOVE W-INT-X (12:2) TO X104-ELIG-CD. DTSBX417 +01314 DTSBX417 +01315 MOVE L205-TEXT (6) (1:06) TO X104-NAICS-CD. DTSBX417 +01316 DTSBX417 +01317 MOVE L205-TEXT (7) (1:03) TO X104-ORG-TYPE. DTSBX417 +01318 DTSBX417 +01319 MOVE L205-TEXT (8) (1:02) TO X104-INCORP-STATE. DTSBX417 +01320 DTSBX417 +01321 MOVE L205-DATE (9) TO X104-INCORP-DATE. DTSBX417 +01322 DTSBX417 +01323 MOVE L205-TEXT (10) (1:01) TO X104-HOUSEHOLD-FILING. DTSBX417 +01324 DTSBX417 +01325 MOVE L205-DATE (11) TO X104-FIRST-WAGE-DT. DTSBX417 +01326 DTSBX417 +01327 MOVE L205-TEXT (12) TO W-500-DATE. DTSBX417 +01328 DTSBX417 +01329 MOVE SPACES TO X104-FIRST-500-QTR DTSBX417 +01330 IF W-500-DATE > SPACES DTSBX417 +01331 MOVE W-500-DATE-YY TO W-500-FQTR-YY. DTSBX417 +01332 IF W-500-DATE-MM < '04' DTSBX417 +01333 MOVE '1' TO W-500-FQTR-NO. DTSBX417 +01334 IF W-500-DATE-MM > '03' AND < '07' DTSBX417 +01335 MOVE '2' TO W-500-FQTR-NO. DTSBX417 +01336 IF W-500-DATE-MM > '06' AND < '10' DTSBX417 +01337 MOVE '3' TO W-500-FQTR-NO. DTSBX417 +01338 IF W-500-DATE-MM > '09' AND < '13' DTSBX417 +01339 MOVE '4' TO W-500-FQTR-NO. DTSBX417 +01340 MOVE W-500-FQTR TO X104-FIRST-500-QTR DTSBX417 +01341 DTSBX417 +01342 MOVE L205-TEXT (13) (1:01) TO X104-ACQUIRE-IND. DTSBX417 +01343 DTSBX417 +01344 MOVE L205-TEXT (14) (1:01) TO X104-MERGER-SPLIT-IND. DTSBX417 +01345 DTSBX417 +01346 MOVE L205-TEXT (15) (1:01) TO X104-REORG-IND. DTSBX417 +01347 DTSBX417 +01348 MOVE L205-TEXT (16) (1:01) TO X104-COMMON-OWN-IND. DTSBX417 +01349 DTSBX417 +01350 MOVE L205-TEXT (17) (1:01) TO X104-SALE-TRANSFER-IND. DTSBX417 +01351 DTSBX417 +01352 MOVE L205-TEXT (18) (1:01) TO X104-NOT-LIAB-REASON. DTSBX417 +01353 ** DISPLAY X104-REC. DTSBX417 +01354 P1200B-EXIT. DTSBX417 +01355 EXIT. DTSBX417 +01356 DTSBX417 +01357 P1200C-NAME. DTSBX417 +01358 MOVE L205-TEXT (1) (1:03) TO X106-REC-TYPE. DTSBX417 +01359 DTSBX417 +01360 MOVE L205-TEXT (2) (1:06) TO X106-EMP-NO. DTSBX417 +01361 DTSBX417 +01362 MOVE L205-TEXT (3) (1:01) TO X106-NAME-TYPE DTSBX417 +01363 DTSBX417 +01364 MOVE L205-TEXT (4) (1:40) TO X106-EMP-NAME. DTSBX417 +01365 DTSBX417 +01366 P1200C-EXIT. DTSBX417 +01367 EXIT. DTSBX417 +01368 DTSBX417 +01369 P1200D-RATE. DTSBX417 +01370 MOVE L205-TEXT (1) (1:03) TO X108-REC-TYPE. DTSBX417 +01371 DTSBX417 +01372 MOVE L205-TEXT (2) (1:06) TO X108-EMP-NO. DTSBX417 +01373 DTSBX417 +01374 MOVE L205-TEXT (3) (1:04) TO X108-RATE-YEAR(1:04). DTSBX417 +01375 MOVE '/1' TO X108-RATE-YEAR(5:02). DTSBX417 +01376 DTSBX417 +01377 MOVE L205-INTEGER (4) TO W-INTEGER. DTSBX417 +01378 MOVE L205-FRACTION (4) TO W-FRACTION. DTSBX417 +01379 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX417 +01380 MOVE W-NUMBER TO X108-RATE. DTSBX417 +01381 ** DISPLAY 'BX420 RATE ' X108-RATE ' ' W-NUMBER. DTSBX417 +01382 ** DISPLAY ' RATE YR ' X108-RATE-YEAR. DTSBX417 +01383 DTSBX417 +01384 P1200D-EXIT. DTSBX417 +01385 EXIT. DTSBX417 +01386 DTSBX417 +01387 P1200E-ADDR. DTSBX417 +01388 MOVE L205-TEXT (1) (1:03) TO X110-REC-TYPE. DTSBX417 +01389 DTSBX417 +01390 MOVE L205-TEXT (2) (1:06) TO X110-EMP-NO. DTSBX417 +01391 DTSBX417 +01392 MOVE L205-INTEGER (3) TO W-INT-9. DTSBX417 +01393 MOVE W-INT-X (12:2) TO X110-ADDR-TYPE. DTSBX417 +01394 DTSBX417 +01395 MOVE L205-TEXT (4) (1:40) TO X110-ATTENTION. DTSBX417 +01396 DTSBX417 +01397 MOVE L205-TEXT (5) (1:40) TO X110-STREET-1. DTSBX417 +01398 DTSBX417 +01399 MOVE L205-TEXT (6) (1:40) TO X110-STREET-2. DTSBX417 +01400 DTSBX417 +01401 MOVE L205-TEXT (7) (1:25) TO X110-CITY. DTSBX417 +01402 DTSBX417 +01403 MOVE L205-TEXT (8) (1:02) TO X110-STATE. DTSBX417 +01404 DTSBX417 +01405 MOVE L205-TEXT (9) (1:10) TO X110-ZIP. DTSBX417 +01406 DTSBX417 +01407 MOVE L205-TEXT (10) (1:15) TO X110-PHONE. DTSBX417 +01408 DTSBX417 +01409 MOVE L205-TEXT (11) (1:15) TO X110-FAX. DTSBX417 +01410 DTSBX417 +01411 MOVE L205-TEXT(12) (1:40) TO X110-EMAIL. DTSBX417 +01412 DTSBX417 +01413 MOVE L205-TEXT (13) (1:40) TO X110-WEB-SITE. DTSBX417 +01414 DTSBX417 +01415 MOVE L205-TEXT (14) (1:40) TO X110-EMP-NAME. DTSBX417 +01416 DTSBX417 +01417 P1200E-EXIT. DTSBX417 +01418 EXIT. DTSBX417 +01419 DTSBX417 +01420 P1200F-OPO. DTSBX417 +01421 MOVE WEB-IMP-REC TO W120-REC. CL*40 +01422 MOVE W120-REC-TYPE TO X120-REC-TYPE. CL*40 +01423 DTSBX417 +01424 MOVE W120-EMP-NO TO X120-EMP-NO. CL*40 +01425 DTSBX417 +01426 MOVE W120-TYPE-IND (1:02) TO X120-TYPE-IND. CL*40 +01427 DTSBX417 +01428 MOVE W120-OPO-FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME. CL*40 +01429 DTSBX417 +01430 MOVE W120-OPO-MID-INIT (1:01) TO X120-OPO-MID-INIT. CL*40 +01431 DTSBX417 +01432 MOVE W120-OPO-LAST-NAME (1:20) TO X120-OPO-LAST-NAME. CL*40 +01433 DTSBX417 +01434 MOVE W120-OPO-MEMBER-NAME (1:40) TO X120-OPO-MEMBER-NAME. CL*40 +01435 DTSBX417 +01436 MOVE W120-OPO-SSN (1:09) TO X120-OPO-SSN. CL*40 +01437 DTSBX417 +01438 MOVE W120-OPO-TITLE (1:40) TO X120-OPO-TITLE. CL*40 +01439 DTSBX417 +01440 MOVE W120-OPO-ATTENTION (1:40) TO X120-OPO-ATTENTION. CL*40 +01441 DTSBX417 +01442 MOVE W120-OPO-STREET-1 (1:40) TO X120-OPO-STREET-1. CL*40 +01443 DTSBX417 +01444 MOVE W120-OPO-STREET-2 (1:40) TO X120-OPO-STREET-2. CL*40 +01445 DTSBX417 +01446 MOVE W120-OPO-CITY (1:20) TO X120-OPO-CITY. CL*40 +01447 DTSBX417 +01448 MOVE W120-OPO-STATE (1:02) TO X120-OPO-STATE. CL*40 +01449 DTSBX417 +01450 MOVE W120-OPO-ZIP (1:10) TO X120-OPO-ZIP. CL*40 +01451 DTSBX417 +01452 MOVE W120-OPO-PHONE (1:15) TO X120-OPO-PHONE. CL*40 +01453 DTSBX417 +01454 MOVE W120-OPO-FAX (1:15) TO X120-OPO-FAX. CL*40 +01455 DTSBX417 +01456 MOVE W120-OPO-EMAIL (1:40) TO X120-OPO-EMAIL. CL*43 +01457 DTSBX417 +01458 P1200F-EXIT. DTSBX417 +01459 EXIT. DTSBX417 +01460 DTSBX417 +01461 P1200G-REL. DTSBX417 +01462 P1200G-EXIT. DTSBX417 +01463 EXIT. DTSBX417 +01464 DTSBX417 +01465 P1200H-RPT. DTSBX417 +01466 * DISPLAY '01200H-RPT ' CL**9 +01467 DTSBX417 +01468 MOVE L205-TEXT (1) (1:03) TO X140-REC-TYPE. DTSBX417 +01469 * DISPLAY 'X140-REC-TYPE' X140-REC-TYPE CL**9 +01470 DTSBX417 +01471 MOVE L205-TEXT (2) (1:06) TO X140-EMP-NO. DTSBX417 +01472 * DISPLAY 'X140-EMP-NO ' X140-EMP-NO CL*68 +01473 DTSBX417 +01474 MOVE L205-TEXT (3) (1:04) TO X140-QUARTER(1:04). DTSBX417 +01475 MOVE '/' TO X140-QUARTER(5:01). DTSBX417 +01476 MOVE L205-TEXT (4) (1:01) TO X140-QUARTER(6:01). DTSBX417 +01477 * DISPLAY 'X140 QTR' X140-QUARTER. CL*68 +01478 DTSBX417 +01479 MOVE '00' TO X140-SOURCE. DTSBX417 +01480 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX417 +01481 DTSBX417 +01482 MOVE L205-TEXT (5) (7:02) TO X140-REPORT-TYPE. CL**2 +01483 IF X140-REPORT-TYPE = ZERO DTSBX417 +01484 MOVE 'OR' TO X140-REPORT-TYPE DTSBX417 +01485 ELSE DTSBX417 +01486 MOVE 'EA' TO X140-REPORT-TYPE DTSBX417 +01487 END-IF. DTSBX417 +01488 DTSBX417 +01489 MOVE L205-TEXT (6) (2:07) TO X140-WRKR-CNT-TOTAL. CL*52 +01490 * DISPLAY 'L205-TEXT (6) (2:07) ' L205-TEXT (6) (2:07) CL*53 +01491 DTSBX417 +01492 MOVE ZEROS TO X140-PSEUDO-BATCH-NO. DTSBX417 +01493 ** DISPLAY 'X140-PSEUDO-BATCH-NO ' X140-PSEUDO-BATCH-NO DTSBX417 +01494 DTSBX417 +01495 MOVE ZEROS TO X140-PSEUDO-ITEM-NO. DTSBX417 +01496 ** DISPLAY 'X140-PSEUDO-ITEM-NO ' X140-PSEUDO-ITEM-NO DTSBX417 +01497 DTSBX417 +01498 MOVE L205-INTEGER (8) TO W-INTEGER. DTSBX417 +01499 MOVE L205-FRACTION (8) TO W-FRACTION. DTSBX417 +01500 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX417 +01501 MOVE W-NUMBER TO X140-TAX-WAGES. DTSBX417 +01502 * DISPLAY 'X140-TAX-WAGES ' X140-TAX-WAGES CL**9 +01503 DTSBX417 +01504 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX417 +01505 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX417 +01506 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX417 +01507 MOVE W-NUMBER TO X140-TOTAL-WAGES. DTSBX417 +01508 * DISPLAY 'X140-TOTAL-WAGES ' X140-TOTAL-WAGES CL**9 +01509 DTSBX417 +01510 MOVE ZERO TO X140-CONFIRMATION. DTSBX417 +01511 DTSBX417 +01512 MOVE L205-TEXT (11) TO X140-RCVD-DATE. DTSBX417 +01513 * DISPLAY 'RECV DATE ' X140-RCVD-DATE. CL**9 +01514 DTSBX417 +01515 MOVE L205-TEXT (12) (2:07) TO X140-WRKR-CNT-1ST-MNTH. CL*51 +01516 * DISPLAY 'X140-WRKR-CNT-1ST-MNTH ' X140-WRKR-CNT-1ST-MNTH CL*53 +01517 DTSBX417 +01518 MOVE L205-TEXT (13) (2:07) TO X140-WRKR-CNT-2ND-MNTH. CL*51 +01519 * DISPLAY 'X140-WRKR-CNT-2ND-MNTH ' X140-WRKR-CNT-2ND-MNTH CL*53 +01520 DTSBX417 +01521 MOVE L205-TEXT (14) (2:07) TO X140-WRKR-CNT-3RD-MNTH. CL*51 +01522 * DISPLAY 'X140-WRKR-CNT-3RD-MNTH ' X140-WRKR-CNT-3RD-MNTH CL*53 +01523 DTSBX417 +01524 CL*25 +01525 MOVE L205-INTEGER (16) TO W-INTEGER. CL*25 +01526 MOVE L205-FRACTION (16) TO W-FRACTION. CL*25 +01527 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*25 +01528 MOVE W-NUMBER TO X140-REMITTANCE. CL*25 +01529 * DISPLAY 'X140-REMITTANCE ' X140-REMITTANCE. CL*30 +01530 CL*25 +01531 MOVE SPACES TO X140-CHECK-SCAN-DT. DTSBX417 +01532 * DISPLAY 'X140-CHECK SCANDATE ' X140-CHECK-SCAN-DT. CL**9 +01533 DTSBX417 +01534 MOVE ZEROS TO X140-CHECK-SEQ-NBR. DTSBX417 +01535 * DISPLAY 'X140-CHECK-SEQ-NBR ' X140-CHECK-SEQ-NBR CL**9 +01536 DTSBX417 +01537 MOVE 'N' TO X140-WAIVE-INTEREST. DTSBX417 +01538 * DISPLAY 'X140-WAIVE-INTEREST ' X140-WAIVE-INTEREST CL**9 +01539 DTSBX417 +01540 MOVE 'N' TO X140-WAIVE-PENALTY. DTSBX417 +01541 * DISPLAY 'X140-WAIVE-PENALTY ' X140-WAIVE-PENALTY CL**9 +01542 DTSBX417 +01543 MOVE ' ' TO X140-RESP-ACTIVITY. DTSBX417 +01544 * DISPLAY 'X140-RESP-ACTIVITY ' X140-RESP-ACTIVITY CL**9 +01545 DTSBX417 +01546 MOVE 'WEBESSP ' TO X140-RESP-OPID. DTSBX417 +01547 * DISPLAY 'X140-RESP-OPID ' X140-RESP-OPID CL**9 +01548 DTSBX417 +01549 *& DTSBX417 +01550 * DISPLAY 'BX420 P1200H: ' X140-REC. CL*30 +01551 P1200H-EXIT. DTSBX417 +01552 EXIT. DTSBX417 +01553 DTSBX417 +01554 P1200I-WAGE. DTSBX417 +01555 MOVE WEB-IMP-REC TO W144-REC. CL*50 +01556 CL*50 +01557 * DISPLAY 'WEB-REC-WORK: ' W144-REC. CL*55 +01558 MOVE W144-REC-TYPE TO X144-REC-TYPE. CL*50 +01559 DTSBX417 +01560 MOVE W144-EMP-NO TO X144-EMP-NO. CL*50 +01561 DTSBX417 +01562 DTSBX417 +01563 MOVE '/' TO W144-QUARTER-SLASH. CL*50 +01564 MOVE W144-QUARTER TO X144-QUARTER. CL*50 +01565 DTSBX417 +01566 MOVE W144-SSN TO X144-SSN. CL*50 +01567 DTSBX417 +01568 MOVE '5' TO X144-WAGE-STATUS. DTSBX417 +01569 DTSBX417 +01570 MOVE W144-LAST-NAME TO X144-LAST-NAME. CL*50 +01571 DTSBX417 +01572 MOVE W144-FIRST-NAME TO X144-FIRST-NAME. CL*50 +01573 DTSBX417 +01574 MOVE W144-MID-INIT TO X144-MID-INIT. CL*50 +01575 DTSBX417 +01576 MOVE W144-EARNINGS TO X144-EARNINGS. CL*50 +01577 DTSBX417 +01578 * DISPLAY 'W144REC: ' X144-REC. CL*55 +01579 P1200I-EXIT. DTSBX417 +01580 EXIT. DTSBX417 +01581 DTSBX417 +01582 P1200J-PAY. DTSBX417 +01583 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. DTSBX417 +01584 DTSBX417 +01585 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. DTSBX417 +01586 DTSBX417 +01587 MOVE '0' TO X145-SOURCE. DTSBX417 +01588 DTSBX417 +01589 MOVE L205-TEXT (3) (1:06) TO X145-QTR. DTSBX417 +01590 DISPLAY 'X145 QTR ' X145-QTR. CL*56 +01591 DTSBX417 +01592 MOVE L205-TEXT (7) (1:02) TO X145-PAY-TYPE. CL*67 +01593 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL**9 +01594 DTSBX417 +01595 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX417 +01596 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX417 +01597 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX417 +01598 MOVE W-NUMBER TO X145-REMITTANCE. DTSBX417 +01599 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL**9 +01600 DTSBX417 +01601 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. DTSBX417 +01602 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL**9 +01603 DTSBX417 +01604 MOVE L205-TEXT (12) TO W-TRACE-B. DTSBX417 +01605 MOVE W-TRACE-9 TO X145-TRACE-NO. DTSBX417 +01606 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL**9 +01607 DTSBX417 +01608 DTSBX417 +01609 MOVE ZEROS TO X145-PSEUDO-BATCH. DTSBX417 +01610 DTSBX417 +01611 MOVE ZEROS TO X145-PSEUDO-ITEM. DTSBX417 +01612 DTSBX417 +01613 MOVE SPACES TO X145-APPLIC-ACCT. DTSBX417 +01614 DTSBX417 +01615 MOVE SPACES TO X145-CHECK-SCAN-DT. DTSBX417 +01616 DTSBX417 +01617 MOVE ZEROS TO X145-CHECK-SEQ-NBR. DTSBX417 +01618 DTSBX417 +01619 MOVE 'N' TO X145-WAIVE-INTEREST. DTSBX417 +01620 DTSBX417 +01621 MOVE 'N' TO X145-WAIVE-PENALTY. DTSBX417 +01622 DTSBX417 +01623 MOVE 'VOL' TO X145-RESP-ACTIVITY. DTSBX417 +01624 DTSBX417 +01625 MOVE 'WEBESSP ' TO X145-RESP-OPID. DTSBX417 +01626 DTSBX417 +01627 P1200J-EXIT. DTSBX417 +01628 EXIT. DTSBX417 +01629 DTSBX417 +01630 P1200K-BATCH-HEADER. DTSBX417 +01631 MOVE L205-TEXT (1) (1:03) TO X149-REC-TYPE. DTSBX417 +01632 DTSBX417 +01633 MOVE L205-TEXT (2) (1:5) TO X149-PSEUDO-BATCH. DTSBX417 +01634 DTSBX417 +01635 MOVE L205-TEXT (3) (1:3) TO X149-PSEUDO-ITEM. DTSBX417 +01636 DTSBX417 +01637 MOVE L205-TEXT (4) (1:08) TO X149-ESTB-OPID. DTSBX417 +01638 DTSBX417 +01639 MOVE L205-DATE (5) TO X149-ESTB-DATE. DTSBX417 +01640 DTSBX417 +01641 MOVE L205-DATE (6) TO X149-DEPOSIT-DATE. DTSBX417 +01642 DTSBX417 +01643 IF L205-VALID-NO-88 (7) DTSBX417 +01644 MOVE SPACES TO X149-RCVD-DATE DTSBX417 +01645 ELSE DTSBX417 +01646 MOVE L205-DATE (7) TO X149-RCVD-DATE DTSBX417 +01647 END-IF. DTSBX417 +01648 DTSBX417 +01649 MOVE L205-INTEGER (8) TO X149-LAST-ITEM-NBR. DTSBX417 +01650 DTSBX417 +01651 MOVE L205-INTEGER (9) TO X149-CONTROL-TRAN-CNT. DTSBX417 +01652 DTSBX417 +01653 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX417 +01654 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX417 +01655 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX417 +01656 MOVE W-NUMBER TO X149-CONTROL-REMIT-AMT. DTSBX417 +01657 MOVE W-INTEGER TO W-AMT-DISP1. DTSBX417 +01658 MOVE W-FRACTION TO W-AMT-DISP4. DTSBX417 +01659 MOVE W-NUMBER TO W-AMT-DISP2. DTSBX417 +01660 ** DISPLAY 'BX420 P1200 HDR ' X149-PSEUDO-BATCH DTSBX417 +01661 ** ' INT ' W-AMT-DISP1 ' FR ' W-AMT-DISP4 DTSBX417 +01662 ** ' NBR ' W-AMT-DISP2 DTSBX417 +01663 ** ' X149 ' X149-CONTROL-REMIT-AMT. DTSBX417 +01664 DTSBX417 +01665 MOVE L205-INTEGER (11) TO X149-CONTROL-CHECK-CNT. DTSBX417 +01666 DTSBX417 +01667 MOVE L205-DATE (12) TO X149-CHECK-SCAN-DATE. DTSBX417 +01668 DTSBX417 +01669 MOVE L205-TEXT (13) (1:08) TO X149-ANN-BATCH-IND. DTSBX417 +01670 DTSBX417 +01671 ** DISPLAY 'BX420 P1200 HDR ' X149-PSEUDO-BATCH DTSBX417 +01672 ** ' ' X149-PSEUDO-ITEM ' ' X149-ESTB-OPID. DTSBX417 +01673 P1200K-EXIT. DTSBX417 +01674 EXIT. DTSBX417 +01675 DTSBX417 +01676 P2000-POST-SORT. DTSBX417 +01677 SET SORT-OK-88 TO TRUE. DTSBX417 +01678 DTSBX417 +01679 * DISPLAY 'P2000 BEG READING SORT-FILE ' SORT-EMP-NO. CL*68 +01680 PERFORM P2100-PROCESS-SORT THRU P2100-EXIT DTSBX417 +01681 UNTIL SORT-EOF-88. DTSBX417 +01682 DTSBX417 +01683 * SET LX42-TERMINATE-88 TO TRUE CL**9 +01684 * DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-EMP-NO. CL**9 +01685 * DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-KEY ' ' CL*68 +01686 * SORT-DATA (1:14). CL*68 +01687 P2000-EXIT. DTSBX417 +01688 EXIT. DTSBX417 +01689 DTSBX417 +01690 P2100-PROCESS-SORT. DTSBX417 +01691 * DISPLAY 'BX420 P2100 FIRST SORT-EMP-NO ' SORT-EMP-NO CL*38 +01692 * ' ' SORT-DATA (1:14). CL*38 +01693 RETURN SORT-FILE DTSBX417 +01694 AT END DTSBX417 +01695 SET SORT-EOF-88 TO TRUE DTSBX417 +01696 GO TO P2100-EXIT DTSBX417 +01697 END-RETURN. DTSBX417 +01698 DTSBX417 +01699 * DISPLAY 'BX420 P2100 SORT-REC ' SORT-KEY ' ' CL*68 +01700 * SORT-DATA (1:14). CL*68 +01701 DTSBX417 +01702 MOVE SORT-DATA TO LX42-DATA-AREA. DTSBX417 +01703 IF SORT-EMP-NO = 999999 DTSBX417 +01704 IF SORT-BATCH = W-PSEUDO-BATCH-NO DTSBX417 +01705 * DISPLAY 'BX420 NEW BATCH 999999 PROCESS' CL*53 +01706 SET LX42-PROCESS-88 TO TRUE DTSBX417 +01707 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX417 +01708 ELSE DTSBX417 +01709 MOVE SORT-BATCH TO W-PSEUDO-BATCH-NO DTSBX417 +01710 * DISPLAY 'BX420 NEW BATCH ' CL*53 +01711 ** PERFORM P2120-NEW-BATCH THRU P2120-EXIT DTSBX417 +01712 SET LX42-PROCESS-88 TO TRUE DTSBX417 +01713 SET LX42-ERROR-NO-88 TO TRUE DTSBX417 +01714 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01715 ** DISPLAY 'BX420 NEW BATCH 888888 PROCESS' CL*13 +01716 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX417 +01717 END-IF DTSBX417 +01718 ELSE CL*19 +01719 IF SORT-EMP-NO = W-EMP-NO AND SORT-PAY-QTR = W-PAY-QTR CL*57 +01720 * DISPLAY 'BX420 SORT-EMP-NO = W-EMP-NO ' CL*53 +01721 SET LX42-PROCESS-88 TO TRUE DTSBX417 +01722 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX417 +01723 ELSE DTSBX417 +01724 * DISPLAY 'BX420 SORT-EMP-NO < W-EMP-NO ' CL*53 +01725 MOVE SORT-EMP-NO TO W-EMP-NO DTSBX417 +01726 MOVE SORT-PAY-QTR TO W-PAY-QTR CL*57 +01727 PERFORM P2110-NEW-EMP THRU P2110-EXIT DTSBX417 +01728 SET LX42-PROCESS-88 TO TRUE DTSBX417 +01729 SET LX42-ERROR-NO-88 TO TRUE DTSBX417 +01730 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01731 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX417 +01732 END-IF DTSBX417 +01733 END-IF. DTSBX417 +01734 DTSBX417 +01735 P2100-EXIT. DTSBX417 +01736 EXIT. DTSBX417 +01737 DTSBX417 +01738 P2110-NEW-EMP. DTSBX417 +01739 DTSBX417 +01740 DISPLAY 'BX420 >>>>>>>> NEW-EMP ' LX42-DATA-AREA (1:20). CL*11 +01741 DTSBX417 +01742 SET LX42-NEW-EMPLOYER-88 TO TRUE. DTSBX417 +01743 MOVE ZERO TO LX42-LAST-DETERM-EMP. DTSBX417 +01744 DTSBX417 +01745 ** PERFORM S421-REGISTRATION THRU S421-EXIT. CL*66 +01746 PERFORM S422-REPORT-WAGES THRU S422-EXIT. CL*63 +01747 PERFORM S423-PAYMENTS THRU S423-EXIT. CL*63 +01748 ** PERFORM S424-PROFILE THRU S424-EXIT. CL*66 +01749 DTSBX417 +01750 P2110-EXIT. DTSBX417 +01751 EXIT. DTSBX417 +01752 DTSBX417 +01753 P2120-NEW-BATCH. DTSBX417 +01754 *& DTSBX417 +01755 * DISPLAY 'BX420 P2120 NEW BATCH ' LX42-PSEUDO-BATCH-NO DTSBX417 +01756 * ' ' LX42-DATA-AREA (1:20). DTSBX417 +01757 *& DTSBX417 +01758 SET LX42-NEW-BATCH-88 TO TRUE. DTSBX417 +01759 DTSBX417 +01760 * PERFORM S426-HEADER THRU S426-EXIT. DTSBX417 +01761 * IF LX42-BATCH-ERR-YES-88 DTSBX417 +01762 * SET LX42-BATCH-ERROR-88 TO TRUE DTSBX417 +01763 * END-IF. DTSBX417 +01764 PERFORM S422-REPORT-WAGES THRU S422-EXIT. CL*63 +01765 PERFORM S423-PAYMENTS THRU S423-EXIT. CL*63 +01766 DTSBX417 +01767 MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX417 +01768 MOVE ZERO TO LX42-RPT-CNT DTSBX417 +01769 LX42-RPT-REMIT-AMT DTSBX417 +01770 LX42-PAY-CNT DTSBX417 +01771 LX42-PAY-REMIT-AMT. DTSBX417 +01772 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX417 +01773 DTSBX417 +01774 P2120-EXIT. DTSBX417 +01775 EXIT. DTSBX417 +01776 DTSBX417 +01777 P3000-PROCESS. DTSBX417 +01778 *& DTSBX417 +01779 *& DTSBX417 +01780 **************************************************************** DTSBX417 +01781 * LX42-LAST-DETERM-EMP IS SET WHEN PROCESSING A DETERMINATION. DTSBX417 +01782 * THE EMPLOYER ACCOUNT NUMBER IS PASSED THROUGH THIS FIELD DTSBX417 +01783 * TO DTSBX422, WHICH PROCESSES REPORTS. IT IS USED DTSBX417 +01784 * TO DETERMINE WHEN TO WAIVE P & I. THE WAIVER IS AUTOMATIC DTSBX417 +01785 * FOR REPORTS WITHIN THE LAST 5 QUARTERS SUBMITTED ALONG DTSBX417 +01786 * WITH A WEB REGISTRATION. DTSBX417 +01787 **************************************************************** DTSBX417 +01788 DTSBX417 +01789 EVALUATE TRUE DTSBX417 +01790 * WHEN LX42-REC-TYPE-PRF-88 CL*66 +01791 * ADD +1 TO W-102-IMP-CNT CL*66 +01792 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*66 +01793 CL**9 +01794 * WHEN LX42-REC-TYPE-DETERM-88 CL*66 +01795 * ADD +1 TO W-104-IMP-CNT CL*66 +01796 * MOVE W-EMP-NO CL*66 +01797 * TO LX42-LAST-DETERM-EMP CL*66 +01798 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*66 +01799 CL**9 +01800 * WHEN LX42-REC-TYPE-RATE-88 CL*66 +01801 * ADD +1 TO W-108-IMP-CNT CL*66 +01802 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*66 +01803 CL**9 +01804 * WHEN LX42-REC-TYPE-NAME-88 CL*66 +01805 * ADD +1 TO W-106-IMP-CNT CL*66 +01806 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*66 +01807 CL**9 +01808 * WHEN LX42-REC-TYPE-REL-88 CL**9 +01809 * PERFORM S421-REGISTRATION THRU S421-EXIT CL**9 +01810 DTSBX417 +01811 WHEN LX42-REC-TYPE-RPT-88 DTSBX417 +01812 ADD +1 TO W-140-IMP-CNT CL*38 +01813 *** PERFORM P3100-BATCH-NO THRU P3100-EXIT DTSBX417 +01814 PERFORM S422-REPORT-WAGES THRU S422-EXIT CL*64 +01815 CL**9 +01816 WHEN LX42-REC-TYPE-WAGE-88 DTSBX417 +01817 ADD +1 TO W-144-IMP-CNT CL*38 +01818 PERFORM S422-REPORT-WAGES THRU S422-EXIT CL*64 +01819 DTSBX417 +01820 * WHEN LX42-REC-TYPE-BHDR-88 CL**9 +01821 * PERFORM S426-HEADER THRU S426-EXIT CL**9 +01822 DTSBX417 +01823 WHEN LX42-REC-TYPE-PAY-88 DTSBX417 +01824 ADD +1 TO W-145-IMP-CNT CL*38 +01825 PERFORM S423-PAYMENTS THRU S423-EXIT CL*64 +01826 DTSBX417 +01827 * WHEN LX42-REC-TYPE-ADDR-88 CL*66 +01828 * ADD +1 TO W-110-IMP-CNT CL*66 +01829 * PERFORM S424-PROFILE THRU S424-EXIT CL*66 +01830 CL**9 +01831 * WHEN LX42-REC-TYPE-OPO-88 CL*66 +01832 * ADD +1 TO W-120-IMP-CNT CL*66 +01833 * PERFORM S424-PROFILE THRU S424-EXIT CL*66 +01834 DTSBX417 +01835 END-EVALUATE. DTSBX417 +01836 DTSBX417 +01837 P3000-EXIT. DTSBX417 +01838 EXIT. DTSBX417 +01839 DTSBX417 +01840 P3100-BATCH-NO. DTSBX417 +01841 *& IF W-PSEUDO-ITEM-NO < 999 DTSBX417 +01842 * ADD 1 TO W-PSEUDO-ITEM-NO DTSBX417 +01843 * ELSE DTSBX417 +01844 * ADD 1 TO W-PSEUDO-BATCH-NO DTSBX417 +01845 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSBX417 +01846 * END-IF. DTSBX417 +01847 * DTSBX417 +01848 * MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX417 +01849 *& MOVE W-PSEUDO-ITEM-NO TO LX42-PSEUDO-ITEM-NO. DTSBX417 +01850 DTSBX417 +01851 P3100-EXIT. DTSBX417 +01852 EXIT. DTSBX417 +01853 DTSBX417 +01854 DTSBX417 +01855 T0000-TERMINATE. DTSBX417 +01856 PERFORM T1000-FINAL-CALLS THRU T1000-EXIT. DTSBX417 +01857 DTSBX417 +01858 *** PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSBX417 +01859 DTSBX417 +01860 DISPLAY ' '. DTSBX417 +01861 DTSBX417 +01862 DISPLAY '*** DTSBX420 TERMINATION STATISTICS ***'. DTSBX417 +01863 DTSBX417 +01864 DISPLAY '***************************************'. CL*30 +01865 DISPLAY '*** WEB/ESSP IMPORT DRIVER COUNTS ***'. CL*38 +01866 DISPLAY '*** ***'. CL*30 +01867 DISPLAY 'TOTAL INPUT RECORDS READ: ' W-WEB-IMP-CNT. CL*38 +01868 DISPLAY ' X102 RECORDS READ: ' W-102-IMP-CNT. CL*38 +01869 DISPLAY ' X104 RECORDS READ: ' W-104-IMP-CNT. CL*38 +01870 DISPLAY ' X106 RECORDS READ: ' W-106-IMP-CNT. CL*38 +01871 DISPLAY ' X108 RECORDS READ: ' W-108-IMP-CNT. CL*38 +01872 DISPLAY ' X110 RECORDS READ: ' W-110-IMP-CNT. CL*38 +01873 DISPLAY ' X120 RECORDS READ: ' W-120-IMP-CNT. CL*38 +01874 DISPLAY ' X140 RECORDS READ: ' W-140-IMP-CNT. CL*38 +01875 DISPLAY ' X144 RECORDS READ: ' W-144-IMP-CNT. CL*38 +01876 DISPLAY ' X145 RECORDS READ: ' W-145-IMP-CNT. CL*38 +01877 DISPLAY ' ' CL*38 +01878 DISPLAY '*** ***'. CL*30 +01879 DISPLAY '*********** END OF RUN ****************'. CL*38 +01880 DTSBX417 +01881 CLOSE WEB-IMP-FILE. DTSBX417 +01882 *** CURR-BATCH-NO. DTSBX417 +01883 *** TEMP-BTC-FILE. DTSBX417 +01884 DTSBX417 +01885 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX417 +01886 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX417 +01887 PERFORM S923-CLOSE THRU S923-EXIT. DTSBX417 +01888 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX417 +01889 * PERFORM S927C-CLOSE THRU S927C-EXIT. CL*44 +01890 DTSBX417 +01891 T0000-EXIT. DTSBX417 +01892 EXIT. DTSBX417 +01893 DTSBX417 +01894 T1000-FINAL-CALLS. DTSBX417 +01895 *& DTSBX417 +01896 DISPLAY 'BX420 T1000 ' LX42-DATA-AREA (1:20). CL**7 +01897 *& DTSBX417 +01898 SET LX42-TERMINATE-88 TO TRUE. DTSBX417 +01899 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX417 +01900 DTSBX417 +01901 ** PERFORM S421-REGISTRATION THRU S421-EXIT. CL*66 +01902 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX417 +01903 PERFORM S422-REPORT-WAGES THRU S422-EXIT. CL*63 +01904 PERFORM S423-PAYMENTS THRU S423-EXIT. CL*63 +01905 ** PERFORM S424-PROFILE THRU S424-EXIT. CL*66 +01906 DTSBX417 +01907 T1000-EXIT. DTSBX417 +01908 EXIT. DTSBX417 +01909 DTSBX417 +01910 *T1100-UPDATE-CURR-BATCH. DTSBX417 +01911 * MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBX417 +01912 * W-END-BATCH. DTSBX417 +01913 * MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBX417 +01914 * DISPLAY 'REWRITING CURRENT BATCH ' DTSBX417 +01915 * W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBX417 +01916 * REWRITE CURR-BATCH-NO-REC. DTSBX417 +01917 * IF BATCH-STATUS-OK-88 DTSBX417 +01918 * NEXT SENTENCE DTSBX417 +01919 * ELSE DTSBX417 +01920 * DISPLAY 'T1100 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBX417 +01921 * BATCH-STATUS DTSBX417 +01922 * END-IF. DTSBX417 +01923 * DTSBX417 +01924 *T1100-EXIT. DTSBX417 +01925 * EXIT. DTSBX417 +01926 DTSBX417 +01927 S001-FROM-FED-8. DTSBX417 +01928 SET L001-FROM-FED-8 TO TRUE. DTSBX417 +01929 GO TO S001-DATE. DTSBX417 +01930 DTSBX417 +01931 S001-FROM-CAL-8. DTSBX417 +01932 SET L001-FROM-CAL-8 TO TRUE. DTSBX417 +01933 GO TO S001-DATE. DTSBX417 +01934 DTSBX417 +01935 S001-FROM-ABS-DAY. DTSBX417 +01936 SET L001-FROM-ABS-DAY TO TRUE. DTSBX417 +01937 GO TO S001-DATE. DTSBX417 +01938 DTSBX417 +01939 S001-DATE. DTSBX417 +01940 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX417 +01941 S001-EXIT. DTSBX417 +01942 EXIT. DTSBX417 +01943 DTSBX417 +01944 S003-AGENCY-DAY. DTSBX417 +01945 SET L003-AGENCY-DAY TO TRUE. DTSBX417 +01946 GO TO S003-WORK-DAY. DTSBX417 +01947 DTSBX417 +01948 S003-WORK-DAY. DTSBX417 +01949 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX417 +01950 S003-EXIT. DTSBX417 +01951 EXIT. DTSBX417 +01952 DTSBX417 +01953 S004-FROM-5. DTSBX417 +01954 SET L004-FROM-5 TO TRUE. DTSBX417 +01955 GO TO S004-YRQ. DTSBX417 +01956 DTSBX417 +01957 S004-FROM-DATE. DTSBX417 +01958 SET L004-FROM-DATE TO TRUE. DTSBX417 +01959 GO TO S004-YRQ. DTSBX417 +01960 DTSBX417 +01961 S004-FROM-ABS. DTSBX417 +01962 SET L004-FROM-ABS TO TRUE. DTSBX417 +01963 GO TO S004-YRQ. DTSBX417 +01964 DTSBX417 +01965 S004-YRQ. DTSBX417 +01966 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX417 +01967 DTSBX417 +01968 S004-EXIT. DTSBX417 +01969 EXIT. DTSBX417 +01970 DTSBX417 +01971 S005-FROM-SYS. DTSBX417 +01972 SET L005-FROM-SYS TO TRUE. DTSBX417 +01973 GO TO S005-ABSTIME. DTSBX417 +01974 DTSBX417 +01975 S005-ABSTIME. DTSBX417 +01976 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX417 +01977 S005-EXIT. DTSBX417 +01978 EXIT. DTSBX417 +01979 DTSBX417 +01980 S421-REGISTRATION. DTSBX417 +01981 DISPLAY 'CALL S421-REGISTRATION'. CL**8 +01982 CALL 'DTSBX421' USING LX42-LINK-AREA. DTSBX417 +01983 S421-EXIT. DTSBX417 +01984 EXIT. DTSBX417 +01985 DTSBX417 +01986 S422-REPORT-WAGES. CL*63 +01987 DISPLAY 'CALL S422-REPORTS- WAGES '. CL*63 +01988 CALL 'DTSBX430' USING LX42-LINK-AREA. CL*23 +01989 S422-EXIT. DTSBX417 +01990 EXIT. DTSBX417 +01991 DTSBX417 +01992 S423-PAYMENTS. CL*63 +01993 * DISPLAY 'CALL S423-RPT-WAGES'. CL*59 +01994 CALL 'DTSBX530' USING LX42-LINK-AREA. CL*63 +01995 S423-EXIT. CL*63 +01996 EXIT. CL*63 +01997 DTSBX417 +01998 S424-PROFILE. DTSBX417 +01999 DISPLAY 'CALL S424-PROFILE' CL**8 +02000 ** DISPLAY 'LINK AREA ' LX42-LINK-AREA DTSBX417 +02001 CALL 'DTSBX424' USING LX42-LINK-AREA. DTSBX417 +02002 S424-EXIT. DTSBX417 +02003 EXIT. DTSBX417 +02004 DTSBX417 +02005 *S426-HEADER. CL*65 +02006 * CALL 'DTSBX426' USING LX42-LINK-AREA. CL*65 +02007 *S426-EXIT. CL*65 +02008 EXIT. DTSBX417 +02009 DTSBX417 +02010 DTSBX417 +02011 S910-OPEN-READ. DTSBX417 +02012 SET L910-OPEN-READ-88 TO TRUE. DTSBX417 +02013 GO TO S910-MSTR-IO. DTSBX417 +02014 DTSBX417 +02015 S910-OPEN-UPDATE. DTSBX417 +02016 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX417 +02017 GO TO S910-MSTR-IO. DTSBX417 +02018 DTSBX417 +02019 S910-READ. DTSBX417 +02020 SET L910-READ-88 TO TRUE. DTSBX417 +02021 GO TO S910-MSTR-IO. DTSBX417 +02022 DTSBX417 +02023 S910-START-BROWSE. DTSBX417 +02024 SET L910-START-BROWSE-88 TO TRUE. DTSBX417 +02025 GO TO S910-MSTR-IO. DTSBX417 +02026 DTSBX417 +02027 S910-READ-NEXT. DTSBX417 +02028 SET L910-READ-NEXT-88 TO TRUE. DTSBX417 +02029 GO TO S910-MSTR-IO. DTSBX417 +02030 DTSBX417 +02031 S910-CLOSE. DTSBX417 +02032 SET L910-CLOSE-88 TO TRUE. DTSBX417 +02033 GO TO S910-MSTR-IO. DTSBX417 +02034 DTSBX417 +02035 S910-MSTR-IO. DTSBX417 +02036 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX417 +02037 MSKL-REC. DTSBX417 +02038 S910-EXIT. DTSBX417 +02039 EXIT. DTSBX417 +02040 DTSBX417 +02041 S921-OPEN-READ. DTSBX417 +02042 SET L921-OPEN-READ-88 TO TRUE. DTSBX417 +02043 GO TO S921-AIX-IO. DTSBX417 +02044 DTSBX417 +02045 S921-READ. DTSBX417 +02046 SET L921-READ-88 TO TRUE. DTSBX417 +02047 GO TO S921-AIX-IO. DTSBX417 +02048 DTSBX417 +02049 S921-START-BROWSE. DTSBX417 +02050 SET L921-START-BROWSE-88 TO TRUE. DTSBX417 +02051 GO TO S921-AIX-IO. DTSBX417 +02052 DTSBX417 +02053 S921-READ-NEXT. DTSBX417 +02054 SET L921-READ-NEXT-88 TO TRUE. DTSBX417 +02055 GO TO S921-AIX-IO. DTSBX417 +02056 DTSBX417 +02057 S921-CLOSE. DTSBX417 +02058 SET L921-CLOSE-88 TO TRUE. DTSBX417 +02059 GO TO S921-AIX-IO. DTSBX417 +02060 DTSBX417 +02061 S921-AIX-IO. DTSBX417 +02062 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX417 +02063 ISKL-REC. DTSBX417 +02064 S921-EXIT. DTSBX417 +02065 EXIT. DTSBX417 +02066 DTSBX417 +02067 S923-OPEN-UPDATE. DTSBX417 +02068 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX417 +02069 GO TO S923-ATC-CALL. DTSBX417 +02070 DTSBX417 +02071 S923-OPEN-READ. DTSBX417 +02072 SET L923-OPEN-READ-88 TO TRUE. DTSBX417 +02073 GO TO S923-ATC-CALL. DTSBX417 +02074 DTSBX417 +02075 S923-WRITE. DTSBX417 +02076 SET L923-WRITE-88 TO TRUE. DTSBX417 +02077 GO TO S923-ATC-CALL. DTSBX417 +02078 DTSBX417 +02079 S923-CLOSE. DTSBX417 +02080 SET L923-CLOSE-88 TO TRUE. DTSBX417 +02081 GO TO S923-ATC-CALL. DTSBX417 +02082 DTSBX417 +02083 S923-ATC-CALL. DTSBX417 +02084 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX417 +02085 ASKL-REC. DTSBX417 +02086 S923-EXIT. DTSBX417 +02087 EXIT. DTSBX417 +02088 DTSBX417 +02089 S927A-OPEN. DTSBX417 +02090 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX417 +02091 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX417 +02092 DTSBX417 +02093 S927A-EXIT. DTSBX417 +02094 EXIT. DTSBX417 +02095 DTSBX417 +02096 S927C-CLOSE. DTSBX417 +02097 SET L927-CLOSE-88 TO TRUE. DTSBX417 +02098 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX417 +02099 DTSBX417 +02100 S927C-EXIT. DTSBX417 +02101 EXIT. DTSBX417 +02102 DTSBX417 +02103 S927Z-IO. DTSBX417 +02104 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX417 +02105 TSKL-REC. DTSBX417 +02106 S927Z-EXIT. DTSBX417 +02107 EXIT. DTSBX417 +02108 DTSBX417 +02109 S931-OPEN-READ. DTSBX417 +02110 SET L931-OPEN-READ-88 TO TRUE. DTSBX417 +02111 GO TO S931-REF-IO. DTSBX417 +02112 DTSBX417 +02113 S931-CLOSE. DTSBX417 +02114 SET L931-CLOSE-88 TO TRUE. DTSBX417 +02115 GO TO S931-REF-IO. DTSBX417 +02116 DTSBX417 +02117 S931-REF-IO. DTSBX417 +02118 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX417 +02119 FSKL-REC. DTSBX417 +02120 S931-EXIT. DTSBX417 +02121 EXIT. DTSBX417 +02122 DTSBX417 +02123 S1000-READ-WEB-IMP. DTSBX417 +02124 READ WEB-IMP-FILE. DTSBX417 +02125 IF WEB-IMP-STATUS-OK-88 DTSBX417 +02126 ADD +1 TO W-WEB-IMP-CNT DTSBX417 +02127 ELSE DTSBX417 +02128 IF WEB-IMP-STATUS-EOF-88 DTSBX417 +02129 DISPLAY 'ENE OF WEB-IMP-FILE ' WEB-IMP-STATUS CL**3 +02130 ELSE DTSBX417 +02131 DISPLAY 'CANNOT READ WEB-IMP-FILE ' WEB-IMP-STATUS DTSBX417 +02132 SET W-ERROR-YES-88 TO TRUE DTSBX417 +02133 END-IF DTSBX417 +02134 END-IF. DTSBX417 +02135 DTSBX417 +02136 * DISPLAY 'S1000-READ WEB ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*12 +02137 DTSBX417 +02138 S1000-EXIT. DTSBX417 +02139 EXIT. DTSBX417 +02140 DTSBX417 +02141 S999-ABEND. DTSBX417 +02142 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX417 +02143 S999-EXIT. DTSBX417 +02144 EXIT. DTSBX417 +02145 DTSBX417 diff --git a/Batch/DTSBX418.cob b/Batch/DTSBX418.cob new file mode 100644 index 0000000..eefb077 --- /dev/null +++ b/Batch/DTSBX418.cob @@ -0,0 +1,2137 @@ +00001 IDENTIFICATION DIVISION. 04/03/15 +00002 PROGRAM-ID. DTSBX418. DTSBX418 +00003 AUTHOR. NGC. LV051 +00004 DATE-WRITTEN. APRIL 2005. DTSBX418 +00005 DATE-COMPILED. DTSBX418 +00006 SKIP3 DTSBX418 +00007 ***** DTSBX418 +00008 * DTSBX418 +00009 * FUNCTION: WEB REGISTRATION IMPORT DRIVER DTSBX418 +00010 * READ DATA PASSED FROM WEB APPLICATION SERVER DTSBX418 +00011 * AND CALL THE APPROPRIATE PROCESSING PROGRAM DTSBX418 +00012 * FOR REGISTRATIONS, REPORTS, PAYMENTS OR DTSBX418 +00013 * PROFILE UPDATES. DTSBX418 +00014 * DTSBX418 +00015 * ACCOUNTING BATCH HEADERS, REPORTS AND PAYMENTS DTSBX418 +00016 * COMING FROM THE IN-HOUSE CASHIERING PROCESS ARE DTSBX418 +00017 * PROCESSED LAST. IN THE SORT KEY, THE FIRST DTSBX418 +00018 * ELEMENT (USED FOR THE EMPLOYER NUMBER FOR OTHER DTSBX418 +00019 * PROCESSES) IS SET TO 999999. DTSBX418 +00020 * DTSBX418 +00021 * MODIFICATION HISTORY: DTSBX418 +00022 * DTSBX418 +00023 * 07-23-2007 INITIAL DEVELOPMENT DTSBX418 +00024 * REFERENCE RFP: WEB REPORTING DTSBX418 +00025 * DTSBX418 +00026 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSBX418 +00027 * THE NEW RECORD INCLUDES EMPLOYEE NAME. DTSBX418 +00028 * REFERENCE RFP: WEB REPORTING DTSBX418 +00029 * DTSBX418 +00030 * 05-28-2010 MODIFIED FOR IN-HOUSE CHECK-SCANNING AND DTSBX418 +00031 * CASHIERING PROCESS. DTSBX418 +00032 * REFERENCE RFP: GD DTSBX418 +00033 * DTSBX418 +00034 * CL*23 +00035 * 10-22-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00036 * CHANGED SORT SEQUENCE FOR PROCESS X104 RECORDS CL*23 +00037 * BEFORE PROCESSING NAMES X106. CL*23 +00038 * RECORDS 102 AND 106 MUST BE PRESENT TO ADD A CL*23 +00039 * NEW EMPLOYER TO DUTAS. IF X102 AND X104 PASS CL*23 +00040 * ALL EDITS THEN NAME RECORD X106 RATE X108 AND CL*23 +00041 * ADDRESS X110 MUST BE PRESENT FOR EMPLOYER TO ADD CL*23 +00042 * CL*23 +00043 * REFERENCE RFP: ZL1 CL*23 +00044 * CL*23 +00045 * DTSBX418 +00046 * 11-01-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00047 * MODIFIED PROGRAM TO CALL A NEW PROGRAM BX430 TO CL*23 +00048 * PROCESS REPORTS,WAGES AND PAYMENTS. CL*23 +00049 * REPORTS X140 COMING FROM ESSP CANNOT BE PROCESSED CL*23 +00050 * UNTIL A PAYMENT X145 IS PRESENT UNLESS IT IS A CL*23 +00051 * ZERO WAGE REPORT (REMIT AMT = 0). ALSO CHANGED CL*23 +00052 * THE SORT SEQ TO SORT PAYMENT X145 BEFORE X140 CL*23 +00053 * PREVIOUS SORT KEY WAS 30 NOW 19. CL*23 +00054 * REFERENCE RFP: ZL1 CL*23 +00055 * CL*23 +00056 * CL*23 +00057 * 11-24-2014 MODIFIED FOR ESSP INTERFACE CL*40 +00058 * MODIFIED PROGRAM TO MOVE ESSP IMPORT RECORDS TYPE CL*40 +00059 * X120 TO A WORKING COPY OF DUTAS X120 CL*40 +00060 * FIELDS ON THE INPUT RECORD IS LARGER THAT DUTAS CL*40 +00061 * FIELDS. WITH NO PHARSING FIELD LENGTHS ARE CL*40 +00062 * THE EDITS TO FAILING. CL*40 +00063 * REFERENCE RFP: ESSP REGISTRTION ZL1 CL*40 +00064 * CL*40 +00065 * CL*40 +00066 ***** DTSBX418 +00067 SKIP3 DTSBX418 +00068 ENVIRONMENT DIVISION. DTSBX418 +00069 SKIP2 DTSBX418 +00070 INPUT-OUTPUT SECTION. DTSBX418 +00071 DTSBX418 +00072 FILE-CONTROL. DTSBX418 +00073 DTSBX418 +00074 SELECT WEB-IMP-FILE ASSIGN TO WEBREG DTSBX418 +00075 FILE STATUS IS WEB-IMP-STATUS. DTSBX418 +00076 DTSBX418 +00077 ** SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBX418 +00078 ** FILE STATUS IS BATCH-STATUS. DTSBX418 +00079 DTSBX418 +00080 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSBX418 +00081 DTSBX418 +00082 DATA DIVISION. DTSBX418 +00083 DTSBX418 +00084 FILE SECTION. DTSBX418 +00085 DTSBX418 +00086 FD WEB-IMP-FILE DTSBX418 +00087 RECORDING MODE IS F DTSBX418 +00088 BLOCK CONTAINS 0 RECORDS DTSBX418 +00089 LABEL RECORDS ARE OMITTED. DTSBX418 +00090 DTSBX418 +00091 01 WEB-IMP-REC. DTSBX418 +00092 05 WEB-IMP-TYPE PIC X(03). DTSBX418 +00093 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. DTSBX418 +00094 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. DTSBX418 +00095 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. DTSBX418 +00096 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. DTSBX418 +00097 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. DTSBX418 +00098 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. DTSBX418 +00099 88 WEB-IMP-TYPE-REL-88 VALUE '130'. DTSBX418 +00100 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. DTSBX418 +00101 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. DTSBX418 +00102 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. DTSBX418 +00103 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. DTSBX418 +00104 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. DTSBX418 +00105 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' DTSBX418 +00106 '108' '130' '132'. DTSBX418 +00107 88 WEB-TYPE-RPT-88 VALUE '140' '144'. DTSBX418 +00108 88 WEB-TYPE-PAY-88 VALUE '145'. DTSBX418 +00109 88 WEB-TYPE-PRF-88 VALUE '110' '120'. DTSBX418 +00110 05 FILLER PIC X(01). DTSBX418 +00111 05 WEB-IMP-EMP-NO PIC 9(06). DTSBX418 +00112 05 FILLER PIC X(01). DTSBX418 +00113 05 WEB-IMP-QTR PIC X(06). DTSBX418 +00114 05 FILLER PIC X(495). DTSBX418 +00115 DTSBX418 +00116 *FD CURR-BATCH-NO DTSBX418 +00117 * RECORDING MODE IS F DTSBX418 +00118 * BLOCK CONTAINS 0 RECORDS DTSBX418 +00119 * LABEL RECORDS ARE OMITTED. DTSBX418 +00120 * DTSBX418 +00121 *01 CURR-BATCH-NO-REC. DTSBX418 +00122 * 05 CURRENT-BATCH-NO PIC 9(05). DTSBX418 +00123 * 05 CURRENT-ITEM-NO PIC 9(03). DTSBX418 +00124 * 05 FILLER PIC X(01). DTSBX418 +00125 * 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBX418 +00126 * 05 FILLER PIC X(01). DTSBX418 +00127 * 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBX418 +00128 * 05 FILLER PIC X(62). DTSBX418 +00129 DTSBX418 +00130 SD SORT-FILE. DTSBX418 +00131 DTSBX418 +00132 01 SORT-REC. DTSBX418 +00133 05 SORT-KEY. DTSBX418 +00134 10 SORT-EMP-NO PIC 9(06). DTSBX418 +00135 10 SORT-SEQ1 PIC S9(04) COMP. DTSBX418 +00136 10 SORT-SEQ2 PIC X(16). DTSBX418 +00137 05 IN-HOUSE-SORT-KEY REDEFINES SORT-KEY. DTSBX418 +00138 10 SORT-IN-HOUSE-SEQ PIC 9(06). DTSBX418 +00139 10 SORT-BATCH PIC 9(05). DTSBX418 +00140 10 SORT-ITEM PIC 9(03). DTSBX418 +00141 10 SORT-FILLER PIC X(10). DTSBX418 +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 +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 +00148 01 WRK-AREA. DTSBX418 +00149 05 W-ABEND-CD PIC S9(04) COMP VALUE 418. CL*49 +00150 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX418'. CL*49 +00151 DTSBX418 +00152 05 WEB-IMP-STATUS PIC X(02). DTSBX418 +00153 88 WEB-IMP-STATUS-OK-88 VALUE '00'. DTSBX418 +00154 88 WEB-IMP-STATUS-EOF-88 VALUE '10'. DTSBX418 +00155 DTSBX418 +00156 ** 05 BATCH-STATUS PIC X(02). DTSBX418 +00157 * 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX418 +00158 ** 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX418 +00159 DTSBX418 +00160 05 SORT-EOF-IND PIC X(01). DTSBX418 +00161 88 SORT-OK-88 VALUE '0'. DTSBX418 +00162 88 SORT-EOF-88 VALUE '1'. DTSBX418 +00163 DTSBX418 +00164 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX418 +00165 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX418 +00166 88 W-ERROR-NO-88 VALUE 'N'. DTSBX418 +00167 DTSBX418 +00168 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX418 +00169 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX418 +00170 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX418 +00171 DTSBX418 +00172 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX418 +00173 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX418 +00174 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX418 +00175 05 W-LAST-RATE-YEAR PIC 9(04). DTSBX418 +00176 05 X102-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00177 DTSBX418 +00178 05 SUB PIC S9(04) COMP. DTSBX418 +00179 ** 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX418 +00180 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX418 +00181 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX418 +00182 ** 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX418 +00183 DTSBX418 +00184 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX418 +00185 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX418 +00186 DTSBX418 +00187 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX418 +00188 DTSBX418 +00189 05 W-500-DATE. DTSBX418 +00190 10 W-500-DATE-MM PIC XX. DTSBX418 +00191 10 FILLER PIC X. DTSBX418 +00192 10 W-500-DATE-DD PIC XX. DTSBX418 +00193 10 FILLER PIC X. DTSBX418 +00194 10 W-500-DATE-YY PIC XXXX. DTSBX418 +00195 DTSBX418 +00196 05 W-500-FQTR. DTSBX418 +00197 10 W-500-FQTR-YY PIC XXXX. DTSBX418 +00198 10 FILLER PIC X VALUE '/'. DTSBX418 +00199 10 W-500-FQTR-NO PIC X. DTSBX418 +00200 DTSBX418 +00201 05 W-INT-9 PIC 9(13). DTSBX418 +00202 05 W-INT-X REDEFINES W-INT-9 DTSBX418 +00203 PIC X(13). DTSBX418 +00204 05 W-INTEGER PIC S9(11) COMP-3. DTSBX418 +00205 05 W-FRACTION PIC SV9(11) COMP-3. DTSBX418 +00206 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBX418 +00207 DTSBX418 +00208 ** 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSBX418 +00209 * VALUE +0. DTSBX418 +00210 * 05 W-DIGIT PIC 9. DTSBX418 +00211 * 05 W-AMT PIC S9(09)V99 COMP-3 DTSBX418 +00212 * VALUE +0. DTSBX418 +00213 * DTSBX418 +00214 * 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX418 +00215 * 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX418 +00216 * 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX418 +00217 * DTSBX418 +00218 * 05 W-WAGES PIC S9(11)V99. DTSBX418 +00219 * 05 W-WAGES-X PIC X(14). DTSBX418 +00220 * 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX418 +00221 * PIC 9(11).99. DTSBX418 +00222 * 05 W-REMIT-X PIC X(12). DTSBX418 +00223 * 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX418 +00224 * PIC 9(09).99. DTSBX418 +00225 05 W-TRACE-X. DTSBX418 +00226 10 W-TRACE-A PIC X(05) VALUE '00000'. DTSBX418 +00227 10 W-TRACE-B PIC X(08) VALUE ZEROS. DTSBX418 +00228 05 W-TRACE-9 REDEFINES W-TRACE-X DTSBX418 +00229 PIC 9(13). DTSBX418 +00230 * 05 W-COUNT-X PIC X(07). DTSBX418 +00231 * 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX418 +00232 * PIC 9(07). DTSBX418 +00233 * 05 W-EARNINGS-X PIC X(12). DTSBX418 +00234 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX418 +00235 * PIC 9(09).99. DTSBX418 +00236 * 05 W-EARNINGS PIC S9(07)V99. DTSBX418 +00237 * 05 W-RATE PIC S9V9(04). DTSBX418 +00238 * 05 W-RATE-X PIC X(06). DTSBX418 +00239 * 05 W-RATE-9 REDEFINES W-RATE-X DTSBX418 +00240 * PIC 9.9999. DTSBX418 +00241 * DTSBX418 +00242 * 05 ISUB1 PIC S9(04) COMP. DTSBX418 +00243 * 05 ISUB2 PIC S9(04) COMP. DTSBX418 +00244 * 05 ISUB3 PIC S9(04) COMP. DTSBX418 +00245 * 05 ISUB4 PIC S9(04) COMP. DTSBX418 +00246 * 05 ISUB5 PIC S9(04) COMP. DTSBX418 +00247 * 05 ISUB6 PIC S9(04) COMP. DTSBX418 +00248 * 05 W-SLASH1 PIC S9(04) COMP. DTSBX418 +00249 * 05 W-SLASH2 PIC S9(04) COMP. DTSBX418 +00250 * 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX418 +00251 * 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX418 +00252 * 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX418 +00253 * 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX418 +00254 * VALUE +502. DTSBX418 +00255 * 05 W-INPUT-LINE PIC X(500). DTSBX418 +00256 * 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX418 +00257 * 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX418 +00258 * 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX418 +00259 * 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX418 +00260 * 05 W-CONV-LINE PIC X(32). DTSBX418 +00261 * DTSBX418 +00262 * 05 W-MDY PIC X(04). DTSBX418 +00263 * 05 FILLER REDEFINES W-MDY. DTSBX418 +00264 * 10 FILLER PIC X(02). DTSBX418 +00265 * 10 W-MDY-X-2 PIC X(02). DTSBX418 +00266 * 10 FILLER REDEFINES W-MDY-X-2. DTSBX418 +00267 * 15 FILLER PIC X(01). DTSBX418 +00268 ** 15 W-MDY-X-1 PIC X(01). DTSBX418 +00269 DTSBX418 +00270 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX418 +00271 05 W-102-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00272 05 W-104-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00273 05 W-106-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00274 05 W-108-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00275 05 W-110-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00276 05 W-120-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00277 05 W-140-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00278 05 W-144-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00279 05 W-145-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00280 DTSBX418 +00281 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX418 +00282 DTSBX418 +00283 05 W-AMT-DISP1 PIC ----------9.99. DTSBX418 +00284 05 W-AMT-DISP2 PIC ----------9.99. DTSBX418 +00285 05 W-AMT-DISP4 PIC -.99999999999. DTSBX418 +00286 05 W-AMT-DISP3 PIC ------------9. DTSBX418 +00287 DTSBX418 +00288 * PROFILE DTSBX418 +00289 01 X102-REC. DTSBX418 +00290 ++INCLUDE DTSIX102 DTSBX418 +00291 DTSBX418 +00292 * DETERMINATION DTSBX418 +00293 01 X104-REC. DTSBX418 +00294 ++INCLUDE DTSIX104 DTSBX418 +00295 DTSBX418 +00296 * NAME DTSBX418 +00297 01 X106-REC. DTSBX418 +00298 ++INCLUDE DTSIX106 DTSBX418 +00299 DTSBX418 +00300 * RATE DTSBX418 +00301 01 X108-REC. DTSBX418 +00302 ++INCLUDE DTSIX108 DTSBX418 +00303 DTSBX418 +00304 * ADDRESS DTSBX418 +00305 01 X110-REC. DTSBX418 +00306 ++INCLUDE DTSIX110 DTSBX418 +00307 DTSBX418 +00308 * OPO DTSBX418 +00309 01 X120-REC. DTSBX418 +00310 ++INCLUDE DTSIX120 DTSBX418 +00311 DTSBX418 +00312 * WORKING COPY OF X120 CL*41 +00313 01 W120-REC. CL*41 +00314 ++INCLUDE DTSWX120 CL*43 +00315 CL*41 +00316 * RELATIONSHIP DTSBX418 +00317 01 X130-REC. DTSBX418 +00318 ++INCLUDE DTSIX130 DTSBX418 +00319 DTSBX418 +00320 ** INDUSTRY DESCRIPTION DTSBX418 +00321 *01 X132-REC. DTSBX418 +00322 ***INCLUDE DTSIX132 DTSBX418 +00323 DTSBX418 +00324 * REPORT DTSBX418 +00325 01 X140-REC. DTSBX418 +00326 ++INCLUDE DTSIX140 DTSBX418 +00327 DTSBX418 +00328 * EMPLOYEE WAGES DTSBX418 +00329 01 X144-REC. DTSBX418 +00330 ++INCLUDE DTSIX144 DTSBX418 +00331 DTSBX418 +00332 * PAYMENT DTSBX418 +00333 01 X145-REC. DTSBX418 +00334 ++INCLUDE DTSIX145 DTSBX418 +00335 DTSBX418 +00336 01 X149-REC. DTSBX418 +00337 ++INCLUDE DTSIX149 DTSBX418 +00338 DTSBX418 +00339 01 L001-LINK-AREA. DTSBX418 +00340 ++INCLUDE DTSIL001 DTSBX418 +00341 DTSBX418 +00342 01 L003-LINK-AREA. DTSBX418 +00343 ++INCLUDE DTSIL003 DTSBX418 +00344 DTSBX418 +00345 01 L004-LINK-AREA. DTSBX418 +00346 ++INCLUDE DTSIL004 DTSBX418 +00347 DTSBX418 +00348 01 L005-LINK-AREA. DTSBX418 +00349 ++INCLUDE DTSIL005 DTSBX418 +00350 DTSBX418 +00351 01 L205-LINK-AREA. DTSBX418 +00352 ++INCLUDE DTSIL205 DTSBX418 +00353 DTSBX418 +00354 01 LX42-LINK-AREA. DTSBX418 +00355 ++INCLUDE DTSILX42 CL*39 +00356 DTSBX418 +00357 01 L910-LINK-AREA. DTSBX418 +00358 ++INCLUDE DTSIL910 DTSBX418 +00359 01 MSKL-REC. DTSBX418 +00360 ++INCLUDE DTSIMSKL DTSBX418 +00361 DTSBX418 +00362 01 MHDR-REC. DTSBX418 +00363 ++INCLUDE DTSIMHDR DTSBX418 +00364 DTSBX418 +00365 01 MPRF-REC. DTSBX418 +00366 ++INCLUDE DTSIMPRF DTSBX418 +00367 DTSBX418 +00368 01 MSOL-REC. DTSBX418 +00369 ++INCLUDE DTSIMSOL DTSBX418 +00370 DTSBX418 +00371 01 MQTR-REC. DTSBX418 +00372 ++INCLUDE DTSIMQTR DTSBX418 +00373 DTSBX418 +00374 01 MOPO-REC. DTSBX418 +00375 ++INCLUDE DTSIMOPO DTSBX418 +00376 DTSBX418 +00377 01 MTAD-REC. DTSBX418 +00378 ++INCLUDE DTSIMTAD DTSBX418 +00379 DTSBX418 +00380 01 MNTE-REC. DTSBX418 +00381 ++INCLUDE DTSIMNTE DTSBX418 +00382 DTSBX418 +00383 01 L921-LINK-AREA. DTSBX418 +00384 ++INCLUDE DTSIL921 DTSBX418 +00385 SKIP3 DTSBX418 +00386 01 ISKL-REC. DTSBX418 +00387 ++INCLUDE DTSIISKL DTSBX418 +00388 SKIP3 DTSBX418 +00389 01 IEIN-REC. DTSBX418 +00390 ++INCLUDE DTSIIEIN DTSBX418 +00391 DTSBX418 +00392 01 L923-LINK-AREA. DTSBX418 +00393 ++INCLUDE DTSIL923 DTSBX418 +00394 EJECT DTSBX418 +00395 01 ASKL-REC. DTSBX418 +00396 ++INCLUDE DTSIASKL DTSBX418 +00397 EJECT DTSBX418 +00398 01 AHDR-REC. DTSBX418 +00399 ++INCLUDE DTSIAHDR DTSBX418 +00400 DTSBX418 +00401 01 ARPT-REC. DTSBX418 +00402 ++INCLUDE DTSIARPT DTSBX418 +00403 DTSBX418 +00404 01 APAY-REC. DTSBX418 +00405 ++INCLUDE DTSIAPAY DTSBX418 +00406 DTSBX418 +00407 DTSBX418 +00408 01 L927-LINK-AREA. DTSBX418 +00409 ++INCLUDE DTSIL927 DTSBX418 +00410 DTSBX418 +00411 01 TSKL-REC. DTSBX418 +00412 ++INCLUDE DTSITSKL DTSBX418 +00413 DTSBX418 +00414 01 L931-LINK-AREA. DTSBX418 +00415 ++INCLUDE DTSIL931 DTSBX418 +00416 DTSBX418 +00417 01 FSKL-REC. DTSBX418 +00418 ++INCLUDE DTSIFSKL DTSBX418 +00419 DTSBX418 +00420 PROCEDURE DIVISION. DTSBX418 +00421 DTSBX418 +00422 DTSBX418-MAIN. CL*49 +00423 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX418 +00424 IF W-FATAL-ERROR-YES-88 DTSBX418 +00425 GO TO DTSBX418-MAIN-EXIT CL*49 +00426 END-IF. DTSBX418 +00427 DTSBX418 +00428 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX418 +00429 DTSBX418 +00430 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX418 +00431 IF W-ERROR-YES-88 DTSBX418 +00432 MOVE +2 TO RETURN-CODE. DTSBX418 +00433 DTSBX418-MAIN-EXIT. CL*49 +00434 GOBACK. DTSBX418 +00435 EJECT DTSBX418 +00436 I0000-INITIATE. DTSBX418 +00437 SET W-ERROR-NO-88 TO TRUE. DTSBX418 +00438 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX418 +00439 DTSBX418 +00440 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX418 +00441 DTSBX418 +00442 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX418 +00443 IF W-FATAL-ERROR-YES-88 DTSBX418 +00444 GO TO I0000-EXIT DTSBX418 +00445 END-IF. DTSBX418 +00446 DTSBX418 +00447 PERFORM I3000-READ-HEADER THRU I3000-EXIT. DTSBX418 +00448 IF W-FATAL-ERROR-YES-88 DTSBX418 +00449 GO TO I0000-EXIT DTSBX418 +00450 END-IF. DTSBX418 +00451 DTSBX418 +00452 ** PERFORM I4000-CURRENT-BATCH THRU I4000-EXIT DTSBX418 +00453 * IF W-FATAL-ERROR-YES-88 DTSBX418 +00454 * GO TO I0000-EXIT DTSBX418 +00455 ** END-IF. DTSBX418 +00456 DTSBX418 +00457 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSBX418 +00458 DTSBX418 +00459 I0000-EXIT. DTSBX418 +00460 EXIT. DTSBX418 +00461 DTSBX418 +00462 I2000-OPEN-FILES. DTSBX418 +00463 OPEN INPUT WEB-IMP-FILE. DTSBX418 +00464 IF NOT WEB-IMP-STATUS-OK-88 DTSBX418 +00465 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 +00466 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX418 +00467 MOVE +3 TO RETURN-CODE DTSBX418 +00468 SET W-ERROR-YES-88 TO TRUE DTSBX418 +00469 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX418 +00470 WEB-IMP-STATUS DTSBX418 +00471 GO TO I2000-EXIT DTSBX418 +00472 END-IF. DTSBX418 +00473 DTSBX418 +00474 READ WEB-IMP-FILE. DTSBX418 +00475 IF NOT WEB-IMP-STATUS-OK-88 DTSBX418 +00476 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 +00477 DISPLAY 'NO ESSP FTP UPDATE FILES TO PROCESS' DTSBX418 +00478 MOVE +3 TO RETURN-CODE DTSBX418 +00479 SET W-ERROR-YES-88 TO TRUE DTSBX418 +00480 DISPLAY 'NO RECORDS ON WEB-IMP-FILE ' DTSBX418 +00481 WEB-IMP-STATUS DTSBX418 +00482 GO TO I2000-EXIT DTSBX418 +00483 END-IF. DTSBX418 +00484 CLOSE WEB-IMP-FILE. DTSBX418 +00485 OPEN INPUT WEB-IMP-FILE. DTSBX418 +00486 IF NOT WEB-IMP-STATUS-OK-88 DTSBX418 +00487 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 +00488 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX418 +00489 MOVE +3 TO RETURN-CODE DTSBX418 +00490 SET W-ERROR-YES-88 TO TRUE DTSBX418 +00491 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX418 +00492 WEB-IMP-STATUS DTSBX418 +00493 GO TO I2000-EXIT DTSBX418 +00494 END-IF. DTSBX418 +00495 DTSBX418 +00496 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX418 +00497 DTSBX418 +00498 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX418 +00499 DTSBX418 +00500 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBX418 +00501 DTSBX418 +00502 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX418 +00503 DTSBX418 +00504 * MOVE 'N' TO L927-TRACE-IND. CL*44 +00505 * MOVE W-MOD-NAME TO L927-MOD-NAME. CL*44 +00506 * PERFORM S927A-OPEN THRU S927A-EXIT. CL*44 +00507 DTSBX418 +00508 I2000-EXIT. DTSBX418 +00509 EXIT. DTSBX418 +00510 DTSBX418 +00511 I3000-READ-HEADER. DTSBX418 +00512 MOVE LOW-VALUES TO MSKL-REC. DTSBX418 +00513 MOVE +0 TO MSKL-EMP-NO. DTSBX418 +00514 SET MSKL-HDR-88 TO TRUE. DTSBX418 +00515 DTSBX418 +00516 PERFORM S910-READ THRU S910-EXIT. DTSBX418 +00517 IF L910-NO-REC-88 DTSBX418 +00518 DISPLAY 'DTSBX418: MHDR RECORD IS MISSING' CL*49 +00519 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 +00520 MOVE +6 TO RETURN-CODE DTSBX418 +00521 GO TO I3000-EXIT DTSBX418 +00522 ELSE DTSBX418 +00523 MOVE MSKL-REC TO MHDR-REC DTSBX418 +00524 END-IF. DTSBX418 +00525 DTSBX418 +00526 MOVE MHDR-CURR-RUN-DATE TO W-CURR-RUN-DATE. DTSBX418 +00527 DTSBX418 +00528 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBX418 +00529 MOVE L004-QTR-5-YR TO W-LAST-RATE-YEAR. DTSBX418 +00530 DISPLAY 'LAST RATE YEAR ' W-LAST-RATE-YEAR. DTSBX418 +00531 DTSBX418 +00532 I3000-EXIT. DTSBX418 +00533 EXIT. DTSBX418 +00534 DTSBX418 +00535 *I4000-CURRENT-BATCH. DTSBX418 +00536 * OPEN I-O CURR-BATCH-NO. DTSBX418 +00537 * IF NOT BATCH-STATUS-OK-88 DTSBX418 +00538 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 +00539 * DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBX418 +00540 * BATCH-STATUS DTSBX418 +00541 * GO TO I4000-EXIT DTSBX418 +00542 * END-IF. DTSBX418 +00543 * DTSBX418 +00544 * READ CURR-BATCH-NO DTSBX418 +00545 * IF BATCH-STATUS-OK-88 DTSBX418 +00546 * DISPLAY 'OLD BATCH ' CURRENT-BATCH-NO DTSBX418 +00547 * COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBX418 +00548 * MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBX418 +00549 * MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBX418 +00550 * DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBX418 +00551 * DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBX418 +00552 * ELSE DTSBX418 +00553 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX418 +00554 * DISPLAY 'CANNOT READ CURR BATCH NUMBER FILE ' DTSBX418 +00555 * BATCH-STATUS DTSBX418 +00556 * GO TO I4000-EXIT DTSBX418 +00557 * END-IF. DTSBX418 +00558 * DTSBX418 +00559 *I4000-EXIT. DTSBX418 +00560 * EXIT. DTSBX418 +00561 DTSBX418 +00562 I5000-INITIAL-CALLS. DTSBX418 +00563 DISPLAY '!!!!! BX418- INITILIZE RECORDS START BX418' CL*49 +00564 SET LX42-INITIALIZE-88 TO TRUE. DTSBX418 +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 +00570 LX42-LAST-DETERM-EMP DTSBX418 +00571 LX42-RPT-CNT DTSBX418 +00572 LX42-RPT-REMIT-AMT DTSBX418 +00573 LX42-PAY-CNT DTSBX418 +00574 LX42-PAY-REMIT-AMT. DTSBX418 +00575 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX418 +00576 SET LX42-ERROR-NO-88 TO TRUE. DTSBX418 +00577 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +00578 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX418 +00579 DTSBX418 +00580 MOVE ZERO TO W-102-IMP-CNT CL*38 +00581 W-104-IMP-CNT CL*38 +00582 W-106-IMP-CNT CL*38 +00583 W-108-IMP-CNT CL*38 +00584 W-110-IMP-CNT CL*38 +00585 W-120-IMP-CNT CL*38 +00586 W-140-IMP-CNT CL*38 +00587 W-144-IMP-CNT CL*38 +00588 W-145-IMP-CNT. CL*38 +00589 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*45 +00590 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +00591 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +00592 * PERFORM S424-PROFILE THRU S424-EXIT. CL*45 +00593 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX418 +00594 DTSBX418 +00595 I5000-EXIT. DTSBX418 +00596 EXIT. DTSBX418 +00597 DTSBX418 +00598 DTSBX418 +00599 P0000-PROCESS. DTSBX418 +00600 DISPLAY '!!!! BX418- START WEB IMPORT PRELIMINARY EDIT'. CL*49 +00601 DISPLAY SPACE. DTSBX418 +00602 DTSBX418 +00603 SET W-ERROR-NO-88 TO TRUE. DTSBX418 +00604 DTSBX418 +00605 SORT SORT-FILE DTSBX418 +00606 ON ASCENDING KEY SORT-KEY DTSBX418 +00607 INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT DTSBX418 +00608 OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT. DTSBX418 +00609 DTSBX418 +00610 IF SORT-RETURN NOT = +0 DTSBX418 +00611 DISPLAY 'SORT FAILED ' SORT-RETURN DTSBX418 +00612 END-IF. DTSBX418 +00613 DTSBX418 +00614 P0000-EXIT. DTSBX418 +00615 EXIT. DTSBX418 +00616 DTSBX418 +00617 DTSBX418 +00618 P1000-PRE-SORT. DTSBX418 +00619 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT. DTSBX418 +00620 PERFORM UNTIL WEB-IMP-STATUS-EOF-88 DTSBX418 +00621 PERFORM P1100-PARSE-IMPORT-REC THRU P1100-EXIT DTSBX418 +00622 PERFORM P1200-BUILD-SORT-REC THRU P1200-EXIT DTSBX418 +00623 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT DTSBX418 +00624 END-PERFORM. DTSBX418 +00625 DTSBX418 +00626 DISPLAY '!!!!! BX418- ENDOF INPUT SORT PROCEDURE ****'. CL*49 +00627 P1000-EXIT. DTSBX418 +00628 EXIT. DTSBX418 +00629 DTSBX418 +00630 P1100-PARSE-IMPORT-REC. DTSBX418 +00631 IF WEB-IMP-TYPE-BHDR-88 DTSBX418 +00632 DISPLAY 'BX418 P1000 HDR ' WEB-IMP-REC(1:14) CL*49 +00633 END-IF. DTSBX418 +00634 CL*20 +00635 * DISPLAY 'P1000 ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*21 +00636 DTSBX418 +00637 PERFORM DTSBX418 +00638 VARYING SUB FROM +1 BY +1 DTSBX418 +00639 UNTIL SUB > +100 DTSBX418 +00640 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX418 +00641 L205-INTEGER (SUB) DTSBX418 +00642 L205-FRACTION (SUB) DTSBX418 +00643 MOVE SPACES TO L205-TEXT (SUB) DTSBX418 +00644 L205-DATE (SUB) DTSBX418 +00645 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX418 +00646 END-PERFORM. DTSBX418 +00647 DTSBX418 +00648 EVALUATE TRUE DTSBX418 +00649 * WHEN WEB-IMP-TYPE-PRF-88 CL*45 +00650 * PERFORM P1100A-PRF THRU P1100A-EXIT CL*45 +00651 DTSBX418 +00652 * WHEN WEB-IMP-TYPE-DETERM-88 CL*45 +00653 * PERFORM P1100B-DETERM THRU P1100B-EXIT CL*45 +00654 DTSBX418 +00655 * WHEN WEB-IMP-TYPE-NAME-88 CL*45 +00656 * PERFORM P1100C-NAME THRU P1100C-EXIT CL*45 +00657 DTSBX418 +00658 * WHEN WEB-IMP-TYPE-RATE-88 CL*45 +00659 * PERFORM P1100D-RATE THRU P1100D-EXIT CL*45 +00660 DTSBX418 +00661 * WHEN WEB-IMP-TYPE-ADDR-88 CL*45 +00662 * PERFORM P1100E-ADDR THRU P1100E-EXIT CL*45 +00663 DTSBX418 +00664 * WHEN WEB-IMP-TYPE-OPO-88 CL*45 +00665 * PERFORM P1100F-OPO THRU P1100F-EXIT CL*45 +00666 DTSBX418 +00667 * WHEN WEB-IMP-TYPE-REL-88 CL*45 +00668 * PERFORM P1100G-REL THRU P1100G-EXIT CL*45 +00669 DTSBX418 +00670 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX418 +00671 * PERFORM P1100X-IND THRU P1100X-EXIT DTSBX418 +00672 * INITIALIZE X132-REC DTSBX418 +00673 * MOVE +4 TO L205-LAST-FIELD DTSBX418 +00674 *** MOVE +500 TO L205-LAST-FIELD-LEN DTSBX418 +00675 DTSBX418 +00676 WHEN WEB-IMP-TYPE-RPT-88 DTSBX418 +00677 PERFORM P1100H-RPT THRU P1100H-EXIT DTSBX418 +00678 DTSBX418 +00679 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX418 +00680 PERFORM P1100I-WAGE THRU P1100I-EXIT DTSBX418 +00681 DTSBX418 +00682 WHEN WEB-IMP-TYPE-PAY-88 DTSBX418 +00683 PERFORM P1100J-PAY THRU P1100J-EXIT DTSBX418 +00684 DTSBX418 +00685 * WHEN WEB-IMP-TYPE-BHDR-88 DTSBX418 +00686 * PERFORM P1100K-BATCH-HEADER THRU P1100K-EXIT DTSBX418 +00687 DTSBX418 +00688 END-EVALUATE. DTSBX418 +00689 DTSBX418 +00690 * MOVE WEB-IMP-REC TO L205-INPUT-DATA. CL*45 +00691 * CALL 'DTSBU205' USING L205-LINK-AREA. CL*45 +00692 DTSBX418 +00693 P1100-EXIT. DTSBX418 +00694 EXIT. DTSBX418 +00695 DTSBX418 +00696 P1100A-PRF. DTSBX418 +00697 INITIALIZE X102-REC DTSBX418 +00698 MOVE +7 TO L205-LAST-FIELD DTSBX418 +00699 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX418 +00700 DTSBX418 +00701 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +00702 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +00703 DTSBX418 +00704 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +00705 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +00706 DTSBX418 +00707 MOVE +9 TO L205-FIELD-LENGTH (3). DTSBX418 +00708 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +00709 DTSBX418 +00710 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX418 +00711 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +00712 DTSBX418 +00713 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX418 +00714 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 +00715 DTSBX418 +00716 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX418 +00717 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBX418 +00718 DTSBX418 +00719 MOVE +1 TO L205-FIELD-LENGTH (7). DTSBX418 +00720 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 +00721 DTSBX418 +00722 P1100A-EXIT. DTSBX418 +00723 EXIT. DTSBX418 +00724 DTSBX418 +00725 P1100B-DETERM. DTSBX418 +00726 INITIALIZE X104-REC DTSBX418 +00727 MOVE +18 TO L205-LAST-FIELD DTSBX418 +00728 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX418 +00729 DTSBX418 +00730 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +00731 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +00732 DTSBX418 +00733 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +00734 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +00735 DTSBX418 +00736 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX418 +00737 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +00738 DTSBX418 +00739 MOVE +2 TO L205-FIELD-LENGTH (4). DTSBX418 +00740 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX418 +00741 DTSBX418 +00742 MOVE +2 TO L205-FIELD-LENGTH (5). DTSBX418 +00743 SET L205-TYPE-NUMBER-88 (5) TO TRUE. DTSBX418 +00744 DTSBX418 +00745 MOVE +6 TO L205-FIELD-LENGTH (6). DTSBX418 +00746 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 +00747 DTSBX418 +00748 MOVE +3 TO L205-FIELD-LENGTH (7). DTSBX418 +00749 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 +00750 DTSBX418 +00751 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX418 +00752 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 +00753 DTSBX418 +00754 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX418 +00755 SET L205-TYPE-DATE-88 (9) TO TRUE. DTSBX418 +00756 DTSBX418 +00757 MOVE +1 TO L205-FIELD-LENGTH (10). DTSBX418 +00758 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 +00759 DTSBX418 +00760 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX418 +00761 SET L205-TYPE-DATE-88 (11) TO TRUE. DTSBX418 +00762 DTSBX418 +00763 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX418 +00764 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 +00765 DTSBX418 +00766 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX418 +00767 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 +00768 DTSBX418 +00769 MOVE +1 TO L205-FIELD-LENGTH (14). DTSBX418 +00770 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX418 +00771 DTSBX418 +00772 MOVE +1 TO L205-FIELD-LENGTH (15). DTSBX418 +00773 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX418 +00774 DTSBX418 +00775 MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX418 +00776 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX418 +00777 DTSBX418 +00778 MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX418 +00779 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX418 +00780 DTSBX418 +00781 MOVE +1 TO L205-FIELD-LENGTH (18). DTSBX418 +00782 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX418 +00783 DTSBX418 +00784 P1100B-EXIT. DTSBX418 +00785 EXIT. DTSBX418 +00786 DTSBX418 +00787 P1100C-NAME. DTSBX418 +00788 INITIALIZE X106-REC DTSBX418 +00789 MOVE +4 TO L205-LAST-FIELD DTSBX418 +00790 MOVE +40 TO L205-LAST-FIELD-LEN DTSBX418 +00791 DTSBX418 +00792 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +00793 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +00794 DTSBX418 +00795 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +00796 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +00797 DTSBX418 +00798 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX418 +00799 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +00800 DTSBX418 +00801 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX418 +00802 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +00803 DTSBX418 +00804 P1100C-EXIT. DTSBX418 +00805 EXIT. DTSBX418 +00806 DTSBX418 +00807 P1100D-RATE. DTSBX418 +00808 ** DISPLAY 'RATE P1100D ' WEB-IMP-REC (1:23). DTSBX418 +00809 DTSBX418 +00810 INITIALIZE X108-REC. DTSBX418 +00811 MOVE +4 TO L205-LAST-FIELD. DTSBX418 +00812 MOVE +6 TO L205-LAST-FIELD-LEN. DTSBX418 +00813 DTSBX418 +00814 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +00815 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +00816 DTSBX418 +00817 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +00818 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +00819 DTSBX418 +00820 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX418 +00821 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +00822 DTSBX418 +00823 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX418 +00824 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX418 +00825 DTSBX418 +00826 P1100D-EXIT. DTSBX418 +00827 EXIT. DTSBX418 +00828 DTSBX418 +00829 P1100E-ADDR. DTSBX418 +00830 INITIALIZE X110-REC. DTSBX418 +00831 MOVE +14 TO L205-LAST-FIELD. DTSBX418 +00832 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX418 +00833 DTSBX418 +00834 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +00835 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +00836 DTSBX418 +00837 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +00838 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +00839 DTSBX418 +00840 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX418 +00841 SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBX418 +00842 DTSBX418 +00843 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX418 +00844 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +00845 DTSBX418 +00846 MOVE +40 TO L205-FIELD-LENGTH (5). DTSBX418 +00847 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 +00848 DTSBX418 +00849 MOVE +40 TO L205-FIELD-LENGTH (6). DTSBX418 +00850 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 +00851 DTSBX418 +00852 MOVE +25 TO L205-FIELD-LENGTH (7). DTSBX418 +00853 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 +00854 DTSBX418 +00855 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX418 +00856 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 +00857 DTSBX418 +00858 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX418 +00859 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX418 +00860 DTSBX418 +00861 MOVE +15 TO L205-FIELD-LENGTH (10). DTSBX418 +00862 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 +00863 DTSBX418 +00864 MOVE +15 TO L205-FIELD-LENGTH (11). DTSBX418 +00865 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 +00866 DTSBX418 +00867 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX418 +00868 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 +00869 DTSBX418 +00870 MOVE +40 TO L205-FIELD-LENGTH (13). DTSBX418 +00871 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 +00872 DTSBX418 +00873 MOVE +40 TO L205-FIELD-LENGTH (14). DTSBX418 +00874 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX418 +00875 DTSBX418 +00876 P1100E-EXIT. DTSBX418 +00877 EXIT. DTSBX418 +00878 DTSBX418 +00879 P1100F-OPO. DTSBX418 +00880 INITIALIZE X120-REC. DTSBX418 +00881 MOVE +18 TO L205-LAST-FIELD. DTSBX418 +00882 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX418 +00883 DTSBX418 +00884 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +00885 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +00886 DTSBX418 +00887 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +00888 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +00889 DTSBX418 +00890 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX418 +00891 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +00892 DTSBX418 +00893 MOVE +40 TO L205-FIELD-LENGTH (4). CL*22 +00894 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +00895 DTSBX418 +00896 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX418 +00897 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 +00898 DTSBX418 +00899 MOVE +40 TO L205-FIELD-LENGTH (6). CL*22 +00900 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 +00901 DTSBX418 +00902 MOVE +40 TO L205-FIELD-LENGTH (7). DTSBX418 +00903 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 +00904 DTSBX418 +00905 MOVE +9 TO L205-FIELD-LENGTH (8). DTSBX418 +00906 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 +00907 DTSBX418 +00908 MOVE +40 TO L205-FIELD-LENGTH (9). DTSBX418 +00909 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX418 +00910 DTSBX418 +00911 MOVE +40 TO L205-FIELD-LENGTH (10). DTSBX418 +00912 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 +00913 DTSBX418 +00914 MOVE +40 TO L205-FIELD-LENGTH (11). DTSBX418 +00915 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 +00916 DTSBX418 +00917 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX418 +00918 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 +00919 DTSBX418 +00920 MOVE +25 TO L205-FIELD-LENGTH (13). DTSBX418 +00921 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 +00922 DTSBX418 +00923 MOVE +2 TO L205-FIELD-LENGTH (14). DTSBX418 +00924 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX418 +00925 DTSBX418 +00926 MOVE +10 TO L205-FIELD-LENGTH (15). DTSBX418 +00927 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX418 +00928 DTSBX418 +00929 MOVE +15 TO L205-FIELD-LENGTH (16). DTSBX418 +00930 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX418 +00931 DTSBX418 +00932 MOVE +16 TO L205-FIELD-LENGTH (17). CL*22 +00933 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX418 +00934 DTSBX418 +00935 MOVE +40 TO L205-FIELD-LENGTH (18). DTSBX418 +00936 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX418 +00937 DTSBX418 +00938 P1100F-EXIT. DTSBX418 +00939 EXIT. DTSBX418 +00940 DTSBX418 +00941 P1100G-REL. DTSBX418 +00942 INITIALIZE X130-REC. DTSBX418 +00943 MOVE +16 TO L205-LAST-FIELD. DTSBX418 +00944 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX418 +00945 DTSBX418 +00946 P1100G-EXIT. DTSBX418 +00947 EXIT. DTSBX418 +00948 DTSBX418 +00949 P1100H-RPT. DTSBX418 +00950 * DISPLAY 'P1100H-RPT ' WEB-IMP-REC(1:126). CL*23 +00951 INITIALIZE X140-REC. DTSBX418 +00952 GO TO P1100H-EXIT. CL*45 +00953 CL*45 +00954 MOVE +16 TO L205-LAST-FIELD. CL*24 +00955 MOVE +14 TO L205-LAST-FIELD-LEN. CL*27 +00956 DTSBX418 +00957 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +00958 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +00959 DTSBX418 +00960 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +00961 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +00962 DTSBX418 +00963 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX418 +00964 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +00965 DTSBX418 +00966 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX418 +00967 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +00968 DTSBX418 +00969 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX418 +00970 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 +00971 DTSBX418 +00972 MOVE +8 TO L205-FIELD-LENGTH (6). DTSBX418 +00973 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 +00974 DTSBX418 +00975 MOVE +14 TO L205-FIELD-LENGTH (7). DTSBX418 +00976 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBX418 +00977 DTSBX418 +00978 MOVE +14 TO L205-FIELD-LENGTH (8). DTSBX418 +00979 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX418 +00980 DTSBX418 +00981 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX418 +00982 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX418 +00983 DTSBX418 +00984 MOVE +04 TO L205-FIELD-LENGTH (10). DTSBX418 +00985 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 +00986 DTSBX418 +00987 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX418 +00988 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 +00989 DTSBX418 +00990 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX418 +00991 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*47 +00992 DTSBX418 +00993 MOVE +8 TO L205-FIELD-LENGTH (13). DTSBX418 +00994 SET L205-TYPE-TEXT-88 (13) TO TRUE. CL*47 +00995 DTSBX418 +00996 MOVE +8 TO L205-FIELD-LENGTH (14). DTSBX418 +00997 SET L205-TYPE-TEXT-88 (14) TO TRUE. CL*47 +00998 DTSBX418 +00999 MOVE +4 TO L205-FIELD-LENGTH (15). DTSBX418 +01000 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX418 +01001 DTSBX418 +01002 MOVE +14 TO L205-FIELD-LENGTH (16). CL*27 +01003 SET L205-TYPE-NUMBER-88 (16) TO TRUE. CL*26 +01004 CL*24 +01005 ** MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX418 +01006 ** SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX418 +01007 DTSBX418 +01008 ** MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX418 +01009 ** SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSBX418 +01010 DTSBX418 +01011 ** MOVE +3 TO L205-FIELD-LENGTH (18). DTSBX418 +01012 ** SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSBX418 +01013 DTSBX418 +01014 ** MOVE +8 TO L205-FIELD-LENGTH (19). DTSBX418 +01015 ** SET L205-TYPE-TEXT-88 (21) TO TRUE. DTSBX418 +01016 ** DISPLAY 'NANCY '. CL*31 +01017 P1100H-EXIT. DTSBX418 +01018 EXIT. DTSBX418 +01019 DTSBX418 +01020 P1100I-WAGE. DTSBX418 +01021 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*10 +01022 INITIALIZE X144-REC. DTSBX418 +01023 GO TO P1100I-EXIT. CL*45 +01024 CL*45 +01025 MOVE +10 TO L205-LAST-FIELD. DTSBX418 +01026 MOVE +14 TO L205-LAST-FIELD-LEN. DTSBX418 +01027 DTSBX418 +01028 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +01029 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +01030 DTSBX418 +01031 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +01032 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +01033 DTSBX418 +01034 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX418 +01035 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +01036 DTSBX418 +01037 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX418 +01038 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +01039 DTSBX418 +01040 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX418 +01041 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 +01042 DTSBX418 +01043 MOVE +9 TO L205-FIELD-LENGTH (6). DTSBX418 +01044 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 +01045 DTSBX418 +01046 MOVE +30 TO L205-FIELD-LENGTH (7). DTSBX418 +01047 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 +01048 DTSBX418 +01049 MOVE +30 TO L205-FIELD-LENGTH (8). DTSBX418 +01050 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 +01051 DTSBX418 +01052 MOVE +1 TO L205-FIELD-LENGTH (9). DTSBX418 +01053 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX418 +01054 DTSBX418 +01055 MOVE +14 TO L205-FIELD-LENGTH (10). DTSBX418 +01056 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX418 +01057 P1100I-EXIT. DTSBX418 +01058 EXIT. DTSBX418 +01059 DTSBX418 +01060 P1100J-PAY. DTSBX418 +01061 * DISPLAY 'P1100J-PAY ' WEB-IMP-REC(1:84). CL*10 +01062 INITIALIZE X145-REC. DTSBX418 +01063 GO TO P1100J-EXIT. CL*45 +01064 CL*45 +01065 MOVE +12 TO L205-LAST-FIELD. DTSBX418 +01066 MOVE +8 TO L205-LAST-FIELD-LEN. DTSBX418 +01067 DTSBX418 +01068 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +01069 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +01070 DTSBX418 +01071 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX418 +01072 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX418 +01073 DTSBX418 +01074 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBX418 +01075 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +01076 DTSBX418 +01077 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX418 +01078 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +01079 DTSBX418 +01080 MOVE +3 TO L205-FIELD-LENGTH (5). DTSBX418 +01081 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX418 +01082 DTSBX418 +01083 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX418 +01084 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX418 +01085 DTSBX418 +01086 MOVE +2 TO L205-FIELD-LENGTH (7). DTSBX418 +01087 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX418 +01088 DTSBX418 +01089 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX418 +01090 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX418 +01091 DTSBX418 +01092 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX418 +01093 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX418 +01094 DTSBX418 +01095 MOVE +10 TO L205-FIELD-LENGTH (10). DTSBX418 +01096 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX418 +01097 DTSBX418 +01098 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX418 +01099 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX418 +01100 DTSBX418 +01101 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX418 +01102 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX418 +01103 DTSBX418 +01104 DTSBX418 +01105 P1100J-EXIT. DTSBX418 +01106 EXIT. DTSBX418 +01107 DTSBX418 +01108 P1100K-BATCH-HEADER. DTSBX418 +01109 ** DISPLAY 'BX418 P1100K-HDR ' WEB-IMP-REC(1:84). CL*49 +01110 INITIALIZE X149-REC. DTSBX418 +01111 MOVE +13 TO L205-LAST-FIELD. DTSBX418 +01112 MOVE +1 TO L205-LAST-FIELD-LEN. DTSBX418 +01113 DTSBX418 +01114 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX418 +01115 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX418 +01116 DTSBX418 +01117 MOVE +5 TO L205-FIELD-LENGTH (2). DTSBX418 +01118 SET L205-TYPE-TEXT-88(2) TO TRUE. DTSBX418 +01119 DTSBX418 +01120 MOVE +3 TO L205-FIELD-LENGTH (3). DTSBX418 +01121 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX418 +01122 DTSBX418 +01123 MOVE +8 TO L205-FIELD-LENGTH (4). DTSBX418 +01124 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX418 +01125 DTSBX418 +01126 MOVE +10 TO L205-FIELD-LENGTH (5). DTSBX418 +01127 SET L205-TYPE-DATE-88 (5) TO TRUE. DTSBX418 +01128 DTSBX418 +01129 MOVE +10 TO L205-FIELD-LENGTH (6). DTSBX418 +01130 SET L205-TYPE-DATE-88 (6) TO TRUE. DTSBX418 +01131 DTSBX418 +01132 MOVE +10 TO L205-FIELD-LENGTH (7). DTSBX418 +01133 SET L205-TYPE-DATE-88 (7) TO TRUE. DTSBX418 +01134 DTSBX418 +01135 MOVE +3 TO L205-FIELD-LENGTH (8). DTSBX418 +01136 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX418 +01137 DTSBX418 +01138 MOVE +3 TO L205-FIELD-LENGTH (9). DTSBX418 +01139 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX418 +01140 DTSBX418 +01141 MOVE +12 TO L205-FIELD-LENGTH (10). DTSBX418 +01142 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX418 +01143 DTSBX418 +01144 MOVE +3 TO L205-FIELD-LENGTH (11). DTSBX418 +01145 SET L205-TYPE-NUMBER-88 (11) TO TRUE. DTSBX418 +01146 DTSBX418 +01147 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX418 +01148 SET L205-TYPE-DATE-88 (12) TO TRUE. DTSBX418 +01149 DTSBX418 +01150 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX418 +01151 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX418 +01152 DTSBX418 +01153 P1100K-EXIT. DTSBX418 +01154 EXIT. DTSBX418 +01155 DTSBX418 +01156 P1200-BUILD-SORT-REC. DTSBX418 +01157 MOVE LOW-VALUES TO SORT-REC. DTSBX418 +01158 MOVE WEB-IMP-EMP-NO TO SORT-EMP-NO. DTSBX418 +01159 DTSBX418 +01160 EVALUATE TRUE DTSBX418 +01161 * WHEN WEB-IMP-TYPE-PRF-88 CL*45 +01162 * PERFORM P1200A-PRF THRU P1200A-EXIT CL*45 +01163 * MOVE +1 TO SORT-SEQ1 CL*45 +01164 * MOVE X102-REC TO SORT-DATA CL*45 +01165 CL*21 +01166 * WHEN WEB-IMP-TYPE-DETERM-88 CL*45 +01167 * PERFORM P1200B-DETERM THRU P1200B-EXIT CL*45 +01168 * MOVE +2 TO SORT-SEQ1 CL*45 +01169 * MOVE X104-REC TO SORT-DATA CL*45 +01170 CL*21 +01171 DTSBX418 +01172 * WHEN WEB-IMP-TYPE-NAME-88 CL*45 +01173 * PERFORM P1200C-NAME THRU P1200C-EXIT CL*42 +01174 * MOVE WEB-IMP-REC TO X106-REC CL*45 +01175 * MOVE +3 TO SORT-SEQ1 CL*45 +01176 * MOVE X106-NAME-TYPE TO SORT-SEQ2 CL*45 +01177 * MOVE X106-REC TO SORT-DATA CL*45 +01178 CL*23 +01179 * WHEN WEB-IMP-TYPE-RATE-88 CL*45 +01180 * PERFORM P1200D-RATE THRU P1200D-EXIT CL*45 +01181 * MOVE +4 TO SORT-SEQ1 CL*45 +01182 * MOVE X108-REC TO SORT-DATA CL*45 +01183 DTSBX418 +01184 * WHEN WEB-IMP-TYPE-ADDR-88 CL*45 +01185 * PERFORM P1200E-ADDR THRU P1200E-EXIT CL*27 +01186 * MOVE WEB-IMP-REC TO X110-REC CL*45 +01187 * MOVE +90 TO SORT-SEQ1 CL*45 +01188 * MOVE X110-REC TO SORT-DATA CL*45 +01189 DTSBX418 +01190 * WHEN WEB-IMP-TYPE-OPO-88 CL*45 +01191 * PERFORM P1200F-OPO THRU P1200F-EXIT CL*45 +01192 * MOVE WEB-IMP-REC TO X120-REC CL*40 +01193 * MOVE +91 TO SORT-SEQ1 CL*45 +01194 * MOVE X120-REC TO SORT-DATA CL*45 +01195 DTSBX418 +01196 * WHEN WEB-IMP-TYPE-REL-88 CL*45 +01197 * PERFORM P1200G-REL THRU P1200G-EXIT CL*45 +01198 * MOVE +5 TO SORT-SEQ1 CL*45 +01199 * MOVE X130-REC TO SORT-DATA CL*45 +01200 DTSBX418 +01201 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX418 +01202 * MOVE +6 TO SORT-SEQ1 DTSBX418 +01203 *** MOVE X132-REC TO SORT-DATA DTSBX418 +01204 DTSBX418 +01205 WHEN WEB-IMP-TYPE-RPT-88 DTSBX418 +01206 * IF X140-IN-HOUSE-88 DTSBX418 +01207 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX418 +01208 ** MOVE X140-PSEUDO-BATCH-NO TO SORT-BATCH DTSBX418 +01209 ** MOVE X140-PSEUDO-ITEM-NO TO SORT-ITEM DTSBX418 +01210 * MOVE LOW-VALUES TO SORT-FILLER DTSBX418 +01211 * ELSE DTSBX418 +01212 * PERFORM P1200H-RPT THRU P1200H-EXIT CL*45 +01213 MOVE WEB-IMP-REC TO X140-REC CL*45 +01214 MOVE +20 TO SORT-SEQ1 CL*33 +01215 MOVE X140-QUARTER TO SORT-SEQ2 CL*51 +01216 STRING CL*34 +01217 X140-QUARTER '0' DELIMITED BY SIZE CL*34 +01218 INTO SORT-SEQ2 CL*34 +01219 END-STRING CL*34 +01220 * END-IF CL*35 +01221 MOVE X140-REC TO SORT-DATA CL*36 +01222 DTSBX418 +01223 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX418 +01224 * PERFORM P1200I-WAGE THRU P1200I-EXIT CL*45 +01225 MOVE WEB-IMP-REC TO X144-REC CL*45 +01226 MOVE +20 TO SORT-SEQ1 CL*36 +01227 MOVE X144-QUARTER TO SORT-SEQ2 CL*51 +01228 STRING CL*34 +01229 X140-QUARTER '1' CL*34 +01230 DELIMITED BY SIZE CL*34 +01231 INTO CL*34 +01232 SORT-SEQ2 CL*34 +01233 END-STRING CL*35 +01234 MOVE X144-REC TO SORT-DATA CL*36 +01235 DTSBX418 +01236 ************************************************************ CL*23 +01237 * CHANGED SORT SEQ FOR PAYMENT RECORDS FROM 30 TO 19 DUE TO ESSP CL*23 +01238 * REPORTS X140 CANNOT BE PROCESSED WITHOUT A PAYMENT TRANSACTION CL*23 +01239 * UNLESS IT IS A 0 WAGE REPORT = REMIT AMOUNT = 0 CL*23 +01240 ************************************************************ CL*23 +01241 CL*23 +01242 WHEN WEB-IMP-TYPE-PAY-88 DTSBX418 +01243 * PERFORM P1200J-PAY THRU P1200J-EXIT CL*45 +01244 MOVE WEB-IMP-REC TO X145-REC CL*45 +01245 MOVE +19 TO SORT-SEQ1 CL*23 +01246 MOVE X145-QTR TO SORT-SEQ2 CL*51 +01247 MOVE X145-REC TO SORT-DATA DTSBX418 +01248 ** DISPLAY 'P2 PAY ' X145-REC DTSBX418 +01249 DTSBX418 +01250 DTSBX418 +01251 ** WHEN WEB-IMP-TYPE-BHDR-88 DTSBX418 +01252 * PERFORM P1200K-BATCH-HEADER THRU P1200K-EXIT DTSBX418 +01253 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX418 +01254 * MOVE X149-PSEUDO-BATCH TO SORT-BATCH DTSBX418 +01255 * MOVE X149-PSEUDO-ITEM TO SORT-ITEM DTSBX418 +01256 * MOVE LOW-VALUES TO SORT-FILLER DTSBX418 +01257 * MOVE X149-REC TO SORT-DATA DTSBX418 +01258 DTSBX418 +01259 END-EVALUATE. DTSBX418 +01260 DTSBX418 +01261 RELEASE SORT-REC. DTSBX418 +01262 DTSBX418 +01263 P1200-EXIT. DTSBX418 +01264 EXIT. DTSBX418 +01265 DTSBX418 +01266 P1200A-PRF. DTSBX418 +01267 MOVE L205-TEXT (1) (1:3) TO X102-REC-TYPE. DTSBX418 +01268 ** DISPLAY X102-REC-TYPE DTSBX418 +01269 MOVE L205-TEXT (2) (1:6) TO X102-EMP-NO. DTSBX418 +01270 ** DISPLAY X102-EMP-NO DTSBX418 +01271 DTSBX418 +01272 MOVE L205-TEXT (3) (1:9) TO X102-EMP-FEIN. DTSBX418 +01273 ** DISPLAY X102-EMP-FEIN DTSBX418 +01274 DTSBX418 +01275 MOVE L205-TEXT (4) (1:1) TO X102-EMP-CLASS. DTSBX418 +01276 ** DISPLAY X102-EMP-CLASS DTSBX418 +01277 DTSBX418 +01278 MOVE L205-TEXT (5) (1:1) TO X102-EMP-STATUS. DTSBX418 +01279 ** DISPLAY X102-EMP-STATUS DTSBX418 +01280 DTSBX418 +01281 MOVE L205-INTEGER (6) TO W-INT-9. DTSBX418 +01282 MOVE W-INT-X (12:2) TO X102-SOURCE-CD. DTSBX418 +01283 ** DISPLAY X102-SOURCE-CD DTSBX418 +01284 DTSBX418 +01285 ** DISPLAY X102-REC-TYPE DTSBX418 +01286 MOVE L205-TEXT (7) (1:1) TO X102-ACTION-CD. DTSBX418 +01287 ** DISPLAY X102-ACTION-CD. DTSBX418 +01288 DTSBX418 +01289 P1200A-EXIT. DTSBX418 +01290 EXIT. DTSBX418 +01291 DTSBX418 +01292 P1200B-DETERM. DTSBX418 +01293 MOVE L205-TEXT (1) (1:03) TO X104-REC-TYPE. DTSBX418 +01294 DTSBX418 +01295 MOVE L205-TEXT (2) (1:06) TO X104-EMP-NO. DTSBX418 +01296 DTSBX418 +01297 MOVE L205-TEXT (3) (1:01) TO X104-STAFF-REVIEW-IND. DTSBX418 +01298 DTSBX418 +01299 MOVE L205-INTEGER (4) TO W-INT-9. DTSBX418 +01300 MOVE W-INT-X (12:2) TO X104-LIAB-CD. DTSBX418 +01301 DTSBX418 +01302 MOVE L205-INTEGER (5) TO W-INT-9. DTSBX418 +01303 MOVE W-INT-X (12:2) TO X104-ELIG-CD. DTSBX418 +01304 DTSBX418 +01305 MOVE L205-TEXT (6) (1:06) TO X104-NAICS-CD. DTSBX418 +01306 DTSBX418 +01307 MOVE L205-TEXT (7) (1:03) TO X104-ORG-TYPE. DTSBX418 +01308 DTSBX418 +01309 MOVE L205-TEXT (8) (1:02) TO X104-INCORP-STATE. DTSBX418 +01310 DTSBX418 +01311 MOVE L205-DATE (9) TO X104-INCORP-DATE. DTSBX418 +01312 DTSBX418 +01313 MOVE L205-TEXT (10) (1:01) TO X104-HOUSEHOLD-FILING. DTSBX418 +01314 DTSBX418 +01315 MOVE L205-DATE (11) TO X104-FIRST-WAGE-DT. DTSBX418 +01316 DTSBX418 +01317 MOVE L205-TEXT (12) TO W-500-DATE. DTSBX418 +01318 DTSBX418 +01319 MOVE SPACES TO X104-FIRST-500-QTR DTSBX418 +01320 IF W-500-DATE > SPACES DTSBX418 +01321 MOVE W-500-DATE-YY TO W-500-FQTR-YY. DTSBX418 +01322 IF W-500-DATE-MM < '04' DTSBX418 +01323 MOVE '1' TO W-500-FQTR-NO. DTSBX418 +01324 IF W-500-DATE-MM > '03' AND < '07' DTSBX418 +01325 MOVE '2' TO W-500-FQTR-NO. DTSBX418 +01326 IF W-500-DATE-MM > '06' AND < '10' DTSBX418 +01327 MOVE '3' TO W-500-FQTR-NO. DTSBX418 +01328 IF W-500-DATE-MM > '09' AND < '13' DTSBX418 +01329 MOVE '4' TO W-500-FQTR-NO. DTSBX418 +01330 MOVE W-500-FQTR TO X104-FIRST-500-QTR DTSBX418 +01331 DTSBX418 +01332 MOVE L205-TEXT (13) (1:01) TO X104-ACQUIRE-IND. DTSBX418 +01333 DTSBX418 +01334 MOVE L205-TEXT (14) (1:01) TO X104-MERGER-SPLIT-IND. DTSBX418 +01335 DTSBX418 +01336 MOVE L205-TEXT (15) (1:01) TO X104-REORG-IND. DTSBX418 +01337 DTSBX418 +01338 MOVE L205-TEXT (16) (1:01) TO X104-COMMON-OWN-IND. DTSBX418 +01339 DTSBX418 +01340 MOVE L205-TEXT (17) (1:01) TO X104-SALE-TRANSFER-IND. DTSBX418 +01341 DTSBX418 +01342 MOVE L205-TEXT (18) (1:01) TO X104-NOT-LIAB-REASON. DTSBX418 +01343 ** DISPLAY X104-REC. DTSBX418 +01344 P1200B-EXIT. DTSBX418 +01345 EXIT. DTSBX418 +01346 DTSBX418 +01347 P1200C-NAME. DTSBX418 +01348 MOVE L205-TEXT (1) (1:03) TO X106-REC-TYPE. DTSBX418 +01349 DTSBX418 +01350 MOVE L205-TEXT (2) (1:06) TO X106-EMP-NO. DTSBX418 +01351 DTSBX418 +01352 MOVE L205-TEXT (3) (1:01) TO X106-NAME-TYPE DTSBX418 +01353 DTSBX418 +01354 MOVE L205-TEXT (4) (1:40) TO X106-EMP-NAME. DTSBX418 +01355 DTSBX418 +01356 P1200C-EXIT. DTSBX418 +01357 EXIT. DTSBX418 +01358 DTSBX418 +01359 P1200D-RATE. DTSBX418 +01360 MOVE L205-TEXT (1) (1:03) TO X108-REC-TYPE. DTSBX418 +01361 DTSBX418 +01362 MOVE L205-TEXT (2) (1:06) TO X108-EMP-NO. DTSBX418 +01363 DTSBX418 +01364 MOVE L205-TEXT (3) (1:04) TO X108-RATE-YEAR(1:04). DTSBX418 +01365 MOVE '/1' TO X108-RATE-YEAR(5:02). DTSBX418 +01366 DTSBX418 +01367 MOVE L205-INTEGER (4) TO W-INTEGER. DTSBX418 +01368 MOVE L205-FRACTION (4) TO W-FRACTION. DTSBX418 +01369 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 +01370 MOVE W-NUMBER TO X108-RATE. DTSBX418 +01371 ** DISPLAY 'BX418 RATE ' X108-RATE ' ' W-NUMBER. CL*49 +01372 ** DISPLAY ' RATE YR ' X108-RATE-YEAR. DTSBX418 +01373 DTSBX418 +01374 P1200D-EXIT. DTSBX418 +01375 EXIT. DTSBX418 +01376 DTSBX418 +01377 P1200E-ADDR. DTSBX418 +01378 MOVE L205-TEXT (1) (1:03) TO X110-REC-TYPE. DTSBX418 +01379 DTSBX418 +01380 MOVE L205-TEXT (2) (1:06) TO X110-EMP-NO. DTSBX418 +01381 DTSBX418 +01382 MOVE L205-INTEGER (3) TO W-INT-9. DTSBX418 +01383 MOVE W-INT-X (12:2) TO X110-ADDR-TYPE. DTSBX418 +01384 DTSBX418 +01385 MOVE L205-TEXT (4) (1:40) TO X110-ATTENTION. DTSBX418 +01386 DTSBX418 +01387 MOVE L205-TEXT (5) (1:40) TO X110-STREET-1. DTSBX418 +01388 DTSBX418 +01389 MOVE L205-TEXT (6) (1:40) TO X110-STREET-2. DTSBX418 +01390 DTSBX418 +01391 MOVE L205-TEXT (7) (1:25) TO X110-CITY. DTSBX418 +01392 DTSBX418 +01393 MOVE L205-TEXT (8) (1:02) TO X110-STATE. DTSBX418 +01394 DTSBX418 +01395 MOVE L205-TEXT (9) (1:10) TO X110-ZIP. DTSBX418 +01396 DTSBX418 +01397 MOVE L205-TEXT (10) (1:15) TO X110-PHONE. DTSBX418 +01398 DTSBX418 +01399 MOVE L205-TEXT (11) (1:15) TO X110-FAX. DTSBX418 +01400 DTSBX418 +01401 MOVE L205-TEXT(12) (1:40) TO X110-EMAIL. DTSBX418 +01402 DTSBX418 +01403 MOVE L205-TEXT (13) (1:40) TO X110-WEB-SITE. DTSBX418 +01404 DTSBX418 +01405 MOVE L205-TEXT (14) (1:40) TO X110-EMP-NAME. DTSBX418 +01406 DTSBX418 +01407 P1200E-EXIT. DTSBX418 +01408 EXIT. DTSBX418 +01409 DTSBX418 +01410 P1200F-OPO. DTSBX418 +01411 MOVE WEB-IMP-REC TO W120-REC. CL*40 +01412 MOVE W120-REC-TYPE TO X120-REC-TYPE. CL*40 +01413 DTSBX418 +01414 MOVE W120-EMP-NO TO X120-EMP-NO. CL*40 +01415 DTSBX418 +01416 MOVE W120-TYPE-IND (1:02) TO X120-TYPE-IND. CL*40 +01417 DTSBX418 +01418 MOVE W120-OPO-FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME. CL*40 +01419 DTSBX418 +01420 MOVE W120-OPO-MID-INIT (1:01) TO X120-OPO-MID-INIT. CL*40 +01421 DTSBX418 +01422 MOVE W120-OPO-LAST-NAME (1:20) TO X120-OPO-LAST-NAME. CL*40 +01423 DTSBX418 +01424 MOVE W120-OPO-MEMBER-NAME (1:40) TO X120-OPO-MEMBER-NAME. CL*40 +01425 DTSBX418 +01426 MOVE W120-OPO-SSN (1:09) TO X120-OPO-SSN. CL*40 +01427 DTSBX418 +01428 MOVE W120-OPO-TITLE (1:40) TO X120-OPO-TITLE. CL*40 +01429 DTSBX418 +01430 MOVE W120-OPO-ATTENTION (1:40) TO X120-OPO-ATTENTION. CL*40 +01431 DTSBX418 +01432 MOVE W120-OPO-STREET-1 (1:40) TO X120-OPO-STREET-1. CL*40 +01433 DTSBX418 +01434 MOVE W120-OPO-STREET-2 (1:40) TO X120-OPO-STREET-2. CL*40 +01435 DTSBX418 +01436 MOVE W120-OPO-CITY (1:20) TO X120-OPO-CITY. CL*40 +01437 DTSBX418 +01438 MOVE W120-OPO-STATE (1:02) TO X120-OPO-STATE. CL*40 +01439 DTSBX418 +01440 MOVE W120-OPO-ZIP (1:10) TO X120-OPO-ZIP. CL*40 +01441 DTSBX418 +01442 MOVE W120-OPO-PHONE (1:15) TO X120-OPO-PHONE. CL*40 +01443 DTSBX418 +01444 MOVE W120-OPO-FAX (1:15) TO X120-OPO-FAX. CL*40 +01445 DTSBX418 +01446 MOVE W120-OPO-EMAIL (1:40) TO X120-OPO-EMAIL. CL*43 +01447 DTSBX418 +01448 P1200F-EXIT. DTSBX418 +01449 EXIT. DTSBX418 +01450 DTSBX418 +01451 P1200G-REL. DTSBX418 +01452 P1200G-EXIT. DTSBX418 +01453 EXIT. DTSBX418 +01454 DTSBX418 +01455 P1200H-RPT. DTSBX418 +01456 * DISPLAY '01200H-RPT ' CL**9 +01457 DTSBX418 +01458 MOVE L205-TEXT (1) (1:03) TO X140-REC-TYPE. DTSBX418 +01459 * DISPLAY 'X140-REC-TYPE' X140-REC-TYPE CL**9 +01460 DTSBX418 +01461 MOVE L205-TEXT (2) (1:06) TO X140-EMP-NO. DTSBX418 +01462 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX418 +01463 DTSBX418 +01464 MOVE L205-TEXT (3) (1:04) TO X140-QUARTER(1:04). DTSBX418 +01465 MOVE '/' TO X140-QUARTER(5:01). DTSBX418 +01466 MOVE L205-TEXT (4) (1:01) TO X140-QUARTER(6:01). DTSBX418 +01467 DTSBX418 +01468 MOVE '00' TO X140-SOURCE. DTSBX418 +01469 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX418 +01470 DTSBX418 +01471 MOVE L205-TEXT (5) (7:02) TO X140-REPORT-TYPE. CL**2 +01472 IF X140-REPORT-TYPE = ZERO DTSBX418 +01473 MOVE 'OR' TO X140-REPORT-TYPE DTSBX418 +01474 ELSE DTSBX418 +01475 MOVE 'EA' TO X140-REPORT-TYPE DTSBX418 +01476 END-IF. DTSBX418 +01477 DTSBX418 +01478 ** DISPLAY 'L205-TEXT (6) (1:02) ' L205-TEXT (6) (1:02) DTSBX418 +01479 ** DISPLAY 'X140-REPORT-TYPE ' X140-REPORT-TYPE DTSBX418 +01480 DTSBX418 +01481 MOVE ZEROS TO X140-PSEUDO-BATCH-NO. DTSBX418 +01482 ** DISPLAY 'X140-PSEUDO-BATCH-NO ' X140-PSEUDO-BATCH-NO DTSBX418 +01483 DTSBX418 +01484 MOVE ZEROS TO X140-PSEUDO-ITEM-NO. DTSBX418 +01485 ** DISPLAY 'X140-PSEUDO-ITEM-NO ' X140-PSEUDO-ITEM-NO DTSBX418 +01486 DTSBX418 +01487 MOVE L205-INTEGER (8) TO W-INTEGER. DTSBX418 +01488 MOVE L205-FRACTION (8) TO W-FRACTION. DTSBX418 +01489 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 +01490 MOVE W-NUMBER TO X140-TAX-WAGES. DTSBX418 +01491 * DISPLAY 'X140-TAX-WAGES ' X140-TAX-WAGES CL**9 +01492 DTSBX418 +01493 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX418 +01494 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX418 +01495 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 +01496 MOVE W-NUMBER TO X140-TOTAL-WAGES. DTSBX418 +01497 * DISPLAY 'X140-TOTAL-WAGES ' X140-TOTAL-WAGES CL**9 +01498 DTSBX418 +01499 MOVE ZERO TO X140-CONFIRMATION. DTSBX418 +01500 DTSBX418 +01501 MOVE L205-TEXT (11) TO X140-RCVD-DATE. DTSBX418 +01502 * DISPLAY 'RECV DATE ' X140-RCVD-DATE. CL**9 +01503 DTSBX418 +01504 MOVE L205-TEXT (12) (2:07) TO X140-WRKR-CNT-1ST-MNTH. CL*47 +01505 * DISPLAY 'X140-WRKR-CNT-1ST-MNTH ' X140-WRKR-CNT-1ST-MNTH CL**9 +01506 DTSBX418 +01507 MOVE L205-TEXT (13) (2:07) TO X140-WRKR-CNT-2ND-MNTH. CL*47 +01508 * DISPLAY 'X140-WRKR-CNT-2ND-MNTH ' X140-WRKR-CNT-2ND-MNTH CL**9 +01509 DTSBX418 +01510 MOVE L205-TEXT (14) (2:07) TO X140-WRKR-CNT-3RD-MNTH. CL*47 +01511 * DISPLAY 'X140-WRKR-CNT-3RD-MNTH ' X140-WRKR-CNT-3RD-MNTH CL**9 +01512 DTSBX418 +01513 CL*25 +01514 MOVE L205-INTEGER (16) TO W-INTEGER. CL*25 +01515 MOVE L205-FRACTION (16) TO W-FRACTION. CL*25 +01516 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*25 +01517 MOVE W-NUMBER TO X140-REMITTANCE. CL*25 +01518 * DISPLAY 'X140-REMITTANCE ' X140-REMITTANCE. CL*30 +01519 CL*25 +01520 MOVE SPACES TO X140-CHECK-SCAN-DT. DTSBX418 +01521 * DISPLAY 'X140-CHECK SCANDATE ' X140-CHECK-SCAN-DT. CL**9 +01522 DTSBX418 +01523 MOVE ZEROS TO X140-CHECK-SEQ-NBR. DTSBX418 +01524 * DISPLAY 'X140-CHECK-SEQ-NBR ' X140-CHECK-SEQ-NBR CL**9 +01525 DTSBX418 +01526 MOVE 'N' TO X140-WAIVE-INTEREST. DTSBX418 +01527 * DISPLAY 'X140-WAIVE-INTEREST ' X140-WAIVE-INTEREST CL**9 +01528 DTSBX418 +01529 MOVE 'N' TO X140-WAIVE-PENALTY. DTSBX418 +01530 * DISPLAY 'X140-WAIVE-PENALTY ' X140-WAIVE-PENALTY CL**9 +01531 DTSBX418 +01532 MOVE ' ' TO X140-RESP-ACTIVITY. DTSBX418 +01533 * DISPLAY 'X140-RESP-ACTIVITY ' X140-RESP-ACTIVITY CL**9 +01534 DTSBX418 +01535 MOVE 'WEBESSP ' TO X140-RESP-OPID. DTSBX418 +01536 * DISPLAY 'X140-RESP-OPID ' X140-RESP-OPID CL**9 +01537 DTSBX418 +01538 *& DTSBX418 +01539 * DISPLAY 'BX418 P1200H: ' X140-REC. CL*49 +01540 P1200H-EXIT. DTSBX418 +01541 EXIT. DTSBX418 +01542 DTSBX418 +01543 P1200I-WAGE. DTSBX418 +01544 MOVE L205-TEXT (1) (1:03) TO X144-REC-TYPE. DTSBX418 +01545 DTSBX418 +01546 MOVE L205-TEXT (2) (1:06) TO X144-EMP-NO. DTSBX418 +01547 DTSBX418 +01548 ** MOVE L205-TEXT (3) (1:06) TO X144-QUARTER. DTSBX418 +01549 DTSBX418 +01550 MOVE L205-TEXT (3) (1:04) TO X144-QUARTER(1:04). DTSBX418 +01551 MOVE '/' TO X144-QUARTER(5:01). DTSBX418 +01552 MOVE L205-TEXT (4) (1:01) TO X144-QUARTER(6:01). DTSBX418 +01553 DTSBX418 +01554 MOVE L205-TEXT (6) (1:09) TO X144-SSN. DTSBX418 +01555 DTSBX418 +01556 MOVE '5' TO X144-WAGE-STATUS. DTSBX418 +01557 DTSBX418 +01558 MOVE L205-TEXT (7) (1:20) TO X144-LAST-NAME. DTSBX418 +01559 DTSBX418 +01560 MOVE L205-TEXT (8) (1:15) TO X144-FIRST-NAME. DTSBX418 +01561 DTSBX418 +01562 MOVE L205-TEXT (9) (1:01) TO X144-MID-INIT. DTSBX418 +01563 DTSBX418 +01564 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX418 +01565 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX418 +01566 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 +01567 MOVE W-NUMBER TO X144-EARNINGS. DTSBX418 +01568 * DISPLAY 'WAGES ' X144-EARNINGS. CL**9 +01569 DTSBX418 +01570 P1200I-EXIT. DTSBX418 +01571 EXIT. DTSBX418 +01572 DTSBX418 +01573 P1200J-PAY. DTSBX418 +01574 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. DTSBX418 +01575 DTSBX418 +01576 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. DTSBX418 +01577 DTSBX418 +01578 MOVE '0' TO X145-SOURCE. DTSBX418 +01579 DTSBX418 +01580 MOVE L205-TEXT (3) (1:06) TO X145-QTR. DTSBX418 +01581 * DISPLAY 'X145 QTR ' X145-QTR. CL**9 +01582 DTSBX418 +01583 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. DTSBX418 +01584 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL**9 +01585 DTSBX418 +01586 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX418 +01587 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX418 +01588 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 +01589 MOVE W-NUMBER TO X145-REMITTANCE. DTSBX418 +01590 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL**9 +01591 DTSBX418 +01592 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. DTSBX418 +01593 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL**9 +01594 DTSBX418 +01595 MOVE L205-TEXT (12) TO W-TRACE-B. DTSBX418 +01596 MOVE W-TRACE-9 TO X145-TRACE-NO. DTSBX418 +01597 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL**9 +01598 DTSBX418 +01599 DTSBX418 +01600 MOVE ZEROS TO X145-PSEUDO-BATCH. DTSBX418 +01601 DTSBX418 +01602 MOVE ZEROS TO X145-PSEUDO-ITEM. DTSBX418 +01603 DTSBX418 +01604 MOVE SPACES TO X145-APPLIC-ACCT. DTSBX418 +01605 DTSBX418 +01606 MOVE SPACES TO X145-CHECK-SCAN-DT. DTSBX418 +01607 DTSBX418 +01608 MOVE ZEROS TO X145-CHECK-SEQ-NBR. DTSBX418 +01609 DTSBX418 +01610 MOVE 'N' TO X145-WAIVE-INTEREST. DTSBX418 +01611 DTSBX418 +01612 MOVE 'N' TO X145-WAIVE-PENALTY. DTSBX418 +01613 DTSBX418 +01614 MOVE 'VOL' TO X145-RESP-ACTIVITY. DTSBX418 +01615 DTSBX418 +01616 MOVE 'WEBESSP ' TO X145-RESP-OPID. DTSBX418 +01617 DTSBX418 +01618 P1200J-EXIT. DTSBX418 +01619 EXIT. DTSBX418 +01620 DTSBX418 +01621 P1200K-BATCH-HEADER. DTSBX418 +01622 MOVE L205-TEXT (1) (1:03) TO X149-REC-TYPE. DTSBX418 +01623 DTSBX418 +01624 MOVE L205-TEXT (2) (1:5) TO X149-PSEUDO-BATCH. DTSBX418 +01625 DTSBX418 +01626 MOVE L205-TEXT (3) (1:3) TO X149-PSEUDO-ITEM. DTSBX418 +01627 DTSBX418 +01628 MOVE L205-TEXT (4) (1:08) TO X149-ESTB-OPID. DTSBX418 +01629 DTSBX418 +01630 MOVE L205-DATE (5) TO X149-ESTB-DATE. DTSBX418 +01631 DTSBX418 +01632 MOVE L205-DATE (6) TO X149-DEPOSIT-DATE. DTSBX418 +01633 DTSBX418 +01634 IF L205-VALID-NO-88 (7) DTSBX418 +01635 MOVE SPACES TO X149-RCVD-DATE DTSBX418 +01636 ELSE DTSBX418 +01637 MOVE L205-DATE (7) TO X149-RCVD-DATE DTSBX418 +01638 END-IF. DTSBX418 +01639 DTSBX418 +01640 MOVE L205-INTEGER (8) TO X149-LAST-ITEM-NBR. DTSBX418 +01641 DTSBX418 +01642 MOVE L205-INTEGER (9) TO X149-CONTROL-TRAN-CNT. DTSBX418 +01643 DTSBX418 +01644 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX418 +01645 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX418 +01646 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX418 +01647 MOVE W-NUMBER TO X149-CONTROL-REMIT-AMT. DTSBX418 +01648 MOVE W-INTEGER TO W-AMT-DISP1. DTSBX418 +01649 MOVE W-FRACTION TO W-AMT-DISP4. DTSBX418 +01650 MOVE W-NUMBER TO W-AMT-DISP2. DTSBX418 +01651 ** DISPLAY 'BX418 P1200 HDR ' X149-PSEUDO-BATCH CL*49 +01652 ** ' INT ' W-AMT-DISP1 ' FR ' W-AMT-DISP4 DTSBX418 +01653 ** ' NBR ' W-AMT-DISP2 DTSBX418 +01654 ** ' X149 ' X149-CONTROL-REMIT-AMT. DTSBX418 +01655 DTSBX418 +01656 MOVE L205-INTEGER (11) TO X149-CONTROL-CHECK-CNT. DTSBX418 +01657 DTSBX418 +01658 MOVE L205-DATE (12) TO X149-CHECK-SCAN-DATE. DTSBX418 +01659 DTSBX418 +01660 MOVE L205-TEXT (13) (1:08) TO X149-ANN-BATCH-IND. DTSBX418 +01661 DTSBX418 +01662 ** DISPLAY 'BX418 P1200 HDR ' X149-PSEUDO-BATCH CL*49 +01663 ** ' ' X149-PSEUDO-ITEM ' ' X149-ESTB-OPID. DTSBX418 +01664 P1200K-EXIT. DTSBX418 +01665 EXIT. DTSBX418 +01666 DTSBX418 +01667 P2000-POST-SORT. DTSBX418 +01668 SET SORT-OK-88 TO TRUE. DTSBX418 +01669 DTSBX418 +01670 DISPLAY 'P2000 BEG READING SORT-FILE ' SORT-EMP-NO. CL**7 +01671 PERFORM P2100-PROCESS-SORT THRU P2100-EXIT DTSBX418 +01672 UNTIL SORT-EOF-88. DTSBX418 +01673 DTSBX418 +01674 * SET LX42-TERMINATE-88 TO TRUE CL**9 +01675 * DISPLAY 'BX418 P2000 END READING SORT-FILE ' SORT-EMP-NO. CL*49 +01676 DISPLAY 'BX418 P2000 END READING SORT-FILE ' SORT-KEY ' ' CL*49 +01677 SORT-DATA (1:14). CL**7 +01678 P2000-EXIT. DTSBX418 +01679 EXIT. DTSBX418 +01680 DTSBX418 +01681 P2100-PROCESS-SORT. DTSBX418 +01682 * DISPLAY 'BX418 P2100 FIRST SORT-EMP-NO ' SORT-EMP-NO CL*49 +01683 * ' ' SORT-DATA (1:14). CL*38 +01684 RETURN SORT-FILE DTSBX418 +01685 AT END DTSBX418 +01686 SET SORT-EOF-88 TO TRUE DTSBX418 +01687 GO TO P2100-EXIT DTSBX418 +01688 END-RETURN. DTSBX418 +01689 DTSBX418 +01690 DISPLAY 'BX418 P2100 SORT-REC ' SORT-KEY ' ' CL*49 +01691 SORT-DATA (1:14). CL*21 +01692 DTSBX418 +01693 MOVE SORT-DATA TO LX42-DATA-AREA. DTSBX418 +01694 IF SORT-EMP-NO = 999999 DTSBX418 +01695 IF SORT-BATCH = W-PSEUDO-BATCH-NO DTSBX418 +01696 DISPLAY 'BX418 NEW BATCH 999999 PROCESS' CL*49 +01697 SET LX42-PROCESS-88 TO TRUE DTSBX418 +01698 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 +01699 ELSE DTSBX418 +01700 MOVE SORT-BATCH TO W-PSEUDO-BATCH-NO DTSBX418 +01701 DISPLAY 'BX418 NEW BATCH ' CL*49 +01702 ** PERFORM P2120-NEW-BATCH THRU P2120-EXIT DTSBX418 +01703 SET LX42-PROCESS-88 TO TRUE DTSBX418 +01704 SET LX42-ERROR-NO-88 TO TRUE DTSBX418 +01705 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01706 ** DISPLAY 'BX418 NEW BATCH 888888 PROCESS' CL*49 +01707 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 +01708 END-IF DTSBX418 +01709 ELSE CL*19 +01710 IF SORT-EMP-NO = W-EMP-NO DTSBX418 +01711 DISPLAY 'BX418 SORT-EMP-NO = W-EMP-NO ' CL*49 +01712 SET LX42-PROCESS-88 TO TRUE DTSBX418 +01713 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 +01714 ELSE DTSBX418 +01715 DISPLAY 'BX418 SORT-EMP-NO < W-EMP-NO ' CL*49 +01716 MOVE SORT-EMP-NO TO W-EMP-NO DTSBX418 +01717 PERFORM P2110-NEW-EMP THRU P2110-EXIT DTSBX418 +01718 SET LX42-PROCESS-88 TO TRUE DTSBX418 +01719 SET LX42-ERROR-NO-88 TO TRUE DTSBX418 +01720 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01721 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX418 +01722 END-IF DTSBX418 +01723 END-IF. DTSBX418 +01724 DTSBX418 +01725 P2100-EXIT. DTSBX418 +01726 EXIT. DTSBX418 +01727 DTSBX418 +01728 P2110-NEW-EMP. DTSBX418 +01729 DTSBX418 +01730 DISPLAY 'BX418 >>>>>>>> NEW-EMP ' LX42-DATA-AREA (1:20). CL*49 +01731 DTSBX418 +01732 SET LX42-NEW-EMPLOYER-88 TO TRUE. DTSBX418 +01733 MOVE ZERO TO LX42-LAST-DETERM-EMP. DTSBX418 +01734 DTSBX418 +01735 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*45 +01736 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01737 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +01738 * PERFORM S424-PROFILE THRU S424-EXIT. CL*45 +01739 DTSBX418 +01740 P2110-EXIT. DTSBX418 +01741 EXIT. DTSBX418 +01742 DTSBX418 +01743 P2120-NEW-BATCH. DTSBX418 +01744 *& DTSBX418 +01745 * DISPLAY 'BX418 P2120 NEW BATCH ' LX42-PSEUDO-BATCH-NO CL*49 +01746 * ' ' LX42-DATA-AREA (1:20). DTSBX418 +01747 *& DTSBX418 +01748 SET LX42-NEW-BATCH-88 TO TRUE. DTSBX418 +01749 DTSBX418 +01750 * PERFORM S426-HEADER THRU S426-EXIT. DTSBX418 +01751 * IF LX42-BATCH-ERR-YES-88 DTSBX418 +01752 * SET LX42-BATCH-ERROR-88 TO TRUE DTSBX418 +01753 * END-IF. DTSBX418 +01754 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01755 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +01756 DTSBX418 +01757 MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX418 +01758 MOVE ZERO TO LX42-RPT-CNT DTSBX418 +01759 LX42-RPT-REMIT-AMT DTSBX418 +01760 LX42-PAY-CNT DTSBX418 +01761 LX42-PAY-REMIT-AMT. DTSBX418 +01762 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX418 +01763 DTSBX418 +01764 P2120-EXIT. DTSBX418 +01765 EXIT. DTSBX418 +01766 DTSBX418 +01767 P3000-PROCESS. DTSBX418 +01768 *& DTSBX418 +01769 *& DTSBX418 +01770 **************************************************************** DTSBX418 +01771 * LX42-LAST-DETERM-EMP IS SET WHEN PROCESSING A DETERMINATION. DTSBX418 +01772 * THE EMPLOYER ACCOUNT NUMBER IS PASSED THROUGH THIS FIELD DTSBX418 +01773 * TO DTSBX422, WHICH PROCESSES REPORTS. IT IS USED DTSBX418 +01774 * TO DETERMINE WHEN TO WAIVE P & I. THE WAIVER IS AUTOMATIC DTSBX418 +01775 * FOR REPORTS WITHIN THE LAST 5 QUARTERS SUBMITTED ALONG DTSBX418 +01776 * WITH A WEB REGISTRATION. DTSBX418 +01777 **************************************************************** DTSBX418 +01778 DTSBX418 +01779 EVALUATE TRUE DTSBX418 +01780 * WHEN LX42-REC-TYPE-PRF-88 CL*45 +01781 * ADD +1 TO W-102-IMP-CNT CL*45 +01782 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 +01783 CL**9 +01784 * WHEN LX42-REC-TYPE-DETERM-88 CL*45 +01785 * ADD +1 TO W-104-IMP-CNT CL*45 +01786 * MOVE W-EMP-NO CL*45 +01787 * TO LX42-LAST-DETERM-EMP CL*45 +01788 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 +01789 CL**9 +01790 * WHEN LX42-REC-TYPE-RATE-88 CL*45 +01791 * ADD +1 TO W-108-IMP-CNT CL*45 +01792 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 +01793 CL**9 +01794 * WHEN LX42-REC-TYPE-NAME-88 CL*45 +01795 * ADD +1 TO W-106-IMP-CNT CL*45 +01796 * PERFORM S421-REGISTRATION THRU S421-EXIT CL*45 +01797 CL**9 +01798 * WHEN LX42-REC-TYPE-REL-88 CL**9 +01799 * PERFORM S421-REGISTRATION THRU S421-EXIT CL**9 +01800 DTSBX418 +01801 WHEN LX42-REC-TYPE-RPT-88 DTSBX418 +01802 ADD +1 TO W-140-IMP-CNT CL*38 +01803 *** PERFORM P3100-BATCH-NO THRU P3100-EXIT DTSBX418 +01804 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 +01805 CL**9 +01806 WHEN LX42-REC-TYPE-WAGE-88 DTSBX418 +01807 ADD +1 TO W-144-IMP-CNT CL*38 +01808 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 +01809 DTSBX418 +01810 * WHEN LX42-REC-TYPE-BHDR-88 CL**9 +01811 * PERFORM S426-HEADER THRU S426-EXIT CL**9 +01812 DTSBX418 +01813 WHEN LX42-REC-TYPE-PAY-88 DTSBX418 +01814 ADD +1 TO W-145-IMP-CNT CL*38 +01815 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 +01816 DTSBX418 +01817 * WHEN LX42-REC-TYPE-ADDR-88 CL*45 +01818 * ADD +1 TO W-110-IMP-CNT CL*45 +01819 * PERFORM S424-PROFILE THRU S424-EXIT CL*45 +01820 CL**9 +01821 * WHEN LX42-REC-TYPE-OPO-88 CL*45 +01822 * ADD +1 TO W-120-IMP-CNT CL*45 +01823 * PERFORM S424-PROFILE THRU S424-EXIT CL*45 +01824 DTSBX418 +01825 END-EVALUATE. DTSBX418 +01826 DTSBX418 +01827 P3000-EXIT. DTSBX418 +01828 EXIT. DTSBX418 +01829 DTSBX418 +01830 P3100-BATCH-NO. DTSBX418 +01831 *& IF W-PSEUDO-ITEM-NO < 999 DTSBX418 +01832 * ADD 1 TO W-PSEUDO-ITEM-NO DTSBX418 +01833 * ELSE DTSBX418 +01834 * ADD 1 TO W-PSEUDO-BATCH-NO DTSBX418 +01835 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSBX418 +01836 * END-IF. DTSBX418 +01837 * DTSBX418 +01838 * MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX418 +01839 *& MOVE W-PSEUDO-ITEM-NO TO LX42-PSEUDO-ITEM-NO. DTSBX418 +01840 DTSBX418 +01841 P3100-EXIT. DTSBX418 +01842 EXIT. DTSBX418 +01843 DTSBX418 +01844 DTSBX418 +01845 T0000-TERMINATE. DTSBX418 +01846 PERFORM T1000-FINAL-CALLS THRU T1000-EXIT. DTSBX418 +01847 DTSBX418 +01848 *** PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSBX418 +01849 DTSBX418 +01850 DISPLAY ' '. DTSBX418 +01851 DTSBX418 +01852 DISPLAY '*** DTSBX418 TERMINATION STATISTICS ***'. CL*48 +01853 DTSBX418 +01854 DISPLAY '***************************************'. CL*30 +01855 DISPLAY '*** WEB/ESSP IMPORT DRIVER COUNTS ***'. CL*38 +01856 DISPLAY '*** RELEASE RPT/PAY/WAGES TO DUTAS ***'. CL*50 +01857 DISPLAY '***************************************'. CL*50 +01858 DISPLAY 'TOTAL INPUT RECORDS READ: ' W-WEB-IMP-CNT. CL*38 +01859 * DISPLAY ' X102 RECORDS READ: ' W-102-IMP-CNT. CL*48 +01860 * DISPLAY ' X104 RECORDS READ: ' W-104-IMP-CNT. CL*48 +01861 * DISPLAY ' X106 RECORDS READ: ' W-106-IMP-CNT. CL*48 +01862 * DISPLAY ' X108 RECORDS READ: ' W-108-IMP-CNT. CL*48 +01863 * DISPLAY ' X110 RECORDS READ: ' W-110-IMP-CNT. CL*48 +01864 * DISPLAY ' X120 RECORDS READ: ' W-120-IMP-CNT. CL*48 +01865 DISPLAY ' X140 RECORDS READ: ' W-140-IMP-CNT. CL*38 +01866 DISPLAY ' X144 RECORDS READ: ' W-144-IMP-CNT. CL*38 +01867 DISPLAY ' X145 RECORDS READ: ' W-145-IMP-CNT. CL*38 +01868 DISPLAY ' ' CL*38 +01869 DISPLAY '*** ***'. CL*30 +01870 DISPLAY '*********** END OF RUN ****************'. CL*38 +01871 DTSBX418 +01872 CLOSE WEB-IMP-FILE. DTSBX418 +01873 *** CURR-BATCH-NO. DTSBX418 +01874 *** TEMP-BTC-FILE. DTSBX418 +01875 DTSBX418 +01876 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX418 +01877 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX418 +01878 PERFORM S923-CLOSE THRU S923-EXIT. DTSBX418 +01879 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX418 +01880 * PERFORM S927C-CLOSE THRU S927C-EXIT. CL*44 +01881 DTSBX418 +01882 T0000-EXIT. DTSBX418 +01883 EXIT. DTSBX418 +01884 DTSBX418 +01885 T1000-FINAL-CALLS. DTSBX418 +01886 *& DTSBX418 +01887 DISPLAY 'BX418 T1000 ' LX42-DATA-AREA (1:20). CL*49 +01888 *& DTSBX418 +01889 SET LX42-TERMINATE-88 TO TRUE. DTSBX418 +01890 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX418 +01891 DTSBX418 +01892 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*45 +01893 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX418 +01894 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01895 ** PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +01896 * PERFORM S424-PROFILE THRU S424-EXIT. CL*45 +01897 DTSBX418 +01898 T1000-EXIT. DTSBX418 +01899 EXIT. DTSBX418 +01900 DTSBX418 +01901 *T1100-UPDATE-CURR-BATCH. DTSBX418 +01902 * MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBX418 +01903 * W-END-BATCH. DTSBX418 +01904 * MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBX418 +01905 * DISPLAY 'REWRITING CURRENT BATCH ' DTSBX418 +01906 * W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBX418 +01907 * REWRITE CURR-BATCH-NO-REC. DTSBX418 +01908 * IF BATCH-STATUS-OK-88 DTSBX418 +01909 * NEXT SENTENCE DTSBX418 +01910 * ELSE DTSBX418 +01911 * DISPLAY 'T1100 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBX418 +01912 * BATCH-STATUS DTSBX418 +01913 * END-IF. DTSBX418 +01914 * DTSBX418 +01915 *T1100-EXIT. DTSBX418 +01916 * EXIT. DTSBX418 +01917 DTSBX418 +01918 S001-FROM-FED-8. DTSBX418 +01919 SET L001-FROM-FED-8 TO TRUE. DTSBX418 +01920 GO TO S001-DATE. DTSBX418 +01921 DTSBX418 +01922 S001-FROM-CAL-8. DTSBX418 +01923 SET L001-FROM-CAL-8 TO TRUE. DTSBX418 +01924 GO TO S001-DATE. DTSBX418 +01925 DTSBX418 +01926 S001-FROM-ABS-DAY. DTSBX418 +01927 SET L001-FROM-ABS-DAY TO TRUE. DTSBX418 +01928 GO TO S001-DATE. DTSBX418 +01929 DTSBX418 +01930 S001-DATE. DTSBX418 +01931 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX418 +01932 S001-EXIT. DTSBX418 +01933 EXIT. DTSBX418 +01934 DTSBX418 +01935 S003-AGENCY-DAY. DTSBX418 +01936 SET L003-AGENCY-DAY TO TRUE. DTSBX418 +01937 GO TO S003-WORK-DAY. DTSBX418 +01938 DTSBX418 +01939 S003-WORK-DAY. DTSBX418 +01940 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX418 +01941 S003-EXIT. DTSBX418 +01942 EXIT. DTSBX418 +01943 DTSBX418 +01944 S004-FROM-5. DTSBX418 +01945 SET L004-FROM-5 TO TRUE. DTSBX418 +01946 GO TO S004-YRQ. DTSBX418 +01947 DTSBX418 +01948 S004-FROM-DATE. DTSBX418 +01949 SET L004-FROM-DATE TO TRUE. DTSBX418 +01950 GO TO S004-YRQ. DTSBX418 +01951 DTSBX418 +01952 S004-FROM-ABS. DTSBX418 +01953 SET L004-FROM-ABS TO TRUE. DTSBX418 +01954 GO TO S004-YRQ. DTSBX418 +01955 DTSBX418 +01956 S004-YRQ. DTSBX418 +01957 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX418 +01958 DTSBX418 +01959 S004-EXIT. DTSBX418 +01960 EXIT. DTSBX418 +01961 DTSBX418 +01962 S005-FROM-SYS. DTSBX418 +01963 SET L005-FROM-SYS TO TRUE. DTSBX418 +01964 GO TO S005-ABSTIME. DTSBX418 +01965 DTSBX418 +01966 S005-ABSTIME. DTSBX418 +01967 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX418 +01968 S005-EXIT. DTSBX418 +01969 EXIT. DTSBX418 +01970 DTSBX418 +01971 S421-REGISTRATION. DTSBX418 +01972 DISPLAY 'CALL S421-REGISTRATION'. CL**8 +01973 CALL 'DTSBX421' USING LX42-LINK-AREA. DTSBX418 +01974 S421-EXIT. DTSBX418 +01975 EXIT. DTSBX418 +01976 DTSBX418 +01977 S422-REPORT-PAYMT. CL*23 +01978 DISPLAY 'CALL S422-REPORTS- WAGES AND PAYMENTS-PENDING'. CL*45 +01979 CALL 'DTSBX436' USING LX42-LINK-AREA. CL*48 +01980 S422-EXIT. DTSBX418 +01981 EXIT. DTSBX418 +01982 DTSBX418 +01983 *S423-PAYMENT. CL*23 +01984 * DISPLAY 'CALL S423-PAYMENT'. CL*23 +01985 * CALL 'DTSBX423' USING LX42-LINK-AREA. CL*23 +01986 *S423-EXIT. CL*23 +01987 * EXIT. CL*23 +01988 DTSBX418 +01989 S424-PROFILE. DTSBX418 +01990 DISPLAY 'CALL S424-PROFILE' CL**8 +01991 ** DISPLAY 'LINK AREA ' LX42-LINK-AREA DTSBX418 +01992 CALL 'DTSBX424' USING LX42-LINK-AREA. DTSBX418 +01993 S424-EXIT. DTSBX418 +01994 EXIT. DTSBX418 +01995 DTSBX418 +01996 S426-HEADER. DTSBX418 +01997 CALL 'DTSBX426' USING LX42-LINK-AREA. DTSBX418 +01998 S426-EXIT. DTSBX418 +01999 EXIT. DTSBX418 +02000 DTSBX418 +02001 DTSBX418 +02002 S910-OPEN-READ. DTSBX418 +02003 SET L910-OPEN-READ-88 TO TRUE. DTSBX418 +02004 GO TO S910-MSTR-IO. DTSBX418 +02005 DTSBX418 +02006 S910-OPEN-UPDATE. DTSBX418 +02007 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX418 +02008 GO TO S910-MSTR-IO. DTSBX418 +02009 DTSBX418 +02010 S910-READ. DTSBX418 +02011 SET L910-READ-88 TO TRUE. DTSBX418 +02012 GO TO S910-MSTR-IO. DTSBX418 +02013 DTSBX418 +02014 S910-START-BROWSE. DTSBX418 +02015 SET L910-START-BROWSE-88 TO TRUE. DTSBX418 +02016 GO TO S910-MSTR-IO. DTSBX418 +02017 DTSBX418 +02018 S910-READ-NEXT. DTSBX418 +02019 SET L910-READ-NEXT-88 TO TRUE. DTSBX418 +02020 GO TO S910-MSTR-IO. DTSBX418 +02021 DTSBX418 +02022 S910-CLOSE. DTSBX418 +02023 SET L910-CLOSE-88 TO TRUE. DTSBX418 +02024 GO TO S910-MSTR-IO. DTSBX418 +02025 DTSBX418 +02026 S910-MSTR-IO. DTSBX418 +02027 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX418 +02028 MSKL-REC. DTSBX418 +02029 S910-EXIT. DTSBX418 +02030 EXIT. DTSBX418 +02031 DTSBX418 +02032 S921-OPEN-READ. DTSBX418 +02033 SET L921-OPEN-READ-88 TO TRUE. DTSBX418 +02034 GO TO S921-AIX-IO. DTSBX418 +02035 DTSBX418 +02036 S921-READ. DTSBX418 +02037 SET L921-READ-88 TO TRUE. DTSBX418 +02038 GO TO S921-AIX-IO. DTSBX418 +02039 DTSBX418 +02040 S921-START-BROWSE. DTSBX418 +02041 SET L921-START-BROWSE-88 TO TRUE. DTSBX418 +02042 GO TO S921-AIX-IO. DTSBX418 +02043 DTSBX418 +02044 S921-READ-NEXT. DTSBX418 +02045 SET L921-READ-NEXT-88 TO TRUE. DTSBX418 +02046 GO TO S921-AIX-IO. DTSBX418 +02047 DTSBX418 +02048 S921-CLOSE. DTSBX418 +02049 SET L921-CLOSE-88 TO TRUE. DTSBX418 +02050 GO TO S921-AIX-IO. DTSBX418 +02051 DTSBX418 +02052 S921-AIX-IO. DTSBX418 +02053 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX418 +02054 ISKL-REC. DTSBX418 +02055 S921-EXIT. DTSBX418 +02056 EXIT. DTSBX418 +02057 DTSBX418 +02058 S923-OPEN-UPDATE. DTSBX418 +02059 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX418 +02060 GO TO S923-ATC-CALL. DTSBX418 +02061 DTSBX418 +02062 S923-OPEN-READ. DTSBX418 +02063 SET L923-OPEN-READ-88 TO TRUE. DTSBX418 +02064 GO TO S923-ATC-CALL. DTSBX418 +02065 DTSBX418 +02066 S923-WRITE. DTSBX418 +02067 SET L923-WRITE-88 TO TRUE. DTSBX418 +02068 GO TO S923-ATC-CALL. DTSBX418 +02069 DTSBX418 +02070 S923-CLOSE. DTSBX418 +02071 SET L923-CLOSE-88 TO TRUE. DTSBX418 +02072 GO TO S923-ATC-CALL. DTSBX418 +02073 DTSBX418 +02074 S923-ATC-CALL. DTSBX418 +02075 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX418 +02076 ASKL-REC. DTSBX418 +02077 S923-EXIT. DTSBX418 +02078 EXIT. DTSBX418 +02079 DTSBX418 +02080 S927A-OPEN. DTSBX418 +02081 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX418 +02082 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX418 +02083 DTSBX418 +02084 S927A-EXIT. DTSBX418 +02085 EXIT. DTSBX418 +02086 DTSBX418 +02087 S927C-CLOSE. DTSBX418 +02088 SET L927-CLOSE-88 TO TRUE. DTSBX418 +02089 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX418 +02090 DTSBX418 +02091 S927C-EXIT. DTSBX418 +02092 EXIT. DTSBX418 +02093 DTSBX418 +02094 S927Z-IO. DTSBX418 +02095 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX418 +02096 TSKL-REC. DTSBX418 +02097 S927Z-EXIT. DTSBX418 +02098 EXIT. DTSBX418 +02099 DTSBX418 +02100 S931-OPEN-READ. DTSBX418 +02101 SET L931-OPEN-READ-88 TO TRUE. DTSBX418 +02102 GO TO S931-REF-IO. DTSBX418 +02103 DTSBX418 +02104 S931-CLOSE. DTSBX418 +02105 SET L931-CLOSE-88 TO TRUE. DTSBX418 +02106 GO TO S931-REF-IO. DTSBX418 +02107 DTSBX418 +02108 S931-REF-IO. DTSBX418 +02109 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX418 +02110 FSKL-REC. DTSBX418 +02111 S931-EXIT. DTSBX418 +02112 EXIT. DTSBX418 +02113 DTSBX418 +02114 S1000-READ-WEB-IMP. DTSBX418 +02115 READ WEB-IMP-FILE. DTSBX418 +02116 IF WEB-IMP-STATUS-OK-88 DTSBX418 +02117 ADD +1 TO W-WEB-IMP-CNT DTSBX418 +02118 ELSE DTSBX418 +02119 IF WEB-IMP-STATUS-EOF-88 DTSBX418 +02120 DISPLAY 'ENE OF WEB-IMP-FILE ' WEB-IMP-STATUS CL**3 +02121 ELSE DTSBX418 +02122 DISPLAY 'CANNOT READ WEB-IMP-FILE ' WEB-IMP-STATUS DTSBX418 +02123 SET W-ERROR-YES-88 TO TRUE DTSBX418 +02124 END-IF DTSBX418 +02125 END-IF. DTSBX418 +02126 DTSBX418 +02127 * DISPLAY 'S1000-READ WEB ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*12 +02128 DTSBX418 +02129 S1000-EXIT. DTSBX418 +02130 EXIT. DTSBX418 +02131 DTSBX418 +02132 S999-ABEND. DTSBX418 +02133 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX418 +02134 S999-EXIT. DTSBX418 +02135 EXIT. DTSBX418 +02136 DTSBX418 diff --git a/Batch/DTSBX420.cob b/Batch/DTSBX420.cob index 0a30e32..1bc0f2d 100644 --- a/Batch/DTSBX420.cob +++ b/Batch/DTSBX420.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 10/07/14 +00001 IDENTIFICATION DIVISION. 03/10/20 00002 PROGRAM-ID. DTSBX420. DTSBX420 -00003 AUTHOR. NGC. LV013 +00003 AUTHOR. NGC. LV056 00004 DATE-WRITTEN. APRIL 2005. DTSBX420 00005 DATE-COMPILED. DTSBX420 00006 SKIP3 DTSBX420 @@ -31,2008 +31,2110 @@ 00031 * CASHIERING PROCESS. DTSBX420 00032 * REFERENCE RFP: GD DTSBX420 00033 * DTSBX420 -00034 * DTSBX420 -00035 ***** DTSBX420 -00036 SKIP3 DTSBX420 -00037 ENVIRONMENT DIVISION. DTSBX420 -00038 SKIP2 DTSBX420 -00039 INPUT-OUTPUT SECTION. DTSBX420 -00040 DTSBX420 -00041 FILE-CONTROL. DTSBX420 -00042 DTSBX420 -00043 SELECT WEB-IMP-FILE ASSIGN TO WEBREG DTSBX420 -00044 FILE STATUS IS WEB-IMP-STATUS. DTSBX420 -00045 DTSBX420 -00046 ** SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBX420 -00047 ** FILE STATUS IS BATCH-STATUS. DTSBX420 -00048 DTSBX420 -00049 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSBX420 -00050 DTSBX420 -00051 DATA DIVISION. DTSBX420 -00052 DTSBX420 -00053 FILE SECTION. DTSBX420 -00054 DTSBX420 -00055 FD WEB-IMP-FILE DTSBX420 -00056 RECORDING MODE IS F DTSBX420 -00057 BLOCK CONTAINS 0 RECORDS DTSBX420 -00058 LABEL RECORDS ARE OMITTED. DTSBX420 -00059 DTSBX420 -00060 01 WEB-IMP-REC. DTSBX420 -00061 05 WEB-IMP-TYPE PIC X(03). DTSBX420 -00062 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. DTSBX420 -00063 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. DTSBX420 -00064 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. DTSBX420 -00065 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. DTSBX420 -00066 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. DTSBX420 -00067 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. DTSBX420 -00068 88 WEB-IMP-TYPE-REL-88 VALUE '130'. DTSBX420 -00069 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. DTSBX420 -00070 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. DTSBX420 -00071 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. DTSBX420 -00072 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. DTSBX420 -00073 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. DTSBX420 -00074 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' DTSBX420 -00075 '108' '130' '132'. DTSBX420 -00076 88 WEB-TYPE-RPT-88 VALUE '140' '144'. DTSBX420 -00077 88 WEB-TYPE-PAY-88 VALUE '145'. DTSBX420 -00078 88 WEB-TYPE-PRF-88 VALUE '110' '120'. DTSBX420 -00079 05 FILLER PIC X(01). DTSBX420 -00080 05 WEB-IMP-EMP-NO PIC 9(06). DTSBX420 -00081 05 FILLER PIC X(01). DTSBX420 -00082 05 WEB-IMP-QTR PIC X(06). DTSBX420 -00083 05 FILLER PIC X(495). DTSBX420 -00084 DTSBX420 -00085 *FD CURR-BATCH-NO DTSBX420 -00086 * RECORDING MODE IS F DTSBX420 -00087 * BLOCK CONTAINS 0 RECORDS DTSBX420 -00088 * LABEL RECORDS ARE OMITTED. DTSBX420 -00089 * DTSBX420 -00090 *01 CURR-BATCH-NO-REC. DTSBX420 -00091 * 05 CURRENT-BATCH-NO PIC 9(05). DTSBX420 -00092 * 05 CURRENT-ITEM-NO PIC 9(03). DTSBX420 -00093 * 05 FILLER PIC X(01). DTSBX420 -00094 * 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBX420 -00095 * 05 FILLER PIC X(01). DTSBX420 -00096 * 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBX420 -00097 * 05 FILLER PIC X(62). DTSBX420 -00098 DTSBX420 -00099 SD SORT-FILE. DTSBX420 -00100 DTSBX420 -00101 01 SORT-REC. DTSBX420 -00102 05 SORT-KEY. DTSBX420 -00103 10 SORT-EMP-NO PIC 9(06). DTSBX420 -00104 10 SORT-SEQ1 PIC S9(04) COMP. DTSBX420 -00105 10 SORT-SEQ2 PIC X(16). DTSBX420 -00106 05 IN-HOUSE-SORT-KEY REDEFINES SORT-KEY. DTSBX420 -00107 10 SORT-IN-HOUSE-SEQ PIC 9(06). DTSBX420 -00108 10 SORT-BATCH PIC 9(05). DTSBX420 -00109 10 SORT-ITEM PIC 9(03). DTSBX420 -00110 10 SORT-FILLER PIC X(10). DTSBX420 -00111 05 SORT-DATA PIC X(512). DTSBX420 -00112 DTSBX420 -00113 WORKING-STORAGE SECTION. DTSBX420 -001135 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX420 10/07/14'. DTSBX420 -00114 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX420 10/07/14'. DTSBX420 -00115 SKIP3 DTSBX420 -00116 01 WRK-AREA. DTSBX420 -00117 05 W-ABEND-CD PIC S9(04) COMP VALUE 420. DTSBX420 -00118 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX420'.DTSBX420 -00119 DTSBX420 -00120 05 WEB-IMP-STATUS PIC X(02). DTSBX420 -00121 88 WEB-IMP-STATUS-OK-88 VALUE '00'. DTSBX420 -00122 88 WEB-IMP-STATUS-EOF-88 VALUE '10'. DTSBX420 -00123 DTSBX420 -00124 ** 05 BATCH-STATUS PIC X(02). DTSBX420 -00125 * 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX420 -00126 ** 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX420 -00127 DTSBX420 -00128 05 SORT-EOF-IND PIC X(01). DTSBX420 -00129 88 SORT-OK-88 VALUE '0'. DTSBX420 -00130 88 SORT-EOF-88 VALUE '1'. DTSBX420 +00034 * CL*23 +00035 * 10-22-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00036 * CHANGED SORT SEQUENCE FOR PROCESS X104 RECORDS CL*23 +00037 * BEFORE PROCESSING NAMES X106. CL*23 +00038 * RECORDS 102 AND 106 MUST BE PRESENT TO ADD A CL*23 +00039 * NEW EMPLOYER TO DUTAS. IF X102 AND X104 PASS CL*23 +00040 * ALL EDITS THEN NAME RECORD X106 RATE X108 AND CL*23 +00041 * ADDRESS X110 MUST BE PRESENT FOR EMPLOYER TO ADD CL*23 +00042 * CL*23 +00043 * REFERENCE RFP: ZL1 CL*23 +00044 * CL*23 +00045 * DTSBX420 +00046 * 11-01-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00047 * MODIFIED PROGRAM TO CALL A NEW PROGRAM BX430 TO CL*23 +00048 * PROCESS REPORTS,WAGES AND PAYMENTS. CL*23 +00049 * REPORTS X140 COMING FROM ESSP CANNOT BE PROCESSED CL*23 +00050 * UNTIL A PAYMENT X145 IS PRESENT UNLESS IT IS A CL*23 +00051 * ZERO WAGE REPORT (REMIT AMT = 0). ALSO CHANGED CL*23 +00052 * THE SORT SEQ TO SORT PAYMENT X145 BEFORE X140 CL*23 +00053 * PREVIOUS SORT KEY WAS 30 NOW 19. CL*23 +00054 * REFERENCE RFP: ZL1 CL*23 +00055 * CL*23 +00056 * CL*23 +00057 * 11-24-2014 MODIFIED FOR ESSP INTERFACE CL*40 +00058 * MODIFIED PROGRAM TO MOVE ESSP IMPORT RECORDS TYPE CL*40 +00059 * X120 TO A WORKING COPY OF DUTAS X120 CL*40 +00060 * FIELDS ON THE INPUT RECORD IS LARGER THAT DUTAS CL*40 +00061 * FIELDS. WITH NO PHARSING FIELD LENGTHS ARE CL*40 +00062 * THE EDITS TO FAILING. CL*40 +00063 * REFERENCE RFP: ESSP REGISTRTION ZL1 CL*40 +00064 * CL*40 +00065 * CL*40 +00066 ***** DTSBX420 +00067 SKIP3 DTSBX420 +00068 ENVIRONMENT DIVISION. DTSBX420 +00069 SKIP2 DTSBX420 +00070 INPUT-OUTPUT SECTION. DTSBX420 +00071 DTSBX420 +00072 FILE-CONTROL. DTSBX420 +00073 DTSBX420 +00074 SELECT WEB-IMP-FILE ASSIGN TO WEBREG DTSBX420 +00075 FILE STATUS IS WEB-IMP-STATUS. DTSBX420 +00076 DTSBX420 +00077 ** SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBX420 +00078 ** FILE STATUS IS BATCH-STATUS. DTSBX420 +00079 DTSBX420 +00080 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSBX420 +00081 DTSBX420 +00082 DATA DIVISION. DTSBX420 +00083 DTSBX420 +00084 FILE SECTION. DTSBX420 +00085 DTSBX420 +00086 FD WEB-IMP-FILE DTSBX420 +00087 RECORDING MODE IS F DTSBX420 +00088 BLOCK CONTAINS 0 RECORDS DTSBX420 +00089 LABEL RECORDS ARE OMITTED. DTSBX420 +00090 DTSBX420 +00091 01 WEB-IMP-REC. DTSBX420 +00092 05 WEB-IMP-TYPE PIC X(03). DTSBX420 +00093 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. DTSBX420 +00094 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. DTSBX420 +00095 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. DTSBX420 +00096 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. DTSBX420 +00097 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. DTSBX420 +00098 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. DTSBX420 +00099 88 WEB-IMP-TYPE-REL-88 VALUE '130'. DTSBX420 +00100 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. DTSBX420 +00101 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. DTSBX420 +00102 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. DTSBX420 +00103 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. DTSBX420 +00104 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. DTSBX420 +00105 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' DTSBX420 +00106 '108' '130' '132'. DTSBX420 +00107 88 WEB-TYPE-RPT-88 VALUE '140' '144'. DTSBX420 +00108 88 WEB-TYPE-PAY-88 VALUE '145'. DTSBX420 +00109 88 WEB-TYPE-PRF-88 VALUE '110' '120'. DTSBX420 +00110 05 FILLER PIC X(01). DTSBX420 +00111 05 WEB-IMP-EMP-NO PIC 9(06). DTSBX420 +00112 05 FILLER PIC X(01). DTSBX420 +00113 05 WEB-IMP-QTR PIC X(06). DTSBX420 +00114 05 FILLER PIC X(495). DTSBX420 +00115 DTSBX420 +00116 *FD CURR-BATCH-NO DTSBX420 +00117 * RECORDING MODE IS F DTSBX420 +00118 * BLOCK CONTAINS 0 RECORDS DTSBX420 +00119 * LABEL RECORDS ARE OMITTED. DTSBX420 +00120 * DTSBX420 +00121 *01 CURR-BATCH-NO-REC. DTSBX420 +00122 * 05 CURRENT-BATCH-NO PIC 9(05). DTSBX420 +00123 * 05 CURRENT-ITEM-NO PIC 9(03). DTSBX420 +00124 * 05 FILLER PIC X(01). DTSBX420 +00125 * 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBX420 +00126 * 05 FILLER PIC X(01). DTSBX420 +00127 * 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBX420 +00128 * 05 FILLER PIC X(62). DTSBX420 +00129 DTSBX420 +00130 SD SORT-FILE. DTSBX420 00131 DTSBX420 -00132 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX420 -00133 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX420 -00134 88 W-ERROR-NO-88 VALUE 'N'. DTSBX420 -00135 DTSBX420 -00136 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX420 -00137 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX420 -00138 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX420 -00139 DTSBX420 -00140 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX420 -00141 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX420 -00142 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX420 -00143 05 W-LAST-RATE-YEAR PIC 9(04). DTSBX420 -00144 DTSBX420 -00145 05 SUB PIC S9(04) COMP. DTSBX420 -00146 ** 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX420 -00147 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX420 -00148 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX420 -00149 ** 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX420 -00150 DTSBX420 -00151 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX420 -00152 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX420 -00153 DTSBX420 -00154 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX420 +00132 01 SORT-REC. DTSBX420 +00133 05 SORT-KEY. DTSBX420 +00134 10 SORT-EMP-NO PIC 9(06). DTSBX420 +00135 10 SORT-SEQ1 PIC S9(04) COMP. DTSBX420 +00136 10 SORT-SEQ2 PIC X(16). DTSBX420 +00137 05 IN-HOUSE-SORT-KEY REDEFINES SORT-KEY. DTSBX420 +00138 10 SORT-IN-HOUSE-SEQ PIC 9(06). DTSBX420 +00139 10 SORT-BATCH PIC 9(05). DTSBX420 +00140 10 SORT-ITEM PIC 9(03). DTSBX420 +00141 10 SORT-FILLER PIC X(10). DTSBX420 +00142 05 SORT-DATA PIC X(512). DTSBX420 +00143 DTSBX420 +00144 WORKING-STORAGE SECTION. DTSBX420 +001445 77 PAN-VALET PICTURE X(24) VALUE '056DTSBX420 03/10/20'. DTSBX420 +00145 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX420 10/07/14'. DTSBX420 +00146 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX420 10/07/14'. DTSBX420 +00147 SKIP3 DTSBX420 +00148 01 WRK-AREA. DTSBX420 +00149 05 W-ABEND-CD PIC S9(04) COMP VALUE 420. DTSBX420 +00150 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX420'.DTSBX420 +00151 DTSBX420 +00152 05 WEB-IMP-STATUS PIC X(02). DTSBX420 +00153 88 WEB-IMP-STATUS-OK-88 VALUE '00'. DTSBX420 +00154 88 WEB-IMP-STATUS-EOF-88 VALUE '10'. DTSBX420 00155 DTSBX420 -00156 05 W-500-DATE. DTSBX420 -00157 10 W-500-DATE-MM PIC XX. DTSBX420 -00158 10 FILLER PIC X. DTSBX420 -00159 10 W-500-DATE-DD PIC XX. DTSBX420 -00160 10 FILLER PIC X. DTSBX420 -00161 10 W-500-DATE-YY PIC XXXX. DTSBX420 -00162 DTSBX420 -00163 05 W-500-FQTR. DTSBX420 -00164 10 W-500-FQTR-YY PIC XXXX. DTSBX420 -00165 10 FILLER PIC X VALUE '/'. DTSBX420 -00166 10 W-500-FQTR-NO PIC X. DTSBX420 +00156 ** 05 BATCH-STATUS PIC X(02). DTSBX420 +00157 * 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX420 +00158 ** 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBX420 +00159 DTSBX420 +00160 05 SORT-EOF-IND PIC X(01). DTSBX420 +00161 88 SORT-OK-88 VALUE '0'. DTSBX420 +00162 88 SORT-EOF-88 VALUE '1'. DTSBX420 +00163 DTSBX420 +00164 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX420 +00165 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX420 +00166 88 W-ERROR-NO-88 VALUE 'N'. DTSBX420 00167 DTSBX420 -00168 05 W-INT-9 PIC 9(13). DTSBX420 -00169 05 W-INT-X REDEFINES W-INT-9 DTSBX420 -00170 PIC X(13). DTSBX420 -00171 05 W-INTEGER PIC S9(11) COMP-3. DTSBX420 -00172 05 W-FRACTION PIC SV9(11) COMP-3. DTSBX420 -00173 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBX420 -00174 DTSBX420 -00175 ** 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSBX420 -00176 * VALUE +0. DTSBX420 -00177 * 05 W-DIGIT PIC 9. DTSBX420 -00178 * 05 W-AMT PIC S9(09)V99 COMP-3 DTSBX420 -00179 * VALUE +0. DTSBX420 -00180 * DTSBX420 -00181 * 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX420 -00182 * 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX420 -00183 * 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX420 -00184 * DTSBX420 -00185 * 05 W-WAGES PIC S9(11)V99. DTSBX420 -00186 * 05 W-WAGES-X PIC X(14). DTSBX420 -00187 * 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX420 -00188 * PIC 9(11).99. DTSBX420 -00189 * 05 W-REMIT-X PIC X(12). DTSBX420 -00190 * 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX420 -00191 * PIC 9(09).99. DTSBX420 -00192 05 W-TRACE-X. DTSBX420 -00193 10 W-TRACE-A PIC X(05) VALUE '00000'. DTSBX420 -00194 10 W-TRACE-B PIC X(08) VALUE ZEROS. DTSBX420 -00195 05 W-TRACE-9 REDEFINES W-TRACE-X DTSBX420 -00196 PIC 9(13). DTSBX420 -00197 * 05 W-COUNT-X PIC X(07). DTSBX420 -00198 * 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX420 -00199 * PIC 9(07). DTSBX420 -00200 * 05 W-EARNINGS-X PIC X(12). DTSBX420 -00201 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX420 -00202 * PIC 9(09).99. DTSBX420 -00203 * 05 W-EARNINGS PIC S9(07)V99. DTSBX420 -00204 * 05 W-RATE PIC S9V9(04). DTSBX420 -00205 * 05 W-RATE-X PIC X(06). DTSBX420 -00206 * 05 W-RATE-9 REDEFINES W-RATE-X DTSBX420 -00207 * PIC 9.9999. DTSBX420 -00208 * DTSBX420 -00209 * 05 ISUB1 PIC S9(04) COMP. DTSBX420 -00210 * 05 ISUB2 PIC S9(04) COMP. DTSBX420 -00211 * 05 ISUB3 PIC S9(04) COMP. DTSBX420 -00212 * 05 ISUB4 PIC S9(04) COMP. DTSBX420 -00213 * 05 ISUB5 PIC S9(04) COMP. DTSBX420 -00214 * 05 ISUB6 PIC S9(04) COMP. DTSBX420 -00215 * 05 W-SLASH1 PIC S9(04) COMP. DTSBX420 -00216 * 05 W-SLASH2 PIC S9(04) COMP. DTSBX420 -00217 * 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX420 -00218 * 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX420 -00219 * 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX420 -00220 * 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX420 -00221 * VALUE +502. DTSBX420 -00222 * 05 W-INPUT-LINE PIC X(500). DTSBX420 -00223 * 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX420 -00224 * 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX420 -00225 * 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX420 -00226 * 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX420 -00227 * 05 W-CONV-LINE PIC X(32). DTSBX420 -00228 * DTSBX420 -00229 * 05 W-MDY PIC X(04). DTSBX420 -00230 * 05 FILLER REDEFINES W-MDY. DTSBX420 -00231 * 10 FILLER PIC X(02). DTSBX420 -00232 * 10 W-MDY-X-2 PIC X(02). DTSBX420 -00233 * 10 FILLER REDEFINES W-MDY-X-2. DTSBX420 -00234 * 15 FILLER PIC X(01). DTSBX420 -00235 ** 15 W-MDY-X-1 PIC X(01). DTSBX420 -00236 DTSBX420 -00237 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX420 -00238 DTSBX420 -00239 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX420 -00240 DTSBX420 -00241 05 W-AMT-DISP1 PIC ----------9.99. DTSBX420 -00242 05 W-AMT-DISP2 PIC ----------9.99. DTSBX420 -00243 05 W-AMT-DISP4 PIC -.99999999999. DTSBX420 -00244 05 W-AMT-DISP3 PIC ------------9. DTSBX420 -00245 DTSBX420 -00246 * PROFILE DTSBX420 -00247 01 X102-REC. DTSBX420 -00248 ++INCLUDE DTSIX102 DTSBX420 -00249 DTSBX420 -00250 * DETERMINATION DTSBX420 -00251 01 X104-REC. DTSBX420 -00252 ++INCLUDE DTSIX104 DTSBX420 -00253 DTSBX420 -00254 * NAME DTSBX420 -00255 01 X106-REC. DTSBX420 -00256 ++INCLUDE DTSIX106 DTSBX420 -00257 DTSBX420 -00258 * RATE DTSBX420 -00259 01 X108-REC. DTSBX420 -00260 ++INCLUDE DTSIX108 DTSBX420 -00261 DTSBX420 -00262 * ADDRESS DTSBX420 -00263 01 X110-REC. DTSBX420 -00264 ++INCLUDE DTSIX110 DTSBX420 -00265 DTSBX420 -00266 * OPO DTSBX420 -00267 01 X120-REC. DTSBX420 -00268 ++INCLUDE DTSIX120 DTSBX420 +00168 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX420 +00169 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX420 +00170 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX420 +00171 DTSBX420 +00172 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX420 +00173 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX420 +00174 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX420 +00175 05 W-LAST-RATE-YEAR PIC 9(04). DTSBX420 +00176 05 X102-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00177 DTSBX420 +00178 05 SUB PIC S9(04) COMP. DTSBX420 +00179 ** 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX420 +00180 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSBX420 +00181 * 10 W-PSEUDO-DAYS PIC 9(03). DTSBX420 +00182 ** 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSBX420 +00183 DTSBX420 +00184 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX420 +00185 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX420 +00186 DTSBX420 +00187 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBX420 +00188 DTSBX420 +00189 05 W-500-DATE. DTSBX420 +00190 10 W-500-DATE-MM PIC XX. DTSBX420 +00191 10 FILLER PIC X. DTSBX420 +00192 10 W-500-DATE-DD PIC XX. DTSBX420 +00193 10 FILLER PIC X. DTSBX420 +00194 10 W-500-DATE-YY PIC XXXX. DTSBX420 +00195 DTSBX420 +00196 05 W-500-FQTR. DTSBX420 +00197 10 W-500-FQTR-YY PIC XXXX. DTSBX420 +00198 10 FILLER PIC X VALUE '/'. DTSBX420 +00199 10 W-500-FQTR-NO PIC X. DTSBX420 +00200 DTSBX420 +00201 05 W-INT-9 PIC 9(13). DTSBX420 +00202 05 W-INT-X REDEFINES W-INT-9 DTSBX420 +00203 PIC X(13). DTSBX420 +00204 05 W-INTEGER PIC S9(11) COMP-3. DTSBX420 +00205 05 W-FRACTION PIC SV9(11) COMP-3. DTSBX420 +00206 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBX420 +00207 DTSBX420 +00208 ** 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSBX420 +00209 * VALUE +0. DTSBX420 +00210 * 05 W-DIGIT PIC 9. DTSBX420 +00211 * 05 W-AMT PIC S9(09)V99 COMP-3 DTSBX420 +00212 * VALUE +0. DTSBX420 +00213 * DTSBX420 +00214 * 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX420 +00215 * 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX420 +00216 * 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX420 +00217 * DTSBX420 +00218 * 05 W-WAGES PIC S9(11)V99. DTSBX420 +00219 * 05 W-WAGES-X PIC X(14). DTSBX420 +00220 * 05 W-WAGES-9 REDEFINES W-WAGES-X DTSBX420 +00221 * PIC 9(11).99. DTSBX420 +00222 * 05 W-REMIT-X PIC X(12). DTSBX420 +00223 * 05 W-REMIT-9 REDEFINES W-REMIT-X DTSBX420 +00224 * PIC 9(09).99. DTSBX420 +00225 05 W-TRACE-X. DTSBX420 +00226 10 W-TRACE-A PIC X(05) VALUE '00000'. DTSBX420 +00227 10 W-TRACE-B PIC X(08) VALUE ZEROS. DTSBX420 +00228 05 W-TRACE-9 REDEFINES W-TRACE-X DTSBX420 +00229 PIC 9(13). DTSBX420 +00230 * 05 W-COUNT-X PIC X(07). DTSBX420 +00231 * 05 W-COUNT-9 REDEFINES W-COUNT-X DTSBX420 +00232 * PIC 9(07). DTSBX420 +00233 * 05 W-EARNINGS-X PIC X(12). DTSBX420 +00234 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX420 +00235 * PIC 9(09).99. DTSBX420 +00236 * 05 W-EARNINGS PIC S9(07)V99. DTSBX420 +00237 * 05 W-RATE PIC S9V9(04). DTSBX420 +00238 * 05 W-RATE-X PIC X(06). DTSBX420 +00239 * 05 W-RATE-9 REDEFINES W-RATE-X DTSBX420 +00240 * PIC 9.9999. DTSBX420 +00241 * DTSBX420 +00242 * 05 ISUB1 PIC S9(04) COMP. DTSBX420 +00243 * 05 ISUB2 PIC S9(04) COMP. DTSBX420 +00244 * 05 ISUB3 PIC S9(04) COMP. DTSBX420 +00245 * 05 ISUB4 PIC S9(04) COMP. DTSBX420 +00246 * 05 ISUB5 PIC S9(04) COMP. DTSBX420 +00247 * 05 ISUB6 PIC S9(04) COMP. DTSBX420 +00248 * 05 W-SLASH1 PIC S9(04) COMP. DTSBX420 +00249 * 05 W-SLASH2 PIC S9(04) COMP. DTSBX420 +00250 * 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX420 +00251 * 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX420 +00252 * 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSBX420 +00253 * 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX420 +00254 * VALUE +502. DTSBX420 +00255 * 05 W-INPUT-LINE PIC X(500). DTSBX420 +00256 * 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX420 +00257 * 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX420 +00258 * 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX420 +00259 * 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX420 +00260 * 05 W-CONV-LINE PIC X(32). DTSBX420 +00261 * DTSBX420 +00262 * 05 W-MDY PIC X(04). DTSBX420 +00263 * 05 FILLER REDEFINES W-MDY. DTSBX420 +00264 * 10 FILLER PIC X(02). DTSBX420 +00265 * 10 W-MDY-X-2 PIC X(02). DTSBX420 +00266 * 10 FILLER REDEFINES W-MDY-X-2. DTSBX420 +00267 * 15 FILLER PIC X(01). DTSBX420 +00268 ** 15 W-MDY-X-1 PIC X(01). DTSBX420 00269 DTSBX420 -00270 * RELATIONSHIP DTSBX420 -00271 01 X130-REC. DTSBX420 -00272 ++INCLUDE DTSIX130 DTSBX420 -00273 DTSBX420 -00274 ** INDUSTRY DESCRIPTION DTSBX420 -00275 *01 X132-REC. DTSBX420 -00276 ***INCLUDE DTSIX132 DTSBX420 -00277 DTSBX420 -00278 * REPORT DTSBX420 -00279 01 X140-REC. DTSBX420 -00280 ++INCLUDE DTSIX140 DTSBX420 -00281 DTSBX420 -00282 * EMPLOYEE WAGES DTSBX420 -00283 01 X144-REC. DTSBX420 -00284 ++INCLUDE DTSIX144 DTSBX420 -00285 DTSBX420 -00286 * PAYMENT DTSBX420 -00287 01 X145-REC. DTSBX420 -00288 ++INCLUDE DTSIX145 DTSBX420 -00289 DTSBX420 -00290 01 X149-REC. DTSBX420 -00291 ++INCLUDE DTSIX149 DTSBX420 -00292 DTSBX420 -00293 01 L001-LINK-AREA. DTSBX420 -00294 ++INCLUDE DTSIL001 DTSBX420 +00270 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX420 +00271 05 W-102-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00272 05 W-104-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00273 05 W-106-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00274 05 W-108-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00275 05 W-110-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00276 05 W-120-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00277 05 W-140-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00278 05 W-144-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00279 05 W-145-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00280 DTSBX420 +00281 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSBX420 +00282 DTSBX420 +00283 05 W-AMT-DISP1 PIC ----------9.99. DTSBX420 +00284 05 W-AMT-DISP2 PIC ----------9.99. DTSBX420 +00285 05 W-AMT-DISP4 PIC -.99999999999. DTSBX420 +00286 05 W-AMT-DISP3 PIC ------------9. DTSBX420 +00287 DTSBX420 +00288 * PROFILE DTSBX420 +00289 01 X102-REC. DTSBX420 +00290 ++INCLUDE DTSIX102 DTSBX420 +00291 DTSBX420 +00292 * DETERMINATION DTSBX420 +00293 01 X104-REC. DTSBX420 +00294 ++INCLUDE DTSIX104 DTSBX420 00295 DTSBX420 -00296 01 L003-LINK-AREA. DTSBX420 -00297 ++INCLUDE DTSIL003 DTSBX420 -00298 DTSBX420 -00299 01 L004-LINK-AREA. DTSBX420 -00300 ++INCLUDE DTSIL004 DTSBX420 -00301 DTSBX420 -00302 01 L005-LINK-AREA. DTSBX420 -00303 ++INCLUDE DTSIL005 DTSBX420 -00304 DTSBX420 -00305 01 L205-LINK-AREA. DTSBX420 -00306 ++INCLUDE DTSIL205 DTSBX420 +00296 * NAME DTSBX420 +00297 01 X106-REC. DTSBX420 +00298 ++INCLUDE DTSIX106 DTSBX420 +00299 DTSBX420 +00300 * RATE DTSBX420 +00301 01 X108-REC. DTSBX420 +00302 ++INCLUDE DTSIX108 DTSBX420 +00303 DTSBX420 +00304 * ADDRESS DTSBX420 +00305 01 X110-REC. DTSBX420 +00306 ++INCLUDE DTSIX110 DTSBX420 00307 DTSBX420 -00308 01 LX42-LINK-AREA. DTSBX420 -00309 ++INCLUDE DTSILX42 DTSBX420 -00310 DTSBX420 -00311 01 L910-LINK-AREA. DTSBX420 -00312 ++INCLUDE DTSIL910 DTSBX420 -00313 01 MSKL-REC. DTSBX420 -00314 ++INCLUDE DTSIMSKL DTSBX420 -00315 DTSBX420 -00316 01 MHDR-REC. DTSBX420 -00317 ++INCLUDE DTSIMHDR DTSBX420 -00318 DTSBX420 -00319 01 MPRF-REC. DTSBX420 -00320 ++INCLUDE DTSIMPRF DTSBX420 -00321 DTSBX420 -00322 01 MSOL-REC. DTSBX420 -00323 ++INCLUDE DTSIMSOL DTSBX420 -00324 DTSBX420 -00325 01 MQTR-REC. DTSBX420 -00326 ++INCLUDE DTSIMQTR DTSBX420 +00308 * OPO DTSBX420 +00309 01 X120-REC. DTSBX420 +00310 ++INCLUDE DTSIX120 DTSBX420 +00311 DTSBX420 +00312 * WORKING COPY OF X120 CL*41 +00313 01 W120-REC. CL*41 +00314 ++INCLUDE DTSWX120 CL*43 +00315 CL*41 +00316 * RELATIONSHIP DTSBX420 +00317 01 X130-REC. DTSBX420 +00318 ++INCLUDE DTSIX130 DTSBX420 +00319 DTSBX420 +00320 ** INDUSTRY DESCRIPTION DTSBX420 +00321 *01 X132-REC. DTSBX420 +00322 ***INCLUDE DTSIX132 DTSBX420 +00323 DTSBX420 +00324 * REPORT DTSBX420 +00325 01 X140-REC. DTSBX420 +00326 ++INCLUDE DTSIX140 DTSBX420 00327 DTSBX420 -00328 01 MOPO-REC. DTSBX420 -00329 ++INCLUDE DTSIMOPO DTSBX420 -00330 DTSBX420 -00331 01 MTAD-REC. DTSBX420 -00332 ++INCLUDE DTSIMTAD DTSBX420 -00333 DTSBX420 -00334 01 MNTE-REC. DTSBX420 -00335 ++INCLUDE DTSIMNTE DTSBX420 -00336 DTSBX420 -00337 01 L921-LINK-AREA. DTSBX420 -00338 ++INCLUDE DTSIL921 DTSBX420 -00339 SKIP3 DTSBX420 -00340 01 ISKL-REC. DTSBX420 -00341 ++INCLUDE DTSIISKL DTSBX420 -00342 SKIP3 DTSBX420 -00343 01 IEIN-REC. DTSBX420 -00344 ++INCLUDE DTSIIEIN DTSBX420 +00328 * EMPLOYEE WAGES DTSBX420 +00329 01 X144-REC. DTSBX420 +00330 ++INCLUDE DTSIX144 DTSBX420 +00331 DTSBX420 +00332 * EMPLOYEE WAGES-WORK COPY CL*50 +00333 01 W144-REC. CL*50 +00334 ++INCLUDE DTSIW144 CL*50 +00335 CL*50 +00336 * PAYMENT DTSBX420 +00337 01 X145-REC. DTSBX420 +00338 ++INCLUDE DTSIX145 DTSBX420 +00339 DTSBX420 +00340 01 X149-REC. DTSBX420 +00341 ++INCLUDE DTSIX149 DTSBX420 +00342 DTSBX420 +00343 01 L001-LINK-AREA. DTSBX420 +00344 ++INCLUDE DTSIL001 DTSBX420 00345 DTSBX420 -00346 01 L923-LINK-AREA. DTSBX420 -00347 ++INCLUDE DTSIL923 DTSBX420 -00348 EJECT DTSBX420 -00349 01 ASKL-REC. DTSBX420 -00350 ++INCLUDE DTSIASKL DTSBX420 -00351 EJECT DTSBX420 -00352 01 AHDR-REC. DTSBX420 -00353 ++INCLUDE DTSIAHDR DTSBX420 +00346 01 L003-LINK-AREA. DTSBX420 +00347 ++INCLUDE DTSIL003 DTSBX420 +00348 DTSBX420 +00349 01 L004-LINK-AREA. DTSBX420 +00350 ++INCLUDE DTSIL004 DTSBX420 +00351 DTSBX420 +00352 01 L005-LINK-AREA. DTSBX420 +00353 ++INCLUDE DTSIL005 DTSBX420 00354 DTSBX420 -00355 01 ARPT-REC. DTSBX420 -00356 ++INCLUDE DTSIARPT DTSBX420 +00355 01 L205-LINK-AREA. DTSBX420 +00356 ++INCLUDE DTSIL205 DTSBX420 00357 DTSBX420 -00358 01 APAY-REC. DTSBX420 -00359 ++INCLUDE DTSIAPAY DTSBX420 +00358 01 LX42-LINK-AREA. DTSBX420 +00359 ++INCLUDE DTSILX42 CL*39 00360 DTSBX420 -00361 DTSBX420 -00362 01 L927-LINK-AREA. DTSBX420 -00363 ++INCLUDE DTSIL927 DTSBX420 -00364 DTSBX420 -00365 01 TSKL-REC. DTSBX420 -00366 ++INCLUDE DTSITSKL DTSBX420 -00367 DTSBX420 -00368 01 L931-LINK-AREA. DTSBX420 -00369 ++INCLUDE DTSIL931 DTSBX420 -00370 DTSBX420 -00371 01 FSKL-REC. DTSBX420 -00372 ++INCLUDE DTSIFSKL DTSBX420 -00373 DTSBX420 -00374 PROCEDURE DIVISION. DTSBX420 -00375 DTSBX420 -00376 DTSBX420-MAIN. DTSBX420 -00377 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX420 -00378 IF W-FATAL-ERROR-YES-88 DTSBX420 -00379 GO TO DTSBX420-MAIN-EXIT DTSBX420 -00380 END-IF. DTSBX420 -00381 DTSBX420 -00382 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX420 +00361 01 L910-LINK-AREA. DTSBX420 +00362 ++INCLUDE DTSIL910 DTSBX420 +00363 01 MSKL-REC. DTSBX420 +00364 ++INCLUDE DTSIMSKL DTSBX420 +00365 DTSBX420 +00366 01 MHDR-REC. DTSBX420 +00367 ++INCLUDE DTSIMHDR DTSBX420 +00368 DTSBX420 +00369 01 MPRF-REC. DTSBX420 +00370 ++INCLUDE DTSIMPRF DTSBX420 +00371 DTSBX420 +00372 01 MSOL-REC. DTSBX420 +00373 ++INCLUDE DTSIMSOL DTSBX420 +00374 DTSBX420 +00375 01 MQTR-REC. DTSBX420 +00376 ++INCLUDE DTSIMQTR DTSBX420 +00377 DTSBX420 +00378 01 MOPO-REC. DTSBX420 +00379 ++INCLUDE DTSIMOPO DTSBX420 +00380 DTSBX420 +00381 01 MTAD-REC. DTSBX420 +00382 ++INCLUDE DTSIMTAD DTSBX420 00383 DTSBX420 -00384 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX420 -00385 IF W-ERROR-YES-88 DTSBX420 -00386 MOVE +2 TO RETURN-CODE. DTSBX420 -00387 DTSBX420-MAIN-EXIT. DTSBX420 -00388 GOBACK. DTSBX420 -00389 EJECT DTSBX420 -00390 I0000-INITIATE. DTSBX420 -00391 SET W-ERROR-NO-88 TO TRUE. DTSBX420 -00392 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX420 -00393 DTSBX420 -00394 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX420 +00384 01 MNTE-REC. DTSBX420 +00385 ++INCLUDE DTSIMNTE DTSBX420 +00386 DTSBX420 +00387 01 L921-LINK-AREA. DTSBX420 +00388 ++INCLUDE DTSIL921 DTSBX420 +00389 SKIP3 DTSBX420 +00390 01 ISKL-REC. DTSBX420 +00391 ++INCLUDE DTSIISKL DTSBX420 +00392 SKIP3 DTSBX420 +00393 01 IEIN-REC. DTSBX420 +00394 ++INCLUDE DTSIIEIN DTSBX420 00395 DTSBX420 -00396 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX420 -00397 IF W-FATAL-ERROR-YES-88 DTSBX420 -00398 GO TO I0000-EXIT DTSBX420 -00399 END-IF. DTSBX420 -00400 DTSBX420 -00401 PERFORM I3000-READ-HEADER THRU I3000-EXIT. DTSBX420 -00402 IF W-FATAL-ERROR-YES-88 DTSBX420 -00403 GO TO I0000-EXIT DTSBX420 -00404 END-IF. DTSBX420 -00405 DTSBX420 -00406 ** PERFORM I4000-CURRENT-BATCH THRU I4000-EXIT DTSBX420 -00407 * IF W-FATAL-ERROR-YES-88 DTSBX420 -00408 * GO TO I0000-EXIT DTSBX420 -00409 ** END-IF. DTSBX420 +00396 01 L923-LINK-AREA. DTSBX420 +00397 ++INCLUDE DTSIL923 DTSBX420 +00398 EJECT DTSBX420 +00399 01 ASKL-REC. DTSBX420 +00400 ++INCLUDE DTSIASKL DTSBX420 +00401 EJECT DTSBX420 +00402 01 AHDR-REC. DTSBX420 +00403 ++INCLUDE DTSIAHDR DTSBX420 +00404 DTSBX420 +00405 01 ARPT-REC. DTSBX420 +00406 ++INCLUDE DTSIARPT DTSBX420 +00407 DTSBX420 +00408 01 APAY-REC. DTSBX420 +00409 ++INCLUDE DTSIAPAY DTSBX420 00410 DTSBX420 -00411 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSBX420 -00412 DTSBX420 -00413 I0000-EXIT. DTSBX420 -00414 EXIT. DTSBX420 -00415 DTSBX420 -00416 I2000-OPEN-FILES. DTSBX420 -00417 OPEN INPUT WEB-IMP-FILE. DTSBX420 -00418 IF NOT WEB-IMP-STATUS-OK-88 DTSBX420 -00419 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 -00420 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX420 -00421 MOVE +3 TO RETURN-CODE DTSBX420 -00422 SET W-ERROR-YES-88 TO TRUE DTSBX420 -00423 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX420 -00424 WEB-IMP-STATUS DTSBX420 -00425 GO TO I2000-EXIT DTSBX420 -00426 END-IF. DTSBX420 -00427 DTSBX420 -00428 READ WEB-IMP-FILE. DTSBX420 -00429 IF NOT WEB-IMP-STATUS-OK-88 DTSBX420 -00430 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 -00431 DISPLAY 'NO ESSP FTP UPDATE FILES TO PROCESS' DTSBX420 -00432 MOVE +3 TO RETURN-CODE DTSBX420 -00433 SET W-ERROR-YES-88 TO TRUE DTSBX420 -00434 DISPLAY 'NO RECORDS ON WEB-IMP-FILE ' DTSBX420 -00435 WEB-IMP-STATUS DTSBX420 -00436 GO TO I2000-EXIT DTSBX420 -00437 END-IF. DTSBX420 -00438 CLOSE WEB-IMP-FILE. DTSBX420 -00439 OPEN INPUT WEB-IMP-FILE. DTSBX420 -00440 IF NOT WEB-IMP-STATUS-OK-88 DTSBX420 -00441 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 -00442 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX420 -00443 MOVE +3 TO RETURN-CODE DTSBX420 -00444 SET W-ERROR-YES-88 TO TRUE DTSBX420 -00445 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX420 -00446 WEB-IMP-STATUS DTSBX420 -00447 GO TO I2000-EXIT DTSBX420 -00448 END-IF. DTSBX420 -00449 DTSBX420 -00450 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX420 -00451 DTSBX420 -00452 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX420 -00453 DTSBX420 -00454 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBX420 +00411 DTSBX420 +00412 01 L927-LINK-AREA. DTSBX420 +00413 ++INCLUDE DTSIL927 DTSBX420 +00414 DTSBX420 +00415 01 TSKL-REC. DTSBX420 +00416 ++INCLUDE DTSITSKL DTSBX420 +00417 DTSBX420 +00418 01 L931-LINK-AREA. DTSBX420 +00419 ++INCLUDE DTSIL931 DTSBX420 +00420 DTSBX420 +00421 01 FSKL-REC. DTSBX420 +00422 ++INCLUDE DTSIFSKL DTSBX420 +00423 DTSBX420 +00424 PROCEDURE DIVISION. DTSBX420 +00425 DTSBX420 +00426 DTSBX420-MAIN. DTSBX420 +00427 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX420 +00428 IF W-FATAL-ERROR-YES-88 DTSBX420 +00429 GO TO DTSBX420-MAIN-EXIT DTSBX420 +00430 END-IF. DTSBX420 +00431 DTSBX420 +00432 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX420 +00433 DTSBX420 +00434 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX420 +00435 IF W-ERROR-YES-88 DTSBX420 +00436 MOVE +2 TO RETURN-CODE. DTSBX420 +00437 DTSBX420-MAIN-EXIT. DTSBX420 +00438 GOBACK. DTSBX420 +00439 EJECT DTSBX420 +00440 I0000-INITIATE. DTSBX420 +00441 SET W-ERROR-NO-88 TO TRUE. DTSBX420 +00442 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX420 +00443 DTSBX420 +00444 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX420 +00445 DTSBX420 +00446 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX420 +00447 IF W-FATAL-ERROR-YES-88 DTSBX420 +00448 GO TO I0000-EXIT DTSBX420 +00449 END-IF. DTSBX420 +00450 DTSBX420 +00451 PERFORM I3000-READ-HEADER THRU I3000-EXIT. DTSBX420 +00452 IF W-FATAL-ERROR-YES-88 DTSBX420 +00453 GO TO I0000-EXIT DTSBX420 +00454 END-IF. DTSBX420 00455 DTSBX420 -00456 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX420 -00457 DTSBX420 -00458 MOVE 'N' TO L927-TRACE-IND. DTSBX420 -00459 MOVE W-MOD-NAME TO L927-MOD-NAME. DTSBX420 -00460 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBX420 -00461 DTSBX420 -00462 I2000-EXIT. DTSBX420 -00463 EXIT. DTSBX420 -00464 DTSBX420 -00465 I3000-READ-HEADER. DTSBX420 -00466 MOVE LOW-VALUES TO MSKL-REC. DTSBX420 -00467 MOVE +0 TO MSKL-EMP-NO. DTSBX420 -00468 SET MSKL-HDR-88 TO TRUE. DTSBX420 -00469 DTSBX420 -00470 PERFORM S910-READ THRU S910-EXIT. DTSBX420 -00471 IF L910-NO-REC-88 DTSBX420 -00472 DISPLAY 'DTSBX420: MHDR RECORD IS MISSING' DTSBX420 -00473 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 -00474 MOVE +6 TO RETURN-CODE DTSBX420 -00475 GO TO I3000-EXIT DTSBX420 -00476 ELSE DTSBX420 -00477 MOVE MSKL-REC TO MHDR-REC DTSBX420 -00478 END-IF. DTSBX420 -00479 DTSBX420 -00480 MOVE MHDR-CURR-RUN-DATE TO W-CURR-RUN-DATE. DTSBX420 -00481 DTSBX420 -00482 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBX420 -00483 MOVE L004-QTR-5-YR TO W-LAST-RATE-YEAR. DTSBX420 -00484 DISPLAY 'LAST RATE YEAR ' W-LAST-RATE-YEAR. DTSBX420 -00485 DTSBX420 -00486 I3000-EXIT. DTSBX420 -00487 EXIT. DTSBX420 -00488 DTSBX420 -00489 *I4000-CURRENT-BATCH. DTSBX420 -00490 * OPEN I-O CURR-BATCH-NO. DTSBX420 -00491 * IF NOT BATCH-STATUS-OK-88 DTSBX420 -00492 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 -00493 * DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBX420 -00494 * BATCH-STATUS DTSBX420 -00495 * GO TO I4000-EXIT DTSBX420 -00496 * END-IF. DTSBX420 -00497 * DTSBX420 -00498 * READ CURR-BATCH-NO DTSBX420 -00499 * IF BATCH-STATUS-OK-88 DTSBX420 -00500 * DISPLAY 'OLD BATCH ' CURRENT-BATCH-NO DTSBX420 -00501 * COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBX420 -00502 * MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBX420 -00503 * MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBX420 -00504 * DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBX420 -00505 * DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBX420 -00506 * ELSE DTSBX420 -00507 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 -00508 * DISPLAY 'CANNOT READ CURR BATCH NUMBER FILE ' DTSBX420 -00509 * BATCH-STATUS DTSBX420 -00510 * GO TO I4000-EXIT DTSBX420 -00511 * END-IF. DTSBX420 -00512 * DTSBX420 -00513 *I4000-EXIT. DTSBX420 -00514 * EXIT. DTSBX420 -00515 DTSBX420 -00516 I5000-INITIAL-CALLS. DTSBX420 -00517 SET LX42-INITIALIZE-88 TO TRUE. DTSBX420 -00518 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSBX420 -00519 MOVE L005-DATE TO LX42-SYS-DATE. DTSBX420 -00520 MOVE L005-TIME TO LX42-SYS-TIME. DTSBX420 -00521 MOVE ZERO TO LX42-BATCH-NO DTSBX420 -00522 LX42-PSEUDO-BATCH-NO DTSBX420 -00523 LX42-LAST-DETERM-EMP DTSBX420 -00524 LX42-RPT-CNT DTSBX420 -00525 LX42-RPT-REMIT-AMT DTSBX420 -00526 LX42-PAY-CNT DTSBX420 -00527 LX42-PAY-REMIT-AMT. DTSBX420 -00528 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX420 -00529 SET LX42-ERROR-NO-88 TO TRUE. DTSBX420 -00530 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX420 +00456 ** PERFORM I4000-CURRENT-BATCH THRU I4000-EXIT DTSBX420 +00457 * IF W-FATAL-ERROR-YES-88 DTSBX420 +00458 * GO TO I0000-EXIT DTSBX420 +00459 ** END-IF. DTSBX420 +00460 DTSBX420 +00461 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSBX420 +00462 DTSBX420 +00463 I0000-EXIT. DTSBX420 +00464 EXIT. DTSBX420 +00465 DTSBX420 +00466 I2000-OPEN-FILES. DTSBX420 +00467 OPEN INPUT WEB-IMP-FILE. DTSBX420 +00468 IF NOT WEB-IMP-STATUS-OK-88 DTSBX420 +00469 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 +00470 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX420 +00471 MOVE +3 TO RETURN-CODE DTSBX420 +00472 SET W-ERROR-YES-88 TO TRUE DTSBX420 +00473 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX420 +00474 WEB-IMP-STATUS DTSBX420 +00475 GO TO I2000-EXIT DTSBX420 +00476 END-IF. DTSBX420 +00477 DTSBX420 +00478 READ WEB-IMP-FILE. DTSBX420 +00479 IF NOT WEB-IMP-STATUS-OK-88 DTSBX420 +00480 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 +00481 DISPLAY 'NO ESSP FTP UPDATE FILES TO PROCESS' DTSBX420 +00482 MOVE +3 TO RETURN-CODE DTSBX420 +00483 SET W-ERROR-YES-88 TO TRUE DTSBX420 +00484 DISPLAY 'NO RECORDS ON WEB-IMP-FILE ' DTSBX420 +00485 WEB-IMP-STATUS DTSBX420 +00486 GO TO I2000-EXIT DTSBX420 +00487 END-IF. DTSBX420 +00488 CLOSE WEB-IMP-FILE. DTSBX420 +00489 OPEN INPUT WEB-IMP-FILE. DTSBX420 +00490 IF NOT WEB-IMP-STATUS-OK-88 DTSBX420 +00491 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 +00492 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSBX420 +00493 MOVE +3 TO RETURN-CODE DTSBX420 +00494 SET W-ERROR-YES-88 TO TRUE DTSBX420 +00495 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSBX420 +00496 WEB-IMP-STATUS DTSBX420 +00497 GO TO I2000-EXIT DTSBX420 +00498 END-IF. DTSBX420 +00499 DTSBX420 +00500 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX420 +00501 DTSBX420 +00502 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX420 +00503 DTSBX420 +00504 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBX420 +00505 DTSBX420 +00506 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX420 +00507 DTSBX420 +00508 * MOVE 'N' TO L927-TRACE-IND. CL*44 +00509 * MOVE W-MOD-NAME TO L927-MOD-NAME. CL*44 +00510 * PERFORM S927A-OPEN THRU S927A-EXIT. CL*44 +00511 DTSBX420 +00512 I2000-EXIT. DTSBX420 +00513 EXIT. DTSBX420 +00514 DTSBX420 +00515 I3000-READ-HEADER. DTSBX420 +00516 MOVE LOW-VALUES TO MSKL-REC. DTSBX420 +00517 MOVE +0 TO MSKL-EMP-NO. DTSBX420 +00518 SET MSKL-HDR-88 TO TRUE. DTSBX420 +00519 DTSBX420 +00520 PERFORM S910-READ THRU S910-EXIT. DTSBX420 +00521 IF L910-NO-REC-88 DTSBX420 +00522 DISPLAY 'DTSBX420: MHDR RECORD IS MISSING' DTSBX420 +00523 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 +00524 MOVE +6 TO RETURN-CODE DTSBX420 +00525 GO TO I3000-EXIT DTSBX420 +00526 ELSE DTSBX420 +00527 MOVE MSKL-REC TO MHDR-REC DTSBX420 +00528 END-IF. DTSBX420 +00529 DTSBX420 +00530 MOVE MHDR-CURR-RUN-DATE TO W-CURR-RUN-DATE. DTSBX420 00531 DTSBX420 -00532 PERFORM S421-REGISTRATION THRU S421-EXIT. DTSBX420 -00533 PERFORM S422-REPORT THRU S422-EXIT. DTSBX420 -00534 PERFORM S423-PAYMENT THRU S423-EXIT. DTSBX420 -00535 PERFORM S424-PROFILE THRU S424-EXIT. DTSBX420 -00536 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX420 -00537 DTSBX420 -00538 I5000-EXIT. DTSBX420 -00539 EXIT. DTSBX420 -00540 DTSBX420 -00541 DTSBX420 -00542 P0000-PROCESS. DTSBX420 -00543 DISPLAY 'WEB IMPORT PRELIMINARY EDIT'. DTSBX420 -00544 DISPLAY SPACE. DTSBX420 -00545 DTSBX420 -00546 SET W-ERROR-NO-88 TO TRUE. DTSBX420 -00547 DTSBX420 -00548 SORT SORT-FILE DTSBX420 -00549 ON ASCENDING KEY SORT-KEY DTSBX420 -00550 INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT DTSBX420 -00551 OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT. DTSBX420 -00552 DTSBX420 -00553 IF SORT-RETURN NOT = +0 DTSBX420 -00554 DISPLAY 'SORT FAILED ' SORT-RETURN DTSBX420 -00555 END-IF. DTSBX420 -00556 DTSBX420 -00557 P0000-EXIT. DTSBX420 -00558 EXIT. DTSBX420 -00559 DTSBX420 -00560 DTSBX420 -00561 P1000-PRE-SORT. DTSBX420 -00562 ** DISPLAY 'P1000-PRE-SORT' DTSBX420 -00563 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT. DTSBX420 -00564 ** DISPLAY 'S1000-READ-WEB-IMP' DTSBX420 -00565 PERFORM UNTIL WEB-IMP-STATUS-EOF-88 DTSBX420 -00566 PERFORM P1100-PARSE-IMPORT-REC THRU P1100-EXIT DTSBX420 -00567 ** DISPLAY 'P1100-PARSE-IMPORT-REC ' DTSBX420 -00568 PERFORM P1200-BUILD-SORT-REC THRU P1200-EXIT DTSBX420 -00569 ** DISPLAY 'P1200-BUILD-SORT-REC ' DTSBX420 -00570 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT DTSBX420 -00571 ** DISPLAY 'S1000-READ-WEB-IMP ' DTSBX420 -00572 END-PERFORM. DTSBX420 -00573 DTSBX420 -00574 P1000-EXIT. DTSBX420 -00575 EXIT. DTSBX420 -00576 DTSBX420 -00577 P1100-PARSE-IMPORT-REC. DTSBX420 -00578 IF WEB-IMP-TYPE-BHDR-88 DTSBX420 -00579 DISPLAY 'BX420 P1000 HDR ' WEB-IMP-REC(1:14) DTSBX420 -00580 END-IF. DTSBX420 -00581 DISPLAY 'P1000 ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. DTSBX420 -00582 DTSBX420 -00583 PERFORM DTSBX420 -00584 VARYING SUB FROM +1 BY +1 DTSBX420 -00585 UNTIL SUB > +100 DTSBX420 -00586 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX420 -00587 L205-INTEGER (SUB) DTSBX420 -00588 L205-FRACTION (SUB) DTSBX420 -00589 MOVE SPACES TO L205-TEXT (SUB) DTSBX420 -00590 L205-DATE (SUB) DTSBX420 -00591 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX420 -00592 END-PERFORM. DTSBX420 -00593 DTSBX420 -00594 EVALUATE TRUE DTSBX420 -00595 WHEN WEB-IMP-TYPE-PRF-88 DTSBX420 -00596 PERFORM P1100A-PRF THRU P1100A-EXIT DTSBX420 -00597 DTSBX420 -00598 WHEN WEB-IMP-TYPE-DETERM-88 DTSBX420 -00599 PERFORM P1100B-DETERM THRU P1100B-EXIT DTSBX420 -00600 DTSBX420 -00601 WHEN WEB-IMP-TYPE-NAME-88 DTSBX420 -00602 PERFORM P1100C-NAME THRU P1100C-EXIT DTSBX420 -00603 DTSBX420 -00604 WHEN WEB-IMP-TYPE-RATE-88 DTSBX420 -00605 PERFORM P1100D-RATE THRU P1100D-EXIT DTSBX420 +00532 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSBX420 +00533 MOVE L004-QTR-5-YR TO W-LAST-RATE-YEAR. DTSBX420 +00534 DISPLAY 'LAST RATE YEAR ' W-LAST-RATE-YEAR. DTSBX420 +00535 DTSBX420 +00536 I3000-EXIT. DTSBX420 +00537 EXIT. DTSBX420 +00538 DTSBX420 +00539 *I4000-CURRENT-BATCH. DTSBX420 +00540 * OPEN I-O CURR-BATCH-NO. DTSBX420 +00541 * IF NOT BATCH-STATUS-OK-88 DTSBX420 +00542 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 +00543 * DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBX420 +00544 * BATCH-STATUS DTSBX420 +00545 * GO TO I4000-EXIT DTSBX420 +00546 * END-IF. DTSBX420 +00547 * DTSBX420 +00548 * READ CURR-BATCH-NO DTSBX420 +00549 * IF BATCH-STATUS-OK-88 DTSBX420 +00550 * DISPLAY 'OLD BATCH ' CURRENT-BATCH-NO DTSBX420 +00551 * COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBX420 +00552 * MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBX420 +00553 * MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBX420 +00554 * DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBX420 +00555 * DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBX420 +00556 * ELSE DTSBX420 +00557 * SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX420 +00558 * DISPLAY 'CANNOT READ CURR BATCH NUMBER FILE ' DTSBX420 +00559 * BATCH-STATUS DTSBX420 +00560 * GO TO I4000-EXIT DTSBX420 +00561 * END-IF. DTSBX420 +00562 * DTSBX420 +00563 *I4000-EXIT. DTSBX420 +00564 * EXIT. DTSBX420 +00565 DTSBX420 +00566 I5000-INITIAL-CALLS. DTSBX420 +00567 DISPLAY '!!!!! BX420- INITILIZE RECORDS START BX420' CL*12 +00568 SET LX42-INITIALIZE-88 TO TRUE. DTSBX420 +00569 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSBX420 +00570 MOVE L005-DATE TO LX42-SYS-DATE. DTSBX420 +00571 MOVE L005-TIME TO LX42-SYS-TIME. DTSBX420 +00572 * MOVE ZERO TO LX42-BATCH-NO CL*53 +00573 MOVE ZERO TO LX42-PSEUDO-BATCH-NO CL*54 +00574 LX42-LAST-DETERM-EMP DTSBX420 +00575 LX42-RPT-CNT DTSBX420 +00576 LX42-RPT-REMIT-AMT DTSBX420 +00577 LX42-PAY-CNT DTSBX420 +00578 LX42-PAY-REMIT-AMT. DTSBX420 +00579 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX420 +00580 SET LX42-ERROR-NO-88 TO TRUE. DTSBX420 +00581 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +00582 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX420 +00583 DTSBX420 +00584 MOVE ZERO TO W-102-IMP-CNT CL*38 +00585 W-104-IMP-CNT CL*38 +00586 W-106-IMP-CNT CL*38 +00587 W-108-IMP-CNT CL*38 +00588 W-110-IMP-CNT CL*38 +00589 W-120-IMP-CNT CL*38 +00590 W-140-IMP-CNT CL*38 +00591 W-144-IMP-CNT CL*38 +00592 W-145-IMP-CNT. CL*38 +00593 PERFORM S421-REGISTRATION THRU S421-EXIT. DTSBX420 +00594 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +00595 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +00596 PERFORM S424-PROFILE THRU S424-EXIT. DTSBX420 +00597 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX420 +00598 DTSBX420 +00599 I5000-EXIT. DTSBX420 +00600 EXIT. DTSBX420 +00601 DTSBX420 +00602 DTSBX420 +00603 P0000-PROCESS. DTSBX420 +00604 DISPLAY '!!!! BX420- START WEB IMPORT PRELIMINARY EDIT'. CL*12 +00605 DISPLAY SPACE. DTSBX420 00606 DTSBX420 -00607 WHEN WEB-IMP-TYPE-ADDR-88 DTSBX420 -00608 PERFORM P1100E-ADDR THRU P1100E-EXIT DTSBX420 -00609 DTSBX420 -00610 WHEN WEB-IMP-TYPE-OPO-88 DTSBX420 -00611 PERFORM P1100F-OPO THRU P1100F-EXIT DTSBX420 -00612 DTSBX420 -00613 WHEN WEB-IMP-TYPE-REL-88 DTSBX420 -00614 PERFORM P1100G-REL THRU P1100G-EXIT DTSBX420 -00615 DTSBX420 -00616 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX420 -00617 * PERFORM P1100X-IND THRU P1100X-EXIT DTSBX420 -00618 * INITIALIZE X132-REC DTSBX420 -00619 * MOVE +4 TO L205-LAST-FIELD DTSBX420 -00620 *** MOVE +500 TO L205-LAST-FIELD-LEN DTSBX420 +00607 SET W-ERROR-NO-88 TO TRUE. DTSBX420 +00608 DTSBX420 +00609 SORT SORT-FILE DTSBX420 +00610 ON ASCENDING KEY SORT-KEY DTSBX420 +00611 INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT DTSBX420 +00612 OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT. DTSBX420 +00613 DTSBX420 +00614 IF SORT-RETURN NOT = +0 DTSBX420 +00615 DISPLAY 'SORT FAILED ' SORT-RETURN DTSBX420 +00616 END-IF. DTSBX420 +00617 DTSBX420 +00618 P0000-EXIT. DTSBX420 +00619 EXIT. DTSBX420 +00620 DTSBX420 00621 DTSBX420 -00622 WHEN WEB-IMP-TYPE-RPT-88 DTSBX420 -00623 PERFORM P1100H-RPT THRU P1100H-EXIT DTSBX420 -00624 DTSBX420 -00625 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX420 -00626 PERFORM P1100I-WAGE THRU P1100I-EXIT DTSBX420 -00627 DTSBX420 -00628 WHEN WEB-IMP-TYPE-PAY-88 DTSBX420 -00629 PERFORM P1100J-PAY THRU P1100J-EXIT DTSBX420 -00630 DTSBX420 -00631 * WHEN WEB-IMP-TYPE-BHDR-88 DTSBX420 -00632 * PERFORM P1100K-BATCH-HEADER THRU P1100K-EXIT DTSBX420 +00622 P1000-PRE-SORT. DTSBX420 +00623 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT. DTSBX420 +00624 PERFORM UNTIL WEB-IMP-STATUS-EOF-88 DTSBX420 +00625 PERFORM P1100-PARSE-IMPORT-REC THRU P1100-EXIT DTSBX420 +00626 PERFORM P1200-BUILD-SORT-REC THRU P1200-EXIT DTSBX420 +00627 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT DTSBX420 +00628 END-PERFORM. DTSBX420 +00629 DTSBX420 +00630 DISPLAY '!!!!! BX420- ENDOF INPUT SORT PROCEDURE ****'. CL*12 +00631 P1000-EXIT. DTSBX420 +00632 EXIT. DTSBX420 00633 DTSBX420 -00634 END-EVALUATE. DTSBX420 -00635 DTSBX420 -00636 ** IF WEB-IMP-TYPE-PAY-88 DTSBX420 -00637 * GO TO P1100-EXIT DTSBX420 -00638 ** END-IF. DTSBX420 -00639 DTSBX420 +00634 P1100-PARSE-IMPORT-REC. DTSBX420 +00635 IF WEB-IMP-TYPE-BHDR-88 DTSBX420 +00636 DISPLAY 'BX420 P1000 HDR ' WEB-IMP-REC(1:14) DTSBX420 +00637 END-IF. DTSBX420 +00638 CL*20 +00639 * DISPLAY 'P1000 ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*21 00640 DTSBX420 -00641 MOVE WEB-IMP-REC TO L205-INPUT-DATA. DTSBX420 -00642 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBX420 -00643 DTSBX420 -00644 P1100-EXIT. DTSBX420 -00645 EXIT. DTSBX420 -00646 DTSBX420 -00647 P1100A-PRF. DTSBX420 -00648 INITIALIZE X102-REC DTSBX420 -00649 MOVE +7 TO L205-LAST-FIELD DTSBX420 -00650 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX420 +00641 PERFORM DTSBX420 +00642 VARYING SUB FROM +1 BY +1 DTSBX420 +00643 UNTIL SUB > +100 DTSBX420 +00644 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX420 +00645 L205-INTEGER (SUB) DTSBX420 +00646 L205-FRACTION (SUB) DTSBX420 +00647 MOVE SPACES TO L205-TEXT (SUB) DTSBX420 +00648 L205-DATE (SUB) DTSBX420 +00649 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX420 +00650 END-PERFORM. DTSBX420 00651 DTSBX420 -00652 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00653 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -00654 DTSBX420 -00655 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00656 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -00657 DTSBX420 -00658 MOVE +9 TO L205-FIELD-LENGTH (3). DTSBX420 -00659 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 -00660 DTSBX420 -00661 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX420 -00662 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 -00663 DTSBX420 -00664 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX420 -00665 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 -00666 DTSBX420 -00667 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX420 -00668 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBX420 -00669 DTSBX420 -00670 MOVE +1 TO L205-FIELD-LENGTH (7). DTSBX420 -00671 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 -00672 DTSBX420 -00673 P1100A-EXIT. DTSBX420 -00674 EXIT. DTSBX420 -00675 DTSBX420 -00676 P1100B-DETERM. DTSBX420 -00677 INITIALIZE X104-REC DTSBX420 -00678 MOVE +18 TO L205-LAST-FIELD DTSBX420 -00679 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX420 -00680 DTSBX420 -00681 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00682 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -00683 DTSBX420 -00684 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00685 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -00686 DTSBX420 -00687 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX420 -00688 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 -00689 DTSBX420 -00690 MOVE +2 TO L205-FIELD-LENGTH (4). DTSBX420 -00691 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX420 -00692 DTSBX420 -00693 MOVE +2 TO L205-FIELD-LENGTH (5). DTSBX420 -00694 SET L205-TYPE-NUMBER-88 (5) TO TRUE. DTSBX420 -00695 DTSBX420 -00696 MOVE +6 TO L205-FIELD-LENGTH (6). DTSBX420 -00697 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 -00698 DTSBX420 -00699 MOVE +3 TO L205-FIELD-LENGTH (7). DTSBX420 -00700 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 -00701 DTSBX420 -00702 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX420 -00703 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 +00652 EVALUATE TRUE DTSBX420 +00653 WHEN WEB-IMP-TYPE-PRF-88 DTSBX420 +00654 PERFORM P1100A-PRF THRU P1100A-EXIT DTSBX420 +00655 DTSBX420 +00656 WHEN WEB-IMP-TYPE-DETERM-88 DTSBX420 +00657 PERFORM P1100B-DETERM THRU P1100B-EXIT DTSBX420 +00658 DTSBX420 +00659 WHEN WEB-IMP-TYPE-NAME-88 DTSBX420 +00660 PERFORM P1100C-NAME THRU P1100C-EXIT DTSBX420 +00661 DTSBX420 +00662 WHEN WEB-IMP-TYPE-RATE-88 DTSBX420 +00663 PERFORM P1100D-RATE THRU P1100D-EXIT DTSBX420 +00664 DTSBX420 +00665 WHEN WEB-IMP-TYPE-ADDR-88 DTSBX420 +00666 PERFORM P1100E-ADDR THRU P1100E-EXIT DTSBX420 +00667 DTSBX420 +00668 WHEN WEB-IMP-TYPE-OPO-88 DTSBX420 +00669 PERFORM P1100F-OPO THRU P1100F-EXIT DTSBX420 +00670 DTSBX420 +00671 WHEN WEB-IMP-TYPE-REL-88 DTSBX420 +00672 PERFORM P1100G-REL THRU P1100G-EXIT DTSBX420 +00673 DTSBX420 +00674 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX420 +00675 * PERFORM P1100X-IND THRU P1100X-EXIT DTSBX420 +00676 * INITIALIZE X132-REC DTSBX420 +00677 * MOVE +4 TO L205-LAST-FIELD DTSBX420 +00678 *** MOVE +500 TO L205-LAST-FIELD-LEN DTSBX420 +00679 DTSBX420 +00680 WHEN WEB-IMP-TYPE-RPT-88 DTSBX420 +00681 PERFORM P1100H-RPT THRU P1100H-EXIT DTSBX420 +00682 DTSBX420 +00683 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX420 +00684 PERFORM P1100I-WAGE THRU P1100I-EXIT DTSBX420 +00685 DTSBX420 +00686 WHEN WEB-IMP-TYPE-PAY-88 DTSBX420 +00687 PERFORM P1100J-PAY THRU P1100J-EXIT DTSBX420 +00688 DTSBX420 +00689 * WHEN WEB-IMP-TYPE-BHDR-88 DTSBX420 +00690 * PERFORM P1100K-BATCH-HEADER THRU P1100K-EXIT DTSBX420 +00691 DTSBX420 +00692 END-EVALUATE. DTSBX420 +00693 DTSBX420 +00694 MOVE WEB-IMP-REC TO L205-INPUT-DATA. DTSBX420 +00695 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBX420 +00696 DTSBX420 +00697 P1100-EXIT. DTSBX420 +00698 EXIT. DTSBX420 +00699 DTSBX420 +00700 P1100A-PRF. DTSBX420 +00701 INITIALIZE X102-REC DTSBX420 +00702 MOVE +7 TO L205-LAST-FIELD DTSBX420 +00703 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX420 00704 DTSBX420 -00705 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX420 -00706 SET L205-TYPE-DATE-88 (9) TO TRUE. DTSBX420 +00705 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +00706 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 00707 DTSBX420 -00708 MOVE +1 TO L205-FIELD-LENGTH (10). DTSBX420 -00709 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 +00708 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +00709 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 00710 DTSBX420 -00711 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX420 -00712 SET L205-TYPE-DATE-88 (11) TO TRUE. DTSBX420 +00711 MOVE +9 TO L205-FIELD-LENGTH (3). DTSBX420 +00712 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 00713 DTSBX420 -00714 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX420 -00715 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 +00714 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX420 +00715 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 00716 DTSBX420 -00717 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX420 -00718 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 +00717 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX420 +00718 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 00719 DTSBX420 -00720 MOVE +1 TO L205-FIELD-LENGTH (14). DTSBX420 -00721 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX420 +00720 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX420 +00721 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBX420 00722 DTSBX420 -00723 MOVE +1 TO L205-FIELD-LENGTH (15). DTSBX420 -00724 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX420 +00723 MOVE +1 TO L205-FIELD-LENGTH (7). DTSBX420 +00724 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 00725 DTSBX420 -00726 MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX420 -00727 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX420 +00726 P1100A-EXIT. DTSBX420 +00727 EXIT. DTSBX420 00728 DTSBX420 -00729 MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX420 -00730 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX420 -00731 DTSBX420 -00732 MOVE +1 TO L205-FIELD-LENGTH (18). DTSBX420 -00733 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX420 -00734 DTSBX420 -00735 P1100B-EXIT. DTSBX420 -00736 EXIT. DTSBX420 -00737 DTSBX420 -00738 P1100C-NAME. DTSBX420 -00739 INITIALIZE X106-REC DTSBX420 -00740 MOVE +4 TO L205-LAST-FIELD DTSBX420 -00741 MOVE +40 TO L205-LAST-FIELD-LEN DTSBX420 +00729 P1100B-DETERM. DTSBX420 +00730 INITIALIZE X104-REC DTSBX420 +00731 MOVE +18 TO L205-LAST-FIELD DTSBX420 +00732 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX420 +00733 DTSBX420 +00734 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +00735 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +00736 DTSBX420 +00737 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +00738 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +00739 DTSBX420 +00740 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX420 +00741 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 00742 DTSBX420 -00743 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00744 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +00743 MOVE +2 TO L205-FIELD-LENGTH (4). DTSBX420 +00744 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX420 00745 DTSBX420 -00746 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00747 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +00746 MOVE +2 TO L205-FIELD-LENGTH (5). DTSBX420 +00747 SET L205-TYPE-NUMBER-88 (5) TO TRUE. DTSBX420 00748 DTSBX420 -00749 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX420 -00750 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +00749 MOVE +6 TO L205-FIELD-LENGTH (6). DTSBX420 +00750 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 00751 DTSBX420 -00752 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX420 -00753 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 +00752 MOVE +3 TO L205-FIELD-LENGTH (7). DTSBX420 +00753 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 00754 DTSBX420 -00755 P1100C-EXIT. DTSBX420 -00756 EXIT. DTSBX420 +00755 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX420 +00756 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 00757 DTSBX420 -00758 P1100D-RATE. DTSBX420 -00759 ** DISPLAY 'RATE P1100D ' WEB-IMP-REC (1:23). DTSBX420 -00760 DTSBX420 -00761 INITIALIZE X108-REC. DTSBX420 -00762 MOVE +4 TO L205-LAST-FIELD. DTSBX420 -00763 MOVE +6 TO L205-LAST-FIELD-LEN. DTSBX420 +00758 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX420 +00759 SET L205-TYPE-DATE-88 (9) TO TRUE. DTSBX420 +00760 DISPLAY 'L2059: ' L205-FIELD-LENGTH (9). CL*56 +00761 DTSBX420 +00762 MOVE +1 TO L205-FIELD-LENGTH (10). DTSBX420 +00763 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 00764 DTSBX420 -00765 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00766 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -00767 DTSBX420 -00768 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00769 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -00770 DTSBX420 -00771 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX420 -00772 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 -00773 DTSBX420 -00774 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX420 -00775 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX420 -00776 DTSBX420 -00777 P1100D-EXIT. DTSBX420 -00778 EXIT. DTSBX420 -00779 DTSBX420 -00780 P1100E-ADDR. DTSBX420 -00781 INITIALIZE X110-REC. DTSBX420 -00782 MOVE +14 TO L205-LAST-FIELD. DTSBX420 -00783 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX420 -00784 DTSBX420 -00785 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00786 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -00787 DTSBX420 -00788 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00789 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -00790 DTSBX420 -00791 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX420 -00792 SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBX420 -00793 DTSBX420 -00794 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX420 -00795 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 -00796 DTSBX420 -00797 MOVE +40 TO L205-FIELD-LENGTH (5). DTSBX420 -00798 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 -00799 DTSBX420 -00800 MOVE +40 TO L205-FIELD-LENGTH (6). DTSBX420 -00801 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 -00802 DTSBX420 -00803 MOVE +25 TO L205-FIELD-LENGTH (7). DTSBX420 -00804 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 -00805 DTSBX420 -00806 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX420 -00807 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 -00808 DTSBX420 -00809 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX420 -00810 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX420 -00811 DTSBX420 -00812 MOVE +15 TO L205-FIELD-LENGTH (10). DTSBX420 -00813 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 -00814 DTSBX420 -00815 MOVE +15 TO L205-FIELD-LENGTH (11). DTSBX420 -00816 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 -00817 DTSBX420 -00818 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX420 -00819 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 -00820 DTSBX420 -00821 MOVE +40 TO L205-FIELD-LENGTH (13). DTSBX420 -00822 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 -00823 DTSBX420 -00824 MOVE +40 TO L205-FIELD-LENGTH (14). DTSBX420 -00825 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX420 -00826 DTSBX420 -00827 P1100E-EXIT. DTSBX420 -00828 EXIT. DTSBX420 -00829 DTSBX420 -00830 P1100F-OPO. DTSBX420 -00831 INITIALIZE X120-REC. DTSBX420 -00832 MOVE +18 TO L205-LAST-FIELD. DTSBX420 -00833 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX420 +00765 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX420 +00766 SET L205-TYPE-DATE-88 (11) TO TRUE. DTSBX420 +00767 DISPLAY 'L20511: ' L205-FIELD-LENGTH (11). CL*56 +00768 DTSBX420 +00769 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX420 +00770 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 +00771 DTSBX420 +00772 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX420 +00773 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 +00774 DTSBX420 +00775 MOVE +1 TO L205-FIELD-LENGTH (14). DTSBX420 +00776 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX420 +00777 DTSBX420 +00778 MOVE +1 TO L205-FIELD-LENGTH (15). DTSBX420 +00779 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX420 +00780 DTSBX420 +00781 MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX420 +00782 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX420 +00783 DTSBX420 +00784 MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX420 +00785 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX420 +00786 DTSBX420 +00787 MOVE +1 TO L205-FIELD-LENGTH (18). DTSBX420 +00788 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX420 +00789 DTSBX420 +00790 P1100B-EXIT. DTSBX420 +00791 EXIT. DTSBX420 +00792 DTSBX420 +00793 P1100C-NAME. DTSBX420 +00794 INITIALIZE X106-REC DTSBX420 +00795 MOVE +4 TO L205-LAST-FIELD DTSBX420 +00796 MOVE +40 TO L205-LAST-FIELD-LEN DTSBX420 +00797 DTSBX420 +00798 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +00799 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +00800 DTSBX420 +00801 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +00802 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +00803 DTSBX420 +00804 MOVE +1 TO L205-FIELD-LENGTH (3). DTSBX420 +00805 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +00806 DTSBX420 +00807 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX420 +00808 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 +00809 DTSBX420 +00810 P1100C-EXIT. DTSBX420 +00811 EXIT. DTSBX420 +00812 DTSBX420 +00813 P1100D-RATE. DTSBX420 +00814 ** DISPLAY 'RATE P1100D ' WEB-IMP-REC (1:23). DTSBX420 +00815 DTSBX420 +00816 INITIALIZE X108-REC. DTSBX420 +00817 MOVE +4 TO L205-LAST-FIELD. DTSBX420 +00818 MOVE +6 TO L205-LAST-FIELD-LEN. DTSBX420 +00819 DTSBX420 +00820 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +00821 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +00822 DTSBX420 +00823 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +00824 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +00825 DTSBX420 +00826 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX420 +00827 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +00828 DTSBX420 +00829 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX420 +00830 SET L205-TYPE-NUMBER-88 (4) TO TRUE. DTSBX420 +00831 DTSBX420 +00832 P1100D-EXIT. DTSBX420 +00833 EXIT. DTSBX420 00834 DTSBX420 -00835 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00836 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -00837 DTSBX420 -00838 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00839 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -00840 DTSBX420 -00841 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX420 -00842 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 -00843 DTSBX420 -00844 MOVE +20 TO L205-FIELD-LENGTH (4). DTSBX420 -00845 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 -00846 DTSBX420 -00847 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX420 -00848 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 -00849 DTSBX420 -00850 MOVE +20 TO L205-FIELD-LENGTH (6). DTSBX420 -00851 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 -00852 DTSBX420 -00853 MOVE +40 TO L205-FIELD-LENGTH (7). DTSBX420 -00854 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 -00855 DTSBX420 -00856 MOVE +9 TO L205-FIELD-LENGTH (8). DTSBX420 -00857 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 -00858 DTSBX420 -00859 MOVE +40 TO L205-FIELD-LENGTH (9). DTSBX420 -00860 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX420 -00861 DTSBX420 -00862 MOVE +40 TO L205-FIELD-LENGTH (10). DTSBX420 -00863 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 -00864 DTSBX420 -00865 MOVE +40 TO L205-FIELD-LENGTH (11). DTSBX420 -00866 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 -00867 DTSBX420 -00868 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX420 -00869 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 -00870 DTSBX420 -00871 MOVE +25 TO L205-FIELD-LENGTH (13). DTSBX420 -00872 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 -00873 DTSBX420 -00874 MOVE +2 TO L205-FIELD-LENGTH (14). DTSBX420 -00875 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX420 -00876 DTSBX420 -00877 MOVE +10 TO L205-FIELD-LENGTH (15). DTSBX420 -00878 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX420 -00879 DTSBX420 -00880 MOVE +15 TO L205-FIELD-LENGTH (16). DTSBX420 -00881 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX420 -00882 DTSBX420 -00883 MOVE +15 TO L205-FIELD-LENGTH (17). DTSBX420 -00884 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX420 -00885 DTSBX420 -00886 MOVE +40 TO L205-FIELD-LENGTH (18). DTSBX420 -00887 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX420 -00888 DTSBX420 -00889 P1100F-EXIT. DTSBX420 -00890 EXIT. DTSBX420 -00891 DTSBX420 -00892 P1100G-REL. DTSBX420 -00893 INITIALIZE X130-REC. DTSBX420 -00894 MOVE +16 TO L205-LAST-FIELD. DTSBX420 -00895 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX420 -00896 DTSBX420 -00897 P1100G-EXIT. DTSBX420 -00898 EXIT. DTSBX420 -00899 DTSBX420 -00900 P1100H-RPT. DTSBX420 -00901 DISPLAY 'P1100H-RPT ' WEB-IMP-REC(1:126). DTSBX420 -00902 INITIALIZE X140-REC. DTSBX420 -00903 MOVE +15 TO L205-LAST-FIELD. DTSBX420 -00904 MOVE +4 TO L205-LAST-FIELD-LEN. DTSBX420 -00905 DTSBX420 -00906 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00907 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -00908 DTSBX420 -00909 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00910 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -00911 DTSBX420 -00912 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX420 -00913 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 -00914 DTSBX420 -00915 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX420 -00916 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 -00917 DTSBX420 -00918 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX420 -00919 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 -00920 DTSBX420 -00921 MOVE +8 TO L205-FIELD-LENGTH (6). DTSBX420 -00922 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 -00923 DTSBX420 -00924 MOVE +14 TO L205-FIELD-LENGTH (7). DTSBX420 -00925 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBX420 -00926 DTSBX420 -00927 MOVE +14 TO L205-FIELD-LENGTH (8). DTSBX420 -00928 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX420 -00929 DTSBX420 -00930 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX420 -00931 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX420 -00932 DTSBX420 -00933 MOVE +04 TO L205-FIELD-LENGTH (10). DTSBX420 -00934 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 -00935 DTSBX420 -00936 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX420 -00937 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 -00938 DTSBX420 -00939 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX420 -00940 SET L205-TYPE-NUMBER-88 (12) TO TRUE. DTSBX420 -00941 DTSBX420 -00942 MOVE +8 TO L205-FIELD-LENGTH (13). DTSBX420 -00943 SET L205-TYPE-NUMBER-88 (13) TO TRUE. DTSBX420 -00944 DTSBX420 -00945 MOVE +8 TO L205-FIELD-LENGTH (14). DTSBX420 -00946 SET L205-TYPE-NUMBER-88 (14) TO TRUE. DTSBX420 -00947 DTSBX420 -00948 MOVE +4 TO L205-FIELD-LENGTH (15). DTSBX420 -00949 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX420 -00950 DTSBX420 -00951 ** MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX420 -00952 ** SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX420 -00953 DTSBX420 -00954 ** MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX420 -00955 ** SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSBX420 -00956 DTSBX420 -00957 ** MOVE +3 TO L205-FIELD-LENGTH (18). DTSBX420 -00958 ** SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSBX420 -00959 DTSBX420 -00960 ** MOVE +8 TO L205-FIELD-LENGTH (19). DTSBX420 -00961 ** SET L205-TYPE-TEXT-88 (21) TO TRUE. DTSBX420 -00962 DISPLAY 'NANCY '. DTSBX420 -00963 P1100H-EXIT. DTSBX420 -00964 EXIT. DTSBX420 -00965 DTSBX420 -00966 P1100I-WAGE. DTSBX420 -00967 DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). DTSBX420 -00968 INITIALIZE X144-REC. DTSBX420 -00969 MOVE +10 TO L205-LAST-FIELD. DTSBX420 -00970 MOVE +14 TO L205-LAST-FIELD-LEN. DTSBX420 -00971 DTSBX420 -00972 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -00973 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -00974 DTSBX420 -00975 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -00976 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -00977 DTSBX420 -00978 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX420 -00979 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 -00980 DTSBX420 -00981 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX420 -00982 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 -00983 DTSBX420 -00984 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX420 -00985 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 -00986 DTSBX420 -00987 MOVE +9 TO L205-FIELD-LENGTH (6). DTSBX420 -00988 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 -00989 DTSBX420 -00990 MOVE +30 TO L205-FIELD-LENGTH (7). DTSBX420 -00991 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 -00992 DTSBX420 -00993 MOVE +30 TO L205-FIELD-LENGTH (8). DTSBX420 -00994 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 -00995 DTSBX420 -00996 MOVE +1 TO L205-FIELD-LENGTH (9). DTSBX420 -00997 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX420 -00998 DTSBX420 -00999 MOVE +14 TO L205-FIELD-LENGTH (10). DTSBX420 -01000 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX420 -01001 P1100I-EXIT. DTSBX420 -01002 EXIT. DTSBX420 -01003 DTSBX420 -01004 P1100J-PAY. DTSBX420 -01005 DISPLAY 'P1100J-PAY ' WEB-IMP-REC(1:84). DTSBX420 -01006 INITIALIZE X145-REC. DTSBX420 -01007 MOVE +12 TO L205-LAST-FIELD. DTSBX420 -01008 MOVE +8 TO L205-LAST-FIELD-LEN. DTSBX420 -01009 DTSBX420 -01010 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -01011 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -01012 DTSBX420 -01013 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 -01014 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 -01015 DTSBX420 -01016 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBX420 -01017 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 -01018 DTSBX420 -01019 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX420 -01020 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 -01021 DTSBX420 -01022 MOVE +3 TO L205-FIELD-LENGTH (5). DTSBX420 -01023 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 -01024 DTSBX420 -01025 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX420 -01026 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 -01027 DTSBX420 -01028 MOVE +2 TO L205-FIELD-LENGTH (7). DTSBX420 -01029 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 -01030 DTSBX420 -01031 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX420 -01032 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 -01033 DTSBX420 -01034 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX420 -01035 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX420 -01036 DTSBX420 -01037 MOVE +10 TO L205-FIELD-LENGTH (10). DTSBX420 -01038 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 -01039 DTSBX420 -01040 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX420 -01041 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 -01042 DTSBX420 -01043 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX420 -01044 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 -01045 DTSBX420 -01046 DTSBX420 -01047 P1100J-EXIT. DTSBX420 -01048 EXIT. DTSBX420 -01049 DTSBX420 -01050 P1100K-BATCH-HEADER. DTSBX420 -01051 ** DISPLAY 'BX420 P1100K-HDR ' WEB-IMP-REC(1:84). DTSBX420 -01052 INITIALIZE X149-REC. DTSBX420 -01053 MOVE +13 TO L205-LAST-FIELD. DTSBX420 -01054 MOVE +1 TO L205-LAST-FIELD-LEN. DTSBX420 -01055 DTSBX420 -01056 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 -01057 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 -01058 DTSBX420 -01059 MOVE +5 TO L205-FIELD-LENGTH (2). DTSBX420 -01060 SET L205-TYPE-TEXT-88(2) TO TRUE. DTSBX420 -01061 DTSBX420 -01062 MOVE +3 TO L205-FIELD-LENGTH (3). DTSBX420 -01063 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +00835 P1100E-ADDR. DTSBX420 +00836 INITIALIZE X110-REC. DTSBX420 +00837 MOVE +15 TO L205-LAST-FIELD. CL*52 +00838 MOVE +1 TO L205-LAST-FIELD-LEN. CL*52 +00839 DTSBX420 +00840 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +00841 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +00842 DTSBX420 +00843 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +00844 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +00845 DTSBX420 +00846 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX420 +00847 SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBX420 +00848 DTSBX420 +00849 MOVE +40 TO L205-FIELD-LENGTH (4). DTSBX420 +00850 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 +00851 DTSBX420 +00852 MOVE +40 TO L205-FIELD-LENGTH (5). DTSBX420 +00853 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 +00854 DTSBX420 +00855 MOVE +40 TO L205-FIELD-LENGTH (6). DTSBX420 +00856 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 +00857 DTSBX420 +00858 MOVE +25 TO L205-FIELD-LENGTH (7). DTSBX420 +00859 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 +00860 DTSBX420 +00861 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX420 +00862 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 +00863 DTSBX420 +00864 MOVE +10 TO L205-FIELD-LENGTH (9). DTSBX420 +00865 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX420 +00866 DTSBX420 +00867 MOVE +15 TO L205-FIELD-LENGTH (10). DTSBX420 +00868 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 +00869 DTSBX420 +00870 MOVE +15 TO L205-FIELD-LENGTH (11). DTSBX420 +00871 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 +00872 DTSBX420 +00873 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX420 +00874 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 +00875 DTSBX420 +00876 MOVE +40 TO L205-FIELD-LENGTH (13). DTSBX420 +00877 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 +00878 DTSBX420 +00879 MOVE +40 TO L205-FIELD-LENGTH (14). DTSBX420 +00880 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX420 +00881 DTSBX420 +00882 MOVE +1 TO L205-FIELD-LENGTH (15). CL*52 +00883 SET L205-TYPE-TEXT-88 (15) TO TRUE. CL*52 +00884 CL*52 +00885 P1100E-EXIT. DTSBX420 +00886 EXIT. DTSBX420 +00887 DTSBX420 +00888 P1100F-OPO. DTSBX420 +00889 INITIALIZE X120-REC. DTSBX420 +00890 MOVE +18 TO L205-LAST-FIELD. DTSBX420 +00891 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX420 +00892 DTSBX420 +00893 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +00894 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +00895 DTSBX420 +00896 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +00897 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +00898 DTSBX420 +00899 MOVE +2 TO L205-FIELD-LENGTH (3). DTSBX420 +00900 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +00901 DTSBX420 +00902 MOVE +40 TO L205-FIELD-LENGTH (4). CL*22 +00903 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 +00904 DTSBX420 +00905 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX420 +00906 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 +00907 DTSBX420 +00908 MOVE +40 TO L205-FIELD-LENGTH (6). CL*22 +00909 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 +00910 DTSBX420 +00911 MOVE +40 TO L205-FIELD-LENGTH (7). DTSBX420 +00912 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 +00913 DTSBX420 +00914 MOVE +9 TO L205-FIELD-LENGTH (8). DTSBX420 +00915 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 +00916 DTSBX420 +00917 MOVE +40 TO L205-FIELD-LENGTH (9). DTSBX420 +00918 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX420 +00919 DTSBX420 +00920 MOVE +40 TO L205-FIELD-LENGTH (10). DTSBX420 +00921 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 +00922 DTSBX420 +00923 MOVE +40 TO L205-FIELD-LENGTH (11). DTSBX420 +00924 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 +00925 DTSBX420 +00926 MOVE +40 TO L205-FIELD-LENGTH (12). DTSBX420 +00927 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 +00928 DTSBX420 +00929 MOVE +25 TO L205-FIELD-LENGTH (13). DTSBX420 +00930 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 +00931 DTSBX420 +00932 MOVE +2 TO L205-FIELD-LENGTH (14). DTSBX420 +00933 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX420 +00934 DTSBX420 +00935 MOVE +10 TO L205-FIELD-LENGTH (15). DTSBX420 +00936 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX420 +00937 DTSBX420 +00938 MOVE +15 TO L205-FIELD-LENGTH (16). DTSBX420 +00939 SET L205-TYPE-TEXT-88 (16) TO TRUE. DTSBX420 +00940 DTSBX420 +00941 MOVE +16 TO L205-FIELD-LENGTH (17). CL*22 +00942 SET L205-TYPE-TEXT-88 (17) TO TRUE. DTSBX420 +00943 DTSBX420 +00944 MOVE +40 TO L205-FIELD-LENGTH (18). DTSBX420 +00945 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX420 +00946 DTSBX420 +00947 P1100F-EXIT. DTSBX420 +00948 EXIT. DTSBX420 +00949 DTSBX420 +00950 P1100G-REL. DTSBX420 +00951 INITIALIZE X130-REC. DTSBX420 +00952 MOVE +16 TO L205-LAST-FIELD. DTSBX420 +00953 MOVE +40 TO L205-LAST-FIELD-LEN. DTSBX420 +00954 DTSBX420 +00955 P1100G-EXIT. DTSBX420 +00956 EXIT. DTSBX420 +00957 DTSBX420 +00958 P1100H-RPT. DTSBX420 +00959 * DISPLAY 'P1100H-RPT ' WEB-IMP-REC(1:126). CL*23 +00960 INITIALIZE X140-REC. DTSBX420 +00961 MOVE +16 TO L205-LAST-FIELD. CL*24 +00962 MOVE +14 TO L205-LAST-FIELD-LEN. CL*27 +00963 DTSBX420 +00964 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +00965 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +00966 DTSBX420 +00967 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +00968 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +00969 DTSBX420 +00970 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX420 +00971 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +00972 DTSBX420 +00973 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX420 +00974 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 +00975 DTSBX420 +00976 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX420 +00977 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 +00978 DTSBX420 +00979 MOVE +8 TO L205-FIELD-LENGTH (6). DTSBX420 +00980 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 +00981 DTSBX420 +00982 MOVE +14 TO L205-FIELD-LENGTH (7). DTSBX420 +00983 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBX420 +00984 DTSBX420 +00985 MOVE +14 TO L205-FIELD-LENGTH (8). DTSBX420 +00986 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX420 +00987 DTSBX420 +00988 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX420 +00989 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX420 +00990 DTSBX420 +00991 MOVE +04 TO L205-FIELD-LENGTH (10). DTSBX420 +00992 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 +00993 DTSBX420 +00994 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX420 +00995 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 +00996 DTSBX420 +00997 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX420 +00998 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*48 +00999 DTSBX420 +01000 MOVE +8 TO L205-FIELD-LENGTH (13). DTSBX420 +01001 SET L205-TYPE-TEXT-88 (13) TO TRUE. CL*48 +01002 DTSBX420 +01003 MOVE +8 TO L205-FIELD-LENGTH (14). DTSBX420 +01004 SET L205-TYPE-TEXT-88 (14) TO TRUE. CL*48 +01005 DTSBX420 +01006 MOVE +4 TO L205-FIELD-LENGTH (15). DTSBX420 +01007 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX420 +01008 DTSBX420 +01009 MOVE +14 TO L205-FIELD-LENGTH (16). CL*27 +01010 SET L205-TYPE-NUMBER-88 (16) TO TRUE. CL*26 +01011 CL*24 +01012 ** MOVE +1 TO L205-FIELD-LENGTH (16). DTSBX420 +01013 ** SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX420 +01014 DTSBX420 +01015 ** MOVE +1 TO L205-FIELD-LENGTH (17). DTSBX420 +01016 ** SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSBX420 +01017 DTSBX420 +01018 ** MOVE +3 TO L205-FIELD-LENGTH (18). DTSBX420 +01019 ** SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSBX420 +01020 DTSBX420 +01021 ** MOVE +8 TO L205-FIELD-LENGTH (19). DTSBX420 +01022 ** SET L205-TYPE-TEXT-88 (21) TO TRUE. DTSBX420 +01023 ** DISPLAY 'NANCY '. CL*31 +01024 P1100H-EXIT. DTSBX420 +01025 EXIT. DTSBX420 +01026 DTSBX420 +01027 P1100I-WAGE. DTSBX420 +01028 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*10 +01029 INITIALIZE X144-REC. DTSBX420 +01030 MOVE +10 TO L205-LAST-FIELD. DTSBX420 +01031 MOVE +14 TO L205-LAST-FIELD-LEN. DTSBX420 +01032 DTSBX420 +01033 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +01034 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +01035 DTSBX420 +01036 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +01037 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 +01038 DTSBX420 +01039 MOVE +4 TO L205-FIELD-LENGTH (3). DTSBX420 +01040 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +01041 DTSBX420 +01042 MOVE +1 TO L205-FIELD-LENGTH (4). DTSBX420 +01043 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 +01044 DTSBX420 +01045 MOVE +8 TO L205-FIELD-LENGTH (5). DTSBX420 +01046 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 +01047 DTSBX420 +01048 MOVE +9 TO L205-FIELD-LENGTH (6). DTSBX420 +01049 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 +01050 DTSBX420 +01051 MOVE +30 TO L205-FIELD-LENGTH (7). DTSBX420 +01052 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 +01053 DTSBX420 +01054 MOVE +30 TO L205-FIELD-LENGTH (8). DTSBX420 +01055 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 +01056 DTSBX420 +01057 MOVE +1 TO L205-FIELD-LENGTH (9). DTSBX420 +01058 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX420 +01059 DTSBX420 +01060 MOVE +14 TO L205-FIELD-LENGTH (10). DTSBX420 +01061 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX420 +01062 P1100I-EXIT. DTSBX420 +01063 EXIT. DTSBX420 01064 DTSBX420 -01065 MOVE +8 TO L205-FIELD-LENGTH (4). DTSBX420 -01066 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 -01067 DTSBX420 -01068 MOVE +10 TO L205-FIELD-LENGTH (5). DTSBX420 -01069 SET L205-TYPE-DATE-88 (5) TO TRUE. DTSBX420 +01065 P1100J-PAY. DTSBX420 +01066 * DISPLAY 'P1100J-PAY ' WEB-IMP-REC(1:84). CL*10 +01067 INITIALIZE X145-REC. DTSBX420 +01068 MOVE +12 TO L205-LAST-FIELD. DTSBX420 +01069 MOVE +8 TO L205-LAST-FIELD-LEN. DTSBX420 01070 DTSBX420 -01071 MOVE +10 TO L205-FIELD-LENGTH (6). DTSBX420 -01072 SET L205-TYPE-DATE-88 (6) TO TRUE. DTSBX420 +01071 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +01072 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 01073 DTSBX420 -01074 MOVE +10 TO L205-FIELD-LENGTH (7). DTSBX420 -01075 SET L205-TYPE-DATE-88 (7) TO TRUE. DTSBX420 +01074 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX420 +01075 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX420 01076 DTSBX420 -01077 MOVE +3 TO L205-FIELD-LENGTH (8). DTSBX420 -01078 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX420 +01077 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBX420 +01078 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 01079 DTSBX420 -01080 MOVE +3 TO L205-FIELD-LENGTH (9). DTSBX420 -01081 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX420 +01080 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX420 +01081 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 01082 DTSBX420 -01083 MOVE +12 TO L205-FIELD-LENGTH (10). DTSBX420 -01084 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX420 +01083 MOVE +3 TO L205-FIELD-LENGTH (5). DTSBX420 +01084 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX420 01085 DTSBX420 -01086 MOVE +3 TO L205-FIELD-LENGTH (11). DTSBX420 -01087 SET L205-TYPE-NUMBER-88 (11) TO TRUE. DTSBX420 +01086 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX420 +01087 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX420 01088 DTSBX420 -01089 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX420 -01090 SET L205-TYPE-DATE-88 (12) TO TRUE. DTSBX420 +01089 MOVE +2 TO L205-FIELD-LENGTH (7). DTSBX420 +01090 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX420 01091 DTSBX420 -01092 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX420 -01093 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 +01092 MOVE +2 TO L205-FIELD-LENGTH (8). DTSBX420 +01093 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX420 01094 DTSBX420 -01095 P1100K-EXIT. DTSBX420 -01096 EXIT. DTSBX420 +01095 MOVE +14 TO L205-FIELD-LENGTH (9). DTSBX420 +01096 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX420 01097 DTSBX420 -01098 P1200-BUILD-SORT-REC. DTSBX420 -01099 MOVE LOW-VALUES TO SORT-REC. DTSBX420 -01100 MOVE WEB-IMP-EMP-NO TO SORT-EMP-NO. DTSBX420 -01101 DTSBX420 -01102 EVALUATE TRUE DTSBX420 -01103 WHEN WEB-IMP-TYPE-PRF-88 DTSBX420 -01104 PERFORM P1200A-PRF THRU P1200A-EXIT DTSBX420 -01105 MOVE +1 TO SORT-SEQ1 DTSBX420 -01106 MOVE X102-REC TO SORT-DATA DTSBX420 +01098 MOVE +10 TO L205-FIELD-LENGTH (10). DTSBX420 +01099 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX420 +01100 DTSBX420 +01101 MOVE +10 TO L205-FIELD-LENGTH (11). DTSBX420 +01102 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX420 +01103 DTSBX420 +01104 MOVE +8 TO L205-FIELD-LENGTH (12). DTSBX420 +01105 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX420 +01106 DTSBX420 01107 DTSBX420 -01108 WHEN WEB-IMP-TYPE-NAME-88 DTSBX420 -01109 PERFORM P1200C-NAME THRU P1200C-EXIT DTSBX420 -01110 MOVE +2 TO SORT-SEQ1 DTSBX420 -01111 MOVE X106-NAME-TYPE TO SORT-SEQ2 DTSBX420 -01112 MOVE X106-REC TO SORT-DATA DTSBX420 -01113 DTSBX420 -01114 WHEN WEB-IMP-TYPE-DETERM-88 DTSBX420 -01115 PERFORM P1200B-DETERM THRU P1200B-EXIT DTSBX420 -01116 MOVE +3 TO SORT-SEQ1 DTSBX420 -01117 MOVE X104-REC TO SORT-DATA DTSBX420 -01118 DTSBX420 -01119 WHEN WEB-IMP-TYPE-RATE-88 DTSBX420 -01120 PERFORM P1200D-RATE THRU P1200D-EXIT DTSBX420 -01121 MOVE +4 TO SORT-SEQ1 DTSBX420 -01122 MOVE X108-REC TO SORT-DATA DTSBX420 -01123 DTSBX420 -01124 WHEN WEB-IMP-TYPE-ADDR-88 DTSBX420 -01125 PERFORM P1200E-ADDR THRU P1200E-EXIT DTSBX420 -01126 MOVE +90 TO SORT-SEQ1 DTSBX420 -01127 MOVE X110-REC TO SORT-DATA DTSBX420 +01108 P1100J-EXIT. DTSBX420 +01109 EXIT. DTSBX420 +01110 DTSBX420 +01111 P1100K-BATCH-HEADER. DTSBX420 +01112 ** DISPLAY 'BX420 P1100K-HDR ' WEB-IMP-REC(1:84). DTSBX420 +01113 INITIALIZE X149-REC. DTSBX420 +01114 MOVE +13 TO L205-LAST-FIELD. DTSBX420 +01115 MOVE +1 TO L205-LAST-FIELD-LEN. DTSBX420 +01116 DTSBX420 +01117 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX420 +01118 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX420 +01119 DTSBX420 +01120 MOVE +5 TO L205-FIELD-LENGTH (2). DTSBX420 +01121 SET L205-TYPE-TEXT-88(2) TO TRUE. DTSBX420 +01122 DTSBX420 +01123 MOVE +3 TO L205-FIELD-LENGTH (3). DTSBX420 +01124 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX420 +01125 DTSBX420 +01126 MOVE +8 TO L205-FIELD-LENGTH (4). DTSBX420 +01127 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX420 01128 DTSBX420 -01129 WHEN WEB-IMP-TYPE-OPO-88 DTSBX420 -01130 PERFORM P1200F-OPO THRU P1200F-EXIT DTSBX420 -01131 MOVE +91 TO SORT-SEQ1 DTSBX420 -01132 MOVE X120-REC TO SORT-DATA DTSBX420 -01133 DTSBX420 -01134 WHEN WEB-IMP-TYPE-REL-88 DTSBX420 -01135 PERFORM P1200G-REL THRU P1200G-EXIT DTSBX420 -01136 MOVE +5 TO SORT-SEQ1 DTSBX420 -01137 MOVE X130-REC TO SORT-DATA DTSBX420 -01138 DTSBX420 -01139 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX420 -01140 * MOVE +6 TO SORT-SEQ1 DTSBX420 -01141 *** MOVE X132-REC TO SORT-DATA DTSBX420 -01142 DTSBX420 -01143 WHEN WEB-IMP-TYPE-RPT-88 DTSBX420 -01144 PERFORM P1200H-RPT THRU P1200H-EXIT DTSBX420 -01145 * IF X140-IN-HOUSE-88 DTSBX420 -01146 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX420 -01147 ** MOVE X140-PSEUDO-BATCH-NO TO SORT-BATCH DTSBX420 -01148 ** MOVE X140-PSEUDO-ITEM-NO TO SORT-ITEM DTSBX420 -01149 * MOVE LOW-VALUES TO SORT-FILLER DTSBX420 -01150 * ELSE DTSBX420 -01151 MOVE +20 TO SORT-SEQ1 DTSBX420 -01152 STRING DTSBX420 -01153 X140-QUARTER '0' DELIMITED BY SIZE DTSBX420 -01154 INTO SORT-SEQ2 DTSBX420 -01155 END-STRING DTSBX420 -01156 * END-IF DTSBX420 -01157 MOVE X140-REC TO SORT-DATA DTSBX420 +01129 MOVE +10 TO L205-FIELD-LENGTH (5). DTSBX420 +01130 SET L205-TYPE-DATE-88 (5) TO TRUE. DTSBX420 +01131 DTSBX420 +01132 MOVE +10 TO L205-FIELD-LENGTH (6). DTSBX420 +01133 SET L205-TYPE-DATE-88 (6) TO TRUE. DTSBX420 +01134 DTSBX420 +01135 MOVE +10 TO L205-FIELD-LENGTH (7). DTSBX420 +01136 SET L205-TYPE-DATE-88 (7) TO TRUE. DTSBX420 +01137 DTSBX420 +01138 MOVE +3 TO L205-FIELD-LENGTH (8). DTSBX420 +01139 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX420 +01140 DTSBX420 +01141 MOVE +3 TO L205-FIELD-LENGTH (9). DTSBX420 +01142 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX420 +01143 DTSBX420 +01144 MOVE +12 TO L205-FIELD-LENGTH (10). DTSBX420 +01145 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX420 +01146 DTSBX420 +01147 MOVE +3 TO L205-FIELD-LENGTH (11). DTSBX420 +01148 SET L205-TYPE-NUMBER-88 (11) TO TRUE. DTSBX420 +01149 DTSBX420 +01150 MOVE +10 TO L205-FIELD-LENGTH (12). DTSBX420 +01151 SET L205-TYPE-DATE-88 (12) TO TRUE. DTSBX420 +01152 DTSBX420 +01153 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBX420 +01154 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX420 +01155 DTSBX420 +01156 P1100K-EXIT. DTSBX420 +01157 EXIT. DTSBX420 01158 DTSBX420 -01159 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX420 -01160 PERFORM P1200I-WAGE THRU P1200I-EXIT DTSBX420 -01161 MOVE +20 TO SORT-SEQ1 DTSBX420 -01162 STRING DTSBX420 -01163 X140-QUARTER '1' DTSBX420 -01164 DELIMITED BY SIZE DTSBX420 -01165 INTO DTSBX420 -01166 SORT-SEQ2 DTSBX420 -01167 END-STRING DTSBX420 -01168 MOVE X144-REC TO SORT-DATA DTSBX420 -01169 DTSBX420 -01170 WHEN WEB-IMP-TYPE-PAY-88 DTSBX420 -01171 PERFORM P1200J-PAY THRU P1200J-EXIT DTSBX420 -01172 * IF X145-IN-HOUSE-88 DTSBX420 -01173 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX420 -01174 * MOVE X145-PSEUDO-BATCH TO SORT-BATCH DTSBX420 -01175 * MOVE X145-PSEUDO-ITEM TO SORT-ITEM DTSBX420 -01176 * MOVE LOW-VALUES TO SORT-FILLER DTSBX420 -01177 * ELSE DTSBX420 -01178 MOVE +30 TO SORT-SEQ1 DTSBX420 -01179 * END-IF DTSBX420 -01180 MOVE X145-REC TO SORT-DATA DTSBX420 -01181 ** DISPLAY 'P2 PAY ' X145-REC DTSBX420 -01182 DTSBX420 -01183 DTSBX420 -01184 ** WHEN WEB-IMP-TYPE-BHDR-88 DTSBX420 -01185 * PERFORM P1200K-BATCH-HEADER THRU P1200K-EXIT DTSBX420 -01186 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX420 -01187 * MOVE X149-PSEUDO-BATCH TO SORT-BATCH DTSBX420 -01188 * MOVE X149-PSEUDO-ITEM TO SORT-ITEM DTSBX420 -01189 * MOVE LOW-VALUES TO SORT-FILLER DTSBX420 -01190 * MOVE X149-REC TO SORT-DATA DTSBX420 -01191 DTSBX420 -01192 END-EVALUATE. DTSBX420 -01193 DTSBX420 -01194 RELEASE SORT-REC. DTSBX420 -01195 DTSBX420 -01196 P1200-EXIT. DTSBX420 -01197 EXIT. DTSBX420 +01159 P1200-BUILD-SORT-REC. DTSBX420 +01160 MOVE LOW-VALUES TO SORT-REC. DTSBX420 +01161 MOVE WEB-IMP-EMP-NO TO SORT-EMP-NO. DTSBX420 +01162 DTSBX420 +01163 EVALUATE TRUE DTSBX420 +01164 WHEN WEB-IMP-TYPE-PRF-88 DTSBX420 +01165 PERFORM P1200A-PRF THRU P1200A-EXIT DTSBX420 +01166 MOVE +1 TO SORT-SEQ1 DTSBX420 +01167 MOVE X102-REC TO SORT-DATA DTSBX420 +01168 CL*21 +01169 WHEN WEB-IMP-TYPE-DETERM-88 CL*21 +01170 PERFORM P1200B-DETERM THRU P1200B-EXIT CL*21 +01171 MOVE +2 TO SORT-SEQ1 CL*21 +01172 MOVE X104-REC TO SORT-DATA CL*21 +01173 CL*21 +01174 DTSBX420 +01175 WHEN WEB-IMP-TYPE-NAME-88 DTSBX420 +01176 * PERFORM P1200C-NAME THRU P1200C-EXIT CL*42 +01177 MOVE WEB-IMP-REC TO X106-REC CL*42 +01178 MOVE +3 TO SORT-SEQ1 CL*21 +01179 MOVE X106-NAME-TYPE TO SORT-SEQ2 DTSBX420 +01180 MOVE X106-REC TO SORT-DATA DTSBX420 +01181 CL*23 +01182 WHEN WEB-IMP-TYPE-RATE-88 DTSBX420 +01183 PERFORM P1200D-RATE THRU P1200D-EXIT DTSBX420 +01184 MOVE +4 TO SORT-SEQ1 DTSBX420 +01185 MOVE X108-REC TO SORT-DATA DTSBX420 +01186 DTSBX420 +01187 WHEN WEB-IMP-TYPE-ADDR-88 DTSBX420 +01188 * PERFORM P1200E-ADDR THRU P1200E-EXIT CL*27 +01189 MOVE WEB-IMP-REC TO X110-REC CL*28 +01190 MOVE +90 TO SORT-SEQ1 DTSBX420 +01191 MOVE X110-REC TO SORT-DATA DTSBX420 +01192 DTSBX420 +01193 WHEN WEB-IMP-TYPE-OPO-88 DTSBX420 +01194 PERFORM P1200F-OPO THRU P1200F-EXIT CL*40 +01195 * MOVE WEB-IMP-REC TO X120-REC CL*40 +01196 MOVE +91 TO SORT-SEQ1 DTSBX420 +01197 MOVE X120-REC TO SORT-DATA DTSBX420 01198 DTSBX420 -01199 P1200A-PRF. DTSBX420 -01200 MOVE L205-TEXT (1) (1:3) TO X102-REC-TYPE. DTSBX420 -01201 ** DISPLAY X102-REC-TYPE DTSBX420 -01202 MOVE L205-TEXT (2) (1:6) TO X102-EMP-NO. DTSBX420 -01203 ** DISPLAY X102-EMP-NO DTSBX420 -01204 DTSBX420 -01205 MOVE L205-TEXT (3) (1:9) TO X102-EMP-FEIN. DTSBX420 -01206 ** DISPLAY X102-EMP-FEIN DTSBX420 +01199 WHEN WEB-IMP-TYPE-REL-88 DTSBX420 +01200 PERFORM P1200G-REL THRU P1200G-EXIT DTSBX420 +01201 MOVE +5 TO SORT-SEQ1 DTSBX420 +01202 MOVE X130-REC TO SORT-DATA DTSBX420 +01203 DTSBX420 +01204 *** WHEN WEB-IMP-TYPE-IND-88 DTSBX420 +01205 * MOVE +6 TO SORT-SEQ1 DTSBX420 +01206 *** MOVE X132-REC TO SORT-DATA DTSBX420 01207 DTSBX420 -01208 MOVE L205-TEXT (4) (1:1) TO X102-EMP-CLASS. DTSBX420 -01209 ** DISPLAY X102-EMP-CLASS DTSBX420 -01210 DTSBX420 -01211 MOVE L205-TEXT (5) (1:1) TO X102-EMP-STATUS. DTSBX420 -01212 ** DISPLAY X102-EMP-STATUS DTSBX420 -01213 DTSBX420 -01214 MOVE L205-INTEGER (6) TO W-INT-9. DTSBX420 -01215 MOVE W-INT-X (12:2) TO X102-SOURCE-CD. DTSBX420 -01216 ** DISPLAY X102-SOURCE-CD DTSBX420 -01217 DTSBX420 -01218 ** DISPLAY X102-REC-TYPE DTSBX420 -01219 MOVE L205-TEXT (7) (1:1) TO X102-ACTION-CD. DTSBX420 -01220 ** DISPLAY X102-ACTION-CD. DTSBX420 -01221 DTSBX420 -01222 P1200A-EXIT. DTSBX420 -01223 EXIT. DTSBX420 +01208 WHEN WEB-IMP-TYPE-RPT-88 DTSBX420 +01209 * IF X140-IN-HOUSE-88 DTSBX420 +01210 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX420 +01211 ** MOVE X140-PSEUDO-BATCH-NO TO SORT-BATCH DTSBX420 +01212 ** MOVE X140-PSEUDO-ITEM-NO TO SORT-ITEM DTSBX420 +01213 * MOVE LOW-VALUES TO SORT-FILLER DTSBX420 +01214 * ELSE DTSBX420 +01215 PERFORM P1200H-RPT THRU P1200H-EXIT CL*33 +01216 MOVE +20 TO SORT-SEQ1 CL*33 +01217 * MOVE X140-QUARTER TO SORT-SEQ2 CL*34 +01218 STRING CL*34 +01219 X140-QUARTER '0' DELIMITED BY SIZE CL*34 +01220 INTO SORT-SEQ2 CL*34 +01221 END-STRING CL*34 +01222 * END-IF CL*35 +01223 MOVE X140-REC TO SORT-DATA CL*36 01224 DTSBX420 -01225 P1200B-DETERM. DTSBX420 -01226 MOVE L205-TEXT (1) (1:03) TO X104-REC-TYPE. DTSBX420 -01227 DTSBX420 -01228 MOVE L205-TEXT (2) (1:06) TO X104-EMP-NO. DTSBX420 -01229 DTSBX420 -01230 MOVE L205-TEXT (3) (1:01) TO X104-STAFF-REVIEW-IND. DTSBX420 -01231 DTSBX420 -01232 MOVE L205-INTEGER (4) TO W-INT-9. DTSBX420 -01233 MOVE W-INT-X (12:2) TO X104-LIAB-CD. DTSBX420 -01234 DTSBX420 -01235 MOVE L205-INTEGER (5) TO W-INT-9. DTSBX420 -01236 MOVE W-INT-X (12:2) TO X104-ELIG-CD. DTSBX420 -01237 DTSBX420 -01238 MOVE L205-TEXT (6) (1:06) TO X104-NAICS-CD. DTSBX420 -01239 DTSBX420 -01240 MOVE L205-TEXT (7) (1:03) TO X104-ORG-TYPE. DTSBX420 -01241 DTSBX420 -01242 MOVE L205-TEXT (8) (1:02) TO X104-INCORP-STATE. DTSBX420 -01243 DTSBX420 -01244 MOVE L205-DATE (9) TO X104-INCORP-DATE. DTSBX420 -01245 DTSBX420 -01246 MOVE L205-TEXT (10) (1:01) TO X104-HOUSEHOLD-FILING. DTSBX420 -01247 DTSBX420 -01248 MOVE L205-DATE (11) TO X104-FIRST-WAGE-DT. DTSBX420 +01225 WHEN WEB-IMP-TYPE-WAGE-88 DTSBX420 +01226 PERFORM P1200I-WAGE THRU P1200I-EXIT DTSBX420 +01227 MOVE +20 TO SORT-SEQ1 CL*36 +01228 * MOVE X144-QUARTER TO SORT-SEQ2 CL*34 +01229 STRING CL*34 +01230 X140-QUARTER '1' CL*34 +01231 DELIMITED BY SIZE CL*34 +01232 INTO CL*34 +01233 SORT-SEQ2 CL*34 +01234 END-STRING CL*35 +01235 MOVE X144-REC TO SORT-DATA CL*36 +01236 DTSBX420 +01237 ************************************************************ CL*23 +01238 * CHANGED SORT SEQ FOR PAYMENT RECORDS FROM 30 TO 19 DUE TO ESSP CL*23 +01239 * REPORTS X140 CANNOT BE PROCESSED WITHOUT A PAYMENT TRANSACTION CL*23 +01240 * UNLESS IT IS A 0 WAGE REPORT = REMIT AMOUNT = 0 CL*23 +01241 ************************************************************ CL*23 +01242 CL*23 +01243 WHEN WEB-IMP-TYPE-PAY-88 DTSBX420 +01244 PERFORM P1200J-PAY THRU P1200J-EXIT DTSBX420 +01245 MOVE +19 TO SORT-SEQ1 CL*23 +01246 * MOVE X145-QTR TO SORT-SEQ2 CL*34 +01247 MOVE X145-REC TO SORT-DATA DTSBX420 +01248 ** DISPLAY 'P2 PAY ' X145-REC DTSBX420 01249 DTSBX420 -01250 MOVE L205-TEXT (12) TO W-500-DATE. DTSBX420 -01251 DTSBX420 -01252 MOVE SPACES TO X104-FIRST-500-QTR DTSBX420 -01253 IF W-500-DATE > SPACES DTSBX420 -01254 MOVE W-500-DATE-YY TO W-500-FQTR-YY. DTSBX420 -01255 IF W-500-DATE-MM < '04' DTSBX420 -01256 MOVE '1' TO W-500-FQTR-NO. DTSBX420 -01257 IF W-500-DATE-MM > '03' AND < '07' DTSBX420 -01258 MOVE '2' TO W-500-FQTR-NO. DTSBX420 -01259 IF W-500-DATE-MM > '06' AND < '10' DTSBX420 -01260 MOVE '3' TO W-500-FQTR-NO. DTSBX420 -01261 IF W-500-DATE-MM > '09' AND < '13' DTSBX420 -01262 MOVE '4' TO W-500-FQTR-NO. DTSBX420 -01263 MOVE W-500-FQTR TO X104-FIRST-500-QTR DTSBX420 -01264 DTSBX420 -01265 MOVE L205-TEXT (13) (1:01) TO X104-ACQUIRE-IND. DTSBX420 -01266 DTSBX420 -01267 MOVE L205-TEXT (14) (1:01) TO X104-MERGER-SPLIT-IND. DTSBX420 -01268 DTSBX420 -01269 MOVE L205-TEXT (15) (1:01) TO X104-REORG-IND. DTSBX420 -01270 DTSBX420 -01271 MOVE L205-TEXT (16) (1:01) TO X104-COMMON-OWN-IND. DTSBX420 -01272 DTSBX420 -01273 MOVE L205-TEXT (17) (1:01) TO X104-SALE-TRANSFER-IND. DTSBX420 +01250 DTSBX420 +01251 ** WHEN WEB-IMP-TYPE-BHDR-88 DTSBX420 +01252 * PERFORM P1200K-BATCH-HEADER THRU P1200K-EXIT DTSBX420 +01253 * MOVE 999999 TO SORT-IN-HOUSE-SEQ DTSBX420 +01254 * MOVE X149-PSEUDO-BATCH TO SORT-BATCH DTSBX420 +01255 * MOVE X149-PSEUDO-ITEM TO SORT-ITEM DTSBX420 +01256 * MOVE LOW-VALUES TO SORT-FILLER DTSBX420 +01257 * MOVE X149-REC TO SORT-DATA DTSBX420 +01258 DTSBX420 +01259 END-EVALUATE. DTSBX420 +01260 DTSBX420 +01261 RELEASE SORT-REC. DTSBX420 +01262 DTSBX420 +01263 P1200-EXIT. DTSBX420 +01264 EXIT. DTSBX420 +01265 DTSBX420 +01266 P1200A-PRF. DTSBX420 +01267 MOVE L205-TEXT (1) (1:3) TO X102-REC-TYPE. DTSBX420 +01268 ** DISPLAY X102-REC-TYPE DTSBX420 +01269 MOVE L205-TEXT (2) (1:6) TO X102-EMP-NO. DTSBX420 +01270 ** DISPLAY X102-EMP-NO DTSBX420 +01271 DTSBX420 +01272 MOVE L205-TEXT (3) (1:9) TO X102-EMP-FEIN. DTSBX420 +01273 ** DISPLAY X102-EMP-FEIN DTSBX420 01274 DTSBX420 -01275 MOVE L205-TEXT (18) (1:01) TO X104-NOT-LIAB-REASON. DTSBX420 -01276 ** DISPLAY X104-REC. DTSBX420 -01277 P1200B-EXIT. DTSBX420 -01278 EXIT. DTSBX420 -01279 DTSBX420 -01280 P1200C-NAME. DTSBX420 -01281 MOVE L205-TEXT (1) (1:03) TO X106-REC-TYPE. DTSBX420 -01282 DTSBX420 -01283 MOVE L205-TEXT (2) (1:06) TO X106-EMP-NO. DTSBX420 +01275 MOVE L205-TEXT (4) (1:1) TO X102-EMP-CLASS. DTSBX420 +01276 ** DISPLAY X102-EMP-CLASS DTSBX420 +01277 DTSBX420 +01278 MOVE L205-TEXT (5) (1:1) TO X102-EMP-STATUS. DTSBX420 +01279 ** DISPLAY X102-EMP-STATUS DTSBX420 +01280 DTSBX420 +01281 MOVE L205-INTEGER (6) TO W-INT-9. DTSBX420 +01282 MOVE W-INT-X (12:2) TO X102-SOURCE-CD. DTSBX420 +01283 ** DISPLAY X102-SOURCE-CD DTSBX420 01284 DTSBX420 -01285 MOVE L205-TEXT (3) (1:01) TO X106-NAME-TYPE DTSBX420 -01286 DTSBX420 -01287 MOVE L205-TEXT (4) (1:40) TO X106-EMP-NAME. DTSBX420 +01285 ** DISPLAY X102-REC-TYPE DTSBX420 +01286 MOVE L205-TEXT (7) (1:1) TO X102-ACTION-CD. DTSBX420 +01287 ** DISPLAY X102-ACTION-CD. DTSBX420 01288 DTSBX420 -01289 P1200C-EXIT. DTSBX420 +01289 P1200A-EXIT. DTSBX420 01290 EXIT. DTSBX420 01291 DTSBX420 -01292 P1200D-RATE. DTSBX420 -01293 MOVE L205-TEXT (1) (1:03) TO X108-REC-TYPE. DTSBX420 +01292 P1200B-DETERM. DTSBX420 +01293 MOVE L205-TEXT (1) (1:03) TO X104-REC-TYPE. DTSBX420 01294 DTSBX420 -01295 MOVE L205-TEXT (2) (1:06) TO X108-EMP-NO. DTSBX420 +01295 MOVE L205-TEXT (2) (1:06) TO X104-EMP-NO. DTSBX420 01296 DTSBX420 -01297 MOVE L205-TEXT (3) (1:04) TO X108-RATE-YEAR(1:04). DTSBX420 -01298 MOVE '/1' TO X108-RATE-YEAR(5:02). DTSBX420 -01299 DTSBX420 -01300 MOVE L205-INTEGER (4) TO W-INTEGER. DTSBX420 -01301 MOVE L205-FRACTION (4) TO W-FRACTION. DTSBX420 -01302 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 -01303 MOVE W-NUMBER TO X108-RATE. DTSBX420 -01304 ** DISPLAY 'BX420 RATE ' X108-RATE ' ' W-NUMBER. DTSBX420 -01305 ** DISPLAY ' RATE YR ' X108-RATE-YEAR. DTSBX420 +01297 MOVE L205-TEXT (3) (1:01) TO X104-STAFF-REVIEW-IND. DTSBX420 +01298 DTSBX420 +01299 MOVE L205-INTEGER (4) TO W-INT-9. DTSBX420 +01300 MOVE W-INT-X (12:2) TO X104-LIAB-CD. DTSBX420 +01301 DTSBX420 +01302 MOVE L205-INTEGER (5) TO W-INT-9. DTSBX420 +01303 MOVE W-INT-X (12:2) TO X104-ELIG-CD. DTSBX420 +01304 DTSBX420 +01305 MOVE L205-TEXT (6) (1:06) TO X104-NAICS-CD. DTSBX420 01306 DTSBX420 -01307 P1200D-EXIT. DTSBX420 -01308 EXIT. DTSBX420 -01309 DTSBX420 -01310 P1200E-ADDR. DTSBX420 -01311 MOVE L205-TEXT (1) (1:03) TO X110-REC-TYPE. DTSBX420 -01312 DTSBX420 -01313 MOVE L205-TEXT (2) (1:06) TO X110-EMP-NO. DTSBX420 +01307 MOVE L205-TEXT (7) (1:03) TO X104-ORG-TYPE. DTSBX420 +01308 DTSBX420 +01309 MOVE L205-TEXT (8) (1:02) TO X104-INCORP-STATE. DTSBX420 +01310 DTSBX420 +01311 MOVE L205-DATE (9) TO X104-INCORP-DATE. DTSBX420 +01312 DISPLAY '205D: ' L205-DATE (9) CL*55 +01313 DISPLAY '104D: ' X104-INCORP-DATE. CL*55 01314 DTSBX420 -01315 MOVE L205-INTEGER (3) TO W-INT-9. DTSBX420 -01316 MOVE W-INT-X (12:2) TO X110-ADDR-TYPE. DTSBX420 -01317 DTSBX420 -01318 MOVE L205-TEXT (4) (1:40) TO X110-ATTENTION. DTSBX420 -01319 DTSBX420 -01320 MOVE L205-TEXT (5) (1:40) TO X110-STREET-1. DTSBX420 -01321 DTSBX420 -01322 MOVE L205-TEXT (6) (1:40) TO X110-STREET-2. DTSBX420 -01323 DTSBX420 -01324 MOVE L205-TEXT (7) (1:25) TO X110-CITY. DTSBX420 -01325 DTSBX420 -01326 MOVE L205-TEXT (8) (1:02) TO X110-STATE. DTSBX420 -01327 DTSBX420 -01328 MOVE L205-TEXT (9) (1:10) TO X110-ZIP. DTSBX420 -01329 DTSBX420 -01330 MOVE L205-TEXT (10) (1:15) TO X110-PHONE. DTSBX420 -01331 DTSBX420 -01332 MOVE L205-TEXT (11) (1:15) TO X110-FAX. DTSBX420 +01315 MOVE L205-TEXT (10) (1:01) TO X104-HOUSEHOLD-FILING. DTSBX420 +01316 DTSBX420 +01317 MOVE L205-DATE (11) TO X104-FIRST-WAGE-DT. DTSBX420 +01318 DTSBX420 +01319 MOVE L205-TEXT (12) TO W-500-DATE. DTSBX420 +01320 DTSBX420 +01321 MOVE SPACES TO X104-FIRST-500-QTR DTSBX420 +01322 IF W-500-DATE > SPACES DTSBX420 +01323 MOVE W-500-DATE-YY TO W-500-FQTR-YY. DTSBX420 +01324 IF W-500-DATE-MM < '04' DTSBX420 +01325 MOVE '1' TO W-500-FQTR-NO. DTSBX420 +01326 IF W-500-DATE-MM > '03' AND < '07' DTSBX420 +01327 MOVE '2' TO W-500-FQTR-NO. DTSBX420 +01328 IF W-500-DATE-MM > '06' AND < '10' DTSBX420 +01329 MOVE '3' TO W-500-FQTR-NO. DTSBX420 +01330 IF W-500-DATE-MM > '09' AND < '13' DTSBX420 +01331 MOVE '4' TO W-500-FQTR-NO. DTSBX420 +01332 MOVE W-500-FQTR TO X104-FIRST-500-QTR DTSBX420 01333 DTSBX420 -01334 MOVE L205-TEXT(12) (1:40) TO X110-EMAIL. DTSBX420 +01334 MOVE L205-TEXT (13) (1:01) TO X104-ACQUIRE-IND. DTSBX420 01335 DTSBX420 -01336 MOVE L205-TEXT (13) (1:40) TO X110-WEB-SITE. DTSBX420 +01336 MOVE L205-TEXT (14) (1:01) TO X104-MERGER-SPLIT-IND. DTSBX420 01337 DTSBX420 -01338 MOVE L205-TEXT (14) (1:40) TO X110-EMP-NAME. DTSBX420 +01338 MOVE L205-TEXT (15) (1:01) TO X104-REORG-IND. DTSBX420 01339 DTSBX420 -01340 P1200E-EXIT. DTSBX420 -01341 EXIT. DTSBX420 -01342 DTSBX420 -01343 P1200F-OPO. DTSBX420 -01344 MOVE L205-TEXT (1) (1:03) TO X120-REC-TYPE. DTSBX420 -01345 DTSBX420 -01346 MOVE L205-TEXT (2) (1:06) TO X120-EMP-NO. DTSBX420 -01347 DTSBX420 -01348 MOVE L205-TEXT (3) (1:02) TO X120-TYPE-IND. DTSBX420 -01349 DTSBX420 -01350 MOVE L205-TEXT (4) (1:20) TO X120-OPO-FIRST-NAME. DTSBX420 +01340 MOVE L205-TEXT (16) (1:01) TO X104-COMMON-OWN-IND. DTSBX420 +01341 DTSBX420 +01342 MOVE L205-TEXT (17) (1:01) TO X104-SALE-TRANSFER-IND. DTSBX420 +01343 DTSBX420 +01344 MOVE L205-TEXT (18) (1:01) TO X104-NOT-LIAB-REASON. DTSBX420 +01345 ** DISPLAY X104-REC. DTSBX420 +01346 P1200B-EXIT. DTSBX420 +01347 EXIT. DTSBX420 +01348 DTSBX420 +01349 P1200C-NAME. DTSBX420 +01350 MOVE L205-TEXT (1) (1:03) TO X106-REC-TYPE. DTSBX420 01351 DTSBX420 -01352 MOVE L205-TEXT (5) (1:01) TO X120-OPO-MID-INIT. DTSBX420 +01352 MOVE L205-TEXT (2) (1:06) TO X106-EMP-NO. DTSBX420 01353 DTSBX420 -01354 MOVE L205-TEXT (6) (1:20) TO X120-OPO-LAST-NAME. DTSBX420 +01354 MOVE L205-TEXT (3) (1:01) TO X106-NAME-TYPE DTSBX420 01355 DTSBX420 -01356 MOVE L205-TEXT (7) (1:40) TO X120-OPO-MEMBER-NAME. DTSBX420 +01356 MOVE L205-TEXT (4) (1:40) TO X106-EMP-NAME. DTSBX420 01357 DTSBX420 -01358 MOVE L205-TEXT (8) (1:09) TO X120-OPO-SSN. DTSBX420 -01359 DTSBX420 -01360 MOVE L205-TEXT (9) (1:40) TO X120-OPO-TITLE. DTSBX420 -01361 DTSBX420 -01362 MOVE L205-TEXT (10) (1:40) TO X120-OPO-ATTENTION. DTSBX420 +01358 P1200C-EXIT. DTSBX420 +01359 EXIT. DTSBX420 +01360 DTSBX420 +01361 P1200D-RATE. DTSBX420 +01362 MOVE L205-TEXT (1) (1:03) TO X108-REC-TYPE. DTSBX420 01363 DTSBX420 -01364 MOVE L205-TEXT (11) (1:40) TO X120-OPO-STREET-1. DTSBX420 +01364 MOVE L205-TEXT (2) (1:06) TO X108-EMP-NO. DTSBX420 01365 DTSBX420 -01366 MOVE L205-TEXT (12) (1:40) TO X120-OPO-STREET-2. DTSBX420 -01367 DTSBX420 -01368 MOVE L205-TEXT (13) (1:25) TO X120-OPO-CITY. DTSBX420 -01369 DTSBX420 -01370 MOVE L205-TEXT (14) (1:02) TO X120-OPO-STATE. DTSBX420 -01371 DTSBX420 -01372 MOVE L205-TEXT (15) (1:10) TO X120-OPO-ZIP. DTSBX420 -01373 DTSBX420 -01374 MOVE L205-TEXT (16) (1:15) TO X120-OPO-PHONE. DTSBX420 +01366 MOVE L205-TEXT (3) (1:04) TO X108-RATE-YEAR(1:04). DTSBX420 +01367 MOVE '/1' TO X108-RATE-YEAR(5:02). DTSBX420 +01368 DTSBX420 +01369 MOVE L205-INTEGER (4) TO W-INTEGER. DTSBX420 +01370 MOVE L205-FRACTION (4) TO W-FRACTION. DTSBX420 +01371 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 +01372 MOVE W-NUMBER TO X108-RATE. DTSBX420 +01373 ** DISPLAY 'BX420 RATE ' X108-RATE ' ' W-NUMBER. DTSBX420 +01374 ** DISPLAY ' RATE YR ' X108-RATE-YEAR. DTSBX420 01375 DTSBX420 -01376 MOVE L205-TEXT (17) (1:15) TO X120-OPO-FAX. DTSBX420 -01377 DTSBX420 -01378 MOVE L205-TEXT (18) (1:40) TO X120-OPO-EMAIL. DTSBX420 -01379 DTSBX420 -01380 P1200F-EXIT. DTSBX420 -01381 EXIT. DTSBX420 -01382 DTSBX420 -01383 P1200G-REL. DTSBX420 -01384 P1200G-EXIT. DTSBX420 -01385 EXIT. DTSBX420 +01376 P1200D-EXIT. DTSBX420 +01377 EXIT. DTSBX420 +01378 DTSBX420 +01379 P1200E-ADDR. DTSBX420 +01380 MOVE L205-TEXT (1) (1:03) TO X110-REC-TYPE. DTSBX420 +01381 DTSBX420 +01382 MOVE L205-TEXT (2) (1:06) TO X110-EMP-NO. DTSBX420 +01383 DTSBX420 +01384 MOVE L205-INTEGER (3) TO W-INT-9. DTSBX420 +01385 MOVE W-INT-X (12:2) TO X110-ADDR-TYPE. DTSBX420 01386 DTSBX420 -01387 P1200H-RPT. DTSBX420 -01388 DISPLAY '01200H-RPT ' DTSBX420 -01389 DTSBX420 -01390 MOVE L205-TEXT (1) (1:03) TO X140-REC-TYPE. DTSBX420 -01391 DISPLAY 'X140-REC-TYPE' X140-REC-TYPE DTSBX420 +01387 MOVE L205-TEXT (4) (1:40) TO X110-ATTENTION. DTSBX420 +01388 DTSBX420 +01389 MOVE L205-TEXT (5) (1:40) TO X110-STREET-1. DTSBX420 +01390 DTSBX420 +01391 MOVE L205-TEXT (6) (1:40) TO X110-STREET-2. DTSBX420 01392 DTSBX420 -01393 MOVE L205-TEXT (2) (1:06) TO X140-EMP-NO. DTSBX420 -01394 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX420 -01395 DTSBX420 -01396 MOVE L205-TEXT (3) (1:04) TO X140-QUARTER(1:04). DTSBX420 -01397 MOVE '/' TO X140-QUARTER(5:01). DTSBX420 -01398 MOVE L205-TEXT (4) (1:01) TO X140-QUARTER(6:01). DTSBX420 -01399 DTSBX420 -01400 MOVE '00' TO X140-SOURCE. DTSBX420 -01401 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX420 +01393 MOVE L205-TEXT (7) (1:25) TO X110-CITY. DTSBX420 +01394 DTSBX420 +01395 MOVE L205-TEXT (8) (1:02) TO X110-STATE. DTSBX420 +01396 DTSBX420 +01397 MOVE L205-TEXT (9) (1:10) TO X110-ZIP. DTSBX420 +01398 DTSBX420 +01399 MOVE L205-TEXT (10) (1:15) TO X110-PHONE. DTSBX420 +01400 DTSBX420 +01401 MOVE L205-TEXT (11) (1:15) TO X110-FAX. DTSBX420 01402 DTSBX420 -01403 MOVE L205-TEXT (5) (1:02) TO X140-REPORT-TYPE. DTSBX420 -01404 IF X140-REPORT-TYPE = ZERO DTSBX420 -01405 MOVE 'OR' TO X140-REPORT-TYPE DTSBX420 -01406 ELSE DTSBX420 -01407 MOVE 'EA' TO X140-REPORT-TYPE DTSBX420 -01408 END-IF. DTSBX420 -01409 DTSBX420 -01410 ** DISPLAY 'L205-TEXT (6) (1:02) ' L205-TEXT (6) (1:02) DTSBX420 -01411 ** DISPLAY 'X140-REPORT-TYPE ' X140-REPORT-TYPE DTSBX420 -01412 DTSBX420 -01413 MOVE ZEROS TO X140-PSEUDO-BATCH-NO. DTSBX420 -01414 ** DISPLAY 'X140-PSEUDO-BATCH-NO ' X140-PSEUDO-BATCH-NO DTSBX420 -01415 DTSBX420 -01416 MOVE ZEROS TO X140-PSEUDO-ITEM-NO. DTSBX420 -01417 ** DISPLAY 'X140-PSEUDO-ITEM-NO ' X140-PSEUDO-ITEM-NO DTSBX420 -01418 DTSBX420 -01419 MOVE L205-INTEGER (8) TO W-INTEGER. DTSBX420 -01420 MOVE L205-FRACTION (8) TO W-FRACTION. DTSBX420 -01421 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 -01422 MOVE W-NUMBER TO X140-TAX-WAGES. DTSBX420 -01423 DISPLAY 'X140-TAX-WAGES ' X140-TAX-WAGES DTSBX420 -01424 DTSBX420 -01425 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX420 -01426 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX420 -01427 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 -01428 MOVE W-NUMBER TO X140-TOTAL-WAGES. DTSBX420 -01429 DISPLAY 'X140-TOTAL-WAGES ' X140-TOTAL-WAGES DTSBX420 -01430 DTSBX420 -01431 MOVE ZEROS TO X140-REMITTANCE. DTSBX420 -01432 DISPLAY 'X140-REMITTANCE ' X140-REMITTANCE DTSBX420 +01403 MOVE L205-TEXT(12) (1:40) TO X110-EMAIL. DTSBX420 +01404 DTSBX420 +01405 MOVE L205-TEXT (13) (1:40) TO X110-WEB-SITE. DTSBX420 +01406 DTSBX420 +01407 MOVE L205-TEXT (14) (1:40) TO X110-EMP-NAME. DTSBX420 +01408 CL*52 +01409 MOVE L205-TEXT (15) (1:1) TO X110-QAS-FLAG. CL*52 +01410 DTSBX420 +01411 P1200E-EXIT. DTSBX420 +01412 EXIT. DTSBX420 +01413 DTSBX420 +01414 P1200F-OPO. DTSBX420 +01415 MOVE WEB-IMP-REC TO W120-REC. CL*40 +01416 MOVE W120-REC-TYPE TO X120-REC-TYPE. CL*40 +01417 DTSBX420 +01418 MOVE W120-EMP-NO TO X120-EMP-NO. CL*40 +01419 DTSBX420 +01420 MOVE W120-TYPE-IND (1:02) TO X120-TYPE-IND. CL*40 +01421 DTSBX420 +01422 MOVE W120-OPO-FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME. CL*40 +01423 DTSBX420 +01424 MOVE W120-OPO-MID-INIT (1:01) TO X120-OPO-MID-INIT. CL*40 +01425 DTSBX420 +01426 MOVE W120-OPO-LAST-NAME (1:20) TO X120-OPO-LAST-NAME. CL*40 +01427 DTSBX420 +01428 MOVE W120-OPO-MEMBER-NAME (1:40) TO X120-OPO-MEMBER-NAME. CL*40 +01429 DTSBX420 +01430 MOVE W120-OPO-SSN (1:09) TO X120-OPO-SSN. CL*40 +01431 DTSBX420 +01432 MOVE W120-OPO-TITLE (1:40) TO X120-OPO-TITLE. CL*40 01433 DTSBX420 -01434 MOVE ZERO TO X140-CONFIRMATION. DTSBX420 +01434 MOVE W120-OPO-ATTENTION (1:40) TO X120-OPO-ATTENTION. CL*40 01435 DTSBX420 -01436 MOVE L205-TEXT (11) TO X140-RCVD-DATE. DTSBX420 -01437 DISPLAY 'RECV DATE ' X140-RCVD-DATE. DTSBX420 -01438 DTSBX420 -01439 MOVE L205-INTEGER (12) TO X140-WRKR-CNT-1ST-MNTH. DTSBX420 -01440 DISPLAY 'X140-WRKR-CNT-1ST-MNTH ' X140-WRKR-CNT-1ST-MNTH DTSBX420 -01441 DTSBX420 -01442 MOVE L205-INTEGER (13) TO X140-WRKR-CNT-2ND-MNTH. DTSBX420 -01443 DISPLAY 'X140-WRKR-CNT-2ND-MNTH ' X140-WRKR-CNT-2ND-MNTH DTSBX420 -01444 DTSBX420 -01445 MOVE L205-INTEGER (14) TO X140-WRKR-CNT-3RD-MNTH. DTSBX420 -01446 DISPLAY 'X140-WRKR-CNT-3RD-MNTH ' X140-WRKR-CNT-3RD-MNTH DTSBX420 -01447 DTSBX420 -01448 MOVE SPACES TO X140-CHECK-SCAN-DT. DTSBX420 -01449 DISPLAY 'X140-CHECK SCANDATE ' X140-CHECK-SCAN-DT. DTSBX420 -01450 DTSBX420 -01451 MOVE ZEROS TO X140-CHECK-SEQ-NBR. DTSBX420 -01452 DISPLAY 'X140-CHECK-SEQ-NBR ' X140-CHECK-SEQ-NBR DTSBX420 +01436 MOVE W120-OPO-STREET-1 (1:40) TO X120-OPO-STREET-1. CL*40 +01437 DTSBX420 +01438 MOVE W120-OPO-STREET-2 (1:40) TO X120-OPO-STREET-2. CL*40 +01439 DTSBX420 +01440 MOVE W120-OPO-CITY (1:20) TO X120-OPO-CITY. CL*40 +01441 DISPLAY ' CITY ' X120-OPO-CITY. CL*51 +01442 DTSBX420 +01443 MOVE W120-OPO-STATE (1:02) TO X120-OPO-STATE. CL*40 +01444 DISPLAY ' ST ' X120-OPO-STATE. CL*51 +01445 DTSBX420 +01446 MOVE W120-OPO-ZIP (1:10) TO X120-OPO-ZIP. CL*40 +01447 DISPLAY ' ZIP ' X120-OPO-ZIP. CL*51 +01448 DTSBX420 +01449 MOVE W120-OPO-PHONE (1:15) TO X120-OPO-PHONE. CL*40 +01450 DISPLAY ' FONE ' X120-OPO-PHONE CL*51 +01451 DTSBX420 +01452 MOVE W120-OPO-FAX (1:15) TO X120-OPO-FAX. CL*40 01453 DTSBX420 -01454 MOVE 'N' TO X140-WAIVE-INTEREST. DTSBX420 -01455 DISPLAY 'X140-WAIVE-INTEREST ' X140-WAIVE-INTEREST DTSBX420 -01456 DTSBX420 -01457 MOVE 'N' TO X140-WAIVE-PENALTY. DTSBX420 -01458 DISPLAY 'X140-WAIVE-PENALTY ' X140-WAIVE-PENALTY DTSBX420 -01459 DTSBX420 -01460 MOVE ' ' TO X140-RESP-ACTIVITY. DTSBX420 -01461 DISPLAY 'X140-RESP-ACTIVITY ' X140-RESP-ACTIVITY DTSBX420 +01454 MOVE W120-OPO-EMAIL (1:40) TO X120-OPO-EMAIL. CL*43 +01455 DTSBX420 +01456 P1200F-EXIT. DTSBX420 +01457 EXIT. DTSBX420 +01458 DTSBX420 +01459 P1200G-REL. DTSBX420 +01460 P1200G-EXIT. DTSBX420 +01461 EXIT. DTSBX420 01462 DTSBX420 -01463 MOVE 'WEBESSP ' TO X140-RESP-OPID. DTSBX420 -01464 DISPLAY 'X140-RESP-OPID ' X140-RESP-OPID DTSBX420 +01463 P1200H-RPT. DTSBX420 +01464 * DISPLAY '01200H-RPT ' CL**9 01465 DTSBX420 -01466 *& DTSBX420 -01467 DISPLAY 'BX420 P1200H: ' X140-REC. DTSBX420 -01468 P1200H-EXIT. DTSBX420 -01469 EXIT. DTSBX420 -01470 DTSBX420 -01471 P1200I-WAGE. DTSBX420 -01472 MOVE L205-TEXT (1) (1:03) TO X144-REC-TYPE. DTSBX420 -01473 DTSBX420 -01474 MOVE L205-TEXT (2) (1:06) TO X144-EMP-NO. DTSBX420 +01466 MOVE L205-TEXT (1) (1:03) TO X140-REC-TYPE. DTSBX420 +01467 * DISPLAY 'X140-REC-TYPE' X140-REC-TYPE CL**9 +01468 DTSBX420 +01469 MOVE L205-TEXT (2) (1:06) TO X140-EMP-NO. DTSBX420 +01470 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX420 +01471 DTSBX420 +01472 MOVE L205-TEXT (3) (1:04) TO X140-QUARTER(1:04). DTSBX420 +01473 MOVE '/' TO X140-QUARTER(5:01). DTSBX420 +01474 MOVE L205-TEXT (4) (1:01) TO X140-QUARTER(6:01). DTSBX420 01475 DTSBX420 -01476 ** MOVE L205-TEXT (3) (1:06) TO X144-QUARTER. DTSBX420 -01477 DTSBX420 -01478 MOVE L205-TEXT (3) (1:04) TO X144-QUARTER(1:04). DTSBX420 -01479 MOVE '/' TO X144-QUARTER(5:01). DTSBX420 -01480 MOVE L205-TEXT (4) (1:01) TO X144-QUARTER(6:01). DTSBX420 -01481 DTSBX420 -01482 MOVE L205-TEXT (6) (1:09) TO X144-SSN. DTSBX420 -01483 DTSBX420 -01484 MOVE '5' TO X144-WAGE-STATUS. DTSBX420 +01476 MOVE '00' TO X140-SOURCE. DTSBX420 +01477 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSBX420 +01478 DTSBX420 +01479 MOVE L205-TEXT (5) (7:02) TO X140-REPORT-TYPE. CL**2 +01480 IF X140-REPORT-TYPE = ZERO DTSBX420 +01481 MOVE 'OR' TO X140-REPORT-TYPE DTSBX420 +01482 ELSE DTSBX420 +01483 MOVE 'EA' TO X140-REPORT-TYPE DTSBX420 +01484 END-IF. DTSBX420 01485 DTSBX420 -01486 MOVE L205-TEXT (7) (1:20) TO X144-LAST-NAME. DTSBX420 -01487 DTSBX420 -01488 MOVE L205-TEXT (8) (1:15) TO X144-FIRST-NAME. DTSBX420 -01489 DTSBX420 -01490 MOVE L205-TEXT (9) (1:01) TO X144-MID-INIT. DTSBX420 +01486 ** DISPLAY 'L205-TEXT (6) (1:02) ' L205-TEXT (6) (1:02) DTSBX420 +01487 ** DISPLAY 'X140-REPORT-TYPE ' X140-REPORT-TYPE DTSBX420 +01488 DTSBX420 +01489 MOVE ZEROS TO X140-PSEUDO-BATCH-NO. DTSBX420 +01490 ** DISPLAY 'X140-PSEUDO-BATCH-NO ' X140-PSEUDO-BATCH-NO DTSBX420 01491 DTSBX420 -01492 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX420 -01493 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX420 -01494 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 -01495 MOVE W-NUMBER TO X144-EARNINGS. DTSBX420 -01496 DISPLAY 'WAGES ' X144-EARNINGS. DTSBX420 -01497 DTSBX420 -01498 P1200I-EXIT. DTSBX420 -01499 EXIT. DTSBX420 +01492 MOVE ZEROS TO X140-PSEUDO-ITEM-NO. DTSBX420 +01493 ** DISPLAY 'X140-PSEUDO-ITEM-NO ' X140-PSEUDO-ITEM-NO DTSBX420 +01494 DTSBX420 +01495 MOVE L205-INTEGER (8) TO W-INTEGER. DTSBX420 +01496 MOVE L205-FRACTION (8) TO W-FRACTION. DTSBX420 +01497 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 +01498 MOVE W-NUMBER TO X140-TAX-WAGES. DTSBX420 +01499 * DISPLAY 'X140-TAX-WAGES ' X140-TAX-WAGES CL**9 01500 DTSBX420 -01501 P1200J-PAY. DTSBX420 -01502 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. DTSBX420 -01503 DTSBX420 -01504 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. DTSBX420 -01505 DTSBX420 -01506 MOVE '0' TO X145-SOURCE. DTSBX420 -01507 DTSBX420 -01508 MOVE L205-TEXT (3) (1:06) TO X145-QTR. DTSBX420 -01509 DISPLAY 'X145 QTR ' X145-QTR. DTSBX420 -01510 DTSBX420 -01511 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. DTSBX420 -01512 DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. DTSBX420 -01513 DTSBX420 -01514 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX420 -01515 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX420 -01516 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 -01517 MOVE W-NUMBER TO X145-REMITTANCE. DTSBX420 -01518 DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. DTSBX420 -01519 DTSBX420 -01520 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. DTSBX420 -01521 DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. DTSBX420 -01522 DTSBX420 -01523 MOVE L205-TEXT (12) TO W-TRACE-B. DTSBX420 -01524 MOVE W-TRACE-9 TO X145-TRACE-NO. DTSBX420 -01525 DISPLAY 'X145 PAY NO ' X145-TRACE-NO. DTSBX420 -01526 DTSBX420 -01527 DTSBX420 -01528 MOVE ZEROS TO X145-PSEUDO-BATCH. DTSBX420 -01529 DTSBX420 -01530 MOVE ZEROS TO X145-PSEUDO-ITEM. DTSBX420 -01531 DTSBX420 -01532 MOVE SPACES TO X145-APPLIC-ACCT. DTSBX420 +01501 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX420 +01502 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX420 +01503 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 +01504 MOVE W-NUMBER TO X140-TOTAL-WAGES. DTSBX420 +01505 * DISPLAY 'X140-TOTAL-WAGES ' X140-TOTAL-WAGES CL**9 +01506 DTSBX420 +01507 MOVE ZERO TO X140-CONFIRMATION. DTSBX420 +01508 DTSBX420 +01509 MOVE L205-TEXT (11) TO X140-RCVD-DATE. DTSBX420 +01510 * DISPLAY 'RECV DATE ' X140-RCVD-DATE. CL**9 +01511 DTSBX420 +01512 MOVE L205-TEXT (12) (2:06) TO X140-WRKR-CNT-1ST-MNTH. CL*48 +01513 DISPLAY 'X140-WRKR-CNT-1ST-MNTH ' X140-WRKR-CNT-1ST-MNTH CL*49 +01514 DTSBX420 +01515 MOVE L205-TEXT (13) (2:06) TO X140-WRKR-CNT-2ND-MNTH. CL*48 +01516 DISPLAY 'X140-WRKR-CNT-2ND-MNTH ' X140-WRKR-CNT-2ND-MNTH CL*49 +01517 DTSBX420 +01518 MOVE L205-TEXT (14) (2:06) TO X140-WRKR-CNT-3RD-MNTH. CL*48 +01519 DISPLAY 'X140-WRKR-CNT-3RD-MNTH ' X140-WRKR-CNT-3RD-MNTH CL*49 +01520 DTSBX420 +01521 CL*25 +01522 MOVE L205-INTEGER (16) TO W-INTEGER. CL*25 +01523 MOVE L205-FRACTION (16) TO W-FRACTION. CL*25 +01524 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*25 +01525 MOVE W-NUMBER TO X140-REMITTANCE. CL*25 +01526 * DISPLAY 'X140-REMITTANCE ' X140-REMITTANCE. CL*30 +01527 CL*25 +01528 MOVE SPACES TO X140-CHECK-SCAN-DT. DTSBX420 +01529 * DISPLAY 'X140-CHECK SCANDATE ' X140-CHECK-SCAN-DT. CL**9 +01530 DTSBX420 +01531 MOVE ZEROS TO X140-CHECK-SEQ-NBR. DTSBX420 +01532 * DISPLAY 'X140-CHECK-SEQ-NBR ' X140-CHECK-SEQ-NBR CL**9 01533 DTSBX420 -01534 MOVE SPACES TO X145-CHECK-SCAN-DT. DTSBX420 -01535 DTSBX420 -01536 MOVE ZEROS TO X145-CHECK-SEQ-NBR. DTSBX420 -01537 DTSBX420 -01538 MOVE 'N' TO X145-WAIVE-INTEREST. DTSBX420 +01534 MOVE 'N' TO X140-WAIVE-INTEREST. DTSBX420 +01535 * DISPLAY 'X140-WAIVE-INTEREST ' X140-WAIVE-INTEREST CL**9 +01536 DTSBX420 +01537 MOVE 'N' TO X140-WAIVE-PENALTY. DTSBX420 +01538 * DISPLAY 'X140-WAIVE-PENALTY ' X140-WAIVE-PENALTY CL**9 01539 DTSBX420 -01540 MOVE 'N' TO X145-WAIVE-PENALTY. DTSBX420 -01541 DTSBX420 -01542 MOVE 'VOL' TO X145-RESP-ACTIVITY. DTSBX420 -01543 DTSBX420 -01544 MOVE 'WEBESSP ' TO X145-RESP-OPID. DTSBX420 +01540 MOVE ' ' TO X140-RESP-ACTIVITY. DTSBX420 +01541 * DISPLAY 'X140-RESP-ACTIVITY ' X140-RESP-ACTIVITY CL**9 +01542 DTSBX420 +01543 MOVE 'WEBESSP ' TO X140-RESP-OPID. DTSBX420 +01544 * DISPLAY 'X140-RESP-OPID ' X140-RESP-OPID CL**9 01545 DTSBX420 -01546 P1200J-EXIT. DTSBX420 -01547 EXIT. DTSBX420 -01548 DTSBX420 -01549 P1200K-BATCH-HEADER. DTSBX420 -01550 MOVE L205-TEXT (1) (1:03) TO X149-REC-TYPE. DTSBX420 -01551 DTSBX420 -01552 MOVE L205-TEXT (2) (1:5) TO X149-PSEUDO-BATCH. DTSBX420 -01553 DTSBX420 -01554 MOVE L205-TEXT (3) (1:3) TO X149-PSEUDO-ITEM. DTSBX420 +01546 *& DTSBX420 +01547 * DISPLAY 'BX420 P1200H: ' X140-REC. CL*30 +01548 P1200H-EXIT. DTSBX420 +01549 EXIT. DTSBX420 +01550 DTSBX420 +01551 P1200I-WAGE. DTSBX420 +01552 MOVE WEB-IMP-REC TO W144-REC. CL*50 +01553 CL*50 +01554 MOVE W144-REC-TYPE TO X144-REC-TYPE. CL*50 01555 DTSBX420 -01556 MOVE L205-TEXT (4) (1:08) TO X149-ESTB-OPID. DTSBX420 +01556 MOVE W144-EMP-NO TO X144-EMP-NO. CL*50 01557 DTSBX420 -01558 MOVE L205-DATE (5) TO X149-ESTB-DATE. DTSBX420 -01559 DTSBX420 -01560 MOVE L205-DATE (6) TO X149-DEPOSIT-DATE. DTSBX420 +01558 DTSBX420 +01559 MOVE '/' TO W144-QUARTER-SLASH. CL*50 +01560 MOVE W144-QUARTER TO X144-QUARTER. CL*50 01561 DTSBX420 -01562 IF L205-VALID-NO-88 (7) DTSBX420 -01563 MOVE SPACES TO X149-RCVD-DATE DTSBX420 -01564 ELSE DTSBX420 -01565 MOVE L205-DATE (7) TO X149-RCVD-DATE DTSBX420 -01566 END-IF. DTSBX420 +01562 MOVE W144-SSN TO X144-SSN. CL*50 +01563 DTSBX420 +01564 MOVE '5' TO X144-WAGE-STATUS. DTSBX420 +01565 DTSBX420 +01566 MOVE W144-LAST-NAME TO X144-LAST-NAME. CL*50 01567 DTSBX420 -01568 MOVE L205-INTEGER (8) TO X149-LAST-ITEM-NBR. DTSBX420 +01568 MOVE W144-FIRST-NAME TO X144-FIRST-NAME. CL*50 01569 DTSBX420 -01570 MOVE L205-INTEGER (9) TO X149-CONTROL-TRAN-CNT. DTSBX420 +01570 MOVE W144-MID-INIT TO X144-MID-INIT. CL*50 01571 DTSBX420 -01572 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX420 -01573 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX420 -01574 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 -01575 MOVE W-NUMBER TO X149-CONTROL-REMIT-AMT. DTSBX420 -01576 MOVE W-INTEGER TO W-AMT-DISP1. DTSBX420 -01577 MOVE W-FRACTION TO W-AMT-DISP4. DTSBX420 -01578 MOVE W-NUMBER TO W-AMT-DISP2. DTSBX420 -01579 ** DISPLAY 'BX420 P1200 HDR ' X149-PSEUDO-BATCH DTSBX420 -01580 ** ' INT ' W-AMT-DISP1 ' FR ' W-AMT-DISP4 DTSBX420 -01581 ** ' NBR ' W-AMT-DISP2 DTSBX420 -01582 ** ' X149 ' X149-CONTROL-REMIT-AMT. DTSBX420 +01572 MOVE W144-EARNINGS TO X144-EARNINGS. CL*50 +01573 DTSBX420 +01574 P1200I-EXIT. DTSBX420 +01575 EXIT. DTSBX420 +01576 DTSBX420 +01577 P1200J-PAY. DTSBX420 +01578 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. DTSBX420 +01579 DTSBX420 +01580 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. DTSBX420 +01581 DTSBX420 +01582 MOVE '0' TO X145-SOURCE. DTSBX420 01583 DTSBX420 -01584 MOVE L205-INTEGER (11) TO X149-CONTROL-CHECK-CNT. DTSBX420 -01585 DTSBX420 -01586 MOVE L205-DATE (12) TO X149-CHECK-SCAN-DATE. DTSBX420 -01587 DTSBX420 -01588 MOVE L205-TEXT (13) (1:08) TO X149-ANN-BATCH-IND. DTSBX420 +01584 MOVE L205-TEXT (3) (1:06) TO X145-QTR. DTSBX420 +01585 * DISPLAY 'X145 QTR ' X145-QTR. CL**9 +01586 DTSBX420 +01587 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. DTSBX420 +01588 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL**9 01589 DTSBX420 -01590 ** DISPLAY 'BX420 P1200 HDR ' X149-PSEUDO-BATCH DTSBX420 -01591 ** ' ' X149-PSEUDO-ITEM ' ' X149-ESTB-OPID. DTSBX420 -01592 P1200K-EXIT. DTSBX420 -01593 EXIT. DTSBX420 -01594 DTSBX420 -01595 P2000-POST-SORT. DTSBX420 -01596 SET SORT-OK-88 TO TRUE. DTSBX420 -01597 DTSBX420 -01598 PERFORM P2100-PROCESS-SORT THRU P2100-EXIT DTSBX420 -01599 UNTIL SORT-EOF-88. DTSBX420 -01600 DTSBX420 -01601 P2000-EXIT. DTSBX420 -01602 EXIT. DTSBX420 +01590 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX420 +01591 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX420 +01592 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 +01593 MOVE W-NUMBER TO X145-REMITTANCE. DTSBX420 +01594 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL**9 +01595 DTSBX420 +01596 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. DTSBX420 +01597 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL**9 +01598 DTSBX420 +01599 MOVE L205-TEXT (12) TO W-TRACE-B. DTSBX420 +01600 MOVE W-TRACE-9 TO X145-TRACE-NO. DTSBX420 +01601 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL**9 +01602 DTSBX420 01603 DTSBX420 -01604 P2100-PROCESS-SORT. DTSBX420 -01605 RETURN SORT-FILE DTSBX420 -01606 AT END DTSBX420 -01607 SET SORT-EOF-88 TO TRUE DTSBX420 -01608 GO TO P2100-EXIT DTSBX420 -01609 END-RETURN. DTSBX420 -01610 DTSBX420 -01611 ** DISPLAY 'P2100 SORT-EMP-NO ' SORT-EMP-NO. DTSBX420 -01612 ** DISPLAY 'BX420 P2100 SORT-REC ' SORT-KEY ' ' DTSBX420 -01613 ** SORT-DATA (1:14). DTSBX420 -01614 DTSBX420 -01615 MOVE SORT-DATA TO LX42-DATA-AREA. DTSBX420 -01616 IF SORT-EMP-NO = 999999 DTSBX420 -01617 IF SORT-BATCH = W-PSEUDO-BATCH-NO DTSBX420 -01618 ** DISPLAY 'BX420 PROCESS' DTSBX420 -01619 SET LX42-PROCESS-88 TO TRUE DTSBX420 -01620 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 -01621 ELSE DTSBX420 -01622 MOVE SORT-BATCH TO W-PSEUDO-BATCH-NO DTSBX420 -01623 DISPLAY 'BX420 NEW ' DTSBX420 -01624 ** PERFORM P2120-NEW-BATCH THRU P2120-EXIT DTSBX420 -01625 SET LX42-PROCESS-88 TO TRUE DTSBX420 -01626 SET LX42-ERROR-NO-88 TO TRUE DTSBX420 -01627 ** DISPLAY 'BX420 NEW PROCESS' DTSBX420 -01628 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 -01629 END-IF DTSBX420 -01630 ELSE DTSBX420 -01631 IF SORT-EMP-NO = W-EMP-NO DTSBX420 -01632 SET LX42-PROCESS-88 TO TRUE DTSBX420 -01633 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 -01634 ELSE DTSBX420 -01635 MOVE SORT-EMP-NO TO W-EMP-NO DTSBX420 -01636 PERFORM P2110-NEW-EMP THRU P2110-EXIT DTSBX420 -01637 SET LX42-PROCESS-88 TO TRUE DTSBX420 -01638 SET LX42-ERROR-NO-88 TO TRUE DTSBX420 -01639 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 -01640 END-IF DTSBX420 -01641 END-IF. DTSBX420 -01642 DTSBX420 -01643 P2100-EXIT. DTSBX420 -01644 EXIT. DTSBX420 +01604 MOVE ZEROS TO X145-PSEUDO-BATCH. DTSBX420 +01605 DTSBX420 +01606 MOVE ZEROS TO X145-PSEUDO-ITEM. DTSBX420 +01607 DTSBX420 +01608 MOVE SPACES TO X145-APPLIC-ACCT. DTSBX420 +01609 DTSBX420 +01610 MOVE SPACES TO X145-CHECK-SCAN-DT. DTSBX420 +01611 DTSBX420 +01612 MOVE ZEROS TO X145-CHECK-SEQ-NBR. DTSBX420 +01613 DTSBX420 +01614 MOVE 'N' TO X145-WAIVE-INTEREST. DTSBX420 +01615 DTSBX420 +01616 MOVE 'N' TO X145-WAIVE-PENALTY. DTSBX420 +01617 DTSBX420 +01618 MOVE 'VOL' TO X145-RESP-ACTIVITY. DTSBX420 +01619 DTSBX420 +01620 MOVE 'WEBESSP ' TO X145-RESP-OPID. DTSBX420 +01621 DTSBX420 +01622 P1200J-EXIT. DTSBX420 +01623 EXIT. DTSBX420 +01624 DTSBX420 +01625 P1200K-BATCH-HEADER. DTSBX420 +01626 MOVE L205-TEXT (1) (1:03) TO X149-REC-TYPE. DTSBX420 +01627 DTSBX420 +01628 MOVE L205-TEXT (2) (1:5) TO X149-PSEUDO-BATCH. DTSBX420 +01629 DTSBX420 +01630 MOVE L205-TEXT (3) (1:3) TO X149-PSEUDO-ITEM. DTSBX420 +01631 DTSBX420 +01632 MOVE L205-TEXT (4) (1:08) TO X149-ESTB-OPID. DTSBX420 +01633 DTSBX420 +01634 MOVE L205-DATE (5) TO X149-ESTB-DATE. DTSBX420 +01635 DTSBX420 +01636 MOVE L205-DATE (6) TO X149-DEPOSIT-DATE. DTSBX420 +01637 DTSBX420 +01638 IF L205-VALID-NO-88 (7) DTSBX420 +01639 MOVE SPACES TO X149-RCVD-DATE DTSBX420 +01640 ELSE DTSBX420 +01641 MOVE L205-DATE (7) TO X149-RCVD-DATE DTSBX420 +01642 END-IF. DTSBX420 +01643 DTSBX420 +01644 MOVE L205-INTEGER (8) TO X149-LAST-ITEM-NBR. DTSBX420 01645 DTSBX420 -01646 P2110-NEW-EMP. DTSBX420 +01646 MOVE L205-INTEGER (9) TO X149-CONTROL-TRAN-CNT. DTSBX420 01647 DTSBX420 -01648 ** DISPLAY 'P2110 NEW ' LX42-DATA-AREA (1:20). DTSBX420 -01649 DTSBX420 -01650 SET LX42-NEW-EMPLOYER-88 TO TRUE. DTSBX420 -01651 MOVE ZERO TO LX42-LAST-DETERM-EMP. DTSBX420 -01652 DTSBX420 -01653 PERFORM S421-REGISTRATION THRU S421-EXIT. DTSBX420 -01654 PERFORM S422-REPORT THRU S422-EXIT. DTSBX420 -01655 PERFORM S423-PAYMENT THRU S423-EXIT. DTSBX420 -01656 PERFORM S424-PROFILE THRU S424-EXIT. DTSBX420 -01657 DTSBX420 -01658 P2110-EXIT. DTSBX420 -01659 EXIT. DTSBX420 -01660 DTSBX420 -01661 P2120-NEW-BATCH. DTSBX420 -01662 *& DTSBX420 -01663 * DISPLAY 'BX420 P2120 NEW BATCH ' LX42-PSEUDO-BATCH-NO DTSBX420 -01664 * ' ' LX42-DATA-AREA (1:20). DTSBX420 -01665 *& DTSBX420 -01666 SET LX42-NEW-BATCH-88 TO TRUE. DTSBX420 -01667 DTSBX420 -01668 * PERFORM S426-HEADER THRU S426-EXIT. DTSBX420 -01669 * IF LX42-BATCH-ERR-YES-88 DTSBX420 -01670 * SET LX42-BATCH-ERROR-88 TO TRUE DTSBX420 -01671 * END-IF. DTSBX420 -01672 PERFORM S422-REPORT THRU S422-EXIT. DTSBX420 -01673 PERFORM S423-PAYMENT THRU S423-EXIT. DTSBX420 -01674 DTSBX420 -01675 MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX420 -01676 MOVE ZERO TO LX42-RPT-CNT DTSBX420 -01677 LX42-RPT-REMIT-AMT DTSBX420 -01678 LX42-PAY-CNT DTSBX420 -01679 LX42-PAY-REMIT-AMT. DTSBX420 -01680 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX420 -01681 DTSBX420 -01682 P2120-EXIT. DTSBX420 +01648 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX420 +01649 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX420 +01650 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX420 +01651 MOVE W-NUMBER TO X149-CONTROL-REMIT-AMT. DTSBX420 +01652 MOVE W-INTEGER TO W-AMT-DISP1. DTSBX420 +01653 MOVE W-FRACTION TO W-AMT-DISP4. DTSBX420 +01654 MOVE W-NUMBER TO W-AMT-DISP2. DTSBX420 +01655 ** DISPLAY 'BX420 P1200 HDR ' X149-PSEUDO-BATCH DTSBX420 +01656 ** ' INT ' W-AMT-DISP1 ' FR ' W-AMT-DISP4 DTSBX420 +01657 ** ' NBR ' W-AMT-DISP2 DTSBX420 +01658 ** ' X149 ' X149-CONTROL-REMIT-AMT. DTSBX420 +01659 DTSBX420 +01660 MOVE L205-INTEGER (11) TO X149-CONTROL-CHECK-CNT. DTSBX420 +01661 DTSBX420 +01662 MOVE L205-DATE (12) TO X149-CHECK-SCAN-DATE. DTSBX420 +01663 DTSBX420 +01664 MOVE L205-TEXT (13) (1:08) TO X149-ANN-BATCH-IND. DTSBX420 +01665 DTSBX420 +01666 ** DISPLAY 'BX420 P1200 HDR ' X149-PSEUDO-BATCH DTSBX420 +01667 ** ' ' X149-PSEUDO-ITEM ' ' X149-ESTB-OPID. DTSBX420 +01668 P1200K-EXIT. DTSBX420 +01669 EXIT. DTSBX420 +01670 DTSBX420 +01671 P2000-POST-SORT. DTSBX420 +01672 SET SORT-OK-88 TO TRUE. DTSBX420 +01673 DTSBX420 +01674 DISPLAY 'P2000 BEG READING SORT-FILE ' SORT-EMP-NO. CL**7 +01675 PERFORM P2100-PROCESS-SORT THRU P2100-EXIT DTSBX420 +01676 UNTIL SORT-EOF-88. DTSBX420 +01677 DTSBX420 +01678 * SET LX42-TERMINATE-88 TO TRUE CL**9 +01679 * DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-EMP-NO. CL**9 +01680 DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-KEY ' ' CL**9 +01681 SORT-DATA (1:14). CL**7 +01682 P2000-EXIT. DTSBX420 01683 EXIT. DTSBX420 01684 DTSBX420 -01685 P3000-PROCESS. DTSBX420 -01686 *& DTSBX420 -01687 ** DISPLAY 'P3000 ' LX42-DATA-AREA (1:20). DTSBX420 -01688 *& DTSBX420 -01689 **************************************************************** DTSBX420 -01690 * LX42-LAST-DETERM-EMP IS SET WHEN PROCESSING A DETERMINATION. DTSBX420 -01691 * THE EMPLOYER ACCOUNT NUMBER IS PASSED THROUGH THIS FIELD DTSBX420 -01692 * TO DTSBX422, WHICH PROCESSES REPORTS. IT IS USED DTSBX420 -01693 * TO DETERMINE WHEN TO WAIVE P & I. THE WAIVER IS AUTOMATIC DTSBX420 -01694 * FOR REPORTS WITHIN THE LAST 5 QUARTERS SUBMITTED ALONG DTSBX420 -01695 * WITH A WEB REGISTRATION. DTSBX420 -01696 **************************************************************** DTSBX420 -01697 DTSBX420 -01698 EVALUATE TRUE DTSBX420 -01699 WHEN LX42-REC-TYPE-PRF-88 DTSBX420 -01700 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 -01701 WHEN LX42-REC-TYPE-DETERM-88 DTSBX420 -01702 MOVE W-EMP-NO DTSBX420 -01703 TO LX42-LAST-DETERM-EMP DTSBX420 -01704 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 -01705 WHEN LX42-REC-TYPE-RATE-88 DTSBX420 -01706 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 -01707 WHEN LX42-REC-TYPE-NAME-88 DTSBX420 -01708 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 -01709 WHEN LX42-REC-TYPE-REL-88 DTSBX420 -01710 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 -01711 DTSBX420 -01712 WHEN LX42-REC-TYPE-RPT-88 DTSBX420 -01713 *** PERFORM P3100-BATCH-NO THRU P3100-EXIT DTSBX420 -01714 PERFORM S422-REPORT THRU S422-EXIT DTSBX420 -01715 WHEN LX42-REC-TYPE-WAGE-88 DTSBX420 -01716 PERFORM S422-REPORT THRU S422-EXIT DTSBX420 -01717 DTSBX420 -01718 WHEN LX42-REC-TYPE-BHDR-88 DTSBX420 -01719 PERFORM S426-HEADER THRU S426-EXIT DTSBX420 -01720 DTSBX420 -01721 WHEN LX42-REC-TYPE-PAY-88 DTSBX420 -01722 PERFORM S423-PAYMENT THRU S423-EXIT DTSBX420 -01723 DTSBX420 -01724 WHEN LX42-REC-TYPE-ADDR-88 DTSBX420 -01725 PERFORM S424-PROFILE THRU S424-EXIT DTSBX420 -01726 WHEN LX42-REC-TYPE-OPO-88 DTSBX420 -01727 PERFORM S424-PROFILE THRU S424-EXIT DTSBX420 +01685 P2100-PROCESS-SORT. DTSBX420 +01686 * DISPLAY 'BX420 P2100 FIRST SORT-EMP-NO ' SORT-EMP-NO CL*38 +01687 * ' ' SORT-DATA (1:14). CL*38 +01688 RETURN SORT-FILE DTSBX420 +01689 AT END DTSBX420 +01690 SET SORT-EOF-88 TO TRUE DTSBX420 +01691 GO TO P2100-EXIT DTSBX420 +01692 END-RETURN. DTSBX420 +01693 DTSBX420 +01694 DISPLAY 'BX420 P2100 SORT-REC ' SORT-KEY ' ' CL*21 +01695 SORT-DATA (1:14). CL*21 +01696 DTSBX420 +01697 MOVE SORT-DATA TO LX42-DATA-AREA. DTSBX420 +01698 IF SORT-EMP-NO = 999999 DTSBX420 +01699 IF SORT-BATCH = W-PSEUDO-BATCH-NO DTSBX420 +01700 DISPLAY 'BX420 NEW BATCH 999999 PROCESS' CL*13 +01701 SET LX42-PROCESS-88 TO TRUE DTSBX420 +01702 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 +01703 ELSE DTSBX420 +01704 MOVE SORT-BATCH TO W-PSEUDO-BATCH-NO DTSBX420 +01705 DISPLAY 'BX420 NEW BATCH ' CL*13 +01706 ** PERFORM P2120-NEW-BATCH THRU P2120-EXIT DTSBX420 +01707 SET LX42-PROCESS-88 TO TRUE DTSBX420 +01708 SET LX42-ERROR-NO-88 TO TRUE DTSBX420 +01709 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01710 ** DISPLAY 'BX420 NEW BATCH 888888 PROCESS' CL*13 +01711 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 +01712 END-IF DTSBX420 +01713 ELSE CL*19 +01714 IF SORT-EMP-NO = W-EMP-NO DTSBX420 +01715 DISPLAY 'BX420 SORT-EMP-NO = W-EMP-NO ' CL*13 +01716 SET LX42-PROCESS-88 TO TRUE DTSBX420 +01717 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 +01718 ELSE DTSBX420 +01719 DISPLAY 'BX420 SORT-EMP-NO < W-EMP-NO ' CL*13 +01720 MOVE SORT-EMP-NO TO W-EMP-NO DTSBX420 +01721 PERFORM P2110-NEW-EMP THRU P2110-EXIT DTSBX420 +01722 SET LX42-PROCESS-88 TO TRUE DTSBX420 +01723 SET LX42-ERROR-NO-88 TO TRUE DTSBX420 +01724 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01725 PERFORM P3000-PROCESS THRU P3000-EXIT DTSBX420 +01726 END-IF DTSBX420 +01727 END-IF. DTSBX420 01728 DTSBX420 -01729 END-EVALUATE. DTSBX420 -01730 DTSBX420 -01731 P3000-EXIT. DTSBX420 -01732 EXIT. DTSBX420 +01729 P2100-EXIT. DTSBX420 +01730 EXIT. DTSBX420 +01731 DTSBX420 +01732 P2110-NEW-EMP. DTSBX420 01733 DTSBX420 -01734 P3100-BATCH-NO. DTSBX420 -01735 *& IF W-PSEUDO-ITEM-NO < 999 DTSBX420 -01736 * ADD 1 TO W-PSEUDO-ITEM-NO DTSBX420 -01737 * ELSE DTSBX420 -01738 * ADD 1 TO W-PSEUDO-BATCH-NO DTSBX420 -01739 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSBX420 -01740 * END-IF. DTSBX420 -01741 * DTSBX420 -01742 * MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX420 -01743 *& MOVE W-PSEUDO-ITEM-NO TO LX42-PSEUDO-ITEM-NO. DTSBX420 -01744 DTSBX420 -01745 P3100-EXIT. DTSBX420 -01746 EXIT. DTSBX420 -01747 DTSBX420 -01748 DTSBX420 -01749 T0000-TERMINATE. DTSBX420 -01750 PERFORM T1000-FINAL-CALLS THRU T1000-EXIT. DTSBX420 -01751 DTSBX420 -01752 *** PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSBX420 +01734 DISPLAY 'BX420 >>>>>>>> NEW-EMP ' LX42-DATA-AREA (1:20). CL*11 +01735 DTSBX420 +01736 SET LX42-NEW-EMPLOYER-88 TO TRUE. DTSBX420 +01737 MOVE ZERO TO LX42-LAST-DETERM-EMP. DTSBX420 +01738 DTSBX420 +01739 PERFORM S421-REGISTRATION THRU S421-EXIT. DTSBX420 +01740 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01741 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +01742 PERFORM S424-PROFILE THRU S424-EXIT. DTSBX420 +01743 DTSBX420 +01744 P2110-EXIT. DTSBX420 +01745 EXIT. DTSBX420 +01746 DTSBX420 +01747 P2120-NEW-BATCH. DTSBX420 +01748 *& DTSBX420 +01749 * DISPLAY 'BX420 P2120 NEW BATCH ' LX42-PSEUDO-BATCH-NO DTSBX420 +01750 * ' ' LX42-DATA-AREA (1:20). DTSBX420 +01751 *& DTSBX420 +01752 SET LX42-NEW-BATCH-88 TO TRUE. DTSBX420 01753 DTSBX420 -01754 DISPLAY ' '. DTSBX420 -01755 DTSBX420 -01756 DISPLAY '*** DTSBX420 TERMINATION STATISTICS ***'. DTSBX420 -01757 DTSBX420 -01758 DISPLAY ' '. DTSBX420 -01759 DTSBX420 -01760 DISPLAY '*** WEB IMPORT DRIVER ***'. DTSBX420 -01761 DTSBX420 -01762 DISPLAY ' '. DTSBX420 -01763 DTSBX420 -01764 DISPLAY 'INPUT RECORDS READ: ' DTSBX420 -01765 W-WEB-IMP-CNT. DTSBX420 -01766 DTSBX420 -01767 DISPLAY ' '. DTSBX420 -01768 DTSBX420 -01769 DISPLAY '***************************************'. DTSBX420 +01754 * PERFORM S426-HEADER THRU S426-EXIT. DTSBX420 +01755 * IF LX42-BATCH-ERR-YES-88 DTSBX420 +01756 * SET LX42-BATCH-ERROR-88 TO TRUE DTSBX420 +01757 * END-IF. DTSBX420 +01758 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01759 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +01760 DTSBX420 +01761 MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX420 +01762 MOVE ZERO TO LX42-RPT-CNT DTSBX420 +01763 LX42-RPT-REMIT-AMT DTSBX420 +01764 LX42-PAY-CNT DTSBX420 +01765 LX42-PAY-REMIT-AMT. DTSBX420 +01766 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSBX420 +01767 DTSBX420 +01768 P2120-EXIT. DTSBX420 +01769 EXIT. DTSBX420 01770 DTSBX420 -01771 CLOSE WEB-IMP-FILE. DTSBX420 -01772 *** CURR-BATCH-NO. DTSBX420 -01773 *** TEMP-BTC-FILE. DTSBX420 -01774 DTSBX420 -01775 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX420 -01776 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX420 -01777 PERFORM S923-CLOSE THRU S923-EXIT. DTSBX420 -01778 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX420 -01779 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBX420 -01780 DTSBX420 -01781 T0000-EXIT. DTSBX420 -01782 EXIT. DTSBX420 -01783 DTSBX420 -01784 T1000-FINAL-CALLS. DTSBX420 -01785 *& DTSBX420 -01786 * DISPLAY 'BX420 T1000 ' LX42-DATA-AREA (1:20). DTSBX420 -01787 *& DTSBX420 -01788 SET LX42-TERMINATE-88 TO TRUE. DTSBX420 -01789 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX420 -01790 DTSBX420 -01791 PERFORM S421-REGISTRATION THRU S421-EXIT. DTSBX420 -01792 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX420 -01793 PERFORM S422-REPORT THRU S422-EXIT. DTSBX420 -01794 PERFORM S423-PAYMENT THRU S423-EXIT. DTSBX420 -01795 PERFORM S424-PROFILE THRU S424-EXIT. DTSBX420 -01796 DTSBX420 -01797 T1000-EXIT. DTSBX420 -01798 EXIT. DTSBX420 -01799 DTSBX420 -01800 *T1100-UPDATE-CURR-BATCH. DTSBX420 -01801 * MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBX420 -01802 * W-END-BATCH. DTSBX420 -01803 * MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBX420 -01804 * DISPLAY 'REWRITING CURRENT BATCH ' DTSBX420 -01805 * W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBX420 -01806 * REWRITE CURR-BATCH-NO-REC. DTSBX420 -01807 * IF BATCH-STATUS-OK-88 DTSBX420 -01808 * NEXT SENTENCE DTSBX420 -01809 * ELSE DTSBX420 -01810 * DISPLAY 'T1100 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBX420 -01811 * BATCH-STATUS DTSBX420 -01812 * END-IF. DTSBX420 -01813 * DTSBX420 -01814 *T1100-EXIT. DTSBX420 -01815 * EXIT. DTSBX420 +01771 P3000-PROCESS. DTSBX420 +01772 *& DTSBX420 +01773 *& DTSBX420 +01774 **************************************************************** DTSBX420 +01775 * LX42-LAST-DETERM-EMP IS SET WHEN PROCESSING A DETERMINATION. DTSBX420 +01776 * THE EMPLOYER ACCOUNT NUMBER IS PASSED THROUGH THIS FIELD DTSBX420 +01777 * TO DTSBX422, WHICH PROCESSES REPORTS. IT IS USED DTSBX420 +01778 * TO DETERMINE WHEN TO WAIVE P & I. THE WAIVER IS AUTOMATIC DTSBX420 +01779 * FOR REPORTS WITHIN THE LAST 5 QUARTERS SUBMITTED ALONG DTSBX420 +01780 * WITH A WEB REGISTRATION. DTSBX420 +01781 **************************************************************** DTSBX420 +01782 DTSBX420 +01783 EVALUATE TRUE DTSBX420 +01784 WHEN LX42-REC-TYPE-PRF-88 DTSBX420 +01785 ADD +1 TO W-102-IMP-CNT CL*38 +01786 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 +01787 CL**9 +01788 WHEN LX42-REC-TYPE-DETERM-88 DTSBX420 +01789 ADD +1 TO W-104-IMP-CNT CL*38 +01790 MOVE W-EMP-NO DTSBX420 +01791 TO LX42-LAST-DETERM-EMP DTSBX420 +01792 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 +01793 CL**9 +01794 WHEN LX42-REC-TYPE-RATE-88 DTSBX420 +01795 ADD +1 TO W-108-IMP-CNT CL*38 +01796 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 +01797 CL**9 +01798 WHEN LX42-REC-TYPE-NAME-88 DTSBX420 +01799 ADD +1 TO W-106-IMP-CNT CL*38 +01800 PERFORM S421-REGISTRATION THRU S421-EXIT DTSBX420 +01801 CL**9 +01802 * WHEN LX42-REC-TYPE-REL-88 CL**9 +01803 * PERFORM S421-REGISTRATION THRU S421-EXIT CL**9 +01804 DTSBX420 +01805 WHEN LX42-REC-TYPE-RPT-88 DTSBX420 +01806 ADD +1 TO W-140-IMP-CNT CL*38 +01807 *** PERFORM P3100-BATCH-NO THRU P3100-EXIT DTSBX420 +01808 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 +01809 CL**9 +01810 WHEN LX42-REC-TYPE-WAGE-88 DTSBX420 +01811 ADD +1 TO W-144-IMP-CNT CL*38 +01812 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 +01813 DTSBX420 +01814 * WHEN LX42-REC-TYPE-BHDR-88 CL**9 +01815 * PERFORM S426-HEADER THRU S426-EXIT CL**9 01816 DTSBX420 -01817 S001-FROM-FED-8. DTSBX420 -01818 SET L001-FROM-FED-8 TO TRUE. DTSBX420 -01819 GO TO S001-DATE. DTSBX420 +01817 WHEN LX42-REC-TYPE-PAY-88 DTSBX420 +01818 ADD +1 TO W-145-IMP-CNT CL*38 +01819 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 01820 DTSBX420 -01821 S001-FROM-CAL-8. DTSBX420 -01822 SET L001-FROM-CAL-8 TO TRUE. DTSBX420 -01823 GO TO S001-DATE. DTSBX420 -01824 DTSBX420 -01825 S001-FROM-ABS-DAY. DTSBX420 -01826 SET L001-FROM-ABS-DAY TO TRUE. DTSBX420 -01827 GO TO S001-DATE. DTSBX420 +01821 WHEN LX42-REC-TYPE-ADDR-88 DTSBX420 +01822 ADD +1 TO W-110-IMP-CNT CL*38 +01823 PERFORM S424-PROFILE THRU S424-EXIT DTSBX420 +01824 CL**9 +01825 WHEN LX42-REC-TYPE-OPO-88 DTSBX420 +01826 ADD +1 TO W-120-IMP-CNT CL*38 +01827 PERFORM S424-PROFILE THRU S424-EXIT DTSBX420 01828 DTSBX420 -01829 S001-DATE. DTSBX420 -01830 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX420 -01831 S001-EXIT. DTSBX420 +01829 END-EVALUATE. DTSBX420 +01830 DTSBX420 +01831 P3000-EXIT. DTSBX420 01832 EXIT. DTSBX420 01833 DTSBX420 -01834 S003-AGENCY-DAY. DTSBX420 -01835 SET L003-AGENCY-DAY TO TRUE. DTSBX420 -01836 GO TO S003-WORK-DAY. DTSBX420 -01837 DTSBX420 -01838 S003-WORK-DAY. DTSBX420 -01839 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX420 -01840 S003-EXIT. DTSBX420 -01841 EXIT. DTSBX420 -01842 DTSBX420 -01843 S004-FROM-5. DTSBX420 -01844 SET L004-FROM-5 TO TRUE. DTSBX420 -01845 GO TO S004-YRQ. DTSBX420 -01846 DTSBX420 -01847 S004-FROM-DATE. DTSBX420 -01848 SET L004-FROM-DATE TO TRUE. DTSBX420 -01849 GO TO S004-YRQ. DTSBX420 -01850 DTSBX420 -01851 S004-FROM-ABS. DTSBX420 -01852 SET L004-FROM-ABS TO TRUE. DTSBX420 -01853 GO TO S004-YRQ. DTSBX420 -01854 DTSBX420 -01855 S004-YRQ. DTSBX420 -01856 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX420 +01834 P3100-BATCH-NO. DTSBX420 +01835 *& IF W-PSEUDO-ITEM-NO < 999 DTSBX420 +01836 * ADD 1 TO W-PSEUDO-ITEM-NO DTSBX420 +01837 * ELSE DTSBX420 +01838 * ADD 1 TO W-PSEUDO-BATCH-NO DTSBX420 +01839 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSBX420 +01840 * END-IF. DTSBX420 +01841 * DTSBX420 +01842 * MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSBX420 +01843 *& MOVE W-PSEUDO-ITEM-NO TO LX42-PSEUDO-ITEM-NO. DTSBX420 +01844 DTSBX420 +01845 P3100-EXIT. DTSBX420 +01846 EXIT. DTSBX420 +01847 DTSBX420 +01848 DTSBX420 +01849 T0000-TERMINATE. DTSBX420 +01850 PERFORM T1000-FINAL-CALLS THRU T1000-EXIT. DTSBX420 +01851 DTSBX420 +01852 *** PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSBX420 +01853 DTSBX420 +01854 DISPLAY ' '. DTSBX420 +01855 DTSBX420 +01856 DISPLAY '*** DTSBX420 TERMINATION STATISTICS ***'. DTSBX420 01857 DTSBX420 -01858 S004-EXIT. DTSBX420 -01859 EXIT. DTSBX420 -01860 DTSBX420 -01861 S005-FROM-SYS. DTSBX420 -01862 SET L005-FROM-SYS TO TRUE. DTSBX420 -01863 GO TO S005-ABSTIME. DTSBX420 -01864 DTSBX420 -01865 S005-ABSTIME. DTSBX420 -01866 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX420 -01867 S005-EXIT. DTSBX420 -01868 EXIT. DTSBX420 -01869 DTSBX420 -01870 S421-REGISTRATION. DTSBX420 -01871 DISPLAY 'S421-REG' DTSBX420 -01872 CALL 'DTSBX421' USING LX42-LINK-AREA. DTSBX420 -01873 S421-EXIT. DTSBX420 -01874 EXIT. DTSBX420 -01875 DTSBX420 -01876 S422-REPORT. DTSBX420 -01877 DISPLAY 'S422-REP' DTSBX420 -01878 CALL 'DTSBX422' USING LX42-LINK-AREA. DTSBX420 -01879 S422-EXIT. DTSBX420 -01880 EXIT. DTSBX420 -01881 DTSBX420 -01882 S423-PAYMENT. DTSBX420 -01883 DISPLAY 'S423-PAY' DTSBX420 -01884 CALL 'DTSBX423' USING LX42-LINK-AREA. DTSBX420 -01885 S423-EXIT. DTSBX420 +01858 DISPLAY '***************************************'. CL*30 +01859 DISPLAY '*** WEB/ESSP IMPORT DRIVER COUNTS ***'. CL*38 +01860 DISPLAY '*** ***'. CL*30 +01861 DISPLAY 'TOTAL INPUT RECORDS READ: ' W-WEB-IMP-CNT. CL*38 +01862 DISPLAY ' X102 RECORDS READ: ' W-102-IMP-CNT. CL*38 +01863 DISPLAY ' X104 RECORDS READ: ' W-104-IMP-CNT. CL*38 +01864 DISPLAY ' X106 RECORDS READ: ' W-106-IMP-CNT. CL*38 +01865 DISPLAY ' X108 RECORDS READ: ' W-108-IMP-CNT. CL*38 +01866 DISPLAY ' X110 RECORDS READ: ' W-110-IMP-CNT. CL*38 +01867 DISPLAY ' X120 RECORDS READ: ' W-120-IMP-CNT. CL*38 +01868 DISPLAY ' X140 RECORDS READ: ' W-140-IMP-CNT. CL*38 +01869 DISPLAY ' X144 RECORDS READ: ' W-144-IMP-CNT. CL*38 +01870 DISPLAY ' X145 RECORDS READ: ' W-145-IMP-CNT. CL*38 +01871 DISPLAY ' ' CL*38 +01872 DISPLAY '*** ***'. CL*30 +01873 DISPLAY '*********** END OF RUN ****************'. CL*38 +01874 DTSBX420 +01875 CLOSE WEB-IMP-FILE. DTSBX420 +01876 *** CURR-BATCH-NO. DTSBX420 +01877 *** TEMP-BTC-FILE. DTSBX420 +01878 DTSBX420 +01879 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX420 +01880 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX420 +01881 PERFORM S923-CLOSE THRU S923-EXIT. DTSBX420 +01882 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX420 +01883 * PERFORM S927C-CLOSE THRU S927C-EXIT. CL*44 +01884 DTSBX420 +01885 T0000-EXIT. DTSBX420 01886 EXIT. DTSBX420 01887 DTSBX420 -01888 S424-PROFILE. DTSBX420 -01889 DISPLAY 'S424-PRO' DTSBX420 -01890 ** DISPLAY 'LINK AREA ' LX42-LINK-AREA DTSBX420 -01891 CALL 'DTSBX424' USING LX42-LINK-AREA. DTSBX420 -01892 S424-EXIT. DTSBX420 -01893 EXIT. DTSBX420 +01888 T1000-FINAL-CALLS. DTSBX420 +01889 *& DTSBX420 +01890 DISPLAY 'BX420 T1000 ' LX42-DATA-AREA (1:20). CL**7 +01891 *& DTSBX420 +01892 SET LX42-TERMINATE-88 TO TRUE. DTSBX420 +01893 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSBX420 01894 DTSBX420 -01895 S426-HEADER. DTSBX420 -01896 CALL 'DTSBX426' USING LX42-LINK-AREA. DTSBX420 -01897 S426-EXIT. DTSBX420 -01898 EXIT. DTSBX420 -01899 DTSBX420 +01895 PERFORM S421-REGISTRATION THRU S421-EXIT. DTSBX420 +01896 ** PERFORM S426-HEADER THRU S426-EXIT. DTSBX420 +01897 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01898 ** PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +01899 PERFORM S424-PROFILE THRU S424-EXIT. DTSBX420 01900 DTSBX420 -01901 S910-OPEN-READ. DTSBX420 -01902 SET L910-OPEN-READ-88 TO TRUE. DTSBX420 -01903 GO TO S910-MSTR-IO. DTSBX420 -01904 DTSBX420 -01905 S910-OPEN-UPDATE. DTSBX420 -01906 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX420 -01907 GO TO S910-MSTR-IO. DTSBX420 -01908 DTSBX420 -01909 S910-READ. DTSBX420 -01910 SET L910-READ-88 TO TRUE. DTSBX420 -01911 GO TO S910-MSTR-IO. DTSBX420 -01912 DTSBX420 -01913 S910-START-BROWSE. DTSBX420 -01914 SET L910-START-BROWSE-88 TO TRUE. DTSBX420 -01915 GO TO S910-MSTR-IO. DTSBX420 -01916 DTSBX420 -01917 S910-READ-NEXT. DTSBX420 -01918 SET L910-READ-NEXT-88 TO TRUE. DTSBX420 -01919 GO TO S910-MSTR-IO. DTSBX420 +01901 T1000-EXIT. DTSBX420 +01902 EXIT. DTSBX420 +01903 DTSBX420 +01904 *T1100-UPDATE-CURR-BATCH. DTSBX420 +01905 * MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBX420 +01906 * W-END-BATCH. DTSBX420 +01907 * MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBX420 +01908 * DISPLAY 'REWRITING CURRENT BATCH ' DTSBX420 +01909 * W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBX420 +01910 * REWRITE CURR-BATCH-NO-REC. DTSBX420 +01911 * IF BATCH-STATUS-OK-88 DTSBX420 +01912 * NEXT SENTENCE DTSBX420 +01913 * ELSE DTSBX420 +01914 * DISPLAY 'T1100 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBX420 +01915 * BATCH-STATUS DTSBX420 +01916 * END-IF. DTSBX420 +01917 * DTSBX420 +01918 *T1100-EXIT. DTSBX420 +01919 * EXIT. DTSBX420 01920 DTSBX420 -01921 S910-CLOSE. DTSBX420 -01922 SET L910-CLOSE-88 TO TRUE. DTSBX420 -01923 GO TO S910-MSTR-IO. DTSBX420 +01921 S001-FROM-FED-8. DTSBX420 +01922 SET L001-FROM-FED-8 TO TRUE. DTSBX420 +01923 GO TO S001-DATE. DTSBX420 01924 DTSBX420 -01925 S910-MSTR-IO. DTSBX420 -01926 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX420 -01927 MSKL-REC. DTSBX420 -01928 S910-EXIT. DTSBX420 -01929 EXIT. DTSBX420 -01930 DTSBX420 -01931 S921-OPEN-READ. DTSBX420 -01932 SET L921-OPEN-READ-88 TO TRUE. DTSBX420 -01933 GO TO S921-AIX-IO. DTSBX420 -01934 DTSBX420 -01935 S921-READ. DTSBX420 -01936 SET L921-READ-88 TO TRUE. DTSBX420 -01937 GO TO S921-AIX-IO. DTSBX420 -01938 DTSBX420 -01939 S921-START-BROWSE. DTSBX420 -01940 SET L921-START-BROWSE-88 TO TRUE. DTSBX420 -01941 GO TO S921-AIX-IO. DTSBX420 -01942 DTSBX420 -01943 S921-READ-NEXT. DTSBX420 -01944 SET L921-READ-NEXT-88 TO TRUE. DTSBX420 -01945 GO TO S921-AIX-IO. DTSBX420 +01925 S001-FROM-CAL-8. DTSBX420 +01926 SET L001-FROM-CAL-8 TO TRUE. DTSBX420 +01927 GO TO S001-DATE. DTSBX420 +01928 DTSBX420 +01929 S001-FROM-ABS-DAY. DTSBX420 +01930 SET L001-FROM-ABS-DAY TO TRUE. DTSBX420 +01931 GO TO S001-DATE. DTSBX420 +01932 DTSBX420 +01933 S001-DATE. DTSBX420 +01934 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX420 +01935 S001-EXIT. DTSBX420 +01936 EXIT. DTSBX420 +01937 DTSBX420 +01938 S003-AGENCY-DAY. DTSBX420 +01939 SET L003-AGENCY-DAY TO TRUE. DTSBX420 +01940 GO TO S003-WORK-DAY. DTSBX420 +01941 DTSBX420 +01942 S003-WORK-DAY. DTSBX420 +01943 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX420 +01944 S003-EXIT. DTSBX420 +01945 EXIT. DTSBX420 01946 DTSBX420 -01947 S921-CLOSE. DTSBX420 -01948 SET L921-CLOSE-88 TO TRUE. DTSBX420 -01949 GO TO S921-AIX-IO. DTSBX420 +01947 S004-FROM-5. DTSBX420 +01948 SET L004-FROM-5 TO TRUE. DTSBX420 +01949 GO TO S004-YRQ. DTSBX420 01950 DTSBX420 -01951 S921-AIX-IO. DTSBX420 -01952 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX420 -01953 ISKL-REC. DTSBX420 -01954 S921-EXIT. DTSBX420 -01955 EXIT. DTSBX420 -01956 DTSBX420 -01957 S923-OPEN-UPDATE. DTSBX420 -01958 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX420 -01959 GO TO S923-ATC-CALL. DTSBX420 -01960 DTSBX420 -01961 S923-OPEN-READ. DTSBX420 -01962 SET L923-OPEN-READ-88 TO TRUE. DTSBX420 -01963 GO TO S923-ATC-CALL. DTSBX420 +01951 S004-FROM-DATE. DTSBX420 +01952 SET L004-FROM-DATE TO TRUE. DTSBX420 +01953 GO TO S004-YRQ. DTSBX420 +01954 DTSBX420 +01955 S004-FROM-ABS. DTSBX420 +01956 SET L004-FROM-ABS TO TRUE. DTSBX420 +01957 GO TO S004-YRQ. DTSBX420 +01958 DTSBX420 +01959 S004-YRQ. DTSBX420 +01960 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX420 +01961 DTSBX420 +01962 S004-EXIT. DTSBX420 +01963 EXIT. DTSBX420 01964 DTSBX420 -01965 S923-WRITE. DTSBX420 -01966 SET L923-WRITE-88 TO TRUE. DTSBX420 -01967 GO TO S923-ATC-CALL. DTSBX420 +01965 S005-FROM-SYS. DTSBX420 +01966 SET L005-FROM-SYS TO TRUE. DTSBX420 +01967 GO TO S005-ABSTIME. DTSBX420 01968 DTSBX420 -01969 S923-CLOSE. DTSBX420 -01970 SET L923-CLOSE-88 TO TRUE. DTSBX420 -01971 GO TO S923-ATC-CALL. DTSBX420 -01972 DTSBX420 -01973 S923-ATC-CALL. DTSBX420 -01974 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX420 -01975 ASKL-REC. DTSBX420 -01976 S923-EXIT. DTSBX420 -01977 EXIT. DTSBX420 -01978 DTSBX420 -01979 S927A-OPEN. DTSBX420 -01980 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX420 -01981 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX420 -01982 DTSBX420 -01983 S927A-EXIT. DTSBX420 +01969 S005-ABSTIME. DTSBX420 +01970 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX420 +01971 S005-EXIT. DTSBX420 +01972 EXIT. DTSBX420 +01973 DTSBX420 +01974 S421-REGISTRATION. DTSBX420 +01975 DISPLAY 'CALL S421-REGISTRATION'. CL**8 +01976 CALL 'DTSBX421' USING LX42-LINK-AREA. DTSBX420 +01977 S421-EXIT. DTSBX420 +01978 EXIT. DTSBX420 +01979 DTSBX420 +01980 S422-REPORT-PAYMT. CL*23 +01981 DISPLAY 'CALL S422-REPORTS- WAGES AND PAYMENTS'. CL*23 +01982 CALL 'DTSBX430' USING LX42-LINK-AREA. CL*23 +01983 S422-EXIT. DTSBX420 01984 EXIT. DTSBX420 01985 DTSBX420 -01986 S927C-CLOSE. DTSBX420 -01987 SET L927-CLOSE-88 TO TRUE. DTSBX420 -01988 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX420 -01989 DTSBX420 -01990 S927C-EXIT. DTSBX420 -01991 EXIT. DTSBX420 -01992 DTSBX420 -01993 S927Z-IO. DTSBX420 -01994 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX420 -01995 TSKL-REC. DTSBX420 -01996 S927Z-EXIT. DTSBX420 +01986 *S423-PAYMENT. CL*23 +01987 * DISPLAY 'CALL S423-PAYMENT'. CL*23 +01988 * CALL 'DTSBX423' USING LX42-LINK-AREA. CL*23 +01989 *S423-EXIT. CL*23 +01990 * EXIT. CL*23 +01991 DTSBX420 +01992 S424-PROFILE. DTSBX420 +01993 DISPLAY 'CALL S424-PROFILE' CL**8 +01994 ** DISPLAY 'LINK AREA ' LX42-LINK-AREA DTSBX420 +01995 CALL 'DTSBX424' USING LX42-LINK-AREA. DTSBX420 +01996 S424-EXIT. DTSBX420 01997 EXIT. DTSBX420 01998 DTSBX420 -01999 S931-OPEN-READ. DTSBX420 -02000 SET L931-OPEN-READ-88 TO TRUE. DTSBX420 -02001 GO TO S931-REF-IO. DTSBX420 -02002 DTSBX420 -02003 S931-CLOSE. DTSBX420 -02004 SET L931-CLOSE-88 TO TRUE. DTSBX420 -02005 GO TO S931-REF-IO. DTSBX420 -02006 DTSBX420 -02007 S931-REF-IO. DTSBX420 -02008 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX420 -02009 FSKL-REC. DTSBX420 -02010 S931-EXIT. DTSBX420 -02011 EXIT. DTSBX420 +01999 S426-HEADER. DTSBX420 +02000 CALL 'DTSBX426' USING LX42-LINK-AREA. DTSBX420 +02001 S426-EXIT. DTSBX420 +02002 EXIT. DTSBX420 +02003 DTSBX420 +02004 DTSBX420 +02005 S910-OPEN-READ. DTSBX420 +02006 SET L910-OPEN-READ-88 TO TRUE. DTSBX420 +02007 GO TO S910-MSTR-IO. DTSBX420 +02008 DTSBX420 +02009 S910-OPEN-UPDATE. DTSBX420 +02010 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX420 +02011 GO TO S910-MSTR-IO. DTSBX420 02012 DTSBX420 -02013 S1000-READ-WEB-IMP. DTSBX420 -02014 READ WEB-IMP-FILE. DTSBX420 -02015 IF WEB-IMP-STATUS-OK-88 DTSBX420 -02016 ADD +1 TO W-WEB-IMP-CNT DTSBX420 -02017 ELSE DTSBX420 -02018 IF WEB-IMP-STATUS-EOF-88 DTSBX420 -02019 NEXT SENTENCE DTSBX420 -02020 ELSE DTSBX420 -02021 DISPLAY 'CANNOT READ WEB-IMP-FILE ' WEB-IMP-STATUS DTSBX420 -02022 SET W-ERROR-YES-88 TO TRUE DTSBX420 -02023 END-IF DTSBX420 -02024 END-IF. DTSBX420 -02025 DTSBX420 -02026 ** IF WEB-IMP-EMP-NO = 464465 DTSBX420 -02027 * DISPLAY 'S1000-READ EMP-NO ' WEB-IMP-EMP-NO DTSBX420 -02028 ** GO TO S1000-READ-WEB-IMP. DTSBX420 -02029 DTSBX420 -02030 S1000-EXIT. DTSBX420 -02031 EXIT. DTSBX420 -02032 DTSBX420 -02033 S999-ABEND. DTSBX420 -02034 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX420 -02035 S999-EXIT. DTSBX420 -02036 EXIT. DTSBX420 -02037 DTSBX420 +02013 S910-READ. DTSBX420 +02014 SET L910-READ-88 TO TRUE. DTSBX420 +02015 GO TO S910-MSTR-IO. DTSBX420 +02016 DTSBX420 +02017 S910-START-BROWSE. DTSBX420 +02018 SET L910-START-BROWSE-88 TO TRUE. DTSBX420 +02019 GO TO S910-MSTR-IO. DTSBX420 +02020 DTSBX420 +02021 S910-READ-NEXT. DTSBX420 +02022 SET L910-READ-NEXT-88 TO TRUE. DTSBX420 +02023 GO TO S910-MSTR-IO. DTSBX420 +02024 DTSBX420 +02025 S910-CLOSE. DTSBX420 +02026 SET L910-CLOSE-88 TO TRUE. DTSBX420 +02027 GO TO S910-MSTR-IO. DTSBX420 +02028 DTSBX420 +02029 S910-MSTR-IO. DTSBX420 +02030 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX420 +02031 MSKL-REC. DTSBX420 +02032 S910-EXIT. DTSBX420 +02033 EXIT. DTSBX420 +02034 DTSBX420 +02035 S921-OPEN-READ. DTSBX420 +02036 SET L921-OPEN-READ-88 TO TRUE. DTSBX420 +02037 GO TO S921-AIX-IO. DTSBX420 +02038 DTSBX420 +02039 S921-READ. DTSBX420 +02040 SET L921-READ-88 TO TRUE. DTSBX420 +02041 GO TO S921-AIX-IO. DTSBX420 +02042 DTSBX420 +02043 S921-START-BROWSE. DTSBX420 +02044 SET L921-START-BROWSE-88 TO TRUE. DTSBX420 +02045 GO TO S921-AIX-IO. DTSBX420 +02046 DTSBX420 +02047 S921-READ-NEXT. DTSBX420 +02048 SET L921-READ-NEXT-88 TO TRUE. DTSBX420 +02049 GO TO S921-AIX-IO. DTSBX420 +02050 DTSBX420 +02051 S921-CLOSE. DTSBX420 +02052 SET L921-CLOSE-88 TO TRUE. DTSBX420 +02053 GO TO S921-AIX-IO. DTSBX420 +02054 DTSBX420 +02055 S921-AIX-IO. DTSBX420 +02056 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX420 +02057 ISKL-REC. DTSBX420 +02058 S921-EXIT. DTSBX420 +02059 EXIT. DTSBX420 +02060 DTSBX420 +02061 S923-OPEN-UPDATE. DTSBX420 +02062 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX420 +02063 GO TO S923-ATC-CALL. DTSBX420 +02064 DTSBX420 +02065 S923-OPEN-READ. DTSBX420 +02066 SET L923-OPEN-READ-88 TO TRUE. DTSBX420 +02067 GO TO S923-ATC-CALL. DTSBX420 +02068 DTSBX420 +02069 S923-WRITE. DTSBX420 +02070 SET L923-WRITE-88 TO TRUE. DTSBX420 +02071 GO TO S923-ATC-CALL. DTSBX420 +02072 DTSBX420 +02073 S923-CLOSE. DTSBX420 +02074 SET L923-CLOSE-88 TO TRUE. DTSBX420 +02075 GO TO S923-ATC-CALL. DTSBX420 +02076 DTSBX420 +02077 S923-ATC-CALL. DTSBX420 +02078 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX420 +02079 ASKL-REC. DTSBX420 +02080 S923-EXIT. DTSBX420 +02081 EXIT. DTSBX420 +02082 DTSBX420 +02083 S927A-OPEN. DTSBX420 +02084 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX420 +02085 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX420 +02086 DTSBX420 +02087 S927A-EXIT. DTSBX420 +02088 EXIT. DTSBX420 +02089 DTSBX420 +02090 S927C-CLOSE. DTSBX420 +02091 SET L927-CLOSE-88 TO TRUE. DTSBX420 +02092 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX420 +02093 DTSBX420 +02094 S927C-EXIT. DTSBX420 +02095 EXIT. DTSBX420 +02096 DTSBX420 +02097 S927Z-IO. DTSBX420 +02098 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX420 +02099 TSKL-REC. DTSBX420 +02100 S927Z-EXIT. DTSBX420 +02101 EXIT. DTSBX420 +02102 DTSBX420 +02103 S931-OPEN-READ. DTSBX420 +02104 SET L931-OPEN-READ-88 TO TRUE. DTSBX420 +02105 GO TO S931-REF-IO. DTSBX420 +02106 DTSBX420 +02107 S931-CLOSE. DTSBX420 +02108 SET L931-CLOSE-88 TO TRUE. DTSBX420 +02109 GO TO S931-REF-IO. DTSBX420 +02110 DTSBX420 +02111 S931-REF-IO. DTSBX420 +02112 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX420 +02113 FSKL-REC. DTSBX420 +02114 S931-EXIT. DTSBX420 +02115 EXIT. DTSBX420 +02116 DTSBX420 +02117 S1000-READ-WEB-IMP. DTSBX420 +02118 READ WEB-IMP-FILE. DTSBX420 +02119 IF WEB-IMP-STATUS-OK-88 DTSBX420 +02120 ADD +1 TO W-WEB-IMP-CNT DTSBX420 +02121 ELSE DTSBX420 +02122 IF WEB-IMP-STATUS-EOF-88 DTSBX420 +02123 DISPLAY 'ENE OF WEB-IMP-FILE ' WEB-IMP-STATUS CL**3 +02124 ELSE DTSBX420 +02125 DISPLAY 'CANNOT READ WEB-IMP-FILE ' WEB-IMP-STATUS DTSBX420 +02126 SET W-ERROR-YES-88 TO TRUE DTSBX420 +02127 END-IF DTSBX420 +02128 END-IF. DTSBX420 +02129 DTSBX420 +02130 * DISPLAY 'S1000-READ WEB ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*12 +02131 DTSBX420 +02132 S1000-EXIT. DTSBX420 +02133 EXIT. DTSBX420 +02134 DTSBX420 +02135 S999-ABEND. DTSBX420 +02136 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX420 +02137 S999-EXIT. DTSBX420 +02138 EXIT. DTSBX420 +02139 DTSBX420 diff --git a/Batch/DTSBX425.cob b/Batch/DTSBX425.cob new file mode 100644 index 0000000..92d3322 --- /dev/null +++ b/Batch/DTSBX425.cob @@ -0,0 +1,1032 @@ +00001 IDENTIFICATION DIVISION. 04/06/18 +00002 PROGRAM-ID. DTSBX425. DTSBX425 +00003 AUTHOR. NGC. LV042 +00004 DATE-WRITTEN. SEPT 2013. CL**2 +00005 DATE-COMPILED. DTSBX425 +00006 SKIP3 DTSBX425 +00007 ***** DTSBX425 +00008 * FUNCTION: READ A DAILY FILE FROM THE AUTOMATED CLEARING HOUSEDTSBX425 +00009 * THAT CONTAINS RECORDS FOR DISHONORED ELECTRONIC DTSBX425 +00010 * PAYMENTS. IT BUILDS DTSIT025 PAYMENT REVERSAL DTSBX425 +00011 * TRANSACTION RECORDS AND WRITES THESE RECORDS DTSBX425 +00012 * TO THE DAILY BTC FILE WHICH IS INPUT TO THE NIGHTLYDTSBX425 +00013 * ACCOUNTING UPDATE. DTSBX425 +00014 ** DTSBX425 +00015 ** DTSBX425 +00016 SKIP3 DTSBX425 +00017 ENVIRONMENT DIVISION. DTSBX425 +00018 CONFIGURATION SECTION. CL*12 +00019 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*12 +00020 CL*12 +00021 INPUT-OUTPUT SECTION. DTSBX425 +00022 DTSBX425 +00023 FILE-CONTROL. DTSBX425 +00024 DTSBX425 +00025 SELECT IN-FACH ASSIGN TO EFTFACH DTSBX425 +00026 FILE STATUS IS FACH-STATUS. DTSBX425 +00027 CL**5 +00028 SELECT ESSP-ACHD-FILE ASSIGN TO X425RPT1 CL**5 +00029 FILE STATUS IS REPT-STATUS. CL**5 +00030 CL**5 +00031 SELECT ESSP-ACHD-TOTAL ASSIGN TO X425TOTL CL*41 +00032 FILE STATUS IS REPT-STATUS. CL*41 +00033 CL*41 +00034 DTSBX425 +00035 DATA DIVISION. DTSBX425 +00036 DTSBX425 +00037 FILE SECTION. DTSBX425 +00038 DTSBX425 +00039 FD IN-FACH DTSBX425 +00040 LABEL RECORDS ARE STANDARD DTSBX425 +00041 RECORDING MODE IS F DTSBX425 +00042 BLOCK CONTAINS 0 RECORDS. DTSBX425 +00043 DTSBX425 +00044 01 IN-FACH-REC PIC X(94). DTSBX425 +00045 DTSBX425 +00046 FD ESSP-ACHD-TOTAL CL*41 +00047 LABEL RECORDS ARE STANDARD CL*41 +00048 RECORDING MODE IS F CL*41 +00049 BLOCK CONTAINS 0 RECORDS. CL*41 +00050 CL*41 +00051 01 ESSP-ACHD-TOT-REC PIC X(80). CL*41 +00052 CL*41 +00053 FD ESSP-ACHD-FILE CL**5 +00054 RECORDING MODE IS F CL**5 +00055 BLOCK CONTAINS 0 RECORDS CL**5 +00056 LABEL RECORDS ARE OMITTED. CL**5 +00057 CL**5 +00058 01 ESSP-ACHD-REC PIC X(133). CL**8 +00059 CL**5 +00060 DTSBX425 +00061 WORKING-STORAGE SECTION. DTSBX425 +000615 77 PAN-VALET PICTURE X(24) VALUE '042DTSBX425 04/06/18'. DTSBX425 +00062 77 PAN-VALET PICTURE X(24) VALUE '216DTSBX425 01/22/04'. CL**2 +00063 DTSBX425 +00064 01 WRK-AREA. DTSBX425 +00065 DTSBX425 +00066 05 WRK-F907-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX425 +00067 DTSBX425 +00068 05 FACH-STATUS PIC X(02). DTSBX425 +00069 88 FACH-STATUS-EOF-88 VALUE '10'. CL**7 +00070 88 FACH-STATUS-OK-88 VALUE '00'. CL**7 +00071 DTSBX425 +00072 05 REPT-STATUS PIC X(02). CL*10 +00073 88 REPT-STATUS-EOF-88 VALUE '10'. CL*10 +00074 88 REPT-STATUS-OK-88 VALUE '00'. CL*12 +00075 CL*10 +00076 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +50. DTSBX425 +00077 DTSBX425 +00078 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX425'. CL**2 +00079 DTSBX425 +00080 05 WRK-MPAY-REMIT-AMT PIC S9(09)V9(02) COMP-3. DTSBX425 +00081 DTSBX425 +00082 05 WRK-CURR-DATE PIC S9(15) COMP-3. DTSBX425 +00083 05 WRK-CURR-TIME PIC S9(09) COMP-3. DTSBX425 +00084 DTSBX425 +00085 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3. DTSBX425 +00086 05 WRK-FAC6-RECORDS PIC S9(07) COMP-3. DTSBX425 +00087 05 WRK-FAC7-RECORDS PIC S9(07) COMP-3. CL*10 +00088 05 WRK-OTHER-RECORDS PIC S9(07) COMP-3. DTSBX425 +00089 05 WRK-HEADER-RECORDS PIC S9(07) COMP-3. DTSBX425 +00090 05 WRK-TRAILER-RECORDS PIC S9(07) COMP-3. DTSBX425 +00091 05 WRK-T025-WRITE-CNT PIC S9(07) COMP-3. DTSBX425 +00092 05 WRK-R907-WRITE-CNT PIC S9(07) COMP-3. DTSBX425 +00093 05 WRK-F907-WRITE-CNT PIC S9(07) COMP-3. DTSBX425 +00094 05 WRK-FACH-READ-CNT PIC S9(07) COMP-3. DTSBX425 +00095 05 WRK-TRAILER-REC-CNT PIC S9(07) COMP-3. DTSBX425 +00096 05 WRK-FACH-SELECTED-CNT PIC S9(07) COMP-3. DTSBX425 +00097 05 WRK-FAC6-AMOUNT PIC S9(08)V99 COMP-3. DTSBX425 +00098 05 TOT-FAC6-AMOUNT PIC S9(10)V99 COMP-3. DTSBX425 +00099 05 TOT-TRAILER-AMT PIC S9(10)V99 COMP-3. DTSBX425 +00100 05 WS-LINE-CNT PIC 9(05) VALUE 60. CL*10 +00101 05 WS-PAGE-CNT PIC 9(05) VALUE 0. CL*10 +00102 CL*33 +00103 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*33 +00104 05 W-SLASH-DATE PIC X(10). CL*33 +00105 05 FILLER REDEFINES W-SLASH-DATE. CL*33 +00106 10 W-SLASH-DT-MM PIC X(02). CL*33 +00107 10 FILLER PIC X(01). CL*33 +00108 10 W-SLASH-DT-DD PIC X(02). CL*33 +00109 10 FILLER PIC X(01). CL*33 +00110 10 W-SLASH-DT-CCYY PIC X(04). CL*33 +00111 CL*33 +00112 DTSBX425 +00113 05 WRK-TEMP-TRACE-NO. DTSBX425 +00114 10 WRK-TEMP-TRACE-NOA PIC X(06) VALUE ZEROS. CL*21 +00115 10 WRK-TEMP-TRACE-NOB PIC X(09) VALUE ZEROS. CL*21 +00116 DTSBX425 +00117 05 WRK-NUMR-TRACE-NO PIC 9(13) VALUE ZEROS. CL*21 +00118 DTSBX425 +00119 05 WRK-FAC6-DOES-TRACE-NO PIC S9(13) COMP-3. CL**4 +00120 DTSBX425 +00121 05 WRK-MPRF-IND PIC X(01). DTSBX425 +00122 88 WRK-MPRF-OK VALUE 'Y'. DTSBX425 +00123 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX425 +00124 DTSBX425 +00125 05 WRK-MPAY-IND PIC X(01). DTSBX425 +00126 88 MPAY-FOUND-YES-88 VALUE 'Y'. DTSBX425 +00127 88 MPAY-FOUND-NO-88 VALUE 'N'. DTSBX425 +00128 DTSBX425 +00129 05 WRITE-T025-IND PIC X(01). DTSBX425 +00130 88 WRITE-T025-YES-88 VALUE 'Y'. DTSBX425 +00131 88 WRITE-T025-NO-88 VALUE 'N'. DTSBX425 +00132 DTSBX425 +00133 05 WRK-DTSBU005-IND PIC X(01). DTSBX425 +00134 88 WRK-DTSBU005-YES VALUE 'Y'. DTSBX425 +00135 88 WRK-DTSBU005-NO VALUE 'N'. DTSBX425 +00136 DTSBX425 +00137 05 WRK-FAC1-IND PIC X(01). DTSBX425 +00138 88 WRK-FAC1-FIRST-OK VALUE 'Y'. DTSBX425 +00139 88 WRK-FAC1-FIRST-NO VALUE 'N'. DTSBX425 +00140 DTSBX425 +00141 05 WRK-FACH-IND PIC X(01). DTSBX425 +00142 88 WRK-FACH-LAST-REC-88 VALUE 'Y'. DTSBX425 +00143 DTSBX425 +00144 05 WRK-TRACE-IND PIC X(01). DTSBX425 +00145 DTSBX425 +00146 01 MSG-TABLE. DTSBX425 +00147 DTSBX425 +00148 05 MSG1-NO-MPAY. DTSBX425 +00149 10 MSG1-ID. DTSBX425 +00150 15 MSG1-ID-A PIC X(08) VALUE 'DTSBX425'. CL**2 +00151 15 MSG1-ID-B PIC X(03) VALUE '907'. DTSBX425 +00152 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'FAC6 WITH NO MPRF'.DTSBX425 +00153 10 MSG1-LONG-TEXT. DTSBX425 +00154 15 FILLER PIC X(30) DTSBX425 +00155 VALUE 'FAC6 RECORD ENCOUNTERED WITH N'. DTSBX425 +00156 15 FILLER PIC X(30) DTSBX425 +00157 VALUE 'O CORRESPONDING MPAY RECORD '. DTSBX425 +00158 01 HEADER-1. CL**5 +00159 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00160 05 FILLER PIC X(49) VALUE '140R1'. CL**5 +00161 05 FILLER PIC X(54) VALUE CL*28 +00162 'DISTRICT OF COLUMBIA'. CL**5 +00163 05 FILLER PIC X(06) VALUE 'DATE:'. CL**5 +00164 05 HDR1-LRCM-SYS-DATE PIC X(10). CL**5 +00165 01 HEADER-2. CL**5 +00166 05 FILLER PIC X(54) VALUE SPACES. CL**5 +00167 05 FILLER PIC X(49) VALUE CL*28 +00168 'TAX DIVISION'. CL**5 +00169 05 FILLER PIC X(06) VALUE 'TIME:'. CL**5 +00170 05 HDR2-LRCM-SYS-TIME PIC X(08). CL**5 +00171 01 HEADER-3. CL**5 +00172 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00173 05 FILLER PIC X(38) VALUE CL**5 +00174 'ROUTE TO: TAX ACCOUNTING '. CL**6 +00175 05 HDR3-LITERAL PIC X(45) VALUE CL*27 +00176 ' DOES DAILY TRANSMITTED ACH DEBIT DEPOSITS'. CL*40 +00177 05 FILLER PIC X(20) VALUE SPACES. CL*27 +00178 05 FILLER PIC X(06) VALUE 'PAGE:'. CL**5 +00179 05 HEADER-3-PAGE PIC ZZ,ZZ9. CL*12 +00180 CL**5 +00181 01 HEADER-3A. CL**6 +00182 05 FILLER PIC X(01) VALUE SPACES. CL**6 +00183 05 FILLER PIC X(23) VALUE CL*30 +00184 'ACH DEBITS DATE/TIME: '. CL*30 +00185 05 FILLER PIC X(01) VALUE SPACES. CL*26 +00186 05 HEADER-3A-DATE PIC X(06) VALUE SPACES. CL*22 +00187 05 FILLER PIC X(01) VALUE '/'. CL*22 +00188 05 HEADER-3A-TIME PIC X(06) VALUE SPACES. CL*22 +00189 CL*22 +00190 01 HEADER-4. CL**5 +00191 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00192 05 FILLER PIC X(132) VALUE SPACES. CL**5 +00193 01 HEADER-5. CL**5 +00194 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00195 05 FILLER PIC X(25) VALUE CL*39 +00196 'EMP NO EMP NAME '. CL*39 +00197 05 FILLER PIC X(01) VALUE SPACES. CL*24 +00198 05 FILLER PIC X(45) VALUE CL*40 +00199 'BANK ID ACCT NO ACH AMOUNT'. CL*40 +00200 05 FILLER PIC X(04) VALUE SPACES. CL**5 +00201 05 FILLER PIC X(09) VALUE CL**5 +00202 'TRACE NO '. CL**5 +00203 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00204 05 HDR5-NAME PIC X(28) VALUE CL**5 +00205 ' MESSAGES '. CL*24 +00206 01 HEADER-6. CL**5 +00207 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00208 05 FILLER PIC X(132) VALUE SPACES. CL**5 +00209 CL**5 +00210 01 DETAIL-LINE-1. CL**5 +00211 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00212 15 X425-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL**6 +00213 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00214 15 X425-NAME-CHECK PIC X(15) VALUE SPACES. CL*38 +00215 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00216 15 X425-BANK-ID PIC X(10) VALUE SPACES. CL*38 +00217 15 FILLER PIC X(02) VALUE SPACES. CL*38 +00218 15 X425-ACCT-NUMBER PIC X(20) VALUE SPACES. CL*38 +00219 15 FILLER PIC X(02) VALUE SPACES. CL*22 +00220 15 X425-X145-REMIT PIC -------9.99. CL**7 +00221 15 FILLER PIC X(04) VALUE SPACES. CL*40 +00222 15 X425-X145-TRACE-NOB PIC X(08) VALUE SPACES. CL*10 +00223 15 FILLER PIC X(05) VALUE SPACES. CL**5 +00224 15 X425-MESSAGE PIC X(20). CL**7 +00225 CL**5 +00226 01 DETAIL-LINE-2. CL*30 +00227 15 FILLER PIC X(15) VALUE SPACES. CL*30 +00228 05 FILLER PIC X(56) VALUE CL*30 +00229 ' ********* NO ACH DEBIT DEPOSITS **********'. CL*36 +00230 CL*30 +00231 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL**5 +00232 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL**5 +00233 CL**5 +00234 01 FOOTING-LINE-3. CL**5 +00235 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00236 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL**5 +00237 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00238 05 FILLER PIC X(45) VALUE CL**5 +00239 ' TOTAL ACH DEBIT DEPOSITS TRANSMITTED'. CL*31 +00240 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00241 CL**5 +00242 01 FOOTING-LINE-4. CL**5 +00243 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00244 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL**5 +00245 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00246 05 FILLER PIC X(34) VALUE CL**5 +00247 ' # OF ACH PAYMENTS HAD ERRORS '. CL**5 +00248 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00249 01 FOOTING-LINE-5. CL**5 +00250 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00251 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL**5 +00252 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00253 05 FILLER PIC X(40) VALUE CL**5 +00254 ' # OF ACH PAYMTS WENT TO PENDING FILE '. CL**5 +00255 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00256 01 FOOTING-LINE-6. CL**5 +00257 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00258 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL**5 +00259 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00260 05 FILLER PIC X(45) VALUE CL**5 +00261 ' # OF ACH PAYMENTS WAITING FOR PROCESSING '. CL**5 +00262 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00263 01 FOOTING-LINE-7. CL**5 +00264 05 FILLER PIC X(19) VALUE SPACES. CL**5 +00265 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL**5 +00266 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00267 05 FILLER PIC X(45) VALUE CL**5 +00268 ' TOTAL AMOUNT OF ACH PAYMENTS '. CL**8 +00269 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00270 CL**5 +00271 01 FOOTING-LINE-8. CL**5 +00272 05 FILLER PIC X(19) VALUE SPACES. CL**5 +00273 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL**5 +00274 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00275 05 FILLER PIC X(45) VALUE CL**5 +00276 'TOTAL AMOUNT - ACH DEBITS DEPOSITED '. CL*31 +00277 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00278 01 FOOTING-LINE-13. CL**5 +00279 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00280 05 FILLER PIC X(67) VALUE CL**5 +00281 '*** END DOES/WELLS FARGO DAILY ACH TRANSMISSION ***'. CL*40 +00282 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL**5 +00283 CL**5 +00284 01 ESSP-ACHD-TOTALS. CL*41 +00285 05 TOT-ACH-DEPOSIT PIC 9(5) VALUE ZEROS. CL*41 +00286 05 TOT-AMT-DEPOSIT PIC 9(11)V99 VALUE ZEROS. CL*41 +00287 05 FILLER PIC X(62) VALUE SPACE. CL*41 +00288 CL*41 +00289 01 FACH-LINK-REC. DTSBX425 +00290 ++INCLUDE DTSIXACH CL**2 +00291 EJECT DTSBX425 +00292 01 FAC1-LINK-REC. DTSBX425 +00293 ++INCLUDE DTSIXAC1 CL**2 +00294 EJECT DTSBX425 +00295 01 FAC5-LINK-REC. CL**2 +00296 ++INCLUDE DTSIXAC5 CL**2 +00297 EJECT CL**2 +00298 01 FAC6-LINK-REC. DTSBX425 +00299 ++INCLUDE DTSIXAC6 CL**2 +00300 EJECT DTSBX425 +00301 01 FAC7-LINK-REC. CL**3 +00302 ++INCLUDE DTSIXAC7 CL**3 +00303 EJECT CL**3 +00304 01 FAC9-LINK-REC. DTSBX425 +00305 ++INCLUDE DTSIXAC9 CL**2 +00306 EJECT DTSBX425 +00307 01 MPAY-REC. DTSBX425 +00308 ++INCLUDE DTSIMPAY DTSBX425 +00309 EJECT DTSBX425 +00310 01 L005-LINK-AREA. DTSBX425 +00311 ++INCLUDE DTSIL005 DTSBX425 +00312 EJECT DTSBX425 +00313 01 RSK1-REC. DTSBX425 +00314 ++INCLUDE DTSIRSK1 DTSBX425 +00315 EJECT DTSBX425 +00316 01 ITRT-REC. DTSBX425 +00317 ++INCLUDE DTSIITRT DTSBX425 +00318 EJECT DTSBX425 +00319 01 ISKL-REC. DTSBX425 +00320 ++INCLUDE DTSIISKL DTSBX425 +00321 EJECT DTSBX425 +00322 01 R907-REC. DTSBX425 +00323 ++INCLUDE DTSIR907 DTSBX425 +00324 EJECT DTSBX425 +00325 01 EFT-BATCH-ERRORS-MESS. DTSBX425 +00326 ++INCLUDE EFTERMSG DTSBX425 +00327 EJECT DTSBX425 +00328 01 F907-REC. DTSBX425 +00329 ++INCLUDE EFTIF907 DTSBX425 +00330 EJECT DTSBX425 +00331 01 T025-REC. DTSBX425 +00332 ++INCLUDE DTSIT025 DTSBX425 +00333 EJECT DTSBX425 +00334 01 L910-LINK-AREA. DTSBX425 +00335 ++INCLUDE DTSIL910 DTSBX425 +00336 EJECT DTSBX425 +00337 01 L921-LINK-AREA. DTSBX425 +00338 ++INCLUDE DTSIL921 DTSBX425 +00339 EJECT DTSBX425 +00340 01 L927-LINK-AREA. DTSBX425 +00341 ++INCLUDE DTSIL927 DTSBX425 +00342 EJECT DTSBX425 +00343 01 MSKL-REC. DTSBX425 +00344 ++INCLUDE DTSIMSKL DTSBX425 +00345 EJECT DTSBX425 +00346 01 TSKL-REC. DTSBX425 +00347 ++INCLUDE DTSITSKL DTSBX425 +00348 EJECT DTSBX425 +00349 01 MPRF-REC. DTSBX425 +00350 ++INCLUDE DTSIMPRF DTSBX425 +00351 EJECT DTSBX425 +00352 01 MTAD-REC. DTSBX425 +00353 ++INCLUDE DTSIMTAD DTSBX425 +00354 DTSBX425 +00355 PROCEDURE DIVISION. DTSBX425 +00356 DTSBX425 +00357 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX425 +00358 CL*16 +00359 IF RETURN-CODE = +3 CL*32 +00360 PERFORM T0000-TERMINATE THRU T0000-EXIT CL*32 +00361 GOBACK. CL*32 +00362 DTSBX425 +00363 PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL DTSBX425 +00364 WRK-FACH-IND = 'Y'. DTSBX425 +00365 DTSBX425 +00366 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX425 +00367 DTSBX425 +00368 GOBACK. DTSBX425 +00369 DTSBX425 +00370 I0000-INITIATE. DTSBX425 +00371 DTSBX425 +00372 MOVE +0 TO WRK-FACH-READ-CNT DTSBX425 +00373 WRK-MPAY-REMIT-AMT DTSBX425 +00374 WRK-FACH-SELECTED-CNT DTSBX425 +00375 WRK-R907-WRITE-CNT DTSBX425 +00376 WRK-OTHER-RECORDS DTSBX425 +00377 WRK-FAC6-RECORDS DTSBX425 +00378 WRK-HEADER-RECORDS DTSBX425 +00379 WRK-TRAILER-RECORDS DTSBX425 +00380 WRK-F907-WRITE-CNT DTSBX425 +00381 WRK-T025-WRITE-CNT DTSBX425 +00382 WRK-TRAILER-REC-CNT DTSBX425 +00383 WRK-FAC6-AMOUNT DTSBX425 +00384 TOT-FAC6-AMOUNT DTSBX425 +00385 TOT-TRAILER-AMT DTSBX425 +00386 WRK-FAC6-DOES-TRACE-NO. CL**4 +00387 DTSBX425 +00388 MOVE ZEROS TO FAC1-LINK-REC DTSBX425 +00389 FAC6-LINK-REC DTSBX425 +00390 FAC9-LINK-REC. DTSBX425 +00391 DTSBX425 +00392 MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND. DTSBX425 +00393 DTSBX425 +00394 MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND. DTSBX425 +00395 DTSBX425 +00396 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX425 +00397 DTSBX425 +00398 I0000-EXIT. DTSBX425 +00399 EXIT. DTSBX425 +00400 I2000-OPEN-FILES. DTSBX425 +00401 DTSBX425 +00402 MOVE LENGTH OF T025-REC TO T025-LENGTH. DTSBX425 +00403 MOVE LENGTH OF F907-REC TO F907-LENGTH. DTSBX425 +00404 DTSBX425 +00405 MOVE WRK-TRACE-IND TO L910-TRACE-IND, L921-TRACE-IND. DTSBX425 +00406 DTSBX425 +00407 MOVE WRK-MOD-NAME TO L910-MOD-NAME, L921-MOD-NAME DTSBX425 +00408 DTSBX425 +00409 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX425 +00410 DTSBX425 +00411 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX425 +00412 DTSBX425 +00413 MOVE 'N' TO L927-TRACE-IND. DTSBX425 +00414 MOVE WRK-MOD-NAME TO L927-MOD-NAME. DTSBX425 +00415 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSBX425 +00416 CL*32 +00417 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*32 +00418 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*32 +00419 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*32 +00420 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*32 +00421 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*32 +00422 DTSBX425 +00423 OPEN INPUT IN-FACH. DTSBX425 +00424 DTSBX425 +00425 IF NOT FACH-STATUS-OK-88 CL*17 +00426 DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS CL*32 +00427 MOVE +3 TO RETURN-CODE CL*13 +00428 ELSE CL**6 +00429 IF FACH-STATUS-OK-88 DTSBX425 +00430 NEXT SENTENCE DTSBX425 +00431 ELSE DTSBX425 +00432 DISPLAY 'OPEN ERROR ON FACH INPUT FILE ** ' FACH-STATUS DTSBX425 +00433 PERFORM S999-ABEND THRU S999-EXIT CL*12 +00434 END-IF CL**6 +00435 END-IF. CL**6 +00436 CL**6 +00437 OPEN OUTPUT ESSP-ACHD-FILE. CL*35 +00438 IF REPT-STATUS-OK-88 CL*35 +00439 NEXT SENTENCE CL*35 +00440 ELSE CL*35 +00441 DISPLAY 'CANNOT OPEN REPORT ACHD FILE ' CL*35 +00442 REPT-STATUS CL*35 +00443 PERFORM S999-ABEND THRU S999-EXIT CL*35 +00444 END-IF. CL*35 +00445 CL*41 +00446 OPEN OUTPUT ESSP-ACHD-TOTAL. CL*41 +00447 IF REPT-STATUS-OK-88 CL*41 +00448 NEXT SENTENCE CL*41 +00449 ELSE CL*41 +00450 DISPLAY 'CANNOT OPEN TOTAL ACHD FILE ' CL*41 +00451 REPT-STATUS CL*41 +00452 PERFORM S999-ABEND THRU S999-EXIT CL*41 +00453 END-IF. CL*41 +00454 CL*35 +00455 READ IN-FACH INTO FACH-LINK-REC CL*18 +00456 AT END CL*18 +00457 MOVE +3 TO RETURN-CODE CL*18 +00458 DISPLAY 'NO ACH PAYMENTS TO TRANSMITT ' CL*18 +00459 MOVE 'Y' TO WRK-FACH-IND CL*18 +00460 GO TO I2000-EXIT. CL*18 +00461 CL*18 +00462 DTSBX425 +00463 I2000-EXIT. DTSBX425 +00464 EXIT. DTSBX425 +00465 DTSBX425 +00466 P0000-PROCESS. DTSBX425 +00467 DISPLAY ' 1000 - PROCESS'. DTSBX425 +00468 DTSBX425 +00469 * READ IN-FACH INTO FACH-LINK-REC CL*18 +00470 * AT END CL*18 +00471 * MOVE 'Y' TO WRK-FACH-IND CL*18 +00472 * GO TO P0000-EXIT. CL*18 +00473 DTSBX425 +00474 ADD +1 TO WRK-FACH-READ-CNT. DTSBX425 +00475 MOVE ZEROS TO FAC6-HEADER-REC. DTSBX425 +00476 DTSBX425 +00477 IF FACH-TYPE-HEADER-88 DTSBX425 +00478 MOVE FACH-LINK-REC TO FAC1-LINK-REC DTSBX425 +00479 ADD 1 TO WRK-HEADER-RECORDS DTSBX425 +00480 PERFORM P1005-HEADER-EDIT THRU P1005-EXIT DTSBX425 +00481 ELSE DTSBX425 +00482 IF FACH-TYPE-ENTRY-DETAIL-88 DTSBX425 +00483 MOVE FACH-LINK-REC TO FAC6-LINK-REC DTSBX425 +00484 ADD 1 TO WRK-FAC6-RECORDS DTSBX425 +00485 PERFORM P1010-FAC6-EDIT THRU P1010-EXIT DTSBX425 +00486 ELSE CL**5 +00487 IF FACH-TYPE-ADDENDA-88 CL*14 +00488 MOVE FACH-LINK-REC TO FAC7-LINK-REC CL**5 +00489 ADD 1 TO WRK-FAC7-RECORDS CL**5 +00490 PERFORM P1011-FAC7-EDIT THRU P1011-EXIT CL**5 +00491 ELSE CL**3 +00492 IF FACH-TYPE-TRAILER-88 DTSBX425 +00493 MOVE FACH-LINK-REC TO FAC9-LINK-REC DTSBX425 +00494 ADD 1 TO WRK-TRAILER-RECORDS DTSBX425 +00495 ADD 1 TO WRK-TRAILER-REC-CNT DTSBX425 +00496 PERFORM P1015-TRAILER-EDIT THRU P1015-EXIT DTSBX425 +00497 ELSE DTSBX425 +00498 ADD 1 TO WRK-OTHER-RECORDS. CL*18 +00499 CL*18 +00500 READ IN-FACH INTO FACH-LINK-REC CL*18 +00501 AT END CL*18 +00502 MOVE 'Y' TO WRK-FACH-IND CL*18 +00503 GO TO P0000-EXIT. CL*18 +00504 DTSBX425 +00505 P0000-EXIT. DTSBX425 +00506 EXIT. DTSBX425 +00507 DTSBX425 +00508 DTSBX425 +00509 P1005-HEADER-EDIT. DTSBX425 +00510 DTSBX425 +00511 DISPLAY ' 1005 - PROCESS'. DTSBX425 +00512 IF WRK-FACH-READ-CNT NOT = 1 DTSBX425 +00513 MOVE 'Y' TO WRK-FACH-IND DTSBX425 +00514 DISPLAY ' FIRST RECORD OF FILE IS NOT A HEADER RECORD' DTSBX425 +00515 PERFORM S999-ABEND THRU S999-EXIT. DTSBX425 +00516 DTSBX425 +00517 P1005-EXIT. DTSBX425 +00518 EXIT. DTSBX425 +00519 DTSBX425 +00520 P1010-FAC6-EDIT. DTSBX425 +00521 DTSBX425 +00522 SET WRITE-T025-NO-88 TO TRUE. DTSBX425 +00523 SET MPAY-FOUND-NO-88 TO TRUE. DTSBX425 +00524 DISPLAY ' 1010 - AMOUNT ' FAC6-AMOUNT DTSBX425 +00525 DISPLAY ' 1010 - TRACEIN ' FAC6-DOES-TRACE-NO CL**4 +00526 MOVE ZEROS TO WRK-TEMP-TRACE-NO DTSBX425 +00527 WRK-FAC6-DOES-TRACE-NO. CL*12 +00528 * WRK-DOES-TRACE-NO. CL*12 +00529 MOVE FAC6-AMOUNT TO WRK-FAC6-AMOUNT. DTSBX425 +00530 MOVE FAC6-DOES-TRACE-NO TO WRK-TEMP-TRACE-NO. CL*10 +00531 DTSBX425 +00532 * MOVE ZEROS TO WRK-TEMP-TRACE-NOA. CL*21 +00533 * MOVE WRK-DOES-TRACE-NOB TO WRK-TEMP-TRACE-NOB. CL*12 +00534 MOVE WRK-TEMP-TRACE-NOA TO WRK-FAC6-DOES-TRACE-NO. CL*21 +00535 DTSBX425 +00536 DISPLAY 'TRACE-NO -TEMP ' WRK-TEMP-TRACE-NO DTSBX425 +00537 DISPLAY 'TRACE-WRK-FAC6 ' WRK-FAC6-DOES-TRACE-NO CL**4 +00538 DTSBX425 +00539 IF FAC6-AMOUNT = ZEROS DTSBX425 +00540 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00541 DISPLAY ' ACH PAYMENT = ZEROS ' FAC6-AMOUNT CL**8 +00542 MOVE +2 TO RETURN-CODE. CL*37 +00543 * MOVE EFT027 TO F907-MSG-TEXT CL**8 +00544 * MOVE '027' TO F907-MSG-ID CL**8 +00545 * MOVE ZEROS TO F907-EMP-NO CL**8 +00546 * MOVE FAC6-AMOUNT TO F907-GOV1-REC CL**8 +00547 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00548 * GO TO P1010-EXIT. CL**8 +00549 DTSBX425 +00550 IF FAC6-AMOUNT NOT NUMERIC DTSBX425 +00551 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00552 DISPLAY ' ACH PAYMENT NOT NUMERIC ' FAC6-AMOUNT CL**8 +00553 MOVE +2 TO RETURN-CODE. CL*37 +00554 * MOVE EFT028 TO F907-MSG-TEXT CL**8 +00555 * MOVE '028' TO F907-MSG-ID CL**8 +00556 * MOVE ZEROS TO F907-EMP-NO CL**8 +00557 * MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC CL**8 +00558 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00559 * GO TO P1010-EXIT. CL**8 +00560 DTSBX425 +00561 ADD WRK-FAC6-AMOUNT TO TOT-FAC6-AMOUNT. DTSBX425 +00562 DTSBX425 +00563 IF WRK-TEMP-TRACE-NO NOT NUMERIC DTSBX425 +00564 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00565 DISPLAY 'TRACE-NO NOT NUMERIC ' WRK-TEMP-TRACE-NO CL**8 +00566 MOVE +2 TO RETURN-CODE. CL*37 +00567 * MOVE EFT013 TO F907-MSG-TEXT CL**8 +00568 * MOVE '013' TO F907-MSG-ID CL**8 +00569 * MOVE ZEROS TO F907-EMP-NO CL**8 +00570 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 +00571 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00572 * GO TO P1010-EXIT. CL**8 +00573 DTSBX425 +00574 IF WRK-TEMP-TRACE-NO = ZEROS DTSBX425 +00575 DISPLAY 'TRACE-NO = ZEROS ' WRK-TEMP-TRACE-NO CL**8 +00576 MOVE +2 TO RETURN-CODE. CL*37 +00577 * MOVE EFT014 TO F907-MSG-TEXT CL**8 +00578 * MOVE '014' TO F907-MSG-ID CL**8 +00579 * MOVE ZEROS TO F907-EMP-NO CL**8 +00580 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 +00581 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00582 * GO TO P1010-EXIT. CL**8 +00583 DTSBX425 +00584 DTSBX425 +00585 PERFORM P4000-PRNT-ACHD THRU P4000-EXIT. CL**7 +00586 CL**7 +00587 * PERFORM P1020-FIND-MPAY THRU P1020-EXIT. CL**8 +00588 DTSBX425 +00589 * IF MPAY-FOUND-YES-88 CL**8 +00590 * PERFORM P1040-BUILD-T025-RECORD THRU P1040-EXIT. CL**8 +00591 DTSBX425 +00592 * IF WRITE-T025-YES-88 CL**8 +00593 * PERFORM S927-WRITE THRU S927-EXIT CL**8 +00594 * ADD 1 TO WRK-T025-WRITE-CNT. CL**8 +00595 DTSBX425 +00596 P1010-EXIT. DTSBX425 +00597 EXIT. DTSBX425 +00598 DTSBX425 +00599 P1011-FAC7-EDIT. CL*10 +00600 CL*10 +00601 P1011-EXIT. CL*10 +00602 EXIT. CL*10 +00603 CL*10 +00604 P1015-TRAILER-EDIT. DTSBX425 +00605 DTSBX425 +00606 DISPLAY ' 1015 - PROCESS'. DTSBX425 +00607 IF WRK-TRAILER-REC-CNT > 1 DTSBX425 +00608 GO TO P1015-EXIT. DTSBX425 +00609 GO TO P1015-EXIT. CL*19 +00610 DTSBX425 +00611 * IF FAC9-BATCH-CNT = ZEROS DTSBX425 +00612 * MOVE EFT066 TO F907-MSG-TEXT DTSBX425 +00613 * MOVE '066' TO F907-MSG-ID DTSBX425 +00614 * MOVE ZEROS TO F907-EMP-NO DTSBX425 +00615 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX425 +00616 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX425 +00617 DTSBX425 +00618 DTSBX425 +00619 * IF FAC9-BATCH-CNT NOT NUMERIC DTSBX425 +00620 * MOVE EFT064 TO F907-MSG-TEXT DTSBX425 +00621 * MOVE '064' TO F907-MSG-ID DTSBX425 +00622 * MOVE ZEROS TO F907-EMP-NO DTSBX425 +00623 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX425 +00624 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX425 +00625 DTSBX425 +00626 * IF WRK-FACH-READ-CNT NOT = FAC9-BATCH-CNT DTSBX425 +00627 * MOVE EFT065 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX425 +00628 * MOVE '065' TO F907-MSG-ID, R907-MSG-ID DTSBX425 +00629 * MOVE ZEROS TO F907-EMP-NO DTSBX425 +00630 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX425 +00631 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX425 +00632 DTSBX425 +00633 MOVE FAC9-TOT-CREDIT-AMT TO TOT-TRAILER-AMT. DTSBX425 +00634 DTSBX425 +00635 IF TOT-FAC6-AMOUNT NOT = TOT-TRAILER-AMT DTSBX425 +00636 MOVE EFT067 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX425 +00637 MOVE '067' TO F907-MSG-ID, R907-MSG-ID DTSBX425 +00638 MOVE ZEROS TO F907-EMP-NO DTSBX425 +00639 MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX425 +00640 PERFORM P1055-WRITE-F907 THRU P1055-EXIT. CL*20 +00641 DTSBX425 +00642 P1015-EXIT. DTSBX425 +00643 EXIT. DTSBX425 +00644 P1020-FIND-MPAY. DTSBX425 +00645 DTSBX425 +00646 DISPLAY ' 1020 - PROCESS'. DTSBX425 +00647 SET MPAY-FOUND-NO-88 TO TRUE DTSBX425 +00648 MOVE LOW-VALUES TO ITRT-KEY-AREA. DTSBX425 +00649 SET ITRT-TRT-88 TO TRUE. DTSBX425 +00650 DTSBX425 +00651 MOVE WRK-NUMR-TRACE-NO TO ITRT-TRACE-NO. DTSBX425 +00652 DTSBX425 +00653 MOVE ZEROS TO ITRT-EMP-NO DTSBX425 +00654 ITRT-BATCH-NO DTSBX425 +00655 ITRT-ITEM-NO. DTSBX425 +00656 DTSBX425 +00657 MOVE ITRT-KEY-AREA TO ISKL-KEY-AREA. DTSBX425 +00658 DTSBX425 +00659 DISPLAY ' 1020 - PROCESS - ' WRK-NUMR-TRACE-NO. DTSBX425 +00660 DISPLAY ' 1020 - PROCESS - ' ITRT-KEY-AREA. DTSBX425 +00661 DTSBX425 +00662 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBX425 +00663 IF L921-NO-REC-88 DTSBX425 +00664 MOVE EFT001 TO F907-MSG-TEXT DTSBX425 +00665 MOVE '001' TO F907-MSG-ID DTSBX425 +00666 MOVE ZEROS TO F907-EMP-NO DTSBX425 +00667 MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE DTSBX425 +00668 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX425 +00669 GO TO P1020-EXIT DTSBX425 +00670 ELSE DTSBX425 +00671 MOVE ISKL-REC TO ITRT-REC. DTSBX425 +00672 DTSBX425 +00673 IF ITRT-TRACE-NO NOT = WRK-FAC6-DOES-TRACE-NO CL**4 +00674 DISPLAY ' 1TRT - NOT FOU - ' WRK-NUMR-TRACE-NO DTSBX425 +00675 DISPLAY ' 1TRT - PACK - ' WRK-FAC6-DOES-TRACE-NO CL**4 +00676 MOVE EFT001 TO F907-MSG-TEXT DTSBX425 +00677 MOVE '001' TO F907-MSG-ID DTSBX425 +00678 MOVE ZEROS TO F907-EMP-NO DTSBX425 +00679 MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE DTSBX425 +00680 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX425 +00681 GO TO P1020-EXIT. DTSBX425 +00682 DTSBX425 +00683 DISPLAY ' TRACE FOUND IN - ' WRK-NUMR-TRACE-NO DTSBX425 +00684 DISPLAY ' TRACE FOUND TRT- ' ITRT-TRACE-NO. DTSBX425 +00685 DTSBX425 +00686 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX425 +00687 MOVE ITRT-EMP-NO TO MPAY-EMP-NO. DTSBX425 +00688 MOVE ITRT-BATCH-NO TO MPAY-BATCH-NO. DTSBX425 +00689 MOVE ITRT-ITEM-NO TO MPAY-ITEM-NO. DTSBX425 +00690 SET MPAY-PAY-88 TO TRUE. DTSBX425 +00691 DTSBX425 +00692 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX425 +00693 DISPLAY ' MPAY KEY-' MPAY-KEY-AREA. DTSBX425 +00694 DISPLAY ' MPAY EMP-' MPAY-EMP-NO. DTSBX425 +00695 DISPLAY ' MPAY BAT-' MPAY-BATCH-NO. DTSBX425 +00696 DISPLAY ' MPAY ITM-' MPAY-ITEM-NO. DTSBX425 +00697 PERFORM S910-READ THRU S910-EXIT. DTSBX425 +00698 DTSBX425 +00699 IF L910-NO-REC-88 DTSBX425 +00700 DISPLAY ' MPAY - NOT FOU - ' WRK-NUMR-TRACE-NO DTSBX425 +00701 DISPLAY ' 1029 - PACK - ' WRK-FAC6-DOES-TRACE-NO CL**4 +00702 SET MPAY-FOUND-NO-88 TO TRUE DTSBX425 +00703 MOVE EFT001 TO F907-MSG-TEXT DTSBX425 +00704 MOVE ZEROS TO F907-EMP-NO DTSBX425 +00705 MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE DTSBX425 +00706 MOVE '001' TO F907-MSG-ID DTSBX425 +00707 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX425 +00708 ELSE DTSBX425 +00709 SET MPAY-FOUND-YES-88 TO TRUE DTSBX425 +00710 MOVE MSKL-REC TO MPAY-REC. DTSBX425 +00711 DTSBX425 +00712 P1020-EXIT. DTSBX425 +00713 EXIT. DTSBX425 +00714 DTSBX425 +00715 DTSBX425 +00716 P1040-BUILD-T025-RECORD. DTSBX425 +00717 DISPLAY ' 1040 - PROCESS'. DTSBX425 +00718 SET WRITE-T025-YES-88 TO TRUE. DTSBX425 +00719 DTSBX425 +00720 IF WRK-DTSBU005-YES DTSBX425 +00721 PERFORM S005-FROM-SYS THRU S005-EXIT DTSBX425 +00722 MOVE L005-DATE TO WRK-CURR-DATE DTSBX425 +00723 MOVE L005-TIME TO WRK-CURR-TIME DTSBX425 +00724 MOVE 'N' TO WRK-DTSBU005-IND. DTSBX425 +00725 DTSBX425 +00726 MOVE MPAY-EMP-NO TO T025-EMP-NO. DTSBX425 +00727 MOVE 'ACHNGCHK' TO T025-ORIGIN. DTSBX425 +00728 DTSBX425 +00729 MOVE WRK-CURR-DATE TO T025-SYS-DATE. DTSBX425 +00730 MOVE WRK-CURR-TIME TO T025-SYS-TIME. DTSBX425 +00731 DTSBX425 +00732 MOVE 'NG' TO T025-PAY-TYPE. DTSBX425 +00733 DTSBX425 +00734 MOVE MPAY-EMP-NO TO MPRF-EMP-NO. DTSBX425 +00735 PERFORM P1070-READ-MPRF THRU P1070-EXIT. DTSBX425 +00736 DTSBX425 +00737 IF L910-NO-REC-88 DTSBX425 +00738 SET WRITE-T025-NO-88 TO TRUE DTSBX425 +00739 DISPLAY '5350 NO MPRF FOUND HERE INSIDE P1040' DTSBX425 +00740 GO TO P1040-EXIT. DTSBX425 +00741 DTSBX425 +00742 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK. DTSBX425 +00743 DTSBX425 +00744 COMPUTE WRK-MPAY-REMIT-AMT = MPAY-REMIT-AMT * -1. DTSBX425 +00745 MOVE WRK-MPAY-REMIT-AMT TO T025-REMIT-AMT. DTSBX425 +00746 DTSBX425 +00747 MOVE MPAY-TRACE-NO TO T025-TRACE-NO. DTSBX425 +00748 MOVE WRK-CURR-DATE TO T025-RECEIVED-DATE DTSBX425 +00749 T025-DEPOSIT-DATE. DTSBX425 +00750 DTSBX425 +00751 MOVE ZERO TO T025-APPLIC-YRQ. DTSBX425 +00752 MOVE SPACES TO T025-APPLIC-IND. DTSBX425 +00753 MOVE MPAY-BATCH-NO TO T025-APPLIC-BATCH-NO. DTSBX425 +00754 MOVE MPAY-ITEM-NO TO T025-APPLIC-ITEM-NO. DTSBX425 +00755 MOVE SPACES TO T025-RESPONSIBLE-ACTIVITY. DTSBX425 +00756 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL**3 +00757 DTSBX425 +00758 MOVE T025-REC TO TSKL-REC. DTSBX425 +00759 DTSBX425 +00760 P1040-EXIT. DTSBX425 +00761 EXIT. DTSBX425 +00762 DTSBX425 +00763 P1055-WRITE-F907. DTSBX425 +00764 ************************************************************** DTSBX425 +00765 * WRITE FACH ERROR RETURN FILE(F907) * DTSBX425 +00766 ************************************************************** DTSBX425 +00767 DTSBX425 +00768 DISPLAY ' 1055 - PROCESS'. DTSBX425 +00769 ADD +1 TO WRK-F907-WRITE-CNT. DTSBX425 +00770 MOVE WRK-MOD-NAME TO F907-MODULE-NAME. DTSBX425 +00771 MOVE IN-FACH-REC TO F907-GOV1-REC. DTSBX425 +00772 MOVE ZEROS TO F907-EMP-NO. DTSBX425 +00773 DTSBX425 +00774 CALL 'DTSBU946' USING F907-REC. DTSBX425 +00775 DTSBX425 +00776 DTSBX425 +00777 P1055-EXIT. DTSBX425 +00778 EXIT. DTSBX425 +00779 P4000-PRNT-ACHD. CL**7 +00780 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL**7 +00781 MOVE FAC6-DUTAS-EMP-NO TO X425-EMP-NO CL**7 +00782 MOVE FAC6-DUTAS-EMP-NAME TO X425-NAME-CHECK. CL*22 +00783 MOVE FAC6-BANK-ACCT-NO TO X425-ACCT-NUMBER CL*22 +00784 MOVE FAC6-RECV-BANK-ID TO X425-BANK-ID. CL*38 +00785 MOVE WRK-FAC6-AMOUNT TO X425-X145-REMIT CL*22 +00786 MOVE WRK-TEMP-TRACE-NOA TO X425-X145-TRACE-NOB. CL*21 +00787 MOVE SPACES TO X425-MESSAGE. CL*24 +00788 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL**7 +00789 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1. CL*12 +00790 ADD 1 TO WS-LINE-CNT. CL**7 +00791 P4000-EXIT. CL**7 +00792 EXIT. CL**7 +00793 P4100-PRINT-HEADER. CL**6 +00794 IF WS-LINE-CNT GREATER 58 CL**6 +00795 MOVE +0 TO WS-LINE-CNT CL**6 +00796 ADD +1 TO WS-PAGE-CNT CL**6 +00797 MOVE WS-PAGE-CNT TO HEADER-3-PAGE CL*10 +00798 * MOVE ' -/+ ----- MONTHLY COUNT' TO HEADER-5-NAME CL*10 +00799 MOVE FAC1-FILE-CREATE-DATE TO HEADER-3A-DATE CL*10 +00800 MOVE FAC1-FILE-CREATE-TIME TO HEADER-3A-TIME CL*10 +00801 WRITE ESSP-ACHD-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*10 +00802 WRITE ESSP-ACHD-REC FROM HEADER-2 AFTER 1 CL*10 +00803 WRITE ESSP-ACHD-REC FROM HEADER-3 AFTER 1 CL*10 +00804 WRITE ESSP-ACHD-REC FROM HEADER-3A AFTER 1 CL*10 +00805 WRITE ESSP-ACHD-REC FROM HEADER-4 AFTER 1 CL*10 +00806 WRITE ESSP-ACHD-REC FROM HEADER-5 AFTER 1 CL*10 +00807 WRITE ESSP-ACHD-REC FROM HEADER-6 AFTER 1 CL*10 +00808 ADD +6 TO WS-LINE-CNT. CL**6 +00809 P4100-EXIT. CL**6 +00810 EXIT. CL**6 +00811 CL**6 +00812 T0000-TERMINATE. DTSBX425 +00813 DTSBX425 +00814 IF NOT FACH-TYPE-TRAILER-88 DTSBX425 +00815 DISPLAY ' LAST RECORD IS NOT A TRAILER RECORD ' DTSBX425 +00816 DISPLAY ' ' DTSBX425 +00817 DISPLAY ' LAST RECORD ' FACH-SKELETAL-REC DTSBX425 +00818 DISPLAY ' **** ACH FILE EMPTY *****'. CL*34 +00819 DTSBX425 +00820 IF WRK-FACH-READ-CNT = 2 DTSBX425 +00821 MOVE +3 TO RETURN-CODE CL*32 +00822 DISPLAY ' *** WELLS FARGO FILE CONTAINS 2 RECS ' CL**3 +00823 DISPLAY ' *** NO REJECTED PAYMENT RECORDS *'. DTSBX425 +00824 DTSBX425 +00825 DTSBX425 +00826 * MOVE -1 TO F907-LENGTH. CL**8 +00827 * CALL 'DTSBU946' USING F907-REC. CL**8 +00828 DTSBX425 +00829 DTSBX425 +00830 DTSBX425 +00831 DISPLAY ' '. DTSBX425 +00832 DTSBX425 +00833 DISPLAY '*** DTSBX425 TERMINATION STATISTICS ***'. CL**2 +00834 DTSBX425 +00835 DISPLAY ' '. DTSBX425 +00836 DTSBX425 +00837 DISPLAY 'NUMBER OF FACH RECORDS READ : ' DTSBX425 +00838 WRK-FACH-READ-CNT. DTSBX425 +00839 DTSBX425 +00840 DISPLAY 'NUMBER IN TRAILER BATCH COUNT : ' DTSBX425 +00841 FAC9-BATCH-CNT. DTSBX425 +00842 DTSBX425 +00843 DISPLAY 'HEADERS IN FACH FILE : ' DTSBX425 +00844 WRK-HEADER-RECORDS. DTSBX425 +00845 DTSBX425 +00846 DISPLAY 'TRAILERS IN FACH FILE : ' DTSBX425 +00847 WRK-TRAILER-RECORDS. DTSBX425 +00848 DTSBX425 +00849 DISPLAY 'DETAIL RECORDS IN FACH FILE : ' DTSBX425 +00850 WRK-FAC6-RECORDS. DTSBX425 +00851 DTSBX425 +00852 DISPLAY 'NUMBER OF OTHER RECORDS IN FACH FILE: ' DTSBX425 +00853 WRK-OTHER-RECORDS. DTSBX425 +00854 DTSBX425 +00855 DISPLAY 'NUMBER OF T025 RECORDS WRITTEN : ' DTSBX425 +00856 WRK-T025-WRITE-CNT. DTSBX425 +00857 DTSBX425 +00858 DISPLAY 'NUMBER OF F907 RECORDS WRITTEN : ' DTSBX425 +00859 WRK-F907-WRITE-CNT. DTSBX425 +00860 * IF WRK-F907-WRITE-CNT > 0 CL*24 +00861 * MOVE +3 TO RETURN-CODE CL*24 +00862 * DISPLAY ' FACH INPUT FILE CONTAINS ERRORS+++' CL*24 +00863 * DISPLAY ' PROGRAM WILL ABEND ***************'. CL*24 +00864 * PERFORM S999-ABEND THRU S999-EXIT. DTSBX425 +00865 DTSBX425 +00866 IF WS-LINE-CNT > 52 OR RETURN-CODE = +3 CL*32 +00867 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*24 +00868 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1 CL*32 +00869 WRITE ESSP-ACHD-REC FROM DETAIL-LINE-2 AFTER 3 CL*36 +00870 END-IF. CL*24 +00871 CL*24 +00872 MOVE WRK-FAC6-RECORDS TO WS-FOOTING-CNT. CL*24 +00873 MOVE TOT-FAC6-AMOUNT TO WS-TOTAL-REMIT. CL*24 +00874 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-1 AFTER 1. CL*25 +00875 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-2 AFTER 1. CL*25 +00876 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-3 AFTER 1. CL*25 +00877 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-4 AFTER 1. CL*25 +00878 * WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL*25 +00879 * WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL*24 +00880 * WRITE ESSP-ACHD-REC FROM FOOTING-LINE-7 AFTER 1. CL*25 +00881 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-8 AFTER 1. CL*25 +00882 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-13 AFTER 3. CL*25 +00883 WRITE ESSP-ACHD-REC FROM FOOTING-LINE-14 AFTER 1. CL*25 +00884 CL*24 +00885 DISPLAY ' '. CL*24 +00886 MOVE WRK-FAC6-RECORDS TO TOT-ACH-DEPOSIT. CL*41 +00887 MOVE TOT-FAC6-AMOUNT TO TOT-AMT-DEPOSIT. CL*41 +00888 DTSBX425 +00889 WRITE ESSP-ACHD-TOT-REC FROM ESSP-ACHD-TOTALS. CL*42 +00890 CL*29 +00891 CLOSE IN-FACH ESSP-ACHD-FILE ESSP-ACHD-TOTAL. CL*41 +00892 PERFORM S910-CLOSE THRU S910-EXIT. CL*29 +00893 PERFORM S927-CLOSE THRU S927-EXIT. CL*29 +00894 CL*29 +00895 CL*29 +00896 DTSBX425 +00897 T0000-EXIT. DTSBX425 +00898 EXIT. DTSBX425 +00899 DTSBX425 +00900 P1070-READ-MPRF. DTSBX425 +00901 DTSBX425 +00902 DTSBX425 +00903 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX425 +00904 SET MPRF-PRF-88 TO TRUE. DTSBX425 +00905 MOVE MPAY-EMP-NO TO MPRF-EMP-NO. DTSBX425 +00906 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX425 +00907 DTSBX425 +00908 PERFORM S910-READ THRU S910-EXIT. DTSBX425 +00909 DTSBX425 +00910 IF L910-OK-88 DTSBX425 +00911 SET L910-OK-88 TO TRUE DTSBX425 +00912 MOVE MSKL-REC TO MPRF-REC DTSBX425 +00913 ELSE DTSBX425 +00914 DISPLAY 'NO MPRF-REC FOUND ' L910-RESULT-IND DTSBX425 +00915 SET L910-NO-REC-88 TO TRUE DTSBX425 +00916 DISPLAY '6090 L910 NO RECORD FOUND ' DTSBX425 +00917 PERFORM P1055-WRITE-F907 THRU P1055-EXIT DTSBX425 +00918 GO TO P1070-EXIT. DTSBX425 +00919 DTSBX425 +00920 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK. DTSBX425 +00921 DTSBX425 +00922 P1070-EXIT. DTSBX425 +00923 EXIT. DTSBX425 +00924 DTSBX425 +00925 DTSBX425 +00926 S005-FROM-SYS. DTSBX425 +00927 DTSBX425 +00928 SET L005-FROM-SYS TO TRUE. DTSBX425 +00929 GO TO S005-ABSTIME. DTSBX425 +00930 DTSBX425 +00931 S005-ABSTIME. DTSBX425 +00932 DTSBX425 +00933 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX425 +00934 DTSBX425 +00935 S005-EXIT. DTSBX425 +00936 EXIT. DTSBX425 +00937 DTSBX425 +00938 DTSBX425 +00939 S910-OPEN-UPDATE-NO-AIX. DTSBX425 +00940 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX425 +00941 GO TO S910-MSTR-IO. DTSBX425 +00942 DTSBX425 +00943 EJECT DTSBX425 +00944 S910-OPEN-READ. DTSBX425 +00945 SET L910-OPEN-READ-88 TO TRUE. DTSBX425 +00946 GO TO S910-MSTR-IO. DTSBX425 +00947 DTSBX425 +00948 S910-READ. DTSBX425 +00949 SET L910-READ-88 TO TRUE. DTSBX425 +00950 GO TO S910-MSTR-IO. DTSBX425 +00951 DTSBX425 +00952 S910-DELETE. DTSBX425 +00953 SET L910-DELETE-88 TO TRUE. DTSBX425 +00954 GO TO S910-MSTR-IO. DTSBX425 +00955 DTSBX425 +00956 S910-WRITE. DTSBX425 +00957 SET L910-WRITE-88 TO TRUE. DTSBX425 +00958 GO TO S910-MSTR-IO. DTSBX425 +00959 DTSBX425 +00960 S910-START-BROWSE. DTSBX425 +00961 SET L910-START-BROWSE-88 TO TRUE. DTSBX425 +00962 GO TO S910-MSTR-IO. DTSBX425 +00963 DTSBX425 +00964 S910-READ-NEXT. DTSBX425 +00965 SET L910-READ-NEXT-88 TO TRUE. DTSBX425 +00966 GO TO S910-MSTR-IO. DTSBX425 +00967 DTSBX425 +00968 S910-REWRITE. DTSBX425 +00969 SET L910-REWRITE-88 TO TRUE. DTSBX425 +00970 GO TO S910-MSTR-IO. DTSBX425 +00971 DTSBX425 +00972 S910-CLOSE. DTSBX425 +00973 SET L910-CLOSE-88 TO TRUE. DTSBX425 +00974 GO TO S910-MSTR-IO. DTSBX425 +00975 DTSBX425 +00976 S910-MSTR-IO. DTSBX425 +00977 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX425 +00978 MSKL-REC. DTSBX425 +00979 S910-EXIT. DTSBX425 +00980 EXIT. DTSBX425 +00981 DTSBX425 +00982 SKIP3 DTSBX425 +00983 S921-OPEN-READ. DTSBX425 +00984 SET L921-OPEN-READ-88 TO TRUE. DTSBX425 +00985 GO TO S921-AIX-IO. DTSBX425 +00986 DTSBX425 +00987 S921-READ. DTSBX425 +00988 SET L921-READ-88 TO TRUE. DTSBX425 +00989 GO TO S921-AIX-IO. DTSBX425 +00990 DTSBX425 +00991 S921-START-BROWSE. DTSBX425 +00992 SET L921-START-BROWSE-88 TO TRUE. DTSBX425 +00993 GO TO S921-AIX-IO. DTSBX425 +00994 DTSBX425 +00995 S921-READ-NEXT. DTSBX425 +00996 SET L921-READ-NEXT-88 TO TRUE. DTSBX425 +00997 GO TO S921-AIX-IO. DTSBX425 +00998 DTSBX425 +00999 S921-CLOSE. DTSBX425 +01000 SET L921-CLOSE-88 TO TRUE. DTSBX425 +01001 GO TO S921-AIX-IO. DTSBX425 +01002 DTSBX425 +01003 S921-AIX-IO. DTSBX425 +01004 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX425 +01005 ISKL-REC. DTSBX425 +01006 S921-EXIT. DTSBX425 +01007 EXIT. DTSBX425 +01008 DTSBX425 +01009 S927-OPEN-UPDATE. DTSBX425 +01010 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX425 +01011 GO TO S927-BTC-O. DTSBX425 +01012 DTSBX425 +01013 S927-WRITE. DTSBX425 +01014 SET L927-WRITE-88 TO TRUE. DTSBX425 +01015 GO TO S927-BTC-O. DTSBX425 +01016 DTSBX425 +01017 S927-CLOSE. DTSBX425 +01018 SET L927-CLOSE-88 TO TRUE. DTSBX425 +01019 GO TO S927-BTC-O. DTSBX425 +01020 DTSBX425 +01021 S927-BTC-O. DTSBX425 +01022 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX425 +01023 TSKL-REC. DTSBX425 +01024 S927-EXIT. DTSBX425 +01025 EXIT. DTSBX425 +01026 DTSBX425 +01027 EJECT DTSBX425 +01028 S999-ABEND. DTSBX425 +01029 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX425 +01030 S999-EXIT. DTSBX425 +01031 EXIT. DTSBX425 diff --git a/Batch/DTSBX426.cob b/Batch/DTSBX426.cob index 4eee0f8..b2ab938 100644 --- a/Batch/DTSBX426.cob +++ b/Batch/DTSBX426.cob @@ -1,557 +1,1610 @@ -00001 IDENTIFICATION DIVISION. 09/21/10 +00001 IDENTIFICATION DIVISION. 04/20/20 00002 PROGRAM-ID. DTSBX426. DTSBX426 -00003 AUTHOR. NGC. LV001 -00004 DATE-WRITTEN. JUNE 2010. DTSBX426 +00003 AUTHOR. NGC. LV159 +00004 DATE-WRITTEN. SEPT 2013. CL**2 00005 DATE-COMPILED. DTSBX426 00006 SKIP3 DTSBX426 00007 ***** DTSBX426 -00008 * DTSBX426 -00009 * FUNCTION: EDIT BATCH HEADER FROM WEB APPLICATION. DTSBX426 -00010 * DTSBX426 -00011 * MODIFICATION HISTORY: DTSBX426 -00012 * DTSBX426 -00013 * 06-16-2010 INITIAL DEVELOPMENT DTSBX426 -00014 * REFERENCE RFP: IN-HOUSE CASHIERING DTSBX426 -00015 * DTSBX426 -00016 * DTSBX426 -00017 * DTSBX426 -00018 ***** DTSBX426 -00019 SKIP3 DTSBX426 -00020 ENVIRONMENT DIVISION. DTSBX426 -00021 SKIP2 DTSBX426 -00022 DATA DIVISION. DTSBX426 -00023 WORKING-STORAGE SECTION. DTSBX426 -000235 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX426 09/21/10'. DTSBX426 -00024 SKIP3 DTSBX426 -00025 01 WRK-AREA. DTSBX426 -00026 05 W-ABEND-CD PIC S9(04) COMP VALUE 426. DTSBX426 -00027 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX426'.DTSBX426 -00028 DTSBX426 -00029 DTSBX426 -00030 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX426 -00031 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX426 -00032 88 W-ERROR-NO-88 VALUE 'N'. DTSBX426 -00033 DTSBX426 -00034 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX426 -00035 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX426 -00036 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX426 -00037 DTSBX426 -00038 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX426 -00039 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSBX426 -00040 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBX426 -00041 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX426 -00042 DTSBX426 -00043 05 W-TRAN-CNT PIC S9(03) COMP-3. DTSBX426 -00044 05 W-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX426 -00045 DTSBX426 -00046 05 W-SLASH-DATE PIC X(10). DTSBX426 -00047 05 FILLER REDEFINES W-SLASH-DATE. DTSBX426 -00048 10 W-SLASH-DT-MM PIC X(02). DTSBX426 -00049 10 FILLER PIC X(01). DTSBX426 -00050 10 W-SLASH-DT-DD PIC X(02). DTSBX426 -00051 10 FILLER PIC X(01). DTSBX426 -00052 10 W-SLASH-DT-CCYY PIC X(04). DTSBX426 -00053 DTSBX426 -00054 05 W-SLASH-QTR PIC X(06). DTSBX426 -00055 05 FILLER REDEFINES W-SLASH-QTR. DTSBX426 -00056 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX426 -00057 10 FILLER PIC X(01). DTSBX426 -00058 10 W-SLASH-QTR-Q PIC X(01). DTSBX426 -00059 DTSBX426 -00060 * BATCH HEADER DTSBX426 -00061 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX426 -00062 DTSBX426 -00063 05 W-AMT-DISP1 PIC ----------9.99. DTSBX426 -00064 05 W-AMT-DISP2 PIC ----------9.99. DTSBX426 -00065 DTSBX426 -00066 01 MESSAGE-AREA. DTSBX426 -00067 *** FATAL ERRORS MSG-A DTSBX426 -00068 05 MSG-A1. DTSBX426 -00069 10 FILLER PIC X(32) DTSBX426 -00070 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX426 -00071 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX426 -00072 DTSBX426 -00073 * ACCOUNTING BATCH HEADER DTSBX426 -00074 01 X149-REC. DTSBX426 -00075 ++INCLUDE DTSIX149 DTSBX426 -00076 DTSBX426 -00077 * ERRORS DTSBX426 -00078 *01 X907-REC. DTSBX426 -00079 ***INCLUDE DTSIX907 DTSBX426 -00080 DTSBX426 -00081 01 L001-LINK-AREA. DTSBX426 -00082 ++INCLUDE DTSIL001 DTSBX426 -00083 DTSBX426 -00084 01 L003-LINK-AREA. DTSBX426 -00085 ++INCLUDE DTSIL003 DTSBX426 -00086 DTSBX426 -00087 01 L004-LINK-AREA. DTSBX426 -00088 ++INCLUDE DTSIL004 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 +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 +00054 DTSBX426 +00055 DATA DIVISION. 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 +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 +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 +00086 CL*83 +00087 01 ESSP-ACHR-REC PIC X(133). CL*83 +00088 CL*83 00089 DTSBX426 -00090 01 L910-LINK-AREA. DTSBX426 -00091 ++INCLUDE DTSIL910 DTSBX426 -00092 01 MSKL-REC. DTSBX426 -00093 ++INCLUDE DTSIMSKL DTSBX426 -00094 DTSBX426 -00095 01 MHDR-REC. DTSBX426 -00096 ++INCLUDE DTSIMHDR DTSBX426 -00097 DTSBX426 -00098 01 L923-LINK-AREA. DTSBX426 -00099 ++INCLUDE DTSIL923 DTSBX426 -00100 EJECT DTSBX426 -00101 01 ASKL-REC. DTSBX426 -00102 ++INCLUDE DTSIASKL DTSBX426 -00103 EJECT DTSBX426 -00104 01 AHDR-REC. DTSBX426 -00105 ++INCLUDE DTSIAHDR DTSBX426 -00106 EJECT DTSBX426 -00107 01 ARPT-REC. DTSBX426 -00108 ++INCLUDE DTSIARPT DTSBX426 -00109 EJECT DTSBX426 -00110 01 APAY-REC. DTSBX426 -00111 ++INCLUDE DTSIAPAY DTSBX426 -00112 DTSBX426 -00113 01 L931-LINK-AREA. DTSBX426 -00114 ++INCLUDE DTSIL931 DTSBX426 -00115 DTSBX426 -00116 01 FSKL-REC. DTSBX426 -00117 ++INCLUDE DTSIFSKL DTSBX426 -00118 DTSBX426 -00119 01 R140-REC. DTSBX426 -00120 ++INCLUDE DTSIR140 DTSBX426 -00121 DTSBX426 -00122 LINKAGE DTSBX426 -00123 SECTION. DTSBX426 -00124 DTSBX426 -00125 01 LX42-LINK-AREA. DTSBX426 -00126 ++INCLUDE DTSILX42 DTSBX426 -00127 DTSBX426 -00128 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX426 -00129 DTSBX426 -00130 DTSBX426-MAIN. DTSBX426 -00131 EVALUATE TRUE DTSBX426 -00132 WHEN LX42-INITIALIZE-88 DTSBX426 -00133 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX426 -00134 DTSBX426 -00135 WHEN LX42-NEW-BATCH-88 DTSBX426 -00136 PERFORM P2000-NEW-BATCH THRU P2000-EXIT DTSBX426 -00137 DTSBX426 -00138 WHEN LX42-PROCESS-88 DTSBX426 -00139 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX426 -00140 DTSBX426 -00141 WHEN LX42-TERMINATE-88 DTSBX426 -00142 PERFORM P2000-NEW-BATCH THRU P2000-EXIT DTSBX426 -00143 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX426 -00144 DTSBX426 -00145 END-EVALUATE. DTSBX426 -00146 DTSBX426 -00147 DTSBX426-MAIN-EXIT. DTSBX426 -00148 GOBACK. DTSBX426 -00149 DTSBX426 -00150 I0000-INITIATE. DTSBX426 -00151 DISPLAY 'BX426 INIT'. DTSBX426 -00152 SET W-ERROR-NO-88 TO TRUE. DTSBX426 -00153 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX426 -00154 DTSBX426 -00155 * FOR VARIABLE REPORT FILE. DTSBX426 -00156 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX426 -00157 MOVE '140' TO R140-REC-TYPE. DTSBX426 -00158 DTSBX426 -00159 PERFORM I3000-READ-MHDR THRU I3000-EXIT DTSBX426 -00160 IF W-FATAL-ERROR-YES-88 DTSBX426 -00161 GO TO I0000-EXIT DTSBX426 -00162 END-IF. DTSBX426 -00163 DTSBX426 -00164 I0000-EXIT. DTSBX426 -00165 EXIT. DTSBX426 -00166 DTSBX426 -00167 I3000-READ-MHDR. DTSBX426 -00168 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBX426 -00169 MOVE +0 TO MHDR-EMP-NO. DTSBX426 -00170 SET MHDR-HDR-88 TO TRUE. DTSBX426 -00171 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 -00172 DTSBX426 -00173 PERFORM S910-READ THRU S910-EXIT. DTSBX426 -00174 IF L910-OK-88 DTSBX426 -00175 MOVE MSKL-REC TO MHDR-REC DTSBX426 -00176 ELSE DTSBX426 -00177 PERFORM S999-ABEND THRU S999-EXIT DTSBX426 -00178 END-IF. DTSBX426 -00179 DTSBX426 -00180 DISPLAY 'BX426 I3000 LAST BTCH: ' MHDR-LAST-USED-BATCH-NO. DTSBX426 -00181 I3000-EXIT. DTSBX426 -00182 EXIT. DTSBX426 -00183 DTSBX426 -00184 DTSBX426 -00185 P0000-PROCESS. DTSBX426 -00186 MOVE LX42-DATA-AREA TO X149-REC. DTSBX426 -00187 *& DTSBX426 -00188 DISPLAY SPACE. DTSBX426 -00189 DISPLAY 'BX426 HEADER ' X149-PSEUDO-BATCH ' ' DTSBX426 -00190 X149-PSEUDO-ITEM. DTSBX426 -00191 ** DISPLAY X140-REC(1:143). DTSBX426 -00192 *& DTSBX426 -00193 ADD +1 TO W-X149-CNT. 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 +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 PERFORM P1100-EDIT-HEADER THRU P1100-EXIT DTSBX426 -00196 IF W-ERROR-NO-88 DTSBX426 -00197 PERFORM P1200-SAVE-HEADER THRU P1200-EXIT DTSBX426 -00198 END-IF. DTSBX426 -00199 DTSBX426 -00200 P0000-EXIT. DTSBX426 -00201 EXIT. 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 P1100-EDIT-HEADER. DTSBX426 -00204 MOVE ZERO TO W-ESTB-DATE. DTSBX426 -00205 MOVE ZERO TO W-RECEIVED-DATE. DTSBX426 -00206 MOVE ZERO TO W-DEPOSIT-DATE. DTSBX426 -00207 MOVE ZERO TO W-CHK-SCAN-DATE. DTSBX426 -00208 DTSBX426 -00209 MOVE X149-ESTB-DATE TO W-SLASH-DATE. DTSBX426 -00210 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 -00211 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 -00212 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 -00213 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 -00214 IF NOT L001-VALID-DATE DTSBX426 -00215 SET W-ERROR-YES-88 TO TRUE DTSBX426 -00216 MOVE SPACES TO R140-MESSAGE DTSBX426 -00217 MOVE X149-PSEUDO-BATCH TO R140-EMP-NO DTSBX426 -00218 MOVE 'BATCH HEADER ' TO R140-RECORD-DESC DTSBX426 -00219 STRING DTSBX426 -00220 'REPORT: INVALID HDR ESTABLISH DATE ' DTSBX426 -00221 X149-ESTB-DATE DTSBX426 -00222 DELIMITED BY SIZE DTSBX426 -00223 INTO R140-MESSAGE DTSBX426 -00224 END-STRING DTSBX426 -00225 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX426 -00226 DISPLAY R140-MESSAGE DTSBX426 -00227 ELSE DTSBX426 -00228 MOVE L001-FED-8-DATE-9 TO W-ESTB-DATE DTSBX426 -00229 END-IF. 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 00230 DTSBX426 -00231 MOVE X149-DEPOSIT-DATE TO W-SLASH-DATE. DTSBX426 -00232 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 -00233 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 -00234 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 -00235 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 -00236 IF NOT L001-VALID-DATE DTSBX426 -00237 SET W-ERROR-YES-88 TO TRUE DTSBX426 -00238 MOVE SPACES TO R140-MESSAGE DTSBX426 -00239 MOVE X149-PSEUDO-BATCH TO R140-EMP-NO DTSBX426 -00240 MOVE 'BATCH HEADER ' TO R140-RECORD-DESC DTSBX426 -00241 STRING DTSBX426 -00242 'REPORT: INVALID HDR DEPOSIT DATE ' DTSBX426 -00243 X149-DEPOSIT-DATE DTSBX426 -00244 DELIMITED BY SIZE DTSBX426 -00245 INTO R140-MESSAGE DTSBX426 -00246 END-STRING DTSBX426 -00247 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX426 -00248 DISPLAY R140-MESSAGE DTSBX426 -00249 ELSE DTSBX426 -00250 MOVE L001-FED-8-DATE-9 TO W-DEPOSIT-DATE DTSBX426 -00251 END-IF. DTSBX426 -00252 DTSBX426 -00253 MOVE X149-RCVD-DATE TO W-SLASH-DATE. DTSBX426 -00254 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 -00255 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 -00256 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 -00257 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 -00258 IF NOT L001-VALID-DATE DTSBX426 -00259 MOVE ZERO TO W-RECEIVED-DATE DTSBX426 -00260 ELSE DTSBX426 -00261 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBX426 -00262 END-IF. DTSBX426 -00263 DTSBX426 -00264 MOVE X149-CHECK-SCAN-DATE TO W-SLASH-DATE. DTSBX426 -00265 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 -00266 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 -00267 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 -00268 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 -00269 IF NOT L001-VALID-DATE DTSBX426 -00270 SET W-ERROR-YES-88 TO TRUE DTSBX426 -00271 MOVE SPACES TO R140-MESSAGE DTSBX426 -00272 MOVE X149-PSEUDO-BATCH TO R140-EMP-NO DTSBX426 -00273 MOVE 'BATCH HEADER ' TO R140-RECORD-DESC DTSBX426 -00274 STRING DTSBX426 -00275 'REPORT: INVALID HDR CHK SCAN DATE ' DTSBX426 -00276 X149-CHECK-SCAN-DATE DTSBX426 -00277 DELIMITED BY SIZE DTSBX426 -00278 INTO R140-MESSAGE DTSBX426 -00279 END-STRING DTSBX426 -00280 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX426 -00281 DISPLAY R140-MESSAGE DTSBX426 -00282 ELSE DTSBX426 -00283 MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSBX426 -00284 END-IF. DTSBX426 -00285 DTSBX426 -00286 P1100-EXIT. DTSBX426 -00287 EXIT. DTSBX426 -00288 DTSBX426 -00289 P1200-SAVE-HEADER. DTSBX426 -00290 MOVE LOW-VALUES TO AHDR-REC. DTSBX426 -00291 DTSBX426 -00292 PERFORM P1210-NEXT-BATCH-NBR THRU P1210-EXIT. DTSBX426 -00293 DTSBX426 -00294 MOVE +0 TO AHDR-ITEM-NO. DTSBX426 -00295 SET AHDR-HDR-88 TO TRUE. DTSBX426 -00296 SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSBX426 -00297 SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSBX426 -00298 MOVE X149-ESTB-OPID TO AHDR-ESTB-OP-ID DTSBX426 -00299 MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE. DTSBX426 -00300 MOVE SPACES TO AHDR-CHNG-OP-ID. DTSBX426 -00301 MOVE +0 TO AHDR-CHNG-DATE. DTSBX426 -00302 MOVE W-DEPOSIT-DATE TO AHDR-DEPOSIT-DATE. DTSBX426 -00303 MOVE W-RECEIVED-DATE TO AHDR-RECEIVED-DATE. DTSBX426 -00304 MOVE X149-CONTROL-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT DTSBX426 -00305 AHDR-LAST-USED-ITEM-NO DTSBX426 -00306 AHDR-ATC-FILE-TRAN-CNT DTSBX426 -00307 MOVE X149-CONTROL-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT DTSBX426 -00308 AHDR-ATC-FILE-REMIT-AMT DTSBX426 -00309 MOVE W-CHK-SCAN-DATE TO AHDR-CHK-SCAN-DATE. DTSBX426 -00310 MOVE +0 TO AHDR-PROC-TRAN-CNT DTSBX426 -00311 AHDR-PROC-REMIT-AMT DTSBX426 -00312 AHDR-BANK-BATCH-NO. DTSBX426 -00313 DTSBX426 -00314 PERFORM P1220-UPDATE-LINKAGE THRU P1220-EXIT. DTSBX426 -00315 DTSBX426 -00316 DISPLAY 'BX426 P1200 HDR: ' AHDR-BATCH-NO ' ' AHDR-ITEM-NO. DTSBX426 -00317 P1200-EXIT. DTSBX426 -00318 EXIT. DTSBX426 -00319 DTSBX426 -00320 P1210-NEXT-BATCH-NBR. DTSBX426 -00321 IF MHDR-LAST-USED-BATCH-NO NOT NUMERIC DTSBX426 -00322 DISPLAY 'BX426 P1210: MHDR BATCH NOT NUMERIC ' DTSBX426 -00323 ELSE DTSBX426 -00324 DISPLAY 'BX426 P1210: MHDR: ' DTSBX426 -00325 MHDR-LAST-USED-BATCH-NO DTSBX426 -00326 END-IF. DTSBX426 -00327 DTSBX426 -00328 IF MHDR-LAST-USED-BATCH-NO < +99999 DTSBX426 -00329 COMPUTE AHDR-BATCH-NO DTSBX426 -00330 = MHDR-LAST-USED-BATCH-NO + 1 DTSBX426 -00331 ELSE DTSBX426 -00332 MOVE +1 TO AHDR-BATCH-NO DTSBX426 -00333 END-IF. DTSBX426 -00334 DTSBX426 -00335 MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSBX426 -00336 DTSBX426 -00337 P1210-EXIT. DTSBX426 -00338 EXIT. DTSBX426 -00339 DTSBX426 -00340 P1220-UPDATE-LINKAGE. DTSBX426 -00341 MOVE AHDR-BATCH-NO TO LX42-BATCH-NO. DTSBX426 -00342 MOVE AHDR-DEPOSIT-DATE TO LX42-DEPOSIT-DATE. DTSBX426 -00343 DTSBX426 -00344 P1220-EXIT. DTSBX426 -00345 EXIT. DTSBX426 -00346 DTSBX426 -00347 P2000-NEW-BATCH. DTSBX426 -00348 *& DTSBX426 -00349 DISPLAY 'BX426 P2000 ' LX42-PSEUDO-BATCH-NO. DTSBX426 -00350 *& DTSBX426 -00351 DTSBX426 -00352 IF LX42-PSEUDO-BATCH-NO = ZERO DTSBX426 -00353 GO TO P2000-EXIT DTSBX426 -00354 ELSE DTSBX426 -00355 PERFORM P2100-CHECK-COUNTS THRU P2100-EXIT DTSBX426 -00356 IF LX42-BATCH-ERR-NO-88 DTSBX426 -00357 MOVE AHDR-REC TO ASKL-REC DTSBX426 -00358 PERFORM S923-WRITE THRU S923-EXIT DTSBX426 -00359 DISPLAY 'BX426 WRITE ' AHDR-BATCH-NO DTSBX426 -00360 ELSE DTSBX426 -00361 DISPLAY 'BX426: ERROR - HEADER NOT WRITTEN ' DTSBX426 -00362 AHDR-BATCH-NO DTSBX426 -00363 END-IF DTSBX426 -00364 END-IF. DTSBX426 -00365 DTSBX426 -00366 P2000-EXIT. DTSBX426 -00367 EXIT. DTSBX426 -00368 DTSBX426 -00369 P2100-CHECK-COUNTS. DTSBX426 -00370 COMPUTE W-TRAN-CNT = LX42-RPT-CNT + LX42-PAY-CNT. DTSBX426 -00371 COMPUTE W-REMIT-AMT = DTSBX426 -00372 (LX42-RPT-REMIT-AMT + LX42-PAY-REMIT-AMT). DTSBX426 -00373 DTSBX426 -00374 IF W-TRAN-CNT NOT = AHDR-CONTROL-TRAN-CNT DTSBX426 -00375 DISPLAY 'INVALID BATCH ' AHDR-BATCH-NO DTSBX426 -00376 ' ' LX42-PSEUDO-BATCH-NO DTSBX426 -00377 '. CONTROL COUNT ' AHDR-CONTROL-TRAN-CNT DTSBX426 -00378 ' ACTUAL COUNT ' W-TRAN-CNT DTSBX426 -00379 SET LX42-BATCH-ERR-YES-88 TO TRUE DTSBX426 -00380 GO TO P2100-EXIT DTSBX426 -00381 END-IF. DTSBX426 -00382 DTSBX426 -00383 IF W-REMIT-AMT NOT = AHDR-CONTROL-REMIT-AMT DTSBX426 -00384 DISPLAY 'INVALID BATCH ' AHDR-BATCH-NO DTSBX426 -00385 ' ' LX42-PSEUDO-BATCH-NO DTSBX426 -00386 '. CONTROL REMIT ' AHDR-CONTROL-REMIT-AMT DTSBX426 -00387 ' ACTUAL REMIT ' W-REMIT-AMT DTSBX426 -00388 SET LX42-BATCH-ERR-YES-88 TO TRUE DTSBX426 -00389 GO TO P2100-EXIT DTSBX426 -00390 END-IF. DTSBX426 -00391 DTSBX426 -00392 P2100-EXIT. DTSBX426 -00393 EXIT. DTSBX426 -00394 DTSBX426 -00395 DTSBX426 -00396 T0000-TERMINATE. DTSBX426 -00397 PERFORM T1000-UPDATE-MHDR-REC THRU T1000-EXIT. DTSBX426 -00398 DTSBX426 -00399 DISPLAY ' '. DTSBX426 -00400 DTSBX426 -00401 DISPLAY '*** DTSBX426 TERMINATION STATISTICS ***'. DTSBX426 -00402 DTSBX426 -00403 DISPLAY ' '. DTSBX426 -00404 DTSBX426 -00405 DISPLAY '*** ACCT BATCH HEADER ***'. DTSBX426 -00406 DTSBX426 -00407 DISPLAY ' '. DTSBX426 -00408 DTSBX426 -00409 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX426 -00410 DTSBX426 -00411 DISPLAY '***************************************'. DTSBX426 -00412 DTSBX426 -00413 T0000-EXIT. DTSBX426 -00414 EXIT. DTSBX426 -00415 DTSBX426 -00416 T1000-UPDATE-MHDR-REC. DTSBX426 -00417 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 -00418 DTSBX426 -00419 PERFORM S910-READ THRU S910-EXIT. DTSBX426 -00420 DTSBX426 -00421 IF L910-OK-88 DTSBX426 -00422 MOVE MHDR-REC TO MSKL-REC DTSBX426 -00423 PERFORM S910-REWRITE THRU S910-EXIT DTSBX426 -00424 ELSE DTSBX426 -00425 PERFORM S999-ABEND THRU S999-EXIT DTSBX426 -00426 END-IF. DTSBX426 -00427 DTSBX426 -00428 T1000-EXIT. DTSBX426 -00429 EXIT. DTSBX426 -00430 DTSBX426 -00431 T2000-DISPLAY-TOTALS. DTSBX426 -00432 DISPLAY 'HEADER RECORD WRITTEN: ' DTSBX426 -00433 W-X149-CNT. DTSBX426 -00434 DTSBX426 -00435 DISPLAY ' '. DTSBX426 -00436 DTSBX426 -00437 T2000-EXIT. DTSBX426 -00438 EXIT. DTSBX426 -00439 DTSBX426 -00440 S001-FROM-FED-8. DTSBX426 -00441 SET L001-FROM-FED-8 TO TRUE. DTSBX426 -00442 GO TO S001-DATE. DTSBX426 -00443 DTSBX426 -00444 S001-FROM-CAL-8. DTSBX426 -00445 SET L001-FROM-CAL-8 TO TRUE. DTSBX426 -00446 GO TO S001-DATE. DTSBX426 -00447 DTSBX426 -00448 S001-FROM-ABS-DAY. DTSBX426 -00449 SET L001-FROM-ABS-DAY TO TRUE. DTSBX426 -00450 GO TO S001-DATE. DTSBX426 -00451 DTSBX426 -00452 S001-DATE. DTSBX426 -00453 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX426 -00454 S001-EXIT. DTSBX426 -00455 EXIT. DTSBX426 -00456 DTSBX426 -00457 S003-AGENCY-DAY. DTSBX426 -00458 SET L003-AGENCY-DAY TO TRUE. DTSBX426 -00459 GO TO S003-WORK-DAY. DTSBX426 -00460 DTSBX426 -00461 S003-WORK-DAY. DTSBX426 -00462 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX426 -00463 S003-EXIT. DTSBX426 -00464 EXIT. DTSBX426 -00465 DTSBX426 -00466 S004-FROM-5. DTSBX426 -00467 SET L004-FROM-5 TO TRUE. DTSBX426 -00468 GO TO S004-YRQ. DTSBX426 -00469 DTSBX426 -00470 S004-FROM-DATE. DTSBX426 -00471 SET L004-FROM-DATE TO TRUE. DTSBX426 -00472 GO TO S004-YRQ. DTSBX426 -00473 DTSBX426 -00474 S004-FROM-ABS. DTSBX426 -00475 SET L004-FROM-ABS TO TRUE. DTSBX426 -00476 GO TO S004-YRQ. DTSBX426 -00477 DTSBX426 -00478 S004-YRQ. DTSBX426 -00479 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX426 -00480 DTSBX426 -00481 S004-EXIT. DTSBX426 -00482 EXIT. DTSBX426 -00483 DTSBX426 -00484 S910-OPEN-READ. DTSBX426 -00485 SET L910-OPEN-READ-88 TO TRUE. DTSBX426 -00486 GO TO S910-MSTR-IO. DTSBX426 -00487 DTSBX426 -00488 S910-READ. DTSBX426 -00489 SET L910-READ-88 TO TRUE. DTSBX426 -00490 GO TO S910-MSTR-IO. DTSBX426 -00491 DTSBX426 -00492 S910-START-BROWSE. DTSBX426 -00493 SET L910-START-BROWSE-88 TO TRUE. DTSBX426 -00494 GO TO S910-MSTR-IO. DTSBX426 -00495 DTSBX426 -00496 S910-READ-NEXT. DTSBX426 -00497 SET L910-READ-NEXT-88 TO TRUE. DTSBX426 -00498 GO TO S910-MSTR-IO. DTSBX426 -00499 DTSBX426 -00500 S910-REWRITE. DTSBX426 -00501 SET L910-REWRITE-88 TO TRUE. DTSBX426 -00502 GO TO S910-MSTR-IO. DTSBX426 -00503 DTSBX426 -00504 S910-CLOSE. DTSBX426 -00505 SET L910-CLOSE-88 TO TRUE. DTSBX426 -00506 GO TO S910-MSTR-IO. DTSBX426 -00507 DTSBX426 -00508 S910-MSTR-IO. DTSBX426 -00509 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX426 -00510 MSKL-REC. DTSBX426 -00511 S910-EXIT. DTSBX426 -00512 EXIT. DTSBX426 -00513 DTSBX426 -00514 S923-OPEN-UPDATE. DTSBX426 -00515 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX426 -00516 GO TO S923-ATC-CALL. DTSBX426 -00517 DTSBX426 -00518 S923-WRITE. DTSBX426 -00519 SET L923-WRITE-88 TO TRUE. DTSBX426 -00520 GO TO S923-ATC-CALL. DTSBX426 -00521 DTSBX426 -00522 S923-CLOSE. DTSBX426 -00523 SET L923-CLOSE-88 TO TRUE. DTSBX426 -00524 GO TO S923-ATC-CALL. DTSBX426 -00525 DTSBX426 -00526 S923-ATC-CALL. DTSBX426 -00527 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX426 -00528 ASKL-REC. DTSBX426 -00529 S923-EXIT. DTSBX426 -00530 EXIT. 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 +00445 EJECT DTSBX426 +00446 01 FAC0-LINK-REC. CL*45 +00447 ++INCLUDE DTSIXAC0 CL*45 +00448 EJECT DTSBX426 +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 +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 +00479 EJECT DTSBX426 +00480 01 ITRT-REC. DTSBX426 +00481 ++INCLUDE DTSIITRT DTSBX426 +00482 EJECT DTSBX426 +00483 01 ISKL-REC. DTSBX426 +00484 ++INCLUDE DTSIISKL DTSBX426 +00485 EJECT DTSBX426 +00486 01 R907-REC. DTSBX426 +00487 ++INCLUDE DTSIR907 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 S931-OPEN-READ. DTSBX426 -00533 SET L931-OPEN-READ-88 TO TRUE. DTSBX426 -00534 GO TO S931-REF-IO. DTSBX426 -00535 DTSBX426 -00536 S931-CLOSE. DTSBX426 -00537 SET L931-CLOSE-88 TO TRUE. DTSBX426 -00538 GO TO S931-REF-IO. DTSBX426 -00539 DTSBX426 -00540 S931-REF-IO. DTSBX426 -00541 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX426 -00542 FSKL-REC. DTSBX426 -00543 S931-EXIT. DTSBX426 -00544 EXIT. 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 S946-WRITE-R140. DTSBX426 -00547 CALL 'DTSBU946' USING R140-REC. DTSBX426 -00548 DTSBX426 -00549 S946-EXIT. DTSBX426 -00550 EXIT. DTSBX426 -00551 DTSBX426 -00552 S999-ABEND. DTSBX426 -00553 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX426 -00554 S999-EXIT. DTSBX426 -00555 EXIT. DTSBX426 -00556 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 +00577 DTSBX426 +00578 MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND. DTSBX426 +00579 DTSBX426 +00580 MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND. DTSBX426 +00581 DTSBX426 +00582 PERFORM I2000-OPEN-FILES THRU I2000-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 +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 +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 +00749 DTSBX426 +00750 IF FAC6-AMOUNT NOT NUMERIC DTSBX426 +00751 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00752 DISPLAY ' ACH PAYMENT NOT NUMERIC ' FAC6-AMOUNT 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 +00756 * MOVE ZEROS TO F907-EMP-NO CL**8 +00757 * MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC 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 +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 +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 +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 +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 +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 +01520 DTSBX426 +01521 S910-READ. DTSBX426 +01522 SET L910-READ-88 TO TRUE. DTSBX426 +01523 GO TO S910-MSTR-IO. DTSBX426 +01524 DTSBX426 +01525 S910-DELETE. DTSBX426 +01526 SET L910-DELETE-88 TO TRUE. DTSBX426 +01527 GO TO S910-MSTR-IO. DTSBX426 +01528 DTSBX426 +01529 S910-WRITE. DTSBX426 +01530 SET L910-WRITE-88 TO TRUE. DTSBX426 +01531 GO TO S910-MSTR-IO. 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 diff --git a/Batch/DTSBX426_.cob b/Batch/DTSBX426_.cob new file mode 100644 index 0000000..9e48201 --- /dev/null +++ b/Batch/DTSBX426_.cob @@ -0,0 +1,557 @@ +00001 IDENTIFICATION DIVISION. 09/21/10 +00002 PROGRAM-ID. DTSBX426. DTSBX426 +00003 AUTHOR. NGC. LV001 +00004 DATE-WRITTEN. JUNE 2010. DTSBX426 +00005 DATE-COMPILED. DTSBX426 +00006 SKIP3 DTSBX426 +00007 ***** DTSBX426 +00008 * DTSBX426 +00009 * FUNCTION: EDIT BATCH HEADER FROM WEB APPLICATION. DTSBX426 +00010 * DTSBX426 +00011 * MODIFICATION HISTORY: DTSBX426 +00012 * DTSBX426 +00013 * 06-16-2010 INITIAL DEVELOPMENT DTSBX426 +00014 * REFERENCE RFP: IN-HOUSE CASHIERING DTSBX426 +00015 * DTSBX426 +00016 * DTSBX426 +00017 * DTSBX426 +00018 ***** DTSBX426 +00019 SKIP3 DTSBX426 +00020 ENVIRONMENT DIVISION. DTSBX426 +00021 SKIP2 DTSBX426 +00022 DATA DIVISION. DTSBX426 +00023 WORKING-STORAGE SECTION. DTSBX426 +000235 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX426 09/21/10'. DTSBX426 +00024 SKIP3 DTSBX426 +00025 01 WRK-AREA. DTSBX426 +00026 05 W-ABEND-CD PIC S9(04) COMP VALUE 426. DTSBX426 +00027 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX426'.DTSBX426 +00028 DTSBX426 +00029 DTSBX426 +00030 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX426 +00031 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX426 +00032 88 W-ERROR-NO-88 VALUE 'N'. DTSBX426 +00033 DTSBX426 +00034 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX426 +00035 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX426 +00036 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX426 +00037 DTSBX426 +00038 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX426 +00039 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSBX426 +00040 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBX426 +00041 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX426 +00042 DTSBX426 +00043 05 W-TRAN-CNT PIC S9(03) COMP-3. DTSBX426 +00044 05 W-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX426 +00045 DTSBX426 +00046 05 W-SLASH-DATE PIC X(10). DTSBX426 +00047 05 FILLER REDEFINES W-SLASH-DATE. DTSBX426 +00048 10 W-SLASH-DT-MM PIC X(02). DTSBX426 +00049 10 FILLER PIC X(01). DTSBX426 +00050 10 W-SLASH-DT-DD PIC X(02). DTSBX426 +00051 10 FILLER PIC X(01). DTSBX426 +00052 10 W-SLASH-DT-CCYY PIC X(04). DTSBX426 +00053 DTSBX426 +00054 05 W-SLASH-QTR PIC X(06). DTSBX426 +00055 05 FILLER REDEFINES W-SLASH-QTR. DTSBX426 +00056 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX426 +00057 10 FILLER PIC X(01). DTSBX426 +00058 10 W-SLASH-QTR-Q PIC X(01). DTSBX426 +00059 DTSBX426 +00060 * BATCH HEADER DTSBX426 +00061 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX426 +00062 DTSBX426 +00063 05 W-AMT-DISP1 PIC ----------9.99. DTSBX426 +00064 05 W-AMT-DISP2 PIC ----------9.99. DTSBX426 +00065 DTSBX426 +00066 01 MESSAGE-AREA. DTSBX426 +00067 *** FATAL ERRORS MSG-A DTSBX426 +00068 05 MSG-A1. DTSBX426 +00069 10 FILLER PIC X(32) DTSBX426 +00070 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX426 +00071 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX426 +00072 DTSBX426 +00073 * ACCOUNTING BATCH HEADER DTSBX426 +00074 01 X149-REC. DTSBX426 +00075 ++INCLUDE DTSIX149 DTSBX426 +00076 DTSBX426 +00077 * ERRORS DTSBX426 +00078 *01 X907-REC. DTSBX426 +00079 ***INCLUDE DTSIX907 DTSBX426 +00080 DTSBX426 +00081 01 L001-LINK-AREA. DTSBX426 +00082 ++INCLUDE DTSIL001 DTSBX426 +00083 DTSBX426 +00084 01 L003-LINK-AREA. DTSBX426 +00085 ++INCLUDE DTSIL003 DTSBX426 +00086 DTSBX426 +00087 01 L004-LINK-AREA. DTSBX426 +00088 ++INCLUDE DTSIL004 DTSBX426 +00089 DTSBX426 +00090 01 L910-LINK-AREA. DTSBX426 +00091 ++INCLUDE DTSIL910 DTSBX426 +00092 01 MSKL-REC. DTSBX426 +00093 ++INCLUDE DTSIMSKL DTSBX426 +00094 DTSBX426 +00095 01 MHDR-REC. DTSBX426 +00096 ++INCLUDE DTSIMHDR DTSBX426 +00097 DTSBX426 +00098 01 L923-LINK-AREA. DTSBX426 +00099 ++INCLUDE DTSIL923 DTSBX426 +00100 EJECT DTSBX426 +00101 01 ASKL-REC. DTSBX426 +00102 ++INCLUDE DTSIASKL DTSBX426 +00103 EJECT DTSBX426 +00104 01 AHDR-REC. DTSBX426 +00105 ++INCLUDE DTSIAHDR DTSBX426 +00106 EJECT DTSBX426 +00107 01 ARPT-REC. DTSBX426 +00108 ++INCLUDE DTSIARPT DTSBX426 +00109 EJECT DTSBX426 +00110 01 APAY-REC. DTSBX426 +00111 ++INCLUDE DTSIAPAY DTSBX426 +00112 DTSBX426 +00113 01 L931-LINK-AREA. DTSBX426 +00114 ++INCLUDE DTSIL931 DTSBX426 +00115 DTSBX426 +00116 01 FSKL-REC. DTSBX426 +00117 ++INCLUDE DTSIFSKL DTSBX426 +00118 DTSBX426 +00119 01 R140-REC. DTSBX426 +00120 ++INCLUDE DTSIR140 DTSBX426 +00121 DTSBX426 +00122 LINKAGE DTSBX426 +00123 SECTION. DTSBX426 +00124 DTSBX426 +00125 01 LX42-LINK-AREA. DTSBX426 +00126 ++INCLUDE DTSILX42 DTSBX426 +00127 DTSBX426 +00128 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX426 +00129 DTSBX426 +00130 DTSBX426-MAIN. DTSBX426 +00131 EVALUATE TRUE DTSBX426 +00132 WHEN LX42-INITIALIZE-88 DTSBX426 +00133 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX426 +00134 DTSBX426 +00135 WHEN LX42-NEW-BATCH-88 DTSBX426 +00136 PERFORM P2000-NEW-BATCH THRU P2000-EXIT DTSBX426 +00137 DTSBX426 +00138 WHEN LX42-PROCESS-88 DTSBX426 +00139 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX426 +00140 DTSBX426 +00141 WHEN LX42-TERMINATE-88 DTSBX426 +00142 PERFORM P2000-NEW-BATCH THRU P2000-EXIT DTSBX426 +00143 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX426 +00144 DTSBX426 +00145 END-EVALUATE. DTSBX426 +00146 DTSBX426 +00147 DTSBX426-MAIN-EXIT. DTSBX426 +00148 GOBACK. DTSBX426 +00149 DTSBX426 +00150 I0000-INITIATE. DTSBX426 +00151 DISPLAY 'BX426 INIT'. DTSBX426 +00152 SET W-ERROR-NO-88 TO TRUE. DTSBX426 +00153 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX426 +00154 DTSBX426 +00155 * FOR VARIABLE REPORT FILE. DTSBX426 +00156 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX426 +00157 MOVE '140' TO R140-REC-TYPE. DTSBX426 +00158 DTSBX426 +00159 PERFORM I3000-READ-MHDR THRU I3000-EXIT DTSBX426 +00160 IF W-FATAL-ERROR-YES-88 DTSBX426 +00161 GO TO I0000-EXIT DTSBX426 +00162 END-IF. DTSBX426 +00163 DTSBX426 +00164 I0000-EXIT. DTSBX426 +00165 EXIT. DTSBX426 +00166 DTSBX426 +00167 I3000-READ-MHDR. DTSBX426 +00168 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBX426 +00169 MOVE +0 TO MHDR-EMP-NO. DTSBX426 +00170 SET MHDR-HDR-88 TO TRUE. DTSBX426 +00171 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 +00172 DTSBX426 +00173 PERFORM S910-READ THRU S910-EXIT. DTSBX426 +00174 IF L910-OK-88 DTSBX426 +00175 MOVE MSKL-REC TO MHDR-REC DTSBX426 +00176 ELSE DTSBX426 +00177 PERFORM S999-ABEND THRU S999-EXIT DTSBX426 +00178 END-IF. DTSBX426 +00179 DTSBX426 +00180 DISPLAY 'BX426 I3000 LAST BTCH: ' MHDR-LAST-USED-BATCH-NO. DTSBX426 +00181 I3000-EXIT. DTSBX426 +00182 EXIT. DTSBX426 +00183 DTSBX426 +00184 DTSBX426 +00185 P0000-PROCESS. DTSBX426 +00186 MOVE LX42-DATA-AREA TO X149-REC. DTSBX426 +00187 *& DTSBX426 +00188 DISPLAY SPACE. DTSBX426 +00189 DISPLAY 'BX426 HEADER ' X149-PSEUDO-BATCH ' ' DTSBX426 +00190 X149-PSEUDO-ITEM. DTSBX426 +00191 ** DISPLAY X140-REC(1:143). DTSBX426 +00192 *& DTSBX426 +00193 ADD +1 TO W-X149-CNT. DTSBX426 +00194 DTSBX426 +00195 PERFORM P1100-EDIT-HEADER THRU P1100-EXIT DTSBX426 +00196 IF W-ERROR-NO-88 DTSBX426 +00197 PERFORM P1200-SAVE-HEADER THRU P1200-EXIT DTSBX426 +00198 END-IF. DTSBX426 +00199 DTSBX426 +00200 P0000-EXIT. DTSBX426 +00201 EXIT. DTSBX426 +00202 DTSBX426 +00203 P1100-EDIT-HEADER. DTSBX426 +00204 MOVE ZERO TO W-ESTB-DATE. DTSBX426 +00205 MOVE ZERO TO W-RECEIVED-DATE. DTSBX426 +00206 MOVE ZERO TO W-DEPOSIT-DATE. DTSBX426 +00207 MOVE ZERO TO W-CHK-SCAN-DATE. DTSBX426 +00208 DTSBX426 +00209 MOVE X149-ESTB-DATE TO W-SLASH-DATE. DTSBX426 +00210 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 +00211 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 +00212 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 +00213 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 +00214 IF NOT L001-VALID-DATE DTSBX426 +00215 SET W-ERROR-YES-88 TO TRUE DTSBX426 +00216 MOVE SPACES TO R140-MESSAGE DTSBX426 +00217 MOVE X149-PSEUDO-BATCH TO R140-EMP-NO DTSBX426 +00218 MOVE 'BATCH HEADER ' TO R140-RECORD-DESC DTSBX426 +00219 STRING DTSBX426 +00220 'REPORT: INVALID HDR ESTABLISH DATE ' DTSBX426 +00221 X149-ESTB-DATE DTSBX426 +00222 DELIMITED BY SIZE DTSBX426 +00223 INTO R140-MESSAGE DTSBX426 +00224 END-STRING DTSBX426 +00225 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX426 +00226 DISPLAY R140-MESSAGE DTSBX426 +00227 ELSE DTSBX426 +00228 MOVE L001-FED-8-DATE-9 TO W-ESTB-DATE DTSBX426 +00229 END-IF. DTSBX426 +00230 DTSBX426 +00231 MOVE X149-DEPOSIT-DATE TO W-SLASH-DATE. DTSBX426 +00232 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 +00233 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 +00234 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 +00235 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 +00236 IF NOT L001-VALID-DATE DTSBX426 +00237 SET W-ERROR-YES-88 TO TRUE DTSBX426 +00238 MOVE SPACES TO R140-MESSAGE DTSBX426 +00239 MOVE X149-PSEUDO-BATCH TO R140-EMP-NO DTSBX426 +00240 MOVE 'BATCH HEADER ' TO R140-RECORD-DESC DTSBX426 +00241 STRING DTSBX426 +00242 'REPORT: INVALID HDR DEPOSIT DATE ' DTSBX426 +00243 X149-DEPOSIT-DATE DTSBX426 +00244 DELIMITED BY SIZE DTSBX426 +00245 INTO R140-MESSAGE DTSBX426 +00246 END-STRING DTSBX426 +00247 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX426 +00248 DISPLAY R140-MESSAGE DTSBX426 +00249 ELSE DTSBX426 +00250 MOVE L001-FED-8-DATE-9 TO W-DEPOSIT-DATE DTSBX426 +00251 END-IF. DTSBX426 +00252 DTSBX426 +00253 MOVE X149-RCVD-DATE TO W-SLASH-DATE. DTSBX426 +00254 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 +00255 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 +00256 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 +00257 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 +00258 IF NOT L001-VALID-DATE DTSBX426 +00259 MOVE ZERO TO W-RECEIVED-DATE DTSBX426 +00260 ELSE DTSBX426 +00261 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBX426 +00262 END-IF. DTSBX426 +00263 DTSBX426 +00264 MOVE X149-CHECK-SCAN-DATE TO W-SLASH-DATE. DTSBX426 +00265 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX426 +00266 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX426 +00267 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX426 +00268 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX426 +00269 IF NOT L001-VALID-DATE DTSBX426 +00270 SET W-ERROR-YES-88 TO TRUE DTSBX426 +00271 MOVE SPACES TO R140-MESSAGE DTSBX426 +00272 MOVE X149-PSEUDO-BATCH TO R140-EMP-NO DTSBX426 +00273 MOVE 'BATCH HEADER ' TO R140-RECORD-DESC DTSBX426 +00274 STRING DTSBX426 +00275 'REPORT: INVALID HDR CHK SCAN DATE ' DTSBX426 +00276 X149-CHECK-SCAN-DATE DTSBX426 +00277 DELIMITED BY SIZE DTSBX426 +00278 INTO R140-MESSAGE DTSBX426 +00279 END-STRING DTSBX426 +00280 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX426 +00281 DISPLAY R140-MESSAGE DTSBX426 +00282 ELSE DTSBX426 +00283 MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSBX426 +00284 END-IF. DTSBX426 +00285 DTSBX426 +00286 P1100-EXIT. DTSBX426 +00287 EXIT. DTSBX426 +00288 DTSBX426 +00289 P1200-SAVE-HEADER. DTSBX426 +00290 MOVE LOW-VALUES TO AHDR-REC. DTSBX426 +00291 DTSBX426 +00292 PERFORM P1210-NEXT-BATCH-NBR THRU P1210-EXIT. DTSBX426 +00293 DTSBX426 +00294 MOVE +0 TO AHDR-ITEM-NO. DTSBX426 +00295 SET AHDR-HDR-88 TO TRUE. DTSBX426 +00296 SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSBX426 +00297 SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSBX426 +00298 MOVE X149-ESTB-OPID TO AHDR-ESTB-OP-ID DTSBX426 +00299 MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE. DTSBX426 +00300 MOVE SPACES TO AHDR-CHNG-OP-ID. DTSBX426 +00301 MOVE +0 TO AHDR-CHNG-DATE. DTSBX426 +00302 MOVE W-DEPOSIT-DATE TO AHDR-DEPOSIT-DATE. DTSBX426 +00303 MOVE W-RECEIVED-DATE TO AHDR-RECEIVED-DATE. DTSBX426 +00304 MOVE X149-CONTROL-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT DTSBX426 +00305 AHDR-LAST-USED-ITEM-NO DTSBX426 +00306 AHDR-ATC-FILE-TRAN-CNT DTSBX426 +00307 MOVE X149-CONTROL-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT DTSBX426 +00308 AHDR-ATC-FILE-REMIT-AMT DTSBX426 +00309 MOVE W-CHK-SCAN-DATE TO AHDR-CHK-SCAN-DATE. DTSBX426 +00310 MOVE +0 TO AHDR-PROC-TRAN-CNT DTSBX426 +00311 AHDR-PROC-REMIT-AMT DTSBX426 +00312 AHDR-BANK-BATCH-NO. DTSBX426 +00313 DTSBX426 +00314 PERFORM P1220-UPDATE-LINKAGE THRU P1220-EXIT. DTSBX426 +00315 DTSBX426 +00316 DISPLAY 'BX426 P1200 HDR: ' AHDR-BATCH-NO ' ' AHDR-ITEM-NO. DTSBX426 +00317 P1200-EXIT. DTSBX426 +00318 EXIT. DTSBX426 +00319 DTSBX426 +00320 P1210-NEXT-BATCH-NBR. DTSBX426 +00321 IF MHDR-LAST-USED-BATCH-NO NOT NUMERIC DTSBX426 +00322 DISPLAY 'BX426 P1210: MHDR BATCH NOT NUMERIC ' DTSBX426 +00323 ELSE DTSBX426 +00324 DISPLAY 'BX426 P1210: MHDR: ' DTSBX426 +00325 MHDR-LAST-USED-BATCH-NO DTSBX426 +00326 END-IF. DTSBX426 +00327 DTSBX426 +00328 IF MHDR-LAST-USED-BATCH-NO < +99999 DTSBX426 +00329 COMPUTE AHDR-BATCH-NO DTSBX426 +00330 = MHDR-LAST-USED-BATCH-NO + 1 DTSBX426 +00331 ELSE DTSBX426 +00332 MOVE +1 TO AHDR-BATCH-NO DTSBX426 +00333 END-IF. DTSBX426 +00334 DTSBX426 +00335 MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSBX426 +00336 DTSBX426 +00337 P1210-EXIT. DTSBX426 +00338 EXIT. DTSBX426 +00339 DTSBX426 +00340 P1220-UPDATE-LINKAGE. DTSBX426 +00341** MOVE AHDR-BATCH-NO TO LX42-BATCH-NO. DTSBX426 +00342 MOVE AHDR-DEPOSIT-DATE TO LX42-DEPOSIT-DATE. DTSBX426 +00343 DTSBX426 +00344 P1220-EXIT. DTSBX426 +00345 EXIT. DTSBX426 +00346 DTSBX426 +00347 P2000-NEW-BATCH. DTSBX426 +00348 *& DTSBX426 +00349 DISPLAY 'BX426 P2000 ' LX42-PSEUDO-BATCH-NO. DTSBX426 +00350 *& DTSBX426 +00351 DTSBX426 +00352 IF LX42-PSEUDO-BATCH-NO = ZERO DTSBX426 +00353 GO TO P2000-EXIT DTSBX426 +00354 ELSE DTSBX426 +00355 PERFORM P2100-CHECK-COUNTS THRU P2100-EXIT DTSBX426 +00356 IF LX42-BATCH-ERR-NO-88 DTSBX426 +00357 MOVE AHDR-REC TO ASKL-REC DTSBX426 +00358 PERFORM S923-WRITE THRU S923-EXIT DTSBX426 +00359 DISPLAY 'BX426 WRITE ' AHDR-BATCH-NO DTSBX426 +00360 ELSE DTSBX426 +00361 DISPLAY 'BX426: ERROR - HEADER NOT WRITTEN ' DTSBX426 +00362 AHDR-BATCH-NO DTSBX426 +00363 END-IF DTSBX426 +00364 END-IF. DTSBX426 +00365 DTSBX426 +00366 P2000-EXIT. DTSBX426 +00367 EXIT. DTSBX426 +00368 DTSBX426 +00369 P2100-CHECK-COUNTS. DTSBX426 +00370 COMPUTE W-TRAN-CNT = LX42-RPT-CNT + LX42-PAY-CNT. DTSBX426 +00371 COMPUTE W-REMIT-AMT = DTSBX426 +00372 (LX42-RPT-REMIT-AMT + LX42-PAY-REMIT-AMT). DTSBX426 +00373 DTSBX426 +00374 IF W-TRAN-CNT NOT = AHDR-CONTROL-TRAN-CNT DTSBX426 +00375 DISPLAY 'INVALID BATCH ' AHDR-BATCH-NO DTSBX426 +00376 ' ' LX42-PSEUDO-BATCH-NO DTSBX426 +00377 '. CONTROL COUNT ' AHDR-CONTROL-TRAN-CNT DTSBX426 +00378 ' ACTUAL COUNT ' W-TRAN-CNT DTSBX426 +00379 SET LX42-BATCH-ERR-YES-88 TO TRUE DTSBX426 +00380 GO TO P2100-EXIT DTSBX426 +00381 END-IF. DTSBX426 +00382 DTSBX426 +00383 IF W-REMIT-AMT NOT = AHDR-CONTROL-REMIT-AMT DTSBX426 +00384 DISPLAY 'INVALID BATCH ' AHDR-BATCH-NO DTSBX426 +00385 ' ' LX42-PSEUDO-BATCH-NO DTSBX426 +00386 '. CONTROL REMIT ' AHDR-CONTROL-REMIT-AMT DTSBX426 +00387 ' ACTUAL REMIT ' W-REMIT-AMT DTSBX426 +00388 SET LX42-BATCH-ERR-YES-88 TO TRUE DTSBX426 +00389 GO TO P2100-EXIT DTSBX426 +00390 END-IF. DTSBX426 +00391 DTSBX426 +00392 P2100-EXIT. DTSBX426 +00393 EXIT. DTSBX426 +00394 DTSBX426 +00395 DTSBX426 +00396 T0000-TERMINATE. DTSBX426 +00397 PERFORM T1000-UPDATE-MHDR-REC THRU T1000-EXIT. DTSBX426 +00398 DTSBX426 +00399 DISPLAY ' '. DTSBX426 +00400 DTSBX426 +00401 DISPLAY '*** DTSBX426 TERMINATION STATISTICS ***'. DTSBX426 +00402 DTSBX426 +00403 DISPLAY ' '. DTSBX426 +00404 DTSBX426 +00405 DISPLAY '*** ACCT BATCH HEADER ***'. DTSBX426 +00406 DTSBX426 +00407 DISPLAY ' '. DTSBX426 +00408 DTSBX426 +00409 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX426 +00410 DTSBX426 +00411 DISPLAY '***************************************'. DTSBX426 +00412 DTSBX426 +00413 T0000-EXIT. DTSBX426 +00414 EXIT. DTSBX426 +00415 DTSBX426 +00416 T1000-UPDATE-MHDR-REC. DTSBX426 +00417 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX426 +00418 DTSBX426 +00419 PERFORM S910-READ THRU S910-EXIT. DTSBX426 +00420 DTSBX426 +00421 IF L910-OK-88 DTSBX426 +00422 MOVE MHDR-REC TO MSKL-REC DTSBX426 +00423 PERFORM S910-REWRITE THRU S910-EXIT DTSBX426 +00424 ELSE DTSBX426 +00425 PERFORM S999-ABEND THRU S999-EXIT DTSBX426 +00426 END-IF. DTSBX426 +00427 DTSBX426 +00428 T1000-EXIT. DTSBX426 +00429 EXIT. DTSBX426 +00430 DTSBX426 +00431 T2000-DISPLAY-TOTALS. DTSBX426 +00432 DISPLAY 'HEADER RECORD WRITTEN: ' DTSBX426 +00433 W-X149-CNT. DTSBX426 +00434 DTSBX426 +00435 DISPLAY ' '. DTSBX426 +00436 DTSBX426 +00437 T2000-EXIT. DTSBX426 +00438 EXIT. DTSBX426 +00439 DTSBX426 +00440 S001-FROM-FED-8. DTSBX426 +00441 SET L001-FROM-FED-8 TO TRUE. DTSBX426 +00442 GO TO S001-DATE. DTSBX426 +00443 DTSBX426 +00444 S001-FROM-CAL-8. DTSBX426 +00445 SET L001-FROM-CAL-8 TO TRUE. DTSBX426 +00446 GO TO S001-DATE. DTSBX426 +00447 DTSBX426 +00448 S001-FROM-ABS-DAY. DTSBX426 +00449 SET L001-FROM-ABS-DAY TO TRUE. DTSBX426 +00450 GO TO S001-DATE. DTSBX426 +00451 DTSBX426 +00452 S001-DATE. DTSBX426 +00453 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX426 +00454 S001-EXIT. DTSBX426 +00455 EXIT. DTSBX426 +00456 DTSBX426 +00457 S003-AGENCY-DAY. DTSBX426 +00458 SET L003-AGENCY-DAY TO TRUE. DTSBX426 +00459 GO TO S003-WORK-DAY. DTSBX426 +00460 DTSBX426 +00461 S003-WORK-DAY. DTSBX426 +00462 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX426 +00463 S003-EXIT. DTSBX426 +00464 EXIT. DTSBX426 +00465 DTSBX426 +00466 S004-FROM-5. DTSBX426 +00467 SET L004-FROM-5 TO TRUE. DTSBX426 +00468 GO TO S004-YRQ. DTSBX426 +00469 DTSBX426 +00470 S004-FROM-DATE. DTSBX426 +00471 SET L004-FROM-DATE TO TRUE. DTSBX426 +00472 GO TO S004-YRQ. DTSBX426 +00473 DTSBX426 +00474 S004-FROM-ABS. DTSBX426 +00475 SET L004-FROM-ABS TO TRUE. DTSBX426 +00476 GO TO S004-YRQ. DTSBX426 +00477 DTSBX426 +00478 S004-YRQ. DTSBX426 +00479 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX426 +00480 DTSBX426 +00481 S004-EXIT. DTSBX426 +00482 EXIT. DTSBX426 +00483 DTSBX426 +00484 S910-OPEN-READ. DTSBX426 +00485 SET L910-OPEN-READ-88 TO TRUE. DTSBX426 +00486 GO TO S910-MSTR-IO. DTSBX426 +00487 DTSBX426 +00488 S910-READ. DTSBX426 +00489 SET L910-READ-88 TO TRUE. DTSBX426 +00490 GO TO S910-MSTR-IO. DTSBX426 +00491 DTSBX426 +00492 S910-START-BROWSE. DTSBX426 +00493 SET L910-START-BROWSE-88 TO TRUE. DTSBX426 +00494 GO TO S910-MSTR-IO. DTSBX426 +00495 DTSBX426 +00496 S910-READ-NEXT. DTSBX426 +00497 SET L910-READ-NEXT-88 TO TRUE. DTSBX426 +00498 GO TO S910-MSTR-IO. DTSBX426 +00499 DTSBX426 +00500 S910-REWRITE. DTSBX426 +00501 SET L910-REWRITE-88 TO TRUE. DTSBX426 +00502 GO TO S910-MSTR-IO. DTSBX426 +00503 DTSBX426 +00504 S910-CLOSE. DTSBX426 +00505 SET L910-CLOSE-88 TO TRUE. DTSBX426 +00506 GO TO S910-MSTR-IO. DTSBX426 +00507 DTSBX426 +00508 S910-MSTR-IO. DTSBX426 +00509 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX426 +00510 MSKL-REC. DTSBX426 +00511 S910-EXIT. DTSBX426 +00512 EXIT. DTSBX426 +00513 DTSBX426 +00514 S923-OPEN-UPDATE. DTSBX426 +00515 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX426 +00516 GO TO S923-ATC-CALL. DTSBX426 +00517 DTSBX426 +00518 S923-WRITE. DTSBX426 +00519 SET L923-WRITE-88 TO TRUE. DTSBX426 +00520 GO TO S923-ATC-CALL. DTSBX426 +00521 DTSBX426 +00522 S923-CLOSE. DTSBX426 +00523 SET L923-CLOSE-88 TO TRUE. DTSBX426 +00524 GO TO S923-ATC-CALL. DTSBX426 +00525 DTSBX426 +00526 S923-ATC-CALL. DTSBX426 +00527 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX426 +00528 ASKL-REC. DTSBX426 +00529 S923-EXIT. DTSBX426 +00530 EXIT. DTSBX426 +00531 DTSBX426 +00532 S931-OPEN-READ. DTSBX426 +00533 SET L931-OPEN-READ-88 TO TRUE. DTSBX426 +00534 GO TO S931-REF-IO. DTSBX426 +00535 DTSBX426 +00536 S931-CLOSE. DTSBX426 +00537 SET L931-CLOSE-88 TO TRUE. DTSBX426 +00538 GO TO S931-REF-IO. DTSBX426 +00539 DTSBX426 +00540 S931-REF-IO. DTSBX426 +00541 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX426 +00542 FSKL-REC. DTSBX426 +00543 S931-EXIT. DTSBX426 +00544 EXIT. DTSBX426 +00545 DTSBX426 +00546 S946-WRITE-R140. DTSBX426 +00547 CALL 'DTSBU946' USING R140-REC. DTSBX426 +00548 DTSBX426 +00549 S946-EXIT. DTSBX426 +00550 EXIT. DTSBX426 +00551 DTSBX426 +00552 S999-ABEND. DTSBX426 +00553 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX426 +00554 S999-EXIT. DTSBX426 +00555 EXIT. DTSBX426 +00556 DTSBX426 diff --git a/Batch/DTSBX427.cob b/Batch/DTSBX427.cob new file mode 100644 index 0000000..0e56e97 --- /dev/null +++ b/Batch/DTSBX427.cob @@ -0,0 +1,1058 @@ +00001 IDENTIFICATION DIVISION. 02/27/20 +00002 PROGRAM-ID. DTSBX427. DTSBX427 +00003 AUTHOR. NORTHROP GRUMMAN. LV094 +00004 DATE-WRITTEN. SEPT 2014. CL**2 +00005 DATE-COMPILED. DTSBX427 +00006 SKIP3 DTSBX427 +00007 ***** DTSBX427 +00008 * DTSBX427 +00009 * FUNCTION: UPDATE MAILING AND BUSINESS ADDRESS FROM ESSP. CL**2 +00010 * DTSBX427 +00011 * MODIFICATION LOG: DTSBX427 +00012 * DTSBX427 +00013 * 09/15/2014 INITIAL DEVELOPMENT. CL**2 +00014 * WORK ORDER: ESSP PROGRAMMER: ZL1 CL**2 +00015 * DTSBX427 +00016 * CL*48 +00017 * 02/15/2017 MODIFIED TO CONVERT ADDRESS FIELDS INTO UPPER CL*48 +00018 * CASE PROGRAMMER: ZL1 CL*48 +00019 * CL*48 +00020 * CL*50 +00021 * CL*50 +00022 * 04/06/2017 MODIFIED TO UPDATE THE RETURN MAIL FLAG WHEN CL*50 +00023 * ADDRESS UPDATES COMPLETED PROGRAMMER: ZL1 CL*50 +00024 * CL*50 +00025 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX427 +00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX427 +00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX427 +00028 * DTSBX427 +00029 * DESCRIPTION: DTSBX427 +00030 * DTSBX427 +00031 * UPDATE ADDRESSES AND THE MPRF MASTER FILE. DTSBX427 +00032 * DTSBX427 +00033 * DTSBX427 IS THE MAILING ADDRESS UPDATE PROCESS FROM A CL**2 +00034 * ESSP ADDRESS FILE. CL**2 +00035 * DTSBX427 +00036 * REPORT RECORDS INPUT: DTSBX427 +00037 * NONE DTSBX427 +00038 * DTSBX427 +00039 * TAPES INPUT: DTSBX427 +00040 * NONE. DTSBX427 +00041 * DTSBX427 +00042 * MASTER FILE RECORDS READ: DTSBX427 +00043 * MHDR DTSBX427 +00044 * MPRF DTSBX427 +00045 * MTAD DTSBX427 +00046 * DTSBX427 +00047 * MASTER FILE RECORDS UPDATED: DTSBX427 +00048 * MPRF (REWRITE). DTSBX427 +00049 * MTAD (REWRITE). DTSBX427 +00050 * MELOG(WRITTEN). DTSBX427 +00051 * DTSBX427 +00052 * RECORDS READ: DTSBX427 +00053 * ESSP ADDRESS FILE (X110). CL**2 +00054 * DTSBX427 +00055 * MODULES CALLED: DTSBX427 +00056 * DTSBU203 FIELD ZIP AND JS ZIP DETERMINATION. DTSBX427 +00057 * DTSBU910 MASTER FILE I/O. DTSBX427 +00058 * DTSBU921 ALTERNATE INDEX I/O. DTSBX427 +00059 * DTSBX427 +00060 ***** DTSBX427 +00061 SKIP3 DTSBX427 +00062 ENVIRONMENT DIVISION. DTSBX427 +00063 CONFIGURATION SECTION. CL*82 +00064 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*82 +00065 SKIP2 CL*82 +00066 CL*82 +00067 INPUT-OUTPUT SECTION. DTSBX427 +00068 DTSBX427 +00069 FILE-CONTROL. DTSBX427 +00070 SELECT REPT-PAID-FILE ASSIGN TO X427RPT1 CL*75 +00071 FILE STATUS IS REPT-STATUS. CL*75 +00072 CL*75 +00073 SELECT REPT-PEND-FILE ASSIGN TO X427RPT2 CL*75 +00074 FILE STATUS IS REPT-STATUS. CL*75 +00075 CL*75 +00076 SELECT ESSP-X110-FILE ASSIGN TO DTSFX110. CL**2 +00077 DATA DIVISION. DTSBX427 +00078 DTSBX427 +00079 FILE SECTION. DTSBX427 +00080 DTSBX427 +00081 FD ESSP-X110-FILE CL**2 +00082 LABEL RECORDS ARE STANDARD DTSBX427 +00083 RECORDING MODE IS F DTSBX427 +00084 BLOCK CONTAINS 0 RECORDS. DTSBX427 +00085 DTSBX427 +00086 01 ESSP-X110-REC PIC X(512). CL*67 +00087 CL*75 +00088 FD REPT-PAID-FILE CL*75 +00089 RECORDING MODE IS F CL*75 +00090 BLOCK CONTAINS 0 RECORDS CL*75 +00091 LABEL RECORDS ARE OMITTED. CL*75 +00092 CL*75 +00093 01 REPT-PAID-REC PIC X(200). CL*75 +00094 CL*75 +00095 CL*75 +00096 FD REPT-PEND-FILE CL*75 +00097 RECORDING MODE IS F CL*75 +00098 BLOCK CONTAINS 0 RECORDS CL*75 +00099 LABEL RECORDS ARE OMITTED. CL*75 +00100 CL*75 +00101 01 REPT-PEND-REC PIC X(133). CL*75 +00102 CL*75 +00103 CL*75 +00104 EJECT DTSBX427 +00105 DTSBX427 +00106 WORKING-STORAGE SECTION. DTSBX427 +001065 77 PAN-VALET PICTURE X(24) VALUE '094DTSBX427 02/27/20'. DTSBX427 +00107 77 PAN-VALET PICTURE X(24) VALUE '062DTSBX427 03/06/07'. DTSBX427 +00108 SKIP3 DTSBX427 +00109 01 WRK-AREA. DTSBX427 +00110 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +427. CL**2 +00111 05 ABEND-MSG PIC X(60). DTSBX427 +00112 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBX427 +00113 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +1000. CL*29 +00114 05 W-EMP-NO PIC S9(07) COMP-3 VALUE +0. CL*77 +00115 CL*77 +00116 05 UPD-MTAD-IND PIC 9(01) VALUE 0. CL**7 +00117 05 WRK-MPRF-MAIL-UPD-CNT PIC 9 VALUE 0. CL*55 +00118 05 WRK-MTAD-MAIL-UPD-CNT PIC 9 VALUE 0. CL*55 +00119 05 WRK-MTAD-MAIL-ADD-CNT PIC 9 VALUE 0. CL*55 +00120 05 X110-EOF-IND PIC X(01). CL**7 +00121 05 WRK-MPRF-ADD-CNT PIC S9(07) COMP-3. CL*18 +00122 05 WRK-MPRF-UPD-CNT PIC S9(07) COMP-3. CL*18 +00123 05 WRK-MPRF-NOT-CNT PIC S9(07) COMP-3. CL*19 +00124 05 WRK-MTAD-ADD-CNT PIC S9(07) COMP-3. CL*18 +00125 05 WRK-MTAD-UPD-CNT PIC S9(07) COMP-3. CL*18 +00126 05 WRK-MDCD-ADD-CNT PIC S9(07) COMP-3. CL*18 +00127 05 WRK-MDCD-UPD-CNT PIC S9(07) COMP-3. CL*18 +00128 05 WRK-MLOG-REC-CNT PIC S9(07) COMP-3. DTSBX427 +00129 05 WRK-X110-REC-CNT PIC S9(07) COMP-3. CL**5 +00130 05 W-T002-ADDR-CNT PIC S9(07) COMP-3. CL*13 +00131 05 REPT-STATUS PIC X(02). CL*76 +00132 88 REPT-STATUS-OK-88 VALUE '00'. CL*76 +00133 88 REPT-STATUS-EOF-88 VALUE '10'. CL*76 +00134 CL*76 +00135 CL*21 +00136 05 W-ERROR-IND PIC X(01) VALUE 'N'. CL*21 +00137 88 W-ERROR-YES-88 VALUE 'Y'. CL*21 +00138 88 W-ERROR-NO-88 VALUE 'N'. CL*21 +00139 CL*21 +00140 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. CL*21 +00141 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. CL*21 +00142 88 W-FATAL-ERROR-NO-88 VALUE 'N'. CL*21 +00143 CL*21 +00144 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBX427 +00145 05 WRK-TAD-EMP-NO PIC S9(07) COMP-3. DTSBX427 +00146 05 WRK-MTAD-ZIP-UPDATED-IND PIC X(01). DTSBX427 +00147 DTSBX427 +00148 05 WRK-ID-NO-9 PIC 9(03). DTSBX427 +00149 05 WRK-ID-NO-X REDEFINES WRK-ID-NO-9 DTSBX427 +00150 PIC X(03). DTSBX427 +00151 05 WRK-ZIP. CL**3 +00152 10 WRK-ZIP-5 PIC X(05). CL**3 +00153 10 WRK-DASH PIC X(01) VALUE '-'. CL**3 +00154 10 WRK-ZIP-PLUS4 PIC X(04). CL**3 +00155 01 HEADER-3. CL*75 +00156 05 FILLER PIC X(01) VALUE SPACES. CL*75 +00157 05 FILLER PIC X(38) VALUE CL*75 +00158 ' TAX STATUS STAFF'. CL*84 +00159 05 HDR3-LITERAL PIC X(43) VALUE CL*75 +00160 ' ESSP DAILY ADDRESS UPDATES '. CL*84 +00161 05 FILLER PIC X(28) VALUE SPACES. CL*75 +00162 * 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*75 +00163 * 05 HDR3-PAGE PIC ZZ,ZZ9. CL*75 +00164 01 HEADER-43. CL*75 +00165 05 FILLER PIC X(02) VALUE SPACES. CL*75 +00166 05 FILLER PIC X(52) VALUE CL*80 +00167 'EMP NO TYPE QAS ATTN LINE1'. CL*80 +00168 05 FILLER PIC X(27) VALUE CL*80 +00169 ' LINE2'. CL*80 +00170 05 FILLER PIC X(22) VALUE SPACES. CL*85 +00171 05 FILLER PIC X(44) VALUE CL*85 +00172 ' CITY ST '. CL*94 +00173 05 HDR5-NAME PIC X(31) VALUE CL*75 +00174 'ZIP EMAIL '. CL*93 +00175 DTSBX427 +00176 CL*66 +00177 01 BLANK-LINE PIC X(200) VALUE SPACES. CL*85 +00178 01 DETAIL-LINE-1. CL*85 +00179 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00180 15 X427-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*75 +00181 15 FILLER PIC X(03) VALUE SPACES. CL*80 +00182 15 X427-TYPE PIC X(02). CL*79 +00183 15 FILLER PIC X(04) VALUE SPACES. CL*80 +00184 15 X427-QAS PIC X(01). CL*75 +00185 15 FILLER PIC X(03) VALUE SPACES. CL*84 +00186 15 X427-ATTN PIC X(20). CL*75 +00187 15 FILLER PIC X(07) VALUE SPACES. CL*80 +00188 15 X427-LINE1 PIC X(25). CL*75 +00189 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00190 15 X427-LINE2 PIC X(40). CL*92 +00191 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00192 15 X427-CITY PIC X(20). CL*92 +00193 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00194 15 X427-STATE PIC X(02). CL*75 +00195 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00196 15 X427-ZIP PIC X(10). CL*75 +00197 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00198 15 X427-EMAIL PIC X(30). CL*75 +00199 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00200 15 X427-MESSAGE PIC X(10) VALUE SPACES. CL*79 +00201 CL*75 +00202 01 DETAIL-PEND-1. CL*75 +00203 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00204 15 P427-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*75 +00205 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00206 15 P427-TYPE PIC X(01). CL*75 +00207 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00208 15 P427-ATTN PIC X(20). CL*75 +00209 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00210 15 P427-LINE1 PIC X(25). CL*75 +00211 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00212 15 P427-LINE2 PIC X(25). CL*75 +00213 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00214 15 P427-CITY PIC X(15). CL*75 +00215 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00216 15 P427-STATE PIC X(02). CL*75 +00217 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00218 15 P427-ZIP PIC X(10). CL*75 +00219 15 FILLER PIC X(02) VALUE SPACES. CL*75 +00220 15 P427-MESSAGE PIC X(10). CL*75 +00221 CL*75 +00222 01 FOOTING-LINE-51. CL*75 +00223 05 FILLER PIC X(25) VALUE SPACES. CL*75 +00224 05 WS-X110-PEN-CNT PIC ZZ,ZZ9. CL*75 +00225 05 FILLER PIC X(02) VALUE SPACES. CL*75 +00226 05 FILLER PIC X(40) VALUE CL*75 +00227 '# OF ADDRESSES RECEIVED FROM ESSP '. CL*75 +00228 05 FILLER PIC X(32) VALUE SPACES. CL*75 +00229 CL*75 +00230 01 FOOTING-LINE-6. CL*75 +00231 05 FILLER PIC X(25) VALUE SPACES. CL*75 +00232 05 WS-X102-RED-CNT PIC ZZ,ZZ9. CL*75 +00233 05 FILLER PIC X(02) VALUE SPACES. CL*75 +00234 05 FILLER PIC X(45) VALUE CL*75 +00235 '# OF ADDRESSES DUTAS PASSED '. CL*89 +00236 05 FILLER PIC X(32) VALUE SPACES. CL*75 +00237 01 FOOTING-LINE-7. CL*75 +00238 05 FILLER PIC X(25) VALUE SPACES. CL*75 +00239 05 WS-X102-ERR-CNT PIC ZZ,ZZ9. CL*75 +00240 05 FILLER PIC X(02) VALUE SPACES. CL*75 +00241 05 FILLER PIC X(40) VALUE CL*75 +00242 '# OF ADDRESSES DUTAS FAILED '. CL*75 +00243 05 FILLER PIC X(32) VALUE SPACES. CL*75 +00244 CL*75 +00245 01 X110-REC. CL*75 +00246 ++INCLUDE DTSUX110 CL*66 +00247 EJECT CL*66 +00248 CL*66 +00249 CL*18 +00250 01 R140-REC. CL*18 +00251 ++INCLUDE DTSIR140 CL*18 +00252 EJECT DTSBX427 +00253 CL*47 +00254 01 L009-LINK-AREA. CL*47 +00255 ++INCLUDE DTSIL009 CL*47 +00256 EJECT CL*47 +00257 01 L005-LINK-AREA. DTSBX427 +00258 ++INCLUDE DTSIL005 DTSBX427 +00259 EJECT DTSBX427 +00260 01 L203-LINK-AREA. DTSBX427 +00261 ++INCLUDE DTSIL203 DTSBX427 +00262 EJECT DTSBX427 +00263 01 L331-LINK-AREA. DTSBX427 +00264 ++INCLUDE DTSIL331 DTSBX427 +00265 EJECT DTSBX427 +00266 01 L910-LINK-AREA. DTSBX427 +00267 ++INCLUDE DTSIL910 DTSBX427 +00268 EJECT DTSBX427 +00269 01 MSKL-REC. DTSBX427 +00270 ++INCLUDE DTSIMSKL DTSBX427 +00271 EJECT DTSBX427 +00272 01 MHDR-REC. DTSBX427 +00273 ++INCLUDE DTSIMHDR DTSBX427 +00274 EJECT DTSBX427 +00275 01 MPRF-REC. DTSBX427 +00276 ++INCLUDE DTSIMPRF DTSBX427 +00277 EJECT DTSBX427 +00278 CL*12 +00279 01 T002-REC. CL*12 +00280 ++INCLUDE DTSIT002 CL*12 +00281 CL*12 +00282 * ADDRESS CL*12 +00283 01 Y110-REC. CL*12 +00284 ++INCLUDE DTSIY110 CL*12 +00285 CL*12 +00286 01 MTAD-REC. DTSBX427 +00287 ++INCLUDE DTSIMTAD DTSBX427 +00288 EJECT DTSBX427 +00289 01 L921-LINK-AREA. DTSBX427 +00290 ++INCLUDE DTSIL921 DTSBX427 +00291 CL*12 +00292 01 L927-LINK-AREA. CL*12 +00293 ++INCLUDE DTSIL927 CL*12 +00294 CL*12 +00295 01 TSKL-REC. CL*12 +00296 ++INCLUDE DTSITSKL CL*12 +00297 CL*12 +00298 EJECT DTSBX427 +00299 01 ISKL-REC. DTSBX427 +00300 ++INCLUDE DTSIISKL DTSBX427 +00301 EJECT DTSBX427 +00302 PROCEDURE DIVISION. DTSBX427 +00303 DTSBX427 +00304 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX427 +00305 DTSBX427 +00306 MOVE 'N' TO X110-EOF-IND. CL**5 +00307 DTSBX427 +00308 MOVE +0 TO WRK-EMP-NO WRK-TAD-EMP-NO. DTSBX427 +00309 DTSBX427 +00310 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND. DTSBX427 +00311 DTSBX427 +00312 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX427 +00313 UNTIL X110-EOF-IND = 'Y'. CL**3 +00314 DTSBX427 +00315 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX427 +00316 IF W-ERROR-YES-88 CL*18 +00317 MOVE 02 TO RETURN-CODE. CL*36 +00318 DTSBX427 +00319 GOBACK. DTSBX427 +00320 EJECT DTSBX427 +00321 DTSBX427 +00322 I0000-INITIATE. DTSBX427 +00323 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBX427 +00324 DTSBX427 +00325 PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBX427 +00326 DTSBX427 +00327 PERFORM S927A-OPEN-UPDATE THRU S927A-EXIT. CL*19 +00328 CL*16 +00329 OPEN INPUT ESSP-X110-FILE. CL**6 +00330 OPEN OUTPUT REPT-PAID-FILE REPT-PEND-FILE. CL*75 +00331 DTSBX427 +00332 WRITE REPT-PAID-REC FROM HEADER-3 CL*82 +00333 AFTER ADVANCING TOP-OF-PAGE CL*82 +00334 CL*82 +00335 WRITE REPT-PAID-REC FROM HEADER-43 CL*83 +00336 AFTER ADVANCING 2 LINE. CL*85 +00337 WRITE REPT-PAID-REC FROM BLANK-LINE CL*85 +00338 AFTER ADVANCING 1 LINE. CL*85 +00339 MOVE +0 TO WRK-MPRF-UPD-CNT CL*19 +00340 W-T002-ADDR-CNT CL*30 +00341 WRK-MTAD-UPD-CNT CL*19 +00342 WRK-MPRF-NOT-CNT CL*20 +00343 WRK-MPRF-ADD-CNT CL*19 +00344 WRK-MTAD-ADD-CNT CL*19 +00345 WRK-MDCD-ADD-CNT CL*26 +00346 WRK-MDCD-UPD-CNT CL*26 +00347 WRK-MLOG-REC-CNT CL*26 +00348 WRK-X110-REC-CNT. CL**5 +00349 DTSBX427 +00350 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX427 +00351 DTSBX427 +00352 MOVE +0 TO MSKL-EMP-NO. DTSBX427 +00353 DTSBX427 +00354 SET MSKL-HDR-88 TO TRUE. DTSBX427 +00355 DTSBX427 +00356 PERFORM S910-READ THRU S910-EXIT. DTSBX427 +00357 DTSBX427 +00358 IF L910-NO-REC-88 DTSBX427 +00359 MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG DTSBX427 +00360 PERFORM S999-ABEND THRU S999-EXIT. DTSBX427 +00361 DTSBX427 +00362 MOVE MSKL-REC TO MHDR-REC. DTSBX427 +00363 DTSBX427 +00364 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX427 +00365 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. DTSBX427 +00366 MOVE LENGTH OF R140-REC TO R140-LENGTH. CL*18 +00367 MOVE '140' TO R140-REC-TYPE. CL*18 +00368 DTSBX427 +00369 I0000-EXIT. DTSBX427 +00370 EXIT. DTSBX427 +00371 DTSBX427 +00372 P0000-PROCESS. DTSBX427 +00373 READ ESSP-X110-FILE INTO X110-REC CL*66 +00374 AT END DTSBX427 +00375 MOVE 'Y' TO X110-EOF-IND CL**3 +00376 PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT DTSBX427 +00377 GO TO P0000-EXIT. DTSBX427 +00378 DTSBX427 +00379 ADD +1 TO WRK-X110-REC-CNT. CL**3 +00380 DTSBX427 +00381 DTSBX427 +00382 * IF X110-EMP-NO = WRK-EMP-NO OR CL*68 +00383 * WRK-X110-REC-CNT = 1 CL*68 +00384 * NEXT SENTENCE CL*68 +00385 * ELSE CL*68 +00386 * PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT CL*68 +00387 * IF L910-NO-REC-88 CL*68 +00388 * DISPLAY ' EMPL NOT FOUND IN DUTAS ADDR NOT ADDED> ' CL*68 +00389 * X110-EMP-NO CL*68 +00390 * GO TO P0000-EXIT. CL*68 +00391 IF X110-STREET-2 = SPACES CL*72 +00392 MOVE X110-STREET-1 TO X110-STREET-2 CL*72 +00393 MOVE SPACES TO X110-STREET-1. CL*72 +00394 CL*62 +00395 MOVE X110-EMP-NO TO WRK-EMP-NO CL*62 +00396 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND CL*62 +00397 MOVE X110-EMP-NO TO L331-EMP-NO CL*62 +00398 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*62 +00399 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*62 +00400 MOVE 'WEBESSP ' TO L331-OP-ID. CL*62 +00401 DTSBX427 +00402 MOVE LOW-VALUES TO MTAD-KEY-AREA. CL**4 +00403 IF X110-ADDR-TYPE-MAIL-88 CL**3 +00404 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE CL**3 +00405 ELSE CL**3 +00406 IF X110-ADDR-TYPE-RECS-88 CL**3 +00407 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE CL**3 +00408 ELSE CL**3 +00409 SET W-ERROR-YES-88 TO TRUE CL*18 +00410 MOVE SPACES TO R140-MESSAGE CL*18 +00411 MOVE WRK-EMP-NO TO R140-EMP-NO CL*19 +00412 STRING CL*18 +00413 'X427 INV ADDR CODE ON X110 ADDR REC ' X110-ADDR-TYPE CL*19 +00414 DELIMITED BY SIZE CL*18 +00415 INTO R140-MESSAGE CL*18 +00416 END-STRING CL*18 +00417 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*18 +00418 GO TO P0000-EXIT. CL**3 +00419 CL**3 +00420 IF MTAD-ID-TAX-RECORDS-ADDR-88 AND X110-STATE NOT = 'DC' CL*42 +00421 SET W-ERROR-YES-88 TO TRUE CL*34 +00422 MOVE SPACES TO R140-MESSAGE CL*34 +00423 MOVE WRK-EMP-NO TO R140-EMP-NO CL*34 +00424 STRING CL*34 +00425 'X427 STATE NOT DC FOR DC ADDRESS ' X110-STATE CL*34 +00426 DELIMITED BY SIZE CL*34 +00427 INTO R140-MESSAGE CL*34 +00428 END-STRING CL*34 +00429 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*34 +00430 GO TO P0000-EXIT. CL*34 +00431 CL*34 +00432 MOVE ZEROS TO UPD-MTAD-IND CL**5 +00433 CL**5 +00434 DISPLAY '+++++++ CHECKING FOR ADDRESS UPDATES: ' X110-EMP-NO. CL*57 +00435 PERFORM P1000-MTAD-UPDATE THRU P1000-EXIT. CL**3 +00436 CL*78 +00437 MOVE X110-EMP-NO TO X427-EMP-NO. CL*78 +00438 MOVE X110-ADDR-TYPE TO X427-TYPE CL*78 +00439 MOVE X110-ATTENTION TO X427-ATTN CL*78 +00440 MOVE X110-STREET-1 TO X427-LINE1 CL*78 +00441 MOVE X110-STREET-2 TO X427-LINE2 CL*78 +00442 MOVE X110-CITY TO X427-CITY CL*78 +00443 MOVE X110-STATE TO X427-STATE. CL*78 +00444 MOVE X110-ZIP TO X427-ZIP. CL*78 +00445 MOVE X110-EMAIL TO X427-EMAIL. CL*78 +00446 MOVE X110-QAS-FLAG TO X427-QAS. CL*78 +00447 WRITE REPT-PAID-REC FROM DETAIL-LINE-1. CL*78 +00448 CL**3 +00449 P0000-EXIT. DTSBX427 +00450 EXIT. DTSBX427 +00451 DTSBX427 +00452 P1000-MTAD-UPDATE. DTSBX427 +00453 DTSBX427 +00454 * MOVE LOW-VALUES TO MTAD-KEY-AREA. CL*43 +00455 MOVE X110-EMP-NO TO WRK-TAD-EMP-NO WRK-EMP-NO. CL*44 +00456 DTSBX427 +00457 MOVE WRK-TAD-EMP-NO TO MTAD-EMP-NO. DTSBX427 +00458 SET MTAD-TAD-88 TO TRUE. DTSBX427 +00459 CL**3 +00460 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX427 +00461 DTSBX427 +00462 PERFORM S910-READ THRU S910-EXIT. DTSBX427 +00463 DTSBX427 +00464 IF L910-NO-REC-88 DTSBX427 +00465 * DISPLAY 'MTAD NOT FOUND ' MTAD-KEY-AREA CL*57 +00466 MOVE SPACES TO R140-MESSAGE CL*18 +00467 MOVE WRK-EMP-NO TO R140-EMP-NO CL*19 +00468 IF X110-ADDR-TYPE-MAIL-88 CL*37 +00469 DISPLAY '------ X427 MAIL ADDR NOT IN DUTAS -ADDED ' CL*57 +00470 X110-EMP-NO CL*45 +00471 STRING CL*18 +00472 'X427 MAIL ADDR NOT IN DUTAS -ADDED ' CL*37 +00473 X110-EMP-NO CL*37 +00474 DELIMITED BY SIZE CL*18 +00475 INTO R140-MESSAGE CL*18 +00476 END-STRING CL*18 +00477 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*18 +00478 PERFORM P1050-MTAD-ADD THRU P1050-EXIT CL*18 +00479 PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT CL*68 +00480 GO TO P1000-EXIT CL*37 +00481 ELSE CL*38 +00482 DISPLAY '----- X427 DC ADDR NOT IN DUTAS -ADDED ' CL*57 +00483 X110-EMP-NO CL*45 +00484 STRING CL*37 +00485 'X427 DC ADDR NOT IN DUTAS -ADDED ' CL*37 +00486 X110-EMP-NO CL*37 +00487 DELIMITED BY SIZE CL*37 +00488 INTO R140-MESSAGE CL*37 +00489 END-STRING CL*37 +00490 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*37 +00491 PERFORM P1050-MTAD-ADD THRU P1050-EXIT CL*37 +00492 GO TO P1000-EXIT. CL*37 +00493 CL*18 +00494 MOVE MSKL-REC TO MTAD-REC. DTSBX427 +00495 DTSBX427 +00496 MOVE X110-ZIP TO WRK-ZIP. CL**3 +00497 DTSBX427 +00498 IF WRK-ZIP = MTAD-ZIP CL**3 +00499 MOVE 'N' TO WRK-MTAD-ZIP-UPDATED-IND CL**3 +00500 ELSE DTSBX427 +00501 MOVE 'Y' TO WRK-MTAD-ZIP-UPDATED-IND. DTSBX427 +00502 DTSBX427 +00503 MOVE ZEROS TO UPD-MTAD-IND. CL*32 +00504 CL*32 +00505 PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT. DTSBX427 +00506 DTSBX427 +00507 DTSBX427 +00508 IF UPD-MTAD-IND = 1 CL**5 +00509 DISPLAY '===== DUTAS ADDRESS UPDATED ' X110-EMP-NO CL*56 +00510 MOVE MHDR-CURR-RUN-DATE TO MTAD-CHNG-DATE CL**5 +00511 MOVE MTAD-REC TO MSKL-REC CL**5 +00512 PERFORM S910-REWRITE THRU S910-EXIT CL*68 +00513 PERFORM P2000-EMP-NO-BREAK THRU P2000-EXIT. CL*68 +00514 DTSBX427 +00515 P1000-EXIT. DTSBX427 +00516 EXIT. DTSBX427 +00517 DTSBX427 +00518 P1050-MTAD-ADD. CL*11 +00519 MOVE +0 TO WRK-MTAD-MAIL-ADD-CNT. CL*51 +00520 IF X110-ADDR-TYPE-MAIL-88 CL*35 +00521 ADD +1 TO WRK-MTAD-ADD-CNT CL*18 +00522 MOVE +1 TO WRK-MTAD-MAIL-ADD-CNT CL*51 +00523 * DISPLAY '<<< X427--ADDIN T002 MAIL ADDR ' WRK-EMP-NO CL*57 +00524 ELSE CL*18 +00525 * DISPLAY '<<< X427--ADDIN T002 DC ADDR ' WRK-EMP-NO CL*57 +00526 ADD +1 TO WRK-MDCD-ADD-CNT. CL*18 +00527 CL*18 +00528 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*13 +00529 MOVE LOW-VALUES TO T002-REC. CL*11 +00530 CL*11 +00531 SET T002-LENGTH-EMP-ADDR-88 TO TRUE. CL*11 +00532 MOVE '002' TO T002-REC-TYPE. CL*11 +00533 MOVE X110-EMP-NO TO T002-EMP-NO. CL*13 +00534 MOVE 'WEB ESSP ' TO T002-ORIGIN. CL*12 +00535 MOVE L005-DATE TO T002-SYS-DATE. CL*13 +00536 MOVE L005-TIME TO T002-SYS-TIME. CL*13 +00537 CL*11 +00538 MOVE X110-ADDR-TYPE TO Y110-EMP-ADDR-TYPE. CL*11 +00539 CL*47 +00540 IF X110-ATTENTION > SPACES CL*47 +00541 MOVE X110-ATTENTION TO L009-DATA CL*47 +00542 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 +00543 MOVE L009-DATA TO Y110-EMP-ATTN CL*49 +00544 ELSE CL*47 +00545 MOVE X110-ATTENTION TO Y110-EMP-ATTN. CL*11 +00546 CL*47 +00547 IF X110-STREET-1 > SPACES CL*47 +00548 MOVE X110-STREET-1 TO L009-DATA CL*47 +00549 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 +00550 MOVE L009-DATA TO Y110-EMP-DELV1 CL*47 +00551 ELSE CL*47 +00552 MOVE X110-STREET-1 TO Y110-EMP-DELV1. CL*11 +00553 CL*47 +00554 IF X110-STREET-2 > SPACES CL*47 +00555 MOVE X110-STREET-2 TO L009-DATA CL*47 +00556 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 +00557 MOVE L009-DATA TO Y110-EMP-DELV2 CL*47 +00558 ELSE CL*47 +00559 MOVE X110-STREET-2 TO Y110-EMP-DELV2. CL*11 +00560 CL*47 +00561 IF X110-CITY > SPACES CL*47 +00562 MOVE X110-CITY TO L009-DATA CL*47 +00563 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 +00564 MOVE L009-DATA TO Y110-EMP-CITY CL*47 +00565 ELSE CL*47 +00566 MOVE X110-CITY TO Y110-EMP-CITY. CL*11 +00567 CL*47 +00568 IF X110-STATE > SPACES CL*47 +00569 MOVE X110-STATE TO L009-DATA CL*47 +00570 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*47 +00571 MOVE L009-DATA TO Y110-EMP-STATE CL*47 +00572 ELSE CL*47 +00573 MOVE X110-STATE TO Y110-EMP-STATE. CL*11 +00574 * MOVE X110-STATE TO Y110-EMP-STATE. CL*51 +00575 MOVE X110-ZIP TO Y110-EMP-ZIP. CL*11 +00576 MOVE X110-PHONE TO Y110-EMP-VOICE. CL*11 +00577 MOVE X110-FAX TO Y110-EMP-FAX. CL*11 +00578 MOVE X110-EMAIL TO Y110-EMP-EMAIL. CL*11 +00579 MOVE Y110-REC TO T002-DATA-AREA. CL*11 +00580 SET T002-EMP-ADDR-88 TO TRUE. CL*11 +00581 MOVE T002-REC TO TSKL-REC. CL*11 +00582 PERFORM S927B-WRITE THRU S927B-EXIT. CL*11 +00583 ADD +1 TO W-T002-ADDR-CNT. CL*11 +00584 CL*11 +00585 P1050-EXIT. CL*11 +00586 EXIT. CL*11 +00587 CL*11 +00588 P1100-CHECK-FOR-MLOG. DTSBX427 +00589 DTSBX427 +00590 MOVE 0 TO WRK-MTAD-MAIL-UPD-CNT. CL*55 +00591 ADD +100 TO WRK-ABSTIME CL*29 +00592 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*27 +00593 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*27 +00594 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*44 +00595 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*27 +00596 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME. CL*29 +00597 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*27 +00598 MOVE 'WEBESSP ' TO L331-OP-ID. CL*41 +00599 CL*24 +00600 IF MTAD-ID-TAX-MAILING-ADDR-88 DTSBX427 +00601 MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID DTSBX427 +00602 * ADD +1 TO WRK-MTAD-ADD-CNT CL*46 +00603 ELSE DTSBX427 +00604 IF MTAD-ID-TAX-RECORDS-ADDR-88 DTSBX427 +00605 MOVE 'RECORDS ADDRESS' TO L331-REC-OCC-ID DTSBX427 +00606 * ADD +1 TO WRK-MDCD-ADD-CNT CL*46 +00607 ELSE DTSBX427 +00608 MOVE MTAD-ID-NO TO WRK-ID-NO-9 DTSBX427 +00609 MOVE WRK-ID-NO-X TO L331-REC-OCC-ID. DTSBX427 +00610 DTSBX427 +00611 MOVE X110-ATTENTION TO L009-DATA CL*69 +00612 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 +00613 MOVE L009-DATA TO X110-ATTENTION CL*69 +00614 IF X110-ATTENTION = MTAD-ATTN-LINE CL**5 +00615 NEXT SENTENCE DTSBX427 +00616 ELSE DTSBX427 +00617 MOVE 'MTAD-ATTENTION ' TO L331-FIELD-NAME CL**3 +00618 MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE CL**5 +00619 DISPLAY 'MTAD-ATTENTION B ' MTAD-ATTN-LINE CL**7 +00620 MOVE X110-ATTENTION TO L331-TO-VALUE CL**4 +00621 MOVE X110-ATTENTION TO MTAD-ATTN-LINE CL**5 +00622 DISPLAY 'MTAD-ATTENTION A ' X110-ATTENTION CL**7 +00623 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 +00624 MOVE 1 TO UPD-MTAD-IND CL**5 +00625 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 +00626 DTSBX427 +00627 CL**3 +00628 MOVE X110-STREET-1 TO L009-DATA CL*69 +00629 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 +00630 MOVE L009-DATA TO X110-STREET-1 CL*69 +00631 IF X110-STREET-1 = MTAD-DELIV-LINE-1 CL**6 +00632 NEXT SENTENCE CL**3 +00633 ELSE CL**3 +00634 MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME CL**4 +00635 MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE CL**4 +00636 DISPLAY 'MTAD-DELV LIN1 B ' MTAD-DELIV-LINE-1 CL**7 +00637 MOVE X110-STREET-1 TO MTAD-DELIV-LINE-1 CL**6 +00638 MOVE X110-STREET-1 TO L331-TO-VALUE CL*52 +00639 DISPLAY 'MTAD-DELV LIN1 A ' X110-STREET-1 CL**7 +00640 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 +00641 MOVE 1 TO UPD-MTAD-IND CL**5 +00642 ADD +1 TO WRK-MLOG-REC-CNT. CL**3 +00643 CL**3 +00644 MOVE X110-STREET-2 TO L009-DATA CL*69 +00645 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 +00646 MOVE L009-DATA TO X110-STREET-2 CL*69 +00647 CL**4 +00648 IF X110-STREET-2 = MTAD-DELIV-LINE-2 CL**6 +00649 NEXT SENTENCE CL**4 +00650 ELSE CL**4 +00651 MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME CL**4 +00652 MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE CL**4 +00653 DISPLAY 'MTAD-DELV LIN2 B ' MTAD-DELIV-LINE-2 CL**7 +00654 MOVE X110-STREET-2 TO L331-TO-VALUE CL**6 +00655 MOVE X110-STREET-2 TO MTAD-DELIV-LINE-2 CL**6 +00656 DISPLAY 'MTAD-DELV LIN3 A ' X110-STREET-2 CL**7 +00657 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 +00658 MOVE 1 TO UPD-MTAD-IND CL**5 +00659 ADD +1 TO WRK-MLOG-REC-CNT. CL**4 +00660 CL**4 +00661 MOVE X110-CITY TO L009-DATA CL*69 +00662 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 +00663 MOVE L009-DATA TO X110-CITY CL*69 +00664 IF X110-CITY = MTAD-CITY CL**4 +00665 NEXT SENTENCE DTSBX427 +00666 ELSE DTSBX427 +00667 MOVE 'MTAD-CITY' TO L331-FIELD-NAME DTSBX427 +00668 MOVE MTAD-CITY TO L331-FROM-VALUE DTSBX427 +00669 DISPLAY 'MTAD-CITY B ' MTAD-CITY CL**7 +00670 MOVE X110-CITY TO L331-TO-VALUE CL**6 +00671 MOVE X110-CITY TO MTAD-CITY CL**6 +00672 DISPLAY 'MTAD-CITY A ' X110-CITY CL**7 +00673 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 +00674 MOVE 1 TO UPD-MTAD-IND CL**5 +00675 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 +00676 DTSBX427 +00677 MOVE X110-STATE TO L009-DATA CL*69 +00678 PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT CL*69 +00679 MOVE L009-DATA TO X110-STATE CL*69 +00680 IF X110-STATE = MTAD-ST CL**4 +00681 NEXT SENTENCE DTSBX427 +00682 ELSE DTSBX427 +00683 MOVE 'MTAD-ST' TO L331-FIELD-NAME DTSBX427 +00684 MOVE MTAD-ST TO L331-FROM-VALUE DTSBX427 +00685 DISPLAY 'MTAD-STATE B ' MTAD-ST CL**7 +00686 MOVE X110-STATE TO L331-TO-VALUE CL**4 +00687 MOVE X110-STATE TO MTAD-ST CL**5 +00688 DISPLAY 'MTAD-STATE A ' X110-STATE CL**7 +00689 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 +00690 MOVE 1 TO UPD-MTAD-IND CL**5 +00691 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 +00692 DTSBX427 +00693 IF WRK-ZIP = MTAD-ZIP CL**4 +00694 NEXT SENTENCE DTSBX427 +00695 ELSE DTSBX427 +00696 MOVE 'MTAD-ZIP' TO L331-FIELD-NAME DTSBX427 +00697 MOVE MTAD-ZIP TO L331-FROM-VALUE DTSBX427 +00698 DISPLAY 'MTAD-ZIP B ' MTAD-ZIP CL**7 +00699 MOVE WRK-ZIP TO L331-TO-VALUE CL**4 +00700 MOVE WRK-ZIP TO MTAD-ZIP CL**6 +00701 DISPLAY 'MTAD-ZIP A ' MTAD-ZIP CL*38 +00702 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 +00703 MOVE 1 TO UPD-MTAD-IND CL**6 +00704 ADD +1 TO WRK-MLOG-REC-CNT. DTSBX427 +00705 DTSBX427 +00706 P1100-CHECK-EMAIL. CL*91 +00707 IF X110-EMAIL = SPACES CL*91 +00708 GO TO P1100-CHECK-PHONE. CL*91 +00709 CL*91 +00710 IF X110-EMAIL = MTAD-EMAIL-ADDRESS CL*91 +00711 NEXT SENTENCE CL**4 +00712 ELSE CL**4 +00713 MOVE 'MTAD-EMAIL ADDR' TO L331-FIELD-NAME CL**4 +00714 MOVE MTAD-EMAIL-ADDRESS TO L331-FROM-VALUE CL**4 +00715 DISPLAY 'MTAD-EMAIL B ' MTAD-EMAIL-ADDRESS CL**7 +00716 MOVE X110-EMAIL TO L331-TO-VALUE CL**4 +00717 MOVE X110-EMAIL TO MTAD-EMAIL-ADDRESS CL**5 +00718 DISPLAY 'MTAD-EMAIL A ' X110-EMAIL CL**7 +00719 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*14 +00720 MOVE 1 TO UPD-MTAD-IND CL**5 +00721 ADD +1 TO WRK-MLOG-REC-CNT. CL**4 +00722 CL*38 +00723 P1100-CHECK-PHONE. CL*91 +00724 IF X110-PHONE = SPACES CL*91 +00725 GO TO P1100-CHECK-MTAD. CL*91 +00726 CL*91 +00727 IF X110-PHONE = MTAD-VOICE-1 CL*90 +00728 NEXT SENTENCE CL*90 +00729 ELSE CL*90 +00730 MOVE 'MTAD-PHONE ' TO L331-FIELD-NAME CL*90 +00731 MOVE MTAD-VOICE-1 TO L331-FROM-VALUE CL*90 +00732 DISPLAY 'MTAD-PHONE B ' MTAD-VOICE-1 CL*90 +00733 MOVE X110-PHONE TO L331-TO-VALUE CL*90 +00734 MOVE X110-PHONE TO MTAD-VOICE-1 CL*90 +00735 DISPLAY 'MTAD-PHONE A ' X110-PHONE CL*90 +00736 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*90 +00737 MOVE 1 TO UPD-MTAD-IND CL*90 +00738 ADD +1 TO WRK-MLOG-REC-CNT. CL*90 +00739 CL*90 +00740 P1100-CHECK-MTAD. CL*91 +00741 IF UPD-MTAD-IND = 0 CL*38 +00742 GO TO P1100-EXIT. CL*39 +00743 CL*38 +00744 IF X110-ADDR-TYPE-MAIL-88 CL*38 +00745 MOVE +1 TO WRK-MTAD-MAIL-UPD-CNT CL*51 +00746 DISPLAY '<<<< ---X427 DUTAS MAILING ADDR ' WRK-EMP-NO CL*55 +00747 STRING CL*38 +00748 'X427 DUTAS MAILING ADDRESS ' CL*38 +00749 X110-EMP-NO CL*38 +00750 DELIMITED BY SIZE CL*38 +00751 INTO R140-MESSAGE CL*38 +00752 END-STRING CL*38 +00753 MOVE WRK-EMP-NO TO R140-EMP-NO CL*44 +00754 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*38 +00755 ADD +1 TO WRK-MTAD-UPD-CNT CL*46 +00756 ELSE CL*38 +00757 DISPLAY '<<<< ---X427 DUTAS DC WORK ADDR ' WRK-EMP-NO CL*55 +00758 STRING CL*38 +00759 'X427 DUTAS DC ADDRESS ' CL*38 +00760 X110-EMP-NO CL*38 +00761 DELIMITED BY SIZE CL*38 +00762 INTO R140-MESSAGE CL*38 +00763 END-STRING CL*38 +00764 MOVE WRK-EMP-NO TO R140-EMP-NO CL*44 +00765 ADD +1 TO WRK-MDCD-UPD-CNT CL*46 +00766 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*38 +00767 CL**4 +00768 P1100-EXIT. DTSBX427 +00769 EXIT. DTSBX427 +00770 DTSBX427 +00771 P2000-EMP-NO-BREAK. DTSBX427 +00772 CL*33 +00773 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX427 +00774 DTSBX427 +00775 DISPLAY 'OLDE ' WRK-EMP-NO ' NEWE ' X110-EMP-NO. CL*65 +00776 MOVE WRK-EMP-NO TO MSKL-EMP-NO. CL*65 +00777 DTSBX427 +00778 SET MSKL-PRF-88 TO TRUE. DTSBX427 +00779 DTSBX427 +00780 PERFORM S910-READ THRU S910-EXIT. DTSBX427 +00781 DTSBX427 +00782 IF L910-NO-REC-88 DTSBX427 +00783 MOVE SPACES TO R140-MESSAGE CL*18 +00784 MOVE X110-EMP-NO TO R140-EMP-NO CL*32 +00785 STRING CL*18 +00786 'X427 NO EMPLOYER PROFILE FOUND IN DUTAS >>>> ' CL*37 +00787 X110-EMP-NO CL*37 +00788 DELIMITED BY SIZE CL*18 +00789 INTO R140-MESSAGE CL*18 +00790 END-STRING CL*18 +00791 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*18 +00792 ADD +1 TO WRK-MPRF-NOT-CNT CL*18 +00793 GO TO P2000-EXIT. CL*31 +00794 CL*18 +00795 MOVE MSKL-REC TO MPRF-REC. DTSBX427 +00796 MOVE 0 TO WRK-MPRF-MAIL-UPD-CNT. CL*55 +00797 CL*54 +00798 DISPLAY ' MPRF: ' WRK-EMP-NO CL*65 +00799 ' MUPD: ' WRK-MTAD-MAIL-UPD-CNT CL*56 +00800 ' MADD: ' WRK-MTAD-MAIL-ADD-CNT CL*55 +00801 ' MIND: ' MPRF-RETURN-MAIL-IND. CL*55 +00802 CL*51 +00803 * IF MPRF-RETURN-MAIL-IND = 'N' CL*74 +00804 * GO TO P2000-EMP-CONTINUE. CL*74 +00805 CL*70 +00806 IF WRK-MTAD-MAIL-UPD-CNT = 1 OR CL*70 +00807 WRK-MTAD-MAIL-ADD-CNT = 1 CL*59 +00808 ADD +100 TO WRK-ABSTIME CL*51 +00809 PERFORM S005-FROM-SYS THRU S005-EXIT CL*51 +00810 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL*51 +00811 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*51 +00812 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*51 +00813 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL*51 +00814 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*51 +00815 MOVE 'WEBESSP ' TO L331-OP-ID CL*51 +00816 MOVE 'RETURN MAIL IND' TO L331-FIELD-NAME CL*51 +00817 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE CL*51 +00818 MOVE 'N' TO L331-TO-VALUE CL*52 +00819 MOVE 'N' TO MPRF-RETURN-MAIL-IND CL*52 +00820 MOVE +1 TO WRK-MPRF-MAIL-UPD-CNT CL*51 +00821 DISPLAY ' RETURN MAIL UPDATED: ' WRK-EMP-NO CL*52 +00822 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*51 +00823 CL*51 +00824 IF MTAD-UC223-IND = 'N' CL*70 +00825 ADD +100 TO WRK-ABSTIME CL*70 +00826 PERFORM S005-FROM-SYS THRU S005-EXIT CL*70 +00827 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL*70 +00828 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*70 +00829 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*70 +00830 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL*70 +00831 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*70 +00832 MOVE 'WEBESSP ' TO L331-OP-ID CL*70 +00833 MOVE 'DEBIT MEMO IND ' TO L331-FIELD-NAME CL*70 +00834 MOVE MTAD-UC223-IND TO L331-FROM-VALUE CL*70 +00835 MOVE 'Y' TO L331-TO-VALUE CL*70 +00836 MOVE 'Y' TO MTAD-UC223-IND CL*71 +00837 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*70 +00838 CL*70 +00839 IF MTAD-MISSING-RPT-LETTERS-IND = 'N' CL*71 +00840 ADD +100 TO WRK-ABSTIME CL*70 +00841 PERFORM S005-FROM-SYS THRU S005-EXIT CL*70 +00842 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL*70 +00843 MOVE X110-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL*70 +00844 MOVE MHDR-CURR-RUN-DATE TO L331-CURR-RUN-DATE CL*70 +00845 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL*70 +00846 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL*70 +00847 MOVE 'WEBESSP ' TO L331-OP-ID CL*70 +00848 MOVE 'MISS RPT LETTER' TO L331-FIELD-NAME CL*70 +00849 MOVE MTAD-MISSING-RPT-LETTERS-IND TO L331-FROM-VALUE CL*73 +00850 MOVE 'Y' TO L331-TO-VALUE CL*70 +00851 MOVE 'Y' TO MTAD-MISSING-RPT-LETTERS-IND CL*71 +00852 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*70 +00853 CL*70 +00854 DTSBX427 +00855 P2000-EMP-CONTINUE. CL*70 +00856 MOVE MPRF-EMP-NO TO L203-EMP-NO. DTSBX427 +00857 DTSBX427 +00858 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSBX427 +00859 TO L203-TAX-REC-ADDR-EXISTS-IND. DTSBX427 +00860 DTSBX427 +00861 PERFORM S203-FIELD-ZIP-CODE THRU S203-EXIT. DTSBX427 +00862 DTSBX427 +00863 * IF L203-OK-88 CL*56 +00864 * NEXT SENTENCE CL*56 +00865 * ELSE CL*56 +00866 * GO TO P2000-EXIT. CL*56 +00867 DTSBX427 +00868 DISPLAY 'Z203: ' L203-FLD-ZIP ' ' L203-FLD-STATE CL*61 +00869 ' MPRF: ' MPRF-FLD-ZIP ' ' MPRF-FLD-ST CL*60 +00870 ' MAIL: ' WRK-MPRF-MAIL-UPD-CNT. CL*60 +00871 IF ((L203-FLD-ZIP = MPRF-FLD-ZIP) AND CL*60 +00872 (L203-FLD-STATE = MPRF-FLD-ST) AND CL*56 +00873 (WRK-MPRF-MAIL-UPD-CNT = 0)) CL*60 +00874 GO TO P2000-EXIT CL*56 +00875 ELSE CL*56 +00876 MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP CL*56 +00877 MOVE L203-FLD-STATE TO MPRF-FLD-ST. DTSBX427 +00878 DTSBX427 +00879 MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSBX427 +00880 DTSBX427 +00881 MOVE MPRF-REC TO MSKL-REC. DTSBX427 +00882 DTSBX427 +00883 PERFORM S910-REWRITE THRU S910-EXIT. DTSBX427 +00884 ADD +1 TO WRK-MPRF-UPD-CNT. CL*18 +00885 DTSBX427 +00886 P2000-EXIT. DTSBX427 +00887 EXIT. DTSBX427 +00888 DTSBX427 +00889 CL**3 +00890 T0000-TERMINATE. DTSBX427 +00891 DISPLAY DTSBX427 +00892 '*** DTSBX427 TERMINATION STATISTICS'. CL**2 +00893 DTSBX427 +00894 DISPLAY ' '. DTSBX427 +00895 DTSBX427 +00896 DISPLAY DTSBX427 +00897 '*** NUMBER OF X110 FILE RECORDS READ : ' CL**5 +00898 WRK-X110-REC-CNT. CL**5 +00899 MOVE WRK-X110-REC-CNT TO WS-X110-PEN-CNT. CL*87 +00900 DTSBX427 +00901 DISPLAY ' '. DTSBX427 +00902 DTSBX427 +00903 DISPLAY DTSBX427 +00904 '*** NUMBER OF PROFILE RECORDS NOT FOUND : ' CL*40 +00905 WRK-MPRF-NOT-CNT. CL*18 +00906 DTSBX427 +00907 DISPLAY CL*18 +00908 '*** NUMBER OF PROFILE RECORDS UPDATED : ' CL*40 +00909 WRK-MPRF-UPD-CNT. CL*18 +00910 CL*18 +00911 DISPLAY DTSBX427 +00912 '*** NUMBER OF MAIL RECORDS ADDED : ' CL*18 +00913 WRK-MTAD-ADD-CNT. CL*18 +00914 DTSBX427 +00915 DISPLAY CL*20 +00916 '*** NUMBER OF MAIL RECORDS UPDATED : ' CL*18 +00917 WRK-MTAD-UPD-CNT. CL*18 +00918 CL*18 +00919 DISPLAY CL*18 +00920 '*** NUMBER OF DC RECORDS ADDED : ' CL*18 +00921 WRK-MDCD-ADD-CNT. CL*18 +00922 CL*18 +00923 DISPLAY CL*20 +00924 '*** NUMBER OF DC RECORDS UPDATED : ' CL*18 +00925 WRK-MDCD-UPD-CNT. CL*18 +00926 CL*18 +00927 DISPLAY DTSBX427 +00928 '*** NUMBER OF MLOG RECORDS WRITTEN : ' DTSBX427 +00929 WRK-MLOG-REC-CNT. DTSBX427 +00930 DTSBX427 +00931 DTSBX427 +00932 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX427 +00933 DTSBX427 +00934 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX427 +00935 PERFORM S927C-CLOSE THRU S927C-EXIT. CL*20 +00936 DTSBX427 +00937 WRITE REPT-PAID-REC FROM FOOTING-LINE-51 AFTER ADVANCING 3. CL*87 +00938 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER ADVANCING 2. CL*87 +00939 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER ADVANCING 2. CL*87 +00940 CLOSE ESSP-X110-FILE REPT-PAID-FILE REPT-PEND-FILE. CL*75 +00941 T0000-EXIT. DTSBX427 +00942 EXIT. DTSBX427 +00943 EJECT DTSBX427 +00944 S005-FROM-SYS. DTSBX427 +00945 SET L005-FROM-SYS TO TRUE. DTSBX427 +00946 GO TO S005-ABSTIME. DTSBX427 +00947 DTSBX427 +00948 S005-FROM-ABSTIME. DTSBX427 +00949 SET L005-FROM-ABSTIME TO TRUE. DTSBX427 +00950 GO TO S005-ABSTIME. DTSBX427 +00951 DTSBX427 +00952 S005-ABSTIME. DTSBX427 +00953 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX427 +00954 S005-EXIT. DTSBX427 +00955 EXIT. DTSBX427 +00956 SKIP3 DTSBX427 +00957 S203-FIELD-ZIP-CODE. DTSBX427 +00958 CALL 'DTSBU203' USING L203-LINK-AREA. DTSBX427 +00959 S203-EXIT. DTSBX427 +00960 EXIT. DTSBX427 +00961 SKIP3 DTSBX427 +00962 S009-CONVERT-TO-CAPS. CL*47 +00963 CALL 'DTSBU009' USING L009-LINK-AREA. CL*47 +00964 S009-EXIT. CL*47 +00965 EXIT. CL*47 +00966 SKIP3 CL*47 +00967 S331-WRITE-MLOG. DTSBX427 +00968 CALL 'DTSBU331' USING L331-LINK-AREA. DTSBX427 +00969 S331-EXIT. DTSBX427 +00970 EXIT. DTSBX427 +00971 SKIP3 DTSBX427 +00972 S910-OPEN-UPDATE. DTSBX427 +00973 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX427 +00974 GO TO S910-MSTR-CALL. DTSBX427 +00975 DTSBX427 +00976 S910-READ. DTSBX427 +00977 SET L910-READ-88 TO TRUE. DTSBX427 +00978 GO TO S910-MSTR-CALL. DTSBX427 +00979 DTSBX427 +00980 S910-START-BROWSE. DTSBX427 +00981 SET L910-START-BROWSE-88 TO TRUE. DTSBX427 +00982 GO TO S910-MSTR-CALL. DTSBX427 +00983 DTSBX427 +00984 S910-READ-NEXT. DTSBX427 +00985 SET L910-READ-NEXT-88 TO TRUE. DTSBX427 +00986 GO TO S910-MSTR-CALL. DTSBX427 +00987 DTSBX427 +00988 *S910-COUNT. DTSBX427 +00989 *****SET L910-COUNT-88 TO TRUE. DTSBX427 +00990 *****GO TO S910-MSTR-CALL. DTSBX427 +00991 DTSBX427 +00992 S910-REWRITE. DTSBX427 +00993 SET L910-REWRITE-88 TO TRUE. DTSBX427 +00994 GO TO S910-MSTR-CALL. DTSBX427 +00995 DTSBX427 +00996 S910-CLOSE. DTSBX427 +00997 SET L910-CLOSE-88 TO TRUE. DTSBX427 +00998 GO TO S910-MSTR-CALL. DTSBX427 +00999 DTSBX427 +01000 S910-MSTR-CALL. DTSBX427 +01001 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX427 +01002 MSKL-REC. DTSBX427 +01003 S910-EXIT. DTSBX427 +01004 EXIT. DTSBX427 +01005 SKIP3 DTSBX427 +01006 S921-OPEN-UPDATE. DTSBX427 +01007 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX427 +01008 GO TO S921-AIX-IO. DTSBX427 +01009 DTSBX427 +01010 S921-CLOSE. DTSBX427 +01011 SET L921-CLOSE-88 TO TRUE. DTSBX427 +01012 GO TO S921-AIX-IO. DTSBX427 +01013 DTSBX427 +01014 S921-AIX-IO. DTSBX427 +01015 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX427 +01016 ISKL-REC. DTSBX427 +01017 S921-EXIT. DTSBX427 +01018 EXIT. DTSBX427 +01019 SKIP3 DTSBX427 +01020 S927A-OPEN-UPDATE. CL*19 +01021 SET L927-OPEN-UPDATE-88 TO TRUE. CL*19 +01022 PERFORM S927Z-IO THRU S927Z-EXIT. CL*19 +01023 S927A-EXIT. CL*19 +01024 EXIT. CL*19 +01025 CL*19 +01026 S927B-WRITE. CL*12 +01027 SET L927-WRITE-88 TO TRUE. CL*12 +01028 PERFORM S927Z-IO THRU S927Z-EXIT. CL*12 +01029 CL*12 +01030 S927B-EXIT. CL*12 +01031 EXIT. CL*12 +01032 CL*12 +01033 S927C-CLOSE. CL*16 +01034 SET L927-CLOSE-88 TO TRUE. CL*16 +01035 PERFORM S927Z-IO THRU S927Z-EXIT. CL*16 +01036 CL*16 +01037 S927C-EXIT. CL*16 +01038 EXIT. CL*16 +01039 CL*12 +01040 S927Z-IO. CL*12 +01041 CALL 'DTSBU927' USING L927-LINK-AREA CL*12 +01042 TSKL-REC. CL*12 +01043 S927Z-EXIT. CL*12 +01044 EXIT. CL*12 +01045 S946-WRITE-R140. CL*18 +01046 CL*18 +01047 CALL 'DTSBU946' USING R140-REC. CL*18 +01048 CL*18 +01049 S946-EXIT. CL*18 +01050 EXIT. CL*18 +01051 S999-ABEND. DTSBX427 +01052 DISPLAY '*** DTSBX427 ABENDING. ' CL**2 +01053 ABEND-MSG. DTSBX427 +01054 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX427 +01055 S999-EXIT. DTSBX427 +01056 EXIT. DTSBX427 +01057 EJECT DTSBX427 diff --git a/Batch/DTSBX429.cob b/Batch/DTSBX429.cob new file mode 100644 index 0000000..9a1028a --- /dev/null +++ b/Batch/DTSBX429.cob @@ -0,0 +1,1267 @@ +00001 IDENTIFICATION DIVISION. 01/08/15 +00002 PROGRAM-ID. DTSBX429. DTSBX429 +00003 AUTHOR. NGC. LV063 +00004 DATE-WRITTEN. SEPT 2014. CL*29 +00005 DATE-COMPILED. DTSBX429 +00006 SKIP3 DTSBX429 +00007 ***** DTSBX429 +00008 * DTSBX429 +00009 * FUNCTION: CREATE PAYMENT TRANS (T025) FROM TDEC PAYMENT CL*28 +00010 * FILE. PAYMENT WILL BE ADDED TO DUTAS FOR ESSP. CL*28 +00011 * MODIFICATION HISTORY: DTSBX429 +00012 * DTSBX429 +00013 * 09-20-2014 INITIAL DEVELOPMENT CL*19 +00014 * REFERENCE RFP: WEB REGISTRATION ESSP ZL1 CL*19 +00015 * CL*19 +00016 * DTSBX429 +00017 * 01-06-2015 MODIFIED PROGRAM TO PRODUCE REPORT OF ALL CL*49 +00018 * TDEC CHECK DISPOSITION (PAID AND PENDING) ZL1 CL*49 +00019 * CL*49 +00020 ***** DTSBX429 +00021 SKIP3 DTSBX429 +00022 ENVIRONMENT DIVISION. DTSBX429 +00023 CONFIGURATION SECTION. CL*51 +00024 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*51 +00025 CL*51 +00026 INPUT-OUTPUT SECTION. DTSBX429 +00027 DTSBX429 +00028 FILE-CONTROL. DTSBX429 +00029 DTSBX429 +00030 CL*14 +00031 SELECT TDEC-PAYT-FILE ASSIGN TO DTSFX145 CL*34 +00032 FILE STATUS IS TDEC-PAYT-STATUS. CL*28 +00033 CL*14 +00034 CL*16 +00035 SELECT TDEC-PEND-FILE ASSIGN TO DTSPX145 CL*34 +00036 FILE STATUS IS BATCH-XREF-STATUS. CL*16 +00037 CL*47 +00038 SELECT REPT-PAID-FILE ASSIGN TO X429RPT1 CL*47 +00039 FILE STATUS IS REPT-STATUS. CL*47 +00040 CL*47 +00041 SELECT REPT-PEND-FILE ASSIGN TO X429RPT2 CL*52 +00042 FILE STATUS IS REPT-STATUS. CL*47 +00043 CL*47 +00044 DATA DIVISION. DTSBX429 +00045 DTSBX429 +00046 FILE SECTION. DTSBX429 +00047 DTSBX429 +00048 CL*14 +00049 FD TDEC-PAYT-FILE CL*28 +00050 RECORDING MODE IS F CL*14 +00051 BLOCK CONTAINS 0 RECORDS CL*14 +00052 LABEL RECORDS ARE OMITTED. CL*14 +00053 CL*14 +00054 01 TDEC-PAYT-REC. CL*30 +00055 05 WEB-IMP-TYPE PIC X(03). CL*30 +00056 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. CL*30 +00057 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. CL*30 +00058 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. CL*30 +00059 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. CL*30 +00060 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. CL*30 +00061 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. CL*30 +00062 88 WEB-IMP-TYPE-REL-88 VALUE '130'. CL*30 +00063 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. CL*30 +00064 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. CL*30 +00065 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. CL*30 +00066 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. CL*30 +00067 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. CL*30 +00068 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' CL*30 +00069 '108' '130' '132'. CL*30 +00070 88 WEB-TYPE-RPT-88 VALUE '140' '144'. CL*30 +00071 88 WEB-TYPE-PAY-88 VALUE '145'. CL*30 +00072 88 WEB-TYPE-PRF-88 VALUE '110' '120'. CL*30 +00073 05 FILLER PIC X(01). CL*30 +00074 05 WEB-IMP-EMP-NO PIC 9(06). CL*30 +00075 05 FILLER PIC X(01). CL*30 +00076 05 WEB-IMP-QTR PIC X(06). CL*30 +00077 05 FILLER PIC X(495). CL*30 +00078 CL*30 +00079 CL*14 +00080 CL*16 +00081 FD TDEC-PEND-FILE CL*28 +00082 RECORDING MODE IS F CL*16 +00083 BLOCK CONTAINS 0 RECORDS CL*16 +00084 LABEL RECORDS ARE OMITTED. CL*16 +00085 CL*16 +00086 01 TDEC-PEND-REC PIC X(512). CL*30 +00087 CL*48 +00088 FD REPT-PAID-FILE CL*47 +00089 RECORDING MODE IS F CL*47 +00090 BLOCK CONTAINS 0 RECORDS CL*47 +00091 LABEL RECORDS ARE OMITTED. CL*47 +00092 CL*47 +00093 01 REPT-PAID-REC PIC X(133). CL*47 +00094 CL*47 +00095 CL*47 +00096 FD REPT-PEND-FILE CL*47 +00097 RECORDING MODE IS F CL*47 +00098 BLOCK CONTAINS 0 RECORDS CL*47 +00099 LABEL RECORDS ARE OMITTED. CL*47 +00100 CL*47 +00101 01 REPT-PEND-REC PIC X(133). CL*47 +00102 CL*47 +00103 CL*16 +00104 WORKING-STORAGE SECTION. DTSBX429 +001045 77 PAN-VALET PICTURE X(24) VALUE '063DTSBX429 01/08/15'. DTSBX429 +00105 SKIP3 DTSBX429 +00106 01 WRK-AREA. DTSBX429 +00107 05 W-ABEND-CD PIC S9(04) COMP VALUE 428. CL*18 +00108 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX429'. CL*28 +00109 DTSBX429 +00110 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX429 +00111 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX429 +00112 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX429 +00113 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX429 +00114 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX429 +00115 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX429 +00116 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX429 +00117 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX429 +00118 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX429 +00119 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX429 +00120 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX429 +00121 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX429 +00122 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX429 +00123 DTSBX429 +00124 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX429 +00125 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX429 +00126 88 W-ERROR-NO-88 VALUE 'N'. DTSBX429 +00127 DTSBX429 +00128 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX429 +00129 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX429 +00130 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX429 +00131 DTSBX429 +00132 05 BATCH-XREF-STATUS PIC X(02). DTSBX429 +00133 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX429 +00134 DTSBX429 +00135 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX429 +00136 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX429 +00137 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX429 +00138 DTSBX429 +00139 05 W-QTR-FOUND-IND PIC X(01) VALUE 'N'. CL*21 +00140 88 W-QTR-FOUND-YES-88 VALUE 'Y'. CL*21 +00141 88 W-QTR-FOUND-NO-88 VALUE 'N'. CL*21 +00142 CL*21 +00143 05 TDEC-PAYT-STATUS PIC X(02) VALUE SPACES. CL*28 +00144 88 W-TDEC-PAYT-EOF-88 VALUE '10'. CL*28 +00145 88 W-TDEC-PAYT-OK-88 VALUE '00'. CL*28 +00146 CL*21 +00147 05 REPT-STATUS PIC X(02) VALUE SPACES. CL*50 +00148 88 REPT-STATUS-EOF-88 VALUE '10'. CL*50 +00149 88 REPT-STATUS-OK-88 VALUE '00'. CL*50 +00150 CL*50 +00151 05 W-APAY-MAX PIC S9(04) COMP VALUE +100. DTSBX429 +00152 05 W-APAY-LAST PIC S9(04) COMP VALUE +0. DTSBX429 +00153 05 PSUB PIC S9(04) COMP VALUE +0. DTSBX429 +00154 05 W-APAY-TABLE. DTSBX429 +00155 10 W-APAY-ENTRY OCCURS 100 TIMES PIC X(96). DTSBX429 +00156 DTSBX429 +00157 05 WRK-RETURN-CODE PIC S9(01) VALUE +0. CL*26 +00158 05 W-EMP-NO PIC S9(07) COMP-3. CL*26 +00159 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBX429 +00160 05 W-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00161 05 W-TOT-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00162 05 W-TOT-PAID-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00163 05 W-TOT-PEND-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00164 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX429 +00165 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBX429 +00166 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX429 +00167 05 W-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX429 +00168 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE 0. CL*51 +00169 05 W-TRAN-CNT PIC S9(03) COMP-3. DTSBX429 +00170 05 W-PEND-CNT PIC 9(05) VALUE 0. CL*37 +00171 05 W-MPRF-CNT PIC 9(05) VALUE 0. CL*37 +00172 05 W-MQTR-CNT PIC 9(05) VALUE 0. CL*37 +00173 05 W-ERRO-CNT PIC 9(05) VALUE 0. CL*37 +00174 05 W-X145-ERR-CNT PIC 9(05) VALUE 0. CL*58 +00175 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*16 +00176 DTSBX429 +00177 05 W-EARNINGS PIC S9(09)V99. DTSBX429 +00178 05 W-INTEGER PIC S9(11) COMP-3. CL*33 +00179 05 W-FRACTION PIC SV9(11) COMP-3. CL*33 +00180 05 W-NUMBER PIC S9(11)V9(05) COMP-3. CL*33 +00181 05 SUB PIC S9(4) COMP. CL*33 +00182 CL*48 +00183 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL*48 +00184 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL*48 +00185 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL*48 +00186 CL*48 +00187 DTSBX429 +00188 05 W-PAY-TYPE PIC X(02). DTSBX429 +00189 88 W-PA-PAY-88 VALUE 'PA'. DTSBX429 +00190 88 W-OR-PAY-88 VALUE 'OR'. DTSBX429 +00191 88 W-EA-PAY-88 VALUE 'EA'. DTSBX429 +00192 88 W-AU-PAY-88 VALUE 'AU'. DTSBX429 +00193 88 W-FS-PAY-88 VALUE 'FS'. DTSBX429 +00194 88 W-AC-PAY-88 VALUE 'AC'. DTSBX429 +00195 88 W-ES-PAY-88 VALUE 'ES'. DTSBX429 +00196 88 W-WD-PAY-88 VALUE 'WD'. DTSBX429 +00197 88 W-PAY-REV-88 VALUE 'PR'. DTSBX429 +00198 88 W-REFUND-88 VALUE 'RF'. DTSBX429 +00199 88 W-REF-REV-88 VALUE 'RR'. DTSBX429 +00200 88 W-NG-CHECK-88 VALUE 'NG'. DTSBX429 +00201 88 W-VALID-PAY-88 VALUE 'PA' 'OR' 'EA' 'AU' DTSBX429 +00202 'FS' 'AC'. DTSBX429 +00203 DTSBX429 +00204 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX429 +00205 DTSBX429 +00206 05 W-SLASH-DATE PIC X(10). DTSBX429 +00207 05 FILLER REDEFINES W-SLASH-DATE. DTSBX429 +00208 10 W-SLASH-DT-MM PIC X(02). DTSBX429 +00209 10 FILLER PIC X(01). DTSBX429 +00210 10 W-SLASH-DT-DD PIC X(02). DTSBX429 +00211 10 FILLER PIC X(01). DTSBX429 +00212 10 W-SLASH-DT-CCYY PIC X(04). DTSBX429 +00213 DTSBX429 +00214 05 W-SLASH-QTR PIC X(06). DTSBX429 +00215 05 FILLER REDEFINES W-SLASH-QTR. DTSBX429 +00216 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX429 +00217 10 FILLER PIC X(01). DTSBX429 +00218 10 W-SLASH-QTR-Q PIC X(01). DTSBX429 +00219 DTSBX429 +00220 * PAYMENT DTSBX429 +00221 05 W-X212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 +00222 DTSBX429 +00223 05 W-APAY-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX429 +00224 DTSBX429 +00225 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX429 +00226 * 05 WS-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*57 +00227 DTSBX429 +00228 05 W-BX212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 +00229 DTSBX429 +00230 05 W-X212-LENGTH PIC S9(04) COMP. CL*16 +00231 DTSBX429 +00232 05 W-AMT-DISP1 PIC ----------9.99. DTSBX429 +00233 05 W-AMT-DISP2 PIC ----------9.99. DTSBX429 +00234 *RW1 DTSBX429 +00235 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX429 +00236 05 DISPLAY-CNT PIC Z(06)9. DTSBX429 +00237 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX429 +00238 *RW2 DTSBX429 +00239 DTSBX429 +00240 01 MESSAGE-AREA. DTSBX429 +00241 *** FATAL ERRORS MSG-A DTSBX429 +00242 05 MSG-A1. DTSBX429 +00243 10 FILLER PIC X(32) DTSBX429 +00244 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX429 +00245 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX429 +00246 DTSBX429 +00247 01 HEADER-1. CL*47 +00248 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00249 05 FILLER PIC X(49) VALUE '140R1'. CL*47 +00250 05 FILLER PIC X(60) VALUE CL*47 +00251 'DISTRICT OF COLUMBIA'. CL*47 +00252 05 FILLER PIC X(06) VALUE 'DATE:'. CL*47 +00253 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*47 +00254 01 HEADER-2. CL*47 +00255 05 FILLER PIC X(54) VALUE SPACES. CL*47 +00256 05 FILLER PIC X(56) VALUE CL*47 +00257 'TAX DIVISION'. CL*47 +00258 05 FILLER PIC X(06) VALUE 'TIME:'. CL*47 +00259 05 HDR2-LRCM-SYS-TIME PIC X(08). CL*47 +00260 CL*47 +00261 01 HEADER-3. CL*47 +00262 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00263 05 FILLER PIC X(38) VALUE CL*47 +00264 'ROUTE TO: TAX ACCOUNTING STAFF'. CL*47 +00265 05 HDR3-LITERAL PIC X(43) VALUE CL*47 +00266 ' TDEC DAILY DEPOSITED CHECKS '. CL*54 +00267 05 FILLER PIC X(28) VALUE SPACES. CL*47 +00268 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*47 +00269 05 HDR3-PAGE PIC ZZ,ZZ9. CL*47 +00270 CL*47 +00271 01 HEADER-4. CL*47 +00272 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00273 05 FILLER PIC X(132) VALUE SPACES. CL*47 +00274 01 HEADER-5. CL*47 +00275 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00276 05 FILLER PIC X(34) VALUE CL*47 +00277 'EMP NO EMPLOYER NAME '. CL*53 +00278 05 FILLER PIC X(04) VALUE SPACES. CL*53 +00279 05 FILLER PIC X(34) VALUE CL*47 +00280 'QTR RECV-DATE PAID-AMT'. CL*54 +00281 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00282 05 HDR5-NAME PIC X(28) VALUE CL*47 +00283 ' DISPOSITION OF CHECKS'. CL*54 +00284 CL*47 +00285 01 HEADER-6. CL*47 +00286 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00287 05 FILLER PIC X(132) VALUE SPACES. CL*47 +00288 CL*48 +00289 01 DETAIL-LINE-1. CL*47 +00290 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00291 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 +00292 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00293 15 X434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 +00294 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00295 15 X434-QTR PIC X(06). CL*47 +00296 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00297 15 X434-RCVD-DATE PIC X(10). CL*47 +00298 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00299 15 X434-X145-REMIT PIC -------9.99. CL*47 +00300 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00301 15 X434-MESSAGE PIC X(20). CL*48 +00302 CL*47 +00303 01 DETAIL-PEND-1. CL*47 +00304 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00305 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 +00306 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00307 15 P434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 +00308 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00309 15 P434-QTR PIC X(06). CL*47 +00310 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00311 15 P434-RCVD-DATE PIC X(10). CL*47 +00312 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00313 15 P434-X145-REMIT PIC --------9.99. CL*47 +00314 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00315 15 P434-MESSAGE PIC X(30). CL*47 +00316 CL*47 +00317 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*47 +00318 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL*47 +00319 CL*47 +00320 01 FOOTING-LINE-3. CL*47 +00321 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00322 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL*47 +00323 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00324 05 FILLER PIC X(45) VALUE CL*47 +00325 ' TOTAL CHECK PAYMENTS RECEIVED'. CL*60 +00326 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00327 CL*47 +00328 01 FOOTING-LINE-4. CL*47 +00329 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00330 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL*47 +00331 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00332 05 FILLER PIC X(34) VALUE CL*47 +00333 ' # OF PAYMENTS HAD ERRORS '. CL*60 +00334 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00335 CL*47 +00336 01 FOOTING-LINE-5. CL*47 +00337 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00338 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL*47 +00339 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00340 05 FILLER PIC X(40) VALUE CL*47 +00341 ' # OF PAYMENTS WENT TO PENDING FILE '. CL*60 +00342 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00343 01 FOOTING-LINE-6. CL*56 +00344 05 FILLER PIC X(25) VALUE SPACES. CL*56 +00345 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL*56 +00346 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00347 05 FILLER PIC X(40) VALUE CL*56 +00348 ' # OF PAYMENTS APPLIED TO DUTAS '. CL*56 +00349 05 FILLER PIC X(32) VALUE SPACES. CL*56 +00350 01 FOOTING-LINE-7. CL*56 +00351 05 FILLER PIC X(19) VALUE SPACES. CL*47 +00352 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL*47 +00353 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00354 05 FILLER PIC X(45) VALUE CL*47 +00355 ' TOTAL PAYMENTS APPLID TO DUTAS '. CL*56 +00356 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00357 CL*47 +00358 01 FOOTING-LINE-8. CL*56 +00359 05 FILLER PIC X(19) VALUE SPACES. CL*56 +00360 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL*56 +00361 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00362 05 FILLER PIC X(45) VALUE CL*56 +00363 'TOTAL CHECK PAYMENTS RECEIVED '. CL*56 +00364 05 FILLER PIC X(32) VALUE SPACES. CL*56 +00365 CL*56 +00366 01 FOOTING-LINE-13. CL*47 +00367 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00368 05 FILLER PIC X(67) VALUE CL*47 +00369 '*** END TDEC/DUTAS DAILY CHECKS PROCESSING ***'. CL*50 +00370 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL*47 +00371 CL*47 +00372 CL*47 +00373 CL*47 +00374 01 T025-REC. DTSBX429 +00375 ++INCLUDE DTSIT025 DTSBX429 +00376 DTSBX429 +00377 * REPORT DTSBX429 +00378 01 X140-REC. DTSBX429 +00379 ++INCLUDE DTSIX140 DTSBX429 +00380 DTSBX429 +00381 * PAYMENT DTSBX429 +00382 01 X145-REC. DTSBX429 +00383 ++INCLUDE DTSIX145 DTSBX429 +00384 DTSBX429 +00385 * ICESA-REPT-FILE CL*16 +00386 01 X212-REC. CL*16 +00387 ++INCLUDE DTSIX212 CL*20 +00388 CL*16 +00389 * BATCH - PSEUDO-BATCH XREF DTSBX429 +00390 01 X214-REC. DTSBX429 +00391 ++INCLUDE DTSIX214 DTSBX429 +00392 DTSBX429 +00393 * ERRORS DTSBX429 +00394 *01 X907-REC. DTSBX429 +00395 ***INCLUDE DTSIX907 DTSBX429 +00396 DTSBX429 +00397 01 L001-LINK-AREA. DTSBX429 +00398 ++INCLUDE DTSIL001 DTSBX429 +00399 DTSBX429 +00400 01 L003-LINK-AREA. DTSBX429 +00401 ++INCLUDE DTSIL003 DTSBX429 +00402 DTSBX429 +00403 01 L004-LINK-AREA. DTSBX429 +00404 ++INCLUDE DTSIL004 DTSBX429 +00405 DTSBX429 +00406 CL*16 +00407 01 L005-LINK-AREA. CL*16 +00408 ++INCLUDE DTSIL005 CL*16 +00409 CL*31 +00410 01 L205-LINK-AREA. CL*31 +00411 ++INCLUDE DTSIL205 CL*31 +00412 CL*16 +00413 01 L910-LINK-AREA. DTSBX429 +00414 ++INCLUDE DTSIL910 DTSBX429 +00415 01 MSKL-REC. DTSBX429 +00416 ++INCLUDE DTSIMSKL DTSBX429 +00417 DTSBX429 +00418 01 MHDR-REC. DTSBX429 +00419 ++INCLUDE DTSIMHDR DTSBX429 +00420 DTSBX429 +00421 01 MQTR-REC. CL*17 +00422 ++INCLUDE DTSIMQTR CL*17 +00423 CL*17 +00424 01 MPRF-REC. DTSBX429 +00425 ++INCLUDE DTSIMPRF DTSBX429 +00426 DTSBX429 +00427 01 MPAY-REC. DTSBX429 +00428 ++INCLUDE DTSIMPAY DTSBX429 +00429 DTSBX429 +00430 01 MNTE-REC. DTSBX429 +00431 ++INCLUDE DTSIMNTE DTSBX429 +00432 DTSBX429 +00433 01 L921-LINK-AREA. DTSBX429 +00434 ++INCLUDE DTSIL921 DTSBX429 +00435 SKIP3 DTSBX429 +00436 01 ISKL-REC. DTSBX429 +00437 ++INCLUDE DTSIISKL DTSBX429 +00438 SKIP3 DTSBX429 +00439 01 IEIN-REC. DTSBX429 +00440 ++INCLUDE DTSIIEIN DTSBX429 +00441 DTSBX429 +00442 01 L923-LINK-AREA. DTSBX429 +00443 ++INCLUDE DTSIL923 DTSBX429 +00444 EJECT DTSBX429 +00445 01 ASKL-REC. DTSBX429 +00446 ++INCLUDE DTSIASKL DTSBX429 +00447 EJECT DTSBX429 +00448 01 AHDR-REC. DTSBX429 +00449 ++INCLUDE DTSIAHDR DTSBX429 +00450 EJECT DTSBX429 +00451 01 ARPT-REC. DTSBX429 +00452 ++INCLUDE DTSIARPT DTSBX429 +00453 EJECT DTSBX429 +00454 01 APAY-REC. DTSBX429 +00455 ++INCLUDE DTSIAPAY DTSBX429 +00456 DTSBX429 +00457 01 L927-LINK-AREA. DTSBX429 +00458 ++INCLUDE DTSIL927 DTSBX429 +00459 DTSBX429 +00460 01 TSKL-REC. DTSBX429 +00461 ++INCLUDE DTSITSKL DTSBX429 +00462 DTSBX429 +00463 01 L931-LINK-AREA. DTSBX429 +00464 ++INCLUDE DTSIL931 DTSBX429 +00465 DTSBX429 +00466 01 FSKL-REC. DTSBX429 +00467 ++INCLUDE DTSIFSKL DTSBX429 +00468 DTSBX429 +00469 01 R140-REC. DTSBX429 +00470 ++INCLUDE DTSIR140 DTSBX429 +00471 DTSBX429 +00472 LINKAGE SECTION. DTSBX429 +00473 DTSBX429 +00474 *01 LX42-LINK-AREA. CL*14 +00475 *++INCLUDE DTSILX42 CL*14 +00476 DTSBX429 +00477 PROCEDURE DIVISION. CL*14 +00478 DTSBX429 +00479 DTSBX423-MAIN. DTSBX429 +00480 PERFORM I0000-INITIATE THRU I0000-EXIT. CL*27 +00481 DTSBX429 +00482 IF W-ERROR-YES-88 CL*27 +00483 MOVE WRK-RETURN-CODE TO RETURN-CODE CL*40 +00484 GO TO DTSBX423-MAIN-EXIT. CL*27 +00485 CL*27 +00486 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*27 +00487 DTSBX429 +00488 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL*27 +00489 MOVE WRK-RETURN-CODE TO RETURN-CODE. CL*40 +00490 DTSBX429 +00491 DTSBX429 +00492 DTSBX423-MAIN-EXIT. DTSBX429 +00493 GOBACK. DTSBX429 +00494 DTSBX429 +00495 I0000-INITIATE. DTSBX429 +00496 SET W-ERROR-NO-88 TO TRUE. DTSBX429 +00497 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX429 +00498 MOVE +0 TO WRK-RETURN-CODE CL*25 +00499 DTSBX429 +00500 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX429 +00501 MOVE '140' TO R140-REC-TYPE. DTSBX429 +00502 DTSBX429 +00503 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX429 +00504 CL*16 +00505 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*16 +00506 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*16 +00507 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*49 +00508 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*49 +00509 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*49 +00510 CL*16 +00511 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*35 +00512 PERFORM S927A-OPEN THRU S927A-EXIT. CL*42 +00513 DTSBX429 +00514 I0000-EXIT. DTSBX429 +00515 EXIT. DTSBX429 +00516 DTSBX429 +00517 I2000-OPEN-FILES. DTSBX429 +00518 DTSBX429 +00519 OPEN INPUT TDEC-PAYT-FILE. CL*29 +00520 IF W-TDEC-PAYT-EOF-88 CL*29 +00521 DISPLAY 'NO TDEC PAYMENT FILES TO PROCESS ' CL*29 +00522 MOVE +3 TO WRK-RETURN-CODE CL*27 +00523 SET W-ERROR-YES-88 TO TRUE CL*27 +00524 END-IF. CL*14 +00525 CL*16 +00526 OPEN OUTPUT TDEC-PEND-FILE. CL*29 +00527 IF BATCH-XREF-OK-88 CL*16 +00528 NEXT SENTENCE CL*16 +00529 ELSE CL*16 +00530 DISPLAY 'CANNOT OPEN TDEC PEND FILE ' CL*29 +00531 BATCH-XREF-STATUS CL*16 +00532 PERFORM S999-ABEND THRU S999-EXIT CL*16 +00533 END-IF. CL*16 +00534 OPEN OUTPUT REPT-PEND-FILE. CL*47 +00535 IF REPT-STATUS-OK-88 CL*47 +00536 NEXT SENTENCE CL*47 +00537 ELSE CL*47 +00538 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' CL*47 +00539 REPT-STATUS CL*47 +00540 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00541 END-IF. CL*47 +00542 CL*47 +00543 OPEN OUTPUT REPT-PAID-FILE. CL*47 +00544 IF REPT-STATUS-OK-88 CL*47 +00545 NEXT SENTENCE CL*47 +00546 ELSE CL*47 +00547 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' CL*47 +00548 REPT-STATUS CL*47 +00549 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00550 END-IF. CL*47 +00551 CL*16 +00552 I2000-EXIT. DTSBX429 +00553 EXIT. DTSBX429 +00554 DTSBX429 +00555 P0000-PROCESS. DTSBX429 +00556 READ TDEC-PAYT-FILE CL*33 +00557 CL*25 +00558 IF W-TDEC-PAYT-EOF-88 CL*29 +00559 DISPLAY 'TDEC INPUT FILE IS EMPTY ' CL*29 +00560 MOVE +3 TO WRK-RETURN-CODE CL*25 +00561 GO TO P0000-EXIT CL*25 +00562 END-IF. CL*25 +00563 CL*25 +00564 PERFORM UNTIL W-TDEC-PAYT-EOF-88 CL*29 +00565 PERFORM P1100-PARSE-TDEC-PAYT-REC THRU P1100-EXIT CL*30 +00566 IF W-ERROR-NO-88 CL*31 +00567 PERFORM P2100-PAYMENT THRU P2100-EXIT CL*25 +00568 END-IF CL*31 +00569 READ TDEC-PAYT-FILE CL*33 +00570 END-PERFORM. CL*25 +00571 CL*25 +00572 DTSBX429 +00573 P0000-EXIT. DTSBX429 +00574 EXIT. DTSBX429 +00575 P1100-PARSE-TDEC-PAYT-REC. CL*33 +00576 SET W-ERROR-NO-88 TO TRUE. CL*36 +00577 CL*30 +00578 PERFORM CL*30 +00579 VARYING SUB FROM +1 BY +1 CL*30 +00580 UNTIL SUB > +100 CL*30 +00581 MOVE +0 TO L205-FIELD-LENGTH (SUB) CL*30 +00582 L205-INTEGER (SUB) CL*30 +00583 L205-FRACTION (SUB) CL*30 +00584 MOVE SPACES TO L205-TEXT (SUB) CL*30 +00585 L205-DATE (SUB) CL*30 +00586 SET L205-TYPE-TEXT-88 (SUB) TO TRUE CL*30 +00587 END-PERFORM. CL*30 +00588 CL*30 +00589 IF WEB-IMP-TYPE-PAY-88 CL*30 +00590 PERFORM P1100J-SET-205-FIELDS THRU P1100J-EXIT CL*31 +00591 ELSE CL*30 +00592 SET W-ERROR-YES-88 TO TRUE CL*30 +00593 DISPLAY ' RECORD IS NOT PAY TYPE ' CL*30 +00594 END-IF. CL*30 +00595 DTSBX429 +00596 CL*31 +00597 * DISPLAY ' **** GOING TO 205 EDIT ESSP RECS ' CL*31 +00598 * DISPLAY ' **** ' CL*31 +00599 CL*31 +00600 IF W-ERROR-NO-88 CL*31 +00601 MOVE TDEC-PAYT-REC TO L205-INPUT-DATA CL*31 +00602 CALL 'DTSBU205' USING L205-LINK-AREA CL*31 +00603 PERFORM P1100K-BUILD-X145-REC THRU P1100K-EXIT. CL*31 +00604 CL*31 +00605 CL*31 +00606 P1100-EXIT. CL*31 +00607 EXIT. CL*31 +00608 CL*31 +00609 P1100J-SET-205-FIELDS. CL*31 +00610 DISPLAY 'P1100J-PAY ' TDEC-PAYT-REC(1:84). CL*31 +00611 INITIALIZE X145-REC. CL*31 +00612 MOVE +12 TO L205-LAST-FIELD. CL*31 +00613 MOVE +8 TO L205-LAST-FIELD-LEN. CL*31 +00614 CL*31 +00615 MOVE +3 TO L205-FIELD-LENGTH (1). CL*31 +00616 SET L205-TYPE-TEXT-88 (1) TO TRUE. CL*31 +00617 CL*31 +00618 MOVE +6 TO L205-FIELD-LENGTH (2). CL*31 +00619 SET L205-TYPE-TEXT-88 (2) TO TRUE. CL*31 +00620 CL*31 +00621 MOVE +6 TO L205-FIELD-LENGTH (3). CL*31 +00622 SET L205-TYPE-TEXT-88 (3) TO TRUE. CL*31 +00623 CL*31 +00624 MOVE +6 TO L205-FIELD-LENGTH (4). CL*31 +00625 SET L205-TYPE-TEXT-88 (4) TO TRUE. CL*31 +00626 MOVE +3 TO L205-FIELD-LENGTH (5). CL*31 +00627 SET L205-TYPE-TEXT-88 (5) TO TRUE. CL*31 +00628 CL*31 +00629 MOVE +2 TO L205-FIELD-LENGTH (6). CL*31 +00630 SET L205-TYPE-TEXT-88 (6) TO TRUE. CL*31 +00631 CL*31 +00632 MOVE +2 TO L205-FIELD-LENGTH (7). CL*31 +00633 SET L205-TYPE-TEXT-88 (7) TO TRUE. CL*31 +00634 CL*31 +00635 MOVE +2 TO L205-FIELD-LENGTH (8). CL*31 +00636 SET L205-TYPE-TEXT-88 (8) TO TRUE. CL*31 +00637 CL*31 +00638 MOVE +14 TO L205-FIELD-LENGTH (9). CL*31 +00639 SET L205-TYPE-NUMBER-88 (9) TO TRUE. CL*31 +00640 MOVE +10 TO L205-FIELD-LENGTH (10). CL*31 +00641 SET L205-TYPE-TEXT-88 (10) TO TRUE. CL*31 +00642 CL*31 +00643 MOVE +10 TO L205-FIELD-LENGTH (11). CL*31 +00644 SET L205-TYPE-TEXT-88 (11) TO TRUE. CL*31 +00645 CL*31 +00646 MOVE +8 TO L205-FIELD-LENGTH (12). CL*31 +00647 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*31 +00648 CL*31 +00649 CL*31 +00650 P1100J-EXIT. CL*31 +00651 EXIT. CL*31 +00652 CL*31 +00653 P1100K-BUILD-X145-REC. CL*31 +00654 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. CL*31 +00655 CL*31 +00656 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. CL*31 +00657 CL*31 +00658 MOVE '0' TO X145-SOURCE. CL*31 +00659 CL*31 +00660 MOVE L205-TEXT (3) (1:06) TO X145-QTR. CL*31 +00661 * DISPLAY 'X145 QTR ' X145-QTR. CL*46 +00662 CL*31 +00663 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. CL*31 +00664 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL*46 +00665 CL*31 +00666 MOVE L205-INTEGER (9) TO W-INTEGER. CL*31 +00667 MOVE L205-FRACTION (9) TO W-FRACTION. CL*31 +00668 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*31 +00669 MOVE W-NUMBER TO X145-REMITTANCE. CL*31 +00670 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL*46 +00671 CL*31 +00672 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. CL*31 +00673 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL*46 +00674 CL*31 +00675 MOVE L205-TEXT (12) TO X145-TRACE-NO. CL*31 +00676 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL*46 +00677 CL*31 +00678 CL*31 +00679 MOVE ZEROS TO X145-PSEUDO-BATCH. CL*31 +00680 CL*31 +00681 MOVE ZEROS TO X145-PSEUDO-ITEM. CL*31 +00682 CL*31 +00683 MOVE SPACES TO X145-APPLIC-ACCT. CL*31 +00684 CL*31 +00685 MOVE SPACES TO X145-CHECK-SCAN-DT. CL*31 +00686 CL*31 +00687 MOVE ZEROS TO X145-CHECK-SEQ-NBR. CL*31 +00688 CL*31 +00689 MOVE 'N' TO X145-WAIVE-INTEREST. CL*31 +00690 CL*31 +00691 MOVE 'N' TO X145-WAIVE-PENALTY. CL*31 +00692 CL*31 +00693 MOVE 'VOL' TO X145-RESP-ACTIVITY. CL*31 +00694 CL*31 +00695 MOVE 'TDECDCHK' TO X145-RESP-OPID. CL*45 +00696 CL*31 +00697 P1100K-EXIT. CL*31 +00698 EXIT. CL*31 +00699 CL*31 +00700 P2100-PAYMENT. DTSBX429 +00701 MOVE X145-EMP-NO TO W-EMP-NO. CL*29 +00702 * DISPLAY ' EMP NO ' W-EMP-NO. CL*46 +00703 SET W-EMP-FOUND-YES-88 TO TRUE. CL*47 +00704 DTSBX429 +00705 SET W-QTR-FOUND-NO-88 TO TRUE. CL*17 +00706 SET W-ERROR-NO-88 TO TRUE CL*17 +00707 DTSBX429 +00708 ADD +1 TO W-X212-CNT. CL*29 +00709 CL*29 +00710 PERFORM P2110-EDIT-PAYMENT THRU P2110-EXIT. CL*29 +00711 CL*47 +00712 IF W-EMP-FOUND-NO-88 OR CL*47 +00713 W-ERROR-YES-88 CL*47 +00714 ADD 1 TO W-PEND-CNT CL*48 +00715 ADD 1 TO W-MPRF-CNT CL*48 +00716 ADD 1 TO W-ERRO-CNT CL*48 +00717 ADD 1 TO W-X145-ERR-CNT CL*57 +00718 ADD W-REMITTANCE TO W-TOT-PEND-REMITTANCE CL*57 +00719 WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 +00720 MOVE R140-MESSAGE TO P434-MESSAGE CL*48 +00721 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT CL*48 +00722 GO TO P2100-EXIT. CL*47 +00723 CL*47 +00724 CL*29 +00725 CL*48 +00726 PERFORM P2120-SAVE-EXT-PAY THRU P2120-EXIT CL*47 +00727 ADD W-REMITTANCE TO W-TOT-PAID-REMITTANCE CL*57 +00728 MOVE 'APPLIED TO DUTAS' TO P434-MESSAGE CL*48 +00729 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT. CL*48 +00730 DTSBX429 +00731 P2100-EXIT. DTSBX429 +00732 EXIT. DTSBX429 +00733 DTSBX429 +00734 P2110-EDIT-PAYMENT. DTSBX429 +00735 * MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*14 +00736 * IF W-VALID-PAY-88 CL*14 +00737 * NEXT SENTENCE CL*14 +00738 * ELSE CL*14 +00739 * SET W-ERROR-YES-88 TO TRUE CL*14 +00740 * MOVE SPACES TO R140-MESSAGE CL*14 +00741 * MOVE W-EMP-NO TO R140-EMP-NO CL*14 +00742 * STRING CL*14 +00743 * 'INVALID PAYMENT TYPE ' CL*14 +00744 * X145-PAY-TYPE CL*14 +00745 * DELIMITED BY SIZE CL*14 +00746 * INTO R140-MESSAGE CL*14 +00747 * END-STRING CL*14 +00748 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*14 +00749 * DISPLAY R140-MESSAGE CL*14 +00750 * END-IF. CL*14 +00751 DTSBX429 +00752 MOVE SPACES TO W-SLASH-QTR. CL*24 +00753 IF X145-QTR = SPACES CL*29 +00754 MOVE ZEROS TO W-REPORT-QTR DTSBX429 +00755 ELSE DTSBX429 +00756 MOVE X145-QTR TO W-SLASH-QTR CL*29 +00757 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR DTSBX429 +00758 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q DTSBX429 +00759 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX429 +00760 IF NOT L004-VALID-QTR DTSBX429 +00761 SET W-ERROR-YES-88 TO TRUE DTSBX429 +00762 MOVE SPACES TO R140-MESSAGE DTSBX429 +00763 MOVE W-EMP-NO TO R140-EMP-NO DTSBX429 +00764 STRING DTSBX429 +00765 'PEND: INV PAY QUARTER ' W-SLASH-QTR CL*63 +00766 DELIMITED BY SIZE DTSBX429 +00767 INTO R140-MESSAGE DTSBX429 +00768 END-STRING DTSBX429 +00769 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX429 +00770 DISPLAY R140-MESSAGE DTSBX429 +00771 MOVE +2 TO WRK-RETURN-CODE CL*25 +00772 ELSE DTSBX429 +00773 MOVE L004-QTR-5-9 TO W-REPORT-QTR DTSBX429 +00774 END-IF DTSBX429 +00775 END-IF. DTSBX429 +00776 DTSBX429 +00777 MOVE X145-REMITTANCE TO W-REMITTANCE. CL*29 +00778 * DISPLAY 'WREMITTANCE ' W-REMITTANCE. CL*46 +00779 * DISPLAY 'XREMITTANCE ' X145-REMITTANCE. CL*46 +00780 CL*38 +00781 ADD W-REMITTANCE TO W-TOT-REMITTANCE. CL*57 +00782 IF W-REMITTANCE = ZEROS CL*39 +00783 SET W-ERROR-YES-88 TO TRUE CL*38 +00784 MOVE SPACES TO R140-MESSAGE CL*38 +00785 MOVE W-EMP-NO TO R140-EMP-NO CL*38 +00786 STRING CL*38 +00787 'INVALID REMITTANCE AMOUNT ' X145-REMITTANCE CL*38 +00788 DELIMITED BY SIZE CL*38 +00789 INTO R140-MESSAGE CL*38 +00790 END-STRING CL*38 +00791 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*38 +00792 DISPLAY R140-MESSAGE CL*38 +00793 MOVE +2 TO WRK-RETURN-CODE CL*38 +00794 END-IF. CL*38 +00795 CL*38 +00796 DTSBX429 +00797 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*30 +00798 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX429 +00799 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX429 +00800 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX429 +00801 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX429 +00802 IF NOT L001-VALID-DATE DTSBX429 +00803 SET W-ERROR-YES-88 TO TRUE DTSBX429 +00804 MOVE SPACES TO R140-MESSAGE DTSBX429 +00805 MOVE W-EMP-NO TO R140-EMP-NO DTSBX429 +00806 STRING DTSBX429 +00807 'INVALID PAY RECEIVED DATE ' X145-RCVD-DATE CL*30 +00808 DELIMITED BY SIZE DTSBX429 +00809 INTO R140-MESSAGE DTSBX429 +00810 END-STRING DTSBX429 +00811 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX429 +00812 DISPLAY R140-MESSAGE DTSBX429 +00813 MOVE +2 TO WRK-RETURN-CODE CL*25 +00814 ELSE DTSBX429 +00815 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBX429 +00816 END-IF. DTSBX429 +00817 DTSBX429 +00818 * MOVE X212-DEPOSIT-DT TO W-SLASH-DATE CL*29 +00819 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*29 +00820 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*29 +00821 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*29 +00822 * PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*29 +00823 * IF NOT L001-VALID-DATE CL*29 +00824 * SET W-ERROR-YES-88 TO TRUE CL*29 +00825 * MOVE SPACES TO R140-MESSAGE CL*29 +00826 * MOVE W-EMP-NO TO R140-EMP-NO CL*29 +00827 * STRING CL*29 +00828 * 'INVALID DEPOSIT DATE ' X212-DEPOSIT-DT CL*29 +00829 * DELIMITED BY SIZE CL*29 +00830 * INTO R140-MESSAGE CL*29 +00831 * END-STRING CL*29 +00832 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*29 +00833 * DISPLAY R140-MESSAGE CL*11 +00834 * MOVE +2 TO WRK-RETURN-CODE CL*29 +00835 * ELSE CL*29 +00836 * MOVE L001-FED-8-DATE-9 TO W-DEPOSIT-DATE CL*29 +00837 * END-IF. CL*11 +00838 DTSBX429 +00839 PERFORM P2112-CHECK-DATABASE THRU P2112-EXIT. CL*17 +00840 P2110-EXIT. DTSBX429 +00841 EXIT. DTSBX429 +00842 DTSBX429 +00843 P2112-CHECK-DATABASE. DTSBX429 +00844 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX429 +00845 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX429 +00846 SET MPRF-PRF-88 TO TRUE. DTSBX429 +00847 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX429 +00848 DTSBX429 +00849 PERFORM S910-READ THRU S910-EXIT. DTSBX429 +00850 IF L910-NO-REC-88 DTSBX429 +00851 SET W-ERROR-YES-88 TO TRUE CL*25 +00852 SET W-EMP-FOUND-NO-88 TO TRUE DTSBX429 +00853 DISPLAY 'PAYMENT: EMPLOYER NOT ON FILE ' W-EMP-NO CL*45 +00854 MOVE SPACES TO R140-MESSAGE CL*15 +00855 MOVE W-EMP-NO TO R140-EMP-NO CL*15 +00856 STRING CL*15 +00857 'PEND: EMP NOT ON DUTAS' CL*62 +00858 X145-EMP-NO CL*30 +00859 DELIMITED BY SIZE CL*15 +00860 INTO R140-MESSAGE CL*15 +00861 END-STRING CL*15 +00862 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*15 +00863 MOVE +2 TO WRK-RETURN-CODE CL*41 +00864 * DISPLAY R140-MESSAGE CL*16 +00865 ELSE DTSBX429 +00866 MOVE MSKL-REC TO MPRF-REC DTSBX429 +00867 SET W-EMP-FOUND-YES-88 TO TRUE DTSBX429 +00868 END-IF. DTSBX429 +00869 DTSBX429 +00870 IF W-EMP-FOUND-NO-88 OR CL*62 +00871 W-ERROR-YES-88 CL*62 +00872 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 +00873 * ADD 1 TO W-PEND-CNT CL*47 +00874 * ADD 1 TO W-MPRF-CNT CL*47 +00875 * ADD 1 TO W-ERRO-CNT CL*47 +00876 GO TO P2112-EXIT. CL*62 +00877 CL*16 +00878 * IF EMPLOYER IS FOUND ON THE MPRF CHECK IF REPORT FOUND. CL*16 +00879 * IF EITHER IS NOT FOUND WRITE T025 REC TO PENDING FILE. CL*16 +00880 CL*16 +00881 MOVE LOW-VALUE TO MQTR-KEY-AREA. CL*22 +00882 MOVE W-EMP-NO TO MQTR-EMP-NO. CL*17 +00883 MOVE W-REPORT-QTR TO MQTR-YRQ. CL*22 +00884 SET MQTR-QTR-88 TO TRUE. CL*16 +00885 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL*16 +00886 CL*16 +00887 PERFORM S910-READ THRU S910-EXIT. CL*16 +00888 IF L910-NO-REC-88 CL*16 +00889 * SET W-ERROR-YES-88 TO TRUE CL*45 +00890 SET W-QTR-FOUND-NO-88 TO TRUE CL*17 +00891 DISPLAY 'PAYMENT: EMPL QTR NOT ON FILE ' W-EMP-NO CL*45 +00892 MOVE SPACES TO R140-MESSAGE CL*16 +00893 MOVE W-EMP-NO TO R140-EMP-NO CL*16 +00894 STRING CL*16 +00895 'PAID: QTR RPT NOT ON FILE ' CL*62 +00896 X145-EMP-NO ' QTR' W-SLASH-QTR CL*30 +00897 DELIMITED BY SIZE CL*16 +00898 INTO R140-MESSAGE CL*16 +00899 END-STRING CL*16 +00900 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*16 +00901 * MOVE +2 TO WRK-RETURN-CODE CL*45 +00902 * DISPLAY R140-MESSAGE CL*16 +00903 ELSE CL*17 +00904 SET W-QTR-FOUND-YES-88 TO TRUE CL*17 +00905 END-IF. CL*16 +00906 CL*16 +00907 * IF W-QTR-FOUND-NO-88 OR CL*47 +00908 * W-ERROR-YES-88 CL*47 +00909 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*45 +00910 * ADD 1 TO W-MQTR-CNT CL*47 +00911 * ADD 1 TO W-ERRO-CNT CL*47 +00912 * ADD 1 TO W-PEND-CNT. CL*47 +00913 CL*16 +00914 P2112-EXIT. DTSBX429 +00915 EXIT. DTSBX429 +00916 DTSBX429 +00917 P2120-SAVE-EXT-PAY. DTSBX429 +00918 DISPLAY 'PAYMENT OK ' X212-EMP-NBR. CL*22 +00919 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*16 +00920 DTSBX429 +00921 MOVE LENGTH OF T025-REC TO T025-LENGTH DTSBX429 +00922 MOVE '025' TO T025-REC-TYPE. DTSBX429 +00923 DTSBX429 +00924 MOVE W-EMP-NO TO T025-EMP-NO. DTSBX429 +00925 MOVE 'WEB PAY ' TO T025-ORIGIN. CL*15 +00926 MOVE L005-DATE TO T025-SYS-DATE. CL*16 +00927 MOVE L005-TIME TO T025-SYS-TIME. CL*16 +00928 CL*15 +00929 IF W-REPORT-QTR > ZERO CL*62 +00930 MOVE W-REPORT-QTR TO T025-APPLIC-YRQ CL*62 +00931 MOVE 'PA' TO T025-PAY-TYPE CL*62 +00932 ELSE CL*62 +00933 MOVE ZERO TO T025-APPLIC-YRQ CL**6 +00934 MOVE 'PA' TO T025-PAY-TYPE CL**6 +00935 END-IF. CL*62 +00936 DTSBX429 +00937 MOVE SPACES TO T025-APPLIC-IND. DTSBX429 +00938 MOVE ZERO TO T025-APPLIC-BATCH-NO DTSBX429 +00939 T025-APPLIC-ITEM-NO. DTSBX429 +00940 DTSBX429 +00941 IF W-EMP-FOUND-YES-88 DTSBX429 +00942 MOVE MPRF-PRIMARY-NAME (1:4) DTSBX429 +00943 TO T025-NAME-CHECK DTSBX429 +00944 ELSE DTSBX429 +00945 MOVE SPACES TO T025-NAME-CHECK DTSBX429 +00946 END-IF. DTSBX429 +00947 DTSBX429 +00948 MOVE W-RECEIVED-DATE TO T025-RECEIVED-DATE CL*15 +00949 T025-DEPOSIT-DATE. CL*29 +00950 DTSBX429 +00951 DTSBX429 +00952 MOVE W-REMITTANCE TO T025-REMIT-AMT. DTSBX429 +00953 DTSBX429 +00954 MOVE ZEROS TO T025-TRACE-NO. CL*15 +00955 DTSBX429 +00956 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. DTSBX429 +00957 MOVE 'TDECDCHK' TO T025-RESPONSIBLE-OP-ID. CL*45 +00958 DTSBX429 +00959 MOVE T025-REC TO TSKL-REC. DTSBX429 +00960 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX429 +00961 ADD +1 TO W-T025-WRITE-CNT. DTSBX429 +00962 DTSBX429 +00963 ** DISPLAY 'BX423 PAYMENT ' X145-EMP-NO. DTSBX429 +00964 P2120-EXIT. DTSBX429 +00965 EXIT. DTSBX429 +00966 DTSBX429 +00967 DTSBX429 +00968 P3000-WRITE-PAID-RPT. CL*48 +00969 MOVE X145-EMP-NO TO P434-EMP-NO CL*48 +00970 MOVE X145-QTR TO P434-QTR CL*48 +00971 IF W-EMP-FOUND-YES-88 CL*48 +00972 MOVE MPRF-PRIMARY-NAME (1:24) CL*48 +00973 TO P434-NAME-CHECK CL*48 +00974 ELSE CL*48 +00975 MOVE SPACES TO P434-NAME-CHECK CL*48 +00976 END-IF. CL*48 +00977 CL*48 +00978 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL*48 +00979 MOVE W-REMITTANCE TO P434-X145-REMIT CL*53 +00980 * ADD W-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL*54 +00981 CL*48 +00982 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL*48 +00983 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL*48 +00984 ADD 1 TO WS-LINE-CNT2. CL*48 +00985 * ADD +1 TO WS-NUMBER-ONE. CL*50 +00986 P3000-EXIT. CL*48 +00987 EXIT. CL*48 +00988 CL*48 +00989 CL*48 +00990 P4100-PRINT-HEADER. CL*48 +00991 IF WS-LINE-CNT GREATER 58 OR CL*48 +00992 WS-LINE-CNT2 GREATER 58 CL*48 +00993 MOVE +0 TO WS-LINE-CNT CL*48 +00994 MOVE +0 TO WS-LINE-CNT2 CL*48 +00995 ADD +1 TO WS-PAGE-CNT CL*48 +00996 MOVE WS-PAGE-CNT TO HDR3-PAGE CL*48 +00997 * MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME CL*50 +00998 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*48 +00999 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL*48 +01000 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL*48 +01001 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL*48 +01002 * WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL*50 +01003 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL*48 +01004 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL*48 +01005 ADD +6 TO WS-LINE-CNT2. CL*48 +01006 P4100-EXIT. CL*48 +01007 EXIT. CL*48 +01008 CL*48 +01009 CL*48 +01010 DTSBX429 +01011 T0000-TERMINATE. DTSBX429 +01012 IF WS-LINE-CNT2 > 52 CL*57 +01013 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*55 +01014 END-IF. CL*55 +01015 MOVE W-X212-CNT TO WS-FOOTING-CNT. CL*56 +01016 MOVE W-T025-WRITE-CNT TO WS-T025-WRITE-CNT. CL*56 +01017 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL*61 +01018 MOVE W-X145-ERR-CNT TO WS-X145-PEN-CNT. CL*61 +01019 MOVE W-TOT-PAID-REMITTANCE TO WS-TOT-REMIT. CL*57 +01020 * MOVE W-TOT-REMIT-AMT TO WS-TOTAL-REMIT. CL*56 +01021 MOVE W-TOT-REMITTANCE TO WS-TOTAL-REMIT. CL*60 +01022 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. CL*55 +01023 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. CL*55 +01024 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. CL*55 +01025 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. CL*55 +01026 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL*55 +01027 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL*55 +01028 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. CL*55 +01029 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. CL*56 +01030 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 3. CL*60 +01031 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. CL*55 +01032 CL*55 +01033 DISPLAY ' '. CL*55 +01034 CL*55 +01035 CL*55 +01036 DTSBX429 +01037 CLOSE TDEC-PAYT-FILE TDEC-PEND-FILE. CL*29 +01038 DTSBX429 +01039 PERFORM S910-CLOSE THRU S910-EXIT. CL*35 +01040 PERFORM S927C-CLOSE THRU S927C-EXIT. CL*43 +01041 DISPLAY ' '. DTSBX429 +01042 DTSBX429 +01043 DISPLAY '*** DTSBX429 TERMINATION STATISTICS ***'. CL*28 +01044 DTSBX429 +01045 DISPLAY ' '. DTSBX429 +01046 DTSBX429 +01047 DISPLAY '*** TDEC DEPOSITED CHECKS FOR DOES *'. CL*45 +01048 DTSBX429 +01049 DISPLAY ' '. DTSBX429 +01050 DTSBX429 +01051 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX429 +01052 DTSBX429 +01053 DISPLAY '***************************************'. DTSBX429 +01054 DTSBX429 +01055 T0000-EXIT. DTSBX429 +01056 EXIT. DTSBX429 +01057 DTSBX429 +01058 DTSBX429 +01059 T2000-DISPLAY-TOTALS. DTSBX429 +01060 DISPLAY 'TDEC CHECKS READ : ' CL*45 +01061 W-X212-CNT. CL*17 +01062 CL*17 +01063 DISPLAY 'CHECKS DEPOSITD WRITTEN: ' CL*45 +01064 W-T025-WRITE-CNT. DTSBX429 +01065 DTSBX429 +01066 DISPLAY 'TDEC CHECK ERRORS : ' CL*45 +01067 W-ERRO-CNT. CL*17 +01068 CL*17 +01069 DISPLAY 'MPRF RECORDS NOT FOUND : ' CL*17 +01070 W-MPRF-CNT. CL*17 +01071 CL*17 +01072 DISPLAY 'MQTR RECORDS NOT FOUND : ' CL*17 +01073 W-MQTR-CNT. CL*17 +01074 CL*17 +01075 DISPLAY 'PENDING RECORDS WRITTEN: ' CL*17 +01076 W-PEND-CNT. CL*17 +01077 CL*17 +01078 DTSBX429 +01079 DISPLAY ' '. DTSBX429 +01080 DTSBX429 +01081 T2000-EXIT. DTSBX429 +01082 EXIT. DTSBX429 +01083 DTSBX429 +01084 S001-FROM-FED-8. DTSBX429 +01085 SET L001-FROM-FED-8 TO TRUE. DTSBX429 +01086 GO TO S001-DATE. DTSBX429 +01087 DTSBX429 +01088 S001-FROM-CAL-8. DTSBX429 +01089 SET L001-FROM-CAL-8 TO TRUE. DTSBX429 +01090 GO TO S001-DATE. DTSBX429 +01091 DTSBX429 +01092 S001-FROM-ABS-DAY. DTSBX429 +01093 SET L001-FROM-ABS-DAY TO TRUE. DTSBX429 +01094 GO TO S001-DATE. DTSBX429 +01095 DTSBX429 +01096 S001-DATE. DTSBX429 +01097 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX429 +01098 S001-EXIT. DTSBX429 +01099 EXIT. DTSBX429 +01100 DTSBX429 +01101 S003-AGENCY-DAY. DTSBX429 +01102 SET L003-AGENCY-DAY TO TRUE. DTSBX429 +01103 GO TO S003-WORK-DAY. DTSBX429 +01104 DTSBX429 +01105 S003-WORK-DAY. DTSBX429 +01106 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX429 +01107 S003-EXIT. DTSBX429 +01108 EXIT. DTSBX429 +01109 DTSBX429 +01110 S004-FROM-5. DTSBX429 +01111 SET L004-FROM-5 TO TRUE. DTSBX429 +01112 GO TO S004-YRQ. DTSBX429 +01113 DTSBX429 +01114 S004-FROM-DATE. DTSBX429 +01115 SET L004-FROM-DATE TO TRUE. DTSBX429 +01116 GO TO S004-YRQ. DTSBX429 +01117 DTSBX429 +01118 S004-FROM-ABS. DTSBX429 +01119 SET L004-FROM-ABS TO TRUE. DTSBX429 +01120 GO TO S004-YRQ. DTSBX429 +01121 DTSBX429 +01122 S004-YRQ. DTSBX429 +01123 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX429 +01124 DTSBX429 +01125 S004-EXIT. DTSBX429 +01126 EXIT. DTSBX429 +01127 S005-FROM-SYS. CL*16 +01128 SET L005-FROM-SYS TO TRUE. CL*16 +01129 GO TO S005-ABSTIME. CL*16 +01130 CL*16 +01131 S005-FROM-ABSTIME. CL*16 +01132 SET L005-FROM-ABSTIME TO TRUE. CL*16 +01133 GO TO S005-ABSTIME. CL*16 +01134 CL*16 +01135 S005-ABSTIME. CL*16 +01136 CALL 'DTSBU005' USING L005-LINK-AREA. CL*16 +01137 S005-EXIT. CL*16 +01138 EXIT. CL*16 +01139 CL*32 +01140 S205-WEB-EDITOR. CL*32 +01141 CALL 'DTSBU205' USING L205-LINK-AREA. CL*32 +01142 S205-EXIT. CL*32 +01143 EXIT. CL*32 +01144 DTSBX429 +01145 S910-OPEN-READ. CL*35 +01146 SET L910-OPEN-READ-88 TO TRUE. CL*35 +01147 GO TO S910-MSTR-IO. CL*35 +01148 CL*35 +01149 S910-READ. DTSBX429 +01150 SET L910-READ-88 TO TRUE. DTSBX429 +01151 GO TO S910-MSTR-IO. DTSBX429 +01152 DTSBX429 +01153 S910-START-BROWSE. DTSBX429 +01154 SET L910-START-BROWSE-88 TO TRUE. DTSBX429 +01155 GO TO S910-MSTR-IO. DTSBX429 +01156 DTSBX429 +01157 S910-READ-NEXT. DTSBX429 +01158 SET L910-READ-NEXT-88 TO TRUE. DTSBX429 +01159 GO TO S910-MSTR-IO. DTSBX429 +01160 DTSBX429 +01161 S910-CLOSE. CL*35 +01162 SET L910-CLOSE-88 TO TRUE. CL*35 +01163 GO TO S910-MSTR-IO. CL*35 +01164 DTSBX429 +01165 S910-MSTR-IO. DTSBX429 +01166 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX429 +01167 MSKL-REC. DTSBX429 +01168 S910-EXIT. DTSBX429 +01169 EXIT. DTSBX429 +01170 DTSBX429 +01171 *S921-OPEN-READ. DTSBX429 +01172 * SET L921-OPEN-READ-88 TO TRUE. DTSBX429 +01173 * GO TO S921-AIX-IO. DTSBX429 +01174 DTSBX429 +01175 S921-READ. DTSBX429 +01176 SET L921-READ-88 TO TRUE. DTSBX429 +01177 GO TO S921-AIX-IO. DTSBX429 +01178 DTSBX429 +01179 S921-START-BROWSE. DTSBX429 +01180 SET L921-START-BROWSE-88 TO TRUE. DTSBX429 +01181 GO TO S921-AIX-IO. DTSBX429 +01182 DTSBX429 +01183 S921-READ-NEXT. DTSBX429 +01184 SET L921-READ-NEXT-88 TO TRUE. DTSBX429 +01185 GO TO S921-AIX-IO. DTSBX429 +01186 DTSBX429 +01187 *S921-CLOSE. DTSBX429 +01188 * SET L921-CLOSE-88 TO TRUE. DTSBX429 +01189 * GO TO S921-AIX-IO. DTSBX429 +01190 DTSBX429 +01191 S921-AIX-IO. DTSBX429 +01192 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX429 +01193 ISKL-REC. DTSBX429 +01194 S921-EXIT. DTSBX429 +01195 EXIT. DTSBX429 +01196 DTSBX429 +01197 S923-OPEN-UPDATE. DTSBX429 +01198 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX429 +01199 GO TO S923-ATC-CALL. DTSBX429 +01200 DTSBX429 +01201 S923-WRITE. DTSBX429 +01202 SET L923-WRITE-88 TO TRUE. DTSBX429 +01203 GO TO S923-ATC-CALL. DTSBX429 +01204 DTSBX429 +01205 S923-CLOSE. DTSBX429 +01206 SET L923-CLOSE-88 TO TRUE. DTSBX429 +01207 GO TO S923-ATC-CALL. DTSBX429 +01208 DTSBX429 +01209 S923-ATC-CALL. DTSBX429 +01210 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX429 +01211 ASKL-REC. DTSBX429 +01212 S923-EXIT. DTSBX429 +01213 EXIT. DTSBX429 +01214 DTSBX429 +01215 S927A-OPEN. CL*42 +01216 SET L927-OPEN-UPDATE-88 TO TRUE. CL*42 +01217 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 +01218 CL*42 +01219 S927A-EXIT. CL*42 +01220 EXIT. CL*42 +01221 DTSBX429 +01222 S927B-WRITE. DTSBX429 +01223 SET L927-WRITE-88 TO TRUE. DTSBX429 +01224 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX429 +01225 DTSBX429 +01226 S927B-EXIT. DTSBX429 +01227 EXIT. DTSBX429 +01228 DTSBX429 +01229 S927C-CLOSE. CL*42 +01230 SET L927-CLOSE-88 TO TRUE. CL*42 +01231 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 +01232 CL*42 +01233 S927C-EXIT. CL*42 +01234 EXIT. CL*42 +01235 DTSBX429 +01236 S927Z-IO. DTSBX429 +01237 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX429 +01238 TSKL-REC. DTSBX429 +01239 S927Z-EXIT. DTSBX429 +01240 EXIT. DTSBX429 +01241 DTSBX429 +01242 S931-OPEN-READ. DTSBX429 +01243 SET L931-OPEN-READ-88 TO TRUE. DTSBX429 +01244 GO TO S931-REF-IO. DTSBX429 +01245 DTSBX429 +01246 S931-CLOSE. DTSBX429 +01247 SET L931-CLOSE-88 TO TRUE. DTSBX429 +01248 GO TO S931-REF-IO. DTSBX429 +01249 DTSBX429 +01250 S931-REF-IO. DTSBX429 +01251 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX429 +01252 FSKL-REC. DTSBX429 +01253 S931-EXIT. DTSBX429 +01254 EXIT. DTSBX429 +01255 DTSBX429 +01256 S946-WRITE-R140. DTSBX429 +01257 CALL 'DTSBU946' USING R140-REC. DTSBX429 +01258 DTSBX429 +01259 S946-EXIT. DTSBX429 +01260 EXIT. DTSBX429 +01261 DTSBX429 +01262 S999-ABEND. DTSBX429 +01263 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX429 +01264 S999-EXIT. DTSBX429 +01265 EXIT. DTSBX429 +01266 DTSBX429 diff --git a/Batch/DTSBX430.cob b/Batch/DTSBX430.cob new file mode 100644 index 0000000..fed12f1 --- /dev/null +++ b/Batch/DTSBX430.cob @@ -0,0 +1,2865 @@ +00001 IDENTIFICATION DIVISION. 03/10/25 +00002 PROGRAM-ID. DTSBX430. DTSBX430 +00003 AUTHOR. NGC. LV253 +00004 DATE-WRITTEN. APRIL 2005. DTSBX430 +00005 DATE-COMPILED. DTSBX430 +00006 SKIP3 DTSBX430 +00007 ***** DTSBX430 +00008 * DTSBX430 +00009 * >>> PROCESSING FOR WEB REPORTS AND WAGES NEEDS TO BE DTSBX430 +00010 * >>> MODIFIED TO CREATE BATCH AND ITEM NUMBERS. THEY DTSBX430 +00011 * >>> WILL EITHER BE GROUPED INTO ACCOUNTING BATCHES DTSBX430 +00012 * >>> IN THE WEB APPLICATION, OR CONTINUE TO GO THROUGH DTSBX430 +00013 * >>> DTSBD140. DTSBX430 +00014 * DTSBX430 +00015 * FUNCTION: EDIT REPORT DATA FROM WEB APPLICATION. DTSBX430 +00016 * DTSBX430 +00017 * MODIFICATION HISTORY: DTSBX430 +00018 * DTSBX430 +00019 * 04-05-2005 INITIAL DEVELOPMENT DTSBX430 +00020 * REFERENCE RFP: WEB REPORTING DTSBX430 +00021 * DTSBX430 +00022 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSBX430 +00023 * NEW RECORD INCLUDES EMPLOYEE NAME. DTSBX430 +00024 * REFERENCE RFP: WEB REPORTING. DTSBX430 +00025 * DTSBX430 +00026 * DTSBX430 +00027 * 10-21-2009 MODIFIED TO SEPARATE REPORT PROCESSING FROM DTSBX430 +00028 * NEW WAGE-ONLY PROCESSING. P5000 CHANGED TO DTSBX430 +00029 * DETERMINE WHETHER ONLY WAGES OR WAGES DTSBX430 +00030 * ASSOCIATED WITH A REPORT ARE PRESENT. DTSBX430 +00031 * IF ONLY WAGES ARE PRESENT, COPY THE DTSBX430 +00032 * TEMPORARY WAGE FILE TO THE OUTPUT WAGE FILE. DTSBX430 +00033 * IF PROCESSING A REPORT, VERIFY THAT THE REPORTED DTSBX430 +00034 * AMOUNTS MATCH THE CALCULATED AMOUNTS, AND COPY DTSBX430 +00035 * BOTH THE REPORT AND WAGE TEMPORARY FILES DTSBX430 +00036 * TO THE OUTPUT. DTSBX430 +00037 * REFERENCE RFP: MAG MEDIA WAGE ONLY GD DTSBX430 +00038 * DTSBX430 +00039 * 06-09-2010 MODIFIED FOR IN-HOUSE CASHIERING. DTSBX430 +00040 * REFERENCE RFP: IN-HOUSE CASHIERING GD DTSBX430 +00041 * DTSBX430 +00042 * 11-10-2010 MODIFIED FOR WEB REPORTING. GD DTSBX430 +00043 * DTSBX430 +00044 * DTSBX430 +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 ***** DTSBX430 +00052 SKIP3 DTSBX430 +00053 ENVIRONMENT DIVISION. DTSBX430 +00054 CL122 +00055 CONFIGURATION SECTION. CL122 +00056 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL122 +00057 CL122 +00058 INPUT-OUTPUT SECTION. DTSBX430 +00059 DTSBX430 +00060 FILE-CONTROL. DTSBX430 +00061 DTSBX430 +00062 SELECT TEMP-BTC-FILE ASSIGN TO X430BTC CL*47 +00063 FILE STATUS IS TEMP-BTC-STATUS. DTSBX430 +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-X145-FILE ASSIGN TO PENDX145 CL*59 +00072 FILE STATUS IS PAYT-145-STATUS. CL*63 +00073 CL*59 +00074 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSBX430 +00075 FILE STATUS IS WAGE-TEMP-STATUS. DTSBX430 +00076 DTSBX430 +00077 SELECT WAGE-FILE-OUT ASSIGN TO DTSFW4GE CL*22 +00078 FILE STATUS IS WAGE-OUT-STATUS. CL*20 +00079 DTSBX430 +00080 SELECT BATCH-XREF-FILE ASSIGN TO BX214422 DTSBX430 +00081 FILE STATUS IS BATCH-XREF-STATUS. DTSBX430 +00082 CL119 +00083 SELECT X430-PAID-FILE ASSIGN TO X430RPT1 CL203 +00084 FILE STATUS IS REPT-STATUS. CL119 +00085 CL119 +00086 SELECT X430-PEND-FILE ASSIGN TO X430RPT2 CL203 +00087 FILE STATUS IS REPT-STATUS. CL119 +00088 CL119 +00089 DTSBX430 +00090 DATA DIVISION. DTSBX430 +00091 DTSBX430 +00092 FILE SECTION. DTSBX430 +00093 DTSBX430 +00094 FD TEMP-BTC-FILE DTSBX430 +00095 RECORDING MODE IS V DTSBX430 +00096 BLOCK CONTAINS 0 RECORDS. DTSBX430 +00097 DTSBX430 +00098 01 TEMP-BTC-REC. DTSBX430 +00099 ++INCLUDE DTSIRVAR DTSBX430 +00100 DTSBX430 +00101 01 TSKL-REC. DTSBX430 +00102 ++INCLUDE DTSITSKL DTSBX430 +00103 DTSBX430 +00104 FD WAGE-FILE-TEMP DTSBX430 +00105 RECORDING MODE IS F DTSBX430 +00106 BLOCK CONTAINS 0 RECORDS DTSBX430 +00107 LABEL RECORDS ARE OMITTED. DTSBX430 +00108 DTSBX430 +00109 01 WAGE-TEMP-REC PIC X(128). DTSBX430 +00110 DTSBX430 +00111 FD WAGE-FILE-OUT CL*20 +00112 RECORDING MODE IS F CL*20 +00113 BLOCK CONTAINS 0 RECORDS CL*20 +00114 LABEL RECORDS ARE OMITTED. CL*20 +00115 DTSBX430 +00116 01 WAGE-OUT-REC PIC X(80). CL*20 +00117 DTSBX430 +00118 FD BATCH-XREF-FILE DTSBX430 +00119 RECORDING MODE IS F DTSBX430 +00120 BLOCK CONTAINS 0 RECORDS DTSBX430 +00121 LABEL RECORDS ARE OMITTED. DTSBX430 +00122 DTSBX430 +00123 01 BATCH-XREF-REC PIC X(30). DTSBX430 +00124 CL*11 +00125 CL*59 +00126 FD PEND-X140-FILE CL*59 +00127 RECORDING MODE IS F CL*59 +00128 BLOCK CONTAINS 0 RECORDS CL*59 +00129 LABEL RECORDS ARE OMITTED. CL*59 +00130 CL*59 +00131 01 PEND-X140-REC PIC X(512). CL*59 +00132 DTSBX430 +00133 FD PEND-X144-FILE CL*59 +00134 RECORDING MODE IS F CL*59 +00135 BLOCK CONTAINS 0 RECORDS CL*59 +00136 LABEL RECORDS ARE OMITTED. CL*59 +00137 CL*59 +00138 01 PEND-X144-REC PIC X(512). CL*59 +00139 CL*59 +00140 FD PEND-X145-FILE CL*59 +00141 RECORDING MODE IS F CL*59 +00142 BLOCK CONTAINS 0 RECORDS CL*59 +00143 LABEL RECORDS ARE OMITTED. CL*59 +00144 CL*59 +00145 01 PEND-X145-REC PIC X(512). CL*59 +00146 CL119 +00147 FD X430-PAID-FILE CL200 +00148 RECORDING MODE IS F CL119 +00149 BLOCK CONTAINS 0 RECORDS CL119 +00150 LABEL RECORDS ARE OMITTED. CL119 +00151 CL119 +00152 01 REPT-PAID-REC PIC X(133). CL121 +00153 CL119 +00154 CL119 +00155 FD X430-PEND-FILE CL200 +00156 RECORDING MODE IS F CL119 +00157 BLOCK CONTAINS 0 RECORDS CL119 +00158 LABEL RECORDS ARE OMITTED. CL119 +00159 CL119 +00160 01 REPT-PEND-REC PIC X(133). CL119 +00161 CL119 +00162 CL*59 +00163 WORKING-STORAGE SECTION. DTSBX430 +001635 77 PAN-VALET PICTURE X(24) VALUE '253DTSBX430 03/10/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 +00167 01 WRK-AREA. DTSBX430 +00168 05 W-ABEND-CD PIC S9(04) COMP VALUE 430. CL*47 +00169 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX430'. CL*47 +00170 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL121 +00171 CL121 +00172 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL121 +00173 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL121 +00174 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL121 +00175 CL133 +00176 05 WSP-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL133 +00177 05 WSP-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL133 +00178 05 WSP-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL133 +00179 05 WRK-CURR-DATE PIC 9(08) VALUE 0. CL248 +00180 CL121 +00181 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX430 +00182 88 W-PREV-REC-NULL-88 VALUE 'XXX'. CL*87 +00183 88 W-PREV-RPT-NULL-88 VALUE 'XXX'. CL*87 +00184 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX430 +00185 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX430 +00186 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX430 +00187 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX430 +00188 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX430 +00189 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX430 +00190 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX430 +00191 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX430 +00192 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX430 +00193 88 W-PREV-RPT-RPT-88 VALUE '140'. CL*86 +00194 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX430 +00195 88 W-PREV-RPT-WAGE-88 VALUE '144'. CL*86 +00196 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX430 +00197 88 W-PREV-RPT-PAY-88 VALUE '145'. CL*86 +00198 88 W-PREV-REC-BHDR-88 VALUE '149'. DTSBX430 +00199 DTSBX430 +00200 05 TEMP-BTC-STATUS PIC X(02). DTSBX430 +00201 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX430 +00202 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX430 +00203 DTSBX430 +00204 05 WAGE-TEMP-STATUS PIC X(02). DTSBX430 +00205 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX430 +00206 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX430 +00207 DTSBX430 +00208 05 WAGE-OUT-STATUS PIC X(02). DTSBX430 +00209 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX430 +00210 DTSBX430 +00211 05 BATCH-XREF-STATUS PIC X(02). DTSBX430 +00212 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX430 +00213 DTSBX430 +00214 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX430 +00215 CL*12 +00216 05 WAGE-TRANS-STATUS PIC X(02). CL*12 +00217 88 WAGE-TRANS-FILE-OK-88 VALUE '00' '97'. CL*12 +00218 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*12 +00219 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. CL*12 +00220 CL*12 +00221 05 REPT-140-STATUS PIC X(02). CL*63 +00222 88 REPT-140-OK-88 VALUE '00' '97'. CL*63 +00223 88 REPT-140--NO-REC-88 VALUE '10' '23'. CL*63 +00224 CL*61 +00225 05 WAGE-144-STATUS PIC X(02). CL*63 +00226 88 WAGE-144-OK-88 VALUE '00' '97'. CL*63 +00227 88 WAGE-144--NO-REC-88 VALUE '10' '23'. CL*63 +00228 CL*61 +00229 05 PAYT-145-STATUS PIC X(02). CL*63 +00230 88 PAYT-145-OK-88 VALUE '00' '97'. CL*64 +00231 88 PAYT-145-NO-REC-88 VALUE '10' '23'. CL*64 +00232 DTSBX430 +00233 CL119 +00234 05 REPT-STATUS PIC X(02). CL119 +00235 88 REPT-STATUS-OK-88 VALUE '00'. CL119 +00236 88 REPT-STATUS-EOF-88 VALUE '10'. CL119 +00237 CL119 +00238 05 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL*80 +00239 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL*81 +00240 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL*81 +00241 DTSBX430 +00242 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX430 +00243 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX430 +00244 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX430 +00245 DTSBX430 +00246 05 W-X145-PAYMENT-FOUND-IND PIC X(01) VALUE 'N'. CL*54 +00247 88 W-X145-PAYMENT-YES-88 VALUE 'Y'. CL*54 +00248 88 W-X145-PAYMENT-NO-88 VALUE 'N'. CL*54 +00249 CL*54 +00250 05 W-X145-PAYMENT-DUPLIC-IND PIC X(01) VALUE 'N'. CL170 +00251 88 X145-PAYMENT-DUP-YES-88 VALUE 'Y'. CL170 +00252 88 X145-PAYMENT-DUP-NO-88 VALUE 'N'. CL170 +00253 CL170 +00254 05 W-WRITE-T025-TRAN PIC X(01) VALUE 'N'. CL*73 +00255 88 W-WRITE-T025-TRAN-YES-88 VALUE 'Y'. CL*73 +00256 88 W-WRITE-T025-TRAN-NO-88 VALUE 'N'. CL*73 +00257 CL*73 +00258 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX430 +00259 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX430 +00260 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX430 +00261 DTSBX430 +00262 05 W-RPT-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX430 +00263 88 W-RPT-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX430 +00264 88 W-RPT-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX430 +00265 DTSBX430 +00266 05 W-WAGE-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX430 +00267 88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX430 +00268 88 W-WAGE-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX430 +00269 DTSBX430 +00270 05 W-ARPT-MAX PIC S9(04) COMP VALUE +100. DTSBX430 +00271 05 W-ARPT-LAST PIC S9(04) COMP VALUE +0. DTSBX430 +00272 05 RSUB PIC S9(04) COMP VALUE +0. DTSBX430 +00273 05 W-ARPT-TABLE. DTSBX430 +00274 10 W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128). DTSBX430 +00275 DTSBX430 +00276 05 W-EMP-NO PIC S9(07) COMP-3. DTSBX430 +00277 05 W-EMP-X140-NO PIC S9(07) COMP-3. CL189 +00278 05 W-EMP-X144-NO PIC S9(07) COMP-3. CL191 +00279 05 W-PAY-QTR PIC X(06) VALUE SPACES. CL166 +00280 05 W-X140-DUP PIC S9(03) COMP-3 VALUE +0. CL*41 +00281 05 W-TRAN-CNT PIC S9(03) COMP-3 VALUE +0. CL*41 +00282 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSBX430 +00283 05 W-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. CL*73 +00284 05 W-CURR-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX430 +00285 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX430 +00286 05 W-WAIVER-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX430 +00287 05 W-X140-REPORT-QTR PIC S9(05) COMP-3. CL*54 +00288 05 W-X145-PAYMENT-QTR PIC S9(05) COMP-3. CL*54 +00289 05 W-X144-WAGE-QTR PIC S9(05) COMP-3. CL*54 +00290 05 WRK-REPORT-QTR PIC 9(05). DTSBX430 +00291 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. CL158 +00292 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. CL157 +00293 10 W-X145-TRACE-NO-A PIC 9(08). CL158 +00294 10 W-X145-TRACE-NO-B PIC 9(05). CL158 +00295 05 W-EXCESS-WAGE PIC S9(11)V99 VALUE +0. CL252 +00296 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. CL194 +00297 05 W-TOT-X144-WAGE PIC S9(11)V99 VALUE +0. CL189 +00298 05 W-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00299 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX430 +00300 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00301 05 WS-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00302 05 W-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00303 05 W-X145-REMITTANCE PIC S9(09)V99 VALUE +0. CL123 +00304 05 W-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00305 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00306 05 W-X145-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00307 05 W-X140-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00308 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSBX430 +00309 05 W-X145-DEPOSIT-DATE PIC S9(09) COMP-3. CL*72 +00310 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX430 +00311 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX430 +00312 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX430 +00313 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX430 +00314 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX430 +00315 05 W-SSN PIC S9(09) COMP-3. DTSBX430 +00316 05 W-EARNINGS-X PIC X(12). DTSBX430 +00317 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX430 +00318 PIC 9(09).99. DTSBX430 +00319 05 W-EARNINGS PIC S9(09)V99. DTSBX430 +00320 CL180 +00321 05 WS-Z145-DUP-REC PIC X(50) VALUE SPACES. CL181 +00322 05 W-WORKER-NAME. DTSBX430 +00323 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX430 +00324 10 W-WRKR-MID-INIT PIC X(01). DTSBX430 +00325 10 W-WRKR-LAST-NAME PIC X(20). DTSBX430 +00326 DTSBX430 +00327 05 W-RPT-TYPE PIC X(02). DTSBX430 +00328 88 W-ORIG-88 VALUE 'OR'. DTSBX430 +00329 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX430 +00330 88 W-AUDIT-88 VALUE 'AU'. DTSBX430 +00331 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX430 +00332 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX430 +00333 88 W-ESTIM-88 VALUE 'ES'. DTSBX430 +00334 88 W-WITHDRW-88 VALUE 'WD'. DTSBX430 +00335 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX430 +00336 'FS' 'AC'. DTSBX430 +00337 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX430 +00338 'FS' 'AC' 'ES'. CL*55 +00339 05 WS-HOLD-X145-REC PIC X(512) VALUE SPACES. CL170 +00340 CL*55 +00341 05 W-PAY-TYPE PIC X(02). CL*54 +00342 88 W-PAY-ORIG-88 VALUE 'OR'. CL*54 +00343 88 W-PAY-REG-88 VALUE 'PA'. CL*54 +00344 88 W-VALID-PAY-88 VALUE 'OR' 'PA'. CL*54 +00345 CL*54 +00346 DTSBX430 +00347 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX430 +00348 DTSBX430 +00349 05 W-MNTE-SUBJECT PIC X(40). DTSBX430 +00350 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX430 +00351 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX430 +00352 88 W-MNTE-KEY-WORD-88 VALUE DTSBX430 +00353 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX430 +00354 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX430 +00355 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX430 +00356 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX430 +00357 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX430 +00358 DTSBX430 +00359 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX430 +00360 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX430 +00361 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX430 +00362 DTSBX430 +00363 05 TSUB1 PIC S9(04) COMP. DTSBX430 +00364 05 TSUB2 PIC S9(04) COMP. DTSBX430 +00365 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX430 +00366 DTSBX430 +00367 05 W-MNTE-LINE PIC X(72). DTSBX430 +00368 DTSBX430 +00369 05 W-SLASH-DATE PIC X(10). DTSBX430 +00370 05 FILLER REDEFINES W-SLASH-DATE. DTSBX430 +00371 10 W-SLASH-DT-MM PIC X(02). DTSBX430 +00372 10 FILLER PIC X(01). DTSBX430 +00373 10 W-SLASH-DT-DD PIC X(02). DTSBX430 +00374 10 FILLER PIC X(01). DTSBX430 +00375 10 W-SLASH-DT-CCYY PIC X(04). DTSBX430 +00376 DTSBX430 +00377 05 W-SLASH-QTR PIC X(06). DTSBX430 +00378 05 FILLER REDEFINES W-SLASH-QTR. DTSBX430 +00379 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX430 +00380 10 FILLER PIC X(01). DTSBX430 +00381 10 W-SLASH-QTR-Q PIC X(01). DTSBX430 +00382 DTSBX430 +00383 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00384 * BATCH HEADER DTSBX430 +00385 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00386 * REPORT DTSBX430 +00387 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00388 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00389 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00390 05 W-X140-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00391 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00392 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00393 * EMPLOYEE WAGES DTSBX430 +00394 05 W-X144-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00395 05 W-X144-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00396 05 W-X144-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00397 05 W-X144-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00398 05 W-X144-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00399 05 W-X144-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00400 DTSBX430 +00401 * EMPLOYER PAYMENT CL*54 +00402 05 W-X145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00403 05 W-X145-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00404 05 W-X145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00405 05 W-X145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00406 05 W-X145-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00407 05 W-X145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00408 * EMPLOYEE W4 COUNT CL*13 +00409 05 W-W4-CNT PIC S9(07) COMP-3 VALUE +0. CL*13 +00410 CL*13 +00411 ** 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00412 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00413 05 W-T028-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00414 05 W-T028-WRITEE-CNT PIC S9(07) COMP-3 VALUE +0. CL102 +00415 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00416 05 W-T025-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00417 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00418 05 W-ARPT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00419 05 W-BX214-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00420 DTSBX430 +00421 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX430 +00422 05 W-X144-LENGTH PIC S9(04) COMP. DTSBX430 +00423 05 W-X145-LENGTH PIC S9(04) COMP. CL*54 +00424 DTSBX430 +00425 05 W-AMT-DISP1 PIC ----------9.99. DTSBX430 +00426 05 W-AMT-DISP2 PIC ----------9.99. DTSBX430 +00427 *RW1 DTSBX430 +00428 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX430 +00429 05 DISPLAY-CNT PIC Z(06)9. DTSBX430 +00430 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX430 +00431 *RW2 DTSBX430 +00432 DTSBX430 +00433 01 MESSAGE-AREA. DTSBX430 +00434 *** FATAL ERRORS MSG-A DTSBX430 +00435 05 MSG-A1. DTSBX430 +00436 10 FILLER PIC X(32) DTSBX430 +00437 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX430 +00438 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX430 +00439 01 HEADER-1. CL119 +00440 05 FILLER PIC X(01) VALUE SPACES. CL119 +00441 05 FILLER PIC X(49) VALUE '140R1'. CL119 +00442 05 FILLER PIC X(60) VALUE CL119 +00443 'DISTRICT OF COLUMBIA'. CL119 +00444 05 FILLER PIC X(06) VALUE 'DATE:'. CL119 +00445 05 HDR1-LRCM-SYS-DATE PIC X(10). CL248 +00446 01 HEADER-2. CL119 +00447 05 FILLER PIC X(54) VALUE SPACES. CL119 +00448 05 FILLER PIC X(56) VALUE CL119 +00449 'TAX DIVISION'. CL119 +00450 05 FILLER PIC X(06) VALUE 'TIME:'. CL119 +00451 05 HDR2-LRCM-SYS-TIME PIC X(08). CL119 +00452 CL119 +00453 01 HEADER-3. CL119 +00454 05 FILLER PIC X(01) VALUE SPACES. CL119 +00455 05 FILLER PIC X(38) VALUE CL119 +00456 'ROUTE TO: TAX ACCOUNTING STAFF'. CL119 +00457 05 HDR3-LITERAL PIC X(43) VALUE CL119 +00458 ' ESSP DAILY REPORTS SUBMITTED TO DUTAS '. CL205 +00459 05 FILLER PIC X(28) VALUE SPACES. CL119 +00460 05 FILLER PIC X(06) VALUE 'PAGE:'. CL119 +00461 05 HDR3-PAGE PIC ZZ,ZZ9. CL119 +00462 CL119 +00463 01 HEADER-31. CL131 +00464 05 FILLER PIC X(01) VALUE SPACES. CL131 +00465 05 FILLER PIC X(38) VALUE CL131 +00466 'ROUTE TO: TAX ACCOUNTING STAFF'. CL131 +00467 05 HDR3-LITERAL PIC X(43) VALUE CL131 +00468 ' ESSP DAILY REPORT MISSING WAGES '. CL209 +00469 05 FILLER PIC X(28) VALUE SPACES. CL131 +00470 05 FILLER PIC X(06) VALUE 'PAGE:'. CL131 +00471 05 HDR31-PAGE PIC ZZ,ZZ9. CL131 +00472 CL131 +00473 01 HEADER-4. CL119 +00474 05 FILLER PIC X(01) VALUE SPACES. CL119 +00475 05 FILLER PIC X(132) VALUE SPACES. CL119 +00476 01 HEADER-42. CL144 +00477 05 FILLER PIC X(02) VALUE SPACES. CL144 +00478 05 FILLER PIC X(34) VALUE CL144 +00479 ' '. CL144 +00480 05 FILLER PIC X(02) VALUE SPACES. CL144 +00481 05 FILLER PIC X(25) VALUE CL144 +00482 ' '. CL144 +00483 05 FILLER PIC X(12) VALUE SPACES. CL205 +00484 05 FILLER PIC X(25) VALUE CL204 +00485 ' -MONTHLY COUNTS-'. CL206 +00486 05 FILLER PIC X(30) VALUE CL152 +00487 ' '. CL204 +00488 CL119 +00489 01 HEADER-5. CL119 +00490 05 FILLER PIC X(02) VALUE SPACES. CL126 +00491 05 FILLER PIC X(34) VALUE CL119 +00492 'EMP NO NAME QTR RECV-DATE '. CL204 +00493 05 FILLER PIC X(25) VALUE CL126 +00494 'TOTAL-AMT EXCESS-AMT '. CL204 +00495 05 FILLER PIC X(03) VALUE SPACES. CL119 +00496 05 FILLER PIC X(41) VALUE CL245 +00497 'TAX-AMT X144-DIFF M1 M2 M3'. CL245 +00498 05 FILLER PIC X(02) VALUE SPACES. CL127 +00499 05 HDR5-NAME PIC X(36) VALUE SPACES. CL206 +00500 CL119 +00501 01 HEADER-6. CL119 +00502 05 FILLER PIC X(01) VALUE SPACES. CL119 +00503 05 FILLER PIC X(132) VALUE SPACES. CL119 +00504 01 DETAIL-LINE-1. CL119 +00505 15 FILLER PIC X(02) VALUE SPACES. CL119 +00506 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL119 +00507 15 FILLER PIC X(01) VALUE SPACES. CL188 +00508 15 X434-NAME-CHECK PIC X(04) VALUE SPACES. CL119 +00509 15 FILLER PIC X(01) VALUE SPACES. CL188 +00510 15 X434-QTR PIC X(06). CL119 +00511 15 FILLER PIC X(01) VALUE SPACES. CL188 +00512 15 X434-RCVD-DATE PIC X(10). CL119 +00513 15 FILLER PIC X(01) VALUE SPACES. CL119 +00514 15 X434-TOT-WAGE PIC --------9.99. CL119 +00515 15 FILLER PIC X(01) VALUE SPACES. CL119 +00516 15 X434-EXC-WAGE PIC --------9.99. CL119 +00517 15 FILLER PIC X(01) VALUE SPACES. CL119 +00518 15 X434-TAX-WAGE PIC --------9.99. CL119 +00519 15 FILLER PIC X(01) VALUE SPACES. CL119 +00520 * 15 X434-X140-REMIT PIC --------9.99. CL187 +00521 15 FILLER PIC X(01) VALUE SPACES. CL119 +00522 15 X434-X144-WAGE PIC --------9.99. CL243 +00523 15 FILLER PIC X(01) VALUE SPACES. CL148 +00524 * 15 X434-DIFF PIC ----9.99. CL187 +00525 15 X434-M1-CNT PIC ZZZZZZ9. CL129 +00526 15 X434-M2-CNT PIC ZZZZZZ9. CL129 +00527 15 X434-M3-CNT PIC ZZZZZZ9. CL129 +00528 15 FILLER PIC X(01) VALUE SPACES. CL188 +00529 15 X434-MESSAGE PIC X(35). CL206 +00530 CL119 +00531 01 DETAIL-PEND-1. CL131 +00532 15 FILLER PIC X(02) VALUE SPACES. CL131 +00533 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL131 +00534 15 FILLER PIC X(02) VALUE SPACES. CL131 +00535 15 P434-NAME-CHECK PIC X(04) VALUE SPACES. CL131 +00536 15 FILLER PIC X(02) VALUE SPACES. CL131 +00537 15 P434-QTR PIC X(06). CL131 +00538 15 FILLER PIC X(02) VALUE SPACES. CL131 +00539 15 P434-RCVD-DATE PIC X(10). CL131 +00540 15 FILLER PIC X(01) VALUE SPACES. CL131 +00541 15 P434-TOT-WAGE PIC --------9.99. CL131 +00542 15 FILLER PIC X(01) VALUE SPACES. CL131 +00543 15 P434-EXC-WAGE PIC --------9.99. CL131 +00544 15 FILLER PIC X(01) VALUE SPACES. CL131 +00545 15 P434-TAX-WAGE PIC --------9.99. CL131 +00546 15 FILLER PIC X(01) VALUE SPACES. CL131 +00547 15 P434-X140-REMIT PIC --------9.99. CL131 +00548 15 FILLER PIC X(01) VALUE SPACES. CL131 +00549 15 P434-X145-REMIT PIC --------9.99. CL131 +00550 15 FILLER PIC X(02) VALUE SPACES. CL138 +00551 15 P434-MESSAGE PIC X(35). CL206 +00552 CL131 +00553 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL119 +00554 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL119 +00555 CL119 +00556 01 FOOTING-LINE-3. CL119 +00557 05 FILLER PIC X(25) VALUE SPACES. CL119 +00558 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL119 +00559 05 FILLER PIC X(02) VALUE SPACES. CL119 +00560 05 FILLER PIC X(34) VALUE CL119 +00561 'TOTAL CHECK PAYMENT RECEIVED'. CL128 +00562 05 FILLER PIC X(32) VALUE SPACES. CL119 +00563 CL119 +00564 01 FOOTING-LINE-4. CL153 +00565 05 FILLER PIC X(25) VALUE SPACES. CL119 +00566 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL119 +00567 05 FILLER PIC X(02) VALUE SPACES. CL119 +00568 05 FILLER PIC X(34) VALUE CL119 +00569 ' # OF PAYMENTS HAD ERRORS '. CL119 +00570 05 FILLER PIC X(32) VALUE SPACES. CL119 +00571 CL119 +00572 01 FOOTING-LINE-5. CL153 +00573 05 FILLER PIC X(25) VALUE SPACES. CL119 +00574 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL119 +00575 05 FILLER PIC X(02) VALUE SPACES. CL119 +00576 05 FILLER PIC X(40) VALUE CL130 +00577 ' # OF PAYMENTS WENT TO PENDING STATUS'. CL130 +00578 05 FILLER PIC X(32) VALUE SPACES. CL119 +00579 01 FOOTING-LINE-6. CL153 +00580 05 FILLER PIC X(25) VALUE SPACES. CL130 +00581 05 WS-X140-RED-CNT PIC ZZ,ZZ9. CL130 +00582 05 FILLER PIC X(02) VALUE SPACES. CL130 +00583 05 FILLER PIC X(34) VALUE CL130 +00584 'TOTAL REPORT RECEIVED FROM ESSP '. CL130 +00585 05 FILLER PIC X(32) VALUE SPACES. CL130 +00586 01 FOOTING-LINE-7. CL153 +00587 05 FILLER PIC X(25) VALUE SPACES. CL130 +00588 05 WS-X140-ERR-CNT PIC ZZ,ZZ9. CL130 +00589 05 FILLER PIC X(02) VALUE SPACES. CL130 +00590 05 FILLER PIC X(34) VALUE CL130 +00591 ' # OF REPORTS HAD ERRORS '. CL130 +00592 05 FILLER PIC X(32) VALUE SPACES. CL130 +00593 CL130 +00594 01 FOOTING-LINE-8. CL153 +00595 05 FILLER PIC X(25) VALUE SPACES. CL130 +00596 05 WS-X140-PEN-CNT PIC ZZ,ZZ9. CL130 +00597 05 FILLER PIC X(02) VALUE SPACES. CL130 +00598 05 FILLER PIC X(40) VALUE CL130 +00599 ' # OF REPORTS WENT TO PENDING STATUS'. CL130 +00600 05 FILLER PIC X(32) VALUE SPACES. CL130 +00601 CL119 +00602 01 FOOTING-LINE-9. CL153 +00603 05 FILLER PIC X(24) VALUE SPACES. CL153 +00604 05 WS-X144-RED-CNT PIC ZZZ,ZZ9. CL153 +00605 05 FILLER PIC X(02) VALUE SPACES. CL153 +00606 05 FILLER PIC X(34) VALUE CL153 +00607 'TOTAL WAGES RECEIVED FROM ESSP '. CL153 +00608 05 FILLER PIC X(32) VALUE SPACES. CL153 +00609 01 FOOTING-LINE-10. CL153 +00610 05 FILLER PIC X(24) VALUE SPACES. CL153 +00611 05 WS-X144-ERR-CNT PIC ZZZ,ZZ9. CL153 +00612 05 FILLER PIC X(02) VALUE SPACES. CL153 +00613 05 FILLER PIC X(34) VALUE CL153 +00614 ' # OF WAGES HAD ERRORS '. CL153 +00615 05 FILLER PIC X(32) VALUE SPACES. CL153 +00616 CL153 +00617 01 FOOTING-LINE-11. CL153 +00618 05 FILLER PIC X(24) VALUE SPACES. CL153 +00619 05 WS-X144-PEN-CNT PIC ZZZ,ZZ9. CL153 +00620 05 FILLER PIC X(02) VALUE SPACES. CL153 +00621 05 FILLER PIC X(40) VALUE CL153 +00622 ' # OF WAGES WENT TO PENDING STATUS'. CL207 +00623 05 FILLER PIC X(32) VALUE SPACES. CL153 +00624 01 FOOTING-LINE-12. CL153 +00625 05 FILLER PIC X(19) VALUE SPACES. CL119 +00626 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL119 +00627 05 FILLER PIC X(02) VALUE SPACES. CL119 +00628 05 FILLER PIC X(36) VALUE CL119 +00629 ' TOTAL REMIT AMOUNT APPLIED TO DUTAS'. CL119 +00630 05 FILLER PIC X(32) VALUE SPACES. CL119 +00631 CL119 +00632 01 FOOTING-LINE-13. CL153 +00633 05 FILLER PIC X(25) VALUE SPACES. CL119 +00634 05 FILLER PIC X(67) VALUE CL153 +00635 '*** END ESSP/DUTAS DAILY REPORT/WAGE PROCESSING ***'. CL207 +00636 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL154 +00637 DTSBX430 +00638 01 T003-REC. DTSBX430 +00639 ++INCLUDE DTSIT003 DTSBX430 +00640 DTSBX430 +00641 01 T025-REC. DTSBX430 +00642 ++INCLUDE DTSIT025 DTSBX430 +00643 DTSBX430 +00644 *01 T027-REC. DTSBX430 +00645 *++INCLUDE DTSIT027 DTSBX430 +00646 DTSBX430 +00647 01 T028-REC. DTSBX430 +00648 ++INCLUDE DTSIT028 DTSBX430 +00649 DTSBX430 +00650 CL*11 +00651 01 W001-REC. DTSBX430 +00652 ++INCLUDE DTSIW001 DTSBX430 +00653 CL*11 +00654 01 WAGE-TRANS-AREA. CL*11 +00655 05 ESP-TRANSACTION-AREA PIC X(80). CL*11 +00656 ++INCLUDE EWGTRNW4 CL*11 +00657 CL*11 +00658 DTSBX430 +00659 * ACCOUNTING BATCH HEADER DTSBX430 +00660 01 X149-REC. DTSBX430 +00661 ++INCLUDE DTSIX149 DTSBX430 +00662 DTSBX430 +00663 * REPORT DTSBX430 +00664 01 X140-REC. DTSBX430 +00665 ++INCLUDE DTSIX140 DTSBX430 +00666 DTSBX430 +00667 * EMPLOYEE WAGES DTSBX430 +00668 01 X144-REC. DTSBX430 +00669 ++INCLUDE DTSIX144 DTSBX430 +00670 DTSBX430 +00671 * PAYMENTS CL*47 +00672 01 X145-REC. CL*47 +00673 ++INCLUDE DTSIX145 CL*47 +00674 CL*47 +00675 * BATCH - PSEUDO-BATCH XREF DTSBX430 +00676 01 X214-REC. DTSBX430 +00677 ++INCLUDE DTSIX214 DTSBX430 +00678 DTSBX430 +00679 * ERRORS DTSBX430 +00680 *01 X907-REC. DTSBX430 +00681 ***INCLUDE DTSIX907 DTSBX430 +00682 DTSBX430 +00683 01 L001-LINK-AREA. DTSBX430 +00684 ++INCLUDE DTSIL001 DTSBX430 +00685 DTSBX430 +00686 01 L003-LINK-AREA. DTSBX430 +00687 ++INCLUDE DTSIL003 DTSBX430 +00688 DTSBX430 +00689 01 L004-LINK-AREA. DTSBX430 +00690 ++INCLUDE DTSIL004 DTSBX430 +00691 DTSBX430 +00692 01 L516-LINK-AREA. DTSBX430 +00693 ++INCLUDE DTSIL516 DTSBX430 +00694 DTSBX430 +00695 01 L910-LINK-AREA. DTSBX430 +00696 ++INCLUDE DTSIL910 DTSBX430 +00697 01 MSKL-REC. DTSBX430 +00698 ++INCLUDE DTSIMSKL DTSBX430 +00699 DTSBX430 +00700 01 MHDR-REC. DTSBX430 +00701 ++INCLUDE DTSIMHDR DTSBX430 +00702 DTSBX430 +00703 01 MPRF-REC. DTSBX430 +00704 ++INCLUDE DTSIMPRF DTSBX430 +00705 DTSBX430 +00706 01 MSOL-REC. DTSBX430 +00707 ++INCLUDE DTSIMSOL DTSBX430 +00708 DTSBX430 +00709 01 MQTR-REC. DTSBX430 +00710 ++INCLUDE DTSIMQTR DTSBX430 +00711 DTSBX430 +00712 01 MRPT-REC. CL178 +00713 ++INCLUDE DTSIMRPT CL178 +00714 CL178 +00715 01 MOPO-REC. DTSBX430 +00716 ++INCLUDE DTSIMOPO DTSBX430 +00717 DTSBX430 +00718 01 MTAD-REC. DTSBX430 +00719 ++INCLUDE DTSIMTAD DTSBX430 +00720 DTSBX430 +00721 01 MNTE-REC. DTSBX430 +00722 ++INCLUDE DTSIMNTE DTSBX430 +00723 DTSBX430 +00724 01 L921-LINK-AREA. DTSBX430 +00725 ++INCLUDE DTSIL921 DTSBX430 +00726 SKIP3 DTSBX430 +00727 01 ISKL-REC. DTSBX430 +00728 ++INCLUDE DTSIISKL DTSBX430 +00729 SKIP3 DTSBX430 +00730 01 IEIN-REC. DTSBX430 +00731 ++INCLUDE DTSIIEIN DTSBX430 +00732 DTSBX430 +00733 01 L923-LINK-AREA. DTSBX430 +00734 ++INCLUDE DTSIL923 DTSBX430 +00735 EJECT DTSBX430 +00736 01 ASKL-REC. DTSBX430 +00737 ++INCLUDE DTSIASKL DTSBX430 +00738 EJECT DTSBX430 +00739 01 AHDR-REC. DTSBX430 +00740 ++INCLUDE DTSIAHDR DTSBX430 +00741 EJECT DTSBX430 +00742 01 ARPT-REC. DTSBX430 +00743 ++INCLUDE DTSIARPT DTSBX430 +00744 EJECT DTSBX430 +00745 01 APAY-REC. DTSBX430 +00746 ++INCLUDE DTSIAPAY DTSBX430 +00747 DTSBX430 +00748 01 L927-LINK-AREA. DTSBX430 +00749 ++INCLUDE DTSIL927 DTSBX430 +00750 DTSBX430 +00751 01 L931-LINK-AREA. DTSBX430 +00752 ++INCLUDE DTSIL931 DTSBX430 +00753 DTSBX430 +00754 01 FSKL-REC. DTSBX430 +00755 ++INCLUDE DTSIFSKL DTSBX430 +00756 DTSBX430 +00757 01 R140-REC. DTSBX430 +00758 ++INCLUDE DTSIR140 DTSBX430 +00759 DTSBX430 +00760 LINKAGE DTSBX430 +00761 SECTION. DTSBX430 +00762 DTSBX430 +00763 01 LX42-LINK-AREA. DTSBX430 +00764 ++INCLUDE DTSILX42 CL112 +00765 DTSBX430 +00766 PROCEDURE DIVISION USING LX42-LINK-AREA. CL253 +00767 DTSBX430 +00768 DTSBX430-MAIN. CL*47 +00769 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA CL*80 +00770 MOVE LX42-RPT-ERROR-IND TO W-RPT-ERROR-IND. CL*80 +00771 CL*80 +00772 IF W-RPT-ERROR-YES-88 CL*80 +00773 DISPLAY '1:BX430 LX42 EMP REC HAS ERROR ' LX42-EMP-NO CL235 +00774 ' ' LX42-RPT-ERROR-IND ' ' W-RPT-ERROR-IND CL*80 +00775 * ELSE CL236 +00776 * DISPLAY '1:BX430 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND CL236 +00777 END-IF. CL*80 +00778 EVALUATE TRUE DTSBX430 +00779 WHEN LX42-INITIALIZE-88 DTSBX430 +00780 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX430 +00781 DTSBX430 +00782 WHEN LX42-NEW-EMPLOYER-88 DTSBX430 +00783 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL231 +00784 CL231 +00785 PERFORM P5000-NEW-EMP THRU P5000-EXIT CL235 +00786 DTSBX430 +00787 WHEN LX42-PROCESS-88 DTSBX430 +00788 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX430 +00789 DTSBX430 +00790 WHEN LX42-TERMINATE-88 DTSBX430 +00791 DISPLAY ' TERMINATE 430' CL*47 +00792 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX430 +00793 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL220 +00794 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX430 +00795 DTSBX430 +00796 END-EVALUATE. DTSBX430 +00797 CL*80 +00798 * IF LX42-PROCESS-88 CL246 +00799 * MOVE W-RPT-ERROR-IND TO LX42-RPT-ERROR-IND CL246 +00800 * END-IF. CL246 +00801 DTSBX430 +00802 DTSBX430-MAIN-EXIT. CL*47 +00803 GOBACK. DTSBX430 +00804 DTSBX430 +00805 I0000-INITIATE. DTSBX430 +00806 SET W-RPT-ERROR-NO-88 TO TRUE. CL*81 +00807 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX430 +00808 SET X145-PAYMENT-DUP-NO-88 TO TRUE. CL171 +00809 DTSBX430 +00810 MOVE LENGTH OF X140-REC TO W-X140-LENGTH. DTSBX430 +00811 MOVE LENGTH OF X144-REC TO W-X144-LENGTH. DTSBX430 +00812 MOVE LENGTH OF X145-REC TO W-X145-LENGTH. CL*47 +00813 DTSBX430 +00814 * FOR VARIABLE REPORT FILE. DTSBX430 +00815 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX430 +00816 MOVE '140' TO R140-REC-TYPE. DTSBX430 +00817 DTSBX430 +00818 MOVE LX42-CURR-RUN-DATE TO L004-DATE. DTSBX430 +00819 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX430 +00820 SUBTRACT +5 FROM L004-ABS-QTR. DTSBX430 +00821 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX430 +00822 MOVE L004-QTR-5-9 TO W-WAIVER-QTR. DTSBX430 +00823 DISPLAY 'BX430 CURR RUN DATE ' LX42-CURR-RUN-DATE. CL*47 +00824 DISPLAY 'BX430 WAIVE QTR ' W-WAIVER-QTR. CL*47 +00825 DTSBX430 +00826 MOVE LX42-CURR-RUN-DATE TO WRK-CURR-DATE. CL249 +00827 MOVE WRK-CURR-DATE TO L001-DATE-8-AREA. CL248 +00828 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL150 +00829 DISPLAY 'RPT CURR RUN DATE ' L001-SLASH-DATE. CL151 +00830 MOVE L001-SLASH-8-DATE TO HDR1-LRCM-SYS-DATE. CL248 +00831 CL150 +00832 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX430 +00833 IF W-FATAL-ERROR-YES-88 DTSBX430 +00834 GO TO I0000-EXIT DTSBX430 +00835 END-IF. DTSBX430 +00836 DTSBX430 +00837 MOVE +0 TO W-ARPT-LAST. DTSBX430 +00838 PERFORM DTSBX430 +00839 VARYING RSUB FROM +1 BY +1 DTSBX430 +00840 UNTIL RSUB > W-ARPT-MAX DTSBX430 +00841 MOVE LOW-VALUES TO W-ARPT-ENTRY (RSUB) DTSBX430 +00842 END-PERFORM. DTSBX430 +00843 DTSBX430 +00844 I0000-EXIT. DTSBX430 +00845 EXIT. DTSBX430 +00846 DTSBX430 +00847 I2000-OPEN-FILES. DTSBX430 +00848 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX430 +00849 IF W-FATAL-ERROR-YES-88 DTSBX430 +00850 DISPLAY 'CANNOT OPEN TEMP XXX530 BTC FILE ' CL224 +00851 TEMP-BTC-STATUS DTSBX430 +00852 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00853 END-IF. DTSBX430 +00854 DTSBX430 +00855 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBX430 +00856 IF W-FATAL-ERROR-YES-88 DTSBX430 +00857 DISPLAY 'CANNOT OPEN MAGE TEMP FILE ' CL234 +00858 WAGE-TEMP-STATUS DTSBX430 +00859 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00860 END-IF. DTSBX430 +00861 DTSBX430 +00862 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. CL*20 +00863 IF W-FATAL-ERROR-YES-88 CL*20 +00864 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' CL*20 +00865 WAGE-OUT-STATUS CL*20 +00866 PERFORM S999-ABEND THRU S999-EXIT CL*20 +00867 END-IF. CL*20 +00868 DTSBX430 +00869 OPEN OUTPUT BATCH-XREF-FILE. DTSBX430 +00870 IF BATCH-XREF-OK-88 DTSBX430 +00871 NEXT SENTENCE DTSBX430 +00872 ELSE DTSBX430 +00873 DISPLAY 'CANNOT OPEN BATCH XREF FILE ' DTSBX430 +00874 BATCH-XREF-STATUS DTSBX430 +00875 PERFORM S999-ABEND THRU S999-EXIT DTSBX430 +00876 END-IF. DTSBX430 +00877 CL*12 +00878 CL*59 +00879 OPEN OUTPUT PEND-X140-FILE. CL*59 +00880 IF REPT-140-OK-88 CL*62 +00881 NEXT SENTENCE CL*59 +00882 ELSE CL*59 +00883 DISPLAY 'CANNOT OPEN PENDING X140 FILE' CL*59 +00884 REPT-140-STATUS CL*62 +00885 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00886 END-IF. CL*59 +00887 CL*59 +00888 OPEN OUTPUT PEND-X144-FILE. CL*59 +00889 IF WAGE-144-OK-88 CL*62 +00890 NEXT SENTENCE CL*59 +00891 ELSE CL*59 +00892 DISPLAY 'CANNOT OPEN PENDING X144 FILE' CL*59 +00893 WAGE-144-STATUS CL*62 +00894 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00895 END-IF. CL*59 +00896 CL*59 +00897 OPEN OUTPUT PEND-X145-FILE. CL*59 +00898 IF PAYT-145-OK-88 CL*62 +00899 NEXT SENTENCE CL*59 +00900 ELSE CL*59 +00901 DISPLAY 'CANNOT OPEN PENDING X145 FILE' CL*59 +00902 PAYT-145-STATUS CL*62 +00903 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00904 END-IF. CL*59 +00905 CL119 +00906 CL119 +00907 OPEN OUTPUT X430-PEND-FILE. CL200 +00908 IF REPT-STATUS-OK-88 CL119 +00909 NEXT SENTENCE CL119 +00910 ELSE CL119 +00911 DISPLAY 'CANNOT OPEN X430XXX PENDING FILE ' CL202 +00912 REPT-STATUS CL119 +00913 PERFORM S999-ABEND THRU S999-EXIT CL119 +00914 END-IF. CL119 +00915 DTSBX430 +00916 OPEN OUTPUT X430-PAID-FILE. CL200 +00917 IF REPT-STATUS-OK-88 CL119 +00918 NEXT SENTENCE CL119 +00919 ELSE CL119 +00920 DISPLAY 'CANNOT OPEN X430 PAID FILE ' CL198 +00921 REPT-STATUS CL119 +00922 PERFORM S999-ABEND THRU S999-EXIT CL119 +00923 END-IF. CL119 +00924 CL119 +00925 I2000-EXIT. DTSBX430 +00926 EXIT. DTSBX430 +00927 DTSBX430 +00928 P0000-PROCESS. DTSBX430 +00929 CL**2 +00930 EVALUATE TRUE DTSBX430 +00931 * WHEN LX42-REC-TYPE-PAY-88 CL187 +00932 * PERFORM P1000-PAYMENT THRU P1000-EXIT CL187 +00933 DTSBX430 +00934 WHEN LX42-REC-TYPE-RPT-88 CL*47 +00935 PERFORM P2000-REPORT THRU P2000-EXIT CL*47 +00936 CL*47 +00937 WHEN LX42-REC-TYPE-WAGE-88 CL196 +00938 PERFORM P3000-WAGES THRU P3000-EXIT CL196 +00939 CL*47 +00940 WHEN OTHER CL196 +00941 DISPLAY 'DTSBX430 ******** - INVALID RECORD TYPE ' CL226 +00942 LX42-REC-TYPE CL196 +00943 * PERFORM S999-ABEND THRU S999-EXIT CL195 +00944 CL*47 +00945 END-EVALUATE. DTSBX430 +00946 DTSBX430 +00947 P0000-EXIT. DTSBX430 +00948 EXIT. DTSBX430 +00949 P1000-PAYMENT. CL*47 +00950 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. CL*57 +00951 MOVE LX42-DATA-AREA TO X145-REC. CL*50 +00952 *& CL*50 +00953 MOVE X145-EMP-NO TO W-EMP-NO. CL*50 +00954 MOVE X145-QTR TO W-PAY-QTR. CL166 +00955 SET W-EMP-FOUND-NO-88 TO TRUE. CL*50 +00956 CL*50 +00957 ADD +1 TO W-X145-RED-CNT CL*50 +00958 DISPLAY SPACE. CL*50 +00959 DISPLAY 'BX430- NEW EMPLOYER PAYMENT ' X145-EMP-NO. CL*50 +00960 DISPLAY ' X145-KEY ' X145-EMP-NO. CL*50 +00961 DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA. CL*50 +00962 CL*51 +00963 IF LX42-X145-EMP-NO = '999999' CL*51 +00964 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +00965 MOVE SPACES TO R140-MESSAGE CL*51 +00966 MOVE W-EMP-NO TO R140-EMP-NO CL*51 +00967 STRING CL*51 +00968 'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS ' CL144 +00969 DELIMITED BY SIZE CL*51 +00970 INTO R140-MESSAGE CL*51 +00971 END-STRING CL*51 +00972 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +00973 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*51 +00974 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +00975 ADD +1 TO W-X145-ERR-CNT CL*92 +00976 ADD +1 TO W-X145-PEN-CNT CL*92 +00977 WRITE PEND-X145-REC FROM X145-REC CL*93 +00978 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +00979 GO TO P1000-EXIT. CL*51 +00980 CL*51 +00981 CL*51 +00982 * IF LX42-REC-TYPE-PAY-88 CL183 +00983 * IF LX42-X145-KEY-AREA = X145-EMP-NO AND CL183 +00984 * LX42-X145-QTR-AREA = X145-QTR CL183 +00985 * SET W-PREV-RPT-NULL-88 TO TRUE CL183 +00986 * ADD +1 TO W-X145-DUP-CNT CL183 +00987 * DISPLAY 'X145 DUPLICATE PAYMENT RECORD ' W-EMP-NO CL183 +00988 * ' ERR IND ' W-RPT-ERROR-IND CL183 +00989 * MOVE SPACES TO R140-MESSAGE CL183 +00990 * MOVE W-EMP-NO TO R140-EMP-NO CL183 +00991 * MOVE SPACES TO R140-MESSAGE CL183 +00992 * MOVE W-EMP-NO TO R140-EMP-NO CL183 +00993 * STRING CL183 +00994 * ': POSSIBLE DUPLICATE PAYMENT RECORD ----PROCESS ' CL183 +00995 * DELIMITED BY SIZE CL183 +00996 * INTO R140-MESSAGE CL183 +00997 * END-STRING CL183 +00998 * SET X145-PAYMENT-DUP-YES-88 TO TRUE CL183 +00999 * WRITE PEND-X145-REC FROM WS-HOLD-X145-REC CL183 +01000 * MOVE R140-MESSAGE TO P434-MESSAGE CL183 +01001 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL183 +01002 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL183 +01003 * ELSE CL183 +01004 MOVE X145-EMP-NO TO LX42-X145-KEY-AREA CL107 +01005 * END-IF CL183 +01006 * END-IF. CL183 +01007 CL*51 +01008 CL*51 +01009 MOVE X145-EMP-NO TO LX42-X145-EMP-NO. CL*51 +01010 MOVE X145-QTR TO LX42-X145-QTR-AREA CL*83 +01011 CL*50 +01012 DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. CL*49 +01013 IF W-PREV-RPT-NULL-88 OR CL*84 +01014 LX42-REC-TYPE-PAY-88 CL*84 +01015 SET W-PREV-RPT-PAY-88 TO TRUE CL*84 +01016 * SET W-PREV-REC-PAY-88 TO TRUE CL107 +01017 ADD +1 TO W-X145-PRO-CNT CL*50 +01018 PERFORM P1110-EDIT-PAYMENT THRU P1110-EXIT CL*51 +01019 IF W-RPT-ERROR-NO-88 CL*81 +01020 PERFORM P1112-CHECK-PAYMENT THRU P1112-EXIT CL*51 +01021 IF W-RPT-ERROR-NO-88 CL*81 +01022 DISPLAY 'X145 PAYMENT REC PASS EDITS ' W-EMP-NO CL*51 +01023 DISPLAY 'X145 SAVED ' W-EMP-NO ' ' W-PAY-QTR ' ' CL169 +01024 ' ' X145-REMITTANCE CL169 +01025 ADD +1 TO W-X145-SAV-CNT CL*51 +01026 PERFORM P1120-SAVE-PAYMENT THRU P1120-EXIT CL*51 +01027 ELSE CL*51 +01028 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01029 ADD +1 TO W-X145-ERR-CNT CL*51 +01030 ADD +1 TO W-X145-PEN-CNT CL*92 +01031 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01032 WRITE PEND-X145-REC FROM X145-REC CL*93 +01033 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01034 END-IF CL*51 +01035 ELSE CL*49 +01036 MOVE '999999' TO LX42-X145-EMP-NO CL*50 +01037 ADD +1 TO W-X145-ERR-CNT CL*51 +01038 ADD +1 TO W-X145-PEN-CNT CL*92 +01039 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01040 WRITE PEND-X145-REC FROM X145-REC CL*93 +01041 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01042 END-IF CL*49 +01043 ELSE CL*49 +01044 MOVE '999999' TO LX42-X145-EMP-NO CL*50 +01045 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01046 MOVE SPACES TO R140-MESSAGE CL*49 +01047 MOVE W-EMP-NO TO R140-EMP-NO CL*49 +01048 STRING CL*49 +01049 ': DUPLICATE PAYMENT RECORD ' CL144 +01050 X145-REMITTANCE CL*54 +01051 DELIMITED BY SIZE CL*49 +01052 INTO R140-MESSAGE CL*49 +01053 END-STRING CL*49 +01054 ADD +1 TO W-X145-ERR-CNT CL*92 +01055 ADD +1 TO W-X145-PEN-CNT CL*92 +01056 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01057 WRITE PEND-X145-REC FROM X145-REC CL*93 +01058 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01059 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*49 +01060 CL*49 +01061 P1000-EXIT. CL*51 +01062 EXIT. CL*49 +01063 CL*49 +01064 P1110-EDIT-PAYMENT. CL*47 +01065 CL*54 +01066 MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*54 +01067 IF W-VALID-PAY-88 CL*54 +01068 NEXT SENTENCE CL*54 +01069 ELSE CL*54 +01070 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01071 MOVE SPACES TO R140-MESSAGE CL*54 +01072 MOVE W-EMP-NO TO R140-EMP-NO CL*54 +01073 STRING CL*54 +01074 ':PAY- INVALID PAYMENT TYPE ' CL144 +01075 X145-PAY-TYPE CL*54 +01076 DELIMITED BY SIZE CL*54 +01077 INTO R140-MESSAGE CL*54 +01078 END-STRING CL*54 +01079 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01080 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54 +01081 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01082 END-IF. CL*54 +01083 IF X145-QTR = SPACES CL*47 +01084 MOVE '2017/1' TO W-SLASH-QTR CL194 +01085 ELSE CL*47 +01086 MOVE X145-QTR TO W-SLASH-QTR. CL*47 +01087 CL*47 +01088 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR CL*47 +01089 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q CL*47 +01090 PERFORM S004-FROM-5 THRU S004-EXIT CL*47 +01091 IF NOT L004-VALID-QTR CL*47 +01092 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01093 MOVE SPACES TO R140-MESSAGE CL*47 +01094 MOVE W-EMP-NO TO R140-EMP-NO CL*47 +01095 STRING CL*47 +01096 ':PAY- INVALID QUARTER ' W-SLASH-QTR CL144 +01097 DELIMITED BY SIZE CL*47 +01098 INTO R140-MESSAGE CL*47 +01099 END-STRING CL*47 +01100 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*47 +01101 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01102 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01103 ELSE CL*48 +01104 MOVE L004-QTR-5-9 TO W-X145-PAYMENT-QTR CL*56 +01105 END-IF. CL*48 +01106 CL*48 +01107 * DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR CL*92 +01108 CL*53 +01109 * MOVE X145-REMITTANCE TO W-X145-REMITTANCE. CL194 +01110 * DISPLAY 'W145REMITCE ' W-X145-REMITTANCE. CL194 +01111 * DISPLAY 'X145REMITCE ' X145-REMITTANCE. CL194 +01112 CL*51 +01113 * IF W-X145-REMITTANCE = ZEROS CL166 +01114 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01115 * MOVE SPACES TO R140-MESSAGE CL166 +01116 * MOVE W-EMP-NO TO R140-EMP-NO CL166 +01117 * STRING CL166 +01118 * 'X430- REVIEW REMITTANCE AMOUNT= 0 ' CL166 +01119 * DELIMITED BY SIZE CL166 +01120 * INTO R140-MESSAGE CL166 +01121 * END-STRING CL166 +01122 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL166 +01123 * END-IF. CL166 +01124 CL*51 +01125 MOVE ZEROS TO W-X145-RECEIVED-DATE CL*72 +01126 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*48 +01127 MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*48 +01128 MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*48 +01129 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*48 +01130 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*48 +01131 IF NOT L001-VALID-DATE CL*48 +01132 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01133 MOVE SPACES TO R140-MESSAGE CL*48 +01134 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01135 STRING CL*48 +01136 ':PAY- INVALID RECEIVED DATE ' CL144 +01137 ' ' X145-RCVD-DATE CL*48 +01138 DELIMITED BY SIZE CL*48 +01139 INTO R140-MESSAGE CL*48 +01140 END-STRING CL*48 +01141 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01142 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01143 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01144 ELSE CL*48 +01145 MOVE L001-FED-8-DATE-9 TO W-X145-RECEIVED-DATE CL*72 +01146 END-IF. CL*48 +01147 CL*55 +01148 P1110-EXIT. CL*55 +01149 EXIT. CL*55 +01150 CL*55 +01151 P1112-CHECK-PAYMENT. CL*51 +01152 MOVE LOW-VALUE TO MPRF-KEY-AREA. CL*48 +01153 MOVE W-EMP-NO TO MPRF-EMP-NO. CL*48 +01154 SET MPRF-PRF-88 TO TRUE. CL*48 +01155 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*48 +01156 CL*48 +01157 PERFORM S910-READ THRU S910-EXIT. CL*48 +01158 IF L910-NO-REC-88 CL*48 +01159 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01160 SET W-EMP-FOUND-NO-88 TO TRUE CL*48 +01161 MOVE SPACES TO R140-MESSAGE CL*48 +01162 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01163 STRING CL*48 +01164 ':EMP NOT ON DUTAS -CANNOT PAY ' CL144 +01165 X145-EMP-NO CL*48 +01166 DELIMITED BY SIZE CL*48 +01167 INTO R140-MESSAGE CL*48 +01168 END-STRING CL*48 +01169 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01170 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01171 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01172 ELSE CL*48 +01173 MOVE MSKL-REC TO MPRF-REC CL*48 +01174 SET W-EMP-FOUND-YES-88 TO TRUE CL*48 +01175 END-IF. CL*48 +01176 CL*48 +01177 P1112-EXIT. CL*51 +01178 EXIT. CL*48 +01179 CL*48 +01180 P1120-SAVE-PAYMENT. CL*51 +01181 DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO. CL*51 +01182 IF X145-PAYMENT-DUP-YES-88 CL180 +01183 DISPLAY '%%%%%%%% DUP-PAYT ' CL180 +01184 MOVE WS-HOLD-X145-REC TO WS-Z145-DUP-REC CL180 +01185 DISPLAY ' HOLD DUP-PAYT ' WS-Z145-DUP-REC CL180 +01186 MOVE X145-REC TO WS-Z145-DUP-REC CL180 +01187 DISPLAY ' CURR DUP-PAYT ' WS-Z145-DUP-REC CL180 +01188 ELSE CL180 +01189 MOVE W-X145-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL180 +01190 CL180 +01191 * ADD +1 TO W-X145-SAV-CNT. CL*96 +01192 MOVE X145-REC TO WS-HOLD-X145-REC. CL172 +01193 P1120-EXIT. CL*51 +01194 EXIT. CL*51 +01195 CL*51 +01196 CL*48 +01197 DTSBX430 +01198 P2000-REPORT. DTSBX430 +01199 CL220 +01200 MOVE LX42-DATA-AREA TO X140-REC. DTSBX430 +01201 CL**2 +01202 * SET W-RPT-IN-PROGRESS-YES-88 TO TRUE CL*56 +01203 CL**2 +01204 MOVE X140-EMP-NO TO W-EMP-NO. DTSBX430 +01205 MOVE X140-EMP-NO TO W-EMP-X140-NO. CL189 +01206 MOVE X140-QUARTER TO W-PAY-QTR. CL166 +01207 ADD +1 TO W-X140-RED-CNT. CL*56 +01208 * DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE. CL184 +01209 * IF W-PREV-RPT-NULL-88 CL184 +01210 * SET W-PREV-RPT-RPT-88 TO TRUE CL184 +01211 * SET W-X145-PAYMENT-NO-88 TO TRUE CL184 +01212 * ELSE CL184 +01213 * SET W-X145-PAYMENT-YES-88 TO TRUE CL184 +01214 * END-IF. CL184 +01215 CL*52 +01216 MOVE SPACES TO R140-MESSAGE. CL215 +01217 MOVE R140-MESSAGE TO P434-MESSAGE CL214 +01218 SET W-RPT-ERROR-NO-88 TO TRUE. CL215 +01219 CL214 +01220 IF LX42-REC-TYPE-RPT-88 CL*40 +01221 IF LX42-X140-KEY-AREA = X140-EMP-NO AND CL*80 +01222 LX42-X140-QTR-AREA = X140-QUARTER CL*80 +01223 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01224 ADD +1 TO W-X140-DUP-CNT CL*92 +01225 ADD +1 TO W-X140-PEN-CNT CL*92 +01226 DISPLAY ':ERROR-RPT DUPLICATE REPORT ' CL229 +01227 ' ERR IND ' W-RPT-ERROR-IND CL*80 +01228 MOVE SPACES TO R140-MESSAGE CL*40 +01229 MOVE W-EMP-NO TO R140-EMP-NO CL*40 +01230 STRING CL*40 +01231 ':-----FAILED - DUPLICATE RPT ' CL240 +01232 DELIMITED BY SIZE CL*40 +01233 INTO R140-MESSAGE CL*40 +01234 END-STRING CL*40 +01235 MOVE R140-MESSAGE TO X434-MESSAGE CL187 +01236 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*40 +01237 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT CL189 +01238 WRITE PEND-X140-REC FROM X140-REC CL*93 +01239 MOVE '999999' TO LX42-X140-EMP-NO CL*51 +01240 GO TO P2000-EXIT CL*40 +01241 ELSE CL*40 +01242 MOVE X140-EMP-NO TO LX42-X140-KEY-AREA CL*80 +01243 END-IF CL*40 +01244 END-IF. CL*40 +01245 CL*40 +01246 MOVE X140-EMP-NO TO LX42-X140-EMP-NO. CL**3 +01247 MOVE X140-QUARTER TO LX42-X140-QTR-AREA CL*80 +01248 SET W-EMP-FOUND-NO-88 TO TRUE. DTSBX430 +01249 CL*51 +01250 * IF LX42-X145-EMP-NO = '999999' CL184 +01251 * SET W-RPT-ERROR-YES-88 TO TRUE CL184 +01252 * MOVE SPACES TO R140-MESSAGE CL184 +01253 * MOVE W-EMP-NO TO R140-EMP-NO CL184 +01254 * STRING CL184 +01255 * ':PAY RECORD INVALID -RPT BYPASSED ' CL184 +01256 * DELIMITED BY SIZE CL184 +01257 * INTO R140-MESSAGE CL184 +01258 * END-STRING CL184 +01259 * MOVE '999999' TO LX42-X140-EMP-NO CL184 +01260 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL184 +01261 * ADD +1 TO W-X140-PEN-CNT CL184 +01262 * WRITE PEND-X140-REC FROM X140-REC CL184 +01263 * MOVE R140-MESSAGE TO P434-MESSAGE CL184 +01264 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL184 +01265 * GO TO P2000-EXIT. CL184 +01266 CL*40 +01267 SET W-PREV-RPT-RPT-88 TO TRUE. CL*84 +01268 DTSBX430 +01269 DTSBX430 +01270 PERFORM P2010-EDIT-REPORT THRU P2010-EXIT DTSBX430 +01271 CL**3 +01272 IF W-RPT-ERROR-YES-88 CL*81 +01273 DISPLAY 'E10 NO: ' W-EMP-NO CL213 +01274 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01275 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01276 CL**3 +01277 PERFORM P2012-CHECK-MPRF THRU P2012-EXIT CL**3 +01278 DISPLAY 'E12 NO: ' W-EMP-NO CL213 +01279 IF W-RPT-ERROR-YES-88 CL*81 +01280 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01281 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01282 CL**3 +01283 PERFORM P2015-CHECK-MRPT THRU P2015-EXIT CL178 +01284 DISPLAY 'E15 NO: ' W-EMP-NO CL213 +01285 IF W-RPT-ERROR-YES-88 CL*81 +01286 MOVE '999999' TO LX42-X140-EMP-NO CL*60 +01287 GO TO P2000-EDIT-REPORT-CONTINUE. CL*60 +01288 CL*32 +01289 P2000-EDIT-REPORT-CONTINUE. CL*32 +01290 IF W-RPT-ERROR-NO-88 CL166 +01291 PERFORM P2020-SAVE-EXT-REPORT THRU P2020-EXIT CL166 +01292 ADD +1 TO W-X140-SAV-CNT CL166 +01293 GO TO P2000-EXIT. CL166 +01294 CL166 +01295 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01296 MOVE SPACES TO R140-MESSAGE CL*32 +01297 MOVE W-EMP-NO TO R140-EMP-NO CL*32 +01298 DISPLAY CL217 +01299 '-X140 +++ FAILED DUTAS EDITS ' CL217 +01300 ' ' X140-QUARTER ' ' W-EMP-NO CL217 +01301 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*32 +01302 ADD +1 TO W-X140-PEN-CNT CL*93 +01303 WRITE PEND-X140-REC FROM X140-REC CL*93 +01304 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. CL217 +01305 * IF W-X145-PAYMENT-YES-88 CL184 +01306 * WRITE PEND-X145-REC FROM X145-REC CL184 +01307 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. CL184 +01308 DTSBX430 +01309 P2000-EXIT. DTSBX430 +01310 EXIT. DTSBX430 +01311 DTSBX430 +01312 P2010-EDIT-REPORT. DTSBX430 +01313 MOVE X140-QUARTER TO W-SLASH-QTR. DTSBX430 +01314 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX430 +01315 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX430 +01316 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX430 +01317 IF NOT L004-VALID-QTR DTSBX430 +01318 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01319 MOVE SPACES TO R140-MESSAGE DTSBX430 +01320 MOVE W-EMP-NO TO R140-EMP-NO DTSBX430 +01321 STRING DTSBX430 +01322 ':-----FAILED INVALID QTR ' CL240 +01323 DELIMITED BY SIZE DTSBX430 +01324 INTO R140-MESSAGE DTSBX430 +01325 END-STRING DTSBX430 +01326 MOVE R140-MESSAGE TO X434-MESSAGE CL217 +01327 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX430 +01328 ELSE DTSBX430 +01329 MOVE L004-QTR-5-9 TO W-X140-REPORT-QTR CL*56 +01330 END-IF. DTSBX430 +01331 DTSBX430 +01332 MOVE X140-REPORT-TYPE TO W-RPT-TYPE. DTSBX430 +01333 IF NOT W-RPT-TYPE-VALID-88 DTSBX430 +01334 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01335 MOVE SPACES TO R140-MESSAGE DTSBX430 +01336 MOVE W-EMP-NO TO R140-EMP-NO DTSBX430 +01337 STRING DTSBX430 +01338 ':-----FAILED INVALID REPORT TYPE ' CL240 +01339 X140-REPORT-TYPE CL**2 +01340 DELIMITED BY SIZE DTSBX430 +01341 INTO R140-MESSAGE DTSBX430 +01342 END-STRING DTSBX430 +01343 MOVE R140-MESSAGE TO X434-MESSAGE CL187 +01344 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX430 +01345 END-IF. DTSBX430 +01346 CL113 +01347 IF W-RPT-TYPE NOT = 'OR' CL115 +01348 SET W-RPT-ERROR-YES-88 TO TRUE CL113 +01349 MOVE SPACES TO R140-MESSAGE CL113 +01350 MOVE W-EMP-NO TO R140-EMP-NO CL113 +01351 STRING CL113 +01352 ':-----FAILED -NOT ORIGINAL REPORT ' CL240 +01353 ' ' W-RPT-TYPE CL116 +01354 DELIMITED BY SIZE CL113 +01355 INTO R140-MESSAGE CL113 +01356 END-STRING CL113 +01357 MOVE R140-MESSAGE TO X434-MESSAGE CL187 +01358 PERFORM S946-WRITE-R140 THRU S946-EXIT CL113 +01359 END-IF. CL113 +01360 CL113 +01361 DTSBX430 +01362 * IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR CL*82 +01363 * MOVE ZERO TO W-TOT-WAGE CL*82 +01364 * MOVE W-X140-REPORT-QTR TO W-CURR-RPT-QTR CL*82 +01365 * END-IF. CL*82 +01366 MOVE ZEROS TO W-TOT-WAGE CL222 +01367 W-TAX-WAGE. CL222 +01368 MOVE X140-TOTAL-WAGES TO W-TOT-WAGE. DTSBX430 +01369 MOVE X140-TAX-WAGES TO W-TAX-WAGE. DTSBX430 +01370 MOVE ZEROS TO W-TOT-X144-WAGE. CL189 +01371 MOVE W-TOT-WAGE TO LX42-RPT-REMIT-AMT CL222 +01372 CL189 +01373 * IF W-EMP-NO = 177462 CL*53 +01374 * MOVE 1352.07 TO X140-REMITTANCE CL*53 +01375 DISPLAY ' X140-TOT-WAGE ' X140-TOTAL-WAGES CL192 +01376 DISPLAY ' W-TOT-WAGE ' W-TOT-WAGE. CL192 +01377 DTSBX430 +01378 * MOVE X140-REMITTANCE TO W-X140-REMITTANCE. CL194 +01379 * DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE. CL194 +01380 *& DTSBX430 +01381 CL*52 +01382 * DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND. CL194 +01383 CL*68 +01384 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0 CL175 +01385 * MOVE SPACES TO R140-MESSAGE CL175 +01386 * SET W-RPT-ERROR-YES-88 TO TRUE CL175 +01387 * MOVE W-EMP-NO TO R140-EMP-NO CL175 +01388 * STRING CL175 +01389 * 'ESSP AMT DUE > 0 AND NO PAYMT ' CL175 +01390 * DELIMITED BY SIZE CL175 +01391 * INTO R140-MESSAGE CL175 +01392 * END-STRING CL175 +01393 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL175 +01394 * MOVE R140-MESSAGE TO P434-MESSAGE CL175 +01395 * GO TO P2010-EDIT-CONTINUE CL175 +01396 * END-IF. CL175 +01397 CL*52 +01398 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0 CL184 +01399 * MOVE SPACES TO R140-MESSAGE CL184 +01400 * MOVE W-EMP-NO TO R140-EMP-NO CL184 +01401 * STRING CL184 +01402 * 'X140 REMIT AMT = 0 AND NO X145 FOUND -PROCESS ' CL184 +01403 * ' ' X140-REMITTANCE CL184 +01404 * DELIMITED BY SIZE CL184 +01405 * INTO R140-MESSAGE CL184 +01406 * END-STRING CL184 +01407 * MOVE R140-MESSAGE TO P434-MESSAGE CL184 +01408 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL184 +01409 * GO TO P2010-EDIT-CONTINUE CL184 +01410 * END-IF. CL184 +01411 CL*69 +01412 * IF W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE CL184 +01413 ** MOVE SPACES TO R140-MESSAGE CL184 +01414 * MOVE W-EMP-NO TO R140-EMP-NO CL184 +01415 * SET W-WRITE-T025-TRAN-YES-88 TO TRUE CL108 +01416 * STRING CL184 +01417 * 'X430 X145-PAY AMT > X140-REMIT AMT --PROCESS ' CL184 +01418 * X145-REMITTANCE ' ' X140-REMITTANCE CL184 +01419 * DELIMITED BY SIZE CL184 +01420 * INTO R140-MESSAGE CL184 +01421 * END-STRING CL184 +01422 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL184 +01423 * END-IF. CL184 +01424 CL*53 +01425 * IF W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE CL184 +01426 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01427 * MOVE SPACES TO R140-MESSAGE CL184 +01428 * MOVE W-EMP-NO TO R140-EMP-NO CL184 +01429 * STRING CL184 +01430 * 'X430 X145-PAY AMT < X140-REMIT AMT ' CL184 +01431 * X145-REMITTANCE ' ' X140-REMITTANCE CL184 +01432 * DELIMITED BY SIZE CL184 +01433 * INTO R140-MESSAGE CL184 +01434 * END-STRING CL184 +01435 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL184 +01436 * END-IF. CL184 +01437 CL*67 +01438 * IF W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0 CL184 +01439 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01440 * MOVE SPACES TO R140-MESSAGE CL184 +01441 * MOVE W-EMP-NO TO R140-EMP-NO CL184 +01442 * STRING CL184 +01443 * 'X430 X145-PAY AMT > 0 AND X140-REMIT AMT = 0 ' CL184 +01444 * X145-REMITTANCE ' ' X140-REMITTANCE CL184 +01445 * DELIMITED BY SIZE CL184 +01446 * INTO R140-MESSAGE CL184 +01447 * END-STRING CL184 +01448 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL184 +01449 * END-IF. CL184 +01450 CL*67 +01451 * IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE CL184 +01452 * ADD 1 TO W-T028-WRITEE-CNT CL184 +01453 * SET W-RPT-ERROR-NO-88 TO TRUE CL184 +01454 * MOVE SPACES TO R140-MESSAGE CL184 +01455 * MOVE W-EMP-NO TO R140-EMP-NO CL184 +01456 * STRING CL184 +01457 * 'X430 ++++ X145-REMIT AMT = X140-REMIT AMT ' CL184 +01458 * X145-REMITTANCE ' ' X140-REMITTANCE CL184 +01459 * DELIMITED BY SIZE CL184 +01460 * INTO R140-MESSAGE CL184 +01461 * END-STRING CL184 +01462 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL184 +01463 * END-IF. CL184 +01464 CL102 +01465 P2010-EDIT-CONTINUE. CL*69 +01466 DISPLAY 'BX430 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES CL*47 +01467 ' TOT: ' X140-TOTAL-WAGES ' RMT: ' W-X140-REMITTANCE CL*57 +01468 *& DTSBX430 +01469 MOVE ZERO TO W-X140-RECEIVED-DATE. CL*72 +01470 MOVE X140-RCVD-DATE TO W-SLASH-DATE. DTSBX430 +01471 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX430 +01472 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX430 +01473 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX430 +01474 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX430 +01475 IF NOT L001-VALID-DATE DTSBX430 +01476 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01477 MOVE SPACES TO R140-MESSAGE DTSBX430 +01478 MOVE W-EMP-NO TO R140-EMP-NO DTSBX430 +01479 STRING DTSBX430 +01480 ':-----FAILED -INVALID RECV DATE ' CL240 +01481 X140-RCVD-DATE CL**2 +01482 DELIMITED BY SIZE DTSBX430 +01483 INTO R140-MESSAGE DTSBX430 +01484 END-STRING DTSBX430 +01485 MOVE R140-MESSAGE TO X434-MESSAGE CL187 +01486 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX430 +01487 ELSE DTSBX430 +01488 MOVE L001-FED-8-DATE-9 TO W-X140-RECEIVED-DATE CL*72 +01489 END-IF. DTSBX430 +01490 DTSBX430 +01491 MOVE ZERO TO W-CHK-SCAN-DATE. DTSBX430 +01492 * IF X140-IN-HOUSE-88 DTSBX430 +01493 * MOVE X140-CHECK-SCAN-DT TO W-SLASH-DATE DTSBX430 +01494 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX430 +01495 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX430 +01496 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX430 +01497 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX430 +01498 * IF NOT L001-VALID-DATE DTSBX430 +01499 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01500 * MOVE SPACES TO R140-MESSAGE DTSBX430 +01501 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX430 +01502 * STRING DTSBX430 +01503 * 'REPORT: INVALID CHK SCAN DATE ' DTSBX430 +01504 * X140-CHECK-SCAN-DT DTSBX430 +01505 * DELIMITED BY SIZE DTSBX430 +01506 * INTO R140-MESSAGE DTSBX430 +01507 * END-STRING DTSBX430 +01508 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX430 +01509 ** DISPLAY R140-MESSAGE DTSBX430 +01510 * ELSE DTSBX430 +01511 * MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSBX430 +01512 * END-IF DTSBX430 +01513 * END-IF. DTSBX430 +01514 DTSBX430 +01515 MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT. DTSBX430 +01516 MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT. DTSBX430 +01517 MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT. DTSBX430 +01518 DTSBX430 +01519 DTSBX430 +01520 P2010-EXIT. DTSBX430 +01521 EXIT. DTSBX430 +01522 DTSBX430 +01523 P2012-CHECK-MPRF. CL**2 +01524 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX430 +01525 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX430 +01526 SET MPRF-PRF-88 TO TRUE. DTSBX430 +01527 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX430 +01528 DTSBX430 +01529 PERFORM S910-READ THRU S910-EXIT. DTSBX430 +01530 CL**2 +01531 IF L910-OK-88 CL**2 +01532 MOVE MSKL-REC TO MPRF-REC CL**2 +01533 MOVE W-X140-REPORT-QTR TO L516-YRQ CL*56 +01534 PERFORM S516-LIABILITY-INFO THRU S516-EXIT CL**2 +01535 IF L516-LIABLE-88 CL*57 +01536 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01537 SET W-EMP-FOUND-YES-88 TO TRUE CL*57 +01538 DISPLAY 'X430 -EMPLOYER FOUND LIAB FOR QTR ' MPRF-EMP-NO CL*57 +01539 GO TO P2012-EXIT CL*57 +01540 ELSE CL*57 +01541 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01542 MOVE SPACES TO R140-MESSAGE CL**2 +01543 MOVE W-EMP-NO TO R140-EMP-NO CL**2 +01544 STRING CL**2 +01545 ':-----FAILED - EMP NOT LIABLE ' CL240 +01546 * ':EMP NOT LIABLE FOR QTRLY RPT ' CL187 +01547 DELIMITED BY SIZE CL**2 +01548 INTO R140-MESSAGE CL211 +01549 END-STRING CL**2 +01550 MOVE R140-MESSAGE TO X434-MESSAGE CL187 +01551 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 +01552 SET W-EMP-FOUND-NO-88 TO TRUE CL**2 +01553 GO TO P2012-EXIT CL*51 +01554 ELSE CL*51 +01555 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01556 MOVE SPACES TO R140-MESSAGE CL*51 +01557 MOVE W-EMP-NO TO R140-EMP-NO CL*51 +01558 STRING CL*51 +01559 * ':EMP NOT FOUND ON DUTAS-CANNOT PRCESS RPT' CL187 +01560 ':-----FAILED -EMP NOT ON DUTAS ' CL240 +01561 * X140-EMP-NO CL187 +01562 DELIMITED BY SIZE CL*51 +01563 INTO R140-MESSAGE CL*51 +01564 END-STRING CL*51 +01565 MOVE R140-MESSAGE TO X434-MESSAGE CL187 +01566 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*51 +01567 SET W-EMP-FOUND-NO-88 TO TRUE CL*51 +01568 END-IF. CL*51 +01569 CL**2 +01570 P2012-EXIT. CL**2 +01571 EXIT. DTSBX430 +01572 DTSBX430 +01573 CL**2 +01574 P2015-CHECK-MRPT. CL178 +01575 CL178 +01576 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL178 +01577 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL178 +01578 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL178 +01579 MOVE ZEROS TO MRPT-BATCH-NO. CL178 +01580 MOVE ZEROS TO MRPT-ITEM-NO CL178 +01581 CL178 +01582 SET MRPT-RPT-88 TO TRUE. CL178 +01583 MOVE MRPT-REC TO MSKL-REC. CL178 +01584 CL178 +01585 PERFORM S910-START-BROWSE THRU S910-EXIT. CL178 +01586 IF L910-OK-88 CL178 +01587 PERFORM P2016-SCAN-MRPT THRU P2016-EXIT CL178 +01588 UNTIL L910-NO-REC-88 CL178 +01589 ELSE CL178 +01590 SET W-RPT-ERROR-NO-88 TO TRUE CL178 +01591 DISPLAY 'P2013 X430 ORIG RPT NOT ON DUTAS- PROCESS ' CL178 +01592 W-EMP-NO ' ' W-X140-REPORT-QTR CL178 +01593 DISPLAY ' ' CL178 +01594 GO TO P2015-EXIT. CL178 +01595 CL178 +01596 CL178 +01597 P2015-EXIT. CL178 +01598 EXIT. CL178 +01599 CL178 +01600 P2016-SCAN-MRPT. CL178 +01601 MOVE MSKL-REC TO MRPT-REC. CL178 +01602 IF MRPT-YRQ = W-X140-REPORT-QTR CL178 +01603 NEXT SENTENCE CL178 +01604 ELSE CL178 +01605 IF MRPT-YRQ > W-X140-REPORT-QTR CL178 +01606 SET W-RPT-ERROR-NO-88 TO TRUE CL178 +01607 SET L910-NO-REC-88 TO TRUE CL178 +01608 GO TO P2016-EXIT CL178 +01609 ELSE CL178 +01610 GO TO P2016-READ-NEXT CL178 +01611 END-IF CL178 +01612 END-IF. CL178 +01613 CL178 +01614 IF MRPT-ORIG-88 CL178 +01615 SET W-RPT-ERROR-YES-88 TO TRUE CL178 +01616 SET L910-NO-REC-88 TO TRUE CL178 +01617 MOVE SPACES TO R140-MESSAGE CL179 +01618 MOVE W-EMP-NO TO R140-EMP-NO CL179 +01619 STRING CL179 +01620 ':-----FAILED - RPT EXIST IN DUTAS ' CL240 +01621 * X140-QUARTER CL187 +01622 DELIMITED BY SIZE CL179 +01623 INTO R140-MESSAGE CL179 +01624 END-STRING CL179 +01625 MOVE R140-MESSAGE TO X434-MESSAGE CL187 +01626 PERFORM S946-WRITE-R140 THRU S946-EXIT CL179 +01627 GO TO P2016-EXIT CL178 +01628 END-IF. CL178 +01629 CL178 +01630 CL178 +01631 P2016-READ-NEXT. CL178 +01632 PERFORM S910-READ-NEXT THRU S910-EXIT. CL178 +01633 IF L910-NO-REC-88 CL178 +01634 SET W-RPT-ERROR-NO-88 TO TRUE. CL178 +01635 P2016-EXIT. CL178 +01636 CL**3 +01637 P2020-SAVE-EXT-REPORT. DTSBX430 +01638 DISPLAY 'P2020-SAVE-EXT-REPORT ' DTSBX430 +01639 ************************************************************ DTSBX430 +01640 * REPORTS FROM EXTERNAL SOURCES. REPORTS WILL BE DTSBX430 +01641 * ASSEMBLED INTO BATCHES IN DTSBD140. CHANGED ALL T027 DTSBX430 +01642 * TO BE T028 PER DOCUMENTATION IN BD140 FROM GIL 4/10/12 DTSBX430 +01643 ************************************************************ DTSBX430 +01644 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBX430 +01645 MOVE '028' TO T028-REC-TYPE. DTSBX430 +01646 DTSBX430 +01647 MOVE W-EMP-NO TO T028-EMP-NO. DTSBX430 +01648 MOVE 'WEB ESSP' TO T028-ORIGIN. DTSBX430 +01649 MOVE LX42-SYS-DATE TO T028-SYS-DATE. DTSBX430 +01650 MOVE LX42-SYS-TIME TO T028-SYS-TIME. DTSBX430 +01651 SET T028-WEB-RPT-88 TO TRUE. DTSBX430 +01652 DTSBX430 +01653 MOVE LX42-EXT-PSEUDO-BATCH TO T028-PSEUDO-BATCH-NO. DTSBX430 +01654 MOVE LX42-EXT-PSEUDO-ITEM TO T028-PSEUDO-ITEM-NO. DTSBX430 +01655 DTSBX430 +01656 MOVE W-X140-REPORT-QTR TO T028-YRQ. CL*56 +01657 IF W-EMP-FOUND-YES-88 DTSBX430 +01658 MOVE MPRF-PRIMARY-NAME (1:4) DTSBX430 +01659 TO T028-NAME-CHECK DTSBX430 +01660 ELSE DTSBX430 +01661 MOVE SPACES TO T028-NAME-CHECK DTSBX430 +01662 END-IF. DTSBX430 +01663 MOVE W-RPT-TYPE TO T028-RPT-TYPE. DTSBX430 +01664 DTSBX430 +01665 **************************************************************** DTSBX430 +01666 * LX42-LAST-DETERM-EMP IS SET BY DTSBX420 WHEN PROCESSING DTSBX430 +01667 * A DETERMINATION. IT IS USED TO DETERMINE WHEN TO WAIVE DTSBX430 +01668 * P & I. THE WAIVER IS AUTOMATIC FOR REPORTS WITHIN DTSBX430 +01669 * THE LAST 5 QUARTERS SUBMITTED ALONG WITH A WEB DTSBX430 +01670 * REGISTRATION. DTSBX430 +01671 **************************************************************** DTSBX430 +01672 IF (W-EMP-NO = LX42-LAST-DETERM-EMP DTSBX430 +01673 AND W-X140-REPORT-QTR >= W-WAIVER-QTR) CL*56 +01674 SET T028-WAIVE-BOTH-YES-88 TO TRUE DTSBX430 +01675 ELSE DTSBX430 +01676 SET T028-WAIVE-BOTH-NO-88 TO TRUE DTSBX430 +01677 END-IF. DTSBX430 +01678 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBX430 +01679 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBX430 +01680 MOVE W-X140-RECEIVED-DATE TO T028-RECEIVED-DATE CL*72 +01681 T028-DEPOSIT-DATE. DTSBX430 +01682 DTSBX430 +01683 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSBX430 +01684 DTSBX430 +01685 IF W-EMP-FOUND-NO-88 DTSBX430 +01686 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX430 +01687 COMPUTE T028-EXCESS-WAGE = DTSBX430 +01688 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX430 +01689 ELSE DTSBX430 +01690 IF MPRF-CLASS-SELF-INS-88 DTSBX430 +01691 MOVE ZERO TO T028-TAX-WAGE DTSBX430 +01692 T028-EXCESS-WAGE DTSBX430 +01693 ELSE DTSBX430 +01694 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX430 +01695 COMPUTE T028-EXCESS-WAGE = DTSBX430 +01696 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX430 +01697 END-IF DTSBX430 +01698 END-IF. DTSBX430 +01699 DTSBX430 +01700 MOVE ZERO TO T028-TOTAL-EMPL-CNT. DTSBX430 +01701 MOVE X140-WRKR-CNT-1ST-MNTH TO T028-1ST-MTH-EMPL-CNT. DTSBX430 +01702 MOVE X140-WRKR-CNT-2ND-MNTH TO T028-2ND-MTH-EMPL-CNT. DTSBX430 +01703 MOVE X140-WRKR-CNT-3RD-MNTH TO T028-3RD-MTH-EMPL-CNT. DTSBX430 +01704 DTSBX430 +01705 * DISPLAY ' X145 PAY AMT ' X145-REMITTANCE CL184 +01706 * DISPLAY ' X140 PAY AMT ' X140-REMITTANCE CL184 +01707 CL108 +01708 * MOVE W-X145-TOT-REMIT-AMT TO W-X140-REMITTANCE CL184 +01709 * MOVE W-X140-REMITTANCE TO T028-REMIT-AMT. CL184 +01710 MOVE ZEROS TO T028-REMIT-AMT. CL184 +01711 DTSBX430 +01712 ADD W-X145-TOT-REMIT-AMT TO W-TOT-REMIT-AMT. CL142 +01713 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBX430 +01714 CL156 +01715 CL163 +01716 * IF X145-TRACE-NO > SPACES CL184 +01717 * MOVE X145-TRACE-NO TO T028-TRACE-NO CL184 +01718 * ELSE CL184 +01719 MOVE ZERO TO T028-TRACE-NO. CL156 +01720 DTSBX430 +01721 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBX430 +01722 MOVE 'WEBESSP ' TO T028-RESPONSIBLE-OP-ID. DTSBX430 +01723 DTSBX430 +01724 DISPLAY 'BX430 WEB RPT ' X140-EMP-NO ' ' X140-QUARTER. CL*47 +01725 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSBX430 +01726 DTSBX430 +01727 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. CL124 +01728 CL124 +01729 * DISPLAY W-EMP-NO ',' T028-TOT-WAGE CL124 +01730 * ',' T028-EXCESS-WAGE CL124 +01731 * ',' T028-TAX-WAGE CL124 +01732 * ',' X140-REMITTANCE CL124 +01733 * ',' X145-REMITTANCE. CL124 +01734 CL110 +01735 IF W-X140-REMITTANCE > 0 CL100 +01736 ADD 1 TO W-T028-WRITE-CNT CL100 +01737 ELSE CL100 +01738 ADD 1 TO W-T028-WRITE-CNT CL100 +01739 ADD 1 TO W-T028-WRITEO-CNT. CL100 +01740 CL100 +01741 * IF W-WRITE-T025-TRAN-YES-88 CL108 +01742 * PERFORM P2021-WRITE-T025 THRU P2021-EXIT CL108 +01743 * ELSE CL108 +01744 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01745 MOVE SPACES TO R140-MESSAGE CL*71 +01746 MOVE W-EMP-NO TO R140-EMP-NO CL*71 +01747 STRING CL*71 +01748 'X430 -:>>>>> REPORT ADDED TO DUTAS - ' X140-QUARTER CL*93 +01749 DELIMITED BY SIZE CL*71 +01750 INTO R140-MESSAGE CL*71 +01751 END-STRING CL*71 +01752 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71 +01753 P2020-EXIT. DTSBX430 +01754 EXIT. DTSBX430 +01755 DTSBX430 +01756 P2021-WRITE-T025. CL*71 +01757 ** CL*73 +01758 **PAYMENT TRANSACTION REMIT AMT > THAN REPORT REMIT AMT, SUBTRACT CL*73 +01759 **DIFFERENCE AND WRITE A PA T025 TRANSACTION. CL*73 +01760 ** CL*73 +01761 DISPLAY 'PAYMENT OK ' X145-EMP-NO. CL*71 +01762 CL*71 +01763 MOVE LENGTH OF T025-REC TO T025-LENGTH CL*71 +01764 MOVE '025' TO T025-REC-TYPE. CL*71 +01765 CL*71 +01766 MOVE W-EMP-NO TO T025-EMP-NO. CL*71 +01767 MOVE 'WEB PAY' TO T025-ORIGIN. CL*71 +01768 MOVE LX42-SYS-DATE TO T025-SYS-DATE. CL*71 +01769 MOVE LX42-SYS-TIME TO T025-SYS-TIME. CL*71 +01770 * CL*71 +01771 MOVE ZERO TO T025-APPLIC-YRQ CL*71 +01772 MOVE 'PA' TO T025-PAY-TYPE CL*71 +01773 CL*71 +01774 MOVE SPACES TO T025-APPLIC-IND. CL*71 +01775 MOVE ZERO TO T025-APPLIC-BATCH-NO CL*71 +01776 T025-APPLIC-ITEM-NO. CL*71 +01777 CL*71 +01778 IF W-EMP-FOUND-YES-88 CL*71 +01779 MOVE MPRF-PRIMARY-NAME (1:4) CL*71 +01780 TO T025-NAME-CHECK CL*71 +01781 ELSE CL*71 +01782 MOVE SPACES TO T025-NAME-CHECK CL*71 +01783 END-IF. CL*71 +01784 CL*71 +01785 MOVE W-X145-RECEIVED-DATE TO T025-RECEIVED-DATE CL*72 +01786 T025-DEPOSIT-DATE. CL*71 +01787 CL*71 +01788 COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL*71 +01789 W-X140-REMITTANCE. CL*71 +01790 CL*71 +01791 MOVE W-T025-REMIT-AMT TO T025-REMIT-AMT. CL*71 +01792 CL*71 +01793 MOVE X145-TRACE-NO TO T025-TRACE-NO. CL165 +01794 CL*71 +01795 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*71 +01796 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL*71 +01797 CL*71 +01798 * MOVE T025-REC TO TSKL-REC. CL*71 +01799 * PERFORM S927B-WRITE THRU S927B-EXIT. CL*71 +01800 CL*71 +01801 PERFORM S1033-WRITE-TEMP-T025 THRU S1033-EXIT. CL*71 +01802 ADD +1 TO W-T025-WRITE-CNT. CL*71 +01803 CL*71 +01804 MOVE ZEROS TO W-T025-REMIT-AMT CL*72 +01805 W-X145-TOT-REMIT-AMT CL*72 +01806 W-X140-REMITTANCE. CL*72 +01807 CL*72 +01808 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*72 +01809 CL*71 +01810 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01811 MOVE SPACES TO R140-MESSAGE CL*71 +01812 MOVE W-EMP-NO TO R140-EMP-NO CL*71 +01813 STRING CL*71 +01814 'X430 -: >>>>> PAYMENT T025 CREATED FOR EXCESS 145 ' CL*93 +01815 'REMIT AMT' CL*93 +01816 DELIMITED BY SIZE CL*71 +01817 INTO R140-MESSAGE CL*71 +01818 END-STRING CL*71 +01819 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71 +01820 P2021-EXIT. CL*71 +01821 EXIT. CL*71 +01822 CL*71 +01823 DTSBX430 +01824 P3000-WAGES. DTSBX430 +01825 MOVE LX42-DATA-AREA TO X144-REC. DTSBX430 +01826 * DISPLAY 'X144: ' X144-REC. CL160 +01827 MOVE X144-EMP-NO TO W-EMP-NO. CL*38 +01828 MOVE X144-EMP-NO TO W-EMP-X144-NO. CL189 +01829 * CL**4 +01830 IF W-EMP-NO = LX42-X144-KEY-AREA AND CL218 +01831 X144-QUARTER = LX42-X144-QTR-AREA CL218 +01832 MOVE X144-EARNINGS TO W-EARNINGS-X CL189 +01833 MOVE W-EARNINGS-9 TO W-EARNINGS CL189 +01834 ADD W-EARNINGS TO W-TOT-X144-WAGE CL220 +01835 MOVE W-TOT-X144-WAGE TO LX42-PAY-REMIT-AMT CL222 +01836 ELSE CL220 +01837 MOVE 0 TO W-TOT-X144-WAGE CL220 +01838 MOVE W-EMP-NO TO LX42-X144-KEY-AREA CL220 +01839 MOVE X144-QUARTER TO LX42-X144-QTR-AREA CL221 +01840 MOVE X144-EARNINGS TO W-EARNINGS-X CL220 +01841 MOVE W-EARNINGS-9 TO W-EARNINGS CL220 +01842 ADD W-EARNINGS TO W-TOT-X144-WAGE CL222 +01843 MOVE W-TOT-X144-WAGE TO LX42-PAY-REMIT-AMT. CL222 +01844 CL220 +01845 * CL189 +01846 ADD +1 TO W-X144-RED-CNT CL*96 +01847 SET W-RPT-ERROR-NO-88 TO TRUE. CL147 +01848 SET W-PREV-REC-WAGE-88 TO TRUE. CL162 +01849 * CL**4 +01850 * DISPLAY 'LX-E ' LX42-X140-EMP-NO ' X145-E ' W-EMP-NO. CL*97 +01851 * IF LX42-X145-EMP-NO = '999999' OR CL157 +01852 * LX42-X140-EMP-NO = '999999' OR CL157 +01853 * LX42-X145-EMP-NO = SPACES OR CL157 +01854 * LX42-X140-EMP-NO = SPACES OR CL157 +01855 * W-PREV-RPT-NULL-88 CL157 +01856 * SET W-RPT-ERROR-YES-88 TO TRUE CL157 +01857 * MOVE SPACES TO R140-MESSAGE CL157 +01858 * MOVE W-EMP-NO TO R140-EMP-NO CL157 +01859 * STRING CL157 +01860 * 'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES ' CL157 +01861 * ' ' X144-QUARTER CL157 +01862 * DELIMITED BY SIZE CL157 +01863 * INTO R140-MESSAGE CL157 +01864 * END-STRING CL157 +01865 * WRITE PEND-X144-REC FROM X144-REC CL157 +01866 * ADD +1 TO W-X144-ERR-CNT CL157 +01867 * ADD +1 TO W-X144-PEN-CNT CL157 +01868 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL117 +01869 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*83 +01870 * GO TO P3000-EXIT. CL159 +01871 CL*36 +01872 * CL**4 +01873 * IF W-PREV-RPT-RPT-88 CL157 +01874 * OR W-PREV-RPT-WAGE-88 CL157 +01875 * SET W-PREV-RPT-WAGE-88 TO TRUE CL162 +01876 ADD +1 TO W-X144-PRO-CNT CL*56 +01877 PERFORM P3010-EDIT-WAGES THRU P3010-EXIT DTSBX430 +01878 IF W-RPT-ERROR-NO-88 CL*81 +01879 PERFORM P3011-WRITE-WAGES-X144 THRU P3011-EXIT DTSBX430 +01880 ADD +1 TO W-X144-SAV-CNT CL*96 +01881 GO TO P3000-EXIT CL160 +01882 ELSE CL*36 +01883 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01884 MOVE SPACES TO R140-MESSAGE CL*36 +01885 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +01886 STRING CL*36 +01887 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' CL*47 +01888 ' ' X144-SSN CL*36 +01889 DELIMITED BY SIZE CL*36 +01890 INTO R140-MESSAGE CL*36 +01891 END-STRING CL*36 +01892 ADD +1 TO W-X144-ERR-CNT CL*93 +01893 ADD +1 TO W-X144-PEN-CNT CL*96 +01894 WRITE PEND-X144-REC FROM X144-REC CL*93 +01895 * PERFORM P6000-WRITE-PEND-X144 THRU P6000-EXIT CL189 +01896 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +01897 GO TO P3000-EXIT CL*36 +01898 * ELSE CL157 +01899 * SET W-RPT-ERROR-YES-88 TO TRUE CL157 +01900 * MOVE SPACES TO R140-MESSAGE CL157 +01901 * MOVE W-EMP-NO TO R140-EMP-NO CL157 +01902 * STRING CL157 +01903 * 'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING ' CL157 +01904 * ' ' X144-SSN CL157 +01905 * DELIMITED BY SIZE CL157 +01906 * INTO R140-MESSAGE CL157 +01907 * END-STRING CL157 +01908 * WRITE PEND-X144-REC FROM X144-REC CL157 +01909 * ADD +1 TO W-X144-ERR-CNT CL157 +01910 * ADD +1 TO W-X144-PEN-CNT CL157 +01911 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL*93 +01912 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL157 +01913 END-IF. DTSBX430 +01914 DTSBX430 +01915 P3000-EXIT. DTSBX430 +01916 EXIT. DTSBX430 +01917 DTSBX430 +01918 P3010-EDIT-WAGES. DTSBX430 +01919 DISPLAY 'P3010-EDIT-WAGES ' CL162 +01920 * DISPLAY 'X144-QUARTER ' X144-QUARTER CL*36 +01921 MOVE X144-QUARTER TO W-SLASH-QTR. DTSBX430 +01922 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX430 +01923 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX430 +01924 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX430 +01925 IF NOT L004-VALID-QTR DTSBX430 +01926 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01927 MOVE SPACES TO R140-MESSAGE DTSBX430 +01928 MOVE W-EMP-NO TO R140-EMP-NO DTSBX430 +01929 STRING DTSBX430 +01930 ': WAGE RECORD HAS INVALID QUARTER ' CL144 +01931 X144-QUARTER ' ' X144-SSN CL*36 +01932 DELIMITED BY SIZE DTSBX430 +01933 INTO R140-MESSAGE DTSBX430 +01934 END-STRING DTSBX430 +01935 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +01936 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX430 +01937 ELSE CL*13 +01938 MOVE L004-QTR-5-9 TO W-X144-WAGE-QTR CL*53 +01939 END-IF. DTSBX430 +01940 CL*15 +01941 * IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR CL161 +01942 * SET W-RPT-ERROR-YES-88 TO TRUE CL161 +01943 * MOVE SPACES TO R140-MESSAGE CL161 +01944 * MOVE W-EMP-NO TO R140-EMP-NO CL161 +01945 * MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR CL161 +01946 * STRING CL161 +01947 * ':WAGE QTR NOT = RPT QTR ' CL161 +01948 * X144-QUARTER ' ' WRK-REPORT-QTR CL161 +01949 * DELIMITED BY SIZE CL161 +01950 * INTO R140-MESSAGE CL161 +01951 * END-STRING CL161 +01952 * MOVE R140-MESSAGE TO P434-MESSAGE CL161 +01953 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL161 +01954 * END-IF. CL161 +01955 DTSBX430 +01956 IF X144-SSN NOT NUMERIC DTSBX430 +01957 * DISPLAY 'X144-SSN ' X144-SSN CL*36 +01958 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01959 MOVE SPACES TO R140-MESSAGE DTSBX430 +01960 MOVE W-EMP-NO TO R140-EMP-NO DTSBX430 +01961 STRING DTSBX430 +01962 ':WAGE RECORD NON-NUMERIC SSN ' CL144 +01963 X144-SSN DTSBX430 +01964 DELIMITED BY SIZE DTSBX430 +01965 INTO R140-MESSAGE DTSBX430 +01966 END-STRING DTSBX430 +01967 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +01968 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX430 +01969 ELSE DTSBX430 +01970 MOVE X144-SSN TO W-SSN DTSBX430 +01971 END-IF. DTSBX430 +01972 DTSBX430 +01973 IF X144-SSN = ZEROS CL*53 +01974 * DISPLAY 'X144-SSN ' X144-SSN CL*53 +01975 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01976 MOVE SPACES TO R140-MESSAGE CL*53 +01977 MOVE W-EMP-NO TO R140-EMP-NO CL*53 +01978 STRING CL*53 +01979 ':WAGE RECORD SSN = ZEROS ' CL144 +01980 X144-SSN CL*53 +01981 DELIMITED BY SIZE CL*53 +01982 INTO R140-MESSAGE CL*53 +01983 END-STRING CL*53 +01984 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +01985 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*53 +01986 ELSE CL*53 +01987 MOVE X144-SSN TO W-SSN CL*53 +01988 END-IF. CL*53 +01989 CL*53 +01990 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME CL162 +01991 * ' FN: ' X144-FIRST-NAME. CL162 +01992 IF X144-LAST-NAME = SPACES CL*36 +01993 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01994 MOVE SPACES TO R140-MESSAGE CL*36 +01995 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +01996 STRING CL*36 +01997 ':WAGE RECORD BLANK LAST NAME ' CL144 +01998 X144-SSN CL*36 +01999 DELIMITED BY SIZE CL*36 +02000 INTO R140-MESSAGE CL*36 +02001 END-STRING CL*36 +02002 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02003 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +02004 END-IF. CL*36 +02005 CL*36 +02006 IF X144-FIRST-NAME = SPACES CL*36 +02007 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02008 MOVE SPACES TO R140-MESSAGE CL*36 +02009 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +02010 STRING CL*36 +02011 ':WAGE RECORD BLANK FIRST NAME ' CL144 +02012 X144-SSN CL*36 +02013 DELIMITED BY SIZE CL*36 +02014 INTO R140-MESSAGE CL*36 +02015 END-STRING CL*36 +02016 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02017 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +02018 END-IF. CL*36 +02019 CL*36 +02020 * IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR DTSBX430 +02021 * MOVE ZERO TO W-WRKR-TOT-WAGE DTSBX430 +02022 * MOVE W-WAGE-QTR TO W-CURR-WAGE-QTR DTSBX430 +02023 * END-IF. DTSBX430 +02024 DTSBX430 +02025 DTSBX430 +02026 P3010-EXIT. DTSBX430 +02027 EXIT. DTSBX430 +02028 DTSBX430 +02029 P3011-WRITE-WAGES-X144. DTSBX430 +02030 DTSBX430 +02031 ************************************************************** CL*11 +02032 * WRITE W4 WAGES FOR DOCS CL*11 +02033 ************************************************************** CL*11 +02034 * CL*11 +02035 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. CL*11 +02036 MOVE X144-SSN TO W4-SSN. CL*11 +02037 MOVE 'W4' TO W4-TRAN-ID. CL*11 +02038 MOVE '00044001' TO W4-TRAN-OPER-ID. CL*11 +02039 * MOVE MHDR-CURR-RUN-DATE TO W4-DATE-ENTERED. CL250 +02040 MOVE LX42-CURR-RUN-DATE TO W4-DATE-ENTERED. CL250 +02041 MOVE ZEROS TO W4-TIME-ENTERED. CL*11 +02042 MOVE X144-LAST-NAME (1:3) TO W4-NAME-CHECK. CL*11 +02043 MOVE W-X144-WAGE-QTR TO W4-QUARTER. CL118 +02044 MOVE X144-EARNINGS TO W4-QUARTER-EARNINGS. CL*11 +02045 MOVE 2 TO W4-AFFI-CODE. CL*11 +02046 MOVE X144-EMP-NO TO W4-ACCOUNT. CL*11 +02047 MOVE MPRF-PRIMARY-NAME (1:4) TO W4-EMP-NAME. CL*11 +02048 CL*11 +02049 * MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. CL*20 +02050 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +02051 CL*11 +02052 * WRITE WAGE-TRANS-REC. CL*20 +02053 WRITE WAGE-OUT-REC. CL*20 +02054 CL*11 +02055 IF WAGE-TEMP-STATUS-OK-88 CL*32 +02056 ADD +1 TO W-W4-CNT CL*11 +02057 * DISPLAY 'WRITE W4 ' W4-ACCOUNT ' ' W4-QUARTER CL162 +02058 * ' ' W4-SSN CL162 +02059 ELSE CL*11 +02060 DISPLAY 'ERROR WRITING W4- WAGE FILE ' CL*36 +02061 WAGE-TEMP-STATUS CL*32 +02062 END-IF. CL*11 +02063 CL*11 +02064 CL*11 +02065 P3011-EXIT. CL*25 +02066 EXIT. DTSBX430 +02067 P4000-WRITE-X434-PAID-REPT. CL119 +02068 CL119 +02069 MOVE X140-EMP-NO TO X434-EMP-NO CL119 +02070 MOVE X140-QUARTER TO X434-QTR CL125 +02071 IF W-EMP-FOUND-YES-88 CL119 +02072 MOVE MPRF-PRIMARY-NAME (1:15) CL119 +02073 TO X434-NAME-CHECK CL119 +02074 ELSE CL119 +02075 MOVE SPACES TO X434-NAME-CHECK CL119 +02076 END-IF. CL119 +02077 CL119 +02078 * DISPLAY ' T028 WAGE ' T028-TOT-WAGE. CL194 +02079 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL121 +02080 MOVE W-TOT-WAGE TO X434-TOT-WAGE CL194 +02081 MOVE W-TAX-WAGE TO X434-TAX-WAGE CL194 +02082 COMPUTE W-EXCESS-WAGE = CL194 +02083 (W-TOT-WAGE - W-TAX-WAGE). CL194 +02084 MOVE W-EXCESS-WAGE TO X434-EXC-WAGE CL194 +02085 * MOVE X140-REMITTANCE TO X434-X140-REMIT CL187 +02086 * WS-X140-REMITTANCE CL187 +02087 * MOVE W-X140-REMITTANCE TO X434-X145-REMIT CL187 +02088 CL148 +02089 * COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL187 +02090 * WS-X140-REMITTANCE. CL187 +02091 CL149 +02092 * MOVE W-T025-REMIT-AMT TO X434-DIFF. CL187 +02093 CL148 +02094 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL121 +02095 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL125 +02096 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL125 +02097 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL125 +02098 CL119 +02099 IF W-RPT-ERROR-NO-88 CL191 +02100 MOVE ':REPORT PASSED TO DUTAS>>>' TO X434-MESSAGE. CL228 +02101 * ELSE CL210 +02102 * MOVE 'PENDING ' TO X434-DISPOSITION. CL120 +02103 * MOVE R140-MESSAGE TO X434-MESSAGE. CL210 +02104 CL119 +02105 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL121 +02106 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. CL120 +02107 ADD 1 TO WS-LINE-CNT2. CL119 +02108 ADD +1 TO WS-NUMBER-ONE. CL119 +02109 CL119 +02110 CL119 +02111 P4000-EXIT. CL119 +02112 EXIT. CL119 +02113 P4100-PRINT-HEADER. CL121 +02114 IF WS-LINE-CNT GREATER 58 OR CL121 +02115 WS-LINE-CNT2 GREATER 58 CL121 +02116 MOVE +0 TO WS-LINE-CNT CL121 +02117 MOVE +0 TO WS-LINE-CNT2 CL121 +02118 ADD +1 TO WS-PAGE-CNT CL121 +02119 MOVE WS-PAGE-CNT TO HDR3-PAGE CL121 +02120 * MOVE L001-SLASH-DATE TO HDR1-LRCM-SYS-DATE CL247 +02121 MOVE '******* X140 REPORT STATUS ******* ' TO HDR5-NAME CL206 +02122 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL122 +02123 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL122 +02124 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL122 +02125 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL122 +02126 WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL153 +02127 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL122 +02128 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL122 +02129 ADD +6 TO WS-LINE-CNT2. CL121 +02130 P4100-EXIT. CL121 +02131 EXIT. CL121 +02132 CL121 +02133 P4200-PRINT-HEADER. CL133 +02134 IF WSP-LINE-CNT GREATER 58 OR CL133 +02135 WSP-LINE-CNT2 GREATER 58 CL133 +02136 MOVE +0 TO WSP-LINE-CNT CL133 +02137 MOVE +0 TO WSP-LINE-CNT2 CL133 +02138 ADD +1 TO WSP-PAGE-CNT CL133 +02139 MOVE WSP-PAGE-CNT TO HDR31-PAGE CL133 +02140 MOVE ' * REASON FOR PENDING *' TO HDR5-NAME CL138 +02141 * MOVE L001-SLASH-DATE TO HDR1-LRCM-SYS-DATE CL247 +02142 WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL133 +02143 WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1 CL133 +02144 WRITE REPT-PEND-REC FROM HEADER-31 AFTER 1 CL133 +02145 WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1 CL133 +02146 WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1 CL144 +02147 WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1 CL133 +02148 WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1 CL133 +02149 ADD +6 TO WSP-LINE-CNT2. CL133 +02150 P4200-EXIT. CL133 +02151 EXIT. CL133 +02152 CL133 +02153 DTSBX430 +02154 P5000-NEW-EMP. DTSBX430 +02155 *& DTSBX430 +02156 DISPLAY ' 5000-NEW-EMP ' W-PREV-REC-TYPE CL*89 +02157 ' ERROR-IND ' W-RPT-ERROR-IND CL*88 +02158 * IF W-PREV-RPT-PAY-88 AND CL184 +02159 * W-RPT-ERROR-NO-88 CL184 +02160 *** LX42-X140-EMP-NO = SPACES AND CL184 +02161 *** LX42-X145-EMP-NO = SPACES CL184 +02162 * ADD +1 TO W-X145-PEN-CNT CL184 +02163 * MOVE SPACES TO R140-MESSAGE CL184 +02164 * MOVE W-EMP-NO TO R140-EMP-NO CL184 +02165 * DISPLAY 'NO REPORT FOR PAYMENT ' W-EMP-NO ' ' W-PAY-QTR CL184 +02166 * ' ' X145-REMITTANCE CL184 +02167 * STRING CL184 +02168 * ': NO REPORT FOR PAYMENT ' CL184 +02169 * DELIMITED BY SIZE CL184 +02170 * INTO R140-MESSAGE CL184 +02171 * END-STRING CL184 +02172 * MOVE R140-MESSAGE TO P434-MESSAGE CL184 +02173 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL184 +02174 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL184 +02175 * WRITE PEND-X145-REC FROM X145-REC. CL184 +02176 CL*82 +02177 DISPLAY 'BX430 P5000-NEW-RPT-PAY ' W-EMP-NO ' ' LX42-EMP-NO. CL104 +02178 DTSBX430 +02179 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX430 +02180 SET W-RPT-ERROR-NO-88 TO TRUE. CL*80 +02181 * SET W-PREV-REC-NULL-88 TO TRUE. CL107 +02182 SET W-PREV-RPT-NULL-88 TO TRUE. CL104 +02183 SET X145-PAYMENT-DUP-NO-88 TO TRUE CL171 +02184 MOVE ZERO TO W-X140-REPORT-QTR CL*56 +02185 W-X145-PAYMENT-QTR CL*57 +02186 W-X144-WAGE-QTR CL*56 +02187 W-TOT-WAGE DTSBX430 +02188 W-EXCESS-WAGE CL194 +02189 W-TAX-WAGE DTSBX430 +02190 LX42-RPT-REMIT-AMT CL227 +02191 LX42-PAY-REMIT-AMT CL227 +02192 W-WRKR-TOT-WAGE DTSBX430 +02193 W-X145-REMITTANCE CL*53 +02194 W-X140-REMITTANCE CL*53 +02195 X434-X144-WAGE CL241 +02196 W-X140-RECEIVED-DATE CL*72 +02197 W-X145-DEPOSIT-DATE CL*72 +02198 W-X145-RECEIVED-DATE CL*72 +02199 W-1ST-MNTH-CNT DTSBX430 +02200 W-2ND-MNTH-CNT DTSBX430 +02201 W-3RD-MNTH-CNT DTSBX430 +02202 W-SSN DTSBX430 +02203 W-EARNINGS DTSBX430 +02204 W-EMP-WAGE-CNT DTSBX430 +02205 W-SEQ-NO CL*77 +02206 W-T025-REMIT-AMT CL*76 +02207 W-X145-TOT-REMIT-AMT CL*76 +02208 W-X140-REMITTANCE CL*83 +02209 LX42-X140-KEY-AREA CL*83 +02210 LX42-X144-KEY-AREA CL*83 +02211 LX42-X145-KEY-AREA. CL*83 +02212 CL*76 +02213 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*76 +02214 CL*76 +02215 DTSBX430 +02216 MOVE SPACES TO W-WRKR-FIRST-NAME DTSBX430 +02217 W-WRKR-LAST-NAME DTSBX430 +02218 W-WRKR-MID-INIT CL*56 +02219 W-X145-PAYMENT-FOUND-IND CL*79 +02220 LX42-X140-EMP-NO CL*79 +02221 LX42-X144-EMP-NO CL*82 +02222 LX42-X145-EMP-NO CL*82 +02223 LX42-X140-QTR-AREA CL*82 +02224 LX42-X144-QTR-AREA CL*82 +02225 P434-MESSAGE CL138 +02226 LX42-X145-QTR-AREA. CL*82 +02227 CL*53 +02228 INITIALIZE X140-REC DTSBX430 +02229 X144-REC CL*47 +02230 WS-HOLD-X145-REC CL174 +02231 X145-REC. CL173 +02232 CL*48 +02233 *& CL*88 +02234 DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE CL*90 +02235 ' W-RROR-IND ' W-RPT-ERROR-IND CL*88 +02236 'LX-W-RROR-IND ' W-RPT-ERROR-IND. CL*90 +02237 P5000-EXIT. CL*25 +02238 EXIT. DTSBX430 +02239 DTSBX430 +02240 P6000-WRITE-PEND-X145. CL132 +02241 * IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-NO-88 CL132 +02242 * WRITE PEND-X140-REC FROM X140-REC CL132 +02243 * ELSE CL132 +02244 * IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-YES-88 CL132 +02245 * WRITE PEND-X140-REC FROM X140-REC CL132 +02246 * WRITE PEND-X145-REC FROM X145-REC CL132 +02247 * ELSE CL132 +02248 * IF LX42-REC-TYPE-WAGE-88 CL132 +02249 * WRITE PEND-X144-REC FROM X144-REC CL132 +02250 * ELSE CL132 +02251 * IF LX42-REC-TYPE-PAY-88 CL132 +02252 * WRITE PEND-X145-REC FROM X145-REC CL132 +02253 * ELSE CL132 +02254 * DISPLAY ' INVALID RECORD TYPE ' LX42-REC-TYPE CL132 +02255 * PERFORM S999-ABEND THRU S999-EXIT. CL132 +02256 CL133 +02257 MOVE X145-EMP-NO TO P434-EMP-NO CL133 +02258 MOVE X145-QTR TO P434-QTR CL134 +02259 * IF W-EMP-FOUND-YES-88 CL135 +02260 * MOVE MPRF-PRIMARY-NAME (1:15) CL135 +02261 * TO P434-NAME-CHECK CL136 +02262 * ELSE CL135 +02263 MOVE 'PAY' TO P434-NAME-CHECK CL135 +02264 * END-IF. CL135 +02265 CL133 +02266 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL133 +02267 MOVE ZEROS TO P434-TOT-WAGE CL134 +02268 MOVE ZEROS TO P434-EXC-WAGE CL133 +02269 * MOVE ZEROS TO P434-EXC-WAGE CL134 +02270 MOVE ZEROS TO P434-TAX-WAGE CL133 +02271 MOVE ZEROS TO P434-X140-REMIT CL133 +02272 MOVE W-X145-TOT-REMIT-AMT TO P434-X145-REMIT CL135 +02273 CL133 +02274 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL133 +02275 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL133 +02276 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL133 +02277 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL133 +02278 CL133 +02279 * IF W-ERROR-NO-88 CL133 +02280 * MOVE 'PROCESSED' TO X434-DISPOSITION CL133 +02281 * ELSE CL133 +02282 * MOVE 'PENDING ' TO X434-DISPOSITION. CL133 +02283 * MOVE R140-MESSAGE TO P434-MESSAGE CL135 +02284 CL133 +02285 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133 +02286 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL133 +02287 ADD 1 TO WS-LINE-CNT2. CL133 +02288 ADD +1 TO WS-NUMBER-ONE. CL133 +02289 GO TO P6000-EXIT. CL133 +02290 CL132 +02291 P6000-WRITE-PEND-X140. CL132 +02292 IF W-X140-RED-CNT = 0 CL231 +02293 GO TO P6000-EXIT. CL231 +02294 DISPLAY '*****NEW EMP: ' CL233 +02295 ' EMP: ' LX42-X140-EMP-NO CL232 +02296 ' QTR: ' LX42-X140-QTR-AREA CL232 +02297 ' WAGE: ' LX42-PAY-REMIT-AMT ' REPT: ' LX42-RPT-REMIT-AMT. CL232 +02298 CL229 +02299 IF LX42-PAY-REMIT-AMT NOT = LX42-RPT-REMIT-AMT CL229 +02300 MOVE '**X140/X144 TOTAL WAGE MISSING' TO X434-MESSAGE CL240 +02301 DISPLAY '***NOT MATCH: ' CL233 +02302 ' EMP: ' LX42-X140-EMP-NO CL232 +02303 ' QTR: ' LX42-X140-QTR-AREA CL232 +02304 ' WAGE: ' LX42-PAY-REMIT-AMT ' REPT: ' LX42-RPT-REMIT-AMT CL232 +02305 ELSE CL229 +02306 GO TO P6000-EXIT. CL229 +02307 CL132 +02308 MOVE X140-EMP-NO TO X434-EMP-NO CL237 +02309 MOVE X140-QUARTER TO X434-QTR CL237 +02310 IF W-EMP-FOUND-YES-88 CL190 +02311 MOVE MPRF-PRIMARY-NAME (1:15) CL190 +02312 TO X434-NAME-CHECK CL237 +02313 ELSE CL190 +02314 MOVE 'RPT' TO X434-NAME-CHECK CL237 +02315 END-IF. CL190 +02316 CL132 +02317 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL237 +02318 MOVE LX42-RPT-REMIT-AMT TO X434-TOT-WAGE CL237 +02319 * MOVE ZEROS TO X434-EXC-WAGE CL241 +02320 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL141 +02321 * MOVE X140-TAX-WAGES TO P434-TAX-WAGE CL190 +02322 MOVE LX42-PAY-REMIT-AMT TO X434-X144-WAGE CL241 +02323 * MOVE X140-REMITTANCE TO P434-X140-REMIT CL190 +02324 * MOVE ZEROS TO X434-X145-REMIT CL239 +02325 CL132 +02326 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL132 +02327 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL132 +02328 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL132 +02329 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL132 +02330 CL132 +02331 * IF W-ERROR-NO-88 CL222 +02332 * MOVE 'PROCESSED' TO X434-DISPOSITION CL132 +02333 * ELSE CL132 +02334 * MOVE 'PENDING ' TO X434-DISPOSITION. CL132 +02335 * MOVE R140-MESSAGE TO P434-MESSAGE CL137 +02336 CL132 +02337 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133 +02338 * WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL237 +02339 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. CL237 +02340 ADD 1 TO WS-LINE-CNT2. CL132 +02341 ADD +1 TO WS-NUMBER-ONE. CL132 +02342 GO TO P6000-EXIT. CL144 +02343 CL132 +02344 P6000-WRITE-PEND-X144. CL144 +02345 CL144 +02346 MOVE X140-EMP-NO TO P434-EMP-NO CL144 +02347 MOVE X140-QUARTER TO P434-QTR CL144 +02348 IF W-EMP-FOUND-YES-88 CL189 +02349 MOVE MPRF-PRIMARY-NAME (1:15) CL189 +02350 TO P434-NAME-CHECK CL189 +02351 ELSE CL189 +02352 MOVE 'WAGE' TO P434-NAME-CHECK CL144 +02353 END-IF. CL189 +02354 CL144 +02355 MOVE SPACES TO P434-RCVD-DATE CL144 +02356 MOVE W-TOT-WAGE TO P434-TOT-WAGE CL189 +02357 MOVE ZEROS TO P434-EXC-WAGE CL144 +02358 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL144 +02359 MOVE ZEROS TO P434-TAX-WAGE CL144 +02360 MOVE ZEROS TO P434-X140-REMIT CL144 +02361 MOVE ZEROS TO P434-X145-REMIT CL144 +02362 CL144 +02363 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL144 +02364 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL144 +02365 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL144 +02366 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL144 +02367 CL144 +02368 * IF W-ERROR-NO-88 CL144 +02369 * MOVE 'PROCESSED' TO X434-DISPOSITION CL144 +02370 * ELSE CL144 +02371 * MOVE 'PENDING ' TO X434-DISPOSITION. CL144 +02372 * MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02373 CL144 +02374 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL144 +02375 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL144 +02376 ADD 1 TO WS-LINE-CNT2. CL144 +02377 ADD +1 TO WS-NUMBER-ONE. CL144 +02378 CL144 +02379 CL144 +02380 CL*59 +02381 P6000-EXIT. CL*59 +02382 EXIT. CL*59 +02383 CL*59 +02384 DTSBX430 +02385 T0000-TERMINATE. DTSBX430 +02386 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO CL121 +02387 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL121 +02388 END-IF. CL121 +02389 MOVE W-X145-RED-CNT TO WS-FOOTING-CNT. CL128 +02390 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL121 +02391 MOVE W-X145-PEN-CNT TO WS-X145-PEN-CNT. CL121 +02392 MOVE W-X140-RED-CNT TO WS-X140-RED-CNT. CL130 +02393 MOVE W-X140-PEN-CNT TO WS-X140-ERR-CNT. CL208 +02394 MOVE W-X140-PEN-CNT TO WS-X140-PEN-CNT. CL130 +02395 MOVE W-X144-RED-CNT TO WS-X144-RED-CNT. CL153 +02396 MOVE W-X144-ERR-CNT TO WS-X144-ERR-CNT. CL153 +02397 MOVE W-X144-PEN-CNT TO WS-X144-PEN-CNT. CL153 +02398 MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT. CL121 +02399 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. CL208 +02400 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. CL208 +02401 * WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. CL207 +02402 * WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. CL207 +02403 * WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL207 +02404 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 2. CL208 +02405 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. CL153 +02406 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. CL153 +02407 WRITE REPT-PAID-REC FROM FOOTING-LINE-9 AFTER 1. CL153 +02408 WRITE REPT-PAID-REC FROM FOOTING-LINE-10 AFTER 1. CL207 +02409 WRITE REPT-PAID-REC FROM FOOTING-LINE-11 AFTER 1. CL153 +02410 * WRITE REPT-PAID-REC FROM FOOTING-LINE-12 AFTER 1. CL208 +02411 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 1. CL208 +02412 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. CL153 +02413 CL121 +02414 DISPLAY ' '. DTSBX430 +02415 DTSBX430 +02416 DTSBX430 +02417 DISPLAY ' '. DTSBX430 +02418 DISPLAY '***************************************'. CL*47 +02419 DISPLAY '*** DTSBX430 TERMINATION STATISTICS ***'. CL*47 +02420 DISPLAY '*** ESSP- REPORT WAGES AND PAYMENTS ***'. CL*47 +02421 DISPLAY '***************************************'. CL*47 +02422 DISPLAY ' '. DTSBX430 +02423 DTSBX430 +02424 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX430 +02425 DTSBX430 +02426 DISPLAY '***************************************'. DTSBX430 +02427 DTSBX430 +02428 CLOSE WAGE-FILE-OUT CL*20 +02429 PEND-X140-FILE CL*59 +02430 PEND-X144-FILE CL*59 +02431 X430-PAID-FILE CL201 +02432 X430-PEND-FILE CL201 +02433 PEND-X145-FILE CL120 +02434 TEMP-BTC-FILE CL*59 +02435 BATCH-XREF-FILE. CL*26 +02436 T0000-EXIT. DTSBX430 +02437 EXIT. DTSBX430 +02438 DTSBX430 +02439 DTSBX430 +02440 T2000-DISPLAY-TOTALS. DTSBX430 +02441 DISPLAY '***** QUARTERLY REPORTS ************* '. CL*92 +02442 DISPLAY 'TOTAL X140-REPORT RECORDS READ..........: ' CL*96 +02443 W-X140-RED-CNT. CL*57 +02444 CL*99 +02445 DISPLAY ' NO OF X140-REPORTS PASSED ALL EDITS....: ' CL*99 +02446 W-X140-SAV-CNT. CL*99 +02447 DTSBX430 +02448 DISPLAY ' NO OF X140-REPORTS T028 TRANS WRITTEN..: ' CL*96 +02449 W-T028-WRITE-CNT. DTSBX430 +02450 CL*99 +02451 DISPLAY ' ##T028 TRANS WRITTEN - REMIT AMT ZERO.: ' CL100 +02452 W-T028-WRITEO-CNT. CL100 +02453 CL*99 +02454 DISPLAY ' #T028 TRANS WRITTEN - REMIT AMT EQUAL: ' CL102 +02455 W-T028-WRITEE-CNT. CL102 +02456 DISPLAY ' NO OF X140-REPORTS WRITTEN TO PENDING..: ' CL*96 +02457 W-X140-PEN-CNT. CL*92 +02458 DISPLAY ' NO OF X140-REPORTS HAS ERRORS..........: ' CL*96 +02459 W-X140-ERR-CNT. CL*92 +02460 DISPLAY ' NO OF X140-REPORTS HAS DUPLICATE.......: ' CL*96 +02461 W-X140-DUP-CNT. CL*92 +02462 CL*92 +02463 DISPLAY ' '. CL*92 +02464 DISPLAY '***** QUARTERLY PAYMENTS ********* '. CL*96 +02465 DISPLAY 'TOTAL X145-PAYMENTS RECORDS READ.......: ' CL*96 +02466 W-X145-RED-CNT. CL*92 +02467 CL*92 +02468 DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: ' CL*98 +02469 W-X145-SAV-CNT. CL*92 +02470 CL*92 +02471 DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: ' CL*96 +02472 W-T025-WRITE-CNT. CL*94 +02473 CL*94 +02474 DISPLAY ' ## T025 TRANS WRITTEN-ZERO REMIT....: ' CL100 +02475 W-T025-WRITEO-CNT. CL100 +02476 CL100 +02477 DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: ' CL*96 +02478 W-X145-PEN-CNT. CL*92 +02479 DISPLAY ' NO OF X145-PAYMENTS HAS ERRORS.........: ' CL*96 +02480 W-X145-ERR-CNT. CL*92 +02481 DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: ' CL*96 +02482 W-X145-DUP-CNT. CL*92 +02483 CL*92 +02484 DISPLAY ' '. CL*92 +02485 DISPLAY '***** QUARTERLY WAGES ************* '. CL*92 +02486 DISPLAY 'TOTAL X144-WAGES RECORDS READ..........: ' CL*96 +02487 W-X144-RED-CNT. CL*92 +02488 CL*99 +02489 DISPLAY ' NO OF X144-WAGES PASSED ALL EDITS......: ' CL*99 +02490 W-X144-SAV-CNT. CL*99 +02491 CL*99 +02492 DISPLAY ' NO OF X144-WAGES W004 TRANS WRITTEN....: ' CL*96 +02493 W-W4-CNT. CL*96 +02494 CL*92 +02495 DISPLAY ' NO OF X144-WAGES WRITTEN TO PENDING....: ' CL*96 +02496 W-X144-PEN-CNT. CL*92 +02497 DISPLAY ' NO OF X144-WAGES HAS ERRORS............: ' CL*96 +02498 W-X144-ERR-CNT. CL*92 +02499 DISPLAY ' NO OF X144-WAGES HAS DUPLICATE.........: ' CL*96 +02500 W-X144-DUP-CNT. CL*92 +02501 CL*92 +02502 CL*10 +02503 DISPLAY ' '. DTSBX430 +02504 DISPLAY '***** END REPORTS/WAGES AND PAYMENTS **** '. CL*96 +02505 DTSBX430 +02506 T2000-EXIT. DTSBX430 +02507 EXIT. DTSBX430 +02508 DTSBX430 +02509 S001-FROM-FED-8. DTSBX430 +02510 SET L001-FROM-FED-8 TO TRUE. DTSBX430 +02511 GO TO S001-DATE. DTSBX430 +02512 DTSBX430 +02513 S001-FROM-CAL-8. DTSBX430 +02514 SET L001-FROM-CAL-8 TO TRUE. DTSBX430 +02515 GO TO S001-DATE. DTSBX430 +02516 DTSBX430 +02517 S001-FROM-ABS-DAY. DTSBX430 +02518 SET L001-FROM-ABS-DAY TO TRUE. DTSBX430 +02519 GO TO S001-DATE. DTSBX430 +02520 DTSBX430 +02521 S001-DATE. DTSBX430 +02522 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX430 +02523 S001-EXIT. DTSBX430 +02524 EXIT. DTSBX430 +02525 DTSBX430 +02526 S003-AGENCY-DAY. DTSBX430 +02527 SET L003-AGENCY-DAY TO TRUE. DTSBX430 +02528 GO TO S003-WORK-DAY. DTSBX430 +02529 DTSBX430 +02530 S003-WORK-DAY. DTSBX430 +02531 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX430 +02532 S003-EXIT. DTSBX430 +02533 EXIT. DTSBX430 +02534 DTSBX430 +02535 S004-FROM-5. DTSBX430 +02536 SET L004-FROM-5 TO TRUE. DTSBX430 +02537 GO TO S004-YRQ. DTSBX430 +02538 DTSBX430 +02539 S004-FROM-DATE. DTSBX430 +02540 SET L004-FROM-DATE TO TRUE. DTSBX430 +02541 GO TO S004-YRQ. DTSBX430 +02542 DTSBX430 +02543 S004-FROM-ABS. DTSBX430 +02544 SET L004-FROM-ABS TO TRUE. DTSBX430 +02545 GO TO S004-YRQ. DTSBX430 +02546 DTSBX430 +02547 S004-YRQ. DTSBX430 +02548 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX430 +02549 CL251 +02550 S004-EXIT. DTSBX430 +02551 EXIT. DTSBX430 +02552 DTSBX430 +02553 S516-LIABILITY-INFO. DTSBX430 +02554 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX430 +02555 MPRF-REC. DTSBX430 +02556 S516-EXIT. DTSBX430 +02557 EXIT. DTSBX430 +02558 DTSBX430 +02559 S910-OPEN-READ. DTSBX430 +02560 SET L910-OPEN-READ-88 TO TRUE. DTSBX430 +02561 GO TO S910-MSTR-IO. DTSBX430 +02562 DTSBX430 +02563 S910-READ. DTSBX430 +02564 SET L910-READ-88 TO TRUE. DTSBX430 +02565 GO TO S910-MSTR-IO. DTSBX430 +02566 DTSBX430 +02567 S910-START-BROWSE. DTSBX430 +02568 SET L910-START-BROWSE-88 TO TRUE. DTSBX430 +02569 GO TO S910-MSTR-IO. DTSBX430 +02570 DTSBX430 +02571 S910-READ-NEXT. DTSBX430 +02572 SET L910-READ-NEXT-88 TO TRUE. DTSBX430 +02573 GO TO S910-MSTR-IO. DTSBX430 +02574 DTSBX430 +02575 S910-CLOSE. DTSBX430 +02576 SET L910-CLOSE-88 TO TRUE. DTSBX430 +02577 GO TO S910-MSTR-IO. DTSBX430 +02578 DTSBX430 +02579 S910-MSTR-IO. DTSBX430 +02580 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX430 +02581 MSKL-REC. DTSBX430 +02582 S910-EXIT. DTSBX430 +02583 EXIT. DTSBX430 +02584 DTSBX430 +02585 S921-OPEN-READ. DTSBX430 +02586 SET L921-OPEN-READ-88 TO TRUE. DTSBX430 +02587 GO TO S921-AIX-IO. DTSBX430 +02588 DTSBX430 +02589 S921-READ. DTSBX430 +02590 SET L921-READ-88 TO TRUE. DTSBX430 +02591 GO TO S921-AIX-IO. DTSBX430 +02592 DTSBX430 +02593 S921-START-BROWSE. DTSBX430 +02594 SET L921-START-BROWSE-88 TO TRUE. DTSBX430 +02595 GO TO S921-AIX-IO. DTSBX430 +02596 DTSBX430 +02597 S921-READ-NEXT. DTSBX430 +02598 SET L921-READ-NEXT-88 TO TRUE. DTSBX430 +02599 GO TO S921-AIX-IO. DTSBX430 +02600 DTSBX430 +02601 S921-CLOSE. DTSBX430 +02602 SET L921-CLOSE-88 TO TRUE. DTSBX430 +02603 GO TO S921-AIX-IO. DTSBX430 +02604 DTSBX430 +02605 S921-AIX-IO. DTSBX430 +02606 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX430 +02607 ISKL-REC. DTSBX430 +02608 S921-EXIT. DTSBX430 +02609 EXIT. DTSBX430 +02610 DTSBX430 +02611 S923-OPEN-UPDATE. DTSBX430 +02612 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX430 +02613 GO TO S923-ATC-CALL. DTSBX430 +02614 DTSBX430 +02615 S923-WRITE. DTSBX430 +02616 SET L923-WRITE-88 TO TRUE. DTSBX430 +02617 GO TO S923-ATC-CALL. DTSBX430 +02618 DTSBX430 +02619 S923-CLOSE. DTSBX430 +02620 SET L923-CLOSE-88 TO TRUE. DTSBX430 +02621 GO TO S923-ATC-CALL. DTSBX430 +02622 DTSBX430 +02623 S923-ATC-CALL. DTSBX430 +02624 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX430 +02625 ASKL-REC. DTSBX430 +02626 S923-EXIT. DTSBX430 +02627 EXIT. DTSBX430 +02628 DTSBX430 +02629 *S927A-OPEN. DTSBX430 +02630 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX430 +02631 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX430 +02632 * DTSBX430 +02633 *S927A-EXIT. DTSBX430 +02634 * EXIT. DTSBX430 +02635 DTSBX430 +02636 S927B-WRITE. DTSBX430 +02637 SET L927-WRITE-88 TO TRUE. DTSBX430 +02638 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX430 +02639 DTSBX430 +02640 S927B-EXIT. DTSBX430 +02641 EXIT. DTSBX430 +02642 DTSBX430 +02643 *S927C-CLOSE. DTSBX430 +02644 * SET L927-CLOSE-88 TO TRUE. DTSBX430 +02645 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX430 +02646 * DTSBX430 +02647 *S927C-EXIT. DTSBX430 +02648 * EXIT. DTSBX430 +02649 DTSBX430 +02650 S927Z-IO. DTSBX430 +02651 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX430 +02652 TSKL-REC. DTSBX430 +02653 S927Z-EXIT. DTSBX430 +02654 EXIT. DTSBX430 +02655 DTSBX430 +02656 S931-OPEN-READ. DTSBX430 +02657 SET L931-OPEN-READ-88 TO TRUE. DTSBX430 +02658 GO TO S931-REF-IO. DTSBX430 +02659 DTSBX430 +02660 S931-CLOSE. DTSBX430 +02661 SET L931-CLOSE-88 TO TRUE. DTSBX430 +02662 GO TO S931-REF-IO. DTSBX430 +02663 DTSBX430 +02664 S931-REF-IO. DTSBX430 +02665 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX430 +02666 FSKL-REC. DTSBX430 +02667 S931-EXIT. DTSBX430 +02668 EXIT. DTSBX430 +02669 DTSBX430 +02670 S1032-WRITE-TEMP-T028. DTSBX430 +02671 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSBX430 +02672 MOVE T028-REC TO TEMP-BTC-REC. DTSBX430 +02673 WRITE TEMP-BTC-REC. DTSBX430 +02674 IF TEMP-BTC-STATUS-OK-88 DTSBX430 +02675 NEXT SENTENCE DTSBX430 +02676 ELSE DTSBX430 +02677 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02678 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSBX430 +02679 TEMP-BTC-STATUS DTSBX430 +02680 END-IF. DTSBX430 +02681 DTSBX430 +02682 S1032-EXIT. CL**9 +02683 EXIT. DTSBX430 +02684 DTSBX430 +02685 S1033-WRITE-TEMP-T025. DTSBX430 +02686 MOVE T025-LENGTH TO VAR-CHAR-CNT. DTSBX430 +02687 MOVE T025-REC TO TEMP-BTC-REC. DTSBX430 +02688 WRITE TEMP-BTC-REC. DTSBX430 +02689 IF TEMP-BTC-STATUS-OK-88 DTSBX430 +02690 NEXT SENTENCE DTSBX430 +02691 ELSE DTSBX430 +02692 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02693 DISPLAY 'CANNOT WRITE TEMP T025: ' DTSBX430 +02694 TEMP-BTC-STATUS DTSBX430 +02695 END-IF. DTSBX430 +02696 DTSBX430 +02697 S1033-EXIT. DTSBX430 +02698 EXIT. DTSBX430 +02699 DTSBX430 +02700 S1040-OPEN-TEMP-BTC-OUT. DTSBX430 +02701 OPEN OUTPUT TEMP-BTC-FILE. DTSBX430 +02702 IF TEMP-BTC-STATUS-OK-88 DTSBX430 +02703 NEXT SENTENCE DTSBX430 +02704 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX430 +02705 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX430 +02706 ELSE DTSBX430 +02707 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02708 DISPLAY 'CANNOT OPEN X430 BTC FILE OUTPUT: ' CL225 +02709 TEMP-BTC-STATUS DTSBX430 +02710 END-IF. DTSBX430 +02711 DTSBX430 +02712 S1040-EXIT. DTSBX430 +02713 EXIT. DTSBX430 +02714 DTSBX430 +02715 S1050-OPEN-TEMP-BTC-IN. DTSBX430 +02716 OPEN INPUT TEMP-BTC-FILE. DTSBX430 +02717 IF TEMP-BTC-STATUS-OK-88 DTSBX430 +02718 NEXT SENTENCE DTSBX430 +02719 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX430 +02720 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX430 +02721 ELSE DTSBX430 +02722 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02723 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBX430 +02724 TEMP-BTC-STATUS DTSBX430 +02725 END-IF. DTSBX430 +02726 DTSBX430 +02727 S1050-EXIT. DTSBX430 +02728 EXIT. DTSBX430 +02729 DTSBX430 +02730 S1060-CLOSE-TEMP-BTC. DTSBX430 +02731 CLOSE TEMP-BTC-FILE. DTSBX430 +02732 IF TEMP-BTC-STATUS-OK-88 DTSBX430 +02733 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX430 +02734 NEXT SENTENCE DTSBX430 +02735 ELSE DTSBX430 +02736 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02737 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX430 +02738 TEMP-BTC-STATUS DTSBX430 +02739 END-IF. DTSBX430 +02740 DTSBX430 +02741 S1060-EXIT. DTSBX430 +02742 EXIT. DTSBX430 +02743 DTSBX430 +02744 S1070-READ-TEMP-BTC. DTSBX430 +02745 READ TEMP-BTC-FILE. DTSBX430 +02746 IF TEMP-BTC-STATUS-OK-88 DTSBX430 +02747 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBX430 +02748 ELSE DTSBX430 +02749 IF TEMP-BTC-STATUS-EOF-88 DTSBX430 +02750 NEXT SENTENCE DTSBX430 +02751 ELSE DTSBX430 +02752 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBX430 +02753 TEMP-BTC-STATUS DTSBX430 +02754 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02755 END-IF DTSBX430 +02756 END-IF. DTSBX430 +02757 DTSBX430 +02758 S1070-EXIT. DTSBX430 +02759 EXIT. DTSBX430 +02760 DTSBX430 +02761 S1100-OPEN-WAGE-TEMP-OUT. DTSBX430 +02762 OPEN OUTPUT WAGE-FILE-TEMP. DTSBX430 +02763 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX430 +02764 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02765 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSBX430 +02766 WAGE-TEMP-STATUS DTSBX430 +02767 END-IF. DTSBX430 +02768 DTSBX430 +02769 S1100-EXIT. DTSBX430 +02770 EXIT. DTSBX430 +02771 DTSBX430 +02772 S1110-CLOSE-WAGE-TEMP. DTSBX430 +02773 CLOSE WAGE-FILE-TEMP. DTSBX430 +02774 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX430 +02775 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02776 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBX430 +02777 WAGE-TEMP-STATUS DTSBX430 +02778 END-IF. DTSBX430 +02779 DTSBX430 +02780 S1110-EXIT. DTSBX430 +02781 EXIT. DTSBX430 +02782 DTSBX430 +02783 S1120-WRITE-WAGE-TEMP. DTSBX430 +02784 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBX430 +02785 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX430 +02786 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02787 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBX430 +02788 WAGE-TEMP-STATUS DTSBX430 +02789 END-IF. DTSBX430 +02790 DTSBX430 +02791 S1120-EXIT. DTSBX430 +02792 EXIT. DTSBX430 +02793 DTSBX430 +02794 S1130-OPEN-WAGE-TEMP-IN. DTSBX430 +02795 OPEN INPUT WAGE-FILE-TEMP. DTSBX430 +02796 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX430 +02797 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02798 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSBX430 +02799 WAGE-TEMP-STATUS DTSBX430 +02800 END-IF. DTSBX430 +02801 DTSBX430 +02802 S1130-EXIT. DTSBX430 +02803 EXIT. DTSBX430 +02804 DTSBX430 +02805 S1140-READ-WAGE-TEMP. DTSBX430 +02806 READ WAGE-FILE-TEMP INTO W001-REC. DTSBX430 +02807 IF WAGE-TEMP-STATUS-EOF-88 DTSBX430 +02808 NEXT SENTENCE DTSBX430 +02809 ELSE DTSBX430 +02810 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX430 +02811 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX430 +02812 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSBX430 +02813 WAGE-TEMP-STATUS DTSBX430 +02814 END-IF DTSBX430 +02815 END-IF. DTSBX430 +02816 DTSBX430 +02817 S1140-EXIT. DTSBX430 +02818 EXIT. DTSBX430 +02819 DTSBX430 +02820 S1150-OPEN-WAGE-FILE-OUT. CL*20 +02821 OPEN OUTPUT WAGE-FILE-OUT. CL*20 +02822 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02823 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02824 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' CL*20 +02825 WAGE-OUT-STATUS CL*20 +02826 END-IF. CL*20 +02827 DTSBX430 +02828 S1150-EXIT. CL*20 +02829 EXIT. CL*20 +02830 DTSBX430 +02831 S1160-CLOSE-WAGE-OUT. CL*20 +02832 CLOSE WAGE-FILE-OUT. CL*20 +02833 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02834 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02835 DISPLAY 'CANNOT CLOSE WAGE FILE: ' CL*20 +02836 WAGE-OUT-STATUS CL*20 +02837 END-IF. CL*20 +02838 DTSBX430 +02839 S1160-EXIT. CL*20 +02840 EXIT. CL*20 +02841 DTSBX430 +02842 S1170-WRITE-WAGE-OUT. CL*20 +02843 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +02844 WRITE WAGE-OUT-REC. CL*20 +02845 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02846 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02847 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' CL*20 +02848 WAGE-OUT-STATUS CL*20 +02849 END-IF. CL*20 +02850 DTSBX430 +02851 S1170-EXIT. CL*20 +02852 EXIT. CL*20 +02853 DTSBX430 +02854 S946-WRITE-R140. DTSBX430 +02855 CALL 'DTSBU946' USING R140-REC. DTSBX430 +02856 DTSBX430 +02857 S946-EXIT. DTSBX430 +02858 EXIT. DTSBX430 +02859 DTSBX430 +02860 S999-ABEND. DTSBX430 +02861 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX430 +02862 S999-EXIT. DTSBX430 +02863 EXIT. DTSBX430 +02864 DTSBX430 diff --git a/Batch/DTSBX431.cob b/Batch/DTSBX431.cob new file mode 100644 index 0000000..5a56062 --- /dev/null +++ b/Batch/DTSBX431.cob @@ -0,0 +1,1002 @@ +00001 IDENTIFICATION DIVISION. 02/26/10 +00002 PROGRAM-ID. DTSBX431. DTSBX431 +00003 AUTHOR. NORTHROP GRUMMAN. LV001 +00004 DATE-WRITTEN. SEPTEMBER 2007. DTSBX431 +00005 DATE-COMPILED. DTSBX431 +00006 SKIP3 DTSBX431 +00007 ***** DTSBX431 +00008 * DTSBX431 +00009 * FUNCTION: UPDATED EVENT LOG (MEVL) AND NOTEPAD (MNTE) DTSBX431 +00010 * RECORDS ON THE MAINFRAME BASED ON AN UPLOADED DTSBX431 +00011 * DATA SET FROM THE REPORT DELINQUENCY TRACKING DTSBX431 +00012 * APPLICATION FROM THE SERVER. DTSBX431 +00013 * DTSBX431 +00014 * MODIFICATION LOG: DTSBX431 +00015 * DTSBX431 +00016 * 02/21/2007 INITIAL DEVELOPMENT. DTSBX431 +00017 * WORK ORDER: PROGRAMMER: RW1 DTSBX431 +00018 * DTSBX431 +00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX431 +00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX431 +00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX431 +00022 * DTSBX431 +00023 * DESCRIPTION: DTSBX431 +00024 * DTSBX431 +00025 * UPDATE THE MAINFRAME CICS MEVL AND MNTE RECORDS. DTSBX431 +00026 * DTSBX431 +00027 * DTSBX431 READ THE UPLOADED DATASET FROM THE REPORT DTSBX431 +00028 * DELINQUENCY TRACKING APPLICATION FROM THE DTSBX431 +00029 * SERVER TO PERFORM THE UPDATE FUNCTIONS. DTSBX431 +00030 * DTSBX431 +00031 * REPORT RECORDS INPUT: DTSBX431 +00032 * NONE. DTSBX431 +00033 * DTSBX431 +00034 * TAPES INPUT: DTSBX431 +00035 * NONE. DTSBX431 +00036 * DTSBX431 +00037 * MASTER FILE RECORDS READ: DTSBX431 +00038 * NONE DTSBX431 +00039 * DTSBX431 +00040 * MASTER FILE RECORDS UPDATED: DTSBX431 +00041 * MEVL (WRITTEN). DTSBX431 +00042 * MNTE (WRITTEN). DTSBX431 +00043 * DTSBX431 +00044 * RECORDS READ: DTSBX431 +00045 * DELINQUENT DATA SET FROM THE SERVER. DTSBX431 +00046 * DTSBX431 +00047 * MODULES CALLED: DTSBX431 +00048 * DTSBU910 MASTER FILE I/O. DTSBX431 +00049 * DTSBX431 +00050 ***** DTSBX431 +00051 SKIP3 DTSBX431 +00052 ENVIRONMENT DIVISION. DTSBX431 +00053 DTSBX431 +00054 INPUT-OUTPUT SECTION. DTSBX431 +00055 DTSBX431 +00056 FILE-CONTROL. DTSBX431 +00057 SELECT WEB-DLQ-FILE ASSIGN TO WEBDLQSI DTSBX431 +00058 FILE STATUS IS WEB-DLQ-STATUS. DTSBX431 +00059 DTSBX431 +00060 DATA DIVISION. DTSBX431 +00061 DTSBX431 +00062 FILE SECTION. DTSBX431 +00063 DTSBX431 +00064 FD WEB-DLQ-FILE DTSBX431 +00065 LABEL RECORDS ARE STANDARD DTSBX431 +00066 RECORDING MODE IS F DTSBX431 +00067 BLOCK CONTAINS 0 RECORDS. DTSBX431 +00068 DTSBX431 +00069 01 WEB-DLQ-REC PIC X(1246). DTSBX431 +00070 ** 05 REC-LEN PIC S9(04) COMP. DTSBX431 +00071 * 05 REC-DATA OCCURS 1 TO 4087 TIMES DTSBX431 +00072 ** DEPENDING ON VAR-REC-CNT PIC X(01). DTSBX431 +00073 DTSBX431 +00074 WORKING-STORAGE SECTION. DTSBX431 +000745 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX431 02/26/10'. DTSBX431 +00075 SKIP3 DTSBX431 +00076 01 WRK-AREA. DTSBX431 +00077 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +431. DTSBX431 +00078 05 ABEND-MSG PIC X(60). DTSBX431 +00079 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX431'.DTSBX431 +00080 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBX431 +00081 05 WRK-SYS-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX431 +00082 05 WRK-SYS-TIME PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00083 DTSBX431 +00084 05 VAR-REC-CNT PIC S9(04) COMP. DTSBX431 +00085 05 WEB-DLQ-STATUS PIC X(02). DTSBX431 +00086 88 WEB-DLQ-STATUS-OK-88 VALUE '00'. DTSBX431 +00087 88 WEB-DLQ-STATUS-EOF-88 VALUE '10'. DTSBX431 +00088 DTSBX431 +00089 05 WRK-MPRF-FOUND-IND PIC X(01). DTSBX431 +00090 88 WRK-MPRF-FOUND-YES-88 VALUE 'Y'. DTSBX431 +00091 88 WRK-MPRF-FOUND-NO-88 VALUE 'N'. DTSBX431 +00092 DTSBX431 +00093 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00094 05 WRK-WEB-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00095 05 WRK-WRITE-MEVL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00096 05 WRK-WRITE-MNTE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00097 05 WRK-YES-MNTE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00098 05 WRK-NO-MNTE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00099 05 WRK-YES-MEVL-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00100 05 WRK-NO-MEVL-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 +00101 DTSBX431 +00102 05 WRK-ID-NO-9 PIC 9(03). DTSBX431 +00103 05 WRK-ID-NO-X REDEFINES WRK-ID-NO-9 DTSBX431 +00104 PIC X(03). DTSBX431 +00105 DTSBX431 +00106 05 W-SLASH-QTR PIC X(06). DTSBX431 +00107 05 FILLER REDEFINES W-SLASH-QTR. DTSBX431 +00108 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX431 +00109 10 FILLER PIC X(01). DTSBX431 +00110 10 W-SLASH-QTR-Q PIC X(01). DTSBX431 +00111 DTSBX431 +00112 05 WRK-ESTB-DATE-TIME. DTSBX431 +00113 10 WRK-ESTB-CCYY PIC X(04) VALUE SPACES. DTSBX431 +00114 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 +00115 10 WRK-ESTB-MO PIC X(02) VALUE SPACES. DTSBX431 +00116 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 +00117 10 WRK-ESTB-DD PIC X(02) VALUE SPACES. DTSBX431 +00118 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 +00119 10 WRK-ESTB-HH PIC X(02) VALUE SPACES. DTSBX431 +00120 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 +00121 10 WRK-ESTB-MM PIC X(02) VALUE SPACES. DTSBX431 +00122 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 +00123 10 WRK-ESTB-SS PIC X(02) VALUE SPACES. DTSBX431 +00124 DTSBX431 +00125 05 WRK-DATE-X. DTSBX431 +00126 10 WRK-CCYY PIC X(04) VALUE SPACES. DTSBX431 +00127 10 WRK-MO PIC X(02) VALUE SPACES. DTSBX431 +00128 10 WRK-DD PIC X(02) VALUE SPACES. DTSBX431 +00129 05 WRK-DATE-9 REDEFINES WRK-DATE-X DTSBX431 +00130 PIC 9(08). DTSBX431 +00131 05 WRK-TIME-X. DTSBX431 +00132 10 WRK-HH PIC X(02) VALUE SPACES. DTSBX431 +00133 10 WRK-MM PIC X(02) VALUE SPACES. DTSBX431 +00134 10 WRK-SS PIC X(02) VALUE SPACES. DTSBX431 +00135 05 WRK-TIME-9 REDEFINES WRK-TIME-X DTSBX431 +00136 PIC 9(06). DTSBX431 +00137 DTSBX431 +00138 05 WRK-DIFFERENCE PIC S9(08) COMP VALUE +0. DTSBX431 +00139 DTSBX431 +00140 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX431 +00141 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX431 +00142 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX431 +00143 DTSBX431 +00144 05 W-MNTE-TEXT-CNT PIC S9(04) COMP VALUE +0. DTSBX431 +00145 05 W-MNTE-TEXT-MAX PIC S9(04) COMP VALUE +16. DTSBX431 +00146 05 W-MNTE-TEXT-AREA. DTSBX431 +00147 10 W-MNTE-TEXT OCCURS 16 TIMES DTSBX431 +00148 PIC X(72). DTSBX431 +00149 DTSBX431 +00150 05 TSUB1 PIC S9(04) COMP. DTSBX431 +00151 05 TSUB2 PIC S9(04) COMP. DTSBX431 +00152 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX431 +00153 05 W-TEXT-CNT PIC S9(04) COMP. DTSBX431 +00154 DTSBX431 +00155 05 W-MNTE-LINE PIC X(72). DTSBX431 +00156 DTSBX431 +00157 05 W-CASE-TYPE PIC X(09). DTSBX431 +00158 88 W-CASE-TYPE-COLL-88 DTSBX431 +00159 VALUE 'COLLECT: '. DTSBX431 +00160 88 W-CASE-TYPE-RPT-88 DTSBX431 +00161 VALUE 'RPT DEL: '. DTSBX431 +00162 DTSBX431 +00163 05 W-CASE-NO PIC S9(09) COMP-3. DTSBX431 +00164 05 W-CASE-NO-X PIC X(09). DTSBX431 +00165 05 W-CASE-NO-9 REDEFINES W-CASE-NO-X DTSBX431 +00166 PIC 9(09). DTSBX431 +00167 05 W-LEN-X PIC X(04). DTSBX431 +00168 05 W-LEN-9 REDEFINES W-LEN-X DTSBX431 +00169 PIC 9(04). DTSBX431 +00170 DTSBX431 +00171 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSBX431 +00172 VALUE +0. DTSBX431 +00173 05 W-DIGIT PIC 9. DTSBX431 +00174 05 W-AMT PIC S9(09)V99 COMP-3 DTSBX431 +00175 VALUE +0. DTSBX431 +00176 05 SUB PIC S9(04) COMP. DTSBX431 +00177 DTSBX431 +00178 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX431 +00179 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX431 +00180 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX431 +00181 DTSBX431 +00182 05 W-SLASH-DATE PIC X(10). DTSBX431 +00183 05 FILLER REDEFINES W-SLASH-DATE. DTSBX431 +00184 10 W-SLASH-DT-MM PIC X(02). DTSBX431 +00185 10 FILLER PIC X(01). DTSBX431 +00186 10 W-SLASH-DT-DD PIC X(02). DTSBX431 +00187 10 FILLER PIC X(01). DTSBX431 +00188 10 W-SLASH-DT-CCYY PIC X(04). DTSBX431 +00189 DTSBX431 +00190 05 W-SLASH-QTR PIC X(06). DTSBX431 +00191 05 FILLER REDEFINES W-SLASH-QTR. DTSBX431 +00192 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX431 +00193 10 FILLER PIC X(01). DTSBX431 +00194 10 W-SLASH-QTR-Q PIC X(01). DTSBX431 +00195 DTSBX431 +00196 05 ISUB1 PIC S9(04) COMP. DTSBX431 +00197 05 ISUB2 PIC S9(04) COMP. DTSBX431 +00198 05 ISUB3 PIC S9(04) COMP. DTSBX431 +00199 05 ISUB4 PIC S9(04) COMP. DTSBX431 +00200 05 ISUB5 PIC S9(04) COMP. DTSBX431 +00201 05 ISUB6 PIC S9(04) COMP. DTSBX431 +00202 05 W-SLASH1 PIC S9(04) COMP. DTSBX431 +00203 05 W-SLASH2 PIC S9(04) COMP. DTSBX431 +00204 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX431 +00205 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX431 +00206 05 W-LAST-FIELD-LEN PIC S9(04) COMP-3. DTSBX431 +00207 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX431 +00208 VALUE +1154. DTSBX431 +00209 05 W-INPUT-LINE PIC X(1152). DTSBX431 +00210 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX431 +00211 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX431 +00212 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX431 +00213 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX431 +00214 05 W-CONV-LINE PIC X(32). DTSBX431 +00215 DTSBX431 +00216 05 W-MDY PIC X(04). DTSBX431 +00217 05 FILLER REDEFINES W-MDY. DTSBX431 +00218 10 FILLER PIC X(02). DTSBX431 +00219 10 W-MDY-X-2 PIC X(02). DTSBX431 +00220 10 FILLER REDEFINES W-MDY-X-2. DTSBX431 +00221 15 FILLER PIC X(01). DTSBX431 +00222 15 W-MDY-X-1 PIC X(01). DTSBX431 +00223 DTSBX431 +00224 05 AMT-DISP1 PIC 9(09). DTSBX431 +00225 DTSBX431 +00226 01 L001-LINK-AREA. DTSBX431 +00227 ++INCLUDE DTSIL001 DTSBX431 +00228 DTSBX431 +00229 01 WRK-WEB-DLQ-REC. DTSBX431 +00230 ++INCLUDE DTSIX431 DTSBX431 +00231 SKIP3 DTSBX431 +00232 01 T003-REC. DTSBX431 +00233 ++INCLUDE DTSIT003 DTSBX431 +00234 EJECT DTSBX431 +00235 01 L005-LINK-AREA. DTSBX431 +00236 ++INCLUDE DTSIL005 DTSBX431 +00237 EJECT DTSBX431 +00238 01 L910-LINK-AREA. DTSBX431 +00239 ++INCLUDE DTSIL910 DTSBX431 +00240 EJECT DTSBX431 +00241 01 MSKL-REC. DTSBX431 +00242 ++INCLUDE DTSIMSKL DTSBX431 +00243 EJECT DTSBX431 +00244 01 MPRF-REC. DTSBX431 +00245 ++INCLUDE DTSIMPRF DTSBX431 +00246 EJECT DTSBX431 +00247 01 MNTE-REC. DTSBX431 +00248 ++INCLUDE DTSIMNTE DTSBX431 +00249 EJECT DTSBX431 +00250 01 MEVL-REC. DTSBX431 +00251 ++INCLUDE DTSIMEVL DTSBX431 +00252 EJECT DTSBX431 +00253 01 L921-LINK-AREA. DTSBX431 +00254 ++INCLUDE DTSIL921 DTSBX431 +00255 EJECT DTSBX431 +00256 01 ISKL-REC. DTSBX431 +00257 ++INCLUDE DTSIISKL DTSBX431 +00258 EJECT DTSBX431 +00259 01 L927-LINK-AREA. DTSBX431 +00260 ++INCLUDE DTSIL927 DTSBX431 +00261 EJECT DTSBX431 +00262 01 TSKL-REC. DTSBX431 +00263 ++INCLUDE DTSITSKL DTSBX431 +00264 EJECT DTSBX431 +00265 PROCEDURE DIVISION. DTSBX431 +00266 DTSBX431 +00267 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX431 +00268 DTSBX431 +00269 DTSBX431 +00270 MOVE +0 TO WRK-EMP-NO. DTSBX431 +00271 DTSBX431 +00272 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX431 +00273 UNTIL WEB-DLQ-STATUS-EOF-88. DTSBX431 +00274 DTSBX431 +00275 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX431 +00276 DTSBX431 +00277 GOBACK. DTSBX431 +00278 EJECT DTSBX431 +00279 DTSBX431 +00280 I0000-INITIATE. DTSBX431 +00281 DTSBX431 +00282 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX431 +00283 ** PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBX431 +00284 * DTSBX431 +00285 ** PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBX431 +00286 DTSBX431 +00287 OPEN INPUT WEB-DLQ-FILE. DTSBX431 +00288 DTSBX431 +00289 IF NOT WEB-DLQ-STATUS-OK-88 DTSBX431 +00290 MOVE 'CANNOT OPEN WEB-DLQ-FILE ' TO ABEND-MSG DTSBX431 +00291 PERFORM S999-ABEND THRU S999-EXIT DTSBX431 +00292 GO TO I0000-EXIT DTSBX431 +00293 END-IF. DTSBX431 +00294 DTSBX431 +00295 MOVE 'N' TO L927-TRACE-IND. DTSBX431 +00296 MOVE W-MOD-NAME TO L927-MOD-NAME. DTSBX431 +00297 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBX431 +00298 DTSBX431 +00299 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX431 +00300 MOVE L005-DATE TO WRK-SYS-DATE. DTSBX431 +00301 MOVE L005-TIME TO WRK-SYS-TIME. DTSBX431 +00302 DTSBX431 +00303 MOVE +0 TO WRK-WRITE-MEVL-CNT DTSBX431 +00304 WRK-WRITE-MNTE-CNT DTSBX431 +00305 WRK-WEB-REC-CNT. DTSBX431 +00306 DTSBX431 +00307 MOVE +9 TO W-LAST-FIELD. DTSBX431 +00308 ** MOVE +1152 TO W-LAST-FIELD-LEN. DTSBX431 +00309 DTSBX431 +00310 I0000-EXIT. DTSBX431 +00311 EXIT. DTSBX431 +00312 DTSBX431 +00313 P0000-PROCESS. DTSBX431 +00314 READ WEB-DLQ-FILE. DTSBX431 +00315 IF NOT WEB-DLQ-STATUS-OK-88 DTSBX431 +00316 DISPLAY 'NO RECORDS IN INPUT FILE ' WEB-DLQ-STATUS DTSBX431 +00317 GO TO P0000-EXIT DTSBX431 +00318 ELSE DTSBX431 +00319 ADD +1 TO WRK-WEB-REC-CNT DTSBX431 +00320 PERFORM UNTIL WEB-DLQ-STATUS-EOF-88 DTSBX431 +00321 INITIALIZE WRK-WEB-DLQ-REC DTSBX431 +00322 PERFORM S2000-PARSE THRU S2000-EXIT DTSBX431 +00323 SET WRK-MPRF-FOUND-NO-88 TO TRUE DTSBX431 +00324 PERFORM P0100-FIND-MPRF THRU P0100-EXIT DTSBX431 +00325 IF WRK-MPRF-FOUND-YES-88 DTSBX431 +00326 PERFORM P1000-WRITE-MNTE-RECORD THRU P1000-EXIT DTSBX431 +00327 PERFORM P2000-WRITE-MEVL-RECORD THRU P2000-EXIT DTSBX431 +00328 END-IF DTSBX431 +00329 READ WEB-DLQ-FILE DTSBX431 +00330 END-PERFORM DTSBX431 +00331 END-IF. DTSBX431 +00332 DTSBX431 +00333 P0000-EXIT. DTSBX431 +00334 EXIT. DTSBX431 +00335 DTSBX431 +00336 P0100-FIND-MPRF. DTSBX431 +00337 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX431 +00338 MOVE X431-EMP-NO TO MSKL-EMP-NO. DTSBX431 +00339 SET MSKL-PRF-88 TO TRUE. DTSBX431 +00340 DTSBX431 +00341 PERFORM S910-READ THRU S910-EXIT. DTSBX431 +00342 IF L910-NO-REC-88 DTSBX431 +00343 DISPLAY 'EMPLOYER NOT ON FILE: ' X431-EMP-NO DTSBX431 +00344 ELSE DTSBX431 +00345 MOVE MSKL-REC TO MPRF-REC DTSBX431 +00346 SET WRK-MPRF-FOUND-YES-88 TO TRUE DTSBX431 +00347 END-IF. DTSBX431 +00348 DTSBX431 +00349 P0100-EXIT. DTSBX431 +00350 EXIT. DTSBX431 +00351 DTSBX431 +00352 P1000-WRITE-MNTE-RECORD. DTSBX431 +00353 MOVE X431-ESTB-DATE TO L001-SLASH-8-DATE. DTSBX431 +00354 MOVE L001-SLASH-8-MO TO L001-FED-8-MO. DTSBX431 +00355 MOVE L001-SLASH-8-DA TO L001-FED-8-DA. DTSBX431 +00356 MOVE L001-SLASH-8-YR TO L001-FED-8-YR. DTSBX431 +00357 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX431 +00358 DTSBX431 +00359 MOVE LOW-VALUES TO MNTE-REC. DTSBX431 +00360 MOVE X431-EMP-NO TO MNTE-EMP-NO. DTSBX431 +00361 SET MNTE-NTE-88 TO TRUE. DTSBX431 +00362 DTSBX431 +00363 MOVE ZERO TO MNTE-DATA-ESTB-ABSTIME DTSBX431 +00364 MNTE-CHNG-ABSTIME. DTSBX431 +00365 MOVE L001-FED-8-DATE-9 TO MNTE-ESTB-DATE DTSBX431 +00366 MNTE-CHNG-DATE. DTSBX431 +00367 DTSBX431 +00368 DISPLAY 'MNTE ' MNTE-EMP-NO. DTSBX431 +00369 MOVE X431-OPID TO MNTE-ESTB-OP-ID DTSBX431 +00370 MNTE-CHNG-OP-ID. DTSBX431 +00371 DTSBX431 +00372 MOVE +0 TO MNTE-PURGE-DATE. DTSBX431 +00373 DTSBX431 +00374 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX431 +00375 DTSBX431 +00376 EVALUATE TRUE DTSBX431 +00377 WHEN X431-RPT-DELINQ-88 DTSBX431 +00378 SET W-CASE-TYPE-RPT-88 TO TRUE DTSBX431 +00379 WHEN X431-COLLECTIONS-88 DTSBX431 +00380 SET W-CASE-TYPE-COLL-88 TO TRUE DTSBX431 +00381 END-EVALUATE. DTSBX431 +00382 DTSBX431 +00383 STRING DTSBX431 +00384 W-CASE-TYPE DTSBX431 +00385 X431-CASE-NO DTSBX431 +00386 DELIMITED BY SIZE DTSBX431 +00387 INTO MNTE-SUBJECT DTSBX431 +00388 END-STRING. DTSBX431 +00389 DTSBX431 +00390 MOVE X431-ACTION TO MNTE-TEXT (1). DTSBX431 +00391 INSPECT X431-RESULT REPLACING ALL ';' BY ','. DTSBX431 +00392 DTSBX431 +00393 MOVE +1 TO MNTE-TEXT-CNT. DTSBX431 +00394 PERFORM P1001-MOVE-TEXT THRU P1001-EXIT. DTSBX431 +00395 DTSBX431 +00396 MOVE LENGTH OF T003-REC TO T003-LENGTH. DTSBX431 +00397 MOVE '003' TO T003-REC-TYPE. DTSBX431 +00398 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBX431 +00399 MOVE 'CASE TRACK' TO T003-ORIGIN. DTSBX431 +00400 MOVE L005-DATE TO T003-SYS-DATE. DTSBX431 +00401 MOVE L005-TIME TO T003-SYS-TIME. DTSBX431 +00402 SET T003-ADD-MNTE-88 TO TRUE. DTSBX431 +00403 MOVE MNTE-REC TO T003-MNTE-REC. DTSBX431 +00404 DTSBX431 +00405 ** DISPLAY 'MNTE ' MNTE-EMP-NO ' ' MNTE-SUBJECT. DTSBX431 +00406 MOVE T003-REC TO TSKL-REC. DTSBX431 +00407 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX431 +00408 DTSBX431 +00409 ADD +1 TO WRK-WRITE-MNTE-CNT. DTSBX431 +00410 DTSBX431 +00411 P1000-EXIT. DTSBX431 +00412 EXIT. DTSBX431 +00413 DTSBX431 +00414 P1001-MOVE-TEXT. DTSBX431 +00415 SET W-MNTE-COMPLETE-NO-88 TO TRUE. DTSBX431 +00416 MOVE SPACES TO W-MNTE-LINE. DTSBX431 +00417 MOVE +0 TO W-LAST-SPACE DTSBX431 +00418 TSUB1 DTSBX431 +00419 TSUB2. DTSBX431 +00420 ** MNTE-TEXT-CNT. DTSBX431 +00421 PERFORM DTSBX431 +00422 UNTIL W-MNTE-COMPLETE-YES-88 DTSBX431 +00423 ADD +1 TO TSUB1 DTSBX431 +00424 IF TSUB1 <= +1152 DTSBX431 +00425 PERFORM P1001A-MOVE-DATA THRU P1001A-EXIT DTSBX431 +00426 ELSE DTSBX431 +00427 SET W-MNTE-COMPLETE-YES-88 TO TRUE DTSBX431 +00428 END-IF DTSBX431 +00429 END-PERFORM. DTSBX431 +00430 DTSBX431 +00431 P1001-EXIT. DTSBX431 +00432 EXIT. DTSBX431 +00433 DTSBX431 +00434 P1001A-MOVE-DATA. DTSBX431 +00435 IF TSUB2 < +72 DTSBX431 +00436 ADD +1 TO TSUB2 DTSBX431 +00437 MOVE X431-RESULT (TSUB1:1) DTSBX431 +00438 TO W-MNTE-LINE (TSUB2:1) DTSBX431 +00439 IF X431-RESULT (TSUB1:1) = SPACE DTSBX431 +00440 MOVE TSUB2 TO W-LAST-SPACE DTSBX431 +00441 END-IF DTSBX431 +00442 ELSE DTSBX431 +00443 PERFORM P1001B-RESET THRU P1001B-EXIT DTSBX431 +00444 IF W-MNTE-LINE NOT = SPACES DTSBX431 +00445 ADD +1 TO MNTE-TEXT-CNT DTSBX431 +00446 MOVE W-MNTE-LINE TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX431 +00447 MOVE SPACES TO W-MNTE-LINE DTSBX431 +00448 MOVE +0 TO W-LAST-SPACE DTSBX431 +00449 TSUB2 DTSBX431 +00450 DISPLAY 'MSG = ' MNTE-TEXT (MNTE-TEXT-CNT) DTSBX431 +00451 ELSE DTSBX431 +00452 MOVE +0 TO W-LAST-SPACE DTSBX431 +00453 TSUB2 DTSBX431 +00454 END-IF DTSBX431 +00455 END-IF. DTSBX431 +00456 DTSBX431 +00457 ** DISPLAY 'A ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX431 +00458 DTSBX431 +00459 P1001A-EXIT. DTSBX431 +00460 EXIT. DTSBX431 +00461 DTSBX431 +00462 P1001B-RESET. DTSBX431 +00463 * DISPLAY 'B1 ' W-LAST-SPACE ' ' TSUB1 ' ' TSUB2. DTSBX431 +00464 ************* DTSBX431 +00465 * EXIT IF THE LAST LETTER MOVED IS A SPACE, OR IF THE CURRENT DTSBX431 +00466 * LINE DOES NOT CONTAIN ANY SPACES. DTSBX431 +00467 ************* DTSBX431 +00468 IF W-MNTE-LINE (72:1) = SPACE DTSBX431 +00469 SUBTRACT +1 FROM TSUB1 DTSBX431 +00470 GO TO P1001B-EXIT DTSBX431 +00471 END-IF. DTSBX431 +00472 DTSBX431 +00473 IF W-LAST-SPACE = ZERO DTSBX431 +00474 GO TO P1001B-EXIT DTSBX431 +00475 END-IF. DTSBX431 +00476 DTSBX431 +00477 ************* DTSBX431 +00478 * REPLACE THE LAST LETTERS WRITTEN (OCCURRING IN THE MIDDLE OF DTSBX431 +00479 * A WORD) WITH SPACES. DTSBX431 +00480 ************* DTSBX431 +00481 PERFORM DTSBX431 +00482 VARYING TSUB2 FROM W-LAST-SPACE BY +1 DTSBX431 +00483 UNTIL TSUB2 > +72 DTSBX431 +00484 MOVE SPACE TO W-MNTE-LINE (TSUB2:1) DTSBX431 +00485 END-PERFORM. DTSBX431 +00486 DTSBX431 +00487 ************* DTSBX431 +00488 * RESET TSUB1 TO POINT TO THE FIRST LETTER OF THE INCOMPLETED DTSBX431 +00489 * WORD. DTSBX431 +00490 ************* DTSBX431 +00491 COMPUTE TSUB1 = TSUB1 - (73 - W-LAST-SPACE). DTSBX431 +00492 DTSBX431 +00493 ** DISPLAY 'B2 ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX431 +00494 DTSBX431 +00495 P1001B-EXIT. DTSBX431 +00496 EXIT. DTSBX431 +00497 DTSBX431 +00498 P2000-WRITE-MEVL-RECORD. DTSBX431 +00499 MOVE X431-ESTB-DATE TO L001-SLASH-8-DATE. DTSBX431 +00500 MOVE L001-SLASH-8-MO TO L001-FED-8-MO. DTSBX431 +00501 MOVE L001-SLASH-8-DA TO L001-FED-8-DA. DTSBX431 +00502 MOVE L001-SLASH-8-YR TO L001-FED-8-YR. DTSBX431 +00503 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX431 +00504 DTSBX431 +00505 MOVE LOW-VALUES TO MEVL-REC. DTSBX431 +00506 MOVE X431-EMP-NO TO MEVL-EMP-NO. DTSBX431 +00507 SET MEVL-EVL-88 TO TRUE. DTSBX431 +00508 DTSBX431 +00509 EVALUATE TRUE DTSBX431 +00510 WHEN X431-RPT-DELINQ-88 DTSBX431 +00511 SET W-CASE-TYPE-RPT-88 TO TRUE DTSBX431 +00512 SET MEVL-BA-ACCOUNTING-88 TO TRUE DTSBX431 +00513 SET MEVL-ACT-CT-RPT-DEL-88 TO TRUE DTSBX431 +00514 WHEN X431-COLLECTIONS-88 DTSBX431 +00515 SET W-CASE-TYPE-COLL-88 TO TRUE DTSBX431 +00516 SET MEVL-BA-COLLECTIONS-88 TO TRUE DTSBX431 +00517 SET MEVL-ACT-CT-COLLECT-88 TO TRUE DTSBX431 +00518 END-EVALUATE. DTSBX431 +00519 DTSBX431 +00520 STRING DTSBX431 +00521 W-CASE-TYPE DTSBX431 +00522 X431-ACTION DTSBX431 +00523 DELIMITED BY SIZE DTSBX431 +00524 INTO MEVL-TEXT DTSBX431 +00525 END-STRING. DTSBX431 +00526 DTSBX431 +00527 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBX431 +00528 DTSBX431 +00529 MOVE X431-OPID TO MEVL-SOURCE. DTSBX431 +00530 DTSBX431 +00531 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBX431 +00532 DTSBX431 +00533 MOVE ZERO TO MEVL-DATE DTSBX431 +00534 MEVL-TIME. DTSBX431 +00535 MOVE L001-FED-8-DATE-9 TO MEVL-ESTB-DATE DTSBX431 +00536 MEVL-CHNG-DATE. DTSBX431 +00537 DTSBX431 +00538 MOVE LENGTH OF T003-REC TO T003-LENGTH. DTSBX431 +00539 MOVE '003' TO T003-REC-TYPE. DTSBX431 +00540 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBX431 +00541 MOVE 'CASE TRACK' TO T003-ORIGIN. DTSBX431 +00542 MOVE L005-DATE TO T003-SYS-DATE. DTSBX431 +00543 MOVE L005-TIME TO T003-SYS-TIME. DTSBX431 +00544 SET T003-ADD-MEVL-88 TO TRUE. DTSBX431 +00545 MOVE MEVL-REC TO T003-MEVL-REC. DTSBX431 +00546 DTSBX431 +00547 MOVE T003-REC TO TSKL-REC. DTSBX431 +00548 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX431 +00549 DTSBX431 +00550 ADD +1 TO WRK-WRITE-MEVL-CNT. DTSBX431 +00551 DTSBX431 +00552 P2000-EXIT. DTSBX431 +00553 EXIT. DTSBX431 +00554 DTSBX431 +00555 T0000-TERMINATE. DTSBX431 +00556 DISPLAY DTSBX431 +00557 '*** DTSBX431 TERMINATION STATISTICS'. DTSBX431 +00558 DTSBX431 +00559 DISPLAY ' '. DTSBX431 +00560 DTSBX431 +00561 DISPLAY DTSBX431 +00562 '*** NO OF WEB DELINQUENT INPUT RECORDS READ : ' DTSBX431 +00563 WRK-WEB-REC-CNT. DTSBX431 +00564 DTSBX431 +00565 DISPLAY ' '. DTSBX431 +00566 DTSBX431 +00567 DISPLAY DTSBX431 +00568 '*** NUMBER OF MNTE NOTE PAD RECORDS WRITTEN : ' DTSBX431 +00569 WRK-WRITE-MNTE-CNT. DTSBX431 +00570 DTSBX431 +00571 DISPLAY DTSBX431 +00572 '*** NUMBER OF MNTE RECS ALREADY EXISTED CNT : ' DTSBX431 +00573 WRK-YES-MNTE-REC-CNT. DTSBX431 +00574 DTSBX431 +00575 DISPLAY ' '. DTSBX431 +00576 DTSBX431 +00577 DISPLAY DTSBX431 +00578 '*** NUMBER OF MEVL EVENT LOG RECORDS WRITTEN: ' DTSBX431 +00579 WRK-WRITE-MEVL-CNT. DTSBX431 +00580 DTSBX431 +00581 DISPLAY DTSBX431 +00582 '*** NUMBER OF MEVL RECS ALREADY EXISTED CNT : ' DTSBX431 +00583 WRK-YES-MEVL-REC-CNT. DTSBX431 +00584 DTSBX431 +00585 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX431 +00586 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBX431 +00587 CLOSE WEB-DLQ-FILE. DTSBX431 +00588 DTSBX431 +00589 T0000-EXIT. DTSBX431 +00590 EXIT. DTSBX431 +00591 EJECT DTSBX431 +00592 DTSBX431 +00593 S001-FROM-FED-8. DTSBX431 +00594 SET L001-FROM-FED-8 TO TRUE. DTSBX431 +00595 GO TO S001-DATE. DTSBX431 +00596 DTSBX431 +00597 S001-DATE. DTSBX431 +00598 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX431 +00599 S001-EXIT. DTSBX431 +00600 EXIT. DTSBX431 +00601 DTSBX431 +00602 S005-FROM-SYS. DTSBX431 +00603 SET L005-FROM-SYS TO TRUE. DTSBX431 +00604 GO TO S005-ABSTIME. DTSBX431 +00605 DTSBX431 +00606 S005-FROM-ABSTIME. DTSBX431 +00607 SET L005-FROM-ABSTIME TO TRUE. DTSBX431 +00608 GO TO S005-ABSTIME. DTSBX431 +00609 DTSBX431 +00610 S005-FROM-DATE-TIME. DTSBX431 +00611 SET L005-FROM-DATE-TIME TO TRUE. DTSBX431 +00612 GO TO S005-ABSTIME. DTSBX431 +00613 DTSBX431 +00614 S005-ABSTIME. DTSBX431 +00615 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX431 +00616 DTSBX431 +00617 S005-EXIT. DTSBX431 +00618 EXIT. DTSBX431 +00619 DTSBX431 +00620 S910-OPEN-READ. DTSBX431 +00621 SET L910-OPEN-READ-88 TO TRUE. DTSBX431 +00622 GO TO S910-MSTR-CALL. DTSBX431 +00623 DTSBX431 +00624 S910-OPEN-UPDATE. DTSBX431 +00625 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX431 +00626 GO TO S910-MSTR-CALL. DTSBX431 +00627 DTSBX431 +00628 S910-READ. DTSBX431 +00629 SET L910-READ-88 TO TRUE. DTSBX431 +00630 GO TO S910-MSTR-CALL. DTSBX431 +00631 DTSBX431 +00632 S910-START-BROWSE. DTSBX431 +00633 SET L910-START-BROWSE-88 TO TRUE. DTSBX431 +00634 GO TO S910-MSTR-CALL. DTSBX431 +00635 DTSBX431 +00636 S910-READ-NEXT. DTSBX431 +00637 SET L910-READ-NEXT-88 TO TRUE. DTSBX431 +00638 GO TO S910-MSTR-CALL. DTSBX431 +00639 DTSBX431 +00640 S910-REWRITE. DTSBX431 +00641 SET L910-REWRITE-88 TO TRUE. DTSBX431 +00642 GO TO S910-MSTR-CALL. DTSBX431 +00643 DTSBX431 +00644 S910-WRITE. DTSBX431 +00645 SET L910-WRITE-88 TO TRUE. DTSBX431 +00646 GO TO S910-MSTR-CALL. DTSBX431 +00647 DTSBX431 +00648 S910-CLOSE. DTSBX431 +00649 SET L910-CLOSE-88 TO TRUE. DTSBX431 +00650 GO TO S910-MSTR-CALL. DTSBX431 +00651 DTSBX431 +00652 S910-MSTR-CALL. DTSBX431 +00653 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX431 +00654 MSKL-REC. DTSBX431 +00655 S910-EXIT. DTSBX431 +00656 EXIT. DTSBX431 +00657 DTSBX431 +00658 S921-OPEN-UPDATE. DTSBX431 +00659 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX431 +00660 GO TO S921-AIX-IO. DTSBX431 +00661 DTSBX431 +00662 S921-CLOSE. DTSBX431 +00663 SET L921-CLOSE-88 TO TRUE. DTSBX431 +00664 GO TO S921-AIX-IO. DTSBX431 +00665 DTSBX431 +00666 S921-AIX-IO. DTSBX431 +00667 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX431 +00668 ISKL-REC. DTSBX431 +00669 S921-EXIT. DTSBX431 +00670 EXIT. DTSBX431 +00671 DTSBX431 +00672 S927A-OPEN. DTSBX431 +00673 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX431 +00674 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX431 +00675 DTSBX431 +00676 S927A-EXIT. DTSBX431 +00677 EXIT. DTSBX431 +00678 DTSBX431 +00679 S927B-WRITE. DTSBX431 +00680 SET L927-WRITE-88 TO TRUE. DTSBX431 +00681 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX431 +00682 DTSBX431 +00683 S927B-EXIT. DTSBX431 +00684 EXIT. DTSBX431 +00685 DTSBX431 +00686 S927C-CLOSE. DTSBX431 +00687 SET L927-CLOSE-88 TO TRUE. DTSBX431 +00688 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX431 +00689 DTSBX431 +00690 S927C-EXIT. DTSBX431 +00691 EXIT. DTSBX431 +00692 DTSBX431 +00693 S927Z-IO. DTSBX431 +00694 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX431 +00695 TSKL-REC. DTSBX431 +00696 S927Z-EXIT. DTSBX431 +00697 EXIT. DTSBX431 +00698 DTSBX431 +00699 S2000-PARSE. DTSBX431 +00700 SET W-PARSE-COMPLETE-NO-88 TO TRUE. DTSBX431 +00701 MOVE +1 TO ISUB1. DTSBX431 +00702 MOVE +0 TO ISUB2. DTSBX431 +00703 MOVE +1 TO W-CURR-FIELD. DTSBX431 +00704 MOVE +0 TO W-LAST-FIELD-LEN. DTSBX431 +00705 DTSBX431 +00706 MOVE SPACES TO W-INPUT-LINE. DTSBX431 +00707 DTSBX431 +00708 PERFORM DTSBX431 +00709 UNTIL W-PARSE-COMPLETE-YES-88 DTSBX431 +00710 IF WEB-DLQ-REC (ISUB1:1) NOT = ',' DTSBX431 +00711 IF W-CURR-FIELD = W-LAST-FIELD DTSBX431 +00712 PERFORM S2010-LAST-FIELD THRU S2010-EXIT DTSBX431 +00713 ELSE DTSBX431 +00714 PERFORM S2020-MOVE-CHAR THRU S2020-EXIT DTSBX431 +00715 END-IF DTSBX431 +00716 ELSE DTSBX431 +00717 PERFORM S2100-MOVE-TO-REC THRU S2100-EXIT DTSBX431 +00718 ADD +1 TO W-CURR-FIELD DTSBX431 +00719 MOVE +0 TO ISUB2 DTSBX431 +00720 MOVE SPACES TO W-INPUT-LINE DTSBX431 +00721 IF WEB-DLQ-REC ((ISUB1 + 1):1) = ',' DTSBX431 +00722 ADD +1 TO ISUB1 DTSBX431 +00723 PERFORM S2100-MOVE-TO-REC THRU S2100-EXIT DTSBX431 +00724 ADD +1 TO W-CURR-FIELD DTSBX431 +00725 END-IF DTSBX431 +00726 END-IF DTSBX431 +00727 ADD +1 TO ISUB1 DTSBX431 +00728 IF ISUB1 > W-INPUT-LENGTH DTSBX431 +00729 SET W-PARSE-COMPLETE-YES-88 TO TRUE DTSBX431 +00730 END-IF DTSBX431 +00731 DTSBX431 +00732 END-PERFORM. DTSBX431 +00733 DTSBX431 +00734 PERFORM S2100-MOVE-TO-REC THRU S2100-EXIT. DTSBX431 +00735 MOVE SPACES TO W-INPUT-LINE. DTSBX431 +00736 ** DISPLAY X431-RESULT (1:80). DTSBX431 +00737 DTSBX431 +00738 S2000-EXIT. DTSBX431 +00739 EXIT. DTSBX431 +00740 DTSBX431 +00741 S2010-LAST-FIELD. DTSBX431 +00742 IF W-LAST-FIELD-LEN NOT NUMERIC DTSBX431 +00743 DISPLAY 'LEN NOT NUMERIC ' X431-EMP-NO DTSBX431 +00744 END-IF. DTSBX431 +00745 ADD +1 TO ISUB2 DTSBX431 +00746 IF ISUB2 > W-LAST-FIELD-LEN DTSBX431 +00747 OR WEB-DLQ-REC (ISUB1:1) = ',' DTSBX431 +00748 SET W-PARSE-COMPLETE-YES-88 TO TRUE DTSBX431 +00749 ELSE DTSBX431 +00750 MOVE WEB-DLQ-REC (ISUB1:1) DTSBX431 +00751 TO W-INPUT-LINE (ISUB2:1) DTSBX431 +00752 END-IF. DTSBX431 +00753 DTSBX431 +00754 S2010-EXIT. DTSBX431 +00755 EXIT. DTSBX431 +00756 DTSBX431 +00757 S2020-MOVE-CHAR. DTSBX431 +00758 ADD +1 TO ISUB2. DTSBX431 +00759 MOVE WEB-DLQ-REC (ISUB1:1) DTSBX431 +00760 TO W-INPUT-LINE (ISUB2:1). DTSBX431 +00761 DTSBX431 +00762 S2020-EXIT. DTSBX431 +00763 EXIT. DTSBX431 +00764 DTSBX431 +00765 S2100-MOVE-TO-REC. DTSBX431 +00766 EVALUATE TRUE DTSBX431 +00767 WHEN W-CURR-FIELD = 1 DTSBX431 +00768 MOVE W-INPUT-LINE (1:03) TO X431-REC-TYPE DTSBX431 +00769 DTSBX431 +00770 WHEN W-CURR-FIELD = 2 DTSBX431 +00771 MOVE W-INPUT-LINE (1:06) TO X431-EMP-NO DTSBX431 +00772 DTSBX431 +00773 WHEN W-CURR-FIELD = 3 DTSBX431 +00774 MOVE W-INPUT-LINE (1:02) TO X431-CASE-TYPE DTSBX431 +00775 DTSBX431 +00776 WHEN W-CURR-FIELD = 4 DTSBX431 +00777 MOVE +0 TO W-CASE-NO DTSBX431 +00778 MOVE +9 TO W-FIELD-LENGTH DTSBX431 +00779 PERFORM S2200-CONV-AMT THRU S2200-EXIT DTSBX431 +00780 MOVE W-CASE-NO TO X431-CASE-NO DTSBX431 +00781 DTSBX431 +00782 WHEN W-CURR-FIELD = 5 DTSBX431 +00783 MOVE W-INPUT-LINE (1:07) TO X431-OPID DTSBX431 +00784 DTSBX431 +00785 WHEN W-CURR-FIELD = 6 DTSBX431 +00786 MOVE +10 TO W-FIELD-LENGTH DTSBX431 +00787 PERFORM S2300-CONV-DATE THRU S2300-EXIT DTSBX431 +00788 MOVE W-INPUT-LINE (1:10) TO X431-ESTB-DATE DTSBX431 +00789 DTSBX431 +00790 WHEN W-CURR-FIELD = 7 DTSBX431 +00791 MOVE W-INPUT-LINE (1:50) TO X431-ACTION DTSBX431 +00792 DTSBX431 +00793 WHEN W-CURR-FIELD = 8 DTSBX431 +00794 ** DISPLAY 'FIELD 8 ' W-INPUT-LINE (1:10) DTSBX431 +00795 MOVE +0 TO W-CASE-NO DTSBX431 +00796 MOVE +4 TO W-FIELD-LENGTH DTSBX431 +00797 PERFORM S2200-CONV-AMT THRU S2200-EXIT DTSBX431 +00798 MOVE W-CASE-NO TO W-CASE-NO-9 DTSBX431 +00799 MOVE W-CASE-NO-X (1:4) TO W-LEN-X DTSBX431 +00800 MOVE W-LEN-9 TO W-LAST-FIELD-LEN DTSBX431 +00801 ** DISPLAY 'FIELD 8 - 2 ' W-LEN-X DTSBX431 +00802 ** DISPLAY 'S21 LEN ' W-LAST-FIELD-LEN DTSBX431 +00803 DTSBX431 +00804 WHEN W-CURR-FIELD = 9 DTSBX431 +00805 MOVE W-INPUT-LINE (1:W-LAST-FIELD-LEN) TO X431-RESULT DTSBX431 +00806 DTSBX431 +00807 END-EVALUATE. DTSBX431 +00808 DTSBX431 +00809 DTSBX431 +00810 S2100-EXIT. DTSBX431 +00811 EXIT. DTSBX431 +00812 DTSBX431 +00813 S2200-CONV-AMT. DTSBX431 +00814 MOVE W-INPUT-LINE (1:ISUB2) TO W-CONV-LINE. DTSBX431 +00815 MOVE ZEROS TO W-INPUT-LINE. DTSBX431 +00816 MOVE W-FIELD-LENGTH TO ISUB4. DTSBX431 +00817 DTSBX431 +00818 ** DISPLAY 'S2200 W-CONV-LINE ' W-CONV-LINE. DTSBX431 +00819 PERFORM DTSBX431 +00820 VARYING ISUB3 FROM ISUB2 BY -1 DTSBX431 +00821 UNTIL ISUB3 < +1 DTSBX431 +00822 IF ((W-CONV-LINE (ISUB3:1) >= '0' AND <= '9') DTSBX431 +00823 OR W-CONV-LINE (ISUB3:1) = '.') DTSBX431 +00824 MOVE W-CONV-LINE (ISUB3:1) DTSBX431 +00825 TO W-INPUT-LINE (ISUB4:1) DTSBX431 +00826 SUBTRACT +1 FROM ISUB4 DTSBX431 +00827 END-IF DTSBX431 +00828 END-PERFORM. DTSBX431 +00829 DTSBX431 +00830 MOVE W-INPUT-LINE (1:09) TO W-CASE-NO-X DTSBX431 +00831 PERFORM S2210-INTEGER THRU S2210-EXIT. DTSBX431 +00832 PERFORM S2220-FRACTION THRU S2220-EXIT. DTSBX431 +00833 DTSBX431 +00834 S2200-EXIT. DTSBX431 +00835 EXIT. DTSBX431 +00836 DTSBX431 +00837 S2210-INTEGER. DTSBX431 +00838 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX431 +00839 MOVE +1 TO W-MULTIPLIER. DTSBX431 +00840 DTSBX431 +00841 PERFORM DTSBX431 +00842 VARYING SUB FROM +9 BY -1 DTSBX431 +00843 UNTIL SUB < +1 DTSBX431 +00844 IF W-CASE-NO-X (SUB:1) = '.' DTSBX431 +00845 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX431 +00846 ELSE DTSBX431 +00847 IF W-DECIMAL-FOUND-YES-88 DTSBX431 +00848 MOVE W-CASE-NO-X (SUB:1) TO W-DIGIT DTSBX431 +00849 COMPUTE W-AMT = (W-DIGIT * W-MULTIPLIER) DTSBX431 +00850 COMPUTE W-CASE-NO = (W-CASE-NO + W-AMT) DTSBX431 +00851 COMPUTE W-MULTIPLIER = (W-MULTIPLIER * 10) DTSBX431 +00852 END-IF DTSBX431 +00853 END-IF DTSBX431 +00854 END-PERFORM. DTSBX431 +00855 DTSBX431 +00856 IF W-DECIMAL-FOUND-NO-88 DTSBX431 +00857 PERFORM DTSBX431 +00858 VARYING SUB FROM +9 BY -1 DTSBX431 +00859 UNTIL SUB < +1 DTSBX431 +00860 MOVE W-CASE-NO-X (SUB:1) TO W-DIGIT DTSBX431 +00861 COMPUTE W-AMT = (W-DIGIT * W-MULTIPLIER) DTSBX431 +00862 COMPUTE W-CASE-NO = (W-CASE-NO + W-AMT) DTSBX431 +00863 COMPUTE W-MULTIPLIER = (W-MULTIPLIER * 10) DTSBX431 +00864 MOVE W-CASE-NO TO AMT-DISP1 DTSBX431 +00865 END-PERFORM DTSBX431 +00866 END-IF. DTSBX431 +00867 DTSBX431 +00868 S2210-EXIT. DTSBX431 +00869 EXIT. DTSBX431 +00870 DTSBX431 +00871 S2220-FRACTION. DTSBX431 +00872 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX431 +00873 MOVE +0.1 TO W-MULTIPLIER. DTSBX431 +00874 DTSBX431 +00875 PERFORM DTSBX431 +00876 VARYING SUB FROM +1 BY +1 DTSBX431 +00877 UNTIL SUB > +9 DTSBX431 +00878 IF W-CASE-NO-X (SUB:1) = '.' DTSBX431 +00879 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX431 +00880 ELSE DTSBX431 +00881 IF W-DECIMAL-FOUND-YES-88 DTSBX431 +00882 MOVE W-CASE-NO-X (SUB:1) TO W-DIGIT DTSBX431 +00883 COMPUTE W-AMT = (W-DIGIT * W-MULTIPLIER) DTSBX431 +00884 COMPUTE W-CASE-NO = (W-CASE-NO + W-AMT) DTSBX431 +00885 COMPUTE W-MULTIPLIER = (W-MULTIPLIER / 10) DTSBX431 +00886 END-IF DTSBX431 +00887 END-IF DTSBX431 +00888 END-PERFORM. DTSBX431 +00889 DTSBX431 +00890 S2220-EXIT. DTSBX431 +00891 EXIT. DTSBX431 +00892 DTSBX431 +00893 S2300-CONV-DATE. DTSBX431 +00894 IF W-INPUT-LINE = SPACES DTSBX431 +00895 GO TO S2300-EXIT DTSBX431 +00896 END-IF. DTSBX431 +00897 DTSBX431 +00898 MOVE W-INPUT-LINE (1:ISUB2) TO W-CONV-LINE. DTSBX431 +00899 MOVE ZEROS TO L001-SLASH-8-MO DTSBX431 +00900 L001-SLASH-8-DA DTSBX431 +00901 L001-SLASH-8-YR. DTSBX431 +00902 DTSBX431 +00903 MOVE ZEROS TO W-MDY. DTSBX431 +00904 DTSBX431 +00905 **************************************************** DTSBX431 +00906 * GET LOCATION OF SLASHES IN DATE DTSBX431 +00907 **************************************************** DTSBX431 +00908 MOVE +0 TO W-SLASH1 DTSBX431 +00909 W-SLASH2. DTSBX431 +00910 DTSBX431 +00911 PERFORM DTSBX431 +00912 VARYING ISUB3 FROM +1 BY +1 DTSBX431 +00913 UNTIL ISUB3 > ISUB2 DTSBX431 +00914 OR W-SLASH2 > ZERO DTSBX431 +00915 IF W-CONV-LINE (ISUB3:1) = '/' DTSBX431 +00916 IF W-SLASH1 = ZERO DTSBX431 +00917 MOVE ISUB3 TO W-SLASH1 DTSBX431 +00918 ELSE DTSBX431 +00919 MOVE ISUB3 TO W-SLASH2 DTSBX431 +00920 END-IF DTSBX431 +00921 END-IF DTSBX431 +00922 END-PERFORM. DTSBX431 +00923 DTSBX431 +00924 **************************************************** DTSBX431 +00925 * GET MONTH DTSBX431 +00926 **************************************************** DTSBX431 +00927 IF W-SLASH1 = 3 DTSBX431 +00928 MOVE W-CONV-LINE (1:2) TO W-MDY-X-2 DTSBX431 +00929 ELSE DTSBX431 +00930 IF W-SLASH1 = 2 DTSBX431 +00931 MOVE W-CONV-LINE (1:1) TO W-MDY-X-1 DTSBX431 +00932 END-IF DTSBX431 +00933 END-IF. DTSBX431 +00934 DTSBX431 +00935 IF (W-MDY-X-2 (1:1) >= '0' AND <= '9') DTSBX431 +00936 AND (W-MDY-X-2 (2:1) >= '0' AND <= '9') DTSBX431 +00937 MOVE W-MDY-X-2 TO L001-SLASH-8-MO DTSBX431 +00938 ELSE DTSBX431 +00939 MOVE ZEROS TO L001-SLASH-8-MO DTSBX431 +00940 END-IF. DTSBX431 +00941 DTSBX431 +00942 **************************************************** DTSBX431 +00943 * GET DAY DTSBX431 +00944 **************************************************** DTSBX431 +00945 MOVE ZEROS TO W-MDY. DTSBX431 +00946 IF W-SLASH1 = 3 DTSBX431 +00947 IF W-SLASH2 = 6 DTSBX431 +00948 MOVE W-CONV-LINE (4:2) TO W-MDY-X-2 DTSBX431 +00949 ELSE DTSBX431 +00950 IF W-SLASH2 = 5 DTSBX431 +00951 MOVE W-CONV-LINE (4:1) TO W-MDY-X-1 DTSBX431 +00952 END-IF DTSBX431 +00953 END-IF DTSBX431 +00954 ELSE DTSBX431 +00955 IF W-SLASH1 = 2 DTSBX431 +00956 IF W-SLASH2 = 5 DTSBX431 +00957 MOVE W-CONV-LINE (3:2) TO W-MDY-X-2 DTSBX431 +00958 ELSE DTSBX431 +00959 IF W-SLASH2 = 4 DTSBX431 +00960 MOVE W-CONV-LINE (3:1) TO W-MDY-X-1 DTSBX431 +00961 END-IF DTSBX431 +00962 END-IF DTSBX431 +00963 END-IF DTSBX431 +00964 END-IF. DTSBX431 +00965 DTSBX431 +00966 IF (W-MDY-X-2 (1:1) >= '0' AND <= '9') DTSBX431 +00967 AND (W-MDY-X-2 (2:1) >= '0' AND <= '9') DTSBX431 +00968 MOVE W-MDY-X-2 TO L001-SLASH-8-DA DTSBX431 +00969 ELSE DTSBX431 +00970 MOVE ZEROS TO L001-SLASH-8-DA DTSBX431 +00971 END-IF. DTSBX431 +00972 DTSBX431 +00973 **************************************************** DTSBX431 +00974 * GET YEAR DTSBX431 +00975 **************************************************** DTSBX431 +00976 MOVE ZEROS TO W-MDY. DTSBX431 +00977 MOVE +1 TO ISUB4. DTSBX431 +00978 COMPUTE ISUB5 = (W-SLASH2 + 1). DTSBX431 +00979 COMPUTE ISUB6 = (ISUB5 + 4). DTSBX431 +00980 PERFORM DTSBX431 +00981 VARYING ISUB3 FROM ISUB5 BY +1 DTSBX431 +00982 UNTIL ISUB3 > ISUB6 DTSBX431 +00983 IF (W-CONV-LINE (ISUB3:1) >= '0' AND <= '9') DTSBX431 +00984 MOVE W-CONV-LINE (ISUB3:1) TO W-MDY (ISUB4:1) DTSBX431 +00985 ADD +1 TO ISUB4 DTSBX431 +00986 END-IF DTSBX431 +00987 END-PERFORM. DTSBX431 +00988 DTSBX431 +00989 MOVE W-MDY TO L001-SLASH-8-YR. DTSBX431 +00990 DTSBX431 +00991 MOVE L001-SLASH-8-DATE TO W-INPUT-LINE (1:10). DTSBX431 +00992 DTSBX431 +00993 S2300-EXIT. DTSBX431 +00994 EXIT. DTSBX431 +00995 DTSBX431 +00996 S999-ABEND. DTSBX431 +00997 DISPLAY '*** DTSBX431 ABENDING. ' DTSBX431 +00998 ABEND-MSG WEB-DLQ-STATUS. DTSBX431 +00999 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX431 +01000 S999-EXIT. DTSBX431 +01001 EXIT. DTSBX431 diff --git a/Batch/DTSBX436.cob b/Batch/DTSBX436.cob new file mode 100644 index 0000000..9b4a598 --- /dev/null +++ b/Batch/DTSBX436.cob @@ -0,0 +1,2861 @@ +00001 IDENTIFICATION DIVISION. 03/04/20 +00002 PROGRAM-ID. DTSBX436. DTSBX436 +00003 AUTHOR. NGC. LV212 +00004 DATE-WRITTEN. APRIL 2005. DTSBX436 +00005 DATE-COMPILED. DTSBX436 +00006 SKIP3 DTSBX436 +00007 ***** DTSBX436 +00008 * DTSBX436 +00009 * >>> PROCESSING FOR WEB REPORTS AND WAGES NEEDS TO BE DTSBX436 +00010 * >>> MODIFIED TO CREATE BATCH AND ITEM NUMBERS. THEY DTSBX436 +00011 * >>> WILL EITHER BE GROUPED INTO ACCOUNTING BATCHES DTSBX436 +00012 * >>> IN THE WEB APPLICATION, OR CONTINUE TO GO THROUGH DTSBX436 +00013 * >>> DTSBD140. DTSBX436 +00014 * DTSBX436 +00015 * FUNCTION: EDIT REPORT DATA FROM WEB APPLICATION. DTSBX436 +00016 * DTSBX436 +00017 * MODIFICATION HISTORY: DTSBX436 +00018 * DTSBX436 +00019 * 04-05-2005 INITIAL DEVELOPMENT DTSBX436 +00020 * REFERENCE RFP: WEB REPORTING DTSBX436 +00021 * DTSBX436 +00022 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSBX436 +00023 * NEW RECORD INCLUDES EMPLOYEE NAME. DTSBX436 +00024 * REFERENCE RFP: WEB REPORTING. DTSBX436 +00025 * DTSBX436 +00026 * DTSBX436 +00027 * 10-21-2009 MODIFIED TO SEPARATE REPORT PROCESSING FROM DTSBX436 +00028 * NEW WAGE-ONLY PROCESSING. P5000 CHANGED TO DTSBX436 +00029 * DETERMINE WHETHER ONLY WAGES OR WAGES DTSBX436 +00030 * ASSOCIATED WITH A REPORT ARE PRESENT. DTSBX436 +00031 * IF ONLY WAGES ARE PRESENT, COPY THE DTSBX436 +00032 * TEMPORARY WAGE FILE TO THE OUTPUT WAGE FILE. DTSBX436 +00033 * IF PROCESSING A REPORT, VERIFY THAT THE REPORTED DTSBX436 +00034 * AMOUNTS MATCH THE CALCULATED AMOUNTS, AND COPY DTSBX436 +00035 * BOTH THE REPORT AND WAGE TEMPORARY FILES DTSBX436 +00036 * TO THE OUTPUT. DTSBX436 +00037 * REFERENCE RFP: MAG MEDIA WAGE ONLY GD DTSBX436 +00038 * DTSBX436 +00039 * 06-09-2010 MODIFIED FOR IN-HOUSE CASHIERING. DTSBX436 +00040 * REFERENCE RFP: IN-HOUSE CASHIERING GD DTSBX436 +00041 * DTSBX436 +00042 * 11-10-2010 MODIFIED FOR WEB REPORTING. GD DTSBX436 +00043 * DTSBX436 +00044 * DTSBX436 +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 ***** DTSBX436 +00052 SKIP3 DTSBX436 +00053 ENVIRONMENT DIVISION. DTSBX436 +00054 CL122 +00055 CONFIGURATION SECTION. CL122 +00056 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL122 +00057 CL122 +00058 INPUT-OUTPUT SECTION. DTSBX436 +00059 DTSBX436 +00060 FILE-CONTROL. DTSBX436 +00061 DTSBX436 +00062 SELECT TEMP-BTC-FILE ASSIGN TO X436BTC CL170 +00063 FILE STATUS IS TEMP-BTC-STATUS. DTSBX436 +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-X145-FILE ASSIGN TO PENDX145 CL*59 +00072 FILE STATUS IS PAYT-145-STATUS. CL*63 +00073 CL*59 +00074 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSBX436 +00075 FILE STATUS IS WAGE-TEMP-STATUS. DTSBX436 +00076 DTSBX436 +00077 SELECT WAGE-FILE-OUT ASSIGN TO DTSFW4GE CL*22 +00078 FILE STATUS IS WAGE-OUT-STATUS. CL*20 +00079 DTSBX436 +00080 SELECT BATCH-XREF-FILE ASSIGN TO BX214422 DTSBX436 +00081 FILE STATUS IS BATCH-XREF-STATUS. DTSBX436 +00082 CL119 +00083 SELECT REPT-PAID-FILE ASSIGN TO X436RPT1 CL170 +00084 FILE STATUS IS REPT-STATUS. CL119 +00085 CL119 +00086 SELECT REPT-PEND-FILE ASSIGN TO X436RPT2 CL170 +00087 FILE STATUS IS REPT-STATUS. CL119 +00088 CL119 +00089 DTSBX436 +00090 DATA DIVISION. DTSBX436 +00091 DTSBX436 +00092 FILE SECTION. DTSBX436 +00093 DTSBX436 +00094 FD TEMP-BTC-FILE DTSBX436 +00095 RECORDING MODE IS V DTSBX436 +00096 BLOCK CONTAINS 0 RECORDS. DTSBX436 +00097 DTSBX436 +00098 01 TEMP-BTC-REC. DTSBX436 +00099 ++INCLUDE DTSIRVAR DTSBX436 +00100 DTSBX436 +00101 01 TSKL-REC. DTSBX436 +00102 ++INCLUDE DTSITSKL DTSBX436 +00103 DTSBX436 +00104 FD WAGE-FILE-TEMP DTSBX436 +00105 RECORDING MODE IS F DTSBX436 +00106 BLOCK CONTAINS 0 RECORDS DTSBX436 +00107 LABEL RECORDS ARE OMITTED. DTSBX436 +00108 DTSBX436 +00109 01 WAGE-TEMP-REC PIC X(128). DTSBX436 +00110 DTSBX436 +00111 FD WAGE-FILE-OUT CL*20 +00112 RECORDING MODE IS F CL*20 +00113 BLOCK CONTAINS 0 RECORDS CL*20 +00114 LABEL RECORDS ARE OMITTED. CL*20 +00115 DTSBX436 +00116 01 WAGE-OUT-REC PIC X(80). CL*20 +00117 DTSBX436 +00118 FD BATCH-XREF-FILE DTSBX436 +00119 RECORDING MODE IS F DTSBX436 +00120 BLOCK CONTAINS 0 RECORDS DTSBX436 +00121 LABEL RECORDS ARE OMITTED. DTSBX436 +00122 DTSBX436 +00123 01 BATCH-XREF-REC PIC X(30). DTSBX436 +00124 CL*11 +00125 CL*59 +00126 FD PEND-X140-FILE CL*59 +00127 RECORDING MODE IS F CL*59 +00128 BLOCK CONTAINS 0 RECORDS CL*59 +00129 LABEL RECORDS ARE OMITTED. CL*59 +00130 CL*59 +00131 01 PEND-X140-REC PIC X(512). CL*59 +00132 DTSBX436 +00133 FD PEND-X144-FILE CL*59 +00134 RECORDING MODE IS F CL*59 +00135 BLOCK CONTAINS 0 RECORDS CL*59 +00136 LABEL RECORDS ARE OMITTED. CL*59 +00137 CL*59 +00138 01 PEND-X144-REC PIC X(512). CL*59 +00139 CL*59 +00140 FD PEND-X145-FILE CL*59 +00141 RECORDING MODE IS F CL*59 +00142 BLOCK CONTAINS 0 RECORDS CL*59 +00143 LABEL RECORDS ARE OMITTED. CL*59 +00144 CL*59 +00145 01 PEND-X145-REC PIC X(512). CL*59 +00146 CL119 +00147 FD REPT-PAID-FILE CL119 +00148 RECORDING MODE IS F CL119 +00149 BLOCK CONTAINS 0 RECORDS CL119 +00150 LABEL RECORDS ARE OMITTED. CL119 +00151 CL119 +00152 01 REPT-PAID-REC PIC X(133). CL121 +00153 CL119 +00154 CL119 +00155 FD REPT-PEND-FILE CL119 +00156 RECORDING MODE IS F CL119 +00157 BLOCK CONTAINS 0 RECORDS CL119 +00158 LABEL RECORDS ARE OMITTED. CL119 +00159 CL119 +00160 01 REPT-PEND-REC PIC X(133). CL119 +00161 CL119 +00162 CL*59 +00163 WORKING-STORAGE SECTION. DTSBX436 +001635 77 PAN-VALET PICTURE X(24) VALUE '212DTSBX436 03/04/20'. DTSBX436 +00164 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX422 10/07/14'. DTSBX436 +00165 77 PAN-VALET PICTURE X(24) VALUE '047DTSBX422 09/27/14'. DTSBX436 +00166 SKIP3 DTSBX436 +00167 01 WRK-AREA. DTSBX436 +00168 05 W-ABEND-CD PIC S9(04) COMP VALUE 436. CL168 +00169 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX436'. CL168 +00170 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL121 +00171 05 WSP-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL163 +00172 CL121 +00173 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL121 +00174 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL121 +00175 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL121 +00176 CL133 +00177 05 WSP-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL133 +00178 05 WSP-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL133 +00179 05 WSP-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL133 +00180 CL121 +00181 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX436 +00182 88 W-PREV-REC-NULL-88 VALUE 'XXX'. CL*87 +00183 88 W-PREV-RPT-NULL-88 VALUE 'XXX'. CL*87 +00184 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX436 +00185 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX436 +00186 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX436 +00187 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX436 +00188 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX436 +00189 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX436 +00190 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX436 +00191 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX436 +00192 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX436 +00193 88 W-PREV-RPT-RPT-88 VALUE '140'. CL*86 +00194 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX436 +00195 88 W-PREV-RPT-WAGE-88 VALUE '144'. CL*86 +00196 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX436 +00197 88 W-PREV-RPT-PAY-88 VALUE '145'. CL*86 +00198 88 W-PREV-REC-BHDR-88 VALUE '149'. DTSBX436 +00199 DTSBX436 +00200 05 TEMP-BTC-STATUS PIC X(02). DTSBX436 +00201 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX436 +00202 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX436 +00203 DTSBX436 +00204 05 WAGE-TEMP-STATUS PIC X(02). DTSBX436 +00205 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX436 +00206 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX436 +00207 DTSBX436 +00208 05 WAGE-OUT-STATUS PIC X(02). DTSBX436 +00209 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX436 +00210 DTSBX436 +00211 05 BATCH-XREF-STATUS PIC X(02). DTSBX436 +00212 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX436 +00213 DTSBX436 +00214 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX436 +00215 CL*12 +00216 05 WAGE-TRANS-STATUS PIC X(02). CL*12 +00217 88 WAGE-TRANS-FILE-OK-88 VALUE '00' '97'. CL*12 +00218 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*12 +00219 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. CL*12 +00220 CL*12 +00221 05 REPT-140-STATUS PIC X(02). CL*63 +00222 88 REPT-140-OK-88 VALUE '00' '97'. CL*63 +00223 88 REPT-140--NO-REC-88 VALUE '10' '23'. CL*63 +00224 CL*61 +00225 05 WAGE-144-STATUS PIC X(02). CL*63 +00226 88 WAGE-144-OK-88 VALUE '00' '97'. CL*63 +00227 88 WAGE-144--NO-REC-88 VALUE '10' '23'. CL*63 +00228 CL*61 +00229 05 PAYT-145-STATUS PIC X(02). CL*63 +00230 88 PAYT-145-OK-88 VALUE '00' '97'. CL*64 +00231 88 PAYT-145-NO-REC-88 VALUE '10' '23'. CL*64 +00232 DTSBX436 +00233 CL119 +00234 05 REPT-STATUS PIC X(02). CL119 +00235 88 REPT-STATUS-OK-88 VALUE '00'. CL119 +00236 88 REPT-STATUS-EOF-88 VALUE '10'. CL119 +00237 CL119 +00238 05 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL*80 +00239 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL*81 +00240 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL*81 +00241 DTSBX436 +00242 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX436 +00243 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX436 +00244 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX436 +00245 DTSBX436 +00246 05 W-X145-PAYMENT-FOUND-IND PIC X(01) VALUE 'N'. CL*54 +00247 88 W-X145-PAYMENT-YES-88 VALUE 'Y'. CL*54 +00248 88 W-X145-PAYMENT-NO-88 VALUE 'N'. CL*54 +00249 CL*54 +00250 05 W-WRITE-T025-TRAN PIC X(01) VALUE 'N'. CL*73 +00251 88 W-WRITE-T025-TRAN-YES-88 VALUE 'Y'. CL*73 +00252 88 W-WRITE-T025-TRAN-NO-88 VALUE 'N'. CL*73 +00253 CL*73 +00254 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX436 +00255 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX436 +00256 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX436 +00257 DTSBX436 +00258 05 W-RPT-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX436 +00259 88 W-RPT-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX436 +00260 88 W-RPT-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX436 +00261 DTSBX436 +00262 05 W-WAGE-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX436 +00263 88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX436 +00264 88 W-WAGE-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX436 +00265 DTSBX436 +00266 05 W-ARPT-MAX PIC S9(04) COMP VALUE +100. DTSBX436 +00267 05 W-ARPT-LAST PIC S9(04) COMP VALUE +0. DTSBX436 +00268 05 RSUB PIC S9(04) COMP VALUE +0. DTSBX436 +00269 05 W-ARPT-TABLE. DTSBX436 +00270 10 W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128). DTSBX436 +00271 DTSBX436 +00272 05 W-EMP-NO PIC S9(07) COMP-3. DTSBX436 +00273 05 W-X140-DUP PIC S9(03) COMP-3 VALUE +0. CL*41 +00274 05 W-TRAN-CNT PIC S9(03) COMP-3 VALUE +0. CL*41 +00275 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSBX436 +00276 05 W-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. CL*73 +00277 05 WS-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. CL174 +00278 05 W-CURR-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX436 +00279 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX436 +00280 05 W-WAIVER-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX436 +00281 05 W-X140-REPORT-QTR PIC S9(05) COMP-3. CL*54 +00282 05 W-X145-PAYMENT-QTR PIC S9(05) COMP-3. CL*54 +00283 05 W-X144-WAGE-QTR PIC S9(05) COMP-3. CL*54 +00284 05 WRK-REPORT-QTR PIC 9(05). CL190 +00285 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. CL191 +00286 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. CL191 +00287 10 W-X145-TRACE-NO-A PIC 9(08). CL191 +00288 10 W-X145-TRACE-NO-B PIC 9(05). CL191 +00289 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX436 +00290 05 W-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00291 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX436 +00292 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00293 05 WS-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00294 05 W-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00295 05 W-X145-REMITTANCE PIC S9(09)V99 VALUE +0. CL123 +00296 05 W-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00297 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00298 05 W-X145-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00299 05 W-X140-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00300 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSBX436 +00301 05 W-X145-DEPOSIT-DATE PIC S9(09) COMP-3. CL*72 +00302 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX436 +00303 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX436 +00304 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX436 +00305 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX436 +00306 05 W-WRKR-CNT-TOTAL PIC S9(07) COMP-3. CL156 +00307 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX436 +00308 05 W-SSN PIC S9(09) COMP-3. DTSBX436 +00309 05 W-EARNINGS-X PIC X(12). DTSBX436 +00310 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX436 +00311 PIC 9(09).99. DTSBX436 +00312 05 W-EARNINGS PIC S9(09)V99. DTSBX436 +00313 05 W-WORKER-NAME. DTSBX436 +00314 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX436 +00315 10 W-WRKR-MID-INIT PIC X(01). DTSBX436 +00316 10 W-WRKR-LAST-NAME PIC X(20). DTSBX436 +00317 DTSBX436 +00318 05 W-RPT-TYPE PIC X(02). DTSBX436 +00319 88 W-ORIG-88 VALUE 'OR'. DTSBX436 +00320 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX436 +00321 88 W-AUDIT-88 VALUE 'AU'. DTSBX436 +00322 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX436 +00323 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX436 +00324 88 W-ESTIM-88 VALUE 'ES'. DTSBX436 +00325 88 W-WITHDRW-88 VALUE 'WD'. DTSBX436 +00326 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX436 +00327 'FS' 'AC'. DTSBX436 +00328 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX436 +00329 'FS' 'AC' 'ES'. CL*55 +00330 CL*55 +00331 05 W-PAY-TYPE PIC X(02). CL*54 +00332 88 W-PAY-ORIG-88 VALUE 'OR'. CL*54 +00333 88 W-PAY-REG-88 VALUE 'PA'. CL*54 +00334 88 W-PAY-ACH-88 VALUE '00'. CL206 +00335 88 W-PAY-CHK-88 VALUE '01'. CL206 +00336 88 W-PAY-SHK-88 VALUE '02'. CL206 +00337 88 W-VALID-PAY-88 VALUE 'OR' 'PA' '00' '01' '02'. CL206 +00338 CL*54 +00339 DTSBX436 +00340 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX436 +00341 DTSBX436 +00342 05 W-MNTE-SUBJECT PIC X(40). DTSBX436 +00343 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX436 +00344 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX436 +00345 88 W-MNTE-KEY-WORD-88 VALUE DTSBX436 +00346 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX436 +00347 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX436 +00348 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX436 +00349 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX436 +00350 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX436 +00351 DTSBX436 +00352 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX436 +00353 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX436 +00354 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX436 +00355 DTSBX436 +00356 05 TSUB1 PIC S9(04) COMP. DTSBX436 +00357 05 TSUB2 PIC S9(04) COMP. DTSBX436 +00358 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX436 +00359 DTSBX436 +00360 05 W-MNTE-LINE PIC X(72). DTSBX436 +00361 DTSBX436 +00362 05 W-SLASH-DATE PIC X(10). DTSBX436 +00363 05 FILLER REDEFINES W-SLASH-DATE. DTSBX436 +00364 10 W-SLASH-DT-MM PIC X(02). DTSBX436 +00365 10 FILLER PIC X(01). DTSBX436 +00366 10 W-SLASH-DT-DD PIC X(02). DTSBX436 +00367 10 FILLER PIC X(01). DTSBX436 +00368 10 W-SLASH-DT-CCYY PIC X(04). DTSBX436 +00369 DTSBX436 +00370 05 WRK-CURR-RUN-DATE PIC 9(08). CL157 +00371 05 FILLER REDEFINES WRK-CURR-RUN-DATE. CL157 +00372 10 WRK-CURR-CCYY PIC 9(04). CL157 +00373 10 WRK-CURR-MO PIC 9(02). CL157 +00374 10 WRK-CURR-DD PIC 9(02). CL157 +00375 CL157 +00376 05 WRK-CURR-RPT-DATE. CL157 +00377 10 RPT-CURR-MO PIC 9(02). CL157 +00378 10 FILLER PIC X(01) VALUE '/'. CL157 +00379 10 RPT-CURR-DD PIC 9(02). CL157 +00380 10 FILLER PIC X(01) VALUE '/'. CL157 +00381 10 RPT-CURR-CCYY PIC 9(04). CL157 +00382 CL157 +00383 05 W-SLASH-QTR PIC X(06). DTSBX436 +00384 05 FILLER REDEFINES W-SLASH-QTR. DTSBX436 +00385 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX436 +00386 10 FILLER PIC X(01). DTSBX436 +00387 10 W-SLASH-QTR-Q PIC X(01). DTSBX436 +00388 DTSBX436 +00389 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00390 * BATCH HEADER DTSBX436 +00391 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00392 * REPORT DTSBX436 +00393 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00394 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00395 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00396 05 W-X140-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00397 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00398 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00399 * EMPLOYEE WAGES DTSBX436 +00400 05 W-X144-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00401 05 W-X144-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00402 05 W-X144-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00403 05 W-X144-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00404 05 W-X144-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00405 05 W-X144-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00406 DTSBX436 +00407 * EMPLOYER PAYMENT CL*54 +00408 05 W-X145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00409 05 W-X145-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00410 05 W-X145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00411 05 W-X145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00412 05 W-X145-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00413 05 W-X145-ZRO-CNT PIC S9(07) COMP-3 VALUE +0. CL173 +00414 05 W-X145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00415 * EMPLOYEE W4 COUNT CL*13 +00416 05 W-W4-CNT PIC S9(07) COMP-3 VALUE +0. CL*13 +00417 CL*13 +00418 ** 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00419 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00420 05 W-T028-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00421 05 W-T028-WRITEE-CNT PIC S9(07) COMP-3 VALUE +0. CL102 +00422 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00423 05 W-T025-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00424 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00425 05 W-ARPT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00426 05 W-BX214-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00427 DTSBX436 +00428 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX436 +00429 05 W-X144-LENGTH PIC S9(04) COMP. DTSBX436 +00430 05 W-X145-LENGTH PIC S9(04) COMP. CL*54 +00431 DTSBX436 +00432 05 W-AMT-DISP1 PIC ----------9.99. DTSBX436 +00433 05 W-AMT-DISP2 PIC ----------9.99. DTSBX436 +00434 *RW1 DTSBX436 +00435 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX436 +00436 05 DISPLAY-CNT PIC Z(06)9. DTSBX436 +00437 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX436 +00438 *RW2 DTSBX436 +00439 DTSBX436 +00440 01 MESSAGE-AREA. DTSBX436 +00441 *** FATAL ERRORS MSG-A DTSBX436 +00442 05 MSG-A1. DTSBX436 +00443 10 FILLER PIC X(32) DTSBX436 +00444 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX436 +00445 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX436 +00446 01 HEADER-1. CL119 +00447 05 FILLER PIC X(01) VALUE SPACES. CL119 +00448 05 FILLER PIC X(49) VALUE '140R1'. CL119 +00449 05 FILLER PIC X(60) VALUE CL119 +00450 'DISTRICT OF COLUMBIA'. CL119 +00451 05 FILLER PIC X(06) VALUE 'DATE:'. CL119 +00452 05 HDR1-LRCM-SYS-DATE PIC X(10). CL160 +00453 01 HEADER-2. CL119 +00454 05 FILLER PIC X(54) VALUE SPACES. CL119 +00455 05 FILLER PIC X(56) VALUE CL119 +00456 'TAX DIVISION'. CL119 +00457 05 FILLER PIC X(06) VALUE 'TIME:'. CL119 +00458 05 HDR2-LRCM-SYS-TIME PIC X(08). CL119 +00459 CL119 +00460 01 HEADER-3. CL119 +00461 05 FILLER PIC X(01) VALUE SPACES. CL119 +00462 05 FILLER PIC X(38) VALUE CL119 +00463 'ROUTE TO: TAX ACCOUNTING STAFF'. CL119 +00464 05 HDR3-LITERAL PIC X(43) VALUE CL119 +00465 ' ESSP DAILY RPTS-PAYMTS-WAGES RELEASED '. CL170 +00466 05 FILLER PIC X(28) VALUE SPACES. CL119 +00467 05 FILLER PIC X(06) VALUE 'PAGE:'. CL119 +00468 05 HDR3-PAGE PIC ZZ,ZZ9. CL119 +00469 CL119 +00470 01 HEADER-31. CL131 +00471 05 FILLER PIC X(01) VALUE SPACES. CL131 +00472 05 FILLER PIC X(38) VALUE CL131 +00473 'ROUTE TO: TAX ACCOUNTING STAFF'. CL131 +00474 05 HDR3-LITERAL PIC X(43) VALUE CL131 +00475 ' ESSP DAILY RPTS-PAYMTS-WAGES IN ERROR '. CL170 +00476 05 FILLER PIC X(28) VALUE SPACES. CL131 +00477 05 FILLER PIC X(06) VALUE 'PAGE:'. CL131 +00478 05 HDR31-PAGE PIC ZZ,ZZ9. CL131 +00479 CL131 +00480 01 HEADER-4. CL119 +00481 05 FILLER PIC X(01) VALUE SPACES. CL119 +00482 05 FILLER PIC X(132) VALUE SPACES. CL119 +00483 01 HEADER-42. CL144 +00484 05 FILLER PIC X(02) VALUE SPACES. CL144 +00485 05 FILLER PIC X(34) VALUE CL144 +00486 ' '. CL144 +00487 05 FILLER PIC X(02) VALUE SPACES. CL144 +00488 05 FILLER PIC X(25) VALUE CL144 +00489 ' '. CL144 +00490 05 FILLER PIC X(03) VALUE SPACES. CL144 +00491 05 FILLER PIC X(43) VALUE CL153 +00492 ' ESSP-CALC TPA/EMPL DIFF'. CL160 +00493 05 FILLER PIC X(30) VALUE CL152 +00494 ' EMPLOYEES '. CL151 +00495 CL119 +00496 01 HEADER-5. CL119 +00497 05 FILLER PIC X(02) VALUE SPACES. CL126 +00498 05 FILLER PIC X(34) VALUE CL119 +00499 'EMP NO NAME QTR RECV-DATE'. CL127 +00500 05 FILLER PIC X(02) VALUE SPACES. CL126 +00501 05 FILLER PIC X(25) VALUE CL126 +00502 ' TOTAL-AMT EXCESS-AMT '. CL127 +00503 05 FILLER PIC X(03) VALUE SPACES. CL119 +00504 05 FILLER PIC X(34) VALUE CL127 +00505 ' TAX-AMT AMT-DUE PAID-AMT'. CL160 +00506 05 FILLER PIC X(02) VALUE SPACES. CL127 +00507 05 HDR5-NAME PIC X(28) VALUE CL138 +00508 '-/+ ----- MONTHLY COUNT'. CL160 +00509 CL119 +00510 01 HEADER-6. CL119 +00511 05 FILLER PIC X(01) VALUE SPACES. CL119 +00512 05 FILLER PIC X(132) VALUE SPACES. CL119 +00513 01 DETAIL-LINE-1. CL119 +00514 15 FILLER PIC X(02) VALUE SPACES. CL119 +00515 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL119 +00516 15 FILLER PIC X(02) VALUE SPACES. CL119 +00517 15 X434-NAME-CHECK PIC X(04) VALUE SPACES. CL119 +00518 15 FILLER PIC X(02) VALUE SPACES. CL119 +00519 15 X434-QTR PIC X(06). CL119 +00520 15 FILLER PIC X(02) VALUE SPACES. CL119 +00521 15 X434-RCVD-DATE PIC X(10). CL119 +00522 15 FILLER PIC X(01) VALUE SPACES. CL119 +00523 15 X434-TOT-WAGE PIC --------9.99. CL119 +00524 15 FILLER PIC X(01) VALUE SPACES. CL119 +00525 15 X434-EXC-WAGE PIC --------9.99. CL119 +00526 15 FILLER PIC X(01) VALUE SPACES. CL119 +00527 15 X434-TAX-WAGE PIC --------9.99. CL119 +00528 15 FILLER PIC X(01) VALUE SPACES. CL119 +00529 15 X434-X140-REMIT PIC -------9.99. CL156 +00530 15 FILLER PIC X(01) VALUE SPACES. CL119 +00531 15 X434-X145-REMIT PIC -------9.99. CL156 +00532 15 FILLER PIC X(01) VALUE SPACES. CL148 +00533 15 X434-DIFF PIC ------9.99. CL156 +00534 * 15 X434-MESSAGE PIC X(20). CL125 +00535 15 X434-M1-CNT PIC ZZZZZZ9. CL129 +00536 15 X434-M2-CNT PIC ZZZZZZ9. CL129 +00537 15 X434-M3-CNT PIC ZZZZZZ9. CL129 +00538 CL119 +00539 01 DETAIL-PEND-1. CL131 +00540 15 FILLER PIC X(02) VALUE SPACES. CL131 +00541 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL131 +00542 15 FILLER PIC X(02) VALUE SPACES. CL131 +00543 15 P434-NAME-CHECK PIC X(04) VALUE SPACES. CL131 +00544 15 FILLER PIC X(02) VALUE SPACES. CL131 +00545 15 P434-QTR PIC X(06). CL131 +00546 15 FILLER PIC X(02) VALUE SPACES. CL131 +00547 15 P434-RCVD-DATE PIC X(10). CL131 +00548 15 FILLER PIC X(01) VALUE SPACES. CL131 +00549 15 P434-TOT-WAGE PIC --------9.99. CL131 +00550 15 FILLER PIC X(01) VALUE SPACES. CL131 +00551 15 P434-EXC-WAGE PIC --------9.99. CL131 +00552 15 FILLER PIC X(01) VALUE SPACES. CL131 +00553 15 P434-TAX-WAGE PIC --------9.99. CL131 +00554 15 FILLER PIC X(01) VALUE SPACES. CL131 +00555 15 P434-X140-REMIT PIC --------9.99. CL131 +00556 15 FILLER PIC X(01) VALUE SPACES. CL131 +00557 15 P434-X145-REMIT PIC --------9.99. CL131 +00558 15 FILLER PIC X(02) VALUE SPACES. CL138 +00559 15 P434-MESSAGE PIC X(30). CL136 +00560 CL131 +00561 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL119 +00562 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL119 +00563 CL119 +00564 01 FOOTING-LINE-3. CL119 +00565 05 FILLER PIC X(25) VALUE SPACES. CL119 +00566 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL119 +00567 05 FILLER PIC X(02) VALUE SPACES. CL119 +00568 05 FILLER PIC X(45) VALUE CL170 +00569 'TOTAL PAYMENT RELEASED TO DUTAS '. CL179 +00570 05 FILLER PIC X(32) VALUE SPACES. CL119 +00571 CL119 +00572 01 FOOTING-LINE-4. CL153 +00573 05 FILLER PIC X(25) VALUE SPACES. CL119 +00574 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL119 +00575 05 FILLER PIC X(02) VALUE SPACES. CL119 +00576 05 FILLER PIC X(34) VALUE CL119 +00577 ' # OF PAYMENTS HAD ERRORS '. CL119 +00578 05 FILLER PIC X(32) VALUE SPACES. CL119 +00579 CL119 +00580 01 FOOTING-LINE-5. CL153 +00581 05 FILLER PIC X(25) VALUE SPACES. CL119 +00582 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL119 +00583 05 FILLER PIC X(02) VALUE SPACES. CL119 +00584 05 FILLER PIC X(40) VALUE CL130 +00585 ' # OF ZERO PAYMENTS DISCARDED '. CL176 +00586 05 FILLER PIC X(32) VALUE SPACES. CL119 +00587 01 FOOTING-LINE-6. CL153 +00588 05 FILLER PIC X(25) VALUE SPACES. CL130 +00589 05 WS-X140-RED-CNT PIC ZZ,ZZ9. CL130 +00590 05 FILLER PIC X(02) VALUE SPACES. CL130 +00591 05 FILLER PIC X(45) VALUE CL170 +00592 'TOTAL REPORT RELEASED TO DUTAS '. CL179 +00593 05 FILLER PIC X(32) VALUE SPACES. CL130 +00594 01 FOOTING-LINE-7. CL153 +00595 05 FILLER PIC X(25) VALUE SPACES. CL130 +00596 05 WS-X140-ERR-CNT PIC ZZ,ZZ9. CL130 +00597 05 FILLER PIC X(02) VALUE SPACES. CL130 +00598 05 FILLER PIC X(34) VALUE CL130 +00599 ' # OF REPORTS HAD ERRORS '. CL130 +00600 05 FILLER PIC X(32) VALUE SPACES. CL130 +00601 CL130 +00602 01 FOOTING-LINE-8. CL153 +00603 05 FILLER PIC X(25) VALUE SPACES. CL130 +00604 05 WS-X140-PEN-CNT PIC ZZ,ZZ9. CL130 +00605 05 FILLER PIC X(02) VALUE SPACES. CL130 +00606 05 FILLER PIC X(40) VALUE CL130 +00607 ' # OF REPORTS DUTAS CANNOT PROCESS '. CL176 +00608 05 FILLER PIC X(32) VALUE SPACES. CL130 +00609 CL119 +00610 01 FOOTING-LINE-9. CL153 +00611 05 FILLER PIC X(24) VALUE SPACES. CL153 +00612 05 WS-X144-RED-CNT PIC ZZZ,ZZ9. CL153 +00613 05 FILLER PIC X(02) VALUE SPACES. CL153 +00614 05 FILLER PIC X(45) VALUE CL170 +00615 'TOTAL WAGES RELEASED TO DUTAS '. CL179 +00616 05 FILLER PIC X(32) VALUE SPACES. CL153 +00617 01 FOOTING-LINE-10. CL153 +00618 05 FILLER PIC X(24) VALUE SPACES. CL153 +00619 05 WS-X144-ERR-CNT PIC ZZZ,ZZ9. CL153 +00620 05 FILLER PIC X(02) VALUE SPACES. CL153 +00621 05 FILLER PIC X(34) VALUE CL153 +00622 ' # OF WAGES HAD ERRORS '. CL153 +00623 05 FILLER PIC X(32) VALUE SPACES. CL153 +00624 CL153 +00625 01 FOOTING-LINE-11. CL153 +00626 05 FILLER PIC X(24) VALUE SPACES. CL153 +00627 05 WS-X144-PEN-CNT PIC ZZZ,ZZ9. CL153 +00628 05 FILLER PIC X(02) VALUE SPACES. CL153 +00629 05 FILLER PIC X(40) VALUE CL153 +00630 ' # OF WAGES DUTAS CANNOT PROCESS '. CL176 +00631 05 FILLER PIC X(32) VALUE SPACES. CL153 +00632 01 FOOTING-LINE-12. CL153 +00633 05 FILLER PIC X(19) VALUE SPACES. CL119 +00634 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL119 +00635 05 FILLER PIC X(02) VALUE SPACES. CL119 +00636 05 FILLER PIC X(45) VALUE CL171 +00637 ' TOTAL PAYMENTS APPLIED TO DUTAS'. CL175 +00638 05 FILLER PIC X(32) VALUE SPACES. CL119 +00639 CL119 +00640 01 FOOTING-LINE-15. CL175 +00641 05 FILLER PIC X(19) VALUE SPACES. CL174 +00642 05 WS-TOT-CREDIT PIC $$$$$$$$9.99. CL174 +00643 05 FILLER PIC X(02) VALUE SPACES. CL174 +00644 05 FILLER PIC X(45) VALUE CL174 +00645 ' TOTAL CREDITS APPLIED TO DUTAS'. CL174 +00646 05 FILLER PIC X(32) VALUE SPACES. CL174 +00647 CL174 +00648 01 FOOTING-LINE-13. CL153 +00649 05 FILLER PIC X(25) VALUE SPACES. CL119 +00650 05 FILLER PIC X(67) VALUE CL153 +00651 '*** END ESSP/DUTAS FINAL RPT/PAY/WAGE PROCESSING ***'. CL170 +00652 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL154 +00653 DTSBX436 +00654 01 T003-REC. DTSBX436 +00655 ++INCLUDE DTSIT003 DTSBX436 +00656 DTSBX436 +00657 01 T025-REC. DTSBX436 +00658 ++INCLUDE DTSIT025 DTSBX436 +00659 DTSBX436 +00660 *01 T027-REC. DTSBX436 +00661 *++INCLUDE DTSIT027 DTSBX436 +00662 DTSBX436 +00663 01 T028-REC. DTSBX436 +00664 ++INCLUDE DTSIT028 DTSBX436 +00665 DTSBX436 +00666 CL*11 +00667 01 W001-REC. DTSBX436 +00668 ++INCLUDE DTSIW001 DTSBX436 +00669 CL*11 +00670 01 WAGE-TRANS-AREA. CL*11 +00671 05 ESP-TRANSACTION-AREA PIC X(80). CL*11 +00672 ++INCLUDE EWGTRNW4 CL*11 +00673 CL*11 +00674 DTSBX436 +00675 * ACCOUNTING BATCH HEADER DTSBX436 +00676 01 X149-REC. DTSBX436 +00677 ++INCLUDE DTSIX149 DTSBX436 +00678 DTSBX436 +00679 * REPORT DTSBX436 +00680 01 X140-REC. DTSBX436 +00681 ++INCLUDE DTSIX140 DTSBX436 +00682 DTSBX436 +00683 * EMPLOYEE WAGES DTSBX436 +00684 01 X144-REC. DTSBX436 +00685 ++INCLUDE DTSIX144 DTSBX436 +00686 DTSBX436 +00687 * PAYMENTS CL*47 +00688 01 X145-REC. CL*47 +00689 ++INCLUDE DTSIX145 CL*47 +00690 CL*47 +00691 * BATCH - PSEUDO-BATCH XREF DTSBX436 +00692 01 X214-REC. DTSBX436 +00693 ++INCLUDE DTSIX214 DTSBX436 +00694 DTSBX436 +00695 * ERRORS DTSBX436 +00696 *01 X907-REC. DTSBX436 +00697 ***INCLUDE DTSIX907 DTSBX436 +00698 DTSBX436 +00699 01 L001-LINK-AREA. DTSBX436 +00700 ++INCLUDE DTSIL001 DTSBX436 +00701 DTSBX436 +00702 01 L003-LINK-AREA. DTSBX436 +00703 ++INCLUDE DTSIL003 DTSBX436 +00704 DTSBX436 +00705 01 L004-LINK-AREA. DTSBX436 +00706 ++INCLUDE DTSIL004 DTSBX436 +00707 DTSBX436 +00708 01 L516-LINK-AREA. DTSBX436 +00709 ++INCLUDE DTSIL516 DTSBX436 +00710 DTSBX436 +00711 01 L910-LINK-AREA. DTSBX436 +00712 ++INCLUDE DTSIL910 DTSBX436 +00713 01 MSKL-REC. DTSBX436 +00714 ++INCLUDE DTSIMSKL DTSBX436 +00715 DTSBX436 +00716 01 MHDR-REC. DTSBX436 +00717 ++INCLUDE DTSIMHDR DTSBX436 +00718 DTSBX436 +00719 01 MPRF-REC. DTSBX436 +00720 ++INCLUDE DTSIMPRF DTSBX436 +00721 DTSBX436 +00722 01 MSOL-REC. DTSBX436 +00723 ++INCLUDE DTSIMSOL DTSBX436 +00724 DTSBX436 +00725 01 MQTR-REC. DTSBX436 +00726 ++INCLUDE DTSIMQTR DTSBX436 +00727 DTSBX436 +00728 01 MOPO-REC. DTSBX436 +00729 ++INCLUDE DTSIMOPO DTSBX436 +00730 DTSBX436 +00731 01 MTAD-REC. DTSBX436 +00732 ++INCLUDE DTSIMTAD DTSBX436 +00733 DTSBX436 +00734 01 MNTE-REC. DTSBX436 +00735 ++INCLUDE DTSIMNTE DTSBX436 +00736 DTSBX436 +00737 01 L921-LINK-AREA. DTSBX436 +00738 ++INCLUDE DTSIL921 DTSBX436 +00739 SKIP3 DTSBX436 +00740 01 ISKL-REC. DTSBX436 +00741 ++INCLUDE DTSIISKL DTSBX436 +00742 SKIP3 DTSBX436 +00743 01 IEIN-REC. DTSBX436 +00744 ++INCLUDE DTSIIEIN DTSBX436 +00745 DTSBX436 +00746 01 L923-LINK-AREA. DTSBX436 +00747 ++INCLUDE DTSIL923 DTSBX436 +00748 EJECT DTSBX436 +00749 01 ASKL-REC. DTSBX436 +00750 ++INCLUDE DTSIASKL DTSBX436 +00751 EJECT DTSBX436 +00752 01 AHDR-REC. DTSBX436 +00753 ++INCLUDE DTSIAHDR DTSBX436 +00754 EJECT DTSBX436 +00755 01 ARPT-REC. DTSBX436 +00756 ++INCLUDE DTSIARPT DTSBX436 +00757 EJECT DTSBX436 +00758 01 APAY-REC. DTSBX436 +00759 ++INCLUDE DTSIAPAY DTSBX436 +00760 DTSBX436 +00761 01 L927-LINK-AREA. DTSBX436 +00762 ++INCLUDE DTSIL927 DTSBX436 +00763 DTSBX436 +00764 01 L931-LINK-AREA. DTSBX436 +00765 ++INCLUDE DTSIL931 DTSBX436 +00766 DTSBX436 +00767 01 FSKL-REC. DTSBX436 +00768 ++INCLUDE DTSIFSKL DTSBX436 +00769 DTSBX436 +00770 01 R140-REC. DTSBX436 +00771 ++INCLUDE DTSIR140 DTSBX436 +00772 DTSBX436 +00773 LINKAGE DTSBX436 +00774 SECTION. DTSBX436 +00775 DTSBX436 +00776 01 LX42-LINK-AREA. DTSBX436 +00777 ++INCLUDE DTSILX42 CL112 +00778 DTSBX436 +00779 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX436 +00780 DTSBX436 +00781 DTSBX436-MAIN. CL168 +00782 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA CL*80 +00783 MOVE LX42-RPT-ERROR-IND TO W-RPT-ERROR-IND. CL*80 +00784 CL*80 +00785 * IF W-RPT-ERROR-YES-88 CL161 +00786 * DISPLAY 'BX436 LX42 EMP REC HAS ERROR ' LX42-EMP-NO CL168 +00787 * ' ' LX42-RPT-ERROR-IND ' ' W-RPT-ERROR-IND CL161 +00788 * ELSE CL161 +00789 * DISPLAY 'BX436 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND CL168 +00790 * END-IF. CL161 +00791 CL157 +00792 EVALUATE TRUE DTSBX436 +00793 WHEN LX42-INITIALIZE-88 DTSBX436 +00794 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX436 +00795 DTSBX436 +00796 WHEN LX42-NEW-EMPLOYER-88 DTSBX436 +00797 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX436 +00798 DTSBX436 +00799 WHEN LX42-PROCESS-88 DTSBX436 +00800 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX436 +00801 DTSBX436 +00802 WHEN LX42-TERMINATE-88 DTSBX436 +00803 DISPLAY ' TERMINATE 430' CL*47 +00804 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX436 +00805 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX436 +00806 DTSBX436 +00807 END-EVALUATE. DTSBX436 +00808 CL*80 +00809 IF LX42-PROCESS-88 CL*80 +00810 MOVE W-RPT-ERROR-IND TO LX42-RPT-ERROR-IND CL*80 +00811 END-IF. CL*80 +00812 DTSBX436 +00813 DTSBX436-MAIN-EXIT. CL168 +00814 GOBACK. DTSBX436 +00815 DTSBX436 +00816 I0000-INITIATE. DTSBX436 +00817 SET W-RPT-ERROR-NO-88 TO TRUE. CL*81 +00818 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX436 +00819 DTSBX436 +00820 MOVE LENGTH OF X140-REC TO W-X140-LENGTH. DTSBX436 +00821 MOVE LENGTH OF X144-REC TO W-X144-LENGTH. DTSBX436 +00822 MOVE LENGTH OF X145-REC TO W-X145-LENGTH. CL*47 +00823 DTSBX436 +00824 * FOR VARIABLE REPORT FILE. DTSBX436 +00825 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX436 +00826 MOVE '140' TO R140-REC-TYPE. DTSBX436 +00827 DTSBX436 +00828 MOVE LX42-CURR-RUN-DATE TO L004-DATE. DTSBX436 +00829 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX436 +00830 SUBTRACT +5 FROM L004-ABS-QTR. DTSBX436 +00831 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX436 +00832 MOVE L004-QTR-5-9 TO W-WAIVER-QTR. DTSBX436 +00833 DISPLAY 'BX436 CURR RUN DATE ' LX42-CURR-RUN-DATE. CL168 +00834 DISPLAY 'BX436 WAIVE QTR ' W-WAIVER-QTR. CL168 +00835 DTSBX436 +00836 MOVE LX42-CURR-RUN-DATE TO WRK-CURR-RUN-DATE. CL158 +00837 MOVE WRK-CURR-CCYY TO RPT-CURR-CCYY CL158 +00838 MOVE WRK-CURR-MO TO RPT-CURR-MO CL158 +00839 MOVE WRK-CURR-DD TO RPT-CURR-DD CL158 +00840 DISPLAY 'RPT CURR RUN DATE ' WRK-CURR-RPT-DATE. CL157 +00841 MOVE WRK-CURR-RPT-DATE TO HDR1-LRCM-SYS-DATE. CL158 +00842 CL150 +00843 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX436 +00844 IF W-FATAL-ERROR-YES-88 DTSBX436 +00845 GO TO I0000-EXIT DTSBX436 +00846 END-IF. DTSBX436 +00847 DTSBX436 +00848 MOVE +0 TO W-ARPT-LAST. DTSBX436 +00849 PERFORM DTSBX436 +00850 VARYING RSUB FROM +1 BY +1 DTSBX436 +00851 UNTIL RSUB > W-ARPT-MAX DTSBX436 +00852 MOVE LOW-VALUES TO W-ARPT-ENTRY (RSUB) DTSBX436 +00853 END-PERFORM. DTSBX436 +00854 DTSBX436 +00855 I0000-EXIT. DTSBX436 +00856 EXIT. DTSBX436 +00857 DTSBX436 +00858 I2000-OPEN-FILES. DTSBX436 +00859 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX436 +00860 IF W-FATAL-ERROR-YES-88 DTSBX436 +00861 DISPLAY 'CANNOT OPEN TEMP X436BTC FILE ' CL169 +00862 TEMP-BTC-STATUS DTSBX436 +00863 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00864 END-IF. DTSBX436 +00865 DTSBX436 +00866 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBX436 +00867 IF W-FATAL-ERROR-YES-88 DTSBX436 +00868 DISPLAY 'CANNOT OPEN WAGE TEMP FILE ' DTSBX436 +00869 WAGE-TEMP-STATUS DTSBX436 +00870 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00871 END-IF. DTSBX436 +00872 DTSBX436 +00873 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. CL*20 +00874 IF W-FATAL-ERROR-YES-88 CL*20 +00875 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' CL*20 +00876 WAGE-OUT-STATUS CL*20 +00877 PERFORM S999-ABEND THRU S999-EXIT CL*20 +00878 END-IF. CL*20 +00879 DTSBX436 +00880 OPEN OUTPUT BATCH-XREF-FILE. DTSBX436 +00881 IF BATCH-XREF-OK-88 DTSBX436 +00882 NEXT SENTENCE DTSBX436 +00883 ELSE DTSBX436 +00884 DISPLAY 'CANNOT OPEN BATCH XREF FILE ' DTSBX436 +00885 BATCH-XREF-STATUS DTSBX436 +00886 PERFORM S999-ABEND THRU S999-EXIT DTSBX436 +00887 END-IF. DTSBX436 +00888 CL*12 +00889 CL*59 +00890 OPEN OUTPUT PEND-X140-FILE. CL*59 +00891 IF REPT-140-OK-88 CL*62 +00892 NEXT SENTENCE CL*59 +00893 ELSE CL*59 +00894 DISPLAY 'CANNOT OPEN PEN7DAY X140 FILE' CL169 +00895 REPT-140-STATUS CL*62 +00896 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00897 END-IF. CL*59 +00898 CL*59 +00899 OPEN OUTPUT PEND-X144-FILE. CL*59 +00900 IF WAGE-144-OK-88 CL*62 +00901 NEXT SENTENCE CL*59 +00902 ELSE CL*59 +00903 DISPLAY 'CANNOT OPEN PEN7DAY X144 FILE' CL169 +00904 WAGE-144-STATUS CL*62 +00905 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00906 END-IF. CL*59 +00907 CL*59 +00908 OPEN OUTPUT PEND-X145-FILE. CL*59 +00909 IF PAYT-145-OK-88 CL*62 +00910 NEXT SENTENCE CL*59 +00911 ELSE CL*59 +00912 DISPLAY 'CANNOT OPEN PEN7DAY X145 FILE' CL169 +00913 PAYT-145-STATUS CL*62 +00914 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00915 END-IF. CL*59 +00916 CL119 +00917 CL119 +00918 OPEN OUTPUT REPT-PEND-FILE. CL119 +00919 IF REPT-STATUS-OK-88 CL119 +00920 NEXT SENTENCE CL119 +00921 ELSE CL119 +00922 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' CL119 +00923 REPT-STATUS CL119 +00924 PERFORM S999-ABEND THRU S999-EXIT CL119 +00925 END-IF. CL119 +00926 DTSBX436 +00927 OPEN OUTPUT REPT-PAID-FILE. CL119 +00928 IF REPT-STATUS-OK-88 CL119 +00929 NEXT SENTENCE CL119 +00930 ELSE CL119 +00931 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' CL119 +00932 REPT-STATUS CL119 +00933 PERFORM S999-ABEND THRU S999-EXIT CL119 +00934 END-IF. CL119 +00935 CL119 +00936 I2000-EXIT. DTSBX436 +00937 EXIT. DTSBX436 +00938 DTSBX436 +00939 P0000-PROCESS. DTSBX436 +00940 CL**2 +00941 EVALUATE TRUE DTSBX436 +00942 WHEN LX42-REC-TYPE-PAY-88 CL*47 +00943 PERFORM P1000-PAYMENT THRU P1000-EXIT CL*47 +00944 DTSBX436 +00945 WHEN LX42-REC-TYPE-RPT-88 CL*47 +00946 PERFORM P2000-REPORT THRU P2000-EXIT CL*47 +00947 CL*47 +00948 WHEN LX42-REC-TYPE-WAGE-88 DTSBX436 +00949 PERFORM P3000-WAGES THRU P3000-EXIT DTSBX436 +00950 CL*47 +00951 WHEN OTHER CL*47 +00952 DISPLAY 'DTSBX436 ABENDING - INVALID RECORD TYPE ' CL168 +00953 LX42-REC-TYPE CL*47 +00954 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00955 CL*47 +00956 END-EVALUATE. DTSBX436 +00957 DTSBX436 +00958 P0000-EXIT. DTSBX436 +00959 EXIT. DTSBX436 +00960 P1000-PAYMENT. CL*47 +00961 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. CL*57 +00962 MOVE LX42-DATA-AREA TO X145-REC. CL*50 +00963 *& CL*50 +00964 MOVE X145-EMP-NO TO W-EMP-NO. CL*50 +00965 SET W-EMP-FOUND-NO-88 TO TRUE. CL*50 +00966 CL*50 +00967 ADD +1 TO W-X145-RED-CNT CL*50 +00968 DISPLAY SPACE. CL*50 +00969 DISPLAY 'BX436- NEW EMPLOYER PAYMENT ' X145-EMP-NO. CL168 +00970 * DISPLAY ' X145-KEY ' X145-EMP-NO. CL161 +00971 * DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA. CL161 +00972 CL*51 +00973 * IF LX42-X145-EMP-NO = '999999' CL169 +00974 * SET W-RPT-ERROR-YES-88 TO TRUE CL169 +00975 * MOVE SPACES TO R140-MESSAGE CL169 +00976 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +00977 * STRING CL169 +00978 * 'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS ' CL169 +00979 * DELIMITED BY SIZE CL169 +00980 * INTO R140-MESSAGE CL169 +00981 * END-STRING CL169 +00982 * MOVE R140-MESSAGE TO P434-MESSAGE CL169 +00983 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +00984 * MOVE '999999' TO LX42-X145-EMP-NO CL169 +00985 * ADD +1 TO W-X145-ERR-CNT CL169 +00986 * ADD +1 TO W-X145-PEN-CNT CL169 +00987 * WRITE PEND-X145-REC FROM X145-REC CL169 +00988 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL169 +00989 * GO TO P1000-EXIT. CL169 +00990 CL*51 +00991 CL*51 +00992 * IF LX42-REC-TYPE-PAY-88 CL169 +00993 * IF LX42-X145-KEY-AREA = X145-EMP-NO AND CL169 +00994 * LX42-X145-QTR-AREA = X145-QTR CL169 +00995 * SET W-PREV-RPT-NULL-88 TO TRUE CL169 +00996 * ADD +1 TO W-X145-DUP-CNT CL169 +00997 * DISPLAY 'X145 DUPLICATE PAYMENT RECORD ' W-EMP-NO CL161 +00998 * ' ERR IND ' W-RPT-ERROR-IND CL161 +00999 * MOVE SPACES TO R140-MESSAGE CL169 +01000 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +01001 * MOVE SPACES TO R140-MESSAGE CL169 +01002 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +01003 * STRING CL169 +01004 * ': DUPLICATE PAYMENT RECORD ----PROCESS ' CL169 +01005 * DELIMITED BY SIZE CL169 +01006 * INTO R140-MESSAGE CL169 +01007 * END-STRING CL169 +01008 * MOVE R140-MESSAGE TO P434-MESSAGE CL169 +01009 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +01010 * ELSE CL169 +01011 * MOVE X145-EMP-NO TO LX42-X145-KEY-AREA CL169 +01012 * END-IF CL169 +01013 * END-IF. CL171 +01014 CL*51 +01015 CL*51 +01016 MOVE X145-EMP-NO TO LX42-X145-EMP-NO. CL*51 +01017 MOVE X145-QTR TO LX42-X145-QTR-AREA CL*83 +01018 CL*50 +01019 * DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. CL161 +01020 * IF W-PREV-RPT-NULL-88 OR CL169 +01021 * LX42-REC-TYPE-PAY-88 CL169 +01022 * SET W-PREV-RPT-PAY-88 TO TRUE CL169 +01023 * SET W-PREV-REC-PAY-88 TO TRUE CL107 +01024 ADD +1 TO W-X145-PRO-CNT CL*50 +01025 PERFORM P1110-EDIT-PAYMENT THRU P1110-EXIT CL*51 +01026 IF W-RPT-ERROR-NO-88 CL*81 +01027 PERFORM P1112-CHECK-PAYMENT THRU P1112-EXIT CL*51 +01028 IF W-RPT-ERROR-NO-88 CL*81 +01029 * DISPLAY 'X145 PAYMENT REC PASS EDITS ' W-EMP-NO CL161 +01030 ADD +1 TO W-X145-SAV-CNT CL*51 +01031 PERFORM P1120-SAVE-PAYMENT THRU P1120-EXIT CL*51 +01032 ELSE CL*51 +01033 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01034 ADD +1 TO W-X145-ERR-CNT CL*51 +01035 ADD +1 TO W-X145-PEN-CNT CL*92 +01036 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01037 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01038 WRITE PEND-X145-REC FROM X145-REC CL199 +01039 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 CL203 +01040 END-IF CL*51 +01041 ELSE CL*49 +01042 MOVE '999999' TO LX42-X145-EMP-NO CL*50 +01043 ADD +1 TO W-X145-ERR-CNT CL*51 +01044 ADD +1 TO W-X145-PEN-CNT CL*92 +01045 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01046 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01047 WRITE PEND-X145-REC FROM X145-REC CL199 +01048 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 CL203 +01049 END-IF. CL171 +01050 CL*49 +01051 P1000-EXIT. CL*51 +01052 EXIT. CL*49 +01053 CL*49 +01054 P1110-EDIT-PAYMENT. CL*47 +01055 CL*54 +01056 MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*54 +01057 IF W-VALID-PAY-88 CL*54 +01058 NEXT SENTENCE CL*54 +01059 ELSE CL*54 +01060 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01061 MOVE SPACES TO R140-MESSAGE CL*54 +01062 MOVE W-EMP-NO TO R140-EMP-NO CL*54 +01063 STRING CL*54 +01064 ':PAY- INVALID PAYMENT TYPE ' CL144 +01065 X145-PAY-TYPE CL*54 +01066 DELIMITED BY SIZE CL*54 +01067 INTO R140-MESSAGE CL*54 +01068 END-STRING CL*54 +01069 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01070 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54 +01071 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01072 END-IF. CL*54 +01073 IF X145-QTR = SPACES CL*47 +01074 MOVE '2020/1' TO W-SLASH-QTR CL212 +01075 ELSE CL*47 +01076 MOVE X145-QTR TO W-SLASH-QTR. CL*47 +01077 CL*47 +01078 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR CL*47 +01079 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q CL*47 +01080 PERFORM S004-FROM-5 THRU S004-EXIT CL*47 +01081 IF NOT L004-VALID-QTR CL*47 +01082 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01083 MOVE SPACES TO R140-MESSAGE CL*47 +01084 MOVE W-EMP-NO TO R140-EMP-NO CL*47 +01085 STRING CL*47 +01086 ':PAY- INVALID QUARTER ' W-SLASH-QTR CL144 +01087 DELIMITED BY SIZE CL*47 +01088 INTO R140-MESSAGE CL*47 +01089 END-STRING CL*47 +01090 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*47 +01091 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01092 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01093 ELSE CL*48 +01094 MOVE L004-QTR-5-9 TO W-X145-PAYMENT-QTR CL*56 +01095 END-IF. CL*48 +01096 CL*48 +01097 * DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR CL*92 +01098 CL*53 +01099 P1110-EDIT-REMITTANCE. CL205 +01100 MOVE X145-REMITTANCE TO W-X145-REMITTANCE. CL*53 +01101 * DISPLAY 'W145REMITCE ' W-X145-REMITTANCE. CL161 +01102 * DISPLAY 'X145REMITCE ' X145-REMITTANCE. CL161 +01103 CL*51 +01104 IF W-X145-REMITTANCE = ZEROS CL*56 +01105 * SET W-RPT-ERROR-YES-88 TO TRUE CL172 +01106 ADD +1 TO W-X145-ZRO-CNT CL172 +01107 MOVE SPACES TO R140-MESSAGE CL*51 +01108 MOVE W-EMP-NO TO R140-EMP-NO CL*51 +01109 * STRING CL169 +01110 * 'X430- REVIEW REMITTANCE AMOUNT= 0 ' CL169 +01111 * DELIMITED BY SIZE CL169 +01112 * INTO R140-MESSAGE CL169 +01113 * END-STRING CL169 +01114 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +01115 END-IF. CL*51 +01116 CL*51 +01117 MOVE ZEROS TO W-X145-RECEIVED-DATE CL*72 +01118 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*48 +01119 MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*48 +01120 MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*48 +01121 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*48 +01122 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*48 +01123 IF NOT L001-VALID-DATE CL*48 +01124 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01125 MOVE SPACES TO R140-MESSAGE CL*48 +01126 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01127 STRING CL*48 +01128 ':PAY- INVALID RECEIVED DATE ' CL144 +01129 ' ' X145-RCVD-DATE CL*48 +01130 DELIMITED BY SIZE CL*48 +01131 INTO R140-MESSAGE CL*48 +01132 END-STRING CL*48 +01133 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01134 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01135 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01136 ELSE CL*48 +01137 MOVE L001-FED-8-DATE-9 TO W-X145-RECEIVED-DATE CL*72 +01138 END-IF. CL*48 +01139 CL*55 +01140 P1110-EXIT. CL*55 +01141 EXIT. CL*55 +01142 CL*55 +01143 P1112-CHECK-PAYMENT. CL*51 +01144 MOVE LOW-VALUE TO MPRF-KEY-AREA. CL*48 +01145 MOVE W-EMP-NO TO MPRF-EMP-NO. CL*48 +01146 SET MPRF-PRF-88 TO TRUE. CL*48 +01147 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*48 +01148 CL*48 +01149 PERFORM S910-READ THRU S910-EXIT. CL*48 +01150 IF L910-NO-REC-88 CL*48 +01151 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01152 SET W-EMP-FOUND-NO-88 TO TRUE CL*48 +01153 MOVE SPACES TO R140-MESSAGE CL*48 +01154 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01155 STRING CL*48 +01156 ':EMP NOT ON DUTAS -CANNOT PAY ' CL144 +01157 X145-EMP-NO CL*48 +01158 DELIMITED BY SIZE CL*48 +01159 INTO R140-MESSAGE CL*48 +01160 END-STRING CL*48 +01161 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01162 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01163 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01164 ELSE CL*48 +01165 MOVE MSKL-REC TO MPRF-REC CL*48 +01166 SET W-EMP-FOUND-YES-88 TO TRUE CL*48 +01167 END-IF. CL*48 +01168 CL*48 +01169 P1112-EXIT. CL*51 +01170 EXIT. CL*48 +01171 CL*48 +01172 P1120-SAVE-PAYMENT. CL*51 +01173 IF W-X145-REMITTANCE = ZEROS CL176 +01174 GO TO P1120-EXIT. CL176 +01175 * DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO. CL161 +01176 MOVE W-X145-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL169 +01177 ADD W-X145-REMITTANCE TO W-TOT-REMIT-AMT. CL172 +01178 ADD +1 TO W-X145-SAV-CNT. CL169 +01179 PERFORM P2021-WRITE-T025 THRU P2021-EXIT. CL170 +01180 P1120-EXIT. CL176 +01181 EXIT. CL*51 +01182 CL*51 +01183 CL*48 +01184 DTSBX436 +01185 P2000-REPORT. DTSBX436 +01186 MOVE LX42-DATA-AREA TO X140-REC. DTSBX436 +01187 CL**2 +01188 * SET W-RPT-IN-PROGRESS-YES-88 TO TRUE CL*56 +01189 CL**2 +01190 MOVE X140-EMP-NO TO W-EMP-NO. DTSBX436 +01191 CL*40 +01192 ADD +1 TO W-X140-RED-CNT. CL*56 +01193 * DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE. CL161 +01194 * IF W-PREV-RPT-NULL-88 CL169 +01195 * SET W-PREV-RPT-RPT-88 TO TRUE CL169 +01196 * SET W-X145-PAYMENT-NO-88 TO TRUE CL169 +01197 * ELSE CL169 +01198 * SET W-X145-PAYMENT-YES-88 TO TRUE CL169 +01199 * END-IF. CL169 +01200 CL*52 +01201 IF LX42-REC-TYPE-RPT-88 CL196 +01202 IF LX42-X140-KEY-AREA = X140-EMP-NO AND CL196 +01203 LX42-X140-QTR-AREA = X140-QUARTER CL196 +01204 SET W-RPT-ERROR-YES-88 TO TRUE CL196 +01205 ADD +1 TO W-X140-DUP-CNT CL196 +01206 ADD +1 TO W-X140-PEN-CNT CL196 +01207 DISPLAY ':ERROR-RPT DUPLICATE REPORT D ' CL196 +01208 ' ERR IND ' W-RPT-ERROR-IND CL196 +01209 MOVE SPACES TO R140-MESSAGE CL196 +01210 MOVE W-EMP-NO TO R140-EMP-NO CL196 +01211 STRING CL196 +01212 ':RPT- DUPLICATE REPORT RECORD ' CL196 +01213 DELIMITED BY SIZE CL196 +01214 INTO R140-MESSAGE CL196 +01215 END-STRING CL196 +01216 MOVE R140-MESSAGE TO P434-MESSAGE CL196 +01217 PERFORM S946-WRITE-R140 THRU S946-EXIT CL196 +01218 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL196 +01219 WRITE PEND-X140-REC FROM X140-REC CL196 +01220 MOVE '999999' TO LX42-X140-EMP-NO CL196 +01221 GO TO P2000-EXIT CL196 +01222 ELSE CL196 +01223 MOVE X140-EMP-NO TO LX42-X140-KEY-AREA CL196 +01224 END-IF CL196 +01225 END-IF. CL196 +01226 CL*40 +01227 SET W-RPT-ERROR-NO-88 TO TRUE CL180 +01228 MOVE X140-EMP-NO TO LX42-X140-EMP-NO. CL**3 +01229 MOVE X140-QUARTER TO LX42-X140-QTR-AREA CL*80 +01230 SET W-EMP-FOUND-NO-88 TO TRUE. DTSBX436 +01231 CL*51 +01232 * IF LX42-X145-EMP-NO = '999999' CL169 +01233 * SET W-RPT-ERROR-YES-88 TO TRUE CL169 +01234 * MOVE SPACES TO R140-MESSAGE CL169 +01235 * MOVE W-EMP-NO TO R140-EMP-NO CL169 +01236 * STRING CL169 +01237 * ':PAY RECORD INVALID -RPT BYPASSED ' CL169 +01238 * DELIMITED BY SIZE CL169 +01239 ** INTO R140-MESSAGE CL169 +01240 * END-STRING CL169 +01241 * MOVE '999999' TO LX42-X140-EMP-NO CL169 +01242 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL169 +01243 * ADD +1 TO W-X140-PEN-CNT CL169 +01244 * WRITE PEND-X140-REC FROM X140-REC CL169 +01245 * MOVE R140-MESSAGE TO P434-MESSAGE CL169 +01246 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL169 +01247 * GO TO P2000-EXIT. CL169 +01248 CL*40 +01249 SET W-PREV-RPT-RPT-88 TO TRUE. CL*84 +01250 DTSBX436 +01251 DTSBX436 +01252 PERFORM P2010-EDIT-REPORT THRU P2010-EXIT DTSBX436 +01253 CL**3 +01254 IF W-RPT-ERROR-YES-88 CL*81 +01255 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01256 DISPLAY ' REPORT HAS ERRORS - DATA ERRORS' CL196 +01257 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01258 CL**3 +01259 PERFORM P2012-CHECK-MPRF THRU P2012-EXIT CL**3 +01260 IF W-RPT-ERROR-YES-88 CL*81 +01261 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01262 DISPLAY ' REPORT HAS ERRORS - MPRF ERRORS' CL196 +01263 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01264 CL**3 +01265 PERFORM P2013-CHECK-MQTR THRU P2013-EXIT CL**3 +01266 IF W-RPT-ERROR-YES-88 CL*81 +01267 MOVE '999999' TO LX42-X140-EMP-NO CL*60 +01268 DISPLAY ' REPORT HAS ERRORS - MQTR ERRORS' CL196 +01269 GO TO P2000-EDIT-REPORT-CONTINUE. CL*60 +01270 CL*32 +01271 P2000-EDIT-REPORT-CONTINUE. CL*32 +01272 IF W-RPT-ERROR-YES-88 CL*81 +01273 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01274 MOVE SPACES TO R140-MESSAGE CL196 +01275 MOVE W-EMP-NO TO R140-EMP-NO CL*32 +01276 STRING CL196 +01277 ': REPORT CONTAINS ERRORS CANNOT PROCESS -REPORT' CL196 +01278 ' ' X140-QUARTER CL196 +01279 DELIMITED BY SIZE CL196 +01280 INTO R140-MESSAGE CL196 +01281 END-STRING CL196 +01282 PERFORM S946-WRITE-R140 THRU S946-EXIT CL181 +01283 ADD +1 TO W-X140-PEN-CNT CL181 +01284 WRITE PEND-X140-REC FROM X140-REC CL181 +01285 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL181 +01286 MOVE R140-MESSAGE TO P434-MESSAGE CL181 +01287 GO TO P2000-EXIT. CL*32 +01288 CL**3 +01289 PERFORM P2020-SAVE-EXT-REPORT THRU P2020-EXIT. CL**3 +01290 ADD +1 TO W-X140-SAV-CNT. CL*93 +01291 CL*67 +01292 DTSBX436 +01293 P2000-EXIT. DTSBX436 +01294 EXIT. DTSBX436 +01295 DTSBX436 +01296 P2010-EDIT-REPORT. DTSBX436 +01297 MOVE X140-QUARTER TO W-SLASH-QTR. DTSBX436 +01298 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX436 +01299 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX436 +01300 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX436 +01301 IF NOT L004-VALID-QTR DTSBX436 +01302 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01303 MOVE SPACES TO R140-MESSAGE DTSBX436 +01304 MOVE W-EMP-NO TO R140-EMP-NO DTSBX436 +01305 STRING DTSBX436 +01306 ':RPT- INVALID QUARTER ' CL144 +01307 X140-QUARTER DTSBX436 +01308 DELIMITED BY SIZE DTSBX436 +01309 INTO R140-MESSAGE DTSBX436 +01310 END-STRING DTSBX436 +01311 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01312 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX436 +01313 ELSE DTSBX436 +01314 MOVE L004-QTR-5-9 TO W-X140-REPORT-QTR CL*56 +01315 END-IF. DTSBX436 +01316 DTSBX436 +01317 MOVE X140-REPORT-TYPE TO W-RPT-TYPE. DTSBX436 +01318 IF NOT W-RPT-TYPE-VALID-88 DTSBX436 +01319 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01320 MOVE SPACES TO R140-MESSAGE DTSBX436 +01321 MOVE W-EMP-NO TO R140-EMP-NO DTSBX436 +01322 STRING DTSBX436 +01323 'ERROR-RPT INVALID REPORT TYPE ' CL144 +01324 X140-REPORT-TYPE CL**2 +01325 DELIMITED BY SIZE DTSBX436 +01326 INTO R140-MESSAGE DTSBX436 +01327 END-STRING DTSBX436 +01328 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01329 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX436 +01330 END-IF. DTSBX436 +01331 CL113 +01332 IF W-RPT-TYPE NOT = 'OR' CL115 +01333 SET W-RPT-ERROR-YES-88 TO TRUE CL113 +01334 MOVE SPACES TO R140-MESSAGE CL113 +01335 MOVE W-EMP-NO TO R140-EMP-NO CL113 +01336 STRING CL113 +01337 ':RPT- AMENDED RPT - CANNOT PROCESS ' CL144 +01338 ' ' W-RPT-TYPE CL116 +01339 DELIMITED BY SIZE CL113 +01340 INTO R140-MESSAGE CL113 +01341 END-STRING CL113 +01342 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01343 PERFORM S946-WRITE-R140 THRU S946-EXIT CL113 +01344 END-IF. CL113 +01345 CL113 +01346 DTSBX436 +01347 * IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR CL*82 +01348 * MOVE ZERO TO W-TOT-WAGE CL*82 +01349 * MOVE W-X140-REPORT-QTR TO W-CURR-RPT-QTR CL*82 +01350 * END-IF. CL*82 +01351 MOVE X140-TOTAL-WAGES TO W-TOT-WAGE. DTSBX436 +01352 MOVE X140-TAX-WAGES TO W-TAX-WAGE. DTSBX436 +01353 CL*44 +01354 * IF W-EMP-NO = 177462 CL*53 +01355 * MOVE 1352.07 TO X140-REMITTANCE CL*53 +01356 * DISPLAY ' X140-RMT ' X140-REMITTANCE. CL161 +01357 DTSBX436 +01358 MOVE X140-REMITTANCE TO W-X140-REMITTANCE. CL*53 +01359 * DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE. CL161 +01360 *& DTSBX436 +01361 CL*52 +01362 * DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND. CL161 +01363 CL*68 +01364 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0 CL170 +01365 * MOVE SPACES TO R140-MESSAGE CL170 +01366 * SET W-RPT-ERROR-YES-88 TO TRUE CL170 +01367 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01368 * STRING CL170 +01369 * 'ESSP AMT DUE > 0 AND NO PAYMT ' CL170 +01370 * DELIMITED BY SIZE CL170 +01371 * INTO R140-MESSAGE CL170 +01372 * END-STRING CL170 +01373 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01374 * MOVE R140-MESSAGE TO P434-MESSAGE CL170 +01375 * GO TO P2010-EDIT-CONTINUE CL170 +01376 * END-IF. CL170 +01377 CL*52 +01378 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0 CL170 +01379 * MOVE SPACES TO R140-MESSAGE CL170 +01380 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01381 * STRING CL170 +01382 * 'X140 REMIT AMT = 0 AND NO X145 FOUND -PROCESS ' CL170 +01383 * ' ' X140-REMITTANCE CL170 +01384 * DELIMITED BY SIZE CL170 +01385 * INTO R140-MESSAGE CL170 +01386 * END-STRING CL170 +01387 * MOVE R140-MESSAGE TO P434-MESSAGE CL170 +01388 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01389 * GO TO P2010-EDIT-CONTINUE CL170 +01390 * END-IF. CL170 +01391 CL*69 +01392 * IF W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE CL170 +01393 * MOVE SPACES TO R140-MESSAGE CL170 +01394 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01395 * SET W-WRITE-T025-TRAN-YES-88 TO TRUE CL108 +01396 * STRING CL170 +01397 * 'X430 X145-PAY AMT > X140-REMIT AMT --PROCESS ' CL170 +01398 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01399 * DELIMITED BY SIZE CL170 +01400 * INTO R140-MESSAGE CL170 +01401 * END-STRING CL170 +01402 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01403 * END-IF. CL170 +01404 CL*53 +01405 * IF W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE CL170 +01406 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01407 * MOVE SPACES TO R140-MESSAGE CL170 +01408 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01409 * STRING CL170 +01410 * 'X430 X145-PAY AMT < X140-REMIT AMT ' CL170 +01411 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01412 * DELIMITED BY SIZE CL170 +01413 * INTO R140-MESSAGE CL170 +01414 * END-STRING CL170 +01415 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01416 * END-IF. CL170 +01417 CL*67 +01418 * IF W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0 CL170 +01419 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01420 * MOVE SPACES TO R140-MESSAGE CL170 +01421 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01422 * STRING CL170 +01423 * 'X430 X145-PAY AMT > 0 AND X140-REMIT AMT = 0 ' CL170 +01424 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01425 * DELIMITED BY SIZE CL170 +01426 * INTO R140-MESSAGE CL170 +01427 * END-STRING CL170 +01428 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01429 * END-IF. CL170 +01430 CL*67 +01431 * IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE CL170 +01432 * ADD 1 TO W-T028-WRITEE-CNT CL170 +01433 * SET W-RPT-ERROR-NO-88 TO TRUE CL170 +01434 * MOVE SPACES TO R140-MESSAGE CL170 +01435 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01436 * STRING CL170 +01437 * 'X430 ++++ X145-REMIT AMT = X140-REMIT AMT ' CL170 +01438 * X145-REMITTANCE ' ' X140-REMITTANCE CL170 +01439 * DELIMITED BY SIZE CL170 +01440 * INTO R140-MESSAGE CL170 +01441 * END-STRING CL170 +01442 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01443 * END-IF. CL170 +01444 CL102 +01445 P2010-EDIT-CONTINUE. CL*69 +01446 * DISPLAY 'BX436 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES CL168 +01447 * ' TOT: ' X140-TOTAL-WAGES ' RMT: ' W-X140-REMITTANCE CL161 +01448 *& DTSBX436 +01449 MOVE ZERO TO W-X140-RECEIVED-DATE. CL*72 +01450 MOVE X140-RCVD-DATE TO W-SLASH-DATE. DTSBX436 +01451 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX436 +01452 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX436 +01453 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX436 +01454 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX436 +01455 IF NOT L001-VALID-DATE DTSBX436 +01456 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01457 MOVE SPACES TO R140-MESSAGE DTSBX436 +01458 MOVE W-EMP-NO TO R140-EMP-NO DTSBX436 +01459 STRING DTSBX436 +01460 ':RPT- INVALID RECEIVED DATE ' CL144 +01461 X140-RCVD-DATE CL**2 +01462 DELIMITED BY SIZE DTSBX436 +01463 INTO R140-MESSAGE DTSBX436 +01464 END-STRING DTSBX436 +01465 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01466 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX436 +01467 ELSE DTSBX436 +01468 MOVE L001-FED-8-DATE-9 TO W-X140-RECEIVED-DATE CL*72 +01469 END-IF. DTSBX436 +01470 DTSBX436 +01471 MOVE ZERO TO W-CHK-SCAN-DATE. DTSBX436 +01472 * IF X140-IN-HOUSE-88 DTSBX436 +01473 * MOVE X140-CHECK-SCAN-DT TO W-SLASH-DATE DTSBX436 +01474 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX436 +01475 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX436 +01476 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX436 +01477 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX436 +01478 * IF NOT L001-VALID-DATE DTSBX436 +01479 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01480 * MOVE SPACES TO R140-MESSAGE DTSBX436 +01481 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX436 +01482 * STRING DTSBX436 +01483 * 'REPORT: INVALID CHK SCAN DATE ' DTSBX436 +01484 * X140-CHECK-SCAN-DT DTSBX436 +01485 * DELIMITED BY SIZE DTSBX436 +01486 * INTO R140-MESSAGE DTSBX436 +01487 * END-STRING DTSBX436 +01488 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX436 +01489 ** DISPLAY R140-MESSAGE DTSBX436 +01490 * ELSE DTSBX436 +01491 * MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSBX436 +01492 * END-IF DTSBX436 +01493 * END-IF. DTSBX436 +01494 DTSBX436 +01495 MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT. DTSBX436 +01496 MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT. DTSBX436 +01497 MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT. DTSBX436 +01498 MOVE X140-WRKR-CNT-TOTAL TO W-WRKR-CNT-TOTAL. CL156 +01499 DTSBX436 +01500 DTSBX436 +01501 P2010-EXIT. DTSBX436 +01502 EXIT. DTSBX436 +01503 DTSBX436 +01504 P2012-CHECK-MPRF. CL**2 +01505 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX436 +01506 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX436 +01507 SET MPRF-PRF-88 TO TRUE. DTSBX436 +01508 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX436 +01509 DTSBX436 +01510 PERFORM S910-READ THRU S910-EXIT. DTSBX436 +01511 CL**2 +01512 IF L910-OK-88 CL**2 +01513 MOVE MSKL-REC TO MPRF-REC CL**2 +01514 MOVE W-X140-REPORT-QTR TO L516-YRQ CL*56 +01515 PERFORM S516-LIABILITY-INFO THRU S516-EXIT CL**2 +01516 IF L516-LIABLE-88 CL*57 +01517 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01518 SET W-EMP-FOUND-YES-88 TO TRUE CL*57 +01519 * DISPLAY 'X430 -EMPLOYER FOUND LIAB FOR QTR ' MPRF-EMP-NO CL161 +01520 GO TO P2012-EXIT CL*57 +01521 ELSE CL*57 +01522 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01523 MOVE SPACES TO R140-MESSAGE CL**2 +01524 MOVE W-EMP-NO TO R140-EMP-NO CL**2 +01525 STRING CL**2 +01526 ':EMP NOT LIABLE FOR QTRLY RPT ' CL144 +01527 X140-QUARTER CL**7 +01528 DELIMITED BY SIZE CL**2 +01529 INTO R140-MESSAGE CL**2 +01530 END-STRING CL**2 +01531 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01532 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 +01533 SET W-EMP-FOUND-NO-88 TO TRUE CL**2 +01534 GO TO P2012-EXIT CL*51 +01535 ELSE CL*51 +01536 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01537 MOVE SPACES TO R140-MESSAGE CL*51 +01538 MOVE W-EMP-NO TO R140-EMP-NO CL*51 +01539 STRING CL*51 +01540 ':EMP NOT FOUND ON DUTAS-CANNOT PRCESS RPT' CL144 +01541 X140-EMP-NO CL*51 +01542 DELIMITED BY SIZE CL*51 +01543 INTO R140-MESSAGE CL*51 +01544 END-STRING CL*51 +01545 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01546 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*51 +01547 SET W-EMP-FOUND-NO-88 TO TRUE CL*51 +01548 END-IF. CL*51 +01549 CL**2 +01550 P2012-EXIT. CL**2 +01551 EXIT. DTSBX436 +01552 DTSBX436 +01553 CL**2 +01554 P2013-CHECK-MQTR. CL**2 +01555 DISPLAY 'P2013 X140 X140 REPORT FROM ESSP- ' CL187 +01556 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL183 +01557 DISPLAY ' ' CL183 +01558 MOVE LOW-VALUE TO MQTR-KEY-AREA. CL**2 +01559 MOVE W-EMP-NO TO MQTR-EMP-NO. CL**2 +01560 SET MQTR-QTR-88 TO TRUE. CL**2 +01561 MOVE W-X140-REPORT-QTR TO MQTR-YRQ. CL*56 +01562 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL**2 +01563 CL**2 +01564 PERFORM S910-READ THRU S910-EXIT. CL**2 +01565 CL*35 +01566 IF L910-NO-REC-88 CL187 +01567 DISPLAY 'P2013 X430 NO REC FOUND ' L910-RESULT-IND CL188 +01568 ELSE CL187 +01569 IF L910-OK-88 CL187 +01570 DISPLAY 'P2013 X430 REC FOUND ' L910-RESULT-IND CL188 +01571 ELSE CL187 +01572 DISPLAY 'P2013 X430 NOT SURE ' L910-RESULT-IND. CL188 +01573 CL187 +01574 IF L910-NO-REC-88 AND W-RPT-TYPE = 'OR' CL187 +01575 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01576 DISPLAY 'P2013 X430 ORIG RPT NOT ON DUTAS- PROCESS ' CL183 +01577 W-EMP-NO ' ' W-X140-REPORT-QTR CL183 +01578 DISPLAY ' ' CL183 +01579 GO TO P2013-EXIT. CL*35 +01580 CL*35 +01581 CL183 +01582 IF L910-NO-REC-88 CL*35 +01583 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01584 DISPLAY 'P2013 X430 QTR RPT NOT ON DUTAS- NOT ORG ' CL197 +01585 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO ' ' MQTR-YRQ CL186 +01586 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01587 MOVE SPACES TO R140-MESSAGE CL*35 +01588 MOVE W-EMP-NO TO R140-EMP-NO CL*35 +01589 STRING CL*35 +01590 'P2013 -EMP NOT ON DUTAS AND X140 INV RPT TYPE ' CL185 +01591 W-RPT-TYPE CL*35 +01592 DELIMITED BY SIZE CL*35 +01593 INTO R140-MESSAGE CL*35 +01594 END-STRING CL*35 +01595 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*35 +01596 SET W-EMP-FOUND-NO-88 TO TRUE CL*35 +01597 GO TO P2013-EXIT. CL*35 +01598 CL*35 +01599 CL*35 +01600 MOVE MSKL-REC TO MQTR-REC CL201 +01601 CL**3 +01602 PERFORM P2014-NEXT-MQTR THRU P2014-EXIT CL**3 +01603 UNTIL L910-NO-REC-88. CL**3 +01604 CL**3 +01605 P2013-EXIT. CL**3 +01606 EXIT. CL**2 +01607 CL**2 +01608 P2014-NEXT-MQTR. CL**3 +01609 IF L910-NO-REC-88 AND W-RPT-TYPE = 'OR' CL*33 +01610 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01611 DISPLAY 'P2013 X430 ORIG RPT NOT ON DUTAS- PROCESS ' CL183 +01612 W-EMP-NO ' ' W-X140-REPORT-QTR CL183 +01613 DISPLAY ' ' CL183 +01614 GO TO P2014-EXIT. CL*32 +01615 CL198 +01616 IF L910-NO-REC-88 CL198 +01617 SET W-RPT-ERROR-YES-88 TO TRUE CL198 +01618 DISPLAY 'X430 ORIG RPT NOT ON DUTAS - ERROR EA RPT ' CL198 +01619 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE CL198 +01620 DISPLAY ' ' CL198 +01621 GO TO P2014-EXIT. CL198 +01622 CL198 +01623 CL**3 +01624 MOVE MSKL-REC TO MQTR-REC CL**3 +01625 CL**3 +01626 IF MQTR-YRQ NOT = W-X140-REPORT-QTR CL195 +01627 DISPLAY 'P2013 X430 QTR RPT NOT ON DUTAS ' CL195 +01628 MQTR-EMP-NO ' ' MQTR-YRQ ' RPT-TYP ' MQTR-CURR-RPT-TYPE CL194 +01629 ' PUR-IND ' MQTR-PURSUED-RPT-IND CL194 +01630 ' CUT-OFF ' MQTR-MISS-RPT-CUTOFF-CD CL195 +01631 SET L910-NO-REC-88 TO TRUE CL195 +01632 SET W-RPT-ERROR-NO-88 TO TRUE CL202 +01633 GO TO P2014-EXIT. CL195 +01634 CL195 +01635 DISPLAY 'PXXXX QTR RPT FOUND ON DUTAS ' CL195 +01636 MQTR-EMP-NO ' ' MQTR-YRQ ' RPT-TYP ' MQTR-CURR-RPT-TYPE CL195 +01637 ' PUR-IND ' MQTR-PURSUED-RPT-IND CL195 +01638 ' CUT-OFF ' MQTR-MISS-RPT-CUTOFF-CD CL195 +01639 CL*28 +01640 IF MQTR-CURR-DELINQ-88 AND W-RPT-TYPE = 'OR' AND CL195 +01641 MQTR-RPT-IS-PURSUED-88 CL195 +01642 SET L910-NO-REC-88 TO TRUE CL**3 +01643 SET W-RPT-ERROR-NO-88 TO TRUE CL195 +01644 MOVE SPACES TO R140-MESSAGE CL**3 +01645 GO TO P2014-EXIT. CL193 +01646 CL193 +01647 IF MQTR-CURR-ORIG-88 AND W-RPT-TYPE = 'OR' CL195 +01648 SET L910-NO-REC-88 TO TRUE CL195 +01649 SET W-RPT-ERROR-YES-88 TO TRUE CL195 +01650 MOVE SPACES TO R140-MESSAGE CL195 +01651 MOVE W-EMP-NO TO R140-EMP-NO CL195 +01652 STRING CL195 +01653 ':ORIX RPT IN DUTAS CANNOT PROCESS ' CL195 +01654 X140-QUARTER CL195 +01655 DELIMITED BY SIZE CL195 +01656 INTO R140-MESSAGE CL195 +01657 END-STRING CL195 +01658 MOVE R140-MESSAGE TO P434-MESSAGE CL195 +01659 PERFORM S946-WRITE-R140 THRU S946-EXIT CL195 +01660 GO TO P2014-EXIT. CL195 +01661 CL195 +01662 IF MQTR-CURR-ESTIM-88 AND W-RPT-TYPE = 'OR' CL182 +01663 SET L910-NO-REC-88 TO TRUE CL182 +01664 SET W-RPT-ERROR-NO-88 TO TRUE CL182 +01665 MOVE SPACES TO R140-MESSAGE CL182 +01666 MOVE W-EMP-NO TO R140-EMP-NO CL182 +01667 STRING CL182 +01668 'X430 ESTIM RPT ON FILE - OR REPORT PROCESS ' CL182 +01669 X140-QUARTER CL182 +01670 DELIMITED BY SIZE CL182 +01671 INTO R140-MESSAGE CL182 +01672 END-STRING CL182 +01673 PERFORM S946-WRITE-R140 THRU S946-EXIT CL182 +01674 GO TO P2014-EXIT. CL182 +01675 CL**3 +01676 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**3 +01677 IF L910-NO-REC-88 CL*52 +01678 DISPLAY 'X430 END OF QUARTER CHECK FOR EMPLOYER ' CL*52 +01679 W-EMP-NO ' ' W-X140-REPORT-QTR. CL*56 +01680 CL**3 +01681 P2014-EXIT. CL**3 +01682 EXIT. CL**3 +01683 CL**3 +01684 P2020-SAVE-EXT-REPORT. DTSBX436 +01685 * DISPLAY 'P2020-SAVE-EXT-REPORT ' CL161 +01686 ************************************************************ DTSBX436 +01687 * REPORTS FROM EXTERNAL SOURCES. REPORTS WILL BE DTSBX436 +01688 * ASSEMBLED INTO BATCHES IN DTSBD140. CHANGED ALL T027 DTSBX436 +01689 * TO BE T028 PER DOCUMENTATION IN BD140 FROM GIL 4/10/12 DTSBX436 +01690 ************************************************************ DTSBX436 +01691 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBX436 +01692 MOVE '028' TO T028-REC-TYPE. DTSBX436 +01693 DTSBX436 +01694 MOVE W-EMP-NO TO T028-EMP-NO. DTSBX436 +01695 MOVE 'WEB ESSP' TO T028-ORIGIN. DTSBX436 +01696 MOVE LX42-SYS-DATE TO T028-SYS-DATE. DTSBX436 +01697 MOVE LX42-SYS-TIME TO T028-SYS-TIME. DTSBX436 +01698 SET T028-WEB-RPT-88 TO TRUE. DTSBX436 +01699 DTSBX436 +01700 MOVE LX42-EXT-PSEUDO-BATCH TO T028-PSEUDO-BATCH-NO. DTSBX436 +01701 MOVE LX42-EXT-PSEUDO-ITEM TO T028-PSEUDO-ITEM-NO. DTSBX436 +01702 DTSBX436 +01703 MOVE W-X140-REPORT-QTR TO T028-YRQ. CL*56 +01704 IF W-EMP-FOUND-YES-88 DTSBX436 +01705 MOVE MPRF-PRIMARY-NAME (1:4) DTSBX436 +01706 TO T028-NAME-CHECK DTSBX436 +01707 ELSE DTSBX436 +01708 MOVE SPACES TO T028-NAME-CHECK DTSBX436 +01709 END-IF. DTSBX436 +01710 MOVE W-RPT-TYPE TO T028-RPT-TYPE. DTSBX436 +01711 DTSBX436 +01712 **************************************************************** DTSBX436 +01713 * LX42-LAST-DETERM-EMP IS SET BY DTSBX420 WHEN PROCESSING DTSBX436 +01714 * A DETERMINATION. IT IS USED TO DETERMINE WHEN TO WAIVE DTSBX436 +01715 * P & I. THE WAIVER IS AUTOMATIC FOR REPORTS WITHIN DTSBX436 +01716 * THE LAST 5 QUARTERS SUBMITTED ALONG WITH A WEB DTSBX436 +01717 * REGISTRATION. DTSBX436 +01718 **************************************************************** DTSBX436 +01719 IF (W-EMP-NO = LX42-LAST-DETERM-EMP DTSBX436 +01720 AND W-X140-REPORT-QTR >= W-WAIVER-QTR) CL*56 +01721 SET T028-WAIVE-BOTH-YES-88 TO TRUE DTSBX436 +01722 ELSE DTSBX436 +01723 SET T028-WAIVE-BOTH-NO-88 TO TRUE DTSBX436 +01724 END-IF. DTSBX436 +01725 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBX436 +01726 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBX436 +01727 MOVE W-X140-RECEIVED-DATE TO T028-RECEIVED-DATE. CL189 +01728 MOVE ZEROS TO T028-DEPOSIT-DATE. CL189 +01729 DTSBX436 +01730 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSBX436 +01731 DTSBX436 +01732 IF W-EMP-FOUND-NO-88 DTSBX436 +01733 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX436 +01734 COMPUTE T028-EXCESS-WAGE = DTSBX436 +01735 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX436 +01736 ELSE DTSBX436 +01737 IF MPRF-CLASS-SELF-INS-88 DTSBX436 +01738 MOVE ZERO TO T028-TAX-WAGE DTSBX436 +01739 T028-EXCESS-WAGE DTSBX436 +01740 ELSE DTSBX436 +01741 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX436 +01742 COMPUTE T028-EXCESS-WAGE = DTSBX436 +01743 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX436 +01744 END-IF DTSBX436 +01745 END-IF. DTSBX436 +01746 DTSBX436 +01747 MOVE W-WRKR-CNT-TOTAL TO T028-TOTAL-EMPL-CNT. CL156 +01748 MOVE W-1ST-MNTH-CNT TO T028-1ST-MTH-EMPL-CNT. CL156 +01749 MOVE W-2ND-MNTH-CNT TO T028-2ND-MTH-EMPL-CNT. CL156 +01750 MOVE W-3RD-MNTH-CNT TO T028-3RD-MTH-EMPL-CNT. CL156 +01751 DTSBX436 +01752 * DISPLAY ' X145 PAY AMT ' X145-REMITTANCE CL156 +01753 * DISPLAY ' X140 PAY AMT ' X140-REMITTANCE CL156 +01754 CL108 +01755 MOVE W-X145-TOT-REMIT-AMT TO W-X140-REMITTANCE CL108 +01756 MOVE ZEROS TO T028-REMIT-AMT. CL170 +01757 DTSBX436 +01758 * ADD W-X145-TOT-REMIT-AMT TO W-TOT-REMIT-AMT. CL170 +01759 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBX436 +01760 DTSBX436 +01761 MOVE ZERO TO T028-TRACE-NO. CL193 +01762 DTSBX436 +01763 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBX436 +01764 MOVE 'WEBESSP ' TO T028-RESPONSIBLE-OP-ID. DTSBX436 +01765 DTSBX436 +01766 * DISPLAY 'BX436 WEB RPT ' X140-EMP-NO ' ' X140-QUARTER. CL168 +01767 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSBX436 +01768 DTSBX436 +01769 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. CL124 +01770 CL124 +01771 * DISPLAY W-EMP-NO ',' T028-TOT-WAGE CL124 +01772 * ',' T028-EXCESS-WAGE CL124 +01773 * ',' T028-TAX-WAGE CL124 +01774 * ',' X140-REMITTANCE CL124 +01775 * ',' X145-REMITTANCE. CL124 +01776 CL110 +01777 IF W-X140-REMITTANCE > 0 CL100 +01778 ADD 1 TO W-T028-WRITE-CNT CL100 +01779 ELSE CL100 +01780 ADD 1 TO W-T028-WRITE-CNT CL100 +01781 ADD 1 TO W-T028-WRITEO-CNT. CL100 +01782 CL100 +01783 * IF W-WRITE-T025-TRAN-YES-88 CL108 +01784 * PERFORM P2021-WRITE-T025 THRU P2021-EXIT CL108 +01785 * ELSE CL108 +01786 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01787 MOVE SPACES TO R140-MESSAGE CL*71 +01788 MOVE W-EMP-NO TO R140-EMP-NO CL*71 +01789 STRING CL*71 +01790 'X430 -:>>>>> REPORT ADDED TO DUTAS - ' X140-QUARTER CL*93 +01791 DELIMITED BY SIZE CL*71 +01792 INTO R140-MESSAGE CL*71 +01793 END-STRING CL*71 +01794 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71 +01795 P2020-EXIT. DTSBX436 +01796 EXIT. DTSBX436 +01797 DTSBX436 +01798 P2021-WRITE-T025. CL*71 +01799 ** CL*73 +01800 **PAYMENT TRANSACTION REMIT AMT > THAN REPORT REMIT AMT, SUBTRACT CL*73 +01801 **DIFFERENCE AND WRITE A PA T025 TRANSACTION. CL*73 +01802 ** CL*73 +01803 DISPLAY 'PAYMENT OK ' X145-EMP-NO. CL*71 +01804 CL*71 +01805 MOVE LENGTH OF T025-REC TO T025-LENGTH CL*71 +01806 MOVE '025' TO T025-REC-TYPE. CL*71 +01807 CL*71 +01808 MOVE W-EMP-NO TO T025-EMP-NO. CL*71 +01809 MOVE 'WEB PAY' TO T025-ORIGIN. CL*71 +01810 MOVE LX42-SYS-DATE TO T025-SYS-DATE. CL*71 +01811 MOVE LX42-SYS-TIME TO T025-SYS-TIME. CL*71 +01812 * CL*71 +01813 IF W-PAY-TYPE = '00' OR '02' CL208 +01814 MOVE W-X145-PAYMENT-QTR TO T025-APPLIC-YRQ CL209 +01815 ELSE CL208 +01816 MOVE W-X145-PAYMENT-QTR TO T025-APPLIC-YRQ. CL208 +01817 MOVE 'PA' TO T025-PAY-TYPE CL189 +01818 CL*71 +01819 MOVE SPACES TO T025-APPLIC-IND. CL*71 +01820 MOVE ZERO TO T025-APPLIC-BATCH-NO CL*71 +01821 T025-APPLIC-ITEM-NO. CL*71 +01822 CL*71 +01823 IF W-EMP-FOUND-YES-88 CL*71 +01824 MOVE MPRF-PRIMARY-NAME (1:4) CL*71 +01825 TO T025-NAME-CHECK CL*71 +01826 ELSE CL*71 +01827 MOVE SPACES TO T025-NAME-CHECK CL*71 +01828 END-IF. CL*71 +01829 CL*71 +01830 MOVE W-X145-RECEIVED-DATE TO T025-RECEIVED-DATE CL*72 +01831 T025-DEPOSIT-DATE. CL*71 +01832 CL*71 +01833 MOVE W-X145-TOT-REMIT-AMT TO W-T025-REMIT-AMT CL170 +01834 CL*71 +01835 MOVE W-T025-REMIT-AMT TO T025-REMIT-AMT. CL*71 +01836 CL*71 +01837 CL189 +01838 IF X145-TRACE-NO > SPACES CL191 +01839 MOVE X145-TRACE-NO TO T025-TRACE-NO CL192 +01840 ELSE CL189 +01841 MOVE ZEROS TO T025-TRACE-NO. CL189 +01842 CL*71 +01843 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*71 +01844 IF W-PAY-TYPE = '02' CL208 +01845 MOVE 'TDECCHK' TO T025-RESPONSIBLE-OP-ID CL208 +01846 ELSE CL208 +01847 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL208 +01848 CL*71 +01849 * MOVE T025-REC TO TSKL-REC. CL*71 +01850 * PERFORM S927B-WRITE THRU S927B-EXIT. CL*71 +01851 CL*71 +01852 PERFORM S1033-WRITE-TEMP-T025 THRU S1033-EXIT. CL*71 +01853 ADD +1 TO W-T025-WRITE-CNT. CL*71 +01854 CL*71 +01855 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. CL177 +01856 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL203 +01857 MOVE ZEROS TO W-T025-REMIT-AMT CL*72 +01858 W-X145-TOT-REMIT-AMT CL*72 +01859 W-X140-REMITTANCE. CL*72 +01860 CL*72 +01861 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*72 +01862 CL*71 +01863 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01864 MOVE SPACES TO R140-MESSAGE CL*71 +01865 MOVE W-EMP-NO TO R140-EMP-NO CL*71 +01866 STRING CL*71 +01867 'X430 -: >>>>> PAYMENT T025 CREATED ' CL170 +01868 'REMIT AMT' CL*93 +01869 DELIMITED BY SIZE CL*71 +01870 INTO R140-MESSAGE CL*71 +01871 END-STRING CL*71 +01872 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71 +01873 P2021-EXIT. CL*71 +01874 EXIT. CL*71 +01875 CL*71 +01876 DTSBX436 +01877 P3000-WAGES. DTSBX436 +01878 MOVE LX42-DATA-AREA TO X144-REC. DTSBX436 +01879 * DISPLAY 'X144: ' X144-REC. CL161 +01880 MOVE X144-EMP-NO TO W-EMP-NO. CL*38 +01881 * CL**4 +01882 ADD +1 TO W-X144-RED-CNT CL*96 +01883 SET W-RPT-ERROR-NO-88 TO TRUE. CL147 +01884 * SET W-PREV-REC-WAGE-88 TO TRUE. CL*83 +01885 * CL**4 +01886 * DISPLAY 'LX-E ' LX42-X140-EMP-NO ' X145-E ' W-EMP-NO. CL*97 +01887 * IF LX42-X145-EMP-NO = '999999' OR CL170 +01888 * LX42-X140-EMP-NO = '999999' OR CL170 +01889 * LX42-X145-EMP-NO = SPACES OR CL170 +01890 * LX42-X140-EMP-NO = SPACES OR CL170 +01891 * W-PREV-RPT-NULL-88 CL170 +01892 * SET W-RPT-ERROR-YES-88 TO TRUE CL170 +01893 * MOVE SPACES TO R140-MESSAGE CL170 +01894 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01895 * STRING CL170 +01896 * 'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES ' CL170 +01897 * ' ' X144-QUARTER CL170 +01898 * DELIMITED BY SIZE CL170 +01899 * INTO R140-MESSAGE CL170 +01900 * END-STRING CL170 +01901 * WRITE PEND-X144-REC FROM X144-REC CL170 +01902 * ADD +1 TO W-X144-ERR-CNT CL170 +01903 * ADD +1 TO W-X144-PEN-CNT CL170 +01904 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL117 +01905 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*83 +01906 * GO TO P3000-EXIT. CL170 +01907 CL*36 +01908 * CL**4 +01909 * IF W-PREV-RPT-RPT-88 CL170 +01910 * OR W-PREV-RPT-WAGE-88 CL170 +01911 * SET W-PREV-RPT-WAGE-88 TO TRUE CL170 +01912 ADD +1 TO W-X144-PRO-CNT CL*56 +01913 PERFORM P3010-EDIT-WAGES THRU P3010-EXIT DTSBX436 +01914 IF W-RPT-ERROR-NO-88 CL*81 +01915 PERFORM P3011-WRITE-WAGES-X144 THRU P3011-EXIT DTSBX436 +01916 ADD +1 TO W-X144-SAV-CNT CL*96 +01917 ELSE CL*36 +01918 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01919 MOVE SPACES TO R140-MESSAGE CL*36 +01920 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +01921 STRING CL*36 +01922 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' CL*47 +01923 ' ' X144-SSN CL*36 +01924 DELIMITED BY SIZE CL*36 +01925 INTO R140-MESSAGE CL*36 +01926 END-STRING CL*36 +01927 ADD +1 TO W-X144-ERR-CNT CL*93 +01928 ADD +1 TO W-X144-PEN-CNT CL*96 +01929 WRITE PEND-X144-REC FROM X144-REC CL*93 +01930 PERFORM P6000-WRITE-PEND-X144 THRU P6000-EXIT CL144 +01931 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +01932 GO TO P3000-EXIT. CL170 +01933 * ELSE CL170 +01934 * SET W-RPT-ERROR-YES-88 TO TRUE CL170 +01935 * MOVE SPACES TO R140-MESSAGE CL170 +01936 * MOVE W-EMP-NO TO R140-EMP-NO CL170 +01937 * STRING CL170 +01938 * 'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING ' CL170 +01939 * ' ' X144-SSN CL170 +01940 * DELIMITED BY SIZE CL170 +01941 * INTO R140-MESSAGE CL170 +01942 * END-STRING CL170 +01943 * WRITE PEND-X144-REC FROM X144-REC CL170 +01944 * ADD +1 TO W-X144-ERR-CNT CL170 +01945 * ADD +1 TO W-X144-PEN-CNT CL170 +01946 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL*93 +01947 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL170 +01948 * END-IF. CL170 +01949 DTSBX436 +01950 P3000-EXIT. DTSBX436 +01951 EXIT. DTSBX436 +01952 DTSBX436 +01953 P3010-EDIT-WAGES. DTSBX436 +01954 * DISPLAY 'P3010-EDIT-WAGES ' CL*97 +01955 * DISPLAY 'X144-QUARTER ' X144-QUARTER CL*36 +01956 MOVE X144-QUARTER TO W-SLASH-QTR. DTSBX436 +01957 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX436 +01958 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX436 +01959 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX436 +01960 IF NOT L004-VALID-QTR DTSBX436 +01961 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01962 MOVE SPACES TO R140-MESSAGE DTSBX436 +01963 MOVE W-EMP-NO TO R140-EMP-NO DTSBX436 +01964 STRING DTSBX436 +01965 ': WAGE RECORD HAS INVALID QUARTER ' CL144 +01966 X144-QUARTER ' ' X144-SSN CL*36 +01967 DELIMITED BY SIZE DTSBX436 +01968 INTO R140-MESSAGE DTSBX436 +01969 END-STRING DTSBX436 +01970 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +01971 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX436 +01972 ELSE CL*13 +01973 MOVE L004-QTR-5-9 TO W-X144-WAGE-QTR CL*53 +01974 END-IF. DTSBX436 +01975 CL*15 +01976 * IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR CL164 +01977 * SET W-RPT-ERROR-YES-88 TO TRUE CL164 +01978 * MOVE SPACES TO R140-MESSAGE CL164 +01979 * MOVE W-EMP-NO TO R140-EMP-NO CL164 +01980 * MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR CL164 +01981 * STRING CL164 +01982 * ':WAGE QTR NOT = RPT QTR ' CL164 +01983 * X144-QUARTER ' ' WRK-REPORT-QTR CL164 +01984 * DELIMITED BY SIZE CL164 +01985 * INTO R140-MESSAGE CL164 +01986 * END-STRING CL164 +01987 * MOVE R140-MESSAGE TO P434-MESSAGE CL164 +01988 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL164 +01989 * END-IF. CL164 +01990 DTSBX436 +01991 IF X144-SSN NOT NUMERIC DTSBX436 +01992 * DISPLAY 'X144-SSN ' X144-SSN CL*36 +01993 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01994 MOVE SPACES TO R140-MESSAGE DTSBX436 +01995 MOVE W-EMP-NO TO R140-EMP-NO DTSBX436 +01996 STRING DTSBX436 +01997 ':WAGE RECORD NON-NUMERIC SSN ' CL144 +01998 X144-SSN DTSBX436 +01999 DELIMITED BY SIZE DTSBX436 +02000 INTO R140-MESSAGE DTSBX436 +02001 END-STRING DTSBX436 +02002 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02003 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX436 +02004 ELSE DTSBX436 +02005 MOVE X144-SSN TO W-SSN DTSBX436 +02006 END-IF. DTSBX436 +02007 DTSBX436 +02008 IF X144-SSN = ZEROS CL*53 +02009 * DISPLAY 'X144-SSN ' X144-SSN CL*53 +02010 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02011 MOVE SPACES TO R140-MESSAGE CL*53 +02012 MOVE W-EMP-NO TO R140-EMP-NO CL*53 +02013 STRING CL*53 +02014 ':WAGE RECORD SSN = ZEROS ' CL144 +02015 X144-SSN CL*53 +02016 DELIMITED BY SIZE CL*53 +02017 INTO R140-MESSAGE CL*53 +02018 END-STRING CL*53 +02019 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02020 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*53 +02021 ELSE CL*53 +02022 MOVE X144-SSN TO W-SSN CL*53 +02023 END-IF. CL*53 +02024 CL*53 +02025 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME CL161 +02026 * ' FN: ' X144-FIRST-NAME. CL161 +02027 IF X144-LAST-NAME = SPACES CL*36 +02028 * SET W-RPT-ERROR-YES-88 TO TRUE CL164 +02029 MOVE SPACES TO R140-MESSAGE CL*36 +02030 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +02031 STRING CL*36 +02032 ':WARNING-SSN LNAME IS BLANK ' CL164 +02033 X144-SSN CL*36 +02034 DELIMITED BY SIZE CL*36 +02035 INTO R140-MESSAGE CL*36 +02036 END-STRING CL*36 +02037 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02038 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +02039 END-IF. CL*36 +02040 CL*36 +02041 IF X144-FIRST-NAME = SPACES CL*36 +02042 * SET W-RPT-ERROR-YES-88 TO TRUE CL164 +02043 MOVE SPACES TO R140-MESSAGE CL*36 +02044 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +02045 STRING CL*36 +02046 ':WARNING - SSN FNAME IS BLANK ' CL164 +02047 X144-SSN CL*36 +02048 DELIMITED BY SIZE CL*36 +02049 INTO R140-MESSAGE CL*36 +02050 END-STRING CL*36 +02051 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02052 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +02053 END-IF. CL*36 +02054 CL*36 +02055 * IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR DTSBX436 +02056 * MOVE ZERO TO W-WRKR-TOT-WAGE DTSBX436 +02057 * MOVE W-WAGE-QTR TO W-CURR-WAGE-QTR DTSBX436 +02058 * END-IF. DTSBX436 +02059 DTSBX436 +02060 * MOVE X144-EARNINGS TO W-EARNINGS-X. DTSBX436 +02061 * MOVE W-EARNINGS-9 TO W-EARNINGS. DTSBX436 +02062 * ADD W-EARNINGS TO W-WRKR-TOT-WAGE. DTSBX436 +02063 * DISPLAY 'X144-LAST-NAME ' X144-LAST-NAME DTSBX436 +02064 * MOVE X144-LAST-NAME TO W-WRKR-LAST-NAME. DTSBX436 +02065 * MOVE X144-FIRST-NAME TO W-WRKR-FIRST-NAME. DTSBX436 +02066 * MOVE X144-MID-INIT TO W-WRKR-MID-INIT. DTSBX436 +02067 DTSBX436 +02068 P3010-EXIT. DTSBX436 +02069 EXIT. DTSBX436 +02070 DTSBX436 +02071 P3011-WRITE-WAGES-X144. DTSBX436 +02072 DTSBX436 +02073 ************************************************************** CL*11 +02074 * WRITE W4 WAGES FOR DOCS CL*11 +02075 ************************************************************** CL*11 +02076 * CL*11 +02077 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. CL*11 +02078 MOVE X144-SSN TO W4-SSN. CL*11 +02079 MOVE 'W4' TO W4-TRAN-ID. CL*11 +02080 MOVE '00044001' TO W4-TRAN-OPER-ID. CL*11 +02081 MOVE MHDR-CURR-RUN-DATE TO W4-DATE-ENTERED. CL*11 +02082 MOVE ZEROS TO W4-TIME-ENTERED. CL*11 +02083 MOVE X144-LAST-NAME (1:3) TO W4-NAME-CHECK. CL*11 +02084 MOVE W-X144-WAGE-QTR TO W4-QUARTER. CL118 +02085 MOVE X144-EARNINGS TO W4-QUARTER-EARNINGS. CL*11 +02086 MOVE 2 TO W4-AFFI-CODE. CL*11 +02087 MOVE X144-EMP-NO TO W4-ACCOUNT. CL*11 +02088 MOVE MPRF-PRIMARY-NAME (1:4) TO W4-EMP-NAME. CL*11 +02089 CL*11 +02090 * MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. CL*20 +02091 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +02092 CL*11 +02093 * WRITE WAGE-TRANS-REC. CL*20 +02094 WRITE WAGE-OUT-REC. CL*20 +02095 CL*11 +02096 IF WAGE-TEMP-STATUS-OK-88 CL*32 +02097 ADD +1 TO W-W4-CNT CL*11 +02098 * DISPLAY 'WRITE W4 ' W4-ACCOUNT ' ' W4-QUARTER CL*36 +02099 * ' ' W4-SSN CL*36 +02100 ELSE CL*11 +02101 DISPLAY 'ERROR WRITING W4- WAGE FILE ' CL*36 +02102 WAGE-TEMP-STATUS CL*32 +02103 END-IF. CL*11 +02104 CL*11 +02105 CL*11 +02106 P3011-EXIT. CL*25 +02107 EXIT. DTSBX436 +02108 P4000-WRITE-X434-PAID-REPT. CL119 +02109 CL119 +02110 MOVE X140-EMP-NO TO X434-EMP-NO CL119 +02111 MOVE X140-QUARTER TO X434-QTR CL125 +02112 * IF W-EMP-FOUND-YES-88 CL174 +02113 * MOVE MPRF-PRIMARY-NAME (1:15) CL174 +02114 * TO X434-NAME-CHECK CL174 +02115 * ELSE CL174 +02116 MOVE 'RPT' TO X434-NAME-CHECK CL174 +02117 * END-IF. CL174 +02118 CL119 +02119 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL121 +02120 MOVE T028-TOT-WAGE TO X434-TOT-WAGE CL119 +02121 MOVE T028-EXCESS-WAGE TO X434-EXC-WAGE CL119 +02122 MOVE T028-TAX-WAGE TO X434-TAX-WAGE CL119 +02123 MOVE X140-REMITTANCE TO X434-X140-REMIT CL119 +02124 WS-X140-REMITTANCE CL149 +02125 MOVE W-X140-REMITTANCE TO X434-X145-REMIT CL119 +02126 CL148 +02127 COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL149 +02128 WS-X140-REMITTANCE. CL149 +02129 CL149 +02130 MOVE W-T025-REMIT-AMT TO X434-DIFF. CL149 +02131 ADD W-T025-REMIT-AMT TO WS-T025-REMIT-AMT. CL174 +02132 CL148 +02133 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL121 +02134 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL125 +02135 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL125 +02136 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL125 +02137 CL119 +02138 * IF W-ERROR-NO-88 CL120 +02139 * MOVE 'PROCESSED' TO X434-DISPOSITION CL120 +02140 * ELSE CL120 +02141 * MOVE 'PENDING ' TO X434-DISPOSITION. CL120 +02142 * MOVE R140-MESSAGE TO X434-MESSAGE CL120 +02143 CL119 +02144 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL121 +02145 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. CL120 +02146 ADD 1 TO WS-LINE-CNT2. CL119 +02147 ADD +1 TO WS-NUMBER-ONE. CL119 +02148 CL119 +02149 CL119 +02150 P4000-EXIT. CL119 +02151 EXIT. CL119 +02152 P4100-PRINT-HEADER. CL121 +02153 IF WS-LINE-CNT GREATER 58 OR CL121 +02154 WS-LINE-CNT2 GREATER 58 CL121 +02155 MOVE +0 TO WS-LINE-CNT CL121 +02156 MOVE +0 TO WS-LINE-CNT2 CL121 +02157 ADD +1 TO WS-PAGE-CNT CL121 +02158 MOVE WS-PAGE-CNT TO HDR3-PAGE CL121 +02159 MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME CL156 +02160 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL122 +02161 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL122 +02162 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL122 +02163 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL122 +02164 WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL153 +02165 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL122 +02166 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL122 +02167 ADD +6 TO WS-LINE-CNT2. CL121 +02168 P4100-EXIT. CL121 +02169 EXIT. CL121 +02170 CL121 +02171 P4200-PRINT-HEADER. CL133 +02172 IF WSP-LINE-CNT GREATER 58 OR CL133 +02173 WSP-LINE-CNT2 GREATER 58 CL133 +02174 MOVE +0 TO WSP-LINE-CNT CL133 +02175 MOVE +0 TO WSP-LINE-CNT2 CL133 +02176 ADD +1 TO WSP-PAGE-CNT CL133 +02177 MOVE WSP-PAGE-CNT TO HDR31-PAGE CL133 +02178 MOVE ' * REASON FOR PENDING *' TO HDR5-NAME CL138 +02179 WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL133 +02180 WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1 CL133 +02181 WRITE REPT-PEND-REC FROM HEADER-31 AFTER 1 CL133 +02182 WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1 CL133 +02183 WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1 CL144 +02184 WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1 CL133 +02185 WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1 CL133 +02186 ADD +6 TO WSP-LINE-CNT2. CL133 +02187 P4200-EXIT. CL133 +02188 EXIT. CL133 +02189 CL133 +02190 DTSBX436 +02191 P5000-NEW-EMP. DTSBX436 +02192 *& DTSBX436 +02193 DISPLAY ' 5000-NEW-EMP ' W-EMP-NO ' ' W-PREV-REC-TYPE CL196 +02194 ' ERROR-IND ' W-RPT-ERROR-IND. CL196 +02195 * IF W-PREV-RPT-PAY-88 AND CL196 +02196 * W-RPT-ERROR-NO-88 CL196 +02197 * LX42-X140-EMP-NO = SPACES AND CL*85 +02198 * LX42-X145-EMP-NO = SPACES CL*85 +02199 * ADD +1 TO W-X145-PEN-CNT CL196 +02200 * WRITE PEND-X145-REC FROM X145-REC CL196 +02201 * MOVE SPACES TO R140-MESSAGE CL196 +02202 * MOVE W-EMP-NO TO R140-EMP-NO CL196 +02203 * STRING CL196 +02204 * ': NO REPORT FOR PAYMENT ' CL196 +02205 * DELIMITED BY SIZE CL196 +02206 * INTO R140-MESSAGE CL196 +02207 * END-STRING CL196 +02208 * MOVE R140-MESSAGE TO P434-MESSAGE CL196 +02209 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL196 +02210 * PERFORM S946-WRITE-R140 THRU S946-EXIT. CL196 +02211 CL*82 +02212 * DISPLAY 'BX436 P5000-NEW-RPT-PAY ' W-EMP-NO ' ' LX42-EMP-NO. CL168 +02213 DTSBX436 +02214 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX436 +02215 SET W-RPT-ERROR-NO-88 TO TRUE. CL*80 +02216 * SET W-PREV-REC-NULL-88 TO TRUE. CL107 +02217 SET W-PREV-RPT-NULL-88 TO TRUE. CL104 +02218 MOVE ZERO TO W-X140-REPORT-QTR CL*56 +02219 W-X145-PAYMENT-QTR CL*57 +02220 W-X144-WAGE-QTR CL*56 +02221 W-TOT-WAGE DTSBX436 +02222 W-TAX-WAGE DTSBX436 +02223 W-WRKR-TOT-WAGE DTSBX436 +02224 W-X145-REMITTANCE CL*53 +02225 W-X140-REMITTANCE CL*53 +02226 W-X140-RECEIVED-DATE CL*72 +02227 W-X145-DEPOSIT-DATE CL*72 +02228 W-X145-RECEIVED-DATE CL*72 +02229 W-1ST-MNTH-CNT DTSBX436 +02230 W-2ND-MNTH-CNT DTSBX436 +02231 W-3RD-MNTH-CNT DTSBX436 +02232 W-SSN DTSBX436 +02233 W-EARNINGS DTSBX436 +02234 W-EMP-WAGE-CNT DTSBX436 +02235 W-SEQ-NO CL*77 +02236 W-T025-REMIT-AMT CL*76 +02237 W-X145-TOT-REMIT-AMT CL*76 +02238 W-X140-REMITTANCE CL*83 +02239 LX42-X140-KEY-AREA CL*83 +02240 LX42-X144-KEY-AREA CL*83 +02241 LX42-X145-KEY-AREA. CL*83 +02242 CL*76 +02243 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*76 +02244 CL*76 +02245 DTSBX436 +02246 MOVE SPACES TO W-WRKR-FIRST-NAME DTSBX436 +02247 W-WRKR-LAST-NAME DTSBX436 +02248 W-WRKR-MID-INIT CL*56 +02249 W-X145-PAYMENT-FOUND-IND CL*79 +02250 LX42-X140-EMP-NO CL*79 +02251 LX42-X144-EMP-NO CL*82 +02252 LX42-X145-EMP-NO CL*82 +02253 LX42-X140-QTR-AREA CL*82 +02254 LX42-X144-QTR-AREA CL*82 +02255 P434-MESSAGE CL138 +02256 LX42-X145-QTR-AREA. CL*82 +02257 CL*53 +02258 INITIALIZE X140-REC DTSBX436 +02259 X144-REC CL*47 +02260 X145-REC. CL*47 +02261 CL*48 +02262 *& CL*88 +02263 * DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE CL161 +02264 * ' W-RROR-IND ' W-RPT-ERROR-IND CL161 +02265 * 'LX-W-RROR-IND ' W-RPT-ERROR-IND. CL161 +02266 P5000-EXIT. CL*25 +02267 EXIT. DTSBX436 +02268 DTSBX436 +02269 P6000-WRITE-PEND-X145. CL132 +02270 CL133 +02271 MOVE X145-EMP-NO TO P434-EMP-NO CL133 +02272 MOVE X145-QTR TO P434-QTR CL134 +02273 * IF W-EMP-FOUND-YES-88 CL135 +02274 * MOVE MPRF-PRIMARY-NAME (1:15) CL135 +02275 * TO P434-NAME-CHECK CL136 +02276 * ELSE CL135 +02277 MOVE 'PAY' TO P434-NAME-CHECK CL135 +02278 * END-IF. CL135 +02279 CL133 +02280 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL133 +02281 MOVE ZEROS TO P434-TOT-WAGE CL134 +02282 MOVE ZEROS TO P434-EXC-WAGE CL133 +02283 * MOVE ZEROS TO P434-EXC-WAGE CL134 +02284 MOVE ZEROS TO P434-TAX-WAGE CL133 +02285 MOVE ZEROS TO P434-X140-REMIT CL133 +02286 MOVE W-X145-TOT-REMIT-AMT TO P434-X145-REMIT CL135 +02287 CL133 +02288 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL133 +02289 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL133 +02290 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL133 +02291 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL133 +02292 CL133 +02293 * IF W-ERROR-NO-88 CL133 +02294 * MOVE 'PROCESSED' TO X434-DISPOSITION CL133 +02295 * ELSE CL133 +02296 * MOVE 'PENDING ' TO X434-DISPOSITION. CL133 +02297 * MOVE R140-MESSAGE TO P434-MESSAGE CL135 +02298 CL133 +02299 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL176 +02300 ADD 1 TO WS-LINE-CNT2. CL176 +02301 ADD +1 TO WS-NUMBER-ONE. CL176 +02302 GO TO P6000-EXIT. CL133 +02303 CL132 +02304 P6000-WRITE-PEND-X140. CL132 +02305 CL132 +02306 MOVE X140-EMP-NO TO P434-EMP-NO CL132 +02307 MOVE X140-QUARTER TO P434-QTR CL132 +02308 * IF W-EMP-FOUND-YES-88 CL135 +02309 * MOVE MPRF-PRIMARY-NAME (1:15) CL135 +02310 * TO P434-NAME-CHECK CL135 +02311 * ELSE CL135 +02312 MOVE 'RPT' TO P434-NAME-CHECK CL135 +02313 * END-IF. CL135 +02314 CL132 +02315 MOVE X140-RCVD-DATE TO P434-RCVD-DATE CL132 +02316 MOVE X140-TOTAL-WAGES TO P434-TOT-WAGE CL132 +02317 MOVE ZEROS TO P434-EXC-WAGE CL141 +02318 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL141 +02319 MOVE X140-TAX-WAGES TO P434-TAX-WAGE CL132 +02320 MOVE X140-REMITTANCE TO P434-X140-REMIT CL132 +02321 MOVE ZEROS TO P434-X145-REMIT CL138 +02322 CL132 +02323 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL132 +02324 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL132 +02325 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL132 +02326 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL132 +02327 CL132 +02328 * IF W-ERROR-NO-88 CL132 +02329 * MOVE 'PROCESSED' TO X434-DISPOSITION CL132 +02330 * ELSE CL132 +02331 * MOVE 'PENDING ' TO X434-DISPOSITION. CL132 +02332 * MOVE R140-MESSAGE TO P434-MESSAGE CL137 +02333 CL132 +02334 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133 +02335 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL132 +02336 ADD 1 TO WSP-LINE-CNT2. CL167 +02337 ADD +1 TO WSP-NUMBER-ONE. CL167 +02338 GO TO P6000-EXIT. CL144 +02339 CL132 +02340 P6000-WRITE-PEND-X144. CL144 +02341 CL144 +02342 MOVE X140-EMP-NO TO P434-EMP-NO CL144 +02343 MOVE X140-QUARTER TO P434-QTR CL144 +02344 * IF W-EMP-FOUND-YES-88 CL144 +02345 * MOVE MPRF-PRIMARY-NAME (1:15) CL144 +02346 * TO P434-NAME-CHECK CL144 +02347 * ELSE CL144 +02348 MOVE 'WAGE' TO P434-NAME-CHECK CL144 +02349 * END-IF. CL144 +02350 CL144 +02351 MOVE SPACES TO P434-RCVD-DATE CL144 +02352 MOVE ZEROS TO P434-TOT-WAGE CL144 +02353 MOVE ZEROS TO P434-EXC-WAGE CL144 +02354 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL144 +02355 MOVE ZEROS TO P434-TAX-WAGE CL144 +02356 MOVE ZEROS TO P434-X140-REMIT CL144 +02357 MOVE ZEROS TO P434-X145-REMIT CL144 +02358 CL144 +02359 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL144 +02360 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL144 +02361 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL144 +02362 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL144 +02363 CL144 +02364 * IF W-ERROR-NO-88 CL144 +02365 * MOVE 'PROCESSED' TO X434-DISPOSITION CL144 +02366 * ELSE CL144 +02367 * MOVE 'PENDING ' TO X434-DISPOSITION. CL144 +02368 * MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02369 CL144 +02370 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL144 +02371 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL144 +02372 ADD 1 TO WSP-LINE-CNT2. CL162 +02373 ADD +1 TO WSP-NUMBER-ONE. CL162 +02374 CL144 +02375 CL144 +02376 CL*59 +02377 P6000-EXIT. CL*59 +02378 EXIT. CL*59 +02379 CL*59 +02380 DTSBX436 +02381 T0000-TERMINATE. DTSBX436 +02382 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO CL121 +02383 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL121 +02384 END-IF. CL121 +02385 MOVE W-X145-RED-CNT TO WS-FOOTING-CNT. CL128 +02386 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL121 +02387 MOVE W-X145-ZRO-CNT TO WS-X145-PEN-CNT. CL172 +02388 MOVE W-X140-RED-CNT TO WS-X140-RED-CNT. CL130 +02389 MOVE W-X140-ERR-CNT TO WS-X140-ERR-CNT. CL130 +02390 MOVE W-X140-PEN-CNT TO WS-X140-PEN-CNT. CL130 +02391 MOVE W-X144-RED-CNT TO WS-X144-RED-CNT. CL153 +02392 MOVE W-X144-ERR-CNT TO WS-X144-ERR-CNT. CL153 +02393 MOVE W-X144-PEN-CNT TO WS-X144-PEN-CNT. CL153 +02394 MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT. CL121 +02395 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. CL121 +02396 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. CL121 +02397 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. CL121 +02398 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. CL153 +02399 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL153 +02400 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL153 +02401 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. CL153 +02402 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. CL153 +02403 WRITE REPT-PAID-REC FROM FOOTING-LINE-9 AFTER 1. CL153 +02404 WRITE REPT-PAID-REC FROM FOOTING-LINE-10 AFTER 1. CL153 +02405 WRITE REPT-PAID-REC FROM FOOTING-LINE-11 AFTER 1. CL153 +02406 WRITE REPT-PAID-REC FROM FOOTING-LINE-12 AFTER 1. CL153 +02407 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 1. CL153 +02408 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. CL153 +02409 CL121 +02410 DISPLAY ' '. DTSBX436 +02411 DTSBX436 +02412 DTSBX436 +02413 DISPLAY ' '. DTSBX436 +02414 DISPLAY '***************************************'. CL*47 +02415 DISPLAY '*** DTSBX436 TERMINATION STATISTICS ***'. CL168 +02416 DISPLAY '*** ESSP-CLEARING RPT/PAYMTS/WAGES ***'. CL168 +02417 DISPLAY '***************************************'. CL*47 +02418 DISPLAY ' '. DTSBX436 +02419 DTSBX436 +02420 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX436 +02421 DTSBX436 +02422 DISPLAY '***************************************'. DTSBX436 +02423 DTSBX436 +02424 CLOSE WAGE-FILE-OUT CL*20 +02425 PEND-X140-FILE CL*59 +02426 PEND-X144-FILE CL*59 +02427 REPT-PAID-FILE CL120 +02428 REPT-PEND-FILE CL120 +02429 PEND-X145-FILE CL120 +02430 TEMP-BTC-FILE CL*59 +02431 BATCH-XREF-FILE. CL*26 +02432 T0000-EXIT. DTSBX436 +02433 EXIT. DTSBX436 +02434 DTSBX436 +02435 DTSBX436 +02436 T2000-DISPLAY-TOTALS. DTSBX436 +02437 DISPLAY '***** QUARTERLY REPORTS ************* '. CL*92 +02438 DISPLAY 'TOTAL X140-REPORT RECORDS READ..........: ' CL*96 +02439 W-X140-RED-CNT. CL*57 +02440 CL*99 +02441 DISPLAY ' NO OF X140-REPORTS PASSED ALL EDITS....: ' CL*99 +02442 W-X140-SAV-CNT. CL*99 +02443 DTSBX436 +02444 DISPLAY ' NO OF X140-REPORTS T028 TRANS WRITTEN..: ' CL*96 +02445 W-T028-WRITE-CNT. DTSBX436 +02446 CL*99 +02447 DISPLAY ' ##T028 TRANS WRITTEN - REMIT AMT ZERO.: ' CL100 +02448 W-T028-WRITEO-CNT. CL100 +02449 CL*99 +02450 DISPLAY ' #T028 TRANS WRITTEN - REMIT AMT EQUAL: ' CL102 +02451 W-T028-WRITEE-CNT. CL102 +02452 DISPLAY ' NO OF X140-REPORTS WRITTEN TO PENDING..: ' CL*96 +02453 W-X140-PEN-CNT. CL*92 +02454 DISPLAY ' NO OF X140-REPORTS HAS ERRORS..........: ' CL*96 +02455 W-X140-ERR-CNT. CL*92 +02456 DISPLAY ' NO OF X140-REPORTS HAS DUPLICATE.......: ' CL*96 +02457 W-X140-DUP-CNT. CL*92 +02458 CL*92 +02459 DISPLAY ' '. CL*92 +02460 DISPLAY '***** QUARTERLY PAYMENTS ********* '. CL*96 +02461 DISPLAY 'TOTAL X145-PAYMENTS RECORDS READ.......: ' CL*96 +02462 W-X145-RED-CNT. CL*92 +02463 CL*92 +02464 DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: ' CL*98 +02465 W-X145-SAV-CNT. CL*92 +02466 CL*92 +02467 DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: ' CL*96 +02468 W-T025-WRITE-CNT. CL*94 +02469 CL*94 +02470 DISPLAY ' ## T025 TRANS WRITTEN-ZERO REMIT....: ' CL100 +02471 W-T025-WRITEO-CNT. CL100 +02472 CL100 +02473 DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: ' CL*96 +02474 W-X145-PEN-CNT. CL*92 +02475 DISPLAY ' NO OF X145-PAYMENTS HAS ERRORS.........: ' CL*96 +02476 W-X145-ERR-CNT. CL*92 +02477 DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: ' CL*96 +02478 W-X145-DUP-CNT. CL*92 +02479 CL*92 +02480 DISPLAY ' '. CL*92 +02481 DISPLAY '***** QUARTERLY WAGES ************* '. CL*92 +02482 DISPLAY 'TOTAL X144-WAGES RECORDS READ..........: ' CL*96 +02483 W-X144-RED-CNT. CL*92 +02484 CL*99 +02485 DISPLAY ' NO OF X144-WAGES PASSED ALL EDITS......: ' CL*99 +02486 W-X144-SAV-CNT. CL*99 +02487 CL*99 +02488 DISPLAY ' NO OF X144-WAGES W004 TRANS WRITTEN....: ' CL*96 +02489 W-W4-CNT. CL*96 +02490 CL*92 +02491 DISPLAY ' NO OF X144-WAGES WRITTEN TO PENDING....: ' CL*96 +02492 W-X144-PEN-CNT. CL*92 +02493 DISPLAY ' NO OF X144-WAGES HAS ERRORS............: ' CL*96 +02494 W-X144-ERR-CNT. CL*92 +02495 DISPLAY ' NO OF X144-WAGES HAS DUPLICATE.........: ' CL*96 +02496 W-X144-DUP-CNT. CL*92 +02497 CL*92 +02498 CL*10 +02499 DISPLAY ' '. DTSBX436 +02500 DISPLAY '***** END REPORTS/WAGES AND PAYMENTS **** '. CL*96 +02501 DTSBX436 +02502 T2000-EXIT. DTSBX436 +02503 EXIT. DTSBX436 +02504 DTSBX436 +02505 S001-FROM-FED-8. DTSBX436 +02506 SET L001-FROM-FED-8 TO TRUE. DTSBX436 +02507 GO TO S001-DATE. DTSBX436 +02508 DTSBX436 +02509 S001-FROM-CAL-8. DTSBX436 +02510 SET L001-FROM-CAL-8 TO TRUE. DTSBX436 +02511 GO TO S001-DATE. DTSBX436 +02512 DTSBX436 +02513 S001-FROM-ABS-DAY. DTSBX436 +02514 SET L001-FROM-ABS-DAY TO TRUE. DTSBX436 +02515 GO TO S001-DATE. DTSBX436 +02516 DTSBX436 +02517 S001-DATE. DTSBX436 +02518 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX436 +02519 S001-EXIT. DTSBX436 +02520 EXIT. DTSBX436 +02521 DTSBX436 +02522 S003-AGENCY-DAY. DTSBX436 +02523 SET L003-AGENCY-DAY TO TRUE. DTSBX436 +02524 GO TO S003-WORK-DAY. DTSBX436 +02525 DTSBX436 +02526 S003-WORK-DAY. DTSBX436 +02527 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX436 +02528 S003-EXIT. DTSBX436 +02529 EXIT. DTSBX436 +02530 DTSBX436 +02531 S004-FROM-5. DTSBX436 +02532 SET L004-FROM-5 TO TRUE. DTSBX436 +02533 GO TO S004-YRQ. DTSBX436 +02534 DTSBX436 +02535 S004-FROM-DATE. DTSBX436 +02536 SET L004-FROM-DATE TO TRUE. DTSBX436 +02537 GO TO S004-YRQ. DTSBX436 +02538 DTSBX436 +02539 S004-FROM-ABS. DTSBX436 +02540 SET L004-FROM-ABS TO TRUE. DTSBX436 +02541 GO TO S004-YRQ. DTSBX436 +02542 DTSBX436 +02543 S004-YRQ. DTSBX436 +02544 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX436 +02545 DTSBX436 +02546 S004-EXIT. DTSBX436 +02547 EXIT. DTSBX436 +02548 DTSBX436 +02549 S516-LIABILITY-INFO. DTSBX436 +02550 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX436 +02551 MPRF-REC. DTSBX436 +02552 S516-EXIT. DTSBX436 +02553 EXIT. DTSBX436 +02554 DTSBX436 +02555 S910-OPEN-READ. DTSBX436 +02556 SET L910-OPEN-READ-88 TO TRUE. DTSBX436 +02557 GO TO S910-MSTR-IO. DTSBX436 +02558 DTSBX436 +02559 S910-READ. DTSBX436 +02560 SET L910-READ-88 TO TRUE. DTSBX436 +02561 GO TO S910-MSTR-IO. DTSBX436 +02562 DTSBX436 +02563 S910-START-BROWSE. DTSBX436 +02564 SET L910-START-BROWSE-88 TO TRUE. DTSBX436 +02565 GO TO S910-MSTR-IO. DTSBX436 +02566 DTSBX436 +02567 S910-READ-NEXT. DTSBX436 +02568 SET L910-READ-NEXT-88 TO TRUE. DTSBX436 +02569 GO TO S910-MSTR-IO. DTSBX436 +02570 DTSBX436 +02571 S910-CLOSE. DTSBX436 +02572 SET L910-CLOSE-88 TO TRUE. DTSBX436 +02573 GO TO S910-MSTR-IO. DTSBX436 +02574 DTSBX436 +02575 S910-MSTR-IO. DTSBX436 +02576 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX436 +02577 MSKL-REC. DTSBX436 +02578 S910-EXIT. DTSBX436 +02579 EXIT. DTSBX436 +02580 DTSBX436 +02581 S921-OPEN-READ. DTSBX436 +02582 SET L921-OPEN-READ-88 TO TRUE. DTSBX436 +02583 GO TO S921-AIX-IO. DTSBX436 +02584 DTSBX436 +02585 S921-READ. DTSBX436 +02586 SET L921-READ-88 TO TRUE. DTSBX436 +02587 GO TO S921-AIX-IO. DTSBX436 +02588 DTSBX436 +02589 S921-START-BROWSE. DTSBX436 +02590 SET L921-START-BROWSE-88 TO TRUE. DTSBX436 +02591 GO TO S921-AIX-IO. DTSBX436 +02592 DTSBX436 +02593 S921-READ-NEXT. DTSBX436 +02594 SET L921-READ-NEXT-88 TO TRUE. DTSBX436 +02595 GO TO S921-AIX-IO. DTSBX436 +02596 DTSBX436 +02597 S921-CLOSE. DTSBX436 +02598 SET L921-CLOSE-88 TO TRUE. DTSBX436 +02599 GO TO S921-AIX-IO. DTSBX436 +02600 DTSBX436 +02601 S921-AIX-IO. DTSBX436 +02602 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX436 +02603 ISKL-REC. DTSBX436 +02604 S921-EXIT. DTSBX436 +02605 EXIT. DTSBX436 +02606 DTSBX436 +02607 S923-OPEN-UPDATE. DTSBX436 +02608 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX436 +02609 GO TO S923-ATC-CALL. DTSBX436 +02610 DTSBX436 +02611 S923-WRITE. DTSBX436 +02612 SET L923-WRITE-88 TO TRUE. DTSBX436 +02613 GO TO S923-ATC-CALL. DTSBX436 +02614 DTSBX436 +02615 S923-CLOSE. DTSBX436 +02616 SET L923-CLOSE-88 TO TRUE. DTSBX436 +02617 GO TO S923-ATC-CALL. DTSBX436 +02618 DTSBX436 +02619 S923-ATC-CALL. DTSBX436 +02620 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX436 +02621 ASKL-REC. DTSBX436 +02622 S923-EXIT. DTSBX436 +02623 EXIT. DTSBX436 +02624 DTSBX436 +02625 *S927A-OPEN. DTSBX436 +02626 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX436 +02627 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX436 +02628 * DTSBX436 +02629 *S927A-EXIT. DTSBX436 +02630 * EXIT. DTSBX436 +02631 DTSBX436 +02632 S927B-WRITE. DTSBX436 +02633 SET L927-WRITE-88 TO TRUE. DTSBX436 +02634 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX436 +02635 DTSBX436 +02636 S927B-EXIT. DTSBX436 +02637 EXIT. DTSBX436 +02638 DTSBX436 +02639 *S927C-CLOSE. DTSBX436 +02640 * SET L927-CLOSE-88 TO TRUE. DTSBX436 +02641 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX436 +02642 * DTSBX436 +02643 *S927C-EXIT. DTSBX436 +02644 * EXIT. DTSBX436 +02645 DTSBX436 +02646 S927Z-IO. DTSBX436 +02647 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX436 +02648 TSKL-REC. DTSBX436 +02649 S927Z-EXIT. DTSBX436 +02650 EXIT. DTSBX436 +02651 DTSBX436 +02652 S931-OPEN-READ. DTSBX436 +02653 SET L931-OPEN-READ-88 TO TRUE. DTSBX436 +02654 GO TO S931-REF-IO. DTSBX436 +02655 DTSBX436 +02656 S931-CLOSE. DTSBX436 +02657 SET L931-CLOSE-88 TO TRUE. DTSBX436 +02658 GO TO S931-REF-IO. DTSBX436 +02659 DTSBX436 +02660 S931-REF-IO. DTSBX436 +02661 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX436 +02662 FSKL-REC. DTSBX436 +02663 S931-EXIT. DTSBX436 +02664 EXIT. DTSBX436 +02665 DTSBX436 +02666 S1032-WRITE-TEMP-T028. DTSBX436 +02667 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSBX436 +02668 MOVE T028-REC TO TEMP-BTC-REC. DTSBX436 +02669 WRITE TEMP-BTC-REC. DTSBX436 +02670 IF TEMP-BTC-STATUS-OK-88 DTSBX436 +02671 NEXT SENTENCE DTSBX436 +02672 ELSE DTSBX436 +02673 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02674 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSBX436 +02675 TEMP-BTC-STATUS DTSBX436 +02676 END-IF. DTSBX436 +02677 DTSBX436 +02678 S1032-EXIT. CL**9 +02679 EXIT. DTSBX436 +02680 DTSBX436 +02681 S1033-WRITE-TEMP-T025. DTSBX436 +02682 MOVE T025-LENGTH TO VAR-CHAR-CNT. DTSBX436 +02683 MOVE T025-REC TO TEMP-BTC-REC. DTSBX436 +02684 WRITE TEMP-BTC-REC. DTSBX436 +02685 IF TEMP-BTC-STATUS-OK-88 DTSBX436 +02686 NEXT SENTENCE DTSBX436 +02687 ELSE DTSBX436 +02688 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02689 DISPLAY 'CANNOT WRITE TEMP T025: ' DTSBX436 +02690 TEMP-BTC-STATUS DTSBX436 +02691 END-IF. DTSBX436 +02692 DTSBX436 +02693 S1033-EXIT. DTSBX436 +02694 EXIT. DTSBX436 +02695 DTSBX436 +02696 S1040-OPEN-TEMP-BTC-OUT. DTSBX436 +02697 OPEN OUTPUT TEMP-BTC-FILE. DTSBX436 +02698 IF TEMP-BTC-STATUS-OK-88 DTSBX436 +02699 NEXT SENTENCE DTSBX436 +02700 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX436 +02701 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX436 +02702 ELSE DTSBX436 +02703 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02704 DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: ' DTSBX436 +02705 TEMP-BTC-STATUS DTSBX436 +02706 END-IF. DTSBX436 +02707 DTSBX436 +02708 S1040-EXIT. DTSBX436 +02709 EXIT. DTSBX436 +02710 DTSBX436 +02711 S1050-OPEN-TEMP-BTC-IN. DTSBX436 +02712 OPEN INPUT TEMP-BTC-FILE. DTSBX436 +02713 IF TEMP-BTC-STATUS-OK-88 DTSBX436 +02714 NEXT SENTENCE DTSBX436 +02715 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX436 +02716 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX436 +02717 ELSE DTSBX436 +02718 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02719 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBX436 +02720 TEMP-BTC-STATUS DTSBX436 +02721 END-IF. DTSBX436 +02722 DTSBX436 +02723 S1050-EXIT. DTSBX436 +02724 EXIT. DTSBX436 +02725 DTSBX436 +02726 S1060-CLOSE-TEMP-BTC. DTSBX436 +02727 CLOSE TEMP-BTC-FILE. DTSBX436 +02728 IF TEMP-BTC-STATUS-OK-88 DTSBX436 +02729 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX436 +02730 NEXT SENTENCE DTSBX436 +02731 ELSE DTSBX436 +02732 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02733 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX436 +02734 TEMP-BTC-STATUS DTSBX436 +02735 END-IF. DTSBX436 +02736 DTSBX436 +02737 S1060-EXIT. DTSBX436 +02738 EXIT. DTSBX436 +02739 DTSBX436 +02740 S1070-READ-TEMP-BTC. DTSBX436 +02741 READ TEMP-BTC-FILE. DTSBX436 +02742 IF TEMP-BTC-STATUS-OK-88 DTSBX436 +02743 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBX436 +02744 ELSE DTSBX436 +02745 IF TEMP-BTC-STATUS-EOF-88 DTSBX436 +02746 NEXT SENTENCE DTSBX436 +02747 ELSE DTSBX436 +02748 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBX436 +02749 TEMP-BTC-STATUS DTSBX436 +02750 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02751 END-IF DTSBX436 +02752 END-IF. DTSBX436 +02753 DTSBX436 +02754 S1070-EXIT. DTSBX436 +02755 EXIT. DTSBX436 +02756 DTSBX436 +02757 S1100-OPEN-WAGE-TEMP-OUT. DTSBX436 +02758 OPEN OUTPUT WAGE-FILE-TEMP. DTSBX436 +02759 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX436 +02760 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02761 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSBX436 +02762 WAGE-TEMP-STATUS DTSBX436 +02763 END-IF. DTSBX436 +02764 DTSBX436 +02765 S1100-EXIT. DTSBX436 +02766 EXIT. DTSBX436 +02767 DTSBX436 +02768 S1110-CLOSE-WAGE-TEMP. DTSBX436 +02769 CLOSE WAGE-FILE-TEMP. DTSBX436 +02770 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX436 +02771 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02772 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBX436 +02773 WAGE-TEMP-STATUS DTSBX436 +02774 END-IF. DTSBX436 +02775 DTSBX436 +02776 S1110-EXIT. DTSBX436 +02777 EXIT. DTSBX436 +02778 DTSBX436 +02779 S1120-WRITE-WAGE-TEMP. DTSBX436 +02780 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBX436 +02781 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX436 +02782 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02783 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBX436 +02784 WAGE-TEMP-STATUS DTSBX436 +02785 END-IF. DTSBX436 +02786 DTSBX436 +02787 S1120-EXIT. DTSBX436 +02788 EXIT. DTSBX436 +02789 DTSBX436 +02790 S1130-OPEN-WAGE-TEMP-IN. DTSBX436 +02791 OPEN INPUT WAGE-FILE-TEMP. DTSBX436 +02792 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX436 +02793 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02794 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSBX436 +02795 WAGE-TEMP-STATUS DTSBX436 +02796 END-IF. DTSBX436 +02797 DTSBX436 +02798 S1130-EXIT. DTSBX436 +02799 EXIT. DTSBX436 +02800 DTSBX436 +02801 S1140-READ-WAGE-TEMP. DTSBX436 +02802 READ WAGE-FILE-TEMP INTO W001-REC. DTSBX436 +02803 IF WAGE-TEMP-STATUS-EOF-88 DTSBX436 +02804 NEXT SENTENCE DTSBX436 +02805 ELSE DTSBX436 +02806 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX436 +02807 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX436 +02808 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSBX436 +02809 WAGE-TEMP-STATUS DTSBX436 +02810 END-IF DTSBX436 +02811 END-IF. DTSBX436 +02812 DTSBX436 +02813 S1140-EXIT. DTSBX436 +02814 EXIT. DTSBX436 +02815 DTSBX436 +02816 S1150-OPEN-WAGE-FILE-OUT. CL*20 +02817 OPEN OUTPUT WAGE-FILE-OUT. CL*20 +02818 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02819 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02820 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' CL*20 +02821 WAGE-OUT-STATUS CL*20 +02822 END-IF. CL*20 +02823 DTSBX436 +02824 S1150-EXIT. CL*20 +02825 EXIT. CL*20 +02826 DTSBX436 +02827 S1160-CLOSE-WAGE-OUT. CL*20 +02828 CLOSE WAGE-FILE-OUT. CL*20 +02829 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02830 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02831 DISPLAY 'CANNOT CLOSE WAGE FILE: ' CL*20 +02832 WAGE-OUT-STATUS CL*20 +02833 END-IF. CL*20 +02834 DTSBX436 +02835 S1160-EXIT. CL*20 +02836 EXIT. CL*20 +02837 DTSBX436 +02838 S1170-WRITE-WAGE-OUT. CL*20 +02839 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +02840 WRITE WAGE-OUT-REC. CL*20 +02841 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02842 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02843 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' CL*20 +02844 WAGE-OUT-STATUS CL*20 +02845 END-IF. CL*20 +02846 DTSBX436 +02847 S1170-EXIT. CL*20 +02848 EXIT. CL*20 +02849 DTSBX436 +02850 S946-WRITE-R140. DTSBX436 +02851 CALL 'DTSBU946' USING R140-REC. DTSBX436 +02852 DTSBX436 +02853 S946-EXIT. DTSBX436 +02854 EXIT. DTSBX436 +02855 DTSBX436 +02856 S999-ABEND. DTSBX436 +02857 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX436 +02858 S999-EXIT. DTSBX436 +02859 EXIT. DTSBX436 +02860 DTSBX436 diff --git a/Batch/DTSBX437.cob b/Batch/DTSBX437.cob new file mode 100644 index 0000000..33618bf --- /dev/null +++ b/Batch/DTSBX437.cob @@ -0,0 +1,1267 @@ +00001 IDENTIFICATION DIVISION. 01/23/15 +00002 PROGRAM-ID. DTSBX437. DTSBX437 +00003 AUTHOR. NGC. LV065 +00004 DATE-WRITTEN. SEPT 2014. CL*29 +00005 DATE-COMPILED. DTSBX437 +00006 SKIP3 DTSBX437 +00007 ***** DTSBX437 +00008 * DTSBX437 +00009 * FUNCTION: CREATE REPORT FOR ALL DAILY TDEC REPORT PAYMENTS CL*64 +00010 * FILE. PAYMENT WILL BE ADDED TO DUTAS FOR ESSP. CL*28 +00011 * MODIFICATION HISTORY: DTSBX437 +00012 * DTSBX437 +00013 * 09-20-2014 INITIAL DEVELOPMENT CL*19 +00014 * REFERENCE RFP: WEB REGISTRATION ESSP ZL1 CL*19 +00015 * CL*19 +00016 * DTSBX437 +00017 * 01-06-2015 MODIFIED PROGRAM TO PRODUCE REPORT OF ALL CL*49 +00018 * TDEC CHECK DISPOSITION (PAID AND PENDING) ZL1 CL*49 +00019 * CL*49 +00020 ***** DTSBX437 +00021 SKIP3 DTSBX437 +00022 ENVIRONMENT DIVISION. DTSBX437 +00023 CONFIGURATION SECTION. CL*51 +00024 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*51 +00025 CL*51 +00026 INPUT-OUTPUT SECTION. DTSBX437 +00027 DTSBX437 +00028 FILE-CONTROL. DTSBX437 +00029 DTSBX437 +00030 CL*14 +00031 SELECT TDEC-PAYT-FILE ASSIGN TO DTSFX145 CL*34 +00032 FILE STATUS IS TDEC-PAYT-STATUS. CL*28 +00033 CL*14 +00034 CL*16 +00035 SELECT TDEC-PEND-FILE ASSIGN TO DTSPX145 CL*34 +00036 FILE STATUS IS BATCH-XREF-STATUS. CL*16 +00037 CL*47 +00038 SELECT REPT-PAID-FILE ASSIGN TO X437RPT1 CL*64 +00039 FILE STATUS IS REPT-STATUS. CL*47 +00040 CL*47 +00041 SELECT REPT-PEND-FILE ASSIGN TO X437RPT2 CL*64 +00042 FILE STATUS IS REPT-STATUS. CL*47 +00043 CL*47 +00044 DATA DIVISION. DTSBX437 +00045 DTSBX437 +00046 FILE SECTION. DTSBX437 +00047 DTSBX437 +00048 CL*14 +00049 FD TDEC-PAYT-FILE CL*28 +00050 RECORDING MODE IS F CL*14 +00051 BLOCK CONTAINS 0 RECORDS CL*14 +00052 LABEL RECORDS ARE OMITTED. CL*14 +00053 CL*14 +00054 01 TDEC-PAYT-REC. CL*30 +00055 05 WEB-IMP-TYPE PIC X(03). CL*30 +00056 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. CL*30 +00057 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. CL*30 +00058 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. CL*30 +00059 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. CL*30 +00060 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. CL*30 +00061 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. CL*30 +00062 88 WEB-IMP-TYPE-REL-88 VALUE '130'. CL*30 +00063 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. CL*30 +00064 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. CL*30 +00065 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. CL*30 +00066 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. CL*30 +00067 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. CL*30 +00068 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' CL*30 +00069 '108' '130' '132'. CL*30 +00070 88 WEB-TYPE-RPT-88 VALUE '140' '144'. CL*30 +00071 88 WEB-TYPE-PAY-88 VALUE '145'. CL*30 +00072 88 WEB-TYPE-PRF-88 VALUE '110' '120'. CL*30 +00073 05 FILLER PIC X(01). CL*30 +00074 05 WEB-IMP-EMP-NO PIC 9(06). CL*30 +00075 05 FILLER PIC X(01). CL*30 +00076 05 WEB-IMP-QTR PIC X(06). CL*30 +00077 05 FILLER PIC X(495). CL*30 +00078 CL*30 +00079 CL*14 +00080 CL*16 +00081 FD TDEC-PEND-FILE CL*28 +00082 RECORDING MODE IS F CL*16 +00083 BLOCK CONTAINS 0 RECORDS CL*16 +00084 LABEL RECORDS ARE OMITTED. CL*16 +00085 CL*16 +00086 01 TDEC-PEND-REC PIC X(512). CL*30 +00087 CL*48 +00088 FD REPT-PAID-FILE CL*47 +00089 RECORDING MODE IS F CL*47 +00090 BLOCK CONTAINS 0 RECORDS CL*47 +00091 LABEL RECORDS ARE OMITTED. CL*47 +00092 CL*47 +00093 01 REPT-PAID-REC PIC X(133). CL*47 +00094 CL*47 +00095 CL*47 +00096 FD REPT-PEND-FILE CL*47 +00097 RECORDING MODE IS F CL*47 +00098 BLOCK CONTAINS 0 RECORDS CL*47 +00099 LABEL RECORDS ARE OMITTED. CL*47 +00100 CL*47 +00101 01 REPT-PEND-REC PIC X(133). CL*47 +00102 CL*47 +00103 CL*16 +00104 WORKING-STORAGE SECTION. DTSBX437 +001045 77 PAN-VALET PICTURE X(24) VALUE '065DTSBX437 01/23/15'. DTSBX437 +00105 SKIP3 DTSBX437 +00106 01 WRK-AREA. DTSBX437 +00107 05 W-ABEND-CD PIC S9(04) COMP VALUE 428. CL*18 +00108 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX429'. CL*28 +00109 DTSBX437 +00110 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX437 +00111 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX437 +00112 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX437 +00113 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX437 +00114 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX437 +00115 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX437 +00116 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX437 +00117 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX437 +00118 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX437 +00119 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX437 +00120 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX437 +00121 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX437 +00122 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX437 +00123 DTSBX437 +00124 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX437 +00125 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX437 +00126 88 W-ERROR-NO-88 VALUE 'N'. DTSBX437 +00127 DTSBX437 +00128 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX437 +00129 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX437 +00130 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX437 +00131 DTSBX437 +00132 05 BATCH-XREF-STATUS PIC X(02). DTSBX437 +00133 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX437 +00134 DTSBX437 +00135 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX437 +00136 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX437 +00137 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX437 +00138 DTSBX437 +00139 05 W-QTR-FOUND-IND PIC X(01) VALUE 'N'. CL*21 +00140 88 W-QTR-FOUND-YES-88 VALUE 'Y'. CL*21 +00141 88 W-QTR-FOUND-NO-88 VALUE 'N'. CL*21 +00142 CL*21 +00143 05 TDEC-PAYT-STATUS PIC X(02) VALUE SPACES. CL*28 +00144 88 W-TDEC-PAYT-EOF-88 VALUE '10'. CL*28 +00145 88 W-TDEC-PAYT-OK-88 VALUE '00'. CL*28 +00146 CL*21 +00147 05 REPT-STATUS PIC X(02) VALUE SPACES. CL*50 +00148 88 REPT-STATUS-EOF-88 VALUE '10'. CL*50 +00149 88 REPT-STATUS-OK-88 VALUE '00'. CL*50 +00150 CL*50 +00151 05 W-APAY-MAX PIC S9(04) COMP VALUE +100. DTSBX437 +00152 05 W-APAY-LAST PIC S9(04) COMP VALUE +0. DTSBX437 +00153 05 PSUB PIC S9(04) COMP VALUE +0. DTSBX437 +00154 05 W-APAY-TABLE. DTSBX437 +00155 10 W-APAY-ENTRY OCCURS 100 TIMES PIC X(96). DTSBX437 +00156 DTSBX437 +00157 05 WRK-RETURN-CODE PIC S9(01) VALUE +0. CL*26 +00158 05 W-EMP-NO PIC S9(07) COMP-3. CL*26 +00159 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBX437 +00160 05 W-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00161 05 W-TOT-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00162 05 W-TOT-PAID-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00163 05 W-TOT-PEND-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00164 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX437 +00165 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBX437 +00166 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX437 +00167 05 W-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX437 +00168 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE 0. CL*51 +00169 05 W-TRAN-CNT PIC S9(03) COMP-3. DTSBX437 +00170 05 W-PEND-CNT PIC 9(05) VALUE 0. CL*37 +00171 05 W-MPRF-CNT PIC 9(05) VALUE 0. CL*37 +00172 05 W-MQTR-CNT PIC 9(05) VALUE 0. CL*37 +00173 05 W-ERRO-CNT PIC 9(05) VALUE 0. CL*37 +00174 05 W-X145-ERR-CNT PIC 9(05) VALUE 0. CL*58 +00175 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*16 +00176 DTSBX437 +00177 05 W-EARNINGS PIC S9(09)V99. DTSBX437 +00178 05 W-INTEGER PIC S9(11) COMP-3. CL*33 +00179 05 W-FRACTION PIC SV9(11) COMP-3. CL*33 +00180 05 W-NUMBER PIC S9(11)V9(05) COMP-3. CL*33 +00181 05 SUB PIC S9(4) COMP. CL*33 +00182 CL*48 +00183 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL*48 +00184 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL*48 +00185 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL*48 +00186 CL*48 +00187 DTSBX437 +00188 05 W-PAY-TYPE PIC X(02). DTSBX437 +00189 88 W-PA-PAY-88 VALUE 'PA'. DTSBX437 +00190 88 W-OR-PAY-88 VALUE 'OR'. DTSBX437 +00191 88 W-EA-PAY-88 VALUE 'EA'. DTSBX437 +00192 88 W-AU-PAY-88 VALUE 'AU'. DTSBX437 +00193 88 W-FS-PAY-88 VALUE 'FS'. DTSBX437 +00194 88 W-AC-PAY-88 VALUE 'AC'. DTSBX437 +00195 88 W-ES-PAY-88 VALUE 'ES'. DTSBX437 +00196 88 W-WD-PAY-88 VALUE 'WD'. DTSBX437 +00197 88 W-PAY-REV-88 VALUE 'PR'. DTSBX437 +00198 88 W-REFUND-88 VALUE 'RF'. DTSBX437 +00199 88 W-REF-REV-88 VALUE 'RR'. DTSBX437 +00200 88 W-NG-CHECK-88 VALUE 'NG'. DTSBX437 +00201 88 W-VALID-PAY-88 VALUE 'PA' 'OR' 'EA' 'AU' DTSBX437 +00202 'FS' 'AC'. DTSBX437 +00203 DTSBX437 +00204 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX437 +00205 DTSBX437 +00206 05 W-SLASH-DATE PIC X(10). DTSBX437 +00207 05 FILLER REDEFINES W-SLASH-DATE. DTSBX437 +00208 10 W-SLASH-DT-MM PIC X(02). DTSBX437 +00209 10 FILLER PIC X(01). DTSBX437 +00210 10 W-SLASH-DT-DD PIC X(02). DTSBX437 +00211 10 FILLER PIC X(01). DTSBX437 +00212 10 W-SLASH-DT-CCYY PIC X(04). DTSBX437 +00213 DTSBX437 +00214 05 W-SLASH-QTR PIC X(06). DTSBX437 +00215 05 FILLER REDEFINES W-SLASH-QTR. DTSBX437 +00216 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX437 +00217 10 FILLER PIC X(01). DTSBX437 +00218 10 W-SLASH-QTR-Q PIC X(01). DTSBX437 +00219 DTSBX437 +00220 * PAYMENT DTSBX437 +00221 05 W-X212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 +00222 DTSBX437 +00223 05 W-APAY-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX437 +00224 DTSBX437 +00225 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX437 +00226 * 05 WS-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*57 +00227 DTSBX437 +00228 05 W-BX212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 +00229 DTSBX437 +00230 05 W-X212-LENGTH PIC S9(04) COMP. CL*16 +00231 DTSBX437 +00232 05 W-AMT-DISP1 PIC ----------9.99. DTSBX437 +00233 05 W-AMT-DISP2 PIC ----------9.99. DTSBX437 +00234 *RW1 DTSBX437 +00235 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX437 +00236 05 DISPLAY-CNT PIC Z(06)9. DTSBX437 +00237 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX437 +00238 *RW2 DTSBX437 +00239 DTSBX437 +00240 01 MESSAGE-AREA. DTSBX437 +00241 *** FATAL ERRORS MSG-A DTSBX437 +00242 05 MSG-A1. DTSBX437 +00243 10 FILLER PIC X(32) DTSBX437 +00244 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX437 +00245 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX437 +00246 DTSBX437 +00247 01 HEADER-1. CL*47 +00248 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00249 05 FILLER PIC X(49) VALUE '140R1'. CL*47 +00250 05 FILLER PIC X(60) VALUE CL*47 +00251 'DISTRICT OF COLUMBIA'. CL*47 +00252 05 FILLER PIC X(06) VALUE 'DATE:'. CL*47 +00253 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*47 +00254 01 HEADER-2. CL*47 +00255 05 FILLER PIC X(54) VALUE SPACES. CL*47 +00256 05 FILLER PIC X(56) VALUE CL*47 +00257 'TAX DIVISION'. CL*47 +00258 05 FILLER PIC X(06) VALUE 'TIME:'. CL*47 +00259 05 HDR2-LRCM-SYS-TIME PIC X(08). CL*47 +00260 CL*47 +00261 01 HEADER-3. CL*47 +00262 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00263 05 FILLER PIC X(38) VALUE CL*47 +00264 'ROUTE TO: TAX ACCOUNTING STAFF'. CL*47 +00265 05 HDR3-LITERAL PIC X(43) VALUE CL*47 +00266 ' TDEC DAILY PROCESSED REPORT PAYMENTS'. CL*64 +00267 05 FILLER PIC X(28) VALUE SPACES. CL*47 +00268 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*47 +00269 05 HDR3-PAGE PIC ZZ,ZZ9. CL*47 +00270 CL*47 +00271 01 HEADER-4. CL*47 +00272 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00273 05 FILLER PIC X(132) VALUE SPACES. CL*47 +00274 01 HEADER-5. CL*47 +00275 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00276 05 FILLER PIC X(34) VALUE CL*47 +00277 'EMP NO EMPLOYER NAME '. CL*53 +00278 05 FILLER PIC X(04) VALUE SPACES. CL*53 +00279 05 FILLER PIC X(34) VALUE CL*47 +00280 'QTR RECV-DATE PAID-AMT'. CL*54 +00281 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00282 05 HDR5-NAME PIC X(28) VALUE CL*47 +00283 ' DISPOSITION OF PAYMTS'. CL*64 +00284 CL*47 +00285 01 HEADER-6. CL*47 +00286 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00287 05 FILLER PIC X(132) VALUE SPACES. CL*47 +00288 CL*48 +00289 01 DETAIL-LINE-1. CL*47 +00290 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00291 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 +00292 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00293 15 X434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 +00294 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00295 15 X434-QTR PIC X(06). CL*47 +00296 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00297 15 X434-RCVD-DATE PIC X(10). CL*47 +00298 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00299 15 X434-X145-REMIT PIC -------9.99. CL*47 +00300 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00301 15 X434-MESSAGE PIC X(20). CL*48 +00302 CL*47 +00303 01 DETAIL-PEND-1. CL*47 +00304 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00305 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 +00306 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00307 15 P434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 +00308 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00309 15 P434-QTR PIC X(06). CL*47 +00310 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00311 15 P434-RCVD-DATE PIC X(10). CL*47 +00312 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00313 15 P434-X145-REMIT PIC --------9.99. CL*47 +00314 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00315 15 P434-MESSAGE PIC X(30). CL*47 +00316 CL*47 +00317 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*47 +00318 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL*47 +00319 CL*47 +00320 01 FOOTING-LINE-3. CL*47 +00321 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00322 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL*47 +00323 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00324 05 FILLER PIC X(45) VALUE CL*47 +00325 ' TOTAL REPORTS PAYMENTS RECEIVED'. CL*65 +00326 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00327 CL*47 +00328 01 FOOTING-LINE-4. CL*47 +00329 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00330 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL*47 +00331 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00332 05 FILLER PIC X(34) VALUE CL*47 +00333 ' # OF PAYMENTS HAD ERRORS '. CL*60 +00334 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00335 CL*47 +00336 01 FOOTING-LINE-5. CL*47 +00337 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00338 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL*47 +00339 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00340 05 FILLER PIC X(40) VALUE CL*47 +00341 ' # OF PAYMENTS WENT TO PENDING FILE '. CL*60 +00342 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00343 01 FOOTING-LINE-6. CL*56 +00344 05 FILLER PIC X(25) VALUE SPACES. CL*56 +00345 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL*56 +00346 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00347 05 FILLER PIC X(40) VALUE CL*56 +00348 ' # OF PAYMENTS WAITING FOR PROCESSING '. CL*64 +00349 05 FILLER PIC X(32) VALUE SPACES. CL*56 +00350 01 FOOTING-LINE-7. CL*56 +00351 05 FILLER PIC X(19) VALUE SPACES. CL*47 +00352 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL*47 +00353 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00354 05 FILLER PIC X(45) VALUE CL*47 +00355 ' TOTAL PAYMENTS WAITING FOR PROCESSING'. CL*64 +00356 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00357 CL*47 +00358 01 FOOTING-LINE-8. CL*56 +00359 05 FILLER PIC X(19) VALUE SPACES. CL*56 +00360 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL*56 +00361 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00362 05 FILLER PIC X(45) VALUE CL*56 +00363 'TOTAL REPORT PAYMENTS RECEIVED '. CL*64 +00364 05 FILLER PIC X(32) VALUE SPACES. CL*56 +00365 CL*56 +00366 01 FOOTING-LINE-13. CL*47 +00367 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00368 05 FILLER PIC X(67) VALUE CL*47 +00369 '*** END TDEC/DUTAS DAILY PAYMNT PROCESSING ***'. CL*64 +00370 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL*47 +00371 CL*47 +00372 CL*47 +00373 CL*47 +00374 01 T025-REC. DTSBX437 +00375 ++INCLUDE DTSIT025 DTSBX437 +00376 DTSBX437 +00377 * REPORT DTSBX437 +00378 01 X140-REC. DTSBX437 +00379 ++INCLUDE DTSIX140 DTSBX437 +00380 DTSBX437 +00381 * PAYMENT DTSBX437 +00382 01 X145-REC. DTSBX437 +00383 ++INCLUDE DTSIX145 DTSBX437 +00384 DTSBX437 +00385 * ICESA-REPT-FILE CL*16 +00386 01 X212-REC. CL*16 +00387 ++INCLUDE DTSIX212 CL*20 +00388 CL*16 +00389 * BATCH - PSEUDO-BATCH XREF DTSBX437 +00390 01 X214-REC. DTSBX437 +00391 ++INCLUDE DTSIX214 DTSBX437 +00392 DTSBX437 +00393 * ERRORS DTSBX437 +00394 *01 X907-REC. DTSBX437 +00395 ***INCLUDE DTSIX907 DTSBX437 +00396 DTSBX437 +00397 01 L001-LINK-AREA. DTSBX437 +00398 ++INCLUDE DTSIL001 DTSBX437 +00399 DTSBX437 +00400 01 L003-LINK-AREA. DTSBX437 +00401 ++INCLUDE DTSIL003 DTSBX437 +00402 DTSBX437 +00403 01 L004-LINK-AREA. DTSBX437 +00404 ++INCLUDE DTSIL004 DTSBX437 +00405 DTSBX437 +00406 CL*16 +00407 01 L005-LINK-AREA. CL*16 +00408 ++INCLUDE DTSIL005 CL*16 +00409 CL*31 +00410 01 L205-LINK-AREA. CL*31 +00411 ++INCLUDE DTSIL205 CL*31 +00412 CL*16 +00413 01 L910-LINK-AREA. DTSBX437 +00414 ++INCLUDE DTSIL910 DTSBX437 +00415 01 MSKL-REC. DTSBX437 +00416 ++INCLUDE DTSIMSKL DTSBX437 +00417 DTSBX437 +00418 01 MHDR-REC. DTSBX437 +00419 ++INCLUDE DTSIMHDR DTSBX437 +00420 DTSBX437 +00421 01 MQTR-REC. CL*17 +00422 ++INCLUDE DTSIMQTR CL*17 +00423 CL*17 +00424 01 MPRF-REC. DTSBX437 +00425 ++INCLUDE DTSIMPRF DTSBX437 +00426 DTSBX437 +00427 01 MPAY-REC. DTSBX437 +00428 ++INCLUDE DTSIMPAY DTSBX437 +00429 DTSBX437 +00430 01 MNTE-REC. DTSBX437 +00431 ++INCLUDE DTSIMNTE DTSBX437 +00432 DTSBX437 +00433 01 L921-LINK-AREA. DTSBX437 +00434 ++INCLUDE DTSIL921 DTSBX437 +00435 SKIP3 DTSBX437 +00436 01 ISKL-REC. DTSBX437 +00437 ++INCLUDE DTSIISKL DTSBX437 +00438 SKIP3 DTSBX437 +00439 01 IEIN-REC. DTSBX437 +00440 ++INCLUDE DTSIIEIN DTSBX437 +00441 DTSBX437 +00442 01 L923-LINK-AREA. DTSBX437 +00443 ++INCLUDE DTSIL923 DTSBX437 +00444 EJECT DTSBX437 +00445 01 ASKL-REC. DTSBX437 +00446 ++INCLUDE DTSIASKL DTSBX437 +00447 EJECT DTSBX437 +00448 01 AHDR-REC. DTSBX437 +00449 ++INCLUDE DTSIAHDR DTSBX437 +00450 EJECT DTSBX437 +00451 01 ARPT-REC. DTSBX437 +00452 ++INCLUDE DTSIARPT DTSBX437 +00453 EJECT DTSBX437 +00454 01 APAY-REC. DTSBX437 +00455 ++INCLUDE DTSIAPAY DTSBX437 +00456 DTSBX437 +00457 01 L927-LINK-AREA. DTSBX437 +00458 ++INCLUDE DTSIL927 DTSBX437 +00459 DTSBX437 +00460 01 TSKL-REC. DTSBX437 +00461 ++INCLUDE DTSITSKL DTSBX437 +00462 DTSBX437 +00463 01 L931-LINK-AREA. DTSBX437 +00464 ++INCLUDE DTSIL931 DTSBX437 +00465 DTSBX437 +00466 01 FSKL-REC. DTSBX437 +00467 ++INCLUDE DTSIFSKL DTSBX437 +00468 DTSBX437 +00469 01 R140-REC. DTSBX437 +00470 ++INCLUDE DTSIR140 DTSBX437 +00471 DTSBX437 +00472 LINKAGE SECTION. DTSBX437 +00473 DTSBX437 +00474 *01 LX42-LINK-AREA. CL*14 +00475 *++INCLUDE DTSILX42 CL*14 +00476 DTSBX437 +00477 PROCEDURE DIVISION. CL*14 +00478 DTSBX437 +00479 DTSBX423-MAIN. DTSBX437 +00480 PERFORM I0000-INITIATE THRU I0000-EXIT. CL*27 +00481 DTSBX437 +00482 IF W-ERROR-YES-88 CL*27 +00483 MOVE WRK-RETURN-CODE TO RETURN-CODE CL*40 +00484 GO TO DTSBX423-MAIN-EXIT. CL*27 +00485 CL*27 +00486 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*27 +00487 DTSBX437 +00488 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL*27 +00489 MOVE WRK-RETURN-CODE TO RETURN-CODE. CL*40 +00490 DTSBX437 +00491 DTSBX437 +00492 DTSBX423-MAIN-EXIT. DTSBX437 +00493 GOBACK. DTSBX437 +00494 DTSBX437 +00495 I0000-INITIATE. DTSBX437 +00496 SET W-ERROR-NO-88 TO TRUE. DTSBX437 +00497 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX437 +00498 MOVE +0 TO WRK-RETURN-CODE CL*25 +00499 DTSBX437 +00500 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX437 +00501 MOVE '140' TO R140-REC-TYPE. DTSBX437 +00502 DTSBX437 +00503 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX437 +00504 CL*16 +00505 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*16 +00506 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*16 +00507 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*49 +00508 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*49 +00509 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*49 +00510 CL*16 +00511 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*35 +00512 PERFORM S927A-OPEN THRU S927A-EXIT. CL*42 +00513 DTSBX437 +00514 I0000-EXIT. DTSBX437 +00515 EXIT. DTSBX437 +00516 DTSBX437 +00517 I2000-OPEN-FILES. DTSBX437 +00518 DTSBX437 +00519 OPEN INPUT TDEC-PAYT-FILE. CL*29 +00520 IF W-TDEC-PAYT-EOF-88 CL*29 +00521 DISPLAY 'NO TDEC PAYMENT FILES TO PROCESS ' CL*29 +00522 MOVE +3 TO WRK-RETURN-CODE CL*27 +00523 SET W-ERROR-YES-88 TO TRUE CL*27 +00524 END-IF. CL*14 +00525 CL*16 +00526 OPEN OUTPUT TDEC-PEND-FILE. CL*29 +00527 IF BATCH-XREF-OK-88 CL*16 +00528 NEXT SENTENCE CL*16 +00529 ELSE CL*16 +00530 DISPLAY 'CANNOT OPEN TDEC PEND FILE ' CL*29 +00531 BATCH-XREF-STATUS CL*16 +00532 PERFORM S999-ABEND THRU S999-EXIT CL*16 +00533 END-IF. CL*16 +00534 OPEN OUTPUT REPT-PEND-FILE. CL*47 +00535 IF REPT-STATUS-OK-88 CL*47 +00536 NEXT SENTENCE CL*47 +00537 ELSE CL*47 +00538 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' CL*47 +00539 REPT-STATUS CL*47 +00540 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00541 END-IF. CL*47 +00542 CL*47 +00543 OPEN OUTPUT REPT-PAID-FILE. CL*47 +00544 IF REPT-STATUS-OK-88 CL*47 +00545 NEXT SENTENCE CL*47 +00546 ELSE CL*47 +00547 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' CL*47 +00548 REPT-STATUS CL*47 +00549 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00550 END-IF. CL*47 +00551 CL*16 +00552 I2000-EXIT. DTSBX437 +00553 EXIT. DTSBX437 +00554 DTSBX437 +00555 P0000-PROCESS. DTSBX437 +00556 READ TDEC-PAYT-FILE CL*33 +00557 CL*25 +00558 IF W-TDEC-PAYT-EOF-88 CL*29 +00559 DISPLAY 'TDEC INPUT FILE IS EMPTY ' CL*29 +00560 MOVE +3 TO WRK-RETURN-CODE CL*25 +00561 GO TO P0000-EXIT CL*25 +00562 END-IF. CL*25 +00563 CL*25 +00564 PERFORM UNTIL W-TDEC-PAYT-EOF-88 CL*29 +00565 PERFORM P1100-PARSE-TDEC-PAYT-REC THRU P1100-EXIT CL*30 +00566 IF W-ERROR-NO-88 CL*31 +00567 PERFORM P2100-PAYMENT THRU P2100-EXIT CL*25 +00568 END-IF CL*31 +00569 READ TDEC-PAYT-FILE CL*33 +00570 END-PERFORM. CL*25 +00571 CL*25 +00572 DTSBX437 +00573 P0000-EXIT. DTSBX437 +00574 EXIT. DTSBX437 +00575 P1100-PARSE-TDEC-PAYT-REC. CL*33 +00576 SET W-ERROR-NO-88 TO TRUE. CL*36 +00577 CL*30 +00578 PERFORM CL*30 +00579 VARYING SUB FROM +1 BY +1 CL*30 +00580 UNTIL SUB > +100 CL*30 +00581 MOVE +0 TO L205-FIELD-LENGTH (SUB) CL*30 +00582 L205-INTEGER (SUB) CL*30 +00583 L205-FRACTION (SUB) CL*30 +00584 MOVE SPACES TO L205-TEXT (SUB) CL*30 +00585 L205-DATE (SUB) CL*30 +00586 SET L205-TYPE-TEXT-88 (SUB) TO TRUE CL*30 +00587 END-PERFORM. CL*30 +00588 CL*30 +00589 IF WEB-IMP-TYPE-PAY-88 CL*30 +00590 PERFORM P1100J-SET-205-FIELDS THRU P1100J-EXIT CL*31 +00591 ELSE CL*30 +00592 SET W-ERROR-YES-88 TO TRUE CL*30 +00593 DISPLAY ' RECORD IS NOT PAY TYPE ' CL*30 +00594 END-IF. CL*30 +00595 DTSBX437 +00596 CL*31 +00597 * DISPLAY ' **** GOING TO 205 EDIT ESSP RECS ' CL*31 +00598 * DISPLAY ' **** ' CL*31 +00599 CL*31 +00600 IF W-ERROR-NO-88 CL*31 +00601 MOVE TDEC-PAYT-REC TO L205-INPUT-DATA CL*31 +00602 CALL 'DTSBU205' USING L205-LINK-AREA CL*31 +00603 PERFORM P1100K-BUILD-X145-REC THRU P1100K-EXIT. CL*31 +00604 CL*31 +00605 CL*31 +00606 P1100-EXIT. CL*31 +00607 EXIT. CL*31 +00608 CL*31 +00609 P1100J-SET-205-FIELDS. CL*31 +00610 DISPLAY 'P1100J-PAY ' TDEC-PAYT-REC(1:84). CL*31 +00611 INITIALIZE X145-REC. CL*31 +00612 MOVE +12 TO L205-LAST-FIELD. CL*31 +00613 MOVE +8 TO L205-LAST-FIELD-LEN. CL*31 +00614 CL*31 +00615 MOVE +3 TO L205-FIELD-LENGTH (1). CL*31 +00616 SET L205-TYPE-TEXT-88 (1) TO TRUE. CL*31 +00617 CL*31 +00618 MOVE +6 TO L205-FIELD-LENGTH (2). CL*31 +00619 SET L205-TYPE-TEXT-88 (2) TO TRUE. CL*31 +00620 CL*31 +00621 MOVE +6 TO L205-FIELD-LENGTH (3). CL*31 +00622 SET L205-TYPE-TEXT-88 (3) TO TRUE. CL*31 +00623 CL*31 +00624 MOVE +6 TO L205-FIELD-LENGTH (4). CL*31 +00625 SET L205-TYPE-TEXT-88 (4) TO TRUE. CL*31 +00626 MOVE +3 TO L205-FIELD-LENGTH (5). CL*31 +00627 SET L205-TYPE-TEXT-88 (5) TO TRUE. CL*31 +00628 CL*31 +00629 MOVE +2 TO L205-FIELD-LENGTH (6). CL*31 +00630 SET L205-TYPE-TEXT-88 (6) TO TRUE. CL*31 +00631 CL*31 +00632 MOVE +2 TO L205-FIELD-LENGTH (7). CL*31 +00633 SET L205-TYPE-TEXT-88 (7) TO TRUE. CL*31 +00634 CL*31 +00635 MOVE +2 TO L205-FIELD-LENGTH (8). CL*31 +00636 SET L205-TYPE-TEXT-88 (8) TO TRUE. CL*31 +00637 CL*31 +00638 MOVE +14 TO L205-FIELD-LENGTH (9). CL*31 +00639 SET L205-TYPE-NUMBER-88 (9) TO TRUE. CL*31 +00640 MOVE +10 TO L205-FIELD-LENGTH (10). CL*31 +00641 SET L205-TYPE-TEXT-88 (10) TO TRUE. CL*31 +00642 CL*31 +00643 MOVE +10 TO L205-FIELD-LENGTH (11). CL*31 +00644 SET L205-TYPE-TEXT-88 (11) TO TRUE. CL*31 +00645 CL*31 +00646 MOVE +8 TO L205-FIELD-LENGTH (12). CL*31 +00647 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*31 +00648 CL*31 +00649 CL*31 +00650 P1100J-EXIT. CL*31 +00651 EXIT. CL*31 +00652 CL*31 +00653 P1100K-BUILD-X145-REC. CL*31 +00654 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. CL*31 +00655 CL*31 +00656 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. CL*31 +00657 CL*31 +00658 MOVE '0' TO X145-SOURCE. CL*31 +00659 CL*31 +00660 MOVE L205-TEXT (3) (1:06) TO X145-QTR. CL*31 +00661 * DISPLAY 'X145 QTR ' X145-QTR. CL*46 +00662 CL*31 +00663 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. CL*31 +00664 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL*46 +00665 CL*31 +00666 MOVE L205-INTEGER (9) TO W-INTEGER. CL*31 +00667 MOVE L205-FRACTION (9) TO W-FRACTION. CL*31 +00668 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*31 +00669 MOVE W-NUMBER TO X145-REMITTANCE. CL*31 +00670 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL*46 +00671 CL*31 +00672 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. CL*31 +00673 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL*46 +00674 CL*31 +00675 MOVE L205-TEXT (12) TO X145-TRACE-NO. CL*31 +00676 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL*46 +00677 CL*31 +00678 CL*31 +00679 MOVE ZEROS TO X145-PSEUDO-BATCH. CL*31 +00680 CL*31 +00681 MOVE ZEROS TO X145-PSEUDO-ITEM. CL*31 +00682 CL*31 +00683 MOVE SPACES TO X145-APPLIC-ACCT. CL*31 +00684 CL*31 +00685 MOVE SPACES TO X145-CHECK-SCAN-DT. CL*31 +00686 CL*31 +00687 MOVE ZEROS TO X145-CHECK-SEQ-NBR. CL*31 +00688 CL*31 +00689 MOVE 'N' TO X145-WAIVE-INTEREST. CL*31 +00690 CL*31 +00691 MOVE 'N' TO X145-WAIVE-PENALTY. CL*31 +00692 CL*31 +00693 MOVE 'VOL' TO X145-RESP-ACTIVITY. CL*31 +00694 CL*31 +00695 MOVE 'TDECDCHK' TO X145-RESP-OPID. CL*45 +00696 CL*31 +00697 P1100K-EXIT. CL*31 +00698 EXIT. CL*31 +00699 CL*31 +00700 P2100-PAYMENT. DTSBX437 +00701 MOVE X145-EMP-NO TO W-EMP-NO. CL*29 +00702 * DISPLAY ' EMP NO ' W-EMP-NO. CL*46 +00703 SET W-EMP-FOUND-YES-88 TO TRUE. CL*47 +00704 DTSBX437 +00705 SET W-QTR-FOUND-NO-88 TO TRUE. CL*17 +00706 SET W-ERROR-NO-88 TO TRUE CL*17 +00707 DTSBX437 +00708 ADD +1 TO W-X212-CNT. CL*29 +00709 CL*29 +00710 PERFORM P2110-EDIT-PAYMENT THRU P2110-EXIT. CL*29 +00711 CL*47 +00712 IF W-EMP-FOUND-NO-88 OR CL*47 +00713 W-ERROR-YES-88 CL*47 +00714 ADD 1 TO W-PEND-CNT CL*48 +00715 ADD 1 TO W-MPRF-CNT CL*48 +00716 ADD 1 TO W-ERRO-CNT CL*48 +00717 ADD 1 TO W-X145-ERR-CNT CL*57 +00718 ADD W-REMITTANCE TO W-TOT-PEND-REMITTANCE CL*57 +00719 WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 +00720 MOVE R140-MESSAGE TO P434-MESSAGE CL*48 +00721 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT CL*48 +00722 GO TO P2100-EXIT. CL*47 +00723 CL*47 +00724 CL*29 +00725 CL*48 +00726 PERFORM P2120-SAVE-EXT-PAY THRU P2120-EXIT CL*47 +00727 ADD W-REMITTANCE TO W-TOT-PAID-REMITTANCE CL*57 +00728 MOVE 'RECEIVED ' TO P434-MESSAGE CL*65 +00729 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT. CL*48 +00730 DTSBX437 +00731 P2100-EXIT. DTSBX437 +00732 EXIT. DTSBX437 +00733 DTSBX437 +00734 P2110-EDIT-PAYMENT. DTSBX437 +00735 * MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*14 +00736 * IF W-VALID-PAY-88 CL*14 +00737 * NEXT SENTENCE CL*14 +00738 * ELSE CL*14 +00739 * SET W-ERROR-YES-88 TO TRUE CL*14 +00740 * MOVE SPACES TO R140-MESSAGE CL*14 +00741 * MOVE W-EMP-NO TO R140-EMP-NO CL*14 +00742 * STRING CL*14 +00743 * 'INVALID PAYMENT TYPE ' CL*14 +00744 * X145-PAY-TYPE CL*14 +00745 * DELIMITED BY SIZE CL*14 +00746 * INTO R140-MESSAGE CL*14 +00747 * END-STRING CL*14 +00748 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*14 +00749 * DISPLAY R140-MESSAGE CL*14 +00750 * END-IF. CL*14 +00751 DTSBX437 +00752 MOVE SPACES TO W-SLASH-QTR. CL*24 +00753 IF X145-QTR = SPACES CL*29 +00754 MOVE ZEROS TO W-REPORT-QTR DTSBX437 +00755 ELSE DTSBX437 +00756 MOVE X145-QTR TO W-SLASH-QTR CL*29 +00757 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR DTSBX437 +00758 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q DTSBX437 +00759 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX437 +00760 IF NOT L004-VALID-QTR DTSBX437 +00761 SET W-ERROR-YES-88 TO TRUE DTSBX437 +00762 MOVE SPACES TO R140-MESSAGE DTSBX437 +00763 MOVE W-EMP-NO TO R140-EMP-NO DTSBX437 +00764 STRING DTSBX437 +00765 'PEND: INV PAY QUARTER ' W-SLASH-QTR CL*63 +00766 DELIMITED BY SIZE DTSBX437 +00767 INTO R140-MESSAGE DTSBX437 +00768 END-STRING DTSBX437 +00769 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX437 +00770 DISPLAY R140-MESSAGE DTSBX437 +00771 MOVE +2 TO WRK-RETURN-CODE CL*25 +00772 ELSE DTSBX437 +00773 MOVE L004-QTR-5-9 TO W-REPORT-QTR DTSBX437 +00774 END-IF DTSBX437 +00775 END-IF. DTSBX437 +00776 DTSBX437 +00777 MOVE X145-REMITTANCE TO W-REMITTANCE. CL*29 +00778 * DISPLAY 'WREMITTANCE ' W-REMITTANCE. CL*46 +00779 * DISPLAY 'XREMITTANCE ' X145-REMITTANCE. CL*46 +00780 CL*38 +00781 ADD W-REMITTANCE TO W-TOT-REMITTANCE. CL*57 +00782 IF W-REMITTANCE = ZEROS CL*39 +00783 * SET W-ERROR-YES-88 TO TRUE CL*64 +00784 MOVE SPACES TO R140-MESSAGE CL*38 +00785 MOVE W-EMP-NO TO R140-EMP-NO CL*38 +00786 STRING CL*38 +00787 'INVALID REMITTANCE AMOUNT ' X145-REMITTANCE CL*38 +00788 DELIMITED BY SIZE CL*38 +00789 INTO R140-MESSAGE CL*38 +00790 END-STRING CL*38 +00791 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*38 +00792 DISPLAY R140-MESSAGE CL*38 +00793 * MOVE +2 TO WRK-RETURN-CODE CL*64 +00794 END-IF. CL*38 +00795 CL*38 +00796 DTSBX437 +00797 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*30 +00798 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX437 +00799 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX437 +00800 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX437 +00801 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX437 +00802 IF NOT L001-VALID-DATE DTSBX437 +00803 SET W-ERROR-YES-88 TO TRUE DTSBX437 +00804 MOVE SPACES TO R140-MESSAGE DTSBX437 +00805 MOVE W-EMP-NO TO R140-EMP-NO DTSBX437 +00806 STRING DTSBX437 +00807 'INVALID PAY RECEIVED DATE ' X145-RCVD-DATE CL*30 +00808 DELIMITED BY SIZE DTSBX437 +00809 INTO R140-MESSAGE DTSBX437 +00810 END-STRING DTSBX437 +00811 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX437 +00812 DISPLAY R140-MESSAGE DTSBX437 +00813 MOVE +2 TO WRK-RETURN-CODE CL*25 +00814 ELSE DTSBX437 +00815 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBX437 +00816 END-IF. DTSBX437 +00817 DTSBX437 +00818 * MOVE X212-DEPOSIT-DT TO W-SLASH-DATE CL*29 +00819 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*29 +00820 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*29 +00821 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*29 +00822 * PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*29 +00823 * IF NOT L001-VALID-DATE CL*29 +00824 * SET W-ERROR-YES-88 TO TRUE CL*29 +00825 * MOVE SPACES TO R140-MESSAGE CL*29 +00826 * MOVE W-EMP-NO TO R140-EMP-NO CL*29 +00827 * STRING CL*29 +00828 * 'INVALID DEPOSIT DATE ' X212-DEPOSIT-DT CL*29 +00829 * DELIMITED BY SIZE CL*29 +00830 * INTO R140-MESSAGE CL*29 +00831 * END-STRING CL*29 +00832 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*29 +00833 * DISPLAY R140-MESSAGE CL*11 +00834 * MOVE +2 TO WRK-RETURN-CODE CL*29 +00835 * ELSE CL*29 +00836 * MOVE L001-FED-8-DATE-9 TO W-DEPOSIT-DATE CL*29 +00837 * END-IF. CL*11 +00838 DTSBX437 +00839 PERFORM P2112-CHECK-DATABASE THRU P2112-EXIT. CL*17 +00840 P2110-EXIT. DTSBX437 +00841 EXIT. DTSBX437 +00842 DTSBX437 +00843 P2112-CHECK-DATABASE. DTSBX437 +00844 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX437 +00845 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX437 +00846 SET MPRF-PRF-88 TO TRUE. DTSBX437 +00847 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX437 +00848 DTSBX437 +00849 PERFORM S910-READ THRU S910-EXIT. DTSBX437 +00850 IF L910-NO-REC-88 DTSBX437 +00851 SET W-ERROR-YES-88 TO TRUE CL*25 +00852 SET W-EMP-FOUND-NO-88 TO TRUE DTSBX437 +00853 DISPLAY 'PAYMENT: EMPLOYER NOT ON FILE ' W-EMP-NO CL*45 +00854 MOVE SPACES TO R140-MESSAGE CL*15 +00855 MOVE W-EMP-NO TO R140-EMP-NO CL*15 +00856 STRING CL*15 +00857 'PEND: EMP NOT ON DUTAS' CL*62 +00858 X145-EMP-NO CL*30 +00859 DELIMITED BY SIZE CL*15 +00860 INTO R140-MESSAGE CL*15 +00861 END-STRING CL*15 +00862 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*15 +00863 MOVE +2 TO WRK-RETURN-CODE CL*41 +00864 * DISPLAY R140-MESSAGE CL*16 +00865 ELSE DTSBX437 +00866 MOVE MSKL-REC TO MPRF-REC DTSBX437 +00867 SET W-EMP-FOUND-YES-88 TO TRUE DTSBX437 +00868 END-IF. DTSBX437 +00869 DTSBX437 +00870 IF W-EMP-FOUND-NO-88 OR CL*62 +00871 W-ERROR-YES-88 CL*62 +00872 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 +00873 * ADD 1 TO W-PEND-CNT CL*47 +00874 * ADD 1 TO W-MPRF-CNT CL*47 +00875 * ADD 1 TO W-ERRO-CNT CL*47 +00876 GO TO P2112-EXIT. CL*62 +00877 CL*16 +00878 * IF EMPLOYER IS FOUND ON THE MPRF CHECK IF REPORT FOUND. CL*16 +00879 * IF EITHER IS NOT FOUND WRITE T025 REC TO PENDING FILE. CL*16 +00880 CL*16 +00881 MOVE LOW-VALUE TO MQTR-KEY-AREA. CL*22 +00882 MOVE W-EMP-NO TO MQTR-EMP-NO. CL*17 +00883 MOVE W-REPORT-QTR TO MQTR-YRQ. CL*22 +00884 SET MQTR-QTR-88 TO TRUE. CL*16 +00885 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL*16 +00886 CL*16 +00887 PERFORM S910-READ THRU S910-EXIT. CL*16 +00888 IF L910-NO-REC-88 CL*16 +00889 * SET W-ERROR-YES-88 TO TRUE CL*45 +00890 SET W-QTR-FOUND-NO-88 TO TRUE CL*17 +00891 DISPLAY 'PAYMENT: EMPL QTR NOT ON FILE ' W-EMP-NO CL*45 +00892 MOVE SPACES TO R140-MESSAGE CL*16 +00893 MOVE W-EMP-NO TO R140-EMP-NO CL*16 +00894 STRING CL*16 +00895 'REPT: QTR RPT NOT ON FILE ' CL*64 +00896 X145-EMP-NO ' QTR' W-SLASH-QTR CL*30 +00897 DELIMITED BY SIZE CL*16 +00898 INTO R140-MESSAGE CL*16 +00899 END-STRING CL*16 +00900 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*16 +00901 * MOVE +2 TO WRK-RETURN-CODE CL*45 +00902 * DISPLAY R140-MESSAGE CL*16 +00903 ELSE CL*17 +00904 SET W-QTR-FOUND-YES-88 TO TRUE CL*17 +00905 END-IF. CL*16 +00906 CL*16 +00907 * IF W-QTR-FOUND-NO-88 OR CL*47 +00908 * W-ERROR-YES-88 CL*47 +00909 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*45 +00910 * ADD 1 TO W-MQTR-CNT CL*47 +00911 * ADD 1 TO W-ERRO-CNT CL*47 +00912 * ADD 1 TO W-PEND-CNT. CL*47 +00913 CL*16 +00914 P2112-EXIT. DTSBX437 +00915 EXIT. DTSBX437 +00916 DTSBX437 +00917 P2120-SAVE-EXT-PAY. DTSBX437 +00918 * DISPLAY 'PAYMENT OK ' X212-EMP-NBR. CL*64 +00919 * PERFORM S005-FROM-SYS THRU S005-EXIT. CL*64 +00920 * CL*64 +00921 * MOVE LENGTH OF T025-REC TO T025-LENGTH CL*64 +00922 * MOVE '025' TO T025-REC-TYPE. CL*64 +00923 * CL*64 +00924 * MOVE W-EMP-NO TO T025-EMP-NO. CL*64 +00925 * MOVE 'WEB PAY ' TO T025-ORIGIN. CL*64 +00926 * MOVE L005-DATE TO T025-SYS-DATE. CL*64 +00927 * MOVE L005-TIME TO T025-SYS-TIME. CL*64 +00928 * CL*64 +00929 * IF W-REPORT-QTR > ZERO CL*64 +00930 * MOVE W-REPORT-QTR TO T025-APPLIC-YRQ CL*64 +00931 * MOVE 'PA' TO T025-PAY-TYPE CL*64 +00932 * ELSE CL*64 +00933 * MOVE ZERO TO T025-APPLIC-YRQ CL*64 +00934 * MOVE 'PA' TO T025-PAY-TYPE CL*64 +00935 * END-IF. CL*64 +00936 DTSBX437 +00937 * MOVE SPACES TO T025-APPLIC-IND. CL*64 +00938 * MOVE ZERO TO T025-APPLIC-BATCH-NO CL*64 +00939 * T025-APPLIC-ITEM-NO. CL*64 +00940 DTSBX437 +00941 * IF W-EMP-FOUND-YES-88 CL*64 +00942 * MOVE MPRF-PRIMARY-NAME (1:4) CL*64 +00943 * TO T025-NAME-CHECK CL*64 +00944 * ELSE CL*64 +00945 * MOVE SPACES TO T025-NAME-CHECK CL*64 +00946 * END-IF. CL*64 +00947 DTSBX437 +00948 * MOVE W-RECEIVED-DATE TO T025-RECEIVED-DATE CL*64 +00949 * T025-DEPOSIT-DATE. CL*64 +00950 DTSBX437 +00951 DTSBX437 +00952 * MOVE W-REMITTANCE TO T025-REMIT-AMT. CL*64 +00953 DTSBX437 +00954 * MOVE ZEROS TO T025-TRACE-NO. CL*64 +00955 DTSBX437 +00956 * MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*64 +00957 * MOVE 'TDECDCHK' TO T025-RESPONSIBLE-OP-ID. CL*64 +00958 DTSBX437 +00959 * MOVE T025-REC TO TSKL-REC. CL*64 +00960 * PERFORM S927B-WRITE THRU S927B-EXIT. CL*64 +00961 * ADD +1 TO W-T025-WRITE-CNT. CL*64 +00962 DTSBX437 +00963 ** DISPLAY 'BX423 PAYMENT ' X145-EMP-NO. DTSBX437 +00964 P2120-EXIT. DTSBX437 +00965 EXIT. DTSBX437 +00966 DTSBX437 +00967 DTSBX437 +00968 P3000-WRITE-PAID-RPT. CL*48 +00969 MOVE X145-EMP-NO TO P434-EMP-NO CL*48 +00970 MOVE X145-QTR TO P434-QTR CL*48 +00971 IF W-EMP-FOUND-YES-88 CL*48 +00972 MOVE MPRF-PRIMARY-NAME (1:24) CL*48 +00973 TO P434-NAME-CHECK CL*48 +00974 ELSE CL*48 +00975 MOVE SPACES TO P434-NAME-CHECK CL*48 +00976 END-IF. CL*48 +00977 CL*48 +00978 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL*48 +00979 MOVE W-REMITTANCE TO P434-X145-REMIT CL*53 +00980 * ADD W-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL*54 +00981 CL*48 +00982 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL*48 +00983 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL*48 +00984 ADD 1 TO WS-LINE-CNT2. CL*48 +00985 * ADD +1 TO WS-NUMBER-ONE. CL*50 +00986 P3000-EXIT. CL*48 +00987 EXIT. CL*48 +00988 CL*48 +00989 CL*48 +00990 P4100-PRINT-HEADER. CL*48 +00991 IF WS-LINE-CNT GREATER 58 OR CL*48 +00992 WS-LINE-CNT2 GREATER 58 CL*48 +00993 MOVE +0 TO WS-LINE-CNT CL*48 +00994 MOVE +0 TO WS-LINE-CNT2 CL*48 +00995 ADD +1 TO WS-PAGE-CNT CL*48 +00996 MOVE WS-PAGE-CNT TO HDR3-PAGE CL*48 +00997 * MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME CL*50 +00998 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*48 +00999 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL*48 +01000 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL*48 +01001 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL*48 +01002 * WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL*50 +01003 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL*48 +01004 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL*48 +01005 ADD +6 TO WS-LINE-CNT2. CL*48 +01006 P4100-EXIT. CL*48 +01007 EXIT. CL*48 +01008 CL*48 +01009 CL*48 +01010 DTSBX437 +01011 T0000-TERMINATE. DTSBX437 +01012 IF WS-LINE-CNT2 > 52 CL*57 +01013 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*55 +01014 END-IF. CL*55 +01015 MOVE W-X212-CNT TO WS-FOOTING-CNT. CL*56 +01016 MOVE W-T025-WRITE-CNT TO WS-T025-WRITE-CNT. CL*56 +01017 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL*61 +01018 MOVE W-X145-ERR-CNT TO WS-X145-PEN-CNT. CL*61 +01019 MOVE W-TOT-PAID-REMITTANCE TO WS-TOT-REMIT. CL*57 +01020 * MOVE W-TOT-REMIT-AMT TO WS-TOTAL-REMIT. CL*56 +01021 MOVE W-TOT-REMITTANCE TO WS-TOTAL-REMIT. CL*60 +01022 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. CL*55 +01023 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. CL*55 +01024 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. CL*55 +01025 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. CL*55 +01026 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL*55 +01027 * WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL*65 +01028 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. CL*55 +01029 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. CL*56 +01030 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 3. CL*60 +01031 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. CL*55 +01032 CL*55 +01033 DISPLAY ' '. CL*55 +01034 CL*55 +01035 CL*55 +01036 DTSBX437 +01037 CLOSE TDEC-PAYT-FILE TDEC-PEND-FILE. CL*29 +01038 DTSBX437 +01039 PERFORM S910-CLOSE THRU S910-EXIT. CL*35 +01040 PERFORM S927C-CLOSE THRU S927C-EXIT. CL*43 +01041 DISPLAY ' '. DTSBX437 +01042 DTSBX437 +01043 DISPLAY '*** DTSBX437 TERMINATION STATISTICS ***'. CL*64 +01044 DTSBX437 +01045 DISPLAY ' '. DTSBX437 +01046 DTSBX437 +01047 DISPLAY '*** TDEC REPORT PAYMENTS FOR DOES *'. CL*64 +01048 DTSBX437 +01049 DISPLAY ' '. DTSBX437 +01050 DTSBX437 +01051 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX437 +01052 DTSBX437 +01053 DISPLAY '***************************************'. DTSBX437 +01054 DTSBX437 +01055 T0000-EXIT. DTSBX437 +01056 EXIT. DTSBX437 +01057 DTSBX437 +01058 DTSBX437 +01059 T2000-DISPLAY-TOTALS. DTSBX437 +01060 DISPLAY 'TDEC PAYMENTS READ : ' CL*64 +01061 W-X212-CNT. CL*17 +01062 CL*17 +01063 DISPLAY 'TOTAL PAYMENTS PROCESSD: ' CL*64 +01064 W-T025-WRITE-CNT. DTSBX437 +01065 DTSBX437 +01066 DISPLAY 'TOTAL PAYMTN HAD ERRORS: ' CL*64 +01067 W-ERRO-CNT. CL*17 +01068 CL*17 +01069 DISPLAY 'MPRF RECORDS NOT FOUND : ' CL*17 +01070 W-MPRF-CNT. CL*17 +01071 CL*17 +01072 DISPLAY 'MQTR RECORDS NOT FOUND : ' CL*17 +01073 W-MQTR-CNT. CL*17 +01074 CL*17 +01075 DISPLAY 'PENDING PAYMENT WRITTEN: ' CL*64 +01076 W-PEND-CNT. CL*17 +01077 CL*17 +01078 DTSBX437 +01079 DISPLAY ' '. DTSBX437 +01080 DTSBX437 +01081 T2000-EXIT. DTSBX437 +01082 EXIT. DTSBX437 +01083 DTSBX437 +01084 S001-FROM-FED-8. DTSBX437 +01085 SET L001-FROM-FED-8 TO TRUE. DTSBX437 +01086 GO TO S001-DATE. DTSBX437 +01087 DTSBX437 +01088 S001-FROM-CAL-8. DTSBX437 +01089 SET L001-FROM-CAL-8 TO TRUE. DTSBX437 +01090 GO TO S001-DATE. DTSBX437 +01091 DTSBX437 +01092 S001-FROM-ABS-DAY. DTSBX437 +01093 SET L001-FROM-ABS-DAY TO TRUE. DTSBX437 +01094 GO TO S001-DATE. DTSBX437 +01095 DTSBX437 +01096 S001-DATE. DTSBX437 +01097 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX437 +01098 S001-EXIT. DTSBX437 +01099 EXIT. DTSBX437 +01100 DTSBX437 +01101 S003-AGENCY-DAY. DTSBX437 +01102 SET L003-AGENCY-DAY TO TRUE. DTSBX437 +01103 GO TO S003-WORK-DAY. DTSBX437 +01104 DTSBX437 +01105 S003-WORK-DAY. DTSBX437 +01106 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX437 +01107 S003-EXIT. DTSBX437 +01108 EXIT. DTSBX437 +01109 DTSBX437 +01110 S004-FROM-5. DTSBX437 +01111 SET L004-FROM-5 TO TRUE. DTSBX437 +01112 GO TO S004-YRQ. DTSBX437 +01113 DTSBX437 +01114 S004-FROM-DATE. DTSBX437 +01115 SET L004-FROM-DATE TO TRUE. DTSBX437 +01116 GO TO S004-YRQ. DTSBX437 +01117 DTSBX437 +01118 S004-FROM-ABS. DTSBX437 +01119 SET L004-FROM-ABS TO TRUE. DTSBX437 +01120 GO TO S004-YRQ. DTSBX437 +01121 DTSBX437 +01122 S004-YRQ. DTSBX437 +01123 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX437 +01124 DTSBX437 +01125 S004-EXIT. DTSBX437 +01126 EXIT. DTSBX437 +01127 S005-FROM-SYS. CL*16 +01128 SET L005-FROM-SYS TO TRUE. CL*16 +01129 GO TO S005-ABSTIME. CL*16 +01130 CL*16 +01131 S005-FROM-ABSTIME. CL*16 +01132 SET L005-FROM-ABSTIME TO TRUE. CL*16 +01133 GO TO S005-ABSTIME. CL*16 +01134 CL*16 +01135 S005-ABSTIME. CL*16 +01136 CALL 'DTSBU005' USING L005-LINK-AREA. CL*16 +01137 S005-EXIT. CL*16 +01138 EXIT. CL*16 +01139 CL*32 +01140 S205-WEB-EDITOR. CL*32 +01141 CALL 'DTSBU205' USING L205-LINK-AREA. CL*32 +01142 S205-EXIT. CL*32 +01143 EXIT. CL*32 +01144 DTSBX437 +01145 S910-OPEN-READ. CL*35 +01146 SET L910-OPEN-READ-88 TO TRUE. CL*35 +01147 GO TO S910-MSTR-IO. CL*35 +01148 CL*35 +01149 S910-READ. DTSBX437 +01150 SET L910-READ-88 TO TRUE. DTSBX437 +01151 GO TO S910-MSTR-IO. DTSBX437 +01152 DTSBX437 +01153 S910-START-BROWSE. DTSBX437 +01154 SET L910-START-BROWSE-88 TO TRUE. DTSBX437 +01155 GO TO S910-MSTR-IO. DTSBX437 +01156 DTSBX437 +01157 S910-READ-NEXT. DTSBX437 +01158 SET L910-READ-NEXT-88 TO TRUE. DTSBX437 +01159 GO TO S910-MSTR-IO. DTSBX437 +01160 DTSBX437 +01161 S910-CLOSE. CL*35 +01162 SET L910-CLOSE-88 TO TRUE. CL*35 +01163 GO TO S910-MSTR-IO. CL*35 +01164 DTSBX437 +01165 S910-MSTR-IO. DTSBX437 +01166 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX437 +01167 MSKL-REC. DTSBX437 +01168 S910-EXIT. DTSBX437 +01169 EXIT. DTSBX437 +01170 DTSBX437 +01171 *S921-OPEN-READ. DTSBX437 +01172 * SET L921-OPEN-READ-88 TO TRUE. DTSBX437 +01173 * GO TO S921-AIX-IO. DTSBX437 +01174 DTSBX437 +01175 S921-READ. DTSBX437 +01176 SET L921-READ-88 TO TRUE. DTSBX437 +01177 GO TO S921-AIX-IO. DTSBX437 +01178 DTSBX437 +01179 S921-START-BROWSE. DTSBX437 +01180 SET L921-START-BROWSE-88 TO TRUE. DTSBX437 +01181 GO TO S921-AIX-IO. DTSBX437 +01182 DTSBX437 +01183 S921-READ-NEXT. DTSBX437 +01184 SET L921-READ-NEXT-88 TO TRUE. DTSBX437 +01185 GO TO S921-AIX-IO. DTSBX437 +01186 DTSBX437 +01187 *S921-CLOSE. DTSBX437 +01188 * SET L921-CLOSE-88 TO TRUE. DTSBX437 +01189 * GO TO S921-AIX-IO. DTSBX437 +01190 DTSBX437 +01191 S921-AIX-IO. DTSBX437 +01192 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX437 +01193 ISKL-REC. DTSBX437 +01194 S921-EXIT. DTSBX437 +01195 EXIT. DTSBX437 +01196 DTSBX437 +01197 S923-OPEN-UPDATE. DTSBX437 +01198 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX437 +01199 GO TO S923-ATC-CALL. DTSBX437 +01200 DTSBX437 +01201 S923-WRITE. DTSBX437 +01202 SET L923-WRITE-88 TO TRUE. DTSBX437 +01203 GO TO S923-ATC-CALL. DTSBX437 +01204 DTSBX437 +01205 S923-CLOSE. DTSBX437 +01206 SET L923-CLOSE-88 TO TRUE. DTSBX437 +01207 GO TO S923-ATC-CALL. DTSBX437 +01208 DTSBX437 +01209 S923-ATC-CALL. DTSBX437 +01210 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX437 +01211 ASKL-REC. DTSBX437 +01212 S923-EXIT. DTSBX437 +01213 EXIT. DTSBX437 +01214 DTSBX437 +01215 S927A-OPEN. CL*42 +01216 SET L927-OPEN-UPDATE-88 TO TRUE. CL*42 +01217 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 +01218 CL*42 +01219 S927A-EXIT. CL*42 +01220 EXIT. CL*42 +01221 DTSBX437 +01222 S927B-WRITE. DTSBX437 +01223 SET L927-WRITE-88 TO TRUE. DTSBX437 +01224 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX437 +01225 DTSBX437 +01226 S927B-EXIT. DTSBX437 +01227 EXIT. DTSBX437 +01228 DTSBX437 +01229 S927C-CLOSE. CL*42 +01230 SET L927-CLOSE-88 TO TRUE. CL*42 +01231 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 +01232 CL*42 +01233 S927C-EXIT. CL*42 +01234 EXIT. CL*42 +01235 DTSBX437 +01236 S927Z-IO. DTSBX437 +01237 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX437 +01238 TSKL-REC. DTSBX437 +01239 S927Z-EXIT. DTSBX437 +01240 EXIT. DTSBX437 +01241 DTSBX437 +01242 S931-OPEN-READ. DTSBX437 +01243 SET L931-OPEN-READ-88 TO TRUE. DTSBX437 +01244 GO TO S931-REF-IO. DTSBX437 +01245 DTSBX437 +01246 S931-CLOSE. DTSBX437 +01247 SET L931-CLOSE-88 TO TRUE. DTSBX437 +01248 GO TO S931-REF-IO. DTSBX437 +01249 DTSBX437 +01250 S931-REF-IO. DTSBX437 +01251 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX437 +01252 FSKL-REC. DTSBX437 +01253 S931-EXIT. DTSBX437 +01254 EXIT. DTSBX437 +01255 DTSBX437 +01256 S946-WRITE-R140. DTSBX437 +01257 CALL 'DTSBU946' USING R140-REC. DTSBX437 +01258 DTSBX437 +01259 S946-EXIT. DTSBX437 +01260 EXIT. DTSBX437 +01261 DTSBX437 +01262 S999-ABEND. DTSBX437 +01263 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX437 +01264 S999-EXIT. DTSBX437 +01265 EXIT. DTSBX437 +01266 DTSBX437 diff --git a/Batch/DTSBX438.cob b/Batch/DTSBX438.cob new file mode 100644 index 0000000..d0e2055 --- /dev/null +++ b/Batch/DTSBX438.cob @@ -0,0 +1,1289 @@ +00001 IDENTIFICATION DIVISION. 02/05/15 +00002 PROGRAM-ID. DTSBX438. DTSBX438 +00003 AUTHOR. NGC. LV082 +00004 DATE-WRITTEN. SEPT 2014. CL*29 +00005 DATE-COMPILED. DTSBX438 +00006 SKIP3 DTSBX438 +00007 ***** DTSBX438 +00008 * DTSBX438 +00009 * FUNCTION: CREATE REPORT FOR ALL DAILY TDEC REPORT PAYMENTS CL*64 +00010 * FILE. PAYMENT WILL BE ADDED TO DUTAS FOR ESSP. CL*28 +00011 * MODIFICATION HISTORY: DTSBX438 +00012 * DTSBX438 +00013 * 09-20-2014 INITIAL DEVELOPMENT CL*19 +00014 * REFERENCE RFP: WEB REGISTRATION ESSP ZL1 CL*19 +00015 * CL*19 +00016 * DTSBX438 +00017 * 01-06-2015 MODIFIED PROGRAM TO PRODUCE REPORT OF ALL CL*49 +00018 * TDEC CHECK DISPOSITION (PAID AND PENDING) ZL1 CL*49 +00019 * CL*49 +00020 ***** DTSBX438 +00021 SKIP3 DTSBX438 +00022 ENVIRONMENT DIVISION. DTSBX438 +00023 CONFIGURATION SECTION. CL*51 +00024 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*51 +00025 CL*51 +00026 INPUT-OUTPUT SECTION. DTSBX438 +00027 DTSBX438 +00028 FILE-CONTROL. DTSBX438 +00029 DTSBX438 +00030 CL*14 +00031 SELECT TDEC-PAYT-FILE ASSIGN TO DTSFX145 CL*34 +00032 FILE STATUS IS TDEC-PAYT-STATUS. CL*28 +00033 CL*14 +00034 CL*16 +00035 SELECT TDEC-PEND-FILE ASSIGN TO DTSPX145 CL*34 +00036 FILE STATUS IS BATCH-XREF-STATUS. CL*16 +00037 CL*47 +00038 SELECT REPT-PAID-FILE ASSIGN TO X438RPT1 CL*68 +00039 FILE STATUS IS REPT-STATUS. CL*47 +00040 CL*47 +00041 SELECT REPT-PEND-FILE ASSIGN TO X438RPT2 CL*68 +00042 FILE STATUS IS REPT-STATUS. CL*47 +00043 CL*47 +00044 DATA DIVISION. DTSBX438 +00045 DTSBX438 +00046 FILE SECTION. DTSBX438 +00047 DTSBX438 +00048 CL*14 +00049 FD TDEC-PAYT-FILE CL*28 +00050 RECORDING MODE IS F CL*14 +00051 BLOCK CONTAINS 0 RECORDS CL*14 +00052 LABEL RECORDS ARE OMITTED. CL*14 +00053 CL*14 +00054 01 TDEC-PAYT-REC. CL*30 +00055 05 WEB-IMP-TYPE PIC X(03). CL*30 +00056 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. CL*30 +00057 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. CL*30 +00058 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. CL*30 +00059 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. CL*30 +00060 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. CL*30 +00061 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. CL*30 +00062 88 WEB-IMP-TYPE-REL-88 VALUE '130'. CL*30 +00063 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. CL*30 +00064 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. CL*30 +00065 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. CL*30 +00066 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. CL*30 +00067 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. CL*30 +00068 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' CL*30 +00069 '108' '130' '132'. CL*30 +00070 88 WEB-TYPE-RPT-88 VALUE '140' '144'. CL*30 +00071 88 WEB-TYPE-PAY-88 VALUE '145'. CL*30 +00072 88 WEB-TYPE-PRF-88 VALUE '110' '120'. CL*30 +00073 05 FILLER PIC X(01). CL*30 +00074 05 WEB-IMP-EMP-NO PIC 9(06). CL*30 +00075 05 FILLER PIC X(01). CL*30 +00076 05 WEB-IMP-QTR PIC X(06). CL*30 +00077 05 FILLER PIC X(495). CL*30 +00078 CL*30 +00079 CL*14 +00080 CL*16 +00081 FD TDEC-PEND-FILE CL*28 +00082 RECORDING MODE IS F CL*16 +00083 BLOCK CONTAINS 0 RECORDS CL*16 +00084 LABEL RECORDS ARE OMITTED. CL*16 +00085 CL*16 +00086 01 TDEC-PEND-REC PIC X(512). CL*30 +00087 CL*48 +00088 FD REPT-PAID-FILE CL*47 +00089 RECORDING MODE IS F CL*47 +00090 BLOCK CONTAINS 0 RECORDS CL*47 +00091 LABEL RECORDS ARE OMITTED. CL*47 +00092 CL*47 +00093 01 REPT-PAID-REC PIC X(133). CL*47 +00094 CL*47 +00095 CL*47 +00096 FD REPT-PEND-FILE CL*47 +00097 RECORDING MODE IS F CL*47 +00098 BLOCK CONTAINS 0 RECORDS CL*47 +00099 LABEL RECORDS ARE OMITTED. CL*47 +00100 CL*47 +00101 01 REPT-PEND-REC PIC X(133). CL*47 +00102 CL*47 +00103 CL*16 +00104 WORKING-STORAGE SECTION. DTSBX438 +001045 77 PAN-VALET PICTURE X(24) VALUE '082DTSBX438 02/05/15'. DTSBX438 +00105 SKIP3 DTSBX438 +00106 01 WRK-AREA. DTSBX438 +00107 05 W-ABEND-CD PIC S9(04) COMP VALUE 428. CL*18 +00108 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX429'. CL*28 +00109 DTSBX438 +00110 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX438 +00111 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSBX438 +00112 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX438 +00113 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX438 +00114 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX438 +00115 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX438 +00116 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX438 +00117 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX438 +00118 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX438 +00119 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX438 +00120 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX438 +00121 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX438 +00122 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX438 +00123 DTSBX438 +00124 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX438 +00125 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX438 +00126 88 W-ERROR-NO-88 VALUE 'N'. DTSBX438 +00127 DTSBX438 +00128 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX438 +00129 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX438 +00130 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX438 +00131 DTSBX438 +00132 05 BATCH-XREF-STATUS PIC X(02). DTSBX438 +00133 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX438 +00134 DTSBX438 +00135 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX438 +00136 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX438 +00137 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX438 +00138 DTSBX438 +00139 05 W-QTR-FOUND-IND PIC X(01) VALUE 'N'. CL*21 +00140 88 W-QTR-FOUND-YES-88 VALUE 'Y'. CL*21 +00141 88 W-QTR-FOUND-NO-88 VALUE 'N'. CL*21 +00142 CL*21 +00143 05 TDEC-PAYT-STATUS PIC X(02) VALUE SPACES. CL*28 +00144 88 W-TDEC-PAYT-EOF-88 VALUE '10'. CL*28 +00145 88 W-TDEC-PAYT-OK-88 VALUE '00'. CL*28 +00146 CL*21 +00147 05 REPT-STATUS PIC X(02) VALUE SPACES. CL*50 +00148 88 REPT-STATUS-EOF-88 VALUE '10'. CL*50 +00149 88 REPT-STATUS-OK-88 VALUE '00'. CL*50 +00150 CL*50 +00151 05 W-APAY-MAX PIC S9(04) COMP VALUE +100. DTSBX438 +00152 05 W-APAY-LAST PIC S9(04) COMP VALUE +0. DTSBX438 +00153 05 PSUB PIC S9(04) COMP VALUE +0. DTSBX438 +00154 05 W-APAY-TABLE. DTSBX438 +00155 10 W-APAY-ENTRY OCCURS 100 TIMES PIC X(96). DTSBX438 +00156 DTSBX438 +00157 05 WRK-RETURN-CODE PIC S9(01) VALUE +0. CL*26 +00158 05 W-EMP-NO PIC S9(07) COMP-3. CL*26 +00159 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBX438 +00160 05 W-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00161 05 W-TOT-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00162 05 W-TOT-PAID-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00163 05 W-TOT-PEND-REMITTANCE PIC S9(09)V99 VALUE 0. CL*59 +00164 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX438 +00165 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBX438 +00166 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX438 +00167 05 W-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX438 +00168 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE 0. CL*51 +00169 05 W-TRAN-CNT PIC S9(03) COMP-3. DTSBX438 +00170 05 W-PEND-CNT PIC 9(05) VALUE 0. CL*37 +00171 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. CL*81 +00172 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. CL*82 +00173 10 W-X145-TRACE-NO-A PIC 9(08). CL*82 +00174 10 W-X145-TRACE-NO-B PIC 9(05). CL*82 +00175 05 W-MPRF-CNT PIC 9(05) VALUE 0. CL*37 +00176 05 W-MQTR-CNT PIC 9(05) VALUE 0. CL*37 +00177 05 W-ERRO-CNT PIC 9(05) VALUE 0. CL*37 +00178 05 W-X145-ERR-CNT PIC 9(05) VALUE 0. CL*58 +00179 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*16 +00180 DTSBX438 +00181 05 W-EARNINGS PIC S9(09)V99. DTSBX438 +00182 05 W-INTEGER PIC S9(11) COMP-3. CL*33 +00183 05 W-FRACTION PIC SV9(11) COMP-3. CL*33 +00184 05 W-NUMBER PIC S9(11)V9(05) COMP-3. CL*33 +00185 05 SUB PIC S9(4) COMP. CL*33 +00186 CL*48 +00187 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL*48 +00188 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL*48 +00189 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL*48 +00190 CL*48 +00191 DTSBX438 +00192 05 W-PAY-TYPE PIC X(02). DTSBX438 +00193 88 W-PA-PAY-88 VALUE 'PA'. DTSBX438 +00194 88 W-OR-PAY-88 VALUE 'OR'. DTSBX438 +00195 88 W-EA-PAY-88 VALUE 'EA'. DTSBX438 +00196 88 W-AU-PAY-88 VALUE 'AU'. DTSBX438 +00197 88 W-FS-PAY-88 VALUE 'FS'. DTSBX438 +00198 88 W-AC-PAY-88 VALUE 'AC'. DTSBX438 +00199 88 W-ES-PAY-88 VALUE 'ES'. DTSBX438 +00200 88 W-WD-PAY-88 VALUE 'WD'. DTSBX438 +00201 88 W-PAY-REV-88 VALUE 'PR'. DTSBX438 +00202 88 W-REFUND-88 VALUE 'RF'. DTSBX438 +00203 88 W-REF-REV-88 VALUE 'RR'. DTSBX438 +00204 88 W-NG-CHECK-88 VALUE 'NG'. DTSBX438 +00205 88 W-VALID-PAY-88 VALUE 'PA' 'OR' 'EA' 'AU' DTSBX438 +00206 'FS' 'AC'. DTSBX438 +00207 DTSBX438 +00208 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX438 +00209 DTSBX438 +00210 05 W-SLASH-DATE PIC X(10). DTSBX438 +00211 05 FILLER REDEFINES W-SLASH-DATE. DTSBX438 +00212 10 W-SLASH-DT-MM PIC X(02). DTSBX438 +00213 10 FILLER PIC X(01). DTSBX438 +00214 10 W-SLASH-DT-DD PIC X(02). DTSBX438 +00215 10 FILLER PIC X(01). DTSBX438 +00216 10 W-SLASH-DT-CCYY PIC X(04). DTSBX438 +00217 DTSBX438 +00218 05 W-SLASH-QTR PIC X(06). DTSBX438 +00219 05 FILLER REDEFINES W-SLASH-QTR. DTSBX438 +00220 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX438 +00221 10 FILLER PIC X(01). DTSBX438 +00222 10 W-SLASH-QTR-Q PIC X(01). DTSBX438 +00223 DTSBX438 +00224 * PAYMENT DTSBX438 +00225 05 W-X212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 +00226 DTSBX438 +00227 05 W-APAY-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX438 +00228 DTSBX438 +00229 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX438 +00230 * 05 WS-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*57 +00231 DTSBX438 +00232 05 W-BX212-CNT PIC S9(07) COMP-3 VALUE +0. CL*16 +00233 DTSBX438 +00234 05 W-X212-LENGTH PIC S9(04) COMP. CL*16 +00235 DTSBX438 +00236 05 W-AMT-DISP1 PIC ----------9.99. DTSBX438 +00237 05 W-AMT-DISP2 PIC ----------9.99. DTSBX438 +00238 *RW1 DTSBX438 +00239 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX438 +00240 05 DISPLAY-CNT PIC Z(06)9. DTSBX438 +00241 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX438 +00242 *RW2 DTSBX438 +00243 DTSBX438 +00244 01 MESSAGE-AREA. DTSBX438 +00245 *** FATAL ERRORS MSG-A DTSBX438 +00246 05 MSG-A1. DTSBX438 +00247 10 FILLER PIC X(32) DTSBX438 +00248 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX438 +00249 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX438 +00250 DTSBX438 +00251 01 HEADER-1. CL*47 +00252 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00253 05 FILLER PIC X(49) VALUE '140R1'. CL*47 +00254 05 FILLER PIC X(60) VALUE CL*47 +00255 'DISTRICT OF COLUMBIA'. CL*47 +00256 05 FILLER PIC X(06) VALUE 'DATE:'. CL*47 +00257 05 HDR1-LRCM-SYS-DATE PIC X(10). CL*47 +00258 01 HEADER-2. CL*47 +00259 05 FILLER PIC X(54) VALUE SPACES. CL*47 +00260 05 FILLER PIC X(56) VALUE CL*47 +00261 'TAX DIVISION'. CL*47 +00262 05 FILLER PIC X(06) VALUE 'TIME:'. CL*47 +00263 05 HDR2-LRCM-SYS-TIME PIC X(08). CL*47 +00264 CL*47 +00265 01 HEADER-3. CL*47 +00266 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00267 05 FILLER PIC X(38) VALUE CL*47 +00268 'ROUTE TO: TAX ACCOUNTING STAFF'. CL*47 +00269 05 HDR3-LITERAL PIC X(43) VALUE CL*47 +00270 ' ESSP DAILY PROCESSED ACH PAYMENTS'. CL*66 +00271 05 FILLER PIC X(28) VALUE SPACES. CL*47 +00272 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*47 +00273 05 HDR3-PAGE PIC ZZ,ZZ9. CL*47 +00274 CL*47 +00275 01 HEADER-4. CL*47 +00276 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00277 05 FILLER PIC X(132) VALUE SPACES. CL*47 +00278 01 HEADER-5. CL*47 +00279 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00280 05 FILLER PIC X(34) VALUE CL*47 +00281 'EMP NO EMPLOYER NAME '. CL*53 +00282 05 FILLER PIC X(04) VALUE SPACES. CL*53 +00283 05 FILLER PIC X(34) VALUE CL*47 +00284 'QTR RECV-DATE PAID-AMT'. CL*54 +00285 05 FILLER PIC X(04) VALUE SPACES. CL*71 +00286 05 FILLER PIC X(09) VALUE CL*71 +00287 'TRACE NO '. CL*71 +00288 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00289 05 HDR5-NAME PIC X(28) VALUE CL*47 +00290 ' DISPOSITION OF PAYMTS'. CL*64 +00291 CL*47 +00292 01 HEADER-6. CL*47 +00293 05 FILLER PIC X(01) VALUE SPACES. CL*47 +00294 05 FILLER PIC X(132) VALUE SPACES. CL*47 +00295 CL*48 +00296 01 DETAIL-LINE-1. CL*47 +00297 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00298 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 +00299 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00300 15 X434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 +00301 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00302 15 X434-QTR PIC X(06). CL*47 +00303 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00304 15 X434-RCVD-DATE PIC X(10). CL*47 +00305 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00306 15 X434-X145-REMIT PIC -------9.99. CL*47 +00307 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00308 15 X434-X145-TRACE PIC X(08) VALUE SPACES. CL*72 +00309 15 FILLER PIC X(05) VALUE SPACES. CL*71 +00310 15 X434-MESSAGE PIC X(20). CL*48 +00311 CL*47 +00312 01 DETAIL-PEND-1. CL*47 +00313 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00314 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL*47 +00315 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00316 15 P434-NAME-CHECK PIC X(24) VALUE SPACES. CL*48 +00317 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00318 15 P434-QTR PIC X(06). CL*47 +00319 15 FILLER PIC X(02) VALUE SPACES. CL*47 +00320 15 P434-RCVD-DATE PIC X(10). CL*47 +00321 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00322 15 P434-X145-REMIT PIC --------9.99. CL*47 +00323 15 FILLER PIC X(05) VALUE SPACES. CL*71 +00324 15 P434-X145-TRACE PIC X(08) VALUE SPACES. CL*71 +00325 15 FILLER PIC X(05) VALUE SPACES. CL*48 +00326 15 P434-MESSAGE PIC X(30). CL*47 +00327 CL*47 +00328 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*47 +00329 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL*47 +00330 CL*47 +00331 01 FOOTING-LINE-3. CL*47 +00332 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00333 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL*47 +00334 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00335 05 FILLER PIC X(45) VALUE CL*47 +00336 ' TOTAL ACH PAYMENTS RECEIVED'. CL*66 +00337 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00338 CL*47 +00339 01 FOOTING-LINE-4. CL*47 +00340 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00341 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL*47 +00342 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00343 05 FILLER PIC X(34) VALUE CL*47 +00344 ' # OF ACH PAYMENTS HAD ERRORS '. CL*66 +00345 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00346 CL*47 +00347 01 FOOTING-LINE-5. CL*47 +00348 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00349 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL*47 +00350 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00351 05 FILLER PIC X(40) VALUE CL*47 +00352 ' # OF ACH PAYMTS WENT TO PENDING FILE '. CL*66 +00353 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00354 01 FOOTING-LINE-6. CL*56 +00355 05 FILLER PIC X(25) VALUE SPACES. CL*56 +00356 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL*56 +00357 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00358 05 FILLER PIC X(45) VALUE CL*67 +00359 ' # OF ACH PAYMENTS WAITING FOR PROCESSING '. CL*66 +00360 05 FILLER PIC X(32) VALUE SPACES. CL*56 +00361 01 FOOTING-LINE-7. CL*56 +00362 05 FILLER PIC X(19) VALUE SPACES. CL*47 +00363 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL*47 +00364 05 FILLER PIC X(02) VALUE SPACES. CL*47 +00365 05 FILLER PIC X(45) VALUE CL*47 +00366 ' TOTAL ACH PAYMENTS TO BE PROCESSED '. CL*66 +00367 05 FILLER PIC X(32) VALUE SPACES. CL*47 +00368 CL*47 +00369 01 FOOTING-LINE-8. CL*56 +00370 05 FILLER PIC X(19) VALUE SPACES. CL*56 +00371 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL*56 +00372 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00373 05 FILLER PIC X(45) VALUE CL*56 +00374 'TOTAL ACH PAYMENTS RECEIVED FROM ESSP'. CL*66 +00375 05 FILLER PIC X(32) VALUE SPACES. CL*56 +00376 CL*56 +00377 01 FOOTING-LINE-13. CL*47 +00378 05 FILLER PIC X(25) VALUE SPACES. CL*47 +00379 05 FILLER PIC X(67) VALUE CL*47 +00380 '*** END ESSP/DUTAS DAILY ACH PAYMNT PROCESSING ***'. CL*66 +00381 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL*47 +00382 CL*47 +00383 CL*47 +00384 CL*47 +00385 01 T025-REC. DTSBX438 +00386 ++INCLUDE DTSIT025 DTSBX438 +00387 DTSBX438 +00388 * REPORT DTSBX438 +00389 01 X140-REC. DTSBX438 +00390 ++INCLUDE DTSIX140 DTSBX438 +00391 DTSBX438 +00392 * PAYMENT DTSBX438 +00393 01 X145-REC. DTSBX438 +00394 ++INCLUDE DTSIX145 DTSBX438 +00395 DTSBX438 +00396 * ICESA-REPT-FILE CL*16 +00397 01 X212-REC. CL*16 +00398 ++INCLUDE DTSIX212 CL*20 +00399 CL*16 +00400 * BATCH - PSEUDO-BATCH XREF DTSBX438 +00401 01 X214-REC. DTSBX438 +00402 ++INCLUDE DTSIX214 DTSBX438 +00403 DTSBX438 +00404 * ERRORS DTSBX438 +00405 *01 X907-REC. DTSBX438 +00406 ***INCLUDE DTSIX907 DTSBX438 +00407 DTSBX438 +00408 01 L001-LINK-AREA. DTSBX438 +00409 ++INCLUDE DTSIL001 DTSBX438 +00410 DTSBX438 +00411 01 L003-LINK-AREA. DTSBX438 +00412 ++INCLUDE DTSIL003 DTSBX438 +00413 DTSBX438 +00414 01 L004-LINK-AREA. DTSBX438 +00415 ++INCLUDE DTSIL004 DTSBX438 +00416 DTSBX438 +00417 CL*16 +00418 01 L005-LINK-AREA. CL*16 +00419 ++INCLUDE DTSIL005 CL*16 +00420 CL*31 +00421 01 L205-LINK-AREA. CL*31 +00422 ++INCLUDE DTSIL205 CL*31 +00423 CL*16 +00424 01 L910-LINK-AREA. DTSBX438 +00425 ++INCLUDE DTSIL910 DTSBX438 +00426 01 MSKL-REC. DTSBX438 +00427 ++INCLUDE DTSIMSKL DTSBX438 +00428 DTSBX438 +00429 01 MHDR-REC. DTSBX438 +00430 ++INCLUDE DTSIMHDR DTSBX438 +00431 DTSBX438 +00432 01 MQTR-REC. CL*17 +00433 ++INCLUDE DTSIMQTR CL*17 +00434 CL*17 +00435 01 MPRF-REC. DTSBX438 +00436 ++INCLUDE DTSIMPRF DTSBX438 +00437 DTSBX438 +00438 01 MPAY-REC. DTSBX438 +00439 ++INCLUDE DTSIMPAY DTSBX438 +00440 DTSBX438 +00441 01 MNTE-REC. DTSBX438 +00442 ++INCLUDE DTSIMNTE DTSBX438 +00443 DTSBX438 +00444 01 L921-LINK-AREA. DTSBX438 +00445 ++INCLUDE DTSIL921 DTSBX438 +00446 SKIP3 DTSBX438 +00447 01 ISKL-REC. DTSBX438 +00448 ++INCLUDE DTSIISKL DTSBX438 +00449 SKIP3 DTSBX438 +00450 01 IEIN-REC. DTSBX438 +00451 ++INCLUDE DTSIIEIN DTSBX438 +00452 DTSBX438 +00453 01 L923-LINK-AREA. DTSBX438 +00454 ++INCLUDE DTSIL923 DTSBX438 +00455 EJECT DTSBX438 +00456 01 ASKL-REC. DTSBX438 +00457 ++INCLUDE DTSIASKL DTSBX438 +00458 EJECT DTSBX438 +00459 01 AHDR-REC. DTSBX438 +00460 ++INCLUDE DTSIAHDR DTSBX438 +00461 EJECT DTSBX438 +00462 01 ARPT-REC. DTSBX438 +00463 ++INCLUDE DTSIARPT DTSBX438 +00464 EJECT DTSBX438 +00465 01 APAY-REC. DTSBX438 +00466 ++INCLUDE DTSIAPAY DTSBX438 +00467 DTSBX438 +00468 01 L927-LINK-AREA. DTSBX438 +00469 ++INCLUDE DTSIL927 DTSBX438 +00470 DTSBX438 +00471 01 TSKL-REC. DTSBX438 +00472 ++INCLUDE DTSITSKL DTSBX438 +00473 DTSBX438 +00474 01 L931-LINK-AREA. DTSBX438 +00475 ++INCLUDE DTSIL931 DTSBX438 +00476 DTSBX438 +00477 01 FSKL-REC. DTSBX438 +00478 ++INCLUDE DTSIFSKL DTSBX438 +00479 DTSBX438 +00480 01 R140-REC. DTSBX438 +00481 ++INCLUDE DTSIR140 DTSBX438 +00482 DTSBX438 +00483 LINKAGE SECTION. DTSBX438 +00484 DTSBX438 +00485 *01 LX42-LINK-AREA. CL*14 +00486 *++INCLUDE DTSILX42 CL*14 +00487 DTSBX438 +00488 PROCEDURE DIVISION. CL*14 +00489 DTSBX438 +00490 DTSBX423-MAIN. DTSBX438 +00491 PERFORM I0000-INITIATE THRU I0000-EXIT. CL*27 +00492 DTSBX438 +00493 IF W-ERROR-YES-88 CL*27 +00494 MOVE WRK-RETURN-CODE TO RETURN-CODE CL*40 +00495 GO TO DTSBX423-MAIN-EXIT. CL*27 +00496 CL*27 +00497 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*27 +00498 DTSBX438 +00499 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL*27 +00500 MOVE WRK-RETURN-CODE TO RETURN-CODE. CL*40 +00501 DTSBX438 +00502 DTSBX438 +00503 DTSBX423-MAIN-EXIT. DTSBX438 +00504 GOBACK. DTSBX438 +00505 DTSBX438 +00506 I0000-INITIATE. DTSBX438 +00507 SET W-ERROR-NO-88 TO TRUE. DTSBX438 +00508 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX438 +00509 MOVE +0 TO WRK-RETURN-CODE CL*25 +00510 DTSBX438 +00511 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX438 +00512 MOVE '140' TO R140-REC-TYPE. DTSBX438 +00513 DTSBX438 +00514 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX438 +00515 CL*16 +00516 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*16 +00517 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*16 +00518 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*49 +00519 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*49 +00520 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*49 +00521 CL*16 +00522 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*35 +00523 PERFORM S927A-OPEN THRU S927A-EXIT. CL*42 +00524 DTSBX438 +00525 I0000-EXIT. DTSBX438 +00526 EXIT. DTSBX438 +00527 DTSBX438 +00528 I2000-OPEN-FILES. DTSBX438 +00529 DTSBX438 +00530 OPEN INPUT TDEC-PAYT-FILE. CL*29 +00531 IF W-TDEC-PAYT-EOF-88 CL*29 +00532 DISPLAY 'NO TDEC PAYMENT FILES TO PROCESS ' CL*29 +00533 MOVE +3 TO WRK-RETURN-CODE CL*27 +00534 SET W-ERROR-YES-88 TO TRUE CL*27 +00535 END-IF. CL*14 +00536 CL*16 +00537 OPEN OUTPUT TDEC-PEND-FILE. CL*29 +00538 IF BATCH-XREF-OK-88 CL*16 +00539 NEXT SENTENCE CL*16 +00540 ELSE CL*16 +00541 DISPLAY 'CANNOT OPEN TDEC PEND FILE ' CL*29 +00542 BATCH-XREF-STATUS CL*16 +00543 PERFORM S999-ABEND THRU S999-EXIT CL*16 +00544 END-IF. CL*16 +00545 OPEN OUTPUT REPT-PEND-FILE. CL*47 +00546 IF REPT-STATUS-OK-88 CL*47 +00547 NEXT SENTENCE CL*47 +00548 ELSE CL*47 +00549 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' CL*47 +00550 REPT-STATUS CL*47 +00551 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00552 END-IF. CL*47 +00553 CL*47 +00554 OPEN OUTPUT REPT-PAID-FILE. CL*47 +00555 IF REPT-STATUS-OK-88 CL*47 +00556 NEXT SENTENCE CL*47 +00557 ELSE CL*47 +00558 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' CL*47 +00559 REPT-STATUS CL*47 +00560 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00561 END-IF. CL*47 +00562 CL*16 +00563 I2000-EXIT. DTSBX438 +00564 EXIT. DTSBX438 +00565 DTSBX438 +00566 P0000-PROCESS. DTSBX438 +00567 READ TDEC-PAYT-FILE CL*33 +00568 CL*25 +00569 IF W-TDEC-PAYT-EOF-88 CL*29 +00570 DISPLAY 'TDEC INPUT FILE IS EMPTY ' CL*29 +00571 MOVE +3 TO WRK-RETURN-CODE CL*25 +00572 GO TO P0000-EXIT CL*25 +00573 END-IF. CL*25 +00574 CL*25 +00575 PERFORM UNTIL W-TDEC-PAYT-EOF-88 CL*29 +00576 PERFORM P1100-PARSE-TDEC-PAYT-REC THRU P1100-EXIT CL*30 +00577 IF W-ERROR-NO-88 CL*31 +00578 PERFORM P2100-PAYMENT THRU P2100-EXIT CL*25 +00579 END-IF CL*31 +00580 READ TDEC-PAYT-FILE CL*33 +00581 END-PERFORM. CL*25 +00582 CL*25 +00583 DTSBX438 +00584 P0000-EXIT. DTSBX438 +00585 EXIT. DTSBX438 +00586 P1100-PARSE-TDEC-PAYT-REC. CL*33 +00587 SET W-ERROR-NO-88 TO TRUE. CL*36 +00588 CL*30 +00589 PERFORM CL*30 +00590 VARYING SUB FROM +1 BY +1 CL*30 +00591 UNTIL SUB > +100 CL*30 +00592 MOVE +0 TO L205-FIELD-LENGTH (SUB) CL*30 +00593 L205-INTEGER (SUB) CL*30 +00594 L205-FRACTION (SUB) CL*30 +00595 MOVE SPACES TO L205-TEXT (SUB) CL*30 +00596 L205-DATE (SUB) CL*30 +00597 SET L205-TYPE-TEXT-88 (SUB) TO TRUE CL*30 +00598 END-PERFORM. CL*30 +00599 CL*30 +00600 IF WEB-IMP-TYPE-PAY-88 CL*30 +00601 PERFORM P1100J-SET-205-FIELDS THRU P1100J-EXIT CL*31 +00602 ELSE CL*30 +00603 SET W-ERROR-YES-88 TO TRUE CL*30 +00604 DISPLAY ' RECORD IS NOT PAY TYPE ' CL*30 +00605 END-IF. CL*30 +00606 DTSBX438 +00607 CL*31 +00608 * DISPLAY ' **** GOING TO 205 EDIT ESSP RECS ' CL*31 +00609 * DISPLAY ' **** ' CL*31 +00610 CL*31 +00611 IF W-ERROR-NO-88 CL*31 +00612 MOVE TDEC-PAYT-REC TO L205-INPUT-DATA CL*31 +00613 CALL 'DTSBU205' USING L205-LINK-AREA CL*31 +00614 PERFORM P1100K-BUILD-X145-REC THRU P1100K-EXIT. CL*31 +00615 CL*31 +00616 CL*31 +00617 P1100-EXIT. CL*31 +00618 EXIT. CL*31 +00619 CL*31 +00620 P1100J-SET-205-FIELDS. CL*31 +00621 DISPLAY 'P1100J-PAY ' TDEC-PAYT-REC(1:84). CL*31 +00622 INITIALIZE X145-REC. CL*31 +00623 MOVE +12 TO L205-LAST-FIELD. CL*31 +00624 MOVE +8 TO L205-LAST-FIELD-LEN. CL*31 +00625 CL*31 +00626 MOVE +3 TO L205-FIELD-LENGTH (1). CL*31 +00627 SET L205-TYPE-TEXT-88 (1) TO TRUE. CL*31 +00628 CL*31 +00629 MOVE +6 TO L205-FIELD-LENGTH (2). CL*31 +00630 SET L205-TYPE-TEXT-88 (2) TO TRUE. CL*31 +00631 CL*31 +00632 MOVE +6 TO L205-FIELD-LENGTH (3). CL*31 +00633 SET L205-TYPE-TEXT-88 (3) TO TRUE. CL*31 +00634 CL*31 +00635 MOVE +6 TO L205-FIELD-LENGTH (4). CL*31 +00636 SET L205-TYPE-TEXT-88 (4) TO TRUE. CL*31 +00637 MOVE +3 TO L205-FIELD-LENGTH (5). CL*31 +00638 SET L205-TYPE-TEXT-88 (5) TO TRUE. CL*31 +00639 CL*31 +00640 MOVE +2 TO L205-FIELD-LENGTH (6). CL*31 +00641 SET L205-TYPE-TEXT-88 (6) TO TRUE. CL*31 +00642 CL*31 +00643 MOVE +2 TO L205-FIELD-LENGTH (7). CL*31 +00644 SET L205-TYPE-TEXT-88 (7) TO TRUE. CL*31 +00645 CL*31 +00646 MOVE +2 TO L205-FIELD-LENGTH (8). CL*31 +00647 SET L205-TYPE-TEXT-88 (8) TO TRUE. CL*31 +00648 CL*31 +00649 MOVE +14 TO L205-FIELD-LENGTH (9). CL*31 +00650 SET L205-TYPE-NUMBER-88 (9) TO TRUE. CL*31 +00651 MOVE +10 TO L205-FIELD-LENGTH (10). CL*31 +00652 SET L205-TYPE-TEXT-88 (10) TO TRUE. CL*31 +00653 CL*31 +00654 MOVE +10 TO L205-FIELD-LENGTH (11). CL*31 +00655 SET L205-TYPE-TEXT-88 (11) TO TRUE. CL*31 +00656 CL*31 +00657 MOVE +8 TO L205-FIELD-LENGTH (12). CL*31 +00658 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*31 +00659 CL*31 +00660 CL*31 +00661 P1100J-EXIT. CL*31 +00662 EXIT. CL*31 +00663 CL*31 +00664 P1100K-BUILD-X145-REC. CL*31 +00665 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. CL*31 +00666 CL*31 +00667 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. CL*31 +00668 CL*31 +00669 MOVE '0' TO X145-SOURCE. CL*31 +00670 CL*31 +00671 MOVE L205-TEXT (3) (1:06) TO X145-QTR. CL*31 +00672 * DISPLAY 'X145 QTR ' X145-QTR. CL*46 +00673 CL*31 +00674 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. CL*31 +00675 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL*46 +00676 CL*31 +00677 MOVE L205-INTEGER (9) TO W-INTEGER. CL*31 +00678 MOVE L205-FRACTION (9) TO W-FRACTION. CL*31 +00679 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*31 +00680 MOVE W-NUMBER TO X145-REMITTANCE. CL*31 +00681 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL*46 +00682 CL*31 +00683 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. CL*31 +00684 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL*46 +00685 CL*31 +00686 MOVE L205-TEXT (12) TO X145-TRACE-NO CL*78 +00687 W-X145-TRACE-NO. CL*78 +00688 DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL*78 +00689 DISPLAY 'W145 PAY NO ' W-X145-TRACE-NO. CL*78 +00690 DISPLAY 'N145 PAY NO ' W-X145-TRACE-NO-N. CL*79 +00691 DISPLAY 'A145 PAY NO ' W-X145-TRACE-NO-A. CL*82 +00692 * MOVE X145-TRACE-NO TO W-X145-TRACE-NO CL*74 +00693 CL*31 +00694 CL*31 +00695 MOVE ZEROS TO X145-PSEUDO-BATCH. CL*31 +00696 CL*31 +00697 MOVE ZEROS TO X145-PSEUDO-ITEM. CL*31 +00698 CL*31 +00699 MOVE SPACES TO X145-APPLIC-ACCT. CL*31 +00700 CL*31 +00701 MOVE SPACES TO X145-CHECK-SCAN-DT. CL*31 +00702 CL*31 +00703 MOVE ZEROS TO X145-CHECK-SEQ-NBR. CL*31 +00704 CL*31 +00705 MOVE 'N' TO X145-WAIVE-INTEREST. CL*31 +00706 CL*31 +00707 MOVE 'N' TO X145-WAIVE-PENALTY. CL*31 +00708 CL*31 +00709 MOVE 'VOL' TO X145-RESP-ACTIVITY. CL*31 +00710 CL*31 +00711 MOVE 'WEBESSP ' TO X145-RESP-OPID. CL*69 +00712 CL*31 +00713 P1100K-EXIT. CL*31 +00714 EXIT. CL*31 +00715 CL*31 +00716 P2100-PAYMENT. DTSBX438 +00717 MOVE X145-EMP-NO TO W-EMP-NO. CL*29 +00718 * DISPLAY ' EMP NO ' W-EMP-NO. CL*46 +00719 SET W-EMP-FOUND-YES-88 TO TRUE. CL*47 +00720 DTSBX438 +00721 SET W-QTR-FOUND-NO-88 TO TRUE. CL*17 +00722 SET W-ERROR-NO-88 TO TRUE CL*17 +00723 DTSBX438 +00724 ADD +1 TO W-X212-CNT. CL*29 +00725 CL*29 +00726 PERFORM P2110-EDIT-PAYMENT THRU P2110-EXIT. CL*29 +00727 CL*47 +00728 IF W-EMP-FOUND-NO-88 OR CL*47 +00729 W-ERROR-YES-88 CL*47 +00730 ADD 1 TO W-PEND-CNT CL*48 +00731 ADD 1 TO W-MPRF-CNT CL*48 +00732 ADD 1 TO W-ERRO-CNT CL*48 +00733 ADD 1 TO W-X145-ERR-CNT CL*57 +00734 ADD W-REMITTANCE TO W-TOT-PEND-REMITTANCE CL*57 +00735 WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 +00736 MOVE R140-MESSAGE TO P434-MESSAGE CL*48 +00737 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT CL*48 +00738 GO TO P2100-EXIT. CL*47 +00739 CL*47 +00740 CL*29 +00741 CL*48 +00742 PERFORM P2120-SAVE-EXT-PAY THRU P2120-EXIT CL*47 +00743 ADD W-REMITTANCE TO W-TOT-PAID-REMITTANCE CL*57 +00744 MOVE 'RECEIVED ' TO P434-MESSAGE CL*65 +00745 PERFORM P3000-WRITE-PAID-RPT THRU P3000-EXIT. CL*48 +00746 DTSBX438 +00747 P2100-EXIT. DTSBX438 +00748 EXIT. DTSBX438 +00749 DTSBX438 +00750 P2110-EDIT-PAYMENT. DTSBX438 +00751 MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*69 +00752 IF W-VALID-PAY-88 CL*69 +00753 NEXT SENTENCE CL*69 +00754 ELSE CL*69 +00755 SET W-ERROR-YES-88 TO TRUE CL*69 +00756 MOVE SPACES TO R140-MESSAGE CL*69 +00757 MOVE W-EMP-NO TO R140-EMP-NO CL*69 +00758 STRING CL*69 +00759 'INVALID PAYMENT TYPE ' CL*69 +00760 X145-PAY-TYPE CL*69 +00761 DELIMITED BY SIZE CL*69 +00762 INTO R140-MESSAGE CL*69 +00763 END-STRING CL*69 +00764 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*69 +00765 DISPLAY R140-MESSAGE CL*69 +00766 END-IF. CL*69 +00767 DTSBX438 +00768 MOVE SPACES TO W-SLASH-QTR. CL*24 +00769 IF X145-QTR = SPACES CL*29 +00770 MOVE ZEROS TO W-REPORT-QTR DTSBX438 +00771 ELSE DTSBX438 +00772 MOVE X145-QTR TO W-SLASH-QTR CL*29 +00773 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR DTSBX438 +00774 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q DTSBX438 +00775 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX438 +00776 IF NOT L004-VALID-QTR DTSBX438 +00777 SET W-ERROR-YES-88 TO TRUE DTSBX438 +00778 MOVE SPACES TO R140-MESSAGE DTSBX438 +00779 MOVE W-EMP-NO TO R140-EMP-NO DTSBX438 +00780 STRING DTSBX438 +00781 'PEND: INV PAY QUARTER ' W-SLASH-QTR CL*63 +00782 DELIMITED BY SIZE DTSBX438 +00783 INTO R140-MESSAGE DTSBX438 +00784 END-STRING DTSBX438 +00785 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX438 +00786 DISPLAY R140-MESSAGE DTSBX438 +00787 MOVE +2 TO WRK-RETURN-CODE CL*25 +00788 ELSE DTSBX438 +00789 MOVE L004-QTR-5-9 TO W-REPORT-QTR DTSBX438 +00790 END-IF DTSBX438 +00791 END-IF. DTSBX438 +00792 DTSBX438 +00793 MOVE X145-REMITTANCE TO W-REMITTANCE. CL*29 +00794 * DISPLAY 'WREMITTANCE ' W-REMITTANCE. CL*46 +00795 * DISPLAY 'XREMITTANCE ' X145-REMITTANCE. CL*46 +00796 CL*38 +00797 ADD W-REMITTANCE TO W-TOT-REMITTANCE. CL*57 +00798 IF W-REMITTANCE = ZEROS CL*39 +00799 * SET W-ERROR-YES-88 TO TRUE CL*64 +00800 MOVE SPACES TO R140-MESSAGE CL*38 +00801 MOVE W-EMP-NO TO R140-EMP-NO CL*38 +00802 STRING CL*38 +00803 'INVALID REMITTANCE AMOUNT ' X145-REMITTANCE CL*38 +00804 DELIMITED BY SIZE CL*38 +00805 INTO R140-MESSAGE CL*38 +00806 END-STRING CL*38 +00807 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*38 +00808 DISPLAY R140-MESSAGE CL*38 +00809 * MOVE +2 TO WRK-RETURN-CODE CL*64 +00810 END-IF. CL*38 +00811 CL*38 +00812 DTSBX438 +00813 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*30 +00814 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX438 +00815 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX438 +00816 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX438 +00817 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX438 +00818 IF NOT L001-VALID-DATE DTSBX438 +00819 SET W-ERROR-YES-88 TO TRUE DTSBX438 +00820 MOVE SPACES TO R140-MESSAGE DTSBX438 +00821 MOVE W-EMP-NO TO R140-EMP-NO DTSBX438 +00822 STRING DTSBX438 +00823 'INVALID PAY RECEIVED DATE ' X145-RCVD-DATE CL*30 +00824 DELIMITED BY SIZE DTSBX438 +00825 INTO R140-MESSAGE DTSBX438 +00826 END-STRING DTSBX438 +00827 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX438 +00828 DISPLAY R140-MESSAGE DTSBX438 +00829 MOVE +2 TO WRK-RETURN-CODE CL*25 +00830 ELSE DTSBX438 +00831 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBX438 +00832 END-IF. DTSBX438 +00833 DTSBX438 +00834 * MOVE X212-DEPOSIT-DT TO W-SLASH-DATE CL*29 +00835 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*29 +00836 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*29 +00837 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*29 +00838 * PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*29 +00839 * IF NOT L001-VALID-DATE CL*29 +00840 * SET W-ERROR-YES-88 TO TRUE CL*29 +00841 * MOVE SPACES TO R140-MESSAGE CL*29 +00842 * MOVE W-EMP-NO TO R140-EMP-NO CL*29 +00843 * STRING CL*29 +00844 * 'INVALID DEPOSIT DATE ' X212-DEPOSIT-DT CL*29 +00845 * DELIMITED BY SIZE CL*29 +00846 * INTO R140-MESSAGE CL*29 +00847 * END-STRING CL*29 +00848 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*29 +00849 * DISPLAY R140-MESSAGE CL*11 +00850 * MOVE +2 TO WRK-RETURN-CODE CL*29 +00851 * ELSE CL*29 +00852 * MOVE L001-FED-8-DATE-9 TO W-DEPOSIT-DATE CL*29 +00853 * END-IF. CL*11 +00854 DTSBX438 +00855 PERFORM P2112-CHECK-DATABASE THRU P2112-EXIT. CL*17 +00856 P2110-EXIT. DTSBX438 +00857 EXIT. DTSBX438 +00858 DTSBX438 +00859 P2112-CHECK-DATABASE. DTSBX438 +00860 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX438 +00861 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX438 +00862 SET MPRF-PRF-88 TO TRUE. DTSBX438 +00863 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX438 +00864 DTSBX438 +00865 PERFORM S910-READ THRU S910-EXIT. DTSBX438 +00866 IF L910-NO-REC-88 DTSBX438 +00867 SET W-ERROR-YES-88 TO TRUE CL*25 +00868 SET W-EMP-FOUND-NO-88 TO TRUE DTSBX438 +00869 DISPLAY 'PAYMENT: EMPLOYER NOT ON FILE ' W-EMP-NO CL*45 +00870 MOVE SPACES TO R140-MESSAGE CL*15 +00871 MOVE W-EMP-NO TO R140-EMP-NO CL*15 +00872 STRING CL*15 +00873 'PEND: EMP NOT ON DUTAS' CL*62 +00874 X145-EMP-NO CL*30 +00875 DELIMITED BY SIZE CL*15 +00876 INTO R140-MESSAGE CL*15 +00877 END-STRING CL*15 +00878 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*15 +00879 MOVE +2 TO WRK-RETURN-CODE CL*41 +00880 * DISPLAY R140-MESSAGE CL*16 +00881 ELSE DTSBX438 +00882 MOVE MSKL-REC TO MPRF-REC DTSBX438 +00883 SET W-EMP-FOUND-YES-88 TO TRUE DTSBX438 +00884 END-IF. DTSBX438 +00885 DTSBX438 +00886 IF W-EMP-FOUND-NO-88 OR CL*62 +00887 W-ERROR-YES-88 CL*62 +00888 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*47 +00889 * ADD 1 TO W-PEND-CNT CL*47 +00890 * ADD 1 TO W-MPRF-CNT CL*47 +00891 * ADD 1 TO W-ERRO-CNT CL*47 +00892 GO TO P2112-EXIT. CL*62 +00893 CL*16 +00894 * IF EMPLOYER IS FOUND ON THE MPRF CHECK IF REPORT FOUND. CL*16 +00895 * IF EITHER IS NOT FOUND WRITE T025 REC TO PENDING FILE. CL*16 +00896 CL*16 +00897 MOVE LOW-VALUE TO MQTR-KEY-AREA. CL*22 +00898 MOVE W-EMP-NO TO MQTR-EMP-NO. CL*17 +00899 MOVE W-REPORT-QTR TO MQTR-YRQ. CL*22 +00900 SET MQTR-QTR-88 TO TRUE. CL*16 +00901 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL*16 +00902 CL*16 +00903 PERFORM S910-READ THRU S910-EXIT. CL*16 +00904 IF L910-NO-REC-88 CL*16 +00905 * SET W-ERROR-YES-88 TO TRUE CL*45 +00906 SET W-QTR-FOUND-NO-88 TO TRUE CL*17 +00907 DISPLAY 'PAYMENT: EMPL QTR NOT ON FILE ' W-EMP-NO CL*45 +00908 MOVE SPACES TO R140-MESSAGE CL*16 +00909 MOVE W-EMP-NO TO R140-EMP-NO CL*16 +00910 STRING CL*16 +00911 'REPT: QTR RPT NOT ON FILE ' CL*64 +00912 X145-EMP-NO ' QTR' W-SLASH-QTR CL*30 +00913 DELIMITED BY SIZE CL*16 +00914 INTO R140-MESSAGE CL*16 +00915 END-STRING CL*16 +00916 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*16 +00917 * MOVE +2 TO WRK-RETURN-CODE CL*45 +00918 * DISPLAY R140-MESSAGE CL*16 +00919 ELSE CL*17 +00920 SET W-QTR-FOUND-YES-88 TO TRUE CL*17 +00921 END-IF. CL*16 +00922 CL*16 +00923 * IF W-QTR-FOUND-NO-88 OR CL*47 +00924 * W-ERROR-YES-88 CL*47 +00925 * WRITE TDEC-PEND-REC FROM TDEC-PAYT-REC CL*45 +00926 * ADD 1 TO W-MQTR-CNT CL*47 +00927 * ADD 1 TO W-ERRO-CNT CL*47 +00928 * ADD 1 TO W-PEND-CNT. CL*47 +00929 CL*16 +00930 P2112-EXIT. DTSBX438 +00931 EXIT. DTSBX438 +00932 DTSBX438 +00933 P2120-SAVE-EXT-PAY. DTSBX438 +00934 DISPLAY 'PAYMENT OK ' X212-EMP-NBR. CL*69 +00935 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*69 +00936 CL*69 +00937 MOVE LENGTH OF T025-REC TO T025-LENGTH CL*69 +00938 MOVE '025' TO T025-REC-TYPE. CL*69 +00939 CL*69 +00940 MOVE W-EMP-NO TO T025-EMP-NO. CL*69 +00941 MOVE 'WEB PAY ' TO T025-ORIGIN. CL*69 +00942 MOVE L005-DATE TO T025-SYS-DATE. CL*69 +00943 MOVE L005-TIME TO T025-SYS-TIME. CL*69 +00944 CL*69 +00945 IF W-REPORT-QTR > ZERO CL*69 +00946 MOVE W-REPORT-QTR TO T025-APPLIC-YRQ CL*69 +00947 MOVE 'PA' TO T025-PAY-TYPE CL*69 +00948 ELSE CL*69 +00949 MOVE ZERO TO T025-APPLIC-YRQ CL*69 +00950 MOVE 'PA' TO T025-PAY-TYPE CL*69 +00951 END-IF. CL*69 +00952 DTSBX438 +00953 MOVE SPACES TO T025-APPLIC-IND. CL*69 +00954 MOVE ZERO TO T025-APPLIC-BATCH-NO CL*69 +00955 T025-APPLIC-ITEM-NO. CL*69 +00956 DTSBX438 +00957 IF W-EMP-FOUND-YES-88 CL*69 +00958 MOVE MPRF-PRIMARY-NAME (1:4) CL*69 +00959 TO T025-NAME-CHECK CL*69 +00960 ELSE CL*69 +00961 MOVE SPACES TO T025-NAME-CHECK CL*69 +00962 END-IF. CL*69 +00963 DTSBX438 +00964 MOVE W-RECEIVED-DATE TO T025-RECEIVED-DATE CL*69 +00965 T025-DEPOSIT-DATE. CL*69 +00966 DTSBX438 +00967 DTSBX438 +00968 MOVE W-REMITTANCE TO T025-REMIT-AMT. CL*69 +00969 DTSBX438 +00970 * MOVE X145-TRACE-NO TO W-X145-TRACE-NO. CL*78 +00971 CL*69 +00972 IF X145-TRACE-NO > SPACES CL*75 +00973 MOVE W-X145-TRACE-NO-A TO T025-TRACE-NO CL*82 +00974 ELSE CL*69 +00975 MOVE ZEROS TO T025-TRACE-NO. CL*69 +00976 CL*69 +00977 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*69 +00978 MOVE 'WEBESSP ' TO T025-RESPONSIBLE-OP-ID. CL*69 +00979 DTSBX438 +00980 MOVE T025-REC TO TSKL-REC. CL*69 +00981 PERFORM S927B-WRITE THRU S927B-EXIT. CL*69 +00982 ADD +1 TO W-T025-WRITE-CNT. CL*69 +00983 DTSBX438 +00984 ** DISPLAY 'BX423 PAYMENT ' X145-EMP-NO. DTSBX438 +00985 P2120-EXIT. DTSBX438 +00986 EXIT. DTSBX438 +00987 DTSBX438 +00988 DTSBX438 +00989 P3000-WRITE-PAID-RPT. CL*48 +00990 MOVE X145-EMP-NO TO P434-EMP-NO CL*48 +00991 MOVE X145-QTR TO P434-QTR CL*48 +00992 IF W-EMP-FOUND-YES-88 CL*48 +00993 MOVE MPRF-PRIMARY-NAME (1:24) CL*48 +00994 TO P434-NAME-CHECK CL*48 +00995 ELSE CL*48 +00996 MOVE SPACES TO P434-NAME-CHECK CL*48 +00997 END-IF. CL*48 +00998 CL*48 +00999 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL*48 +01000 MOVE W-REMITTANCE TO P434-X145-REMIT CL*53 +01001 MOVE X145-TRACE-NO TO P434-X145-TRACE CL*71 +01002 * ADD W-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL*54 +01003 CL*48 +01004 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL*48 +01005 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL*48 +01006 ADD 1 TO WS-LINE-CNT2. CL*48 +01007 * ADD +1 TO WS-NUMBER-ONE. CL*50 +01008 P3000-EXIT. CL*48 +01009 EXIT. CL*48 +01010 CL*48 +01011 CL*48 +01012 P4100-PRINT-HEADER. CL*48 +01013 IF WS-LINE-CNT GREATER 58 OR CL*48 +01014 WS-LINE-CNT2 GREATER 58 CL*48 +01015 MOVE +0 TO WS-LINE-CNT CL*48 +01016 MOVE +0 TO WS-LINE-CNT2 CL*48 +01017 ADD +1 TO WS-PAGE-CNT CL*48 +01018 MOVE WS-PAGE-CNT TO HDR3-PAGE CL*48 +01019 * MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME CL*50 +01020 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL*48 +01021 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL*48 +01022 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL*48 +01023 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL*48 +01024 * WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL*50 +01025 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL*48 +01026 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL*48 +01027 ADD +6 TO WS-LINE-CNT2. CL*48 +01028 P4100-EXIT. CL*48 +01029 EXIT. CL*48 +01030 CL*48 +01031 CL*48 +01032 DTSBX438 +01033 T0000-TERMINATE. DTSBX438 +01034 IF WS-LINE-CNT2 > 52 CL*57 +01035 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT CL*55 +01036 END-IF. CL*55 +01037 MOVE W-X212-CNT TO WS-FOOTING-CNT. CL*56 +01038 MOVE W-T025-WRITE-CNT TO WS-T025-WRITE-CNT. CL*56 +01039 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL*61 +01040 MOVE W-X145-ERR-CNT TO WS-X145-PEN-CNT. CL*61 +01041 MOVE W-TOT-PAID-REMITTANCE TO WS-TOT-REMIT. CL*57 +01042 * MOVE W-TOT-REMIT-AMT TO WS-TOTAL-REMIT. CL*56 +01043 MOVE W-TOT-REMITTANCE TO WS-TOTAL-REMIT. CL*60 +01044 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. CL*55 +01045 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. CL*55 +01046 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. CL*55 +01047 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. CL*55 +01048 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. CL*55 +01049 * WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. CL*65 +01050 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. CL*55 +01051 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. CL*56 +01052 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 3. CL*60 +01053 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. CL*55 +01054 CL*55 +01055 DISPLAY ' '. CL*55 +01056 CL*55 +01057 CL*55 +01058 DTSBX438 +01059 CLOSE TDEC-PAYT-FILE TDEC-PEND-FILE. CL*29 +01060 DTSBX438 +01061 PERFORM S910-CLOSE THRU S910-EXIT. CL*35 +01062 PERFORM S927C-CLOSE THRU S927C-EXIT. CL*43 +01063 DISPLAY ' '. DTSBX438 +01064 DTSBX438 +01065 DISPLAY '*** DTSBX437 TERMINATION STATISTICS ***'. CL*64 +01066 DTSBX438 +01067 DISPLAY ' '. DTSBX438 +01068 DTSBX438 +01069 DISPLAY '*** TDEC REPORT PAYMENTS FOR DOES *'. CL*64 +01070 DTSBX438 +01071 DISPLAY ' '. DTSBX438 +01072 DTSBX438 +01073 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX438 +01074 DTSBX438 +01075 DISPLAY '***************************************'. DTSBX438 +01076 DTSBX438 +01077 T0000-EXIT. DTSBX438 +01078 EXIT. DTSBX438 +01079 DTSBX438 +01080 DTSBX438 +01081 T2000-DISPLAY-TOTALS. DTSBX438 +01082 DISPLAY 'TDEC PAYMENTS READ : ' CL*64 +01083 W-X212-CNT. CL*17 +01084 CL*17 +01085 DISPLAY 'TOTAL PAYMENTS PROCESSD: ' CL*64 +01086 W-T025-WRITE-CNT. DTSBX438 +01087 DTSBX438 +01088 DISPLAY 'TOTAL PAYMTN HAD ERRORS: ' CL*64 +01089 W-ERRO-CNT. CL*17 +01090 CL*17 +01091 DISPLAY 'MPRF RECORDS NOT FOUND : ' CL*17 +01092 W-MPRF-CNT. CL*17 +01093 CL*17 +01094 DISPLAY 'MQTR RECORDS NOT FOUND : ' CL*17 +01095 W-MQTR-CNT. CL*17 +01096 CL*17 +01097 DISPLAY 'PENDING PAYMENT WRITTEN: ' CL*64 +01098 W-PEND-CNT. CL*17 +01099 CL*17 +01100 DTSBX438 +01101 DISPLAY ' '. DTSBX438 +01102 DTSBX438 +01103 T2000-EXIT. DTSBX438 +01104 EXIT. DTSBX438 +01105 DTSBX438 +01106 S001-FROM-FED-8. DTSBX438 +01107 SET L001-FROM-FED-8 TO TRUE. DTSBX438 +01108 GO TO S001-DATE. DTSBX438 +01109 DTSBX438 +01110 S001-FROM-CAL-8. DTSBX438 +01111 SET L001-FROM-CAL-8 TO TRUE. DTSBX438 +01112 GO TO S001-DATE. DTSBX438 +01113 DTSBX438 +01114 S001-FROM-ABS-DAY. DTSBX438 +01115 SET L001-FROM-ABS-DAY TO TRUE. DTSBX438 +01116 GO TO S001-DATE. DTSBX438 +01117 DTSBX438 +01118 S001-DATE. DTSBX438 +01119 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX438 +01120 S001-EXIT. DTSBX438 +01121 EXIT. DTSBX438 +01122 DTSBX438 +01123 S003-AGENCY-DAY. DTSBX438 +01124 SET L003-AGENCY-DAY TO TRUE. DTSBX438 +01125 GO TO S003-WORK-DAY. DTSBX438 +01126 DTSBX438 +01127 S003-WORK-DAY. DTSBX438 +01128 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX438 +01129 S003-EXIT. DTSBX438 +01130 EXIT. DTSBX438 +01131 DTSBX438 +01132 S004-FROM-5. DTSBX438 +01133 SET L004-FROM-5 TO TRUE. DTSBX438 +01134 GO TO S004-YRQ. DTSBX438 +01135 DTSBX438 +01136 S004-FROM-DATE. DTSBX438 +01137 SET L004-FROM-DATE TO TRUE. DTSBX438 +01138 GO TO S004-YRQ. DTSBX438 +01139 DTSBX438 +01140 S004-FROM-ABS. DTSBX438 +01141 SET L004-FROM-ABS TO TRUE. DTSBX438 +01142 GO TO S004-YRQ. DTSBX438 +01143 DTSBX438 +01144 S004-YRQ. DTSBX438 +01145 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX438 +01146 DTSBX438 +01147 S004-EXIT. DTSBX438 +01148 EXIT. DTSBX438 +01149 S005-FROM-SYS. CL*16 +01150 SET L005-FROM-SYS TO TRUE. CL*16 +01151 GO TO S005-ABSTIME. CL*16 +01152 CL*16 +01153 S005-FROM-ABSTIME. CL*16 +01154 SET L005-FROM-ABSTIME TO TRUE. CL*16 +01155 GO TO S005-ABSTIME. CL*16 +01156 CL*16 +01157 S005-ABSTIME. CL*16 +01158 CALL 'DTSBU005' USING L005-LINK-AREA. CL*16 +01159 S005-EXIT. CL*16 +01160 EXIT. CL*16 +01161 CL*32 +01162 S205-WEB-EDITOR. CL*32 +01163 CALL 'DTSBU205' USING L205-LINK-AREA. CL*32 +01164 S205-EXIT. CL*32 +01165 EXIT. CL*32 +01166 DTSBX438 +01167 S910-OPEN-READ. CL*35 +01168 SET L910-OPEN-READ-88 TO TRUE. CL*35 +01169 GO TO S910-MSTR-IO. CL*35 +01170 CL*35 +01171 S910-READ. DTSBX438 +01172 SET L910-READ-88 TO TRUE. DTSBX438 +01173 GO TO S910-MSTR-IO. DTSBX438 +01174 DTSBX438 +01175 S910-START-BROWSE. DTSBX438 +01176 SET L910-START-BROWSE-88 TO TRUE. DTSBX438 +01177 GO TO S910-MSTR-IO. DTSBX438 +01178 DTSBX438 +01179 S910-READ-NEXT. DTSBX438 +01180 SET L910-READ-NEXT-88 TO TRUE. DTSBX438 +01181 GO TO S910-MSTR-IO. DTSBX438 +01182 DTSBX438 +01183 S910-CLOSE. CL*35 +01184 SET L910-CLOSE-88 TO TRUE. CL*35 +01185 GO TO S910-MSTR-IO. CL*35 +01186 DTSBX438 +01187 S910-MSTR-IO. DTSBX438 +01188 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX438 +01189 MSKL-REC. DTSBX438 +01190 S910-EXIT. DTSBX438 +01191 EXIT. DTSBX438 +01192 DTSBX438 +01193 *S921-OPEN-READ. DTSBX438 +01194 * SET L921-OPEN-READ-88 TO TRUE. DTSBX438 +01195 * GO TO S921-AIX-IO. DTSBX438 +01196 DTSBX438 +01197 S921-READ. DTSBX438 +01198 SET L921-READ-88 TO TRUE. DTSBX438 +01199 GO TO S921-AIX-IO. DTSBX438 +01200 DTSBX438 +01201 S921-START-BROWSE. DTSBX438 +01202 SET L921-START-BROWSE-88 TO TRUE. DTSBX438 +01203 GO TO S921-AIX-IO. DTSBX438 +01204 DTSBX438 +01205 S921-READ-NEXT. DTSBX438 +01206 SET L921-READ-NEXT-88 TO TRUE. DTSBX438 +01207 GO TO S921-AIX-IO. DTSBX438 +01208 DTSBX438 +01209 *S921-CLOSE. DTSBX438 +01210 * SET L921-CLOSE-88 TO TRUE. DTSBX438 +01211 * GO TO S921-AIX-IO. DTSBX438 +01212 DTSBX438 +01213 S921-AIX-IO. DTSBX438 +01214 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX438 +01215 ISKL-REC. DTSBX438 +01216 S921-EXIT. DTSBX438 +01217 EXIT. DTSBX438 +01218 DTSBX438 +01219 S923-OPEN-UPDATE. DTSBX438 +01220 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX438 +01221 GO TO S923-ATC-CALL. DTSBX438 +01222 DTSBX438 +01223 S923-WRITE. DTSBX438 +01224 SET L923-WRITE-88 TO TRUE. DTSBX438 +01225 GO TO S923-ATC-CALL. DTSBX438 +01226 DTSBX438 +01227 S923-CLOSE. DTSBX438 +01228 SET L923-CLOSE-88 TO TRUE. DTSBX438 +01229 GO TO S923-ATC-CALL. DTSBX438 +01230 DTSBX438 +01231 S923-ATC-CALL. DTSBX438 +01232 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX438 +01233 ASKL-REC. DTSBX438 +01234 S923-EXIT. DTSBX438 +01235 EXIT. DTSBX438 +01236 DTSBX438 +01237 S927A-OPEN. CL*42 +01238 SET L927-OPEN-UPDATE-88 TO TRUE. CL*42 +01239 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 +01240 CL*42 +01241 S927A-EXIT. CL*42 +01242 EXIT. CL*42 +01243 DTSBX438 +01244 S927B-WRITE. DTSBX438 +01245 SET L927-WRITE-88 TO TRUE. DTSBX438 +01246 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX438 +01247 DTSBX438 +01248 S927B-EXIT. DTSBX438 +01249 EXIT. DTSBX438 +01250 DTSBX438 +01251 S927C-CLOSE. CL*42 +01252 SET L927-CLOSE-88 TO TRUE. CL*42 +01253 PERFORM S927Z-IO THRU S927Z-EXIT. CL*42 +01254 CL*42 +01255 S927C-EXIT. CL*42 +01256 EXIT. CL*42 +01257 DTSBX438 +01258 S927Z-IO. DTSBX438 +01259 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX438 +01260 TSKL-REC. DTSBX438 +01261 S927Z-EXIT. DTSBX438 +01262 EXIT. DTSBX438 +01263 DTSBX438 +01264 S931-OPEN-READ. DTSBX438 +01265 SET L931-OPEN-READ-88 TO TRUE. DTSBX438 +01266 GO TO S931-REF-IO. DTSBX438 +01267 DTSBX438 +01268 S931-CLOSE. DTSBX438 +01269 SET L931-CLOSE-88 TO TRUE. DTSBX438 +01270 GO TO S931-REF-IO. DTSBX438 +01271 DTSBX438 +01272 S931-REF-IO. DTSBX438 +01273 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX438 +01274 FSKL-REC. DTSBX438 +01275 S931-EXIT. DTSBX438 +01276 EXIT. DTSBX438 +01277 DTSBX438 +01278 S946-WRITE-R140. DTSBX438 +01279 CALL 'DTSBU946' USING R140-REC. DTSBX438 +01280 DTSBX438 +01281 S946-EXIT. DTSBX438 +01282 EXIT. DTSBX438 +01283 DTSBX438 +01284 S999-ABEND. DTSBX438 +01285 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX438 +01286 S999-EXIT. DTSBX438 +01287 EXIT. DTSBX438 +01288 DTSBX438 diff --git a/Batch/DTSBX441.cob b/Batch/DTSBX441.cob new file mode 100644 index 0000000..58bdf96 --- /dev/null +++ b/Batch/DTSBX441.cob @@ -0,0 +1,812 @@ +00001 IDENTIFICATION DIVISION. 08/01/24 +00002 PROGRAM-ID. DTSBX441. DTSBX441 +00003 AUTHOR. SC. LV083 +00004 DATE-WRITTEN. APRIL 2024. CL*21 +00005 DATE-COMPILED. DTSBX441 +00006 SKIP3 DTSBX441 +00007 ***** DTSBX441 +00008 * DTSBX441 +00009 * DTSBX441 +00010 * FUNCTION: READ X104 FILE,IF X104-INACTIVE-DATE = 0000000000 CL*78 +00011 * OR X104-INACTIVE-CODE = SPACES, READ MPRF-REC TO CL*78 +00012 * CHECK THE MPRF-EMP-STATUS. IF THE MPRF-EMP-STATUS CL*78 +00013 * IS ACTIVE, WRITE THE X104 RECORD AS IS TO X104-NEW CL*82 +00014 * IF THE STATUS IS INACTIVE,READ THE MSOL-REC, GET CL*78 +00015 * THE INACTIVE DATE,INACTIVE CODE,LIAB-DATE & WRITE CL*82 +00016 * TO X104-NEW REC. CL*78 +00017 * DTSBX441 +00018 * MODIFICATION LOG: DTSBX441 +00019 * DTSBX441 +00020 * 04/08/2024 INITIAL DEVELOPMENT. CL*21 +00021 * REFERENCE: PROGRAMMER: SC CL*21 +00022 * DTSBX441 +00023 DTSBX441 +00024 ENVIRONMENT DIVISION. DTSBX441 +00025 INPUT-OUTPUT SECTION. DTSBX441 +00026 DTSBX441 +00027 FILE-CONTROL. DTSBX441 +00028 DTSBX441 +00029 SELECT X104-DETERM-FILE ASSIGN TO EXPBX104 DTSBX441 +00030 FILE STATUS IS X104-IN-STATUS. CL*45 +00031 DTSBX441 +00032 SELECT X104-NEW-FILE ASSIGN TO EXPNW104 CL*22 +00033 FILE STATUS IS X104-NEW-STATUS. CL*22 +00034 CL*22 +00035 DTSBX441 +00036 DATA DIVISION. DTSBX441 +00037 FILE SECTION. DTSBX441 +00038 DTSBX441 +00039 FD X104-DETERM-FILE DTSBX441 +00040 RECORDING MODE IS F. DTSBX441 +00041 01 X104-REC PIC X(119). CL*70 +00042 DTSBX441 +00043 FD X104-NEW-FILE CL*22 +00044 RECORDING MODE IS F. CL*22 +00045 01 X104-NEW-REC. CL*36 +00046 05 X104-NEW-REC-TYPE PIC X(03). CL*45 +00047 05 FILLER PIC X(01) VALUE ','. CL*36 +00048 05 X104-NEW-EMP-NO PIC 9(06). CL*37 +00049 05 FILLER PIC X(01) VALUE ','. CL*36 +00050 05 X104-NEW-STAFF-REVIEW-IND PIC X(01). CL*37 +00051 05 FILLER PIC X(01) VALUE ','. CL*36 +00052 05 X104-NEW-LIAB-CD PIC X(02). CL*37 +00053 05 FILLER PIC X(01) VALUE ','. CL*36 +00054 05 X104-NEW-ELIG-CD PIC X(02). CL*37 +00055 05 FILLER PIC X(01) VALUE ','. CL*36 +00056 05 X104-NEW-NAICS-CD PIC 9(06). CL*37 +00057 05 FILLER PIC X(01) VALUE ','. CL*36 +00058 05 X104-NEW-ORG-TYPE PIC X(03). CL*37 +00059 05 FILLER PIC X(01) VALUE ','. CL*36 +00060 05 X104-NEW-INCORP-STATE PIC X(02). CL*37 +00061 05 FILLER PIC X(01) VALUE ','. CL*36 +00062 05 X104-NEW-INCORP-DATE PIC X(10). CL*37 +00063 05 FILLER PIC X(01) VALUE ','. CL*36 +00064 05 X104-NEW-HOUSEHOLD-FILING PIC X(01). CL*37 +00065 05 FILLER PIC X(01) VALUE ','. CL*36 +00066 05 X104-NEW-FIRST-WAGE-DT PIC X(10). CL*37 +00067 05 FILLER PIC X(01) VALUE ','. CL*36 +00068 05 X104-NEW-FIRST-500-QTR PIC X(06). CL*37 +00069 05 FILLER PIC X(01) VALUE ','. CL*36 +00070 05 X104-NEW-ACQUIRE-IND PIC X(01). CL*37 +00071 05 FILLER PIC X(01) VALUE ','. CL*37 +00072 05 X104-NEW-MERGER-SPLIT-IND PIC X(01). CL*37 +00073 05 FILLER PIC X(01) VALUE ','. CL*37 +00074 05 X104-NEW-REORG-IND PIC X(01). CL*37 +00075 05 FILLER PIC X(01) VALUE ','. CL*37 +00076 05 X104-NEW-COMMON-OWN-IND PIC X(01). CL*37 +00077 05 FILLER PIC X(01) VALUE ','. CL*37 +00078 05 X104-NEW-SALE-TRANSFER-IND PIC X(01). CL*37 +00079 05 FILLER PIC X(01) VALUE ','. CL*37 +00080 05 X104-NEW-NOT-LIAB-REASON PIC X(01). CL*37 +00081 05 FILLER PIC X(01) VALUE ','. CL*37 +00082 05 X104-NEW-INACTIVE-DATE PIC X(10). CL*37 +00083 05 FILLER PIC X(01) VALUE ','. CL*37 +00084 05 X104-NEW-INACTIVE-CODE PIC X(02). CL*37 +00085 05 FILLER PIC X(30) VALUE SPACE. CL*56 +00086 CL*37 +00087 WORKING-STORAGE SECTION. DTSBX441 +000875 77 PAN-VALET PICTURE X(24) VALUE '083DTSBX441 08/01/24'. DTSBX441 +00088 DTSBX441 +00089 01 WRK-AREA. DTSBX441 +00090 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +410.DTSBX441 +00091 05 ABEND-MSG PIC X(60). DTSBX441 +00092 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX410'.DTSBX441 +00093 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DTSBX441 +00094 DTSBX441 +00095 DTSBX441 +00096 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX441 +00097 05 WRK-TRACE-NO PIC 9(13). DTSBX441 +00098 05 WRK-TRACE-NO-X REDEFINES WRK-TRACE-NO DTSBX441 +00099 PIC B(12)9. DTSBX441 +00100 DTSBX441 +00101 05 WORK-HOLD-DATE1 PIC X(10) VALUE SPACE. CL*79 +00102 05 WORK-HOLD-DATE2 PIC X(10) VALUE SPACE. CL*79 +00103 05 WORK-INACT-DATE PIC S9(09) COMP-3. CL*51 +00104 05 WORK-LIAB-DATE PIC S9(09) COMP-3. CL*79 +00105 05 WORK-INACT-CODE PIC X(2) VALUE SPACE. CL*42 +00106 CL*39 +00107 05 WRK-ERROR-IND PIC X(01). DTSBX441 +00108 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX441 +00109 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX441 +00110 DTSBX441 +00111 05 WRK-SELECT-SOL-IND PIC X(01). DTSBX441 +00112 88 WRK-SELECT-SOL-YES-88 VALUE 'Y'. DTSBX441 +00113 88 WRK-SELECT-SOL-NO-88 VALUE 'N'. DTSBX441 +00114 DTSBX441 +00115 05 WRK-MPRF-IND PIC X(01). CL*45 +00116 88 WRK-MPRF-OK VALUE 'Y'. CL*45 +00117 88 WRK-MPRF-NO-REC VALUE 'N'. CL*45 +00118 CL*45 +00119 05 WRK-SELECT-INACT-IND PIC X(01). DTSBX441 +00120 88 WRK-SELECT-INACT-YES-88 VALUE 'Y'. DTSBX441 +00121 88 WRK-SELECT-INACT-NO-88 VALUE 'N'. DTSBX441 +00122 DTSBX441 +00123 DTSBX441 +00124 05 X104-IN-STATUS PIC X(02) VALUE SPACES. CL*32 +00125 88 X104-IN-OK-88 VALUE '00'. CL*32 +00126 88 X104-IN-EOF-88 VALUE '10'. CL*32 +00127 CL*23 +00128 05 X104-NEW-STATUS PIC X(02). CL*32 +00129 88 X104-NEW-OK-88 VALUE '00'. CL*32 +00130 DTSBX441 +00131 05 X104-IN-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00132 05 X104-OUT-CNT PIC S9(07) COMP-3 VALUE +0. CL*39 +00133 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. CL*52 +00134 CL*72 +00135 05 WRK-INACT-SLASH-DT. CL*72 +00136 15 WRK-INACT-MM PIC X(02) VALUE SPACE. CL*79 +00137 15 FILLER PIC X(01) VALUE '/'. CL*72 +00138 15 WRK-INACT-DD PIC X(02) VALUE SPACE. CL*79 +00139 15 FILLER PIC X(01) VALUE '/'. CL*72 +00140 15 WRK-INACT-YYYY PIC X(04) VALUE SPACE. CL*79 +00141 DTSBX441 +00142 05 WRK-LIAB-SLASH-DT. CL*79 +00143 15 WRK-LIAB-MM PIC X(02) VALUE SPACE. CL*79 +00144 15 FILLER PIC X(01) VALUE '/'. CL*79 +00145 15 WRK-LIAB-DD PIC X(02) VALUE SPACE. CL*79 +00146 15 FILLER PIC X(01) VALUE '/'. CL*79 +00147 15 WRK-LIAB-YYYY PIC X(04) VALUE SPACE. CL*79 +00148 CL*79 +00149 01 MSG-AREA. DTSBX441 +00150 05 MSG1-AREA. DTSBX441 +00151 10 MSG1-ID PIC X(03) VALUE '800'. DTSBX441 +00152 10 MSG1-TEXT. DTSBX441 +00153 15 FILLER PIC X(40) DTSBX441 +00154 VALUE ' '. DTSBX441 +00155 15 FILLER PIC X(40) DTSBX441 +00156 VALUE ' '. DTSBX441 +00157 DTSBX441 +00158 01 TALLY-AREA. DTSBX441 +00159 05 SLASH-NAME. DTSBX441 +00160 10 SLASH-NAME-CHAR OCCURS 40 TIMES PIC X(01). DTSBX441 +00161 05 FIRST-NAME PIC X(40) VALUE SPACE. DTSBX441 +00162 05 MIDDLE-INIT PIC X(01) VALUE SPACE. DTSBX441 +00163 05 LAST-NAME PIC X(40) VALUE SPACE. DTSBX441 +00164 05 NSUB PIC S9(04) COMP. DTSBX441 +00165 05 FSUB PIC S9(04) COMP. DTSBX441 +00166 05 LSUB PIC S9(04) COMP. DTSBX441 +00167 05 LAST-NAME-COMPLETE-IND PIC X(01). DTSBX441 +00168 88 LAST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBX441 +00169 88 LAST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBX441 +00170 05 FIRST-NAME-COMPLETE-IND PIC X(01). DTSBX441 +00171 88 FIRST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSBX441 +00172 88 FIRST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSBX441 +00173 05 MID-INIT-COMPLETE-IND PIC X(01). DTSBX441 +00174 88 MID-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSBX441 +00175 88 MID-INIT-COMPLETE-NO-88 VALUE 'N'. DTSBX441 +00176 05 D-S PIC X(02) VALUE SPACE. DTSBX441 +00177 05 SLASH-TALLY PIC S9(04) COMP. DTSBX441 +00178 05 LAST-NAME-LEN PIC S9(04) COMP. DTSBX441 +00179 05 FIRST-MID-LEN PIC S9(04) COMP. DTSBX441 +00180 05 FIRST-NAME-LEN PIC S9(04) COMP. DTSBX441 +00181 05 TOTAL-LEN PIC S9(04) COMP. DTSBX441 +00182 EJECT DTSBX441 +00183 01 WRK-X104-REC. CL*69 +00184 ++INCLUDE DTSNH104 CL*69 +00185 DTSBX441 +00186 01 L001-LINK-AREA. DTSBX441 +00187 ++INCLUDE DTSIL001 DTSBX441 +00188 DTSBX441 +00189 01 L003-LINK-AREA. DTSBX441 +00190 ++INCLUDE DTSIL003 DTSBX441 +00191 DTSBX441 +00192 01 L004-LINK-AREA. DTSBX441 +00193 ++INCLUDE DTSIL004 DTSBX441 +00194 DTSBX441 +00195 01 L005-LINK-AREA. DTSBX441 +00196 ++INCLUDE DTSIL005 DTSBX441 +00197 DTSBX441 +00198 01 L109-LINK-AREA. DTSBX441 +00199 ++INCLUDE DTSIL109 DTSBX441 +00200 DTSBX441 +00201 01 L410-LINK-AREA. DTSBX441 +00202 ++INCLUDE DTSIL410 DTSBX441 +00203 DTSBX441 +00204 01 L516-LINK-AREA. DTSBX441 +00205 ++INCLUDE DTSIL516 DTSBX441 +00206 DTSBX441 +00207 01 L600-LINK-AREA. DTSBX441 +00208 ++INCLUDE DTSIL600 DTSBX441 +00209 DTSBX441 +00210 01 L101-LINK-AREA. DTSBX441 +00211 ++INCLUDE DTSIL101 DTSBX441 +00212 DTSBX441 +00213 01 L910-LINK-AREA. DTSBX441 +00214 ++INCLUDE DTSIL910 DTSBX441 +00215 SKIP3 DTSBX441 +00216 01 MSKL-REC. DTSBX441 +00217 ++INCLUDE DTSIMSKL DTSBX441 +00218 SKIP3 DTSBX441 +00219 01 MHDR-REC. DTSBX441 +00220 ++INCLUDE DTSIMHDR DTSBX441 +00221 SKIP3 DTSBX441 +00222 01 MPRF-REC. DTSBX441 +00223 ++INCLUDE DTSIMPRF DTSBX441 +00224 DTSBX441 +00225 01 MSOL-REC. DTSBX441 +00226 ++INCLUDE DTSIMSOL DTSBX441 +00227 DTSBX441 +00228 01 MERA-REC. DTSBX441 +00229 ++INCLUDE DTSIMERA DTSBX441 +00230 DTSBX441 +00231 ++INCLUDE DTSIMQTR DTSBX441 +00232 DTSBX441 +00233 01 MFAE-REC. DTSBX441 +00234 ++INCLUDE DTSIMFAE DTSBX441 +00235 DTSBX441 +00236 01 MOPO-REC. DTSBX441 +00237 ++INCLUDE DTSIMOPO DTSBX441 +00238 DTSBX441 +00239 01 MTAD-REC. DTSBX441 +00240 ++INCLUDE DTSIMTAD DTSBX441 +00241 DTSBX441 +00242 01 MTAA-REC. DTSBX441 +00243 ++INCLUDE DTSIMTAA DTSBX441 +00244 DTSBX441 +00245 01 MREL-REC. DTSBX441 +00246 ++INCLUDE DTSIMREL DTSBX441 +00247 DTSBX441 +00248 01 MRTE-REC. DTSBX441 +00249 ++INCLUDE DTSIMRTE DTSBX441 +00250 DTSBX441 +00251 01 MLOG-REC. DTSBX441 +00252 ++INCLUDE DTSIMLOG DTSBX441 +00253 DTSBX441 +00254 01 MJRN-REC. DTSBX441 +00255 ++INCLUDE DTSIMJRN DTSBX441 +00256 DTSBX441 +00257 01 MRPT-REC. DTSBX441 +00258 ++INCLUDE DTSIMRPT DTSBX441 +00259 DTSBX441 +00260 01 MPAY-REC. DTSBX441 +00261 ++INCLUDE DTSIMPAY DTSBX441 +00262 DTSBX441 +00263 01 L921-LINK-AREA. DTSBX441 +00264 ++INCLUDE DTSIL921 DTSBX441 +00265 SKIP3 DTSBX441 +00266 01 ISKL-REC. DTSBX441 +00267 ++INCLUDE DTSIISKL DTSBX441 +00268 SKIP3 DTSBX441 +00269 01 IPES-REC. DTSBX441 +00270 ++INCLUDE DTSIIPES DTSBX441 +00271 DTSBX441 +00272 01 L931-LINK-AREA. DTSBX441 +00273 ++INCLUDE DTSIL931 DTSBX441 +00274 EJECT DTSBX441 +00275 01 FSKL-REC. DTSBX441 +00276 ++INCLUDE DTSIFSKL DTSBX441 +00277 EJECT DTSBX441 +00278 01 FCYR-REC. DTSBX441 +00279 ++INCLUDE DTSIFCYR DTSBX441 +00280 DTSBX441 +00281 01 FUIR-REC. DTSBX441 +00282 ++INCLUDE DTSIFUIR DTSBX441 +00283 DTSBX441 +00284 01 L981-LINK-AREA. DTSBX441 +00285 ++INCLUDE DTSIL981 DTSBX441 +00286 SKIP3 DTSBX441 +00287 01 WWGH-REC. DTSBX441 +00288 ++INCLUDE DTSIWWGH DTSBX441 +00289 EJECT DTSBX441 +00290 01 L982-LINK-AREA. DTSBX441 +00291 ++INCLUDE DTSIL982 DTSBX441 +00292 SKIP3 DTSBX441 +00293 01 WNAM-REC. DTSBX441 +00294 ++INCLUDE DTSIWNAM DTSBX441 +00295 EJECT DTSBX441 +00296 DTSBX441 +00297 PROCEDURE DIVISION. DTSBX441 +00298 DTSBX441 +00299 DTSBX441-MAIN. CL*28 +00300 CL*28 +00301 PERFORM I0000-INITIALIZE THRU I0000-EXIT. CL*28 +00302 CL*28 +00303 IF WRK-ERROR-YES-88 CL*45 +00304 GO TO DTSBX441-MAIN-EXIT. CL*28 +00305 CL*28 +00306 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*28 +00307 CL*28 +00308 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL*28 +00309 CL*28 +00310 DTSBX441-MAIN-EXIT. CL*28 +00311 GOBACK. CL*28 +00312 CL*28 +00313 I0000-INITIALIZE. DTSBX441 +00314 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX441 +00315 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX441 +00316 CL*42 +00317 SET WRK-ERROR-NO-88 TO TRUE. DTSBX441 +00318 DTSBX441 +00319 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX441 +00320 DTSBX441 +00321 I0000-EXIT. DTSBX441 +00322 EXIT. DTSBX441 +00323 DTSBX441 +00324 I2000-OPEN-FILES. DTSBX441 +00325 OPEN INPUT X104-DETERM-FILE. CL*23 +00326 IF X104-IN-OK-88 CL*45 +00327 NEXT SENTENCE CL**5 +00328 ELSE CL**5 +00329 DISPLAY 'OPEN ERROR ON X104 FILE ' X104-IN-STATUS CL*45 +00330 SET WRK-ERROR-YES-88 TO TRUE CL**5 +00331 GO TO I2000-EXIT CL**5 +00332 END-IF. CL**5 +00333 DTSBX441 +00334 OPEN OUTPUT X104-NEW-FILE. CL*23 +00335 IF X104-NEW-OK-88 CL*45 +00336 NEXT SENTENCE CL*23 +00337 ELSE CL*23 +00338 DISPLAY 'OPEN ERROR ON X104 NEW FILE ' X104-NEW-STATUS CL*45 +00339 SET WRK-ERROR-YES-88 TO TRUE CL*23 +00340 GO TO I2000-EXIT CL*23 +00341 END-IF. CL*23 +00342 CL*23 +00343 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*29 +00344 DTSBX441 +00345 I2000-EXIT. DTSBX441 +00346 EXIT. DTSBX441 +00347 DTSBX441 +00348 P0000-PROCESS. DTSBX441 +00349 PERFORM S1010-READ-X104-IN THRU S1010-EXIT. CL*32 +00350 CL*32 +00351 IF X104-IN-EOF-88 CL*32 +00352 DISPLAY 'INPUT FILE IS EMPTY' CL*32 +00353 GO TO P0000-EXIT CL*32 +00354 END-IF. CL*32 +00355 CL*32 +00356 PERFORM UNTIL X104-IN-EOF-88 CL*32 +00357 PERFORM P3100-UPDATE-INACT-DT THRU P3100-EXIT CL*32 +00358 PERFORM S1010-READ-X104-IN THRU S1010-EXIT CL*32 +00359 END-PERFORM. CL*32 +00360 CL*32 +00361 P0000-EXIT. CL*32 +00362 EXIT. CL*32 +00363 CL*32 +00364 CL*33 +00365 P3100-UPDATE-INACT-DT. CL*33 +00366 CL*58 +00367 IF X104-INACTIVE-DATE = 0000000000 OR CL*78 +00368 X104-INACTIVE-CODE = SPACES CL*33 +00369 CL*33 +00370 PERFORM P3200-GET-INACT-DT THRU P3200-EXIT CL*45 +00371 ELSE CL*33 +00372 WRITE X104-NEW-REC FROM WRK-X104-REC DTSBX441 +00373 ADD +1 TO X104-OUT-CNT CL*45 +00374 END-IF. CL*33 +00375 CL*33 +00376 P3100-EXIT. CL*33 +00377 EXIT. CL*33 +00378 CL*33 +00379 P3200-GET-INACT-DT. CL*33 +00380 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*29 +00381 MOVE X104-EMP-NO TO MSKL-EMP-NO. CL*29 +00382 CL*29 +00383 SET MSKL-PRF-88 TO TRUE. CL*29 +00384 CL*29 +00385 PERFORM S910-READ THRU S910-EXIT. CL*29 +00386 IF L910-OK-88 CL*29 +00387 SET WRK-MPRF-OK TO TRUE CL*29 +00388 ELSE CL*29 +00389 DISPLAY 'EMP NO NOT IN USE ' MSKL-EMP-NO CL*29 +00390 PERFORM S999-ABEND THRU S999-EXIT. CL*47 +00391 CL*29 +00392 MOVE MSKL-REC TO MPRF-REC. CL*29 +00393 CL*30 +00394 IF MPRF-EMP-STATUS = 'I' CL*30 +00395 PERFORM P3300-READ-SOL THRU P3300-EXIT CL*51 +00396 ELSE CL*30 +00397 WRITE X104-NEW-REC FROM WRK-X104-REC DTSBX441 +00398 ADD +1 TO X104-OUT-CNT. CL*42 +00399 CL*33 +00400 CL*33 +00401 P3200-EXIT. CL*33 +00402 EXIT. CL*33 +00403 CL*29 +00404 P3300-READ-SOL. CL*33 +00405 MOVE ZEROES TO WORK-INACT-DATE. CL*43 +00406 MOVE ZEROES TO WORK-LIAB-DATE. CL*81 +00407 CL*43 +00408 MOVE LOW-VALUES TO MSOL-REC. CL*35 +00409 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*35 +00410 MOVE X104-EMP-NO TO MSOL-EMP-NO. CL*35 +00411 SET MSOL-SOL-88 TO TRUE. CL*35 +00412 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. CL*35 +00413 CL*47 +00414 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL*35 +00415 CL*50 +00416 IF L910-OK-88 CL*35 +00417 PERFORM S910B-READ THRU S910B-EXIT CL*51 +00418 ELSE CL*50 +00419 PERFORM S999-ABEND THRU S999-EXIT. CL*50 +00420 CL*47 +00421 IF L910-OK-88 CL*35 +00422 PERFORM P3310-BUILD-NEW-X104 THRU P3310-EXIT CL*50 +00423 UNTIL L910-NO-REC-88 CL*51 +00424 ELSE CL*47 +00425 PERFORM S999-ABEND THRU S999-EXIT. CL*50 +00426 CL*63 +00427 MOVE WORK-INACT-DATE TO WORK-HOLD-DATE1 CL*79 +00428 CL*72 +00429 MOVE WORK-HOLD-DATE1(2:4) TO WRK-INACT-YYYY CL*79 +00430 MOVE WORK-HOLD-DATE1(6:2) TO WRK-INACT-MM CL*79 +00431 MOVE WORK-HOLD-DATE1(8:2) TO WRK-INACT-DD CL*79 +00432 CL*73 +00433 MOVE WORK-LIAB-DATE TO WORK-HOLD-DATE2 CL*79 +00434 CL*79 +00435 MOVE WORK-HOLD-DATE2(2:4) TO WRK-LIAB-YYYY CL*79 +00436 MOVE WORK-HOLD-DATE2(6:2) TO WRK-LIAB-MM CL*79 +00437 MOVE WORK-HOLD-DATE2(8:2) TO WRK-LIAB-DD CL*79 +00438 CL*79 +00439 MOVE WRK-LIAB-SLASH-DT TO X104-FIRST-WAGE-DT CL*79 +00440 MOVE WRK-INACT-SLASH-DT TO X104-INACTIVE-DATE CL*73 +00441 MOVE WORK-INACT-CODE TO X104-INACTIVE-CODE CL*73 +00442 CL*63 +00443 WRITE X104-NEW-REC FROM WRK-X104-REC DTSBX441 +00444 ADD +1 TO X104-OUT-CNT. CL*42 +00445 CL*35 +00446 P3300-EXIT. CL*33 +00447 EXIT. CL*33 +00448 CL*33 +00449 P3310-BUILD-NEW-X104. CL*35 +00450 MOVE MSKL-REC TO MSOL-REC. CL*47 +00451 CL*47 +00452 IF MSOL-INACT-DATE > WORK-INACT-DATE CL*35 +00453 MOVE MSOL-LIAB-DATE TO WORK-LIAB-DATE CL*81 +00454 MOVE MSOL-INACT-DATE TO WORK-INACT-DATE CL*81 +00455 MOVE MSOL-INACT-CD TO WORK-INACT-CODE. CL*41 +00456 CL*35 +00457 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*51 +00458 CL*47 +00459 P3310-EXIT. CL*35 +00460 EXIT. CL*35 +00461 CL*35 +00462 DTSBX441 +00463 S1010-READ-X104-IN. CL*32 +00464 READ X104-DETERM-FILE INTO WRK-X104-REC CL*69 +00465 IF X104-IN-OK-88 CL*32 +00466 ADD +1 TO X104-IN-CNT CL*45 +00467 ELSE CL*32 +00468 IF X104-IN-EOF-88 CL*32 +00469 DISPLAY 'EOF' CL*32 +00470 ELSE CL*32 +00471 DISPLAY 'CANNOT READ X104 INPUT ' X104-IN-STATUS CL*53 +00472 PERFORM S999-ABEND THRU S999-EXIT CL*53 +00473 END-IF CL*32 +00474 END-IF. CL*32 +00475 CL*32 +00476 S1010-EXIT. CL*32 +00477 EXIT. CL*32 +00478 CL*32 +00479 T0000-TERMINATE. DTSBX441 +00480 DTSBX441 +00481 DISPLAY '*********************************************'. DTSBX441 +00482 DISPLAY '* DTSBX441 TERMINATION STATISTICS'. CL*41 +00483 DISPLAY '* '. DTSBX441 +00484 DISPLAY '* DETERMINATION RECS READ : ' CL*41 +00485 X104-IN-CNT. CL*45 +00486 DISPLAY '* DETERMINATION RECS WRITTEN : ' CL*45 +00487 X104-OUT-CNT. CL*45 +00488 DISPLAY '*********************************************'. DTSBX441 +00489 DTSBX441 +00490 DTSBX441 +00491 CLOSE X104-DETERM-FILE CL*25 +00492 X104-NEW-FILE. CL*25 +00493 DTSBX441 +00494 PERFORM S910-CLOSE THRU S910-EXIT. CL*41 +00495 DTSBX441 +00496 T0000-EXIT. DTSBX441 +00497 EXIT. DTSBX441 +00498 DTSBX441 +00499 S001-FROM-FED-8. DTSBX441 +00500 SET L001-FROM-FED-8 TO TRUE. DTSBX441 +00501 GO TO S001-DATE. DTSBX441 +00502 DTSBX441 +00503 S001-FROM-ABS-DAY. DTSBX441 +00504 SET L001-FROM-ABS-DAY TO TRUE. DTSBX441 +00505 GO TO S001-DATE. DTSBX441 +00506 DTSBX441 +00507 S001-DATE. DTSBX441 +00508 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX441 +00509 S001-EXIT. DTSBX441 +00510 EXIT. DTSBX441 +00511 DTSBX441 +00512 S003-AGENCY-DAY. DTSBX441 +00513 SET L003-AGENCY-DAY TO TRUE. DTSBX441 +00514 GO TO S003-WORK-DAY. DTSBX441 +00515 DTSBX441 +00516 S003-WORK-DAY. DTSBX441 +00517 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX441 +00518 S003-EXIT. DTSBX441 +00519 EXIT. DTSBX441 +00520 DTSBX441 +00521 S004-FROM-DATE. DTSBX441 +00522 SET L004-FROM-DATE TO TRUE. DTSBX441 +00523 GO TO S004-QTR. DTSBX441 +00524 DTSBX441 +00525 S004-FROM-5. DTSBX441 +00526 SET L004-FROM-5 TO TRUE. DTSBX441 +00527 GO TO S004-QTR. DTSBX441 +00528 DTSBX441 +00529 S004-FROM-ABS. DTSBX441 +00530 SET L004-FROM-ABS TO TRUE. DTSBX441 +00531 GO TO S004-QTR. DTSBX441 +00532 DTSBX441 +00533 S004-FROM-3. DTSBX441 +00534 SET L004-FROM-3 TO TRUE. DTSBX441 +00535 GO TO S004-QTR. DTSBX441 +00536 DTSBX441 +00537 S004-QTR. DTSBX441 +00538 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX441 +00539 S004-EXIT. DTSBX441 +00540 EXIT. DTSBX441 +00541 DTSBX441 +00542 S005-SYS-DATE. DTSBX441 +00543 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX441 +00544 DTSBX441 +00545 S005-EXIT. DTSBX441 +00546 EXIT. DTSBX441 +00547 DTSBX441 +00548 S101-PER-MONTH-NO. DTSBX441 +00549 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBX441 +00550 GO TO S101-INT-CHARGE. DTSBX441 +00551 DTSBX441 +00552 S101-INT-CHARGE. DTSBX441 +00553 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBX441 +00554 S101-EXIT. DTSBX441 +00555 EXIT. DTSBX441 +00556 DTSBX441 +00557 S109-SUR-BY-QTR. DTSBX441 +00558 SET L109-CLASS-SELF-INS-88 TO TRUE. DTSBX441 +00559 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBX441 +00560 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBX441 +00561 DTSBX441 +00562 S109-QTR-EXIT. DTSBX441 +00563 EXIT. DTSBX441 +00564 DTSBX441 +00565 S410-FILE-SCHED. DTSBX441 +00566 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBX441 +00567 S410-EXIT. DTSBX441 +00568 EXIT. DTSBX441 +00569 DTSBX441 +00570 S516-LIABILITY. DTSBX441 +00571 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX441 +00572 MPRF-REC. DTSBX441 +00573 S516-EXIT. DTSBX441 +00574 EXIT. DTSBX441 +00575 DTSBX441 +00576 S910-OPEN-READ. CL*29 +00577 SET L910-OPEN-READ-88 TO TRUE. CL*29 +00578 GO TO S910-MSTR-IO. CL*29 +00579 CL*29 +00580 S910-OPEN-UPDATE-NO-AIX. CL*29 +00581 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*29 +00582 GO TO S910-MSTR-IO. CL*29 +00583 CL*29 +00584 S910-READ. CL*29 +00585 SET L910-READ-88 TO TRUE. CL*29 +00586 GO TO S910-MSTR-IO. CL*29 +00587 CL*29 +00588 S910-START-BROWSE. CL*29 +00589 SET L910-START-BROWSE-88 TO TRUE. CL*29 +00590 GO TO S910-MSTR-IO. CL*29 +00591 CL*29 +00592 S910-READ-NEXT. CL*29 +00593 SET L910-READ-NEXT-88 TO TRUE. CL*29 +00594 GO TO S910-MSTR-IO. CL*29 +00595 CL*29 +00596 S910-COUNT. CL*29 +00597 SET L910-COUNT-88 TO TRUE. CL*29 +00598 GO TO S910-MSTR-IO. CL*29 +00599 CL*29 +00600 S910-REWRITE. CL*29 +00601 SET L910-REWRITE-88 TO TRUE. CL*29 +00602 GO TO S910-MSTR-IO. CL*29 +00603 CL*29 +00604 S910-DELETE. CL*29 +00605 SET L910-DELETE-88 TO TRUE. CL*29 +00606 GO TO S910-MSTR-IO. CL*29 +00607 CL*29 +00608 S910-CLOSE. CL*29 +00609 SET L910-CLOSE-88 TO TRUE. CL*29 +00610 GO TO S910-MSTR-IO. CL*29 +00611 CL*29 +00612 S910-MSTR-IO. CL*29 +00613 CALL 'DTSBU910' USING L910-LINK-AREA CL*29 +00614 MSKL-REC. CL*29 +00615 S910-EXIT. CL*29 +00616 EXIT. CL*29 +00617 SKIP3 CL*29 +00618 S910A-OPEN-READ. DTSBX441 +00619 SET L910-OPEN-READ-88 TO TRUE. DTSBX441 +00620 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441 +00621 DTSBX441 +00622 S910A-EXIT. DTSBX441 +00623 EXIT. DTSBX441 +00624 DTSBX441 +00625 S910B-READ. DTSBX441 +00626 SET L910-READ-88 TO TRUE. DTSBX441 +00627 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441 +00628 DTSBX441 +00629 S910B-EXIT. DTSBX441 +00630 EXIT. DTSBX441 +00631 DTSBX441 +00632 S910C-START-BROWSE. DTSBX441 +00633 SET L910-START-BROWSE-88 TO TRUE. DTSBX441 +00634 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441 +00635 DTSBX441 +00636 S910C-EXIT. DTSBX441 +00637 EXIT. DTSBX441 +00638 DTSBX441 +00639 S910Y-READ-NEXT. CL**3 +00640 SET L910-READ-NEXT-88 TO TRUE. CL**3 +00641 MOVE MSOL-REC TO MSKL-REC CL**3 +00642 DISPLAY 'SOL KEY B ' MSOL-KEY-AREA. CL*17 +00643 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. CL**3 +00644 DISPLAY 'NEXT MSKL ' MSKL-KEY-AREA CL*17 +00645 DISPLAY 'L910 ' L910-RESULT-IND. CL*18 +00646 CL**3 +00647 S910Y-EXIT. CL**3 +00648 EXIT. CL**3 +00649 S910D-READ-NEXT. DTSBX441 +00650 SET L910-READ-NEXT-88 TO TRUE. DTSBX441 +00651 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441 +00652 IF L910-OK-88 DTSBX441 +00653 IF MSKL-PRF-88 DTSBX441 +00654 ADD +1 TO WRK-MPRF-CNT DTSBX441 +00655 END-IF DTSBX441 +00656 END-IF. DTSBX441 +00657 DTSBX441 +00658 S910D-EXIT. DTSBX441 +00659 EXIT. DTSBX441 +00660 DTSBX441 +00661 S910E-COUNT. DTSBX441 +00662 SET L910-COUNT-88 TO TRUE. DTSBX441 +00663 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441 +00664 DTSBX441 +00665 S910E-EXIT. DTSBX441 +00666 EXIT. DTSBX441 +00667 DTSBX441 +00668 S910F-REWRITE. DTSBX441 +00669 SET L910-REWRITE-88 TO TRUE. DTSBX441 +00670 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441 +00671 DTSBX441 +00672 S910F-EXIT. DTSBX441 +00673 EXIT. DTSBX441 +00674 DTSBX441 +00675 S910G-CLOSE. DTSBX441 +00676 SET L910-CLOSE-88 TO TRUE. DTSBX441 +00677 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSBX441 +00678 DTSBX441 +00679 S910G-EXIT. DTSBX441 +00680 EXIT. DTSBX441 +00681 DTSBX441 +00682 S910Z-MSTR-IO. DTSBX441 +00683 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX441 +00684 MSKL-REC. DTSBX441 +00685 S910Z-EXIT. DTSBX441 +00686 EXIT. DTSBX441 +00687 DTSBX441 +00688 S921-OPEN-READ. DTSBX441 +00689 SET L921-OPEN-READ-88 TO TRUE. DTSBX441 +00690 GO TO S921-AIX-IO. DTSBX441 +00691 DTSBX441 +00692 S921-START-BROWSE. DTSBX441 +00693 SET L921-START-BROWSE-88 TO TRUE. DTSBX441 +00694 GO TO S921-AIX-IO. DTSBX441 +00695 DTSBX441 +00696 S921-READ-NEXT. DTSBX441 +00697 SET L921-READ-NEXT-88 TO TRUE. DTSBX441 +00698 GO TO S921-AIX-IO. DTSBX441 +00699 DTSBX441 +00700 S921-CLOSE. DTSBX441 +00701 SET L921-CLOSE-88 TO TRUE. DTSBX441 +00702 GO TO S921-AIX-IO. DTSBX441 +00703 DTSBX441 +00704 S921-AIX-IO. DTSBX441 +00705 CALL 'DTSBU921' DTSBX441 +00706 USING L921-LINK-AREA DTSBX441 +00707 ISKL-REC. DTSBX441 +00708 DTSBX441 +00709 S921-EXIT. EXIT. DTSBX441 +00710 DTSBX441 +00711 S931A-OPEN-READ. DTSBX441 +00712 SET L931-OPEN-READ-88 TO TRUE. DTSBX441 +00713 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441 +00714 DTSBX441 +00715 S931A-EXIT. DTSBX441 +00716 EXIT. DTSBX441 +00717 DTSBX441 +00718 S931B-START-BROWSE. DTSBX441 +00719 SET L931-START-BROWSE-88 TO TRUE. DTSBX441 +00720 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441 +00721 DTSBX441 +00722 S931B-EXIT. DTSBX441 +00723 EXIT. DTSBX441 +00724 DTSBX441 +00725 S931C-READ-NEXT. DTSBX441 +00726 SET L931-READ-NEXT-88 TO TRUE. DTSBX441 +00727 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441 +00728 DTSBX441 +00729 S931C-EXIT. DTSBX441 +00730 EXIT. DTSBX441 +00731 DTSBX441 +00732 S931D-CLOSE. DTSBX441 +00733 SET L931-CLOSE-88 TO TRUE. DTSBX441 +00734 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSBX441 +00735 DTSBX441 +00736 S931D-EXIT. DTSBX441 +00737 EXIT. DTSBX441 +00738 DTSBX441 +00739 S931Z-REF-IO. DTSBX441 +00740 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX441 +00741 FSKL-REC. DTSBX441 +00742 S931Z-EXIT. EXIT. DTSBX441 +00743 DTSBX441 +00744 S981A-OPEN-READ. DTSBX441 +00745 SET L981-OPEN-READ-88 TO TRUE. DTSBX441 +00746 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441 +00747 DTSBX441 +00748 S981A-EXIT. DTSBX441 +00749 EXIT. DTSBX441 +00750 DTSBX441 +00751 S981C-CLOSE. DTSBX441 +00752 SET L981-CLOSE-88 TO TRUE. DTSBX441 +00753 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441 +00754 DTSBX441 +00755 S981C-EXIT. DTSBX441 +00756 EXIT. DTSBX441 +00757 DTSBX441 +00758 S981D-START-BROWSE. DTSBX441 +00759 SET L981-START-BROWSE-88 TO TRUE. DTSBX441 +00760 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441 +00761 DTSBX441 +00762 S981D-EXIT. DTSBX441 +00763 EXIT. DTSBX441 +00764 DTSBX441 +00765 S981E-READ-NEXT. DTSBX441 +00766 SET L981-READ-NEXT-88 TO TRUE. DTSBX441 +00767 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX441 +00768 DTSBX441 +00769 S981E-EXIT. DTSBX441 +00770 EXIT. DTSBX441 +00771 DTSBX441 +00772 S981Z-WAGE-I. DTSBX441 +00773 CALL 'DTSBU981' USING L981-LINK-AREA DTSBX441 +00774 WWGH-REC. DTSBX441 +00775 S981Z-EXIT. DTSBX441 +00776 EXIT. DTSBX441 +00777 DTSBX441 +00778 S982A-START-BROWSE. DTSBX441 +00779 SET L982-START-BROWSE-88 TO TRUE. DTSBX441 +00780 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX441 +00781 DTSBX441 +00782 S982A-EXIT. DTSBX441 +00783 EXIT. DTSBX441 +00784 DTSBX441 +00785 S982C-OPEN-READ. DTSBX441 +00786 SET L982-OPEN-READ-88 TO TRUE. DTSBX441 +00787 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX441 +00788 DTSBX441 +00789 S982C-EXIT. DTSBX441 +00790 EXIT. DTSBX441 +00791 DTSBX441 +00792 S982D-CLOSE. DTSBX441 +00793 SET L982-CLOSE-88 TO TRUE. DTSBX441 +00794 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX441 +00795 DTSBX441 +00796 S982D-EXIT. DTSBX441 +00797 EXIT. DTSBX441 +00798 DTSBX441 +00799 S982Z-WNAM-IO. DTSBX441 +00800 CALL 'DTSBU982' USING L982-LINK-AREA DTSBX441 +00801 WNAM-REC. DTSBX441 +00802 S982Z-EXIT. DTSBX441 +00803 EXIT. DTSBX441 +00804 DTSBX441 +00805 S999-ABEND. DTSBX441 +00806 DISPLAY '*** DTSBX441 ABENDING. ' CL*83 +00807 ABEND-MSG. DTSBX441 +00808 DTSBX441 +00809 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX441 +00810 S999-EXIT. DTSBX441 +00811 EXIT. DTSBX441 diff --git a/Batch/DTSBX465.cob b/Batch/DTSBX465.cob new file mode 100644 index 0000000..f8521d1 --- /dev/null +++ b/Batch/DTSBX465.cob @@ -0,0 +1,682 @@ +00001 IDENTIFICATION DIVISION. 11/21/18 +00002 PROGRAM-ID. DTSBX465. DTSBX465 +00003 LV016 +00004 ******************************************************************DTSBX465 +00005 * *DTSBX465 +00006 * *DTSBX465 +00007 * FUNCTION: *DTSBX465 +00008 * *DTSBX465 +00009 * THE FUNCTION OF DTSBX465 IS TO GENERATE A UI QTR WAGE *DTSBX465 +00010 * FILE FOR THE OFFICE OF TAX AND REVENUE. UI WAGE DATA *DTSBX465 +00011 * WILL BE EXTRACTED FOR A GIVEN QUARTER PERIOD BASED ON *DTSBX465 +00012 * THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE. *DTSBX465 +00013 * *DTSBX465 +00014 * CONTACT: WALTER GOETZ 202-442-6312 TAX AND REVENUE(OTR) *DTSBX465 +00015 * *DTSBX465 +00016 * G.A.BROWN *DTSBX465 +00017 ******************************************************************DTSBX465 +00018 * DTSBX465 +00019 * MODIFICATION HISTORY: DTSBX465 +00020 * DTSBX465 +00021 * 03-07-2005 MODIFIED SYSIN PARM ACCEPT CARD TO ACCEPT BLANK DTSBX465 +00022 * ON QUARTERLY FROM-DATE AND TO-DATE AS THE DEFAULT DTSBX465 +00023 * FROM THE HEADER RECORD COMPLETE QUARTER BEGIN DATE DTSBX465 +00024 * AND THE COMPLETE QUARTER END DATE FIELDS. IF THE DTSBX465 +00025 * INVALID QTR FROM-DATE AND QTR TO-DATE ENTERED, DTSBX465 +00026 * THE PROGRAM EDITING RESULTS WILL ABEND. DTSBX465 +00027 * REFERENCE RFP: STEVE PROGRAMMER: RLWDTSBX465 +00028 * DTSBX465 +00029 * 06-17-2018 MODIFIED PROGRAM TO READ WAGE NAME FILE AN OUTPUT CL**8 +00030 * FULL NAME ON OUTPUT WAGE FILE TO OTR CL**8 +00031 * REFERENCE RFP: STEVE PROGRAMMER: ZL1 CL**8 +00032 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX465 +00033 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX465 +00034 * REFERENCE RFP #**** PROGRAMMER: XXXDTSBX465 +00035 ***** DTSBX465 +00036 DTSBX465 +00037 ENVIRONMENT DIVISION. DTSBX465 +00038 CONFIGURATION SECTION. DTSBX465 +00039 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX465 +00040 INPUT-OUTPUT SECTION. DTSBX465 +00041 FILE-CONTROL. DTSBX465 +00042 SELECT WAGE-FILE ASSIGN TO UT-S-BUSINES. DTSBX465 +00043 SELECT WAGE-FILE-G ASSIGN TO UT-S-GOVT. DTSBX465 +00044 SELECT WAGE-FILE-F ASSIGN TO UT-S-FED. DTSBX465 +00045 DATA DIVISION. DTSBX465 +00046 FILE SECTION. DTSBX465 +00047 DTSBX465 +00048 FD WAGE-FILE DTSBX465 +00049 RECORDING MODE IS F DTSBX465 +00050 LABEL RECORD ARE STANDARD DTSBX465 +00051 RECORD CONTAINS 80 CHARACTERS CL**3 +00052 BLOCK CONTAINS 0 RECORDS DTSBX465 +00053 DATA RECORD IS WAGE-REC. DTSBX465 +00054 DTSBX465 +00055 01 WAGE-REC. DTSBX465 +00056 03 EMPLOYEE-SSN PIC 9(9). DTSBX465 +00057 03 EMPLOYEE-LAST-NAME PIC X(20). CL**3 +00058 03 EMPLOYEE-FIRST-NAME PIC X(15). CL**3 +00059 03 EMPLOYEE-MID-INIT PIC X(01). CL**3 +00060 03 EMPLOYER-ACCT-NUM PIC 9(6). DTSBX465 +00061 03 EMPLOYEE-WAGES PIC 9(7). DTSBX465 +00062 03 CEN-YEAR-QUARTER PIC 9(5). DTSBX465 +00063 03 WAGE-UPDATE-DATE PIC 9(8). DTSBX465 +00064 03 FEDERAL-ID-NUMBER PIC 9(9). DTSBX465 +00065 DTSBX465 +00066 FD WAGE-FILE-G DTSBX465 +00067 RECORDING MODE IS F DTSBX465 +00068 LABEL RECORD ARE STANDARD DTSBX465 +00069 RECORD CONTAINS 80 CHARACTERS CL**3 +00070 BLOCK CONTAINS 0 RECORDS DTSBX465 +00071 DATA RECORD IS WAGE-REC-G. DTSBX465 +00072 DTSBX465 +00073 01 WAGE-REC-G. DTSBX465 +00074 03 EMPLOYEE-SSN-G PIC 9(9). DTSBX465 +00075 03 EMPLOYEE-LAST-NAME-G PIC X(20). CL**3 +00076 03 EMPLOYEE-FIRST-NAME-G PIC X(15). CL**3 +00077 03 EMPLOYEE-MID-INIT-G PIC X(01). CL**3 +00078 03 EMPLOYER-ACCT-NUM-G PIC 9(6). DTSBX465 +00079 03 EMPLOYEE-WAGES-G PIC 9(7). DTSBX465 +00080 03 CEN-YEAR-QUARTER-G PIC 9(5). DTSBX465 +00081 03 WAGE-UPDATE-DATE-G PIC 9(8). DTSBX465 +00082 03 FEDERAL-ID-NUMBER-G PIC 9(9). DTSBX465 +00083 DTSBX465 +00084 DTSBX465 +00085 FD WAGE-FILE-F DTSBX465 +00086 RECORDING MODE IS F DTSBX465 +00087 LABEL RECORD ARE STANDARD DTSBX465 +00088 RECORD CONTAINS 80 CHARACTERS CL**3 +00089 BLOCK CONTAINS 0 RECORDS DTSBX465 +00090 DATA RECORD IS WAGE-REC-F. DTSBX465 +00091 DTSBX465 +00092 01 WAGE-REC-F. DTSBX465 +00093 03 EMPLOYEE-SSN-F PIC 9(9). DTSBX465 +00094 03 EMPLOYEE-LAST-NAME-F PIC X(20). CL**3 +00095 03 EMPLOYEE-FIRST-NAME-F PIC X(15). CL**3 +00096 03 EMPLOYEE-MID-INIT-F PIC X(01). CL**3 +00097 03 EMPLOYER-ACCT-NUM-F PIC 9(6). DTSBX465 +00098 03 EMPLOYEE-WAGES-F PIC 9(7). DTSBX465 +00099 03 CEN-YEAR-QUARTER-F PIC 9(5). DTSBX465 +00100 03 WAGE-UPDATE-DATE-F PIC 9(8). DTSBX465 +00101 03 FEDERAL-ID-NUMBER-F PIC 9(9). DTSBX465 +00102 DTSBX465 +00103 ******************************************************************DTSBX465 +00104 * WORKING STORAGE SECTION *DTSBX465 +00105 ******************************************************************DTSBX465 +00106 WORKING-STORAGE SECTION. DTSBX465 +001065 77 PAN-VALET PICTURE X(24) VALUE '016DTSBX465 11/21/18'. DTSBX465 +00107 DTSBX465 +00108 01 SELECT-CARD. DTSBX465 +00109 03 PRG-NAME PIC X(10) VALUE '**DTSBX465'. DTSBX465 +00110 03 FIL PIC XX. DTSBX465 +00111 03 FROM-ACTIVITY-DATE PIC 9(8). DTSBX465 +00112 03 FIL PIC X. DTSBX465 +00113 03 TO-ACTIVITY-DATE PIC 9(8). DTSBX465 +00114 03 FIL PIC X VALUE SPACE. DTSBX465 +00115 03 DCGOVT PIC X(3). DTSBX465 +00116 03 FIL PIC X. DTSBX465 +00117 03 FEDGOVT PIC X(3). DTSBX465 +00118 03 FIL PIC X. DTSBX465 +00119 03 BUSINESS PIC X(3). DTSBX465 +00120 03 FIL PIC X(39). DTSBX465 +00121 DTSBX465 +00122 01 COUNTERS. DTSBX465 +00123 03 FEDERAL-ID-NUMBER-WS PIC 9(9). DTSBX465 +00124 03 STOP-RECS PIC 9(5). DTSBX465 +00125 03 UNMATCH-SW PIC X. DTSBX465 +00126 03 ALL-NINES PIC 9. DTSBX465 +00127 03 RECS-IN PIC 9(9). DTSBX465 +00128 03 RECS-OUT PIC 9(9). DTSBX465 +00129 03 QTR-WAGES PIC 9(9). DTSBX465 +00130 03 DC-WAGES PIC 9(9). DTSBX465 +00131 03 FED-WAGES PIC 9(9). DTSBX465 +00132 03 BUSINESS-WAGES PIC 9(9). DTSBX465 +00133 03 DC-ACCT PIC 9(6). DTSBX465 +00134 03 EMP-ACCT-HOLD PIC 9(6). DTSBX465 +00135 03 EMP-ACCT-HOLD-RED PIC 9(6). DTSBX465 +00136 03 EMP-ACCT-HOLD-WS REDEFINES EMP-ACCT-HOLD-RED. DTSBX465 +00137 05 ACCT-FOUR PIC 9(4). DTSBX465 +00138 05 ACCT-THREE-WS REDEFINES ACCT-FOUR. DTSBX465 +00139 07 ACCT-THREE-RED PIC 9(3). DTSBX465 +00140 07 ACCT-FIL PIC 9. DTSBX465 +00141 05 ACCT-TWO PIC 99. DTSBX465 +00142 DTSBX465 +00143 03 W-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 +00144 03 WRK-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 +00145 03 ABEND-CODE PIC S9(04) COMP CL**2 +00146 VALUE +465. DTSBX465 +00147 03 ABEND-MOD PIC X(08) DTSBX465 +00148 VALUE 'DTSBU999'. DTSBX465 +00149 03 ABEND-MSG PIC X(60). DTSBX465 +00150 DTSBX465 +00151 03 WRK-BEGIN-DATE PIC S9(09) COMP-3. DTSBX465 +00152 03 WRK-END-DATE PIC S9(09) COMP-3. DTSBX465 +00153 DTSBX465 +00154 03 WRK-BEGIN-DATE-DISP PIC 9(08). DTSBX465 +00155 03 FILLER REDEFINES WRK-BEGIN-DATE-DISP. DTSBX465 +00156 05 WRK-BEGIN-YR PIC 9(04). DTSBX465 +00157 05 WRK-BEGIN-MO PIC 9(02). DTSBX465 +00158 05 WRK-BEGIN-DA PIC 9(02). DTSBX465 +00159 DTSBX465 +00160 03 WRK-END-DATE-DISP PIC 9(08). DTSBX465 +00161 03 FILLER REDEFINES WRK-END-DATE-DISP. DTSBX465 +00162 05 WRK-END-YR PIC 9(04). DTSBX465 +00163 05 WRK-END-MO PIC 9(02). DTSBX465 +00164 05 WRK-END-DA PIC 9(02). DTSBX465 +00165 CL**3 +00166 03 WRK-NAME. CL**3 +00167 05 WRK-LNAME PIC X(20) VALUE SPACES. CL**3 +00168 05 WRK-FNAME PIC X(15) VALUE SPACES. CL**3 +00169 05 WRK-INAME PIC X(01) VALUE SPACES. CL**3 +00170 01 L001-LINK-AREA. DTSBX465 +00171 ++INCLUDE DTSIL001 DTSBX465 +00172 DTSBX465 +00173 01 L004-LINK-AREA. DTSBX465 +00174 ++INCLUDE DTSIL004 DTSBX465 +00175 DTSBX465 +00176 01 L910-LINK-AREA. DTSBX465 +00177 ++INCLUDE DTSIL910 DTSBX465 +00178 CL**3 +00179 01 L982-LINK-AREA. CL**3 +00180 ++INCLUDE DTSIL982 CL**3 +00181 DTSBX465 +00182 01 MSKL-REC. DTSBX465 +00183 ++INCLUDE DTSIMSKL DTSBX465 +00184 DTSBX465 +00185 01 MHDR-REC. DTSBX465 +00186 ++INCLUDE DTSIMHDR DTSBX465 +00187 DTSBX465 +00188 01 MPRF-REC. DTSBX465 +00189 ++INCLUDE DTSIMPRF DTSBX465 +00190 CL**3 +00191 01 WNAM-REC. CL**3 +00192 ++INCLUDE DTSIWNAM CL**3 +00193 CL**3 +00194 01 COMMON-LINKAGE-SECTION. DTSBX465 +00195 ++INCLUDE EWGLINKB DTSBX465 +00196 EJECT DTSBX465 +00197 EJECT DTSBX465 +00198 ******************************************************************DTSBX465 +00199 * PROCEDURE DIVISION - CONTROL PROCEDURE *DTSBX465 +00200 ******************************************************************DTSBX465 +00201 PROCEDURE DIVISION. DTSBX465 +00202 BEGIN00000. DTSBX465 +00203 OPEN OUTPUT WAGE-FILE, WAGE-FILE-G, WAGE-FILE-F. DTSBX465 +00204 ** DTSBX465 +00205 **** OPEN UI WAGE MASTER FILE FOR READ ONLY DTSBX465 +00206 ** DTSBX465 +00207 SET DBW-RANDOM-PROCESSING TO TRUE. DTSBX465 +00208 SET DBW-HEADER-RECORD TO TRUE. DTSBX465 +00209 SET DBW-OPEN-INPUT TO TRUE. DTSBX465 +00210 CALL 'EWG960D' DTSBX465 +00211 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 +00212 DTSBX465 +00213 PERFORM 114-S910-OPEN-READ THRU 114-S910-OPEN-READ-EXIT. DTSBX465 +00214 PERFORM S982O-OPEN-READ THRU S982O-EXIT. CL**6 +00215 DTSBX465 +00216 MOVE ZEROS TO COUNTERS. DTSBX465 +00217 MOVE ZERO TO WRK-BEGIN-DATE DTSBX465 +00218 WRK-END-DATE. DTSBX465 +00219 DTSBX465 +00220 MAIN0100-INITIATE. DTSBX465 +00221 ACCEPT SELECT-CARD. DTSBX465 +00222 DISPLAY ' '. DTSBX465 +00223 DISPLAY ' ' SELECT-CARD. DTSBX465 +00224 DISPLAY ' '. DTSBX465 +00225 DISPLAY ' PROGRAM ' PRG-NAME. DTSBX465 +00226 DISPLAY ' FROM-DATE ' FROM-ACTIVITY-DATE. DTSBX465 +00227 DISPLAY ' TO-DATE ' TO-ACTIVITY-DATE. DTSBX465 +00228 DISPLAY ' DC GOVT ' DCGOVT DTSBX465 +00229 DISPLAY ' FED GOVT ' FEDGOVT DTSBX465 +00230 DISPLAY ' BUSINESS ' BUSINESS DTSBX465 +00231 DISPLAY ' '. DTSBX465 +00232 DISPLAY ' '. DTSBX465 +00233 DTSBX465 +00234 IF (FROM-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX465 +00235 AND (TO-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX465 +00236 PERFORM INIT0300-DEFAULT-DATES THRU INIT0300-EXIT DTSBX465 +00237 ELSE DTSBX465 +00238 PERFORM INIT0100-BEGIN-DATE THRU INIT0100-EXIT DTSBX465 +00239 PERFORM INIT0200-END-DATE THRU INIT0200-EXIT. DTSBX465 +00240 DTSBX465 +00241 IF WRK-END-DATE < WRK-BEGIN-DATE DTSBX465 +00242 MOVE 'PERIOD END LESS THAN PERIOD BEGIN' DTSBX465 +00243 TO ABEND-MSG DTSBX465 +00244 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 +00245 DTSBX465 +00246 MOVE WRK-BEGIN-DATE TO WRK-BEGIN-DATE-DISP. DTSBX465 +00247 MOVE WRK-END-DATE TO WRK-END-DATE-DISP. DTSBX465 +00248 DISPLAY ' '. DTSBX465 +00249 DISPLAY ' FROM-DATE/DEFAULT FROM DATE ' WRK-BEGIN-DATE-DISP.DTSBX465 +00250 DISPLAY ' TO-DATE/DEFAULT TO-DATE ' WRK-END-DATE-DISP. DTSBX465 +00251 DISPLAY ' '. DTSBX465 +00252 DTSBX465 +00253 MOVE LOW-VALUE TO VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 +00254 PERFORM MAIN0200-PROCESS-WAGE THRU MAIN0200-EX DTSBX465 +00255 UNTIL DBW-END-OF-FILE. DTSBX465 +00256 GO TO TERM0100-CLOSE-FILES. DTSBX465 +00257 DTSBX465 +00258 INIT0100-BEGIN-DATE. DTSBX465 +00259 MOVE FROM-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX465 +00260 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX465 +00261 IF L001-VALID-DATE DTSBX465 +00262 MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE DTSBX465 +00263 ELSE DTSBX465 +00264 MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG DTSBX465 +00265 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 +00266 DTSBX465 +00267 MOVE WRK-BEGIN-DATE TO L004-DATE. DTSBX465 +00268 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX465 +00269 IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE DTSBX465 +00270 MOVE 'PERIOD BEGIN NOT START OF QTR' DTSBX465 +00271 TO ABEND-MSG DTSBX465 +00272 PERFORM S999-ABEND THRU S999-EXIT DTSBX465 +00273 END-IF. DTSBX465 +00274 DTSBX465 +00275 INIT0100-EXIT. DTSBX465 +00276 EXIT. DTSBX465 +00277 DTSBX465 +00278 INIT0200-END-DATE. DTSBX465 +00279 MOVE TO-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX465 +00280 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX465 +00281 IF L001-VALID-DATE DTSBX465 +00282 MOVE L001-FED-8-DATE-9 TO WRK-END-DATE DTSBX465 +00283 ELSE DTSBX465 +00284 MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG DTSBX465 +00285 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 +00286 DTSBX465 +00287 MOVE WRK-END-DATE TO L004-DATE. DTSBX465 +00288 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX465 +00289 IF WRK-END-DATE NOT = L004-QTR-END-DATE DTSBX465 +00290 DISPLAY ' END DT ' L004-QTR-END-DATE CL*16 +00291 MOVE 'PERIOD END NOT END OF QTR' DTSBX465 +00292 TO ABEND-MSG DTSBX465 +00293 PERFORM S999-ABEND THRU S999-EXIT DTSBX465 +00294 END-IF. DTSBX465 +00295 DTSBX465 +00296 INIT0200-EXIT. DTSBX465 +00297 EXIT. DTSBX465 +00298 DTSBX465 +00299 INIT0300-DEFAULT-DATES. DTSBX465 +00300 DTSBX465 +00301 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX465 +00302 MOVE +0 TO MSKL-EMP-NO. DTSBX465 +00303 SET MSKL-HDR-88 TO TRUE. DTSBX465 +00304 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. DTSBX465 +00305 DTSBX465 +00306 IF L910-NO-REC-88 DTSBX465 +00307 MOVE 'MHDR RECORD IS MISSING' DTSBX465 +00308 TO ABEND-MSG DTSBX465 +00309 PERFORM S999-ABEND THRU S999-EXIT. DTSBX465 +00310 DTSBX465 +00311 MOVE MSKL-REC TO MHDR-REC. DTSBX465 +00312 DTSBX465 +00313 MOVE MHDR-CMPL-QTR-BEGIN-DATE DTSBX465 +00314 TO WRK-BEGIN-DATE. DTSBX465 +00315 MOVE MHDR-CMPL-QTR-END-DATE DTSBX465 +00316 TO WRK-END-DATE. DTSBX465 +00317 DTSBX465 +00318 MOVE WRK-BEGIN-DATE TO FROM-ACTIVITY-DATE. DTSBX465 +00319 MOVE WRK-END-DATE TO TO-ACTIVITY-DATE. DTSBX465 +00320 DTSBX465 +00321 INIT0300-EXIT. DTSBX465 +00322 EXIT. DTSBX465 +00323 DTSBX465 +00324 MAIN0200-PROCESS-WAGE. DTSBX465 +00325 MOVE 'S' TO DBW-PROCESSING-MODE. DTSBX465 +00326 MOVE 'SG01' TO DBW-SEGNAME. DTSBX465 +00327 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX465 +00328 PERFORM LOCATE-WAGE THRU L-W-EX DTSBX465 +00329 UNTIL DBW-NO-RECORD-FOUND. DTSBX465 +00330 ADD 1 TO RECS-IN. DTSBX465 +00331 IF WGP-SSN = 999999999 DTSBX465 +00332 GO TO TERM0100-CLOSE-FILES. DTSBX465 +00333 IF ALL-NINES = 1 DTSBX465 +00334 GO TO TERM0100-CLOSE-FILES. DTSBX465 +00335 MAIN0200-EX. DTSBX465 +00336 EXIT. DTSBX465 +00337 DTSBX465 +00338 LOCATE-WAGE. DTSBX465 +00339 MOVE 'R' TO DBW-PROCESSING-MODE. DTSBX465 +00340 MOVE 'SG02' TO DBW-SEGNAME. DTSBX465 +00341 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX465 +00342 IF DBW-NO-RECORD-FOUND DTSBX465 +00343 GO TO L-W-EX. DTSBX465 +00344 PERFORM SEGMENT-2-DATA THRU S-2-D-EX. DTSBX465 +00345 L-W-EX. DTSBX465 +00346 EXIT. DTSBX465 +00347 DTSBX465 +00348 SEGMENT-2-DATA. DTSBX465 +00349 ********************************************************** DTSBX465 +00350 * ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS DTSBX465 +00351 ******* ************************************************** DTSBX465 +00352 IF WGP-SSN = 999999999 DTSBX465 +00353 MOVE 1 TO ALL-NINES DTSBX465 +00354 GO TO S-2-D-EX. DTSBX465 +00355 DTSBX465 +00356 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. DTSBX465 +00357 IF WGD-ACTIVITY-DATE NOT LESS THAN FROM-ACTIVITY-DATE DTSBX465 +00358 AND DTSBX465 +00359 WGD-ACTIVITY-DATE NOT GREATER THAN TO-ACTIVITY-DATE DTSBX465 +00360 NEXT SENTENCE ELSE DTSBX465 +00361 GO TO S-2-D-EX. DTSBX465 +00362 DTSBX465 +00363 * DISPLAY ' ENO : ' WGD-ACCOUNT-NUMBER ' ' CL*12 +00364 * ' DOCS: ' WGD-ACTIVITY-DATE ' ' CL*12 +00365 * ' FROM: ' FROM-ACTIVITY-DATE ' ' CL*12 +00366 * ' TO : ' TO-ACTIVITY-DATE. CL*12 +00367 DTSBX465 +00368 MOVE WGD-ACCOUNT-NUMBER TO EMP-ACCT-HOLD. DTSBX465 +00369 MOVE EMP-ACCT-HOLD TO EMP-ACCT-HOLD-RED. DTSBX465 +00370 DTSBX465 +00371 IF ACCT-FOUR = DTSBX465 +00372 1101 OR 1102 OR 1104 OR 1105 OR 1106 OR 1108 OR DTSBX465 +00373 1109 OR 1110 OR 1111 OR 1112 OR 1113 OR 1115 OR DTSBX465 +00374 1116 OR 1117 OR 1118 OR 1119 OR 1120 OR 1121 OR 1122 OR DTSBX465 +00375 1123 OR 1124 OR 1125 OR 1126 OR 1127 OR 1128 OR 1129 OR DTSBX465 +00376 1130 OR 1131 OR 1132 OR 1133 OR 1134 OR 1135 OR 1136 OR DTSBX465 +00377 1137 OR 1138 OR 1139 OR 1140 OR 1141 OR 1142 OR 1144 OR DTSBX465 +00378 1145 OR 1146 OR 1147 OR 1148 OR 1149 OR 1150 OR 1151 OR DTSBX465 +00379 1153 OR 1154 OR 1155 OR 1156 DTSBX465 +00380 GO TO S-2-D-EX. DTSBX465 +00381 DTSBX465 +00382 ADD 1 TO QTR-WAGES. DTSBX465 +00383 DTSBX465 +00384 40-WRITE-DCGOV-FEDL-BUS-ACCTS. DTSBX465 +00385 DTSBX465 +00386 PERFORM 110-FEIN-LOOK-UP THRU 110-FLU-EXIT. DTSBX465 +00387 DTSBX465 +00388 IF WGP-SSN = 000000000 DTSBX465 +00389 GO TO S-2-D-EX. DTSBX465 +00390 DTSBX465 +00391 IF L910-NO-REC-88 DTSBX465 +00392 GO TO S-2-D-EX. DTSBX465 +00393 DTSBX465 +00394 IF DCGOVT = 'DCG' DTSBX465 +00395 IF EMP-ACCT-HOLD = 998888 CL*13 +00396 PERFORM 050-WRITE-GOVERNMENT-ACCOUNTS THRU 050-W-G-A-EXT DTSBX465 +00397 GO TO S-2-D-EX. DTSBX465 +00398 DTSBX465 +00399 IF FEDGOVT = 'FED' DTSBX465 +00400 IF ACCT-THREE-RED = 000 DTSBX465 +00401 PERFORM 025-WRITE-FEDERAL-ACCOUNTS THRU 025-W-F-A-EXT DTSBX465 +00402 GO TO S-2-D-EX. DTSBX465 +00403 DTSBX465 +00404 IF BUSINESS = 'BUS' CL*15 +00405 PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*15 +00406 DTSBX465 +00407 GO TO S-2-D-EX. DTSBX465 +00408 DTSBX465 +00409 025-WRITE-FEDERAL-ACCOUNTS. DTSBX465 +00410 DTSBX465 +00411 * DISPLAY ' FED ACCT ' WGD-ACCOUNT-NUMBER CL*15 +00412 IF ACCT-THREE-RED = 000 DTSBX465 +00413 ADD 1 TO FED-WAGES. DTSBX465 +00414 DTSBX465 +00415 MOVE WGP-SSN TO EMPLOYEE-SSN-F. DTSBX465 +00416 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER-F. DTSBX465 +00417 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM-F. DTSBX465 +00418 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES-F. DTSBX465 +00419 * MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME-F. CL**3 +00420 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE-F. DTSBX465 +00421 MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER-F. DTSBX465 +00422 * CL**2 +00423 MOVE SPACES TO WRK-NAME. CL**2 +00424 MOVE LOW-VALUE TO WNAM-REC. CL**2 +00425 MOVE WGP-SSN TO WNAM-SSN WRK-SSN. CL**2 +00426 PERFORM 130-READ-NAME THRU 130-READ-NAME-EXIT. CL**2 +00427 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME-F CL**3 +00428 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME-F CL**3 +00429 MOVE WRK-INAME TO EMPLOYEE-MID-INIT-F CL**3 +00430 WRITE WAGE-REC-F. DTSBX465 +00431 MOVE SPACES TO WAGE-REC-F. DTSBX465 +00432 025-W-F-A-EXT. DTSBX465 +00433 EXIT. DTSBX465 +00434 DTSBX465 +00435 050-WRITE-GOVERNMENT-ACCOUNTS. DTSBX465 +00436 * DISPLAY ' DC GOV ACCT ' WGD-ACCOUNT-NUMBER CL*15 +00437 * IF WGD-ACCOUNT-NUMBER = 998888 CL*13 +00438 ADD 1 TO DC-WAGES. DTSBX465 +00439 DTSBX465 +00440 MOVE WGP-SSN TO EMPLOYEE-SSN-G. DTSBX465 +00441 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER-G. DTSBX465 +00442 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM-G. DTSBX465 +00443 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES-G. DTSBX465 +00444 * MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME-G. CL**3 +00445 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE-G. DTSBX465 +00446 MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER-G. DTSBX465 +00447 * CL**3 +00448 MOVE SPACES TO WRK-NAME. CL**3 +00449 MOVE LOW-VALUE TO WNAM-REC. CL**3 +00450 MOVE WGP-SSN TO WNAM-SSN WRK-SSN. CL**3 +00451 PERFORM 130-READ-NAME THRU 130-READ-NAME-EXIT. CL**3 +00452 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME-G CL**3 +00453 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME-G CL**3 +00454 MOVE WRK-INAME TO EMPLOYEE-MID-INIT-G CL**3 +00455 WRITE WAGE-REC-G. DTSBX465 +00456 MOVE SPACES TO WAGE-REC-G. DTSBX465 +00457 050-W-G-A-EXT. DTSBX465 +00458 EXIT. DTSBX465 +00459 100-WRITE-BUSINESS-ACCOUNTS. DTSBX465 +00460 DTSBX465 +00461 ADD 1 TO BUSINESS-WAGES. DTSBX465 +00462 MOVE WGP-SSN TO EMPLOYEE-SSN. DTSBX465 +00463 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER. DTSBX465 +00464 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM. DTSBX465 +00465 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES. DTSBX465 +00466 * MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME. CL**3 +00467 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE. DTSBX465 +00468 MOVE FEDERAL-ID-NUMBER-WS TO FEDERAL-ID-NUMBER. DTSBX465 +00469 MOVE SPACES TO WRK-NAME. CL**3 +00470 MOVE LOW-VALUE TO WNAM-REC. CL**3 +00471 MOVE WGP-SSN TO WNAM-SSN WRK-SSN. CL**3 +00472 PERFORM 130-READ-NAME THRU 130-READ-NAME-EXIT. CL**3 +00473 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME CL**3 +00474 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME CL**3 +00475 MOVE WRK-INAME TO EMPLOYEE-MID-INIT CL**3 +00476 WRITE WAGE-REC. DTSBX465 +00477 MOVE SPACES TO WAGE-REC. DTSBX465 +00478 DTSBX465 +00479 100-W-B-A-EXT. DTSBX465 +00480 EXIT. DTSBX465 +00481 S-2-D-EX. DTSBX465 +00482 EXIT. DTSBX465 +00483 110-FEIN-LOOK-UP. DTSBX465 +00484 DTSBX465 +00485 MOVE ZEROS TO FEDERAL-ID-NUMBER-WS. DTSBX465 +00486 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX465 +00487 DTSBX465 +00488 MOVE WGD-ACCOUNT-NUMBER TO MSKL-EMP-NO. DTSBX465 +00489 SET MSKL-PRF-88 TO TRUE. CL*14 +00490 * SET L910-READ-88 TO TRUE. CL*14 +00491 DTSBX465 +00492 * PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. CL*14 +00493 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT CL*14 +00494 DTSBX465 +00495 IF L910-NO-REC-88 DTSBX465 +00496 DISPLAY 'ACCT NOT IN DTS: ' WGD-ACCOUNT-NUMBER CL*15 +00497 GO TO 110-FLU-EXIT. DTSBX465 +00498 DTSBX465 +00499 MOVE MSKL-REC TO MPRF-REC. DTSBX465 +00500 DTSBX465 +00501 * IF MPRF-STATUS-ACT-88 CL*15 +00502 * NEXT SENTENCE CL*15 +00503 * ELSE CL*15 +00504 * DISPLAY ' ACCT NOT ACTIVE ' MPRF-FEIN CL*15 +00505 * SET L910-NO-REC-88 TO TRUE CL*15 +00506 * GO TO 110-FLU-EXIT. CL*15 +00507 DTSBX465 +00508 MOVE MPRF-FEIN TO FEDERAL-ID-NUMBER-WS. DTSBX465 +00509 DTSBX465 +00510 110-FLU-EXIT. DTSBX465 +00511 EXIT. DTSBX465 +00512 DTSBX465 +00513 114-S910-OPEN-READ. DTSBX465 +00514 SET L910-OPEN-READ-88 TO TRUE. DTSBX465 +00515 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX465 +00516 114-S910-OPEN-READ-EXIT. DTSBX465 +00517 EXIT. DTSBX465 +00518 DTSBX465 +00519 115-S910-READ. DTSBX465 +00520 SET L910-READ-88 TO TRUE. DTSBX465 +00521 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX465 +00522 115-S910-READ-EXIT. DTSBX465 +00523 EXIT. DTSBX465 +00524 DTSBX465 +00525 116-S910-CLOSE. DTSBX465 +00526 SET L910-CLOSE-88 TO TRUE. DTSBX465 +00527 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX465 +00528 116-S910-CLOSE-EXIT. DTSBX465 +00529 EXIT. DTSBX465 +00530 DTSBX465 +00531 120-READ-MPRF. DTSBX465 +00532 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX465 +00533 MSKL-REC. DTSBX465 +00534 120-READ-MPRF-EXIT. DTSBX465 +00535 EXIT. DTSBX465 +00536 CL**2 +00537 130-READ-NAME. CL**2 +00538 ******************************************************************DTSBX465 +00539 * SEARCH FOR NAME ON WAGE NAME FILE * CL**2 +00540 ******************************************************************DTSBX465 +00541 CL**2 +00542 PERFORM S982A-START-BROWSE THRU S982A-EXIT. CL**2 +00543 CL**2 +00544 IF NOT L982-OK-88 CL**2 +00545 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN CL**2 +00546 GO TO 130-READ-NAME-EXIT CL**4 +00547 END-IF. CL**2 +00548 CL**2 +00549 MOVE WNAM-SSN TO W-SSN. CL**2 +00550 CL**2 +00551 IF WRK-SSN = W-SSN CL**2 +00552 MOVE WNAM-LAST-NAME TO WRK-LNAME CL**3 +00553 MOVE WNAM-FIRST-NAME TO WRK-FNAME CL**3 +00554 MOVE WNAM-MID-INIT TO WRK-INAME CL**3 +00555 ELSE CL**2 +00556 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN. CL**2 +00557 130-READ-NAME-EXIT. CL**2 +00558 EXIT. CL**2 +00559 ****************************************************************** CL**2 +00560 * TERMINATION ROUTINE * CL**2 +00561 ****************************************************************** CL**2 +00562 TERM0100-CLOSE-FILES. DTSBX465 +00563 CLOSE WAGE-FILE, WAGE-FILE-G, WAGE-FILE-F. DTSBX465 +00564 DTSBX465 +00565 MOVE 'C' TO DBW-COMMAND-CODE. DTSBX465 +00566 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX465 +00567 DTSBX465 +00568 PERFORM 116-S910-CLOSE THRU 116-S910-CLOSE-EXIT. DTSBX465 +00569 DTSBX465 +00570 DISPLAY 'NUMBER RECORDS READ *** ' RECS-IN. DTSBX465 +00571 DISPLAY ' ' . DTSBX465 +00572 DISPLAY 'DC WAGES ' DC-WAGES. DTSBX465 +00573 DISPLAY 'BUSINESS WAGES ' BUSINESS-WAGES. DTSBX465 +00574 DISPLAY 'FEDRAL WAGES ' FED-WAGES. DTSBX465 +00575 DISPLAY ' ' . DTSBX465 +00576 DISPLAY 'NUMBER RECORDS PRINTED *** ' RECS-OUT. DTSBX465 +00577 STOP RUN. DTSBX465 +00578 TERM0100-EXIT. DTSBX465 +00579 EXIT. DTSBX465 +00580 EJECT DTSBX465 +00581 ******************************************************************DTSBX465 +00582 * SERVICE ROUTINES *DTSBX465 +00583 ******************************************************************DTSBX465 +00584 SERV1001-READ-MASTER. DTSBX465 +00585 MOVE 'R' TO DBW-COMMAND-CODE. DTSBX465 +00586 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX465 +00587 SERV1001-EXIT. DTSBX465 +00588 EXIT. DTSBX465 +00589 SERV2001-RESET-MASTER. DTSBX465 +00590 MOVE 'S' TO DBW-COMMAND-CODE. DTSBX465 +00591 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX465 +00592 SERV2001-EXIT. DTSBX465 +00593 EXIT. DTSBX465 +00594 SERV9001-ACCESS-DATABASE. DTSBX465 +00595 IF DBW-SEGNAME = 'SG01' DTSBX465 +00596 CALL 'EWG960D' DTSBX465 +00597 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 +00598 IF DBW-SEGNAME = 'SG02' DTSBX465 +00599 CALL 'EWG960D' DTSBX465 +00600 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX465 +00601 SERV9001-EXIT. DTSBX465 +00602 EXIT. DTSBX465 +00603 DTSBX465 +00604 S001-FROM-CAL-6. DTSBX465 +00605 SET L001-FROM-CAL-6 TO TRUE. DTSBX465 +00606 GO TO S001-DATE. DTSBX465 +00607 DTSBX465 +00608 S001-FROM-FED-8. DTSBX465 +00609 SET L001-FROM-FED-8 TO TRUE. DTSBX465 +00610 GO TO S001-DATE. DTSBX465 +00611 DTSBX465 +00612 S001-FROM-ABS. DTSBX465 +00613 SET L001-FROM-ABS-DAY TO TRUE. DTSBX465 +00614 GO TO S001-DATE. DTSBX465 +00615 DTSBX465 +00616 S001-DATE. DTSBX465 +00617 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX465 +00618 S001-EXIT. DTSBX465 +00619 EXIT. DTSBX465 +00620 DTSBX465 +00621 S004-FROM-DATE. DTSBX465 +00622 SET L004-FROM-DATE TO TRUE. DTSBX465 +00623 GO TO S004-YRQ. DTSBX465 +00624 DTSBX465 +00625 S004-YRQ. DTSBX465 +00626 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX465 +00627 S004-EXIT. DTSBX465 +00628 EXIT. DTSBX465 +00629 S982O-OPEN-READ. CL**5 +00630 SET L982-OPEN-READ-88 TO TRUE. CL**5 +00631 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00632 CL**3 +00633 S982O-EXIT. CL**3 +00634 EXIT. CL**3 +00635 CL**3 +00636 S982A-START-BROWSE. CL**3 +00637 SET L982-START-BROWSE-88 TO TRUE. CL**3 +00638 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00639 CL**3 +00640 S982A-EXIT. CL**3 +00641 EXIT. CL**3 +00642 S982B-READ-NEXT. CL**3 +00643 SET L982-READ-NEXT-88 TO TRUE. CL**3 +00644 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00645 CL**3 +00646 S982B-EXIT. CL**3 +00647 EXIT. CL**3 +00648 S982C-WRITE. CL**3 +00649 SET L982-WRITE-88 TO TRUE. CL**3 +00650 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00651 CL**3 +00652 S982C-EXIT. CL**3 +00653 EXIT. CL**3 +00654 CL**3 +00655 S982D-REWRITE. CL**3 +00656 SET L982-REWRITE-88 TO TRUE. CL**3 +00657 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00658 S982D-EXIT. CL**3 +00659 EXIT. CL**3 +00660 S982F-CLOSE. CL**3 +00661 SET L982-CLOSE-88 TO TRUE. CL**3 +00662 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00663 CL**3 +00664 S982F-EXIT. CL**3 +00665 EXIT. CL**3 +00666 CL**3 +00667 S982Z-WNAM-IO. CL**3 +00668 CALL 'DTSBU982' USING L982-LINK-AREA CL**3 +00669 WNAM-REC. CL**3 +00670 S982Z-EXIT. CL**3 +00671 EXIT. CL**3 +00672 CL**3 +00673 DTSBX465 +00674 S999-ABEND. DTSBX465 +00675 DISPLAY '**** DTSBX465 ABENDING ' DTSBX465 +00676 ABEND-MSG. DTSBX465 +00677 CALL ABEND-MOD USING ABEND-CODE. DTSBX465 +00678 DTSBX465 +00679 S999-EXIT. DTSBX465 +00680 EXIT. DTSBX465 +00681 DTSBX465 diff --git a/Batch/DTSBX467.cob b/Batch/DTSBX467.cob new file mode 100644 index 0000000..3da351c --- /dev/null +++ b/Batch/DTSBX467.cob @@ -0,0 +1,680 @@ +00001 IDENTIFICATION DIVISION. 02/23/24 +00002 PROGRAM-ID. DTSBX467. DTSBX467 +00003 LV031 +00004 ******************************************************************DTSBX467 +00005 * *DTSBX467 +00006 * FUNCTION: CREATE QUARTERLY WAGE FILE FOR NDNH. * CL*17 +00007 * *DTSBX467 +00008 * FUNCTION: *DTSBX467 +00009 * *DTSBX467 +00010 * THE FUNCTION OF DTSBX465 IS TO GENERATE A UI QTR WAGE *DTSBX467 +00011 * FILE FOR THE OFFICE OF TAX AND REVENUE. UI WAGE DATA *DTSBX467 +00012 * WILL BE EXTRACTED FOR A GIVEN QUARTER PERIOD BASED ON *DTSBX467 +00013 * THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE. *DTSBX467 +00014 * *DTSBX467 +00015 * CONTACT: WALTER GOETZ 202-442-6312 TAX AND REVENUE(OTR) *DTSBX467 +00016 * *DTSBX467 +00017 * G.A.BROWN *DTSBX467 +00018 ******************************************************************DTSBX467 +00019 * DTSBX467 +00020 * MODIFICATION HISTORY: DTSBX467 +00021 * DTSBX467 +00022 * 03-07-2005 MODIFIED SYSIN PARM ACCEPT CARD TO ACCEPT BLANK DTSBX467 +00023 * ON QUARTERLY FROM-DATE AND TO-DATE AS THE DEFAULT DTSBX467 +00024 * FROM THE HEADER RECORD COMPLETE QUARTER BEGIN DATE DTSBX467 +00025 * AND THE COMPLETE QUARTER END DATE FIELDS. IF THE DTSBX467 +00026 * INVALID QTR FROM-DATE AND QTR TO-DATE ENTERED, DTSBX467 +00027 * THE PROGRAM EDITING RESULTS WILL ABEND. DTSBX467 +00028 * REFERENCE RFP: STEVE PROGRAMMER: RLWDTSBX467 +00029 * DTSBX467 +00030 * 06-17-2018 MODIFIED PROGRAM TO READ WAGE NAME FILE AN OUTPUT CL**8 +00031 * FULL NAME ON OUTPUT WAGE FILE TO OTR CL**8 +00032 * REFERENCE RFP: STEVE PROGRAMMER: ZL1 CL**8 +00033 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX467 +00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX467 +00035 * REFERENCE RFP #**** PROGRAMMER: XXXDTSBX467 +00036 ***** DTSBX467 +00037 DTSBX467 +00038 ENVIRONMENT DIVISION. DTSBX467 +00039 CONFIGURATION SECTION. DTSBX467 +00040 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX467 +00041 INPUT-OUTPUT SECTION. DTSBX467 +00042 FILE-CONTROL. DTSBX467 +00043 SELECT WAGE-FILE ASSIGN TO UT-S-BUSINES. DTSBX467 +00044 * SELECT WAGE-FILE-G ASSIGN TO UT-S-GOVT. CL*19 +00045 * SELECT WAGE-FILE-F ASSIGN TO UT-S-FED. CL*19 +00046 DATA DIVISION. DTSBX467 +00047 FILE SECTION. DTSBX467 +00048 DTSBX467 +00049 FD WAGE-FILE DTSBX467 +00050 RECORDING MODE IS F. CL*21 +00051 01 WAGE-REC PIC X(601). CL*19 +00052 DTSBX467 +00053 DTSBX467 +00054 ******************************************************************DTSBX467 +00055 * WORKING STORAGE SECTION *DTSBX467 +00056 ******************************************************************DTSBX467 +00057 WORKING-STORAGE SECTION. DTSBX467 +000575 77 PAN-VALET PICTURE X(24) VALUE '031DTSBX467 02/23/24'. DTSBX467 +00058 DTSBX467 +00059 01 SELECT-CARD. DTSBX467 +00060 03 PRG-NAME PIC X(10) VALUE '**DTSBX465'. DTSBX467 +00061 03 FIL PIC XX. DTSBX467 +00062 03 FROM-ACTIVITY-DATE PIC 9(8). DTSBX467 +00063 03 FIL PIC X. DTSBX467 +00064 03 TO-ACTIVITY-DATE PIC 9(8). DTSBX467 +00065 03 FIL PIC X VALUE SPACE. DTSBX467 +00066 03 DCGOVT PIC X(3). DTSBX467 +00067 03 FIL PIC X. DTSBX467 +00068 03 FEDGOVT PIC X(3). DTSBX467 +00069 03 FIL PIC X. DTSBX467 +00070 03 BUSINESS PIC X(3). DTSBX467 +00071 03 FIL PIC X(39). DTSBX467 +00072 DTSBX467 +00073 01 COUNTERS. DTSBX467 +00074 03 FEDERAL-ID-NUMBER-WS PIC 9(9). DTSBX467 +00075 03 STOP-RECS PIC 9(5). DTSBX467 +00076 03 UNMATCH-SW PIC X. DTSBX467 +00077 03 ALL-NINES PIC 9. DTSBX467 +00078 03 RECS-IN PIC 9(9). DTSBX467 +00079 03 RECS-OUT PIC 9(9). DTSBX467 +00080 03 QTR-WAGES PIC 9(9). DTSBX467 +00081 03 WRK-ZIP. CL*18 +00082 05 WRK-ZIPA PIC X(05). CL*18 +00083 05 FILLER PIC X(01). CL*18 +00084 05 WRK-ZIPB PIC X(04). CL*18 +00085 03 DC-WAGES PIC 9(9). DTSBX467 +00086 03 WRK-YEAR-QUARTER. CL*18 +00087 05 WRK-YEAR-YR PIC 9(4). CL*18 +00088 05 WRK-YEAR-Q PIC 9(1). CL*18 +00089 03 FED-WAGES PIC 9(9). DTSBX467 +00090 03 BUSINESS-WAGES PIC 9(9). DTSBX467 +00091 03 DC-ACCT PIC 9(6). DTSBX467 +00092 03 EMP-ACCT-HOLD PIC 9(6). DTSBX467 +00093 03 EMP-ACCT-HOLD-RED PIC 9(6). DTSBX467 +00094 03 EMP-ACCT-HOLD-WS REDEFINES EMP-ACCT-HOLD-RED. DTSBX467 +00095 05 ACCT-FOUR PIC 9(4). DTSBX467 +00096 05 ACCT-THREE-WS REDEFINES ACCT-FOUR. DTSBX467 +00097 07 ACCT-THREE-RED PIC 9(3). DTSBX467 +00098 07 ACCT-FIL PIC 9. DTSBX467 +00099 05 ACCT-TWO PIC 99. DTSBX467 +00100 DTSBX467 +00101 03 W-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 +00102 03 WRK-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 +00103 03 ABEND-CODE PIC S9(04) COMP CL**2 +00104 VALUE +465. DTSBX467 +00105 03 ABEND-MOD PIC X(08) DTSBX467 +00106 VALUE 'DTSBU999'. DTSBX467 +00107 03 ABEND-MSG PIC X(60). DTSBX467 +00108 DTSBX467 +00109 03 WRK-BEGIN-DATE PIC S9(09) COMP-3. DTSBX467 +00110 03 WRK-END-DATE PIC S9(09) COMP-3. DTSBX467 +00111 DTSBX467 +00112 03 WRK-BEGIN-DATE-DISP PIC 9(08). DTSBX467 +00113 03 FILLER REDEFINES WRK-BEGIN-DATE-DISP. DTSBX467 +00114 05 WRK-BEGIN-YR PIC 9(04). DTSBX467 +00115 05 WRK-BEGIN-MO PIC 9(02). DTSBX467 +00116 05 WRK-BEGIN-DA PIC 9(02). DTSBX467 +00117 DTSBX467 +00118 03 WRK-END-DATE-DISP PIC 9(08). DTSBX467 +00119 03 FILLER REDEFINES WRK-END-DATE-DISP. DTSBX467 +00120 05 WRK-END-YR PIC 9(04). DTSBX467 +00121 05 WRK-END-MO PIC 9(02). DTSBX467 +00122 05 WRK-END-DA PIC 9(02). DTSBX467 +00123 CL**3 +00124 03 WRK-NAME. CL**3 +00125 05 WRK-LNAME PIC X(20) VALUE SPACES. CL**3 +00126 05 WRK-FNAME PIC X(15) VALUE SPACES. CL**3 +00127 05 WRK-INAME PIC X(01) VALUE SPACES. CL**3 +00128 01 HEADER-RECORD. CL*27 +00129 05 HEADER-IDENTIFIER PIC X(02) VALUE 'HQ'. CL*27 +00130 05 HEADER-STATE-CODE PIC 9(02) VALUE 11. CL*27 +00131 05 HEADER-AGENCY-CODE PIC X(09) VALUE SPACES. CL*27 +00132 05 HEADER-TRANSMISSION-TYPE PIC X(02) VALUE 'QW'. CL*27 +00133 05 FILLER PIC X(01) VALUE SPACE. CL*27 +00134 05 HEADER-VERSION-CONTROL PIC X(02) VALUE '01'. CL*27 +00135 05 HEADER-DATE-STAMP PIC 9(08) VALUE 20231207. CL*30 +00136 05 FILLER REDEFINES HEADER-DATE-STAMP. CL*27 +00137 10 HEADER-DATE-STAMP-CC PIC 9(02). CL*27 +00138 10 HEADER-DATE-STAMP-YY PIC 9(02). CL*27 +00139 10 HEADER-DATE-STAMP-MM PIC 9(02). CL*27 +00140 10 HEADER-DATE-STAMP-DD PIC 9(02). CL*27 +00141 05 HEADER-BATCH-NUMBER PIC 9(06) VALUE 000210. CL*27 +00142 05 FILLER PIC X(263) VALUE SPACES. CL*27 +00143 CL*28 +00144 01 TRAILER-RECORD. CL*28 +00145 05 TRAILER-IDENTIFIER PIC X(02) VALUE 'TQ'. CL*28 +00146 05 TRAILER-RECORD-COUNT PIC 9(11) VALUE 2. CL*28 +00147 05 FILLER PIC X(282) VALUE SPACES. CL*28 +00148 CL*28 +00149 CL*27 +00150 01 NDNH-LINK-AREA. CL*17 +00151 ++INCLUDE DTSQWREC CL*18 +00152 CL*17 +00153 01 L001-LINK-AREA. DTSBX467 +00154 ++INCLUDE DTSIL001 DTSBX467 +00155 DTSBX467 +00156 01 L004-LINK-AREA. DTSBX467 +00157 ++INCLUDE DTSIL004 DTSBX467 +00158 DTSBX467 +00159 01 L910-LINK-AREA. DTSBX467 +00160 ++INCLUDE DTSIL910 DTSBX467 +00161 CL**3 +00162 01 L982-LINK-AREA. CL**3 +00163 ++INCLUDE DTSIL982 CL**3 +00164 DTSBX467 +00165 01 MSKL-REC. DTSBX467 +00166 ++INCLUDE DTSIMSKL DTSBX467 +00167 DTSBX467 +00168 01 MHDR-REC. DTSBX467 +00169 ++INCLUDE DTSIMHDR DTSBX467 +00170 DTSBX467 +00171 CL*19 +00172 01 MTAD-REC. CL*19 +00173 ++INCLUDE DTSIMTAD CL*19 +00174 CL*19 +00175 01 MPRF-REC. DTSBX467 +00176 ++INCLUDE DTSIMPRF DTSBX467 +00177 CL**3 +00178 01 WNAM-REC. CL**3 +00179 ++INCLUDE DTSIWNAM CL**3 +00180 CL**3 +00181 01 COMMON-LINKAGE-SECTION. DTSBX467 +00182 ++INCLUDE EWGLINKB DTSBX467 +00183 EJECT DTSBX467 +00184 EJECT DTSBX467 +00185 ******************************************************************DTSBX467 +00186 * PROCEDURE DIVISION - CONTROL PROCEDURE *DTSBX467 +00187 ******************************************************************DTSBX467 +00188 PROCEDURE DIVISION. DTSBX467 +00189 BEGIN00000. DTSBX467 +00190 OPEN OUTPUT WAGE-FILE. CL*18 +00191 WRITE WAGE-REC FROM HEADER-RECORD. CL*27 +00192 ** DTSBX467 +00193 **** OPEN UI WAGE MASTER FILE FOR READ ONLY DTSBX467 +00194 ** DTSBX467 +00195 SET DBW-RANDOM-PROCESSING TO TRUE. DTSBX467 +00196 SET DBW-HEADER-RECORD TO TRUE. DTSBX467 +00197 SET DBW-OPEN-INPUT TO TRUE. DTSBX467 +00198 CALL 'EWG960D' DTSBX467 +00199 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX467 +00200 DTSBX467 +00201 PERFORM 114-S910-OPEN-READ THRU 114-S910-OPEN-READ-EXIT. DTSBX467 +00202 PERFORM S982O-OPEN-READ THRU S982O-EXIT. CL**6 +00203 DTSBX467 +00204 MOVE ZEROS TO COUNTERS. DTSBX467 +00205 MOVE ZERO TO WRK-BEGIN-DATE DTSBX467 +00206 WRK-END-DATE. DTSBX467 +00207 DTSBX467 +00208 MAIN0100-INITIATE. DTSBX467 +00209 ACCEPT SELECT-CARD. DTSBX467 +00210 DISPLAY ' '. DTSBX467 +00211 DISPLAY ' ' SELECT-CARD. DTSBX467 +00212 DISPLAY ' '. DTSBX467 +00213 DISPLAY ' PROGRAM ' PRG-NAME. DTSBX467 +00214 DISPLAY ' FROM-DATE ' FROM-ACTIVITY-DATE. DTSBX467 +00215 DISPLAY ' TO-DATE ' TO-ACTIVITY-DATE. DTSBX467 +00216 DISPLAY ' DC GOVT ' DCGOVT DTSBX467 +00217 DISPLAY ' FED GOVT ' FEDGOVT DTSBX467 +00218 DISPLAY ' BUSINESS ' BUSINESS DTSBX467 +00219 DISPLAY ' '. DTSBX467 +00220 DISPLAY ' '. DTSBX467 +00221 DTSBX467 +00222 IF (FROM-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX467 +00223 AND (TO-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX467 +00224 PERFORM INIT0300-DEFAULT-DATES THRU INIT0300-EXIT DTSBX467 +00225 ELSE DTSBX467 +00226 PERFORM INIT0100-BEGIN-DATE THRU INIT0100-EXIT DTSBX467 +00227 PERFORM INIT0200-END-DATE THRU INIT0200-EXIT. DTSBX467 +00228 DTSBX467 +00229 IF WRK-END-DATE < WRK-BEGIN-DATE DTSBX467 +00230 MOVE 'PERIOD END LESS THAN PERIOD BEGIN' DTSBX467 +00231 TO ABEND-MSG DTSBX467 +00232 PERFORM S999-ABEND THRU S999-EXIT. DTSBX467 +00233 DTSBX467 +00234 MOVE WRK-BEGIN-DATE TO WRK-BEGIN-DATE-DISP. DTSBX467 +00235 MOVE WRK-END-DATE TO WRK-END-DATE-DISP. DTSBX467 +00236 DISPLAY ' '. DTSBX467 +00237 DISPLAY ' FROM-DATE/DEFAULT FROM DATE ' WRK-BEGIN-DATE-DISP.DTSBX467 +00238 DISPLAY ' TO-DATE/DEFAULT TO-DATE ' WRK-END-DATE-DISP. DTSBX467 +00239 DISPLAY ' '. DTSBX467 +00240 DTSBX467 +00241 MOVE LOW-VALUE TO VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX467 +00242 PERFORM MAIN0200-PROCESS-WAGE THRU MAIN0200-EX DTSBX467 +00243 UNTIL DBW-END-OF-FILE. DTSBX467 +00244 GO TO TERM0100-CLOSE-FILES. DTSBX467 +00245 DTSBX467 +00246 INIT0100-BEGIN-DATE. DTSBX467 +00247 MOVE FROM-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX467 +00248 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX467 +00249 IF L001-VALID-DATE DTSBX467 +00250 MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE DTSBX467 +00251 ELSE DTSBX467 +00252 MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG DTSBX467 +00253 PERFORM S999-ABEND THRU S999-EXIT. DTSBX467 +00254 END-IF. CL*31 +00255 DTSBX467 +00256 * MOVE WRK-BEGIN-DATE TO L004-DATE. CL*31 +00257 * PERFORM S004-FROM-DATE THRU S004-EXIT. CL*31 +00258 * IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE CL*31 +00259 * MOVE 'PERIOD BEGIN NOT START OF QTR' CL*31 +00260 * TO ABEND-MSG CL*31 +00261 * PERFORM S999-ABEND THRU S999-EXIT CL*31 +00262 DTSBX467 +00263 INIT0100-EXIT. DTSBX467 +00264 EXIT. DTSBX467 +00265 DTSBX467 +00266 INIT0200-END-DATE. DTSBX467 +00267 MOVE TO-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX467 +00268 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX467 +00269 IF L001-VALID-DATE DTSBX467 +00270 MOVE L001-FED-8-DATE-9 TO WRK-END-DATE DTSBX467 +00271 ELSE DTSBX467 +00272 MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG DTSBX467 +00273 PERFORM S999-ABEND THRU S999-EXIT. DTSBX467 +00274 DTSBX467 +00275 * MOVE WRK-END-DATE TO L004-DATE. CL*31 +00276 * PERFORM S004-FROM-DATE THRU S004-EXIT. CL*31 +00277 * IF WRK-END-DATE NOT = L004-QTR-END-DATE CL*31 +00278 * DISPLAY ' END DT ' L004-QTR-END-DATE CL*31 +00279 * MOVE 'PERIOD END NOT END OF QTR' CL*31 +00280 * TO ABEND-MSG CL*31 +00281 * PERFORM S999-ABEND THRU S999-EXIT CL*31 +00282 * END-IF. CL*31 +00283 DTSBX467 +00284 INIT0200-EXIT. DTSBX467 +00285 EXIT. DTSBX467 +00286 DTSBX467 +00287 INIT0300-DEFAULT-DATES. DTSBX467 +00288 DTSBX467 +00289 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX467 +00290 MOVE +0 TO MSKL-EMP-NO. DTSBX467 +00291 SET MSKL-HDR-88 TO TRUE. DTSBX467 +00292 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. DTSBX467 +00293 DTSBX467 +00294 IF L910-NO-REC-88 DTSBX467 +00295 MOVE 'MHDR RECORD IS MISSING' DTSBX467 +00296 TO ABEND-MSG DTSBX467 +00297 PERFORM S999-ABEND THRU S999-EXIT. DTSBX467 +00298 DTSBX467 +00299 MOVE MSKL-REC TO MHDR-REC. DTSBX467 +00300 DTSBX467 +00301 MOVE MHDR-CMPL-QTR-BEGIN-DATE DTSBX467 +00302 TO WRK-BEGIN-DATE. DTSBX467 +00303 MOVE MHDR-CMPL-QTR-END-DATE DTSBX467 +00304 TO WRK-END-DATE. DTSBX467 +00305 DTSBX467 +00306 MOVE WRK-BEGIN-DATE TO FROM-ACTIVITY-DATE. DTSBX467 +00307 MOVE WRK-END-DATE TO TO-ACTIVITY-DATE. DTSBX467 +00308 DTSBX467 +00309 INIT0300-EXIT. DTSBX467 +00310 EXIT. DTSBX467 +00311 DTSBX467 +00312 MAIN0200-PROCESS-WAGE. DTSBX467 +00313 MOVE 'S' TO DBW-PROCESSING-MODE. DTSBX467 +00314 MOVE 'SG01' TO DBW-SEGNAME. DTSBX467 +00315 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX467 +00316 PERFORM LOCATE-WAGE THRU L-W-EX DTSBX467 +00317 UNTIL DBW-NO-RECORD-FOUND. DTSBX467 +00318 ADD 1 TO RECS-IN. DTSBX467 +00319 IF WGP-SSN = 999999999 DTSBX467 +00320 GO TO TERM0100-CLOSE-FILES. DTSBX467 +00321 IF ALL-NINES = 1 DTSBX467 +00322 GO TO TERM0100-CLOSE-FILES. DTSBX467 +00323 MAIN0200-EX. DTSBX467 +00324 EXIT. DTSBX467 +00325 DTSBX467 +00326 LOCATE-WAGE. DTSBX467 +00327 MOVE 'R' TO DBW-PROCESSING-MODE. DTSBX467 +00328 MOVE 'SG02' TO DBW-SEGNAME. DTSBX467 +00329 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX467 +00330 IF DBW-NO-RECORD-FOUND DTSBX467 +00331 GO TO L-W-EX. DTSBX467 +00332 PERFORM SEGMENT-2-DATA THRU S-2-D-EX. DTSBX467 +00333 L-W-EX. DTSBX467 +00334 EXIT. DTSBX467 +00335 DTSBX467 +00336 SEGMENT-2-DATA. DTSBX467 +00337 ********************************************************** DTSBX467 +00338 * ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS DTSBX467 +00339 ******* ************************************************** DTSBX467 +00340 IF WGP-SSN = 999999999 DTSBX467 +00341 MOVE 1 TO ALL-NINES DTSBX467 +00342 GO TO S-2-D-EX. DTSBX467 +00343 DTSBX467 +00344 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. DTSBX467 +00345 IF WGD-ACTIVITY-DATE NOT LESS THAN FROM-ACTIVITY-DATE DTSBX467 +00346 AND DTSBX467 +00347 WGD-ACTIVITY-DATE NOT GREATER THAN TO-ACTIVITY-DATE DTSBX467 +00348 NEXT SENTENCE ELSE DTSBX467 +00349 GO TO S-2-D-EX. DTSBX467 +00350 DTSBX467 +00351 * DISPLAY ' ENO : ' WGD-ACCOUNT-NUMBER ' ' CL*12 +00352 * ' DOCS: ' WGD-ACTIVITY-DATE ' ' CL*12 +00353 * ' FROM: ' FROM-ACTIVITY-DATE ' ' CL*12 +00354 * ' TO : ' TO-ACTIVITY-DATE. CL*12 +00355 DTSBX467 +00356 MOVE WGD-ACCOUNT-NUMBER TO EMP-ACCT-HOLD. DTSBX467 +00357 MOVE EMP-ACCT-HOLD TO EMP-ACCT-HOLD-RED. DTSBX467 +00358 DTSBX467 +00359 IF ACCT-FOUR = DTSBX467 +00360 1101 OR 1102 OR 1104 OR 1105 OR 1106 OR 1108 OR DTSBX467 +00361 1109 OR 1110 OR 1111 OR 1112 OR 1113 OR 1115 OR DTSBX467 +00362 1116 OR 1117 OR 1118 OR 1119 OR 1120 OR 1121 OR 1122 OR DTSBX467 +00363 1123 OR 1124 OR 1125 OR 1126 OR 1127 OR 1128 OR 1129 OR DTSBX467 +00364 1130 OR 1131 OR 1132 OR 1133 OR 1134 OR 1135 OR 1136 OR DTSBX467 +00365 1137 OR 1138 OR 1139 OR 1140 OR 1141 OR 1142 OR 1144 OR DTSBX467 +00366 1145 OR 1146 OR 1147 OR 1148 OR 1149 OR 1150 OR 1151 OR DTSBX467 +00367 1153 OR 1154 OR 1155 OR 1156 DTSBX467 +00368 GO TO S-2-D-EX. DTSBX467 +00369 DTSBX467 +00370 ADD 1 TO QTR-WAGES. DTSBX467 +00371 DTSBX467 +00372 40-WRITE-DCGOV-FEDL-BUS-ACCTS. DTSBX467 +00373 DTSBX467 +00374 PERFORM 110-FEIN-LOOK-UP THRU 110-FLU-EXIT. DTSBX467 +00375 DTSBX467 +00376 IF WGP-SSN = 000000000 DTSBX467 +00377 GO TO S-2-D-EX. DTSBX467 +00378 DTSBX467 +00379 IF L910-NO-REC-88 DTSBX467 +00380 GO TO S-2-D-EX. DTSBX467 +00381 DTSBX467 +00382 * IF DCGOVT = 'DCG' CL*22 +00383 * IF EMP-ACCT-HOLD = 998888 CL*22 +00384 * PERFORM 050-WRITE-GOVERNMENT-ACCOUNTS THRU 050-W-G-A-EXT CL*18 +00385 * PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*22 +00386 * GO TO S-2-D-EX. CL*22 +00387 DTSBX467 +00388 * IF FEDGOVT = 'FED' CL*22 +00389 * IF ACCT-THREE-RED = 000 CL*22 +00390 * PERFORM 025-WRITE-FEDERAL-ACCOUNTS THRU 025-W-F-A-EXT CL*18 +00391 * PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*22 +00392 * GO TO S-2-D-EX. CL*22 +00393 DTSBX467 +00394 * IF BUSINESS = 'BUS' CL*22 +00395 PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*15 +00396 DTSBX467 +00397 GO TO S-2-D-EX. DTSBX467 +00398 DTSBX467 +00399 100-WRITE-BUSINESS-ACCOUNTS. DTSBX467 +00400 DTSBX467 +00401 ADD 1 TO BUSINESS-WAGES. DTSBX467 +00402 MOVE WGP-SSN TO EMPLOYEE-SSN. CL*18 +00403 MOVE WGD-YR-QTR TO WRK-YEAR-QUARTER. CL*18 +00404 MOVE WRK-YEAR-YR TO REPORTING-PERIOD-CCYY. CL*18 +00405 MOVE WRK-YEAR-Q TO REPORTING-PERIOD-Q. CL*18 +00406 * MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM. CL*21 +00407 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-DOLLARS. CL*18 +00408 MOVE ZEROS TO EMPLOYEE-CENTS. CL*18 +00409 * MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE. CL*18 +00410 MOVE FEDERAL-ID-NUMBER-WS TO EMPLOYER-FEIN. CL*18 +00411 MOVE SPACES TO WRK-NAME. CL*18 +00412 MOVE LOW-VALUE TO WNAM-REC. CL*18 +00413 MOVE WGP-SSN TO WNAM-SSN WRK-SSN. CL*18 +00414 CL*18 +00415 PERFORM 130-READ-NAME THRU 130-READ-NAME-EXIT. CL*18 +00416 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME CL*18 +00417 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME CL*18 +00418 MOVE WRK-INAME TO EMPLOYEE-MIDDLE-NAME CL*21 +00419 PERFORM 200-READ-MTAD THRU 200-EXIT. CL*26 +00420 WRITE WAGE-REC FROM NDNH-LINK-AREA. CL*23 +00421 MOVE SPACES TO WAGE-REC. CL*18 +00422 DISPLAY 'FEIN ' EMPLOYER-FEIN ' SSN ' EMPLOYEE-SSN. CL*25 +00423 DTSBX467 +00424 * IF BUSINESS-WAGES > 100000 CL*29 +00425 * GO TO TERM0100-CLOSE-FILES. CL*29 +00426 100-W-B-A-EXT. DTSBX467 +00427 EXIT. DTSBX467 +00428 S-2-D-EX. DTSBX467 +00429 EXIT. DTSBX467 +00430 110-FEIN-LOOK-UP. DTSBX467 +00431 DTSBX467 +00432 MOVE ZEROS TO FEDERAL-ID-NUMBER-WS. DTSBX467 +00433 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX467 +00434 DTSBX467 +00435 MOVE WGD-ACCOUNT-NUMBER TO MSKL-EMP-NO. DTSBX467 +00436 SET MSKL-PRF-88 TO TRUE. CL*14 +00437 * SET L910-READ-88 TO TRUE. CL*14 +00438 DTSBX467 +00439 * PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. CL*14 +00440 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT CL*14 +00441 DTSBX467 +00442 IF L910-NO-REC-88 DTSBX467 +00443 DISPLAY 'ACCT NOT IN DTS: ' WGD-ACCOUNT-NUMBER CL*15 +00444 GO TO 110-FLU-EXIT. DTSBX467 +00445 DTSBX467 +00446 MOVE MSKL-REC TO MPRF-REC. DTSBX467 +00447 DTSBX467 +00448 * IF MPRF-STATUS-ACT-88 CL*15 +00449 * NEXT SENTENCE CL*15 +00450 * ELSE CL*15 +00451 * DISPLAY ' ACCT NOT ACTIVE ' MPRF-FEIN CL*15 +00452 * SET L910-NO-REC-88 TO TRUE CL*15 +00453 * GO TO 110-FLU-EXIT. CL*15 +00454 DTSBX467 +00455 MOVE MPRF-FEIN TO FEDERAL-ID-NUMBER-WS. DTSBX467 +00456 MOVE MPRF-PRIMARY-NAME TO EMPLOYER-NAME. CL*18 +00457 IF MPRF-EMP-NO = 998888 CL*29 +00458 DISPLAY ' DCGOV ID ' FEDERAL-ID-NUMBER-WS CL*29 +00459 ' ' EMPLOYER-NAME. CL*29 +00460 110-FLU-EXIT. DTSBX467 +00461 EXIT. DTSBX467 +00462 CL*18 +00463 200-READ-MTAD. CL*18 +00464 MOVE LOW-VALUE TO MTAD-REC. CL*18 +00465 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. CL*18 +00466 SET MTAD-TAD-88 TO TRUE. CL*18 +00467 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. CL*18 +00468 CL*18 +00469 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. CL*18 +00470 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. CL*20 +00471 IF L910-NO-REC-88 CL*18 +00472 GO TO 200-EXIT. CL*18 +00473 CL*18 +00474 MOVE MSKL-REC TO MTAD-REC. CL*18 +00475 MOVE MTAD-ATTN-LINE TO EMPLOYER-STREET-ADDRESS1 CL*18 +00476 MOVE MTAD-DELIV-LINE-1 TO EMPLOYER-STREET-ADDRESS2 CL*18 +00477 MOVE MTAD-DELIV-LINE-2 TO EMPLOYER-STREET-ADDRESS3 CL*18 +00478 MOVE MTAD-CITY TO EMPLOYER-CITY CL*18 +00479 MOVE MTAD-ST TO EMPLOYER-STATE CL*18 +00480 MOVE MTAD-ZIP TO WRK-ZIP CL*18 +00481 MOVE WRK-ZIPA TO EMPLOYER-ZIP-CODE CL*18 +00482 MOVE WRK-ZIPB TO EMPLOYER-ZIP4. CL*18 +00483 * CL*18 +00484 MOVE LOW-VALUE TO MTAD-REC. CL*18 +00485 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. CL*18 +00486 SET MTAD-TAD-88 TO TRUE. CL*18 +00487 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. CL*18 +00488 CL*18 +00489 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. CL*18 +00490 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. CL*20 +00491 IF L910-NO-REC-88 CL*18 +00492 GO TO 200-EXIT. CL*18 +00493 DTSBX467 +00494 CL*18 +00495 MOVE MSKL-REC TO MTAD-REC. CL*18 +00496 MOVE MTAD-ATTN-LINE TO OPTIONAL-STREET-ADDRESS1 CL*18 +00497 MOVE MTAD-DELIV-LINE-1 TO OPTIONAL-STREET-ADDRESS2 CL*18 +00498 MOVE MTAD-DELIV-LINE-2 TO OPTIONAL-STREET-ADDRESS3 CL*18 +00499 MOVE MTAD-CITY TO OPTIONAL-CITY CL*18 +00500 MOVE MTAD-ST TO OPTIONAL-STATE CL*18 +00501 MOVE MTAD-ZIP TO WRK-ZIP CL*18 +00502 MOVE WRK-ZIPA TO OPTIONAL-ZIP-CODE CL*18 +00503 MOVE WRK-ZIPB TO OPTIONAL-ZIP4. CL*18 +00504 * CL*18 +00505 200-EXIT. CL*18 +00506 EXIT. CL*18 +00507 CL*18 +00508 114-S910-OPEN-READ. DTSBX467 +00509 SET L910-OPEN-READ-88 TO TRUE. DTSBX467 +00510 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX467 +00511 114-S910-OPEN-READ-EXIT. DTSBX467 +00512 EXIT. DTSBX467 +00513 DTSBX467 +00514 115-S910-READ. DTSBX467 +00515 SET L910-READ-88 TO TRUE. DTSBX467 +00516 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX467 +00517 115-S910-READ-EXIT. DTSBX467 +00518 EXIT. DTSBX467 +00519 DTSBX467 +00520 116-S910-CLOSE. DTSBX467 +00521 SET L910-CLOSE-88 TO TRUE. DTSBX467 +00522 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX467 +00523 116-S910-CLOSE-EXIT. DTSBX467 +00524 EXIT. DTSBX467 +00525 DTSBX467 +00526 120-READ-MPRF. DTSBX467 +00527 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX467 +00528 MSKL-REC. DTSBX467 +00529 120-READ-MPRF-EXIT. DTSBX467 +00530 EXIT. DTSBX467 +00531 CL**2 +00532 130-READ-NAME. CL**2 +00533 ******************************************************************DTSBX467 +00534 * SEARCH FOR NAME ON WAGE NAME FILE * CL**2 +00535 ******************************************************************DTSBX467 +00536 CL**2 +00537 PERFORM S982A-START-BROWSE THRU S982A-EXIT. CL**2 +00538 CL**2 +00539 IF NOT L982-OK-88 CL**2 +00540 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN CL**2 +00541 GO TO 130-READ-NAME-EXIT CL**4 +00542 END-IF. CL**2 +00543 CL**2 +00544 MOVE WNAM-SSN TO W-SSN. CL**2 +00545 CL**2 +00546 IF WRK-SSN = W-SSN CL**2 +00547 MOVE WNAM-LAST-NAME TO WRK-LNAME CL**3 +00548 MOVE WNAM-FIRST-NAME TO WRK-FNAME CL**3 +00549 MOVE WNAM-MID-INIT TO WRK-INAME CL**3 +00550 ELSE CL**2 +00551 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN. CL**2 +00552 130-READ-NAME-EXIT. CL**2 +00553 EXIT. CL**2 +00554 ****************************************************************** CL**2 +00555 * TERMINATION ROUTINE * CL**2 +00556 ****************************************************************** CL**2 +00557 TERM0100-CLOSE-FILES. DTSBX467 +00558 CL*28 +00559 MOVE BUSINESS-WAGES TO TRAILER-RECORD-COUNT. CL*28 +00560 WRITE WAGE-REC FROM TRAILER-RECORD. CL*28 +00561 CLOSE WAGE-FILE. CL*18 +00562 DTSBX467 +00563 MOVE 'C' TO DBW-COMMAND-CODE. DTSBX467 +00564 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX467 +00565 DTSBX467 +00566 PERFORM 116-S910-CLOSE THRU 116-S910-CLOSE-EXIT. DTSBX467 +00567 DTSBX467 +00568 DISPLAY 'NUMBER RECORDS READ *** ' RECS-IN. DTSBX467 +00569 DISPLAY ' ' . DTSBX467 +00570 DISPLAY 'DC WAGES ' DC-WAGES. DTSBX467 +00571 DISPLAY 'BUSINESS WAGES ' BUSINESS-WAGES. DTSBX467 +00572 DISPLAY 'FEDRAL WAGES ' FED-WAGES. DTSBX467 +00573 DISPLAY ' ' . DTSBX467 +00574 DISPLAY 'NUMBER RECORDS PRINTED *** ' RECS-OUT. DTSBX467 +00575 STOP RUN. DTSBX467 +00576 TERM0100-EXIT. DTSBX467 +00577 EXIT. DTSBX467 +00578 EJECT DTSBX467 +00579 ******************************************************************DTSBX467 +00580 * SERVICE ROUTINES *DTSBX467 +00581 ******************************************************************DTSBX467 +00582 SERV1001-READ-MASTER. DTSBX467 +00583 MOVE 'R' TO DBW-COMMAND-CODE. DTSBX467 +00584 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX467 +00585 SERV1001-EXIT. DTSBX467 +00586 EXIT. DTSBX467 +00587 SERV2001-RESET-MASTER. DTSBX467 +00588 MOVE 'S' TO DBW-COMMAND-CODE. DTSBX467 +00589 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX467 +00590 SERV2001-EXIT. DTSBX467 +00591 EXIT. DTSBX467 +00592 SERV9001-ACCESS-DATABASE. DTSBX467 +00593 IF DBW-SEGNAME = 'SG01' DTSBX467 +00594 CALL 'EWG960D' DTSBX467 +00595 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX467 +00596 IF DBW-SEGNAME = 'SG02' DTSBX467 +00597 CALL 'EWG960D' DTSBX467 +00598 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX467 +00599 SERV9001-EXIT. DTSBX467 +00600 EXIT. DTSBX467 +00601 DTSBX467 +00602 S001-FROM-CAL-6. DTSBX467 +00603 SET L001-FROM-CAL-6 TO TRUE. DTSBX467 +00604 GO TO S001-DATE. DTSBX467 +00605 DTSBX467 +00606 S001-FROM-FED-8. DTSBX467 +00607 SET L001-FROM-FED-8 TO TRUE. DTSBX467 +00608 GO TO S001-DATE. DTSBX467 +00609 DTSBX467 +00610 S001-FROM-ABS. DTSBX467 +00611 SET L001-FROM-ABS-DAY TO TRUE. DTSBX467 +00612 GO TO S001-DATE. DTSBX467 +00613 DTSBX467 +00614 S001-DATE. DTSBX467 +00615 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX467 +00616 S001-EXIT. DTSBX467 +00617 EXIT. DTSBX467 +00618 DTSBX467 +00619 S004-FROM-DATE. DTSBX467 +00620 SET L004-FROM-DATE TO TRUE. DTSBX467 +00621 GO TO S004-YRQ. DTSBX467 +00622 DTSBX467 +00623 S004-YRQ. DTSBX467 +00624 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX467 +00625 S004-EXIT. DTSBX467 +00626 EXIT. DTSBX467 +00627 S982O-OPEN-READ. CL**5 +00628 SET L982-OPEN-READ-88 TO TRUE. CL**5 +00629 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00630 CL**3 +00631 S982O-EXIT. CL**3 +00632 EXIT. CL**3 +00633 CL**3 +00634 S982A-START-BROWSE. CL**3 +00635 SET L982-START-BROWSE-88 TO TRUE. CL**3 +00636 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00637 CL**3 +00638 S982A-EXIT. CL**3 +00639 EXIT. CL**3 +00640 S982B-READ-NEXT. CL**3 +00641 SET L982-READ-NEXT-88 TO TRUE. CL**3 +00642 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00643 CL**3 +00644 S982B-EXIT. CL**3 +00645 EXIT. CL**3 +00646 S982C-WRITE. CL**3 +00647 SET L982-WRITE-88 TO TRUE. CL**3 +00648 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00649 CL**3 +00650 S982C-EXIT. CL**3 +00651 EXIT. CL**3 +00652 CL**3 +00653 S982D-REWRITE. CL**3 +00654 SET L982-REWRITE-88 TO TRUE. CL**3 +00655 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00656 S982D-EXIT. CL**3 +00657 EXIT. CL**3 +00658 S982F-CLOSE. CL**3 +00659 SET L982-CLOSE-88 TO TRUE. CL**3 +00660 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00661 CL**3 +00662 S982F-EXIT. CL**3 +00663 EXIT. CL**3 +00664 CL**3 +00665 S982Z-WNAM-IO. CL**3 +00666 CALL 'DTSBU982' USING L982-LINK-AREA CL**3 +00667 WNAM-REC. CL**3 +00668 S982Z-EXIT. CL**3 +00669 EXIT. CL**3 +00670 CL**3 +00671 DTSBX467 +00672 S999-ABEND. DTSBX467 +00673 DISPLAY '**** DTSBX465 ABENDING ' DTSBX467 +00674 ABEND-MSG. DTSBX467 +00675 CALL ABEND-MOD USING ABEND-CODE. DTSBX467 +00676 DTSBX467 +00677 S999-EXIT. DTSBX467 +00678 EXIT. DTSBX467 +00679 DTSBX467 diff --git a/Batch/DTSBX468.cob b/Batch/DTSBX468.cob new file mode 100644 index 0000000..07f416a --- /dev/null +++ b/Batch/DTSBX468.cob @@ -0,0 +1,726 @@ +00001 IDENTIFICATION DIVISION. 06/02/25 +00002 PROGRAM-ID. DTSBX468. DTSBX468 +00003 LV054 +00004 ******************************************************************DTSBX468 +00005 * *DTSBX468 +00006 * FUNCTION: CREATE QUARTERLY WAGE FILE FOR NDNH. * CL*17 +00007 * *DTSBX468 +00008 * FUNCTION: *DTSBX468 +00009 * *DTSBX468 +00010 * THE FUNCTION OF DTSBX465 IS TO GENERATE A UI QTR WAGE *DTSBX468 +00011 * FILE FOR THE OFFICE OF TAX AND REVENUE. UI WAGE DATA *DTSBX468 +00012 * WILL BE EXTRACTED FOR A GIVEN QUARTER PERIOD BASED ON *DTSBX468 +00013 * THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE. *DTSBX468 +00014 * *DTSBX468 +00015 * CONTACT: WALTER GOETZ 202-442-6312 TAX AND REVENUE(OTR) *DTSBX468 +00016 * *DTSBX468 +00017 * G.A.BROWN *DTSBX468 +00018 ******************************************************************DTSBX468 +00019 * DTSBX468 +00020 * MODIFICATION HISTORY: DTSBX468 +00021 * DTSBX468 +00022 * 03-07-2005 MODIFIED SYSIN PARM ACCEPT CARD TO ACCEPT BLANK DTSBX468 +00023 * ON QUARTERLY FROM-DATE AND TO-DATE AS THE DEFAULT DTSBX468 +00024 * FROM THE HEADER RECORD COMPLETE QUARTER BEGIN DATE DTSBX468 +00025 * AND THE COMPLETE QUARTER END DATE FIELDS. IF THE DTSBX468 +00026 * INVALID QTR FROM-DATE AND QTR TO-DATE ENTERED, DTSBX468 +00027 * THE PROGRAM EDITING RESULTS WILL ABEND. DTSBX468 +00028 * REFERENCE RFP: STEVE PROGRAMMER: RLWDTSBX468 +00029 * DTSBX468 +00030 * 06-17-2018 MODIFIED PROGRAM TO READ WAGE NAME FILE AN OUTPUT CL**8 +00031 * FULL NAME ON OUTPUT WAGE FILE TO OTR CL**8 +00032 * REFERENCE RFP: STEVE PROGRAMMER: ZL1 CL**8 +00033 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX468 +00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDTSBX468 +00035 * REFERENCE RFP #**** PROGRAMMER: XXXDTSBX468 +00036 ***** DTSBX468 +00037 DTSBX468 +00038 ENVIRONMENT DIVISION. DTSBX468 +00039 CONFIGURATION SECTION. DTSBX468 +00040 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX468 +00041 INPUT-OUTPUT SECTION. DTSBX468 +00042 FILE-CONTROL. DTSBX468 +00043 SELECT WAGE-FILE ASSIGN TO UT-S-BUSINES. DTSBX468 +00044 * SELECT WAGE-FILE-G ASSIGN TO UT-S-GOVT. CL*19 +00045 * SELECT WAGE-FILE-F ASSIGN TO UT-S-FED. CL*19 +00046 DATA DIVISION. DTSBX468 +00047 FILE SECTION. DTSBX468 +00048 DTSBX468 +00049 FD WAGE-FILE DTSBX468 +00050 RECORDING MODE IS F. CL*21 +00051 01 WAGE-REC PIC X(601). CL*19 +00052 DTSBX468 +00053 DTSBX468 +00054 ******************************************************************DTSBX468 +00055 * WORKING STORAGE SECTION *DTSBX468 +00056 ******************************************************************DTSBX468 +00057 WORKING-STORAGE SECTION. DTSBX468 +000575 77 PAN-VALET PICTURE X(24) VALUE '054DTSBX468 06/02/25'. DTSBX468 +00058 DTSBX468 +00059 01 SELECT-CARD. DTSBX468 +00060 03 PRG-NAME PIC X(10) VALUE '**DTSBX465'. DTSBX468 +00061 03 FIL PIC XX. DTSBX468 +00062 03 FROM-ACTIVITY-DATE PIC 9(8). DTSBX468 +00063 03 FIL PIC X. DTSBX468 +00064 03 TO-ACTIVITY-DATE PIC 9(8). DTSBX468 +00065 03 FIL PIC X VALUE SPACE. DTSBX468 +00066 03 DCGOVT PIC X(3). DTSBX468 +00067 03 FIL PIC X. DTSBX468 +00068 03 FEDGOVT PIC X(3). DTSBX468 +00069 03 FIL PIC X. DTSBX468 +00070 03 BUSINESS PIC X(3). DTSBX468 +00071 03 FIL PIC X(39). DTSBX468 +00072 DTSBX468 +00073 01 COUNTERS. DTSBX468 +00074 03 FEDERAL-ID-NUMBER-WS PIC 9(9). DTSBX468 +00075 03 STOP-RECS PIC 9(5). CL*46 +00076 03 UNMATCH-SW PIC X. CL*46 +00077 03 ALL-NINES PIC 9. CL*46 +00078 03 RECS-IN PIC 9(9). DTSBX468 +00079 03 RECS-OUT PIC 9(9). DTSBX468 +00080 03 QTR-WAGES PIC 9(9). DTSBX468 +00081 03 WRK-ZIP. CL*18 +00082 05 WRK-ZIPA PIC X(05). CL*18 +00083 05 FILLER PIC X(01). CL*18 +00084 05 WRK-ZIPB PIC X(04). CL*18 +00085 03 DC-WAGES PIC 9(9). DTSBX468 +00086 CL*46 +00087 03 WRK-YEAR-QUARTER PIC 9(5). CL*47 +00088 03 WRK-YEARZ REDEFINES WRK-YEAR-QUARTER. CL*46 +00089 05 WRK-YEAR-YR PIC 9(4). CL*18 +00090 05 WRK-YEAR-Q PIC 9(1). CL*18 +00091 CL*46 +00092 03 FED-WAGES PIC 9(9). DTSBX468 +00093 03 BUSINESS-WAGES PIC 9(9). DTSBX468 +00094 03 DC-ACCT PIC 9(6). DTSBX468 +00095 03 EMP-ACCT-HOLD PIC 9(6). DTSBX468 +00096 03 EMP-ACCT-HOLD-RED PIC 9(6). DTSBX468 +00097 03 EMP-ACCT-HOLD-WS REDEFINES EMP-ACCT-HOLD-RED. DTSBX468 +00098 05 ACCT-FOUR PIC 9(4). DTSBX468 +00099 05 ACCT-THREE-WS REDEFINES ACCT-FOUR. DTSBX468 +00100 07 ACCT-THREE-RED PIC 9(3). DTSBX468 +00101 07 ACCT-FIL PIC 9. DTSBX468 +00102 05 ACCT-TWO PIC 99. DTSBX468 +00103 DTSBX468 +00104 03 W-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 +00105 03 WRK-SSN PIC S9(09) COMP-3 VALUE 0. CL**2 +00106 03 ABEND-CODE PIC S9(04) COMP CL**2 +00107 VALUE +465. DTSBX468 +00108 03 ABEND-MOD PIC X(08) DTSBX468 +00109 VALUE 'DTSBU999'. DTSBX468 +00110 03 ABEND-MSG PIC X(60). DTSBX468 +00111 DTSBX468 +00112 03 WRK-BEGIN-DATE PIC S9(09) COMP-3. DTSBX468 +00113 03 WRK-END-DATE PIC S9(09) COMP-3. DTSBX468 +00114 DTSBX468 +00115 03 WRK-BEGIN-DATE-DISP PIC 9(08). DTSBX468 +00116 03 FILLER REDEFINES WRK-BEGIN-DATE-DISP. DTSBX468 +00117 05 WRK-BEGIN-YR PIC 9(04). DTSBX468 +00118 05 WRK-BEGIN-MO PIC 9(02). DTSBX468 +00119 05 WRK-BEGIN-DA PIC 9(02). DTSBX468 +00120 DTSBX468 +00121 03 WRK-END-DATE-DISP PIC 9(08). DTSBX468 +00122 03 FILLER REDEFINES WRK-END-DATE-DISP. DTSBX468 +00123 05 WRK-END-YR PIC 9(04). DTSBX468 +00124 05 WRK-END-MO PIC 9(02). DTSBX468 +00125 05 WRK-END-DA PIC 9(02). DTSBX468 +00126 CL**3 +00127 03 WRK-NAME. CL**3 +00128 05 WRK-LNAME PIC X(20) VALUE SPACES. CL**3 +00129 05 WRK-FNAME PIC X(15) VALUE SPACES. CL**3 +00130 05 WRK-INAME PIC X(01) VALUE SPACES. CL**3 +00131 01 HEADER-RECORD. CL*27 +00132 05 HEADER-IDENTIFIER PIC X(02) VALUE 'HQ'. CL*27 +00133 05 HEADER-STATE-CODE PIC 9(02) VALUE 11. CL*27 +00134 05 HEADER-AGENCY-CODE PIC X(09) VALUE SPACES. CL*27 +00135 05 HEADER-TRANSMISSION-TYPE PIC X(02) VALUE 'QW'. CL*27 +00136 05 FILLER PIC X(01) VALUE SPACE. CL*27 +00137 05 HEADER-VERSION-CONTROL PIC X(02) VALUE '01'. CL*27 +00138 05 HEADER-DATE-STAMP PIC 9(08) VALUE 20250531. CL*54 +00139 05 FILLER REDEFINES HEADER-DATE-STAMP. CL*27 +00140 10 HEADER-DATE-STAMP-CC PIC 9(02). CL*27 +00141 10 HEADER-DATE-STAMP-YY PIC 9(02). CL*27 +00142 10 HEADER-DATE-STAMP-MM PIC 9(02). CL*27 +00143 10 HEADER-DATE-STAMP-DD PIC 9(02). CL*27 +00144 05 HEADER-BATCH-NUMBER PIC 9(06) VALUE 000210. CL*27 +00145 05 FILLER PIC X(263) VALUE SPACES. CL*27 +00146 CL*28 +00147 01 TRAILER-RECORD. CL*28 +00148 05 TRAILER-IDENTIFIER PIC X(02) VALUE 'TQ'. CL*28 +00149 05 TRAILER-RECORD-COUNT PIC 9(11) VALUE 2. CL*28 +00150 05 FILLER PIC X(282) VALUE SPACES. CL*28 +00151 CL*28 +00152 CL*33 +00153 01 L981-LINK-AREA. CL*33 +00154 ++INCLUDE DTSIL981 CL*33 +00155 CL*33 +00156 01 WWGH-REC. CL*33 +00157 ++INCLUDE DTSIWWGH CL*33 +00158 CL*33 +00159 CL*27 +00160 01 NDNH-LINK-AREA. CL*17 +00161 ++INCLUDE DTSQWREC CL*18 +00162 CL*17 +00163 01 L001-LINK-AREA. DTSBX468 +00164 ++INCLUDE DTSIL001 DTSBX468 +00165 DTSBX468 +00166 01 L004-LINK-AREA. DTSBX468 +00167 ++INCLUDE DTSIL004 DTSBX468 +00168 DTSBX468 +00169 01 L910-LINK-AREA. DTSBX468 +00170 ++INCLUDE DTSIL910 DTSBX468 +00171 CL**3 +00172 01 L982-LINK-AREA. CL**3 +00173 ++INCLUDE DTSIL982 CL**3 +00174 DTSBX468 +00175 01 MSKL-REC. DTSBX468 +00176 ++INCLUDE DTSIMSKL DTSBX468 +00177 DTSBX468 +00178 01 MHDR-REC. DTSBX468 +00179 ++INCLUDE DTSIMHDR DTSBX468 +00180 DTSBX468 +00181 CL*19 +00182 01 MTAD-REC. CL*19 +00183 ++INCLUDE DTSIMTAD CL*19 +00184 CL*19 +00185 01 MPRF-REC. DTSBX468 +00186 ++INCLUDE DTSIMPRF DTSBX468 +00187 CL**3 +00188 01 WNAM-REC. CL**3 +00189 ++INCLUDE DTSIWNAM CL**3 +00190 CL**3 +00191 *01 COMMON-LINKAGE-SECTION. CL*33 +00192 *++INCLUDE EWGLINKB CL*33 +00193 EJECT DTSBX468 +00194 EJECT DTSBX468 +00195 ******************************************************************DTSBX468 +00196 * PROCEDURE DIVISION - CONTROL PROCEDURE *DTSBX468 +00197 ******************************************************************DTSBX468 +00198 PROCEDURE DIVISION. DTSBX468 +00199 BEGIN00000. DTSBX468 +00200 OPEN OUTPUT WAGE-FILE. CL*18 +00201 WRITE WAGE-REC FROM HEADER-RECORD. CL*27 +00202 DTSBX468 +00203 PERFORM 114-S910-OPEN-READ THRU 114-S910-OPEN-READ-EXIT. DTSBX468 +00204 PERFORM S981A1-OPEN-READ THRU S981A1-EXIT. CL*36 +00205 IF NOT L981-OK-88 CL*40 +00206 DISPLAY ' OPEN WWGH VSAM FAILED ' WWGH-KEY-AREA CL*44 +00207 PERFORM S999-ABEND THRU S999-EXIT. CL*40 +00208 CL*40 +00209 PERFORM S982O-OPEN-READ THRU S982O-EXIT. CL*33 +00210 IF NOT L982-OK-88 CL*44 +00211 DISPLAY ' OPEN NAME VSAM FAILED ' CL*44 +00212 PERFORM S999-ABEND THRU S999-EXIT. CL*44 +00213 CL*44 +00214 DTSBX468 +00215 MOVE ZEROS TO COUNTERS. DTSBX468 +00216 MOVE ZERO TO WRK-BEGIN-DATE DTSBX468 +00217 WRK-END-DATE. DTSBX468 +00218 DTSBX468 +00219 MAIN0100-INITIATE. DTSBX468 +00220 ACCEPT SELECT-CARD. DTSBX468 +00221 DISPLAY ' '. DTSBX468 +00222 DISPLAY ' ' SELECT-CARD. DTSBX468 +00223 DISPLAY ' '. DTSBX468 +00224 DISPLAY ' PROGRAM ' PRG-NAME. DTSBX468 +00225 DISPLAY ' FROM-DATE ' FROM-ACTIVITY-DATE. DTSBX468 +00226 DISPLAY ' TO-DATE ' TO-ACTIVITY-DATE. DTSBX468 +00227 DISPLAY ' DC GOVT ' DCGOVT DTSBX468 +00228 DISPLAY ' FED GOVT ' FEDGOVT DTSBX468 +00229 DISPLAY ' BUSINESS ' BUSINESS DTSBX468 +00230 DISPLAY ' '. DTSBX468 +00231 DISPLAY ' '. DTSBX468 +00232 DTSBX468 +00233 IF (FROM-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX468 +00234 AND (TO-ACTIVITY-DATE = SPACES OR LOW-VALUES) DTSBX468 +00235 PERFORM INIT0300-DEFAULT-DATES THRU INIT0300-EXIT DTSBX468 +00236 ELSE DTSBX468 +00237 PERFORM INIT0100-BEGIN-DATE THRU INIT0100-EXIT DTSBX468 +00238 PERFORM INIT0200-END-DATE THRU INIT0200-EXIT. DTSBX468 +00239 DTSBX468 +00240 IF WRK-END-DATE < WRK-BEGIN-DATE DTSBX468 +00241 MOVE 'PERIOD END LESS THAN PERIOD BEGIN' DTSBX468 +00242 TO ABEND-MSG DTSBX468 +00243 PERFORM S999-ABEND THRU S999-EXIT. DTSBX468 +00244 DTSBX468 +00245 MOVE WRK-BEGIN-DATE TO WRK-BEGIN-DATE-DISP. DTSBX468 +00246 MOVE WRK-END-DATE TO WRK-END-DATE-DISP. DTSBX468 +00247 DISPLAY ' '. DTSBX468 +00248 DISPLAY ' DEFAULT FROM DATE - ' WRK-BEGIN-DATE-DISP. CL*34 +00249 DISPLAY ' DEFAULT TO-DATE - ' WRK-END-DATE-DISP. CL*34 +00250 DISPLAY ' '. DTSBX468 +00251 DTSBX468 +00252 PERFORM P0000-PROCESS THRU P0000-EXIT. CL*34 +00253 PERFORM P9999-TERMINATE THRU P9999-EXIT. CL*34 +00254 STOP RUN. CL*35 +00255 DTSBX468 +00256 INIT0100-BEGIN-DATE. DTSBX468 +00257 MOVE FROM-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX468 +00258 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX468 +00259 IF L001-VALID-DATE DTSBX468 +00260 MOVE L001-FED-8-DATE-9 TO WRK-BEGIN-DATE DTSBX468 +00261 ELSE DTSBX468 +00262 MOVE 'INVALID PERIOD BEGIN DATE' TO ABEND-MSG DTSBX468 +00263 PERFORM S999-ABEND THRU S999-EXIT CL*35 +00264 END-IF. CL*31 +00265 DTSBX468 +00266 * MOVE WRK-BEGIN-DATE TO L004-DATE. CL*31 +00267 * PERFORM S004-FROM-DATE THRU S004-EXIT. CL*31 +00268 * IF WRK-BEGIN-DATE NOT = L004-QTR-START-DATE CL*31 +00269 * MOVE 'PERIOD BEGIN NOT START OF QTR' CL*31 +00270 * TO ABEND-MSG CL*31 +00271 * PERFORM S999-ABEND THRU S999-EXIT CL*31 +00272 DTSBX468 +00273 INIT0100-EXIT. DTSBX468 +00274 EXIT. DTSBX468 +00275 DTSBX468 +00276 INIT0200-END-DATE. DTSBX468 +00277 MOVE TO-ACTIVITY-DATE TO L001-FED-8-DATE-X. DTSBX468 +00278 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX468 +00279 IF L001-VALID-DATE DTSBX468 +00280 MOVE L001-FED-8-DATE-9 TO WRK-END-DATE DTSBX468 +00281 ELSE DTSBX468 +00282 MOVE 'INVALID PERIOD END DATE' TO ABEND-MSG DTSBX468 +00283 PERFORM S999-ABEND THRU S999-EXIT. DTSBX468 +00284 DTSBX468 +00285 * MOVE WRK-END-DATE TO L004-DATE. CL*31 +00286 * PERFORM S004-FROM-DATE THRU S004-EXIT. CL*31 +00287 * IF WRK-END-DATE NOT = L004-QTR-END-DATE CL*31 +00288 * DISPLAY ' END DT ' L004-QTR-END-DATE CL*31 +00289 * MOVE 'PERIOD END NOT END OF QTR' CL*31 +00290 * TO ABEND-MSG CL*31 +00291 * PERFORM S999-ABEND THRU S999-EXIT CL*31 +00292 * END-IF. CL*31 +00293 DTSBX468 +00294 INIT0200-EXIT. DTSBX468 +00295 EXIT. DTSBX468 +00296 DTSBX468 +00297 INIT0300-DEFAULT-DATES. DTSBX468 +00298 DTSBX468 +00299 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX468 +00300 MOVE +0 TO MSKL-EMP-NO. DTSBX468 +00301 SET MSKL-HDR-88 TO TRUE. DTSBX468 +00302 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. DTSBX468 +00303 DTSBX468 +00304 IF L910-NO-REC-88 DTSBX468 +00305 MOVE 'MHDR RECORD IS MISSING' DTSBX468 +00306 TO ABEND-MSG DTSBX468 +00307 PERFORM S999-ABEND THRU S999-EXIT. DTSBX468 +00308 DTSBX468 +00309 MOVE MSKL-REC TO MHDR-REC. DTSBX468 +00310 DTSBX468 +00311 MOVE MHDR-CMPL-QTR-BEGIN-DATE DTSBX468 +00312 TO WRK-BEGIN-DATE. DTSBX468 +00313 MOVE MHDR-CMPL-QTR-END-DATE DTSBX468 +00314 TO WRK-END-DATE. DTSBX468 +00315 DTSBX468 +00316 MOVE WRK-BEGIN-DATE TO FROM-ACTIVITY-DATE. DTSBX468 +00317 MOVE WRK-END-DATE TO TO-ACTIVITY-DATE. DTSBX468 +00318 DTSBX468 +00319 INIT0300-EXIT. DTSBX468 +00320 EXIT. DTSBX468 +00321 DTSBX468 +00322 P0000-PROCESS. CL*33 +00323 * DISPLAY 'P0000 PROCESSED '. CL*49 +00324 * DISPLAY ' WWGH KEY AREA' WWGH-KEY-AREA. CL*49 +00325 MOVE LOW-VALUES TO WWGH-KEY-AREA. CL*41 +00326 CL*33 +00327 MOVE 010021 TO WWGH-EMP-NO. CL*33 +00328 MOVE 20191 TO WWGH-YRQ. CL*33 +00329 MOVE 000000000 TO WWGH-SSN. CL*42 +00330 CL*33 +00331 * DISPLAY ' BEFORE BROWSE ********* ' WWGH-KEY-AREA CL*49 +00332 PERFORM S981X-START-BROWSE THRU S981X-EXIT. CL*43 +00333 * DISPLAY ' AFTER BROWSE ********* ' WWGH-KEY-AREA CL*49 +00334 IF NOT L981-OK-88 CL*43 +00335 DISPLAY ' BROWSE FAILED ********* ' WWGH-KEY-AREA CL*43 +00336 PERFORM S999-ABEND THRU S999-EXIT. CL*43 +00337 CL*33 +00338 * PERFORM S981C-READ THRU S981C-EXIT. CL*43 +00339 * IF NOT L981-OK-88 CL*43 +00340 * DISPLAY ' READ FAILED ********* ' WWGH-KEY-AREA CL*43 +00341 * PERFORM S999-ABEND THRU S999-EXIT. CL*43 +00342 CL*33 +00343 PERFORM P1000-FIND-QTR-WAGE THRU P1000-EXIT CL*33 +00344 UNTIL L981-NO-REC-88. CL*34 +00345 P0000-EXIT. CL*33 +00346 EXIT. DTSBX468 +00347 DTSBX468 +00348 P1000-FIND-QTR-WAGE. CL*33 +00349 ********************************************************** DTSBX468 +00350 * ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS DTSBX468 +00351 ******* ************************************************** DTSBX468 +00352 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. DTSBX468 +00353 ADD 1 TO RECS-IN. CL*33 +00354 IF WWGH-CHNG-DATE NOT LESS THAN FROM-ACTIVITY-DATE CL*33 +00355 AND DTSBX468 +00356 WWGH-CHNG-DATE NOT GREATER THAN TO-ACTIVITY-DATE CL*33 +00357 NEXT SENTENCE CL*33 +00358 ELSE CL*33 +00359 GO TO P1000-CONTINUE. CL*33 +00360 DTSBX468 +00361 * IF WWGH-CHNG-DATE > 20240227 CL*49 +00362 * DISPLAY 'FEB WAGES WWGH : ' WWGH-EMP-NO. CL*49 +00363 CL*45 +00364 MOVE WWGH-EMP-NO TO EMP-ACCT-HOLD. CL*33 +00365 MOVE EMP-ACCT-HOLD TO EMP-ACCT-HOLD-RED. DTSBX468 +00366 DTSBX468 +00367 DTSBX468 +00368 PERFORM P4000-FEIN-LOOK-UP THRU P4000-EXIT. CL*33 +00369 DTSBX468 +00370 IF L910-NO-REC-88 DTSBX468 +00371 DISPLAY 'ACCT NOT IN DTS: ' WWGH-EMP-NO CL*33 +00372 GO TO P1000-CONTINUE. CL*33 +00373 DTSBX468 +00374 PERFORM P2000-WRITE-QTR-WAGES THRU P2000-EXIT. CL*33 +00375 * IF DCGOVT = 'DCG' CL*22 +00376 * IF EMP-ACCT-HOLD = 998888 CL*22 +00377 * PERFORM 050-WRITE-GOVERNMENT-ACCOUNTS THRU 050-W-G-A-EXT CL*18 +00378 * PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*22 +00379 * GO TO S-2-D-EX. CL*22 +00380 DTSBX468 +00381 * IF FEDGOVT = 'FED' CL*22 +00382 * IF ACCT-THREE-RED = 000 CL*22 +00383 * PERFORM 025-WRITE-FEDERAL-ACCOUNTS THRU 025-W-F-A-EXT CL*18 +00384 * PERFORM 100-WRITE-BUSINESS-ACCOUNTS THRU 100-W-B-A-EXT. CL*22 +00385 * GO TO S-2-D-EX. CL*22 +00386 DTSBX468 +00387 DTSBX468 +00388 P1000-CONTINUE. CL*33 +00389 DTSBX468 +00390 PERFORM S981C2-READ-NEXT THRU S981C2-EXIT. CL*33 +00391 P1000-EXIT. CL*33 +00392 EXIT. CL*33 +00393 CL*33 +00394 P2000-WRITE-QTR-WAGES. CL*33 +00395 DTSBX468 +00396 ADD 1 TO BUSINESS-WAGES. DTSBX468 +00397 MOVE WWGH-SSN TO EMPLOYEE-SSN. CL*33 +00398 MOVE WWGH-YRQ TO WRK-YEAR-QUARTER. CL*33 +00399 * DISPLAY 'YRQ ' WRK-YEAR-QUARTER. CL*48 +00400 MOVE WRK-YEAR-YR TO REPORTING-PERIOD-CCYY. CL*18 +00401 MOVE WRK-YEAR-Q TO REPORTING-PERIOD-Q. CL*18 +00402 MOVE WWGH-EMP-NO TO EMPLOYER-STATE-TAX-ID. CL*50 +00403 MOVE WWGH-EARNINGS TO EMPLOYEE-DOLLARS. CL*33 +00404 MOVE ZEROS TO EMPLOYEE-CENTS. CL*18 +00405 * MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE. CL*18 +00406 MOVE FEDERAL-ID-NUMBER-WS TO EMPLOYER-FEIN. CL*18 +00407 CL*41 +00408 MOVE SPACES TO WRK-NAME. CL*18 +00409 MOVE LOW-VALUE TO WNAM-REC. CL*18 +00410 MOVE WWGH-SSN TO WNAM-SSN WRK-SSN. CL*33 +00411 CL*18 +00412 PERFORM P3000-READ-NAME THRU P3000-EXIT. CL*33 +00413 CL*33 +00414 MOVE WRK-LNAME TO EMPLOYEE-LAST-NAME CL*18 +00415 MOVE WRK-FNAME TO EMPLOYEE-FIRST-NAME CL*18 +00416 MOVE WRK-INAME TO EMPLOYEE-MIDDLE-NAME CL*21 +00417 CL*33 +00418 PERFORM P2500-READ-MTAD THRU P2500-EXIT. CL*33 +00419 CL*33 +00420 WRITE WAGE-REC FROM NDNH-LINK-AREA. CL*23 +00421 MOVE SPACES TO WAGE-REC. CL*18 +00422 * DISPLAY 'FEIN ' EMPLOYER-FEIN ' SSN ' EMPLOYEE-SSN. CL*33 +00423 DTSBX468 +00424 * IF BUSINESS-WAGES > 10 CL*48 +00425 * GO TO P9999-TERMINATE. CL*48 +00426 P2000-EXIT. CL*33 +00427 EXIT. DTSBX468 +00428 CL*33 +00429 CL*33 +00430 P4000-FEIN-LOOK-UP. CL*33 +00431 DTSBX468 +00432 MOVE ZEROS TO FEDERAL-ID-NUMBER-WS. DTSBX468 +00433 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX468 +00434 DTSBX468 +00435 MOVE WWGH-EMP-NO TO MSKL-EMP-NO. CL*33 +00436 SET MSKL-PRF-88 TO TRUE. CL*14 +00437 * SET L910-READ-88 TO TRUE. CL*14 +00438 DTSBX468 +00439 * PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. CL*14 +00440 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT CL*14 +00441 DTSBX468 +00442 IF L910-NO-REC-88 DTSBX468 +00443 DISPLAY 'ACCT NOT IN DTS: ' WWGH-EMP-NO CL*33 +00444 GO TO P4000-EXIT. CL*33 +00445 DTSBX468 +00446 MOVE MSKL-REC TO MPRF-REC. DTSBX468 +00447 DTSBX468 +00448 * IF MPRF-STATUS-ACT-88 CL*15 +00449 * NEXT SENTENCE CL*15 +00450 * ELSE CL*15 +00451 * DISPLAY ' ACCT NOT ACTIVE ' MPRF-FEIN CL*15 +00452 * SET L910-NO-REC-88 TO TRUE CL*15 +00453 * GO TO 110-FLU-EXIT. CL*15 +00454 DTSBX468 +00455 MOVE MPRF-FEIN TO FEDERAL-ID-NUMBER-WS. DTSBX468 +00456 MOVE MPRF-PRIMARY-NAME TO EMPLOYER-NAME. CL*18 +00457 * IF MPRF-EMP-NO = 998888 CL*45 +00458 * DISPLAY ' DCGOV ID ' FEDERAL-ID-NUMBER-WS CL*45 +00459 * ' ' EMPLOYER-NAME. CL*45 +00460 P4000-EXIT. CL*33 +00461 EXIT. DTSBX468 +00462 CL*18 +00463 P2500-READ-MTAD. CL*33 +00464 MOVE LOW-VALUE TO MTAD-REC. CL*18 +00465 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. CL*18 +00466 SET MTAD-TAD-88 TO TRUE. CL*18 +00467 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. CL*18 +00468 CL*18 +00469 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. CL*18 +00470 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. CL*20 +00471 IF L910-NO-REC-88 CL*18 +00472 GO TO P2500-EXIT. CL*33 +00473 CL*18 +00474 MOVE MSKL-REC TO MTAD-REC. CL*18 +00475 MOVE MTAD-ATTN-LINE TO EMPLOYER-STREET-ADDRESS1 CL*18 +00476 MOVE MTAD-DELIV-LINE-1 TO EMPLOYER-STREET-ADDRESS2 CL*18 +00477 MOVE MTAD-DELIV-LINE-2 TO EMPLOYER-STREET-ADDRESS3 CL*18 +00478 MOVE MTAD-CITY TO EMPLOYER-CITY CL*18 +00479 MOVE MTAD-ST TO EMPLOYER-STATE CL*18 +00480 MOVE MTAD-ZIP TO WRK-ZIP CL*18 +00481 MOVE WRK-ZIPA TO EMPLOYER-ZIP-CODE CL*18 +00482 MOVE WRK-ZIPB TO EMPLOYER-ZIP4. CL*18 +00483 * CL*18 +00484 MOVE LOW-VALUE TO MTAD-REC. CL*18 +00485 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. CL*18 +00486 SET MTAD-TAD-88 TO TRUE. CL*18 +00487 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. CL*18 +00488 CL*18 +00489 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. CL*18 +00490 PERFORM 115-S910-READ THRU 115-S910-READ-EXIT. CL*20 +00491 IF L910-NO-REC-88 CL*18 +00492 MOVE SPACES TO OPTIONAL-STREET-ADDRESS1 CL*44 +00493 OPTIONAL-STREET-ADDRESS2 CL*44 +00494 OPTIONAL-STREET-ADDRESS3 CL*44 +00495 OPTIONAL-CITY CL*44 +00496 OPTIONAL-STATE CL*44 +00497 WRK-ZIP CL*44 +00498 OPTIONAL-ZIP-CODE CL*44 +00499 OPTIONAL-ZIP4 CL*44 +00500 GO TO P2500-EXIT. CL*33 +00501 DTSBX468 +00502 CL*18 +00503 MOVE MSKL-REC TO MTAD-REC. CL*18 +00504 MOVE MTAD-ATTN-LINE TO OPTIONAL-STREET-ADDRESS1 CL*18 +00505 MOVE MTAD-DELIV-LINE-1 TO OPTIONAL-STREET-ADDRESS2 CL*18 +00506 MOVE MTAD-DELIV-LINE-2 TO OPTIONAL-STREET-ADDRESS3 CL*18 +00507 MOVE MTAD-CITY TO OPTIONAL-CITY CL*18 +00508 MOVE MTAD-ST TO OPTIONAL-STATE CL*18 +00509 MOVE MTAD-ZIP TO WRK-ZIP CL*18 +00510 MOVE WRK-ZIPA TO OPTIONAL-ZIP-CODE CL*18 +00511 MOVE WRK-ZIPB TO OPTIONAL-ZIP4. CL*18 +00512 * CL*18 +00513 P2500-EXIT. CL*33 +00514 EXIT. CL*18 +00515 CL*18 +00516 114-S910-OPEN-READ. DTSBX468 +00517 SET L910-OPEN-READ-88 TO TRUE. DTSBX468 +00518 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX468 +00519 114-S910-OPEN-READ-EXIT. DTSBX468 +00520 EXIT. DTSBX468 +00521 DTSBX468 +00522 115-S910-READ. DTSBX468 +00523 SET L910-READ-88 TO TRUE. DTSBX468 +00524 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX468 +00525 115-S910-READ-EXIT. DTSBX468 +00526 EXIT. DTSBX468 +00527 DTSBX468 +00528 116-S910-CLOSE. DTSBX468 +00529 SET L910-CLOSE-88 TO TRUE. DTSBX468 +00530 PERFORM 120-READ-MPRF THRU 120-READ-MPRF-EXIT. DTSBX468 +00531 116-S910-CLOSE-EXIT. DTSBX468 +00532 EXIT. DTSBX468 +00533 DTSBX468 +00534 120-READ-MPRF. DTSBX468 +00535 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX468 +00536 MSKL-REC. DTSBX468 +00537 120-READ-MPRF-EXIT. DTSBX468 +00538 EXIT. DTSBX468 +00539 CL**2 +00540 P3000-READ-NAME. CL*33 +00541 ******************************************************************DTSBX468 +00542 * SEARCH FOR NAME ON WAGE NAME FILE * CL**2 +00543 ******************************************************************DTSBX468 +00544 CL**2 +00545 PERFORM S982A-START-BROWSE THRU S982A-EXIT. CL**2 +00546 CL**2 +00547 IF NOT L982-OK-88 CL**2 +00548 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN CL**2 +00549 GO TO P3000-EXIT CL*33 +00550 END-IF. CL**2 +00551 CL**2 +00552 MOVE WNAM-SSN TO W-SSN. CL**2 +00553 CL**2 +00554 IF WRK-SSN = W-SSN CL**2 +00555 MOVE WNAM-LAST-NAME TO WRK-LNAME CL**3 +00556 MOVE WNAM-FIRST-NAME TO WRK-FNAME CL**3 +00557 MOVE WNAM-MID-INIT TO WRK-INAME CL**3 +00558 ELSE CL**2 +00559 DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN. CL**2 +00560 P3000-EXIT. CL*33 +00561 EXIT. CL**2 +00562 ****************************************************************** CL**2 +00563 * TERMINATION ROUTINE * CL**2 +00564 ****************************************************************** CL**2 +00565 P9999-TERMINATE. CL*33 +00566 CL*28 +00567 MOVE BUSINESS-WAGES TO TRAILER-RECORD-COUNT. CL*28 +00568 WRITE WAGE-REC FROM TRAILER-RECORD. CL*28 +00569 CLOSE WAGE-FILE. CL*18 +00570 DTSBX468 +00571 DTSBX468 +00572 PERFORM 116-S910-CLOSE THRU 116-S910-CLOSE-EXIT. DTSBX468 +00573 DTSBX468 +00574 PERFORM S981D-CLOSE THRU S981D-EXIT. CL*33 +00575 PERFORM S982F-CLOSE THRU S982F-EXIT. CL*33 +00576 CL*33 +00577 DISPLAY 'TOTAL WWGH RECORDS READ *** = ' RECS-IN. CL*33 +00578 DISPLAY ' ' . DTSBX468 +00579 DISPLAY 'TOTAL QTR WAGE RECORDS WRITTEN = ' BUSINESS-WAGES. CL*33 +00580 DISPLAY ' ' . DTSBX468 +00581 P9999-EXIT. CL*33 +00582 EXIT. DTSBX468 +00583 EJECT DTSBX468 +00584 ******************************************************************DTSBX468 +00585 * SERVICE ROUTINES *DTSBX468 +00586 ******************************************************************DTSBX468 +00587 DTSBX468 +00588 S001-FROM-CAL-6. DTSBX468 +00589 SET L001-FROM-CAL-6 TO TRUE. DTSBX468 +00590 GO TO S001-DATE. DTSBX468 +00591 DTSBX468 +00592 S001-FROM-FED-8. DTSBX468 +00593 SET L001-FROM-FED-8 TO TRUE. DTSBX468 +00594 GO TO S001-DATE. DTSBX468 +00595 DTSBX468 +00596 S001-FROM-ABS. DTSBX468 +00597 SET L001-FROM-ABS-DAY TO TRUE. DTSBX468 +00598 GO TO S001-DATE. DTSBX468 +00599 DTSBX468 +00600 S001-DATE. DTSBX468 +00601 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX468 +00602 S001-EXIT. DTSBX468 +00603 EXIT. DTSBX468 +00604 DTSBX468 +00605 S004-FROM-DATE. DTSBX468 +00606 SET L004-FROM-DATE TO TRUE. DTSBX468 +00607 GO TO S004-YRQ. DTSBX468 +00608 DTSBX468 +00609 S004-YRQ. DTSBX468 +00610 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX468 +00611 S004-EXIT. DTSBX468 +00612 EXIT. DTSBX468 +00613 S981A-OPEN-UPDATE. CL*32 +00614 SET L981-OPEN-UPDATE-88 TO TRUE. CL*32 +00615 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 +00616 CL*32 +00617 S981A-EXIT. CL*32 +00618 EXIT. CL*32 +00619 CL*32 +00620 S981A1-OPEN-READ. CL*36 +00621 SET L981-OPEN-READ-88 TO TRUE. CL*33 +00622 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*33 +00623 CL*33 +00624 S981A1-EXIT. CL*33 +00625 EXIT. CL*33 +00626 CL*33 +00627 S981B-WRITE. CL*32 +00628 SET L981-WRITE-88 TO TRUE. CL*32 +00629 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 +00630 CL*32 +00631 S981B-EXIT. CL*32 +00632 EXIT. CL*32 +00633 S981C-READ. CL*32 +00634 SET L981-READ-88 TO TRUE. CL*32 +00635 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 +00636 CL*32 +00637 S981C-EXIT. CL*32 +00638 EXIT. CL*32 +00639 S981X-START-BROWSE. CL*43 +00640 DISPLAY ' STARTING BROWSE' CL*43 +00641 SET L981-START-BROWSE-88 TO TRUE. CL*33 +00642 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*33 +00643 DISPLAY ' BROWSE COMPLETE'. CL*43 +00644 CL*33 +00645 S981X-EXIT. CL*43 +00646 EXIT. CL*33 +00647 S981C2-READ-NEXT. CL*33 +00648 SET L981-READ-NEXT-88 TO TRUE. CL*33 +00649 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*33 +00650 CL*33 +00651 S981C2-EXIT. CL*33 +00652 EXIT. CL*33 +00653 S981E-DELETE. CL*32 +00654 SET L981-DELETE-88 TO TRUE. CL*32 +00655 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 +00656 CL*32 +00657 S981E-EXIT. CL*32 +00658 EXIT. CL*32 +00659 CL*32 +00660 S981D-CLOSE. CL*32 +00661 SET L981-CLOSE-88 TO TRUE. CL*32 +00662 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*32 +00663 CL*32 +00664 S981D-EXIT. CL*32 +00665 EXIT. CL*32 +00666 S981Z-WWGH-IO. CL*32 +00667 CALL 'DTSBU981' USING L981-LINK-AREA CL*32 +00668 WWGH-REC. CL*32 +00669 S981Z-EXIT. CL*32 +00670 EXIT. CL*32 +00671 CL*32 +00672 CL*32 +00673 S982O-OPEN-READ. CL**5 +00674 SET L982-OPEN-READ-88 TO TRUE. CL**5 +00675 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00676 CL**3 +00677 S982O-EXIT. CL**3 +00678 EXIT. CL**3 +00679 CL**3 +00680 S982A-START-BROWSE. CL**3 +00681 SET L982-START-BROWSE-88 TO TRUE. CL**3 +00682 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00683 CL**3 +00684 S982A-EXIT. CL**3 +00685 EXIT. CL**3 +00686 S982B-READ-NEXT. CL**3 +00687 SET L982-READ-NEXT-88 TO TRUE. CL**3 +00688 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00689 CL**3 +00690 S982B-EXIT. CL**3 +00691 EXIT. CL**3 +00692 S982C-WRITE. CL**3 +00693 SET L982-WRITE-88 TO TRUE. CL**3 +00694 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00695 CL**3 +00696 S982C-EXIT. CL**3 +00697 EXIT. CL**3 +00698 CL**3 +00699 S982D-REWRITE. CL**3 +00700 SET L982-REWRITE-88 TO TRUE. CL**3 +00701 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00702 S982D-EXIT. CL**3 +00703 EXIT. CL**3 +00704 S982F-CLOSE. CL**3 +00705 SET L982-CLOSE-88 TO TRUE. CL**3 +00706 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. CL**3 +00707 CL**3 +00708 S982F-EXIT. CL**3 +00709 EXIT. CL**3 +00710 CL**3 +00711 S982Z-WNAM-IO. CL**3 +00712 CALL 'DTSBU982' USING L982-LINK-AREA CL**3 +00713 WNAM-REC. CL**3 +00714 S982Z-EXIT. CL**3 +00715 EXIT. CL**3 +00716 CL**3 +00717 DTSBX468 +00718 S999-ABEND. DTSBX468 +00719 DISPLAY '**** DTSBX465 ABENDING ' DTSBX468 +00720 ABEND-MSG. DTSBX468 +00721 CALL ABEND-MOD USING ABEND-CODE. DTSBX468 +00722 DTSBX468 +00723 S999-EXIT. DTSBX468 +00724 EXIT. DTSBX468 +00725 DTSBX468 diff --git a/Batch/DTSBX469.cob b/Batch/DTSBX469.cob new file mode 100644 index 0000000..c699b00 --- /dev/null +++ b/Batch/DTSBX469.cob @@ -0,0 +1,230 @@ +00001 IDENTIFICATION DIVISION. 07/13/10 +00002 PROGRAM-ID. DTSBX469. DTSBX469 +00003 LV001 +00004 ******************************************************************DTSBX469 +00005 * *DTSBX469 +00006 * *DTSBX469 +00007 * FUNCTION: *DTSBX469 +00008 * *DTSBX469 +00009 * THE FUNCTION OF DTSBX465 IS TO GENERATE A UI WAGE *DTSBX469 +00010 * FILE OF UI WAGES UPDATED TO THE UI WAGE FILE ON A GIVEN *DTSBX469 +00011 * DATE. *DTSBX469 +00012 * THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE. *DTSBX469 +00013 * *DTSBX469 +00014 * *DTSBX469 +00015 * *DTSBX469 +00016 * G.A.BROWN *DTSBX469 +00017 ******************************************************************DTSBX469 +00018 ***** DTSBX469 +00019 DTSBX469 +00020 ENVIRONMENT DIVISION. DTSBX469 +00021 CONFIGURATION SECTION. DTSBX469 +00022 INPUT-OUTPUT SECTION. DTSBX469 +00023 FILE-CONTROL. DTSBX469 +00024 SELECT WAGE-FILE ASSIGN TO UT-S-WAGE. DTSBX469 +00025 DATA DIVISION. DTSBX469 +00026 FILE SECTION. DTSBX469 +00027 DTSBX469 +00028 FD WAGE-FILE DTSBX469 +00029 RECORDING MODE IS F DTSBX469 +00030 LABEL RECORD ARE STANDARD DTSBX469 +00031 RECORD CONTAINS 59 CHARACTERS DTSBX469 +00032 BLOCK CONTAINS 0 RECORDS DTSBX469 +00033 DATA RECORD IS WAGE-REC. DTSBX469 +00034 DTSBX469 +00035 01 WAGE-REC. DTSBX469 +00036 03 EMPLOYEE-SSN PIC 9(9). DTSBX469 +00037 03 EMPLOYEE-LAST-NAME PIC X(3). DTSBX469 +00038 03 FIL PIC 9(3). DTSBX469 +00039 03 EMPLOYER-ACCT-NUM PIC 9(6). DTSBX469 +00040 03 FIL PIC 9(3). DTSBX469 +00041 03 EMPLOYEE-WAGES PIC 9(7). DTSBX469 +00042 03 FIL PIC 9(3). DTSBX469 +00043 03 CEN-YEAR-QUARTER PIC 9(5). DTSBX469 +00044 03 FIL PIC 9(3). DTSBX469 +00045 03 WAGE-UPDATE-DATE PIC 9(8). DTSBX469 +00046 03 FIL PIC 9(9). DTSBX469 +00047 DTSBX469 +00048 DTSBX469 +00049 ******************************************************************DTSBX469 +00050 * WORKING STORAGE SECTION *DTSBX469 +00051 ******************************************************************DTSBX469 +00052 WORKING-STORAGE SECTION. DTSBX469 +000525 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX469 07/13/10'. DTSBX469 +00053 DTSBX469 +00054 DTSBX469 +00055 01 COUNTERS. DTSBX469 +00056 03 STOP-RECS PIC 9(5). DTSBX469 +00057 03 ALL-NINES PIC 9. DTSBX469 +00058 03 RECS-IN PIC 9(9). DTSBX469 +00059 03 RECS-OUT PIC 9(9). DTSBX469 +00060 DTSBX469 +00061 03 WRK-ACCEPTED-DATE. DTSBX469 +00062 05 WRK-ACCEPTED-YR PIC 9(02). DTSBX469 +00063 05 WRK-ACCEPTED-MO PIC 9(02). DTSBX469 +00064 05 WRK-ACCEPTED-DD PIC 9(02). DTSBX469 +00065 DTSBX469 +00066 03 WRK-ACCEPTED-DATE-RED. DTSBX469 +00067 05 WRK-ACCEPTED-CEN-RED PIC 9(02). DTSBX469 +00068 05 WRK-ACCEPTED-YR-RED PIC 9(02). DTSBX469 +00069 05 WRK-ACCEPTED-MO-RED PIC 9(02). DTSBX469 +00070 05 WRK-ACCEPTED-DD-RED PIC 9(02). DTSBX469 +00071 DTSBX469 +00072 DTSBX469 +00073 03 WRK-END-DATE-DISP PIC 9(08). DTSBX469 +00074 03 FILLER REDEFINES WRK-END-DATE-DISP. DTSBX469 +00075 05 WRK-END-YR PIC 9(04). DTSBX469 +00076 05 WRK-END-MO PIC 9(02). DTSBX469 +00077 05 WRK-END-DA PIC 9(02). DTSBX469 +00078 DTSBX469 +00079 01 WRK-ACCEPTED-DATE-WS PIC 9(8). DTSBX469 +00080 01 BLANK-LINE PIC X(80) VALUE SPACE. DTSBX469 +00081 01 WRK-RECS-OUT. DTSBX469 +00082 03 FIL PIC X(13) VALUE 'RECS UPDATED:'. DTSBX469 +00083 03 FIL PIC XXX VALUE SPACES. DTSBX469 +00084 03 WRK-RECS-OUT-WS PIC 9(9). DTSBX469 +00085 03 FIL PIC X(56) VALUE SPACE. DTSBX469 +00086 DTSBX469 +00087 01 COMMON-LINKAGE-SECTION. DTSBX469 +00088 ++INCLUDE EWGLINKB DTSBX469 +00089 EJECT DTSBX469 +00090 EJECT DTSBX469 +00091 ******************************************************************DTSBX469 +00092 * PROCEDURE DIVISION - CONTROL PROCEDURE *DTSBX469 +00093 ******************************************************************DTSBX469 +00094 PROCEDURE DIVISION. DTSBX469 +00095 BEGIN00000. DTSBX469 +00096 OPEN OUTPUT WAGE-FILE. DTSBX469 +00097 MOVE LOW-VALUE TO VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX469 +00098 DTSBX469 +00099 ACCEPT WRK-ACCEPTED-DATE FROM DATE. DTSBX469 +00100 DTSBX469 +00101 DISPLAY 'CURRENT DATE ' WRK-ACCEPTED-DATE. DTSBX469 +00102 DTSBX469 +00103 MOVE WRK-ACCEPTED-YR TO WRK-ACCEPTED-YR-RED. DTSBX469 +00104 MOVE WRK-ACCEPTED-MO TO WRK-ACCEPTED-MO-RED. DTSBX469 +00105 MOVE WRK-ACCEPTED-DD TO WRK-ACCEPTED-DD-RED. DTSBX469 +00106 MOVE 20 TO WRK-ACCEPTED-CEN-RED. DTSBX469 +00107 SUBTRACT 1 FROM WRK-ACCEPTED-DD-RED. DTSBX469 +00108 MOVE WRK-ACCEPTED-DATE-RED TO WRK-ACCEPTED-DATE-WS. DTSBX469 +00109 DTSBX469 +00110 DISPLAY 'YESTERDAY S DATE ' WRK-ACCEPTED-DATE-RED. DTSBX469 +00111 DTSBX469 +00112 PERFORM SERV2001-RESET-MASTER THRU SERV2001-EXIT. DTSBX469 +00113 ** DTSBX469 +00114 DTSBX469 +00115 MOVE ZEROS TO COUNTERS. DTSBX469 +00116 PERFORM MAIN0200-PROCESS-WAGE THRU MAIN0200-EX DTSBX469 +00117 UNTIL DTSBX469 +00118 DBW-END-OF-FILE. DTSBX469 +00119 ******************************************************************DTSBX469 +00120 * TERMINATION ROUTINE *DTSBX469 +00121 ******************************************************************DTSBX469 +00122 TERM0100-CLOSE-FILES. DTSBX469 +00123 DTSBX469 +00124 WRITE WAGE-REC FROM BLANK-LINE. DTSBX469 +00125 MOVE RECS-OUT TO WRK-RECS-OUT-WS. DTSBX469 +00126 WRITE WAGE-REC FROM WRK-RECS-OUT. DTSBX469 +00127 CLOSE WAGE-FILE. DTSBX469 +00128 DTSBX469 +00129 MOVE 'C' TO DBW-COMMAND-CODE. DTSBX469 +00130 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX469 +00131 DTSBX469 +00132 DTSBX469 +00133 DISPLAY 'NUMBER RECORDS READ *** ' RECS-IN. DTSBX469 +00134 DISPLAY ' ' . DTSBX469 +00135 DISPLAY 'NUMBER RECORDS WRITTEN *** ' RECS-OUT. DTSBX469 +00136 STOP RUN. DTSBX469 +00137 TERM0100-EXIT. DTSBX469 +00138 EXIT. DTSBX469 +00139 DTSBX469 +00140 MAIN0200-PROCESS-WAGE. DTSBX469 +00141 DTSBX469 +00142 MOVE 'S' TO DBW-PROCESSING-MODE. DTSBX469 +00143 MOVE 'SG01' TO DBW-SEGNAME. DTSBX469 +00144 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX469 +00145 DTSBX469 +00146 IF DBW-END-OF-FILE DTSBX469 +00147 GO TO MAIN0200-EX. DTSBX469 +00148 DTSBX469 +00149 ADD 1 TO RECS-IN. DTSBX469 +00150 PERFORM LOCATE-WAGE THRU L-W-EX DTSBX469 +00151 UNTIL DBW-NO-RECORD-FOUND. DTSBX469 +00152 DTSBX469 +00153 MAIN0200-EX. DTSBX469 +00154 EXIT. DTSBX469 +00155 DTSBX469 +00156 LOCATE-WAGE. DTSBX469 +00157 MOVE 'R' TO DBW-PROCESSING-MODE. DTSBX469 +00158 MOVE 'SG02' TO DBW-SEGNAME. DTSBX469 +00159 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX469 +00160 IF DBW-NO-RECORD-FOUND DTSBX469 +00161 GO TO L-W-EX. DTSBX469 +00162 PERFORM SEGMENT-2-DATA THRU S-2-D-EX. DTSBX469 +00163 L-W-EX. DTSBX469 +00164 EXIT. DTSBX469 +00165 DTSBX469 +00166 SEGMENT-2-DATA. DTSBX469 +00167 ********************************************************** DTSBX469 +00168 * ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS DTSBX469 +00169 ******* ************************************************** DTSBX469 +00170 * IF WGP-SSN = 999999999 DTSBX469 +00171 * MOVE 1 TO ALL-NINES DTSBX469 +00172 * GO TO S-2-D-EX. DTSBX469 +00173 DTSBX469 +00174 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. DTSBX469 +00175 DTSBX469 +00176 IF WGD-ACTIVITY-DATE = WRK-ACCEPTED-DATE-WS DTSBX469 +00177 NEXT SENTENCE ELSE DTSBX469 +00178 GO TO S-2-D-EX. DTSBX469 +00179 DTSBX469 +00180 * DISPLAY ' WGD-ACTIVITY-DATE' WGD-ACTIVITY-DATE. DTSBX469 +00181 * DISPLAY ' FROM-ACTIVITY-DATE' FROM-ACTIVITY-DATE. DTSBX469 +00182 * DISPLAY ' TO-ACTIVITY-DATE' TO-ACTIVITY-DATE. DTSBX469 +00183 DTSBX469 +00184 PERFORM 100-WRITE-ACCOUNTS THRU 100-W-B-A-EXT. DTSBX469 +00185 DTSBX469 +00186 GO TO S-2-D-EX. DTSBX469 +00187 DTSBX469 +00188 S-2-D-EX. DTSBX469 +00189 EXIT. DTSBX469 +00190 DTSBX469 +00191 100-WRITE-ACCOUNTS. DTSBX469 +00192 DTSBX469 +00193 ADD 1 TO RECS-OUT. DTSBX469 +00194 MOVE SPACES TO WAGE-REC. DTSBX469 +00195 MOVE WGP-SSN TO EMPLOYEE-SSN. DTSBX469 +00196 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER. DTSBX469 +00197 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM. DTSBX469 +00198 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES. DTSBX469 +00199 MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME. DTSBX469 +00200 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE. DTSBX469 +00201 WRITE WAGE-REC. DTSBX469 +00202 MOVE SPACES TO WAGE-REC. DTSBX469 +00203 DTSBX469 +00204 100-W-B-A-EXT. DTSBX469 +00205 EXIT. DTSBX469 +00206 EJECT DTSBX469 +00207 ******************************************************************DTSBX469 +00208 * SERVICE ROUTINES *DTSBX469 +00209 ******************************************************************DTSBX469 +00210 SERV1001-READ-MASTER. DTSBX469 +00211 MOVE 'R' TO DBW-COMMAND-CODE. DTSBX469 +00212 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX469 +00213 SERV1001-EXIT. DTSBX469 +00214 EXIT. DTSBX469 +00215 SERV2001-RESET-MASTER. DTSBX469 +00216 MOVE 'S' TO DBW-COMMAND-CODE. DTSBX469 +00217 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX469 +00218 SERV2001-EXIT. DTSBX469 +00219 EXIT. DTSBX469 +00220 SERV9001-ACCESS-DATABASE. DTSBX469 +00221 IF DBW-SEGNAME = 'SG01' DTSBX469 +00222 CALL 'EWG960D' DTSBX469 +00223 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX469 +00224 IF DBW-SEGNAME = 'SG02' DTSBX469 +00225 CALL 'EWG960D' DTSBX469 +00226 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX469 +00227 SERV9001-EXIT. DTSBX469 +00228 EXIT. DTSBX469 +00229 DTSBX469 diff --git a/Batch/DTSBX478.cob b/Batch/DTSBX478.cob new file mode 100644 index 0000000..fa6273d --- /dev/null +++ b/Batch/DTSBX478.cob @@ -0,0 +1,540 @@ +00001 IDENTIFICATION DIVISION. 11/14/24 +00002 PROGRAM-ID. DTSBX478. DTSBX478 +00003 AUTHOR. NGC. LV007 +00004 DATE-WRITTEN. DECEMBER 2012. DTSBX478 +00005 DATE-COMPILED. DTSBX478 +00006 SKIP3 DTSBX478 +00007 ***** DTSBX478 +00008 * DTSBX478 +00009 * ZUNCTION: DELETE WAGES TO WGH FILE FOR TESTING. DTSBX478 +00010 * FOR TAX WAGES SINCE UIBS 01/21/24 ZL1 DTSBX478 +00011 * DTSBX478 +00012 * DTSBX478 +00013 * MODIFICATION LOG: DTSBX478 +00014 * DTSBX478 +00015 * 12/06/2012 INITIAL DEVELOPMENT. DTSBX478 +00016 * WORK ORDER: PROGRAMMER: GD DTSBX478 +00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX478 +00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX478 +00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX478 +00020 * DTSBX478 +00021 * DTSBX478 +00022 * DESCRIPTION: DTSBX478 +00023 * DTSBX478 +00024 * DTSBX478 +00025 * DTSBX478 +00026 * DTSBX478 +00027 * DTSBX478 +00028 * DTSBX478 +00029 * DTSBX478 +00030 * DTSBX478 +00031 * DTSBX478 +00032 * DTSBX478 +00033 * DTSBX478 +00034 * GENERAL SPECIFICATIONS: DTSBX478 +00035 * DTSBX478 +00036 * ALL COMMANDS ARE VALID. DTSBX478 +00037 * DTSBX478 +00038 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSBX478 +00039 * MODULE. DTSBX478 +00040 * DTSBX478 +00041 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DTSBX478 +00042 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DTSBX478 +00043 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DTSBX478 +00044 * DTSBX478 +00045 * DTSBX478 +00046 * DTSBX478 +00047 * COMMAND SPECIFIC SPECIFICATIONS: DTSBX478 +00048 * DTSBX478 +00049 * OPEN-READ DTSBX478 +00050 * OPEN INPUT. DTSBX478 +00051 * DTSBX478 +00052 * OPEN-UPDATE DTSBX478 +00053 * OPEN I-O. DTSBX478 +00054 * DTSBX478 +00055 * CLOSE DTSBX478 +00056 * DTSBX478 +00057 * READ DTSBX478 +00058 * DTSBX478 +00059 * START BROWSE DTSBX478 +00060 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DTSBX478 +00061 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DTSBX478 +00062 * A RECORD. DTSBX478 +00063 * DTSBX478 +00064 * READ NEXT DTSBX478 +00065 * DTSBX478 +00066 * WRITE DTSBX478 +00067 * DTSBX478 +00068 * REWRITE DTSBX478 +00069 * DTSBX478 +00070 * DELETE DTSBX478 +00071 * DTSBX478 +00072 * DTSBX478 +00073 ***** DTSBX478 +00074 DTSBX478 +00075 ENVIRONMENT DIVISION. DTSBX478 +00076 DTSBX478 +00077 INPUT-OUTPUT SECTION. DTSBX478 +00078 DTSBX478 +00079 FILE-CONTROL. DTSBX478 +00080 SELECT W2GE-TRANS-FILE ASSIGN TO DTSFW2 CL**3 +00081 FILE STATUS IS WAGE-TRANS-STATUS. DTSBX478 +00082 DTSBX478 +00083 SELECT W4GE-TRANS-FILE ASSIGN TO DTSFW4 CL**3 +00084 FILE STATUS IS WAGE-TRANS-STATUS. CL**3 +00085 CL**5 +00086 SELECT UIBS-TRANS-FILE ASSIGN TO DTSFUIBS CL**5 +00087 FILE STATUS IS WAGE-TRANS-STATUS. CL**5 +00088 CL**3 +00089 * SELECT TAXWGH-FILE ASSIGN TO DTSXWGH DTSBX478 +00090 * FILE STATUS IS DOWNLOAD-STATUS. DTSBX478 +00091 DTSBX478 +00092 DATA DIVISION. DTSBX478 +00093 DTSBX478 +00094 FILE SECTION. DTSBX478 +00095 DTSBX478 +00096 FD W2GE-TRANS-FILE CL**3 +00097 RECORDING MODE IS F DTSBX478 +00098 BLOCK CONTAINS 0 RECORDS. DTSBX478 +00099 DTSBX478 +00100 01 W2GE-TRANS-REC PIC X(80). CL**3 +00101 DTSBX478 +00102 FD UIBS-TRANS-FILE CL**5 +00103 RECORDING MODE IS F CL**5 +00104 BLOCK CONTAINS 0 RECORDS. CL**5 +00105 CL**5 +00106 01 UIBS-TRANS-REC PIC X(80). CL**5 +00107 CL**5 +00108 CL**3 +00109 FD W4GE-TRANS-FILE CL**3 +00110 RECORDING MODE IS F CL**3 +00111 BLOCK CONTAINS 0 RECORDS. CL**3 +00112 CL**3 +00113 01 W4GE-TRANS-REC PIC X(80). CL**3 +00114 CL**3 +00115 *FD TAXWGH-FILE DTSBX478 +00116 * RECORDING MODE IS F DTSBX478 +00117 * BLOCK CONTAINS 0 RECORDS. DTSBX478 +00118 DTSBX478 +00119 *01 TAXWGH-REC PIC X(18). DTSBX478 +00120 DTSBX478 +00121 WORKING-STORAGE SECTION. DTSBX478 +001215 77 PAN-VALET PICTURE X(24) VALUE '007DTSBX478 11/14/24'. DTSBX478 +00122 SKIP3 DTSBX478 +00123 01 WRK-AREA. DTSBX478 +00124 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +480. DTSBX478 +00125 DTSBX478 +00126 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU480'. DTSBX478 +00127 DTSBX478 +00128 05 W-CURR-EMP-NO PIC S9(06) COMP-3 VALUE +0. DTSBX478 +00129 05 W-CURR-YRQ PIC S9(05) COMP-3 DTSBX478 +00130 VALUE +20121. DTSBX478 +00131 05 W-CURR-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBX478 +00132 05 W-CURR-ITEM PIC S9(03) COMP-3 VALUE +0. DTSBX478 +00133 05 W-MQTR-TOT-WAGE PIC S9(11)V99 COMP-3 DTSBX478 +00134 VALUE +0. DTSBX478 +00135 05 W-WTC-BATCH-NO PIC S9(05) COMP-3 DTSBX478 +00136 VALUE +90001. DTSBX478 +00137 05 W-WTC-ITEM-NO PIC S9(03) COMP-3 DTSBX478 +00138 VALUE +003. DTSBX478 +00139 05 W-WTC-SEQ-NO PIC S9(03) COMP-3 DTSBX478 +00140 VALUE +001. DTSBX478 +00141 05 W-MAX-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBX478 +00142 05 W-MIN-BATCH PIC S9(05) COMP-3 DTSBX478 +00143 VALUE +99999. DTSBX478 +00144 05 WRK-W2-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX478 +00145 05 WRK-W4-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX478 +00146 05 WRK-WWGH-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX478 +00147 05 WRK-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX478 +00148 05 W-BYPASSED-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX478 +00149 05 W-BACKLOG PIC S9(07) COMP-3 VALUE +0. DTSBX478 +00150 05 AMT-DISP1 PIC ----------9.99. DTSBX478 +00151 05 AMT-DISP2 PIC ----------9.99. DTSBX478 +00152 05 AMT-DISP3 PIC ----------9.99. DTSBX478 +00153 05 AMT-DISP4 PIC ----------9.99. DTSBX478 +00154 DTSBX478 +00155 05 WRK-NET-WAGE PIC S9(11)V99 COMP-3 DTSBX478 +00156 VALUE +0. DTSBX478 +00157 05 W-WGH-WAGE PIC S9(11)V99 COMP-3 DTSBX478 +00158 VALUE +0. DTSBX478 +00159 05 W-WORKER-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX478 +00160 05 W-DIFFERENCE PIC S9(11)V99 COMP-3 DTSBX478 +00161 VALUE +0. DTSBX478 +00162 DTSBX478 +00163 05 W2-REC-READ PIC 9(9) VALUE 0. DTSBX478 +00164 05 W4-REC-READ PIC 9(9) VALUE 0. DTSBX478 +00165 05 W4-REC-FOUND PIC 9(9) VALUE 0. DTSBX478 +00166 05 W4-REC-ADDED PIC 9(9) VALUE 0. DTSBX478 +00167 05 W2-REC-DELETED PIC 9(9) VALUE 0. DTSBX478 +00168 05 W2-REC-FOUND PIC 9(9) VALUE 0. DTSBX478 +00169 DTSBX478 +00170 05 W-RESP-OPID PIC X(08). DTSBX478 +00171 05 WRK-ERROR-IND PIC X(01). DTSBX478 +00172 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX478 +00173 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX478 +00174 DTSBX478 +00175 05 W-EMP-EXISTS-IND PIC X(01). DTSBX478 +00176 88 W-EMP-EXISTS-YES-88 VALUE 'Y'. DTSBX478 +00177 88 W-EMP-EXISTS-NO-88 VALUE 'N'. DTSBX478 +00178 05 W-DELINQUENT-IND PIC X(01). DTSBX478 +00179 88 W-DELINQUENT-YES-88 VALUE 'Y'. DTSBX478 +00180 88 W-DELINQUENT-NO-88 VALUE 'N'. DTSBX478 +00181 05 WAGE-TRANS-STATUS PIC X(02). DTSBX478 +00182 88 WAGE-TRANS-FILE-OK-88 VALUE '00'. DTSBX478 +00183 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DTSBX478 +00184 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DTSBX478 +00185 DTSBX478 +00186 05 DOWNLOAD-STATUS PIC X(02). DTSBX478 +00187 88 DOWNLOAD-FILE-OK-88 VALUE '00'. DTSBX478 +00188 DTSBX478 +00189 05 WRK-YRQ PIC 9(05). DTSBX478 +00190 05 FILLER REDEFINES WRK-YRQ. DTSBX478 +00191 10 WRK-YRQ-YEAR PIC 9(04). DTSBX478 +00192 10 WRK-YRQ-QTR PIC 9(01). DTSBX478 +00193 DTSBX478 +00194 05 WRK-YRQ-X. DTSBX478 +00195 10 WRK-YRQ-YEAR-X PIC 9(04). DTSBX478 +00196 10 FILLER PIC X(01) VALUE '/'. DTSBX478 +00197 10 WRK-YRQ-QTR-X PIC 9(01). DTSBX478 +00198 DTSBX478 +00199 01 OUT-W4-REC. CL**5 +00200 10 FILLER PIC X(10) VALUE SPACES. CL**5 +00201 10 FILLER PIC X(35) VALUE CL**5 +00202 'TOTAL W4 TRANS REC SENT TO UIBS = '. CL**7 +00203 10 W4-COUNT PIC ZZZZ999. CL**6 +00204 10 FILLER PIC X(28) VALUE SPACES. CL**6 +00205 CL**5 +00206 01 OUT-W2-REC. CL**6 +00207 10 FILLER PIC X(10) VALUE SPACES. CL**6 +00208 10 FILLER PIC X(35) VALUE CL**6 +00209 'TOTAL W2 TRANS REC SENT TO UIBS = '. CL**7 +00210 10 W2-COUNT PIC ZZZZ999. CL**6 +00211 10 FILLER PIC X(28) VALUE SPACES. CL**6 +00212 CL**6 +00213 01 L004-COMM-AREA. CL**5 +00214 ++INCLUDE DTSIL004 DTSBX478 +00215 DTSBX478 +00216 01 L424-LINK-AREA. DTSBX478 +00217 ++INCLUDE DTSIL424 DTSBX478 +00218 DTSBX478 +00219 01 L516-LINK-AREA. DTSBX478 +00220 ++INCLUDE DTSIL516 DTSBX478 +00221 DTSBX478 +00222 01 L910-LINK-AREA. DTSBX478 +00223 ++INCLUDE DTSIL910 DTSBX478 +00224 DTSBX478 +00225 01 X147-REC. DTSBX478 +00226 ++INCLUDE DTSIX147 DTSBX478 +00227 DTSBX478 +00228 01 MSKL-REC. DTSBX478 +00229 ++INCLUDE DTSIMSKL DTSBX478 +00230 DTSBX478 +00231 01 MPRF-REC. DTSBX478 +00232 ++INCLUDE DTSIMPRF DTSBX478 +00233 DTSBX478 +00234 01 MQTR-REC. DTSBX478 +00235 ++INCLUDE DTSIMQTR DTSBX478 +00236 DTSBX478 +00237 01 L931-LINK-AREA. DTSBX478 +00238 ++INCLUDE DTSIL931 DTSBX478 +00239 DTSBX478 +00240 01 FSKL-REC. DTSBX478 +00241 ++INCLUDE DTSIFSKL DTSBX478 +00242 DTSBX478 +00243 01 L981-LINK-AREA. DTSBX478 +00244 ++INCLUDE DTSIL981 DTSBX478 +00245 DTSBX478 +00246 01 WWGH-REC. DTSBX478 +00247 ++INCLUDE DTSIWWGH DTSBX478 +00248 DTSBX478 +00249 01 L983-LINK-AREA. DTSBX478 +00250 ++INCLUDE DTSIL983 DTSBX478 +00251 DTSBX478 +00252 01 WSKL-REC. DTSBX478 +00253 ++INCLUDE DTSIWSKL DTSBX478 +00254 DTSBX478 +00255 01 W001-REC. DTSBX478 +00256 ++INCLUDE DTSIW001 DTSBX478 +00257 DTSBX478 +00258 01 L982-LINK-AREA. DTSBX478 +00259 ++INCLUDE DTSIL982 DTSBX478 +00260 DTSBX478 +00261 01 WNAM-REC. DTSBX478 +00262 ++INCLUDE DTSIWNAM DTSBX478 +00263 DTSBX478 +00264 01 WAGE-TRANS-AREA. CL**4 +00265 05 ESP-TRANSACTION-AREA PIC X(80). CL**4 +00266 ++INCLUDE EWGTRNW2 DTSBX478 +00267 ++INCLUDE EWGTRNW4 CL**3 +00268 CL**3 +00269 PROCEDURE DIVISION. DTSBX478 +00270 DTSBX478 +00271 PERFORM I0000-INIT THRU I0000-EXIT. DTSBX478 +00272 IF WRK-ERROR-NO-88 DTSBX478 +00273 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX478 +00274 PERFORM T0000-TERM THRU T0000-EXIT DTSBX478 +00275 END-IF. DTSBX478 +00276 DTSBX478 +00277 GOBACK. DTSBX478 +00278 EJECT DTSBX478 +00279 I0000-INIT. DTSBX478 +00280 SET WRK-ERROR-NO-88 TO TRUE. DTSBX478 +00281 DTSBX478 +00282 OPEN INPUT W2GE-TRANS-FILE. CL**3 +00283 IF WAGE-TRANS-FILE-OK-88 DTSBX478 +00284 OR WAGE-TRANS-FILE-VERIFY-88 DTSBX478 +00285 NEXT SENTENCE DTSBX478 +00286 ELSE DTSBX478 +00287 PERFORM S999-ABEND THRU S999-EXIT DTSBX478 +00288 END-IF. DTSBX478 +00289 DTSBX478 +00290 OPEN OUTPUT UIBS-TRANS-FILE. CL**6 +00291 IF WAGE-TRANS-FILE-OK-88 CL**6 +00292 OR WAGE-TRANS-FILE-VERIFY-88 CL**6 +00293 NEXT SENTENCE CL**6 +00294 ELSE CL**6 +00295 PERFORM S999-ABEND THRU S999-EXIT CL**6 +00296 END-IF. CL**6 +00297 CL**6 +00298 OPEN INPUT W4GE-TRANS-FILE. CL**3 +00299 IF WAGE-TRANS-FILE-OK-88 CL**3 +00300 OR WAGE-TRANS-FILE-VERIFY-88 CL**3 +00301 NEXT SENTENCE CL**3 +00302 ELSE CL**3 +00303 PERFORM S999-ABEND THRU S999-EXIT CL**3 +00304 END-IF. CL**3 +00305 CL**3 +00306 DTSBX478 +00307 * OPEN OUTPUT TAXWGH-FILE. DTSBX478 +00308 * IF WAGE-TRANS-FILE-OK-88 DTSBX478 +00309 * OR WAGE-TRANS-FILE-VERIFY-88 DTSBX478 +00310 * NEXT SENTENCE DTSBX478 +00311 * ELSE DTSBX478 +00312 * PERFORM S999-ABEND THRU S999-EXIT DTSBX478 +00313 * END-IF. DTSBX478 +00314 DTSBX478 +00315 * PERFORM S981A-OPEN-UPDATE THRU S981A-EXIT. CL**3 +00316 * PERFORM S983-OPEN-UPDATE THRU S983-EXIT. CL**3 +00317 * PERFORM S931-OPEN-READ THRU S931-EXIT. CL**3 +00318 DTSBX478 +00319 I0000-EXIT. DTSBX478 +00320 EXIT. DTSBX478 +00321 DTSBX478 +00322 P0000-PROCESS. DTSBX478 +00323 READ W2GE-TRANS-FILE INTO ESP-TRANSACTION-AREA CL**4 +00324 DTSBX478 +00325 PERFORM UNTIL WAGE-TRANS-FILE-NO-REC-88 DTSBX478 +00326 PERFORM P2000-W2-WAGE THRU P2000-EXIT CL**3 +00327 READ W2GE-TRANS-FILE INTO ESP-TRANSACTION-AREA CL**4 +00328 DTSBX478 +00329 END-PERFORM. DTSBX478 +00330 DTSBX478 +00331 READ W4GE-TRANS-FILE INTO ESP-TRANSACTION-AREA CL**4 +00332 CL**3 +00333 PERFORM UNTIL WAGE-TRANS-FILE-NO-REC-88 CL**3 +00334 PERFORM P3000-W4-WAGE THRU P3000-EXIT CL**3 +00335 READ W4GE-TRANS-FILE INTO ESP-TRANSACTION-AREA CL**4 +00336 CL**3 +00337 END-PERFORM. CL**3 +00338 P0000-EXIT. DTSBX478 +00339 EXIT. DTSBX478 +00340 DTSBX478 +00341 DTSBX478 +00342 P2000-W2-WAGE. CL**3 +00343 ADD 1 TO W2-REC-READ. CL**3 +00344 DTSBX478 +00345 P2000-EXIT. DTSBX478 +00346 EXIT. DTSBX478 +00347 DTSBX478 +00348 P3000-W4-WAGE. CL**3 +00349 ADD 1 TO W4-REC-READ. CL**3 +00350 CL**3 +00351 P3000-EXIT. CL**3 +00352 T0000-TERM. DTSBX478 +00353 * PERFORM S981D-CLOSE THRU S981D-EXIT. CL**3 +00354 * PERFORM S983-CLOSE THRU S983-EXIT. CL**3 +00355 * PERFORM S931-CLOSE THRU S931-EXIT. CL**3 +00356 DTSBX478 +00357 * CLOSE WAGE-TRANS-FILE TAXWGH-FILE. DTSBX478 +00358 CLOSE W2GE-TRANS-FILE. CL**3 +00359 CLOSE W4GE-TRANS-FILE. CL**3 +00360 DTSBX478 +00361 DISPLAY '******************************************' DTSBX478 +00362 DISPLAY '** DTSBX478 TERMINATION STATISTICS **'. CL**3 +00363 DTSBX478 +00364 DISPLAY 'TOTAL W4 TRANS REC READ = ' W4-REC-READ. DTSBX478 +00365 * DISPLAY 'TOTAL W4 TRANS REC FOUND = ' W4-REC-FOUND. CL**3 +00366 * DISPLAY 'TOTAL W4 TRANS REC ADDED = ' W4-REC-ADDED. CL**3 +00367 DISPLAY 'TOTAL W2 TRANS REC READ = ' W2-REC-READ. DTSBX478 +00368 * DISPLAY 'TOTAL W2 TRANS REC FOUND = ' W2-REC-FOUND. CL**3 +00369 * DISPLAY 'TOTAL W2 TRANS REC DELETED = ' W2-REC-DELETED. CL**3 +00370 DISPLAY ' '. DTSBX478 +00371 MOVE W4-REC-READ TO W4-COUNT. CL**6 +00372 MOVE W2-REC-READ TO W2-COUNT. CL**6 +00373 WRITE UIBS-TRANS-REC FROM OUT-W2-REC. CL**6 +00374 WRITE UIBS-TRANS-REC FROM OUT-W4-REC. CL**6 +00375 CLOSE W4GE-TRANS-FILE. CL**6 +00376 T0000-EXIT. DTSBX478 +00377 EXIT. DTSBX478 +00378 DTSBX478 +00379 S004-EDIT-QTR. DTSBX478 +00380 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBX478 +00381 DTSBX478 +00382 S004-EXIT. DTSBX478 +00383 EXIT. DTSBX478 +00384 DTSBX478 +00385 S516-LIABILITY-INFO. DTSBX478 +00386 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX478 +00387 MPRF-REC. DTSBX478 +00388 S516-EXIT. DTSBX478 +00389 EXIT. DTSBX478 +00390 DTSBX478 +00391 S910-OPEN-READ. DTSBX478 +00392 SET L910-OPEN-READ-88 TO TRUE. DTSBX478 +00393 GO TO S910-MSTR-IO. DTSBX478 +00394 DTSBX478 +00395 S910-READ. DTSBX478 +00396 SET L910-READ-88 TO TRUE. DTSBX478 +00397 GO TO S910-MSTR-IO. DTSBX478 +00398 DTSBX478 +00399 S910-START-BROWSE. DTSBX478 +00400 SET L910-START-BROWSE-88 TO TRUE. DTSBX478 +00401 GO TO S910-MSTR-IO. DTSBX478 +00402 DTSBX478 +00403 S910-READ-NEXT. DTSBX478 +00404 SET L910-READ-NEXT-88 TO TRUE. DTSBX478 +00405 GO TO S910-MSTR-IO. DTSBX478 +00406 DTSBX478 +00407 S910-CLOSE. DTSBX478 +00408 SET L910-CLOSE-88 TO TRUE. DTSBX478 +00409 GO TO S910-MSTR-IO. DTSBX478 +00410 DTSBX478 +00411 S910-MSTR-IO. DTSBX478 +00412 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX478 +00413 MSKL-REC. DTSBX478 +00414 S910-EXIT. DTSBX478 +00415 EXIT. DTSBX478 +00416 DTSBX478 +00417 S931-OPEN-READ. DTSBX478 +00418 SET L931-OPEN-READ-88 TO TRUE. DTSBX478 +00419 GO TO S931-REF-IO. DTSBX478 +00420 DTSBX478 +00421 S931-CLOSE. DTSBX478 +00422 SET L931-CLOSE-88 TO TRUE. DTSBX478 +00423 GO TO S931-REF-IO. DTSBX478 +00424 DTSBX478 +00425 S931-REF-IO. DTSBX478 +00426 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX478 +00427 FSKL-REC. DTSBX478 +00428 S931-EXIT. DTSBX478 +00429 EXIT. DTSBX478 +00430 DTSBX478 +00431 S981A-OPEN-UPDATE. DTSBX478 +00432 SET L981-OPEN-UPDATE-88 TO TRUE. DTSBX478 +00433 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBX478 +00434 DTSBX478 +00435 S981A-EXIT. DTSBX478 +00436 EXIT. DTSBX478 +00437 DTSBX478 +00438 S981B-WRITE. DTSBX478 +00439 SET L981-WRITE-88 TO TRUE. DTSBX478 +00440 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBX478 +00441 DTSBX478 +00442 S981B-EXIT. DTSBX478 +00443 EXIT. DTSBX478 +00444 S981C-READ. DTSBX478 +00445 SET L981-READ-88 TO TRUE. DTSBX478 +00446 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBX478 +00447 DTSBX478 +00448 S981C-EXIT. DTSBX478 +00449 EXIT. DTSBX478 +00450 S981E-DELETE. DTSBX478 +00451 SET L981-DELETE-88 TO TRUE. DTSBX478 +00452 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBX478 +00453 DTSBX478 +00454 S981E-EXIT. DTSBX478 +00455 EXIT. DTSBX478 +00456 DTSBX478 +00457 S981D-CLOSE. DTSBX478 +00458 SET L981-CLOSE-88 TO TRUE. DTSBX478 +00459 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBX478 +00460 DTSBX478 +00461 S981D-EXIT. DTSBX478 +00462 EXIT. DTSBX478 +00463 DTSBX478 +00464 S981Z-WWGH-IO. DTSBX478 +00465 CALL 'DTSBU981' USING L981-LINK-AREA DTSBX478 +00466 WWGH-REC. DTSBX478 +00467 S981Z-EXIT. DTSBX478 +00468 EXIT. DTSBX478 +00469 DTSBX478 +00470 S983-OPEN-UPDATE. DTSBX478 +00471 SET L983-OPEN-UPDATE-88 TO TRUE. DTSBX478 +00472 GO TO S983-WAGE-I. DTSBX478 +00473 DTSBX478 +00474 S983-WRITE. DTSBX478 +00475 SET L983-WRITE-88 TO TRUE. DTSBX478 +00476 GO TO S983-WAGE-I. DTSBX478 +00477 DTSBX478 +00478 S983-DELETE. DTSBX478 +00479 SET L983-DELETE-88 TO TRUE. DTSBX478 +00480 GO TO S983-WAGE-I. DTSBX478 +00481 DTSBX478 +00482 S983-CLOSE. DTSBX478 +00483 SET L983-CLOSE-88 TO TRUE. DTSBX478 +00484 GO TO S983-WAGE-I. DTSBX478 +00485 DTSBX478 +00486 S983-WAGE-I. DTSBX478 +00487 CALL 'DTSBU983' USING L983-LINK-AREA DTSBX478 +00488 WSKL-REC. DTSBX478 +00489 S983-EXIT. DTSBX478 +00490 EXIT. DTSBX478 +00491 DTSBX478 +00492 S982A-START-BROWSE. DTSBX478 +00493 SET L982-START-BROWSE-88 TO TRUE. DTSBX478 +00494 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX478 +00495 DTSBX478 +00496 S982A-EXIT. DTSBX478 +00497 EXIT. DTSBX478 +00498 DTSBX478 +00499 S982B-READ-NEXT. DTSBX478 +00500 SET L982-READ-NEXT-88 TO TRUE. DTSBX478 +00501 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX478 +00502 DTSBX478 +00503 S982B-EXIT. DTSBX478 +00504 EXIT. DTSBX478 +00505 DTSBX478 +00506 S982C-OPEN-READ. DTSBX478 +00507 SET L982-OPEN-READ-88 TO TRUE. DTSBX478 +00508 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX478 +00509 DTSBX478 +00510 S982C-EXIT. DTSBX478 +00511 EXIT. DTSBX478 +00512 DTSBX478 +00513 S982D-CLOSE. DTSBX478 +00514 SET L982-CLOSE-88 TO TRUE. DTSBX478 +00515 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX478 +00516 DTSBX478 +00517 S982D-EXIT. DTSBX478 +00518 EXIT. DTSBX478 +00519 DTSBX478 +00520 S982Z-WNAM-IO. DTSBX478 +00521 CALL 'DTSBU982' USING L982-LINK-AREA DTSBX478 +00522 WNAM-REC. DTSBX478 +00523 S982Z-EXIT. DTSBX478 +00524 EXIT. DTSBX478 +00525 DTSBX478 +00526 DTSBX478 +00527 S999-ABEND. DTSBX478 +00528 DISPLAY '*** I/O MODULE ABENDING'. DTSBX478 +00529 DTSBX478 +00530 DISPLAY '*** CMND-CD = ' L983-CMND-CD. DTSBX478 +00531 DTSBX478 +00532 DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS. DTSBX478 +00533 DTSBX478 +00534 DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME. DTSBX478 +00535 DTSBX478 +00536 DTSBX478 +00537 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX478 +00538 S999-EXIT. DTSBX478 +00539 EXIT. DTSBX478 diff --git a/Batch/DTSBX479.cob b/Batch/DTSBX479.cob new file mode 100644 index 0000000..b97c8c0 --- /dev/null +++ b/Batch/DTSBX479.cob @@ -0,0 +1,532 @@ +00001 IDENTIFICATION DIVISION. 03/13/25 +00002 PROGRAM-ID. DTSBX479. DTSBX479 +00003 AUTHOR. NGC. LV018 +00004 DATE-WRITTEN. AUGUST 2004. DTSBX479 +00005 DATE-COMPILED. DTSBX479 +00006 SKIP3 DTSBX479 +00007 ***** DTSBX479 +00008 * DTSBX479 +00009 * FUNCTION: EXTRACT FOR BENEFITS COPY OF TAX EMPLOYER DATA. DTSBX479 +00010 * DTSBX479 +00011 * DTSBX479 +00012 ***** DTSBX479 +00013 ***************************************************************** DTSBX479 +00014 * * DTSBX479 +00015 * MODIFICATION HISTORY: * DTSBX479 +00016 * * DTSBX479 +00017 * * DTSBX479 +00018 * 08-03-2004 INITIAL DEVELOPMENT * DTSBX479 +00019 * REFERENCE: AUTHOR OF CHANGE - GD * DTSBX479 +00020 * * DTSBX479 +00021 * 10-13-2004 MODIFIED TO INCLUDE POOL ACCOUNTS * DTSBX479 +00022 * REFERENCE: AUTHOR OF CHANGE - GD * DTSBX479 +00023 * * DTSBX479 +00024 * 02-26-2009 RECOMPLIED FOR NEW MPRF - INCLUDES ELIG CD 20 * DTSBX479 +00025 * FOR FAC * DTSBX479 +00026 * REFERENCE: AUTHOR OF CHANGE - GD * DTSBX479 +00027 * * DTSBX479 +00028 * 05-10-2010 REMOVED TEST IN I1000-TIME-CHECK. THIS PREVENTED * DTSBX479 +00029 * THE JOB FROM RUNNING IF THE TIME WERE LATER THAN * DTSBX479 +00030 * 6:00 PM. THE CHECK WAS NEEDED TO PREVENT FILE * DTSBX479 +00031 * CONTENTION PROBLEMS IF THE BENEFITS JOB THAT READS * DTSBX479 +00032 * THE FILE TRIED TO RUN WHILE THE TAX JOB WAS * DTSBX479 +00033 * CREATING IT. SINCE THE TAX JOB SCHEDULE HAS BEEN * DTSBX479 +00034 * MOVED BACK ONE HOUR, BENEFITS WILL NOW PICK UP THE * DTSBX479 +00035 * FILE EARLY IN THE MONRNING. * DTSBX479 +00036 * REFERENCE: AUTHOR OF CHANGE - GD * DTSBX479 +00037 * * DTSBX479 +00038 * 11-04-2010 MODIFIED TO CHANGE FEIN FOR ONE EMPLOYER - * DTSBX479 +00039 * TO PREVENT EMPLOYEE LAID OFF FROM ACCESSING * DTSBX479 +00040 * INFORMATION THROUGH BENEFITS WEB SITE. * DTSBX479 +00041 * REFERENCE: AUTHOR OF CHANGE - GD * DTSBX479 +00042 * * DTSBX479 +00043 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * DTSBX479 +00044 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * DTSBX479 +00045 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** * DTSBX479 +00046 ***************************************************************** DTSBX479 +00047 SKIP3 DTSBX479 +00048 ENVIRONMENT DIVISION. DTSBX479 +00049 SKIP2 DTSBX479 +00050 INPUT-OUTPUT SECTION. DTSBX479 +00051 DTSBX479 +00052 FILE-CONTROL. DTSBX479 +00053 DTSBX479 +00054 SELECT TAX-FILE ASSIGN TO TAXFILE DTSBX479 +00055 FILE STATUS IS TAX-STATUS. DTSBX479 +00056 DTSBX479 +00057 DATA DIVISION. DTSBX479 +00058 DTSBX479 +00059 FILE SECTION. DTSBX479 +00060 DTSBX479 +00061 FD TAX-FILE DTSBX479 +00062 RECORDING MODE IS F DTSBX479 +00063 LABEL RECORDS ARE STANDARD DTSBX479 +00064 BLOCK CONTAINS 0 CHARACTERS. DTSBX479 +00065 DTSBX479 +00066 01 TAX-REC PIC X(346). CL*16 +00067 DTSBX479 +00068 WORKING-STORAGE SECTION. DTSBX479 +000685 77 PAN-VALET PICTURE X(24) VALUE '018DTSBX479 03/13/25'. DTSBX479 +00069 77 PAN-VALET PICTURE X(24) VALUE '009DTSBX476 11/04/10'. DTSBX479 +00070 SKIP3 DTSBX479 +00071 01 WRK-AREA. DTSBX479 +00072 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +476.DTSBX479 +00073 DTSBX479 +00074 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX476'.DTSBX479 +00075 DTSBX479 +00076 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSBX479 +00077 DTSBX479 +00078 05 WRK-TAX-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX479 +00079 DTSBX479 +00080 05 TAX-STATUS PIC X(02). DTSBX479 +00081 88 TAX-STATUS-OK-88 VALUE '00'. DTSBX479 +00082 DTSBX479 +00083 05 WRK-ERROR-IND PIC X(01). DTSBX479 +00084 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX479 +00085 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX479 +00086 DTSBX479 +00087 05 WRK-MPRF-IND PIC X(01). DTSBX479 +00088 88 WRK-MPRF-OK-88 VALUE 'Y'. DTSBX479 +00089 88 WRK-MPRF-NO-REC-88 VALUE 'N'. DTSBX479 +00090 DTSBX479 +00091 05 WRK-MTAD-IND PIC X(01). DTSBX479 +00092 88 WRK-MTAD-OK-88 VALUE 'Y'. DTSBX479 +00093 88 WRK-MTAD-NO-REC-88 VALUE 'N'. DTSBX479 +00094 DTSBX479 +00095 05 WRK-MBAA-IND PIC X(01). DTSBX479 +00096 88 WRK-MBAA-OK-88 VALUE 'Y'. DTSBX479 +00097 88 WRK-MBAA-NO-REC-88 VALUE 'N'. DTSBX479 +00098 DTSBX479 +00099 05 WRK-PHONE PIC 9(10). DTSBX479 +00100 05 FILLER REDEFINES WRK-PHONE. DTSBX479 +00101 10 WRK-PHONE-AREA PIC 9(03). DTSBX479 +00102 10 WRK-PHONE-PFX PIC 9(03). DTSBX479 +00103 10 WRK-PHONE-SFX PIC 9(04). DTSBX479 +00104 DTSBX479 +00105 05 WRK-AMT-DISP PIC Z(10)9.99-. DTSBX479 +00106 DTSBX479 +00107 05 WRK-TRACE-IND PIC X(01). DTSBX479 +00108 05 WRK-MHDR-PRIOR-RUN-DATE PIC S9(09) COMP-3. CL**9 +00109 DTSBX479 +00110 01 TAX-REC1. CL*16 +00111 *++INCLUDE DTSIX479 CL*16 +00112 ++INCLUDE DTSIX47Z CL*16 +00113 CL*16 +00114 01 L001-LINK-AREA. DTSBX479 +00115 ++INCLUDE DTSIL001 DTSBX479 +00116 DTSBX479 +00117 01 L004-LINK-AREA. DTSBX479 +00118 ++INCLUDE DTSIL004 DTSBX479 +00119 DTSBX479 +00120 01 L005-LINK-AREA. DTSBX479 +00121 ++INCLUDE DTSIL005 DTSBX479 +00122 DTSBX479 +00123 DTSBX479 +00124 01 L910-LINK-AREA. DTSBX479 +00125 ++INCLUDE DTSIL910 DTSBX479 +00126 EJECT DTSBX479 +00127 01 MSKL-REC. DTSBX479 +00128 ++INCLUDE DTSIMSKL DTSBX479 +00129 EJECT DTSBX479 +00130 01 MHDR-REC. DTSBX479 +00131 ++INCLUDE DTSIMHDR DTSBX479 +00132 EJECT DTSBX479 +00133 01 MPRF-REC. DTSBX479 +00134 ++INCLUDE DTSIMPRF DTSBX479 +00135 EJECT DTSBX479 +00136 01 MBAA-REC. DTSBX479 +00137 ++INCLUDE DTSIMBAA DTSBX479 +00138 EJECT DTSBX479 +00139 01 MTAD-REC. DTSBX479 +00140 ++INCLUDE DTSIMTAD DTSBX479 +00141 EJECT DTSBX479 +00142 01 MRTE-REC. DTSBX479 +00143 ++INCLUDE DTSIMRTE DTSBX479 +00144 EJECT DTSBX479 +00145 PROCEDURE DIVISION. DTSBX479 +00146 DTSBX479 +00147 DTSBX476-MAIN. DTSBX479 +00148 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX479 +00149 IF WRK-ERROR-YES-88 DTSBX479 +00150 GO TO DTSBX476-MAIN-EXIT. DTSBX479 +00151 DTSBX479 +00152 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX479 +00153 DTSBX479 +00154 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX479 +00155 DTSBX479 +00156 DTSBX476-MAIN-EXIT. DTSBX479 +00157 GOBACK. DTSBX479 +00158 EJECT DTSBX479 +00159 I0000-INITIATE. DTSBX479 +00160 MOVE +0 TO WRK-MPRF-CNT. DTSBX479 +00161 DTSBX479 +00162 SET WRK-ERROR-NO-88 TO TRUE. DTSBX479 +00163 DTSBX479 +00164 ** PERFORM I1000-CHECK-TIME THRU I1000-EXIT. DTSBX479 +00165 * IF WRK-ERROR-YES-88 DTSBX479 +00166 ** GO TO I0000-EXIT. DTSBX479 +00167 DTSBX479 +00168 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX479 +00169 IF WRK-ERROR-YES-88 DTSBX479 +00170 GO TO I0000-EXIT. DTSBX479 +00171 CL**9 +00172 MOVE LOW-VALUES TO MHDR-KEY-AREA. CL**9 +00173 MOVE +0 TO MHDR-EMP-NO. CL**9 +00174 SET MHDR-HDR-88 TO TRUE. CL**9 +00175 MOVE MHDR-REC TO MSKL-REC. CL**9 +00176 PERFORM S910-READ THRU S910-EXIT. CL**9 +00177 IF L910-NO-REC-88 CL**9 +00178 * MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG CL*12 +00179 PERFORM S999-ABEND THRU S999-EXIT. CL**9 +00180 MOVE MSKL-REC TO MHDR-REC. CL**9 +00181 MOVE MHDR-PRIOR-RUN-DATE TO WRK-MHDR-PRIOR-RUN-DATE. CL**9 +00182 DTSBX479 +00183 I0000-EXIT. DTSBX479 +00184 EXIT. DTSBX479 +00185 DTSBX479 +00186 *I1000-CHECK-TIME. DTSBX479 +00187 * PERFORM S005-FROM-SYS THRU S005-EXIT DTSBX479 +00188 * IF L005-DISPLAY-H > 18 DTSBX479 +00189 * SET WRK-ERROR-YES-88 TO TRUE DTSBX479 +00190 * MOVE +4 TO RETURN-CODE DTSBX479 +00191 * DISPLAY 'BX476: TIME > 6:00 PM, PROGRAM CANCELLED ' DTSBX479 +00192 * L005-DISPLAY-TIME DTSBX479 +00193 * END-IF. DTSBX479 +00194 * DTSBX479 +00195 *I1000-EXIT. DTSBX479 +00196 * EXIT. DTSBX479 +00197 DTSBX479 +00198 I2000-OPEN-FILES. DTSBX479 +00199 DTSBX479 +00200 OPEN OUTPUT TAX-FILE. DTSBX479 +00201 IF TAX-STATUS-OK-88 DTSBX479 +00202 NEXT SENTENCE DTSBX479 +00203 ELSE DTSBX479 +00204 DISPLAY 'DTSBX476: CANNOT OPEN OUTPUT FILE ' DTSBX479 +00205 TAX-STATUS DTSBX479 +00206 SET WRK-ERROR-YES-88 TO TRUE DTSBX479 +00207 GO TO I2000-EXIT. DTSBX479 +00208 DTSBX479 +00209 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX479 +00210 DTSBX479 +00211 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX479 +00212 DTSBX479 +00213 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX479 +00214 DTSBX479 +00215 I2000-EXIT. DTSBX479 +00216 EXIT. DTSBX479 +00217 DTSBX479 +00218 DTSBX479 +00219 EJECT DTSBX479 +00220 P0000-PROCESS. DTSBX479 +00221 DISPLAY 'BENEFITS TAX DATA EXTRACT '. DTSBX479 +00222 DISPLAY SPACE. DTSBX479 +00223 DTSBX479 +00224 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX479 +00225 MOVE +0 TO MSKL-EMP-NO. DTSBX479 +00226 SET MSKL-PRF-88 TO TRUE. DTSBX479 +00227 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX479 +00228 IF NOT L910-OK-88 DTSBX479 +00229 DISPLAY 'BAD FIRST READ' DTSBX479 +00230 GO TO P0000-EXIT DTSBX479 +00231 ELSE DTSBX479 +00232 MOVE MSKL-REC TO MPRF-REC DTSBX479 +00233 SET WRK-MPRF-OK-88 TO TRUE. DTSBX479 +00234 DTSBX479 +00235 PERFORM P1000-SCAN-MPRF THRU P1000-EXIT DTSBX479 +00236 UNTIL WRK-MPRF-NO-REC-88. DTSBX479 +00237 DTSBX479 +00238 P0000-EXIT. DTSBX479 +00239 EXIT. DTSBX479 +00240 EJECT DTSBX479 +00241 P1000-SCAN-MPRF. DTSBX479 +00242 * IF MPRF-CHNG-DATE < WRK-MHDR-PRIOR-RUN-DATE CL*13 +00243 * GO TO P1000-SCAN-MPRF-CONT. CL*13 +00244 CL**9 +00245 IF MPRF-ELIGIBLE-NOT-SUBJECT-88 DTSBX479 +00246 NEXT SENTENCE DTSBX479 +00247 ELSE DTSBX479 +00248 ADD +1 TO WRK-MPRF-CNT DTSBX479 +00249 PERFORM P1100-FIND-ADDRESS THRU P1100-EXIT DTSBX479 +00250 IF WRK-MTAD-OK-88 CL**5 +00251 PERFORM P2000-BUILD-OUTPUT THRU P2000-EXIT CL**2 +00252 DISPLAY 'MPRF-EMP-NO' MPRF-EMP-NO CL*14 +00253 ELSE CL**3 +00254 DISPLAY 'MPRF-EMP-NO' MPRF-EMP-NO CL**3 +00255 END-IF CL**2 +00256 END-IF. DTSBX479 +00257 DTSBX479 +00258 P1000-SCAN-MPRF-CONT. CL**9 +00259 MOVE MPRF-REC TO MSKL-REC. DTSBX479 +00260 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX479 +00261 IF NOT L910-OK-88 DTSBX479 +00262 SET WRK-MPRF-NO-REC-88 TO TRUE DTSBX479 +00263 ELSE DTSBX479 +00264 MOVE MSKL-REC TO MPRF-REC. DTSBX479 +00265 DTSBX479 +00266 P1000-EXIT. DTSBX479 +00267 EXIT. DTSBX479 +00268 DTSBX479 +00269 P1100-FIND-ADDRESS. DTSBX479 +00270 PERFORM P1110-FIND-MBAA THRU P1110-EXIT DTSBX479 +00271 IF WRK-MBAA-NO-REC-88 DTSBX479 +00272 PERFORM P1120-FIND-MTAD THRU P1120-EXIT DTSBX479 +00273 END-IF. DTSBX479 +00274 DTSBX479 +00275 P1100-EXIT. DTSBX479 +00276 EXIT. DTSBX479 +00277 DTSBX479 +00278 P1110-FIND-MBAA. DTSBX479 +00279 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSBX479 +00280 MOVE MPRF-EMP-NO TO MBAA-EMP-NO. DTSBX479 +00281 SET MBAA-PRIMARY-BEN-MAIL-ADDR-88 TO TRUE. DTSBX479 +00282 SET MBAA-BAA-88 TO TRUE. DTSBX479 +00283 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSBX479 +00284 DTSBX479 +00285 PERFORM S910-READ THRU S910-EXIT. DTSBX479 +00286 IF L910-OK-88 DTSBX479 +00287 MOVE MSKL-REC TO MBAA-REC DTSBX479 +00288 SET WRK-MBAA-OK-88 TO TRUE DTSBX479 +00289 ELSE DTSBX479 +00290 SET WRK-MBAA-NO-REC-88 TO TRUE DTSBX479 +00291 END-IF. DTSBX479 +00292 DTSBX479 +00293 P1110-EXIT. DTSBX479 +00294 EXIT. DTSBX479 +00295 DTSBX479 +00296 P1120-FIND-MTAD. DTSBX479 +00297 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBX479 +00298 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX479 +00299 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBX479 +00300 SET MTAD-TAD-88 TO TRUE. DTSBX479 +00301 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX479 +00302 DTSBX479 +00303 PERFORM S910-READ THRU S910-EXIT. DTSBX479 +00304 IF L910-OK-88 DTSBX479 +00305 MOVE MSKL-REC TO MTAD-REC DTSBX479 +00306 SET WRK-MTAD-OK-88 TO TRUE DTSBX479 +00307 ELSE DTSBX479 +00308 SET WRK-MTAD-NO-REC-88 TO TRUE DTSBX479 +00309 END-IF. DTSBX479 +00310 DTSBX479 +00311 P1120-EXIT. DTSBX479 +00312 EXIT. DTSBX479 +00313 DTSBX479 +00314 P2000-BUILD-OUTPUT. DTSBX479 +00315 PERFORM P2100-INITIALIZE THRU P2100-EXIT. DTSBX479 +00316 PERFORM P2200-BUILD THRU P2200-EXIT. DTSBX479 +00317 DTSBX479 +00318 DTSBX479 +00319 P2000-EXIT. DTSBX479 +00320 EXIT. DTSBX479 +00321 DTSBX479 +00322 P2100-INITIALIZE. DTSBX479 +00323 MOVE SPACES TO X476-TRADE-NAME DTSBX479 +00324 X476-ENTITY-NAME DTSBX479 +00325 X476-ADDRESS DTSBX479 +00326 X476-REIMB-IND DTSBX479 +00327 X476-EMP-STATUS-CODE DTSBX479 +00328 X476-SIC-CODE DTSBX479 +00329 X476-NAICS-CODE DTSBX479 +00330 X476-OWN-CODE DTSBX479 +00331 X476-EMAIL. DTSBX479 +00332 DTSBX479 +00333 MOVE ZERO TO X476-EMP-NO DTSBX479 +00334 X476-FEIN DTSBX479 +00335 X476-EMP-TYPE DTSBX479 +00336 X476-PHONE DTSBX479 +00337 X476-FAX. DTSBX479 +00338 DTSBX479 +00339 P2100-EXIT. DTSBX479 +00340 EXIT. DTSBX479 +00341 DTSBX479 +00342 P2200-BUILD. DTSBX479 +00343 MOVE MPRF-EMP-NO TO X476-EMP-NO. DTSBX479 +00344 DTSBX479 +00345 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBX479 +00346 MOVE MPRF-PRIMARY-NAME TO X476-ENTITY-NAME DTSBX479 +00347 MOVE SPACES TO X476-TRADE-NAME DTSBX479 +00348 ELSE DTSBX479 +00349 MOVE MPRF-PRIMARY-NAME TO X476-TRADE-NAME DTSBX479 +00350 MOVE MPRF-ENTITY-NAME TO X476-ENTITY-NAME DTSBX479 +00351 END-IF. DTSBX479 +00352 DTSBX479 +00353 IF WRK-MBAA-OK-88 DTSBX479 +00354 MOVE MBAA-ATTN-LINE TO X476-ATTN DTSBX479 +00355 MOVE MBAA-DELIV-LINE-1 TO X476-DELV1 DTSBX479 +00356 MOVE MBAA-DELIV-LINE-2 TO X476-DELV2 DTSBX479 +00357 MOVE MBAA-CITY TO X476-CITY DTSBX479 +00358 MOVE MBAA-ST TO X476-STATE DTSBX479 +00359 MOVE MBAA-ZIP TO X476-ZIP DTSBX479 +00360 ELSE DTSBX479 +00361 MOVE MTAD-ATTN-LINE TO X476-ATTN DTSBX479 +00362 MOVE MTAD-DELIV-LINE-1 TO X476-DELV1 DTSBX479 +00363 MOVE MTAD-DELIV-LINE-2 TO X476-DELV2 DTSBX479 +00364 MOVE MTAD-CITY TO X476-CITY DTSBX479 +00365 MOVE MTAD-ST TO X476-STATE DTSBX479 +00366 MOVE MTAD-ZIP TO X476-ZIP DTSBX479 +00367 END-IF. DTSBX479 +00368 DTSBX479 +00369 *& MOVE MPRF-FEIN TO X476-FEIN. DTSBX479 +00370 *& DTSBX479 +00371 IF MPRF-EMP-NO = 890308 DTSBX479 +00372 MOVE 224973456 TO X476-FEIN DTSBX479 +00373 DISPLAY X476-EMP-NO ' ' DTSBX479 +00374 X476-ENTITY-NAME ' ' X476-FEIN DTSBX479 +00375 ELSE DTSBX479 +00376 MOVE MPRF-FEIN TO X476-FEIN DTSBX479 +00377 END-IF. DTSBX479 +00378 *& DTSBX479 +00379 DTSBX479 +00380 IF MPRF-CLASS-RATED-88 DTSBX479 +00381 SET X476-REIMB-NO-88 TO TRUE DTSBX479 +00382 ELSE DTSBX479 +00383 SET X476-REIMB-YES-88 TO TRUE DTSBX479 +00384 END-IF. DTSBX479 +00385 MOVE MPRF-EMP-STATUS TO X476-EMP-STATUS-CODE. DTSBX479 +00386 MOVE MPRF-ELIGIBLE-CD TO X476-EMP-TYPE. DTSBX479 +00387 MOVE MPRF-SIC-CD TO X476-SIC-CODE. DTSBX479 +00388 MOVE MPRF-OWN-CD TO X476-OWN-CODE. DTSBX479 +00389 MOVE MPRF-NAICS-CD TO X476-NAICS-CODE. DTSBX479 +00390 DTSBX479 +00391 IF WRK-MBAA-OK-88 DTSBX479 +00392 IF MBAA-VOICE-1 NOT = ZEROS OR SPACES DTSBX479 +00393 MOVE MBAA-VOICE-1-AREA-CD TO WRK-PHONE-AREA DTSBX479 +00394 MOVE MBAA-VOICE-1-PREFIX TO WRK-PHONE-PFX DTSBX479 +00395 MOVE MBAA-VOICE-1-SUFFIX TO WRK-PHONE-SFX DTSBX479 +00396 ELSE DTSBX479 +00397 MOVE MTAD-VOICE-1-AREA-CD TO WRK-PHONE-AREA DTSBX479 +00398 MOVE MTAD-VOICE-1-PREFIX TO WRK-PHONE-PFX DTSBX479 +00399 MOVE MTAD-VOICE-1-SUFFIX TO WRK-PHONE-SFX DTSBX479 +00400 END-IF DTSBX479 +00401 ELSE DTSBX479 +00402 MOVE MTAD-VOICE-1-AREA-CD TO WRK-PHONE-AREA DTSBX479 +00403 MOVE MTAD-VOICE-1-PREFIX TO WRK-PHONE-PFX DTSBX479 +00404 MOVE MTAD-VOICE-1-SUFFIX TO WRK-PHONE-SFX DTSBX479 +00405 END-IF. DTSBX479 +00406 MOVE WRK-PHONE TO X476-PHONE. DTSBX479 +00407 DTSBX479 +00408 IF WRK-MBAA-OK-88 DTSBX479 +00409 IF MBAA-FAX NOT = ZEROS OR SPACES DTSBX479 +00410 MOVE MBAA-FAX-AREA-CD TO WRK-PHONE-AREA DTSBX479 +00411 MOVE MBAA-FAX-PREFIX TO WRK-PHONE-PFX DTSBX479 +00412 MOVE MBAA-FAX-SUFFIX TO WRK-PHONE-SFX DTSBX479 +00413 ELSE DTSBX479 +00414 MOVE MTAD-FAX-AREA-CD TO WRK-PHONE-AREA DTSBX479 +00415 MOVE MTAD-FAX-PREFIX TO WRK-PHONE-PFX DTSBX479 +00416 MOVE MTAD-FAX-SUFFIX TO WRK-PHONE-SFX DTSBX479 +00417 END-IF DTSBX479 +00418 ELSE DTSBX479 +00419 MOVE MTAD-FAX-AREA-CD TO WRK-PHONE-AREA DTSBX479 +00420 MOVE MTAD-FAX-PREFIX TO WRK-PHONE-PFX DTSBX479 +00421 MOVE MTAD-FAX-SUFFIX TO WRK-PHONE-SFX DTSBX479 +00422 END-IF. DTSBX479 +00423 MOVE WRK-PHONE TO X476-FAX. DTSBX479 +00424 DTSBX479 +00425 IF WRK-MBAA-OK-88 DTSBX479 +00426 IF MBAA-EMAIL-ADDRESS NOT = SPACES DTSBX479 +00427 MOVE MBAA-EMAIL-ADDRESS TO X476-EMAIL DTSBX479 +00428 ELSE DTSBX479 +00429 MOVE MTAD-EMAIL-ADDRESS TO X476-EMAIL DTSBX479 +00430 END-IF DTSBX479 +00431 ELSE DTSBX479 +00432 MOVE MTAD-EMAIL-ADDRESS TO X476-EMAIL DTSBX479 +00433 END-IF. DTSBX479 +00434 DTSBX479 +00435 ADD +1 TO WRK-TAX-CNT. DTSBX479 +00436 MOVE '|' TO FILLER1 FILLER2 FILLER3 FILLER4 FILLER5 CL*18 +00437 WRITE TAX-REC FROM TAX-REC1. CL*16 +00438 DTSBX479 +00439 P2200-EXIT. DTSBX479 +00440 EXIT. DTSBX479 +00441 DTSBX479 +00442 T0000-TERMINATE. DTSBX479 +00443 DTSBX479 +00444 DISPLAY ' '. DTSBX479 +00445 DTSBX479 +00446 DISPLAY '*** DTSBX476 TERMINATION STATISTICS ***'. DTSBX479 +00447 DTSBX479 +00448 DISPLAY ' '. DTSBX479 +00449 DTSBX479 +00450 DISPLAY 'NUMBER OF OUTPUT RECORDS WRITTEN: ' DTSBX479 +00451 WRK-TAX-CNT. DTSBX479 +00452 DTSBX479 +00453 DISPLAY 'NUMBER OF EMPLOYERS ENCOUNTERED: ' DTSBX479 +00454 WRK-MPRF-CNT. DTSBX479 +00455 DTSBX479 +00456 CLOSE TAX-FILE. DTSBX479 +00457 DTSBX479 +00458 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX479 +00459 DTSBX479 +00460 T0000-EXIT. DTSBX479 +00461 EXIT. DTSBX479 +00462 EJECT DTSBX479 +00463 S910-OPEN-READ. DTSBX479 +00464 SET L910-OPEN-READ-88 TO TRUE. DTSBX479 +00465 GO TO S910-MSTR-IO. DTSBX479 +00466 DTSBX479 +00467 S910-OPEN-UPDATE-NO-AIX. DTSBX479 +00468 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX479 +00469 GO TO S910-MSTR-IO. DTSBX479 +00470 DTSBX479 +00471 S910-READ. DTSBX479 +00472 SET L910-READ-88 TO TRUE. DTSBX479 +00473 GO TO S910-MSTR-IO. DTSBX479 +00474 DTSBX479 +00475 S910-START-BROWSE. DTSBX479 +00476 SET L910-START-BROWSE-88 TO TRUE. DTSBX479 +00477 GO TO S910-MSTR-IO. DTSBX479 +00478 DTSBX479 +00479 S910-READ-NEXT. DTSBX479 +00480 SET L910-READ-NEXT-88 TO TRUE. DTSBX479 +00481 GO TO S910-MSTR-IO. DTSBX479 +00482 DTSBX479 +00483 S910-COUNT. DTSBX479 +00484 SET L910-COUNT-88 TO TRUE. DTSBX479 +00485 GO TO S910-MSTR-IO. DTSBX479 +00486 DTSBX479 +00487 S910-REWRITE. DTSBX479 +00488 SET L910-REWRITE-88 TO TRUE. DTSBX479 +00489 GO TO S910-MSTR-IO. DTSBX479 +00490 DTSBX479 +00491 S910-CLOSE. DTSBX479 +00492 SET L910-CLOSE-88 TO TRUE. DTSBX479 +00493 GO TO S910-MSTR-IO. DTSBX479 +00494 DTSBX479 +00495 S910-MSTR-IO. DTSBX479 +00496 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX479 +00497 MSKL-REC. DTSBX479 +00498 S910-EXIT. DTSBX479 +00499 EXIT. DTSBX479 +00500 DTSBX479 +00501 S001-FROM-FED-8. DTSBX479 +00502 SET L001-FROM-FED-8 TO TRUE. DTSBX479 +00503 GO TO S001-DATE. DTSBX479 +00504 DTSBX479 +00505 S001-DATE. DTSBX479 +00506 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX479 +00507 S001-EXIT. DTSBX479 +00508 EXIT. DTSBX479 +00509 DTSBX479 +00510 S004-FROM-5. DTSBX479 +00511 SET L004-FROM-5 TO TRUE. DTSBX479 +00512 GO TO S004-YRQ. DTSBX479 +00513 DTSBX479 +00514 S004-YRQ. DTSBX479 +00515 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX479 +00516 DTSBX479 +00517 S004-EXIT. DTSBX479 +00518 EXIT. DTSBX479 +00519 CL*10 +00520 S999-ABEND. CL*10 +00521 DISPLAY '*** DTSBE479 ABENDING. '. CL*11 +00522 SKIP1 CL*10 +00523 CALL 'DTSBU999' USING WRK-ABEND-CD. CL*10 +00524 S999-EXIT. CL*10 +00525 EXIT. CL*10 +00526 DTSBX479 +00527 S005-FROM-SYS. DTSBX479 +00528 SET L005-FROM-SYS TO TRUE. DTSBX479 +00529 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX479 +00530 S005-EXIT. DTSBX479 +00531 EXIT. DTSBX479 diff --git a/Batch/DTSBX500.cob b/Batch/DTSBX500.cob new file mode 100644 index 0000000..72373c0 --- /dev/null +++ b/Batch/DTSBX500.cob @@ -0,0 +1,1117 @@ +00001 IDENTIFICATION DIVISION. 06/23/14 +00002 PROGRAM-ID. DTSBZ500. DTSBX500 +00003 AUTHOR. NORTHROP GRUMMAN CORP. LV007 +00004 DATE-WRITTEN. AUGUST 2005. DTSBX500 +00005 DATE-COMPILED. DTSBX500 +00006 DTSBX500 +00007 ***** DTSBX500 +00008 * DTSBX500 +00009 * FUNCTION: CREATE A WAGE AND EMPLOYER FILE FOR EACH QUATER DTSBX500 +00010 * TO BE LOADED INTO THE SDDS SYSTEM. EVERY QUATER DTSBX500 +00011 * OF WAGE RECORD DATA MUST HAVE A CORRESPONDING DTSBX500 +00012 * QUATER OF EMPLOYER DATA. THIS SYSTEM REQUIRS A DTSBX500 +00013 * MINIMUN OF THREE YEARS OF DATA TO BE LOADED INTO DTSBX500 +00014 * THE SYSTEM. DTSBX500 +00015 ***** DTSBX500 +00016 DTSBX500 +00017 ENVIRONMENT DIVISION. DTSBX500 +00018 DTSBX500 +00019 CONFIGURATION SECTION. DTSBX500 +00020 DTSBX500 +00021 INPUT-OUTPUT SECTION. DTSBX500 +00022 DTSBX500 +00023 FILE-CONTROL. DTSBX500 +00024 SELECT WAGE-FILE ASSIGN TO DTSWAGE DTSBX500 +00025 FILE STATUS IS WAGEFILE-STATUS. DTSBX500 +00026 DTSBX500 +00027 SELECT EMPL-FILE ASSIGN TO DTSEMPL DTSBX500 +00028 FILE STATUS IS EMPFILE-STATUS. DTSBX500 +00029 DTSBX500 +00030 SELECT TAX-FILE ASSIGN TO DTSTAX DTSBX500 +00031 FILE STATUS IS TAXFILE-STATUS. DTSBX500 +00032 DTSBX500 +00033 SELECT CONTACT-FILE ASSIGN TO DTSCONT DTSBX500 +00034 FILE STATUS IS CONTFILE-STATUS. DTSBX500 +00035 DTSBX500 +00036 DATA DIVISION. DTSBX500 +00037 DTSBX500 +00038 FILE SECTION. DTSBX500 +00039 DTSBX500 +00040 FD WAGE-FILE DTSBX500 +00041 RECORDING MODE IS F. DTSBX500 +00042 01 WAGE-RECORD PIC X(086). DTSBX500 +00043 DTSBX500 +00044 FD EMPL-FILE DTSBX500 +00045 RECORDING MODE IS F. DTSBX500 +00046 01 EMPL-RECORD PIC X(340). DTSBX500 +00047 DTSBX500 +00048 FD TAX-FILE DTSBX500 +00049 RECORDING MODE IS F. DTSBX500 +00050 01 TAX-RECORD PIC X(72). DTSBX500 +00051 DTSBX500 +00052 FD CONTACT-FILE DTSBX500 +00053 RECORDING MODE IS F. DTSBX500 +00054 01 CONTACT-RECORD PIC X(101). DTSBX500 +00055 EJECT DTSBX500 +00056 DTSBX500 +00057 WORKING-STORAGE SECTION. DTSBX500 +000575 77 PAN-VALET PICTURE X(24) VALUE '007DTSBX500 06/23/14'. DTSBX500 +00058 DTSBX500 +00059 01 WRK-AREA. DTSBX500 +00060 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +500.DTSBX500 +00061 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBX500 +00062 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. DTSBX500 +00063 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ500'.DTSBX500 +00064 DTSBX500 +00065 05 DISP-DATE PIC X(10). DTSBX500 +00066 05 DISP-TIME PIC X(08). DTSBX500 +00067 05 DISP-ABSTIME PIC X(16). DTSBX500 +00068 DTSBX500 +00069 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00070 05 WRK-MPRF-ZERO-FEIN-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00071 05 WRK-MPRF-ACT-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00072 05 WRK-MPRF-ACT-NO-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00073 05 WRK-TAX-ADDR-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00074 05 WRK-PHY-ADDR-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00075 05 WRK-PHY-TAX-ADDR-SAME-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00076 05 WRK-ADDR-SELECT-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00077 05 WRK-ADDR-FOUND-NO-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00078 05 WRK-WWGH-READ-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00079 05 WRK-WWGH-EMP-NO-CNT PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00080 05 WRK-WWGH-ACCT-INVALID PIC S9(07) COMP-3 VALUE 0. DTSBX500 +00081 05 WRK-WAGE-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500 +00082 05 WRK-EMPL-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500 +00083 05 WRK-TAX-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500 +00084 05 WRK-CONTACT-REC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500 +00085 05 WRK-MQTR-REC-NOT-FOUND-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500 +00086 05 WRK-LIABLE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500 +00087 05 WRK-NOT-LIABLE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX500 +00088 05 WRK-DISPLAY-CNT PIC 9(06) VALUE 0. DTSBX500 +00089 DTSBX500 +00090 05 WRK-WWGH-EMP-NO PIC S9(07) VALUE +0. DTSBX500 +00091 05 WRK-MQTR-EMP-NO PIC 9(06) VALUE 0. DTSBX500 +00092 05 WRK-EMP-NO PIC 9(06) VALUE 0. DTSBX500 +00093 05 WRK-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX500 +00094 05 WRK-YEAR-QTR PIC 9(05). DTSBX500 +00095 05 FILLER REDEFINES WRK-YEAR-QTR. DTSBX500 +00096 10 WRK-YRQ-YEAR PIC 9(4). DTSBX500 +00097 10 WRK-YRQ-QTR PIC 9(1). DTSBX500 +00098 05 WRK-SSN PIC 9(09) VALUE 0. DTSBX500 +00099 05 WRK-MOPO-SSN PIC 9(09) VALUE 0. DTSBX500 +00100 05 WRK-FEIN PIC 9(09) VALUE 0. DTSBX500 +00101 05 WRK-EARNINGS PIC 9(10) VALUE 0. DTSBX500 +00102 DTSBX500 +00103 05 WRK-QTR-PAID-AMT PIC ZZZZZ9.99. DTSBX500 +00104 05 WRK-QTR-TOT-WAGE PIC ZZZZZZZ9.99. DTSBX500 +00105 05 WRK-QTR-TAX-WAGE PIC ZZZZZZZ9.99. DTSBX500 +00106 05 WRK-QTR-UI-RATE PIC 9.9999. DTSBX500 +00107 05 WRK-QTR-MON1-EMP-CNT PIC 9(06). DTSBX500 +00108 05 WRK-QTR-MON2-EMP-CNT PIC 9(06). DTSBX500 +00109 05 WRK-QTR-MON3-EMP-CNT PIC 9(06). DTSBX500 +00110 DTSBX500 +00111 05 WAGEFILE-STATUS PIC X(02). DTSBX500 +00112 88 WAGEFILE-OK-88 VALUE '00'. DTSBX500 +00113 DTSBX500 +00114 05 EMPFILE-STATUS PIC X(02). DTSBX500 +00115 88 EMPFILE-OK-88 VALUE '00'. DTSBX500 +00116 DTSBX500 +00117 05 TAXFILE-STATUS PIC X(02). DTSBX500 +00118 88 TAXFILE-OK-88 VALUE '00'. DTSBX500 +00119 DTSBX500 +00120 05 CONTFILE-STATUS PIC X(02). DTSBX500 +00121 88 CONTFILE-OK-88 VALUE '00'. DTSBX500 +00122 DTSBX500 +00123 05 WRK-ERROR-IND PIC X(01). DTSBX500 +00124 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX500 +00125 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX500 +00126 DTSBX500 +00127 05 WRK-SUBJECT-IND PIC X(01) VALUE 'N'. DTSBX500 +00128 88 WRK-SUBJECT-YES-88 VALUE 'Y'. DTSBX500 +00129 88 WRK-SUBJECT-NO-88 VALUE 'N'. DTSBX500 +00130 DTSBX500 +00131 05 WRK-LIABLE-IND PIC X(01) VALUE 'N'. DTSBX500 +00132 88 WRK-LIABLE-YES-88 VALUE 'Y'. DTSBX500 +00133 88 WRK-LIABLE-NO-88 VALUE 'N'. DTSBX500 +00134 DTSBX500 +00135 05 WRK-EMP-NO-IND PIC X(01) VALUE SPACE. DTSBX500 +00136 88 WRK-EMP-NO-INVALID-88 VALUE 'N'. DTSBX500 +00137 88 WRK-EMP-NO-VALID-88 VALUE 'Y'. DTSBX500 +00138 DTSBX500 +00139 05 WRK-EMP-SELECTED-IND PIC X(01). DTSBX500 +00140 88 WRK-EMP-SELECTED-YES VALUE 'Y'. DTSBX500 +00141 88 WRK-EMP-SELECTED-NO VALUE 'N'. DTSBX500 +00142 DTSBX500 +00143 05 WS-MAILING-ADDRESS-1 PIC X(35) VALUE SPACES. DTSBX500 +00144 05 WS-MAILING-ADDRESS-2 PIC X(35) VALUE SPACES. DTSBX500 +00145 05 WS-CITY-1 PIC X(30) VALUE SPACES. DTSBX500 +00146 05 WS-STATE-1 PIC X(02) VALUE SPACES. DTSBX500 +00147 DTSBX500 +00148 05 WS-ZIP-1. DTSBX500 +00149 10 WS-ZIP-1-5 PIC X(05). DTSBX500 +00150 10 FILLER PIC X(01) VALUE SPACE. DTSBX500 +00151 10 WS-ZIP-1-4 PIC X(04). DTSBX500 +00152 DTSBX500 +00153 05 WS-ZIP-2. DTSBX500 +00154 10 WS-ZIP-2-5 PIC X(05). DTSBX500 +00155 10 FILLER PIC X(01) VALUE SPACE. DTSBX500 +00156 10 WS-ZIP-2-4 PIC X(04). DTSBX500 +00157 DTSBX500 +00158 05 WS-VOICE-1. DTSBX500 +00159 10 WS-VOICE-1-AREA-CD PIC X(03). DTSBX500 +00160 10 WS-VOICE-1-PREFIX PIC X(03). DTSBX500 +00161 10 WS-VOICE-1-SUFFIX PIC X(04). DTSBX500 +00162 DTSBX500 +00163 05 WRK-VOICE-1. DTSBX500 +00164 10 WRK-VOICE-1-AREA-CD PIC X(03). DTSBX500 +00165 10 WRK-VOICE-1-PREFIX PIC X(03). DTSBX500 +00166 10 WRK-VOICE-1-SUFFIX PIC X(04). DTSBX500 +00167 DTSBX500 +00168 01 WR-WAGE-RECORD. DTSBX500 +00169 05 WR-SSN PIC X(09) VALUE SPACES. DTSBX500 +00170 05 WR-FIRST-NAME PIC X(15) VALUE SPACES. DTSBX500 +00171 05 WR-M-I PIC X(01) VALUE SPACE. DTSBX500 +00172 05 WR-LAST-NAME PIC X(20) VALUE SPACES. DTSBX500 +00173 05 WR-STATE-CODE PIC X(02) VALUE '11'. DTSBX500 +00174 05 WR-UI-ACCT-NO. DTSBX500 +00175 10 WR-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500 +00176 10 WR-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500 +00177 05 WR-RPT-UNIT-NO PIC X(05) VALUE '00000'. DTSBX500 +00178 05 WR-EIN PIC X(09) VALUE SPACES. DTSBX500 +00179 05 WR-YEAR PIC X(04) VALUE SPACES. DTSBX500 +00180 05 WR-QUARTER PIC X(01) VALUE SPACE. DTSBX500 +00181 05 WR-WAGE PIC X(10) VALUE SPACES. DTSBX500 +00182 DTSBX500 +00183 01 ER-EMPL-RECORD. DTSBX500 +00184 05 ER-STATE-CODE PIC X(02) VALUE '11'. DTSBX500 +00185 05 ER-UI-ACCT-NO. DTSBX500 +00186 10 ER-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500 +00187 10 ER-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500 +00188 05 ER-EIN PIC X(09) VALUE SPACES. DTSBX500 +00189 05 ER-YEAR PIC X(04) VALUE SPACES. DTSBX500 +00190 05 ER-QUARTER PIC X(01) VALUE SPACE. DTSBX500 +00191 05 ER-EMP-PRIMARY-NAME PIC X(35) VALUE SPACES. DTSBX500 +00192 05 ER-EMP-ENTITY-NAME PIC X(35) VALUE SPACES. DTSBX500 +00193 05 ER-MAILING-ADDRESS-1 PIC X(35) VALUE SPACES. DTSBX500 +00194 05 ER-MAILING-ADDRESS-2 PIC X(35) VALUE SPACES. DTSBX500 +00195 05 ER-CITY-1 PIC X(30) VALUE SPACES. DTSBX500 +00196 05 ER-STATE-1 PIC X(02) VALUE SPACES. DTSBX500 +00197 05 ER-ZIP-1-5 PIC X(05) VALUE SPACES. DTSBX500 +00198 05 ER-ZIP-1-4 PIC X(04) VALUE SPACES. DTSBX500 +00199 05 ER-PHYSICAL-ADDRESS-1 PIC X(35) VALUE SPACES. DTSBX500 +00200 05 ER-PHYSICAL-ADDRESS-2 PIC X(35) VALUE SPACES. DTSBX500 +00201 05 ER-CITY-2 PIC X(30) VALUE SPACES. DTSBX500 +00202 05 ER-STATE-2 PIC X(02) VALUE SPACES. DTSBX500 +00203 05 ER-ZIP-2-5 PIC X(05) VALUE SPACES. DTSBX500 +00204 05 ER-ZIP-2-4 PIC X(04) VALUE SPACES. DTSBX500 +00205 05 ER-PHONE PIC X(10) VALUE SPACES. DTSBX500 +00206 05 ER-OWNERSHIP-CODE PIC X(02) VALUE SPACES. DTSBX500 +00207 05 ER-SIC-CODE PIC X(04) VALUE SPACES. DTSBX500 +00208 05 ER-NAICS-CODE PIC X(06) VALUE SPACES. DTSBX500 +00209 DTSBX500 +00210 01 TX-TAX-RECORD. DTSBX500 +00211 05 TX-STATE-CODE PIC X(02) VALUE '11'. DTSBX500 +00212 05 TX-UI-ACCT-NO. DTSBX500 +00213 10 TX-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500 +00214 10 TX-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500 +00215 05 TX-YEAR PIC X(04) VALUE SPACES. DTSBX500 +00216 05 TX-QUARTER PIC X(01) VALUE SPACE. DTSBX500 +00217 05 TX-TAX-PAID PIC X(09) VALUE SPACES. DTSBX500 +00218 05 TX-TOT-WAGE PIC X(11) VALUE SPACES. DTSBX500 +00219 05 TX-TAX-WAGE PIC X(11) VALUE SPACES. DTSBX500 +00220 05 TX-UI-RATE PIC X(06) VALUE SPACES. DTSBX500 +00221 05 TX-MON1-EMP-CNT PIC X(06) VALUE SPACES. DTSBX500 +00222 05 TX-MON2-EMP-CNT PIC X(06) VALUE SPACES. DTSBX500 +00223 05 TX-MON3-EMP-CNT PIC X(06) VALUE SPACES. DTSBX500 +00224 DTSBX500 +00225 01 CT-CONTACT-RECORD. DTSBX500 +00226 05 CT-STATE-CODE PIC X(02) VALUE '11'. DTSBX500 +00227 05 CT-UI-ACCT-NO. DTSBX500 +00228 10 CT-ACCT-NO-FIRST-4 PIC X(04) VALUE '0000'. DTSBX500 +00229 10 CT-ACCT-NO-LAST-6 PIC X(06) VALUE SPACES. DTSBX500 +00230 05 CT-YEAR PIC X(04) VALUE SPACES. DTSBX500 +00231 05 CT-QUARTER PIC X(01) VALUE SPACE. DTSBX500 +00232 05 CT-CONTACT-NAME PIC X(35) VALUE SPACES. DTSBX500 +00233 05 CT-PHONE PIC X(10) VALUE SPACES. DTSBX500 +00234 05 CT-SSN PIC X(09) VALUE SPACES. DTSBX500 +00235 05 CT-CONTACT-TITLE PIC X(30) VALUE SPACES. DTSBX500 +00236 DTSBX500 +00237 EJECT DTSBX500 +00238 01 L005-COMM-AREA. DTSBX500 +00239 ++INCLUDE DTSIL005 DTSBX500 +00240 EJECT DTSBX500 +00241 01 L071-LINK-AREA. DTSBX500 +00242 ++INCLUDE DTSIL071 DTSBX500 +00243 EJECT DTSBX500 +00244 01 L910-LINK-AREA. DTSBX500 +00245 ++INCLUDE DTSIL910 DTSBX500 +00246 EJECT DTSBX500 +00247 01 L921-LINK-AREA. DTSBX500 +00248 ++INCLUDE DTSIL921 DTSBX500 +00249 EJECT DTSBX500 +00250 01 ISKL-REC. DTSBX500 +00251 ++INCLUDE DTSIISKL DTSBX500 +00252 EJECT DTSBX500 +00253 01 IEIN-REC. DTSBX500 +00254 ++INCLUDE DTSIIEIN DTSBX500 +00255 EJECT DTSBX500 +00256 01 MSKL-REC. DTSBX500 +00257 ++INCLUDE DTSIMSKL DTSBX500 +00258 EJECT DTSBX500 +00259 01 MPRF-REC. DTSBX500 +00260 ++INCLUDE DTSIMPRF DTSBX500 +00261 EJECT DTSBX500 +00262 01 MTAD-REC. DTSBX500 +00263 ++INCLUDE DTSIMTAD DTSBX500 +00264 EJECT DTSBX500 +00265 01 MQTR-REC. DTSBX500 +00266 ++INCLUDE DTSIMQTR DTSBX500 +00267 EJECT DTSBX500 +00268 01 MOPO-REC. DTSBX500 +00269 ++INCLUDE DTSIMOPO DTSBX500 +00270 EJECT DTSBX500 +00271 ** DTSBX500 +00272 01 L981-LINK-AREA. DTSBX500 +00273 ++INCLUDE DTSIL981 DTSBX500 +00274 SKIP3 DTSBX500 +00275 01 WWGH-REC. DTSBX500 +00276 ++INCLUDE DTSIWWGH DTSBX500 +00277 EJECT DTSBX500 +00278 01 L982-LINK-AREA. DTSBX500 +00279 ++INCLUDE DTSIL982 DTSBX500 +00280 SKIP3 DTSBX500 +00281 01 WNAM-REC. DTSBX500 +00282 ++INCLUDE DTSIWNAM DTSBX500 +00283 EJECT DTSBX500 +00284 ** DTSBX500 +00285 LINKAGE SECTION. DTSBX500 +00286 DTSBX500 +00287 01 PARM-AREA. DTSBX500 +00288 05 PARM-LENGTH PIC S9(04) COMP. DTSBX500 +00289 05 PARM-DATA. DTSBX500 +00290 10 PARM-YEAR-QTR PIC 9(05). DTSBX500 +00291 10 PARM-YEAR-QTR-X REDEFINES PARM-YEAR-QTR DTSBX500 +00292 PIC X(05). DTSBX500 +00293 EJECT DTSBX500 +00294 PROCEDURE DIVISION USING PARM-AREA. DTSBX500 +00295 DTSBX500 +00296 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX500 +00297 DTSBX500 +00298 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX500 +00299 DTSBX500 +00300 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX500 +00301 DTSBX500 +00302 GOBACK. DTSBX500 +00303 EJECT DTSBX500 +00304 I0000-INITIATE. DTSBX500 +00305 DTSBX500 +00306 MOVE 'N' TO WRK-TRACE-IND. DTSBX500 +00307 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBX500 +00308 PERFORM I2000-SYS-DATE THRU I2000-EXIT. DTSBX500 +00309 PERFORM I3000-OPEN-FILES THRU I3000-EXIT. DTSBX500 +00310 DTSBX500 +00311 I0000-EXIT. DTSBX500 +00312 EXIT. DTSBX500 +00313 DTSBX500 +00314 I1000-PROCESS-PARMS. DTSBX500 +00315 DTSBX500 +00316 DISPLAY '*** ' DTSBX500 +00317 WRK-MOD-NAME DTSBX500 +00318 ' PARAMETERS: ' DTSBX500 +00319 PARM-DATA. DTSBX500 +00320 DTSBX500 +00321 IF PARM-LENGTH = +5 DTSBX500 +00322 NEXT SENTENCE DTSBX500 +00323 ELSE DTSBX500 +00324 MOVE 'PARM-LENGTH NOT EQUAL TO 5' DTSBX500 +00325 TO WRK-ABEND-MSG DTSBX500 +00326 PERFORM S999-ABEND THRU S999-EXIT. DTSBX500 +00327 DTSBX500 +00328 IF PARM-YEAR-QTR = ZEROS OR PARM-YEAR-QTR-X = SPACES DTSBX500 +00329 MOVE 'PARM-YEAR-QTR NOT VALID' TO WRK-ABEND-MSG DTSBX500 +00330 PERFORM S999-ABEND THRU S999-EXIT. DTSBX500 +00331 DTSBX500 +00332 MOVE PARM-YEAR-QTR TO WRK-YRQ WRK-YEAR-QTR. DTSBX500 +00333 DTSBX500 +00334 I1000-EXIT. DTSBX500 +00335 EXIT. DTSBX500 +00336 DTSBX500 +00337 I2000-SYS-DATE. DTSBX500 +00338 SET L005-FROM-SYS TO TRUE. DTSBX500 +00339 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBX500 +00340 MOVE L005-DATE TO DISP-DATE. DTSBX500 +00341 MOVE L005-TIME TO DISP-TIME. DTSBX500 +00342 MOVE L005-ABSTIME TO DISP-ABSTIME. DTSBX500 +00343 DTSBX500 +00344 DISPLAY ' '. DTSBX500 +00345 DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME DTSBX500 +00346 ' L005-ABSTIME ' DISP-ABSTIME. DTSBX500 +00347 DTSBX500 +00348 I2000-EXIT. DTSBX500 +00349 EXIT. DTSBX500 +00350 DTSBX500 +00351 I3000-OPEN-FILES. DTSBX500 +00352 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX500 +00353 DTSBX500 +00354 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX500 +00355 MOVE WRK-MOD-NAME TO L981-MOD-NAME. DTSBX500 +00356 MOVE WRK-MOD-NAME TO L982-MOD-NAME. DTSBX500 +00357 DTSBX500 +00358 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX500 +00359 * PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX500 +00360 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DTSBX500 +00361 PERFORM S982E-OPEN-READ THRU S982E-EXIT. DTSBX500 +00362 DTSBX500 +00363 OPEN OUTPUT WAGE-FILE. DTSBX500 +00364 IF NOT WAGEFILE-OK-88 DTSBX500 +00365 DISPLAY 'CANNOT OPEN WAGE FILE ' WAGEFILE-STATUS DTSBX500 +00366 MOVE 'CANNOT OPEN WAGE REC FILE ' TO WRK-ABEND-MSG DTSBX500 +00367 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00368 END-IF. DTSBX500 +00369 DTSBX500 +00370 OPEN OUTPUT EMPL-FILE. DTSBX500 +00371 IF NOT EMPFILE-OK-88 DTSBX500 +00372 DISPLAY 'CANNOT OPEN EMP FILE ' EMPFILE-STATUS DTSBX500 +00373 MOVE 'CANNOT OPEN EMPLOYER FILE ' TO WRK-ABEND-MSG DTSBX500 +00374 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00375 END-IF. DTSBX500 +00376 DTSBX500 +00377 OPEN OUTPUT TAX-FILE. DTSBX500 +00378 IF NOT TAXFILE-OK-88 DTSBX500 +00379 DISPLAY 'CANNOT OPEN TAX FILE ' TAXFILE-STATUS DTSBX500 +00380 MOVE 'CANNOT OPEN TAX OUTPUT FILE ' TO WRK-ABEND-MSG DTSBX500 +00381 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00382 END-IF. DTSBX500 +00383 DTSBX500 +00384 OPEN OUTPUT CONTACT-FILE. DTSBX500 +00385 IF NOT CONTFILE-OK-88 DTSBX500 +00386 DISPLAY 'CANNOT OPEN CONTACT FILE ' CONTFILE-STATUS DTSBX500 +00387 MOVE 'CANNOT OPEN CONTACT OUTPUT FILE ' TO WRK-ABEND-MSG DTSBX500 +00388 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00389 END-IF. DTSBX500 +00390 DTSBX500 +00391 I3000-EXIT. DTSBX500 +00392 EXIT. DTSBX500 +00393 EJECT DTSBX500 +00394 DTSBX500 +00395 P0000-PROCESS. DTSBX500 +00396 DTSBX500 +00397 SET WRK-LIABLE-NO-88 TO TRUE. DTSBX500 +00398 MOVE LOW-VALUES TO WWGH-REC. DTSBX500 +00399 MOVE ZERO TO WWGH-EMP-NO DTSBX500 +00400 WWGH-YRQ DTSBX500 +00401 WWGH-SSN. DTSBX500 +00402 DTSBX500 +00403 PERFORM S981D-START-BROWSE THRU S981D-EXIT. DTSBX500 +00404 IF L981-NO-REC-88 DTSBX500 +00405 MOVE '1ST BROWSE WWGH FIND NO REC ' TO WRK-ABEND-MSG DTSBX500 +00406 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00407 GO TO P0000-EXIT DTSBX500 +00408 ELSE DTSBX500 +00409 PERFORM P1000-SCAN-WAGES THRU P1000-EXIT DTSBX500 +00410 UNTIL L981-NO-REC-88. DTSBX500 +00411 DTSBX500 +00412 P0000-EXIT. DTSBX500 +00413 EXIT. DTSBX500 +00414 DTSBX500 +00415 ************************************************************** DTSBX500 +00416 * SELECT VSAM-WGH RECORDS FROM YRQ INPUT PARAMETER AND * DTSBX500 +00417 * OUTPUT THE WAGE RECORD FILE. * DTSBX500 +00418 ************************************************************** DTSBX500 +00419 DTSBX500 +00420 P1000-SCAN-WAGES. DTSBX500 +00421 DTSBX500 +00422 ADD +1 TO WRK-WWGH-READ-CNT. DTSBX500 +00423 DTSBX500 +00424 IF WWGH-EMP-NO = ZERO DTSBX500 +00425 * NEXT SENTENCE DTSBX500 +00426 ADD +1 TO WRK-WWGH-ACCT-INVALID DTSBX500 +00427 ELSE DTSBX500 +00428 PERFORM P2000-CHECK-YEAR-QTR THRU P2000-EXIT DTSBX500 +00429 END-IF. DTSBX500 +00430 DTSBX500 +00431 PERFORM S981E-READ-NEXT THRU S981E-EXIT. DTSBX500 +00432 DTSBX500 +00433 P1000-EXIT. DTSBX500 +00434 EXIT. DTSBX500 +00435 DTSBX500 +00436 ************************************************************** DTSBX500 +00437 * CREATE WAGE OUTPUT RECORDS, BASED ON YEAR-QUARTER * DTSBX500 +00438 ************************************************************** DTSBX500 +00439 DTSBX500 +00440 P2000-CHECK-YEAR-QTR. DTSBX500 +00441 * DTSBX500 +00442 IF WWGH-YRQ = WRK-YRQ DTSBX500 +00443 *RW IF WWGH-EMP-NO NOT = WRK-WWGH-EMP-NO DTSBX500 +00444 IF WWGH-EMP-NO NOT = WRK-EMP-NO DTSBX500 +00445 PERFORM P4000-READ-MQTR THRU P4000-EXIT DTSBX500 +00446 IF WRK-LIABLE-YES-88 DTSBX500 +00447 PERFORM P2100-READ-MPRF THRU P2100-EXIT DTSBX500 +00448 ** IF WRK-SUBJECT-YES-88 DTSBX500 +00449 *RW1 DTSBX500 +00450 ADD +1 TO WRK-WWGH-EMP-NO-CNT DTSBX500 +00451 *RW2 DTSBX500 +00452 PERFORM P2300-WRITE-EMPL-RECORD THRU P2300-EXIT DTSBX500 +00453 ** PERFORM P4000-READ-MQTR THRU P4000-EXIT DTSBX500 +00454 PERFORM P5000-READ-MOPO THRU P5000-EXIT DTSBX500 +00455 END-IF DTSBX500 +00456 END-IF DTSBX500 +00457 ELSE DTSBX500 +00458 GO TO P2000-EXIT. DTSBX500 +00459 DTSBX500 +00460 ** IF WRK-SUBJECT-YES-88 DTSBX500 +00461 IF WRK-LIABLE-YES-88 DTSBX500 +00462 PERFORM P2200-WRITE-WAGE-RECORD THRU P2200-EXIT DTSBX500 +00463 END-IF. DTSBX500 +00464 DTSBX500 +00465 P2000-EXIT. DTSBX500 +00466 EXIT. DTSBX500 +00467 DTSBX500 +00468 P2100-READ-MPRF. DTSBX500 +00469 ** SET WRK-SUBJECT-NO-88 TO TRUE. DTSBX500 +00470 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX500 +00471 MOVE WWGH-EMP-NO TO MSKL-EMP-NO. DTSBX500 +00472 SET MSKL-PRF-88 TO TRUE. DTSBX500 +00473 DTSBX500 +00474 PERFORM S910-READ THRU S910-EXIT. DTSBX500 +00475 IF L910-OK-88 DTSBX500 +00476 MOVE MSKL-REC TO MPRF-REC DTSBX500 +00477 IF MPRF-STATUS-SUB-88 DTSBX500 +00478 ADD +1 TO WRK-MPRF-READ-CNT DTSBX500 +00479 IF MPRF-STATUS-ACT-88 DTSBX500 +00480 ** MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBX500 +00481 *RW WRK-WWGH-EMP-NO DTSBX500 +00482 ** SET WRK-SUBJECT-YES-88 TO TRUE DTSBX500 +00483 ADD +1 TO WRK-MPRF-ACT-CNT DTSBX500 +00484 ELSE DTSBX500 +00485 ** MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBX500 +00486 *RW WRK-WWGH-EMP-NO DTSBX500 +00487 ** SET WRK-SUBJECT-YES-88 TO TRUE DTSBX500 +00488 ADD +1 TO WRK-MPRF-ACT-NO-CNT DTSBX500 +00489 * DISPLAY 'INACTIVE MPRF-EMP-NO = ' MPRF-EMP-NO ' ' DTSBX500 +00490 * 'WWGH-EMP-NO = ' WWGH-EMP-NO DTSBX500 +00491 END-IF DTSBX500 +00492 END-IF DTSBX500 +00493 ELSE DTSBX500 +00494 DISPLAY 'WAGE FILE EMP-NO INVALID ' WWGH-EMP-NO DTSBX500 +00495 ADD +1 TO WRK-WWGH-ACCT-INVALID DTSBX500 +00496 END-IF. DTSBX500 +00497 DTSBX500 +00498 P2100-EXIT. DTSBX500 +00499 EXIT. DTSBX500 +00500 DTSBX500 +00501 P2200-WRITE-WAGE-RECORD. DTSBX500 +00502 DTSBX500 +00503 SET WRK-ERROR-NO-88 TO TRUE. DTSBX500 +00504 MOVE LOW-VALUE TO WNAM-REC. DTSBX500 +00505 MOVE WWGH-SSN TO WNAM-SSN. DTSBX500 +00506 DTSBX500 +00507 PERFORM S982A-START-BROWSE THRU S982A-EXIT. DTSBX500 +00508 DTSBX500 +00509 IF L982-OK-88 DTSBX500 +00510 IF NOT WNAM-TYPE-3CHAR-88 DTSBX500 +00511 MOVE WNAM-FIRST-NAME TO WR-FIRST-NAME DTSBX500 +00512 MOVE WNAM-MID-INIT TO WR-M-I DTSBX500 +00513 MOVE WNAM-LAST-NAME TO WR-LAST-NAME DTSBX500 +00514 ELSE DTSBX500 +00515 MOVE SPACES TO WR-FIRST-NAME DTSBX500 +00516 MOVE SPACES TO WR-M-I CL**5 +00517 MOVE SPACES TO WR-LAST-NAME DTSBX500 +00518 END-IF DTSBX500 +00519 ELSE DTSBX500 +00520 MOVE SPACES TO WR-FIRST-NAME DTSBX500 +00521 MOVE SPACES TO WR-M-I CL**5 +00522 MOVE SPACES TO WR-LAST-NAME DTSBX500 +00523 END-IF. CL**7 +00524 CL**7 +00525 IF WR-M-I = LOW-VALUES CL**7 +00526 MOVE SPACES TO WR-M-I CL**7 +00527 END-IF. CL**7 +00528 CL**7 +00529 MOVE WWGH-SSN TO WRK-SSN. DTSBX500 +00530 MOVE WRK-SSN TO WR-SSN. DTSBX500 +00531 DTSBX500 +00532 MOVE WRK-EMP-NO TO WR-ACCT-NO-LAST-6. DTSBX500 +00533 DTSBX500 +00534 MOVE MPRF-FEIN TO WRK-FEIN. DTSBX500 +00535 MOVE WRK-FEIN TO WR-EIN. DTSBX500 +00536 DTSBX500 +00537 MOVE WRK-YRQ-YEAR TO WR-YEAR. DTSBX500 +00538 MOVE WRK-YRQ-QTR TO WR-QUARTER. DTSBX500 +00539 DTSBX500 +00540 MOVE WWGH-EARNINGS TO WRK-EARNINGS. DTSBX500 +00541 MOVE WRK-EARNINGS TO WR-WAGE. DTSBX500 +00542 DTSBX500 +00543 WRITE WAGE-RECORD FROM WR-WAGE-RECORD. DTSBX500 +00544 IF WAGEFILE-OK-88 DTSBX500 +00545 ADD +1 TO WRK-WAGE-REC-WRITE-CNT DTSBX500 +00546 *RW1 DTSBX500 +00547 * IF WRK-WAGE-REC-WRITE-CNT < 2000 DTSBX500 +00548 * DISPLAY ' WWGH-EMP-NO = ' WRK-EMP-NO ' ' WRK-SSN DTSBX500 +00549 * END-IF DTSBX500 +00550 *RW2 DTSBX500 +00551 ELSE DTSBX500 +00552 DISPLAY 'CANNOT WRITE WAGE REC, WWGH-EMP-NO = ' WRK-EMP-NODTSBX500 +00553 DISPLAY 'THE WAGE FILE STATUS = ' WAGEFILE-STATUS DTSBX500 +00554 DISPLAY ' ' DTSBX500 +00555 SET WRK-ERROR-YES-88 TO TRUE DTSBX500 +00556 MOVE 'CANNOT WRITE WAGE FILE RECS ' TO WRK-ABEND-MSG DTSBX500 +00557 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00558 END-IF. DTSBX500 +00559 DTSBX500 +00560 P2200-EXIT. DTSBX500 +00561 EXIT. DTSBX500 +00562 DTSBX500 +00563 P2300-WRITE-EMPL-RECORD. DTSBX500 +00564 DTSBX500 +00565 MOVE WRK-EMP-NO TO ER-ACCT-NO-LAST-6. DTSBX500 +00566 MOVE WRK-FEIN TO ER-EIN. DTSBX500 +00567 DTSBX500 +00568 MOVE WRK-YRQ-YEAR TO ER-YEAR. DTSBX500 +00569 MOVE WRK-YRQ-QTR TO ER-QUARTER. DTSBX500 +00570 DTSBX500 +00571 MOVE MPRF-OWN-CD TO ER-OWNERSHIP-CODE. DTSBX500 +00572 MOVE MPRF-SIC-CD TO ER-SIC-CODE. DTSBX500 +00573 MOVE MPRF-NAICS-CD TO ER-NAICS-CODE. DTSBX500 +00574 DTSBX500 +00575 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBX500 +00576 MOVE MPRF-PRIMARY-NAME TO ER-EMP-PRIMARY-NAME DTSBX500 +00577 MOVE MPRF-PRIMARY-NAME TO ER-EMP-ENTITY-NAME DTSBX500 +00578 ELSE DTSBX500 +00579 MOVE MPRF-PRIMARY-NAME TO ER-EMP-PRIMARY-NAME DTSBX500 +00580 IF MPRF-ENTITY-NAME = LOW-VALUES CL**2 +00581 MOVE SPACES TO ER-EMP-ENTITY-NAME CL**2 +00582 DISPLAY 'P2300 - LOW-VALUES IN ENTITY ' MPRF-EMP-NO CL**3 +00583 ELSE CL**2 +00584 MOVE MPRF-ENTITY-NAME TO ER-EMP-ENTITY-NAME CL**2 +00585 END-IF CL**2 +00586 END-IF. CL**2 +00587 DTSBX500 +00588 PERFORM P3000-FIND-ADDRESS THRU P3000-EXIT DTSBX500 +00589 DTSBX500 +00590 WRITE EMPL-RECORD FROM ER-EMPL-RECORD. DTSBX500 +00591 IF EMPFILE-OK-88 DTSBX500 +00592 ADD +1 TO WRK-EMPL-REC-WRITE-CNT DTSBX500 +00593 ELSE DTSBX500 +00594 DISPLAY 'CANNOT WRITE EMPL REC, MPRF-EMP-NO = ' WRK-EMP-NODTSBX500 +00595 DISPLAY 'THE EMPL FILE STATUS = ' EMPFILE-STATUS DTSBX500 +00596 DISPLAY ' ' DTSBX500 +00597 MOVE 'CANNOT WRITE EMPLOYER FILE RECS ' TO WRK-ABEND-MSG DTSBX500 +00598 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00599 END-IF. DTSBX500 +00600 DTSBX500 +00601 P2300-EXIT. DTSBX500 +00602 EXIT. DTSBX500 +00603 DTSBX500 +00604 P3000-FIND-ADDRESS. DTSBX500 +00605 DTSBX500 +00606 MOVE LOW-VALUE TO MTAD-REC. DTSBX500 +00607 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX500 +00608 SET MTAD-TAD-88 TO TRUE. DTSBX500 +00609 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBX500 +00610 PERFORM P3100-GET-MAILING-DATA THRU P3100-EXIT. DTSBX500 +00611 DTSBX500 +00612 MOVE LOW-VALUE TO MTAD-REC. DTSBX500 +00613 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX500 +00614 SET MTAD-TAD-88 TO TRUE. DTSBX500 +00615 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBX500 +00616 PERFORM P3200-GET-PHYSICAL-DATA THRU P3200-EXIT. DTSBX500 +00617 DTSBX500 +00618 SET WRK-EMP-SELECTED-YES TO TRUE. DTSBX500 +00619 ADD +1 TO WRK-ADDR-SELECT-CNT. DTSBX500 +00620 DTSBX500 +00621 P3000-EXIT. DTSBX500 +00622 EXIT. DTSBX500 +00623 DTSBX500 +00624 P3100-GET-MAILING-DATA. DTSBX500 +00625 DTSBX500 +00626 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX500 +00627 PERFORM S910-READ THRU S910-EXIT. DTSBX500 +00628 IF L910-NO-REC-88 DTSBX500 +00629 ADD +1 TO WRK-ADDR-FOUND-NO-CNT DTSBX500 +00630 GO TO P3100-EXIT. DTSBX500 +00631 DTSBX500 +00632 MOVE MSKL-REC TO MTAD-REC. DTSBX500 +00633 DTSBX500 +00634 ADD +1 TO WRK-TAX-ADDR-CNT. DTSBX500 +00635 MOVE MTAD-DELIV-LINE-2 TO ER-MAILING-ADDRESS-1 DTSBX500 +00636 WS-MAILING-ADDRESS-1. DTSBX500 +00637 MOVE MTAD-DELIV-LINE-1 TO ER-MAILING-ADDRESS-2 DTSBX500 +00638 WS-MAILING-ADDRESS-2. DTSBX500 +00639 MOVE MTAD-CITY TO ER-CITY-1 DTSBX500 +00640 WS-CITY-1. DTSBX500 +00641 MOVE MTAD-ST TO ER-STATE-1 DTSBX500 +00642 WS-STATE-1. DTSBX500 +00643 MOVE MTAD-ZIP TO WS-ZIP-1. DTSBX500 +00644 MOVE WS-ZIP-1-5 TO ER-ZIP-1-5. DTSBX500 +00645 MOVE WS-ZIP-1-4 TO ER-ZIP-1-4. DTSBX500 +00646 MOVE MTAD-VOICE-1-AREA-CD TO WS-VOICE-1-AREA-CD. DTSBX500 +00647 MOVE MTAD-VOICE-1-PREFIX TO WS-VOICE-1-PREFIX. DTSBX500 +00648 MOVE MTAD-VOICE-1-SUFFIX TO WS-VOICE-1-SUFFIX. DTSBX500 +00649 MOVE WS-VOICE-1 TO ER-PHONE. DTSBX500 +00650 DTSBX500 +00651 P3100-EXIT. DTSBX500 +00652 EXIT. DTSBX500 +00653 DTSBX500 +00654 P3200-GET-PHYSICAL-DATA. DTSBX500 +00655 DTSBX500 +00656 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX500 +00657 PERFORM S910-READ THRU S910-EXIT. DTSBX500 +00658 IF L910-NO-REC-88 DTSBX500 +00659 ADD +1 TO WRK-PHY-TAX-ADDR-SAME-CNT DTSBX500 +00660 MOVE WS-MAILING-ADDRESS-1 TO ER-PHYSICAL-ADDRESS-1 DTSBX500 +00661 MOVE WS-MAILING-ADDRESS-2 TO ER-PHYSICAL-ADDRESS-2 DTSBX500 +00662 MOVE WS-CITY-1 TO ER-CITY-2 DTSBX500 +00663 MOVE WS-STATE-1 TO ER-STATE-2 DTSBX500 +00664 MOVE WS-ZIP-1-5 TO ER-ZIP-2-5 DTSBX500 +00665 MOVE WS-ZIP-1-4 TO ER-ZIP-2-4 DTSBX500 +00666 GO TO P3200-EXIT. DTSBX500 +00667 DTSBX500 +00668 MOVE MSKL-REC TO MTAD-REC. DTSBX500 +00669 DTSBX500 +00670 ADD +1 TO WRK-PHY-ADDR-CNT. DTSBX500 +00671 MOVE MTAD-DELIV-LINE-2 TO ER-PHYSICAL-ADDRESS-1. DTSBX500 +00672 MOVE MTAD-DELIV-LINE-1 TO ER-PHYSICAL-ADDRESS-2. DTSBX500 +00673 MOVE MTAD-CITY TO ER-CITY-2. DTSBX500 +00674 MOVE MTAD-ST TO ER-STATE-2. DTSBX500 +00675 MOVE MTAD-ZIP TO WS-ZIP-2. DTSBX500 +00676 MOVE WS-ZIP-2-5 TO ER-ZIP-2-5. DTSBX500 +00677 MOVE WS-ZIP-2-4 TO ER-ZIP-2-4. DTSBX500 +00678 DTSBX500 +00679 P3200-EXIT. DTSBX500 +00680 EXIT. DTSBX500 +00681 DTSBX500 +00682 P4000-READ-MQTR. DTSBX500 +00683 DTSBX500 +00684 SET WRK-LIABLE-NO-88 TO TRUE. DTSBX500 +00685 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBX500 +00686 ** MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBX500 +00687 MOVE WWGH-EMP-NO TO MQTR-EMP-NO. DTSBX500 +00688 SET MQTR-QTR-88 TO TRUE. DTSBX500 +00689 MOVE WRK-YRQ TO MQTR-YRQ. DTSBX500 +00690 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBX500 +00691 PERFORM S910-READ THRU S910-EXIT. DTSBX500 +00692 DTSBX500 +00693 IF L910-OK-88 DTSBX500 +00694 MOVE MSKL-REC TO MQTR-REC DTSBX500 +00695 *RW3 DTSBX500 +00696 IF MQTR-CURR-NOT-LIABLE-88 DTSBX500 +00697 ADD +1 TO WRK-NOT-LIABLE-REC-CNT DTSBX500 +00698 ** GO TO P4000-EXIT DTSBX500 +00699 ELSE DTSBX500 +00700 SET WRK-LIABLE-YES-88 TO TRUE DTSBX500 +00701 ADD +1 TO WRK-LIABLE-REC-CNT DTSBX500 +00702 *RW4 DTSBX500 +00703 PERFORM P4100-WRITE-TAX-RECORD THRU P4100-EXIT DTSBX500 +00704 ELSE DTSBX500 +00705 ADD +1 TO WRK-MQTR-REC-NOT-FOUND-CNT DTSBX500 +00706 DISPLAY 'MQTR REC NOT FOUND - WWGH-EMP-NO = ' DTSBX500 +00707 WWGH-EMP-NO DTSBX500 +00708 END-IF. DTSBX500 +00709 DTSBX500 +00710 MOVE WWGH-EMP-NO TO WRK-EMP-NO. DTSBX500 +00711 DTSBX500 +00712 P4000-EXIT. DTSBX500 +00713 EXIT. DTSBX500 +00714 DTSBX500 +00715 P4100-WRITE-TAX-RECORD. DTSBX500 +00716 DTSBX500 +00717 MOVE ZEROS TO WRK-QTR-PAID-AMT DTSBX500 +00718 WRK-QTR-TOT-WAGE DTSBX500 +00719 WRK-QTR-TAX-WAGE. DTSBX500 +00720 DTSBX500 +00721 ** MOVE WRK-EMP-NO TO TX-ACCT-NO-LAST-6. DTSBX500 +00722 MOVE MQTR-EMP-NO TO WRK-MQTR-EMP-NO. DTSBX500 +00723 MOVE WRK-MQTR-EMP-NO TO TX-ACCT-NO-LAST-6. DTSBX500 +00724 DTSBX500 +00725 MOVE WRK-YRQ-YEAR TO TX-YEAR. DTSBX500 +00726 MOVE WRK-YRQ-QTR TO TX-QUARTER. DTSBX500 +00727 DTSBX500 +00728 PERFORM DTSBX500 +00729 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBX500 +00730 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT DTSBX500 +00731 DTSBX500 +00732 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBX500 +00733 MOVE MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-QTR-PAID-AMTDTSBX500 +00734 * SET MQTR-ACCT-IDX TO MQTR-ACT-CNT DTSBX500 +00735 END-IF DTSBX500 +00736 END-PERFORM. DTSBX500 +00737 DTSBX500 +00738 MOVE WRK-QTR-PAID-AMT TO TX-TAX-PAID. DTSBX500 +00739 DTSBX500 +00740 MOVE MQTR-TOT-WAGE TO WRK-QTR-TOT-WAGE. DTSBX500 +00741 MOVE WRK-QTR-TOT-WAGE TO TX-TOT-WAGE. DTSBX500 +00742 DTSBX500 +00743 MOVE MQTR-TAX-WAGE TO WRK-QTR-TAX-WAGE. DTSBX500 +00744 MOVE WRK-QTR-TAX-WAGE TO TX-TAX-WAGE. DTSBX500 +00745 DTSBX500 +00746 IF MQTR-UI-RATE = -9.9999 DTSBX500 +00747 MOVE SPACE TO TX-UI-RATE DTSBX500 +00748 ELSE DTSBX500 +00749 MOVE MQTR-UI-RATE TO WRK-QTR-UI-RATE DTSBX500 +00750 MOVE WRK-QTR-UI-RATE TO TX-UI-RATE DTSBX500 +00751 END-IF. DTSBX500 +00752 DTSBX500 +00753 IF MQTR-1ST-MTH-EMPL-CNT = +9999999 DTSBX500 +00754 MOVE '000000' TO TX-MON1-EMP-CNT DTSBX500 +00755 ELSE DTSBX500 +00756 MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-QTR-MON1-EMP-CNT DTSBX500 +00757 MOVE WRK-QTR-MON1-EMP-CNT TO TX-MON1-EMP-CNT DTSBX500 +00758 END-IF. DTSBX500 +00759 DTSBX500 +00760 IF MQTR-2ND-MTH-EMPL-CNT = +9999999 DTSBX500 +00761 MOVE '000000' TO TX-MON2-EMP-CNT DTSBX500 +00762 ELSE DTSBX500 +00763 MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-QTR-MON2-EMP-CNT DTSBX500 +00764 MOVE WRK-QTR-MON2-EMP-CNT TO TX-MON2-EMP-CNT DTSBX500 +00765 END-IF. DTSBX500 +00766 DTSBX500 +00767 IF MQTR-3RD-MTH-EMPL-CNT = +9999999 DTSBX500 +00768 MOVE '000000' TO TX-MON3-EMP-CNT DTSBX500 +00769 ELSE DTSBX500 +00770 MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-QTR-MON3-EMP-CNT DTSBX500 +00771 MOVE WRK-QTR-MON3-EMP-CNT TO TX-MON3-EMP-CNT DTSBX500 +00772 END-IF. DTSBX500 +00773 DTSBX500 +00774 WRITE TAX-RECORD FROM TX-TAX-RECORD. DTSBX500 +00775 IF TAXFILE-OK-88 DTSBX500 +00776 ADD +1 TO WRK-TAX-REC-WRITE-CNT DTSBX500 +00777 ELSE DTSBX500 +00778 DISPLAY 'CANNOT WRITE TAX REC, MPRF-EMP-NO = ' WRK-EMP-NO DTSBX500 +00779 DISPLAY 'THE TAX FILE STATUS = ' TAXFILE-STATUS DTSBX500 +00780 DISPLAY ' ' DTSBX500 +00781 MOVE 'CANNOT WRITE TAX FILE RECS ' TO WRK-ABEND-MSG DTSBX500 +00782 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00783 END-IF. DTSBX500 +00784 DTSBX500 +00785 P4100-EXIT. DTSBX500 +00786 EXIT. DTSBX500 +00787 DTSBX500 +00788 P5000-READ-MOPO. DTSBX500 +00789 DTSBX500 +00790 MOVE LOW-VALUE TO MOPO-KEY-AREA. DTSBX500 +00791 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBX500 +00792 SET MOPO-OPO-88 TO TRUE. DTSBX500 +00793 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBX500 +00794 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX500 +00795 IF L910-NO-REC-88 DTSBX500 +00796 NEXT SENTENCE DTSBX500 +00797 ELSE DTSBX500 +00798 PERFORM DTSBX500 +00799 UNTIL L910-NO-REC-88 DTSBX500 +00800 MOVE MSKL-REC TO MOPO-REC DTSBX500 +00801 IF MOPO-TYPE-OPO-88 DTSBX500 +00802 * DISPLAY 'MOPO-EMP-NO = ' MOPO-EMP-NO DTSBX500 +00803 * DISPLAY 'CONTACT - MOPO NAME FOUND ' MOPO-NAME DTSBX500 +00804 PERFORM P5100-WRITE-CONTACT-RECORD DTSBX500 +00805 THRU P5100-EXIT DTSBX500 +00806 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX500 +00807 ELSE DTSBX500 +00808 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX500 +00809 END-IF DTSBX500 +00810 END-PERFORM DTSBX500 +00811 END-IF. DTSBX500 +00812 DTSBX500 +00813 P5000-EXIT. DTSBX500 +00814 EXIT. DTSBX500 +00815 DTSBX500 +00816 P5100-WRITE-CONTACT-RECORD. DTSBX500 +00817 MOVE SPACES TO WRK-VOICE-1. DTSBX500 +00818 MOVE ZEROS TO WRK-MOPO-SSN. DTSBX500 +00819 DTSBX500 +00820 MOVE WRK-EMP-NO TO CT-ACCT-NO-LAST-6. DTSBX500 +00821 DTSBX500 +00822 MOVE WRK-YRQ-YEAR TO CT-YEAR. DTSBX500 +00823 MOVE WRK-YRQ-QTR TO CT-QUARTER. DTSBX500 +00824 DTSBX500 +00825 INSPECT MOPO-NAME REPLACING ALL LOW-VALUE BY SPACE. DTSBX500 +00826 MOVE MOPO-NAME TO L071-NAM. DTSBX500 +00827 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSBX500 +00828 PERFORM S071-DESLASH-NAME THRU S071-EXIT. DTSBX500 +00829 MOVE L071-NAM TO CT-CONTACT-NAME. DTSBX500 +00830 * DISPLAY 'MOPO-EMP-NO = ' MOPO-EMP-NO. DTSBX500 +00831 * DISPLAY 'CONTACT - MOPO NAME FOUND ' L071-NAM. DTSBX500 +00832 DTSBX500 +00833 MOVE MOPO-VOICE-1-AREA-CD TO WRK-VOICE-1-AREA-CD. DTSBX500 +00834 MOVE MOPO-VOICE-1-PREFIX TO WRK-VOICE-1-PREFIX. DTSBX500 +00835 MOVE MOPO-VOICE-1-SUFFIX TO WRK-VOICE-1-SUFFIX. DTSBX500 +00836 MOVE WRK-VOICE-1 TO CT-PHONE. DTSBX500 +00837 DTSBX500 +00838 MOVE MOPO-SSN TO WRK-MOPO-SSN. DTSBX500 +00839 MOVE WRK-MOPO-SSN TO CT-SSN. DTSBX500 +00840 DTSBX500 +00841 MOVE MOPO-TITLE TO CT-CONTACT-TITLE DTSBX500 +00842 DTSBX500 +00843 WRITE CONTACT-RECORD FROM CT-CONTACT-RECORD. DTSBX500 +00844 IF CONTFILE-OK-88 DTSBX500 +00845 ADD +1 TO WRK-CONTACT-REC-WRITE-CNT DTSBX500 +00846 ELSE DTSBX500 +00847 DISPLAY 'CANNOT WRITE CONTACT REC, MPRF-EMP-NO = ' DTSBX500 +00848 WRK-EMP-NO DTSBX500 +00849 DISPLAY 'THE CONTACT FILE STATUS = ' CONTFILE-STATUS DTSBX500 +00850 DISPLAY ' ' DTSBX500 +00851 MOVE 'CANNOT WRITE CONTACT FILE RECS ' TO WRK-ABEND-MSG DTSBX500 +00852 PERFORM S999-ABEND THRU S999-EXIT DTSBX500 +00853 END-IF. DTSBX500 +00854 DTSBX500 +00855 P5100-EXIT. DTSBX500 +00856 EXIT. DTSBX500 +00857 DTSBX500 +00858 T0000-TERMINATE. DTSBX500 +00859 DTSBX500 +00860 DISPLAY ' '. DTSBX500 +00861 DTSBX500 +00862 DISPLAY '*** DTSBZ500 TERMINATION STATISTICS ***'. DTSBX500 +00863 DTSBX500 +00864 DISPLAY ' '. DTSBX500 +00865 DTSBX500 +00866 DISPLAY 'VSAM WAGE FILE INPUT REC READ COUNT : ' DTSBX500 +00867 WRK-WWGH-READ-CNT. DTSBX500 +00868 DTSBX500 +00869 DISPLAY 'VSAM WAGE FILE ACCOUNT INVALID COUNT : ' DTSBX500 +00870 WRK-WWGH-ACCT-INVALID. DTSBX500 +00871 DTSBX500 +00872 DISPLAY ' '. DTSBX500 +00873 DTSBX500 +00874 DISPLAY 'MPRF MASTER FILE SUBJ STATUS ACCT RECS READ : ' DTSBX500 +00875 WRK-MPRF-READ-CNT. DTSBX500 +00876 DTSBX500 +00877 DISPLAY ' MPRF MASTER FILE ACT STATUS ACCT RECS READ : ' DTSBX500 +00878 WRK-MPRF-ACT-CNT. DTSBX500 +00879 DTSBX500 +00880 DISPLAY ' MPRF MASTER FILE INACTIVE STATUS ACCT READ : ' DTSBX500 +00881 WRK-MPRF-ACT-NO-CNT. DTSBX500 +00882 DTSBX500 +00883 DISPLAY ' '. DTSBX500 +00884 DTSBX500 +00885 DISPLAY 'NUMBER OF TAX MAILING ADDRESSES FOUND COUNT : ' DTSBX500 +00886 WRK-TAX-ADDR-CNT. DTSBX500 +00887 DTSBX500 +00888 DISPLAY 'NUMBER OF PHYSICAL ADDRESSES FOUND COUNT : ' DTSBX500 +00889 WRK-PHY-ADDR-CNT. DTSBX500 +00890 DTSBX500 +00891 DISPLAY 'NUMBER OF PHYSICAL AND MAILING ADDR SAME CNT : ' DTSBX500 +00892 WRK-PHY-TAX-ADDR-SAME-CNT DTSBX500 +00893 DTSBX500 +00894 DISPLAY ' '. DTSBX500 +00895 DTSBX500 +00896 DISPLAY 'NUMBER OF EMPLOYERS WAGES ACCOUNT COUNT : ' DTSBX500 +00897 WRK-WWGH-EMP-NO-CNT. DTSBX500 +00898 DTSBX500 +00899 DISPLAY 'NUMBER OF SS WAGE RECORDS WRITTEN COUNT : ' DTSBX500 +00900 WRK-WAGE-REC-WRITE-CNT. DTSBX500 +00901 DTSBX500 +00902 DISPLAY ' '. DTSBX500 +00903 DTSBX500 +00904 DISPLAY 'NUMBER OF EMPL RECORDS WRITTEN COUNT : ' DTSBX500 +00905 WRK-EMPL-REC-WRITE-CNT. DTSBX500 +00906 DTSBX500 +00907 DISPLAY ' '. DTSBX500 +00908 DTSBX500 +00909 DISPLAY ' NUMBER OF TAX RECORDS WRITTEN COUNT : ' DTSBX500 +00910 WRK-TAX-REC-WRITE-CNT. DTSBX500 +00911 DTSBX500 +00912 DISPLAY 'NUMBER OF YEAR-QTR MQTR REC NOT FOUND : ' DTSBX500 +00913 WRK-MQTR-REC-NOT-FOUND-CNT. DTSBX500 +00914 DTSBX500 +00915 DISPLAY ' '. DTSBX500 +00916 DTSBX500 +00917 DISPLAY ' NUMBER OF CONTACT REC WRITTEN COUNT : ' DTSBX500 +00918 WRK-CONTACT-REC-WRITE-CNT. DTSBX500 +00919 DTSBX500 +00920 DISPLAY ' '. DTSBX500 +00921 DTSBX500 +00922 DISPLAY ' NUMBER OF LIABLE RECORDS COUNT : ' DTSBX500 +00923 WRK-LIABLE-REC-CNT. DTSBX500 +00924 DTSBX500 +00925 DISPLAY ' NUMBER OF NOT-LIABLE RECORDS COUNT : ' DTSBX500 +00926 WRK-NOT-LIABLE-REC-CNT. DTSBX500 +00927 DTSBX500 +00928 DISPLAY ' '. DTSBX500 +00929 DTSBX500 +00930 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX500 +00931 PERFORM S981C-CLOSE THRU S981C-EXIT. DTSBX500 +00932 PERFORM S982F-CLOSE THRU S982F-EXIT. DTSBX500 +00933 DTSBX500 +00934 CLOSE WAGE-FILE TAX-FILE CONTACT-FILE EMPL-FILE. DTSBX500 +00935 DTSBX500 +00936 T0000-EXIT. DTSBX500 +00937 EXIT. DTSBX500 +00938 EJECT DTSBX500 +00939 DTSBX500 +00940 S005-SYS-DATE. DTSBX500 +00941 CALL 'DTSBU005' USING L005-COMM-AREA. DTSBX500 +00942 DTSBX500 +00943 S005-EXIT. DTSBX500 +00944 EXIT. DTSBX500 +00945 DTSBX500 +00946 S071-DESLASH-NAME. DTSBX500 +00947 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBX500 +00948 S071-EXIT. DTSBX500 +00949 EXIT. DTSBX500 +00950 EJECT DTSBX500 +00951 DTSBX500 +00952 S910-OPEN-READ. DTSBX500 +00953 SET L910-OPEN-READ-88 TO TRUE. DTSBX500 +00954 GO TO S910-MSTR-IO. DTSBX500 +00955 DTSBX500 +00956 S910-OPEN-UPDATE-NO-AIX. DTSBX500 +00957 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX500 +00958 GO TO S910-MSTR-IO. DTSBX500 +00959 DTSBX500 +00960 S910-READ. DTSBX500 +00961 SET L910-READ-88 TO TRUE. DTSBX500 +00962 GO TO S910-MSTR-IO. DTSBX500 +00963 DTSBX500 +00964 S910-START-BROWSE. DTSBX500 +00965 SET L910-START-BROWSE-88 TO TRUE. DTSBX500 +00966 GO TO S910-MSTR-IO. DTSBX500 +00967 DTSBX500 +00968 S910-READ-NEXT. DTSBX500 +00969 SET L910-READ-NEXT-88 TO TRUE. DTSBX500 +00970 GO TO S910-MSTR-IO. DTSBX500 +00971 DTSBX500 +00972 S910-COUNT. DTSBX500 +00973 SET L910-COUNT-88 TO TRUE. DTSBX500 +00974 GO TO S910-MSTR-IO. DTSBX500 +00975 DTSBX500 +00976 S910-WRITE. DTSBX500 +00977 SET L910-WRITE-88 TO TRUE. DTSBX500 +00978 GO TO S910-MSTR-IO. DTSBX500 +00979 DTSBX500 +00980 S910-REWRITE. DTSBX500 +00981 SET L910-REWRITE-88 TO TRUE. DTSBX500 +00982 GO TO S910-MSTR-IO. DTSBX500 +00983 DTSBX500 +00984 S910-CLOSE. DTSBX500 +00985 SET L910-CLOSE-88 TO TRUE. DTSBX500 +00986 GO TO S910-MSTR-IO. DTSBX500 +00987 DTSBX500 +00988 S910-MSTR-IO. DTSBX500 +00989 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX500 +00990 MSKL-REC. DTSBX500 +00991 S910-EXIT. DTSBX500 +00992 EXIT. DTSBX500 +00993 DTSBX500 +00994 S921-OPEN-READ. DTSBX500 +00995 SET L921-OPEN-READ-88 TO TRUE. DTSBX500 +00996 GO TO S921-AIX-IO. DTSBX500 +00997 DTSBX500 +00998 S921-OPEN-UPDATE. DTSBX500 +00999 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX500 +01000 GO TO S921-AIX-IO. DTSBX500 +01001 DTSBX500 +01002 S921-READ. DTSBX500 +01003 SET L921-READ-88 TO TRUE. DTSBX500 +01004 GO TO S921-AIX-IO. DTSBX500 +01005 DTSBX500 +01006 S921-START-BROWSE. DTSBX500 +01007 SET L921-START-BROWSE-88 TO TRUE. DTSBX500 +01008 GO TO S921-AIX-IO. DTSBX500 +01009 DTSBX500 +01010 S921-READ-NEXT. DTSBX500 +01011 SET L921-READ-NEXT-88 TO TRUE. DTSBX500 +01012 GO TO S921-AIX-IO. DTSBX500 +01013 DTSBX500 +01014 S921-CLOSE. DTSBX500 +01015 SET L921-CLOSE-88 TO TRUE. DTSBX500 +01016 GO TO S921-AIX-IO. DTSBX500 +01017 DTSBX500 +01018 S921-AIX-IO. DTSBX500 +01019 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX500 +01020 ISKL-REC. DTSBX500 +01021 S921-EXIT. DTSBX500 +01022 EXIT. DTSBX500 +01023 ** DTSBX500 +01024 S981A-OPEN-READ. DTSBX500 +01025 SET L981-OPEN-READ-88 TO TRUE. DTSBX500 +01026 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500 +01027 DTSBX500 +01028 S981A-EXIT. DTSBX500 +01029 EXIT. DTSBX500 +01030 DTSBX500 +01031 S981C-CLOSE. DTSBX500 +01032 SET L981-CLOSE-88 TO TRUE. DTSBX500 +01033 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500 +01034 DTSBX500 +01035 S981C-EXIT. DTSBX500 +01036 EXIT. DTSBX500 +01037 DTSBX500 +01038 S981D-START-BROWSE. DTSBX500 +01039 SET L981-START-BROWSE-88 TO TRUE. DTSBX500 +01040 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500 +01041 DTSBX500 +01042 S981D-EXIT. DTSBX500 +01043 EXIT. DTSBX500 +01044 DTSBX500 +01045 S981E-READ-NEXT. DTSBX500 +01046 SET L981-READ-NEXT-88 TO TRUE. DTSBX500 +01047 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX500 +01048 DTSBX500 +01049 S981E-EXIT. DTSBX500 +01050 EXIT. DTSBX500 +01051 DTSBX500 +01052 S981Z-WAGE-I. DTSBX500 +01053 CALL 'DTSBU981' USING L981-LINK-AREA DTSBX500 +01054 WWGH-REC. DTSBX500 +01055 S981Z-EXIT. DTSBX500 +01056 EXIT. DTSBX500 +01057 ** DTSBX500 +01058 DTSBX500 +01059 S982A-START-BROWSE. DTSBX500 +01060 SET L982-START-BROWSE-88 TO TRUE. DTSBX500 +01061 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500 +01062 DTSBX500 +01063 S982A-EXIT. DTSBX500 +01064 EXIT. DTSBX500 +01065 DTSBX500 +01066 S982B-READ-NEXT. DTSBX500 +01067 SET L982-READ-NEXT-88 TO TRUE. DTSBX500 +01068 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500 +01069 DTSBX500 +01070 S982B-EXIT. DTSBX500 +01071 EXIT. DTSBX500 +01072 DTSBX500 +01073 S982C-WRITE. DTSBX500 +01074 SET L982-WRITE-88 TO TRUE. DTSBX500 +01075 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500 +01076 DTSBX500 +01077 S982C-EXIT. DTSBX500 +01078 EXIT. DTSBX500 +01079 DTSBX500 +01080 S982D-REWRITE. DTSBX500 +01081 SET L982-REWRITE-88 TO TRUE. DTSBX500 +01082 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500 +01083 DTSBX500 +01084 S982D-EXIT. DTSBX500 +01085 EXIT. DTSBX500 +01086 DTSBX500 +01087 S982E-OPEN-READ. DTSBX500 +01088 SET L982-OPEN-READ-88 TO TRUE. DTSBX500 +01089 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500 +01090 DTSBX500 +01091 S982E-EXIT. DTSBX500 +01092 EXIT. DTSBX500 +01093 DTSBX500 +01094 S982F-CLOSE. DTSBX500 +01095 SET L982-CLOSE-88 TO TRUE. DTSBX500 +01096 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSBX500 +01097 DTSBX500 +01098 S982F-EXIT. DTSBX500 +01099 EXIT. DTSBX500 +01100 DTSBX500 +01101 S982Z-WNAM-IO. DTSBX500 +01102 CALL 'DTSBU982' USING L982-LINK-AREA DTSBX500 +01103 WNAM-REC. DTSBX500 +01104 S982Z-EXIT. DTSBX500 +01105 EXIT. DTSBX500 +01106 ** DTSBX500 +01107 DTSBX500 +01108 S999-ABEND. DTSBX500 +01109 DTSBX500 +01110 DISPLAY '**** DTSBZ500 ABENDING ' DTSBX500 +01111 WRK-ABEND-MSG. DTSBX500 +01112 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX500 +01113 DTSBX500 +01114 S999-EXIT. DTSBX500 +01115 EXIT. DTSBX500 +01116 DTSBX500 diff --git a/Batch/DTSBX520.cob b/Batch/DTSBX520.cob new file mode 100644 index 0000000..34d815d --- /dev/null +++ b/Batch/DTSBX520.cob @@ -0,0 +1,1069 @@ +00001 IDENTIFICATION DIVISION. 12/10/15 +00002 PROGRAM-ID. DTSBX520. DTSBX520 +00003 AUTHOR. NGC. LV028 +00004 DATE-WRITTEN. OCTOBER 2007. DTSBX520 +00005 DATE-COMPILED. DTSBX520 +00006 SKIP3 DTSBX520 +00007 ***** DTSBX520 +00008 * DTSBX520 +00009 * FUNCTION: INTERNAL WEB MAINFRAME EXTRACT DRIVER DTSBX520 +00010 * DTSBX520 +00011 * DTSBX520 +00012 * MODIFICATION LOG: DTSBX520 +00013 * DTSBX520 +00014 * 10/17/2014 INITIAL DEVELOPMENT. CL*26 +00015 * REFERENCE: ESSP ACCT DETAIL PROGRAMMER: NH CL*26 +00016 * DTSBX520 +00017 * DTSBX520 +00018 * 12/10/2015 PROGRAM RENAMED FROM BX354 TO BX520 CL*28 +00019 * REFERENCE: ESSP ACCT DETAIL PROGRAMMER: ZL1 CL*28 +00020 * CL*28 +00021 * CL*28 +00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX520 +00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX520 +00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX520 +00025 * DTSBX520 +00026 * DTSBX520 +00027 * DESCRIPTION: DTSBX520 +00028 * DTSBX520 +00029 * DTSBX520 +00030 * INITIATION: DTSBX520 +00031 * DTSBX520 +00032 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBX520 +00033 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBX520 +00034 * DTSBX520 +00035 * EDIT AND DEFAULT PARAMETERS. DTSBX520 +00036 * DTSBX520 +00037 * DTSBX520 +00038 * PROCESSING: DTSBX520 +00039 * DTSBX520 +00040 * DTSBX520 +00041 * TERMINATION: DTSBX520 +00042 * DTSBX520 +00043 * DTSBX520 +00044 * DTSBX520 +00045 * RECORDS READ: DTSBX520 +00046 * DTSBX520 +00047 * MASTER: DTSBX520 +00048 * DTSBX520 +00049 * MSOL DTSBX520 +00050 * MQTR DTSBX520 +00051 * DTSBX520 +00052 * DTSBX520 +00053 * ALTERNATE INDEX: DTSBX520 +00054 * DTSBX520 +00055 * NONE. DTSBX520 +00056 * DTSBX520 +00057 * DTSBX520 +00058 * REFERENCE: DTSBX520 +00059 * DTSBX520 +00060 * DTSBX520 +00061 * DTSBX520 +00062 * RECORDS UPDATED: DTSBX520 +00063 * DTSBX520 +00064 * NONE DTSBX520 +00065 * DTSBX520 +00066 * DTSBX520 +00067 * OUTPUT RECORDS WRITTEN: DTSBX520 +00068 * DTSBX520 +00069 * DTSBX331 DTSBX520 +00070 * DTSBX520 +00071 * DTSBX520 +00072 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX520 +00073 * DTSBX520 +00074 * NONE. DTSBX520 +00075 * DTSBX520 +00076 * DTSBX520 +00077 * MODULES CALLED: DTSBX520 +00078 * DTSBX520 +00079 * DTSBU001 DATE EDIT/CONVERSION. DTSBX520 +00080 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX520 +00081 * DTSBU910 MASTER FILE I/O. DTSBX520 +00082 * DTSBX520 +00083 * DTSBX520 +00084 * DTSBX520 +00085 ***** DTSBX520 +00086 SKIP3 DTSBX520 +00087 ENVIRONMENT DIVISION. DTSBX520 +00088 INPUT-OUTPUT SECTION. DTSBX520 +00089 FILE-CONTROL. DTSBX520 +00090 SELECT SERVER-FILE ASSIGN TO DTSFSERV DTSBX520 +00091 FILE STATUS IS SRVR-STATUS. DTSBX520 +00092 DTSBX520 +00093 DTSBX520 +00094 DATA DIVISION. DTSBX520 +00095 FILE SECTION. DTSBX520 +00096 FD SERVER-FILE DTSBX520 +00097 RECORDING MODE IS F DTSBX520 +00098 LABEL RECORDS ARE STANDARD DTSBX520 +00099 BLOCK CONTAINS 0 CHARACTERS. DTSBX520 +00100 DTSBX520 +00101 01 SERVER-REC. DTSBX520 +00102 05 SRVR-EMP-NO PIC 9(06). DTSBX520 +00103 DTSBX520 +00104 DTSBX520 +00105 WORKING-STORAGE SECTION. DTSBX520 +001055 77 PAN-VALET PICTURE X(24) VALUE '028DTSBX520 12/10/15'. DTSBX520 +00106 77 PAN-VALET PICTURE X(24) VALUE '002DTSBX340 10/10/13'. DTSBX520 +00107 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX340 03/12/12'. DTSBX520 +00108 SKIP3 DTSBX520 +00109 01 W-AREA. DTSBX520 +00110 05 W-ABEND-CD PIC S9(04) COMP VALUE +340.DTSBX520 +00111 DTSBX520 +00112 05 W-TRACE-IND PIC X(01) VALUE SPACE. DTSBX520 +00113 05 W-MOD-NAME PIC X(08) VALUE 'DTSBE340'.DTSBX520 +00114 DTSBX520 +00115 05 ABEND-MSG PIC X(60). DTSBX520 +00116 DTSBX520 +00117 05 SRVR-STATUS PIC X(02). DTSBX520 +00118 88 SRVR-STATUS-OK-88 VALUE '00'. DTSBX520 +00119 88 SRVR-STATUS-EOF-88 VALUE '10'. DTSBX520 +00120 DTSBX520 +00121 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX520 +00122 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX520 +00123 88 W-ERROR-NO-88 VALUE 'N'. DTSBX520 +00124 DTSBX520 +00125 05 W-RUN-TYPE PIC X(01). DTSBX520 +00126 88 W-RUN-CONVERT-88 VALUE '0'. DTSBX520 +00127 88 W-RUN-INCREMENTAL-88 VALUE '1'. DTSBX520 +00128 DTSBX520 +00129 05 W-SELECT-IND PIC X(01) VALUE 'N'. DTSBX520 +00130 88 W-SELECT-NO-88 VALUE '0'. DTSBX520 +00131 88 W-SELECT-ALL-88 VALUE '1'. DTSBX520 +00132 88 W-SELECT-UPD-88 VALUE '2'. DTSBX520 +00133 88 W-SELECT-PRF-88 VALUE '3'. DTSBX520 +00134 DTSBX520 +00135 05 W-SELECT-NAME-IND PIC X(01). DTSBX520 +00136 88 W-SELECT-NAME-YES-88 VALUE 'Y'. DTSBX520 +00137 88 W-SELECT-NAME-NO-88 VALUE 'N'. DTSBX520 +00138 05 W-SELECT-ADDR-IND PIC X(01). DTSBX520 +00139 88 W-SELECT-ADDR-YES-88 VALUE 'Y'. DTSBX520 +00140 88 W-SELECT-ADDR-NO-88 VALUE 'N'. DTSBX520 +00141 05 W-SELECT-OPO-IND PIC X(01). DTSBX520 +00142 88 W-SELECT-OPO-YES-88 VALUE 'Y'. DTSBX520 +00143 88 W-SELECT-OPO-NO-88 VALUE 'N'. DTSBX520 +00144 05 W-SELECT-SOL-IND PIC X(01). DTSBX520 +00145 88 W-SELECT-SOL-YES-88 VALUE 'Y'. DTSBX520 +00146 88 W-SELECT-SOL-NO-88 VALUE 'N'. DTSBX520 +00147 05 W-SELECT-FSC-IND PIC X(01). DTSBX520 +00148 88 W-SELECT-FSC-YES-88 VALUE 'Y'. DTSBX520 +00149 88 W-SELECT-FSC-NO-88 VALUE 'N'. DTSBX520 +00150 05 W-SELECT-RATE-IND PIC X(01). DTSBX520 +00151 88 W-SELECT-RATE-YES-88 VALUE 'Y'. DTSBX520 +00152 88 W-SELECT-RATE-NO-88 VALUE 'N'. DTSBX520 +00153 DTSBX520 +00154 ** 05 W-SUBJECT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX520 +00155 05 W-CUTOFF-DATE PIC S9(09) COMP-3 DTSBX520 +00156 VALUE +20020101. DTSBX520 +00157 05 W-LAST-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX520 +00158 05 W-INACT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX520 +00159 05 W-INACT-CUTOFF PIC S9(09) COMP-3 VALUE +0. DTSBX520 +00160 05 W-JRN-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBX520 +00161 05 W-HOLD-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX520 +00162 05 W-SUBJ-EMP-IND PIC X(01). DTSBX520 +00163 88 W-SUBJ-EMP-YES-88 VALUE 'Y'. DTSBX520 +00164 88 W-SUBJ-EMP-NO-88 VALUE 'N'. DTSBX520 +00165 05 W-ACTIVE-JRN-IND PIC X(01). DTSBX520 +00166 88 W-ACTIVE-JRN-YES-88 VALUE 'Y'. DTSBX520 +00167 88 W-ACTIVE-JRN-NO-88 VALUE 'N'. DTSBX520 +00168 DTSBX520 +00169 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX520 +00170 05 W-SERVER-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX520 +00171 05 W-SELECT-NO-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX520 +00172 05 W-SELECT-PRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX520 +00173 05 W-SELECT-ALL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX520 +00174 05 W-SELECT-UPD-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX520 +00175 05 DISPLAY-CNT PIC Z(06)9. DTSBX520 +00176 DTSBX520 +00177 05 DISPLAY-AMT1-X PIC X(14). DTSBX520 +00178 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX520 +00179 PIC ---,---,--9.99. DTSBX520 +00180 05 DISPLAY-AMT2-X PIC X(14). DTSBX520 +00181 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX520 +00182 PIC ---,---,--9.99. DTSBX520 +00183 05 DISPLAY-AMT3-X PIC X(14). DTSBX520 +00184 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX520 +00185 PIC ---,---,--9.99. DTSBX520 +00186 05 DISPLAY-AMT4-X PIC X(14). DTSBX520 +00187 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX520 +00188 PIC ---,---,--9.99. DTSBX520 +00189 EJECT DTSBX520 +00190 01 L001-LINK-AREA. DTSBX520 +00191 ++INCLUDE DTSIL001 DTSBX520 +00192 EJECT DTSBX520 +00193 01 L003-LINK-AREA. DTSBX520 +00194 ++INCLUDE DTSIL003 DTSBX520 +00195 EJECT DTSBX520 +00196 01 L004-LINK-AREA. DTSBX520 +00197 ++INCLUDE DTSIL004 DTSBX520 +00198 EJECT DTSBX520 +00199 01 L005-LINK-AREA. DTSBX520 +00200 ++INCLUDE DTSIL005 DTSBX520 +00201 DTSBX520 +00202 01 LX34-LINK-AREA. DTSBX520 +00203 ++INCLUDE DTSILX34 DTSBX520 +00204 EJECT DTSBX520 +00205 01 L910-LINK-AREA. DTSBX520 +00206 ++INCLUDE DTSIL910 DTSBX520 +00207 SKIP3 DTSBX520 +00208 01 MSKL-REC. DTSBX520 +00209 ++INCLUDE DTSIMSKL DTSBX520 +00210 SKIP3 DTSBX520 +00211 01 MHDR-REC. DTSBX520 +00212 ++INCLUDE DTSIMHDR DTSBX520 +00213 SKIP3 DTSBX520 +00214 01 MPRF-REC. DTSBX520 +00215 ++INCLUDE DTSIMPRF DTSBX520 +00216 EJECT DTSBX520 +00217 01 MQTR-REC. DTSBX520 +00218 ++INCLUDE DTSIMQTR DTSBX520 +00219 SKIP3 DTSBX520 +00220 01 MJRN-REC. DTSBX520 +00221 ++INCLUDE DTSIMJRN DTSBX520 +00222 SKIP3 DTSBX520 +00223 01 MRPT-REC. DTSBX520 +00224 ++INCLUDE DTSIMRPT DTSBX520 +00225 SKIP3 DTSBX520 +00226 01 MADJ-REC. DTSBX520 +00227 ++INCLUDE DTSIMADJ DTSBX520 +00228 SKIP3 DTSBX520 +00229 01 MPAY-REC. DTSBX520 +00230 ++INCLUDE DTSIMPAY DTSBX520 +00231 SKIP3 DTSBX520 +00232 01 MRTE-REC. DTSBX520 +00233 ++INCLUDE DTSIMRTE DTSBX520 +00234 SKIP3 DTSBX520 +00235 01 MEVL-REC. DTSBX520 +00236 ++INCLUDE DTSIMEVL DTSBX520 +00237 SKIP3 DTSBX520 +00238 01 MSOL-REC. DTSBX520 +00239 ++INCLUDE DTSIMSOL DTSBX520 +00240 SKIP3 DTSBX520 +00241 01 MFSC-REC. DTSBX520 +00242 ++INCLUDE DTSIMFSC DTSBX520 +00243 SKIP3 DTSBX520 +00244 01 MTAD-REC. DTSBX520 +00245 ++INCLUDE DTSIMTAD DTSBX520 +00246 SKIP3 DTSBX520 +00247 01 MTAA-REC. DTSBX520 +00248 ++INCLUDE DTSIMTAA DTSBX520 +00249 SKIP3 DTSBX520 +00250 01 MLOG-REC. DTSBX520 +00251 ++INCLUDE DTSIMLOG DTSBX520 +00252 SKIP3 DTSBX520 +00253 01 L921-LINK-AREA. DTSBX520 +00254 ++INCLUDE DTSIL921 DTSBX520 +00255 SKIP3 DTSBX520 +00256 01 ISKL-REC. DTSBX520 +00257 ++INCLUDE DTSIISKL DTSBX520 +00258 DTSBX520 +00259 01 L931-LINK-AREA. DTSBX520 +00260 ++INCLUDE DTSIL931 DTSBX520 +00261 SKIP3 DTSBX520 +00262 01 FSKL-REC. DTSBX520 +00263 ++INCLUDE DTSIFSKL DTSBX520 +00264 SKIP3 DTSBX520 +00265 01 FQTR-REC. DTSBX520 +00266 ++INCLUDE DTSIFQTR DTSBX520 +00267 DTSBX520 +00268 LINKAGE SECTION. DTSBX520 +00269 SKIP3 DTSBX520 +00270 01 PARM-AREA. DTSBX520 +00271 05 PARM-LENGTH PIC S9(04) COMP. DTSBX520 +00272 05 PARM-DATA. DTSBX520 +00273 10 PARM-RUN-TYPE PIC X(01). DTSBX520 +00274 88 PARM-RUN-CONVERT-88 VALUE '0'. DTSBX520 +00275 88 PARM-RUN-INCREMENTAL-88 VALUE '1'. DTSBX520 +00276 88 PARM-RUN-VALID-88 VALUE '0', '1'. DTSBX520 +00277 DTSBX520 +00278 PROCEDURE DIVISION USING PARM-AREA. DTSBX520 +00279 DTSBX520 +00280 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX520 +00281 IF W-ERROR-NO-88 DTSBX520 +00282 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX520 +00283 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX520 +00284 END-IF. DTSBX520 +00285 DTSBX520 +00286 GOBACK. DTSBX520 +00287 DTSBX520 +00288 I0000-INITIALIZE. DTSBX520 +00289 SKIP2 DTSBX520 +00290 MOVE W-TRACE-IND TO L910-TRACE-IND. DTSBX520 +00291 DTSBX520 +00292 MOVE W-MOD-NAME TO L910-MOD-NAME. DTSBX520 +00293 DTSBX520 +00294 SET L005-FROM-SYS TO TRUE. DTSBX520 +00295 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX520 +00296 DTSBX520 +00297 PERFORM I1000-EDIT-PARM THRU I1000-EXIT. DTSBX520 +00298 IF W-ERROR-YES-88 DTSBX520 +00299 GO TO I0000-EXIT DTSBX520 +00300 END-IF. DTSBX520 +00301 DTSBX520 +00302 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX520 +00303 IF W-ERROR-YES-88 DTSBX520 +00304 GO TO I0000-EXIT DTSBX520 +00305 END-IF. DTSBX520 +00306 DTSBX520 +00307 PERFORM I3000-GET-MHDR THRU I3000-EXIT. DTSBX520 +00308 DTSBX520 +00309 PERFORM I4000-INIT-LINKAGE THRU I4000-EXIT. DTSBX520 +00310 DTSBX520 +00311 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSBX520 +00312 DTSBX520 +00313 I0000-EXIT. DTSBX520 +00314 EXIT. DTSBX520 +00315 EJECT DTSBX520 +00316 I1000-EDIT-PARM. DTSBX520 +00317 IF PARM-RUN-VALID-88 DTSBX520 +00318 MOVE PARM-RUN-TYPE TO W-RUN-TYPE DTSBX520 +00319 IF W-RUN-CONVERT-88 DTSBX520 +00320 DISPLAY 'BX340 RUN TYPE: CONVERT' DTSBX520 +00321 ELSE DTSBX520 +00322 IF W-RUN-INCREMENTAL-88 DTSBX520 +00323 DISPLAY 'BX340 RUN TYPE: INCREMENTAL' DTSBX520 +00324 END-IF DTSBX520 +00325 END-IF DTSBX520 +00326 ELSE DTSBX520 +00327 DISPLAY 'INVALID RUN TYPE: ' PARM-RUN-TYPE DTSBX520 +00328 DISPLAY 'BX340 TERMINATING' DTSBX520 +00329 SET W-ERROR-YES-88 TO TRUE DTSBX520 +00330 END-IF. DTSBX520 +00331 DTSBX520 +00332 I1000-EXIT. DTSBX520 +00333 EXIT. DTSBX520 +00334 DTSBX520 +00335 DTSBX520 +00336 I2000-OPEN-FILES. DTSBX520 +00337 OPEN INPUT SERVER-FILE. DTSBX520 +00338 IF NOT SRVR-STATUS-OK-88 DTSBX520 +00339 DISPLAY 'OPEN ERROR ON SERVER FILE ' SRVR-STATUS DTSBX520 +00340 SET W-ERROR-YES-88 TO TRUE DTSBX520 +00341 GO TO I2000-EXIT DTSBX520 +00342 END-IF. DTSBX520 +00343 DTSBX520 +00344 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX520 +00345 DTSBX520 +00346 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX520 +00347 DTSBX520 +00348 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX520 +00349 DTSBX520 +00350 DTSBX520 +00351 I2000-EXIT. DTSBX520 +00352 EXIT. DTSBX520 +00353 DTSBX520 +00354 I3000-GET-MHDR. DTSBX520 +00355 MOVE LOW-VALUES TO MSKL-REC. DTSBX520 +00356 MOVE +0 TO MSKL-EMP-NO. DTSBX520 +00357 SET MSKL-HDR-88 TO TRUE. DTSBX520 +00358 DTSBX520 +00359 PERFORM S910-READ THRU S910-EXIT. DTSBX520 +00360 IF L910-NO-REC-88 DTSBX520 +00361 DISPLAY 'DTSBX340: MHDR RECORD IS MISSING' DTSBX520 +00362 SET W-ERROR-YES-88 TO TRUE DTSBX520 +00363 GO TO I3000-EXIT DTSBX520 +00364 ELSE DTSBX520 +00365 MOVE MSKL-REC TO MHDR-REC DTSBX520 +00366 END-IF. DTSBX520 +00367 DTSBX520 +00368 I3000-EXIT. DTSBX520 +00369 EXIT. DTSBX520 +00370 DTSBX520 +00371 I4000-INIT-LINKAGE. DTSBX520 +00372 MOVE MHDR-CURR-RUN-DATE TO LX34-CURR-RUN-DATE. CL*22 +00373 MOVE MHDR-PRIOR-RUN-DATE TO LX34-PRIOR-RUN-DATE. CL*22 +00374 MOVE L005-DATE TO LX34-SYS-DATE. DTSBX520 +00375 MOVE L005-TIME TO LX34-SYS-TIME. DTSBX520 +00376 DTSBX520 +00377 MOVE MHDR-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX520 +00378 SUBTRACT +1 FROM L001-FED-8-YR. DTSBX520 +00379 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX520 +00380 MOVE L001-JUL-ABS-DAY TO W-JRN-ABSTIME. DTSBX520 +00381 SUBTRACT +2 FROM L001-FED-8-YR. DTSBX520 +00382 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX520 +00383 MOVE L001-FED-8-DATE-9 TO L004-DATE. DTSBX520 +00384 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX520 +00385 MOVE L004-QTR-5-9 TO LX34-3-YRS-AGO-YRQ. DTSBX520 +00386 DTSBX520 +00387 ** MOVE MHDR-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX520 +00388 * SUBTRACT +3 FROM L001-FED-8-YR. DTSBX520 +00389 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX520 +00390 * MOVE L001-FED-8-DATE-9 TO L004-DATE. DTSBX520 +00391 * PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX520 +00392 * MOVE L004-QTR-5-9 TO LX34-3-YRS-AGO-YRQ. DTSBX520 +00393 * DTSBX520 +00394 * MOVE MHDR-CURR-RUN-DATE TO L005-DATE. DTSBX520 +00395 * MOVE ZERO TO L005-TIME. DTSBX520 +00396 * SET L005-FROM-DATE-TIME TO TRUE. DTSBX520 +00397 * PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX520 +00398 ** MOVE L005-ABSTIME TO W-JRN-ABSTIME. DTSBX520 +00399 DTSBX520 +00400 MOVE MHDR-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX520 +00401 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX520 +00402 SUBTRACT +1 FROM L001-JUL-ABS-DAY. DTSBX520 +00403 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBX520 +00404 MOVE L001-FED-8-DATE-9 TO L005-DATE. DTSBX520 +00405 MOVE ZERO TO L005-TIME. DTSBX520 +00406 SET L005-FROM-DATE-TIME TO TRUE. DTSBX520 +00407 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX520 +00408 MOVE L005-ABSTIME TO LX34-ABSTIME. DTSBX520 +00409 DTSBX520 +00410 MOVE MHDR-PRIOR-RUN-DATE TO L004-DATE. DTSBX520 +00411 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX520 +00412 SUBTRACT +2 FROM L004-ABS-QTR. DTSBX520 +00413 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX520 +00414 MOVE L004-QTR-START-DATE TO W-INACT-CUTOFF. DTSBX520 +00415 DTSBX520 +00416 MOVE W-CUTOFF-DATE TO LX34-CUTOFF-DATE. DTSBX520 +00417 DTSBX520 +00418 IF W-RUN-INCREMENTAL-88 DTSBX520 +00419 SET LX34-RUN-INCREMENTAL-88 TO TRUE DTSBX520 +00420 ELSE DTSBX520 +00421 IF W-RUN-CONVERT-88 DTSBX520 +00422 SET LX34-RUN-CONVERT-88 TO TRUE DTSBX520 +00423 END-IF DTSBX520 +00424 END-IF. DTSBX520 +00425 DTSBX520 +00426 DISPLAY '********************************'. DTSBX520 +00427 DISPLAY ' DTSBX340'. DTSBX520 +00428 DISPLAY ' 3 YEARS AGO ' LX34-3-YRS-AGO-YRQ. DTSBX520 +00429 DISPLAY ' INACT CUTOFF ' W-INACT-CUTOFF. DTSBX520 +00430 DISPLAY '********************************'. DTSBX520 +00431 DISPLAY SPACE. DTSBX520 +00432 DTSBX520 +00433 I4000-EXIT. DTSBX520 +00434 EXIT. DTSBX520 +00435 DTSBX520 +00436 I5000-INITIAL-CALLS. DTSBX520 +00437 SET LX34-INITIALIZE-88 TO TRUE. DTSBX520 +00438 DTSBX520 +00439 PERFORM S341-STATUS THRU S341-EXIT. CL*24 +00440 ** PERFORM S342-ACCT-DAILY THRU S342-EXIT. DTSBX520 +00441 PERFORM S355-ACCT-CONVERT THRU S355-EXIT. CL*27 +00442 ** PERFORM S344-DELINQ-COLL THRU S344-EXIT. CL*23 +00443 * PERFORM S346-CHARGES THRU S346-EXIT. DTSBX520 +00444 DTSBX520 +00445 I5000-EXIT. DTSBX520 +00446 EXIT. DTSBX520 +00447 DTSBX520 +00448 P0000-PROCESS. DTSBX520 +00449 SET LX34-PROCESS-88 TO TRUE. DTSBX520 +00450 DTSBX520 +00451 IF LX34-RUN-CONVERT-88 DTSBX520 +00452 PERFORM P1000-CONVERT THRU P1000-EXIT DTSBX520 +00453 ELSE DTSBX520 +00454 PERFORM P2000-INCREMENTAL THRU P2000-EXIT DTSBX520 +00455 END-IF. DTSBX520 +00456 DTSBX520 +00457 * PERFORM S346-CHARGES THRU S346-EXIT. DTSBX520 +00458 DTSBX520 +00459 PERFORM S348-HOLIDAYS THRU S348-EXIT. DTSBX520 +00460 P0000-EXIT. DTSBX520 +00461 EXIT. DTSBX520 +00462 DTSBX520 +00463 P1000-CONVERT. DTSBX520 +00464 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX520 +00465 MOVE +0 TO MSKL-EMP-NO. DTSBX520 +00466 SET MSKL-PRF-88 TO TRUE. DTSBX520 +00467 DTSBX520 +00468 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX520 +00469 IF NOT L910-OK-88 DTSBX520 +00470 DISPLAY 'CANNOT READ MASTER FILE ' DTSBX520 +00471 GO TO P1000-EXIT DTSBX520 +00472 END-IF. DTSBX520 +00473 DTSBX520 +00474 PERFORM DTSBX520 +00475 UNTIL L910-NO-REC-88 DTSBX520 +00476 OR W-ERROR-YES-88 DTSBX520 +00477 ADD +1 TO W-MPRF-CNT DTSBX520 +00478 MOVE MSKL-REC TO MPRF-REC DTSBX520 +00479 PERFORM P1100-SELECT THRU P1100-EXIT DTSBX520 +00480 IF W-SELECT-PRF-88 DTSBX520 +00481 PERFORM S341-STATUS THRU S341-EXIT DTSBX520 +00482 ELSE DTSBX520 +00483 IF W-SELECT-ALL-88 DTSBX520 +00484 PERFORM S341-STATUS THRU S341-EXIT CL*24 +00485 PERFORM S355-ACCT-CONVERT THRU S355-EXIT CL*27 +00486 ** PERFORM S344-DELINQ-COLL THRU S344-EXIT CL*23 +00487 END-IF DTSBX520 +00488 END-IF DTSBX520 +00489 MOVE MPRF-REC TO MSKL-REC DTSBX520 +00490 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX520 +00491 END-PERFORM. DTSBX520 +00492 DTSBX520 +00493 P1000-EXIT. DTSBX520 +00494 EXIT. DTSBX520 +00495 DTSBX520 +00496 P1100-SELECT. DTSBX520 +00497 PERFORM S3000-INITIALIZE THRU S3000-EXIT. DTSBX520 +00498 DTSBX520 +00499 IF MPRF-CLASS-CHG-ONLY-88 DTSBX520 +00500 SET W-SELECT-PRF-88 TO TRUE DTSBX520 +00501 PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT DTSBX520 +00502 GO TO P1100-EXIT DTSBX520 +00503 END-IF. DTSBX520 +00504 DTSBX520 +00505 ** IF MPRF-CLASS-CHG-ONLY-88 DTSBX520 +00506 * IF MPRF-ELIGIBLE-DC-GOV-88 DTSBX520 +00507 * SET W-SELECT-PRF-88 TO TRUE DTSBX520 +00508 * PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT DTSBX520 +00509 * GO TO P1100-EXIT DTSBX520 +00510 * END-IF DTSBX520 +00511 ** END-IF. DTSBX520 +00512 DTSBX520 +00513 IF MPRF-STATUS-INACT-88 DTSBX520 +00514 PERFORM P1110-INACT-DATES THRU P1110-EXIT DTSBX520 +00515 IF W-LAST-LIAB-YRQ < LX34-3-YRS-AGO-YRQ DTSBX520 +00516 IF MPRF-TOT-BALANCE-AMT > ZERO DTSBX520 +00517 OR MPRF-TOT-CREDIT-AMT > ZERO DTSBX520 +00518 OR MPRF-PURSUED-RPT-CNT > ZERO DTSBX520 +00519 OR W-INACT-DATE >= W-INACT-CUTOFF DTSBX520 +00520 OR W-ACTIVE-JRN-YES-88 DTSBX520 +00521 SET W-SELECT-ALL-88 TO TRUE DTSBX520 +00522 ELSE DTSBX520 +00523 SET W-SELECT-PRF-88 TO TRUE DTSBX520 +00524 END-IF DTSBX520 +00525 ELSE DTSBX520 +00526 SET W-SELECT-ALL-88 TO TRUE DTSBX520 +00527 END-IF DTSBX520 +00528 ELSE DTSBX520 +00529 SET W-SELECT-ALL-88 TO TRUE DTSBX520 +00530 END-IF. DTSBX520 +00531 DTSBX520 +00532 IF (MPRF-STATUS-NEVERSUB-88 DTSBX520 +00533 OR MPRF-STATUS-UNK-88) DTSBX520 +00534 SET W-SELECT-ALL-88 TO TRUE DTSBX520 +00535 **** PERFORM S2000-UNKNOWN THRU S2000-EXIT DTSBX520 +00536 END-IF. DTSBX520 +00537 DTSBX520 +00538 PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT. DTSBX520 +00539 DTSBX520 +00540 IF W-SELECT-NO-88 DTSBX520 +00541 ADD +1 TO W-SELECT-NO-CNT DTSBX520 +00542 END-IF. DTSBX520 +00543 DTSBX520 +00544 EVALUATE TRUE DTSBX520 +00545 WHEN W-SELECT-NO-88 DTSBX520 +00546 ADD +1 TO W-SELECT-NO-CNT DTSBX520 +00547 DTSBX520 +00548 WHEN W-SELECT-PRF-88 DTSBX520 +00549 ADD +1 TO W-SELECT-PRF-CNT DTSBX520 +00550 DTSBX520 +00551 WHEN W-SELECT-ALL-88 DTSBX520 +00552 ADD +1 TO W-SELECT-ALL-CNT DTSBX520 +00553 DTSBX520 +00554 END-EVALUATE. DTSBX520 +00555 DTSBX520 +00556 P1100-EXIT. DTSBX520 +00557 EXIT. DTSBX520 +00558 DTSBX520 +00559 P1110-INACT-DATES. DTSBX520 +00560 MOVE ZERO TO W-LAST-LIAB-YRQ DTSBX520 +00561 W-INACT-DATE. DTSBX520 +00562 SET W-ACTIVE-JRN-NO-88 TO TRUE. DTSBX520 +00563 DTSBX520 +00564 MOVE LOW-VALUES TO MSOL-REC DTSBX520 +00565 MOVE MPRF-EMP-NO TO MSOL-EMP-NO DTSBX520 +00566 SET MSOL-SOL-88 TO TRUE DTSBX520 +00567 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA DTSBX520 +00568 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBX520 +00569 PERFORM UNTIL L910-NO-REC-88 DTSBX520 +00570 MOVE MSKL-REC TO MSOL-REC DTSBX520 +00571 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBX520 +00572 IF MSOL-INACT-INACTIVE-88 DTSBX520 +00573 IF MSOL-LAST-LIAB-YRQ > W-LAST-LIAB-YRQ DTSBX520 +00574 MOVE MSOL-LAST-LIAB-YRQ DTSBX520 +00575 TO W-LAST-LIAB-YRQ DTSBX520 +00576 MOVE MSOL-INACT-ENTER-DATE DTSBX520 +00577 TO W-INACT-DATE DTSBX520 +00578 END-IF DTSBX520 +00579 END-IF DTSBX520 +00580 END-IF DTSBX520 +00581 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX520 +00582 END-PERFORM. DTSBX520 +00583 DTSBX520 +00584 ** IF W-INACT-DATE >= W-INACT-CUTOFF DTSBX520 +00585 * DISPLAY 'INACT WITHIN 2 QTRS ' MPRF-EMP-NO DTSBX520 +00586 ** END-IF. DTSBX520 +00587 DTSBX520 +00588 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX520 +00589 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBX520 +00590 SET MJRN-JRN-88 TO TRUE. DTSBX520 +00591 MOVE W-JRN-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBX520 +00592 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX520 +00593 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX520 +00594 IF L910-OK-88 DTSBX520 +00595 IF W-LAST-LIAB-YRQ < LX34-3-YRS-AGO-YRQ DTSBX520 +00596 SET W-ACTIVE-JRN-YES-88 TO TRUE DTSBX520 +00597 ** DISPLAY 'BX340 INACT > 3, ACT JRN ' MPRF-EMP-NO DTSBX520 +00598 END-IF DTSBX520 +00599 END-IF. DTSBX520 +00600 DTSBX520 +00601 P1110-EXIT. DTSBX520 +00602 EXIT. DTSBX520 +00603 DTSBX520 +00604 P2000-INCREMENTAL. DTSBX520 +00605 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX520 +00606 MOVE +0 TO MSKL-EMP-NO. DTSBX520 +00607 SET MSKL-PRF-88 TO TRUE. DTSBX520 +00608 DTSBX520 +00609 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX520 +00610 IF NOT L910-OK-88 DTSBX520 +00611 DISPLAY 'CANNOT READ MASTER FILE ' DTSBX520 +00612 GO TO P2000-EXIT DTSBX520 +00613 ELSE DTSBX520 +00614 MOVE MSKL-REC TO MPRF-REC DTSBX520 +00615 END-IF. DTSBX520 +00616 DTSBX520 +00617 PERFORM S1000-READ-SRVR THRU S1000-EXIT. DTSBX520 +00618 IF W-ERROR-YES-88 DTSBX520 +00619 DISPLAY 'CANNOT READ SERVER FILE ' DTSBX520 +00620 GO TO P2000-EXIT DTSBX520 +00621 END-IF. DTSBX520 +00622 DTSBX520 +00623 PERFORM DTSBX520 +00624 UNTIL (L910-NO-REC-88 DTSBX520 +00625 OR SRVR-STATUS-EOF-88 DTSBX520 +00626 OR W-ERROR-YES-88) DTSBX520 +00627 SET W-SELECT-NO-88 TO TRUE DTSBX520 +00628 IF MPRF-EMP-NO < SRVR-EMP-NO DTSBX520 +00629 PERFORM P2100-EXTRACT THRU P2100-EXIT DTSBX520 +00630 PERFORM P2010-READ-MPRF THRU P2010-EXIT DTSBX520 +00631 ELSE DTSBX520 +00632 IF MPRF-EMP-NO = SRVR-EMP-NO DTSBX520 +00633 SET W-SELECT-UPD-88 TO TRUE DTSBX520 +00634 PERFORM P2100-EXTRACT THRU P2100-EXIT DTSBX520 +00635 PERFORM P2010-READ-MPRF THRU P2010-EXIT DTSBX520 +00636 PERFORM S1000-READ-SRVR THRU S1000-EXIT DTSBX520 +00637 ELSE DTSBX520 +00638 DISPLAY 'P2000 ERROR > NO MPRF ' SRVR-EMP-NO DTSBX520 +00639 PERFORM S1000-READ-SRVR THRU S1000-EXIT DTSBX520 +00640 END-IF DTSBX520 +00641 END-IF DTSBX520 +00642 END-PERFORM. DTSBX520 +00643 DTSBX520 +00644 IF SRVR-STATUS-EOF-88 DTSBX520 +00645 AND L910-OK-88 DTSBX520 +00646 PERFORM UNTIL L910-NO-REC-88 DTSBX520 +00647 SET W-SELECT-NO-88 TO TRUE DTSBX520 +00648 PERFORM P2100-EXTRACT THRU P2100-EXIT DTSBX520 +00649 PERFORM P2010-READ-MPRF THRU P2010-EXIT DTSBX520 +00650 END-PERFORM DTSBX520 +00651 END-IF. DTSBX520 +00652 DTSBX520 +00653 IF SRVR-STATUS-OK-88 DTSBX520 +00654 AND L910-NO-REC-88 DTSBX520 +00655 PERFORM UNTIL SRVR-STATUS-EOF-88 DTSBX520 +00656 DISPLAY 'P2000 EOF ERR > NO MPRF ' SRVR-EMP-NO DTSBX520 +00657 READ SERVER-FILE DTSBX520 +00658 END-PERFORM DTSBX520 +00659 END-IF. DTSBX520 +00660 DTSBX520 +00661 P2000-EXIT. DTSBX520 +00662 EXIT. DTSBX520 +00663 DTSBX520 +00664 P2010-READ-MPRF. DTSBX520 +00665 MOVE MPRF-REC TO MSKL-REC. DTSBX520 +00666 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX520 +00667 MOVE MSKL-REC TO MPRF-REC. DTSBX520 +00668 DTSBX520 +00669 P2010-EXIT. DTSBX520 +00670 EXIT. DTSBX520 +00671 DTSBX520 +00672 P2100-EXTRACT. DTSBX520 +00673 PERFORM S3000-INITIALIZE THRU S3000-EXIT. DTSBX520 +00674 IF MPRF-EMP-NO = SRVR-EMP-NO DTSBX520 +00675 SET W-SELECT-UPD-88 TO TRUE DTSBX520 +00676 END-IF. DTSBX520 +00677 DTSBX520 +00678 EVALUATE TRUE DTSBX520 +00679 WHEN MPRF-CLASS-CHG-ONLY-88 DTSBX520 +00680 IF MPRF-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX520 +00681 OR MPRF-CHNG-DATE = LX34-PRIOR-RUN-DATE DTSBX520 +00682 SET W-SELECT-PRF-88 TO TRUE DTSBX520 +00683 ** DISPLAY 'BX340 CHG ONLY ' MPRF-EMP-NO DTSBX520 +00684 ** ' ' W-SELECT-IND DTSBX520 +00685 END-IF DTSBX520 +00686 DTSBX520 +00687 WHEN MPRF-CLASS-SUB-88 DTSBX520 +00688 IF W-SELECT-UPD-88 DTSBX520 +00689 PERFORM P2110-CHK-CHANGES THRU P2110-EXIT DTSBX520 +00690 ELSE DTSBX520 +00691 IF MPRF-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX520 +00692 OR MPRF-CHNG-DATE = LX34-PRIOR-RUN-DATE DTSBX520 +00693 ** DISPLAY 'BX340 NEWLY SUBJECT ' MPRF-EMP-NO DTSBX520 +00694 SET W-SELECT-ALL-88 TO TRUE DTSBX520 +00695 END-IF DTSBX520 +00696 END-IF DTSBX520 +00697 DTSBX520 +00698 WHEN MPRF-CLASS-UNK-88 DTSBX520 +00699 IF NOT W-SELECT-UPD-88 DTSBX520 +00700 PERFORM S2000-UNKNOWN THRU S2000-EXIT DTSBX520 +00701 END-IF DTSBX520 +00702 END-EVALUATE. DTSBX520 +00703 DTSBX520 +00704 EVALUATE TRUE DTSBX520 +00705 WHEN W-SELECT-NO-88 DTSBX520 +00706 ADD +1 TO W-SELECT-NO-CNT DTSBX520 +00707 DTSBX520 +00708 WHEN W-SELECT-PRF-88 DTSBX520 +00709 ADD +1 TO W-SELECT-PRF-CNT DTSBX520 +00710 DTSBX520 +00711 WHEN W-SELECT-ALL-88 DTSBX520 +00712 ADD +1 TO W-SELECT-ALL-CNT DTSBX520 +00713 DTSBX520 +00714 WHEN W-SELECT-UPD-88 DTSBX520 +00715 ADD +1 TO W-SELECT-UPD-CNT DTSBX520 +00716 DTSBX520 +00717 END-EVALUATE. DTSBX520 +00718 DTSBX520 +00719 PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT. DTSBX520 +00720 DTSBX520 +00721 EVALUATE TRUE DTSBX520 +00722 WHEN W-SELECT-PRF-88 DTSBX520 +00723 PERFORM S341-STATUS THRU S341-EXIT DTSBX520 +00724 DTSBX520 +00725 WHEN W-SELECT-UPD-88 DTSBX520 +00726 PERFORM S341-STATUS THRU S341-EXIT DTSBX520 +00727 ** PERFORM S342-ACCT-DAILY THRU S342-EXIT DTSBX520 +00728 *& PERFORM S344-DELINQ-COLL THRU S344-EXIT DTSBX520 +00729 DTSBX520 +00730 WHEN W-SELECT-ALL-88 DTSBX520 +00731 PERFORM S341-STATUS THRU S341-EXIT CL*24 +00732 PERFORM S355-ACCT-CONVERT THRU S355-EXIT CL*27 +00733 *& PERFORM S344-DELINQ-COLL THRU S344-EXIT DTSBX520 +00734 DTSBX520 +00735 END-EVALUATE. DTSBX520 +00736 DTSBX520 +00737 DTSBX520 +00738 P2100-EXIT. DTSBX520 +00739 EXIT. DTSBX520 +00740 DTSBX520 +00741 P2110-CHK-CHANGES. DTSBX520 +00742 MOVE LOW-VALUES TO MLOG-REC. DTSBX520 +00743 MOVE MPRF-EMP-NO TO MLOG-EMP-NO. DTSBX520 +00744 SET MLOG-LOG-88 TO TRUE. DTSBX520 +00745 MOVE LX34-ABSTIME TO MLOG-ESTB-ABSTIME. DTSBX520 +00746 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. DTSBX520 +00747 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX520 +00748 DTSBX520 +00749 PERFORM DTSBX520 +00750 UNTIL L910-NO-REC-88 DTSBX520 +00751 MOVE MSKL-REC TO MLOG-REC DTSBX520 +00752 IF MLOG-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX520 +00753 EVALUATE TRUE DTSBX520 +00754 WHEN MLOG-DATA-ELEMENT-NAME = MPRF-PRIMARY-NAME DTSBX520 +00755 SET W-SELECT-NAME-YES-88 TO TRUE DTSBX520 +00756 DISPLAY 'NAME ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX520 +00757 DTSBX520 +00758 WHEN MLOG-DE-REC-TYPE = 'MTAD' DTSBX520 +00759 SET W-SELECT-ADDR-YES-88 TO TRUE DTSBX520 +00760 DISPLAY 'ADDR ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX520 +00761 DTSBX520 +00762 WHEN MLOG-DE-REC-TYPE = 'MOPO' DTSBX520 +00763 SET W-SELECT-OPO-YES-88 TO TRUE DTSBX520 +00764 DISPLAY 'OPO ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX520 +00765 DTSBX520 +00766 WHEN MLOG-DE-REC-TYPE = 'MSOL' DTSBX520 +00767 SET W-SELECT-SOL-YES-88 TO TRUE DTSBX520 +00768 DISPLAY 'SOL ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX520 +00769 DTSBX520 +00770 WHEN MLOG-DE-REC-TYPE = 'MFSC' DTSBX520 +00771 SET W-SELECT-FSC-YES-88 TO TRUE DTSBX520 +00772 DISPLAY 'FSC ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX520 +00773 DTSBX520 +00774 WHEN MLOG-DE-REC-TYPE = 'MRTE' DTSBX520 +00775 SET W-SELECT-RATE-YES-88 TO TRUE DTSBX520 +00776 DISPLAY 'RATE ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX520 +00777 DTSBX520 +00778 END-EVALUATE DTSBX520 +00779 END-IF DTSBX520 +00780 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX520 +00781 END-PERFORM. DTSBX520 +00782 DTSBX520 +00783 P2110-EXIT. DTSBX520 +00784 EXIT. DTSBX520 +00785 DTSBX520 +00786 DTSBX520 +00787 DTSBX520 +00788 DTSBX520 +00789 T0000-TERMINATE. DTSBX520 +00790 DTSBX520 +00791 SET LX34-TERMINATE-88 TO TRUE. DTSBX520 +00792 DTSBX520 +00793 PERFORM S341-STATUS THRU S341-EXIT. CL*24 +00794 ** PERFORM S342-ACCT-DAILY THRU S342-EXIT. DTSBX520 +00795 PERFORM S355-ACCT-CONVERT THRU S355-EXIT. CL*27 +00796 ** PERFORM S344-DELINQ-COLL THRU S344-EXIT. CL*23 +00797 * PERFORM S346-CHARGES THRU S346-EXIT. DTSBX520 +00798 DTSBX520 +00799 CLOSE SERVER-FILE. DTSBX520 +00800 DTSBX520 +00801 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX520 +00802 DTSBX520 +00803 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX520 +00804 DTSBX520 +00805 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX520 +00806 DTSBX520 +00807 DTSBX520 +00808 DISPLAY '*********************************************'. DTSBX520 +00809 DISPLAY '** DTSBX340 TERMINATION STATISTICS **'. DTSBX520 +00810 DISPLAY '** **'. DTSBX520 +00811 DISPLAY '** PROFILE RECORDS READ: ' W-MPRF-CNT DTSBX520 +00812 ' **'. DTSBX520 +00813 DISPLAY '** SERVER RECORDS READ: ' W-SERVER-CNT DTSBX520 +00814 ' **'. DTSBX520 +00815 DISPLAY '** **'. DTSBX520 +00816 DISPLAY '** NOT LIABLE BYPASSED : ' W-SELECT-NO-CNT DTSBX520 +00817 ' **'. DTSBX520 +00818 DISPLAY '** SELECT ALL : ' W-SELECT-ALL-CNT DTSBX520 +00819 ' **'. DTSBX520 +00820 DISPLAY '** SELECT PROFILE : ' W-SELECT-PRF-CNT DTSBX520 +00821 ' **'. DTSBX520 +00822 DISPLAY '** SELECT UPDATE : ' W-SELECT-UPD-CNT DTSBX520 +00823 ' **'. DTSBX520 +00824 DISPLAY '** **'. DTSBX520 +00825 DISPLAY '*********************************************'. DTSBX520 +00826 DTSBX520 +00827 T0000-EXIT. DTSBX520 +00828 EXIT. DTSBX520 +00829 DTSBX520 +00830 S001-FROM-FED-8. DTSBX520 +00831 SET L001-FROM-FED-8 TO TRUE. DTSBX520 +00832 GO TO S001-DATE. DTSBX520 +00833 DTSBX520 +00834 S001-FROM-ABS-DAY. DTSBX520 +00835 SET L001-FROM-ABS-DAY TO TRUE. DTSBX520 +00836 GO TO S001-DATE. DTSBX520 +00837 DTSBX520 +00838 S001-FROM-CAL-6. DTSBX520 +00839 SET L001-FROM-CAL-6 TO TRUE. DTSBX520 +00840 GO TO S001-DATE. DTSBX520 +00841 DTSBX520 +00842 S001-DATE. DTSBX520 +00843 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX520 +00844 S001-EXIT. DTSBX520 +00845 EXIT. DTSBX520 +00846 SKIP3 DTSBX520 +00847 S004-FROM-5. DTSBX520 +00848 SET L004-FROM-5 TO TRUE. DTSBX520 +00849 GO TO S004-QTR. DTSBX520 +00850 DTSBX520 +00851 S004-FROM-ABS. DTSBX520 +00852 SET L004-FROM-ABS TO TRUE. DTSBX520 +00853 GO TO S004-QTR. DTSBX520 +00854 DTSBX520 +00855 S004-FROM-3. DTSBX520 +00856 SET L004-FROM-3 TO TRUE. DTSBX520 +00857 GO TO S004-QTR. DTSBX520 +00858 DTSBX520 +00859 S004-FROM-DATE. DTSBX520 +00860 SET L004-FROM-DATE TO TRUE. DTSBX520 +00861 GO TO S004-QTR. DTSBX520 +00862 DTSBX520 +00863 S004-QTR. DTSBX520 +00864 DTSBX520 +00865 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX520 +00866 DTSBX520 +00867 S004-EXIT. DTSBX520 +00868 EXIT. DTSBX520 +00869 SKIP3 DTSBX520 +00870 S005-FROM-SYS. DTSBX520 +00871 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX520 +00872 S005-EXIT. DTSBX520 +00873 EXIT. DTSBX520 +00874 DTSBX520 +00875 S341-STATUS. DTSBX520 +00876 CALL 'DTSBX341' USING LX34-LINK-AREA DTSBX520 +00877 MPRF-REC. DTSBX520 +00878 DTSBX520 +00879 S341-EXIT. DTSBX520 +00880 EXIT. DTSBX520 +00881 DTSBX520 +00882 S342-ACCT-DAILY. DTSBX520 +00883 CALL 'DTSBX342' USING LX34-LINK-AREA DTSBX520 +00884 MPRF-REC. DTSBX520 +00885 DTSBX520 +00886 S342-EXIT. DTSBX520 +00887 EXIT. DTSBX520 +00888 DTSBX520 +00889 S355-ACCT-CONVERT. CL*27 +00890 CALL 'DTSBX522' USING LX34-LINK-AREA CL*28 +00891 MPRF-REC. DTSBX520 +00892 DTSBX520 +00893 S355-EXIT. CL*27 +00894 EXIT. DTSBX520 +00895 DTSBX520 +00896 S344-DELINQ-COLL. DTSBX520 +00897 CALL 'DTSBX344' USING LX34-LINK-AREA DTSBX520 +00898 MPRF-REC. DTSBX520 +00899 DTSBX520 +00900 S344-EXIT. DTSBX520 +00901 EXIT. DTSBX520 +00902 DTSBX520 +00903 *S346-CHARGES. DTSBX520 +00904 * CALL 'DTSBX346' USING LX34-LINK-AREA DTSBX520 +00905 * MPRF-REC. DTSBX520 +00906 * DTSBX520 +00907 *S346-EXIT. DTSBX520 +00908 * EXIT. DTSBX520 +00909 DTSBX520 +00910 DTSBX520 +00911 S348-HOLIDAYS. DTSBX520 +00912 ADD +1 TO L001-JUL-ABS-DAY. DTSBX520 +00913 DTSBX520 +00914 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBX520 +00915 DTSBX520 +00916 MOVE L001-FED-8-DATE-9 TO L003-DATE. DTSBX520 +00917 DTSBX520 +00918 MOVE '2' TO L003-OPTION. DTSBX520 +00919 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX520 +00920 DTSBX520 +00921 S348-EXIT. DTSBX520 +00922 EXIT. DTSBX520 +00923 DTSBX520 +00924 S910-OPEN-READ. DTSBX520 +00925 SET L910-OPEN-READ-88 TO TRUE. DTSBX520 +00926 GO TO S910-MSTR-IO. DTSBX520 +00927 DTSBX520 +00928 S910-READ. DTSBX520 +00929 SET L910-READ-88 TO TRUE. DTSBX520 +00930 GO TO S910-MSTR-IO. DTSBX520 +00931 DTSBX520 +00932 S910-START-BROWSE. DTSBX520 +00933 SET L910-START-BROWSE-88 TO TRUE. DTSBX520 +00934 GO TO S910-MSTR-IO. DTSBX520 +00935 DTSBX520 +00936 S910-READ-NEXT. DTSBX520 +00937 SET L910-READ-NEXT-88 TO TRUE. DTSBX520 +00938 GO TO S910-MSTR-IO. DTSBX520 +00939 DTSBX520 +00940 S910-COUNT. DTSBX520 +00941 SET L910-COUNT-88 TO TRUE. DTSBX520 +00942 GO TO S910-MSTR-IO. DTSBX520 +00943 DTSBX520 +00944 S910-REWRITE. DTSBX520 +00945 SET L910-REWRITE-88 TO TRUE. DTSBX520 +00946 GO TO S910-MSTR-IO. DTSBX520 +00947 DTSBX520 +00948 S910-CLOSE. DTSBX520 +00949 SET L910-CLOSE-88 TO TRUE. DTSBX520 +00950 GO TO S910-MSTR-IO. DTSBX520 +00951 DTSBX520 +00952 S910-MSTR-IO. DTSBX520 +00953 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX520 +00954 MSKL-REC. DTSBX520 +00955 S910-EXIT. DTSBX520 +00956 EXIT. DTSBX520 +00957 SKIP3 DTSBX520 +00958 DTSBX520 +00959 S931-OPEN-READ. DTSBX520 +00960 SET L931-OPEN-READ-88 TO TRUE. DTSBX520 +00961 GO TO S931-REF-IO. DTSBX520 +00962 DTSBX520 +00963 S931-READ. DTSBX520 +00964 SET L931-READ-88 TO TRUE. DTSBX520 +00965 GO TO S931-REF-IO. DTSBX520 +00966 DTSBX520 +00967 S931-CLOSE. DTSBX520 +00968 SET L931-CLOSE-88 TO TRUE. DTSBX520 +00969 GO TO S931-REF-IO. DTSBX520 +00970 DTSBX520 +00971 S931-REF-IO. DTSBX520 +00972 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX520 +00973 FSKL-REC. DTSBX520 +00974 S931-EXIT. DTSBX520 +00975 EXIT. DTSBX520 +00976 DTSBX520 +00977 S921-OPEN-READ. DTSBX520 +00978 SET L921-OPEN-READ-88 TO TRUE. DTSBX520 +00979 GO TO S921-AIX-IO. DTSBX520 +00980 DTSBX520 +00981 S921-CLOSE. DTSBX520 +00982 SET L921-CLOSE-88 TO TRUE. DTSBX520 +00983 GO TO S921-AIX-IO. DTSBX520 +00984 DTSBX520 +00985 S921-AIX-IO. DTSBX520 +00986 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX520 +00987 ISKL-REC. DTSBX520 +00988 S921-EXIT. DTSBX520 +00989 EXIT. DTSBX520 +00990 DTSBX520 +00991 S1000-READ-SRVR. DTSBX520 +00992 READ SERVER-FILE. DTSBX520 +00993 IF NOT SRVR-STATUS-OK-88 DTSBX520 +00994 IF SRVR-STATUS-EOF-88 DTSBX520 +00995 NEXT SENTENCE DTSBX520 +00996 ELSE DTSBX520 +00997 DISPLAY 'SERVER FILE READ ERROR ' SRVR-STATUS DTSBX520 +00998 SET W-ERROR-YES-88 TO TRUE DTSBX520 +00999 END-IF DTSBX520 +01000 ELSE DTSBX520 +01001 ADD +1 TO W-SERVER-CNT DTSBX520 +01002 END-IF. DTSBX520 +01003 DTSBX520 +01004 S1000-EXIT. DTSBX520 +01005 EXIT. DTSBX520 +01006 DTSBX520 +01007 S2000-UNKNOWN. DTSBX520 +01008 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX520 +01009 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBX520 +01010 SET MJRN-JRN-88 TO TRUE. DTSBX520 +01011 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX520 +01012 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX520 +01013 IF L910-OK-88 DTSBX520 +01014 SET W-SELECT-ALL-88 TO TRUE DTSBX520 +01015 ELSE DTSBX520 +01016 SET W-SELECT-NO-88 TO TRUE DTSBX520 +01017 END-IF. DTSBX520 +01018 DTSBX520 +01019 S2000-EXIT. DTSBX520 +01020 EXIT. DTSBX520 +01021 DTSBX520 +01022 S3000-INITIALIZE. DTSBX520 +01023 * SET LX34-SELECT-NO-88 TO TRUE. DTSBX520 +01024 SET W-SELECT-NO-88 TO TRUE. DTSBX520 +01025 IF W-RUN-INCREMENTAL-88 DTSBX520 +01026 SET W-SELECT-NAME-NO-88 TO TRUE DTSBX520 +01027 SET W-SELECT-ADDR-NO-88 TO TRUE DTSBX520 +01028 SET W-SELECT-OPO-NO-88 TO TRUE DTSBX520 +01029 SET W-SELECT-SOL-NO-88 TO TRUE DTSBX520 +01030 SET W-SELECT-FSC-NO-88 TO TRUE DTSBX520 +01031 SET W-SELECT-RATE-NO-88 TO TRUE DTSBX520 +01032 ELSE DTSBX520 +01033 SET W-SELECT-NAME-YES-88 TO TRUE DTSBX520 +01034 SET W-SELECT-ADDR-YES-88 TO TRUE DTSBX520 +01035 SET W-SELECT-OPO-YES-88 TO TRUE DTSBX520 +01036 SET W-SELECT-SOL-YES-88 TO TRUE DTSBX520 +01037 SET W-SELECT-FSC-YES-88 TO TRUE DTSBX520 +01038 SET W-SELECT-RATE-YES-88 TO TRUE DTSBX520 +01039 END-IF. DTSBX520 +01040 DTSBX520 +01041 PERFORM DTSBX520 +01042 VARYING LX34-SUB FROM +1 BY +1 DTSBX520 +01043 UNTIL LX34-SUB > LX34-MAX DTSBX520 +01044 SET LX34-QTR-EXISTS-NO-88 (LX34-SUB) TO TRUE DTSBX520 +01045 END-PERFORM. DTSBX520 +01046 DTSBX520 +01047 S3000-EXIT. DTSBX520 +01048 EXIT. DTSBX520 +01049 DTSBX520 +01050 S3100-LX34-SELECTIONS. DTSBX520 +01051 MOVE W-SELECT-IND TO LX34-SELECT-IND. DTSBX520 +01052 MOVE W-SELECT-NAME-IND TO LX34-SELECT-NAME-IND. DTSBX520 +01053 MOVE W-SELECT-ADDR-IND TO LX34-SELECT-ADDR-IND. DTSBX520 +01054 MOVE W-SELECT-OPO-IND TO LX34-SELECT-OPO-IND. DTSBX520 +01055 MOVE W-SELECT-SOL-IND TO LX34-SELECT-SOL-IND. DTSBX520 +01056 MOVE W-SELECT-FSC-IND TO LX34-SELECT-FSC-IND. DTSBX520 +01057 MOVE W-SELECT-RATE-IND TO LX34-SELECT-RATE-IND. DTSBX520 +01058 DTSBX520 +01059 S3100-EXIT. DTSBX520 +01060 EXIT. DTSBX520 +01061 DTSBX520 +01062 S999-ABEND. DTSBX520 +01063 DISPLAY '*** DTSBX340 ABENDING. ' DTSBX520 +01064 ABEND-MSG. DTSBX520 +01065 DTSBX520 +01066 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX520 +01067 S999-EXIT. DTSBX520 +01068 EXIT. DTSBX520 diff --git a/Batch/DTSBX521.cob b/Batch/DTSBX521.cob new file mode 100644 index 0000000..215d6d6 --- /dev/null +++ b/Batch/DTSBX521.cob @@ -0,0 +1,1222 @@ +00001 IDENTIFICATION DIVISION. 01/26/16 +00002 PROGRAM-ID. DTSBX521. DTSBX521 +00003 AUTHOR. NGC. LV111 +00004 DATE-WRITTEN. OCTOBER 2012. CL**4 +00005 DATE-COMPILED. DTSBX521 +00006 SKIP3 DTSBX521 +00007 ** CL*20 +00008 * DTSBX521 +00009 * FUNCTION: EXTRACT ACCOUNTING AND JOURNAL ENTRIES POSTED CL**4 +00010 * DURING THE CURRENT DAILY CYCLE. CL**4 +00011 * DTSBX521 +00012 * DTSBX521 +00013 * MODIFICATION LOG: DTSBX521 +00014 * DTSBX521 +00015 * 10/07/2012 INITIAL DEVELOPMENT. CL**4 +00016 * REFERENCE: PROGRAMMER: GD DTSBX521 +00017 * DTSBX521 +00018 * 08/07/2015 MODIFIED TO FIND PAYMENTS AND DISTRIBUTION CL*76 +00019 * TO MATCH JOURNAL ENTRIES FOR ESSP CL*76 +00020 * REFERENCE: PROGRAMMER: ZL1 CL*76 +00021 * CL*76 +00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX521 +00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX521 +00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX521 +00025 * DTSBX521 +00026 * DTSBX521 +00027 * DESCRIPTION: DTSBX521 +00028 * DTSBX521 +00029 * DTSBX521 +00030 * INITIATION: DTSBX521 +00031 * DTSBX521 +00032 * DTSBX521 +00033 * DTSBX521 +00034 * PROCESSING: DTSBX521 +00035 * DTSBX521 +00036 * DTSBX521 +00037 * TERMINATION: DTSBX521 +00038 * DTSBX521 +00039 * DTSBX521 +00040 * DTSBX521 +00041 * RECORDS READ: DTSBX521 +00042 * DTSBX521 +00043 * MASTER: DTSBX521 +00044 * DTSBX521 +00045 * MQTR DTSBX521 +00046 * MJRN DTSBX521 +00047 * MPAY DTSBX521 +00048 * MRPT DTSBX521 +00049 * MADJ DTSBX521 +00050 * DTSBX521 +00051 * DTSBX521 +00052 * ALTERNATE INDEX: DTSBX521 +00053 * DTSBX521 +00054 * NONE. DTSBX521 +00055 * DTSBX521 +00056 * DTSBX521 +00057 * REFERENCE: DTSBX521 +00058 * DTSBX521 +00059 * DTSBX521 +00060 * DTSBX521 +00061 * RECORDS UPDATED: DTSBX521 +00062 * DTSBX521 +00063 * NONE DTSBX521 +00064 * DTSBX521 +00065 * DTSBX521 +00066 * OUTPUT RECORDS WRITTEN: DTSBX521 +00067 * DTSBX521 +00068 * DTSBX331 DTSBX521 +00069 * DTSBX521 +00070 * DTSBX521 +00071 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX521 +00072 * DTSBX521 +00073 * NONE. DTSBX521 +00074 * DTSBX521 +00075 * DTSBX521 +00076 * MODULES CALLED: DTSBX521 +00077 * DTSBX521 +00078 * DTSBU001 DATE EDIT/CONVERSION. DTSBX521 +00079 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX521 +00080 * DTSBU910 MASTER FILE I/O. DTSBX521 +00081 * DTSBX521 +00082 * DTSBX521 +00083 * DTSBX521 +00084 ***** DTSBX521 +00085 SKIP3 DTSBX521 +00086 ENVIRONMENT DIVISION. DTSBX521 +00087 INPUT-OUTPUT SECTION. DTSBX521 +00088 FILE-CONTROL. DTSBX521 +00089 SELECT ACCT-FILE-OUT ASSIGN TO DTSFACCT CL*34 +00090 FILE STATUS IS ACCT-I-STATUS. DTSBX521 +00091 DTSBX521 +00092 SELECT ACCT-FILE-IN ASSIGN TO DTSFTRAN CL*34 +00093 FILE STATUS IS TRAN-I-STATUS. DTSBX521 +00094 DTSBX521 +00095 SELECT PAYD-FILE ASSIGN TO DTSFPAYD CL*65 +00096 FILE STATUS IS QTR-STATUS. CL*65 +00097 * CL**6 +00098 * SELECT SUMMARY-FILE ASSIGN TO DTSFSUM1 CL**6 +00099 ** FILE STATUS IS SUMMARY-STATUS. CL**6 +00100 DTSBX521 +00101 SELECT PAYMT-FILE-OUT ASSIGN TO DTSFPAYT CL*34 +00102 FILE STATUS IS PAYDIST-STATUS. CL*29 +00103 DTSBX521 +00104 DATA DIVISION. DTSBX521 +00105 FILE SECTION. DTSBX521 +00106 FD ACCT-FILE-OUT CL*34 +00107 RECORDING MODE IS F DTSBX521 +00108 LABEL RECORDS ARE STANDARD DTSBX521 +00109 BLOCK CONTAINS 0 CHARACTERS. DTSBX521 +00110 DTSBX521 +00111 01 ACCT-OUT-REC PIC X(253). CL*57 +00112 DTSBX521 +00113 FD ACCT-FILE-IN CL*34 +00114 RECORDING MODE IS F DTSBX521 +00115 LABEL RECORDS ARE STANDARD DTSBX521 +00116 BLOCK CONTAINS 0 CHARACTERS. DTSBX521 +00117 DTSBX521 +00118 01 ACCT-IN-REC PIC X(081). CL*41 +00119 DTSBX521 +00120 FD PAYD-FILE CL*65 +00121 RECORDING MODE IS F CL*65 +00122 LABEL RECORDS ARE STANDARD CL*65 +00123 BLOCK CONTAINS 0 CHARACTERS. CL*65 +00124 CL*65 +00125 01 PAYD-REC PIC X(63). CL*65 +00126 CL*65 +00127 *FD SUMMARY-FILE CL**6 +00128 * RECORDING MODE IS F. CL**6 +00129 *01 SUMMARY-REC PIC X(73). CL**6 +00130 * CL**6 +00131 FD PAYMT-FILE-OUT CL*40 +00132 RECORDING MODE IS F. CL*29 +00133 01 PAYMT-REC PIC X(120). CL*46 +00134 DTSBX521 +00135 WORKING-STORAGE SECTION. DTSBX521 +001355 77 PAN-VALET PICTURE X(24) VALUE '111DTSBX521 01/26/16'. DTSBX521 +00136 77 PAN-VALET PICTURE X(24) VALUE '019DTSBX343 05/14/10'. DTSBX521 +00137 SKIP3 DTSBX521 +00138 01 W-AREA. DTSBX521 +00139 05 W-ABEND-CD PIC S9(04) COMP VALUE +478. CL**4 +00140 DTSBX521 +00141 DTSBX521 +00142 05 ABEND-MSG PIC X(60). DTSBX521 +00143 DTSBX521 +00144 05 PARM-STATUS PIC X(02). DTSBX521 +00145 88 PARM-STATUS-OK-88 VALUE '00'. DTSBX521 +00146 05 ACCT-I-STATUS PIC X(02). DTSBX521 +00147 88 ACCT-I-STATUS-OK-88 VALUE '00'. DTSBX521 +00148 88 ACCT-I-STATUS-EOF-88 VALUE '10'. DTSBX521 +00149 05 TRAN-I-STATUS PIC X(02). CL**4 +00150 88 TRAN-I-STATUS-OK-88 VALUE '00'. DTSBX521 +00151 88 TRAN-I-STATUS-EOF-88 VALUE '10'. CL**4 +00152 05 QTR-STATUS PIC X(02). DTSBX521 +00153 88 QTR-STATUS-OK-88 VALUE '00'. DTSBX521 +00154 05 QCOLL-STATUS PIC X(02). DTSBX521 +00155 88 QCOLL-STATUS-OK-88 VALUE '00'. DTSBX521 +00156 05 SUMMARY-STATUS PIC X(02). DTSBX521 +00157 88 SUMMARY-STATUS-OK-88 VALUE '00'. DTSBX521 +00158 05 PAYDIST-STATUS PIC X(02). DTSBX521 +00159 88 PAYDIST-STATUS-OK-88 VALUE '00'. DTSBX521 +00160 DTSBX521 +00161 05 EMP-STATUS PIC X(02). DTSBX521 +00162 88 EMP-STATUS-OK-88 VALUE '00'. DTSBX521 +00163 DTSBX521 +00164 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX521 +00165 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX521 +00166 88 W-ERROR-NO-88 VALUE 'N'. DTSBX521 +00167 DTSBX521 +00168 05 W-RPT-COMPLETE-IND PIC X(01). DTSBX521 +00169 88 W-RPT-COMPLETE-YES-88 VALUE 'Y'. DTSBX521 +00170 88 W-RPT-COMPLETE-NO-88 VALUE 'N'. DTSBX521 +00171 88 W-RPT-COMPLETE-NULL-88 VALUE ' '. DTSBX521 +00172 DTSBX521 +00173 05 W-UI-CHARGE-IND PIC X(01). DTSBX521 +00174 88 W-UI-CHARGE-YES-88 VALUE 'Y'. DTSBX521 +00175 88 W-UI-CHARGE-NO-88 VALUE 'N'. DTSBX521 +00176 05 W-LP-CHARGE-IND PIC X(01). DTSBX521 +00177 88 W-LP-CHARGE-YES-88 VALUE 'Y'. DTSBX521 +00178 88 W-LP-CHARGE-NO-88 VALUE 'N'. DTSBX521 +00179 DTSBX521 +00180 05 W-STATUS-CD PIC X(02). DTSBX521 +00181 88 W-STATUS-WITHDRAWN-88 VALUE '04', '05'. DTSBX521 +00182 DTSBX521 +00183 05 WS-ACIN-EMP-NO PIC 9(06) VALUE ZEROS. CL*88 +00184 05 ACCT-EOF PIC 9(01) VALUE 0. CL*39 +00185 05 WRK-CREDIT-CNTR PIC 9(02) VALUE 0. CL*55 +00186 05 CONV-QTR-SUB PIC S9(04) COMP. CL*39 +00187 05 AMT-DISP PIC ---,---,---,--9.99. CL*63 +00188 05 AMT-DISP1 PIC ---,---,---,--9.99. CL*63 +00189 05 AMT-DISP2 PIC ---,---,---,--9.99. CL*63 +00190 05 QSUB PIC S9(04) COMP. DTSBX521 +00191 05 QMAX PIC S9(04) COMP VALUE +400. DTSBX521 +00192 05 ACCT-TABLE OCCURS 400 TIMES. DTSBX521 +00193 10 TBL-YRQ PIC S9(05) COMP-3. DTSBX521 +00194 10 TBL-JRN-IND PIC X(01). DTSBX521 +00195 88 TBL-JRN-GOOD-88 VALUE '0'. DTSBX521 +00196 88 TBL-JRN-BAD-88 VALUE '1'. DTSBX521 +00197 10 Q-UI-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00198 10 Q-UI-PD PIC S9(11)V99 COMP-3. DTSBX521 +00199 10 Q-UI-WV PIC S9(11)V99 COMP-3. DTSBX521 +00200 10 Q-UI-WO PIC S9(11)V99 COMP-3. DTSBX521 +00201 10 Q-UI-TL PIC S9(11)V99 COMP-3. DTSBX521 +00202 10 Q-UI-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00203 10 J-UI-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00204 10 J-UI-PD PIC S9(11)V99 COMP-3. DTSBX521 +00205 10 J-UI-WV PIC S9(11)V99 COMP-3. DTSBX521 +00206 10 J-UI-WO PIC S9(11)V99 COMP-3. DTSBX521 +00207 10 J-UI-TL PIC S9(11)V99 COMP-3. DTSBX521 +00208 10 J-UI-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00209 10 Q-INT-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00210 10 Q-INT-PD PIC S9(11)V99 COMP-3. DTSBX521 +00211 10 Q-INT-WV PIC S9(11)V99 COMP-3. DTSBX521 +00212 10 Q-INT-WO PIC S9(11)V99 COMP-3. DTSBX521 +00213 10 Q-INT-TL PIC S9(11)V99 COMP-3. DTSBX521 +00214 10 Q-INT-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00215 10 J-INT-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00216 10 J-INT-PD PIC S9(11)V99 COMP-3. DTSBX521 +00217 10 J-INT-WV PIC S9(11)V99 COMP-3. DTSBX521 +00218 10 J-INT-WO PIC S9(11)V99 COMP-3. DTSBX521 +00219 10 J-INT-TL PIC S9(11)V99 COMP-3. DTSBX521 +00220 10 J-INT-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00221 10 Q-LP-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00222 10 Q-LP-PD PIC S9(11)V99 COMP-3. DTSBX521 +00223 10 Q-LP-WV PIC S9(11)V99 COMP-3. DTSBX521 +00224 10 Q-LP-WO PIC S9(11)V99 COMP-3. DTSBX521 +00225 10 Q-LP-TL PIC S9(11)V99 COMP-3. DTSBX521 +00226 10 Q-LP-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00227 10 J-LP-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00228 10 J-LP-PD PIC S9(11)V99 COMP-3. DTSBX521 +00229 10 J-LP-WV PIC S9(11)V99 COMP-3. DTSBX521 +00230 10 J-LP-WO PIC S9(11)V99 COMP-3. DTSBX521 +00231 10 J-LP-TL PIC S9(11)V99 COMP-3. DTSBX521 +00232 10 J-LP-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00233 10 Q-NP-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00234 10 Q-NP-PD PIC S9(11)V99 COMP-3. DTSBX521 +00235 10 Q-NP-WV PIC S9(11)V99 COMP-3. DTSBX521 +00236 10 Q-NP-WO PIC S9(11)V99 COMP-3. DTSBX521 +00237 10 Q-NP-TL PIC S9(11)V99 COMP-3. DTSBX521 +00238 10 Q-NP-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00239 10 J-NP-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00240 10 J-NP-PD PIC S9(11)V99 COMP-3. DTSBX521 +00241 10 J-NP-WV PIC S9(11)V99 COMP-3. DTSBX521 +00242 10 J-NP-WO PIC S9(11)V99 COMP-3. DTSBX521 +00243 10 J-NP-TL PIC S9(11)V99 COMP-3. DTSBX521 +00244 10 J-NP-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00245 10 Q-MP-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00246 10 Q-MP-PD PIC S9(11)V99 COMP-3. DTSBX521 +00247 10 Q-MP-WV PIC S9(11)V99 COMP-3. DTSBX521 +00248 10 Q-MP-WO PIC S9(11)V99 COMP-3. DTSBX521 +00249 10 Q-MP-TL PIC S9(11)V99 COMP-3. DTSBX521 +00250 10 Q-MP-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00251 10 J-MP-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00252 10 J-MP-PD PIC S9(11)V99 COMP-3. DTSBX521 +00253 10 J-MP-WV PIC S9(11)V99 COMP-3. DTSBX521 +00254 10 J-MP-WO PIC S9(11)V99 COMP-3. DTSBX521 +00255 10 J-MP-TL PIC S9(11)V99 COMP-3. DTSBX521 +00256 10 J-MP-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00257 10 Q-SU-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00258 10 Q-SU-PD PIC S9(11)V99 COMP-3. DTSBX521 +00259 10 Q-SU-WV PIC S9(11)V99 COMP-3. DTSBX521 +00260 10 Q-SU-WO PIC S9(11)V99 COMP-3. DTSBX521 +00261 10 Q-SU-TL PIC S9(11)V99 COMP-3. DTSBX521 +00262 10 Q-SU-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00263 10 J-SU-CHG PIC S9(11)V99 COMP-3. DTSBX521 +00264 10 J-SU-PD PIC S9(11)V99 COMP-3. DTSBX521 +00265 10 J-SU-WV PIC S9(11)V99 COMP-3. DTSBX521 +00266 10 J-SU-WO PIC S9(11)V99 COMP-3. DTSBX521 +00267 10 J-SU-TL PIC S9(11)V99 COMP-3. DTSBX521 +00268 10 J-SU-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00269 DTSBX521 +00270 05 W-AMT PIC S9(11)V99 COMP-3. DTSBX521 +00271 05 W-TOT-CHG PIC S9(11)V99 COMP-3 DTSBX521 +00272 VALUE +0. DTSBX521 +00273 05 W-TOT-PD PIC S9(11)V99 COMP-3 DTSBX521 +00274 VALUE +0. DTSBX521 +00275 05 W-TOT-CREDIT PIC S9(11)V99 COMP-3 DTSBX521 +00276 VALUE +0. DTSBX521 +00277 05 W-CREDIT-CORRECT PIC S9(11)V99 COMP-3 DTSBX521 +00278 VALUE +0. DTSBX521 +00279 DTSBX521 +00280 05 W-TOT-MPRF-CREDIT PIC S9(11)V99 COMP-3 CL*15 +00281 VALUE +0. CL*15 +00282 05 W-TOT-MJRN-CREDIT PIC S9(11)V99 COMP-3 CL*15 +00283 VALUE +0. CL*15 +00284 CL*15 +00285 05 W-DIF-MPRF-CREDIT PIC S9(11)V99 COMP-3 CL*15 +00286 VALUE +0. CL*15 +00287 05 W-DIF-MJRN-CREDIT PIC S9(11)V99 COMP-3 CL*15 +00288 VALUE +0. CL*15 +00289 CL*15 +00290 05 W-DEFAULT-DATE PIC X(10) DTSBX521 +00291 VALUE '12/31/1994'. DTSBX521 +00292 DTSBX521 +00293 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. CL*65 +00294 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00295 05 W-MJRN-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00296 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00297 05 W-ACCT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00298 05 W-ACCT-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00299 05 W-PAYT-CNT PIC S9(07) COMP-3 VALUE +0. CL*42 +00300 05 W-TRAN-CNT PIC S9(07) COMP-3 VALUE +0. CL*42 +00301 05 W-TRAN-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00302 05 W-SUMMARY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00303 05 W-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00304 05 W-ANN-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00305 05 W-PAY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00306 05 W-PAY-DIST-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00307 05 W-ADJ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00308 05 W-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00309 05 W-CR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 +00310 05 W-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBX521 +00311 05 W-ITEM PIC S9(03) COMP-3 VALUE +0. DTSBX521 +00312 05 ADJ-CHG PIC S9(09)V99 COMP-3. DTSBX521 +00313 05 ADJ-PD PIC S9(09)V99 COMP-3. DTSBX521 +00314 05 ADJ-WV PIC S9(09)V99 COMP-3. DTSBX521 +00315 05 ADJ-WO PIC S9(09)V99 COMP-3. DTSBX521 +00316 05 ADJ-TL PIC S9(09)V99 COMP-3. DTSBX521 +00317 05 W-CHG PIC S9(09)V99 COMP-3. DTSBX521 +00318 05 W-PD PIC S9(09)V99 COMP-3. DTSBX521 +00319 05 W-WV PIC S9(09)V99 COMP-3. DTSBX521 +00320 05 W-WO PIC S9(09)V99 COMP-3. DTSBX521 +00321 05 W-TL PIC S9(09)V99 COMP-3. DTSBX521 +00322 05 W-BAL PIC S9(09)V99 COMP-3. DTSBX521 +00323 05 W-QTR-BAL PIC S9(11)V99 COMP-3. DTSBX521 +00324 05 W-RATE PIC S9(03)V9(04) COMP-3. DTSBX521 +00325 05 W-JC-BATCH PIC S9(05) COMP-3 DTSBX521 +00326 VALUE +00010. DTSBX521 +00327 05 W-JC-ITEM PIC S9(03) COMP-3 DTSBX521 +00328 VALUE +0. DTSBX521 +00329 DTSBX521 +00330 05 ASUB PIC S9(04) COMP. DTSBX521 +00331 05 ASUB1 PIC S9(04) COMP. DTSBX521 +00332 05 ASUB-MAX PIC S9(04) COMP VALUE +50. DTSBX521 +00333 05 ASUB-LAST PIC S9(04) COMP VALUE +0. DTSBX521 +00334 05 ANN-RPT-TABLE OCCURS 50 TIMES. DTSBX521 +00335 10 W-ANN-RPT-TYPE PIC X(02). DTSBX521 +00336 10 W-ANN-YRQ PIC 9(05). DTSBX521 +00337 10 FILLER REDEFINES W-ANN-YRQ. DTSBX521 +00338 15 W-ANN-YRQ-CCYY PIC 9(04). DTSBX521 +00339 15 W-ANN-YRQ-Q PIC 9(01). DTSBX521 +00340 DTSBX521 +00341 10 W-ANN-BATCH PIC S9(05) COMP-3. DTSBX521 +00342 10 W-ANN-ITEM PIC S9(03) COMP-3. DTSBX521 +00343 10 W-ANN-RATE PIC S9(03)V9(04) COMP-3. DTSBX521 +00344 10 W-ANN-REMIT PIC S9(09)V99 COMP-3. DTSBX521 +00345 10 W-ANN-TOT-WAGE PIC S9(09)V99 COMP-3. DTSBX521 +00346 10 W-ANN-TAX-WAGE PIC S9(09)V99 COMP-3. DTSBX521 +00347 10 W-ANN-EXCESS-WAGE PIC S9(09)V99 COMP-3. DTSBX521 +00348 10 W-ANN-RCVD-DT PIC S9(09) COMP-3. DTSBX521 +00349 10 W-ANN-PROCESS-DT PIC S9(09) COMP-3. DTSBX521 +00350 DTSBX521 +00351 05 W-LAST-ANN-YRQ PIC S9(05) COMP-3. DTSBX521 +00352 DTSBX521 +00353 05 W-ACCT-IN. CL*34 +00354 10 W-ACCT-IN-DATA. CL*39 +00355 15 ACIN-EMP-NO PIC 9(06). CL*39 +00356 15 FILLER PIC X(01) VALUE ','. CL*39 +00357 15 ACIN-YRQ PIC X(06). CL*39 +00358 15 FILLER PIC X(01) VALUE ','. CL*39 +00359 15 ACIN-BATCH-NO PIC 9(05). CL*40 +00360 15 FILLER PIC X(01) VALUE ','. CL*39 +00361 15 ACIN-ITEM-NO PIC 9(03). CL*40 +00362 15 FILLER PIC X(01) VALUE ','. CL*39 +00363 15 ACIN-TRAN PIC X(02). CL*39 +00364 15 FILLER PIC X(01) VALUE ','. CL*39 +00365 15 ACIN-ROW PIC X(02). CL*39 +00366 15 FILLER PIC X(01) VALUE ','. CL*39 +00367 15 ACIN-COL PIC X(02). CL*39 +00368 15 FILLER PIC X(01) VALUE ','. CL*39 +00369 15 ACIN-AMT PIC ---------9.99. CL*39 +00370 15 ACIN-AMT-9 REDEFINES ACIN-AMT PIC 9(10).99. CL*39 +00371 15 FILLER PIC X(01) VALUE ','. CL*39 +00372 15 ACIN-CAT PIC X(01). CL*39 +00373 15 FILLER PIC X(01) VALUE ','. CL*39 +00374 15 ACIN-PROCESS-DT PIC X(10). CL*39 +00375 15 FILLER PIC X(01) VALUE ','. CL*39 +00376 15 ACIN-SOURCE PIC X(01). CL*39 +00377 88 ACIN-SOURCE-CR-DB-88 VALUE '1'. CL*39 +00378 88 ACIN-SOURCE-STATUS-88 VALUE '2'. CL*39 +00379 88 ACIN-SOURCE-ERROR-88 VALUE '3'. CL*39 +00380 15 FILLER PIC X(01) VALUE ','. CL*39 +00381 15 ACIN-RCVD-DT PIC X(10). CL*39 +00382 15 FILLER PIC X(01) VALUE ','. CL*39 +00383 10 FILLER PIC X(10). CL*39 +00384 DTSBX521 +00385 CL*34 +00386 05 W-ACCT-OUT. CL*34 +00387 10 ACCT-OUT-DATA PIC X(73). CL*39 +00388 10 ACCT-NEW-DATA. CL*39 +00389 15 ACCT-PAYMT-ID PIC 9(10). CL*39 +00390 15 FILLER PIC X(01) VALUE ' '. CL*82 +00391 15 ACCT-ORIG-BATCH-NO1 PIC X(05). CL*82 +00392 15 FILLER PIC X(01) VALUE ' '. CL*82 +00393 15 ACCT-ORIG-ITEM-NO1 PIC X(03). CL*82 +00394 15 FILLER PIC X(01) VALUE ' '. CL*82 +00395 15 ACCT-OPID PIC X(10). CL*52 +00396 15 FILLER PIC X(01) VALUE ' '. CL*82 +00397 15 FILLER PIC X(05) VALUE SPACES. CL*52 +00398 15 FILLER PIC X(01) VALUE ' '. CL*75 +00399 CL*34 +00400 CL*29 +00401 05 W-PAYMT-REC. CL*29 +00402 10 PAYT-EMP-NO PIC 9(06). CL*29 +00403 10 FILLER PIC X(01) VALUE ','. CL*29 +00404 10 PAYT-YRQ PIC X(06). CL*29 +00405 10 FILLER PIC X(01) VALUE ','. CL*29 +00406 10 PAYT-BATCH PIC 9(05). CL*29 +00407 10 FILLER PIC X(01) VALUE ','. CL*29 +00408 10 PAYT-ITEM PIC 9(03). CL*29 +00409 10 FILLER PIC X(01) VALUE ','. CL*29 +00410 10 PAYT-PAY-TYPE PIC X(02). CL*30 +00411 10 FILLER PIC X(01) VALUE ','. CL*29 +00412 10 PAYT-WI-IND PIC X(01). CL*29 +00413 10 FILLER PIC X(01) VALUE ','. CL*29 +00414 10 PAYT-WLP-IND PIC X(01). CL*29 +00415 10 FILLER PIC X(01) VALUE ','. CL*29 +00416 10 PAYT-WNP-IND PIC X(01). CL*29 +00417 10 FILLER PIC X(01) VALUE ','. CL*29 +00418 10 PAYT-AMT PIC ---------9.99. CL*29 +00419 10 PAYT-AMT-9 REDEFINES PAYT-AMT PIC 9(10).99. CL*29 +00420 10 FILLER PIC X(01) VALUE ','. CL*29 +00421 10 PAYT-RCVD-DT PIC X(10). CL*29 +00422 10 FILLER PIC X(01) VALUE ','. CL*29 +00423 10 PAYT-DEPOSIT-DT PIC X(10). CL*29 +00424 10 FILLER PIC X(01) VALUE ','. CL*29 +00425 10 PAYT-IND PIC X(02). CL*29 +00426 10 FILLER PIC X(01) VALUE ','. CL*29 +00427 10 PAYT-ORIG-BATCH-NO PIC X(05). CL*29 +00428 10 FILLER PIC X(01) VALUE ','. CL*29 +00429 10 PAYT-ORIG-ITEM-NO PIC X(03). CL*29 +00430 10 FILLER PIC X(01) VALUE ','. CL*29 +00431 10 PAYT-PAYMT-ID PIC 9(10). CL*46 +00432 10 FILLER PIC X(01) VALUE ','. CL*29 +00433 10 PAYT-OPID PIC X(10). CL*29 +00434 10 FILLER PIC X(16) VALUE SPACES. CL*44 +00435 10 FILLER PIC X(01) VALUE ' '. CL*75 +00436 CL*29 +00437 05 W-TRAN-REC. DTSBX521 +00438 10 TRAN-EMP-NO PIC 9(06). DTSBX521 +00439 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00440 10 TRAN-YRQ PIC X(06). DTSBX521 +00441 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00442 10 TRAN-BATCH PIC 9(05). DTSBX521 +00443 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00444 10 TRAN-ITEM PIC 9(03). DTSBX521 +00445 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00446 10 TRAN-TRANS PIC X(02). DTSBX521 +00447 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00448 10 TRAN-AMT PIC --------9.99. DTSBX521 +00449 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00450 10 TRAN-TOT-WAGE PIC ----------9.99. DTSBX521 +00451 10 TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE DTSBX521 +00452 PIC X(14). DTSBX521 +00453 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00454 10 TRAN-TAX-WAGE PIC ----------9.99. DTSBX521 +00455 10 TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE DTSBX521 +00456 PIC X(14). DTSBX521 +00457 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00458 10 TRAN-EXC-WAGE PIC ----------9.99. DTSBX521 +00459 10 TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE DTSBX521 +00460 PIC X(14). DTSBX521 +00461 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00462 10 TRAN-RATE PIC Z9.9. DTSBX521 +00463 10 TRAN-RATE-X REDEFINES TRAN-RATE DTSBX521 +00464 PIC X(04). DTSBX521 +00465 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00466 10 TRAN-ACCT PIC X(02). DTSBX521 +00467 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00468 10 TRAN-CAT PIC X(01). DTSBX521 +00469 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00470 10 TRAN-SOURCE PIC X(01). DTSBX521 +00471 88 TRAN-SOURCE-CR-DB-88 VALUE '1'. DTSBX521 +00472 88 TRAN-SOURCE-STATUS-88 VALUE '2'. DTSBX521 +00473 88 TRAN-SOURCE-ERROR-88 VALUE '3'. DTSBX521 +00474 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00475 10 TRAN-RCVD-DT PIC X(10). DTSBX521 +00476 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00477 10 TRAN-PROCESS-DT PIC X(10). DTSBX521 +00478 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00479 10 TRAN-APPLIC-BATCH PIC 9(05). DTSBX521 +00480 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00481 10 TRAN-APPLIC-ITEM PIC 9(03). DTSBX521 +00482 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00483 10 TRAN-RESP-ACTIVITY PIC X(03). DTSBX521 +00484 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00485 10 TRAN-RESP-OPID PIC X(08). DTSBX521 +00486 DTSBX521 +00487 05 W-QTR-REC. DTSBX521 +00488 10 QTR-EMP-NO PIC 9(06). DTSBX521 +00489 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00490 10 QTR-QUARTER PIC X(06). DTSBX521 +00491 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00492 10 QTR-RPT-STATUS PIC X(01). DTSBX521 +00493 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00494 10 QTR-RPT-DUE-DT PIC X(10). DTSBX521 +00495 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00496 10 QTR-PROCESS-DT PIC X(10). DTSBX521 +00497 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00498 10 QTR-BAL-DUE PIC ----------9.99. DTSBX521 +00499 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00500 10 QTR-TAX-DUE-DT PIC X(10). DTSBX521 +00501 DTSBX521 +00502 05 W-SUMMARY-REC. DTSBX521 +00503 10 SUMMARY-PROCESS-DT PIC X(10). DTSBX521 +00504 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00505 10 SUMMARY-MESSAGE PIC X(40). DTSBX521 +00506 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00507 10 SUMMARY-EMP-NO PIC 9(06). DTSBX521 +00508 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00509 10 SUMMARY-BATCH PIC 9(05). DTSBX521 +00510 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00511 10 SUMMARY-ITEM PIC 9(03). DTSBX521 +00512 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00513 10 SUMMARY-TRAN PIC X(02). DTSBX521 +00514 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00515 10 SUMMARY-SOURCE PIC X(01). DTSBX521 +00516 88 SUMMARY-SOURCE-CR-DB-88 VALUE '1'. DTSBX521 +00517 88 SUMMARY-SOURCE-STATUS-88 VALUE '2'. DTSBX521 +00518 88 SUMMARY-SOURCE-ERROR-88 VALUE '3'. DTSBX521 +00519 DTSBX521 +00520 05 W-PAY-DIST-REC. DTSBX521 +00521 10 DST-EMP-NO PIC 9(06). DTSBX521 +00522 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00523 10 DST-BATCH PIC 9(05). DTSBX521 +00524 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00525 10 DST-ITEM PIC 9(03). DTSBX521 +00526 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00527 10 DST-YRQ PIC X(06). CL*66 +00528 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00529 10 DST-ACCT PIC X(02). DTSBX521 +00530 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00531 10 DST-AMT PIC --------9.99. DTSBX521 +00532 10 FILLER PIC X(01) VALUE ','. DTSBX521 +00533 10 DST-CHNG-DT PIC X(10). DTSBX521 +00534 DTSBX521 +00535 05 W-CURR-UI-TOT PIC S9(11)V99 COMP-3 DTSBX521 +00536 VALUE +0. DTSBX521 +00537 DTSBX521 +00538 05 DISPLAY-CNT PIC Z(06)9. DTSBX521 +00539 DTSBX521 +00540 05 DISPLAY-AMT1-X PIC X(14). DTSBX521 +00541 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX521 +00542 PIC ---,---,--9.99. DTSBX521 +00543 05 DISPLAY-AMT2-X PIC X(14). DTSBX521 +00544 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX521 +00545 PIC ---,---,--9.99. DTSBX521 +00546 05 DISPLAY-AMT3-X PIC X(14). DTSBX521 +00547 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX521 +00548 PIC ---,---,--9.99. DTSBX521 +00549 05 DISPLAY-AMT4-X PIC X(14). DTSBX521 +00550 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX521 +00551 PIC ---,---,--9.99. DTSBX521 +00552 EJECT DTSBX521 +00553 01 L001-LINK-AREA. DTSBX521 +00554 ++INCLUDE DTSIL001 DTSBX521 +00555 EJECT DTSBX521 +00556 01 L004-LINK-AREA. DTSBX521 +00557 ++INCLUDE DTSIL004 DTSBX521 +00558 EJECT DTSBX521 +00559 01 L005-LINK-AREA. DTSBX521 +00560 ++INCLUDE DTSIL005 DTSBX521 +00561 DTSBX521 +00562 01 L910-LINK-AREA. DTSBX521 +00563 ++INCLUDE DTSIL910 DTSBX521 +00564 SKIP3 DTSBX521 +00565 01 MSKL-REC. DTSBX521 +00566 ++INCLUDE DTSIMSKL DTSBX521 +00567 SKIP3 DTSBX521 +00568 01 MHDR-REC. DTSBX521 +00569 ++INCLUDE DTSIMHDR DTSBX521 +00570 SKIP3 DTSBX521 +00571 01 MPRF-REC. CL**4 +00572 ++INCLUDE DTSIMPRF CL**4 +00573 CL**4 +00574 01 MQTR-REC. DTSBX521 +00575 ++INCLUDE DTSIMQTR DTSBX521 +00576 SKIP3 DTSBX521 +00577 01 MJRN-REC. DTSBX521 +00578 ++INCLUDE DTSIMJRN DTSBX521 +00579 SKIP3 DTSBX521 +00580 01 MRPT-REC. DTSBX521 +00581 ++INCLUDE DTSIMRPT DTSBX521 +00582 SKIP3 DTSBX521 +00583 01 MADJ-REC. DTSBX521 +00584 ++INCLUDE DTSIMADJ DTSBX521 +00585 SKIP3 DTSBX521 +00586 01 MPAY-REC. DTSBX521 +00587 ++INCLUDE DTSIMPAY DTSBX521 +00588 SKIP3 DTSBX521 +00589 01 MDST-REC. DTSBX521 +00590 ++INCLUDE DTSIMDST DTSBX521 +00591 SKIP3 DTSBX521 +00592 01 MRTE-REC. DTSBX521 +00593 ++INCLUDE DTSIMRTE DTSBX521 +00594 SKIP3 DTSBX521 +00595 01 MEVL-REC. DTSBX521 +00596 ++INCLUDE DTSIMEVL DTSBX521 +00597 SKIP3 DTSBX521 +00598 01 MSOL-REC. DTSBX521 +00599 ++INCLUDE DTSIMSOL DTSBX521 +00600 SKIP3 DTSBX521 +00601 01 MFSC-REC. DTSBX521 +00602 ++INCLUDE DTSIMFSC DTSBX521 +00603 SKIP3 DTSBX521 +00604 01 MTAD-REC. DTSBX521 +00605 ++INCLUDE DTSIMTAD DTSBX521 +00606 SKIP3 DTSBX521 +00607 01 MTAA-REC. DTSBX521 +00608 ++INCLUDE DTSIMTAA DTSBX521 +00609 SKIP3 DTSBX521 +00610 01 MLOG-REC. DTSBX521 +00611 ++INCLUDE DTSIMLOG DTSBX521 +00612 CL**5 +00613 01 L921-LINK-AREA. CL**5 +00614 ++INCLUDE DTSIL921 CL**5 +00615 SKIP3 CL**5 +00616 01 ISKL-REC. CL**5 +00617 ++INCLUDE DTSIISKL CL**5 +00618 CL**5 +00619 01 L931-LINK-AREA. DTSBX521 +00620 ++INCLUDE DTSIL931 DTSBX521 +00621 SKIP3 DTSBX521 +00622 01 FSKL-REC. DTSBX521 +00623 ++INCLUDE DTSIFSKL DTSBX521 +00624 SKIP3 DTSBX521 +00625 01 FQTR-REC. DTSBX521 +00626 ++INCLUDE DTSIFQTR DTSBX521 +00627 DTSBX521 +00628 EJECT DTSBX521 +00629 PROCEDURE DIVISION. CL**4 +00630 DTSBX521 +00631 PERFORM I0000-INITIALIZE THRU I0000-EXIT. CL**4 +00632 CL**4 +00633 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**4 +00634 CL**4 +00635 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL**4 +00636 DTSBX521 +00637 GOBACK. DTSBX521 +00638 DTSBX521 +00639 I0000-INITIALIZE. DTSBX521 +00640 SET L005-FROM-SYS TO TRUE. CL**4 +00641 PERFORM S005-SYS-DATE THRU S005-EXIT. CL**4 +00642 CL**4 +00643 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX521 +00644 DTSBX521 +00645 PERFORM I3000-GET-MHDR THRU I3000-EXIT. CL**5 +00646 CL**4 +00647 I0000-EXIT. DTSBX521 +00648 EXIT. DTSBX521 +00649 DTSBX521 +00650 I2000-OPEN-FILES. DTSBX521 +00651 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**4 +00652 CL**4 +00653 PERFORM S921-OPEN-READ THRU S921-EXIT. CL**4 +00654 CL**4 +00655 PERFORM S931-OPEN-READ THRU S931-EXIT. CL**4 +00656 DTSBX521 +00657 OPEN OUTPUT ACCT-FILE-OUT. CL*35 +00658 IF NOT ACCT-I-STATUS-OK-88 DTSBX521 +00659 DISPLAY 'BZ478 ACCT INCR OPEN ERROR: ' ACCT-I-STATUS CL**7 +00660 MOVE 'FILE OPEN ERROR' DTSBX521 +00661 TO ABEND-MSG DTSBX521 +00662 PERFORM S999-ABEND THRU S999-EXIT DTSBX521 +00663 END-IF. DTSBX521 +00664 DTSBX521 +00665 OPEN INPUT ACCT-FILE-IN. CL*35 +00666 IF NOT TRAN-I-STATUS-OK-88 DTSBX521 +00667 DISPLAY 'BZ478 TRAN FILE INPUT ERROR: ' TRAN-I-STATUS CL*35 +00668 MOVE 'FILE OPEN ERROR' DTSBX521 +00669 TO ABEND-MSG DTSBX521 +00670 PERFORM S999-ABEND THRU S999-EXIT DTSBX521 +00671 END-IF. DTSBX521 +00672 DTSBX521 +00673 OPEN OUTPUT PAYD-FILE. CL*65 +00674 IF NOT QTR-STATUS-OK-88 CL*65 +00675 DISPLAY 'PAYMENT DISTRIBUTION FILE PROBLEM: ' QTR-STATUS CL*65 +00676 MOVE 'FILE OPEN ERROR' CL*65 +00677 TO ABEND-MSG CL*65 +00678 PERFORM S999-ABEND THRU S999-EXIT CL*65 +00679 END-IF. CL*65 +00680 DTSBX521 +00681 ** OPEN OUTPUT SUMMARY-FILE. CL**6 +00682 * IF NOT SUMMARY-STATUS-OK-88 CL**6 +00683 * DISPLAY 'BX343 SUMMARY FILE OPEN ERROR: ' CL**6 +00684 * SUMMARY-STATUS CL**6 +00685 * MOVE 'FILE OPEN ERROR' CL**6 +00686 * TO ABEND-MSG CL**6 +00687 * PERFORM S999-ABEND THRU S999-EXIT CL**6 +00688 ** END-IF. CL**6 +00689 DTSBX521 +00690 OPEN OUTPUT PAYMT-FILE-OUT. CL*35 +00691 IF NOT PAYDIST-STATUS-OK-88 CL*29 +00692 DISPLAY 'BX343 PAYMT FILE OPEN ERROR: ' CL*35 +00693 PAYDIST-STATUS CL*29 +00694 MOVE 'FILE OPEN ERROR' CL*29 +00695 TO ABEND-MSG CL*29 +00696 PERFORM S999-ABEND THRU S999-EXIT CL*29 +00697 END-IF. CL*29 +00698 DTSBX521 +00699 I2000-EXIT. DTSBX521 +00700 EXIT. DTSBX521 +00701 DTSBX521 +00702 I3000-GET-MHDR. CL**4 +00703 MOVE LOW-VALUES TO MSKL-REC. CL**4 +00704 MOVE +0 TO MSKL-EMP-NO. CL**4 +00705 SET MSKL-HDR-88 TO TRUE. CL**4 +00706 CL**4 +00707 PERFORM S910-READ THRU S910-EXIT. CL**4 +00708 IF L910-NO-REC-88 CL**4 +00709 DISPLAY 'DTSBZ478: MHDR RECORD IS MISSING' CL**4 +00710 SET W-ERROR-YES-88 TO TRUE CL**4 +00711 GO TO I3000-EXIT CL**4 +00712 ELSE CL**4 +00713 MOVE MSKL-REC TO MHDR-REC CL**4 +00714 END-IF. CL**4 +00715 CL**4 +00716 I3000-EXIT. CL**4 +00717 EXIT. CL**4 +00718 CL**4 +00719 P0000-PROCESS. CL*11 +00720 PERFORM P1000-READ-ACCTS-IN THRU P1000-EXIT CL*37 +00721 UNTIL ACCT-EOF = 1. CL*40 +00722 CL**4 +00723 CL**4 +00724 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*32 +00725 MOVE +0 TO MSKL-EMP-NO. CL*32 +00726 SET MSKL-PRF-88 TO TRUE. CL*32 +00727 CL*32 +00728 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*32 +00729 CL*32 +00730 PERFORM UNTIL L910-NO-REC-88 CL*32 +00731 MOVE MSKL-REC TO MPRF-REC CL*32 +00732 * IF MPRF-STATUS-SUB-88 CL*39 +00733 PERFORM P3200-PAYMENT THRU P3200-EXIT CL*32 +00734 * END-IF CL*39 +00735 MOVE MPRF-REC TO MSKL-REC CL*32 +00736 PERFORM S910-READ-NEXT THRU S910-EXIT CL*32 +00737 END-PERFORM. CL*32 +00738 CL*32 +00739 CL*32 +00740 DTSBX521 +00741 P0000-EXIT. DTSBX521 +00742 EXIT. DTSBX521 +00743 DTSBX521 +00744 P1000-READ-ACCTS-IN. CL*37 +00745 READ ACCT-FILE-IN INTO W-ACCT-IN AT END CL*37 +00746 MOVE 1 TO ACCT-EOF CL*37 +00747 GO TO P1000-EXIT. CL*37 +00748 CL*37 +00749 ADD +1 TO W-TRAN-CNT CL*42 +00750 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*37 +00751 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL*37 +00752 CL*37 +00753 MOVE +0 TO MSKL-EMP-NO. CL*37 +00754 CL*37 +00755 SET MPRF-PRF-88 TO TRUE. CL*37 +00756 MOVE ACIN-EMP-NO TO MPRF-EMP-NO CL*39 +00757 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*37 +00758 PERFORM S910-READ THRU S910-EXIT. CL*37 +00759 IF L910-OK-88 CL*37 +00760 MOVE MSKL-REC TO MPRF-REC CL*37 +00761 ELSE CL*37 +00762 DISPLAY 'MPRF NOT FOUND ' L910-RESULT-IND ' ' ACIN-EMP-NO CL*39 +00763 SET L910-NO-REC-88 TO TRUE CL*37 +00764 GO TO P1000-EXIT. CL*37 +00765 CL*37 +00766 PERFORM P2000-ACCTS-RECEIVABLE THRU P2000-EXIT. CL*40 +00767 CL*37 +00768 P1000-EXIT. CL*37 +00769 EXIT. CL*37 +00770 CL*37 +00771 P2000-ACCTS-RECEIVABLE. DTSBX521 +00772 MOVE ZEROS TO ACCT-PAYMT-ID CL*37 +00773 CL*37 +00774 MOVE ZERO TO W-TOT-CREDIT CL*56 +00775 WRK-CREDIT-CNTR. CL*82 +00776 * ACCT-ORIG-BATCH-NO1 CL*82 +00777 * ACCT-ORIG-ITEM-NO1. CL*82 +00778 PERFORM P2100-PAYMENT-DATA THRU P2100-EXIT. CL*39 +00779 CL*82 +00780 IF ACIN-TRAN = 'AC' OR 'FS' OR 'EA' CL*82 +00781 GO TO P2000-EXIT. CL*82 +00782 CL*82 +00783 IF ACIN-YRQ = SPACES AND ACIN-ROW = 'CR' AND ACIN-COL = 'PD' CL*80 +00784 IF ACIN-EMP-NO NOT = WS-ACIN-EMP-NO CL*88 +00785 MOVE ACIN-EMP-NO TO WS-ACIN-EMP-NO CL*88 +00786 PERFORM P2500-FIND-MDST THRU P2500-EXIT. CL*88 +00787 * PERFORM P3000-CREDIT-INFO THRU P3000-EXIT. CL*63 +00788 CL*37 +00789 MOVE W-ACCT-IN-DATA TO ACCT-OUT-DATA. CL*39 +00790 CL*39 +00791 WRITE ACCT-OUT-REC FROM W-ACCT-OUT. CL*39 +00792 IF NOT ACCT-I-STATUS-OK-88 CL*39 +00793 DISPLAY 'CANNOT WRITE TO ACCT FILE INCR ' CL*39 +00794 ' ' ACCT-I-STATUS ' ' ACIN-EMP-NO CL*39 +00795 ELSE CL*39 +00796 ADD +1 TO W-ACCT-CNT-INCR CL*39 +00797 END-IF. CL*39 +00798 CL*38 +00799 P2000-EXIT. CL*38 +00800 EXIT. CL*38 +00801 CL*38 +00802 P2100-PAYMENT-DATA. CL*39 +00803 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*39 +00804 MOVE LOW-VALUES TO MPAY-KEY-AREA. CL*39 +00805 MOVE ACIN-BATCH-NO TO MPAY-BATCH-NO, CL*38 +00806 MOVE ACIN-ITEM-NO TO MPAY-ITEM-NO. CL*38 +00807 MOVE ACIN-EMP-NO TO MPAY-EMP-NO. CL*38 +00808 CL*38 +00809 SET MPAY-PAY-88 TO TRUE. CL*38 +00810 CL*38 +00811 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. CL*38 +00812 CL*38 +00813 PERFORM S910-READ THRU S910-EXIT. CL*38 +00814 CL*38 +00815 IF L910-OK-88 CL*38 +00816 MOVE MSKL-REC TO MPAY-REC CL*38 +00817 * DISPLAY 'MPAY ' MPAY-EMP-NO ' ' MPAY-APPLIC-YRQ ' ' CL*65 +00818 * MPAY-BATCH-NO ' ' MPAY-ITEM-NO ' ' CL*65 +00819 * MPAY-PAY-TYPE ' ' MPAY-REMIT-AMT ' ' CL*65 +00820 * MPAY-APPLIC-IND ' ' MPAY-TRACE-NO ' ' CL*65 +00821 * MPAY-APPLIC-BATCH-NO ' ' CL*65 +00822 * MPAY-APPLIC-ITEM-NO CL*65 +00823 MOVE MPAY-TRACE-NO TO ACCT-PAYMT-ID CL*38 +00824 MOVE SPACES TO ACCT-ORIG-BATCH-NO1 CL*82 +00825 MOVE SPACES TO ACCT-ORIG-ITEM-NO1 CL*82 +00826 MOVE SPACES TO ACCT-OPID CL*82 +00827 ELSE CL*38 +00828 SET L910-OK-88 TO TRUE CL*38 +00829 END-IF. CL*38 +00830 CL*38 +00831 CL*60 +00832 P2100-EXIT. CL*39 +00833 EXIT. CL*38 +00834 CL*38 +00835 CL*38 +00836 P2500-FIND-MDST. CL*59 +00837 * MOVE 20124 TO L004-QTR-5-9. CL*59 +00838 * MOVE 1 TO L004-QTR-5-Q. CL*59 +00839 * MOVE L004-QTR-5-9 TO WRK-LAST-YRQ. CL*59 +00840 * MOVE 4 TO L004-QTR-5-Q. CL*59 +00841 * MOVE L004-QTR-5-9 TO WRK-NEXT-YRQ. CL*59 +00842 * DISPLAY 'P2831 QTRS ' WRK-LAST-YRQ ' ' WRK-NEXT-YRQ. CL*59 +00843 CL*59 +00844 MOVE LOW-VALUES TO MDST-KEY-AREA. CL*59 +00845 MOVE MPRF-EMP-NO TO MDST-EMP-NO. CL*69 +00846 SET MDST-DST-88 TO TRUE. CL*59 +00847 * SET MDST-CREDIT-REC-88 TO TRUE CL*59 +00848 * MOVE MPAY-BATCH-NO TO MDST-BATCH-NO CL*59 +00849 * MOVE MPAY-ITEM-NO TO MDST-ITEM-NO. CL*59 +00850 MOVE MDST-REC TO MSKL-REC. CL*59 +00851 CL*59 +00852 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*59 +00853 * PERFORM S910-READ THRU S910-EXIT CL*59 +00854 * IF L910-OK-88 CL*59 +00855 * MOVE MSKL-REC TO MDST-REC CL*59 +00856 * PERFORM CL*59 +00857 * VARYING MDST-ACCT-IDX FROM 1 BY 1 CL*59 +00858 * UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT CL*59 +00859 * IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) CL*59 +00860 * ADD +1 TO WRK-TOT-EMPS CL*59 +00861 * MOVE MDST-AMT (MDST-ACCT-IDX) TO AMT-DISP CL*59 +00862 * DISPLAY ' ' MDST-BATCH-NO ' ' MDST-ITEM-NO CL*59 +00863 * ' AMT ' AMT-DISP CL*59 +00864 * END-IF CL*59 +00865 * END-PERFORM CL*59 +00866 ** END-IF. CL*59 +00867 PERFORM P2510-SCAN-MDST THRU P2510-EXIT CL*59 +00868 UNTIL L910-NO-REC-88. CL*59 +00869 P2500-EXIT. CL*59 +00870 EXIT. CL*59 +00871 CL*59 +00872 P2510-SCAN-MDST. CL*59 +00873 MOVE MSKL-REC TO MDST-REC. CL*59 +00874 CL*59 +00875 IF MDST-EMP-NO = 027554 CL*72 +00876 DISPLAY MDST-EMP-NO CL*69 +00877 ' YRQ ' MDST-YRQ CL*69 +00878 ' BATCH ' MDST-BATCH-NO CL*69 +00879 ' ITEM ' MDST-ITEM-NO CL*69 +00880 ' EDATE ' MDST-ESTB-DATE CL*69 +00881 ' CDATE ' MDST-CHNG-DATE. CL*69 +00882 CL*65 +00883 IF MDST-CHNG-DATE = MHDR-PRIOR-RUN-DATE CL111 +00884 * IF MDST-CHNG-DATE = 20160122 CL111 +00885 PERFORM CL*59 +00886 VARYING MDST-ACCT-IDX FROM 1 BY 1 CL*59 +00887 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT CL*59 +00888 MOVE MDST-EMP-NO TO DST-EMP-NO CL*71 +00889 MOVE MDST-BATCH-NO TO DST-BATCH CL*71 +00890 MOVE MDST-ITEM-NO TO DST-ITEM CL*65 +00891 MOVE MDST-YRQ TO L004-QTR-5-9 CL*65 +00892 PERFORM S004-FROM-5 THRU S004-EXIT CL*65 +00893 MOVE L004-SLASH-5-QTR TO DST-YRQ CL*65 +00894 MOVE MDST-ACCT-IND(MDST-ACCT-IDX) TO DST-ACCT CL*66 +00895 MOVE MDST-AMT(MDST-ACCT-IDX) TO DST-AMT CL*67 +00896 MOVE MDST-ESTB-DATE TO L001-FED-8-DATE-9 CL*65 +00897 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*65 +00898 IF L001-VALID-DATE CL*65 +00899 MOVE L001-SLASH-8-DATE TO DST-CHNG-DT CL*65 +00900 ELSE CL*65 +00901 MOVE SPACES TO DST-CHNG-DT CL*65 +00902 END-IF CL*65 +00903 WRITE PAYD-REC FROM W-PAY-DIST-REC CL*70 +00904 END-PERFORM CL*81 +00905 END-IF. CL*81 +00906 CL*59 +00907 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*59 +00908 CL*59 +00909 P2510-EXIT. CL*59 +00910 EXIT. CL*59 +00911 CL*59 +00912 CL*59 +00913 P3000-CREDIT-INFO. CL*38 +00914 CL*55 +00915 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX521 +00916 MOVE ACIN-EMP-NO TO MJRN-EMP-NO. CL*39 +00917 SET MJRN-JRN-88 TO TRUE. DTSBX521 +00918 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX521 +00919 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX521 +00920 PERFORM UNTIL L910-NO-REC-88 DTSBX521 +00921 MOVE MSKL-REC TO MJRN-REC DTSBX521 +00922 ADD +1 TO W-MJRN-READ-CNT DTSBX521 +00923 IF NOT MJRN-TRAN-CNVR-88 CL*26 +00924 PERFORM P3100-CREDIT-PAYMT THRU P3100-EXIT CL*47 +00925 END-IF CL*28 +00926 MOVE MJRN-REC TO MSKL-REC CL*33 +00927 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX521 +00928 END-PERFORM. DTSBX521 +00929 DTSBX521 +00930 P3000-EXIT. CL*39 +00931 EXIT. DTSBX521 +00932 DTSBX521 +00933 P3100-CREDIT-PAYMT. CL*47 +00934 IF MJRN-TRAN-ADJ-88 CL*47 +00935 GO TO P3100-EXIT. CL*47 +00936 CL*47 +00937 IF MJRN-DEPOSIT-DATE > MHDR-PRIOR-RUN-DATE CL111 +00938 * IF MJRN-DEPOSIT-DATE > 20160122 CL111 +00939 GO TO P3100-EXIT. CL*83 +00940 CL*48 +00941 IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) AND CL*47 +00942 MJRN-COL-PAID-88 (MJRN-OCC-IDX) CL*47 +00943 DISPLAY ' MJRN CR PAID ' MJRN-EMP-NO ' ' CL*47 +00944 MJRN-BATCH-NO ' ' MJRN-ITEM-NO ' ' CL*47 +00945 MJRN-TRAN-CATEGORY ' ' MJRN-TRAN-TYPE ' ' CL*47 +00946 MJRN-AMT (MJRN-OCC-IDX) ' ' CL*48 +00947 MJRN-RECEIVED-DATE ' ' CL*48 +00948 MJRN-DEPOSIT-DATE CL*48 +00949 MOVE +1 TO WRK-CREDIT-CNTR CL*63 +00950 IF WRK-CREDIT-CNTR < 5 CL*58 +00951 PERFORM P3150-MOVE-CREDIT THRU P3150-EXIT CL*55 +00952 END-IF. CL*47 +00953 CL*47 +00954 P3100-EXIT. CL*47 +00955 EXIT. CL*47 +00956 P3150-MOVE-CREDIT. CL*55 +00957 IF WRK-CREDIT-CNTR = 1 CL*55 +00958 MOVE MJRN-BATCH-NO TO ACCT-ORIG-BATCH-NO1 CL*55 +00959 MOVE MJRN-ITEM-NO TO ACCT-ORIG-ITEM-NO1 CL*55 +00960 * MJRN-AMT (MJRN-OCC-IDX) ACCT-AMT1 CL*64 +00961 ELSE CL*55 +00962 DISPLAY ' ************ FATAL ERROR *****************' CL*55 +00963 DISPLAY ' MJRN CR PAID HAS MORE THAN 4 CREDITS AVAIL' CL*55 +00964 DISPLAY ' EXTEND CREDIT TABLE !!!!!!!!!!!!!!!!!!! ' CL*55 +00965 DISPLAY ' ************ FATAL ERROR *****************' CL*55 +00966 PERFORM S999-ABEND THRU S999-EXIT. CL*55 +00967 P3150-EXIT. CL*55 +00968 EXIT. CL*55 +00969 CL*55 +00970 P3200-PAYMENT. CL*29 +00971 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX521 +00972 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBX521 +00973 SET MPAY-PAY-88 TO TRUE. DTSBX521 +00974 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX521 +00975 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX521 +00976 IF L910-NO-REC-88 DTSBX521 +00977 GO TO P3200-EXIT CL*29 +00978 ELSE DTSBX521 +00979 PERFORM DTSBX521 +00980 UNTIL L910-NO-REC-88 DTSBX521 +00981 MOVE MSKL-REC TO MPAY-REC DTSBX521 +00982 PERFORM P3210-WRITE THRU P3210-EXIT DTSBX521 +00983 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX521 +00984 END-PERFORM DTSBX521 +00985 END-IF. DTSBX521 +00986 DTSBX521 +00987 P3200-EXIT. DTSBX521 +00988 EXIT. DTSBX521 +00989 DTSBX521 +00990 P3210-WRITE. DTSBX521 +00991 MOVE MPAY-PAY-TYPE TO PAYT-PAY-TYPE CL*29 +00992 IF MPAY-APPLIC-YRQ > ZERO DTSBX521 +00993 MOVE MPAY-APPLIC-YRQ TO L004-QTR-5-9 DTSBX521 +00994 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX521 +00995 MOVE L004-SLASH-5-QTR TO PAYT-YRQ CL*29 +00996 ELSE DTSBX521 +00997 MOVE SPACES TO PAYT-YRQ CL*29 +00998 END-IF. DTSBX521 +00999 MOVE MPRF-EMP-NO TO PAYT-EMP-NO. CL*29 +01000 MOVE MPAY-BATCH-NO TO PAYT-BATCH. CL*29 +01001 MOVE MPAY-ITEM-NO TO PAYT-ITEM. CL*29 +01002 MOVE MPAY-REMIT-AMT TO PAYT-AMT. CL*29 +01003 MOVE MPAY-TRACE-NO TO PAYT-PAYMT-ID. CL*44 +01004 DTSBX521 +01005 MOVE MPAY-WAIVE-INT-IND TO PAYT-WI-IND CL*51 +01006 MOVE MPAY-WAIVE-LATE-PEN-IND TO PAYT-WLP-IND CL*51 +01007 MOVE MPAY-NSF-PEN-CHARGE-IND TO PAYT-WNP-IND CL*51 +01008 CL*51 +01009 MOVE MPAY-APPLIC-IND TO PAYT-IND. CL*29 +01010 MOVE MPAY-APPLIC-BATCH-NO TO PAYT-ORIG-BATCH-NO. CL*30 +01011 MOVE MPAY-APPLIC-ITEM-NO TO PAYT-ORIG-ITEM-NO CL*30 +01012 MOVE MPAY-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX521 +01013 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX521 +01014 MOVE L001-SLASH-8-DATE TO PAYT-RCVD-DT. CL*29 +01015 MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9. CL*29 +01016 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX521 +01017 IF L001-VALID-DATE DTSBX521 +01018 MOVE L001-SLASH-8-DATE TO PAYT-DEPOSIT-DT CL*29 +01019 ELSE DTSBX521 +01020 MOVE ZEROS TO PAYT-DEPOSIT-DT CL*31 +01021 END-IF. DTSBX521 +01022 DTSBX521 +01023 MOVE MPAY-RESPONSIBLE-OP-ID TO PAYT-OPID. CL*29 +01024 DTSBX521 +01025 DTSBX521 +01026 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX521 +01027 CL*29 +01028 ** IF MPAY-ESTB-DATE = 20160122 CL111 +01029 IF MPAY-ESTB-DATE = MHDR-PRIOR-RUN-DATE CL111 +01030 WRITE PAYMT-REC FROM W-PAYMT-REC CL*30 +01031 IF NOT PAYDIST-STATUS-OK-88 CL*42 +01032 DISPLAY 'CANNOT WRITE TO PAYMT FILE ' CL*42 +01033 ' ' PAYDIST-STATUS ' ' ACIN-EMP-NO CL*42 +01034 ELSE DTSBX521 +01035 ADD +1 TO W-PAYT-CNT CL*42 +01036 END-IF DTSBX521 +01037 END-IF. DTSBX521 +01038 DTSBX521 +01039 P3210-EXIT. DTSBX521 +01040 EXIT. DTSBX521 +01041 DTSBX521 +01042 T0000-TERMINATE. DTSBX521 +01043 PERFORM S910-CLOSE THRU S910-EXIT. CL**4 +01044 PERFORM S921-CLOSE THRU S921-EXIT. CL**4 +01045 PERFORM S931-CLOSE THRU S931-EXIT. CL**4 +01046 CL**4 +01047 CLOSE ACCT-FILE-OUT CL*35 +01048 ACCT-FILE-IN CL*35 +01049 PAYD-FILE CL*65 +01050 ** SUMMARY-FILE CL**6 +01051 PAYMT-FILE-OUT. CL*35 +01052 DTSBX521 +01053 DISPLAY '*********************************************'. DTSBX521 +01054 DISPLAY '** DTSBX521 TERMINATION STATISTICS **'. CL*76 +01055 DISPLAY '** **'. DTSBX521 +01056 DISPLAY '** ACOUNTING ' W-ACCT-CNT DTSBX521 +01057 DISPLAY '** ACOUNTING INCR ' W-ACCT-CNT-INCR DTSBX521 +01058 DISPLAY '** TRANSACTIONS ' W-TRAN-CNT DTSBX521 +01059 DISPLAY '** TRANSACTIONS INCR ' W-TRAN-CNT-INCR DTSBX521 +01060 DISPLAY '** PAYMENTS ' W-PAY-CNT DTSBX521 +01061 ' **'. DTSBX521 +01062 DISPLAY '** PAY DIST ' W-PAY-DIST-CNT DTSBX521 +01063 ' **'. DTSBX521 +01064 DISPLAY '** ADJUST ' W-ADJ-CNT DTSBX521 +01065 ' **'. DTSBX521 +01066 DISPLAY '** ERRORS ' W-ERROR-CNT DTSBX521 +01067 ' **'. DTSBX521 +01068 DISPLAY '** CREDITS CORRECTED ' W-CR-CNT DTSBX521 +01069 ' **'. DTSBX521 +01070 DISPLAY '** LAST JC BATCH/ITEM ' DTSBX521 +01071 W-JC-BATCH '/' W-JC-ITEM DTSBX521 +01072 ' **'. DTSBX521 +01073 DISPLAY '*********************************************'. CL*15 +01074 DISPLAY '*******TOTAL CRDEITS ON MJRN AND MPRF RECS **'. CL*15 +01075 DISPLAY '**' CL*15 +01076 DISPLAY '** TOTAL-MPRF-CREDIT = ' W-TOT-MPRF-CREDIT CL*15 +01077 DISPLAY '** TOTAL-MJRN-CREDIT = ' W-TOT-MJRN-CREDIT CL*15 +01078 DISPLAY '**' CL*15 +01079 DISPLAY '*********************************************'. CL*15 +01080 DISPLAY '*******MPRF CRDITS NOT EQ TO MJRN CREDITS **'. CL*15 +01081 DISPLAY '**' CL*15 +01082 DISPLAY '** TOTAL-MPRF-CREDIT = ' W-DIF-MPRF-CREDIT CL*15 +01083 DISPLAY '** TOTAL-MJRN-CREDIT = ' W-DIF-MJRN-CREDIT CL*15 +01084 DISPLAY '**' CL*15 +01085 DISPLAY '*********************************************'. CL*15 +01086 DISPLAY '*********************************************'. DTSBX521 +01087 DTSBX521 +01088 DTSBX521 +01089 T0000-EXIT. DTSBX521 +01090 EXIT. DTSBX521 +01091 DTSBX521 +01092 DTSBX521 +01093 S001-FROM-FED-8. DTSBX521 +01094 SET L001-FROM-FED-8 TO TRUE. DTSBX521 +01095 GO TO S001-DATE. DTSBX521 +01096 DTSBX521 +01097 S001-FROM-ABS-DAY. DTSBX521 +01098 SET L001-FROM-ABS-DAY TO TRUE. DTSBX521 +01099 GO TO S001-DATE. DTSBX521 +01100 DTSBX521 +01101 S001-FROM-CAL-6. DTSBX521 +01102 SET L001-FROM-CAL-6 TO TRUE. DTSBX521 +01103 GO TO S001-DATE. DTSBX521 +01104 DTSBX521 +01105 S001-DATE. DTSBX521 +01106 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX521 +01107 S001-EXIT. DTSBX521 +01108 EXIT. DTSBX521 +01109 SKIP3 DTSBX521 +01110 S004-FROM-5. DTSBX521 +01111 SET L004-FROM-5 TO TRUE. DTSBX521 +01112 GO TO S004-QTR. DTSBX521 +01113 DTSBX521 +01114 S004-FROM-ABS. DTSBX521 +01115 SET L004-FROM-ABS TO TRUE. DTSBX521 +01116 GO TO S004-QTR. DTSBX521 +01117 DTSBX521 +01118 S004-FROM-3. DTSBX521 +01119 SET L004-FROM-3 TO TRUE. DTSBX521 +01120 GO TO S004-QTR. DTSBX521 +01121 DTSBX521 +01122 S004-FROM-DATE. DTSBX521 +01123 SET L004-FROM-DATE TO TRUE. DTSBX521 +01124 GO TO S004-QTR. DTSBX521 +01125 DTSBX521 +01126 S004-QTR. DTSBX521 +01127 DTSBX521 +01128 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX521 +01129 DTSBX521 +01130 S004-EXIT. DTSBX521 +01131 EXIT. DTSBX521 +01132 SKIP3 DTSBX521 +01133 S005-SYS-DATE. CL**4 +01134 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX521 +01135 S005-EXIT. DTSBX521 +01136 EXIT. DTSBX521 +01137 DTSBX521 +01138 S910-OPEN-READ. DTSBX521 +01139 SET L910-OPEN-READ-88 TO TRUE. DTSBX521 +01140 GO TO S910-MSTR-IO. DTSBX521 +01141 DTSBX521 +01142 S910-READ. DTSBX521 +01143 SET L910-READ-88 TO TRUE. DTSBX521 +01144 GO TO S910-MSTR-IO. DTSBX521 +01145 DTSBX521 +01146 S910-START-BROWSE. DTSBX521 +01147 SET L910-START-BROWSE-88 TO TRUE. DTSBX521 +01148 GO TO S910-MSTR-IO. DTSBX521 +01149 DTSBX521 +01150 S910-READ-NEXT. DTSBX521 +01151 SET L910-READ-NEXT-88 TO TRUE. DTSBX521 +01152 GO TO S910-MSTR-IO. DTSBX521 +01153 DTSBX521 +01154 S910-COUNT. DTSBX521 +01155 SET L910-COUNT-88 TO TRUE. DTSBX521 +01156 GO TO S910-MSTR-IO. DTSBX521 +01157 DTSBX521 +01158 S910-REWRITE. DTSBX521 +01159 SET L910-REWRITE-88 TO TRUE. DTSBX521 +01160 GO TO S910-MSTR-IO. DTSBX521 +01161 DTSBX521 +01162 S910-CLOSE. DTSBX521 +01163 SET L910-CLOSE-88 TO TRUE. DTSBX521 +01164 GO TO S910-MSTR-IO. DTSBX521 +01165 DTSBX521 +01166 S910-MSTR-IO. DTSBX521 +01167 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX521 +01168 MSKL-REC. DTSBX521 +01169 S910-EXIT. DTSBX521 +01170 EXIT. DTSBX521 +01171 CL**4 +01172 S921-OPEN-READ. CL**4 +01173 SET L921-OPEN-READ-88 TO TRUE. CL**4 +01174 GO TO S921-AIX-IO. CL**4 +01175 CL**4 +01176 S921-CLOSE. CL**4 +01177 SET L921-CLOSE-88 TO TRUE. CL**4 +01178 GO TO S921-AIX-IO. CL**4 +01179 CL**4 +01180 S921-AIX-IO. CL**4 +01181 CALL 'DTSBU921' USING L921-LINK-AREA CL**4 +01182 ISKL-REC. CL**4 +01183 S921-EXIT. CL**4 +01184 EXIT. CL**4 +01185 DTSBX521 +01186 S931-OPEN-READ. CL**5 +01187 SET L931-OPEN-READ-88 TO TRUE CL**5 +01188 GO TO S931-REF-IO. CL**5 +01189 CL**5 +01190 S931-READ. DTSBX521 +01191 SET L931-READ-88 TO TRUE. DTSBX521 +01192 GO TO S931-REF-IO. DTSBX521 +01193 DTSBX521 +01194 S931-CLOSE. CL**5 +01195 SET L931-CLOSE-88 TO TRUE. CL**5 +01196 GO TO S931-REF-IO. CL**5 +01197 CL**5 +01198 S931-REF-IO. DTSBX521 +01199 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX521 +01200 FSKL-REC. DTSBX521 +01201 S931-EXIT. DTSBX521 +01202 EXIT. DTSBX521 +01203 DTSBX521 +01204 S1000-CORRECTION-BATCH. DTSBX521 +01205 IF W-JC-ITEM < +999 DTSBX521 +01206 ADD +1 TO W-JC-ITEM DTSBX521 +01207 ELSE DTSBX521 +01208 ADD +1 TO W-JC-BATCH DTSBX521 +01209 MOVE +1 TO W-JC-ITEM DTSBX521 +01210 END-IF. DTSBX521 +01211 DTSBX521 +01212 S1000-EXIT. DTSBX521 +01213 EXIT. DTSBX521 +01214 DTSBX521 +01215 S999-ABEND. DTSBX521 +01216 DISPLAY '*** DTSBX343 ABENDING. ' DTSBX521 +01217 ABEND-MSG. DTSBX521 +01218 DTSBX521 +01219 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX521 +01220 S999-EXIT. DTSBX521 +01221 EXIT. DTSBX521 diff --git a/Batch/DTSBX522.cob b/Batch/DTSBX522.cob new file mode 100644 index 0000000..5eb2a09 --- /dev/null +++ b/Batch/DTSBX522.cob @@ -0,0 +1,2371 @@ +00001 IDENTIFICATION DIVISION. 01/23/16 +00002 PROGRAM-ID. DTSBX522. DTSBX522 +00003 AUTHOR. NGC. LV068 +00004 DATE-WRITTEN. OCTOBER 2007. DTSBX522 +00005 DATE-COMPILED. DTSBX522 +00006 SKIP3 DTSBX522 +00007 ***** DTSBX522 +00008 * DTSBX522 +00009 * FUNCTION: INTERNAL WEB MAINFRAME EXTRACT - ACCOUNTING DTSBX522 +00010 * >>> INITIAL CONVERSION <<< DTSBX522 +00011 * DTSBX522 +00012 * DTSBX342 IS FOR THE DAILY INCREMENTAL UPDATE DTSBX522 +00013 * DTSBX522 +00014 * MODIFICATION LOG: DTSBX522 +00015 * DTSBX522 +00016 * 10/22/2007 INITIAL DEVELOPMENT. DTSBX522 +00017 * REFERENCE: PROGRAMMER: GD DTSBX522 +00018 * DTSBX522 +00019 * 04/17/2008 CORRECTED SELECTION FOR REPORTS IN P3100. DTSBX522 +00020 * THE PROCESS THAT ATTEMPTED TO COMBINE 4 DTSBX522 +00021 * QUARTERLY REPORTS INTO ONE ANNUAL REPORT DTSBX522 +00022 * HAD A PROBLEM WITH THE READS AND RESULTED DTSBX522 +00023 * IN SOME NON-ANNUAL REPORTS BEING BYPASSED. DTSBX522 +00024 * THE ANNUAL REPORTS ARE NOW WRITTEN IN DTSBX522 +00025 * EXACTLY THE SAME WAY AS QUARTERLY REPORTS. DTSBX522 +00026 * REFERENCE: PROGRAMMER: GD DTSBX522 +00027 * DTSBX522 +00028 * 03/02/2009 MODIFIED P5000 (PAY DISTRIBUTION) TO SELECT DTSBX522 +00029 * RECORDS FOR ALL EMPLOYERS - NOT JUST THOSE DTSBX522 +00030 * WITH CREDITS. DTSBX522 +00031 * REFERENCE: PROGRAMMER: GD DTSBX522 +00032 * DTSBX522 +00033 * 03/11/2009 MODIFIED FOR INCREMENTAL UPDATE OF ACCOUNTING DTSBX522 +00034 * TRANSACTION FILES. PARAGRAPHS AFFECTED: DTSBX522 +00035 * P2110, P3110, P3210, P3310. DTSBX522 +00036 * NEW, TEMPORARY, FILES ADDED FOR INCREMENTAL DTSBX522 +00037 * RECORDS FOR TESTING. THE REGULAR FILES CONTINUE DTSBX522 +00038 * TO BE PRODUCED FOR THE PRODUCTION DATABASE. DTSBX522 +00039 * REFERENCE: PROGRAMMER: GD DTSBX522 +00040 * DTSBX522 +00041 * 11/05/2009 REMOVED TRAN AND ACCT FILES - ONLY THE DTSBX522 +00042 * INCREMENTALLY UPDATED VERSIONS WILL BE WRITTEN. DTSBX522 +00043 * REFERENCE: PROGRAMMER: GD DTSBX522 +00044 * DTSBX522 +00045 * 01/22/2010 MODIFIED PROCESS THAT SETS BALANCE DUE IN DTSBX522 +00046 * P1210-BAL-DUE. IF CURRENT DATE < THE TAX DUE DTSBX522 +00047 * DATE FOR THE QUARTER, SET THE BALANCE DUE TO 0. DTSBX522 +00048 * REFERENCE: PROGRAMMER: GD DTSBX522 +00049 * DTSBX522 +00050 * 04/05/2010 ADDED TAX DUE DATE TO TA1-QUARTER TABLE. DTSBX522 +00051 * ADDED RECEIVED DATE TO TA3-ACCT-DETAIL TABLE. DTSBX522 +00052 * ADDED RESP ACTIVITY AND RESP OPID TO DTSBX522 +00053 * TA2-TRAN-DETAIL. DTSBX522 +00054 * REFERENCE: PROGRAMMER: GD DTSBX522 +00055 * DTSBX522 +00056 * 05/14/2010 CORRECTED ORDER OF FIELDS IN W-QTR-REC TO DTSBX522 +00057 * MATCH ORDER EXPECTED IN SQL SERVER DATABASE. DTSBX522 +00058 * REFERENCE: PROGRAMMER: GD DTSBX522 +00059 * DTSBX522 +00060 * 12/10/2015 PROGRAM RENAMED FROM BX355 TO BX522 CL*67 +00061 * REFERENCE: PROGRAMMER: ZL1 CL*67 +00062 * CL*67 +00063 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX522 +00064 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX522 +00065 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX522 +00066 * DTSBX522 +00067 * DTSBX522 +00068 * DESCRIPTION: DTSBX522 +00069 * DTSBX522 +00070 * DTSBX522 +00071 * INITIATION: DTSBX522 +00072 * DTSBX522 +00073 * DTSBX522 +00074 * DTSBX522 +00075 * PROCESSING: DTSBX522 +00076 * DTSBX522 +00077 * DTSBX522 +00078 * TERMINATION: DTSBX522 +00079 * DTSBX522 +00080 * DTSBX522 +00081 * DTSBX522 +00082 * RECORDS READ: DTSBX522 +00083 * DTSBX522 +00084 * MASTER: DTSBX522 +00085 * DTSBX522 +00086 * MQTR DTSBX522 +00087 * MJRN DTSBX522 +00088 * MPAY DTSBX522 +00089 * MRPT DTSBX522 +00090 * MADJ DTSBX522 +00091 * DTSBX522 +00092 * DTSBX522 +00093 * ALTERNATE INDEX: DTSBX522 +00094 * DTSBX522 +00095 * NONE. DTSBX522 +00096 * DTSBX522 +00097 * DTSBX522 +00098 * REFERENCE: DTSBX522 +00099 * DTSBX522 +00100 * DTSBX522 +00101 * DTSBX522 +00102 * RECORDS UPDATED: DTSBX522 +00103 * DTSBX522 +00104 * NONE DTSBX522 +00105 * DTSBX522 +00106 * DTSBX522 +00107 * OUTPUT RECORDS WRITTEN: DTSBX522 +00108 * DTSBX522 +00109 * DTSBX331 DTSBX522 +00110 * DTSBX522 +00111 * DTSBX522 +00112 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX522 +00113 * DTSBX522 +00114 * NONE. DTSBX522 +00115 * DTSBX522 +00116 * DTSBX522 +00117 * MODULES CALLED: DTSBX522 +00118 * DTSBX522 +00119 * DTSBU001 DATE EDIT/CONVERSION. DTSBX522 +00120 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX522 +00121 * DTSBU910 MASTER FILE I/O. DTSBX522 +00122 * DTSBX522 +00123 * DTSBX522 +00124 * DTSBX522 +00125 ***** DTSBX522 +00126 SKIP3 DTSBX522 +00127 ENVIRONMENT DIVISION. DTSBX522 +00128 INPUT-OUTPUT SECTION. DTSBX522 +00129 FILE-CONTROL. DTSBX522 +00130 ** SELECT ACCT-FILE ASSIGN TO DTSFACC1 DTSBX522 +00131 ** FILE STATUS IS ACCT-STATUS. DTSBX522 +00132 DTSBX522 +00133 SELECT ACCT-FILE-INCR ASSIGN TO DTSFACC3 DTSBX522 +00134 FILE STATUS IS ACCT-I-STATUS. DTSBX522 +00135 DTSBX522 +00136 ** SELECT TRAN-FILE ASSIGN TO DTSFTRN1 DTSBX522 +00137 ** FILE STATUS IS TRAN-STATUS. DTSBX522 +00138 DTSBX522 +00139 SELECT TRAN-FILE-INCR ASSIGN TO DTSFTRN3 DTSBX522 +00140 FILE STATUS IS TRAN-I-STATUS. DTSBX522 +00141 DTSBX522 +00142 SELECT QTR-FILE ASSIGN TO DTSFQTR1 DTSBX522 +00143 FILE STATUS IS QTR-STATUS. DTSBX522 +00144 DTSBX522 +00145 SELECT SUMMARY-FILE ASSIGN TO DTSFSUM1 DTSBX522 +00146 FILE STATUS IS SUMMARY-STATUS. DTSBX522 +00147 DTSBX522 +00148 SELECT PAY-DIST-FILE ASSIGN TO DTSFDST1 DTSBX522 +00149 FILE STATUS IS PAYDIST-STATUS. DTSBX522 +00150 DTSBX522 +00151 DATA DIVISION. DTSBX522 +00152 FILE SECTION. DTSBX522 +00153 FD ACCT-FILE-INCR DTSBX522 +00154 RECORDING MODE IS F DTSBX522 +00155 LABEL RECORDS ARE STANDARD DTSBX522 +00156 BLOCK CONTAINS 0 CHARACTERS. DTSBX522 +00157 DTSBX522 +00158 01 ACCT-INCR-REC PIC X(81). CL*63 +00159 *01 ACCT-INCR-REC PIC X(72). CL*63 +00160 DTSBX522 +00161 FD TRAN-FILE-INCR DTSBX522 +00162 RECORDING MODE IS F DTSBX522 +00163 LABEL RECORDS ARE STANDARD DTSBX522 +00164 BLOCK CONTAINS 0 CHARACTERS. DTSBX522 +00165 DTSBX522 +00166 01 TRAN-INCR-REC PIC X(141). DTSBX522 +00167 DTSBX522 +00168 FD QTR-FILE DTSBX522 +00169 RECORDING MODE IS F DTSBX522 +00170 LABEL RECORDS ARE STANDARD DTSBX522 +00171 BLOCK CONTAINS 0 CHARACTERS. DTSBX522 +00172 DTSBX522 +00173 01 QTR-REC PIC X(63). DTSBX522 +00174 DTSBX522 +00175 FD SUMMARY-FILE DTSBX522 +00176 RECORDING MODE IS F. DTSBX522 +00177 01 SUMMARY-REC PIC X(73). DTSBX522 +00178 DTSBX522 +00179 FD PAY-DIST-FILE DTSBX522 +00180 RECORDING MODE IS F. DTSBX522 +00181 01 PAY-DIST-REC PIC X(50). DTSBX522 +00182 DTSBX522 +00183 WORKING-STORAGE SECTION. DTSBX522 +001835 77 PAN-VALET PICTURE X(24) VALUE '068DTSBX522 01/23/16'. DTSBX522 +00184 SKIP3 DTSBX522 +00185 01 W-AREA. DTSBX522 +00186 05 W-ABEND-CD PIC S9(04) COMP VALUE +343.DTSBX522 +00187 DTSBX522 +00188 DTSBX522 +00189 05 ABEND-MSG PIC X(60). DTSBX522 +00190 DTSBX522 +00191 05 PARM-STATUS PIC X(02). DTSBX522 +00192 88 PARM-STATUS-OK-88 VALUE '00'. DTSBX522 +00193 05 ACCT-STATUS PIC X(02). DTSBX522 +00194 88 ACCT-STATUS-OK-88 VALUE '00'. DTSBX522 +00195 88 ACCT-STATUS-EOF-88 VALUE '10'. DTSBX522 +00196 05 ACCT-I-STATUS PIC X(02). DTSBX522 +00197 88 ACCT-I-STATUS-OK-88 VALUE '00'. DTSBX522 +00198 88 ACCT-I-STATUS-EOF-88 VALUE '10'. DTSBX522 +00199 05 TRAN-STATUS PIC X(02). DTSBX522 +00200 88 TRAN-STATUS-OK-88 VALUE '00'. DTSBX522 +00201 05 TRAN-I-STATUS PIC X(02). DTSBX522 +00202 88 TRAN-I-STATUS-OK-88 VALUE '00'. DTSBX522 +00203 05 QTR-STATUS PIC X(02). DTSBX522 +00204 88 QTR-STATUS-OK-88 VALUE '00'. DTSBX522 +00205 05 QCOLL-STATUS PIC X(02). DTSBX522 +00206 88 QCOLL-STATUS-OK-88 VALUE '00'. DTSBX522 +00207 05 SUMMARY-STATUS PIC X(02). DTSBX522 +00208 88 SUMMARY-STATUS-OK-88 VALUE '00'. DTSBX522 +00209 05 PAYDIST-STATUS PIC X(02). DTSBX522 +00210 88 PAYDIST-STATUS-OK-88 VALUE '00'. DTSBX522 +00211 DTSBX522 +00212 05 EMP-STATUS PIC X(02). DTSBX522 +00213 88 EMP-STATUS-OK-88 VALUE '00'. DTSBX522 +00214 DTSBX522 +00215 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX522 +00216 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX522 +00217 88 W-ERROR-NO-88 VALUE 'N'. DTSBX522 +00218 DTSBX522 +00219 05 W-RPT-COMPLETE-IND PIC X(01). DTSBX522 +00220 88 W-RPT-COMPLETE-YES-88 VALUE 'Y'. DTSBX522 +00221 88 W-RPT-COMPLETE-NO-88 VALUE 'N'. DTSBX522 +00222 88 W-RPT-COMPLETE-NULL-88 VALUE ' '. DTSBX522 +00223 DTSBX522 +00224 05 W-UI-CHARGE-IND PIC X(01). DTSBX522 +00225 88 W-UI-CHARGE-YES-88 VALUE 'Y'. DTSBX522 +00226 88 W-UI-CHARGE-NO-88 VALUE 'N'. DTSBX522 +00227 05 W-LP-CHARGE-IND PIC X(01). DTSBX522 +00228 88 W-LP-CHARGE-YES-88 VALUE 'Y'. DTSBX522 +00229 88 W-LP-CHARGE-NO-88 VALUE 'N'. DTSBX522 +00230 05 WK-JRN-HOLD-KEY-AREA PIC X(16). CL*56 +00231 05 W-STATUS-CD PIC X(02). DTSBX522 +00232 88 W-STATUS-WITHDRAWN-88 VALUE '04', '05'. DTSBX522 +00233 DTSBX522 +00234 05 CONV-QTR-SUB PIC S9(04) COMP. DTSBX522 +00235 05 QSUB PIC S9(04) COMP. DTSBX522 +00236 05 QMAX PIC S9(04) COMP VALUE +400. DTSBX522 +00237 05 ACCT-TABLE OCCURS 400 TIMES. DTSBX522 +00238 10 TBL-YRQ PIC S9(05) COMP-3. DTSBX522 +00239 10 TBL-JRN-IND PIC X(01). DTSBX522 +00240 88 TBL-JRN-GOOD-88 VALUE '0'. DTSBX522 +00241 88 TBL-JRN-BAD-88 VALUE '1'. DTSBX522 +00242 10 Q-UI-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00243 10 Q-UI-PD PIC S9(11)V99 COMP-3. DTSBX522 +00244 10 Q-UI-WV PIC S9(11)V99 COMP-3. DTSBX522 +00245 10 Q-UI-WO PIC S9(11)V99 COMP-3. DTSBX522 +00246 10 Q-UI-TL PIC S9(11)V99 COMP-3. DTSBX522 +00247 10 Q-UI-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00248 10 J-UI-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00249 10 J-UI-PD PIC S9(11)V99 COMP-3. DTSBX522 +00250 10 J-UI-WV PIC S9(11)V99 COMP-3. DTSBX522 +00251 10 J-UI-WO PIC S9(11)V99 COMP-3. DTSBX522 +00252 10 J-UI-TL PIC S9(11)V99 COMP-3. DTSBX522 +00253 10 J-UI-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00254 10 Q-INT-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00255 10 Q-INT-PD PIC S9(11)V99 COMP-3. DTSBX522 +00256 10 Q-INT-WV PIC S9(11)V99 COMP-3. DTSBX522 +00257 10 Q-INT-WO PIC S9(11)V99 COMP-3. DTSBX522 +00258 10 Q-INT-TL PIC S9(11)V99 COMP-3. DTSBX522 +00259 10 Q-INT-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00260 10 J-INT-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00261 10 J-INT-PD PIC S9(11)V99 COMP-3. DTSBX522 +00262 10 J-INT-WV PIC S9(11)V99 COMP-3. DTSBX522 +00263 10 J-INT-WO PIC S9(11)V99 COMP-3. DTSBX522 +00264 10 J-INT-TL PIC S9(11)V99 COMP-3. DTSBX522 +00265 10 J-INT-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00266 10 Q-LP-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00267 10 Q-LP-PD PIC S9(11)V99 COMP-3. DTSBX522 +00268 10 Q-LP-WV PIC S9(11)V99 COMP-3. DTSBX522 +00269 10 Q-LP-WO PIC S9(11)V99 COMP-3. DTSBX522 +00270 10 Q-LP-TL PIC S9(11)V99 COMP-3. DTSBX522 +00271 10 Q-LP-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00272 10 J-LP-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00273 10 J-LP-PD PIC S9(11)V99 COMP-3. DTSBX522 +00274 10 J-LP-WV PIC S9(11)V99 COMP-3. DTSBX522 +00275 10 J-LP-WO PIC S9(11)V99 COMP-3. DTSBX522 +00276 10 J-LP-TL PIC S9(11)V99 COMP-3. DTSBX522 +00277 10 J-LP-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00278 10 Q-NP-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00279 10 Q-NP-PD PIC S9(11)V99 COMP-3. DTSBX522 +00280 10 Q-NP-WV PIC S9(11)V99 COMP-3. DTSBX522 +00281 10 Q-NP-WO PIC S9(11)V99 COMP-3. DTSBX522 +00282 10 Q-NP-TL PIC S9(11)V99 COMP-3. DTSBX522 +00283 10 Q-NP-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00284 10 J-NP-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00285 10 J-NP-PD PIC S9(11)V99 COMP-3. DTSBX522 +00286 10 J-NP-WV PIC S9(11)V99 COMP-3. DTSBX522 +00287 10 J-NP-WO PIC S9(11)V99 COMP-3. DTSBX522 +00288 10 J-NP-TL PIC S9(11)V99 COMP-3. DTSBX522 +00289 10 J-NP-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00290 10 Q-MP-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00291 10 Q-MP-PD PIC S9(11)V99 COMP-3. DTSBX522 +00292 10 Q-MP-WV PIC S9(11)V99 COMP-3. DTSBX522 +00293 10 Q-MP-WO PIC S9(11)V99 COMP-3. DTSBX522 +00294 10 Q-MP-TL PIC S9(11)V99 COMP-3. DTSBX522 +00295 10 Q-MP-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00296 10 J-MP-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00297 10 J-MP-PD PIC S9(11)V99 COMP-3. DTSBX522 +00298 10 J-MP-WV PIC S9(11)V99 COMP-3. DTSBX522 +00299 10 J-MP-WO PIC S9(11)V99 COMP-3. DTSBX522 +00300 10 J-MP-TL PIC S9(11)V99 COMP-3. DTSBX522 +00301 10 J-MP-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00302 10 Q-SU-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00303 10 Q-SU-PD PIC S9(11)V99 COMP-3. DTSBX522 +00304 10 Q-SU-WV PIC S9(11)V99 COMP-3. DTSBX522 +00305 10 Q-SU-WO PIC S9(11)V99 COMP-3. DTSBX522 +00306 10 Q-SU-TL PIC S9(11)V99 COMP-3. DTSBX522 +00307 10 Q-SU-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00308 10 J-SU-CHG PIC S9(11)V99 COMP-3. DTSBX522 +00309 10 J-SU-PD PIC S9(11)V99 COMP-3. DTSBX522 +00310 10 J-SU-WV PIC S9(11)V99 COMP-3. DTSBX522 +00311 10 J-SU-WO PIC S9(11)V99 COMP-3. DTSBX522 +00312 10 J-SU-TL PIC S9(11)V99 COMP-3. DTSBX522 +00313 10 J-SU-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00314 DTSBX522 +00315 05 W-AMT PIC S9(11)V99 COMP-3. DTSBX522 +00316 05 W-TOT-CHG PIC S9(11)V99 COMP-3 DTSBX522 +00317 VALUE +0. DTSBX522 +00318 05 W-TOT-PD PIC S9(11)V99 COMP-3 DTSBX522 +00319 VALUE +0. DTSBX522 +00320 05 W-TOT-CREDIT PIC S9(11)V99 COMP-3 DTSBX522 +00321 VALUE +0. DTSBX522 +00322 05 W-CREDIT-CORRECT PIC S9(11)V99 COMP-3 DTSBX522 +00323 VALUE +0. DTSBX522 +00324 DTSBX522 +00325 05 W-DEFAULT-DATE PIC X(10) DTSBX522 +00326 VALUE '12/31/1994'. DTSBX522 +00327 DTSBX522 +00328 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00329 05 W-MJRN-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00330 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00331 05 W-ACCT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00332 05 W-ACCT-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00333 05 W-TRAN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00334 05 W-TRAN-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00335 05 W-SUMMARY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00336 05 W-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00337 05 W-ANN-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00338 05 W-PAY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00339 05 W-PAY-DIST-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00340 05 W-ADJ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00341 05 W-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00342 05 W-CR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 +00343 05 W-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBX522 +00344 05 W-ITEM PIC S9(03) COMP-3 VALUE +0. DTSBX522 +00345 05 ADJ-CHG PIC S9(09)V99 COMP-3. DTSBX522 +00346 05 ADJ-PD PIC S9(09)V99 COMP-3. DTSBX522 +00347 05 ADJ-WV PIC S9(09)V99 COMP-3. DTSBX522 +00348 05 ADJ-WO PIC S9(09)V99 COMP-3. DTSBX522 +00349 05 ADJ-TL PIC S9(09)V99 COMP-3. DTSBX522 +00350 05 W-CHG PIC S9(09)V99 COMP-3. DTSBX522 +00351 05 W-PD PIC S9(09)V99 COMP-3. DTSBX522 +00352 05 W-WV PIC S9(09)V99 COMP-3. DTSBX522 +00353 05 W-WO PIC S9(09)V99 COMP-3. DTSBX522 +00354 05 W-TL PIC S9(09)V99 COMP-3. DTSBX522 +00355 05 W-BAL PIC S9(09)V99 COMP-3. DTSBX522 +00356 05 W-QTR-BAL PIC S9(11)V99 COMP-3. DTSBX522 +00357 05 W-RATE PIC S9(03)V9(04) COMP-3. DTSBX522 +00358 05 W-JC-BATCH PIC S9(05) COMP-3 DTSBX522 +00359 VALUE +00010. DTSBX522 +00360 05 W-JC-ITEM PIC S9(03) COMP-3 DTSBX522 +00361 VALUE +0. DTSBX522 +00362 DTSBX522 +00363 05 ASUB PIC S9(04) COMP. DTSBX522 +00364 05 ASUB1 PIC S9(04) COMP. DTSBX522 +00365 05 ASUB-MAX PIC S9(04) COMP VALUE +50. DTSBX522 +00366 05 ASUB-LAST PIC S9(04) COMP VALUE +0. DTSBX522 +00367 05 ANN-RPT-TABLE OCCURS 50 TIMES. DTSBX522 +00368 10 W-ANN-RPT-TYPE PIC X(02). DTSBX522 +00369 10 W-ANN-YRQ PIC 9(05). DTSBX522 +00370 10 FILLER REDEFINES W-ANN-YRQ. DTSBX522 +00371 15 W-ANN-YRQ-CCYY PIC 9(04). DTSBX522 +00372 15 W-ANN-YRQ-Q PIC 9(01). DTSBX522 +00373 DTSBX522 +00374 10 W-ANN-BATCH PIC S9(05) COMP-3. DTSBX522 +00375 10 W-ANN-ITEM PIC S9(03) COMP-3. DTSBX522 +00376 10 W-ANN-RATE PIC S9(03)V9(04) COMP-3. DTSBX522 +00377 10 W-ANN-REMIT PIC S9(09)V99 COMP-3. DTSBX522 +00378 10 W-ANN-TOT-WAGE PIC S9(09)V99 COMP-3. DTSBX522 +00379 10 W-ANN-TAX-WAGE PIC S9(09)V99 COMP-3. DTSBX522 +00380 10 W-ANN-EXCESS-WAGE PIC S9(09)V99 COMP-3. DTSBX522 +00381 10 W-ANN-RCVD-DT PIC S9(09) COMP-3. DTSBX522 +00382 10 W-ANN-PROCESS-DT PIC S9(09) COMP-3. DTSBX522 +00383 DTSBX522 +00384 05 W-LAST-ANN-YRQ PIC S9(05) COMP-3. DTSBX522 +00385 DTSBX522 +00386 05 W-ACCT-REC. DTSBX522 +00387 10 ACCT-EMP-NO PIC 9(06). DTSBX522 +00388 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00389 10 ACCT-YRQ PIC X(06). DTSBX522 +00390 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00391 10 ACCT-BATCH PIC 9(05). DTSBX522 +00392 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00393 10 ACCT-ITEM PIC 9(03). DTSBX522 +00394 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00395 10 ACCT-TRAN PIC X(02). DTSBX522 +00396 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00397 10 ACCT-ROW PIC X(02). DTSBX522 +00398 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00399 10 ACCT-COL PIC X(02). DTSBX522 +00400 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00401 10 ACCT-AMT PIC ---------9.99. DTSBX522 +00402 10 ACCT-AMT-9 REDEFINES ACCT-AMT PIC 9(10).99. DTSBX522 +00403 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00404 10 ACCT-CAT PIC X(01). DTSBX522 +00405 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00406 10 ACCT-PROCESS-DT PIC X(10). DTSBX522 +00407 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00408 10 ACCT-SOURCE PIC X(01). DTSBX522 +00409 88 ACCT-SOURCE-CR-DB-88 VALUE '1'. DTSBX522 +00410 88 ACCT-SOURCE-STATUS-88 VALUE '2'. DTSBX522 +00411 88 ACCT-SOURCE-ERROR-88 VALUE '3'. DTSBX522 +00412 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00413 10 ACCT-RCVD-DT PIC X(10). DTSBX522 +00414 10 FILLER PIC X(01) VALUE ','. CL*20 +00415 10 ACCT-PAYMENT-ID PIC 9(08). CL*20 +00416 DTSBX522 +00417 05 W-TRAN-REC. DTSBX522 +00418 10 TRAN-EMP-NO PIC 9(06). DTSBX522 +00419 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00420 10 TRAN-YRQ PIC X(06). DTSBX522 +00421 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00422 10 TRAN-BATCH PIC 9(05). DTSBX522 +00423 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00424 10 TRAN-ITEM PIC 9(03). DTSBX522 +00425 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00426 10 TRAN-TRANS PIC X(02). DTSBX522 +00427 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00428 10 TRAN-AMT PIC --------9.99. DTSBX522 +00429 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00430 10 TRAN-TOT-WAGE PIC ----------9.99. DTSBX522 +00431 10 TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE DTSBX522 +00432 PIC X(14). DTSBX522 +00433 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00434 10 TRAN-TAX-WAGE PIC ----------9.99. DTSBX522 +00435 10 TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE DTSBX522 +00436 PIC X(14). DTSBX522 +00437 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00438 10 TRAN-EXC-WAGE PIC ----------9.99. DTSBX522 +00439 10 TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE DTSBX522 +00440 PIC X(14). DTSBX522 +00441 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00442 10 TRAN-RATE PIC Z9.9. DTSBX522 +00443 10 TRAN-RATE-X REDEFINES TRAN-RATE DTSBX522 +00444 PIC X(04). DTSBX522 +00445 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00446 10 TRAN-ACCT PIC X(02). DTSBX522 +00447 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00448 10 TRAN-CAT PIC X(01). DTSBX522 +00449 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00450 10 TRAN-SOURCE PIC X(01). DTSBX522 +00451 88 TRAN-SOURCE-CR-DB-88 VALUE '1'. DTSBX522 +00452 88 TRAN-SOURCE-STATUS-88 VALUE '2'. DTSBX522 +00453 88 TRAN-SOURCE-ERROR-88 VALUE '3'. DTSBX522 +00454 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00455 10 TRAN-RCVD-DT PIC X(10). DTSBX522 +00456 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00457 10 TRAN-PROCESS-DT PIC X(10). DTSBX522 +00458 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00459 10 TRAN-APPLIC-BATCH PIC 9(05). DTSBX522 +00460 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00461 10 TRAN-APPLIC-ITEM PIC 9(03). DTSBX522 +00462 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00463 10 TRAN-RESP-ACTIVITY PIC X(03). DTSBX522 +00464 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00465 10 TRAN-RESP-OPID PIC X(08). DTSBX522 +00466 DTSBX522 +00467 05 W-QTR-REC. DTSBX522 +00468 10 QTR-EMP-NO PIC 9(06). DTSBX522 +00469 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00470 10 QTR-QUARTER PIC X(06). DTSBX522 +00471 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00472 10 QTR-RPT-STATUS PIC X(01). DTSBX522 +00473 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00474 10 QTR-RPT-DUE-DT PIC X(10). DTSBX522 +00475 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00476 10 QTR-PROCESS-DT PIC X(10). DTSBX522 +00477 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00478 10 QTR-BAL-DUE PIC ----------9.99. DTSBX522 +00479 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00480 10 QTR-TAX-DUE-DT PIC X(10). DTSBX522 +00481 DTSBX522 +00482 05 W-SUMMARY-REC. DTSBX522 +00483 10 SUMMARY-PROCESS-DT PIC X(10). DTSBX522 +00484 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00485 10 SUMMARY-MESSAGE PIC X(40). DTSBX522 +00486 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00487 10 SUMMARY-EMP-NO PIC 9(06). DTSBX522 +00488 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00489 10 SUMMARY-BATCH PIC 9(05). DTSBX522 +00490 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00491 10 SUMMARY-ITEM PIC 9(03). DTSBX522 +00492 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00493 10 SUMMARY-TRAN PIC X(02). DTSBX522 +00494 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00495 10 SUMMARY-SOURCE PIC X(01). DTSBX522 +00496 88 SUMMARY-SOURCE-CR-DB-88 VALUE '1'. DTSBX522 +00497 88 SUMMARY-SOURCE-STATUS-88 VALUE '2'. DTSBX522 +00498 88 SUMMARY-SOURCE-ERROR-88 VALUE '3'. DTSBX522 +00499 DTSBX522 +00500 05 W-PAY-DIST-REC. DTSBX522 +00501 10 DST-EMP-NO PIC 9(06). DTSBX522 +00502 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00503 10 DST-BATCH PIC 9(05). DTSBX522 +00504 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00505 10 DST-ITEM PIC 9(03). DTSBX522 +00506 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00507 10 DST-QTR PIC X(06). DTSBX522 +00508 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00509 10 DST-ACCT PIC X(02). DTSBX522 +00510 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00511 10 DST-AMT PIC --------9.99. DTSBX522 +00512 10 FILLER PIC X(01) VALUE ','. DTSBX522 +00513 10 DST-CHNG-DT PIC X(10). DTSBX522 +00514 DTSBX522 +00515 05 W-CURR-UI-TOT PIC S9(11)V99 COMP-3 DTSBX522 +00516 VALUE +0. DTSBX522 +00517 DTSBX522 +00518 05 DISPLAY-CNT PIC Z(06)9. DTSBX522 +00519 DTSBX522 +00520 05 DISPLAY-AMT1-X PIC X(14). DTSBX522 +00521 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX522 +00522 PIC ---,---,--9.99. DTSBX522 +00523 05 DISPLAY-AMT2-X PIC X(14). DTSBX522 +00524 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX522 +00525 PIC ---,---,--9.99. DTSBX522 +00526 05 DISPLAY-AMT3-X PIC X(14). DTSBX522 +00527 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX522 +00528 PIC ---,---,--9.99. DTSBX522 +00529 05 DISPLAY-AMT4-X PIC X(14). DTSBX522 +00530 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX522 +00531 PIC ---,---,--9.99. DTSBX522 +00532 EJECT DTSBX522 +00533 01 L001-LINK-AREA. DTSBX522 +00534 ++INCLUDE DTSIL001 DTSBX522 +00535 EJECT DTSBX522 +00536 01 L004-LINK-AREA. DTSBX522 +00537 ++INCLUDE DTSIL004 DTSBX522 +00538 EJECT DTSBX522 +00539 01 L005-LINK-AREA. DTSBX522 +00540 ++INCLUDE DTSIL005 DTSBX522 +00541 DTSBX522 +00542 01 L910-LINK-AREA. DTSBX522 +00543 ++INCLUDE DTSIL910 DTSBX522 +00544 SKIP3 DTSBX522 +00545 01 MSKL-REC. DTSBX522 +00546 ++INCLUDE DTSIMSKL DTSBX522 +00547 SKIP3 DTSBX522 +00548 01 MHDR-REC. DTSBX522 +00549 ++INCLUDE DTSIMHDR DTSBX522 +00550 SKIP3 DTSBX522 +00551 01 MQTR-REC. DTSBX522 +00552 ++INCLUDE DTSIMQTR DTSBX522 +00553 SKIP3 DTSBX522 +00554 01 MJRN-REC. DTSBX522 +00555 ++INCLUDE DTSIMJRN DTSBX522 +00556 SKIP3 DTSBX522 +00557 01 MRPT-REC. DTSBX522 +00558 ++INCLUDE DTSIMRPT DTSBX522 +00559 SKIP3 DTSBX522 +00560 01 MADJ-REC. DTSBX522 +00561 ++INCLUDE DTSIMADJ DTSBX522 +00562 SKIP3 DTSBX522 +00563 01 MPAY-REC. DTSBX522 +00564 ++INCLUDE DTSIMPAY DTSBX522 +00565 SKIP3 DTSBX522 +00566 01 MDST-REC. DTSBX522 +00567 ++INCLUDE DTSIMDST DTSBX522 +00568 SKIP3 DTSBX522 +00569 01 MRTE-REC. DTSBX522 +00570 ++INCLUDE DTSIMRTE DTSBX522 +00571 SKIP3 DTSBX522 +00572 01 MEVL-REC. DTSBX522 +00573 ++INCLUDE DTSIMEVL DTSBX522 +00574 SKIP3 DTSBX522 +00575 01 MSOL-REC. DTSBX522 +00576 ++INCLUDE DTSIMSOL DTSBX522 +00577 SKIP3 DTSBX522 +00578 01 MFSC-REC. DTSBX522 +00579 ++INCLUDE DTSIMFSC DTSBX522 +00580 SKIP3 DTSBX522 +00581 01 MTAD-REC. DTSBX522 +00582 ++INCLUDE DTSIMTAD DTSBX522 +00583 SKIP3 DTSBX522 +00584 01 MTAA-REC. DTSBX522 +00585 ++INCLUDE DTSIMTAA DTSBX522 +00586 SKIP3 DTSBX522 +00587 01 MLOG-REC. DTSBX522 +00588 ++INCLUDE DTSIMLOG DTSBX522 +00589 SKIP3 DTSBX522 +00590 01 L931-LINK-AREA. DTSBX522 +00591 ++INCLUDE DTSIL931 DTSBX522 +00592 SKIP3 DTSBX522 +00593 01 FSKL-REC. DTSBX522 +00594 ++INCLUDE DTSIFSKL DTSBX522 +00595 SKIP3 DTSBX522 +00596 01 FQTR-REC. DTSBX522 +00597 ++INCLUDE DTSIFQTR DTSBX522 +00598 DTSBX522 +00599 LINKAGE SECTION. DTSBX522 +00600 DTSBX522 +00601 01 LX34-LINK-AREA. DTSBX522 +00602 ++INCLUDE DTSILX34 DTSBX522 +00603 DTSBX522 +00604 01 MPRF-REC. DTSBX522 +00605 ++INCLUDE DTSIMPRF DTSBX522 +00606 EJECT DTSBX522 +00607 PROCEDURE DIVISION USING LX34-LINK-AREA DTSBX522 +00608 MPRF-REC. DTSBX522 +00609 DTSBX522 +00610 EVALUATE TRUE DTSBX522 +00611 WHEN LX34-INITIALIZE-88 DTSBX522 +00612 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX522 +00613 WHEN LX34-PROCESS-88 DTSBX522 +00614 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX522 +00615 WHEN LX34-TERMINATE-88 DTSBX522 +00616 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX522 +00617 END-EVALUATE. DTSBX522 +00618 DTSBX522 +00619 GOBACK. DTSBX522 +00620 DTSBX522 +00621 I0000-INITIALIZE. DTSBX522 +00622 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX522 +00623 DTSBX522 +00624 I0000-EXIT. DTSBX522 +00625 EXIT. DTSBX522 +00626 DTSBX522 +00627 I2000-OPEN-FILES. DTSBX522 +00628 ** OPEN OUTPUT ACCT-FILE. DTSBX522 +00629 * IF NOT ACCT-STATUS-OK-88 DTSBX522 +00630 * DISPLAY 'BX343 ACCT FILE OPEN ERROR: ' ACCT-STATUS DTSBX522 +00631 * MOVE 'FILE OPEN ERROR' DTSBX522 +00632 * TO ABEND-MSG DTSBX522 +00633 * PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +00634 ** END-IF. DTSBX522 +00635 DTSBX522 +00636 OPEN OUTPUT ACCT-FILE-INCR. DTSBX522 +00637 IF NOT ACCT-I-STATUS-OK-88 DTSBX522 +00638 DISPLAY 'BX343 ACCT INCR OPEN ERROR: ' ACCT-I-STATUS DTSBX522 +00639 MOVE 'FILE OPEN ERROR' DTSBX522 +00640 TO ABEND-MSG DTSBX522 +00641 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +00642 END-IF. DTSBX522 +00643 DTSBX522 +00644 ** OPEN OUTPUT TRAN-FILE. DTSBX522 +00645 * IF NOT TRAN-STATUS-OK-88 DTSBX522 +00646 * DISPLAY 'BX343 TRAN FILE OPEN ERROR: ' TRAN-STATUS DTSBX522 +00647 * MOVE 'FILE OPEN ERROR' DTSBX522 +00648 * TO ABEND-MSG DTSBX522 +00649 * PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +00650 ** END-IF. DTSBX522 +00651 DTSBX522 +00652 OPEN OUTPUT TRAN-FILE-INCR. DTSBX522 +00653 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 +00654 DISPLAY 'BX343 TRAN FILE INCR ERROR: ' TRAN-I-STATUS DTSBX522 +00655 MOVE 'FILE OPEN ERROR' DTSBX522 +00656 TO ABEND-MSG DTSBX522 +00657 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +00658 END-IF. DTSBX522 +00659 DTSBX522 +00660 OPEN OUTPUT QTR-FILE. DTSBX522 +00661 IF NOT QTR-STATUS-OK-88 DTSBX522 +00662 DISPLAY 'BX343 QTR FILE OPEN ERROR: ' QTR-STATUS DTSBX522 +00663 MOVE 'FILE OPEN ERROR' DTSBX522 +00664 TO ABEND-MSG DTSBX522 +00665 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +00666 END-IF. DTSBX522 +00667 DTSBX522 +00668 OPEN OUTPUT SUMMARY-FILE. DTSBX522 +00669 IF NOT SUMMARY-STATUS-OK-88 DTSBX522 +00670 DISPLAY 'BX343 SUMMARY FILE OPEN ERROR: ' DTSBX522 +00671 SUMMARY-STATUS DTSBX522 +00672 MOVE 'FILE OPEN ERROR' DTSBX522 +00673 TO ABEND-MSG DTSBX522 +00674 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +00675 END-IF. DTSBX522 +00676 DTSBX522 +00677 OPEN OUTPUT PAY-DIST-FILE. DTSBX522 +00678 IF NOT PAYDIST-STATUS-OK-88 DTSBX522 +00679 DISPLAY 'BX343 PAY DIST FILE OPEN ERROR: ' DTSBX522 +00680 PAYDIST-STATUS DTSBX522 +00681 MOVE 'FILE OPEN ERROR' DTSBX522 +00682 TO ABEND-MSG DTSBX522 +00683 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +00684 END-IF. DTSBX522 +00685 DTSBX522 +00686 I2000-EXIT. DTSBX522 +00687 EXIT. DTSBX522 +00688 DTSBX522 +00689 P0000-PROCESS. DTSBX522 +00690 PERFORM P0100-INIT-TABLE THRU P0100-EXIT. DTSBX522 +00691 DTSBX522 +00692 ** PERFORM P1000-QUARTER THRU P1000-EXIT CL*54 +00693 PERFORM P2000-ACCTS-RECEIVABLE THRU P2000-EXIT. CL*55 +00694 ** PERFORM P3000-TRANSACTION-DETAIL THRU P3000-EXIT. CL*65 +00695 ** PERFORM P4000-CORRECTIONS THRU P4000-EXIT. CL*54 +00696 ** IF MPRF-TOT-CREDIT-AMT > ZERO DTSBX522 +00697 ** PERFORM P5000-PAY-DISTRIBUTION THRU P5000-EXIT. CL*54 +00698 ** END-IF. DTSBX522 +00699 DTSBX522 +00700 P0000-EXIT. DTSBX522 +00701 EXIT. DTSBX522 +00702 DTSBX522 +00703 P0100-INIT-TABLE. DTSBX522 +00704 PERFORM DTSBX522 +00705 VARYING QSUB FROM +1 BY +1 DTSBX522 +00706 UNTIL QSUB > QMAX DTSBX522 +00707 SET TBL-JRN-GOOD-88 (QSUB) TO TRUE DTSBX522 +00708 MOVE +0 TO TBL-YRQ (QSUB) DTSBX522 +00709 Q-UI-CHG (QSUB) DTSBX522 +00710 Q-UI-PD (QSUB) DTSBX522 +00711 Q-UI-WV (QSUB) DTSBX522 +00712 Q-UI-WO (QSUB) DTSBX522 +00713 Q-UI-TL (QSUB) DTSBX522 +00714 Q-UI-BAL (QSUB) DTSBX522 +00715 J-UI-CHG (QSUB) DTSBX522 +00716 J-UI-PD (QSUB) DTSBX522 +00717 J-UI-WV (QSUB) DTSBX522 +00718 J-UI-WO (QSUB) DTSBX522 +00719 J-UI-TL (QSUB) DTSBX522 +00720 Q-INT-CHG (QSUB) DTSBX522 +00721 Q-INT-PD (QSUB) DTSBX522 +00722 Q-INT-WV (QSUB) DTSBX522 +00723 Q-INT-WO (QSUB) DTSBX522 +00724 Q-INT-TL (QSUB) DTSBX522 +00725 Q-INT-BAL (QSUB) DTSBX522 +00726 J-INT-CHG (QSUB) DTSBX522 +00727 J-INT-PD (QSUB) DTSBX522 +00728 J-INT-WV (QSUB) DTSBX522 +00729 J-INT-WO (QSUB) DTSBX522 +00730 J-INT-TL (QSUB) DTSBX522 +00731 Q-LP-CHG (QSUB) DTSBX522 +00732 Q-LP-PD (QSUB) DTSBX522 +00733 Q-LP-WV (QSUB) DTSBX522 +00734 Q-LP-WO (QSUB) DTSBX522 +00735 Q-LP-TL (QSUB) DTSBX522 +00736 Q-LP-BAL (QSUB) DTSBX522 +00737 J-LP-CHG (QSUB) DTSBX522 +00738 J-LP-PD (QSUB) DTSBX522 +00739 J-LP-WV (QSUB) DTSBX522 +00740 J-LP-WO (QSUB) DTSBX522 +00741 J-LP-TL (QSUB) DTSBX522 +00742 Q-NP-CHG (QSUB) DTSBX522 +00743 Q-NP-PD (QSUB) DTSBX522 +00744 Q-NP-WV (QSUB) DTSBX522 +00745 Q-NP-WO (QSUB) DTSBX522 +00746 Q-NP-TL (QSUB) DTSBX522 +00747 Q-NP-BAL (QSUB) DTSBX522 +00748 J-NP-CHG (QSUB) DTSBX522 +00749 J-NP-PD (QSUB) DTSBX522 +00750 J-NP-WV (QSUB) DTSBX522 +00751 J-NP-WO (QSUB) DTSBX522 +00752 J-NP-TL (QSUB) DTSBX522 +00753 Q-MP-CHG (QSUB) DTSBX522 +00754 Q-MP-PD (QSUB) DTSBX522 +00755 Q-MP-WV (QSUB) DTSBX522 +00756 Q-MP-WO (QSUB) DTSBX522 +00757 Q-MP-TL (QSUB) DTSBX522 +00758 Q-MP-BAL (QSUB) DTSBX522 +00759 J-MP-CHG (QSUB) DTSBX522 +00760 J-MP-PD (QSUB) DTSBX522 +00761 J-MP-WV (QSUB) DTSBX522 +00762 J-MP-WO (QSUB) DTSBX522 +00763 J-MP-TL (QSUB) DTSBX522 +00764 Q-SU-CHG (QSUB) DTSBX522 +00765 Q-SU-PD (QSUB) DTSBX522 +00766 Q-SU-WV (QSUB) DTSBX522 +00767 Q-SU-WO (QSUB) DTSBX522 +00768 Q-SU-TL (QSUB) DTSBX522 +00769 Q-SU-BAL (QSUB) DTSBX522 +00770 J-SU-CHG (QSUB) DTSBX522 +00771 J-SU-PD (QSUB) DTSBX522 +00772 J-SU-WV (QSUB) DTSBX522 +00773 J-SU-WO (QSUB) DTSBX522 +00774 J-SU-TL (QSUB) DTSBX522 +00775 END-PERFORM. DTSBX522 +00776 DTSBX522 +00777 P0100-EXIT. DTSBX522 +00778 EXIT. DTSBX522 +00779 DTSBX522 +00780 P1000-QUARTER. DTSBX522 +00781 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBX522 +00782 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBX522 +00783 SET MQTR-QTR-88 TO TRUE. DTSBX522 +00784 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 +00785 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 +00786 PERFORM UNTIL L910-NO-REC-88 DTSBX522 +00787 MOVE MSKL-REC TO MQTR-REC DTSBX522 +00788 PERFORM P1100-SAVE-QTR THRU P1100-EXIT DTSBX522 +00789 PERFORM P1200-BUILD-QTR THRU P1200-EXIT DTSBX522 +00790 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +00791 END-PERFORM. DTSBX522 +00792 DTSBX522 +00793 P1000-EXIT. DTSBX522 +00794 EXIT. DTSBX522 +00795 DTSBX522 +00796 P1100-SAVE-QTR. DTSBX522 +00797 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX522 +00798 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 +00799 MOVE L004-ABS-QTR TO QSUB. DTSBX522 +00800 DTSBX522 +00801 MOVE MQTR-YRQ TO TBL-YRQ (QSUB). DTSBX522 +00802 DTSBX522 +00803 SET W-UI-CHARGE-NO-88 TO TRUE. DTSBX522 +00804 SET W-LP-CHARGE-NO-88 TO TRUE. DTSBX522 +00805 DTSBX522 +00806 PERFORM DTSBX522 +00807 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBX522 +00808 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBX522 +00809 PERFORM P1105-GET-AMTS THRU P1105-EXIT DTSBX522 +00810 EVALUATE TRUE DTSBX522 +00811 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBX522 +00812 PERFORM P1110-TABLE-UI THRU P1110-EXIT DTSBX522 +00813 DTSBX522 +00814 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBX522 +00815 PERFORM P1111-TABLE-INT THRU P1111-EXIT DTSBX522 +00816 DTSBX522 +00817 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBX522 +00818 PERFORM P1112-TABLE-LP THRU P1112-EXIT DTSBX522 +00819 DTSBX522 +00820 WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBX522 +00821 PERFORM P1113-TABLE-MP THRU P1113-EXIT DTSBX522 +00822 DTSBX522 +00823 WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBX522 +00824 PERFORM P1114-TABLE-NP THRU P1114-EXIT DTSBX522 +00825 DTSBX522 +00826 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBX522 +00827 PERFORM P1115-TABLE-SU THRU P1115-EXIT DTSBX522 +00828 DTSBX522 +00829 END-EVALUATE DTSBX522 +00830 END-PERFORM. DTSBX522 +00831 DTSBX522 +00832 IF MQTR-YRQ < 20001 DTSBX522 +00833 IF W-UI-CHARGE-NO-88 DTSBX522 +00834 AND W-LP-CHARGE-NO-88 DTSBX522 +00835 SET TBL-JRN-BAD-88 (QSUB) TO TRUE DTSBX522 +00836 END-IF DTSBX522 +00837 END-IF. DTSBX522 +00838 DTSBX522 +00839 * IF MQTR-EMP-NO = 030450 DTSBX522 +00840 * IF MQTR-YRQ > 20041 DTSBX522 +00841 * IF W-UI-BAL NOT = ZERO DTSBX522 +00842 * OR W-LP-BAL NOT = ZERO DTSBX522 +00843 * OR W-NP-BAL NOT = ZERO DTSBX522 +00844 * OR W-INT-BAL NOT = ZERO DTSBX522 +00845 * DISPLAY 'P1100 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBX522 +00846 DTSBX522 +00847 DTSBX522 +00848 P1100-EXIT. DTSBX522 +00849 EXIT. DTSBX522 +00850 DTSBX522 +00851 P1105-GET-AMTS. DTSBX522 +00852 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) TO W-CHG. DTSBX522 +00853 MOVE MQTR-PAID-AMT (MQTR-ACCT-IDX) TO W-PD. DTSBX522 +00854 MOVE MQTR-WAIVED-AMT (MQTR-ACCT-IDX) TO W-WV. DTSBX522 +00855 MOVE MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) TO W-WO. DTSBX522 +00856 MOVE MQTR-TOLER-AMT (MQTR-ACCT-IDX) TO W-TL. DTSBX522 +00857 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO W-BAL. DTSBX522 +00858 DTSBX522 +00859 P1105-EXIT. DTSBX522 +00860 EXIT. DTSBX522 +00861 DTSBX522 +00862 P1110-TABLE-UI. DTSBX522 +00863 IF W-CHG > ZERO DTSBX522 +00864 SET W-UI-CHARGE-YES-88 TO TRUE DTSBX522 +00865 END-IF. DTSBX522 +00866 DTSBX522 +00867 ADD W-CHG TO Q-UI-CHG (QSUB). DTSBX522 +00868 ADD W-PD TO Q-UI-PD (QSUB). DTSBX522 +00869 ADD W-WV TO Q-UI-WV (QSUB). DTSBX522 +00870 ADD W-WO TO Q-UI-WO (QSUB). DTSBX522 +00871 ADD W-TL TO Q-UI-TL (QSUB). DTSBX522 +00872 ADD W-BAL TO Q-UI-BAL (QSUB). DTSBX522 +00873 DTSBX522 +00874 ** IF MPRF-EMP-NO = 062362 OR 073765 DTSBX522 +00875 * MOVE Q-UI-BAL (QSUB) TO DISPLAY-AMT1 DTSBX522 +00876 * DISPLAY 'P1110 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBX522 +00877 * ' UI ' DISPLAY-AMT1 DTSBX522 +00878 ** END-IF. DTSBX522 +00879 DTSBX522 +00880 P1110-EXIT. DTSBX522 +00881 EXIT. DTSBX522 +00882 DTSBX522 +00883 P1111-TABLE-INT. DTSBX522 +00884 ADD W-CHG TO Q-INT-CHG (QSUB). DTSBX522 +00885 ADD W-PD TO Q-INT-PD (QSUB). DTSBX522 +00886 ADD W-WV TO Q-INT-WV (QSUB). DTSBX522 +00887 ADD W-WO TO Q-INT-WO (QSUB). DTSBX522 +00888 ADD W-TL TO Q-INT-TL (QSUB). DTSBX522 +00889 ADD W-BAL TO Q-INT-BAL (QSUB). DTSBX522 +00890 DTSBX522 +00891 P1111-EXIT. DTSBX522 +00892 EXIT. DTSBX522 +00893 DTSBX522 +00894 P1112-TABLE-LP. DTSBX522 +00895 IF W-CHG > ZERO DTSBX522 +00896 SET W-LP-CHARGE-YES-88 TO TRUE DTSBX522 +00897 END-IF. DTSBX522 +00898 DTSBX522 +00899 ADD W-CHG TO Q-LP-CHG (QSUB). DTSBX522 +00900 ADD W-PD TO Q-LP-PD (QSUB). DTSBX522 +00901 ADD W-WV TO Q-LP-WV (QSUB). DTSBX522 +00902 ADD W-WO TO Q-LP-WO (QSUB). DTSBX522 +00903 ADD W-TL TO Q-LP-TL (QSUB). DTSBX522 +00904 ADD W-BAL TO Q-LP-BAL (QSUB). DTSBX522 +00905 DTSBX522 +00906 ** IF MPRF-EMP-NO = 137540 DTSBX522 +00907 * MOVE Q-LP-BAL (QSUB) TO DISPLAY-AMT2 DTSBX522 +00908 * DISPLAY 'P1112 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBX522 +00909 * ' PEN ' DISPLAY-AMT2 DTSBX522 +00910 ** END-IF. DTSBX522 +00911 DTSBX522 +00912 P1112-EXIT. DTSBX522 +00913 EXIT. DTSBX522 +00914 DTSBX522 +00915 P1113-TABLE-MP. DTSBX522 +00916 ADD W-CHG TO Q-MP-CHG (QSUB). DTSBX522 +00917 ADD W-PD TO Q-MP-PD (QSUB). DTSBX522 +00918 ADD W-WV TO Q-MP-WV (QSUB). DTSBX522 +00919 ADD W-WO TO Q-MP-WO (QSUB). DTSBX522 +00920 ADD W-TL TO Q-MP-TL (QSUB). DTSBX522 +00921 ADD W-BAL TO Q-MP-BAL (QSUB). DTSBX522 +00922 DTSBX522 +00923 P1113-EXIT. DTSBX522 +00924 EXIT. DTSBX522 +00925 DTSBX522 +00926 P1114-TABLE-NP. DTSBX522 +00927 ADD W-CHG TO Q-NP-CHG (QSUB). DTSBX522 +00928 ADD W-PD TO Q-NP-PD (QSUB). DTSBX522 +00929 ADD W-WV TO Q-NP-WV (QSUB). DTSBX522 +00930 ADD W-WO TO Q-NP-WO (QSUB). DTSBX522 +00931 ADD W-TL TO Q-NP-TL (QSUB). DTSBX522 +00932 ADD W-BAL TO Q-NP-BAL (QSUB). DTSBX522 +00933 DTSBX522 +00934 P1114-EXIT. DTSBX522 +00935 EXIT. DTSBX522 +00936 DTSBX522 +00937 P1115-TABLE-SU. DTSBX522 +00938 ADD W-CHG TO Q-SU-CHG (QSUB). DTSBX522 +00939 ADD W-PD TO Q-SU-PD (QSUB). DTSBX522 +00940 ADD W-WV TO Q-SU-WV (QSUB). DTSBX522 +00941 ADD W-WO TO Q-SU-WO (QSUB). DTSBX522 +00942 ADD W-TL TO Q-SU-TL (QSUB). DTSBX522 +00943 ADD W-BAL TO Q-SU-BAL (QSUB). DTSBX522 +00944 DTSBX522 +00945 P1115-EXIT. DTSBX522 +00946 EXIT. DTSBX522 +00947 DTSBX522 +00948 DTSBX522 +00949 P1200-BUILD-QTR. DTSBX522 +00950 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX522 +00951 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 +00952 MOVE L004-ABS-QTR TO LX34-SUB. DTSBX522 +00953 IF LX34-QTR-EXISTS-YES-88 (LX34-SUB) DTSBX522 +00954 GO TO P1200-EXIT DTSBX522 +00955 ELSE DTSBX522 +00956 SET LX34-QTR-EXISTS-YES-88 (LX34-SUB) TO TRUE DTSBX522 +00957 END-IF. DTSBX522 +00958 DTSBX522 +00959 MOVE ZERO TO W-QTR-BAL. DTSBX522 +00960 IF MPRF-TOT-BALANCE-AMT > ZERO DTSBX522 +00961 AND MQTR-TAX-DUE-DATE < LX34-CURR-RUN-DATE DTSBX522 +00962 PERFORM P1210-BAL-DUE THRU P1210-EXIT DTSBX522 +00963 END-IF. DTSBX522 +00964 DTSBX522 +00965 MOVE MQTR-EMP-NO TO QTR-EMP-NO. DTSBX522 +00966 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX522 +00967 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 +00968 IF L004-VALID-QTR DTSBX522 +00969 MOVE L004-SLASH-5-QTR TO QTR-QUARTER DTSBX522 +00970 ELSE DTSBX522 +00971 GO TO P1200-EXIT DTSBX522 +00972 END-IF. DTSBX522 +00973 MOVE MQTR-CURR-RPT-TYPE TO QTR-RPT-STATUS. DTSBX522 +00974 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBX522 +00975 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +00976 MOVE L001-SLASH-8-DATE TO QTR-RPT-DUE-DT. DTSBX522 +00977 MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBX522 +00978 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +00979 MOVE L001-SLASH-8-DATE TO QTR-TAX-DUE-DT. DTSBX522 +00980 MOVE W-QTR-BAL TO QTR-BAL-DUE. DTSBX522 +00981 DTSBX522 +00982 MOVE MQTR-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 +00983 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +00984 IF L001-VALID-DATE DTSBX522 +00985 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX522 +00986 ELSE DTSBX522 +00987 MOVE W-DEFAULT-DATE TO QTR-PROCESS-DT DTSBX522 +00988 END-IF. DTSBX522 +00989 DTSBX522 +00990 IF QTR-PROCESS-DT = W-DEFAULT-DATE DTSBX522 +00991 MOVE MQTR-CHNG-DATE TO L001-FED-8-DATE-9 DTSBX522 +00992 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX522 +00993 IF L001-VALID-DATE DTSBX522 +00994 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX522 +00995 END-IF DTSBX522 +00996 END-IF. DTSBX522 +00997 DTSBX522 +00998 WRITE QTR-REC FROM W-QTR-REC DTSBX522 +00999 IF NOT QTR-STATUS-OK-88 DTSBX522 +01000 DISPLAY 'CANNOT WRITE TO QTR FILE ' DTSBX522 +01001 ' ' QTR-STATUS ' ' QTR-EMP-NO DTSBX522 +01002 ELSE DTSBX522 +01003 ADD +1 TO W-QTR-CNT DTSBX522 +01004 END-IF. DTSBX522 +01005 DTSBX522 +01006 P1200-EXIT. DTSBX522 +01007 EXIT. DTSBX522 +01008 DTSBX522 +01009 P1210-BAL-DUE. DTSBX522 +01010 PERFORM DTSBX522 +01011 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBX522 +01012 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBX522 +01013 IF MPRF-CLASS-SELF-INS-88 DTSBX522 +01014 AND MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBX522 +01015 CONTINUE DTSBX522 +01016 ELSE DTSBX522 +01017 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBX522 +01018 TO W-QTR-BAL DTSBX522 +01019 END-IF DTSBX522 +01020 END-PERFORM. DTSBX522 +01021 DTSBX522 +01022 P1210-EXIT. DTSBX522 +01023 EXIT. DTSBX522 +01024 DTSBX522 +01025 DTSBX522 +01026 P2000-ACCTS-RECEIVABLE. DTSBX522 +01027 MOVE ZERO TO W-TOT-CREDIT. DTSBX522 +01028 DTSBX522 +01029 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX522 +01030 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBX522 +01031 SET MJRN-JRN-88 TO TRUE. DTSBX522 +01032 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 +01033 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 +01034 PERFORM UNTIL L910-NO-REC-88 DTSBX522 +01035 MOVE MSKL-REC TO MJRN-REC DTSBX522 +01036 ADD +1 TO W-MJRN-READ-CNT DTSBX522 +01037 IF NOT MJRN-TRAN-CNVR-88 DTSBX522 +01038 PERFORM P2100-BUILD-ACCT THRU P2100-EXIT DTSBX522 +01039 END-IF DTSBX522 +01040 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +01041 END-PERFORM. DTSBX522 +01042 DTSBX522 +01043 ** MOVE MPRF-TOT-CREDIT-AMT TO DISPLAY-AMT1. DTSBX522 +01044 ** MOVE W-TOT-CREDIT TO DISPLAY-AMT2. DTSBX522 +01045 IF W-TOT-CREDIT NOT = MPRF-TOT-CREDIT-AMT DTSBX522 +01046 * PERFORM P2010-CORRECT-CR THRU P2010-EXIT CL*68 +01047 ** DISPLAY 'CREDIT ' MPRF-EMP-NO DTSBX522 +01048 ** ' MPRF ' DISPLAY-AMT1 DTSBX522 +01049 ** ' ' DISPLAY-AMT2 DTSBX522 +01050 END-IF. DTSBX522 +01051 P2000-EXIT. DTSBX522 +01052 EXIT. DTSBX522 +01053 DTSBX522 +01054 P2010-CORRECT-CR. DTSBX522 +01055 PERFORM S1000-CORRECTION-BATCH THRU S1000-EXIT. DTSBX522 +01056 MOVE W-JC-BATCH TO ACCT-BATCH DTSBX522 +01057 MOVE W-JC-ITEM TO ACCT-ITEM. DTSBX522 +01058 DTSBX522 +01059 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBX522 +01060 MOVE SPACES TO ACCT-YRQ. DTSBX522 +01061 MOVE 'CR' TO ACCT-ROW. DTSBX522 +01062 MOVE 'PD' TO ACCT-COL. DTSBX522 +01063 COMPUTE W-CREDIT-CORRECT = DTSBX522 +01064 (MPRF-TOT-CREDIT-AMT - W-TOT-CREDIT). DTSBX522 +01065 MOVE W-CREDIT-CORRECT TO ACCT-AMT. DTSBX522 +01066 MOVE 'JC' TO ACCT-TRAN DTSBX522 +01067 MOVE 'B' TO ACCT-CAT. DTSBX522 +01068 MOVE W-DEFAULT-DATE TO ACCT-RCVD-DT DTSBX522 +01069 ACCT-PROCESS-DT. DTSBX522 +01070 DTSBX522 +01071 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBX522 +01072 DTSBX522 +01073 ** WRITE ACCT-REC FROM W-ACCT-REC DTSBX522 +01074 * IF NOT ACCT-STATUS-OK-88 DTSBX522 +01075 * DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBX522 +01076 * ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBX522 +01077 * ELSE DTSBX522 +01078 * ADD +1 TO W-ACCT-CNT DTSBX522 +01079 * ADD +1 TO W-CR-CNT DTSBX522 +01080 ** END-IF. DTSBX522 +01081 DTSBX522 +01082 P2010-EXIT. DTSBX522 +01083 EXIT. DTSBX522 +01084 DTSBX522 +01085 P2100-BUILD-ACCT. DTSBX522 +01086 PERFORM DTSBX522 +01087 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBX522 +01088 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBX522 +01089 IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) DTSBX522 +01090 ADD MJRN-AMT (MJRN-OCC-IDX) TO W-TOT-CREDIT DTSBX522 +01091 PERFORM P2110-WRITE-ACCT THRU P2110-EXIT DTSBX522 +01092 ELSE DTSBX522 +01093 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBX522 +01094 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 +01095 MOVE L004-SLASH-5-QTR TO ACCT-YRQ DTSBX522 +01096 MOVE L004-ABS-QTR TO QSUB DTSBX522 +01097 IF TBL-JRN-GOOD-88 (QSUB) DTSBX522 +01098 PERFORM P2110-WRITE-ACCT THRU P2110-EXIT DTSBX522 +01099 * PERFORM P2120-SAVE-JRN THRU P2120-EXIT CL*68 +01100 END-IF DTSBX522 +01101 END-IF DTSBX522 +01102 END-PERFORM. DTSBX522 +01103 DTSBX522 +01104 P2100-EXIT. DTSBX522 +01105 EXIT. DTSBX522 +01106 DTSBX522 +01107 P2110-WRITE-ACCT. DTSBX522 +01108 IF MJRN-YRQ (MJRN-OCC-IDX) = 99999 DTSBX522 +01109 MOVE SPACES TO ACCT-YRQ DTSBX522 +01110 ELSE DTSBX522 +01111 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBX522 +01112 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 +01113 MOVE L004-SLASH-5-QTR TO ACCT-YRQ DTSBX522 +01114 END-IF. DTSBX522 +01115 DTSBX522 +01116 MOVE MJRN-BATCH-NO TO ACCT-BATCH. DTSBX522 +01117 MOVE MJRN-ITEM-NO TO ACCT-ITEM. DTSBX522 +01118 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBX522 +01119 MOVE MJRN-TRAN-TYPE TO ACCT-TRAN. DTSBX522 +01120 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) TO ACCT-ROW. DTSBX522 +01121 MOVE MJRN-ACCT-COL (MJRN-OCC-IDX) TO ACCT-COL. DTSBX522 +01122 IF ACCT-ROW = 'CR' DTSBX522 +01123 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBX522 +01124 MOVE ZEROS TO ACCT-PAYMENT-ID CL*37 +01125 ELSE DTSBX522 +01126 IF ACCT-COL NOT = 'CH' DTSBX522 +01127 COMPUTE ACCT-AMT = DTSBX522 +01128 (MJRN-AMT (MJRN-OCC-IDX) * -1) DTSBX522 +01129 ELSE DTSBX522 +01130 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBX522 +01131 MOVE ZEROS TO ACCT-PAYMENT-ID CL*37 +01132 END-IF DTSBX522 +01133 END-IF. DTSBX522 +01134 DTSBX522 +01135 MOVE MJRN-TRAN-CATEGORY TO ACCT-CAT. DTSBX522 +01136 MOVE MJRN-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 +01137 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01138 IF L001-VALID-DATE DTSBX522 +01139 MOVE L001-SLASH-8-DATE TO ACCT-PROCESS-DT DTSBX522 +01140 ELSE DTSBX522 +01141 MOVE LX34-SYS-DATE TO ACCT-PROCESS-DT DTSBX522 +01142 END-IF. DTSBX522 +01143 MOVE MJRN-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 +01144 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01145 IF L001-VALID-DATE DTSBX522 +01146 MOVE L001-SLASH-8-DATE TO ACCT-RCVD-DT DTSBX522 +01147 ELSE DTSBX522 +01148 MOVE LX34-SYS-DATE TO ACCT-RCVD-DT DTSBX522 +01149 END-IF. DTSBX522 +01150 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBX522 +01151 CL*25 +01152 ** WRITE ACCT-REC FROM W-ACCT-REC DTSBX522 +01153 * IF NOT ACCT-STATUS-OK-88 DTSBX522 +01154 * DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBX522 +01155 * ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBX522 +01156 * ELSE DTSBX522 +01157 * ADD +1 TO W-ACCT-CNT DTSBX522 +01158 ** END-IF. DTSBX522 +01159 DTSBX522 +01160 *** SELECT ONLY JOURNAL ENTRIES FROM MOST RECENT DATE. *** DTSBX522 +01161 IF MJRN-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 +01162 DISPLAY 'MJRN-KEY ' MSKL-KEY-AREA CL*56 +01163 MOVE MSKL-KEY-AREA TO WK-JRN-HOLD-KEY-AREA CL*57 +01164 * PERFORM P2101-PAYMENT-ID THRU P2101-EXIT CL*68 +01165 MOVE WK-JRN-HOLD-KEY-AREA TO MSKL-KEY-AREA CL*57 +01166 DISPLAY 'MPAY-TRACE-ID ' MPAY-TRACE-NO CL*32 +01167 DISPLAY 'MJRN-EMP-NO ' MJRN-EMP-NO CL*32 +01168 WRITE ACCT-INCR-REC FROM W-ACCT-REC DTSBX522 +01169 IF NOT ACCT-I-STATUS-OK-88 DTSBX522 +01170 DISPLAY 'CANNOT WRITE TO ACCT FILE INCR ' DTSBX522 +01171 ' ' ACCT-I-STATUS ' ' ACCT-EMP-NO DTSBX522 +01172 ELSE DTSBX522 +01173 ADD +1 TO W-ACCT-CNT-INCR DTSBX522 +01174 END-IF DTSBX522 +01175 END-IF. DTSBX522 +01176 DTSBX522 +01177 ** IF MPRF-EMP-NO = 156293 DTSBX522 +01178 * DISPLAY 'P2110 ' MPRF-EMP-NO ' ' ACCT-YRQ DTSBX522 +01179 * ' ' ACCT-BATCH '/' ACCT-ITEM DTSBX522 +01180 * DISPLAY ' ' ACCT-ROW ' ' ACCT-COL DTSBX522 +01181 * ' ' ACCT-TRAN ' ' ACCT-AMT DTSBX522 +01182 ** END-IF. DTSBX522 +01183 DTSBX522 +01184 P2110-EXIT. DTSBX522 +01185 EXIT. DTSBX522 +01186 CL*40 +01187 P2101-PAYMENT-ID. CL*40 +01188 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*59 +01189 MOVE MJRN-BATCH-NO TO MPAY-BATCH-NO, CL*40 +01190 MOVE MJRN-ITEM-NO TO MPAY-ITEM-NO. CL*40 +01191 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. CL*40 +01192 CL*40 +01193 SET MPAY-PAY-88 TO TRUE. CL*40 +01194 CL*40 +01195 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. CL*40 +01196 CL*40 +01197 PERFORM S910-READ THRU S910-EXIT. CL*50 +01198 CL*52 +01199 IF L910-OK-88 CL*52 +01200 MOVE MSKL-REC TO MPAY-REC CL*59 +01201 MOVE MPAY-TRACE-NO TO ACCT-PAYMENT-ID CL*59 +01202 ELSE CL*52 +01203 DISPLAY 'MPAY TRACE NO NOT FOUND ' CL*53 +01204 DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO CL*59 +01205 DISPLAY 'MPAY-ITEM-NO ' MPAY-ITEM-NO CL*59 +01206 DISPLAY 'MPAY-EMP-NO ' MPAY-EMP-NO CL*59 +01207 MOVE ZEROS TO ACCT-PAYMENT-ID CL*52 +01208 END-IF. CL*52 +01209 CL*52 +01210 P2101-EXIT. CL*40 +01211 EXIT. CL*40 +01212 CL*40 +01213 P2120-SAVE-JRN. DTSBX522 +01214 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9. DTSBX522 +01215 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 +01216 IF L004-INVALID-QTR DTSBX522 +01217 GO TO P2120-EXIT DTSBX522 +01218 ELSE DTSBX522 +01219 MOVE L004-ABS-QTR TO QSUB DTSBX522 +01220 IF TBL-YRQ (QSUB) = ZERO DTSBX522 +01221 MOVE L004-QTR-5-9 TO TBL-YRQ (QSUB) DTSBX522 +01222 END-IF DTSBX522 +01223 END-IF. DTSBX522 +01224 DTSBX522 +01225 EVALUATE TRUE DTSBX522 +01226 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'UI' DTSBX522 +01227 PERFORM P2121-TABLE-UI THRU P2121-EXIT DTSBX522 +01228 DTSBX522 +01229 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'LP' DTSBX522 +01230 PERFORM P2122-TABLE-LP THRU P2122-EXIT DTSBX522 +01231 DTSBX522 +01232 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'NP' DTSBX522 +01233 PERFORM P2123-TABLE-NP THRU P2123-EXIT DTSBX522 +01234 DTSBX522 +01235 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'MP' DTSBX522 +01236 PERFORM P2124-TABLE-MP THRU P2124-EXIT DTSBX522 +01237 DTSBX522 +01238 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'I ' DTSBX522 +01239 PERFORM P2125-TABLE-INT THRU P2125-EXIT DTSBX522 +01240 DTSBX522 +01241 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'SU' DTSBX522 +01242 PERFORM P2126-TABLE-SU THRU P2126-EXIT DTSBX522 +01243 DTSBX522 +01244 END-EVALUATE. DTSBX522 +01245 DTSBX522 +01246 ** IF MJRN-EMP-NO = 062362 OR 073765 DTSBX522 +01247 * MOVE J-UI-CHG (QSUB) TO DISPLAY-AMT1 DTSBX522 +01248 * MOVE Q-UI-CHG (QSUB) TO DISPLAY-AMT2 DTSBX522 +01249 * MOVE J-UI-PD (QSUB) TO DISPLAY-AMT3 DTSBX522 +01250 * MOVE Q-UI-PD (QSUB) TO DISPLAY-AMT4 DTSBX522 +01251 * DISPLAY 'P2121 ' MPRF-EMP-NO ' ' L004-QTR-5-9 DTSBX522 +01252 * ' ' MJRN-ACCT-COL (MJRN-OCC-IDX) DTSBX522 +01253 * ' Q CHG ' DISPLAY-AMT2 DTSBX522 +01254 * ' J CHG ' DISPLAY-AMT1 DTSBX522 +01255 * ' Q PD ' DISPLAY-AMT4 DTSBX522 +01256 * ' J PD ' DISPLAY-AMT3 DTSBX522 +01257 ** END-IF. DTSBX522 +01258 P2120-EXIT. DTSBX522 +01259 EXIT. DTSBX522 +01260 DTSBX522 +01261 P2121-TABLE-UI. DTSBX522 +01262 EVALUATE TRUE DTSBX522 +01263 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 +01264 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-CHG (QSUB) DTSBX522 +01265 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 +01266 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-PD (QSUB) DTSBX522 +01267 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 +01268 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-WV (QSUB) DTSBX522 +01269 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 +01270 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 +01271 TO J-UI-WO (QSUB) DTSBX522 +01272 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 +01273 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-TL (QSUB) DTSBX522 +01274 END-EVALUATE. DTSBX522 +01275 DTSBX522 +01276 ** IF MPRF-EMP-NO = 137540 DTSBX522 +01277 * MOVE J-UI-CHG (QSUB) TO DISPLAY-AMT1 DTSBX522 +01278 * MOVE J-UI-PD (QSUB) TO DISPLAY-AMT2 DTSBX522 +01279 * DISPLAY 'P2121 ' MPRF-EMP-NO DTSBX522 +01280 * ' ' MJRN-YRQ (MJRN-OCC-IDX) DTSBX522 +01281 * ' UI CH ' DISPLAY-AMT1 DTSBX522 +01282 * ' UI PD ' DISPLAY-AMT2 DTSBX522 +01283 ** END-IF. DTSBX522 +01284 P2121-EXIT. DTSBX522 +01285 EXIT. DTSBX522 +01286 DTSBX522 +01287 P2122-TABLE-LP. DTSBX522 +01288 EVALUATE TRUE DTSBX522 +01289 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 +01290 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-CHG (QSUB) DTSBX522 +01291 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 +01292 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-PD (QSUB) DTSBX522 +01293 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 +01294 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-WV (QSUB) DTSBX522 +01295 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 +01296 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 +01297 TO J-LP-WO (QSUB) DTSBX522 +01298 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 +01299 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-TL (QSUB) DTSBX522 +01300 END-EVALUATE. DTSBX522 +01301 DTSBX522 +01302 ** IF MPRF-EMP-NO = 137540 DTSBX522 +01303 * MOVE J-LP-CHG (QSUB) TO DISPLAY-AMT1 DTSBX522 +01304 * MOVE J-LP-PD (QSUB) TO DISPLAY-AMT2 DTSBX522 +01305 * DISPLAY 'P2122 ' MPRF-EMP-NO DTSBX522 +01306 * ' ' MJRN-YRQ (MJRN-OCC-IDX) DTSBX522 +01307 * ' LP CH ' DISPLAY-AMT1 DTSBX522 +01308 * ' LP PD ' DISPLAY-AMT2 DTSBX522 +01309 ** END-IF. DTSBX522 +01310 P2122-EXIT. DTSBX522 +01311 EXIT. DTSBX522 +01312 DTSBX522 +01313 P2123-TABLE-NP. DTSBX522 +01314 EVALUATE TRUE DTSBX522 +01315 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 +01316 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-CHG (QSUB) DTSBX522 +01317 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 +01318 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-PD (QSUB) DTSBX522 +01319 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 +01320 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-WV (QSUB) DTSBX522 +01321 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 +01322 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 +01323 TO J-NP-WO (QSUB) DTSBX522 +01324 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 +01325 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-TL (QSUB) DTSBX522 +01326 END-EVALUATE. DTSBX522 +01327 DTSBX522 +01328 P2123-EXIT. DTSBX522 +01329 EXIT. DTSBX522 +01330 DTSBX522 +01331 P2124-TABLE-MP. DTSBX522 +01332 EVALUATE TRUE DTSBX522 +01333 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 +01334 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-CHG (QSUB) DTSBX522 +01335 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 +01336 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-PD (QSUB) DTSBX522 +01337 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 +01338 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-WV (QSUB) DTSBX522 +01339 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 +01340 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 +01341 TO J-MP-WO (QSUB) DTSBX522 +01342 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 +01343 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-TL (QSUB) DTSBX522 +01344 END-EVALUATE. DTSBX522 +01345 DTSBX522 +01346 P2124-EXIT. DTSBX522 +01347 EXIT. DTSBX522 +01348 DTSBX522 +01349 P2125-TABLE-INT. DTSBX522 +01350 EVALUATE TRUE DTSBX522 +01351 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 +01352 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-CHG (QSUB) DTSBX522 +01353 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 +01354 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-PD (QSUB) DTSBX522 +01355 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 +01356 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-WV (QSUB) DTSBX522 +01357 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 +01358 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 +01359 TO J-INT-WO (QSUB) DTSBX522 +01360 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 +01361 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-TL (QSUB) DTSBX522 +01362 END-EVALUATE. DTSBX522 +01363 DTSBX522 +01364 P2125-EXIT. DTSBX522 +01365 EXIT. DTSBX522 +01366 DTSBX522 +01367 P2126-TABLE-SU. DTSBX522 +01368 EVALUATE TRUE DTSBX522 +01369 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 +01370 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-CHG (QSUB) DTSBX522 +01371 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 +01372 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-PD (QSUB) DTSBX522 +01373 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 +01374 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-WV (QSUB) DTSBX522 +01375 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 +01376 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 +01377 TO J-SU-WO (QSUB) DTSBX522 +01378 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 +01379 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-TL (QSUB) DTSBX522 +01380 END-EVALUATE. DTSBX522 +01381 DTSBX522 +01382 P2126-EXIT. DTSBX522 +01383 EXIT. DTSBX522 +01384 DTSBX522 +01385 DTSBX522 +01386 P3000-TRANSACTION-DETAIL. DTSBX522 +01387 PERFORM P3100-REPORTS THRU P3100-EXIT. DTSBX522 +01388 PERFORM P3200-PAYMENT THRU P3200-EXIT. DTSBX522 +01389 PERFORM P3300-ADJUSTMENT THRU P3300-EXIT. DTSBX522 +01390 DTSBX522 +01391 P3000-EXIT. DTSBX522 +01392 EXIT. DTSBX522 +01393 DTSBX522 +01394 DTSBX522 +01395 P3100-REPORTS. DTSBX522 +01396 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBX522 +01397 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBX522 +01398 SET MRPT-RPT-88 TO TRUE. DTSBX522 +01399 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 +01400 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 +01401 IF L910-NO-REC-88 DTSBX522 +01402 GO TO P3100-EXIT DTSBX522 +01403 ELSE DTSBX522 +01404 PERFORM DTSBX522 +01405 UNTIL L910-NO-REC-88 DTSBX522 +01406 MOVE MSKL-REC TO MRPT-REC DTSBX522 +01407 IF MRPT-STATUS-CHNG-YES-88 DTSBX522 +01408 PERFORM P3130-STATUS-CHANGE THRU P3130-EXIT DTSBX522 +01409 END-IF DTSBX522 +01410 PERFORM P3110-WRITE THRU P3110-EXIT DTSBX522 +01411 ** IF MRPT-ESTB-DATE > 20070731 DTSBX522 +01412 * OR MRPT-YRQ > 20031 DTSBX522 +01413 * IF MRPT-ANNUAL-YES-88 DTSBX522 +01414 * PERFORM P3120-ANNUAL THRU P3120-EXIT DTSBX522 +01415 * ELSE DTSBX522 +01416 * PERFORM P3110-WRITE THRU P3110-EXIT DTSBX522 +01417 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +01418 * END-IF DTSBX522 +01419 ** END-IF DTSBX522 +01420 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +01421 END-PERFORM DTSBX522 +01422 END-IF. DTSBX522 +01423 DTSBX522 +01424 P3100-EXIT. DTSBX522 +01425 EXIT. DTSBX522 +01426 DTSBX522 +01427 P3110-WRITE. DTSBX522 +01428 MOVE MRPT-RPT-TYPE TO TRAN-TRANS. DTSBX522 +01429 MOVE MRPT-BATCH-NO TO TRAN-BATCH. DTSBX522 +01430 MOVE MRPT-ITEM-NO TO TRAN-ITEM. DTSBX522 +01431 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 +01432 MOVE MRPT-YRQ TO L004-QTR-5-9 DTSBX522 +01433 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 +01434 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 +01435 MOVE MRPT-REMIT-AMT TO TRAN-AMT. DTSBX522 +01436 MOVE MRPT-TOT-WAGE TO TRAN-TOT-WAGE. DTSBX522 +01437 MOVE MRPT-TAX-WAGE TO TRAN-TAX-WAGE. DTSBX522 +01438 MOVE MRPT-EXCESS-WAGE TO TRAN-EXC-WAGE. DTSBX522 +01439 IF MPRF-CLASS-SELF-INS-88 DTSBX522 +01440 MOVE ZERO TO TRAN-RATE DTSBX522 +01441 ELSE DTSBX522 +01442 COMPUTE W-RATE = (MRPT-UI-RATE * 100) DTSBX522 +01443 MOVE W-RATE TO TRAN-RATE DTSBX522 +01444 END-IF DTSBX522 +01445 MOVE SPACES TO TRAN-ACCT. DTSBX522 +01446 MOVE ZEROS TO TRAN-APPLIC-BATCH DTSBX522 +01447 TRAN-APPLIC-ITEM. DTSBX522 +01448 IF MRPT-ANNUAL-YES-88 DTSBX522 +01449 MOVE 'T' TO TRAN-CAT DTSBX522 +01450 ELSE DTSBX522 +01451 MOVE 'R' TO TRAN-CAT DTSBX522 +01452 END-IF. DTSBX522 +01453 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 +01454 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 +01455 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01456 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 +01457 MOVE MRPT-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 +01458 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01459 IF L001-VALID-DATE DTSBX522 +01460 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX522 +01461 ELSE DTSBX522 +01462 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX522 +01463 END-IF. DTSBX522 +01464 DTSBX522 +01465 MOVE MRPT-RESPONSIBLE-ACTIVITY TO TRAN-RESP-ACTIVITY. DTSBX522 +01466 MOVE MRPT-RESPONSIBLE-OP-ID TO TRAN-RESP-OPID. DTSBX522 +01467 DTSBX522 +01468 ** WRITE TRAN-REC FROM W-TRAN-REC DTSBX522 +01469 * IF NOT TRAN-STATUS-OK-88 DTSBX522 +01470 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 +01471 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 +01472 * ELSE DTSBX522 +01473 * ADD +1 TO W-TRAN-CNT DTSBX522 +01474 * W-RPT-CNT DTSBX522 +01475 ** END-IF. DTSBX522 +01476 DTSBX522 +01477 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX522 +01478 IF MRPT-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 +01479 WRITE TRAN-INCR-REC FROM W-TRAN-REC DTSBX522 +01480 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 +01481 DISPLAY 'CANNOT WRITE TO TRAN INCR FILE ' DTSBX522 +01482 ' ' TRAN-I-STATUS ' ' TRAN-EMP-NO DTSBX522 +01483 ELSE DTSBX522 +01484 ADD +1 TO W-TRAN-CNT-INCR DTSBX522 +01485 END-IF DTSBX522 +01486 END-IF. DTSBX522 +01487 DTSBX522 +01488 P3110-EXIT. DTSBX522 +01489 EXIT. DTSBX522 +01490 DTSBX522 +01491 *P3120-ANNUAL. DTSBX522 +01492 ** DISPLAY 'ANNUAL ' MPRF-EMP-NO ' ' MRPT-YRQ. DTSBX522 +01493 * DTSBX522 +01494 * PERFORM P3122-INIT-ANN-TBL THRU P3122-EXIT. DTSBX522 +01495 * DTSBX522 +01496 * SET W-RPT-COMPLETE-NULL-88 TO TRUE. DTSBX522 +01497 * DTSBX522 +01498 * MOVE MRPT-YRQ TO L004-QTR-5-9. DTSBX522 +01499 * MOVE 4 TO L004-QTR-5-Q. DTSBX522 +01500 * MOVE L004-QTR-5-9 TO W-LAST-ANN-YRQ. DTSBX522 +01501 * DTSBX522 +01502 * MOVE MRPT-BATCH-NO TO W-BATCH. DTSBX522 +01503 * MOVE MRPT-ITEM-NO TO W-ITEM. DTSBX522 +01504 * DTSBX522 +01505 * PERFORM DTSBX522 +01506 * UNTIL L910-NO-REC-88 OR W-RPT-COMPLETE-YES-88 DTSBX522 +01507 * MOVE MSKL-REC TO MRPT-REC DTSBX522 +01508 * IF MRPT-YRQ > W-LAST-ANN-YRQ DTSBX522 +01509 * OR MPRF-EMP-NO DTSBX522 +01510 * SET W-RPT-COMPLETE-YES-88 TO TRUE DTSBX522 +01511 * ELSE DTSBX522 +01512 * PERFORM P3121-SUM-DATA THRU P3121-EXIT DTSBX522 +01513 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +01514 * END-IF DTSBX522 +01515 * END-PERFORM. DTSBX522 +01516 * DTSBX522 +01517 * PERFORM DTSBX522 +01518 * VARYING ASUB FROM +1 BY +1 DTSBX522 +01519 * UNTIL ASUB > ASUB-LAST DTSBX522 +01520 * PERFORM P3123-WRITE THRU P3123-EXIT DTSBX522 +01521 * END-PERFORM. DTSBX522 +01522 * DTSBX522 +01523 * DTSBX522 +01524 *P3120-EXIT. DTSBX522 +01525 * EXIT. DTSBX522 +01526 * DTSBX522 +01527 *P3121-SUM-DATA. DTSBX522 +01528 * MOVE +0 TO ASUB. DTSBX522 +01529 * PERFORM DTSBX522 +01530 * VARYING ASUB1 FROM +1 BY +1 DTSBX522 +01531 * UNTIL ASUB > +0 DTSBX522 +01532 * OR ASUB1 > ASUB-LAST DTSBX522 +01533 * IF W-ANN-BATCH (ASUB1) = MRPT-BATCH-NO DTSBX522 +01534 * AND W-ANN-ITEM (ASUB1) = MRPT-ITEM-NO DTSBX522 +01535 * MOVE ASUB1 TO ASUB DTSBX522 +01536 * END-IF DTSBX522 +01537 * END-PERFORM. DTSBX522 +01538 * DTSBX522 +01539 * IF ASUB = ZERO DTSBX522 +01540 * ADD +1 TO ASUB-LAST DTSBX522 +01541 * MOVE ASUB-LAST TO ASUB DTSBX522 +01542 * ELSE DTSBX522 +01543 * ADD MRPT-REMIT-AMT TO W-ANN-REMIT (ASUB) DTSBX522 +01544 * ADD MRPT-TOT-WAGE TO W-ANN-TOT-WAGE (ASUB) DTSBX522 +01545 * ADD MRPT-TAX-WAGE TO W-ANN-TAX-WAGE (ASUB) DTSBX522 +01546 * ADD MRPT-EXCESS-WAGE TO W-ANN-EXCESS-WAGE (ASUB) DTSBX522 +01547 * GO TO P3121-EXIT DTSBX522 +01548 * END-IF. DTSBX522 +01549 * DTSBX522 +01550 * MOVE MRPT-RPT-TYPE DTSBX522 +01551 * TO W-ANN-RPT-TYPE (ASUB). DTSBX522 +01552 * MOVE MRPT-YRQ TO W-ANN-YRQ (ASUB). DTSBX522 +01553 * MOVE MRPT-BATCH-NO TO W-ANN-BATCH (ASUB). DTSBX522 +01554 * MOVE MRPT-ITEM-NO TO W-ANN-ITEM (ASUB). DTSBX522 +01555 * ADD MRPT-REMIT-AMT TO W-ANN-REMIT (ASUB). DTSBX522 +01556 * ADD MRPT-TOT-WAGE TO W-ANN-TOT-WAGE (ASUB). DTSBX522 +01557 * ADD MRPT-TAX-WAGE TO W-ANN-TAX-WAGE (ASUB). DTSBX522 +01558 * ADD MRPT-EXCESS-WAGE TO W-ANN-EXCESS-WAGE (ASUB). DTSBX522 +01559 * MOVE MRPT-UI-RATE TO W-ANN-RATE (ASUB). DTSBX522 +01560 * MOVE MRPT-RECEIVED-DATE TO W-ANN-RCVD-DT (ASUB). DTSBX522 +01561 * MOVE MRPT-ESTB-DATE TO W-ANN-PROCESS-DT (ASUB). DTSBX522 +01562 * DTSBX522 +01563 *P3121-EXIT. DTSBX522 +01564 * EXIT. DTSBX522 +01565 * DTSBX522 +01566 *P3122-INIT-ANN-TBL. DTSBX522 +01567 * MOVE ZERO TO ASUB-LAST. DTSBX522 +01568 * PERFORM DTSBX522 +01569 * VARYING ASUB FROM +1 BY +1 DTSBX522 +01570 * UNTIL ASUB > ASUB-MAX DTSBX522 +01571 * MOVE SPACES TO W-ANN-RPT-TYPE (ASUB) DTSBX522 +01572 * MOVE ZERO TO W-ANN-YRQ (ASUB) DTSBX522 +01573 * W-ANN-RATE (ASUB) DTSBX522 +01574 * W-ANN-REMIT (ASUB) DTSBX522 +01575 * W-ANN-BATCH (ASUB) DTSBX522 +01576 * W-ANN-ITEM (ASUB) DTSBX522 +01577 * W-ANN-TOT-WAGE (ASUB) DTSBX522 +01578 * W-ANN-TAX-WAGE (ASUB) DTSBX522 +01579 * W-ANN-EXCESS-WAGE (ASUB) DTSBX522 +01580 * W-ANN-RCVD-DT (ASUB) DTSBX522 +01581 * W-ANN-PROCESS-DT (ASUB) DTSBX522 +01582 * END-PERFORM. DTSBX522 +01583 * DTSBX522 +01584 *P3122-EXIT. DTSBX522 +01585 * EXIT. DTSBX522 +01586 * DTSBX522 +01587 *P3123-WRITE. DTSBX522 +01588 * MOVE W-ANN-RPT-TYPE (ASUB) TO TRAN-TRANS. DTSBX522 +01589 * MOVE W-ANN-BATCH (ASUB) TO TRAN-BATCH. DTSBX522 +01590 * MOVE W-ANN-ITEM (ASUB) TO TRAN-ITEM. DTSBX522 +01591 * MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 +01592 * MOVE 1 TO W-ANN-YRQ-Q (ASUB). DTSBX522 +01593 * MOVE W-ANN-YRQ (ASUB) TO L004-QTR-5-9 DTSBX522 +01594 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 +01595 * MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 +01596 * MOVE W-ANN-REMIT (ASUB) TO TRAN-AMT. DTSBX522 +01597 * MOVE W-ANN-TOT-WAGE (ASUB) TO TRAN-TOT-WAGE. DTSBX522 +01598 * MOVE W-ANN-TAX-WAGE (ASUB) TO TRAN-TAX-WAGE. DTSBX522 +01599 * MOVE W-ANN-EXCESS-WAGE (ASUB) TO TRAN-EXC-WAGE. DTSBX522 +01600 * COMPUTE W-RATE = (W-ANN-RATE (ASUB) * 100). DTSBX522 +01601 * MOVE W-RATE TO TRAN-RATE. DTSBX522 +01602 * MOVE SPACES TO TRAN-ACCT. DTSBX522 +01603 * MOVE 'T' TO TRAN-CAT. DTSBX522 +01604 * SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 +01605 * MOVE W-ANN-RCVD-DT (ASUB) TO L001-FED-8-DATE-9. DTSBX522 +01606 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01607 * MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 +01608 * MOVE W-ANN-PROCESS-DT (ASUB) TO L001-FED-8-DATE-9. DTSBX522 +01609 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01610 * MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT. DTSBX522 +01611 * DTSBX522 +01612 * WRITE TRAN-REC FROM W-TRAN-REC. DTSBX522 +01613 * IF NOT TRAN-STATUS-OK-88 DTSBX522 +01614 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 +01615 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 +01616 * ELSE DTSBX522 +01617 * ADD +1 TO W-TRAN-CNT DTSBX522 +01618 * W-ANN-RPT-CNT DTSBX522 +01619 * END-IF. DTSBX522 +01620 * DTSBX522 +01621 *P3123-EXIT. DTSBX522 +01622 * EXIT. DTSBX522 +01623 DTSBX522 +01624 P3130-STATUS-CHANGE. DTSBX522 +01625 *** DISPLAY 'STATUS ' MRPT-EMP-NO ' ' MRPT-BATCH-NO DTSBX522 +01626 *** ' ' MRPT-ITEM-NO. DTSBX522 +01627 MOVE LX34-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX522 +01628 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01629 MOVE L001-SLASH-8-DATE TO SUMMARY-PROCESS-DT. DTSBX522 +01630 MOVE 'STATUS CHANGE ' TO SUMMARY-MESSAGE. DTSBX522 +01631 MOVE MRPT-EMP-NO TO SUMMARY-EMP-NO DTSBX522 +01632 DTSBX522 +01633 MOVE MRPT-BATCH-NO TO SUMMARY-BATCH. DTSBX522 +01634 MOVE MRPT-ITEM-NO TO SUMMARY-ITEM. DTSBX522 +01635 MOVE MRPT-RPT-TYPE TO SUMMARY-TRAN. DTSBX522 +01636 SET SUMMARY-SOURCE-STATUS-88 TO TRUE DTSBX522 +01637 DTSBX522 +01638 WRITE SUMMARY-REC FROM W-SUMMARY-REC. DTSBX522 +01639 ADD +1 TO W-SUMMARY-CNT. DTSBX522 +01640 DTSBX522 +01641 P3130-EXIT. DTSBX522 +01642 EXIT. DTSBX522 +01643 DTSBX522 +01644 P3200-PAYMENT. DTSBX522 +01645 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX522 +01646 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBX522 +01647 SET MPAY-PAY-88 TO TRUE. DTSBX522 +01648 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 +01649 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 +01650 IF L910-NO-REC-88 DTSBX522 +01651 GO TO P3200-EXIT DTSBX522 +01652 ELSE DTSBX522 +01653 PERFORM DTSBX522 +01654 UNTIL L910-NO-REC-88 DTSBX522 +01655 MOVE MSKL-REC TO MPAY-REC DTSBX522 +01656 PERFORM P3210-WRITE THRU P3210-EXIT DTSBX522 +01657 *& IF MPAY-ESTB-DATE = LECM-PRIOR-RUN-DATE DTSBX522 +01658 ** DISPLAY 'P3200 ' MPRF-EMP-NO ' ' MPAY-BATCH-NO CL*64 +01659 ** ' ' MPAY-ITEM-NO CL*64 +01660 ** ' ' MPAY-TRACE-NO CL*64 +01661 ** PERFORM P3210-WRITE THRU P3210-EXIT CL*39 +01662 *& END-IF DTSBX522 +01663 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +01664 END-PERFORM DTSBX522 +01665 END-IF. DTSBX522 +01666 DTSBX522 +01667 P3200-EXIT. DTSBX522 +01668 EXIT. DTSBX522 +01669 DTSBX522 +01670 P3210-WRITE. DTSBX522 +01671 MOVE MPAY-PAY-TYPE TO TRAN-TRANS. DTSBX522 +01672 IF MPAY-APPLIC-YRQ > ZERO DTSBX522 +01673 MOVE MPAY-APPLIC-YRQ TO L004-QTR-5-9 DTSBX522 +01674 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 +01675 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 +01676 ELSE DTSBX522 +01677 MOVE SPACES TO TRAN-YRQ DTSBX522 +01678 END-IF. DTSBX522 +01679 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 +01680 MOVE MPAY-BATCH-NO TO TRAN-BATCH. DTSBX522 +01681 MOVE MPAY-ITEM-NO TO TRAN-ITEM. DTSBX522 +01682 MOVE MPAY-REMIT-AMT TO TRAN-AMT. DTSBX522 +01683 MOVE ZERO TO TRAN-TAX-WAGE DTSBX522 +01684 TRAN-TOT-WAGE DTSBX522 +01685 TRAN-EXC-WAGE DTSBX522 +01686 TRAN-RATE. DTSBX522 +01687 MOVE MPAY-APPLIC-IND TO TRAN-ACCT. DTSBX522 +01688 MOVE MPAY-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBX522 +01689 MOVE MPAY-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBX522 +01690 MOVE 'P' TO TRAN-CAT. DTSBX522 +01691 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 +01692 MOVE MPAY-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 +01693 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01694 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 +01695 MOVE MPAY-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 +01696 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01697 IF L001-VALID-DATE DTSBX522 +01698 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX522 +01699 ELSE DTSBX522 +01700 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX522 +01701 ** MOVE W-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBX522 +01702 END-IF. DTSBX522 +01703 DTSBX522 +01704 MOVE MPAY-RESPONSIBLE-ACTIVITY TO TRAN-RESP-ACTIVITY. DTSBX522 +01705 MOVE MPAY-RESPONSIBLE-OP-ID TO TRAN-RESP-OPID. DTSBX522 +01706 DTSBX522 +01707 ** WRITE TRAN-REC FROM W-TRAN-REC DTSBX522 +01708 * IF NOT TRAN-STATUS-OK-88 DTSBX522 +01709 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 +01710 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 +01711 * ELSE DTSBX522 +01712 * ADD +1 TO W-TRAN-CNT DTSBX522 +01713 * W-PAY-CNT DTSBX522 +01714 ** END-IF. DTSBX522 +01715 DTSBX522 +01716 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX522 +01717 IF MPAY-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 +01718 WRITE TRAN-INCR-REC FROM W-TRAN-REC DTSBX522 +01719 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 +01720 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 +01721 ' ' TRAN-I-STATUS ' ' TRAN-EMP-NO DTSBX522 +01722 ELSE DTSBX522 +01723 ADD +1 TO W-TRAN-CNT DTSBX522 +01724 END-IF DTSBX522 +01725 END-IF. DTSBX522 +01726 DTSBX522 +01727 P3210-EXIT. DTSBX522 +01728 EXIT. DTSBX522 +01729 DTSBX522 +01730 P3300-ADJUSTMENT. DTSBX522 +01731 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBX522 +01732 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBX522 +01733 SET MADJ-ADJ-88 TO TRUE. DTSBX522 +01734 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 +01735 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 +01736 IF L910-NO-REC-88 DTSBX522 +01737 GO TO P3300-EXIT DTSBX522 +01738 ELSE DTSBX522 +01739 PERFORM DTSBX522 +01740 UNTIL L910-NO-REC-88 DTSBX522 +01741 MOVE MSKL-REC TO MADJ-REC DTSBX522 +01742 PERFORM P3310-WRITE THRU P3310-EXIT DTSBX522 +01743 *& IF MADJ-ESTB-DATE = LECM-PRIOR-RUN-DATE DTSBX522 +01744 * PERFORM P3310-WRITE THRU P3310-EXIT DTSBX522 +01745 *& END-IF DTSBX522 +01746 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +01747 END-PERFORM DTSBX522 +01748 END-IF. DTSBX522 +01749 DTSBX522 +01750 P3300-EXIT. DTSBX522 +01751 EXIT. DTSBX522 +01752 DTSBX522 +01753 P3310-WRITE. DTSBX522 +01754 IF MADJ-CHRG-88 DTSBX522 +01755 OR MADJ-WAIVE-88 DTSBX522 +01756 OR MADJ-TOLER-88 DTSBX522 +01757 OR MADJ-WRITE-OFF-88 DTSBX522 +01758 OR MADJ-WRITE-OFF-REV-88 DTSBX522 +01759 NEXT SENTENCE DTSBX522 +01760 ELSE DTSBX522 +01761 GO TO P3310-EXIT DTSBX522 +01762 END-IF. DTSBX522 +01763 MOVE MADJ-ADJ-TYPE TO TRAN-TRANS. DTSBX522 +01764 MOVE MADJ-BATCH-NO TO TRAN-BATCH. DTSBX522 +01765 MOVE MADJ-ITEM-NO TO TRAN-ITEM. DTSBX522 +01766 IF MADJ-APPLIC-YRQ > ZERO DTSBX522 +01767 MOVE MADJ-APPLIC-YRQ TO L004-QTR-5-9 DTSBX522 +01768 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 +01769 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 +01770 ELSE DTSBX522 +01771 MOVE SPACES TO TRAN-YRQ DTSBX522 +01772 END-IF. DTSBX522 +01773 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 +01774 MOVE MADJ-AMT TO TRAN-AMT. DTSBX522 +01775 DTSBX522 +01776 MOVE ZERO TO TRAN-TOT-WAGE DTSBX522 +01777 TRAN-TAX-WAGE DTSBX522 +01778 TRAN-EXC-WAGE DTSBX522 +01779 TRAN-RATE. DTSBX522 +01780 MOVE MADJ-APPLIC-IND TO TRAN-ACCT. DTSBX522 +01781 MOVE MADJ-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBX522 +01782 MOVE MADJ-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBX522 +01783 MOVE 'A' TO TRAN-CAT. DTSBX522 +01784 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 +01785 MOVE MADJ-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 +01786 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01787 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 +01788 MOVE MADJ-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 +01789 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +01790 IF L001-VALID-DATE DTSBX522 +01791 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX522 +01792 ELSE DTSBX522 +01793 ** MOVE W-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBX522 +01794 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX522 +01795 END-IF. DTSBX522 +01796 DTSBX522 +01797 MOVE MADJ-RESPONSIBLE-ACTIVITY TO TRAN-RESP-ACTIVITY. DTSBX522 +01798 MOVE MADJ-RESPONSIBLE-OP-ID TO TRAN-RESP-OPID. DTSBX522 +01799 DTSBX522 +01800 ** WRITE TRAN-REC FROM W-TRAN-REC DTSBX522 +01801 * IF NOT TRAN-STATUS-OK-88 DTSBX522 +01802 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 +01803 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 +01804 * ELSE DTSBX522 +01805 * ADD +1 TO W-TRAN-CNT DTSBX522 +01806 * W-ADJ-CNT DTSBX522 +01807 ** END-IF. DTSBX522 +01808 DTSBX522 +01809 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX522 +01810 IF MADJ-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 +01811 WRITE TRAN-INCR-REC FROM W-TRAN-REC DTSBX522 +01812 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 +01813 DISPLAY 'CANNOT WRITE TO TRAN INCR FILE ' DTSBX522 +01814 ' ' TRAN-I-STATUS ' ' TRAN-EMP-NO DTSBX522 +01815 ELSE DTSBX522 +01816 ADD +1 TO W-TRAN-CNT DTSBX522 +01817 END-IF DTSBX522 +01818 END-IF. DTSBX522 +01819 DTSBX522 +01820 P3310-EXIT. DTSBX522 +01821 EXIT. DTSBX522 +01822 DTSBX522 +01823 P4000-CORRECTIONS. DTSBX522 +01824 PERFORM DTSBX522 +01825 VARYING QSUB FROM +1 BY +1 DTSBX522 +01826 UNTIL QSUB > QMAX DTSBX522 +01827 IF (Q-UI-CHG (QSUB) NOT = J-UI-CHG (QSUB) DTSBX522 +01828 OR Q-UI-PD (QSUB) NOT = J-UI-PD (QSUB) DTSBX522 +01829 OR Q-UI-WV (QSUB) NOT = J-UI-WV (QSUB) DTSBX522 +01830 OR Q-UI-WO (QSUB) NOT = J-UI-WO (QSUB) DTSBX522 +01831 OR Q-UI-TL (QSUB) NOT = J-UI-TL (QSUB)) DTSBX522 +01832 PERFORM P4100-CORRECT-UI THRU P4100-EXIT DTSBX522 +01833 END-IF DTSBX522 +01834 IF (Q-INT-CHG (QSUB) NOT = J-INT-CHG (QSUB) DTSBX522 +01835 OR Q-INT-PD (QSUB) NOT = J-INT-PD (QSUB) DTSBX522 +01836 OR Q-INT-WV (QSUB) NOT = J-INT-WV (QSUB) DTSBX522 +01837 OR Q-INT-WO (QSUB) NOT = J-INT-WO (QSUB) DTSBX522 +01838 OR Q-INT-TL (QSUB) NOT = J-INT-TL (QSUB)) DTSBX522 +01839 PERFORM P4200-CORRECT-INT THRU P4200-EXIT DTSBX522 +01840 END-IF DTSBX522 +01841 IF (Q-LP-CHG (QSUB) NOT = J-LP-CHG (QSUB) DTSBX522 +01842 OR Q-LP-PD (QSUB) NOT = J-LP-PD (QSUB) DTSBX522 +01843 OR Q-LP-WV (QSUB) NOT = J-LP-WV (QSUB) DTSBX522 +01844 OR Q-LP-WO (QSUB) NOT = J-LP-WO (QSUB) DTSBX522 +01845 OR Q-LP-TL (QSUB) NOT = J-LP-TL (QSUB)) DTSBX522 +01846 PERFORM P4300-CORRECT-LP THRU P4300-EXIT DTSBX522 +01847 END-IF DTSBX522 +01848 IF (Q-NP-CHG (QSUB) NOT = J-NP-CHG (QSUB) DTSBX522 +01849 OR Q-NP-PD (QSUB) NOT = J-NP-PD (QSUB) DTSBX522 +01850 OR Q-NP-WV (QSUB) NOT = J-NP-WV (QSUB) DTSBX522 +01851 OR Q-NP-WO (QSUB) NOT = J-NP-WO (QSUB) DTSBX522 +01852 OR Q-NP-TL (QSUB) NOT = J-NP-TL (QSUB)) DTSBX522 +01853 PERFORM P4400-CORRECT-NP THRU P4400-EXIT DTSBX522 +01854 END-IF DTSBX522 +01855 IF (Q-MP-CHG (QSUB) NOT = J-MP-CHG (QSUB) DTSBX522 +01856 OR Q-MP-PD (QSUB) NOT = J-MP-PD (QSUB) DTSBX522 +01857 OR Q-MP-WV (QSUB) NOT = J-MP-WV (QSUB) DTSBX522 +01858 OR Q-MP-WO (QSUB) NOT = J-MP-WO (QSUB) DTSBX522 +01859 OR Q-MP-TL (QSUB) NOT = J-MP-TL (QSUB)) DTSBX522 +01860 PERFORM P4500-CORRECT-MP THRU P4500-EXIT DTSBX522 +01861 END-IF DTSBX522 +01862 IF (Q-SU-CHG (QSUB) NOT = J-SU-CHG (QSUB) DTSBX522 +01863 OR Q-SU-PD (QSUB) NOT = J-SU-PD (QSUB) DTSBX522 +01864 OR Q-SU-WV (QSUB) NOT = J-SU-WV (QSUB) DTSBX522 +01865 OR Q-SU-WO (QSUB) NOT = J-SU-WO (QSUB) DTSBX522 +01866 OR Q-SU-TL (QSUB) NOT = J-SU-TL (QSUB)) DTSBX522 +01867 PERFORM P4600-CORRECT-SU THRU P4600-EXIT DTSBX522 +01868 END-IF DTSBX522 +01869 END-PERFORM. DTSBX522 +01870 DTSBX522 +01871 P4000-EXIT. DTSBX522 +01872 EXIT. DTSBX522 +01873 DTSBX522 +01874 P4100-CORRECT-UI. DTSBX522 +01875 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 +01876 GO TO P4100-EXIT DTSBX522 +01877 ELSE DTSBX522 +01878 ADD +1 TO W-ERROR-CNT DTSBX522 +01879 END-IF. DTSBX522 +01880 DTSBX522 +01881 MOVE 'UI' TO ACCT-ROW. DTSBX522 +01882 DTSBX522 +01883 MOVE ZERO TO ADJ-CHG DTSBX522 +01884 ADJ-PD DTSBX522 +01885 ADJ-WV DTSBX522 +01886 ADJ-WO DTSBX522 +01887 ADJ-TL. DTSBX522 +01888 DTSBX522 +01889 COMPUTE ADJ-CHG = (Q-UI-CHG (QSUB) - J-UI-CHG (QSUB)). DTSBX522 +01890 COMPUTE ADJ-PD = (Q-UI-PD (QSUB) - J-UI-PD (QSUB)). DTSBX522 +01891 COMPUTE ADJ-WV = (Q-UI-WV (QSUB) - J-UI-WV (QSUB)). DTSBX522 +01892 COMPUTE ADJ-WO = (Q-UI-WO (QSUB) - J-UI-WO (QSUB)). DTSBX522 +01893 COMPUTE ADJ-TL = (Q-UI-TL (QSUB) - J-UI-TL (QSUB)). DTSBX522 +01894 DTSBX522 +01895 ** DISPLAY 'P4900 Q CHG ' Q-UI-CHG (QSUB) DTSBX522 +01896 * ' Q PD ' Q-UI-PD (QSUB) DTSBX522 +01897 * DISPLAY ' J CHG ' J-UI-CHG (QSUB) DTSBX522 +01898 ** ' J PD ' J-UI-PD (QSUB). DTSBX522 +01899 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 +01900 DTSBX522 +01901 P4100-EXIT. DTSBX522 +01902 EXIT. DTSBX522 +01903 DTSBX522 +01904 P4200-CORRECT-INT. DTSBX522 +01905 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 +01906 GO TO P4200-EXIT DTSBX522 +01907 ELSE DTSBX522 +01908 ADD +1 TO W-ERROR-CNT DTSBX522 +01909 END-IF. DTSBX522 +01910 DTSBX522 +01911 MOVE 'I ' TO ACCT-ROW. DTSBX522 +01912 DTSBX522 +01913 MOVE ZERO TO ADJ-CHG DTSBX522 +01914 ADJ-PD DTSBX522 +01915 ADJ-WV DTSBX522 +01916 ADJ-WO DTSBX522 +01917 ADJ-TL. DTSBX522 +01918 DTSBX522 +01919 COMPUTE ADJ-CHG = (Q-INT-CHG (QSUB) - J-INT-CHG (QSUB)). DTSBX522 +01920 COMPUTE ADJ-PD = (Q-INT-PD (QSUB) - J-INT-PD (QSUB)). DTSBX522 +01921 COMPUTE ADJ-WV = (Q-INT-WV (QSUB) - J-INT-WV (QSUB)). DTSBX522 +01922 COMPUTE ADJ-WO = (Q-INT-WO (QSUB) - J-INT-WO (QSUB)). DTSBX522 +01923 COMPUTE ADJ-TL = (Q-INT-TL (QSUB) - J-INT-TL (QSUB)). DTSBX522 +01924 DTSBX522 +01925 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 +01926 DTSBX522 +01927 P4200-EXIT. DTSBX522 +01928 EXIT. DTSBX522 +01929 DTSBX522 +01930 P4300-CORRECT-LP. DTSBX522 +01931 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 +01932 ** DISPLAY 'P4300 LP ' MPRF-EMP-NO ' ' DTSBX522 +01933 ** TBL-YRQ (QSUB) DTSBX522 +01934 GO TO P4300-EXIT DTSBX522 +01935 ELSE DTSBX522 +01936 ADD +1 TO W-ERROR-CNT DTSBX522 +01937 END-IF. DTSBX522 +01938 DTSBX522 +01939 MOVE 'LP' TO ACCT-ROW. DTSBX522 +01940 DTSBX522 +01941 MOVE ZERO TO ADJ-CHG DTSBX522 +01942 ADJ-PD DTSBX522 +01943 ADJ-WV DTSBX522 +01944 ADJ-WO DTSBX522 +01945 ADJ-TL. DTSBX522 +01946 DTSBX522 +01947 COMPUTE ADJ-CHG = (Q-LP-CHG (QSUB) - J-LP-CHG (QSUB)). DTSBX522 +01948 COMPUTE ADJ-PD = (Q-LP-PD (QSUB) - J-LP-PD (QSUB)). DTSBX522 +01949 COMPUTE ADJ-WV = (Q-LP-WV (QSUB) - J-LP-WV (QSUB)). DTSBX522 +01950 COMPUTE ADJ-WO = (Q-LP-WO (QSUB) - J-LP-WO (QSUB)). DTSBX522 +01951 COMPUTE ADJ-TL = (Q-LP-TL (QSUB) - J-LP-TL (QSUB)). DTSBX522 +01952 DTSBX522 +01953 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 +01954 DTSBX522 +01955 P4300-EXIT. DTSBX522 +01956 EXIT. DTSBX522 +01957 DTSBX522 +01958 P4400-CORRECT-NP. DTSBX522 +01959 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 +01960 ** DISPLAY 'P4400 NP ' MPRF-EMP-NO ' ' DTSBX522 +01961 ** TBL-YRQ (QSUB) DTSBX522 +01962 GO TO P4400-EXIT DTSBX522 +01963 ELSE DTSBX522 +01964 ADD +1 TO W-ERROR-CNT DTSBX522 +01965 END-IF. DTSBX522 +01966 DTSBX522 +01967 MOVE 'NP' TO ACCT-ROW. DTSBX522 +01968 DTSBX522 +01969 MOVE ZERO TO ADJ-CHG DTSBX522 +01970 ADJ-PD DTSBX522 +01971 ADJ-WV DTSBX522 +01972 ADJ-WO DTSBX522 +01973 ADJ-TL. DTSBX522 +01974 DTSBX522 +01975 COMPUTE ADJ-CHG = (Q-NP-CHG (QSUB) - J-NP-CHG (QSUB)). DTSBX522 +01976 COMPUTE ADJ-PD = (Q-NP-PD (QSUB) - J-NP-PD (QSUB)). DTSBX522 +01977 COMPUTE ADJ-WV = (Q-NP-WV (QSUB) - J-NP-WV (QSUB)). DTSBX522 +01978 COMPUTE ADJ-WO = (Q-NP-WO (QSUB) - J-NP-WO (QSUB)). DTSBX522 +01979 COMPUTE ADJ-TL = (Q-NP-TL (QSUB) - J-NP-TL (QSUB)). DTSBX522 +01980 DTSBX522 +01981 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 +01982 DTSBX522 +01983 P4400-EXIT. DTSBX522 +01984 EXIT. DTSBX522 +01985 DTSBX522 +01986 P4500-CORRECT-MP. DTSBX522 +01987 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 +01988 ** DISPLAY 'P4500 MP ' MPRF-EMP-NO ' ' DTSBX522 +01989 ** TBL-YRQ (QSUB) DTSBX522 +01990 GO TO P4500-EXIT DTSBX522 +01991 ELSE DTSBX522 +01992 ADD +1 TO W-ERROR-CNT DTSBX522 +01993 END-IF. DTSBX522 +01994 DTSBX522 +01995 MOVE 'MP' TO ACCT-ROW. DTSBX522 +01996 DTSBX522 +01997 MOVE ZERO TO ADJ-CHG DTSBX522 +01998 ADJ-PD DTSBX522 +01999 ADJ-WV DTSBX522 +02000 ADJ-WO DTSBX522 +02001 ADJ-TL. DTSBX522 +02002 DTSBX522 +02003 COMPUTE ADJ-CHG = (Q-MP-CHG (QSUB) - J-MP-CHG (QSUB)). DTSBX522 +02004 COMPUTE ADJ-PD = (Q-MP-PD (QSUB) - J-MP-PD (QSUB)). DTSBX522 +02005 COMPUTE ADJ-WV = (Q-MP-WV (QSUB) - J-MP-WV (QSUB)). DTSBX522 +02006 COMPUTE ADJ-WO = (Q-MP-WO (QSUB) - J-MP-WO (QSUB)). DTSBX522 +02007 COMPUTE ADJ-TL = (Q-MP-TL (QSUB) - J-MP-TL (QSUB)). DTSBX522 +02008 DTSBX522 +02009 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 +02010 DTSBX522 +02011 P4500-EXIT. DTSBX522 +02012 EXIT. DTSBX522 +02013 DTSBX522 +02014 P4600-CORRECT-SU. DTSBX522 +02015 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 +02016 ** DISPLAY 'P4600 SU ' MPRF-EMP-NO ' ' DTSBX522 +02017 ** TBL-YRQ (QSUB) DTSBX522 +02018 GO TO P4600-EXIT DTSBX522 +02019 ELSE DTSBX522 +02020 ADD +1 TO W-ERROR-CNT DTSBX522 +02021 END-IF. DTSBX522 +02022 DTSBX522 +02023 MOVE 'SU' TO ACCT-ROW. DTSBX522 +02024 DTSBX522 +02025 MOVE ZERO TO ADJ-CHG DTSBX522 +02026 ADJ-PD DTSBX522 +02027 ADJ-WV DTSBX522 +02028 ADJ-WO DTSBX522 +02029 ADJ-TL. DTSBX522 +02030 DTSBX522 +02031 COMPUTE ADJ-CHG = (Q-SU-CHG (QSUB) - J-SU-CHG (QSUB)). DTSBX522 +02032 COMPUTE ADJ-PD = (Q-SU-PD (QSUB) - J-SU-PD (QSUB)). DTSBX522 +02033 COMPUTE ADJ-WV = (Q-SU-WV (QSUB) - J-SU-WV (QSUB)). DTSBX522 +02034 COMPUTE ADJ-WO = (Q-SU-WO (QSUB) - J-SU-WO (QSUB)). DTSBX522 +02035 COMPUTE ADJ-TL = (Q-SU-TL (QSUB) - J-SU-TL (QSUB)). DTSBX522 +02036 DTSBX522 +02037 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 +02038 DTSBX522 +02039 P4600-EXIT. DTSBX522 +02040 EXIT. DTSBX522 +02041 DTSBX522 +02042 P4900-WRITE-ACCT. DTSBX522 +02043 IF ADJ-CHG NOT = ZERO DTSBX522 +02044 MOVE 'CH' TO ACCT-COL DTSBX522 +02045 MOVE ADJ-CHG TO ACCT-AMT DTSBX522 +02046 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 +02047 END-IF. DTSBX522 +02048 DTSBX522 +02049 IF ADJ-PD NOT = ZERO DTSBX522 +02050 MOVE 'PD' TO ACCT-COL DTSBX522 +02051 COMPUTE ADJ-PD = (ADJ-PD * -1) DTSBX522 +02052 MOVE ADJ-PD TO ACCT-AMT DTSBX522 +02053 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 +02054 END-IF. DTSBX522 +02055 DTSBX522 +02056 IF ADJ-WV NOT = ZERO DTSBX522 +02057 MOVE 'WV' TO ACCT-COL DTSBX522 +02058 COMPUTE ADJ-WV = (ADJ-WV * -1) DTSBX522 +02059 MOVE ADJ-WV TO ACCT-AMT DTSBX522 +02060 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 +02061 END-IF. DTSBX522 +02062 DTSBX522 +02063 IF ADJ-WO NOT = ZERO DTSBX522 +02064 MOVE 'WO' TO ACCT-COL DTSBX522 +02065 COMPUTE ADJ-WO = (ADJ-WO * -1) DTSBX522 +02066 MOVE ADJ-WO TO ACCT-AMT DTSBX522 +02067 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 +02068 END-IF. DTSBX522 +02069 DTSBX522 +02070 IF ADJ-TL NOT = ZERO DTSBX522 +02071 MOVE 'TL' TO ACCT-COL DTSBX522 +02072 COMPUTE ADJ-TL = (ADJ-TL * -1) DTSBX522 +02073 MOVE ADJ-TL TO ACCT-AMT DTSBX522 +02074 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 +02075 END-IF. DTSBX522 +02076 DTSBX522 +02077 P4900-EXIT. DTSBX522 +02078 EXIT. DTSBX522 +02079 DTSBX522 +02080 P4910-WRITE. DTSBX522 +02081 ** DISPLAY 'P4910 ADJ JRN ' TBL-YRQ (QSUB). DTSBX522 +02082 DTSBX522 +02083 PERFORM S1000-CORRECTION-BATCH THRU S1000-EXIT. DTSBX522 +02084 MOVE W-JC-BATCH TO ACCT-BATCH DTSBX522 +02085 MOVE W-JC-ITEM TO ACCT-ITEM. DTSBX522 +02086 DTSBX522 +02087 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBX522 +02088 MOVE TBL-YRQ (QSUB) TO L004-QTR-5-9. DTSBX522 +02089 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 +02090 MOVE L004-SLASH-5-QTR TO ACCT-YRQ. DTSBX522 +02091 MOVE 'JC' TO ACCT-TRAN DTSBX522 +02092 MOVE 'B' TO ACCT-CAT. DTSBX522 +02093 ** MOVE W-DEFAULT-DATE TO L001-FED-8-DATE-9. DTSBX522 +02094 MOVE L004-QTR-DEFAULT-DUE-DATE TO L001-FED-8-DATE-9. DTSBX522 +02095 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +02096 IF L001-VALID-DATE DTSBX522 +02097 MOVE L001-SLASH-8-DATE TO ACCT-PROCESS-DT DTSBX522 +02098 ACCT-RCVD-DT DTSBX522 +02099 END-IF. DTSBX522 +02100 DTSBX522 +02101 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBX522 +02102 DTSBX522 +02103 ** WRITE ACCT-REC FROM W-ACCT-REC DTSBX522 +02104 * IF NOT ACCT-STATUS-OK-88 DTSBX522 +02105 * DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBX522 +02106 * ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBX522 +02107 * ELSE DTSBX522 +02108 * ADD +1 TO W-ACCT-CNT DTSBX522 +02109 ** END-IF. DTSBX522 +02110 DTSBX522 +02111 ** IF MPRF-EMP-NO = 010021 DTSBX522 +02112 * DISPLAY 'P4910 ' MPRF-EMP-NO ' ' ACCT-YRQ DTSBX522 +02113 * ' ' ACCT-BATCH '/' ACCT-ITEM DTSBX522 +02114 * DISPLAY ' ' ACCT-ROW ' ' ACCT-COL DTSBX522 +02115 * ' ' ACCT-TRAN ' ' ACCT-AMT DTSBX522 +02116 ** END-IF. DTSBX522 +02117 P4910-EXIT. DTSBX522 +02118 EXIT. DTSBX522 +02119 DTSBX522 +02120 P5000-PAY-DISTRIBUTION. DTSBX522 +02121 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBX522 +02122 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBX522 +02123 SET MDST-DST-88 TO TRUE. DTSBX522 +02124 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 +02125 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 +02126 PERFORM UNTIL L910-NO-REC-88 DTSBX522 +02127 MOVE MSKL-REC TO MDST-REC DTSBX522 +02128 PERFORM P5100-BUILD-OUTPUT THRU P5100-EXIT DTSBX522 +02129 MOVE MDST-REC TO MSKL-REC DTSBX522 +02130 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 +02131 END-PERFORM. DTSBX522 +02132 DTSBX522 +02133 P5000-EXIT. DTSBX522 +02134 EXIT. DTSBX522 +02135 DTSBX522 +02136 P5100-BUILD-OUTPUT. DTSBX522 +02137 MOVE MDST-EMP-NO TO DST-EMP-NO. DTSBX522 +02138 MOVE MDST-BATCH-NO TO DST-BATCH. DTSBX522 +02139 MOVE MDST-ITEM-NO TO DST-ITEM. DTSBX522 +02140 MOVE MDST-YRQ TO L004-QTR-5-9. DTSBX522 +02141 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 +02142 MOVE L004-SLASH-5-QTR TO DST-QTR DTSBX522 +02143 MOVE MDST-CHNG-DATE TO L001-FED-8-DATE-9. DTSBX522 +02144 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 +02145 MOVE L001-SLASH-8-DATE TO DST-CHNG-DT. DTSBX522 +02146 IF L001-INVALID-DATE DTSBX522 +02147 DISPLAY 'P5100 INVALID MDST-CHNG-DATE ' DTSBX522 +02148 MDST-EMP-NO ' ' MDST-BATCH-NO DTSBX522 +02149 ' ' MDST-ITEM-NO DTSBX522 +02150 GO TO P5100-EXIT DTSBX522 +02151 ELSE DTSBX522 +02152 PERFORM DTSBX522 +02153 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBX522 +02154 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBX522 +02155 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO DST-ACCT DTSBX522 +02156 MOVE MDST-AMT (MDST-ACCT-IDX) TO DST-AMT DTSBX522 +02157 PERFORM P5110-WRITE THRU P5110-EXIT DTSBX522 +02158 END-PERFORM DTSBX522 +02159 END-IF. DTSBX522 +02160 DTSBX522 +02161 P5100-EXIT. DTSBX522 +02162 EXIT. DTSBX522 +02163 DTSBX522 +02164 P5110-WRITE. DTSBX522 +02165 WRITE PAY-DIST-REC FROM W-PAY-DIST-REC. DTSBX522 +02166 IF NOT PAYDIST-STATUS-OK-88 DTSBX522 +02167 DISPLAY 'CANNOT WRITE TO PAY DIST FILE ' DTSBX522 +02168 ' ' PAYDIST-STATUS ' ' DST-EMP-NO DTSBX522 +02169 ELSE DTSBX522 +02170 ADD +1 TO W-PAY-DIST-CNT DTSBX522 +02171 END-IF. DTSBX522 +02172 DTSBX522 +02173 P5110-EXIT. DTSBX522 +02174 EXIT. DTSBX522 +02175 DTSBX522 +02176 T0000-TERMINATE. DTSBX522 +02177 ** CLOSE ACCT-FILE DTSBX522 +02178 CLOSE ACCT-FILE-INCR DTSBX522 +02179 QTR-FILE DTSBX522 +02180 ** TRAN-FILE DTSBX522 +02181 TRAN-FILE-INCR DTSBX522 +02182 SUMMARY-FILE DTSBX522 +02183 PAY-DIST-FILE. DTSBX522 +02184 DTSBX522 +02185 MOVE W-CURR-UI-TOT TO DISPLAY-AMT1. DTSBX522 +02186 DISPLAY '*********************************************'. DTSBX522 +02187 DISPLAY '** DTSBX343 TERMINATION STATISTICS **'. DTSBX522 +02188 DISPLAY '** **'. DTSBX522 +02189 DISPLAY '** QUARTERS ' W-QTR-CNT DTSBX522 +02190 ' **'. DTSBX522 +02191 DISPLAY '** ACOUNTING ' W-ACCT-CNT DTSBX522 +02192 ' **'. DTSBX522 +02193 DISPLAY '** ACOUNTING INCR ' W-ACCT-CNT-INCR DTSBX522 +02194 ' **'. DTSBX522 +02195 DISPLAY '** TRANSACTIONS ' W-TRAN-CNT DTSBX522 +02196 ' **'. DTSBX522 +02197 DISPLAY '** TRANSACTIONS INCR ' W-TRAN-CNT-INCR DTSBX522 +02198 ' **'. DTSBX522 +02199 DISPLAY '** REPORTS ' W-RPT-CNT DTSBX522 +02200 ' **'. DTSBX522 +02201 DISPLAY '** ANN REPORTS ' W-ANN-RPT-CNT DTSBX522 +02202 ' **'. DTSBX522 +02203 DISPLAY '** PAYMENTS ' W-PAY-CNT DTSBX522 +02204 ' **'. DTSBX522 +02205 DISPLAY '** PAY DIST ' W-PAY-DIST-CNT DTSBX522 +02206 ' **'. DTSBX522 +02207 DISPLAY '** ADJUST ' W-ADJ-CNT DTSBX522 +02208 ' **'. DTSBX522 +02209 DISPLAY '** ERRORS ' W-ERROR-CNT DTSBX522 +02210 ' **'. DTSBX522 +02211 DISPLAY '** CREDITS CORRECTED ' W-CR-CNT DTSBX522 +02212 ' **'. DTSBX522 +02213 DISPLAY '** LAST JC BATCH/ITEM ' DTSBX522 +02214 W-JC-BATCH '/' W-JC-ITEM DTSBX522 +02215 ' **'. DTSBX522 +02216 DISPLAY '** **'. DTSBX522 +02217 DISPLAY '** **'. DTSBX522 +02218 DISPLAY '*********************************************'. DTSBX522 +02219 DTSBX522 +02220 *** PERFORM T1000-ACCT-TOT THRU T1000-EXIT. DTSBX522 +02221 DTSBX522 +02222 T0000-EXIT. DTSBX522 +02223 EXIT. DTSBX522 +02224 DTSBX522 +02225 *T1000-ACCT-TOT. DTSBX522 +02226 * OPEN INPUT ACCT-FILE. DTSBX522 +02227 * IF NOT ACCT-STATUS-OK-88 DTSBX522 +02228 * DISPLAY 'T1000 ACCT FILE OPEN ERROR: ' ACCT-STATUS DTSBX522 +02229 * MOVE 'FILE OPEN ERROR' DTSBX522 +02230 * TO ABEND-MSG DTSBX522 +02231 * PERFORM S999-ABEND THRU S999-EXIT DTSBX522 +02232 * END-IF. DTSBX522 +02233 * DTSBX522 +02234 * READ ACCT-FILE INTO W-ACCT-REC. DTSBX522 +02235 * IF NOT ACCT-STATUS-OK-88 DTSBX522 +02236 * DISPLAY 'T1000 ACCT FILE EMPTY: ' ACCT-STATUS DTSBX522 +02237 * ELSE DTSBX522 +02238 * PERFORM UNTIL ACCT-STATUS-EOF-88 DTSBX522 +02239 * IF ACCT-ROW = 'UI' DTSBX522 +02240 * EVALUATE TRUE DTSBX522 +02241 * WHEN ACCT-COL = 'CH' DTSBX522 +02242 * ADD ACCT-AMT-9 TO W-TOT-CHG DTSBX522 +02243 * WHEN ACCT-COL = 'PD' DTSBX522 +02244 * ADD ACCT-AMT-9 TO W-TOT-PD DTSBX522 +02245 * END-EVALUATE DTSBX522 +02246 * END-IF DTSBX522 +02247 * END-PERFORM DTSBX522 +02248 * END-IF. DTSBX522 +02249 * DTSBX522 +02250 * CLOSE ACCT-FILE. DTSBX522 +02251 * MOVE W-TOT-CHG TO DISPLAY-AMT1. DTSBX522 +02252 * MOVE W-TOT-PD TO DISPLAY-AMT2. DTSBX522 +02253 * DISPLAY 'BX343 UI CHARGED ' DISPLAY-AMT1. DTSBX522 +02254 * DISPLAY ' UI PAID ' DISPLAY-AMT2. DTSBX522 +02255 * COMPUTE W-AMT = (W-TOT-CHG - W-TOT-PD). DTSBX522 +02256 * MOVE W-AMT TO DISPLAY-AMT3. DTSBX522 +02257 * DISPLAY ' BALANCE ' DISPLAY-AMT3. DTSBX522 +02258 * DTSBX522 +02259 *T1000-EXIT. DTSBX522 +02260 * EXIT. DTSBX522 +02261 DTSBX522 +02262 S001-FROM-FED-8. DTSBX522 +02263 SET L001-FROM-FED-8 TO TRUE. DTSBX522 +02264 GO TO S001-DATE. DTSBX522 +02265 DTSBX522 +02266 S001-FROM-ABS-DAY. DTSBX522 +02267 SET L001-FROM-ABS-DAY TO TRUE. DTSBX522 +02268 GO TO S001-DATE. DTSBX522 +02269 DTSBX522 +02270 S001-FROM-CAL-6. DTSBX522 +02271 SET L001-FROM-CAL-6 TO TRUE. DTSBX522 +02272 GO TO S001-DATE. DTSBX522 +02273 DTSBX522 +02274 S001-DATE. DTSBX522 +02275 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX522 +02276 S001-EXIT. DTSBX522 +02277 EXIT. DTSBX522 +02278 SKIP3 DTSBX522 +02279 S004-FROM-5. DTSBX522 +02280 SET L004-FROM-5 TO TRUE. DTSBX522 +02281 GO TO S004-QTR. DTSBX522 +02282 DTSBX522 +02283 S004-FROM-ABS. DTSBX522 +02284 SET L004-FROM-ABS TO TRUE. DTSBX522 +02285 GO TO S004-QTR. DTSBX522 +02286 DTSBX522 +02287 S004-FROM-3. DTSBX522 +02288 SET L004-FROM-3 TO TRUE. DTSBX522 +02289 GO TO S004-QTR. DTSBX522 +02290 DTSBX522 +02291 S004-FROM-DATE. DTSBX522 +02292 SET L004-FROM-DATE TO TRUE. DTSBX522 +02293 GO TO S004-QTR. DTSBX522 +02294 DTSBX522 +02295 S004-QTR. DTSBX522 +02296 DTSBX522 +02297 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX522 +02298 DTSBX522 +02299 S004-EXIT. DTSBX522 +02300 EXIT. DTSBX522 +02301 SKIP3 DTSBX522 +02302 S005-FROM-DATE-TIME. DTSBX522 +02303 SET L005-FROM-DATE-TIME TO TRUE. DTSBX522 +02304 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX522 +02305 S005-EXIT. DTSBX522 +02306 EXIT. DTSBX522 +02307 DTSBX522 +02308 S910-OPEN-READ. DTSBX522 +02309 SET L910-OPEN-READ-88 TO TRUE. DTSBX522 +02310 GO TO S910-MSTR-IO. DTSBX522 +02311 DTSBX522 +02312 S910-READ. DTSBX522 +02313 SET L910-READ-88 TO TRUE. DTSBX522 +02314 GO TO S910-MSTR-IO. DTSBX522 +02315 DTSBX522 +02316 S910-START-BROWSE. DTSBX522 +02317 SET L910-START-BROWSE-88 TO TRUE. DTSBX522 +02318 GO TO S910-MSTR-IO. DTSBX522 +02319 DTSBX522 +02320 S910-READ-NEXT. DTSBX522 +02321 SET L910-READ-NEXT-88 TO TRUE. DTSBX522 +02322 GO TO S910-MSTR-IO. DTSBX522 +02323 DTSBX522 +02324 S910-COUNT. DTSBX522 +02325 SET L910-COUNT-88 TO TRUE. DTSBX522 +02326 GO TO S910-MSTR-IO. DTSBX522 +02327 DTSBX522 +02328 S910-REWRITE. DTSBX522 +02329 SET L910-REWRITE-88 TO TRUE. DTSBX522 +02330 GO TO S910-MSTR-IO. DTSBX522 +02331 DTSBX522 +02332 S910-CLOSE. DTSBX522 +02333 SET L910-CLOSE-88 TO TRUE. DTSBX522 +02334 GO TO S910-MSTR-IO. DTSBX522 +02335 DTSBX522 +02336 S910-MSTR-IO. DTSBX522 +02337 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX522 +02338 MSKL-REC. DTSBX522 +02339 S910-EXIT. DTSBX522 +02340 EXIT. DTSBX522 +02341 SKIP3 DTSBX522 +02342 DTSBX522 +02343 S931-READ. DTSBX522 +02344 SET L931-READ-88 TO TRUE. DTSBX522 +02345 GO TO S931-REF-IO. DTSBX522 +02346 DTSBX522 +02347 S931-REF-IO. DTSBX522 +02348 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX522 +02349 FSKL-REC. DTSBX522 +02350 S931-EXIT. DTSBX522 +02351 EXIT. DTSBX522 +02352 DTSBX522 +02353 S1000-CORRECTION-BATCH. DTSBX522 +02354 IF W-JC-ITEM < +999 DTSBX522 +02355 ADD +1 TO W-JC-ITEM DTSBX522 +02356 ELSE DTSBX522 +02357 ADD +1 TO W-JC-BATCH DTSBX522 +02358 MOVE +1 TO W-JC-ITEM DTSBX522 +02359 END-IF. DTSBX522 +02360 DTSBX522 +02361 S1000-EXIT. DTSBX522 +02362 EXIT. DTSBX522 +02363 DTSBX522 +02364 S999-ABEND. DTSBX522 +02365 DISPLAY '*** DTSBX343 ABENDING. ' DTSBX522 +02366 ABEND-MSG. DTSBX522 +02367 DTSBX522 +02368 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX522 +02369 S999-EXIT. DTSBX522 +02370 EXIT. DTSBX522 diff --git a/Batch/DTSBX530.cob b/Batch/DTSBX530.cob new file mode 100644 index 0000000..cd9c24a --- /dev/null +++ b/Batch/DTSBX530.cob @@ -0,0 +1,2892 @@ +00001 IDENTIFICATION DIVISION. 07/15/19 +00002 PROGRAM-ID. DTSBX530. DTSBX530 +00003 AUTHOR. NGC. LV252 +00004 DATE-WRITTEN. APRIL 2005. DTSBX530 +00005 DATE-COMPILED. DTSBX530 +00006 SKIP3 DTSBX530 +00007 ***** DTSBX530 +00008 * DTSBX530 +00009 * >>> PROCESSING FOR ESSP PAYMENTS ONLY. SEPERATED REPORT CL184 +00010 * >>> AND PAYMENT DUE TO ERROR PROCESSING AMENDED REPORTS. CL184 +00011 * DTSBX530 +00012 * FUNCTION: EDIT PAYMENT DATA FROM ESSP APPLICATION. CL184 +00013 * DTSBX530 +00014 * MODIFICATION HISTORY: DTSBX530 +00015 * DTSBX530 +00016 * 04-05-2005 INITIAL DEVELOPMENT DTSBX530 +00017 * REFERENCE RFP: ESSP PAYMENTS CL184 +00018 * DTSBX530 +00019 * DTSBX530 +00020 * CL**9 +00021 * 06-15-2016 MODIFIED PROGRAM TO WRITE T25 RECORDS ONLY CL184 +00022 * TO X530BTC FILE. ALSO NO WAGE RECORDS ARE CL184 +00023 * WRITTEN TO TO THE WAGE BTC FILE DUE TO NO CL**9 +00024 * BATCH NUMBERS, WAGE RECORDS ARE NOW WRITTEN CL**9 +00025 * TO THE WAGE NAME FILE ZL1. CL184 +00026 ***** DTSBX530 +00027 SKIP3 DTSBX530 +00028 ENVIRONMENT DIVISION. DTSBX530 +00029 CL122 +00030 CONFIGURATION SECTION. CL122 +00031 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL122 +00032 CL122 +00033 INPUT-OUTPUT SECTION. DTSBX530 +00034 DTSBX530 +00035 FILE-CONTROL. DTSBX530 +00036 DTSBX530 +00037 SELECT TEMP-BTC-FILE ASSIGN TO X530BTC CL184 +00038 FILE STATUS IS TEMP-BTC-STATUS. DTSBX530 +00039 CL*59 +00040 SELECT PEND-X140-FILE ASSIGN TO P530X140 CL229 +00041 FILE STATUS IS REPT-140-STATUS. CL*63 +00042 CL*59 +00043 SELECT PEND-X144-FILE ASSIGN TO P530X144 CL229 +00044 FILE STATUS IS WAGE-144-STATUS. CL*63 +00045 CL*59 +00046 SELECT PEND-X145-FILE ASSIGN TO P530X145 CL229 +00047 FILE STATUS IS PAYT-145-STATUS. CL*63 +00048 CL*59 +00049 SELECT WAGE-FILE-TEMP ASSIGN TO P530WAGE CL234 +00050 FILE STATUS IS WAGE-TEMP-STATUS. DTSBX530 +00051 DTSBX530 +00052 SELECT WAGE-FILE-OUT ASSIGN TO P530WOUT CL234 +00053 FILE STATUS IS WAGE-OUT-STATUS. CL*20 +00054 DTSBX530 +00055 SELECT BATCH-XREF-FILE ASSIGN TO P530XREF CL234 +00056 FILE STATUS IS BATCH-XREF-STATUS. DTSBX530 +00057 CL119 +00058 SELECT X530-PAID-FILE ASSIGN TO X530RPT1 CL233 +00059 FILE STATUS IS REPT-STATUS. CL119 +00060 CL119 +00061 SELECT X530-PEND-FILE ASSIGN TO X530RPT2 CL233 +00062 FILE STATUS IS REPT-STATUS. CL119 +00063 CL119 +00064 DTSBX530 +00065 DATA DIVISION. DTSBX530 +00066 DTSBX530 +00067 FILE SECTION. DTSBX530 +00068 DTSBX530 +00069 FD TEMP-BTC-FILE DTSBX530 +00070 RECORDING MODE IS V DTSBX530 +00071 BLOCK CONTAINS 0 RECORDS. DTSBX530 +00072 DTSBX530 +00073 01 TEMP-BTC-REC. DTSBX530 +00074 ++INCLUDE DTSIRVAR DTSBX530 +00075 DTSBX530 +00076 01 TSKL-REC. DTSBX530 +00077 ++INCLUDE DTSITSKL DTSBX530 +00078 DTSBX530 +00079 FD WAGE-FILE-TEMP DTSBX530 +00080 RECORDING MODE IS F DTSBX530 +00081 BLOCK CONTAINS 0 RECORDS DTSBX530 +00082 LABEL RECORDS ARE OMITTED. DTSBX530 +00083 DTSBX530 +00084 01 WAGE-TEMP-REC PIC X(128). DTSBX530 +00085 DTSBX530 +00086 FD WAGE-FILE-OUT CL*20 +00087 RECORDING MODE IS F CL*20 +00088 BLOCK CONTAINS 0 RECORDS CL*20 +00089 LABEL RECORDS ARE OMITTED. CL*20 +00090 DTSBX530 +00091 01 WAGE-OUT-REC PIC X(80). CL*20 +00092 DTSBX530 +00093 FD BATCH-XREF-FILE DTSBX530 +00094 RECORDING MODE IS F DTSBX530 +00095 BLOCK CONTAINS 0 RECORDS DTSBX530 +00096 LABEL RECORDS ARE OMITTED. DTSBX530 +00097 DTSBX530 +00098 01 BATCH-XREF-REC PIC X(30). DTSBX530 +00099 CL*11 +00100 CL*59 +00101 FD PEND-X140-FILE CL*59 +00102 RECORDING MODE IS F CL*59 +00103 BLOCK CONTAINS 0 RECORDS CL*59 +00104 LABEL RECORDS ARE OMITTED. CL*59 +00105 CL*59 +00106 01 PEND-X140-REC PIC X(512). CL*59 +00107 DTSBX530 +00108 FD PEND-X144-FILE CL*59 +00109 RECORDING MODE IS F CL*59 +00110 BLOCK CONTAINS 0 RECORDS CL*59 +00111 LABEL RECORDS ARE OMITTED. CL*59 +00112 CL*59 +00113 01 PEND-X144-REC PIC X(512). CL*59 +00114 CL*59 +00115 FD PEND-X145-FILE CL*59 +00116 RECORDING MODE IS F CL*59 +00117 BLOCK CONTAINS 0 RECORDS CL*59 +00118 LABEL RECORDS ARE OMITTED. CL*59 +00119 CL*59 +00120 01 PEND-X145-REC PIC X(512). CL*59 +00121 CL119 +00122 FD X530-PAID-FILE CL233 +00123 RECORDING MODE IS F CL119 +00124 BLOCK CONTAINS 0 RECORDS CL119 +00125 LABEL RECORDS ARE OMITTED. CL119 +00126 CL119 +00127 01 REPT-PAID-REC PIC X(133). CL121 +00128 CL119 +00129 CL119 +00130 FD X530-PEND-FILE CL233 +00131 RECORDING MODE IS F CL119 +00132 BLOCK CONTAINS 0 RECORDS CL119 +00133 LABEL RECORDS ARE OMITTED. CL119 +00134 CL119 +00135 01 REPT-PEND-REC PIC X(133). CL119 +00136 CL119 +00137 CL*59 +00138 WORKING-STORAGE SECTION. DTSBX530 +001385 77 PAN-VALET PICTURE X(24) VALUE '252DTSBX530 07/15/19'. DTSBX530 +00139 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX422 10/07/14'. DTSBX530 +00140 77 PAN-VALET PICTURE X(24) VALUE '047DTSBX422 09/27/14'. DTSBX530 +00141 SKIP3 DTSBX530 +00142 01 WRK-AREA. DTSBX530 +00143 05 W-ABEND-CD PIC S9(04) COMP VALUE 430. CL*47 +00144 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX530'. CL184 +00145 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL121 +00146 CL121 +00147 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL121 +00148 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL121 +00149 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL121 +00150 CL133 +00151 05 WSP-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL133 +00152 05 WSP-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL133 +00153 05 WSP-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL133 +00154 CL121 +00155 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSBX530 +00156 88 W-PREV-REC-NULL-88 VALUE 'XXX'. CL*87 +00157 88 W-PREV-RPT-NULL-88 VALUE 'XXX'. CL*87 +00158 88 W-PREV-REC-PRF-88 VALUE '102'. DTSBX530 +00159 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSBX530 +00160 88 W-PREV-REC-NAME-88 VALUE '106'. DTSBX530 +00161 88 W-PREV-REC-RATE-88 VALUE '108'. DTSBX530 +00162 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSBX530 +00163 88 W-PREV-REC-OPO-88 VALUE '120'. DTSBX530 +00164 88 W-PREV-REC-REL-88 VALUE '130'. DTSBX530 +00165 88 W-PREV-REC-IND-88 VALUE '132'. DTSBX530 +00166 88 W-PREV-REC-RPT-88 VALUE '140'. DTSBX530 +00167 88 W-PREV-RPT-RPT-88 VALUE '140'. CL*86 +00168 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSBX530 +00169 88 W-PREV-RPT-WAGE-88 VALUE '144'. CL*86 +00170 88 W-PREV-REC-PAY-88 VALUE '145'. DTSBX530 +00171 88 W-PREV-RPT-PAY-88 VALUE '145'. CL*86 +00172 88 W-PREV-REC-BHDR-88 VALUE '149'. DTSBX530 +00173 DTSBX530 +00174 05 TEMP-BTC-STATUS PIC X(02). DTSBX530 +00175 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBX530 +00176 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBX530 +00177 DTSBX530 +00178 05 WAGE-TEMP-STATUS PIC X(02). DTSBX530 +00179 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX530 +00180 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX530 +00181 DTSBX530 +00182 05 WAGE-OUT-STATUS PIC X(02). DTSBX530 +00183 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX530 +00184 DTSBX530 +00185 05 BATCH-XREF-STATUS PIC X(02). DTSBX530 +00186 88 BATCH-XREF-OK-88 VALUE '00'. DTSBX530 +00187 DTSBX530 +00188 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBX530 +00189 CL*12 +00190 05 WAGE-TRANS-STATUS PIC X(02). CL*12 +00191 88 WAGE-TRANS-FILE-OK-88 VALUE '00' '97'. CL*12 +00192 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. CL*12 +00193 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. CL*12 +00194 CL*12 +00195 05 REPT-140-STATUS PIC X(02). CL*63 +00196 88 REPT-140-OK-88 VALUE '00' '97'. CL*63 +00197 88 REPT-140--NO-REC-88 VALUE '10' '23'. CL*63 +00198 CL*61 +00199 05 WAGE-144-STATUS PIC X(02). CL*63 +00200 88 WAGE-144-OK-88 VALUE '00' '97'. CL*63 +00201 88 WAGE-144--NO-REC-88 VALUE '10' '23'. CL*63 +00202 CL*61 +00203 05 PAYT-145-STATUS PIC X(02). CL*63 +00204 88 PAYT-145-OK-88 VALUE '00' '97'. CL*64 +00205 88 PAYT-145-NO-REC-88 VALUE '10' '23'. CL*64 +00206 DTSBX530 +00207 CL119 +00208 05 REPT-STATUS PIC X(02). CL119 +00209 88 REPT-STATUS-OK-88 VALUE '00'. CL119 +00210 88 REPT-STATUS-EOF-88 VALUE '10'. CL119 +00211 CL119 +00212 05 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL*80 +00213 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL*81 +00214 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL*81 +00215 DTSBX530 +00216 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX530 +00217 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX530 +00218 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX530 +00219 DTSBX530 +00220 05 W-X145-PAYMENT-FOUND-IND PIC X(01) VALUE 'N'. CL*54 +00221 88 W-X145-PAYMENT-YES-88 VALUE 'Y'. CL*54 +00222 88 W-X145-PAYMENT-NO-88 VALUE 'N'. CL*54 +00223 CL*54 +00224 05 W-X145-PAYMENT-DUPLIC-IND PIC X(01) VALUE 'N'. CL170 +00225 88 X145-PAYMENT-DUP-YES-88 VALUE 'Y'. CL170 +00226 88 X145-PAYMENT-DUP-NO-88 VALUE 'N'. CL170 +00227 CL170 +00228 05 W-WRITE-T025-TRAN PIC X(01) VALUE 'N'. CL*73 +00229 88 W-WRITE-T025-TRAN-YES-88 VALUE 'Y'. CL*73 +00230 88 W-WRITE-T025-TRAN-NO-88 VALUE 'N'. CL*73 +00231 CL*73 +00232 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBX530 +00233 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBX530 +00234 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBX530 +00235 DTSBX530 +00236 05 W-RPT-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX530 +00237 88 W-RPT-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX530 +00238 88 W-RPT-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX530 +00239 DTSBX530 +00240 05 W-WAGE-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSBX530 +00241 88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'. DTSBX530 +00242 88 W-WAGE-IN-PROGRESS-NO-88 VALUE 'N'. DTSBX530 +00243 DTSBX530 +00244 05 W-ARPT-MAX PIC S9(04) COMP VALUE +100. DTSBX530 +00245 05 W-ARPT-LAST PIC S9(04) COMP VALUE +0. DTSBX530 +00246 05 RSUB PIC S9(04) COMP VALUE +0. DTSBX530 +00247 05 W-ARPT-TABLE. DTSBX530 +00248 10 W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128). DTSBX530 +00249 DTSBX530 +00250 05 W-EMP-NO PIC S9(07) COMP-3. DTSBX530 +00251 05 W-PAY-QTR PIC X(06) VALUE SPACES. CL166 +00252 05 W-X140-DUP PIC S9(03) COMP-3 VALUE +0. CL*41 +00253 05 W-TRAN-CNT PIC S9(03) COMP-3 VALUE +0. CL*41 +00254 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSBX530 +00255 05 W-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. CL*73 +00256 05 W-CURR-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX530 +00257 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX530 +00258 05 WRK-CURR-DATE PIC 9(08) VALUE 0. CL250 +00259 05 W-WAIVER-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX530 +00260 05 W-CURENT-QTR PIC X(06) VALUE SPACES. CL245 +00261 05 W-X140-REPORT-QTR PIC S9(05) COMP-3. CL*54 +00262 05 W-X145-PAYMENT-QTR PIC S9(05) COMP-3. CL*54 +00263 05 W-X144-WAGE-QTR PIC S9(05) COMP-3. CL*54 +00264 05 WRK-REPORT-QTR PIC 9(05). DTSBX530 +00265 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. CL158 +00266 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. CL157 +00267 10 W-X145-TRACE-NO-A PIC 9(08). CL158 +00268 10 W-X145-TRACE-NO-B PIC 9(05). CL158 +00269 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX530 +00270 05 W-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00271 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX530 +00272 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. CL123 +00273 05 WS-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00274 05 W-X140-REMITTANCE PIC S9(09)V99 VALUE +0. CL149 +00275 05 W-X145-REMITTANCE PIC S9(09)V99 VALUE +0. CL123 +00276 05 W-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00277 05 W-A145-TOT-AMT PIC S9(09)V99 VALUE +0. CL219 +00278 05 W-C145-TOT-AMT PIC S9(09)V99 VALUE +0. CL219 +00279 05 W-S145-TOT-AMT PIC S9(09)V99 VALUE +0. CL219 +00280 05 W-OTOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL212 +00281 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. CL123 +00282 05 W-X145-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00283 05 W-X140-RECEIVED-DATE PIC S9(09) COMP-3. CL*72 +00284 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSBX530 +00285 05 W-X145-DEPOSIT-DATE PIC S9(09) COMP-3. CL*72 +00286 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSBX530 +00287 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBX530 +00288 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBX530 +00289 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBX530 +00290 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSBX530 +00291 05 W-SSN PIC S9(09) COMP-3. DTSBX530 +00292 05 W-EARNINGS-X PIC X(12). DTSBX530 +00293 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX530 +00294 PIC 9(09).99. DTSBX530 +00295 05 W-EARNINGS PIC S9(09)V99. DTSBX530 +00296 CL180 +00297 05 WS-Z145-DUP-REC PIC X(50) VALUE SPACES. CL181 +00298 05 W-WORKER-NAME. DTSBX530 +00299 10 W-WRKR-FIRST-NAME PIC X(15). DTSBX530 +00300 10 W-WRKR-MID-INIT PIC X(01). DTSBX530 +00301 10 W-WRKR-LAST-NAME PIC X(20). DTSBX530 +00302 DTSBX530 +00303 05 W-RPT-TYPE PIC X(02). DTSBX530 +00304 88 W-ORIG-88 VALUE 'OR'. DTSBX530 +00305 88 W-EMP-AMEND-88 VALUE 'EA'. DTSBX530 +00306 88 W-AUDIT-88 VALUE 'AU'. DTSBX530 +00307 88 W-FLD-SUP-88 VALUE 'FS'. DTSBX530 +00308 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSBX530 +00309 88 W-ESTIM-88 VALUE 'ES'. DTSBX530 +00310 88 W-WITHDRW-88 VALUE 'WD'. DTSBX530 +00311 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSBX530 +00312 'FS' 'AC'. DTSBX530 +00313 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSBX530 +00314 'FS' 'AC' 'ES'. CL*55 +00315 05 WS-HOLD-X145-REC PIC X(512) VALUE SPACES. CL170 +00316 CL*55 +00317 05 W-PAY-TYPE PIC X(02). CL200 +00318 88 W-PAY-ACH-88 VALUE '00'. CL200 +00319 88 W-PAY-CHK-88 VALUE '01'. CL200 +00320 88 W-PAY-SCK-88 VALUE '02'. CL200 +00321 88 W-PAY-OTH-88 VALUE '03'. CL200 +00322 88 W-VALID-PAY-88 VALUE '00' '01' '02' '03'. CL241 +00323 88 W-VALID-EPAY-88 VALUE '00' '02'. CL241 +00324 DTSBX530 +00325 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX530 +00326 05 W-TRACE-NO. CL206 +00327 10 W-TRACE-NOA PIC X(7). CL206 +00328 10 W-TRACE-NOB PIC X(6). CL206 +00329 DTSBX530 +00330 05 W-MNTE-SUBJECT PIC X(40). DTSBX530 +00331 88 W-MNTE-NOT-LIAB-88 VALUE DTSBX530 +00332 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBX530 +00333 88 W-MNTE-KEY-WORD-88 VALUE DTSBX530 +00334 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBX530 +00335 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBX530 +00336 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBX530 +00337 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBX530 +00338 'WEB REGISTRATION RELATED EMPLOYER '. DTSBX530 +00339 DTSBX530 +00340 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX530 +00341 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX530 +00342 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX530 +00343 DTSBX530 +00344 05 TSUB1 PIC S9(04) COMP. DTSBX530 +00345 05 TSUB2 PIC S9(04) COMP. DTSBX530 +00346 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX530 +00347 DTSBX530 +00348 05 W-MNTE-LINE PIC X(72). DTSBX530 +00349 DTSBX530 +00350 05 W-SLASH-DATE PIC X(10). DTSBX530 +00351 05 FILLER REDEFINES W-SLASH-DATE. DTSBX530 +00352 10 W-SLASH-DT-MM PIC X(02). DTSBX530 +00353 10 FILLER PIC X(01). DTSBX530 +00354 10 W-SLASH-DT-DD PIC X(02). DTSBX530 +00355 10 FILLER PIC X(01). DTSBX530 +00356 10 W-SLASH-DT-CCYY PIC X(04). DTSBX530 +00357 DTSBX530 +00358 05 W-SLASH-QTR PIC X(06). DTSBX530 +00359 05 FILLER REDEFINES W-SLASH-QTR. DTSBX530 +00360 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX530 +00361 10 FILLER PIC X(01). DTSBX530 +00362 10 W-SLASH-QTR-Q PIC X(01). DTSBX530 +00363 DTSBX530 +00364 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00365 * BATCH HEADER DTSBX530 +00366 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00367 * REPORT DTSBX530 +00368 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00369 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00370 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00371 05 W-X140-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00372 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00373 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00374 * EMPLOYEE WAGES DTSBX530 +00375 05 W-X144-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00376 05 W-X144-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00377 05 W-X144-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00378 05 W-X144-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00379 05 W-X144-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00380 05 W-X144-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00381 DTSBX530 +00382 * EMPLOYER PAYMENT CL*54 +00383 05 W-X145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00384 05 W-X145-DUP-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00385 05 W-X145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL*54 +00386 05 W-X145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL*94 +00387 05 W-X145-PRO-CNT PIC S9(07) COMP-3 VALUE +0. CL*95 +00388 05 W-X145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL*55 +00389 * EMPLOYER PAYMENT-TOTALS CL220 +00390 05 WS-A145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL220 +00391 05 WS-C145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL220 +00392 05 WS-S145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL220 +00393 * EMPLOYER PAYMENT-ACH CL217 +00394 05 W-A145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00395 05 W-A145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00396 05 W-A145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00397 05 W-A145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00398 * EMPLOYER PAYMENT-CHECK CL217 +00399 05 W-C145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00400 05 W-C145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00401 05 W-C145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00402 05 W-C145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00403 * EMPLOYER PAYMENT-SUPER CHECK CL217 +00404 05 W-S145-RED-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00405 05 W-S145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00406 05 W-S145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00407 05 W-S145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. CL217 +00408 * EMPLOYEE W4 COUNT CL*13 +00409 05 W-W4-CNT PIC S9(07) COMP-3 VALUE +0. CL*13 +00410 CL*13 +00411 ** 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00412 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00413 05 W-T028-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00414 05 W-T028-WRITEE-CNT PIC S9(07) COMP-3 VALUE +0. CL102 +00415 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00416 05 W-T025-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL100 +00417 05 W-X145-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. CL189 +00418 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00419 05 W-ARPT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00420 05 W-BX214-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00421 DTSBX530 +00422 05 W-X140-LENGTH PIC S9(04) COMP. DTSBX530 +00423 05 W-X144-LENGTH PIC S9(04) COMP. DTSBX530 +00424 05 W-X145-LENGTH PIC S9(04) COMP. CL*54 +00425 DTSBX530 +00426 05 W-AMT-DISP1 PIC ----------9.99. DTSBX530 +00427 05 W-AMT-DISP2 PIC ----------9.99. DTSBX530 +00428 *RW1 DTSBX530 +00429 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX530 +00430 05 DISPLAY-CNT PIC Z(06)9. DTSBX530 +00431 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBX530 +00432 *RW2 DTSBX530 +00433 DTSBX530 +00434 01 MESSAGE-AREA. DTSBX530 +00435 *** FATAL ERRORS MSG-A DTSBX530 +00436 05 MSG-A1. DTSBX530 +00437 10 FILLER PIC X(32) DTSBX530 +00438 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBX530 +00439 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBX530 +00440 01 HEADER-1. CL119 +00441 05 FILLER PIC X(01) VALUE SPACES. CL119 +00442 05 FILLER PIC X(49) VALUE '140R1'. CL119 +00443 05 FILLER PIC X(60) VALUE CL119 +00444 'DISTRICT OF COLUMBIA'. CL119 +00445 05 FILLER PIC X(06) VALUE 'DATE:'. CL119 +00446 05 HDR1-LRCM-SYS-DATE PIC X(10). CL251 +00447 01 HEADER-2. CL119 +00448 05 FILLER PIC X(54) VALUE SPACES. CL119 +00449 05 FILLER PIC X(56) VALUE CL119 +00450 'TAX DIVISION'. CL119 +00451 05 FILLER PIC X(06) VALUE 'TIME:'. CL119 +00452 05 HDR2-LRCM-SYS-TIME PIC X(08). CL119 +00453 CL119 +00454 01 HEADER-3. CL119 +00455 05 FILLER PIC X(01) VALUE SPACES. CL119 +00456 05 FILLER PIC X(38) VALUE CL119 +00457 'ROUTE TO: TAX ACCOUNTING STAFF'. CL119 +00458 05 HDR3-LITERAL PIC X(43) VALUE CL119 +00459 ' DAILY TOTAL PAYMENTS RECEIVED REPORT '. CL222 +00460 05 FILLER PIC X(28) VALUE SPACES. CL119 +00461 05 FILLER PIC X(06) VALUE 'PAGE:'. CL119 +00462 05 HDR3-PAGE PIC ZZ,ZZ9. CL119 +00463 CL119 +00464 01 HEADER-31. CL131 +00465 05 FILLER PIC X(01) VALUE SPACES. CL131 +00466 05 FILLER PIC X(38) VALUE CL131 +00467 'ROUTE TO: TAX ACCOUNTING STAFF'. CL131 +00468 05 HDR3-LITERAL PIC X(43) VALUE CL131 +00469 ' ESSP-TDEC DAILY PAYMENTS REPORT '. CL188 +00470 05 FILLER PIC X(28) VALUE SPACES. CL131 +00471 05 FILLER PIC X(06) VALUE 'PAGE:'. CL131 +00472 05 HDR31-PAGE PIC ZZ,ZZ9. CL131 +00473 CL131 +00474 01 HEADER-4. CL119 +00475 05 FILLER PIC X(01) VALUE SPACES. CL119 +00476 05 FILLER PIC X(132) VALUE SPACES. CL119 +00477 01 HEADER-42. CL144 +00478 05 FILLER PIC X(02) VALUE SPACES. CL144 +00479 05 FILLER PIC X(34) VALUE CL144 +00480 ' '. CL144 +00481 05 FILLER PIC X(02) VALUE SPACES. CL144 +00482 05 FILLER PIC X(25) VALUE CL144 +00483 ' '. CL144 +00484 05 FILLER PIC X(03) VALUE SPACES. CL144 +00485 05 FILLER PIC X(43) VALUE CL153 +00486 ' '. CL195 +00487 05 FILLER PIC X(30) VALUE CL152 +00488 ' '. CL195 +00489 CL119 +00490 01 HEADER-5. CL119 +00491 05 FILLER PIC X(02) VALUE SPACES. CL126 +00492 05 FILLER PIC X(34) VALUE CL119 +00493 'EMP NO NAME QTR '. CL202 +00494 05 FILLER PIC X(02) VALUE SPACES. CL126 +00495 05 FILLER PIC X(36) VALUE CL209 +00496 ' PAID AMT PAY-ID PAY-TYPE '. CL210 +00497 05 FILLER PIC X(01) VALUE SPACES. CL210 +00498 05 FILLER PIC X(11) VALUE CL210 +00499 'RECV-DATE '. CL210 +00500 05 FILLER PIC X(01) VALUE SPACES. CL210 +00501 05 HDR5-NAME PIC X(28) VALUE CL138 +00502 ' '. CL195 +00503 CL119 +00504 01 HEADER-6. CL119 +00505 05 FILLER PIC X(01) VALUE SPACES. CL119 +00506 05 FILLER PIC X(132) VALUE SPACES. CL119 +00507 01 DETAIL-LINE-1. CL119 +00508 15 FILLER PIC X(02) VALUE SPACES. CL119 +00509 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL119 +00510 15 FILLER PIC X(02) VALUE SPACES. CL119 +00511 15 X434-NAME-CHECK PIC X(04) VALUE SPACES. CL119 +00512 15 FILLER PIC X(02) VALUE SPACES. CL119 +00513 15 X434-QTR PIC X(06). CL119 +00514 15 FILLER PIC X(02) VALUE SPACES. CL119 +00515 15 X434-RCVD-DATE PIC X(10). CL119 +00516 15 FILLER PIC X(01) VALUE SPACES. CL119 +00517 15 X434-TOT-WAGE PIC --------9.99. CL119 +00518 15 FILLER PIC X(01) VALUE SPACES. CL119 +00519 15 X434-EXC-WAGE PIC --------9.99. CL119 +00520 15 FILLER PIC X(01) VALUE SPACES. CL119 +00521 15 X434-TAX-WAGE PIC --------9.99. CL119 +00522 15 FILLER PIC X(01) VALUE SPACES. CL119 +00523 15 X434-X140-REMIT PIC --------9.99. CL119 +00524 15 FILLER PIC X(01) VALUE SPACES. CL119 +00525 15 X434-X145-REMIT PIC --------9.99. CL119 +00526 15 FILLER PIC X(01) VALUE SPACES. CL148 +00527 15 X434-DIFF PIC ----9.99. CL148 +00528 * 15 X434-MESSAGE PIC X(20). CL125 +00529 15 X434-M1-CNT PIC ZZZZZZ9. CL129 +00530 15 X434-M2-CNT PIC ZZZZZZ9. CL129 +00531 15 X434-M3-CNT PIC ZZZZZZ9. CL129 +00532 CL119 +00533 01 DETAIL-PEND-1. CL131 +00534 15 FILLER PIC X(02) VALUE SPACES. CL131 +00535 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL131 +00536 15 FILLER PIC X(02) VALUE SPACES. CL131 +00537 15 P434-NAME-CHECK PIC X(15) VALUE SPACES. CL190 +00538 15 FILLER PIC X(02) VALUE SPACES. CL131 +00539 15 P434-QTR PIC X(06). CL131 +00540 15 FILLER PIC X(02) VALUE SPACES. CL131 +00541 15 P434-X145-REMIT PIC --------9.99. CL190 +00542 15 FILLER PIC X(05) VALUE SPACES. CL206 +00543 15 P434-TRACE-NO PIC X(06). CL207 +00544 15 FILLER PIC X(05) VALUE SPACES. CL206 +00545 15 P434-X145-TYPE PIC X(09). CL207 +00546 15 FILLER PIC X(02) VALUE SPACES. CL199 +00547 15 P434-RCVD-DATE PIC X(10). CL131 +00548 15 FILLER PIC X(03) VALUE SPACES. CL196 +00549 15 P434-MESSAGE PIC X(30). CL136 +00550 CL131 +00551 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL119 +00552 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL119 +00553 CL119 +00554 01 FOOTING-LINE-3. CL119 +00555 05 FILLER PIC X(25) VALUE SPACES. CL119 +00556 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL119 +00557 05 FILLER PIC X(02) VALUE SPACES. CL119 +00558 05 FILLER PIC X(34) VALUE CL119 +00559 'TOTAL DAILY PAYMENT RECEIVED'. CL195 +00560 05 FILLER PIC X(32) VALUE CL221 +00561 ' '. CL222 +00562 CL119 +00563 01 FOOTING-LINE-4. CL153 +00564 05 FILLER PIC X(25) VALUE SPACES. CL119 +00565 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL119 +00566 05 FILLER PIC X(02) VALUE SPACES. CL119 +00567 05 FILLER PIC X(34) VALUE CL119 +00568 ' # OF PAYMENTS HAD ERRORS '. CL119 +00569 05 FILLER PIC X(32) VALUE SPACES. CL119 +00570 CL119 +00571 01 FOOTING-LINE-5. CL153 +00572 05 FILLER PIC X(25) VALUE SPACES. CL119 +00573 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL119 +00574 05 FILLER PIC X(02) VALUE SPACES. CL119 +00575 05 FILLER PIC X(40) VALUE CL130 +00576 ' # OF PAYMENTS WENT TO PENDING STATUS'. CL130 +00577 05 FILLER PIC X(32) VALUE SPACES. CL119 +00578 01 FOOTING-LINE-6. CL153 +00579 05 FILLER PIC X(25) VALUE SPACES. CL130 +00580 05 WS-A145-RED-CNT PIC ZZ,ZZ9. CL214 +00581 05 FILLER PIC X(02) VALUE SPACES. CL130 +00582 05 FILLER PIC X(34) VALUE CL130 +00583 'TOTAL ACH PAYMENT RECV FROM ESSP '. CL211 +00584 05 FILLER PIC X(32) VALUE SPACES. CL130 +00585 01 FOOTING-LINE-7. CL153 +00586 05 FILLER PIC X(25) VALUE SPACES. CL130 +00587 05 WS-A145-ERR-CNT PIC ZZ,ZZ9. CL214 +00588 05 FILLER PIC X(02) VALUE SPACES. CL130 +00589 05 FILLER PIC X(34) VALUE CL130 +00590 ' # OF ACH PAYMENTS HAD ERRORS '. CL211 +00591 05 FILLER PIC X(32) VALUE SPACES. CL130 +00592 CL130 +00593 01 FOOTING-LINE-8. CL153 +00594 05 FILLER PIC X(19) VALUE SPACES. CL214 +00595 05 WS-A145-TOT-AMT PIC $$$$$$$$9.99. CL219 +00596 05 FILLER PIC X(02) VALUE SPACES. CL130 +00597 05 FILLER PIC X(40) VALUE CL130 +00598 ' $AMT ACH PAYMENTS SENT TO DUTAS '. CL224 +00599 05 FILLER PIC X(32) VALUE SPACES. CL130 +00600 CL119 +00601 01 FOOTING-LINE-9. CL153 +00602 05 FILLER PIC X(24) VALUE SPACES. CL153 +00603 05 WS-C145-RED-CNT PIC ZZZ,ZZ9. CL213 +00604 05 FILLER PIC X(02) VALUE SPACES. CL153 +00605 05 FILLER PIC X(36) VALUE CL211 +00606 'TOTAL CHECK PAYMENTS RECV FROM TDEC'. CL211 +00607 05 FILLER PIC X(32) VALUE SPACES. CL153 +00608 01 FOOTING-LINE-10. CL153 +00609 05 FILLER PIC X(24) VALUE SPACES. CL153 +00610 05 WS-C145-ERR-CNT PIC ZZZ,ZZ9. CL213 +00611 05 FILLER PIC X(02) VALUE SPACES. CL153 +00612 05 FILLER PIC X(34) VALUE CL153 +00613 ' # OF CHECK PAYMTS HAD ERRORS '. CL211 +00614 05 FILLER PIC X(32) VALUE SPACES. CL153 +00615 CL153 +00616 01 FOOTING-LINE-11. CL153 +00617 05 FILLER PIC X(19) VALUE SPACES. CL214 +00618 05 WS-C145-TOT-AMT PIC $$$$$$$$9.99. CL220 +00619 05 FILLER PIC X(02) VALUE SPACES. CL153 +00620 05 FILLER PIC X(40) VALUE CL153 +00621 ' $AMT CHECK PAYMENTS SENT TO DUTAS '. CL224 +00622 05 FILLER PIC X(32) VALUE SPACES. CL218 +00623 01 FOOTING-LINE-12. CL218 +00624 05 FILLER PIC X(24) VALUE SPACES. CL218 +00625 05 WS-S145-RED-CNT PIC ZZZ,ZZ9. CL218 +00626 05 FILLER PIC X(02) VALUE SPACES. CL218 +00627 05 FILLER PIC X(36) VALUE CL218 +00628 'TOTAL SUPER CHECK PAYMENTS RECEIVED'. CL218 +00629 05 FILLER PIC X(32) VALUE SPACES. CL218 +00630 01 FOOTING-LINE-13. CL218 +00631 05 FILLER PIC X(24) VALUE SPACES. CL218 +00632 05 WS-S145-ERR-CNT PIC ZZZ,ZZ9. CL218 +00633 05 FILLER PIC X(02) VALUE SPACES. CL218 +00634 05 FILLER PIC X(34) VALUE CL218 +00635 ' # OF S-CHECK PAYMTS HAD ERRORS'. CL219 +00636 05 FILLER PIC X(32) VALUE SPACES. CL218 +00637 CL218 +00638 01 FOOTING-LINE-14. CL218 +00639 05 FILLER PIC X(19) VALUE SPACES. CL218 +00640 05 WS-S145-TOT-AMT PIC $$$$$$$$9.99. CL219 +00641 05 FILLER PIC X(02) VALUE SPACES. CL218 +00642 05 FILLER PIC X(41) VALUE CL219 +00643 ' $AMT S-CHECK PAYMENTS SENT TO DUTAS'. CL222 +00644 05 FILLER PIC X(32) VALUE SPACES. CL218 +00645 01 FOOTING-LINE-14-2. CL224 +00646 05 FILLER PIC X(23) VALUE SPACES. CL224 +00647 05 FILLER PIC X(70) VALUE CL224 +00648 '----------------------------------------------'. CL224 +00649 05 FILLER PIC X(32) VALUE SPACES. CL224 +00650 01 FOOTING-LINE-15. CL218 +00651 05 FILLER PIC X(19) VALUE SPACES. CL119 +00652 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL119 +00653 05 FILLER PIC X(02) VALUE SPACES. CL119 +00654 05 FILLER PIC X(36) VALUE CL119 +00655 ' TOTAL REMIT AMOUNT --SENT- TO DUTAS'. CL214 +00656 05 FILLER PIC X(32) VALUE SPACES. CL119 +00657 CL119 +00658 01 FOOTING-LINE-16. CL218 +00659 05 FILLER PIC X(23) VALUE SPACES. CL224 +00660 05 FILLER PIC X(70) VALUE CL224 +00661 '******** END DAILY PAYMENT PROCESSING ********'. CL223 +00662 01 FOOTING-LINE-17 PIC X(133) VALUE SPACES. CL223 +00663 DTSBX530 +00664 01 T003-REC. DTSBX530 +00665 ++INCLUDE DTSIT003 DTSBX530 +00666 DTSBX530 +00667 01 T025-REC. DTSBX530 +00668 ++INCLUDE DTSIT025 DTSBX530 +00669 DTSBX530 +00670 *01 T027-REC. DTSBX530 +00671 *++INCLUDE DTSIT027 DTSBX530 +00672 DTSBX530 +00673 01 T028-REC. DTSBX530 +00674 ++INCLUDE DTSIT028 DTSBX530 +00675 DTSBX530 +00676 CL*11 +00677 01 W001-REC. DTSBX530 +00678 ++INCLUDE DTSIW001 DTSBX530 +00679 CL*11 +00680 01 WAGE-TRANS-AREA. CL*11 +00681 05 ESP-TRANSACTION-AREA PIC X(80). CL*11 +00682 ++INCLUDE EWGTRNW4 CL*11 +00683 CL*11 +00684 DTSBX530 +00685 * ACCOUNTING BATCH HEADER DTSBX530 +00686 01 X149-REC. DTSBX530 +00687 ++INCLUDE DTSIX149 DTSBX530 +00688 DTSBX530 +00689 * REPORT DTSBX530 +00690 01 X140-REC. DTSBX530 +00691 ++INCLUDE DTSIX140 DTSBX530 +00692 DTSBX530 +00693 * EMPLOYEE WAGES DTSBX530 +00694 01 X144-REC. DTSBX530 +00695 ++INCLUDE DTSIX144 DTSBX530 +00696 DTSBX530 +00697 * PAYMENTS CL*47 +00698 01 X145-REC. CL*47 +00699 ++INCLUDE DTSIX145 CL*47 +00700 CL*47 +00701 * BATCH - PSEUDO-BATCH XREF DTSBX530 +00702 01 X214-REC. DTSBX530 +00703 ++INCLUDE DTSIX214 DTSBX530 +00704 DTSBX530 +00705 * ERRORS DTSBX530 +00706 *01 X907-REC. DTSBX530 +00707 ***INCLUDE DTSIX907 DTSBX530 +00708 DTSBX530 +00709 01 L001-LINK-AREA. DTSBX530 +00710 ++INCLUDE DTSIL001 DTSBX530 +00711 DTSBX530 +00712 01 L003-LINK-AREA. DTSBX530 +00713 ++INCLUDE DTSIL003 DTSBX530 +00714 DTSBX530 +00715 01 L004-LINK-AREA. DTSBX530 +00716 ++INCLUDE DTSIL004 DTSBX530 +00717 DTSBX530 +00718 01 L516-LINK-AREA. DTSBX530 +00719 ++INCLUDE DTSIL516 DTSBX530 +00720 DTSBX530 +00721 01 L910-LINK-AREA. DTSBX530 +00722 ++INCLUDE DTSIL910 DTSBX530 +00723 01 MSKL-REC. DTSBX530 +00724 ++INCLUDE DTSIMSKL DTSBX530 +00725 DTSBX530 +00726 01 MHDR-REC. DTSBX530 +00727 ++INCLUDE DTSIMHDR DTSBX530 +00728 DTSBX530 +00729 01 MPRF-REC. DTSBX530 +00730 ++INCLUDE DTSIMPRF DTSBX530 +00731 DTSBX530 +00732 01 MSOL-REC. DTSBX530 +00733 ++INCLUDE DTSIMSOL DTSBX530 +00734 DTSBX530 +00735 01 MQTR-REC. DTSBX530 +00736 ++INCLUDE DTSIMQTR DTSBX530 +00737 DTSBX530 +00738 01 MRPT-REC. CL178 +00739 ++INCLUDE DTSIMRPT CL178 +00740 CL178 +00741 01 MOPO-REC. DTSBX530 +00742 ++INCLUDE DTSIMOPO DTSBX530 +00743 DTSBX530 +00744 01 MTAD-REC. DTSBX530 +00745 ++INCLUDE DTSIMTAD DTSBX530 +00746 DTSBX530 +00747 01 MNTE-REC. DTSBX530 +00748 ++INCLUDE DTSIMNTE DTSBX530 +00749 DTSBX530 +00750 01 L921-LINK-AREA. DTSBX530 +00751 ++INCLUDE DTSIL921 DTSBX530 +00752 SKIP3 DTSBX530 +00753 01 ISKL-REC. DTSBX530 +00754 ++INCLUDE DTSIISKL DTSBX530 +00755 SKIP3 DTSBX530 +00756 01 IEIN-REC. DTSBX530 +00757 ++INCLUDE DTSIIEIN DTSBX530 +00758 DTSBX530 +00759 01 L923-LINK-AREA. DTSBX530 +00760 ++INCLUDE DTSIL923 DTSBX530 +00761 EJECT DTSBX530 +00762 01 ASKL-REC. DTSBX530 +00763 ++INCLUDE DTSIASKL DTSBX530 +00764 EJECT DTSBX530 +00765 01 AHDR-REC. DTSBX530 +00766 ++INCLUDE DTSIAHDR DTSBX530 +00767 EJECT DTSBX530 +00768 01 ARPT-REC. DTSBX530 +00769 ++INCLUDE DTSIARPT DTSBX530 +00770 EJECT DTSBX530 +00771 01 APAY-REC. DTSBX530 +00772 ++INCLUDE DTSIAPAY DTSBX530 +00773 DTSBX530 +00774 01 L927-LINK-AREA. DTSBX530 +00775 ++INCLUDE DTSIL927 DTSBX530 +00776 DTSBX530 +00777 01 L931-LINK-AREA. DTSBX530 +00778 ++INCLUDE DTSIL931 DTSBX530 +00779 DTSBX530 +00780 01 FSKL-REC. DTSBX530 +00781 ++INCLUDE DTSIFSKL DTSBX530 +00782 DTSBX530 +00783 01 R140-REC. DTSBX530 +00784 ++INCLUDE DTSIR140 DTSBX530 +00785 DTSBX530 +00786 LINKAGE DTSBX530 +00787 SECTION. DTSBX530 +00788 DTSBX530 +00789 01 LX42-LINK-AREA. DTSBX530 +00790 ++INCLUDE DTSILX42 CL112 +00791 DTSBX530 +00792 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSBX530 +00793 DTSBX530 +00794 DTSBX430-MAIN. CL*47 +00795 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA CL*80 +00796 MOVE LX42-RPT-ERROR-IND TO W-RPT-ERROR-IND. CL*80 +00797 CL*80 +00798 IF W-RPT-ERROR-YES-88 CL*80 +00799 DISPLAY 'BX430 LX42 EMP REC HAS ERROR ' LX42-EMP-NO CL*80 +00800 ' ' LX42-RPT-ERROR-IND ' ' W-RPT-ERROR-IND CL*80 +00801 ELSE CL*80 +00802 DISPLAY 'BX430 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND CL*81 +00803 END-IF. CL*80 +00804 EVALUATE TRUE DTSBX530 +00805 WHEN LX42-INITIALIZE-88 DTSBX530 +00806 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBX530 +00807 DTSBX530 +00808 WHEN LX42-NEW-EMPLOYER-88 DTSBX530 +00809 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX530 +00810 DTSBX530 +00811 WHEN LX42-PROCESS-88 DTSBX530 +00812 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX530 +00813 DTSBX530 +00814 WHEN LX42-TERMINATE-88 DTSBX530 +00815 DISPLAY ' TERMINATE 430' CL*47 +00816 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSBX530 +00817 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX530 +00818 DTSBX530 +00819 END-EVALUATE. DTSBX530 +00820 CL*80 +00821 IF LX42-PROCESS-88 CL*80 +00822 MOVE W-RPT-ERROR-IND TO LX42-RPT-ERROR-IND CL*80 +00823 END-IF. CL*80 +00824 DTSBX530 +00825 DTSBX430-MAIN-EXIT. CL*47 +00826 GOBACK. DTSBX530 +00827 DTSBX530 +00828 I0000-INITIATE. DTSBX530 +00829 SET W-RPT-ERROR-NO-88 TO TRUE. CL*81 +00830 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX530 +00831 SET X145-PAYMENT-DUP-NO-88 TO TRUE. CL171 +00832 DTSBX530 +00833 MOVE LENGTH OF X140-REC TO W-X140-LENGTH. DTSBX530 +00834 MOVE LENGTH OF X144-REC TO W-X144-LENGTH. DTSBX530 +00835 MOVE LENGTH OF X145-REC TO W-X145-LENGTH. CL*47 +00836 DTSBX530 +00837 * FOR VARIABLE REPORT FILE. DTSBX530 +00838 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX530 +00839 MOVE '140' TO R140-REC-TYPE. DTSBX530 +00840 DTSBX530 +00841 MOVE LX42-CURR-RUN-DATE TO L004-DATE. DTSBX530 +00842 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX530 +00843 SUBTRACT +5 FROM L004-ABS-QTR. DTSBX530 +00844 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX530 +00845 MOVE L004-QTR-5-9 TO W-WAIVER-QTR. DTSBX530 +00846 DISPLAY 'BX530 CURR RUN DATE ' LX42-CURR-RUN-DATE. CL184 +00847 DISPLAY 'BX530 WAIVE QTR ' W-WAIVER-QTR. CL184 +00848 DTSBX530 +00849 CL235 +00850 MOVE LX42-CURR-RUN-DATE TO L004-DATE. CL235 +00851 PERFORM S004-FROM-DATE THRU S004-EXIT. CL235 +00852 PERFORM S004-FROM-ABS THRU S004-EXIT. CL235 +00853 MOVE LX42-CURR-QTR TO W-CURENT-QTR. CL240 +00854 DISPLAY 'BX530 CURR RUN DATE ' LX42-CURR-RUN-DATE. CL235 +00855 DISPLAY 'BX530 CURENT QTR ' W-CURENT-QTR. CL235 +00856 CL235 +00857 MOVE LX42-CURR-RUN-DATE TO WRK-CURR-DATE. CL250 +00858 MOVE WRK-CURR-DATE TO L001-DATE-8-AREA. CL250 +00859 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL150 +00860 DISPLAY 'RPT CURR RUN DATE ' L001-SLASH-DATE. CL151 +00861 MOVE L001-SLASH-8-DATE TO HDR1-LRCM-SYS-DATE. CL252 +00862 CL150 +00863 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBX530 +00864 IF W-FATAL-ERROR-YES-88 DTSBX530 +00865 GO TO I0000-EXIT DTSBX530 +00866 END-IF. DTSBX530 +00867 DTSBX530 +00868 MOVE +0 TO W-ARPT-LAST. DTSBX530 +00869 PERFORM DTSBX530 +00870 VARYING RSUB FROM +1 BY +1 DTSBX530 +00871 UNTIL RSUB > W-ARPT-MAX DTSBX530 +00872 MOVE LOW-VALUES TO W-ARPT-ENTRY (RSUB) DTSBX530 +00873 END-PERFORM. DTSBX530 +00874 DTSBX530 +00875 I0000-EXIT. DTSBX530 +00876 EXIT. DTSBX530 +00877 DTSBX530 +00878 I2000-OPEN-FILES. DTSBX530 +00879 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBX530 +00880 IF W-FATAL-ERROR-YES-88 DTSBX530 +00881 DISPLAY 'CANNOT OPEN TEMP X530BTC FILE ' CL184 +00882 TEMP-BTC-STATUS DTSBX530 +00883 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00884 END-IF. DTSBX530 +00885 DTSBX530 +00886 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBX530 +00887 IF W-FATAL-ERROR-YES-88 DTSBX530 +00888 DISPLAY 'CANNOT OPEN WAGE TEMP FILE ' DTSBX530 +00889 WAGE-TEMP-STATUS DTSBX530 +00890 PERFORM S999-ABEND THRU S999-EXIT CL*15 +00891 END-IF. DTSBX530 +00892 DTSBX530 +00893 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. CL*20 +00894 IF W-FATAL-ERROR-YES-88 CL*20 +00895 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' CL*20 +00896 WAGE-OUT-STATUS CL*20 +00897 PERFORM S999-ABEND THRU S999-EXIT CL*20 +00898 END-IF. CL*20 +00899 DTSBX530 +00900 OPEN OUTPUT BATCH-XREF-FILE. DTSBX530 +00901 IF BATCH-XREF-OK-88 DTSBX530 +00902 NEXT SENTENCE DTSBX530 +00903 ELSE DTSBX530 +00904 DISPLAY 'CANNOT OPEN BATCH XREF FILE ' DTSBX530 +00905 BATCH-XREF-STATUS DTSBX530 +00906 PERFORM S999-ABEND THRU S999-EXIT DTSBX530 +00907 END-IF. DTSBX530 +00908 CL*12 +00909 CL*59 +00910 OPEN OUTPUT PEND-X140-FILE. CL*59 +00911 IF REPT-140-OK-88 CL*62 +00912 NEXT SENTENCE CL*59 +00913 ELSE CL*59 +00914 DISPLAY 'CANNOT OPEN PENDING 530X140 FILE' CL244 +00915 REPT-140-STATUS CL*62 +00916 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00917 END-IF. CL*59 +00918 CL*59 +00919 OPEN OUTPUT PEND-X144-FILE. CL*59 +00920 IF WAGE-144-OK-88 CL*62 +00921 NEXT SENTENCE CL*59 +00922 ELSE CL*59 +00923 DISPLAY 'CANNOT OPEN PENDING X144 FILE' CL*59 +00924 WAGE-144-STATUS CL*62 +00925 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00926 END-IF. CL*59 +00927 CL*59 +00928 OPEN OUTPUT PEND-X145-FILE. CL*59 +00929 IF PAYT-145-OK-88 CL*62 +00930 NEXT SENTENCE CL*59 +00931 ELSE CL*59 +00932 DISPLAY 'CANNOT OPEN PENDING X145 FILE' CL*59 +00933 PAYT-145-STATUS CL*62 +00934 PERFORM S999-ABEND THRU S999-EXIT CL*59 +00935 END-IF. CL*59 +00936 CL119 +00937 CL119 +00938 OPEN OUTPUT X530-PEND-FILE. CL233 +00939 IF REPT-STATUS-OK-88 CL119 +00940 NEXT SENTENCE CL119 +00941 ELSE CL119 +00942 DISPLAY 'CANNOT OPEN X503 PENDING FILE ' CL232 +00943 REPT-STATUS CL119 +00944 PERFORM S999-ABEND THRU S999-EXIT CL119 +00945 END-IF. CL119 +00946 DTSBX530 +00947 OPEN OUTPUT X530-PAID-FILE. CL233 +00948 IF REPT-STATUS-OK-88 CL119 +00949 NEXT SENTENCE CL119 +00950 ELSE CL119 +00951 DISPLAY 'CANNOT OPEN X503 PAID FILE ' CL232 +00952 REPT-STATUS CL119 +00953 PERFORM S999-ABEND THRU S999-EXIT CL119 +00954 END-IF. CL119 +00955 CL119 +00956 I2000-EXIT. DTSBX530 +00957 EXIT. DTSBX530 +00958 DTSBX530 +00959 P0000-PROCESS. DTSBX530 +00960 CL**2 +00961 EVALUATE TRUE DTSBX530 +00962 WHEN LX42-REC-TYPE-PAY-88 CL*47 +00963 PERFORM P1000-PAYMENT THRU P1000-EXIT CL*47 +00964 DTSBX530 +00965 WHEN LX42-REC-TYPE-RPT-88 CL*47 +00966 PERFORM P2000-REPORT THRU P2000-EXIT CL*47 +00967 CL*47 +00968 WHEN LX42-REC-TYPE-WAGE-88 DTSBX530 +00969 PERFORM P3000-WAGES THRU P3000-EXIT DTSBX530 +00970 CL*47 +00971 WHEN OTHER CL*47 +00972 DISPLAY 'DTSBX430 ABENDING - INVALID RECORD TYPE ' CL*47 +00973 LX42-REC-TYPE CL*47 +00974 PERFORM S999-ABEND THRU S999-EXIT CL*47 +00975 CL*47 +00976 END-EVALUATE. DTSBX530 +00977 DTSBX530 +00978 P0000-EXIT. DTSBX530 +00979 EXIT. DTSBX530 +00980 P1000-PAYMENT. CL*47 +00981 INITIALIZE X145-REC CL227 +00982 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. CL*57 +00983 MOVE LX42-DATA-AREA TO X145-REC. CL*50 +00984 *& CL*50 +00985 MOVE X145-EMP-NO TO W-EMP-NO. CL*50 +00986 MOVE X145-QTR TO W-PAY-QTR. CL166 +00987 SET W-EMP-FOUND-NO-88 TO TRUE. CL*50 +00988 CL*50 +00989 ADD +1 TO W-X145-RED-CNT CL*50 +00990 DISPLAY SPACE. CL*50 +00991 DISPLAY 'BX530- NEW EMPLOYER PAYMENT ' X145-EMP-NO. CL184 +00992 DISPLAY ' X145-KEY ' X145-EMP-NO. CL*50 +00993 DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA. CL*50 +00994 SET W-RPT-ERROR-NO-88 TO TRUE. CL186 +00995 CL215 +00996 * DISPLAY '** PAY TYPE ' X145-PAY-TYPE ' ' X145-EMP-NO. CL228 +00997 * IF W-PAY-ACH-88 CL228 +00998 IF X145-PAY-TYPE = '00' CL228 +00999 ADD +1 TO W-A145-RED-CNT CL215 +01000 ELSE CL215 +01001 * IF W-PAY-CHK-88 CL228 +01002 IF X145-PAY-TYPE = '01' CL228 +01003 ADD +1 TO W-C145-RED-CNT CL215 +01004 ELSE CL215 +01005 * IF W-PAY-SCK-88 CL228 +01006 IF X145-PAY-TYPE = '02' CL228 +01007 ADD +1 TO W-S145-RED-CNT CL215 +01008 ELSE CL215 +01009 DISPLAY '** UNK PAY TYPE ' X145-PAY-TYPE ' ' X145-EMP-NO. CL225 +01010 CL215 +01011 CL*51 +01012 * IF LX42-X145-EMP-NO = '999999' CL185 +01013 * SET W-RPT-ERROR-YES-88 TO TRUE CL185 +01014 * MOVE SPACES TO R140-MESSAGE CL185 +01015 * MOVE W-EMP-NO TO R140-EMP-NO CL185 +01016 * STRING CL185 +01017 * 'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS ' CL185 +01018 * DELIMITED BY SIZE CL185 +01019 * INTO R140-MESSAGE CL185 +01020 * END-STRING CL185 +01021 * MOVE R140-MESSAGE TO P434-MESSAGE CL185 +01022 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL185 +01023 * MOVE '999999' TO LX42-X145-EMP-NO CL185 +01024 * ADD +1 TO W-X145-ERR-CNT CL185 +01025 * ADD +1 TO W-X145-PEN-CNT CL185 +01026 * WRITE PEND-X145-REC FROM X145-REC CL185 +01027 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL185 +01028 * GO TO P1000-EXIT. CL185 +01029 CL*51 +01030 CL*51 +01031 * IF LX42-REC-TYPE-PAY-88 CL183 +01032 * IF LX42-X145-KEY-AREA = X145-EMP-NO AND CL183 +01033 * LX42-X145-QTR-AREA = X145-QTR CL183 +01034 * SET W-PREV-RPT-NULL-88 TO TRUE CL183 +01035 * ADD +1 TO W-X145-DUP-CNT CL183 +01036 * DISPLAY 'X145 DUPLICATE PAYMENT RECORD ' W-EMP-NO CL183 +01037 * ' ERR IND ' W-RPT-ERROR-IND CL183 +01038 * MOVE SPACES TO R140-MESSAGE CL183 +01039 * MOVE W-EMP-NO TO R140-EMP-NO CL183 +01040 * MOVE SPACES TO R140-MESSAGE CL183 +01041 * MOVE W-EMP-NO TO R140-EMP-NO CL183 +01042 * STRING CL183 +01043 * ': POSSIBLE DUPLICATE PAYMENT RECORD ----PROCESS ' CL183 +01044 * DELIMITED BY SIZE CL183 +01045 * INTO R140-MESSAGE CL183 +01046 * END-STRING CL183 +01047 * SET X145-PAYMENT-DUP-YES-88 TO TRUE CL183 +01048 * WRITE PEND-X145-REC FROM WS-HOLD-X145-REC CL183 +01049 * MOVE R140-MESSAGE TO P434-MESSAGE CL183 +01050 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL183 +01051 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL183 +01052 * ELSE CL183 +01053 MOVE X145-EMP-NO TO LX42-X145-KEY-AREA CL107 +01054 * END-IF CL183 +01055 * END-IF. CL183 +01056 CL*51 +01057 CL*51 +01058 MOVE X145-EMP-NO TO LX42-X145-EMP-NO. CL*51 +01059 MOVE X145-QTR TO LX42-X145-QTR-AREA CL*83 +01060 CL*50 +01061 * DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. CL184 +01062 * IF W-PREV-RPT-NULL-88 OR CL184 +01063 * LX42-REC-TYPE-PAY-88 CL184 +01064 * SET W-PREV-RPT-PAY-88 TO TRUE CL184 +01065 * SET W-PREV-REC-PAY-88 TO TRUE CL107 +01066 CL184 +01067 ADD +1 TO W-X145-PRO-CNT CL*50 +01068 PERFORM P1110-EDIT-PAYMENT THRU P1110-EXIT CL*51 +01069 CL184 +01070 IF W-RPT-ERROR-NO-88 CL*81 +01071 PERFORM P1112-CHECK-PAYMENT THRU P1112-EXIT CL*51 +01072 ELSE CL185 +01073 MOVE '999999' TO LX42-X145-EMP-NO CL185 +01074 ADD +1 TO W-X145-ERR-CNT CL185 +01075 ADD +1 TO W-X145-PEN-CNT CL185 +01076 SET W-RPT-ERROR-YES-88 TO TRUE CL185 +01077 WRITE PEND-X145-REC FROM X145-REC CL185 +01078 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL185 +01079 PERFORM P7000-COUNT-X145 THRU P7000-EXIT CL215 +01080 GO TO P1000-EXIT CL185 +01081 END-IF. CL185 +01082 CL185 +01083 IF W-RPT-ERROR-NO-88 CL*81 +01084 * DISPLAY 'X145 PAYMENT REC PASS EDITS ' W-EMP-NO CL186 +01085 * DISPLAY 'X145 SAVED ' W-EMP-NO ' ' W-PAY-QTR ' ' CL186 +01086 * ' ' X145-REMITTANCE CL186 +01087 * ADD +1 TO W-X145-SAV-CNT CL188 +01088 PERFORM P1120-SAVE-PAYMENT THRU P1120-EXIT CL*51 +01089 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL190 +01090 ELSE CL*51 +01091 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01092 ADD +1 TO W-X145-ERR-CNT CL*51 +01093 ADD +1 TO W-X145-PEN-CNT CL*92 +01094 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01095 WRITE PEND-X145-REC FROM X145-REC CL*93 +01096 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL131 +01097 PERFORM P7000-COUNT-X145 THRU P7000-EXIT CL215 +01098 END-IF. CL186 +01099 * PERFORM S946-WRITE-R140 THRU S946-EXIT. CL186 +01100 CL*49 +01101 P1000-EXIT. CL*51 +01102 EXIT. CL*49 +01103 CL*49 +01104 P1110-EDIT-PAYMENT. CL*47 +01105 CL*54 +01106 MOVE X145-PAY-TYPE TO W-PAY-TYPE. CL*54 +01107 IF W-VALID-PAY-88 CL*54 +01108 NEXT SENTENCE CL*54 +01109 ELSE CL*54 +01110 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01111 MOVE SPACES TO R140-MESSAGE CL*54 +01112 MOVE W-EMP-NO TO R140-EMP-NO CL*54 +01113 STRING CL*54 +01114 ':PAY- INVALID PAYMENT TYPE ' CL144 +01115 X145-PAY-TYPE CL*54 +01116 DELIMITED BY SIZE CL*54 +01117 INTO R140-MESSAGE CL*54 +01118 END-STRING CL*54 +01119 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01120 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*54 +01121 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01122 END-IF. CL*54 +01123 * IF X145-QTR = SPACES CL241 +01124 IF W-VALID-EPAY-88 CL242 +01125 MOVE W-CURENT-QTR TO W-SLASH-QTR CL248 +01126 * MOVE '2019/1' TO W-SLASH-QTR CL248 +01127 ELSE CL*47 +01128 MOVE X145-QTR TO W-SLASH-QTR. CL*47 +01129 CL*47 +01130 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR CL*47 +01131 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q CL*47 +01132 PERFORM S004-FROM-5 THRU S004-EXIT CL*47 +01133 IF NOT L004-VALID-QTR CL*47 +01134 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01135 MOVE SPACES TO R140-MESSAGE CL*47 +01136 MOVE W-EMP-NO TO R140-EMP-NO CL*47 +01137 STRING CL*47 +01138 ':PAY- INVALID QUARTER ' W-SLASH-QTR CL144 +01139 DELIMITED BY SIZE CL*47 +01140 INTO R140-MESSAGE CL*47 +01141 END-STRING CL*47 +01142 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*47 +01143 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01144 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01145 ELSE CL*48 +01146 MOVE L004-QTR-5-9 TO W-X145-PAYMENT-QTR CL*56 +01147 END-IF. CL*48 +01148 CL*48 +01149 * DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR CL*92 +01150 CL*53 +01151 MOVE X145-REMITTANCE TO W-X145-REMITTANCE. CL*53 +01152 DISPLAY 'W145REMITCE ' W-X145-REMITTANCE. CL*53 +01153 DISPLAY 'X145REMITCE ' X145-REMITTANCE. CL*53 +01154 CL*51 +01155 IF W-X145-REMITTANCE = ZEROS CL201 +01156 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01157 MOVE SPACES TO R140-MESSAGE CL201 +01158 MOVE W-EMP-NO TO R140-EMP-NO CL201 +01159 STRING CL201 +01160 'X430- REVIEW REMITTANCE AMOUNT= 0 ' CL201 +01161 DELIMITED BY SIZE CL201 +01162 INTO R140-MESSAGE CL201 +01163 END-STRING CL201 +01164 PERFORM S946-WRITE-R140 THRU S946-EXIT CL201 +01165 END-IF. CL201 +01166 CL*51 +01167 MOVE ZEROS TO W-X145-RECEIVED-DATE CL*72 +01168 MOVE X145-RCVD-DATE TO W-SLASH-DATE CL*48 +01169 MOVE W-SLASH-DT-MM TO L001-FED-8-MO CL*48 +01170 MOVE W-SLASH-DT-DD TO L001-FED-8-DA CL*48 +01171 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR CL*48 +01172 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*48 +01173 IF NOT L001-VALID-DATE CL*48 +01174 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01175 MOVE SPACES TO R140-MESSAGE CL*48 +01176 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01177 STRING CL*48 +01178 ':PAY- INVALID RECEIVED DATE ' CL144 +01179 ' ' X145-RCVD-DATE CL*48 +01180 DELIMITED BY SIZE CL*48 +01181 INTO R140-MESSAGE CL*48 +01182 END-STRING CL*48 +01183 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01184 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01185 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01186 ELSE CL*48 +01187 MOVE L001-FED-8-DATE-9 TO W-X145-RECEIVED-DATE CL*72 +01188 END-IF. CL*48 +01189 CL*55 +01190 P1110-EXIT. CL*55 +01191 EXIT. CL*55 +01192 CL*55 +01193 P1112-CHECK-PAYMENT. CL*51 +01194 MOVE LOW-VALUE TO MPRF-KEY-AREA. CL*48 +01195 MOVE W-EMP-NO TO MPRF-EMP-NO. CL*48 +01196 SET MPRF-PRF-88 TO TRUE. CL*48 +01197 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*48 +01198 CL*48 +01199 PERFORM S910-READ THRU S910-EXIT. CL*48 +01200 IF L910-NO-REC-88 CL*48 +01201 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01202 SET W-EMP-FOUND-NO-88 TO TRUE CL*48 +01203 MOVE SPACES TO R140-MESSAGE CL*48 +01204 MOVE W-EMP-NO TO R140-EMP-NO CL*48 +01205 STRING CL*48 +01206 ':EMP NOT ON DUTAS -CANNOT PAY ' CL144 +01207 X145-EMP-NO CL*48 +01208 DELIMITED BY SIZE CL*48 +01209 INTO R140-MESSAGE CL*48 +01210 END-STRING CL*48 +01211 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01212 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*48 +01213 MOVE '999999' TO LX42-X145-EMP-NO CL*51 +01214 ELSE CL*48 +01215 MOVE MSKL-REC TO MPRF-REC CL*48 +01216 SET W-EMP-FOUND-YES-88 TO TRUE CL*48 +01217 END-IF. CL*48 +01218 CL*48 +01219 P1112-EXIT. CL*51 +01220 EXIT. CL*48 +01221 CL*48 +01222 CL*51 +01223 P1120-SAVE-PAYMENT. CL186 +01224 IF W-X145-REMITTANCE = ZEROS CL186 +01225 ADD +1 TO W-X145-WRITEO-CNT CL188 +01226 GO TO P1120-EXIT. CL186 +01227 CL188 +01228 * DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO. CL186 +01229 MOVE W-X145-REMITTANCE TO W-X145-TOT-REMIT-AMT. CL186 +01230 ADD W-X145-REMITTANCE TO W-TOT-REMIT-AMT. CL222 +01231 ADD +1 TO W-X145-SAV-CNT. CL186 +01232 PERFORM P2021-WRITE-T025 THRU P2021-EXIT. CL186 +01233 P1120-EXIT. CL186 +01234 EXIT. CL186 +01235 CL186 +01236 CL*48 +01237 DTSBX530 +01238 P2000-REPORT. DTSBX530 +01239 MOVE LX42-DATA-AREA TO X140-REC. DTSBX530 +01240 CL**2 +01241 * SET W-RPT-IN-PROGRESS-YES-88 TO TRUE CL*56 +01242 CL**2 +01243 MOVE X140-EMP-NO TO W-EMP-NO. DTSBX530 +01244 MOVE X140-QUARTER TO W-PAY-QTR. CL166 +01245 ADD +1 TO W-X140-RED-CNT. CL*56 +01246 DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE. CL*87 +01247 IF W-PREV-RPT-NULL-88 CL*80 +01248 SET W-PREV-RPT-RPT-88 TO TRUE CL*84 +01249 SET W-X145-PAYMENT-NO-88 TO TRUE CL*52 +01250 ELSE CL*52 +01251 SET W-X145-PAYMENT-YES-88 TO TRUE CL*52 +01252 END-IF. CL*52 +01253 CL*52 +01254 IF LX42-REC-TYPE-RPT-88 CL*40 +01255 IF LX42-X140-KEY-AREA = X140-EMP-NO AND CL*80 +01256 LX42-X140-QTR-AREA = X140-QUARTER CL*80 +01257 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01258 ADD +1 TO W-X140-DUP-CNT CL*92 +01259 ADD +1 TO W-X140-PEN-CNT CL*92 +01260 DISPLAY ':ERROR-RPT DUPLICATE REPORT D ' CL144 +01261 ' ERR IND ' W-RPT-ERROR-IND CL*80 +01262 MOVE SPACES TO R140-MESSAGE CL*40 +01263 MOVE W-EMP-NO TO R140-EMP-NO CL*40 +01264 STRING CL*40 +01265 ':RPT- DUPLICATE REPORT RECORD ' CL144 +01266 DELIMITED BY SIZE CL*40 +01267 INTO R140-MESSAGE CL*40 +01268 END-STRING CL*40 +01269 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01270 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*40 +01271 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL131 +01272 WRITE PEND-X140-REC FROM X140-REC CL*93 +01273 MOVE '999999' TO LX42-X140-EMP-NO CL*51 +01274 GO TO P2000-EXIT CL*40 +01275 ELSE CL*40 +01276 MOVE X140-EMP-NO TO LX42-X140-KEY-AREA CL*80 +01277 END-IF CL*40 +01278 END-IF. CL*40 +01279 CL*40 +01280 MOVE X140-EMP-NO TO LX42-X140-EMP-NO. CL**3 +01281 MOVE X140-QUARTER TO LX42-X140-QTR-AREA CL*80 +01282 SET W-EMP-FOUND-NO-88 TO TRUE. DTSBX530 +01283 CL*51 +01284 IF LX42-X145-EMP-NO = '999999' CL*51 +01285 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01286 MOVE SPACES TO R140-MESSAGE CL*40 +01287 MOVE W-EMP-NO TO R140-EMP-NO CL*40 +01288 STRING CL*40 +01289 ':PAY RECORD INVALID -RPT BYPASSED ' CL144 +01290 DELIMITED BY SIZE CL*40 +01291 INTO R140-MESSAGE CL*40 +01292 END-STRING CL*40 +01293 MOVE '999999' TO LX42-X140-EMP-NO CL*40 +01294 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*40 +01295 ADD +1 TO W-X140-PEN-CNT CL*93 +01296 WRITE PEND-X140-REC FROM X140-REC CL*93 +01297 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01298 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL131 +01299 GO TO P2000-EXIT. CL*40 +01300 CL*40 +01301 SET W-PREV-RPT-RPT-88 TO TRUE. CL*84 +01302 DTSBX530 +01303 DTSBX530 +01304 PERFORM P2010-EDIT-REPORT THRU P2010-EXIT DTSBX530 +01305 CL**3 +01306 IF W-RPT-ERROR-YES-88 CL*81 +01307 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01308 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01309 CL**3 +01310 PERFORM P2012-CHECK-MPRF THRU P2012-EXIT CL**3 +01311 IF W-RPT-ERROR-YES-88 CL*81 +01312 MOVE '999999' TO LX42-X140-EMP-NO CL**3 +01313 GO TO P2000-EDIT-REPORT-CONTINUE. CL*32 +01314 CL**3 +01315 PERFORM P2015-CHECK-MRPT THRU P2015-EXIT CL178 +01316 IF W-RPT-ERROR-YES-88 CL*81 +01317 MOVE '999999' TO LX42-X140-EMP-NO CL*60 +01318 GO TO P2000-EDIT-REPORT-CONTINUE. CL*60 +01319 CL*32 +01320 P2000-EDIT-REPORT-CONTINUE. CL*32 +01321 IF W-RPT-ERROR-NO-88 CL166 +01322 PERFORM P2020-SAVE-EXT-REPORT THRU P2020-EXIT CL166 +01323 ADD +1 TO W-X140-SAV-CNT CL166 +01324 GO TO P2000-EXIT. CL166 +01325 CL166 +01326 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01327 MOVE SPACES TO R140-MESSAGE CL*32 +01328 MOVE W-EMP-NO TO R140-EMP-NO CL*32 +01329 STRING CL*32 +01330 ': REPORT CONTAINS ERRORS CANNOT PROCESS -REPORT' CL144 +01331 ' ' X140-QUARTER CL*32 +01332 DELIMITED BY SIZE CL*32 +01333 INTO R140-MESSAGE CL*32 +01334 END-STRING CL*32 +01335 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*32 +01336 ADD +1 TO W-X140-PEN-CNT CL*93 +01337 WRITE PEND-X140-REC FROM X140-REC CL*93 +01338 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL131 +01339 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +01340 IF W-X145-PAYMENT-YES-88 CL166 +01341 WRITE PEND-X145-REC FROM X145-REC CL166 +01342 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. CL166 +01343 DTSBX530 +01344 P2000-EXIT. DTSBX530 +01345 EXIT. DTSBX530 +01346 DTSBX530 +01347 P2010-EDIT-REPORT. DTSBX530 +01348 MOVE X140-QUARTER TO W-SLASH-QTR. DTSBX530 +01349 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX530 +01350 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX530 +01351 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX530 +01352 IF NOT L004-VALID-QTR DTSBX530 +01353 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01354 MOVE SPACES TO R140-MESSAGE DTSBX530 +01355 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530 +01356 STRING DTSBX530 +01357 ':RPT- INVALID QUARTER ' CL144 +01358 X140-QUARTER DTSBX530 +01359 DELIMITED BY SIZE DTSBX530 +01360 INTO R140-MESSAGE DTSBX530 +01361 END-STRING DTSBX530 +01362 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01363 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530 +01364 ELSE DTSBX530 +01365 MOVE L004-QTR-5-9 TO W-X140-REPORT-QTR CL*56 +01366 END-IF. DTSBX530 +01367 DTSBX530 +01368 MOVE X140-REPORT-TYPE TO W-RPT-TYPE. DTSBX530 +01369 IF NOT W-RPT-TYPE-VALID-88 DTSBX530 +01370 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01371 MOVE SPACES TO R140-MESSAGE DTSBX530 +01372 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530 +01373 STRING DTSBX530 +01374 'ERROR-RPT INVALID REPORT TYPE ' CL144 +01375 X140-REPORT-TYPE CL**2 +01376 DELIMITED BY SIZE DTSBX530 +01377 INTO R140-MESSAGE DTSBX530 +01378 END-STRING DTSBX530 +01379 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01380 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530 +01381 END-IF. DTSBX530 +01382 CL113 +01383 IF W-RPT-TYPE NOT = 'OR' CL115 +01384 SET W-RPT-ERROR-YES-88 TO TRUE CL113 +01385 MOVE SPACES TO R140-MESSAGE CL113 +01386 MOVE W-EMP-NO TO R140-EMP-NO CL113 +01387 STRING CL113 +01388 ':RPT- AMENDED RPT - CANNOT PROCESS ' CL144 +01389 ' ' W-RPT-TYPE CL116 +01390 DELIMITED BY SIZE CL113 +01391 INTO R140-MESSAGE CL113 +01392 END-STRING CL113 +01393 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01394 PERFORM S946-WRITE-R140 THRU S946-EXIT CL113 +01395 END-IF. CL113 +01396 CL113 +01397 DTSBX530 +01398 * IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR CL*82 +01399 * MOVE ZERO TO W-TOT-WAGE CL*82 +01400 * MOVE W-X140-REPORT-QTR TO W-CURR-RPT-QTR CL*82 +01401 * END-IF. CL*82 +01402 MOVE X140-TOTAL-WAGES TO W-TOT-WAGE. DTSBX530 +01403 MOVE X140-TAX-WAGES TO W-TAX-WAGE. DTSBX530 +01404 CL*44 +01405 * IF W-EMP-NO = 177462 CL*53 +01406 * MOVE 1352.07 TO X140-REMITTANCE CL*53 +01407 DISPLAY ' X140-RMT ' X140-REMITTANCE. CL*70 +01408 DTSBX530 +01409 MOVE X140-REMITTANCE TO W-X140-REMITTANCE. CL*53 +01410 DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE. CL*70 +01411 *& DTSBX530 +01412 CL*52 +01413 DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND. CL*68 +01414 CL*68 +01415 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0 CL175 +01416 * MOVE SPACES TO R140-MESSAGE CL175 +01417 * SET W-RPT-ERROR-YES-88 TO TRUE CL175 +01418 * MOVE W-EMP-NO TO R140-EMP-NO CL175 +01419 * STRING CL175 +01420 * 'ESSP AMT DUE > 0 AND NO PAYMT ' CL175 +01421 * DELIMITED BY SIZE CL175 +01422 * INTO R140-MESSAGE CL175 +01423 * END-STRING CL175 +01424 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL175 +01425 * MOVE R140-MESSAGE TO P434-MESSAGE CL175 +01426 * GO TO P2010-EDIT-CONTINUE CL175 +01427 * END-IF. CL175 +01428 CL*52 +01429 IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0 CL*69 +01430 MOVE SPACES TO R140-MESSAGE CL*69 +01431 MOVE W-EMP-NO TO R140-EMP-NO CL*69 +01432 STRING CL*69 +01433 'X140 REMIT AMT = 0 AND NO X145 FOUND -PROCESS ' CL*70 +01434 ' ' X140-REMITTANCE CL*70 +01435 DELIMITED BY SIZE CL*69 +01436 INTO R140-MESSAGE CL*69 +01437 END-STRING CL*69 +01438 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01439 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*69 +01440 GO TO P2010-EDIT-CONTINUE CL*69 +01441 END-IF. CL*69 +01442 CL*69 +01443 IF W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE CL*71 +01444 MOVE SPACES TO R140-MESSAGE CL*53 +01445 MOVE W-EMP-NO TO R140-EMP-NO CL*53 +01446 * SET W-WRITE-T025-TRAN-YES-88 TO TRUE CL108 +01447 STRING CL*53 +01448 'X430 X145-PAY AMT > X140-REMIT AMT --PROCESS ' CL113 +01449 X145-REMITTANCE ' ' X140-REMITTANCE CL*75 +01450 DELIMITED BY SIZE CL*53 +01451 INTO R140-MESSAGE CL*53 +01452 END-STRING CL*53 +01453 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*53 +01454 END-IF. CL*53 +01455 CL*53 +01456 IF W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE CL*71 +01457 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01458 MOVE SPACES TO R140-MESSAGE CL*67 +01459 MOVE W-EMP-NO TO R140-EMP-NO CL*67 +01460 STRING CL*67 +01461 'X430 X145-PAY AMT < X140-REMIT AMT ' CL*67 +01462 X145-REMITTANCE ' ' X140-REMITTANCE CL*73 +01463 DELIMITED BY SIZE CL*67 +01464 INTO R140-MESSAGE CL*67 +01465 END-STRING CL*67 +01466 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*67 +01467 END-IF. CL*67 +01468 CL*67 +01469 IF W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0 CL*71 +01470 * SET W-RPT-ERROR-YES-88 TO TRUE CL108 +01471 MOVE SPACES TO R140-MESSAGE CL*67 +01472 MOVE W-EMP-NO TO R140-EMP-NO CL*67 +01473 STRING CL*67 +01474 'X430 X145-PAY AMT > 0 AND X140-REMIT AMT = 0 ' CL*71 +01475 X145-REMITTANCE ' ' X140-REMITTANCE CL*73 +01476 DELIMITED BY SIZE CL*67 +01477 INTO R140-MESSAGE CL*67 +01478 END-STRING CL*67 +01479 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*67 +01480 END-IF. CL*67 +01481 CL*67 +01482 IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE CL102 +01483 ADD 1 TO W-T028-WRITEE-CNT CL102 +01484 SET W-RPT-ERROR-NO-88 TO TRUE CL102 +01485 MOVE SPACES TO R140-MESSAGE CL102 +01486 MOVE W-EMP-NO TO R140-EMP-NO CL102 +01487 STRING CL102 +01488 'X430 ++++ X145-REMIT AMT = X140-REMIT AMT ' CL102 +01489 X145-REMITTANCE ' ' X140-REMITTANCE CL102 +01490 DELIMITED BY SIZE CL102 +01491 INTO R140-MESSAGE CL102 +01492 END-STRING CL102 +01493 PERFORM S946-WRITE-R140 THRU S946-EXIT CL102 +01494 END-IF. CL102 +01495 CL102 +01496 P2010-EDIT-CONTINUE. CL*69 +01497 DISPLAY 'BX430 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES CL*47 +01498 ' TOT: ' X140-TOTAL-WAGES ' RMT: ' W-X140-REMITTANCE CL*57 +01499 *& DTSBX530 +01500 MOVE ZERO TO W-X140-RECEIVED-DATE. CL*72 +01501 MOVE X140-RCVD-DATE TO W-SLASH-DATE. DTSBX530 +01502 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBX530 +01503 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBX530 +01504 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBX530 +01505 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX530 +01506 IF NOT L001-VALID-DATE DTSBX530 +01507 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01508 MOVE SPACES TO R140-MESSAGE DTSBX530 +01509 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530 +01510 STRING DTSBX530 +01511 ':RPT- INVALID RECEIVED DATE ' CL144 +01512 X140-RCVD-DATE CL**2 +01513 DELIMITED BY SIZE DTSBX530 +01514 INTO R140-MESSAGE DTSBX530 +01515 END-STRING DTSBX530 +01516 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01517 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530 +01518 ELSE DTSBX530 +01519 MOVE L001-FED-8-DATE-9 TO W-X140-RECEIVED-DATE CL*72 +01520 END-IF. DTSBX530 +01521 DTSBX530 +01522 MOVE ZERO TO W-CHK-SCAN-DATE. DTSBX530 +01523 * IF X140-IN-HOUSE-88 DTSBX530 +01524 * MOVE X140-CHECK-SCAN-DT TO W-SLASH-DATE DTSBX530 +01525 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSBX530 +01526 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSBX530 +01527 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSBX530 +01528 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX530 +01529 * IF NOT L001-VALID-DATE DTSBX530 +01530 * SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01531 * MOVE SPACES TO R140-MESSAGE DTSBX530 +01532 * MOVE W-EMP-NO TO R140-EMP-NO DTSBX530 +01533 * STRING DTSBX530 +01534 * 'REPORT: INVALID CHK SCAN DATE ' DTSBX530 +01535 * X140-CHECK-SCAN-DT DTSBX530 +01536 * DELIMITED BY SIZE DTSBX530 +01537 * INTO R140-MESSAGE DTSBX530 +01538 * END-STRING DTSBX530 +01539 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530 +01540 ** DISPLAY R140-MESSAGE DTSBX530 +01541 * ELSE DTSBX530 +01542 * MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSBX530 +01543 * END-IF DTSBX530 +01544 * END-IF. DTSBX530 +01545 DTSBX530 +01546 MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT. DTSBX530 +01547 MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT. DTSBX530 +01548 MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT. DTSBX530 +01549 DTSBX530 +01550 DTSBX530 +01551 P2010-EXIT. DTSBX530 +01552 EXIT. DTSBX530 +01553 DTSBX530 +01554 P2012-CHECK-MPRF. CL**2 +01555 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBX530 +01556 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBX530 +01557 SET MPRF-PRF-88 TO TRUE. DTSBX530 +01558 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX530 +01559 DTSBX530 +01560 PERFORM S910-READ THRU S910-EXIT. DTSBX530 +01561 CL**2 +01562 IF L910-OK-88 CL**2 +01563 MOVE MSKL-REC TO MPRF-REC CL**2 +01564 MOVE W-X140-REPORT-QTR TO L516-YRQ CL*56 +01565 PERFORM S516-LIABILITY-INFO THRU S516-EXIT CL**2 +01566 IF L516-LIABLE-88 CL*57 +01567 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01568 SET W-EMP-FOUND-YES-88 TO TRUE CL*57 +01569 DISPLAY 'X430 -EMPLOYER FOUND LIAB FOR QTR ' MPRF-EMP-NO CL*57 +01570 GO TO P2012-EXIT CL*57 +01571 ELSE CL*57 +01572 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01573 MOVE SPACES TO R140-MESSAGE CL**2 +01574 MOVE W-EMP-NO TO R140-EMP-NO CL**2 +01575 STRING CL**2 +01576 ':EMP NOT LIABLE FOR QTRLY RPT ' CL144 +01577 X140-QUARTER CL**7 +01578 DELIMITED BY SIZE CL**2 +01579 INTO R140-MESSAGE CL**2 +01580 END-STRING CL**2 +01581 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01582 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 +01583 SET W-EMP-FOUND-NO-88 TO TRUE CL**2 +01584 GO TO P2012-EXIT CL*51 +01585 ELSE CL*51 +01586 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01587 MOVE SPACES TO R140-MESSAGE CL*51 +01588 MOVE W-EMP-NO TO R140-EMP-NO CL*51 +01589 STRING CL*51 +01590 ':EMP NOT FOUND ON DUTAS-CANNOT PRCESS RPT' CL144 +01591 X140-EMP-NO CL*51 +01592 DELIMITED BY SIZE CL*51 +01593 INTO R140-MESSAGE CL*51 +01594 END-STRING CL*51 +01595 MOVE R140-MESSAGE TO P434-MESSAGE CL136 +01596 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*51 +01597 SET W-EMP-FOUND-NO-88 TO TRUE CL*51 +01598 END-IF. CL*51 +01599 CL**2 +01600 P2012-EXIT. CL**2 +01601 EXIT. DTSBX530 +01602 DTSBX530 +01603 CL**2 +01604 P2015-CHECK-MRPT. CL178 +01605 CL178 +01606 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL178 +01607 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL178 +01608 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL178 +01609 MOVE ZEROS TO MRPT-BATCH-NO. CL178 +01610 MOVE ZEROS TO MRPT-ITEM-NO CL178 +01611 CL178 +01612 SET MRPT-RPT-88 TO TRUE. CL178 +01613 MOVE MRPT-REC TO MSKL-REC. CL178 +01614 CL178 +01615 PERFORM S910-START-BROWSE THRU S910-EXIT. CL178 +01616 IF L910-OK-88 CL178 +01617 PERFORM P2016-SCAN-MRPT THRU P2016-EXIT CL178 +01618 UNTIL L910-NO-REC-88 CL178 +01619 ELSE CL178 +01620 SET W-RPT-ERROR-NO-88 TO TRUE CL178 +01621 DISPLAY 'P2013 X430 ORIG RPT NOT ON DUTAS- PROCESS ' CL178 +01622 W-EMP-NO ' ' W-X140-REPORT-QTR CL178 +01623 DISPLAY ' ' CL178 +01624 GO TO P2015-EXIT. CL178 +01625 CL178 +01626 CL178 +01627 P2015-EXIT. CL178 +01628 EXIT. CL178 +01629 CL178 +01630 P2016-SCAN-MRPT. CL178 +01631 MOVE MSKL-REC TO MRPT-REC. CL178 +01632 IF MRPT-YRQ = W-X140-REPORT-QTR CL178 +01633 NEXT SENTENCE CL178 +01634 ELSE CL178 +01635 IF MRPT-YRQ > W-X140-REPORT-QTR CL178 +01636 SET W-RPT-ERROR-NO-88 TO TRUE CL178 +01637 SET L910-NO-REC-88 TO TRUE CL178 +01638 GO TO P2016-EXIT CL178 +01639 ELSE CL178 +01640 GO TO P2016-READ-NEXT CL178 +01641 END-IF CL178 +01642 END-IF. CL178 +01643 CL178 +01644 IF MRPT-ORIG-88 CL178 +01645 SET W-RPT-ERROR-YES-88 TO TRUE CL178 +01646 SET L910-NO-REC-88 TO TRUE CL178 +01647 MOVE SPACES TO R140-MESSAGE CL179 +01648 MOVE W-EMP-NO TO R140-EMP-NO CL179 +01649 STRING CL179 +01650 ':ORIGINAL RPT EXIST IN DUTAS -NOT ADDED ' CL179 +01651 X140-QUARTER CL179 +01652 DELIMITED BY SIZE CL179 +01653 INTO R140-MESSAGE CL179 +01654 END-STRING CL179 +01655 MOVE R140-MESSAGE TO P434-MESSAGE CL179 +01656 PERFORM S946-WRITE-R140 THRU S946-EXIT CL179 +01657 GO TO P2016-EXIT CL178 +01658 END-IF. CL178 +01659 CL178 +01660 CL178 +01661 P2016-READ-NEXT. CL178 +01662 PERFORM S910-READ-NEXT THRU S910-EXIT. CL178 +01663 IF L910-NO-REC-88 CL178 +01664 SET W-RPT-ERROR-NO-88 TO TRUE. CL178 +01665 P2016-EXIT. CL178 +01666 CL**3 +01667 P2020-SAVE-EXT-REPORT. DTSBX530 +01668 DISPLAY 'P2020-SAVE-EXT-REPORT ' DTSBX530 +01669 ************************************************************ DTSBX530 +01670 * REPORTS FROM EXTERNAL SOURCES. REPORTS WILL BE DTSBX530 +01671 * ASSEMBLED INTO BATCHES IN DTSBD140. CHANGED ALL T027 DTSBX530 +01672 * TO BE T028 PER DOCUMENTATION IN BD140 FROM GIL 4/10/12 DTSBX530 +01673 ************************************************************ DTSBX530 +01674 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBX530 +01675 MOVE '028' TO T028-REC-TYPE. DTSBX530 +01676 DTSBX530 +01677 MOVE W-EMP-NO TO T028-EMP-NO. DTSBX530 +01678 MOVE 'WEB ESSP' TO T028-ORIGIN. DTSBX530 +01679 MOVE LX42-SYS-DATE TO T028-SYS-DATE. DTSBX530 +01680 MOVE LX42-SYS-TIME TO T028-SYS-TIME. DTSBX530 +01681 SET T028-WEB-RPT-88 TO TRUE. DTSBX530 +01682 DTSBX530 +01683 MOVE LX42-EXT-PSEUDO-BATCH TO T028-PSEUDO-BATCH-NO. DTSBX530 +01684 MOVE LX42-EXT-PSEUDO-ITEM TO T028-PSEUDO-ITEM-NO. DTSBX530 +01685 DTSBX530 +01686 MOVE W-X140-REPORT-QTR TO T028-YRQ. CL*56 +01687 IF W-EMP-FOUND-YES-88 DTSBX530 +01688 MOVE MPRF-PRIMARY-NAME (1:4) DTSBX530 +01689 TO T028-NAME-CHECK DTSBX530 +01690 ELSE DTSBX530 +01691 MOVE SPACES TO T028-NAME-CHECK DTSBX530 +01692 END-IF. DTSBX530 +01693 MOVE W-RPT-TYPE TO T028-RPT-TYPE. DTSBX530 +01694 DTSBX530 +01695 **************************************************************** DTSBX530 +01696 * LX42-LAST-DETERM-EMP IS SET BY DTSBX420 WHEN PROCESSING DTSBX530 +01697 * A DETERMINATION. IT IS USED TO DETERMINE WHEN TO WAIVE DTSBX530 +01698 * P & I. THE WAIVER IS AUTOMATIC FOR REPORTS WITHIN DTSBX530 +01699 * THE LAST 5 QUARTERS SUBMITTED ALONG WITH A WEB DTSBX530 +01700 * REGISTRATION. DTSBX530 +01701 **************************************************************** DTSBX530 +01702 IF (W-EMP-NO = LX42-LAST-DETERM-EMP DTSBX530 +01703 AND W-X140-REPORT-QTR >= W-WAIVER-QTR) CL*56 +01704 SET T028-WAIVE-BOTH-YES-88 TO TRUE DTSBX530 +01705 ELSE DTSBX530 +01706 SET T028-WAIVE-BOTH-NO-88 TO TRUE DTSBX530 +01707 END-IF. DTSBX530 +01708 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBX530 +01709 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBX530 +01710 MOVE W-X140-RECEIVED-DATE TO T028-RECEIVED-DATE CL*72 +01711 T028-DEPOSIT-DATE. DTSBX530 +01712 DTSBX530 +01713 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSBX530 +01714 DTSBX530 +01715 IF W-EMP-FOUND-NO-88 DTSBX530 +01716 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX530 +01717 COMPUTE T028-EXCESS-WAGE = DTSBX530 +01718 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX530 +01719 ELSE DTSBX530 +01720 IF MPRF-CLASS-SELF-INS-88 DTSBX530 +01721 MOVE ZERO TO T028-TAX-WAGE DTSBX530 +01722 T028-EXCESS-WAGE DTSBX530 +01723 ELSE DTSBX530 +01724 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBX530 +01725 COMPUTE T028-EXCESS-WAGE = DTSBX530 +01726 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBX530 +01727 END-IF DTSBX530 +01728 END-IF. DTSBX530 +01729 DTSBX530 +01730 MOVE ZERO TO T028-TOTAL-EMPL-CNT. DTSBX530 +01731 MOVE X140-WRKR-CNT-1ST-MNTH TO T028-1ST-MTH-EMPL-CNT. DTSBX530 +01732 MOVE X140-WRKR-CNT-2ND-MNTH TO T028-2ND-MTH-EMPL-CNT. DTSBX530 +01733 MOVE X140-WRKR-CNT-3RD-MNTH TO T028-3RD-MTH-EMPL-CNT. DTSBX530 +01734 DTSBX530 +01735 DISPLAY ' X145 PAY AMT ' X145-REMITTANCE CL109 +01736 DISPLAY ' X140 PAY AMT ' X140-REMITTANCE CL109 +01737 CL108 +01738 MOVE W-X145-TOT-REMIT-AMT TO W-X140-REMITTANCE CL108 +01739 MOVE W-X140-REMITTANCE TO T028-REMIT-AMT. CL100 +01740 DTSBX530 +01741 ADD W-X145-TOT-REMIT-AMT TO W-TOT-REMIT-AMT. CL142 +01742 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBX530 +01743 CL156 +01744 CL163 +01745 IF X145-TRACE-NO > SPACES CL164 +01746 MOVE X145-TRACE-NO TO T028-TRACE-NO CL164 +01747 ELSE CL156 +01748 MOVE ZERO TO T028-TRACE-NO. CL156 +01749 DTSBX530 +01750 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBX530 +01751 IF W-PAY-TYPE = '01' CL243 +01752 MOVE 'TDECCHK ' TO T028-RESPONSIBLE-OP-ID CL243 +01753 ELSE CL243 +01754 MOVE 'WEBESSP ' TO T028-RESPONSIBLE-OP-ID. CL243 +01755 DTSBX530 +01756 DISPLAY 'BX430 WEB RPT ' X140-EMP-NO ' ' X140-QUARTER. CL*47 +01757 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSBX530 +01758 DTSBX530 +01759 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. CL124 +01760 CL124 +01761 * DISPLAY W-EMP-NO ',' T028-TOT-WAGE CL124 +01762 * ',' T028-EXCESS-WAGE CL124 +01763 * ',' T028-TAX-WAGE CL124 +01764 * ',' X140-REMITTANCE CL124 +01765 * ',' X145-REMITTANCE. CL124 +01766 CL110 +01767 IF W-X140-REMITTANCE > 0 CL100 +01768 ADD 1 TO W-T028-WRITE-CNT CL100 +01769 ELSE CL100 +01770 ADD 1 TO W-T028-WRITE-CNT CL100 +01771 ADD 1 TO W-T028-WRITEO-CNT. CL100 +01772 CL100 +01773 * IF W-WRITE-T025-TRAN-YES-88 CL108 +01774 * PERFORM P2021-WRITE-T025 THRU P2021-EXIT CL108 +01775 * ELSE CL108 +01776 SET W-RPT-ERROR-NO-88 TO TRUE CL*81 +01777 MOVE SPACES TO R140-MESSAGE CL*71 +01778 MOVE W-EMP-NO TO R140-EMP-NO CL*71 +01779 STRING CL*71 +01780 'X430 -:>>>>> REPORT ADDED TO DUTAS - ' X140-QUARTER CL*93 +01781 DELIMITED BY SIZE CL*71 +01782 INTO R140-MESSAGE CL*71 +01783 END-STRING CL*71 +01784 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL*71 +01785 P2020-EXIT. DTSBX530 +01786 EXIT. DTSBX530 +01787 DTSBX530 +01788 P2021-WRITE-T025. CL*71 +01789 ** CL*73 +01790 **PAYMENT TRANSACTION REMIT AMT > 0 CL186 +01791 **WRITE A PA T025 TRANSACTION. CL186 +01792 ** CL*73 +01793 DISPLAY 'PAYMENT OK ' X145-EMP-NO. CL*71 +01794 CL*71 +01795 MOVE LENGTH OF T025-REC TO T025-LENGTH CL*71 +01796 MOVE '025' TO T025-REC-TYPE. CL*71 +01797 CL*71 +01798 MOVE W-EMP-NO TO T025-EMP-NO. CL*71 +01799 MOVE 'WEB PAY' TO T025-ORIGIN. CL*71 +01800 MOVE LX42-SYS-DATE TO T025-SYS-DATE. CL*71 +01801 MOVE LX42-SYS-TIME TO T025-SYS-TIME. CL*71 +01802 * CL*71 +01803 * IF W-PAY-ACH-88 OR W-PAY-SCK-88 CL246 +01804 * MOVE +0 TO T025-APPLIC-YRQ CL246 +01805 * ELSE CL246 +01806 MOVE W-X145-PAYMENT-QTR TO T025-APPLIC-YRQ. CL239 +01807 CL239 +01808 MOVE 'PA' TO T025-PAY-TYPE CL186 +01809 CL*71 +01810 MOVE SPACES TO T025-APPLIC-IND. CL*71 +01811 MOVE ZERO TO T025-APPLIC-BATCH-NO CL*71 +01812 T025-APPLIC-ITEM-NO. CL*71 +01813 CL*71 +01814 IF W-EMP-FOUND-YES-88 CL*71 +01815 MOVE MPRF-PRIMARY-NAME (1:4) CL*71 +01816 TO T025-NAME-CHECK CL*71 +01817 ELSE CL*71 +01818 MOVE SPACES TO T025-NAME-CHECK CL*71 +01819 END-IF. CL*71 +01820 CL*71 +01821 MOVE W-X145-RECEIVED-DATE TO T025-RECEIVED-DATE CL*72 +01822 T025-DEPOSIT-DATE. CL*71 +01823 CL*71 +01824 * COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL186 +01825 * W-X140-REMITTANCE. CL186 +01826 CL*71 +01827 * MOVE W-T025-REMIT-AMT TO T025-REMIT-AMT. CL186 +01828 MOVE W-X145-TOT-REMIT-AMT TO T025-REMIT-AMT. CL186 +01829 CL*71 +01830 CL186 +01831 IF X145-TRACE-NO > SPACES CL186 +01832 MOVE X145-TRACE-NO TO T025-TRACE-NO CL186 +01833 ELSE CL186 +01834 MOVE ZEROS TO T025-TRACE-NO. CL186 +01835 CL186 +01836 CL*71 +01837 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. CL*71 +01838 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL*71 +01839 CL*71 +01840 * MOVE T025-REC TO TSKL-REC. CL*71 +01841 * PERFORM S927B-WRITE THRU S927B-EXIT. CL*71 +01842 CL*71 +01843 PERFORM S1033-WRITE-TEMP-T025 THRU S1033-EXIT. CL*71 +01844 ADD +1 TO W-T025-WRITE-CNT. CL*71 +01845 CL*71 +01846 CL215 +01847 IF W-PAY-ACH-88 CL220 +01848 ADD +1 TO W-A145-SAV-CNT CL217 +01849 ADD W-X145-TOT-REMIT-AMT TO W-A145-TOT-AMT CL217 +01850 ELSE CL215 +01851 IF W-PAY-CHK-88 CL220 +01852 ADD +1 TO W-C145-SAV-CNT CL217 +01853 ADD W-X145-TOT-REMIT-AMT TO W-C145-TOT-AMT CL217 +01854 ELSE CL215 +01855 IF W-PAY-SCK-88 CL221 +01856 ADD +1 TO W-S145-SAV-CNT CL217 +01857 ADD W-X145-TOT-REMIT-AMT TO W-S145-TOT-AMT CL217 +01858 ELSE CL215 +01859 DISPLAY ' ****** ERROR UNKNOW PAY TYPE ' X145-EMP-NO. CL215 +01860 CL215 +01861 MOVE ZEROS TO W-T025-REMIT-AMT CL*72 +01862 * W-S145-TOT-AMT CL224 +01863 * W-C145-TOT-AMT CL224 +01864 * W-A145-TOT-AMT CL224 +01865 W-X145-TOT-REMIT-AMT CL*72 +01866 W-X140-REMITTANCE. CL*72 +01867 CL*72 +01868 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. CL193 +01869 * WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. CL188 +01870 MOVE ZEROS TO W-T025-REMIT-AMT CL186 +01871 W-X145-TOT-REMIT-AMT CL186 +01872 W-X140-REMITTANCE. CL186 +01873 CL186 +01874 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL186 +01875 CL186 +01876 SET W-RPT-ERROR-NO-88 TO TRUE CL186 +01877 MOVE SPACES TO R140-MESSAGE CL186 +01878 MOVE W-EMP-NO TO R140-EMP-NO CL186 +01879 STRING CL186 +01880 'X430 -: >>>>> PAYMENT T025 CREATED ' CL186 +01881 'REMIT AMT' CL186 +01882 DELIMITED BY SIZE CL186 +01883 INTO R140-MESSAGE CL186 +01884 END-STRING CL186 +01885 PERFORM S946-WRITE-R140 THRU S946-EXIT. CL186 +01886 P2021-EXIT. CL*71 +01887 EXIT. CL*71 +01888 CL*71 +01889 DTSBX530 +01890 P3000-WAGES. DTSBX530 +01891 MOVE LX42-DATA-AREA TO X144-REC. DTSBX530 +01892 * DISPLAY 'X144: ' X144-REC. CL160 +01893 MOVE X144-EMP-NO TO W-EMP-NO. CL*38 +01894 * CL**4 +01895 ADD +1 TO W-X144-RED-CNT CL*96 +01896 SET W-RPT-ERROR-NO-88 TO TRUE. CL147 +01897 SET W-PREV-REC-WAGE-88 TO TRUE. CL162 +01898 * CL**4 +01899 * DISPLAY 'LX-E ' LX42-X140-EMP-NO ' X145-E ' W-EMP-NO. CL*97 +01900 * IF LX42-X145-EMP-NO = '999999' OR CL157 +01901 * LX42-X140-EMP-NO = '999999' OR CL157 +01902 * LX42-X145-EMP-NO = SPACES OR CL157 +01903 * LX42-X140-EMP-NO = SPACES OR CL157 +01904 * W-PREV-RPT-NULL-88 CL157 +01905 * SET W-RPT-ERROR-YES-88 TO TRUE CL157 +01906 * MOVE SPACES TO R140-MESSAGE CL157 +01907 * MOVE W-EMP-NO TO R140-EMP-NO CL157 +01908 * STRING CL157 +01909 * 'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES ' CL157 +01910 * ' ' X144-QUARTER CL157 +01911 * DELIMITED BY SIZE CL157 +01912 * INTO R140-MESSAGE CL157 +01913 * END-STRING CL157 +01914 * WRITE PEND-X144-REC FROM X144-REC CL157 +01915 * ADD +1 TO W-X144-ERR-CNT CL157 +01916 * ADD +1 TO W-X144-PEN-CNT CL157 +01917 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL117 +01918 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL*83 +01919 * GO TO P3000-EXIT. CL159 +01920 CL*36 +01921 * CL**4 +01922 * IF W-PREV-RPT-RPT-88 CL157 +01923 * OR W-PREV-RPT-WAGE-88 CL157 +01924 * SET W-PREV-RPT-WAGE-88 TO TRUE CL162 +01925 ADD +1 TO W-X144-PRO-CNT CL*56 +01926 PERFORM P3010-EDIT-WAGES THRU P3010-EXIT DTSBX530 +01927 IF W-RPT-ERROR-NO-88 CL*81 +01928 PERFORM P3011-WRITE-WAGES-X144 THRU P3011-EXIT DTSBX530 +01929 ADD +1 TO W-X144-SAV-CNT CL*96 +01930 GO TO P3000-EXIT CL160 +01931 ELSE CL*36 +01932 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01933 MOVE SPACES TO R140-MESSAGE CL*36 +01934 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +01935 STRING CL*36 +01936 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' CL*47 +01937 ' ' X144-SSN CL*36 +01938 DELIMITED BY SIZE CL*36 +01939 INTO R140-MESSAGE CL*36 +01940 END-STRING CL*36 +01941 ADD +1 TO W-X144-ERR-CNT CL*93 +01942 ADD +1 TO W-X144-PEN-CNT CL*96 +01943 WRITE PEND-X144-REC FROM X144-REC CL*93 +01944 PERFORM P6000-WRITE-PEND-X144 THRU P6000-EXIT CL144 +01945 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +01946 GO TO P3000-EXIT CL*36 +01947 * ELSE CL157 +01948 * SET W-RPT-ERROR-YES-88 TO TRUE CL157 +01949 * MOVE SPACES TO R140-MESSAGE CL157 +01950 * MOVE W-EMP-NO TO R140-EMP-NO CL157 +01951 * STRING CL157 +01952 * 'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING ' CL157 +01953 * ' ' X144-SSN CL157 +01954 * DELIMITED BY SIZE CL157 +01955 * INTO R140-MESSAGE CL157 +01956 * END-STRING CL157 +01957 * WRITE PEND-X144-REC FROM X144-REC CL157 +01958 * ADD +1 TO W-X144-ERR-CNT CL157 +01959 * ADD +1 TO W-X144-PEN-CNT CL157 +01960 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT CL*93 +01961 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL157 +01962 END-IF. DTSBX530 +01963 DTSBX530 +01964 P3000-EXIT. DTSBX530 +01965 EXIT. DTSBX530 +01966 DTSBX530 +01967 P3010-EDIT-WAGES. DTSBX530 +01968 DISPLAY 'P3010-EDIT-WAGES ' CL162 +01969 * DISPLAY 'X144-QUARTER ' X144-QUARTER CL*36 +01970 MOVE X144-QUARTER TO W-SLASH-QTR. DTSBX530 +01971 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX530 +01972 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX530 +01973 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX530 +01974 IF NOT L004-VALID-QTR DTSBX530 +01975 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +01976 MOVE SPACES TO R140-MESSAGE DTSBX530 +01977 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530 +01978 STRING DTSBX530 +01979 ': WAGE RECORD HAS INVALID QUARTER ' CL144 +01980 X144-QUARTER ' ' X144-SSN CL*36 +01981 DELIMITED BY SIZE DTSBX530 +01982 INTO R140-MESSAGE DTSBX530 +01983 END-STRING DTSBX530 +01984 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +01985 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530 +01986 ELSE CL*13 +01987 MOVE L004-QTR-5-9 TO W-X144-WAGE-QTR CL*53 +01988 END-IF. DTSBX530 +01989 CL*15 +01990 * IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR CL161 +01991 * SET W-RPT-ERROR-YES-88 TO TRUE CL161 +01992 * MOVE SPACES TO R140-MESSAGE CL161 +01993 * MOVE W-EMP-NO TO R140-EMP-NO CL161 +01994 * MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR CL161 +01995 * STRING CL161 +01996 * ':WAGE QTR NOT = RPT QTR ' CL161 +01997 * X144-QUARTER ' ' WRK-REPORT-QTR CL161 +01998 * DELIMITED BY SIZE CL161 +01999 * INTO R140-MESSAGE CL161 +02000 * END-STRING CL161 +02001 * MOVE R140-MESSAGE TO P434-MESSAGE CL161 +02002 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL161 +02003 * END-IF. CL161 +02004 DTSBX530 +02005 IF X144-SSN NOT NUMERIC DTSBX530 +02006 * DISPLAY 'X144-SSN ' X144-SSN CL*36 +02007 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02008 MOVE SPACES TO R140-MESSAGE DTSBX530 +02009 MOVE W-EMP-NO TO R140-EMP-NO DTSBX530 +02010 STRING DTSBX530 +02011 ':WAGE RECORD NON-NUMERIC SSN ' CL144 +02012 X144-SSN DTSBX530 +02013 DELIMITED BY SIZE DTSBX530 +02014 INTO R140-MESSAGE DTSBX530 +02015 END-STRING DTSBX530 +02016 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02017 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBX530 +02018 ELSE DTSBX530 +02019 MOVE X144-SSN TO W-SSN DTSBX530 +02020 END-IF. DTSBX530 +02021 DTSBX530 +02022 IF X144-SSN = ZEROS CL*53 +02023 * DISPLAY 'X144-SSN ' X144-SSN CL*53 +02024 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02025 MOVE SPACES TO R140-MESSAGE CL*53 +02026 MOVE W-EMP-NO TO R140-EMP-NO CL*53 +02027 STRING CL*53 +02028 ':WAGE RECORD SSN = ZEROS ' CL144 +02029 X144-SSN CL*53 +02030 DELIMITED BY SIZE CL*53 +02031 INTO R140-MESSAGE CL*53 +02032 END-STRING CL*53 +02033 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02034 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*53 +02035 ELSE CL*53 +02036 MOVE X144-SSN TO W-SSN CL*53 +02037 END-IF. CL*53 +02038 CL*53 +02039 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME CL162 +02040 * ' FN: ' X144-FIRST-NAME. CL162 +02041 IF X144-LAST-NAME = SPACES CL*36 +02042 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02043 MOVE SPACES TO R140-MESSAGE CL*36 +02044 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +02045 STRING CL*36 +02046 ':WAGE RECORD BLANK LAST NAME ' CL144 +02047 X144-SSN CL*36 +02048 DELIMITED BY SIZE CL*36 +02049 INTO R140-MESSAGE CL*36 +02050 END-STRING CL*36 +02051 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02052 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +02053 END-IF. CL*36 +02054 CL*36 +02055 IF X144-FIRST-NAME = SPACES CL*36 +02056 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02057 MOVE SPACES TO R140-MESSAGE CL*36 +02058 MOVE W-EMP-NO TO R140-EMP-NO CL*36 +02059 STRING CL*36 +02060 ':WAGE RECORD BLANK FIRST NAME ' CL144 +02061 X144-SSN CL*36 +02062 DELIMITED BY SIZE CL*36 +02063 INTO R140-MESSAGE CL*36 +02064 END-STRING CL*36 +02065 MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02066 PERFORM S946-WRITE-R140 THRU S946-EXIT CL*36 +02067 END-IF. CL*36 +02068 CL*36 +02069 * IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR DTSBX530 +02070 * MOVE ZERO TO W-WRKR-TOT-WAGE DTSBX530 +02071 * MOVE W-WAGE-QTR TO W-CURR-WAGE-QTR DTSBX530 +02072 * END-IF. DTSBX530 +02073 DTSBX530 +02074 * MOVE X144-EARNINGS TO W-EARNINGS-X. DTSBX530 +02075 * MOVE W-EARNINGS-9 TO W-EARNINGS. DTSBX530 +02076 * ADD W-EARNINGS TO W-WRKR-TOT-WAGE. DTSBX530 +02077 * DISPLAY 'X144-LAST-NAME ' X144-LAST-NAME DTSBX530 +02078 * MOVE X144-LAST-NAME TO W-WRKR-LAST-NAME. DTSBX530 +02079 * MOVE X144-FIRST-NAME TO W-WRKR-FIRST-NAME. DTSBX530 +02080 * MOVE X144-MID-INIT TO W-WRKR-MID-INIT. DTSBX530 +02081 DTSBX530 +02082 P3010-EXIT. DTSBX530 +02083 EXIT. DTSBX530 +02084 DTSBX530 +02085 P3011-WRITE-WAGES-X144. DTSBX530 +02086 DTSBX530 +02087 ************************************************************** CL*11 +02088 * WRITE W4 WAGES FOR DOCS CL*11 +02089 ************************************************************** CL*11 +02090 * CL*11 +02091 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. CL*11 +02092 MOVE X144-SSN TO W4-SSN. CL*11 +02093 MOVE 'W4' TO W4-TRAN-ID. CL*11 +02094 MOVE '00044001' TO W4-TRAN-OPER-ID. CL*11 +02095 MOVE MHDR-CURR-RUN-DATE TO W4-DATE-ENTERED. CL*11 +02096 MOVE ZEROS TO W4-TIME-ENTERED. CL*11 +02097 MOVE X144-LAST-NAME (1:3) TO W4-NAME-CHECK. CL*11 +02098 MOVE W-X144-WAGE-QTR TO W4-QUARTER. CL118 +02099 MOVE X144-EARNINGS TO W4-QUARTER-EARNINGS. CL*11 +02100 MOVE 2 TO W4-AFFI-CODE. CL*11 +02101 MOVE X144-EMP-NO TO W4-ACCOUNT. CL*11 +02102 MOVE MPRF-PRIMARY-NAME (1:4) TO W4-EMP-NAME. CL*11 +02103 CL*11 +02104 * MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. CL*20 +02105 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +02106 CL*11 +02107 * WRITE WAGE-TRANS-REC. CL*20 +02108 WRITE WAGE-OUT-REC. CL*20 +02109 CL*11 +02110 IF WAGE-TEMP-STATUS-OK-88 CL*32 +02111 ADD +1 TO W-W4-CNT CL*11 +02112 * DISPLAY 'WRITE W4 ' W4-ACCOUNT ' ' W4-QUARTER CL162 +02113 * ' ' W4-SSN CL162 +02114 ELSE CL*11 +02115 DISPLAY 'ERROR WRITING W4- WAGE FILE ' CL*36 +02116 WAGE-TEMP-STATUS CL*32 +02117 END-IF. CL*11 +02118 CL*11 +02119 CL*11 +02120 P3011-EXIT. CL*25 +02121 EXIT. DTSBX530 +02122 P4000-WRITE-X434-PAID-REPT. CL119 +02123 CL119 +02124 MOVE X140-EMP-NO TO X434-EMP-NO CL119 +02125 MOVE X140-QUARTER TO X434-QTR CL125 +02126 IF W-EMP-FOUND-YES-88 CL119 +02127 MOVE MPRF-PRIMARY-NAME (1:15) CL119 +02128 TO X434-NAME-CHECK CL119 +02129 ELSE CL119 +02130 MOVE SPACES TO X434-NAME-CHECK CL119 +02131 END-IF. CL119 +02132 CL119 +02133 MOVE X140-RCVD-DATE TO X434-RCVD-DATE CL121 +02134 MOVE T028-TOT-WAGE TO X434-TOT-WAGE CL119 +02135 MOVE T028-EXCESS-WAGE TO X434-EXC-WAGE CL119 +02136 MOVE T028-TAX-WAGE TO X434-TAX-WAGE CL119 +02137 MOVE X140-REMITTANCE TO X434-X140-REMIT CL119 +02138 WS-X140-REMITTANCE CL149 +02139 MOVE W-X140-REMITTANCE TO X434-X145-REMIT CL119 +02140 CL148 +02141 COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - CL149 +02142 WS-X140-REMITTANCE. CL149 +02143 CL149 +02144 MOVE W-T025-REMIT-AMT TO X434-DIFF. CL149 +02145 CL148 +02146 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL121 +02147 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL125 +02148 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL125 +02149 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL125 +02150 CL119 +02151 * IF W-ERROR-NO-88 CL120 +02152 * MOVE 'PROCESSED' TO P434-MESSAGE CL188 +02153 * ELSE CL120 +02154 * MOVE 'PENDING ' TO P434-MESSAGE CL188 +02155 * MOVE R140-MESSAGE TO X434-MESSAGE CL120 +02156 CL119 +02157 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL121 +02158 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. CL120 +02159 ADD 1 TO WS-LINE-CNT2. CL119 +02160 ADD +1 TO WS-NUMBER-ONE. CL119 +02161 CL119 +02162 CL119 +02163 P4000-EXIT. CL119 +02164 EXIT. CL119 +02165 P4100-PRINT-HEADER. CL121 +02166 IF WS-LINE-CNT GREATER 58 OR CL121 +02167 WS-LINE-CNT2 GREATER 58 CL121 +02168 MOVE +0 TO WS-LINE-CNT CL121 +02169 MOVE +0 TO WS-LINE-CNT2 CL121 +02170 ADD +1 TO WS-PAGE-CNT CL121 +02171 MOVE WS-PAGE-CNT TO HDR3-PAGE CL121 +02172 * MOVE L001-SLASH-DATE TO HDR1-LRCM-SYS-DATE CL249 +02173 MOVE '-/+ ----- MONTHLY COUNT' TO HDR5-NAME CL153 +02174 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL122 +02175 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 CL122 +02176 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 CL122 +02177 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 CL122 +02178 WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 CL153 +02179 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 CL122 +02180 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 CL122 +02181 ADD +6 TO WS-LINE-CNT2. CL121 +02182 P4100-EXIT. CL121 +02183 EXIT. CL121 +02184 CL121 +02185 P4200-PRINT-HEADER. CL133 +02186 IF WSP-LINE-CNT GREATER 58 OR CL133 +02187 WSP-LINE-CNT2 GREATER 58 CL133 +02188 MOVE +0 TO WSP-LINE-CNT CL133 +02189 MOVE +0 TO WSP-LINE-CNT2 CL133 +02190 ADD +1 TO WSP-PAGE-CNT CL133 +02191 MOVE WSP-PAGE-CNT TO HDR31-PAGE CL133 +02192 MOVE ' * STATUS OF PAYMENTS *' TO HDR5-NAME CL196 +02193 * MOVE L001-SLASH-DATE TO HDR1-LRCM-SYS-DATE CL249 +02194 WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL133 +02195 WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1 CL133 +02196 WRITE REPT-PEND-REC FROM HEADER-3 AFTER 1 CL224 +02197 WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1 CL133 +02198 WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1 CL144 +02199 WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1 CL133 +02200 WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1 CL133 +02201 ADD +6 TO WSP-LINE-CNT2. CL133 +02202 P4200-EXIT. CL133 +02203 EXIT. CL133 +02204 CL133 +02205 DTSBX530 +02206 P5000-NEW-EMP. DTSBX530 +02207 *& DTSBX530 +02208 DISPLAY ' 5000-NEW-EMP ' W-PREV-REC-TYPE CL*89 +02209 ' ERROR-IND ' W-RPT-ERROR-IND CL*88 +02210 * IF W-PREV-RPT-PAY-88 AND CL188 +02211 * W-RPT-ERROR-NO-88 CL188 +02212 * LX42-X140-EMP-NO = SPACES AND CL*85 +02213 * LX42-X145-EMP-NO = SPACES CL*85 +02214 * ADD +1 TO W-X145-PEN-CNT CL188 +02215 * MOVE SPACES TO R140-MESSAGE CL188 +02216 * MOVE W-EMP-NO TO R140-EMP-NO CL188 +02217 * DISPLAY 'NO REPORT FOR PAYMENT ' W-EMP-NO ' ' W-PAY-QTR CL188 +02218 * ' ' X145-REMITTANCE CL188 +02219 * STRING CL188 +02220 * ': NO REPORT FOR PAYMENT ' CL188 +02221 * DELIMITED BY SIZE CL188 +02222 * INTO R140-MESSAGE CL188 +02223 * END-STRING CL188 +02224 * MOVE R140-MESSAGE TO P434-MESSAGE CL188 +02225 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT CL188 +02226 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL188 +02227 * WRITE PEND-X145-REC FROM X145-REC. CL188 +02228 CL*82 +02229 DISPLAY 'BX530 P5000-NEW-EMP-PAY ' W-EMP-NO ' ' LX42-EMP-NO. CL188 +02230 DTSBX530 +02231 MOVE LX42-EMP-NO TO W-EMP-NO. DTSBX530 +02232 SET W-RPT-ERROR-NO-88 TO TRUE. CL*80 +02233 * SET W-PREV-REC-NULL-88 TO TRUE. CL107 +02234 SET W-PREV-RPT-NULL-88 TO TRUE. CL104 +02235 SET X145-PAYMENT-DUP-NO-88 TO TRUE CL171 +02236 MOVE ZERO TO W-X140-REPORT-QTR CL*56 +02237 W-X145-PAYMENT-QTR CL*57 +02238 W-X144-WAGE-QTR CL*56 +02239 W-TOT-WAGE DTSBX530 +02240 W-TAX-WAGE DTSBX530 +02241 W-WRKR-TOT-WAGE DTSBX530 +02242 W-X145-REMITTANCE CL*53 +02243 W-X140-REMITTANCE CL*53 +02244 W-X140-RECEIVED-DATE CL*72 +02245 W-X145-DEPOSIT-DATE CL*72 +02246 W-X145-RECEIVED-DATE CL*72 +02247 W-1ST-MNTH-CNT DTSBX530 +02248 W-2ND-MNTH-CNT DTSBX530 +02249 W-3RD-MNTH-CNT DTSBX530 +02250 W-SSN DTSBX530 +02251 W-EARNINGS DTSBX530 +02252 W-EMP-WAGE-CNT DTSBX530 +02253 W-SEQ-NO CL*77 +02254 W-T025-REMIT-AMT CL*76 +02255 W-X145-TOT-REMIT-AMT CL*76 +02256 W-X140-REMITTANCE CL*83 +02257 LX42-X140-KEY-AREA CL*83 +02258 LX42-X144-KEY-AREA CL*83 +02259 LX42-X145-KEY-AREA. CL*83 +02260 CL*76 +02261 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. CL*76 +02262 CL*76 +02263 DTSBX530 +02264 MOVE SPACES TO W-WRKR-FIRST-NAME DTSBX530 +02265 W-WRKR-LAST-NAME DTSBX530 +02266 W-WRKR-MID-INIT CL*56 +02267 W-X145-PAYMENT-FOUND-IND CL*79 +02268 LX42-X140-EMP-NO CL*79 +02269 LX42-X144-EMP-NO CL*82 +02270 LX42-X145-EMP-NO CL*82 +02271 LX42-X140-QTR-AREA CL*82 +02272 LX42-X144-QTR-AREA CL*82 +02273 P434-MESSAGE CL138 +02274 LX42-X145-QTR-AREA. CL*82 +02275 CL*53 +02276 INITIALIZE X140-REC DTSBX530 +02277 X144-REC CL*47 +02278 WS-HOLD-X145-REC CL174 +02279 X145-REC. CL173 +02280 CL*48 +02281 *& CL*88 +02282 DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE CL*90 +02283 ' W-RROR-IND ' W-RPT-ERROR-IND CL*88 +02284 'LX-W-RROR-IND ' W-RPT-ERROR-IND. CL*90 +02285 P5000-EXIT. CL*25 +02286 EXIT. DTSBX530 +02287 DTSBX530 +02288 P6000-WRITE-PEND-X145. CL132 +02289 * IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-NO-88 CL132 +02290 * WRITE PEND-X140-REC FROM X140-REC CL132 +02291 * ELSE CL132 +02292 * IF LX42-REC-TYPE-RPT-88 AND W-X145-PAYMENT-YES-88 CL132 +02293 * WRITE PEND-X140-REC FROM X140-REC CL132 +02294 * WRITE PEND-X145-REC FROM X145-REC CL132 +02295 * ELSE CL132 +02296 * IF LX42-REC-TYPE-WAGE-88 CL132 +02297 * WRITE PEND-X144-REC FROM X144-REC CL132 +02298 * ELSE CL132 +02299 * IF LX42-REC-TYPE-PAY-88 CL132 +02300 * WRITE PEND-X145-REC FROM X145-REC CL132 +02301 * ELSE CL132 +02302 * DISPLAY ' INVALID RECORD TYPE ' LX42-REC-TYPE CL132 +02303 * PERFORM S999-ABEND THRU S999-EXIT. CL132 +02304 CL133 +02305 MOVE X145-REMITTANCE TO W-X145-REMITTANCE CL201 +02306 MOVE X145-EMP-NO TO P434-EMP-NO CL133 +02307 MOVE X145-QTR TO P434-QTR CL134 +02308 IF W-EMP-FOUND-YES-88 CL190 +02309 MOVE MPRF-PRIMARY-NAME (1:15) CL190 +02310 TO P434-NAME-CHECK CL190 +02311 ELSE CL190 +02312 MOVE '***NOT IN DUTAS' TO P434-NAME-CHECK CL196 +02313 END-IF. CL190 +02314 CL191 +02315 DISPLAY 'PAY TPE ' X145-PAY-TYPE CL196 +02316 IF X145-PAY-ACH-88 CL191 +02317 MOVE ' ACH ' TO P434-X145-TYPE CL212 +02318 ELSE CL191 +02319 IF X145-PAY-SCK-88 CL212 +02320 MOVE ' SUP ' TO P434-X145-TYPE CL212 +02321 ELSE CL212 +02322 MOVE ' CHK ' TO P434-X145-TYPE. CL212 +02323 CL197 +02324 MOVE SPACES TO P434-TRACE-NO W-TRACE-NO CL206 +02325 MOVE X145-TRACE-NO TO W-TRACE-NO CL206 +02326 MOVE W-TRACE-NOB TO P434-TRACE-NO CL206 +02327 CL133 +02328 MOVE X145-RCVD-DATE TO P434-RCVD-DATE CL133 +02329 MOVE X145-REMITTANCE TO P434-X145-REMIT CL198 +02330 * MOVE X145-REMITTANCE TO W-X145-REMIT CL220 +02331 CL133 +02332 IF W-RPT-ERROR-NO-88 CL189 +02333 MOVE '-X530 - PASSED TO DUTAS ' TO P434-MESSAGE CL206 +02334 ELSE CL188 +02335 MOVE '*X530 - **ERROR SENT TO PENDING ' TO P434-MESSAGE. CL206 +02336 CL133 +02337 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133 +02338 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL133 +02339 ADD 1 TO WS-LINE-CNT2. CL133 +02340 ADD +1 TO WS-NUMBER-ONE. CL133 +02341 GO TO P6000-EXIT. CL133 +02342 CL132 +02343 P6000-WRITE-PEND-X140. CL132 +02344 CL132 +02345 MOVE X140-EMP-NO TO P434-EMP-NO CL132 +02346 MOVE X140-QUARTER TO P434-QTR CL132 +02347 * IF W-EMP-FOUND-YES-88 CL135 +02348 * MOVE MPRF-PRIMARY-NAME (1:15) CL135 +02349 * TO P434-NAME-CHECK CL135 +02350 * ELSE CL135 +02351 MOVE 'RPT' TO P434-NAME-CHECK CL135 +02352 * END-IF. CL135 +02353 CL132 +02354 MOVE X140-RCVD-DATE TO P434-RCVD-DATE CL132 +02355 * MOVE X140-TOTAL-WAGES TO P434-TOT-WAGE CL192 +02356 * MOVE ZEROS TO P434-EXC-WAGE CL192 +02357 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL141 +02358 * MOVE X140-TAX-WAGES TO P434-TAX-WAGE CL192 +02359 * MOVE X140-REMITTANCE TO P434-X140-REMIT CL192 +02360 MOVE ZEROS TO P434-X145-REMIT CL138 +02361 CL132 +02362 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL132 +02363 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL132 +02364 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL132 +02365 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL132 +02366 CL132 +02367 * IF W-ERROR-NO-88 CL132 +02368 * MOVE 'PROCESSED' TO X434-DISPOSITION CL132 +02369 * ELSE CL132 +02370 * MOVE 'PENDING ' TO X434-DISPOSITION. CL132 +02371 * MOVE R140-MESSAGE TO P434-MESSAGE CL137 +02372 CL132 +02373 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL133 +02374 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL132 +02375 ADD 1 TO WS-LINE-CNT2. CL132 +02376 ADD +1 TO WS-NUMBER-ONE. CL132 +02377 GO TO P6000-EXIT. CL144 +02378 CL132 +02379 P6000-WRITE-PEND-X144. CL144 +02380 CL144 +02381 MOVE X140-EMP-NO TO P434-EMP-NO CL144 +02382 MOVE X140-QUARTER TO P434-QTR CL144 +02383 * IF W-EMP-FOUND-YES-88 CL144 +02384 * MOVE MPRF-PRIMARY-NAME (1:15) CL144 +02385 * TO P434-NAME-CHECK CL144 +02386 * ELSE CL144 +02387 MOVE 'WAGE' TO P434-NAME-CHECK CL144 +02388 * END-IF. CL144 +02389 CL144 +02390 MOVE SPACES TO P434-RCVD-DATE CL144 +02391 * MOVE ZEROS TO P434-TOT-WAGE CL192 +02392 * MOVE ZEROS TO P434-EXC-WAGE CL192 +02393 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE CL144 +02394 * MOVE ZEROS TO P434-TAX-WAGE CL192 +02395 * MOVE ZEROS TO P434-X140-REMIT CL192 +02396 MOVE ZEROS TO P434-X145-REMIT CL144 +02397 CL144 +02398 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. CL144 +02399 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. CL144 +02400 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. CL144 +02401 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. CL144 +02402 CL144 +02403 * IF W-ERROR-NO-88 CL144 +02404 * MOVE 'PROCESSED' TO X434-DISPOSITION CL144 +02405 * ELSE CL144 +02406 * MOVE 'PENDING ' TO X434-DISPOSITION. CL144 +02407 * MOVE R140-MESSAGE TO P434-MESSAGE CL144 +02408 CL144 +02409 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. CL144 +02410 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. CL144 +02411 ADD 1 TO WS-LINE-CNT2. CL144 +02412 ADD +1 TO WS-NUMBER-ONE. CL144 +02413 CL144 +02414 CL144 +02415 CL*59 +02416 P6000-EXIT. CL*59 +02417 EXIT. CL*59 +02418 CL*59 +02419 DTSBX530 +02420 P7000-COUNT-X145. CL215 +02421 CL215 +02422 IF W-PAY-ACH-88 CL220 +02423 ADD +1 TO W-A145-ERR-CNT CL215 +02424 ELSE CL215 +02425 IF W-PAY-CHK-88 CL220 +02426 ADD +1 TO W-C145-ERR-CNT CL215 +02427 ELSE CL215 +02428 IF W-PAY-SCK-88 CL221 +02429 ADD +1 TO W-S145-ERR-CNT CL215 +02430 ELSE CL215 +02431 DISPLAY ' ****** ERROR UNKNOW PAY TYPE ' X145-EMP-NO. CL215 +02432 CL215 +02433 P7000-EXIT. CL215 +02434 EXIT. CL215 +02435 CL215 +02436 T0000-TERMINATE. DTSBX530 +02437 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO CL121 +02438 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT CL194 +02439 END-IF. CL121 +02440 MOVE W-X145-RED-CNT TO WS-FOOTING-CNT. CL128 +02441 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. CL121 +02442 MOVE W-X145-PEN-CNT TO WS-X145-PEN-CNT. CL121 +02443 MOVE W-A145-RED-CNT TO WS-A145-RED-CNT. CL213 +02444 MOVE W-A145-ERR-CNT TO WS-A145-ERR-CNT. CL213 +02445 MOVE W-A145-SAV-CNT TO WS-A145-SAV-CNT. CL217 +02446 MOVE W-C145-RED-CNT TO WS-C145-RED-CNT. CL213 +02447 MOVE W-C145-ERR-CNT TO WS-C145-ERR-CNT. CL213 +02448 MOVE W-C145-SAV-CNT TO WS-C145-SAV-CNT. CL217 +02449 MOVE W-S145-RED-CNT TO WS-S145-RED-CNT. CL215 +02450 MOVE W-S145-ERR-CNT TO WS-S145-ERR-CNT. CL215 +02451 MOVE W-S145-SAV-CNT TO WS-S145-SAV-CNT. CL217 +02452 MOVE W-S145-TOT-AMT TO WS-S145-TOT-AMT. CL217 +02453 MOVE W-A145-TOT-AMT TO WS-A145-TOT-AMT. CL217 +02454 MOVE W-C145-TOT-AMT TO WS-C145-TOT-AMT. CL217 +02455 MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT. CL121 +02456 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL194 +02457 WRITE REPT-PEND-REC FROM FOOTING-LINE-2 AFTER 1. CL194 +02458 WRITE REPT-PEND-REC FROM FOOTING-LINE-6 AFTER 1. CL222 +02459 WRITE REPT-PEND-REC FROM FOOTING-LINE-7 AFTER 1. CL222 +02460 WRITE REPT-PEND-REC FROM FOOTING-LINE-8 AFTER 1. CL222 +02461 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222 +02462 WRITE REPT-PEND-REC FROM FOOTING-LINE-9 AFTER 1. CL194 +02463 WRITE REPT-PEND-REC FROM FOOTING-LINE-10 AFTER 1. CL194 +02464 WRITE REPT-PEND-REC FROM FOOTING-LINE-11 AFTER 1. CL194 +02465 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222 +02466 WRITE REPT-PEND-REC FROM FOOTING-LINE-12 AFTER 1. CL194 +02467 WRITE REPT-PEND-REC FROM FOOTING-LINE-13 AFTER 1. CL194 +02468 WRITE REPT-PEND-REC FROM FOOTING-LINE-14 AFTER 1. CL194 +02469 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222 +02470 WRITE REPT-PEND-REC FROM FOOTING-LINE-3 AFTER 1. CL222 +02471 WRITE REPT-PEND-REC FROM FOOTING-LINE-4 AFTER 1. CL222 +02472 WRITE REPT-PEND-REC FROM FOOTING-LINE-5 AFTER 1. CL222 +02473 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222 +02474 WRITE REPT-PEND-REC FROM FOOTING-LINE-14-2 BEFORE 1. CL224 +02475 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL224 +02476 WRITE REPT-PEND-REC FROM FOOTING-LINE-15 AFTER 1. CL222 +02477 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222 +02478 WRITE REPT-PEND-REC FROM FOOTING-LINE-1 AFTER 1. CL222 +02479 WRITE REPT-PEND-REC FROM FOOTING-LINE-16 AFTER 1. CL222 +02480 DISPLAY ' '. DTSBX530 +02481 DTSBX530 +02482 DTSBX530 +02483 DISPLAY ' '. DTSBX530 +02484 DISPLAY '***************************************'. CL*47 +02485 DISPLAY '*** DTSBX530 TERMINATION STATISTICS ***'. CL188 +02486 DISPLAY '*** ***ESSP-TDEC PAYMENTS SUMMARY *****'. CL188 +02487 DISPLAY '***************************************'. CL*47 +02488 DISPLAY ' '. DTSBX530 +02489 DTSBX530 +02490 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSBX530 +02491 DTSBX530 +02492 DISPLAY '***************************************'. DTSBX530 +02493 DTSBX530 +02494 CLOSE WAGE-FILE-OUT CL*20 +02495 PEND-X140-FILE CL*59 +02496 PEND-X144-FILE CL*59 +02497 X530-PAID-FILE CL233 +02498 X530-PEND-FILE CL233 +02499 PEND-X145-FILE CL120 +02500 TEMP-BTC-FILE CL*59 +02501 BATCH-XREF-FILE. CL*26 +02502 T0000-EXIT. DTSBX530 +02503 EXIT. DTSBX530 +02504 DTSBX530 +02505 DTSBX530 +02506 T2000-DISPLAY-TOTALS. DTSBX530 +02507 DISPLAY ' '. CL*92 +02508 DISPLAY '*X530 ESSP/TDEC CHECK AND ACH PAYMENTS **'. CL188 +02509 DISPLAY ' '. CL186 +02510 DISPLAY 'TOTAL X145-PAYMENTS RECORDS READ.......: ' CL*96 +02511 W-X145-RED-CNT. CL*92 +02512 CL*92 +02513 DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: ' CL*98 +02514 W-X145-SAV-CNT. CL*92 +02515 CL*92 +02516 DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: ' CL*96 +02517 W-T025-WRITE-CNT. CL*94 +02518 CL*94 +02519 DISPLAY ' NO OF X145-PAYMENTS WITH ZERO REMIT....: ' CL188 +02520 W-T025-WRITEO-CNT. CL100 +02521 CL100 +02522 DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: ' CL*96 +02523 W-X145-PEN-CNT. CL*92 +02524 DISPLAY ' NO OF X145-PAYMENTS HAD ERRORS.........: ' CL188 +02525 W-X145-ERR-CNT. CL*92 +02526 * DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: ' CL188 +02527 * W-X145-DUP-CNT. CL188 +02528 CL*92 +02529 CL*10 +02530 DISPLAY ' '. DTSBX530 +02531 DISPLAY '***** END X530 ESSP/TDEC PAYMENTS **** '. CL188 +02532 DTSBX530 +02533 T2000-EXIT. DTSBX530 +02534 EXIT. DTSBX530 +02535 DTSBX530 +02536 S001-FROM-FED-8. DTSBX530 +02537 SET L001-FROM-FED-8 TO TRUE. DTSBX530 +02538 GO TO S001-DATE. DTSBX530 +02539 DTSBX530 +02540 S001-FROM-CAL-8. DTSBX530 +02541 SET L001-FROM-CAL-8 TO TRUE. DTSBX530 +02542 GO TO S001-DATE. DTSBX530 +02543 DTSBX530 +02544 S001-FROM-ABS-DAY. DTSBX530 +02545 SET L001-FROM-ABS-DAY TO TRUE. DTSBX530 +02546 GO TO S001-DATE. DTSBX530 +02547 DTSBX530 +02548 S001-DATE. DTSBX530 +02549 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX530 +02550 S001-EXIT. DTSBX530 +02551 EXIT. DTSBX530 +02552 DTSBX530 +02553 S003-AGENCY-DAY. DTSBX530 +02554 SET L003-AGENCY-DAY TO TRUE. DTSBX530 +02555 GO TO S003-WORK-DAY. DTSBX530 +02556 DTSBX530 +02557 S003-WORK-DAY. DTSBX530 +02558 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX530 +02559 S003-EXIT. DTSBX530 +02560 EXIT. DTSBX530 +02561 DTSBX530 +02562 S004-FROM-5. DTSBX530 +02563 SET L004-FROM-5 TO TRUE. DTSBX530 +02564 GO TO S004-YRQ. DTSBX530 +02565 DTSBX530 +02566 S004-FROM-DATE. DTSBX530 +02567 SET L004-FROM-DATE TO TRUE. DTSBX530 +02568 GO TO S004-YRQ. DTSBX530 +02569 DTSBX530 +02570 S004-FROM-ABS. DTSBX530 +02571 SET L004-FROM-ABS TO TRUE. DTSBX530 +02572 GO TO S004-YRQ. DTSBX530 +02573 DTSBX530 +02574 S004-YRQ. DTSBX530 +02575 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX530 +02576 DTSBX530 +02577 S004-EXIT. DTSBX530 +02578 EXIT. DTSBX530 +02579 DTSBX530 +02580 S516-LIABILITY-INFO. DTSBX530 +02581 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX530 +02582 MPRF-REC. DTSBX530 +02583 S516-EXIT. DTSBX530 +02584 EXIT. DTSBX530 +02585 DTSBX530 +02586 S910-OPEN-READ. DTSBX530 +02587 SET L910-OPEN-READ-88 TO TRUE. DTSBX530 +02588 GO TO S910-MSTR-IO. DTSBX530 +02589 DTSBX530 +02590 S910-READ. DTSBX530 +02591 SET L910-READ-88 TO TRUE. DTSBX530 +02592 GO TO S910-MSTR-IO. DTSBX530 +02593 DTSBX530 +02594 S910-START-BROWSE. DTSBX530 +02595 SET L910-START-BROWSE-88 TO TRUE. DTSBX530 +02596 GO TO S910-MSTR-IO. DTSBX530 +02597 DTSBX530 +02598 S910-READ-NEXT. DTSBX530 +02599 SET L910-READ-NEXT-88 TO TRUE. DTSBX530 +02600 GO TO S910-MSTR-IO. DTSBX530 +02601 DTSBX530 +02602 S910-CLOSE. DTSBX530 +02603 SET L910-CLOSE-88 TO TRUE. DTSBX530 +02604 GO TO S910-MSTR-IO. DTSBX530 +02605 DTSBX530 +02606 S910-MSTR-IO. DTSBX530 +02607 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX530 +02608 MSKL-REC. DTSBX530 +02609 S910-EXIT. DTSBX530 +02610 EXIT. DTSBX530 +02611 DTSBX530 +02612 S921-OPEN-READ. DTSBX530 +02613 SET L921-OPEN-READ-88 TO TRUE. DTSBX530 +02614 GO TO S921-AIX-IO. DTSBX530 +02615 DTSBX530 +02616 S921-READ. DTSBX530 +02617 SET L921-READ-88 TO TRUE. DTSBX530 +02618 GO TO S921-AIX-IO. DTSBX530 +02619 DTSBX530 +02620 S921-START-BROWSE. DTSBX530 +02621 SET L921-START-BROWSE-88 TO TRUE. DTSBX530 +02622 GO TO S921-AIX-IO. DTSBX530 +02623 DTSBX530 +02624 S921-READ-NEXT. DTSBX530 +02625 SET L921-READ-NEXT-88 TO TRUE. DTSBX530 +02626 GO TO S921-AIX-IO. DTSBX530 +02627 DTSBX530 +02628 S921-CLOSE. DTSBX530 +02629 SET L921-CLOSE-88 TO TRUE. DTSBX530 +02630 GO TO S921-AIX-IO. DTSBX530 +02631 DTSBX530 +02632 S921-AIX-IO. DTSBX530 +02633 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX530 +02634 ISKL-REC. DTSBX530 +02635 S921-EXIT. DTSBX530 +02636 EXIT. DTSBX530 +02637 DTSBX530 +02638 S923-OPEN-UPDATE. DTSBX530 +02639 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX530 +02640 GO TO S923-ATC-CALL. DTSBX530 +02641 DTSBX530 +02642 S923-WRITE. DTSBX530 +02643 SET L923-WRITE-88 TO TRUE. DTSBX530 +02644 GO TO S923-ATC-CALL. DTSBX530 +02645 DTSBX530 +02646 S923-CLOSE. DTSBX530 +02647 SET L923-CLOSE-88 TO TRUE. DTSBX530 +02648 GO TO S923-ATC-CALL. DTSBX530 +02649 DTSBX530 +02650 S923-ATC-CALL. DTSBX530 +02651 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX530 +02652 ASKL-REC. DTSBX530 +02653 S923-EXIT. DTSBX530 +02654 EXIT. DTSBX530 +02655 DTSBX530 +02656 *S927A-OPEN. DTSBX530 +02657 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX530 +02658 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX530 +02659 * DTSBX530 +02660 *S927A-EXIT. DTSBX530 +02661 * EXIT. DTSBX530 +02662 DTSBX530 +02663 S927B-WRITE. DTSBX530 +02664 SET L927-WRITE-88 TO TRUE. DTSBX530 +02665 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX530 +02666 DTSBX530 +02667 S927B-EXIT. DTSBX530 +02668 EXIT. DTSBX530 +02669 DTSBX530 +02670 *S927C-CLOSE. DTSBX530 +02671 * SET L927-CLOSE-88 TO TRUE. DTSBX530 +02672 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX530 +02673 * DTSBX530 +02674 *S927C-EXIT. DTSBX530 +02675 * EXIT. DTSBX530 +02676 DTSBX530 +02677 S927Z-IO. DTSBX530 +02678 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX530 +02679 TSKL-REC. DTSBX530 +02680 S927Z-EXIT. DTSBX530 +02681 EXIT. DTSBX530 +02682 DTSBX530 +02683 S931-OPEN-READ. DTSBX530 +02684 SET L931-OPEN-READ-88 TO TRUE. DTSBX530 +02685 GO TO S931-REF-IO. DTSBX530 +02686 DTSBX530 +02687 S931-CLOSE. DTSBX530 +02688 SET L931-CLOSE-88 TO TRUE. DTSBX530 +02689 GO TO S931-REF-IO. DTSBX530 +02690 DTSBX530 +02691 S931-REF-IO. DTSBX530 +02692 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX530 +02693 FSKL-REC. DTSBX530 +02694 S931-EXIT. DTSBX530 +02695 EXIT. DTSBX530 +02696 DTSBX530 +02697 S1032-WRITE-TEMP-T028. DTSBX530 +02698 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSBX530 +02699 MOVE T028-REC TO TEMP-BTC-REC. DTSBX530 +02700 WRITE TEMP-BTC-REC. DTSBX530 +02701 IF TEMP-BTC-STATUS-OK-88 DTSBX530 +02702 NEXT SENTENCE DTSBX530 +02703 ELSE DTSBX530 +02704 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02705 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSBX530 +02706 TEMP-BTC-STATUS DTSBX530 +02707 END-IF. DTSBX530 +02708 DTSBX530 +02709 S1032-EXIT. CL**9 +02710 EXIT. DTSBX530 +02711 DTSBX530 +02712 S1033-WRITE-TEMP-T025. DTSBX530 +02713 MOVE T025-LENGTH TO VAR-CHAR-CNT. DTSBX530 +02714 MOVE T025-REC TO TEMP-BTC-REC. DTSBX530 +02715 WRITE TEMP-BTC-REC. DTSBX530 +02716 IF TEMP-BTC-STATUS-OK-88 DTSBX530 +02717 NEXT SENTENCE DTSBX530 +02718 ELSE DTSBX530 +02719 SET W-RPT-ERROR-YES-88 TO TRUE CL*81 +02720 DISPLAY 'CANNOT WRITE BTC X530: ' CL186 +02721 TEMP-BTC-STATUS DTSBX530 +02722 END-IF. DTSBX530 +02723 DTSBX530 +02724 S1033-EXIT. DTSBX530 +02725 EXIT. DTSBX530 +02726 DTSBX530 +02727 S1040-OPEN-TEMP-BTC-OUT. DTSBX530 +02728 OPEN OUTPUT TEMP-BTC-FILE. DTSBX530 +02729 IF TEMP-BTC-STATUS-OK-88 DTSBX530 +02730 NEXT SENTENCE DTSBX530 +02731 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX530 +02732 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSBX530 +02733 ELSE DTSBX530 +02734 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02735 DISPLAY 'CANNOT OPEN X530 BTC FILE OUTPUT: ' CL186 +02736 TEMP-BTC-STATUS DTSBX530 +02737 END-IF. DTSBX530 +02738 DTSBX530 +02739 S1040-EXIT. DTSBX530 +02740 EXIT. DTSBX530 +02741 DTSBX530 +02742 S1050-OPEN-TEMP-BTC-IN. DTSBX530 +02743 OPEN INPUT TEMP-BTC-FILE. DTSBX530 +02744 IF TEMP-BTC-STATUS-OK-88 DTSBX530 +02745 NEXT SENTENCE DTSBX530 +02746 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSBX530 +02747 *** DISPLAY 'TEMP BTC OPENED INP ' DTSBX530 +02748 ELSE DTSBX530 +02749 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02750 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBX530 +02751 TEMP-BTC-STATUS DTSBX530 +02752 END-IF. DTSBX530 +02753 DTSBX530 +02754 S1050-EXIT. DTSBX530 +02755 EXIT. DTSBX530 +02756 DTSBX530 +02757 S1060-CLOSE-TEMP-BTC. DTSBX530 +02758 CLOSE TEMP-BTC-FILE. DTSBX530 +02759 IF TEMP-BTC-STATUS-OK-88 DTSBX530 +02760 *** DISPLAY 'TEMP-BTC CLOSED' DTSBX530 +02761 NEXT SENTENCE DTSBX530 +02762 ELSE DTSBX530 +02763 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02764 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBX530 +02765 TEMP-BTC-STATUS DTSBX530 +02766 END-IF. DTSBX530 +02767 DTSBX530 +02768 S1060-EXIT. DTSBX530 +02769 EXIT. DTSBX530 +02770 DTSBX530 +02771 S1070-READ-TEMP-BTC. DTSBX530 +02772 READ TEMP-BTC-FILE. DTSBX530 +02773 IF TEMP-BTC-STATUS-OK-88 DTSBX530 +02774 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBX530 +02775 ELSE DTSBX530 +02776 IF TEMP-BTC-STATUS-EOF-88 DTSBX530 +02777 NEXT SENTENCE DTSBX530 +02778 ELSE DTSBX530 +02779 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBX530 +02780 TEMP-BTC-STATUS DTSBX530 +02781 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02782 END-IF DTSBX530 +02783 END-IF. DTSBX530 +02784 DTSBX530 +02785 S1070-EXIT. DTSBX530 +02786 EXIT. DTSBX530 +02787 DTSBX530 +02788 S1100-OPEN-WAGE-TEMP-OUT. DTSBX530 +02789 OPEN OUTPUT WAGE-FILE-TEMP. DTSBX530 +02790 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530 +02791 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02792 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSBX530 +02793 WAGE-TEMP-STATUS DTSBX530 +02794 END-IF. DTSBX530 +02795 DTSBX530 +02796 S1100-EXIT. DTSBX530 +02797 EXIT. DTSBX530 +02798 DTSBX530 +02799 S1110-CLOSE-WAGE-TEMP. DTSBX530 +02800 CLOSE WAGE-FILE-TEMP. DTSBX530 +02801 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530 +02802 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02803 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBX530 +02804 WAGE-TEMP-STATUS DTSBX530 +02805 END-IF. DTSBX530 +02806 DTSBX530 +02807 S1110-EXIT. DTSBX530 +02808 EXIT. DTSBX530 +02809 DTSBX530 +02810 S1120-WRITE-WAGE-TEMP. DTSBX530 +02811 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBX530 +02812 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530 +02813 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02814 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBX530 +02815 WAGE-TEMP-STATUS DTSBX530 +02816 END-IF. DTSBX530 +02817 DTSBX530 +02818 S1120-EXIT. DTSBX530 +02819 EXIT. DTSBX530 +02820 DTSBX530 +02821 S1130-OPEN-WAGE-TEMP-IN. DTSBX530 +02822 OPEN INPUT WAGE-FILE-TEMP. DTSBX530 +02823 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530 +02824 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02825 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSBX530 +02826 WAGE-TEMP-STATUS DTSBX530 +02827 END-IF. DTSBX530 +02828 DTSBX530 +02829 S1130-EXIT. DTSBX530 +02830 EXIT. DTSBX530 +02831 DTSBX530 +02832 S1140-READ-WAGE-TEMP. DTSBX530 +02833 READ WAGE-FILE-TEMP INTO W001-REC. DTSBX530 +02834 IF WAGE-TEMP-STATUS-EOF-88 DTSBX530 +02835 NEXT SENTENCE DTSBX530 +02836 ELSE DTSBX530 +02837 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX530 +02838 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX530 +02839 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSBX530 +02840 WAGE-TEMP-STATUS DTSBX530 +02841 END-IF DTSBX530 +02842 END-IF. DTSBX530 +02843 DTSBX530 +02844 S1140-EXIT. DTSBX530 +02845 EXIT. DTSBX530 +02846 DTSBX530 +02847 S1150-OPEN-WAGE-FILE-OUT. CL*20 +02848 OPEN OUTPUT WAGE-FILE-OUT. CL*20 +02849 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02850 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02851 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' CL*20 +02852 WAGE-OUT-STATUS CL*20 +02853 END-IF. CL*20 +02854 DTSBX530 +02855 S1150-EXIT. CL*20 +02856 EXIT. CL*20 +02857 DTSBX530 +02858 S1160-CLOSE-WAGE-OUT. CL*20 +02859 CLOSE WAGE-FILE-OUT. CL*20 +02860 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02861 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02862 DISPLAY 'CANNOT CLOSE WAGE FILE: ' CL*20 +02863 WAGE-OUT-STATUS CL*20 +02864 END-IF. CL*20 +02865 DTSBX530 +02866 S1160-EXIT. CL*20 +02867 EXIT. CL*20 +02868 DTSBX530 +02869 S1170-WRITE-WAGE-OUT. CL*20 +02870 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. CL*20 +02871 WRITE WAGE-OUT-REC. CL*20 +02872 IF NOT WAGE-OUT-STATUS-OK-88 CL*20 +02873 SET W-FATAL-ERROR-YES-88 TO TRUE CL*20 +02874 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' CL*20 +02875 WAGE-OUT-STATUS CL*20 +02876 END-IF. CL*20 +02877 DTSBX530 +02878 S1170-EXIT. CL*20 +02879 EXIT. CL*20 +02880 DTSBX530 +02881 S946-WRITE-R140. DTSBX530 +02882 CALL 'DTSBU946' USING R140-REC. DTSBX530 +02883 DTSBX530 +02884 S946-EXIT. DTSBX530 +02885 EXIT. DTSBX530 +02886 DTSBX530 +02887 S999-ABEND. DTSBX530 +02888 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX530 +02889 S999-EXIT. DTSBX530 +02890 EXIT. DTSBX530 +02891 DTSBX530 diff --git a/Batch/DTSBX601.cob b/Batch/DTSBX601.cob new file mode 100644 index 0000000..57620f2 --- /dev/null +++ b/Batch/DTSBX601.cob @@ -0,0 +1,963 @@ +00001 IDENTIFICATION DIVISION. 09/24/18 +00002 PROGRAM-ID. DTSBX601. DTSBX601 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV124 +00004 DATE-WRITTEN. DECEMBER 1998. CL**5 +00005 DATE-COMPILED. DTSBX601 +00006 SKIP3 DTSBX601 +00007 ***** DTSBX601 +00008 * DTSBX601 +00009 * FUNCTION: REPORT ALL RETURN FLAG UPDATED PRIOR DAY. CL*83 +00010 * DTSBX601 +00011 * DTSBX601 +00012 ***** DTSBX601 +00013 SKIP3 DTSBX601 +00014 ENVIRONMENT DIVISION. DTSBX601 +00015 SKIP2 DTSBX601 +00016 CONFIGURATION SECTION. CL*74 +00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*74 +00018 CL*74 +00019 INPUT-OUTPUT SECTION. CL193 +00020 CL*74 +00021 FILE-CONTROL. CL193 +00022 SELECT EXP-FILE1 ASSIGN TO DTSFX601 CL*85 +00023 FILE STATUS IS EXP-STATUS. CL*85 +00024 CL*74 +00025 DATA DIVISION. CL*74 +00026 CL*74 +00027 FILE SECTION. CL193 +00028 CL193 +00029 FD EXP-FILE1 CL*85 +00030 RECORDING MODE IS F. CL*85 +00031 01 EXP-REC1 PIC X(80). CL*85 +00032 EJECT CL*74 +00033 CL*74 +00034 WORKING-STORAGE SECTION. DTSBX601 +000345 77 PAN-VALET PICTURE X(24) VALUE '124DTSBX601 09/24/18'. DTSBX601 +00035 SKIP3 DTSBX601 +00036 01 WRK-AREA. DTSBX601 +00037 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSBX601 +00038 DTSBX601 +00039 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'. CL**2 +00040 CL181 +00041 05 WRK-RATE-TYPE-AREA. CL181 +00042 10 WRK-RATE-YR-SCHED PIC X(01). CL181 +00043 88 WRK-RATE-YR-ANN-88 VALUE 'Y'. CL181 +00044 10 WRK-RATE-YR-MINUS-1-SCHED PIC X(01). CL181 +00045 88 WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'. CL181 +00046 10 WRK-RATE-YR-MINUS-2-SCHED PIC X(01). CL181 +00047 88 WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'. CL181 +00048 05 FILLER REDEFINES WRK-RATE-TYPE-AREA PIC X(03). CL181 +00049 88 WRK-ESTIMATE-NEEDED-88 VALUE 'YYY' 'NYY'. CL185 +00050 88 WRK-TRANSITION-YEAR-88 VALUE 'YYN' 'NYN'. CL185 +00051 88 WRK-INIT-VALUES-88 VALUE 'NNN'. CL181 +00052 DTSBX601 +00053 05 WRK-SEQ PIC 9(05) CL*29 +00054 VALUE ZERO. CL*21 +00055 05 MLOG-CNT PIC 9(05) CL*86 +00056 VALUE ZERO. CL*86 +00057 05 WRK-ZIP PIC X(10). CL197 +00058 05 FILLER REDEFINES WRK-ZIP. CL197 +00059 10 WRK-ZIP5 PIC X(05). CL197 +00060 10 FILLER PIC X(05). CL197 +00061 CL197 +00062 05 EXP-STATUS PIC X(02). CL193 +00063 88 EXP-STATUS-OK-88 VALUE '00'. CL194 +00064 05 WRK-ERROR-IND PIC X(01). CL193 +00065 88 WRK-ERROR-YES-88 VALUE 'Y'. CL193 +00066 88 WRK-ERROR-NO-88 VALUE 'N'. CL193 +00067 05 WRK-MPRF-IND PIC X(01). CL*93 +00068 88 MPRF-OK-YES-88 VALUE 'Y'. CL*93 +00069 88 MPRF-NO-REC-88 VALUE 'N'. CL*93 +00070 05 WRK-WRITE-REC-IND PIC X(01). CL225 +00071 88 WRK-WRITE-REC-YES-88 VALUE 'Y'. CL225 +00072 88 WRK-WRITE-REC-NO-88 VALUE 'N'. CL225 +00073 05 WRK-OP-ID PIC X(08). CL236 +00074 05 WRK-IND-CODE PIC X(06). CL**9 +00075 05 WRK-REC1. CL193 +00076 10 REC1-EMP-NO PIC 999999. CL*21 +00077 10 FILLER PIC X(01) VALUE ','. CL*29 +00078 10 REC1-FLAG PIC X(01). CL*99 +00079 10 FILLER PIC X(01) VALUE ','. CL*33 +00080 10 REC1-DATE PIC 9(08). CL100 +00081 10 FILLER PIC X(01) VALUE ','. CL*44 +00082 10 REC1-OPID PIC X(08). CL*99 +00083 10 WRK-R1-SPACES PIC X(54). CL108 +00084 05 WRK-REC1-OLD. CL*21 +00085 10 REC1-BALANCE PIC --------9.99. CL*53 +00086 10 REC1-LP-BAL PIC --------9.99. CL*53 +00087 10 REC1-INT-BAL PIC --------9.99. CL*53 +00088 10 REC1-ZIP PIC 9(05). CL*53 +00089 10 REC1-ORG-TYPE PIC X(03). CL*47 +00090 10 REC1-CLASS PIC X(02). CL*47 +00091 10 REC1-LIAB-CD PIC X(02). CL*47 +00092 10 REC1-RCVD-DATE PIC X(10). CL*44 +00093 10 REC1-BATCH PIC 9(05). CL*44 +00094 10 REC1-ITEM PIC 9(03). CL*44 +00095 10 REC1-LP-CHG PIC --------9.99. CL*44 +00096 10 REC1-INT-CHG PIC --------9.99. CL*37 +00097 10 REC1-SOURCE PIC X(02). CL*31 +00098 10 REC1-MLOG-DATE PIC X(10). CL**8 +00099 10 REC1-IND-CODE PIC X(06). CL**8 +00100 10 REC1-OP-ID PIC X(08). CL**8 +00101 10 REC1-LIAB-DATE PIC X(10). CL**8 +00102 10 REC1-ASSIGN PIC 9(09). CL**5 +00103 10 REC1-COUNT PIC 9(07). CL**5 +00104 10 REC1-DEPOSIT-DATE PIC X(10). CL253 +00105 10 REC1-PROCESS-DATE PIC X(10). CL253 +00106 10 REC1-LIAB-ENTER-DATE PIC X(10). CL232 +00107 10 REC1-INACT-CODE PIC X(05). CL235 +00108 88 REC1-INACT-YES-88 VALUE 'INACT'. CL235 +00109 88 REC1-INACT-NO-88 VALUE 'ACT '. CL235 +00110 10 REC1-REACT PIC X(05). CL235 +00111 88 REC1-REACT-NO-88 VALUE 'NEW '. CL235 +00112 88 REC1-REACT-YES-88 VALUE 'REACT'. CL235 +00113 10 REC1-CREDIT PIC --------9.99. CL249 +00114 10 REC1-AREA PIC X(03). CL249 +00115 10 REC1-PFX PIC X(03). CL249 +00116 10 REC1-SFX PIC X(04). CL249 +00117 10 REC1-EXT PIC X(05). CL249 +00118 10 REC1-PAY-TYPE PIC X(02). CL225 +00119 10 REC1-AMT PIC --------9.99. CL225 +00120 05 WRK-ABS-QTR1 PIC S9(04) COMP-3 CL206 +00121 VALUE +0. CL206 +00122 05 WRK-ABS-QTR2 PIC S9(04) COMP-3 CL206 +00123 VALUE +0. CL206 +00124 05 WRK-ABS-DATE1 PIC S9(08) COMP. CL**1 +00125 05 WRK-ABS-DATE2 PIC S9(08) COMP. CL**1 +00126 05 WRK-EXT-CURRENT-DATE PIC S9(09) COMP-3. CL*84 +00127 05 WRK-DIFF PIC S9(07) COMP-3. CL*84 +00128 05 WRK-UNDER-30-CNT PIC S9(04) COMP-3 CL*19 +00129 VALUE +0. CL220 +00130 05 WRK-OVER-31-CNT PIC S9(04) COMP-3 CL*19 +00131 VALUE +0. CL220 +00132 05 WRK-MEVL-READ-CNT PIC S9(04) COMP-3 CL*72 +00133 VALUE +0. CL*72 +00134 05 WRK-MPRF-CNT PIC S9(07) COMP-3. CL220 +00135 05 WRK-FISCAL-AGENT-CD PIC X(03). CL239 +00136 05 WRK-BNK-IND PIC X(02). CL*38 +00137 05 WRK-FIRST-NEW-EMP-NO PIC S9(07) COMP-3. CL101 +00138 *& VALUE +123778. CL101 +00139 05 WRK-FEIN PIC 9(09). CL104 +00140 05 WRK-MQTR-BAL PIC S9(11)V99 COMP-3 VALUE +0. CL136 +00141 05 WRK-MQTR-CHG PIC S9(09)V99 COMP-3. CL**6 +00142 05 WRK-MQTR-ANN-BAL PIC S9(07)V99 COMP-3. CL234 +00143 05 WRK-MQTR-PEN-BAL PIC S9(07)V99 COMP-3. CL**1 +00144 05 WRK-MQTR-PEN-CHG PIC S9(07)V99 COMP-3. CL*34 +00145 05 WRK-MQTR-INT-BAL PIC S9(07)V99 COMP-3. CL**1 +00146 05 WRK-MQTR-INT-CHG PIC S9(07)V99 COMP-3. CL*34 +00147 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3. CL*18 +00148 05 WRK-RPT-BAL-CNT PIC S9(07) COMP-3. CL*18 +00149 05 WRK-RPT-CNT PIC S9(07) COMP-3. CL195 +00150 05 WRK-BAL-CNT PIC S9(07) COMP-3. CL195 +00151 05 WRK-REL-CNT PIC S9(07) COMP-3. CL195 +00152 05 WRK-RATED-CNT PIC S9(07) COMP-3. CL*99 +00153 05 WRK-SELF-INS-CNT PIC S9(07) COMP-3. CL*99 +00154 05 WRK-HOTEL-CNT PIC S9(07) COMP-3 VALUE +0. CL251 +00155 05 WRK-TOT-EMPS PIC S9(07) COMP-3 VALUE +0. CL251 +00156 05 WRK-TOT-WORKERS PIC S9(11) COMP-3 VALUE +0. CL251 +00157 05 WRK-PURSUED-RPT-CNT PIC S9(07) COMP-3. CL205 +00158 05 WRK-LATE-RPT-CNT PIC S9(07) COMP-3. CL104 +00159 05 WRK-MEVL-DELETED-CNT PIC S9(07) COMP-3. CL*61 +00160 05 WRK-UC30-SENT-CNT PIC S9(07) COMP-3. CL188 +00161 05 WRK-UC30-RCVD-CNT PIC S9(07) COMP-3. CL188 +00162 05 WRK-OVER-1000-CNT PIC S9(07) COMP-3. CL*42 +00163 05 WRK-UNDER-1000-CNT PIC S9(07) COMP-3. CL*42 +00164 05 WRK-HOUSEHOLD-PAYMENTS PIC S9(11)V99 COMP-3. CL*43 +00165 05 WRK-TOT-WAGES PIC S9(11)V99 COMP-3. CL*43 +00166 05 WRK-ALL-BNK-RATED PIC S9(11)V99 COMP-3. CL154 +00167 05 WRK-OPN-BNK-RATED PIC S9(11)V99 COMP-3. CL154 +00168 05 WRK-ALL-BNK-SI PIC S9(11)V99 COMP-3. CL154 +00169 05 WRK-OPN-BNK-SI PIC S9(11)V99 COMP-3. CL154 +00170 05 WRK-BOND-AMT PIC S9(11)V99 COMP-3. CL142 +00171 05 WRK-OVER-100-CNT PIC S9(07) COMP-3 CL112 +00172 VALUE +0. CL112 +00173 05 WRK-OVER-100-AMT PIC S9(11)V99 COMP-3 CL112 +00174 VALUE +0. CL112 +00175 05 WRK-1-10-CNT PIC S9(07) COMP-3 CL113 +00176 VALUE +0. CL112 +00177 05 WRK-1-10-AMT PIC S9(11)V99 COMP-3 CL112 +00178 VALUE +0. CL112 +00179 05 WRK-11-100-CNT PIC S9(07) COMP-3 CL113 +00180 VALUE +0. CL112 +00181 05 WRK-11-100-AMT PIC S9(11)V99 COMP-3 CL112 +00182 VALUE +0. CL112 +00183 05 WRK-OVER-100-WRKRS PIC S9(07) COMP-3. CL190 +00184 05 WRK-100-249-CNT PIC S9(07) COMP-3. CL*47 +00185 05 WRK-100-249-WRKRS PIC S9(07) COMP-3. CL*56 +00186 05 WRK-50-100-CNT PIC S9(07) COMP-3. CL190 +00187 05 WRK-50-100-WRKRS PIC S9(07) COMP-3. CL190 +00188 05 WRK-25-49-CNT PIC S9(07) COMP-3. CL*59 +00189 05 WRK-25-49-WRKRS PIC S9(07) COMP-3. CL190 +00190 05 WRK-10-24-CNT PIC S9(07) COMP-3. CL190 +00191 05 WRK-10-24-WRKRS PIC S9(07) COMP-3. CL190 +00192 05 WRK-6-9-CNT PIC S9(07) COMP-3. CL225 +00193 05 WRK-5-9-WRKRS PIC S9(07) COMP-3. CL*94 +00194 05 WRK-5-CNT PIC S9(07) COMP-3. CL*97 +00195 05 WRK-4-CNT PIC S9(07) COMP-3. CL*97 +00196 05 WRK-3-CNT PIC S9(07) COMP-3. CL*97 +00197 05 WRK-2-CNT PIC S9(07) COMP-3. CL*97 +00198 05 WRK-1-CNT PIC S9(07) COMP-3. CL*97 +00199 05 WRK-UNDER-5-CNT PIC S9(07) COMP-3. CL*94 +00200 05 WRK-UNDER-5-WRKRS PIC S9(07) COMP-3. CL*94 +00201 05 WRK-UNDER-10-CNT PIC S9(07) COMP-3. CL*47 +00202 05 WRK-OVER-10-CNT PIC S9(07) COMP-3. CL225 +00203 05 WRK-UNDER-10-WRKRS PIC S9(07) COMP-3. CL*56 +00204 05 WRK-NO-EMPS-CNT PIC S9(07) COMP-3. CL*52 +00205 05 WRK-MRCT-TOT-WAGES PIC S9(11)V99 COMP-3. CL*72 +00206 05 WRK-MRCT-TAX-WAGES PIC S9(11)V99 COMP-3. CL*72 +00207 05 WRK-MRCT-UI-PAID PIC S9(11)V99 COMP-3. CL*72 +00208 05 WRK-TOT-UI PIC S9(11)V99 COMP-3. CL**6 +00209 05 WRK-TOT-INT PIC S9(11)V99 COMP-3. CL**6 +00210 05 WRK-TOT-PEN PIC S9(11)V99 COMP-3. CL**6 +00211 05 WRK-MQTR-ANN-TOT-WAGE PIC S9(12)V99 COMP-3. CL*84 +00212 05 WRK-MQTR-ANN-TAX-WAGE PIC S9(12)V99 COMP-3. CL*84 +00213 05 WRK-MJRN-TOT-NEG-CHG PIC S9(11)V99 COMP-3 CL252 +00214 VALUE +0. CL252 +00215 05 WRK-MQTR-TOT-UI-CHARGED PIC S9(11)V99 COMP-3. CL*76 +00216 05 WRK-START-DATE PIC S9(09) COMP-3. CL*10 +00217 05 WRK-END-DATE PIC S9(09) COMP-3. CL*10 +00218 05 WRK-LIAB-DATE PIC S9(09) COMP-3. CL*71 +00219 05 WRK-FIRST-LIAB-DATE PIC S9(09) COMP-3. CL*71 +00220 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 CL*71 +00221 VALUE +999999999. CL*71 +00222 05 WRK-BNK-PETITION-DATE PIC 9(08). CL*89 +00223 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. CL*89 +00224 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). CL*89 +00225 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). CL*89 +00226 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). CL*89 +00227 05 WRK-BNK-PETITION-YRQ PIC 9(05). CL*89 +00228 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. CL*89 +00229 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). CL*89 +00230 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). CL*89 +00231 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. CL*89 +00232 05 WRK-EST-RPT-IND PIC X(01). CL*90 +00233 88 WRK-EST-RPT-YES VALUE 'Y'. CL*90 +00234 88 WRK-EST-RPT-NO VALUE 'N'. CL*90 +00235 CL*19 +00236 05 WRK-ZERO-FOUND-IND PIC X(01). CL100 +00237 88 WRK-ZERO-FOUND-YES-88 VALUE 'Y'. CL100 +00238 88 WRK-ZERO-FOUND-NO-88 VALUE 'N'. CL100 +00239 CL*41 +00240 05 WRK-WITHDRAWN-IND PIC X(01). CL*41 +00241 88 WRK-WITHDRAWN-YES VALUE 'Y'. CL*41 +00242 88 WRK-WITHDRAWN-NO VALUE 'N'. CL*41 +00243 CL153 +00244 05 WRK-ORIG-IND PIC X(01). CL153 +00245 88 WRK-ORIG-YES VALUE 'Y'. CL153 +00246 88 WRK-ORIG-NO VALUE 'N'. CL153 +00247 CL*72 +00248 05 WRK-MQTR-CNT PIC S9(07) COMP-3. CL**9 +00249 05 WRK-MRPT-CNT PIC S9(07) COMP-3. CL191 +00250 05 WRK-MSOL-CNT PIC S9(07) COMP-3. CL*32 +00251 05 WRK-MLIN-CNT PIC S9(07) COMP-3. CL118 +00252 05 WRK-MFAS-CNT PIC S9(07) COMP-3. CL198 +00253 05 WRK-MFAE-CNT PIC S9(07) COMP-3. CL237 +00254 05 WRK-MPAY-CNT PIC S9(07) COMP-3. CL150 +00255 05 WRK-MADJ-CNT PIC S9(07) COMP-3. CL153 +00256 05 WRK-MJRN-CNT PIC S9(08) COMP-3. CL155 +00257 05 WRK-MERA-CNT PIC S9(08) COMP-3. CL231 +00258 05 WRK-MRTE-CNT PIC S9(08) COMP-3. CL**9 +00259 05 WRK-MRTE-CNT1 PIC S9(08) COMP-3. CL163 +00260 05 WRK-MLOG-CNT PIC S9(08) COMP-3. DTSBX601 +00261 05 WRK-MFSC-CNT PIC S9(08) COMP-3 CL*40 +00262 VALUE +0. CL*40 +00263 05 WRK-CR-TOL-CNT PIC S9(07) COMP-3. CL146 +00264 05 SUB PIC S9(04) COMP. CL147 +00265 05 RPT-SUB PIC S9(04) COMP. CL147 +00266 05 QTR-SUB PIC S9(04) COMP. CL113 +00267 05 WRK-QTR-AREA OCCURS 20 TIMES. CL113 +00268 10 WRK-QTR-YRQ PIC S9(05) COMP-3. CL113 +00269 10 WRK-QTR-CHG PIC S9(09)V99 COMP-3. CL113 +00270 10 WRK-QTR-PAID PIC S9(09)V99 COMP-3. CL113 +00271 10 WRK-QTR-WAIVED PIC S9(09)V99 COMP-3. CL113 +00272 10 WRK-QTR-TOLERATED PIC S9(09)V99 COMP-3. CL113 +00273 05 WRK-TIMELY-PMT-AREA. CL190 +00274 10 WRK-PEN-INT-BAL-CNT PIC S9(07) COMP-3. CL181 +00275 10 WRK-INT-MANUAL-CNT PIC S9(07) COMP-3. CL181 +00276 10 WRK-QTR-TAX-BAL PIC S9(09)V9(02) COMP-3. CL170 +00277 10 WRK-QTR-TAX-CHG PIC S9(09)V9(02) COMP-3. CL170 +00278 10 WRK-QTR-INT-PEN-BAL PIC S9(09)V9(02) COMP-3. CL170 +00279 10 WRK-AVG-PMT PIC S9(09)V9(02) COMP-3. CL116 +00280 10 WRK-TIMELY-PMT PIC S9(09)V9(02) COMP-3. CL133 +00281 10 WRK-OLD-PEN-CHG PIC S9(09)V9(02) COMP-3. CL132 +00282 CL170 +00283 05 WRK-YRQ PIC S9(05) COMP-3 CL171 +00284 VALUE +20041. CL*51 +00285 05 WRK-PCT PIC S9(03)V9(04) COMP-3 CL142 +00286 VALUE +0. CL142 +00287 05 WRK-AVG-PCT PIC S9(09)V9(04) COMP-3 CL142 +00288 VALUE +0. CL142 +00289 05 WRK-PCT-DISP PIC Z(02)9.9999. CL118 +00290 05 WRK-PCT-DISP1 PIC Z(02)9.9999. CL119 +00291 05 WRK-UI-RATE PIC S9(01)V9(04) COMP-3. CL118 +00292 05 DISP-UI-RATE1 PIC 9.9(04). CL135 +00293 05 DISP-UI-RATE2 PIC 9.9(04). CL135 +00294 05 AMT-DISP PIC ---,---,--9.99. CL242 +00295 05 WRK-AMT-DISP PIC --------9.99. CL*82 +00296 05 AMT-DISP1 PIC Z(11)9.99-. CL102 +00297 05 AMT-DISP2 PIC Z(11)9.99-. CL141 +00298 05 AMT-DISP3 PIC Z(11)9-. CL237 +00299 05 EMP-ACCT-DISP PIC 9(06). CL183 +00300 05 EMP-SUCC-DISP PIC 9(06). CL*86 +00301 05 EMP-SUCC-DISP-X REDEFINES EMP-SUCC-DISP CL*88 +00302 PIC X(06). CL*87 +00303 05 DISP-DATE1 PIC X(10). CL232 +00304 05 DISP-DATE2 PIC X(10). CL232 +00305 05 INACT-LBL PIC X(10). CL*71 +00306 05 WRK-MPRF-IND PIC X(01). CL*42 +00307 88 WRK-MPRF-OK VALUE 'Y'. CL*42 +00308 88 WRK-MPRF-NO-REC VALUE 'N'. CL*42 +00309 05 WRK-MQTR-IND PIC X(01). CL*42 +00310 88 WRK-MQTR-OK VALUE 'Y'. CL*42 +00311 88 WRK-MQTR-NO-REC VALUE 'N'. CL*42 +00312 05 WRK-MRPT-IND PIC X(01). CL*77 +00313 88 WRK-MRPT-OK VALUE 'Y'. CL*77 +00314 88 WRK-MRPT-NO-REC VALUE 'N'. CL*77 +00315 05 WRK-MDST-IND PIC X(01). CL169 +00316 88 WRK-MDST-OK VALUE 'Y'. CL169 +00317 88 WRK-MDST-NO-REC VALUE 'N'. CL169 +00318 05 WRK-MEVL-IND PIC X(01). CL111 +00319 88 WRK-MEVL-OK VALUE 'Y'. CL111 +00320 88 WRK-MEVL-NO-REC VALUE 'N'. CL111 +00321 05 WRK-MLIN-IND PIC X(01). CL116 +00322 88 WRK-MLIN-OK VALUE 'Y'. CL116 +00323 88 WRK-MLIN-NO-REC VALUE 'N'. CL116 +00324 05 WRK-MFAS-IND PIC X(01). CL198 +00325 88 WRK-MFAS-OK VALUE 'Y'. CL198 +00326 88 WRK-MFAS-NO-REC VALUE 'N'. CL198 +00327 05 WRK-MFAE-IND PIC X(01). CL237 +00328 88 WRK-MFAE-OK VALUE 'Y'. CL237 +00329 88 WRK-MFAE-NO-REC VALUE 'N'. CL237 +00330 05 WRK-MSOL-IND PIC X(01). CL237 +00331 88 WRK-MSOL-OK VALUE 'Y'. CL160 +00332 88 WRK-MSOL-NO-REC VALUE 'N'. CL160 +00333 05 WRK-MLOG-IND PIC X(01). DTSBX601 +00334 88 WRK-MLOG-OK VALUE 'Y'. DTSBX601 +00335 88 WRK-MLOG-NO-REC VALUE 'N'. DTSBX601 +00336 88 WRK-MLOG-COMPLETE VALUE 'C'. DTSBX601 +00337 05 WRK-MRPT-FOUND-IND PIC X(01). CL*96 +00338 88 WRK-MRPT-FOUND-YES VALUE 'Y'. CL*98 +00339 88 WRK-MRPT-FOUND-NO VALUE 'N'. CL*98 +00340 05 WRK-CR-TOL-IND PIC X(01). CL146 +00341 88 WRK-CR-TOL-YES VALUE 'Y'. CL146 +00342 88 WRK-CR-TOL-NO VALUE 'N'. CL146 +00343 05 WRK-DUP-FOUND-IND PIC X(01). CL193 +00344 88 WRK-DUP-FOUND-YES VALUE 'Y'. CL193 +00345 88 WRK-DUP-FOUND-NO VALUE 'N'. CL193 +00346 05 WRK-LAST-MRPT-TYPE PIC X(02). CL*77 +00347 05 WRK-DISP-AREA. CL216 +00348 10 WRK-DISP-STAR PIC X(01). CL216 +00349 10 FILLER PIC X(01) VALUE SPACE. CL216 +00350 10 WRK-DISP-AMT PIC Z(10)9.99-. CL216 +00351 CL**9 +00352 05 WRK-INACT-DATE PIC S9(09) COMP-3 CL184 +00353 VALUE +0. CL184 +00354 05 WRK-INACT-CODE PIC X(02). CL232 +00355 05 WRK-INACT-YRQ PIC S9(05) COMP-3 CL184 +00356 VALUE +0. CL184 +00357 05 WRK-LAST-YRQ PIC S9(05) COMP-3 CL184 +00358 VALUE +0. CL184 +00359 05 WRK-FIRST-LIAB-YRQ PIC S9(05) COMP-3 CL232 +00360 VALUE +0. CL217 +00361 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 CL232 +00362 VALUE +0. CL232 +00363 05 WRK-NEXT-YRQ PIC S9(05) COMP-3 CL196 +00364 VALUE +0. CL196 +00365 05 WRK-UPDATED-CNT PIC S9(07) COMP-3. DTSBX601 +00366 DTSBX601 +00367 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBX601 +00368 DTSBX601 +00369 05 PARM-EOF-IND PIC X(01). DTSBX601 +00370 DTSBX601 +00371 05 WRK-EMP-NO PIC 9(06). CL*31 +00372 DTSBX601 +00373 05 WRK-TRACE-IND PIC X(01). DTSBX601 +00374 DTSBX601 +00375 05 WRK-MST-OPEN-IND PIC X(01). DTSBX601 +00376 DTSBX601 +00377 05 WRK-REF-OPEN-IND PIC X(01). DTSBX601 +00378 CL221 +00379 05 WRK-SIC-SCAN-AREA. CL221 +00380 10 WRK-RPT-FOUND-IND PIC X(01). CL222 +00381 88 WRK-RPT-FOUND-YES VALUE 'Y'. CL222 +00382 88 WRK-RPT-FOUND-NO VALUE 'N'. CL222 +00383 10 WRK-EMPL-CNT PIC S9(07) COMP-3. CL222 +00384 10 WRK-SIC-4 PIC X(04). CL221 +00385 10 FILLER REDEFINES WRK-SIC-4. CL221 +00386 15 WRK-SIC-3 PIC X(03). CL221 +00387 15 FILLER PIC X(01). CL221 +00388 10 WRK-NO-SIC-CNT PIC S9(07) COMP-3. CL221 +00389 10 WRK-SIC-7911-AREA. CL221 +00390 15 WRK-SIC-7911-WORKERS PIC S9(07) COMP-3. CL224 +00391 15 WRK-SIC-7911-BUSINESSES PIC S9(07) COMP-3. CL224 +00392 10 WRK-SIC-794-AREA. CL221 +00393 15 WRK-SIC-794-WORKERS PIC S9(07) COMP-3. CL221 +00394 15 WRK-SIC-794-BUSINESSES PIC S9(07) COMP-3. CL221 +00395 10 WRK-SIC-799-AREA. CL221 +00396 15 WRK-SIC-799-WORKERS PIC S9(07) COMP-3. CL221 +00397 15 WRK-SIC-799-BUSINESSES PIC S9(07) COMP-3. CL221 +00398 10 WRK-SIC-8351-AREA. CL221 +00399 15 WRK-SIC-8351-WORKERS PIC S9(07) COMP-3. CL221 +00400 15 WRK-SIC-8351-BUSINESSES PIC S9(07) COMP-3. CL221 +00401 10 WRK-SIC-8641-AREA. CL221 +00402 15 WRK-SIC-8641-WORKERS PIC S9(07) COMP-3. CL221 +00403 15 WRK-SIC-8641-BUSINESSES PIC S9(07) COMP-3. CL221 +00404 10 WRK-NAICS-6 PIC X(06). CL217 +00405 10 FILLER REDEFINES WRK-NAICS-6. CL217 +00406 15 WRK-NAICS-2 PIC X(02). CL217 +00407 15 FILLER PIC X(04). CL217 +00408 *RW1 CL*74 +00409 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. CL*74 +00410 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL*74 +00411 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL*74 +00412 CL*80 +00413 05 DISP-DATE PIC X(08). CL*80 +00414 05 DISP-TIME PIC X(08). CL*81 +00415 CL*79 +00416 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL*74 +00417 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL*74 +00418 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL*74 +00419 CL*74 +00420 01 HEADER-1. CL*74 +00421 05 FILLER PIC X(01) VALUE SPACES. CL*74 +00422 05 FILLER PIC X(49) VALUE '016R1'. CL*79 +00423 05 FILLER PIC X(60) VALUE CL*74 +00424 'DISTRICT OF COLUMBIA'. CL*74 +00425 05 FILLER PIC X(06) VALUE 'DATE:'. CL*74 +00426 05 HDR1-LRCM-SYS-DATE PIC X(08). CL*74 +00427 CL*74 +00428 01 HEADER-2. CL*74 +00429 05 FILLER PIC X(54) VALUE SPACES. CL*74 +00430 05 FILLER PIC X(56) VALUE CL*74 +00431 'TAX DIVISION'. CL*74 +00432 05 FILLER PIC X(06) VALUE 'TIME:'. CL*74 +00433 05 HDR2-LRCM-SYS-TIME PIC X(08). CL*74 +00434 CL*74 +00435 01 HEADER-3. CL*74 +00436 05 FILLER PIC X(01) VALUE SPACES. CL*74 +00437 05 FILLER PIC X(38) VALUE CL*74 +00438 'ROUTE TO: ACCOUNTING UNIT'. CL*74 +00439 05 HDR3-LITERAL PIC X(43) VALUE CL*74 +00440 ' EMPLOYERS REGISTERED SINCE 09/11/01 '. CL*82 +00441 05 FILLER PIC X(28) VALUE SPACES. CL*74 +00442 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*74 +00443 05 HDR3-PAGE PIC ZZ,ZZ9. CL*74 +00444 CL*74 +00445 01 HEADER-4. CL*82 +00446 05 FILLER PIC X(01) VALUE SPACES. CL*74 +00447 05 FILLER PIC X(132) VALUE SPACES. CL*74 +00448 CL*74 +00449 01 HEADER-5. CL*82 +00450 05 FILLER PIC X(01) VALUE SPACES. CL*74 +00451 05 FILLER PIC X(05) VALUE SPACES. CL*74 +00452 05 FILLER PIC X(06) VALUE CL*74 +00453 'EMP NO'. CL*74 +00454 05 FILLER PIC X(05) VALUE SPACES. CL*74 +00455 05 FILLER PIC X(12) VALUE CL*74 +00456 'PRIMARY NAME'. CL*74 +00457 05 FILLER PIC X(28) VALUE SPACES. CL*74 +00458 05 FILLER PIC X(04) VALUE SPACES. CL*74 +00459 05 FILLER PIC X(14) VALUE CL*82 +00460 'LIABILITY DATE'. CL*82 +00461 05 FILLER PIC X(04) VALUE SPACES. CL*82 +00462 05 FILLER PIC X(13) VALUE CL*82 +00463 'INACTIVE DATE'. CL*82 +00464 05 FILLER PIC X(12) VALUE SPACES. CL*74 +00465 05 FILLER PIC X(18) VALUE SPACES. CL*74 +00466 CL*74 +00467 01 HEADER-6. CL*82 +00468 05 FILLER PIC X(01) VALUE SPACES. CL*74 +00469 05 FILLER PIC X(132) VALUE SPACES. CL*74 +00470 CL*74 +00471 01 DETAIL-LINE-1. CL*74 +00472 05 FILLER PIC X(05) VALUE SPACES. CL*77 +00473 05 WS-EMP-NO PIC 999B999. CL*74 +00474 05 FILLER PIC X(02) VALUE SPACES. CL*77 +00475 05 WS-PRIMARY-NAME PIC X(40). CL*74 +00476 05 FILLER PIC X(02) VALUE SPACES. CL*77 +00477 05 WS-DATE1 PIC X(10). CL*77 +00478 05 FILLER PIC X(02) VALUE SPACES. CL*77 +00479 05 WS-DATE2 PIC X(10). CL*77 +00480 * 05 FILLER PIC X(05) VALUE SPACES. CL*77 +00481 * 05 WS-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99. CL*77 +00482 * 05 FILLER PIC X(09) VALUE SPACES. CL*77 +00483 * 05 WS-PURSUED-RPT PIC ZZ9. CL*77 +00484 * 05 FILLER PIC X(10) VALUE SPACES. CL*77 +00485 * 05 WS-DPC PIC X(01). CL*77 +00486 * 05 FILLER PIC X(06) VALUE SPACES. CL*77 +00487 * 05 WS-LIEN PIC X(01). CL*77 +00488 * 05 FILLER PIC X(21) VALUE SPACES. CL*77 +00489 CL*74 +00490 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*74 +00491 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL*74 +00492 CL*74 +00493 01 FOOTING-LINE-3. CL*74 +00494 05 FILLER PIC X(25) VALUE SPACES. CL*74 +00495 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL*74 +00496 05 FILLER PIC X(02) VALUE SPACES. CL*74 +00497 05 FILLER PIC X(43) VALUE CL*74 +00498 'DEBIT WRITE OFF CANDIDATES LISTED ON REPORT'. CL*74 +00499 05 FILLER PIC X(23) VALUE SPACES. CL*74 +00500 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. CL*74 +00501 01 FOOTING-LINE-5 PIC X(133) VALUE SPACES. CL*74 +00502 01 FOOTING-LINE-6. CL*74 +00503 05 FILLER PIC X(25) VALUE SPACES. CL*74 +00504 05 FILLER PIC X(17) VALUE CL*74 +00505 '*** END OF REPORT'. CL*74 +00506 *RW2 CL*74 +00507 CL*74 +00508 01 L001-LINK-AREA. CL232 +00509 ++INCLUDE DTSIL001 CL232 +00510 EJECT CL232 +00511 01 L005-COMM-AREA. CL*81 +00512 ++INCLUDE DTSIL005 CL*79 +00513 EJECT CL*79 +00514 01 L102-LINK-AREA. CL133 +00515 ++INCLUDE DTSIL102 CL133 +00516 EJECT CL133 +00517 01 L054-LINK-AREA. CL206 +00518 ++INCLUDE DTSIL054 CL206 +00519 EJECT DTSBX601 +00520 01 L410-LINK-AREA. CL*46 +00521 ++INCLUDE DTSIL410 CL*46 +00522 EJECT CL*46 +00523 01 L600-LINK-AREA. CL*86 +00524 ++INCLUDE DTSIL600 CL*86 +00525 EJECT CL*86 +00526 01 L910-LINK-AREA. DTSBX601 +00527 ++INCLUDE DTSIL910 CL**2 +00528 EJECT DTSBX601 +00529 01 MSKL-REC. DTSBX601 +00530 ++INCLUDE DTSIMSKL CL**2 +00531 EJECT DTSBX601 +00532 01 MHDR-REC. CL**9 +00533 ++INCLUDE DTSIMHDR CL**2 +00534 EJECT DTSBX601 +00535 01 MPRF-REC. CL**9 +00536 ++INCLUDE DTSIMPRF CL**9 +00537 EJECT DTSBX601 +00538 01 MQTR-REC. CL**9 +00539 ++INCLUDE DTSIMQTR CL**9 +00540 EJECT CL**9 +00541 01 MRPT-REC. CL*70 +00542 ++INCLUDE DTSIMRPT CL*70 +00543 EJECT CL*70 +00544 01 MSOL-REC. CL*53 +00545 ++INCLUDE DTSIMSOL CL*53 +00546 EJECT CL*56 +00547 01 MRCT-REC. CL*56 +00548 ++INCLUDE DTSIMRCT CL*56 +00549 EJECT DTSBX601 +00550 01 MEVL-REC. CL111 +00551 ++INCLUDE DTSIMEVL CL111 +00552 EJECT CL111 +00553 01 MLIN-REC. CL116 +00554 ++INCLUDE DTSIMLIN CL116 +00555 EJECT CL116 +00556 01 MRTE-REC. CL137 +00557 ++INCLUDE DTSIMRTE CL137 +00558 EJECT CL137 +00559 01 MDST-REC. CL144 +00560 ++INCLUDE DTSIMDST CL144 +00561 EJECT CL144 +00562 01 MPAY-REC. CL151 +00563 ++INCLUDE DTSIMPAY CL151 +00564 EJECT CL151 +00565 01 MADJ-REC. CL153 +00566 ++INCLUDE DTSIMADJ CL153 +00567 EJECT CL153 +00568 01 MJRN-REC. CL155 +00569 ++INCLUDE DTSIMJRN CL155 +00570 EJECT CL155 +00571 01 MERA-REC. CL157 +00572 ++INCLUDE DTSIMERA CL157 +00573 EJECT CL157 +00574 01 MCOL-REC. CL*91 +00575 ++INCLUDE DTSIMCOL CL*91 +00576 EJECT CL*91 +00577 01 MFAS-REC. CL253 +00578 ++INCLUDE DTSIMFAS CL253 +00579 EJECT CL198 +00580 01 MFAE-REC. CL237 +00581 ++INCLUDE DTSIMFAE CL237 +00582 EJECT CL237 +00583 01 MLOG-REC. DTSBX601 +00584 ++INCLUDE DTSIMLOG DTSBX601 +00585 EJECT DTSBX601 +00586 01 MOPO-REC. CL*85 +00587 ++INCLUDE DTSIMOPO CL*85 +00588 EJECT CL*85 +00589 01 MTAD-REC. CL193 +00590 ++INCLUDE DTSIMTAD CL193 +00591 EJECT CL*86 +00592 01 MTAA-REC. CL193 +00593 ++INCLUDE DTSIMTAA CL193 +00594 EJECT CL193 +00595 01 MBAA-REC. CL227 +00596 ++INCLUDE DTSIMBAA CL227 +00597 EJECT CL227 +00598 01 MFSC-REC. CL*39 +00599 ++INCLUDE DTSIMFSC CL*39 +00600 EJECT CL*39 +00601 01 MERD-REC. CL*22 +00602 ++INCLUDE DTSIMERD CL*22 +00603 EJECT CL*22 +00604 01 L921-LINK-AREA. CL*89 +00605 ++INCLUDE DTSIL921 CL*89 +00606 EJECT CL*89 +00607 01 ISKL-REC. CL*89 +00608 ++INCLUDE DTSIISKL CL*89 +00609 EJECT CL*89 +00610 01 L931-LINK-AREA. CL132 +00611 ++INCLUDE DTSIL931 CL132 +00612 EJECT CL132 +00613 01 FSKL-REC. CL132 +00614 ++INCLUDE DTSIFSKL CL132 +00615 EJECT CL132 +00616 01 FQTR-REC. CL132 +00617 ++INCLUDE DTSIFQTR CL132 +00618 EJECT CL132 +00619 01 FFIS-REC. CL239 +00620 ++INCLUDE DTSIFFIS CL239 +00621 EJECT CL239 +00622 01 L004-COMM-AREA. CL239 +00623 ++INCLUDE DTSIL004 CL183 +00624 CL*53 +00625 01 L061-LINK-AREA. CL*54 +00626 ++INCLUDE DTSIL061 CL*53 +00627 EJECT CL*53 +00628 01 L516-LINK-AREA. CL185 +00629 ++INCLUDE DTSIL516 CL185 +00630 EJECT CL185 +00631 PROCEDURE DIVISION. CL183 +00632 SKIP2 DTSBX601 +00633 PERFORM I0000-INITIATE THRU I0000-EXIT. CL**5 +00634 IF WRK-ERROR-NO-88 CL193 +00635 PERFORM P0000-PROCESS THRU P0000-EXIT CL193 +00636 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL193 +00637 SKIP2 DTSBX601 +00638 GOBACK. DTSBX601 +00639 EJECT DTSBX601 +00640 I0000-INITIATE. CL**5 +00641 SKIP2 CL**5 +00642 MOVE 'N' TO WRK-TRACE-IND. CL**8 +00643 SET WRK-ERROR-NO-88 TO TRUE. CL193 +00644 DTSBX601 +00645 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. CL**5 +00646 CL113 +00647 SKIP2 DTSBX601 +00648 I0000-EXIT. CL**7 +00649 EXIT. CL**7 +00650 I2000-OPEN-FILES-1. DTSBX601 +00651 OPEN OUTPUT EXP-FILE1. CL*86 +00652 IF NOT EXP-STATUS-OK-88 CL*86 +00653 DISPLAY 'CANNOT OPEN EXP FILE ' EXP-STATUS CL*86 +00654 SET WRK-ERROR-YES-88 TO TRUE CL*86 +00655 GO TO I2000-EXIT. CL*86 +00656 MOVE WRK-TRACE-IND TO L910-TRACE-IND. CL**5 +00657 CL**3 +00658 MOVE WRK-MOD-NAME TO L910-MOD-NAME. CL**5 +00659 DTSBX601 +00660 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*68 +00661 ** PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL*68 +00662 CL*89 +00663 PERFORM S921-OPEN-READ THRU S921-EXIT. CL*68 +00664 DTSBX601 +00665 PERFORM S931-OPEN-READ THRU S931-EXIT. CL*68 +00666 *** PERFORM S931-OPEN-UPDATE THRU S931-EXIT. CL*34 +00667 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*84 +00668 CL*84 +00669 MOVE +0 TO MSKL-EMP-NO. CL*84 +00670 CL*84 +00671 SET MSKL-HDR-88 TO TRUE. CL*84 +00672 CL*84 +00673 PERFORM S910-READ THRU S910-EXIT. CL*84 +00674 CL*84 +00675 IF L910-NO-REC-88 CL*84 +00676 MOVE 'MHDR RECORD NOT FOUND' CL*84 +00677 TO WRK-ABEND-MSG CL*84 +00678 PERFORM S999-ABEND THRU S999-EXIT. CL*84 +00679 CL*84 +00680 MOVE MSKL-REC TO MHDR-REC. CL*84 +00681 CL*84 +00682 MOVE MHDR-PRIOR-RUN-DATE TO WRK-EXT-CURRENT-DATE. CL*84 +00683 CL*84 +00684 DISPLAY ' PRIOR RUN DATE: ' MHDR-PRIOR-RUN-DATE. CL*84 +00685 CL*21 +00686 I2000-EXIT. DTSBX601 +00687 EXIT. DTSBX601 +00688 CL113 +00689 P0000-PROCESS. DTSBX601 +00690 DTSBX601 +00691 MOVE +0 TO WRK-MPRF-CNT CL**9 +00692 CL*16 +00693 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL*89 +00694 MOVE 0 TO MLOG-CNT. CL*86 +00695 SET WRK-MLOG-OK TO TRUE. DTSBX601 +00696 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL*92 +00697 MOVE +000001 TO MPRF-EMP-NO. CL*92 +00698 SET MPRF-PRF-88 TO TRUE. CL*92 +00699 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*92 +00700 DTSBX601 +00701 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX601 +00702 IF L910-NO-REC-88 DTSBX601 +00703 NEXT SENTENCE CL*83 +00704 ELSE DTSBX601 +00705 PERFORM P1100-SCAN-MPRF THRU P1100-EXIT CL*89 +00706 UNTIL MPRF-NO-REC-88. CL*92 +00707 DTSBX601 +00708 P0000-EXIT. CL*83 +00709 EXIT. CL*83 +00710 EJECT CL*83 +00711 CL*83 +00712 DTSBX601 +00713 P1100-SCAN-MPRF. CL*89 +00714 CL*84 +00715 MOVE MSKL-REC TO MPRF-REC. CL*96 +00716 PERFORM P2100-PROCESS-MLOG THRU P2100-EXIT CL*89 +00717 MOVE MPRF-REC TO MSKL-REC CL*94 +00718 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX601 +00719 IF NOT L910-OK-88 CL*92 +00720 SET MPRF-NO-REC-88 TO TRUE. CL*92 +00721 DTSBX601 +00722 P1100-EXIT. CL*87 +00723 EXIT. DTSBX601 +00724 SKIP3 CL*56 +00725 CL**1 +00726 CL*89 +00727 P2100-PROCESS-MLOG. CL*89 +00728 CL*89 +00729 MOVE +0 TO WRK-MPRF-CNT CL*89 +00730 CL*89 +00731 SET WRK-MLOG-OK TO TRUE. CL*89 +00732 MOVE LOW-VALUES TO MLOG-KEY-AREA. CL*89 +00733 MOVE MPRF-EMP-NO TO MLOG-EMP-NO. CL*89 +00734 SET MLOG-LOG-88 TO TRUE. CL*89 +00735 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. CL*89 +00736 CL*89 +00737 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*89 +00738 IF L910-NO-REC-88 CL*89 +00739 NEXT SENTENCE CL*89 +00740 ELSE CL*89 +00741 PERFORM P2200-SCAN-MLOG THRU P2200-EXIT CL*89 +00742 UNTIL WRK-MLOG-NO-REC. CL*90 +00743 CL*89 +00744 P2100-EXIT. CL*89 +00745 EXIT. CL*89 +00746 EJECT CL*89 +00747 CL*89 +00748 CL*89 +00749 P2200-SCAN-MLOG. CL*89 +00750 MOVE MSKL-REC TO MLOG-REC. CL*89 +00751 ADD 1 TO MLOG-CNT CL*89 +00752 IF MLOG-EMP-NO = 010021 OR 010727 OR 010729 CL119 +00753 * DISPLAY 'MNAME: ' MLOG-DATA-ELEMENT-NAME(1:20) CL*99 +00754 DISPLAY 'MDATE: ' MLOG-EMP-NO ' ' MLOG-ESTB-DATE CL115 +00755 ' ' MLOG-OP-ID CL120 +00756 ' ' MLOG-DATA-ELEMENT-NAME(1:15). CL120 +00757 CL121 +00758 * IF MLOG-ESTB-DATE = MHDR-PRIOR-RUN-DATE CL123 +00759 IF MLOG-ESTB-DATE = 20180924 CL124 +00760 IF MLOG-DATA-ELEMENT-NAME(1:20) = 'MPRF-RETURN-MAIL-IND' CL*97 +00761 OR CL103 +00762 MLOG-DATA-ELEMENT-NAME(1:12) = 'MRTE-UI-RATE' CL103 +00763 OR CL104 +00764 MLOG-DATA-ELEMENT-NAME(1:15) = 'RETURN MAIL IND' CL105 +00765 MOVE SPACES TO WRK-R1-SPACES CL108 +00766 * MOVE MLOG-ESTB-DATE TO REC1-DATE CL123 +00767 MOVE 20180924 TO REC1-DATE CL124 +00768 MOVE MPRF-RETURN-MAIL-IND TO REC1-FLAG CL*99 +00769 MOVE MLOG-EMP-NO TO REC1-EMP-NO CL*99 +00770 MOVE MLOG-OP-ID TO REC1-OPID CL113 +00771 * SET WRK-MLOG-NO-REC TO TRUE CL120 +00772 WRITE EXP-REC1 FROM WRK-REC1. CL121 +00773 * GO TO P2200-EXIT. CL121 +00774 CL112 +00775 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*89 +00776 IF L910-NO-REC-88 CL*89 +00777 SET L910-OK-88 TO TRUE CL*90 +00778 SET WRK-MLOG-NO-REC TO TRUE. CL*89 +00779 CL*89 +00780 P2200-EXIT. CL*89 +00781 EXIT. CL*89 +00782 SKIP3 CL*89 +00783 CL*89 +00784 T0000-TERMINATE. DTSBX601 +00785 CL**4 +00786 DISPLAY ' '. DTSBX601 +00787 CL**4 +00788 DISPLAY '*** DTSBX601 TERMINATION STATISTICS ***'. CL*83 +00789 CL**4 +00790 DISPLAY ' '. DTSBX601 +00791 CL**4 +00792 PERFORM S910-CLOSE THRU S910-EXIT. CL**4 +00793 CLOSE EXP-FILE1. CL*86 +00794 DTSBX601 +00795 T0000-EXIT. DTSBX601 +00796 EXIT. DTSBX601 +00797 EJECT DTSBX601 +00798 S001-FROM-FED-8. CL232 +00799 SET L001-FROM-FED-8 TO TRUE. CL232 +00800 GO TO S001-DATE. CL232 +00801 CL232 +00802 S001-FROM-ABS-DAY. CL*10 +00803 SET L001-FROM-ABS-DAY TO TRUE. CL*10 +00804 GO TO S001-DATE. CL*10 +00805 CL*10 +00806 S001-DATE. CL232 +00807 CALL 'DTSBU001' USING L001-LINK-AREA. CL232 +00808 CL232 +00809 S001-EXIT. CL232 +00810 EXIT. CL232 +00811 SKIP3 DTSBX601 +00812 S004-FROM-5. CL*10 +00813 SET L004-FROM-5 TO TRUE. CL*10 +00814 GO TO S004-EDIT-QTR. CL*10 +00815 CL*10 +00816 S004-FROM-ABS. CL*10 +00817 SET L004-FROM-ABS TO TRUE. CL*10 +00818 GO TO S004-EDIT-QTR. CL*10 +00819 CL*10 +00820 S004-EDIT-QTR. CL183 +00821 CALL 'DTSBU004' USING L004-COMM-AREA. CL183 +00822 CL183 +00823 S004-EXIT. CL183 +00824 EXIT. CL183 +00825 SKIP3 CL183 +00826 S005-SYS-DATE. CL*80 +00827 CALL 'DTSBU005' USING L005-COMM-AREA. CL*80 +00828 CL*80 +00829 S005-EXIT. CL*80 +00830 EXIT. CL*80 +00831 SKIP3 CL*80 +00832 CL*80 +00833 S054-RATE-DETERMINATION. CL206 +00834 CALL 'DTSBU054' USING L054-LINK-AREA CL206 +00835 MRCT-REC. CL206 +00836 CL206 +00837 S054-EXIT. CL206 +00838 EXIT. CL206 +00839 SKIP3 CL206 +00840 S061-FLD-REP-INFO. CL*53 +00841 SKIP1 CL*53 +00842 CALL 'DTSBU061' USING L061-LINK-AREA. CL*53 +00843 SKIP2 CL*53 +00844 S061-EXIT. CL*53 +00845 EXIT. CL*53 +00846 CL*53 +00847 S410-FILING-SCHED. CL*46 +00848 CALL 'DTSBU410' USING L410-LINK-AREA. CL*46 +00849 CL*46 +00850 S410-EXIT. CL*46 +00851 EXIT. CL*46 +00852 SKIP3 CL*46 +00853 S516-LIABILITY. CL185 +00854 CALL 'DTSBU516' USING L516-LINK-AREA CL185 +00855 MPRF-REC. CL185 +00856 CL185 +00857 S516-EXIT. CL185 +00858 EXIT. CL185 +00859 SKIP3 CL185 +00860 S910-OPEN-READ. DTSBX601 +00861 SET L910-OPEN-READ-88 TO TRUE. DTSBX601 +00862 GO TO S910-MSTR-IO. DTSBX601 +00863 DTSBX601 +00864 S910-OPEN-UPDATE-NO-AIX. CL*18 +00865 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*18 +00866 GO TO S910-MSTR-IO. CL*15 +00867 DTSBX601 +00868 S910-READ. DTSBX601 +00869 SET L910-READ-88 TO TRUE. DTSBX601 +00870 GO TO S910-MSTR-IO. DTSBX601 +00871 DTSBX601 +00872 S910-START-BROWSE. DTSBX601 +00873 SET L910-START-BROWSE-88 TO TRUE. DTSBX601 +00874 GO TO S910-MSTR-IO. DTSBX601 +00875 DTSBX601 +00876 S910-READ-NEXT. DTSBX601 +00877 SET L910-READ-NEXT-88 TO TRUE. DTSBX601 +00878 GO TO S910-MSTR-IO. DTSBX601 +00879 DTSBX601 +00880 S910-COUNT. CL**9 +00881 SET L910-COUNT-88 TO TRUE. CL**9 +00882 GO TO S910-MSTR-IO. CL**9 +00883 CL**9 +00884 S910-REWRITE. CL*15 +00885 SET L910-REWRITE-88 TO TRUE. CL*15 +00886 GO TO S910-MSTR-IO. CL*15 +00887 DTSBX601 +00888 S910-DELETE. CL119 +00889 SET L910-DELETE-88 TO TRUE. CL119 +00890 GO TO S910-MSTR-IO. CL119 +00891 CL119 +00892 S910-CLOSE. DTSBX601 +00893 SET L910-CLOSE-88 TO TRUE. DTSBX601 +00894 GO TO S910-MSTR-IO. DTSBX601 +00895 DTSBX601 +00896 S910-MSTR-IO. DTSBX601 +00897 CALL 'DTSBU910' USING L910-LINK-AREA CL**2 +00898 MSKL-REC. DTSBX601 +00899 S910-EXIT. DTSBX601 +00900 EXIT. DTSBX601 +00901 SKIP3 DTSBX601 +00902 S921-OPEN-READ. CL*89 +00903 SET L921-OPEN-READ-88 TO TRUE. CL*89 +00904 GO TO S921-AIX-IO. CL*89 +00905 CL*89 +00906 S921-CLOSE. CL*89 +00907 SET L921-CLOSE-88 TO TRUE. CL*89 +00908 GO TO S921-AIX-IO. CL*89 +00909 CL*89 +00910 S921-AIX-IO. CL*89 +00911 CALL 'DTSBU921' USING L921-LINK-AREA CL*89 +00912 ISKL-REC. CL*89 +00913 S921-EXIT. CL*89 +00914 EXIT. CL*89 +00915 SKIP3 CL*89 +00916 CL*89 +00917 S931-OPEN-READ. CL132 +00918 SET L931-OPEN-READ-88 TO TRUE. CL132 +00919 GO TO S931-REF-IO. CL132 +00920 CL132 +00921 S931-OPEN-UPDATE. CL*31 +00922 SET L931-OPEN-UPDATE-88 TO TRUE. CL*31 +00923 GO TO S931-REF-IO. CL*31 +00924 CL*31 +00925 S931-START-BROWSE. CL*31 +00926 SET L931-START-BROWSE-88 TO TRUE. CL**6 +00927 GO TO S931-REF-IO. CL**6 +00928 CL**6 +00929 S931-READ. CL132 +00930 SET L931-READ-88 TO TRUE. CL132 +00931 GO TO S931-REF-IO. CL132 +00932 CL133 +00933 S931-READ-NEXT. CL**6 +00934 SET L931-READ-NEXT-88 TO TRUE. CL**6 +00935 GO TO S931-REF-IO. CL**6 +00936 CL**6 +00937 S931-DELETE. CL*32 +00938 SET L931-DELETE-88 TO TRUE. CL*32 +00939 GO TO S931-REF-IO. CL*32 +00940 CL*32 +00941 S931-REWRITE. CL*29 +00942 SET L931-REWRITE-88 TO TRUE. CL*29 +00943 GO TO S931-REF-IO. CL*29 +00944 CL*29 +00945 S931-WRITE. CL*33 +00946 SET L931-WRITE-88 TO TRUE. CL*33 +00947 GO TO S931-REF-IO. CL*33 +00948 CL*33 +00949 S931-CLOSE. CL134 +00950 SET L931-CLOSE-88 TO TRUE. CL133 +00951 GO TO S931-REF-IO. CL133 +00952 CL133 +00953 S931-REF-IO. CL132 +00954 CALL 'DTSBU931' USING L931-LINK-AREA CL132 +00955 FSKL-REC. CL132 +00956 S931-EXIT. CL132 +00957 EXIT. CL132 +00958 SKIP3 CL132 +00959 S999-ABEND. DTSBX601 +00960 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 +00961 S999-EXIT. DTSBX601 +00962 EXIT. DTSBX601 diff --git a/Batch/DTSBX626.cob b/Batch/DTSBX626.cob new file mode 100644 index 0000000..f709b51 --- /dev/null +++ b/Batch/DTSBX626.cob @@ -0,0 +1,1733 @@ +00001 IDENTIFICATION DIVISION. 09/20/22 +00002 PROGRAM-ID. DTSBX626. DTSBX626 +00003 AUTHOR. NGC. LV224 +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 +00011 * PAYMENT FILE TO WELLS FARGO. CL205 +00012 * 06/01/18 ZL1 CL205 +00013 *** CL205 +00014 SKIP3 CL120 +00015 ENVIRONMENT DIVISION. DTSBX626 +00016 CONFIGURATION SECTION. CL*12 +00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*12 +00018 CL*12 +00019 INPUT-OUTPUT SECTION. DTSBX626 +00020 DTSBX626 +00021 FILE-CONTROL. DTSBX626 +00022 DTSBX626 +00023 SELECT ESSP-EMAIL-RPT ASSIGN TO DTSFX626 CL205 +00024 FILE STATUS IS FACH-STATUS. DTSBX626 +00025 CL205 +00026 SELECT ESSP-IN-X145 ASSIGN TO DTSIX145 CL205 +00027 FILE STATUS IS FACH-STATUS. CL205 +00028 CL205 +00029 SELECT ESSP-IN-X145ACH ASSIGN TO DTSIXACH CL174 +00030 FILE STATUS IS FACH-STATUS. CL174 +00031 CL**5 +00032 SELECT ESSP-OUT-X145 ASSIGN TO DTSOX145 CL150 +00033 FILE STATUS IS REPT-STATUS. CL*79 +00034 CL**5 +00035 SELECT ESSP-ACH-TOTALS ASSIGN TO DTSOTOTL CL193 +00036 FILE STATUS IS REPT-STATUS. CL193 +00037 CL193 +00038 DTSBX626 +00039 DATA DIVISION. DTSBX626 +00040 DTSBX626 +00041 FILE SECTION. DTSBX626 +00042 DTSBX626 +00043 FD ESSP-IN-X145 CL153 +00044 LABEL RECORDS ARE STANDARD DTSBX626 +00045 RECORDING MODE IS F DTSBX626 +00046 BLOCK CONTAINS 0 RECORDS. DTSBX626 +00047 DTSBX626 +00048 01 X145-IN-REC PIC X(512). CL150 +00049 DTSBX626 +00050 FD ESSP-EMAIL-RPT CL205 +00051 LABEL RECORDS ARE STANDARD CL205 +00052 RECORDING MODE IS F CL205 +00053 BLOCK CONTAINS 0 RECORDS. CL205 +00054 CL205 +00055 01 X626-REC. CL205 +00056 05 X626-TXT PIC X(40). CL205 +00057 05 FILLER PIC X(10). CL205 +00058 05 X626-CNT PIC 9(10). CL205 +00059 05 FILLER PIC X(20). CL205 +00060 CL205 +00061 FD ESSP-OUT-X145 CL150 +00062 LABEL RECORDS ARE STANDARD CL*79 +00063 RECORDING MODE IS F CL*79 +00064 BLOCK CONTAINS 0 RECORDS. CL*79 +00065 CL*79 +00066 01 X145-OUT-REC PIC X(512). CL150 +00067 CL*79 +00068 CL174 +00069 FD ESSP-IN-X145ACH CL174 +00070 LABEL RECORDS ARE STANDARD CL174 +00071 RECORDING MODE IS F CL174 +00072 BLOCK CONTAINS 0 RECORDS. CL174 +00073 CL174 +00074 01 X145-ACH-REC. CL178 +00075 05 X145-ACH-RECA PIC X(94). CL178 +00076 * 05 X145-ACH-RECB PIC X(418). CL197 +00077 CL174 +00078 FD ESSP-ACH-TOTALS CL193 +00079 LABEL RECORDS ARE STANDARD CL193 +00080 RECORDING MODE IS F CL193 +00081 BLOCK CONTAINS 0 RECORDS. CL193 +00082 CL193 +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 +00086 77 PAN-VALET PICTURE X(24) VALUE '216DTSBX425 01/22/04'. CL**2 +00087 DTSBX626 +00088 01 WRK-AREA. CL216 +00089 DTSBX626 +00090 05 WRK-F907-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX626 +00091 05 WRK-FAC6-EMP-NO PIC 9(06) VALUE 0. CL125 +00092 05 WRK-FACH-EMP-FOUND PIC 9(01) VALUE 0. CL177 +00093 05 WS-FAC6-DUTAS-EMP-NAME. CL129 +00094 10 WS-FAC6-DUTAS-EMP-NAMEA PIC X(4) VALUE SPACES. CL129 +00095 10 WS-FAC6-DUTAS-EMP-NAMEB PIC X(36) VALUE SPACES. CL129 +00096 DTSBX626 +00097 05 FACH-STATUS PIC X(02). DTSBX626 +00098 88 FACH-STATUS-EOF-88 VALUE '10'. CL**7 +00099 88 FACH-STATUS-OK-88 VALUE '00'. CL**7 +00100 DTSBX626 +00101 05 REPT-STATUS PIC X(02). CL*10 +00102 88 REPT-STATUS-EOF-88 VALUE '10'. CL*10 +00103 88 REPT-STATUS-OK-88 VALUE '00'. CL*12 +00104 CL*10 +00105 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +5. CL213 +00106 DTSBX626 +00107 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX425'. CL**2 +00108 05 WRK-RTN-CD PIC X(05) VALUE SPACES. CL*46 +00109 05 WRK-FAC7-RTN-CD PIC X(05) VALUE SPACES. CL*83 +00110 05 WRK-DTS-RTN-CD PIC X(05) VALUE SPACES. CL*84 +00111 DTSBX626 +00112 05 WRK-MPAY-REMIT-AMT PIC S9(09)V9(02) COMP-3. DTSBX626 +00113 05 TOT-MPAY-AMOUNT PIC S9(09)V9(02) COMP-3. CL115 +00114 05 WRK-MPAY-EMP-AMT PIC S9(09)V9(02) COMP-3. CL137 +00115 DTSBX626 +00116 05 WRK-CURR-DATE PIC S9(15) COMP-3. DTSBX626 +00117 05 WRK-CURR-TIME PIC S9(09) COMP-3. DTSBX626 +00118 DTSBX626 +00119 05 WRK-MPAY-EMP-CNT PIC S9(07) COMP-3. CL137 +00120 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3. CL137 +00121 05 WRK-MPAY-HOLD-EMP-NO PIC S9(07) COMP-3. CL106 +00122 05 WRK-FAC6-RECORDS PIC S9(07) COMP-3. DTSBX626 +00123 05 WRK-FAC7-RECORDS PIC S9(07) COMP-3. CL*10 +00124 05 WRK-OTHER-RECORDS PIC S9(07) COMP-3. DTSBX626 +00125 05 WRK-HEADER-RECORDS PIC S9(07) COMP-3. DTSBX626 +00126 05 WRK-TRAILER-RECORDS PIC S9(07) COMP-3. DTSBX626 +00127 05 WRK-T025-WRITE-CNT PIC S9(07) COMP-3. DTSBX626 +00128 05 WRK-T003-WRITE-CNT PIC S9(07) COMP-3. CL*72 +00129 05 WRK-R907-WRITE-CNT PIC S9(07) COMP-3. DTSBX626 +00130 05 WRK-F907-WRITE-CNT PIC S9(07) COMP-3. DTSBX626 +00131 05 WS-FAC7-PEN-CNT PIC S9(07) COMP-3. CL*85 +00132 05 WRK-FACH-READ-CNT PIC S9(07) COMP-3. CL153 +00133 05 WRK-TRAILER-REC-CNT PIC S9(07) COMP-3. DTSBX626 +00134 05 WRK-FACH-SELECTED-CNT PIC S9(07) COMP-3. DTSBX626 +00135 05 WRK-FAC6-AMOUNT PIC S9(08)V99 COMP-3. DTSBX626 +00136 05 WRK-MPAY-AMOUNT PIC S9(08)V99 COMP-3. CL*99 +00137 05 WRK-TOLR-AMOUNT PIC S9(08)V99 COMP-3 CL*98 +00138 VALUE +15.00. CL102 +00139 05 WS-FAC6-HOLD-TRACE-NO PIC 9(08) VALUE ZEROS. CL183 +00140 05 WS-HOLD-TRACE-NO PIC 9(08) VALUE ZEROS. CL183 +00141 05 WS-TOTAL-X145-AMT PIC 9(11)V99 VALUE ZEROS. CL173 +00142 05 WS-HOLD-E145-AMT PIC 9(11)V99 VALUE ZEROS. CL169 +00143 05 WS-HOLD-X145-AMT PIC 9(11)V99 VALUE ZEROS. CL165 +00144 05 FAC6-HOLD-AMOUNT PIC 9(11)V99 VALUE ZEROS. CL176 +00145 05 WRK-X145-OUT-CNT PIC 9(05) VALUE ZEROS. CL205 +00146 05 WRK-X145-NOT-CNT PIC 9(05) VALUE ZEROS. CL200 +00147 05 WRK-X145-XYZ-CNT PIC 9(05) VALUE ZEROS. CL202 +00148 05 WS-HOLD-X145-EMP-NO PIC 9(06) VALUE ZEROS. CL151 +00149 05 TOT-FAC6-AMOUNT PIC S9(10)V99 COMP-3. CL151 +00150 05 TOT-TRAILER-AMT PIC S9(10)V99 COMP-3. DTSBX626 +00151 05 WS-LINE-CNT PIC 9(05) VALUE 60. CL*10 +00152 05 WS-RETN-CNT PIC 9(05) VALUE 60. CL*88 +00153 05 WS-PAGE-CNT PIC 9(05) VALUE 0. CL*10 +00154 05 WRK-MPAY-CNT PIC 9(05) VALUE 0. CL107 +00155 05 WRK-FAC6-AMT-DISP PIC ---,---,999.99. CL*95 +00156 05 WRK-AMT-DISP1 PIC ---,---,999.99. CL*95 +00157 05 WRK-AMT-DISP2 PIC ---,---,999.99. CL*95 +00158 CL*33 +00159 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE 0. CL*33 +00160 05 W-SLASH-DATE PIC X(10). CL*33 +00161 05 FILLER REDEFINES W-SLASH-DATE. CL*33 +00162 10 W-SLASH-DT-MM PIC X(02). CL*33 +00163 10 FILLER PIC X(01). CL*33 +00164 10 W-SLASH-DT-DD PIC X(02). CL*33 +00165 10 FILLER PIC X(01). CL*33 +00166 10 W-SLASH-DT-CCYY PIC X(04). CL*33 +00167 CL*33 +00168 05 WRK-FAC1-DATE. CL*92 +00169 10 WRK-FAC1-DATE-YY PIC X(02). CL*92 +00170 10 WRK-FAC1-DATE-MM PIC X(02). CL*92 +00171 10 WRK-FAC1-DATE-DD PIC X(02). CL*92 +00172 CL*92 +00173 05 WRK-RTN-DATE. CL*92 +00174 10 WRK-RTN-DATE-CC PIC 9(02) VALUE 20. CL*94 +00175 10 WRK-RTN-DATE-YY PIC 9(02). CL*94 +00176 10 WRK-RTN-DATE-MM PIC 9(02). CL*92 +00177 10 WRK-RTN-DATE-DD PIC 9(02). CL*93 +00178 CL*92 +00179 05 WRK-RECV-DATE PIC 9(8) VALUE ZERO. CL*92 +00180 CL*46 +00181 05 WS-HOLD-ITRT-REC PIC X(63). CL*47 +00182 CL*47 +00183 05 WRK-FAC7-RTN-CODE PIC X(01). CL*47 +00184 88 WRK-FAC7-RTN-VALID-88 VALUE 'Y'. CL*46 +00185 88 WRK-FAC7-RTN-INVALID-88 VALUE 'N'. CL*46 +00186 DTSBX626 +00187 05 WRK-TEMP-TRACE-NO. DTSBX626 +00188 10 WRK-TEMP-TRACE-NOA PIC X(08) VALUE ZEROS. CL149 +00189 10 WRK-TEMP-TRACE-NOB PIC X(07) VALUE ZEROS. CL149 +00190 DTSBX626 +00191 05 WRK-NUMR-TRACE-NO PIC 9(13) VALUE ZEROS. CL*21 +00192 DTSBX626 +00193 05 WRK-FAC6-DOES-TRACE-NO PIC S9(13) COMP-3. CL**4 +00194 CL106 +00195 05 WRK-TRACE-NO-IND PIC X(01). CL106 +00196 88 TRACE-NO-END-YES-88 VALUE 'Y'. CL107 +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 +00203 DTSBX626 +00204 05 WRK-MPAY-IND PIC X(01). DTSBX626 +00205 88 MPAY-FOUND-YES-88 VALUE 'Y'. DTSBX626 +00206 88 MPAY-FOUND-NO-88 VALUE 'N'. DTSBX626 +00207 DTSBX626 +00208 05 WRK-TOLR-IND PIC X(01). CL*98 +00209 88 WRK-TOLR-YES-88 VALUE 'Y'. CL*98 +00210 88 WRK-TOLR-NO-88 VALUE 'N'. CL*98 +00211 CL*98 +00212 05 WRK-MPRF-IND PIC X(01). CL*66 +00213 88 MPRF-FOUND-YES-88 VALUE 'Y'. CL*66 +00214 88 MPRF-FOUND-NO-88 VALUE 'N'. CL*66 +00215 CL*66 +00216 05 WRK-ITRT-IND PIC X(01). CL*79 +00217 88 ITRT-FOUND-YES-88 VALUE 'Y'. CL*79 +00218 88 ITRT-FOUND-NO-88 VALUE 'N'. CL*79 +00219 CL*79 +00220 05 WRITE-T025-IND PIC X(01). DTSBX626 +00221 88 WRITE-T025-YES-88 VALUE 'Y'. DTSBX626 +00222 88 WRITE-T025-NO-88 VALUE 'N'. DTSBX626 +00223 DTSBX626 +00224 05 WRK-DTSBU005-IND PIC X(01). DTSBX626 +00225 88 WRK-DTSBU005-YES VALUE 'Y'. DTSBX626 +00226 88 WRK-DTSBU005-NO VALUE 'N'. DTSBX626 +00227 DTSBX626 +00228 05 WRK-FACH-PEND PIC X(01). CL*84 +00229 88 WRK-FACH-PEND-REC-YES-88 VALUE 'Y'. CL*83 +00230 88 WRK-FACH-PEND-REC-NO-88 VALUE 'N'. CL*83 +00231 CL*83 +00232 05 WRK-FAC1-IND PIC X(01). DTSBX626 +00233 88 WRK-FAC1-FIRST-OK VALUE 'Y'. DTSBX626 +00234 88 WRK-FAC1-FIRST-NO VALUE 'N'. DTSBX626 +00235 DTSBX626 +00236 05 WRK-FACH-IND PIC X(01). DTSBX626 +00237 88 WRK-FACH-LAST-REC-88 VALUE 'Y'. DTSBX626 +00238 DTSBX626 +00239 05 WRK-XACH-IND PIC X(01). CL176 +00240 88 WRK-XACH-LAST-REC-88 VALUE 'Y'. CL176 +00241 CL176 +00242 05 WRK-TRACE-IND PIC X(01). DTSBX626 +00243 DTSBX626 +00244 01 ESSP-ACH-DEPOSITS. CL193 +00245 05 X145-ACH-REC-CNT PIC 9(5). CL193 +00246 05 X145-ACH-REC-DEPOSIT PIC 9(11)V99. CL193 +00247 05 FILLER PIC X(62). CL193 +00248 CL193 +00249 01 WRK-MNTE-SUBJECT. CL*74 +00250 10 NTE-SUBJ PIC X(19) CL*70 +00251 VALUE 'ACH PAYMENT RETURN '. CL*70 +00252 01 WRK-MNTE-REASON. CL*70 +00253 10 FILLER PIC X(13) CL*70 +00254 VALUE 'CODE/REASON: '. CL*70 +00255 10 NTE-REASON PIC X(54). CL*70 +00256 01 WRK-MNTE-TRACE-NO. CL*70 +00257 10 FILLER PIC X(13) CL*70 +00258 VALUE ' TRACE NO: '. CL*70 +00259 10 NTE-TRACE-NO PIC X(13). CL*70 +00260 01 WRK-MNTE-DEP-DATE. CL*70 +00261 10 FILLER PIC X(13) CL*70 +00262 VALUE 'RECEIVD DTE: '. CL121 +00263 10 NTE-DEPOSIT-DATE PIC X(13). CL*70 +00264 01 WRK-MNTE-BATCH-ITEM. CL*70 +00265 10 FILLER PIC X(13) CL*70 +00266 VALUE ' BATCH/ITEM: '. CL*70 +00267 10 NTE-BATCH-NO PIC X(5). CL*70 +00268 10 FILLER PIC X(1) VALUE '/'. CL*70 +00269 10 NTE-ITEM-NO PIC XXX. CL*70 +00270 01 WRK-MNTE-ACCT-NO. CL*72 +00271 10 FILLER PIC X(13) CL*71 +00272 VALUE ' ACCOUNT NO: '. CL*71 +00273 10 NTE-ACCT-NO PIC X(20). CL*71 +00274 01 WRK-MNTE-AMOUNT. CL*72 +00275 10 FILLER PIC X(13) CL*71 +00276 VALUE ' DEP AMOUNT: '. CL*71 +00277 10 NTE-AMOUNT PIC ---,---,999.99. CL*96 +00278 01 WRK-MNTE-NO-FEE. CL*77 +00279 10 FILLER PIC X(39) CL*77 +00280 VALUE ' RETURN FEE: NO RETURN FEE WAS CHARGED '. CL*77 +00281 10 FILLER PIC X(29) CL*77 +00282 VALUE 'RETURN AMOUNT LESS THAN 15.00'. CL*77 +00283 01 MSG-TABLE. CL*70 +00284 05 MSG1-NO-MPAY. DTSBX626 +00285 10 MSG1-ID. DTSBX626 +00286 15 MSG1-ID-A PIC X(08) VALUE 'DTSBX425'. CL**2 +00287 15 MSG1-ID-B PIC X(03) VALUE '907'. DTSBX626 +00288 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'FAC6 WITH NO MPRF'.DTSBX626 +00289 10 MSG1-LONG-TEXT. DTSBX626 +00290 15 FILLER PIC X(30) DTSBX626 +00291 VALUE 'FAC6 RECORD ENCOUNTERED WITH N'. DTSBX626 +00292 15 FILLER PIC X(30) DTSBX626 +00293 VALUE 'O CORRESPONDING MPAY RECORD '. DTSBX626 +00294 01 HEADER-1. CL**5 +00295 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00296 05 FILLER PIC X(49) VALUE '140R1'. CL**5 +00297 05 FILLER PIC X(54) VALUE CL*28 +00298 'DISTRICT OF COLUMBIA'. CL**5 +00299 05 FILLER PIC X(06) VALUE 'DATE:'. CL**5 +00300 05 HDR1-LRCM-SYS-DATE PIC X(10). CL**5 +00301 01 HEADER-2. CL**5 +00302 05 FILLER PIC X(54) VALUE SPACES. CL**5 +00303 05 FILLER PIC X(49) VALUE CL*28 +00304 'TAX DIVISION'. CL**5 +00305 05 FILLER PIC X(06) VALUE 'TIME:'. CL**5 +00306 05 HDR2-LRCM-SYS-TIME PIC X(08). CL**5 +00307 01 HEADER-3. CL**5 +00308 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00309 05 FILLER PIC X(40) VALUE CL119 +00310 'ROUTE TO: TAX ACCOUNTING '. CL**6 +00311 05 HDR3-LITERAL PIC X(57) VALUE SPACES. CL117 +00312 05 FILLER PIC X(20) VALUE SPACES. CL*27 +00313 05 FILLER PIC X(06) VALUE 'PAGE:'. CL**5 +00314 05 HEADER-3-PAGE PIC ZZ,ZZ9. CL*12 +00315 CL**5 +00316 01 HEADER-3A. CL**6 +00317 05 FILLER PIC X(01) VALUE SPACES. CL**6 +00318 05 FILLER PIC X(23) VALUE CL*30 +00319 'ACH RETURNS DATE/TIME: '. CL*41 +00320 05 FILLER PIC X(01) VALUE SPACES. CL*26 +00321 05 HEADER-3A-DATE PIC X(06) VALUE SPACES. CL*22 +00322 05 FILLER PIC X(01) VALUE '/'. CL*22 +00323 05 HEADER-3A-TIME PIC X(06) VALUE SPACES. CL*22 +00324 CL*22 +00325 01 HEADER-4. CL**5 +00326 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00327 05 FILLER PIC X(132) VALUE SPACES. CL**5 +00328 01 HEADER-5. CL**5 +00329 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00330 05 FILLER PIC X(28) VALUE CL*55 +00331 'EMP NO NAME REV BTCH/ITM '. CL*55 +00332 05 FILLER PIC X(01) VALUE SPACES. CL*55 +00333 05 FILLER PIC X(44) VALUE CL*69 +00334 'BANK ID ACCT NO ACH AMOUNT '. CL*69 +00335 * 05 FILLER PIC X(04) VALUE SPACES. CL*63 +00336 05 FILLER PIC X(09) VALUE CL**5 +00337 'TRACE NO '. CL**5 +00338 * 05 FILLER PIC X(02) VALUE SPACES. CL*63 +00339 05 HDR5-NAME PIC X(50) VALUE CL119 +00340 ' CODE REASON BANK RETURNED ACH DEBIT PAYMENT'. CL119 +00341 01 HEADER-6. CL**5 +00342 05 FILLER PIC X(01) VALUE SPACES. CL**5 +00343 05 FILLER PIC X(132) VALUE SPACES. CL**5 +00344 CL*56 +00345 01 ZNOTE1. CL*56 +00346 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00347 05 FILLER PIC X(53) VALUE CL*56 +00348 '** NOTE 1. CODE BEGINNING WITH 98 INDICATES A NOC '. CL*69 +00349 CL*56 +00350 01 CNOTE1. CL*56 +00351 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00352 05 FILLER PIC X(53) VALUE CL*56 +00353 'THE ACH NETWORK PROVIDED NOTIFICATION THAT SOMETHING '. CL*56 +00354 05 FILLER PIC X(53) VALUE CL*56 +00355 'ABOUT THE BANK ACCOUNT HAS CHANGED. WELLS FARGO HAS '. CL*56 +00356 CL*56 +00357 01 CNOTE2. CL*56 +00358 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00359 05 FILLER PIC X(53) VALUE CL*56 +00360 'CORRECTED SUBSEQUENT PAYMENTS FOR THE AFFTECTED BANK '. CL*56 +00361 05 FILLER PIC X(53) VALUE CL*56 +00362 'ACCOUNT USING THE UPDATED INFORMATION. '. CL*56 +00363 CL*56 +00364 01 CNOTE3. CL*56 +00365 05 FILLER PIC X(02) VALUE SPACES. CL*56 +00366 05 FILLER PIC X(53) VALUE CL*56 +00367 '>>>>>>>> USE THE NOTIFICATION OF CHANGE REPORT FROM '. CL*56 +00368 05 FILLER PIC X(53) VALUE CL*56 +00369 'WELLS FARGO TO UPDATE YOUR SYSTEM INFORMATION. <<<<< '. CL*56 +00370 CL*56 +00371 01 DETAIL-LINE-1. CL**5 +00372 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00373 15 X425-EMP-NO PIC 999B999 BLANK WHEN ZERO. CL**6 +00374 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00375 15 X425-NAME-CHECK PIC X(04) VALUE SPACES. CL*53 +00376 15 FILLER PIC X(02) VALUE SPACES. CL*53 +00377 15 X425-AUTO-REV PIC X(02) VALUE SPACES. CL*53 +00378 15 FILLER PIC X(01) VALUE SPACES. CL*53 +00379 15 X425-AUTO-BATCH PIC X(05) VALUE SPACES. CL*53 +00380 15 X425-AUTO-FILL PIC X(01) VALUE '/'. CL*53 +00381 15 X425-AUTO-ITEM PIC X(03) VALUE SPACES. CL*53 +00382 15 FILLER PIC X(02) VALUE SPACES. CL**5 +00383 15 X425-BANK-ID PIC X(10) VALUE SPACES. CL*38 +00384 15 FILLER PIC X(02) VALUE SPACES. CL*38 +00385 15 X425-ACCT-NUMBER PIC X(17) VALUE SPACES. CL*58 +00386 15 FILLER PIC X(02) VALUE SPACES. CL*22 +00387 15 X425-X145-REMIT PIC -------9.99. CL**7 +00388 15 FILLER PIC X(02) VALUE SPACES. CL*58 +00389 15 X425-X145-TRACE-NOB PIC X(08) VALUE SPACES. CL*10 +00390 15 FILLER PIC X(02) VALUE SPACES. CL*58 +00391 15 X425-MESSAGE PIC X(54). CL*58 +00392 CL**5 +00393 CL*83 +00394 01 DETAIL-LINE-2. CL*30 +00395 15 FILLER PIC X(15) VALUE SPACES. CL*30 +00396 05 FILLER PIC X(56) VALUE CL*30 +00397 ' ********* NO ACH DEBIT RETURNS **********'. CL*41 +00398 CL*30 +00399 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL**5 +00400 01 FOOTING-LINE-2 PIC X(133) VALUE CL117 +00401 ' *** WELLS FARGO TRANSACTIONS **'. CL117 +00402 CL**5 +00403 01 FOOTDTS-LINE-2 PIC X(133) VALUE CL117 +00404 ' *** DOES DUTAS TRANSACTIONS **'. CL117 +00405 01 FOOTING-LINE-3. CL**5 +00406 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00407 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL**5 +00408 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00409 05 FILLER PIC X(45) VALUE CL**5 +00410 ' TOTAL ACH DEBIT DEPOSITS RETURNED '. CL*41 +00411 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00412 CL**5 +00413 01 FOOTING-LINE-4. CL**5 +00414 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00415 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. CL**5 +00416 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00417 05 FILLER PIC X(40) VALUE CL118 +00418 ' # OF ACH DEBITS RETURNED HAD ERRORS'. CL117 +00419 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00420 01 FOOTING-LINE-5. CL**5 +00421 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00422 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. CL**5 +00423 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00424 05 FILLER PIC X(40) VALUE CL**5 +00425 ' # OF ACH RETURNS WENT TO PENDING FILE '. CL*83 +00426 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00427 01 FOOTING-LINE-6. CL**5 +00428 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00429 05 WS-T025-WRITE-CNT PIC ZZ,ZZ9. CL**5 +00430 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00431 05 FILLER PIC X(45) VALUE CL**5 +00432 ' # OF ACH REVERSAL TRANS SENT TO DUTAS '. CL117 +00433 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00434 01 FOOTING-LINE-7. CL**5 +00435 05 FILLER PIC X(19) VALUE SPACES. CL**5 +00436 05 WS-TOT-REMIT PIC $$$$$$$$9.99. CL**5 +00437 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00438 05 FILLER PIC X(50) VALUE CL114 +00439 ' TOTAL AMOUNT OF ACH PAYMENTS REVERSED'. CL114 +00440 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00441 CL**5 +00442 01 FOOTING-LINE-8. CL**5 +00443 05 FILLER PIC X(19) VALUE SPACES. CL**5 +00444 05 WS-TOTAL-REMIT PIC $$$$$$$$9.99. CL**5 +00445 05 FILLER PIC X(02) VALUE SPACES. CL**5 +00446 05 FILLER PIC X(45) VALUE CL**5 +00447 'TOTAL AMOUNT - ACH DEBITS RETURNED '. CL*41 +00448 05 FILLER PIC X(32) VALUE SPACES. CL**5 +00449 01 FOOTING-LINE-13. CL**5 +00450 05 FILLER PIC X(25) VALUE SPACES. CL**5 +00451 05 FILLER PIC X(67) VALUE CL**5 +00452 '*** END DOES/WELLS FARGO DAILY ACH TRANSMISSION ***'. CL*40 +00453 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. CL**5 +00454 CL152 +00455 01 HOLD-X145-REC. CL152 +00456 ++INCLUDE DTSHX145 CL152 +00457 CL152 +00458 DTSBX626 +00459 01 ESSP-X145-REC. CL150 +00460 ++INCLUDE DTSEX145 CL150 +00461 CL150 +00462 01 FACH-LINK-REC. DTSBX626 +00463 ++INCLUDE DTSIXACH CL**2 +00464 EJECT DTSBX626 +00465 01 FAC0-LINK-REC. CL*45 +00466 ++INCLUDE DTSIXAC0 CL*45 +00467 EJECT DTSBX626 +00468 EJECT CL*45 +00469 01 FAC1-LINK-REC. CL*45 +00470 ++INCLUDE DTSIXAC1 CL*45 +00471 EJECT CL*45 +00472 01 FAC5-LINK-REC. CL**2 +00473 ++INCLUDE DTSIXAC5 CL**2 +00474 EJECT CL**2 +00475 01 FAC6-LINK-REC. DTSBX626 +00476 ++INCLUDE DTSIXAC6 CL**2 +00477 EJECT DTSBX626 +00478 01 FAC7-LINK-REC. CL**3 +00479 ++INCLUDE DTSIXAC7 CL**3 +00480 EJECT CL**3 +00481 01 FAC9-LINK-REC. DTSBX626 +00482 ++INCLUDE DTSIXAC9 CL**2 +00483 EJECT DTSBX626 +00484 01 MNTE-REC. CL*70 +00485 ++INCLUDE DTSIMNTE CL*70 +00486 EJECT DTSBX626 +00487 01 MPAY-REC. CL*70 +00488 ++INCLUDE DTSIMPAY CL*70 +00489 EJECT CL*70 +00490 01 L005-LINK-AREA. DTSBX626 +00491 ++INCLUDE DTSIL005 DTSBX626 +00492 EJECT DTSBX626 +00493 01 L001-LINK-AREA. CL*71 +00494 ++INCLUDE DTSIL001 CL*71 +00495 EJECT CL*71 +00496 01 RSK1-REC. DTSBX626 +00497 ++INCLUDE DTSIRSK1 DTSBX626 +00498 EJECT DTSBX626 +00499 01 ITRT-REC. DTSBX626 +00500 ++INCLUDE DTSIITRT DTSBX626 +00501 EJECT DTSBX626 +00502 01 ISKL-REC. DTSBX626 +00503 ++INCLUDE DTSIISKL DTSBX626 +00504 EJECT DTSBX626 +00505 01 R907-REC. DTSBX626 +00506 ++INCLUDE DTSIR907 DTSBX626 +00507 EJECT DTSBX626 +00508 01 EFT-BATCH-ERRORS-MESS. DTSBX626 +00509 ++INCLUDE EFTERMSG DTSBX626 +00510 EJECT DTSBX626 +00511 01 F907-REC. DTSBX626 +00512 ++INCLUDE EFTIF907 DTSBX626 +00513 EJECT DTSBX626 +00514 01 T025-REC. DTSBX626 +00515 ++INCLUDE DTSIT025 DTSBX626 +00516 EJECT DTSBX626 +00517 01 T003-REC. CL*71 +00518 ++INCLUDE DTSIT003 CL*71 +00519 EJECT CL*71 +00520 01 L910-LINK-AREA. DTSBX626 +00521 ++INCLUDE DTSIL910 DTSBX626 +00522 EJECT DTSBX626 +00523 01 L921-LINK-AREA. DTSBX626 +00524 ++INCLUDE DTSIL921 DTSBX626 +00525 EJECT DTSBX626 +00526 01 L927-LINK-AREA. DTSBX626 +00527 ++INCLUDE DTSIL927 DTSBX626 +00528 EJECT DTSBX626 +00529 01 MSKL-REC. DTSBX626 +00530 ++INCLUDE DTSIMSKL DTSBX626 +00531 EJECT DTSBX626 +00532 01 TSKL-REC. DTSBX626 +00533 ++INCLUDE DTSITSKL DTSBX626 +00534 EJECT DTSBX626 +00535 01 MPRF-REC. DTSBX626 +00536 ++INCLUDE DTSIMPRF DTSBX626 +00537 EJECT DTSBX626 +00538 01 MTAD-REC. DTSBX626 +00539 ++INCLUDE DTSIMTAD DTSBX626 +00540 DTSBX626 +00541 PROCEDURE DIVISION. DTSBX626 +00542 DTSBX626 +00543 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX626 +00544 CL*16 +00545 PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL DTSBX626 +00546 WRK-FACH-IND = 'Y'. DTSBX626 +00547 DTSBX626 +00548 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX626 +00549 IF WS-TOTAL-X145-AMT NOT = X145-ACH-REC-DEPOSIT CL224 +00550 * PERFORM S999-ABEND THRU S999-EXIT CL224 +00551 MOVE +05 TO RETURN-CODE CL224 +00552 DISPLAY 'RET CODE VALUE ' RETURN-CODE CL224 +00553 END-IF. CL224 +00554 DTSBX626 +00555 GOBACK. DTSBX626 +00556 DTSBX626 +00557 I0000-INITIATE. DTSBX626 +00558 DTSBX626 +00559 MOVE +0 TO WRK-FACH-READ-CNT DTSBX626 +00560 WRK-MPAY-REMIT-AMT DTSBX626 +00561 WRK-FACH-SELECTED-CNT DTSBX626 +00562 WRK-R907-WRITE-CNT DTSBX626 +00563 WRK-OTHER-RECORDS DTSBX626 +00564 WS-FAC7-PEN-CNT CL*86 +00565 WRK-FAC6-RECORDS DTSBX626 +00566 WRK-FAC7-RECORDS CL*43 +00567 WRK-HEADER-RECORDS DTSBX626 +00568 WRK-TRAILER-RECORDS DTSBX626 +00569 WRK-F907-WRITE-CNT DTSBX626 +00570 WRK-T025-WRITE-CNT DTSBX626 +00571 WRK-T003-WRITE-CNT CL*76 +00572 WRK-TRAILER-REC-CNT DTSBX626 +00573 WRK-FAC6-AMOUNT DTSBX626 +00574 WRK-MPAY-AMOUNT CL*99 +00575 TOT-FAC6-AMOUNT DTSBX626 +00576 TOT-MPAY-AMOUNT CL115 +00577 WRK-MPAY-HOLD-EMP-NO CL106 +00578 WRK-MPAY-CNT CL106 +00579 TOT-TRAILER-AMT CL106 +00580 WRK-FAC6-DOES-TRACE-NO. CL**4 +00581 DTSBX626 +00582 MOVE ZEROS TO FAC1-LINK-REC DTSBX626 +00583 FAC6-LINK-REC DTSBX626 +00584 FAC7-LINK-REC CL*48 +00585 FAC9-LINK-REC. DTSBX626 +00586 DTSBX626 +00587 MOVE 'N' TO WRK-TRACE-IND, WRK-FACH-IND. DTSBX626 +00588 DTSBX626 +00589 MOVE 'Y' TO WRK-FAC1-IND, WRK-DTSBU005-IND. DTSBX626 +00590 DTSBX626 +00591 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX626 +00592 DTSBX626 +00593 I0000-EXIT. DTSBX626 +00594 EXIT. DTSBX626 +00595 I2000-OPEN-FILES. DTSBX626 +00596 DTSBX626 +00597 MOVE LENGTH OF T025-REC TO T025-LENGTH. DTSBX626 +00598 MOVE LENGTH OF F907-REC TO F907-LENGTH. DTSBX626 +00599 DTSBX626 +00600 MOVE WRK-TRACE-IND TO L910-TRACE-IND, L921-TRACE-IND. DTSBX626 +00601 DTSBX626 +00602 MOVE WRK-MOD-NAME TO L910-MOD-NAME, L921-MOD-NAME DTSBX626 +00603 DTSBX626 +00604 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX626 +00605 DTSBX626 +00606 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX626 +00607 DTSBX626 +00608 MOVE 'N' TO L927-TRACE-IND. DTSBX626 +00609 MOVE WRK-MOD-NAME TO L927-MOD-NAME. DTSBX626 +00610 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSBX626 +00611 CL*32 +00612 PERFORM S005-FROM-SYS THRU S005-EXIT. CL*32 +00613 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME. CL*32 +00614 MOVE L005-SLASH-DATE TO W-SLASH-DATE. CL*32 +00615 DISPLAY 'SYS DATE ' W-SLASH-DATE. CL*32 +00616 MOVE W-SLASH-DATE TO HDR1-LRCM-SYS-DATE. CL*32 +00617 MOVE L005-DATE TO WRK-CURR-DATE CL147 +00618 MOVE L005-TIME TO WRK-CURR-TIME CL147 +00619 DTSBX626 +00620 OPEN INPUT ESSP-IN-X145. CL150 +00621 DTSBX626 +00622 IF NOT FACH-STATUS-OK-88 CL*17 +00623 DISPLAY 'OPEN ERROR ON ESSP INPUT FILE ** ' FACH-STATUS CL150 +00624 ELSE CL213 +00625 IF FACH-STATUS-OK-88 CL213 +00626 NEXT SENTENCE CL213 +00627 ELSE CL213 +00628 DISPLAY 'OPEN ERROR ON ESSP INPUT FILE ** ' FACH-STATUS CL213 +00629 PERFORM S999-ABEND THRU S999-EXIT CL213 +00630 END-IF CL213 +00631 END-IF. CL213 +00632 CL**6 +00633 CL*83 +00634 OPEN OUTPUT ESSP-OUT-X145. CL150 +00635 IF REPT-STATUS-OK-88 CL*79 +00636 NEXT SENTENCE CL*79 +00637 ELSE CL*79 +00638 DISPLAY 'CANNOT OPEN OUTPUT ESSP X145 FILE ' CL150 +00639 REPT-STATUS CL*79 +00640 PERFORM S999-ABEND THRU S999-EXIT CL213 +00641 END-IF. CL*79 +00642 CL*79 +00643 OPEN OUTPUT ESSP-EMAIL-RPT CL205 +00644 IF REPT-STATUS-OK-88 CL205 +00645 NEXT SENTENCE CL205 +00646 ELSE CL205 +00647 DISPLAY 'CANNOT OPEN EMAIL FILE ' CL205 +00648 REPT-STATUS CL205 +00649 PERFORM S999-ABEND THRU S999-EXIT CL213 +00650 END-IF. CL205 +00651 CL205 +00652 READ ESSP-IN-X145 INTO ESSP-X145-REC CL151 +00653 AT END CL*18 +00654 MOVE +5 TO RETURN-CODE CL209 +00655 DISPLAY 'NO X145 PAYMENTS FROM ESSP ' CL150 +00656 MOVE 'Y' TO WRK-FACH-IND CL*18 +00657 GO TO I2000-EXIT. CL*18 +00658 CL174 +00659 CL*18 +00660 * ADD +1 TO WRK-FACH-READ-CNT. CL150 +00661 DTSBX626 +00662 I2000-EXIT. DTSBX626 +00663 EXIT. DTSBX626 +00664 DTSBX626 +00665 P0000-PROCESS. DTSBX626 +00666 * DISPLAY ' 1000 - PROCESS'. CL150 +00667 DTSBX626 +00668 * MOVE FACH-REC-94 TO FACH-LINK-REC. CL146 +00669 DTSBX626 +00670 ADD +1 TO WRK-FACH-READ-CNT. DTSBX626 +00671 CL151 +00672 IF WRK-FACH-READ-CNT = 1 CL151 +00673 MOVE ESSP-X145-REC TO HOLD-X145-REC CL153 +00674 MOVE E145-EMP-NO TO WS-HOLD-X145-EMP-NO CL151 +00675 MOVE E145-TRACE-NO TO WS-HOLD-TRACE-NO CL173 +00676 MOVE E145-REMITTANCE TO WS-HOLD-E145-AMT CL168 +00677 ADD WS-HOLD-E145-AMT TO WS-HOLD-X145-AMT CL172 +00678 GO TO P0000-CONTINUE. CL151 +00679 CL151 +00680 MOVE 0 TO WRK-FACH-EMP-FOUND. CL176 +00681 * IF FACH-TYPE-ENTRY-DETAIL-88 CL146 +00682 * SET WRK-FACH-PEND-REC-NO-88 TO TRUE CL146 +00683 * MOVE FACH-LINK-REC TO FAC6-LINK-REC CL146 +00684 * ADD 1 TO WRK-FAC6-RECORDS CL146 +00685 PERFORM P2010-X145-EDIT THRU P2010-EXIT. CL154 +00686 * ELSE CL146 +00687 * IF FACH-TYPE-ADDENDA-88 CL146 +00688 * MOVE FACH-LINK-REC TO FAC7-LINK-REC CL146 +00689 * ADD 1 TO WRK-FAC7-RECORDS CL146 +00690 * PERFORM P1011-FAC7-EDIT THRU P1011-EXIT CL150 +00691 * ELSE CL146 +00692 * IF FACH-TYPE-TRAILER-88 CL146 +00693 * MOVE FACH-LINK-REC TO FAC9-LINK-REC CL146 +00694 * ADD 1 TO WRK-TRAILER-RECORDS CL146 +00695 * ADD 1 TO WRK-TRAILER-REC-CNT CL146 +00696 * PERFORM P1015-TRAILER-EDIT THRU P1015-EXIT CL146 +00697 * ELSE CL146 +00698 * ADD 1 TO WRK-OTHER-RECORDS. CL146 +00699 CL*18 +00700 P0000-CONTINUE. CL151 +00701 READ ESSP-IN-X145 INTO ESSP-X145-REC CL151 +00702 AT END CL*18 +00703 MOVE 'Y' TO WRK-FACH-IND CL*18 +00704 PERFORM P2050-X145-END THRU P2050-EXIT CL170 +00705 GO TO P0000-EXIT. CL*18 +00706 DTSBX626 +00707 P0000-EXIT. DTSBX626 +00708 EXIT. DTSBX626 +00709 DTSBX626 +00710 DTSBX626 +00711 P1005-HEADER-EDIT. DTSBX626 +00712 DTSBX626 +00713 DISPLAY ' 1005 - HEADER PROCESS'. CL*49 +00714 IF WRK-FACH-READ-CNT NOT = 1 DTSBX626 +00715 MOVE 'Y' TO WRK-FACH-IND DTSBX626 +00716 DISPLAY ' FIRST RECORD OF FILE IS NOT A HEADER RECORD' DTSBX626 +00717 PERFORM S999-ABEND THRU S999-EXIT. DTSBX626 +00718 MOVE '161003' TO WRK-FAC1-DATE. CL146 +00719 MOVE WRK-FAC1-DATE-YY TO WRK-RTN-DATE-YY. CL*92 +00720 MOVE WRK-FAC1-DATE-MM TO WRK-RTN-DATE-MM. CL*92 +00721 MOVE WRK-FAC1-DATE-DD TO WRK-RTN-DATE-DD. CL*92 +00722 MOVE WRK-RTN-DATE TO WRK-RECV-DATE. CL*92 +00723 P1005-EXIT. DTSBX626 +00724 EXIT. DTSBX626 +00725 P2010-X145-EDIT. CL151 +00726 DISPLAY 'WS-HOLD-EMP: ' WS-HOLD-X145-EMP-NO. CL151 +00727 DISPLAY 'ESSP-IN-EMP: ' E145-EMP-NO ' ' E145-REMITTANCE CL198 +00728 CL151 +00729 IF E145-EMP-NO = WS-HOLD-X145-EMP-NO AND CL173 +00730 E145-TRACE-NO = WS-HOLD-TRACE-NO CL173 +00731 MOVE E145-REMITTANCE TO WS-HOLD-E145-AMT CL165 +00732 ADD WS-HOLD-E145-AMT TO WS-HOLD-X145-AMT CL165 +00733 GO TO P2010-EXIT CL184 +00734 ELSE CL151 +00735 MOVE WS-HOLD-X145-AMT TO H145-REMITTANCE CL152 +00736 PERFORM P2075-X145-ACH THRU P2075-EXIT. CL184 +00737 CL186 +00738 IF WRK-FACH-EMP-FOUND = 1 CL176 +00739 WRITE X145-OUT-REC FROM HOLD-X145-REC CL176 +00740 ADD WS-HOLD-X145-AMT TO WS-TOTAL-X145-AMT CL169 +00741 DISPLAY 'TOT EMP AMT: ' WS-HOLD-X145-EMP-NO ' ' CL165 +00742 WS-FAC6-HOLD-TRACE-NO ' ' WS-HOLD-X145-AMT CL191 +00743 ELSE CL184 +00744 ADD 1 TO WRK-X145-NOT-CNT CL200 +00745 WRITE X145-OUT-REC FROM HOLD-X145-REC CL200 +00746 ADD WS-HOLD-X145-AMT TO WS-TOTAL-X145-AMT CL200 +00747 DISPLAY '**TOT EMP AMT: ' WS-HOLD-X145-EMP-NO ' ' CL200 +00748 WS-HOLD-TRACE-NO ' ' WS-HOLD-X145-AMT. CL200 +00749 MOVE E145-EMP-NO TO WS-HOLD-X145-EMP-NO. CL184 +00750 MOVE E145-TRACE-NO TO WS-HOLD-TRACE-NO. CL184 +00751 MOVE ZEROS TO WS-HOLD-X145-AMT. CL184 +00752 MOVE ZEROS TO WS-HOLD-E145-AMT. CL184 +00753 MOVE E145-REMITTANCE TO WS-HOLD-E145-AMT. CL184 +00754 ADD WS-HOLD-E145-AMT TO WS-HOLD-X145-AMT. CL184 +00755 ADD 1 TO WRK-X145-OUT-CNT. CL207 +00756 MOVE ESSP-X145-REC TO HOLD-X145-REC. CL184 +00757 CL151 +00758 P2010-EXIT. CL151 +00759 EXIT. CL151 +00760 DTSBX626 +00761 P2050-X145-END. CL170 +00762 * DISPLAY 'WS-HOLD-EMP: ' WS-HOLD-X145-EMP-NO. CL175 +00763 * DISPLAY 'ESSP-IN-EMP: ' E145-EMP-NO. CL175 +00764 CL170 +00765 MOVE WS-HOLD-X145-AMT TO H145-REMITTANCE CL170 +00766 PERFORM P2075-X145-ACH THRU P2075-EXIT CL176 +00767 IF WRK-FACH-EMP-FOUND = 1 CL176 +00768 WRITE X145-OUT-REC FROM HOLD-X145-REC CL176 +00769 ADD WS-HOLD-X145-AMT TO WS-TOTAL-X145-AMT CL170 +00770 DISPLAY 'TOT EMP AMT: ' WS-HOLD-X145-EMP-NO ' ' CL170 +00771 WS-HOLD-X145-AMT CL170 +00772 ADD 1 TO WRK-X145-OUT-CNT CL207 +00773 ELSE CL176 +00774 WRITE X145-OUT-REC FROM HOLD-X145-REC CL201 +00775 ADD WS-HOLD-X145-AMT TO WS-TOTAL-X145-AMT CL201 +00776 DISPLAY '**TOT EMP AMT: ' WS-HOLD-X145-EMP-NO ' ' CL201 +00777 WS-HOLD-X145-AMT CL201 +00778 ADD 1 TO WRK-X145-NOT-CNT CL201 +00779 DISPLAY 'ERROR ***** NOT MATCH: ' WS-HOLD-X145-EMP-NO ' ' CL186 +00780 WS-HOLD-X145-AMT. CL176 +00781 CL176 +00782 CL170 +00783 P2050-EXIT. CL171 +00784 EXIT. CL170 +00785 CL170 +00786 P2075-X145-ACH. CL174 +00787 OPEN INPUT ESSP-IN-X145ACH. CL174 +00788 CL174 +00789 MOVE 0 TO WRK-XACH-IND. CL186 +00790 DISPLAY 'P2075: ' WS-HOLD-X145-EMP-NO ' ' CL180 +00791 WS-HOLD-X145-AMT. CL180 +00792 CL186 +00793 IF NOT FACH-STATUS-OK-88 CL174 +00794 DISPLAY 'OPEN ERROR ON ESSP ACH FILE ** ' FACH-STATUS CL174 +00795 * MOVE +5 TO RETURN-CODE CL213 +00796 PERFORM S999-ABEND THRU S999-EXIT CL213 +00797 CLOSE ESSP-IN-X145ACH CL209 +00798 GO TO P2075-EXIT CL209 +00799 END-IF. CL174 +00800 CL174 +00801 PERFORM P2085-X145-FIND-ACH THRU P2085-EXIT UNTIL CL174 +00802 WRK-XACH-IND = 1 CL174 +00803 CL174 +00804 CLOSE ESSP-IN-X145ACH. CL180 +00805 P2075-EXIT. CL174 +00806 EXIT. CL174 +00807 CL174 +00808 P2085-X145-FIND-ACH. CL174 +00809 READ ESSP-IN-X145ACH INTO FACH-LINK-REC CL177 +00810 AT END CL174 +00811 MOVE 1 TO WRK-XACH-IND CL204 +00812 MOVE 0 TO WRK-FACH-EMP-FOUND CL203 +00813 GO TO P2085-EXIT. CL174 +00814 CL174 +00815 IF NOT FACH-TYPE-ENTRY-DETAIL-88 CL174 +00816 * DISPLAY 'P2085: FACH NOT TYPE 6: ' WS-HOLD-X145-EMP-NO CL188 +00817 GO TO P2085-EXIT. CL174 +00818 CL174 +00819 * DISPLAY 'P2085: ' WS-HOLD-X145-EMP-NO ' ' CL189 +00820 * WS-HOLD-X145-AMT. CL189 +00821 MOVE ZEROS TO FAC6-HOLD-AMOUNT CL176 +00822 MOVE FACH-LINK-REC TO FAC6-LINK-REC CL174 +00823 ADD 1 TO WRK-FAC6-RECORDS CL174 +00824 MOVE 0 TO WRK-FACH-EMP-FOUND CL176 +00825 CL176 +00826 MOVE FAC6-AMOUNT TO FAC6-HOLD-AMOUNT CL176 +00827 MOVE FAC6-DOES-TRACE-NO TO WS-FAC6-HOLD-TRACE-NO CL183 +00828 CL176 +00829 * DISPLAY 'FACH: ' FAC6-DUTAS-EMP-NO CL188 +00830 * ' ' WS-FAC6-HOLD-TRACE-NO ' ' FAC6-HOLD-AMOUNT. CL188 +00831 CL182 +00832 * DISPLAY 'X145: ' WS-HOLD-X145-EMP-NO CL188 +00833 * ' ' WS-HOLD-TRACE-NO ' ' WS-HOLD-X145-AMT. CL188 +00834 CL182 +00835 IF FAC6-DUTAS-EMP-NO = WS-HOLD-X145-EMP-NO AND CL182 +00836 WS-FAC6-HOLD-TRACE-NO = WS-HOLD-TRACE-NO AND CL184 +00837 WS-HOLD-X145-AMT = FAC6-HOLD-AMOUNT CL176 +00838 MOVE 1 TO WRK-XACH-IND CL176 +00839 MOVE 1 TO WRK-FACH-EMP-FOUND CL176 +00840 GO TO P2085-EXIT. CL176 +00841 CL176 +00842 IF FAC6-DUTAS-EMP-NO > WS-HOLD-X145-EMP-NO CL187 +00843 MOVE 1 TO WRK-XACH-IND CL181 +00844 MOVE 0 TO WRK-FACH-EMP-FOUND CL176 +00845 DISPLAY 'P2086: EMP NOT ON ACH: ' WS-HOLD-X145-EMP-NO CL189 +00846 GO TO P2085-EXIT. CL176 +00847 CL175 +00848 IF FAC6-DUTAS-EMP-NO < WS-HOLD-X145-EMP-NO CL187 +00849 GO TO P2085-X145-FIND-ACH. CL175 +00850 CL175 +00851 IF WS-FAC6-HOLD-TRACE-NO < WS-HOLD-TRACE-NO CL192 +00852 GO TO P2085-X145-FIND-ACH. CL175 +00853 CL175 +00854 IF WS-FAC6-HOLD-TRACE-NO > WS-HOLD-TRACE-NO CL192 +00855 DISPLAY 'P2086:TRACE NO NOT ACH: ' WS-HOLD-X145-EMP-NO CL189 +00856 DISPLAY 'FACH: ' FAC6-DUTAS-EMP-NO CL190 +00857 ' ' WS-FAC6-HOLD-TRACE-NO ' ' FAC6-HOLD-AMOUNT CL190 +00858 DISPLAY 'X145: ' WS-HOLD-X145-EMP-NO CL190 +00859 ' ' WS-HOLD-TRACE-NO ' ' WS-HOLD-X145-AMT CL190 +00860 MOVE 1 TO WRK-XACH-IND CL181 +00861 MOVE 0 TO WRK-FACH-EMP-FOUND CL176 +00862 GO TO P2085-EXIT. CL176 +00863 CL175 +00864 * IF X144-SSN < X147-SSN CL176 +00865 * GO TO P2085-X145-FIND-ACH. CL176 +00866 CL175 +00867 CL175 +00868 CL174 +00869 P2085-EXIT. CL174 +00870 EXIT. CL174 +00871 P1010-FAC6-EDIT. DTSBX626 +00872 CL151 +00873 SET WRITE-T025-NO-88 TO TRUE. DTSBX626 +00874 SET MPAY-FOUND-YES-88 TO TRUE. CL105 +00875 * DISPLAY ' 1010 - AMOUNT ' FAC6-AMOUNT CL146 +00876 * DISPLAY ' 1010 - TRACEIN ' FAC6-DOES-TRACE-NO CL146 +00877 MOVE ZEROS TO WRK-TEMP-TRACE-NO DTSBX626 +00878 WRK-FAC6-AMT-DISP CL148 +00879 WRK-FAC6-DOES-TRACE-NO. CL148 +00880 * WRK-DOES-TRACE-NO. CL*12 +00881 MOVE E145-REMITTANCE TO FAC6-AMOUNT CL147 +00882 MOVE FAC6-AMOUNT TO WRK-FAC6-AMOUNT. CL146 +00883 * MOVE E145-TRACE-NO TO FAC6-DOES-TRACE-NO CL149 +00884 MOVE E145-TRACE-NO TO WRK-TEMP-TRACE-NO. CL149 +00885 DTSBX626 +00886 MOVE FAC6-AMOUNT TO WRK-FAC6-AMT-DISP. CL*73 +00887 MOVE WRK-FAC6-AMT-DISP TO NTE-AMOUNT. CL*73 +00888 * MOVE ZEROS TO WRK-TEMP-TRACE-NOA. CL*21 +00889 * MOVE WRK-DOES-TRACE-NOB TO WRK-TEMP-TRACE-NOB. CL*12 +00890 MOVE WRK-TEMP-TRACE-NOA TO WRK-FAC6-DOES-TRACE-NO. CL*21 +00891 DTSBX626 +00892 DISPLAY 'TRACE-NO -TEMP ' WRK-TEMP-TRACE-NO DTSBX626 +00893 DISPLAY 'TRACE-WRK-FAC6 ' WRK-FAC6-DOES-TRACE-NO CL**4 +00894 DTSBX626 +00895 IF FAC6-AMOUNT = ZEROS DTSBX626 +00896 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00897 DISPLAY ' ACH PAYMENT = ZEROS ' FAC6-AMOUNT CL**8 +00898 MOVE +2 TO RETURN-CODE. CL*37 +00899 * MOVE EFT027 TO F907-MSG-TEXT CL**8 +00900 * MOVE '027' TO F907-MSG-ID CL**8 +00901 * MOVE ZEROS TO F907-EMP-NO CL**8 +00902 * MOVE FAC6-AMOUNT TO F907-GOV1-REC CL**8 +00903 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00904 * GO TO P1010-EXIT. CL**8 +00905 DTSBX626 +00906 IF FAC6-AMOUNT NOT NUMERIC DTSBX626 +00907 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00908 DISPLAY ' ACH PAYMENT NOT NUMERIC ' FAC6-AMOUNT CL**8 +00909 MOVE +2 TO RETURN-CODE. CL*37 +00910 * MOVE EFT028 TO F907-MSG-TEXT CL**8 +00911 * MOVE '028' TO F907-MSG-ID CL**8 +00912 * MOVE ZEROS TO F907-EMP-NO CL**8 +00913 * MOVE WRK-FAC6-AMOUNT TO F907-GOV1-REC CL**8 +00914 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00915 * GO TO P1010-EXIT. CL**8 +00916 DTSBX626 +00917 ADD WRK-FAC6-AMOUNT TO TOT-FAC6-AMOUNT. DTSBX626 +00918 DTSBX626 +00919 IF WRK-TEMP-TRACE-NO NOT NUMERIC DTSBX626 +00920 ADD 1 TO WRK-F907-WRITE-CNT CL**8 +00921 DISPLAY 'TRACE-NO NOT NUMERIC ' WRK-TEMP-TRACE-NO CL**8 +00922 MOVE +2 TO RETURN-CODE. CL*37 +00923 * MOVE EFT013 TO F907-MSG-TEXT CL**8 +00924 * MOVE '013' TO F907-MSG-ID CL**8 +00925 * MOVE ZEROS TO F907-EMP-NO CL**8 +00926 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 +00927 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00928 * GO TO P1010-EXIT. CL**8 +00929 DTSBX626 +00930 IF WRK-TEMP-TRACE-NO = ZEROS DTSBX626 +00931 DISPLAY 'TRACE-NO = ZEROS ' WRK-TEMP-TRACE-NO CL**8 +00932 MOVE +2 TO RETURN-CODE. CL*37 +00933 * MOVE EFT014 TO F907-MSG-TEXT CL**8 +00934 * MOVE '014' TO F907-MSG-ID CL**8 +00935 * MOVE ZEROS TO F907-EMP-NO CL**8 +00936 * MOVE WRK-TEMP-TRACE-NO TO F907-GOV1-TRACE CL**8 +00937 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT CL**8 +00938 * GO TO P1010-EXIT. CL**8 +00939 DTSBX626 +00940 SET MPRF-FOUND-YES-88 TO TRUE. CL135 +00941 CL123 +00942 * IF FAC6-DUTAS-EMP-NOA = 'DC' CL135 +00943 * GO TO P1010-EXIT. CL135 +00944 CL133 +00945 CL133 +00946 * DISPLAY 'ZEMP-NO: ' FAC6-DUTAS-EMP-NO CL135 +00947 CL132 +00948 * PERFORM P1070-READ-MPRF THRU P1070-EXIT. CL135 +00949 CL*65 +00950 * IF L910-NO-REC-88 CL135 +00951 * SET MPRF-FOUND-NO-88 TO TRUE CL135 +00952 * SET WRITE-T025-NO-88 TO TRUE CL135 +00953 * SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL135 +00954 * MOVE 'DTS01' TO WRK-DTS-RTN-CD CL135 +00955 * DISPLAY '***NO MPRF FOUND ON DUTAS -ERROR ' MPRF-EMP-NO. CL135 +00956 CL*65 +00957 * IF FAC6-AMOUNT = ZEROS OR MPRF-FOUND-NO-88 CL135 +00958 * SET MPAY-FOUND-NO-88 TO TRUE. CL135 +00959 P1010-EXIT. DTSBX626 +00960 EXIT. DTSBX626 +00961 DTSBX626 +00962 P1011-FAC7-EDIT. CL*10 +00963 DISPLAY ' 1011 - TYPE7 PROCESS'. CL*56 +00964 DISPLAY ' FAC7 RETURN CODE ' FAC7-RTN-CD. CL*60 +00965 CL*61 +00966 CL*56 +00967 * IF FAC7-RTN-CD = '98' CL*65 +00968 * DISPLAY ' ***** CODE 98 NO T025 WRITTEN ' MPAY-EMP-NO CL*65 +00969 * MOVE 'N' TO X425-AUTO-REV CL*65 +00970 * MOVE '*****' TO X425-AUTO-BATCH CL*65 +00971 * MOVE 'NOC' TO X425-AUTO-ITEM. CL*65 +00972 CL*87 +00973 MOVE ' DOES-ESSP ACH DEBIT RETURNS/REVERSALS ' CL113 +00974 TO HDR3-LITERAL. CL110 +00975 CL110 +00976 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. CL110 +00977 PERFORM P4000-PRNT-ACHD THRU P4000-EXIT. CL110 +00978 MOVE '98' TO WRK-FAC7-RTN-CD CL147 +00979 PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT. CL110 +00980 * WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1. CL153 +00981 ADD 1 TO WS-LINE-CNT. CL110 +00982 CL109 +00983 IF MPAY-FOUND-YES-88 CL109 +00984 DISPLAY ' MPAY SET TO TRUE ' CL111 +00985 PERFORM P1020-FIND-MPAY-INDEX THRU P1020-EXIT. CL109 +00986 CL109 +00987 GO TO P1011-EXIT. CL147 +00988 CL105 +00989 IF WRK-FACH-PEND-REC-YES-88 CL*83 +00990 MOVE ' DOES-ESSP ACH DEBIT RETURNS NOT FOUND ON DUTAS' CL*87 +00991 TO HDR3-LITERAL CL*87 +00992 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT CL*90 +00993 PERFORM P4000-PRNT-ACHD THRU P4000-EXIT CL*87 +00994 MOVE WRK-DTS-RTN-CD TO WRK-FAC7-RTN-CD CL*83 +00995 PERFORM P5000-ACH-RETURN-CODE THRU P5000-EXIT CL*83 +00996 * WRITE ESSP-ACHR-REC FROM DETAIL-LINE-1 AFTER 1 CL153 +00997 * WRITE PEND-FACH-REC FROM FAC1-LINK-REC CL153 +00998 * WRITE PEND-FACH-REC FROM FAC6-LINK-REC CL153 +00999 * WRITE PEND-FACH-REC FROM FAC7-LINK-REC CL153 +01000 ADD 1 TO WS-FAC7-PEN-CNT CL114 +01001 ADD 1 TO WS-LINE-CNT. CL*83 +01002 CL*83 +01003 P1011-EXIT. CL*10 +01004 EXIT. CL*10 +01005 CL*10 +01006 P1015-TRAILER-EDIT. DTSBX626 +01007 DTSBX626 +01008 DISPLAY ' 1015 - TRAILER PROCESS'. CL*49 +01009 IF WRK-TRAILER-REC-CNT > 1 DTSBX626 +01010 GO TO P1015-EXIT. DTSBX626 +01011 GO TO P1015-EXIT. CL*19 +01012 DTSBX626 +01013 * IF FAC9-BATCH-CNT = ZEROS DTSBX626 +01014 * MOVE EFT066 TO F907-MSG-TEXT DTSBX626 +01015 * MOVE '066' TO F907-MSG-ID DTSBX626 +01016 * MOVE ZEROS TO F907-EMP-NO DTSBX626 +01017 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX626 +01018 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX626 +01019 DTSBX626 +01020 DTSBX626 +01021 * IF FAC9-BATCH-CNT NOT NUMERIC DTSBX626 +01022 * MOVE EFT064 TO F907-MSG-TEXT DTSBX626 +01023 * MOVE '064' TO F907-MSG-ID DTSBX626 +01024 * MOVE ZEROS TO F907-EMP-NO DTSBX626 +01025 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX626 +01026 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX626 +01027 DTSBX626 +01028 * IF WRK-FACH-READ-CNT NOT = FAC9-BATCH-CNT DTSBX626 +01029 * MOVE EFT065 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX626 +01030 * MOVE '065' TO F907-MSG-ID, R907-MSG-ID DTSBX626 +01031 * MOVE ZEROS TO F907-EMP-NO DTSBX626 +01032 * MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX626 +01033 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. DTSBX626 +01034 DTSBX626 +01035 MOVE FAC9-TOT-CREDIT-AMT TO TOT-TRAILER-AMT. DTSBX626 +01036 DTSBX626 +01037 IF TOT-FAC6-AMOUNT NOT = TOT-TRAILER-AMT DTSBX626 +01038 MOVE EFT067 TO F907-MSG-TEXT, R907-MSG-TEXT DTSBX626 +01039 MOVE '067' TO F907-MSG-ID, R907-MSG-ID DTSBX626 +01040 MOVE ZEROS TO F907-EMP-NO DTSBX626 +01041 MOVE FAC9-TRAILER-REC TO F907-GOV1-REC DTSBX626 +01042 DISPLAY '****ERROR TYPE6 AMT NOT = TRAILER AMT ' CL122 +01043 FAC9-TRAILER-REC. CL122 +01044 * PERFORM P1055-WRITE-F907 THRU P1055-EXIT. CL122 +01045 DTSBX626 +01046 P1015-EXIT. DTSBX626 +01047 EXIT. DTSBX626 +01048 P1020-FIND-MPAY-INDEX. CL105 +01049 DTSBX626 +01050 DISPLAY ' 1020 - PROCESS'. DTSBX626 +01051 SET MPAY-FOUND-NO-88 TO TRUE CL111 +01052 SET TRACE-NO-END-NO-88 TO TRUE. CL111 +01053 MOVE LOW-VALUES TO ITRT-KEY-AREA. DTSBX626 +01054 SET ITRT-TRT-88 TO TRUE. DTSBX626 +01055 DTSBX626 +01056 DISPLAY 'TRACE-WRK-FAC6 ' WRK-FAC6-DOES-TRACE-NO CL*46 +01057 * MOVE WRK-NUMR-TRACE-NO TO ITRT-TRACE-NO. CL*46 +01058 MOVE WRK-FAC6-DOES-TRACE-NO TO ITRT-TRACE-NO. CL*46 +01059 DTSBX626 +01060 * MOVE ZEROS TO ITRT-EMP-NO CL141 +01061 * ITRT-BATCH-NO CL141 +01062 * ITRT-ITEM-NO CL141 +01063 MOVE ZEROS TO WRK-MPAY-EMP-AMT CL141 +01064 WRK-MPAY-EMP-CNT CL136 +01065 WRK-MPAY-CNT. CL136 +01066 DTSBX626 +01067 MOVE ITRT-KEY-AREA TO ISKL-KEY-AREA. DTSBX626 +01068 DTSBX626 +01069 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBX626 +01070 IF L921-NO-REC-88 DTSBX626 +01071 DISPLAY ' TRACE NO NOT FOUND ' WRK-FAC6-DOES-TRACE-NO CL*46 +01072 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 +01073 MOVE 'DTS02' TO WRK-DTS-RTN-CD CL*83 +01074 GO TO P1020-EXIT DTSBX626 +01075 ELSE DTSBX626 +01076 PERFORM P1021-FIND-MPAY-RECORD THRU P1021-EXIT UNTIL CL105 +01077 TRACE-NO-END-YES-88. CL105 +01078 P1020-EXIT. CL105 +01079 EXIT. CL105 +01080 CL105 +01081 P1021-FIND-MPAY-RECORD. CL107 +01082 CL105 +01083 DISPLAY ' 1021 - PROCESS'. CL111 +01084 ADD 1 TO WRK-MPAY-CNT. CL105 +01085 MOVE ISKL-REC TO ITRT-REC. CL105 +01086 * DISPLAY ' MMAY CNT ' WRK-MPAY-CNT. CL145 +01087 DISPLAY ' 1TRT TRACE NO - ' ITRT-TRACE-NO CL147 +01088 DISPLAY ' 1FAC6 TRACE NO - ' CL147 +01089 WRK-FAC6-DOES-TRACE-NO. CL147 +01090 DISPLAY ' TRANSACTION TYPE ' ITRT-TRAN-TYPE CL147 +01091 DISPLAY 'ITRT EMP ' ITRT-EMP-NO. CL147 +01092 DISPLAY 'ITRT BATCH ' ITRT-BATCH-NO CL147 +01093 DISPLAY 'ITRT ITEM ' ITRT-ITEM-NO. CL147 +01094 DTSBX626 +01095 IF ITRT-TRACE-NO NOT = WRK-FAC6-DOES-TRACE-NO CL**4 +01096 SET TRACE-NO-END-YES-88 TO TRUE CL105 +01097 IF WRK-MPAY-CNT = 1 CL105 +01098 DISPLAY ' 1TRT TRACE NO - NOT FOUND - ' ITRT-TRACE-NO CL105 +01099 DISPLAY ' 1FAC6 TRACE NO - NOT FOUND - ' CL105 +01100 WRK-FAC6-DOES-TRACE-NO CL105 +01101 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 +01102 MOVE 'DTS02' TO WRK-DTS-RTN-CD CL*83 +01103 GO TO P1021-EXIT CL105 +01104 ELSE CL105 +01105 GO TO P1021-EXIT CL105 +01106 END-IF CL105 +01107 END-IF. CL105 +01108 CL105 +01109 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX626 +01110 MOVE ITRT-EMP-NO TO MPAY-EMP-NO. DTSBX626 +01111 MOVE ITRT-BATCH-NO TO MPAY-BATCH-NO. DTSBX626 +01112 MOVE ITRT-ITEM-NO TO MPAY-ITEM-NO. DTSBX626 +01113 SET MPAY-PAY-88 TO TRUE. DTSBX626 +01114 DTSBX626 +01115 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX626 +01116 DISPLAY ' MPAY EMP-' MPAY-EMP-NO. DTSBX626 +01117 DISPLAY ' MPAY BAT-' MPAY-BATCH-NO. DTSBX626 +01118 DISPLAY ' MPAY ITM-' MPAY-ITEM-NO. DTSBX626 +01119 PERFORM S910-READ THRU S910-EXIT. DTSBX626 +01120 DTSBX626 +01121 IF L910-NO-REC-88 DTSBX626 +01122 DISPLAY ' MPAY - TRACE NO NOT FOUND - ' WRK-NUMR-TRACE-NO CL*78 +01123 DISPLAY ' FAC6 - TRACE NO - ' WRK-FAC6-DOES-TRACE-NO CL*78 +01124 SET WRK-FACH-PEND-REC-YES-88 TO TRUE CL*83 +01125 MOVE 'DTS03' TO WRK-DTS-RTN-CD CL*83 +01126 SET MPAY-FOUND-NO-88 TO TRUE DTSBX626 +01127 SET TRACE-NO-END-YES-88 TO TRUE CL105 +01128 GO TO P1021-EXIT CL105 +01129 ELSE DTSBX626 +01130 MOVE MSKL-REC TO MPAY-REC. CL*82 +01131 SET MPAY-FOUND-YES-88 TO TRUE DTSBX626 +01132 CL*82 +01133 MOVE FAC6-AMOUNT TO WRK-FAC6-AMOUNT CL*98 +01134 MOVE MPAY-REMIT-AMT TO WRK-MPAY-AMOUNT CL*98 +01135 ADD MPAY-REMIT-AMT TO WRK-MPAY-EMP-AMT CL136 +01136 MOVE FAC6-AMOUNT TO WRK-AMT-DISP1 CL*98 +01137 MOVE MPAY-REMIT-AMT TO WRK-AMT-DISP2 CL*92 +01138 MOVE MPAY-REMIT-AMT TO NTE-AMOUNT. CL140 +01139 CL*82 +01140 ADD WRK-MPAY-AMOUNT TO TOT-MPAY-AMOUNT. CL114 +01141 DISPLAY ' WF RETURN AMOUNT ' WRK-AMT-DISP1 CL*82 +01142 DISPLAY 'MPAYRETURN AMOUNT ' WRK-AMT-DISP2 CL*82 +01143 CL*82 +01144 IF MPAY-FOUND-YES-88 CL105 +01145 MOVE MPAY-EMP-NO TO WRK-FAC6-EMP-NO CL124 +01146 MOVE WRK-FAC6-EMP-NO TO FAC6-DUTAS-EMP-NO CL124 +01147 PERFORM P1070-READ-MPRF THRU P1070-EXIT CL123 +01148 PERFORM P1040-BUILD-T025-RECORD THRU P1040-EXIT CL105 +01149 PERFORM P1045-BUILD-T003-RECORD THRU P1045-EXIT CL105 +01150 IF WRITE-T025-YES-88 CL105 +01151 MOVE T025-REC TO TSKL-REC CL105 +01152 PERFORM S927-WRITE THRU S927-EXIT CL105 +01153 MOVE T003-REC TO TSKL-REC CL105 +01154 PERFORM S927-WRITE THRU S927-EXIT CL105 +01155 ADD 1 TO WRK-T025-WRITE-CNT CL105 +01156 ADD 1 TO WRK-T003-WRITE-CNT CL105 +01157 END-IF CL105 +01158 END-IF. CL105 +01159 CL105 +01160 PERFORM S921-READ-NEXT THRU S921-EXIT. CL105 +01161 CL105 +01162 IF L921-NO-REC-88 CL105 +01163 DISPLAY ' TRACE NO NXT NOT FOUND ' WRK-FAC6-DOES-TRACE-NO CL105 +01164 SET TRACE-NO-END-YES-88 TO TRUE. CL105 +01165 CL105 +01166 P1021-EXIT. CL105 +01167 EXIT. CL105 +01168 CL105 +01169 DTSBX626 +01170 P1040-BUILD-T025-RECORD. DTSBX626 +01171 DISPLAY ' 1040 - PROCESS'. DTSBX626 +01172 SET WRITE-T025-YES-88 TO TRUE. DTSBX626 +01173 SET WRK-TOLR-NO-88 TO TRUE CL*98 +01174 MOVE LENGTH OF T025-REC TO T025-LENGTH. CL*71 +01175 DTSBX626 +01176 * IF WRK-DTSBU005-YES CL*46 +01177 PERFORM S005-FROM-SYS THRU S005-EXIT DTSBX626 +01178 MOVE L005-DATE TO WRK-CURR-DATE DTSBX626 +01179 MOVE L005-TIME TO WRK-CURR-TIME DTSBX626 +01180 * MOVE 'N' TO WRK-DTSBU005-IND. CL*46 +01181 DTSBX626 +01182 MOVE MPAY-EMP-NO TO T025-EMP-NO. DTSBX626 +01183 MOVE 'WEB PAY' TO T025-ORIGIN. CL*83 +01184 DTSBX626 +01185 MOVE WRK-CURR-DATE TO T025-SYS-DATE. DTSBX626 +01186 MOVE WRK-CURR-TIME TO T025-SYS-TIME. DTSBX626 +01187 CL138 +01188 IF MPAY-EMP-NO NOT = WRK-MPAY-HOLD-EMP-NO CL138 +01189 MOVE MPAY-REMIT-AMT TO WRK-MPAY-EMP-AMT CL139 +01190 MOVE ZEROS TO WRK-MPAY-EMP-CNT. CL138 +01191 CL*77 +01192 IF WRK-MPAY-EMP-CNT = 1 CL136 +01193 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 +01194 SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 +01195 MOVE 'PR' TO T025-PAY-TYPE CL147 +01196 GO TO P1040-BUILD-T025-CONT. CL136 +01197 CL136 +01198 IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT CL136 +01199 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 +01200 DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT CL136 +01201 SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 +01202 MOVE 'PR' TO T025-PAY-TYPE CL147 +01203 GO TO P1040-BUILD-T025-CONT. CL136 +01204 CL136 +01205 * IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT OR CL136 +01206 * WRK-MPAY-HOLD-EMP-NO = MPAY-EMP-NO CL136 +01207 * MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL136 +01208 * DISPLAY 'FAC6 < 15: ' WRK-MPAY-AMOUNT ' ' WRK-TOLR-AMOUNT CL136 +01209 * SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL136 +01210 * MOVE 'NG' TO T025-PAY-TYPE CL136 +01211 * ELSE CL136 +01212 MOVE MPAY-EMP-NO TO WRK-MPAY-HOLD-EMP-NO CL106 +01213 MOVE 1 TO WRK-MPAY-EMP-CNT CL136 +01214 SET T025-NSF-PEN-CHARGE-NO-88 TO TRUE CL147 +01215 MOVE 'PR' TO T025-PAY-TYPE. CL147 +01216 DTSBX626 +01217 P1040-BUILD-T025-CONT. CL136 +01218 MOVE MPRF-PRIMARY-NAME TO T025-NAME-CHECK. DTSBX626 +01219 DTSBX626 +01220 COMPUTE WRK-MPAY-REMIT-AMT = MPAY-REMIT-AMT * -1. DTSBX626 +01221 MOVE WRK-MPAY-REMIT-AMT TO T025-REMIT-AMT. DTSBX626 +01222 CL*78 +01223 MOVE MPAY-TRACE-NO TO T025-TRACE-NO. DTSBX626 +01224 MOVE WRK-RECV-DATE TO T025-RECEIVED-DATE CL*92 +01225 T025-DEPOSIT-DATE. DTSBX626 +01226 DTSBX626 +01227 SET T025-WAIVE-INT-YES-88 TO TRUE CL147 +01228 SET T025-WAIVE-LATE-PEN-YES-88 TO TRUE CL147 +01229 MOVE ZERO TO T025-APPLIC-YRQ. DTSBX626 +01230 MOVE SPACES TO T025-APPLIC-IND. DTSBX626 +01231 MOVE MPAY-BATCH-NO TO T025-APPLIC-BATCH-NO. DTSBX626 +01232 MOVE MPAY-ITEM-NO TO T025-APPLIC-ITEM-NO. DTSBX626 +01233 MOVE SPACES TO T025-RESPONSIBLE-ACTIVITY. DTSBX626 +01234 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. CL**3 +01235 DTSBX626 +01236 CL107 +01237 DISPLAY ' EMP PAYMENT REVERSED ' MPAY-EMP-NO CL107 +01238 DISPLAY ' WF RETURN AMOUNT ' WRK-AMT-DISP1 CL107 +01239 DISPLAY ' MPAY RETURN AMOUNT ' WRK-AMT-DISP2 CL107 +01240 DISPLAY ' PAY TYPE ' T025-PAY-TYPE. CL107 +01241 CL107 +01242 PERFORM P4300-PRNT-REVR THRU P4300-EXIT. CL110 +01243 * WRITE ESSP-ACHD-REC FROM DETAIL-LINE-1 AFTER 1. CL153 +01244 ADD 1 TO WS-LINE-CNT. CL110 +01245 CL110 +01246 DTSBX626 +01247 P1040-EXIT. DTSBX626 +01248 EXIT. DTSBX626 +01249 DTSBX626 +01250 P1045-BUILD-T003-RECORD. CL*71 +01251 CL*70 +01252 PERFORM S3000-INIT-T003 THRU S3000-EXIT. CL*70 +01253 CL*70 +01254 MOVE WRK-MNTE-SUBJECT TO MNTE-SUBJECT CL*70 +01255 CL*70 +01256 MOVE +1 TO MNTE-TEXT-CNT. CL*70 +01257 MOVE WRK-MNTE-REASON TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01258 DISPLAY 'MNTE-REASON: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01259 CL*70 +01260 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01261 MOVE WRK-MNTE-TRACE-NO TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01262 DISPLAY 'MNTE-TRACEN: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01263 CL*74 +01264 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01265 MOVE 'NEVER DEPOSITED' TO MNTE-TEXT(MNTE-TEXT-CNT) CL147 +01266 DISPLAY 'MNTE-DEPDTE: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01267 CL*74 +01268 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01269 MOVE WRK-MNTE-BATCH-ITEM TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01270 DISPLAY 'MNTE-BTHITM: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01271 CL*74 +01272 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01273 MOVE WRK-MNTE-ACCT-NO TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01274 DISPLAY 'MNTE-ACCTNO: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01275 CL*74 +01276 ADD +1 TO MNTE-TEXT-CNT. CL*95 +01277 MOVE WRK-MNTE-AMOUNT TO MNTE-TEXT(MNTE-TEXT-CNT) CL*75 +01278 DISPLAY 'MNTE-AMOUNT: ' MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01279 CL*74 +01280 * ADD +1 TO MNTE-TEXT-CNT. CL*98 +01281 * MOVE WRK-MNTE-AMOUNT TO MNTE-TEXT(MNTE-TEXT-CNT) CL*98 +01282 CL*77 +01283 * IF WRK-MPAY-EMP-AMT < WRK-TOLR-AMOUNT CL147 +01284 * SET WRK-TOLR-YES-88 TO TRUE. CL147 +01285 CL106 +01286 * IF WRK-TOLR-YES-88 CL147 +01287 * DISPLAY 'P1045 - TOLERATED NO FEE: ' WRK-MPAY-AMOUNT CL147 +01288 * ADD +1 TO MNTE-TEXT-CNT CL147 +01289 * MOVE WRK-MNTE-NO-FEE TO MNTE-TEXT(MNTE-TEXT-CNT). CL147 +01290 CL*77 +01291 MOVE MNTE-REC TO T003-MNTE-REC. CL*70 +01292 CL*70 +01293 P1045-EXIT. CL*70 +01294 EXIT. CL*70 +01295 P1055-WRITE-F907. CL*70 +01296 ************************************************************** DTSBX626 +01297 * WRITE FACH ERROR RETURN FILE(F907) * DTSBX626 +01298 ************************************************************** DTSBX626 +01299 DTSBX626 +01300 DISPLAY ' 1055 - PROCESS'. DTSBX626 +01301 ADD +1 TO WRK-F907-WRITE-CNT. DTSBX626 +01302 MOVE WRK-MOD-NAME TO F907-MODULE-NAME. DTSBX626 +01303 * MOVE IN-FACH-REC TO F907-GOV1-REC. CL153 +01304 MOVE ZEROS TO F907-EMP-NO. DTSBX626 +01305 DTSBX626 +01306 CALL 'DTSBU946' USING F907-REC. DTSBX626 +01307 DTSBX626 +01308 DTSBX626 +01309 P1055-EXIT. DTSBX626 +01310 EXIT. DTSBX626 +01311 P4000-PRNT-ACHD. CL**7 +01312 MOVE E145-EMP-NO TO X425-EMP-NO CL147 +01313 MOVE MPRF-PRIMARY-NAME TO X425-NAME-CHECK. CL147 +01314 MOVE SPACES TO X425-ACCT-NUMBER NTE-ACCT-NO CL147 +01315 MOVE SPACES TO X425-BANK-ID. CL147 +01316 MOVE WRK-FAC6-AMOUNT TO X425-X145-REMIT CL*72 +01317 MOVE WRK-TEMP-TRACE-NOA TO X425-X145-TRACE-NOB. CL*21 +01318 MOVE WRK-TEMP-TRACE-NOA TO NTE-TRACE-NO. CL*71 +01319 * MOVE SPACES TO X425-MESSAGE. CL*51 +01320 * IF MPAY-FOUND-YES-88 CL110 +01321 * MOVE MPAY-BATCH-NO TO X425-AUTO-BATCH NTE-BATCH-NO CL110 +01322 * MOVE MPAY-ITEM-NO TO X425-AUTO-ITEM NTE-ITEM-NO CL110 +01323 * MOVE '/' TO X425-AUTO-FILL CL110 +01324 * MOVE 'Y ' TO X425-AUTO-REV CL110 +01325 * MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9 CL110 +01326 * SET L001-FROM-FED-8 TO TRUE CL110 +01327 * PERFORM S001-DATE THRU S001-EXIT CL110 +01328 * MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE CL110 +01329 * ELSE CL110 +01330 MOVE ' ' TO X425-AUTO-FILL CL*53 +01331 MOVE 'FARGO' TO X425-AUTO-BATCH CL110 +01332 MOVE 'RTN' TO X425-AUTO-ITEM CL110 +01333 MOVE '* ' TO X425-AUTO-REV. CL110 +01334 CL*71 +01335 CL*53 +01336 P4000-EXIT. CL**7 +01337 EXIT. CL**7 +01338 P4100-PRINT-HEADER. CL**6 +01339 IF WS-LINE-CNT > 58 CL*90 +01340 ADD +1 TO WS-PAGE-CNT CL**6 +01341 MOVE WS-PAGE-CNT TO HEADER-3-PAGE CL*89 +01342 * MOVE ' -/+ ----- MONTHLY COUNT' TO HEADER-5-NAME CL*10 +01343 MOVE WRK-CURR-DATE TO HEADER-3A-DATE CL147 +01344 MOVE WRK-CURR-TIME TO HEADER-3A-TIME. CL153 +01345 * WRITE ESSP-ACHD-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL153 +01346 * WRITE ESSP-ACHD-REC FROM HEADER-2 AFTER 1 CL153 +01347 * WRITE ESSP-ACHD-REC FROM HEADER-3 AFTER 1 CL153 +01348 * WRITE ESSP-ACHD-REC FROM HEADER-3A AFTER 1 CL153 +01349 * WRITE ESSP-ACHD-REC FROM HEADER-4 AFTER 1 CL153 +01350 * WRITE ESSP-ACHD-REC FROM HEADER-5 AFTER 1 CL153 +01351 * WRITE ESSP-ACHD-REC FROM HEADER-6 AFTER 1 CL153 +01352 * MOVE +6 TO WS-LINE-CNT. CL153 +01353 P4100-EXIT. CL**6 +01354 EXIT. CL**6 +01355 CL**6 +01356 P4200-PRINT-HEADER. CL*90 +01357 IF WS-RETN-CNT > 58 CL*90 +01358 ADD +1 TO WS-PAGE-CNT CL*90 +01359 MOVE WS-PAGE-CNT TO HEADER-3-PAGE CL*90 +01360 * MOVE ' -/+ ----- MONTHLY COUNT' TO HEADER-5-NAME CL*90 +01361 MOVE WRK-CURR-DATE TO HEADER-3A-DATE CL147 +01362 MOVE WRK-CURR-TIME TO HEADER-3A-TIME CL147 +01363 * WRITE ESSP-ACHR-REC FROM HEADER-1 AFTER TOP-OF-PAGE CL153 +01364 * WRITE ESSP-ACHR-REC FROM HEADER-2 AFTER 1 CL153 +01365 * WRITE ESSP-ACHR-REC FROM HEADER-3 AFTER 1 CL153 +01366 * WRITE ESSP-ACHR-REC FROM HEADER-3A AFTER 1 CL153 +01367 * WRITE ESSP-ACHR-REC FROM HEADER-4 AFTER 1 CL153 +01368 * WRITE ESSP-ACHR-REC FROM HEADER-5 AFTER 1 CL153 +01369 * WRITE ESSP-ACHR-REC FROM HEADER-6 AFTER 1 CL153 +01370 MOVE +6 TO WS-RETN-CNT. CL*90 +01371 P4200-EXIT. CL*90 +01372 EXIT. CL*90 +01373 CL*90 +01374 P4300-PRNT-REVR. CL110 +01375 MOVE FAC6-DUTAS-EMP-NO TO X425-EMP-NO CL110 +01376 MOVE FAC6-DUTAS-EMP-NAME TO X425-NAME-CHECK. CL127 +01377 MOVE SPACES TO X425-ACCT-NUMBER NTE-ACCT-NO CL147 +01378 MOVE SPACES TO X425-BANK-ID. CL147 +01379 MOVE WRK-MPAY-REMIT-AMT TO X425-X145-REMIT CL110 +01380 MOVE WRK-TEMP-TRACE-NOA TO X425-X145-TRACE-NOB. CL110 +01381 MOVE WRK-TEMP-TRACE-NOA TO NTE-TRACE-NO. CL110 +01382 * MOVE SPACES TO X425-MESSAGE. CL119 +01383 IF MPAY-FOUND-YES-88 CL110 +01384 MOVE MPAY-BATCH-NO TO X425-AUTO-BATCH NTE-BATCH-NO CL110 +01385 MOVE MPAY-ITEM-NO TO X425-AUTO-ITEM NTE-ITEM-NO CL110 +01386 MOVE '/' TO X425-AUTO-FILL CL110 +01387 MOVE 'Y ' TO X425-AUTO-REV CL110 +01388 MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9 CL110 +01389 SET L001-FROM-FED-8 TO TRUE CL110 +01390 PERFORM S001-DATE THRU S001-EXIT CL110 +01391 MOVE L001-SLASH-8-DATE TO NTE-DEPOSIT-DATE CL110 +01392 ELSE CL110 +01393 MOVE ' ' TO X425-AUTO-FILL CL110 +01394 MOVE 'STAFF' TO X425-AUTO-BATCH CL110 +01395 MOVE 'REV' TO X425-AUTO-ITEM CL110 +01396 MOVE 'N ' TO X425-AUTO-REV. CL110 +01397 CL110 +01398 CL110 +01399 P4300-EXIT. CL110 +01400 EXIT. CL110 +01401 P5000-ACH-RETURN-CODE. CL*45 +01402 IF WRK-FAC7-RTN-CD = WRK-RTN-CD CL*83 +01403 GO TO P5000-EXIT. CL*45 +01404 CL*45 +01405 SET WRK-FAC7-RTN-INVALID-88 TO TRUE CL*46 +01406 CL*45 +01407 PERFORM VARYING ACH-RTN-IDX FROM 1 BY 1 CL*45 +01408 UNTIL WRK-FAC7-RTN-VALID-88 CL*46 +01409 OR ACH-RTN-IDX > ACH-RTN-CD-CNT CL*45 +01410 OR ACH-RTN-CD(ACH-RTN-IDX) = SPACE CL*45 +01411 IF WRK-FAC7-RTN-CD = CL*83 +01412 ACH-RTN-CD(ACH-RTN-IDX) CL*46 +01413 SET WRK-FAC7-RTN-VALID-88 TO TRUE CL*46 +01414 MOVE ACH-RTN-CD (ACH-RTN-IDX) TO WRK-RTN-CD CL*45 +01415 MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO X425-MESSAGE CL*57 +01416 MOVE ACH-RTN-VALUE(ACH-RTN-IDX) TO NTE-REASON CL*71 +01417 END-IF CL*45 +01418 END-PERFORM. CL*45 +01419 CL*45 +01420 IF WRK-FAC7-RTN-INVALID-88 CL*46 +01421 MOVE '???????? INVALID RETURN CODE ' TO X425-MESSAGE CL*57 +01422 GO TO P5000-EXIT. CL*45 +01423 P5000-EXIT. CL*45 +01424 EXIT. CL*45 +01425 CL*45 +01426 T0000-TERMINATE. DTSBX626 +01427 DTSBX626 +01428 * IF NOT FACH-TYPE-TRAILER-88 CL147 +01429 * DISPLAY ' LAST RECORD IS NOT A TRAILER RECORD ' CL147 +01430 * DISPLAY ' ' CL147 +01431 * DISPLAY ' LAST RECORD ' FACH-SKELETAL-REC CL147 +01432 * DISPLAY ' **** ACH FILE EMPTY *****'. CL147 +01433 DTSBX626 +01434 IF WRK-FACH-READ-CNT = 2 DTSBX626 +01435 MOVE +3 TO RETURN-CODE CL*32 +01436 DISPLAY ' *** WELLS FARGO FILE CONTAINS 2 RECS ' CL**3 +01437 DISPLAY ' *** NO REJECTED PAYMENT RECORDS *'. DTSBX626 +01438 DTSBX626 +01439 DTSBX626 +01440 * MOVE -1 TO F907-LENGTH. CL**8 +01441 * CALL 'DTSBU946' USING F907-REC. CL**8 +01442 DTSBX626 +01443 DTSBX626 +01444 DTSBX626 +01445 DISPLAY ' '. DTSBX626 +01446 DTSBX626 +01447 DISPLAY '*** DTSBX626 TERMINATION -VERIFY ACH DEPOSITS***'. CL208 +01448 DTSBX626 +01449 DISPLAY ' '. DTSBX626 +01450 DTSBX626 +01451 MOVE 'NO OF X145 (ESSP PAY ALLOCATION) READ: ' TO X626-TXT. CL208 +01452 MOVE WRK-FACH-READ-CNT TO X626-CNT. CL205 +01453 WRITE X626-REC. CL205 +01454 * DISPLAY 'NUMBER IN TRAILER BATCH COUNT : ' CL152 +01455 * FAC9-BATCH-CNT. CL152 +01456 * CL152 +01457 * DISPLAY 'HEADERS IN FACH FILE : ' CL152 +01458 * WRK-HEADER-RECORDS. CL152 +01459 * CL152 +01460 * DISPLAY 'TRAILERS IN FACH FILE : ' CL152 +01461 * WRK-TRAILER-RECORDS. CL152 +01462 DTSBX626 +01463 * DISPLAY 'DETAIL RECORDS IN FACH FILE : ' CL152 +01464 * WRK-FAC6-RECORDS. CL152 +01465 DTSBX626 +01466 * DISPLAY 'NUMBER OF OTHER RECORDS IN FACH FILE: ' CL152 +01467 * WRK-OTHER-RECORDS. CL152 +01468 DTSBX626 +01469 MOVE 'NO OF X145 (DUTAS PAY) WRITTEN : ' TO X626-TXT CL208 +01470 MOVE WRK-X145-OUT-CNT TO X626-CNT. CL207 +01471 WRITE X626-REC. CL205 +01472 DTSBX626 +01473 MOVE 'NUMBER OF X145 RECORDS NOT ON ACH FI: ' TO X626-TXT CL205 +01474 MOVE WRK-X145-NOT-CNT TO X626-CNT. CL205 +01475 WRITE X626-REC. CL205 +01476 CL169 +01477 MOVE 'TOTAL ACH AMT TRNSFERRED TO DUTAS : ' TO X626-TXT CL208 +01478 MOVE WS-TOTAL-X145-AMT TO X626-CNT. CL205 +01479 WRITE X626-REC. CL205 +01480 * DISPLAY 'NUMBER OF F907 RECORDS WRITTEN : ' CL152 +01481 * WRK-F907-WRITE-CNT. CL152 +01482 * IF WRK-F907-WRITE-CNT > 0 CL*24 +01483 * MOVE +3 TO RETURN-CODE CL*24 +01484 * DISPLAY ' FACH INPUT FILE CONTAINS ERRORS+++' CL*24 +01485 * DISPLAY ' PROGRAM WILL ABEND ***************'. CL*24 +01486 * PERFORM S999-ABEND THRU S999-EXIT. DTSBX626 +01487 CL193 +01488 OPEN INPUT ESSP-ACH-TOTALS. CL195 +01489 IF REPT-STATUS-OK-88 CL193 +01490 NEXT SENTENCE CL193 +01491 ELSE CL193 +01492 DISPLAY 'CANNOT OPEN TOTAL ACH FILE ' CL193 +01493 REPT-STATUS CL193 +01494 PERFORM S999-ABEND THRU S999-EXIT CL213 +01495 END-IF. CL193 +01496 CL193 +01497 READ ESSP-ACH-TOTALS INTO ESSP-ACH-DEPOSITS CL194 +01498 AT END DISPLAY '**** NO RECORDS LEFT'. CL194 +01499 CL194 +01500 IF REPT-STATUS-OK-88 CL193 +01501 NEXT SENTENCE CL193 +01502 ELSE CL193 +01503 DISPLAY 'CANNOT READ TOTAL ACH FILE ' CL193 +01504 REPT-STATUS CL193 +01505 PERFORM S999-ABEND THRU S999-EXIT CL213 +01506 END-IF. CL193 +01507 CL213 +01508 IF WRK-X145-NOT-CNT > 0 CL202 +01509 COMPUTE WRK-X145-XYZ-CNT = WRK-X145-OUT-CNT - CL207 +01510 WRK-X145-NOT-CNT. CL202 +01511 MOVE ' TOTAL WELLS ACH DEPOSIT: ' TO X626-TXT CL208 +01512 MOVE X145-ACH-REC-DEPOSIT TO X626-CNT. CL205 +01513 WRITE X626-REC. CL205 +01514 MOVE ' TOTAL DUTAS ACH DEPOSIT: ' TO X626-TXT CL208 +01515 MOVE WS-TOTAL-X145-AMT TO X626-CNT CL205 +01516 WRITE X626-REC. CL205 +01517 MOVE ' TOTAL WELLS ACH REC CNT: ' TO X626-TXT CL208 +01518 MOVE X145-ACH-REC-CNT TO X626-CNT CL205 +01519 WRITE X626-REC. CL205 +01520 MOVE ' TOTAL DUTAS ACH REC CNT: ' TO X626-TXT CL208 +01521 MOVE WRK-X145-OUT-CNT TO X626-CNT CL206 +01522 WRITE X626-REC. CL205 +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 +01552 CL*29 +01553 DTSBX626 +01554 T0000-EXIT. DTSBX626 +01555 EXIT. DTSBX626 +01556 DTSBX626 +01557 P1070-READ-MPRF. DTSBX626 +01558 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 +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 diff --git a/Batch/DTSBX629.cob b/Batch/DTSBX629.cob new file mode 100644 index 0000000..0d89c05 --- /dev/null +++ b/Batch/DTSBX629.cob @@ -0,0 +1,1241 @@ +00001 IDENTIFICATION DIVISION. 02/12/19 +00002 PROGRAM-ID. DTSBX629. DTSBX629 +00003 LV015 +00004 ******************************************************************DTSBX629 +00005 * *DTSBX629 +00006 * FUNCTION: *DTSBX629 +00007 * *DTSBX629 +00008 * PROGRAM WILL READ TDEC X144 FILE (DETAIL WAGE RECORDS SENT * CL254 +00009 * TO ESSP) AND REPORT ANY WAGES NOT RETURNED THE SAME DAY. CL254 +00010 * RECORDS NOT RETURNED MAY BE JOB RAN LATE OR TDEC WAGES WAS * CL254 +00011 * REJECTED BY ESSP. * CL254 +00012 * 07/07/18 ZL1 * CL254 +00013 * * CL*53 +00014 ******************************************************************DTSBX629 +00015 DTSBX629 +00016 ENVIRONMENT DIVISION. DTSBX629 +00017 DTSBX629 +00018 CONFIGURATION SECTION. DTSBX629 +00019 DTSBX629 +00020 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX629 +00021 DTSBX629 +00022 INPUT-OUTPUT SECTION. DTSBX629 +00023 DTSBX629 +00024 FILE-CONTROL. DTSBX629 +00025 DTSBX629 +00026 SELECT X140RPT-IN ASSIGN TO DTSFX140. CL239 +00027 SELECT X144SSN-IN ASSIGN TO DTSFI144. CL**1 +00028 SELECT X144SSN-OUT ASSIGN TO DTSFO144. CL**1 +00029 * SELECT X147SSN-OUTA ASSIGN TO DTSFA147. CL223 +00030 * SELECT X147SSN-OUTB ASSIGN TO DTSFB147. CL223 +00031 SELECT REPORT-FILE ASSIGN TO RPT627R1. CL223 +00032 DTSBX629 +00033 DTSBX629 +00034 DATA DIVISION. DTSBX629 +00035 FILE SECTION. DTSBX629 +00036 CL101 +00037 FD X144SSN-IN CL101 +00038 RECORDING MODE IS F. CL101 +00039 01 X144-RECORD-IN PIC X(512). CL101 +00040 CL101 +00041 FD X144SSN-OUT CL**1 +00042 RECORDING MODE IS F. CL**1 +00043 01 X144-RECORD-OUT PIC X(512). CL**1 +00044 CL**1 +00045 CL138 +00046 FD X140RPT-IN CL239 +00047 RECORDING MODE IS F. CL239 +00048 01 X140-RECORD-IN PIC X(512). CL239 +00049 CL138 +00050 DTSBX629 +00051 *FD X147SSN-IN CL239 +00052 * RECORDING MODE IS F. CL239 +00053 *01 X147-RECORD-IN PIC X(80). CL239 +00054 CL*87 +00055 *FD X147SSN-OUTA CL223 +00056 * RECORDING MODE IS F. CL223 +00057 *01 X147-RECORD-OUTA PIC X(512). CL223 +00058 CL*87 +00059 *FD X147SSN-OUTB CL223 +00060 * RECORDING MODE IS F. CL223 +00061 *01 X147-RECORD-OUTB PIC X(512). CL223 +00062 CL123 +00063 FD REPORT-FILE DTSBX629 +00064 RECORDING MODE IS F DTSBX629 +00065 RECORD CONTAINS 133 CHARACTERS DTSBX629 +00066 BLOCK CONTAINS 0 RECORDS DTSBX629 +00067 LABEL RECORDS ARE OMITTED DTSBX629 +00068 DATA RECORD IS PRINT-RECORD. DTSBX629 +00069 DTSBX629 +00070 01 PRINT-RECORD PIC X(133). DTSBX629 +00071 DTSBX629 +00072 ******************************************************************DTSBX629 +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 +00076 DTSBX629 +00077 01 ENDOFSEG PIC 9 VALUE ZEROES. DTSBX629 +00078 DTSBX629 +00079 01 EMPLOYER-FOUND-IND PIC X VALUE SPACE. CL*87 +00080 DTSBX629 +00081 01 MASTER-END-IND PIC X VALUE SPACE. DTSBX629 +00082 88 MASTER-END VALUE 'Y'. DTSBX629 +00083 DTSBX629 +00084 CL*70 +00085 01 MASUIX-END-IND PIC X VALUE SPACE. CL*73 +00086 88 MASHIS-END VALUE 'Y'. CL*70 +00087 01 WRK-AREA. CL*79 +00088 05 WRK-ABEND-CODE PIC X(04) VALUE 'X552'. CL*91 +00089 CL*70 +00090 01 WRK-SEG01-SSN-FOUND PIC 9(01) VALUE ZEROES. CL147 +00091 01 WS-X144-NOT-RETURNED PIC 9(05) VALUE ZEROES. CL243 +00092 01 WS-X144-SSN-FOUND PIC 9(01) VALUE ZEROES. CL243 +00093 01 WS-CLAIM-SSN-FOUND PIC 9(01) VALUE ZEROES. CL182 +00094 01 WS-X140-RPT-FOUND PIC 9(01) VALUE ZEROES. CL138 +00095 01 WS-X147-SSN-NOT-DOCS PIC 9(05) VALUE ZEROES. CL168 +00096 01 WS-X147-SSN-N99-DOCS PIC 9(05) VALUE ZEROES. CL211 +00097 01 WS-X147-SSN-IN-DOCS PIC 9(05) VALUE ZEROES. CL168 +00098 01 SSN-HIT-COUNT PIC 9(03) VALUE ZEROES. CL106 +00099 01 WS-HOLD-X147-SSN PIC 9(09) VALUE ZEROES. CL*91 +00100 01 WS-TOTAL-NO-X144-SSN PIC 9(05) VALUE ZEROES. CL108 +00101 01 WS-TOTAL-YES-X144-SSN PIC 9(05) VALUE ZEROES. CL113 +00102 01 WS-TOTAL-OTH-X144-SSN PIC 9(05) VALUE ZEROES. CL113 +00103 01 WS-HOLD-X147-EMP-NO PIC 9(06) VALUE ZEROES. CL*91 +00104 01 WS-SAV-X147 PIC 9(01) VALUE ZEROES. CL129 +00105 01 WRK-MODULE-NAME PIC X(08) VALUE 'DTSBX551'. CL138 +00106 01 WRK-ABEND-CD PIC X(04) VALUE 'X551'. CL138 +00107 01 WRK-ABEND-MSG PIC X(60). CL*62 +00108 DTSBX629 +00109 01 WS-HOLD-PAY-DATE. DTSBX629 +00110 05 WS-HOLD-PAY-DATE-CEN PIC 9(02) VALUE ZEROS. DTSBX629 +00111 05 WS-HOLD-PAY-DATE-YY PIC 9(02) VALUE ZEROES. DTSBX629 +00112 05 WS-HOLD-PAY-DATE-MM PIC 9(02) VALUE ZEROES. DTSBX629 +00113 05 WS-HOLD-PAY-DATE-DD PIC 9(02) VALUE ZEROES. DTSBX629 +00114 DTSBX629 +00115 01 WS-X147-SSN PIC 9(09) VALUE ZEROS. CL106 +00116 01 WS-X147-EMP-NO PIC 9(06) VALUE ZEROS. CL104 +00117 01 WS-X147-QUARTER. CL150 +00118 05 WS-X147-YR PIC 9(04) VALUE ZEROS. CL152 +00119 05 WS-X147-QTR PIC 9(01) VALUE ZEROS. CL150 +00120 CL*34 +00121 01 WS-X140-QUARTER. CL240 +00122 05 WS-X140-YR PIC 9(04) VALUE ZEROS. CL240 +00123 05 WS-X140-QTR PIC 9(01) VALUE ZEROS. CL240 +00124 CL240 +00125 01 W-X140-REPORT-QTR PIC 9(5) VALUE ZEROS. CL**4 +00126 01 WS-INPUT-SSN. DTSBX629 +00127 05 WS-INPUT-SSN1 PIC 9(03) VALUE ZEROES. DTSBX629 +00128 05 WS-INPUT-SSN2 PIC 9(02) VALUE ZEROES. DTSBX629 +00129 05 WS-INPUT-SSN3 PIC 9(04) VALUE ZEROES. DTSBX629 +00130 DTSBX629 +00131 01 WS-HOLD-BWE PIC 9(08) VALUE ZEROES. DTSBX629 +00132 CL**8 +00133 01 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL**8 +00134 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL**7 +00135 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL**7 +00136 CL**7 +00137 DTSBX629 +00138 01 WS-HOLD-PAYMENT PIC 9(05)V99 VALUE ZEROES.DTSBX629 +00139 DTSBX629 +00140 01 WS-HOLD-DATE. CL*25 +00141 05 WS-HOLD-DATE-CEN PIC 9(02) VALUE ZEROS. CL*26 +00142 05 WS-HOLD-DATE-YY PIC 9(02) VALUE ZEROES. CL*26 +00143 05 WS-HOLD-DATE-MM PIC 9(02) VALUE ZEROES. CL*26 +00144 05 WS-HOLD-DATE-DD PIC 9(02) VALUE ZEROES. CL*26 +00145 DTSBX629 +00146 01 WS-WRK-BWE-DATE. CL*51 +00147 05 WS-WRK-BWE-CEN PIC 9(02) VALUE ZERO. CL*51 +00148 05 WS-WRK-BWE-YY PIC 9(02) VALUE ZERO. CL*51 +00149 05 WS-WRK-BWE-MM PIC 9(02) VALUE ZERO. CL*51 +00150 05 WS-WRK-BWE-DD PIC 9(02) VALUE ZERO. CL*51 +00151 CL*50 +00152 01 WS-X147-SSN-NO. CL106 +00153 05 WS-XSSN PIC 9(9) VALUE ZERO. CL*85 +00154 05 FILLER PIC 9(1) VALUE ZERO. CL*85 +00155 CL*85 +00156 01 WS-X147-QTR-ESSP. CL*86 +00157 05 WS-X147-EYY PIC X(4) VALUE SPACES. CL*86 +00158 05 FILLER PIC X(1) VALUE SPACES. CL*86 +00159 05 WS-X147-EQ PIC X(1) VALUE SPACES. CL*86 +00160 CL*86 +00161 CL*86 +00162 01 WS-X147-QTR-DUTAS. CL*86 +00163 05 WS-X147-YY PIC 9(4) VALUE ZERO. CL*86 +00164 05 WS-X147-Q PIC 9(1) VALUE ZERO. CL*86 +00165 01 WS-X147-QTR-DELETE REDEFINES WS-X147-QTR-DUTAS PIC 9(5). CL*86 +00166 CL*86 +00167 01 WS-DOCS-BASE-QTR PIC 9(5) VALUE ZEROS. CL192 +00168 01 WS-DOCS-BASE-QTRA REDEFINES WS-DOCS-BASE-QTR. CL192 +00169 05 WS-DOCS-BASE-QTR-Y PIC 9(4). CL192 +00170 05 WS-DOCS-BASE-QTR-Q PIC 9(1). CL192 +00171 01 WS-DOCS-BASE-QTR1. CL188 +00172 05 WS-DOCS-BASE-QTR1-Y PIC 9(4). CL192 +00173 05 WS-DOCS-BASE-QTR1-Q PIC 9(1). CL192 +00174 01 WS-DOCS-BASE-QTR2. CL188 +00175 05 WS-DOCS-BASE-QTR2-Y PIC 9(4). CL192 +00176 05 WS-DOCS-BASE-QTR2-Q PIC 9(1). CL192 +00177 01 WS-DOCS-BASE-QTR3. CL188 +00178 05 WS-DOCS-BASE-QTR3-Y PIC 9(4). CL192 +00179 05 WS-DOCS-BASE-QTR3-Q PIC 9(1). CL192 +00180 CL*86 +00181 01 WS-COUNTERS. DTSBX629 +00182 05 LINE-COUNT PIC 9(03) VALUE 99. DTSBX629 +00183 05 PAGE-COUNT PIC 9(03) VALUE ZEROES. DTSBX629 +00184 05 TRANS-READ-COUNT PIC 9(06) VALUE ZEROES. DTSBX629 +00185 05 MASTER-READ-COUNT PIC 9(06) VALUE ZEROES. DTSBX629 +00186 05 WS-TOTAL-READ PIC 9(05) VALUE ZEROES. CL*93 +00187 05 WS-TOTAL-NDEL PIC 9(05) VALUE ZEROES. CL*93 +00188 05 WS-TOTAL-DELQ PIC 9(05) VALUE ZEROES. CL*93 +00189 DTSBX629 +00190 01 WS-OUTPUT. DTSBX629 +00191 03 FILLER PIC X(03) VALUE SPACES. CL*20 +00192 03 WS-OUT-EMP-NO PIC 9(06). CL*92 +00193 03 FILLER PIC X(04) VALUE SPACES. CL243 +00194 03 WS-OUT-NAME PIC X(04). CL243 +00195 03 FILLER PIC X(04) VALUE SPACES. CL243 +00196 03 WS-OUT-QUARTER PIC X(06). CL*92 +00197 03 FILLER PIC X(04) VALUE SPACES. CL129 +00198 03 WS-OUT-DATE PIC X(10). CL**2 +00199 03 FILLER PIC X(04) VALUE SPACES. CL**2 +00200 03 WS-OUT-MESSAGE PIC X(40). CL137 +00201 CL*25 +00202 CL*11 +00203 01 WS-TOTAL-LINE1. CL*92 +00204 03 FIL PIC X(2) VALUE SPACES. CL249 +00205 03 FIL PIC X(43) VALUE CL126 +00206 'TOTAL TDEC REPORTS RECEIVED BY ... DUTAS = '. CL249 +00207 03 WS-OUT-READ PIC ZZZZ9. CL*93 +00208 03 FIL PIC X(50) VALUE SPACES. CL126 +00209 01 WS-TOTAL-LINE10. CL211 +00210 03 FIL PIC X(2) VALUE SPACES. CL249 +00211 03 FIL PIC X(43) VALUE CL211 +00212 'TOTAL TDEC REPORTS SENT TO ... ESSP = '. CL251 +00213 03 WS-OUT-READ1 PIC ZZZZ9. CL248 +00214 03 FIL PIC X(50) VALUE SPACES. CL211 +00215 01 WS-TOTAL-LINE11. CL126 +00216 03 FIL PIC X(2) VALUE SPACES. CL249 +00217 03 FIL PIC X(43) VALUE CL126 +00218 'TOTAL TDEC REPORTS RETURED TO ... DUTAS = '. CL251 +00219 03 WS-OUT-NDEL PIC ZZZZ9. CL248 +00220 03 FIL PIC X(50) VALUE SPACES. CL126 +00221 01 WS-TOTAL-LINE12. CL165 +00222 03 FIL PIC X(2) VALUE SPACES. CL249 +00223 03 FIL PIC X(43) VALUE CL165 +00224 'TOTAL TDEC REPORTS MISSING FROM .. ESSP = '. CL251 +00225 03 WS-OUT-DELQ PIC ZZZZ9. CL248 +00226 03 FIL PIC X(05) VALUE SPACES. CL254 +00227 03 FIL PIC X(45) VALUE 'SEE NOTE1'. CL254 +00228 01 WS-TOTAL-LINE2. CL*92 +00229 03 FIL PIC X(5) VALUE SPACES. CL*92 +00230 03 FIL PIC X(43) VALUE CL127 +00231 'NOTE1: PLEASE CHECK ESSP (TDEC REJECT FILE)'. CL254 +00232 * 03 WS-OUT-NDEL PIC ZZZZ9. CL248 +00233 03 FIL PIC X(50) VALUE SPACES. CL127 +00234 DTSBX629 +00235 01 WS-TOTAL-LINE3. CL*92 +00236 03 FIL PIC X(5) VALUE SPACES. CL*92 +00237 03 FIL PIC X(43) VALUE CL126 +00238 'TOTAL X147 - SENT TO DOCS 4 DELETION = '. CL175 +00239 * 03 WS-OUT-DELQ PIC ZZZZ9. CL248 +00240 03 FIL PIC X(101) VALUE SPACES. CL*92 +00241 CL*92 +00242 CL172 +00243 01 WS-TOTAL-LINE4. CL172 +00244 03 FIL PIC X(5) VALUE SPACES. CL172 +00245 03 FIL PIC X(43) VALUE CL172 +00246 'TOTAL X140/144 NOT FOUND FOR X147 = '. CL172 +00247 03 RP-TOTAL-NO-X144-SSN PIC ZZZZ9. CL172 +00248 03 FIL PIC X(101) VALUE SPACES. CL172 +00249 CL220 +00250 *01 WS-TOTAL-LINE45. CL243 +00251 * 03 FIL PIC X(5) VALUE SPACES. CL243 +00252 * 03 FIL PIC X(43) VALUE CL243 +00253 * '****** PLEASE EMAIL CHANGES BY NOON TO STOP'. CL243 +00254 * 03 FIL PIC X(43) VALUE CL243 +00255 * ' UPDATES/DELETION OF WAGES FROM DOCS... '. CL243 +00256 * 03 FIL PIC X(040) VALUE SPACES. CL243 +00257 CL220 +00258 CL172 +00259 01 WS-RUN-DATE. DTSBX629 +00260 03 RUN-YR PIC 99. CL*54 +00261 03 RUN-MO PIC 99. CL*54 +00262 03 RUN-DA PIC 99. CL*54 +00263 DTSBX629 +00264 DTSBX629 +00265 01 Z147-EMP-NO. CL233 +00266 05 WS-EMP-NOA PIC 9(3) VALUE ZEROS. CL233 +00267 05 WS-EMP-NOB PIC 9(3) VALUE ZEROS. CL233 +00268 CL233 +00269 01 HEADER1. DTSBX629 +00270 03 FILLER PIC X(05) VALUE SPACES. DTSBX629 +00271 03 FILLER PIC X(31) VALUE DTSBX629 +00272 'DISTRICT OF COLUMBIA GOVERNMENT'. DTSBX629 +00273 03 FILLER PIC X(05) VALUE SPACES. CL247 +00274 03 REPORTING-DATE. CL247 +00275 05 RUN-MO1 PIC 99. CL247 +00276 05 FIL PIC X VALUE '/'. CL247 +00277 05 RUN-DA1 PIC 99. CL247 +00278 05 FIL PIC X VALUE '/'. CL247 +00279 05 RUN-CEN PIC 99. CL247 +00280 05 RUN-YR1 PIC 99. CL247 +00281 * DTSBX629 +00282 01 HEADER2. DTSBX629 +00283 03 FILLER PIC X(04) VALUE SPACES. CL247 +00284 03 FILLER PIC X(33) VALUE DTSBX629 +00285 'DEPARTMENT OF EMPLOYMENT SERVICES'. DTSBX629 +00286 03 FILLER PIC X(30) VALUE SPACES. CL*99 +00287 * 03 FILLER PIC X(10) VALUE CL249 +00288 * 'PAGE NO. '. CL249 +00289 * 03 HD-PAGE PIC 9(03). CL249 +00290 03 FILLER PIC X(07) VALUE SPACES. DTSBX629 +00291 DTSBX629 +00292 01 HEADER3. DTSBX629 +00293 03 FILLER PIC X(02) VALUE SPACES. CL249 +00294 03 FILLER PIC X(50) VALUE CL220 +00295 'MISSING TDEC REPORTS (X140) FROM ESSP'. CL250 +00296 03 FILLER PIC X(30) VALUE SPACES. CL201 +00297 DTSBX629 +00298 01 COLUMN-HD1. CL*44 +00299 03 FILLER PIC X(03) VALUE SPACES. CL*54 +00300 03 FILLER PIC X(06) VALUE 'EMP-NO'. CL*97 +00301 03 FILLER PIC X(04) VALUE SPACES. CL243 +00302 03 FILLER PIC X(04) VALUE 'NAME'. CL243 +00303 03 FILLER PIC X(04) VALUE SPACES. CL243 +00304 03 FILLER PIC X(06) VALUE 'YR/QTR'. CL*96 +00305 03 FILLER PIC X(04) VALUE SPACES. CL247 +00306 03 FILLER PIC X(35) VALUE 'DATE SENT TO ESSP'. CL**3 +00307 CL*15 +00308 ++INCLUDE WSDATES DTSBX629 +00309 01 L001-LINK-AREA. CL*61 +00310 ++INCLUDE DTSIL001 CL*60 +00311 01 Z147-REC. CL228 +00312 05 Z147-EMP-NOA PIC 9(3). CL233 +00313 05 FILLER PIC X(01). CL233 +00314 05 Z147-EMP-NOB PIC 9(3). CL233 +00315 05 FILLER PIC X(73). CL233 +00316 01 Z144-REC. CL228 +00317 05 FILLER PIC X(61). CL226 +00318 05 Z144-EMP-NO PIC 9(6). CL228 +00319 05 Z144-EMP-NAME PIC X(04). CL241 +00320 05 FILLER PIC X(14). CL241 +00321 05 Z144-QUARTER PIC 9(5). CL235 +00322 05 FILLER PIC X(400). CL**2 +00323 05 Z144-DATE-SENT-ESSP PIC X(10). CL**2 +00324 05 FILLER PIC X(12). CL**2 +00325 CL**4 +00326 01 MRPT-REC. CL**4 +00327 ++INCLUDE DTSIMRPT CL**4 +00328 01 L910-LINK-AREA. CL**6 +00329 ++INCLUDE DTSIL910 CL**5 +00330 01 MSKL-REC. CL**5 +00331 ++INCLUDE DTSIMSKL CL**5 +00332 CL**4 +00333 ++INCLUDE DTSEX147 CL228 +00334 01 X140-REC. CL228 +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 +00341 ******************************************************************DTSBX629 +00342 * PROCEDURE DIVISION *DTSBX629 +00343 ******************************************************************DTSBX629 +00344 DTSBX629 +00345 PROCEDURE DIVISION. DTSBX629 +00346 DTSBX629 +00347 MAIN0100-CONTROL. DTSBX629 +00348 DTSBX629 +00349 CL145 +00350 OPEN INPUT X144SSN-IN. CL239 +00351 OPEN OUTPUT X144SSN-OUT. CL**1 +00352 * OPEN OUTPUT X147SSN-OUTB CL226 +00353 OPEN OUTPUT REPORT-FILE. CL*87 +00354 ++INCLUDE CODEDATE DTSBX629 +00355 MOVE ZEROS TO WS-RUN-DATE. DTSBX629 +00356 MOVE WS-SYSTEM-DATE TO WS-RUN-DATE. DTSBX629 +00357 MOVE RUN-DA TO RUN-DA1. DTSBX629 +00358 MOVE RUN-MO TO RUN-MO1. DTSBX629 +00359 MOVE 20 TO RUN-CEN. DTSBX629 +00360 MOVE RUN-YR TO RUN-YR1. DTSBX629 +00361 DTSBX629 +00362 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**4 +00363 ADD 1 TO PAGE-COUNT CL*98 +00364 * MOVE PAGE-COUNT TO HD-PAGE CL249 +00365 WRITE PRINT-RECORD FROM HEADER1 AFTER ADVANCING CL*98 +00366 TOP-OF-PAGE CL*98 +00367 WRITE PRINT-RECORD FROM HEADER2 AFTER ADVANCING 1 CL*98 +00368 WRITE PRINT-RECORD FROM HEADER3 AFTER ADVANCING 1 CL*98 +00369 MOVE SPACES TO PRINT-RECORD CL*98 +00370 WRITE PRINT-RECORD AFTER ADVANCING 1 CL*98 +00371 WRITE PRINT-RECORD FROM COLUMN-HD1 AFTER 1. CL132 +00372 MOVE ZEROES TO MASTER-READ-COUNT. DTSBX629 +00373 ****************************************************************** CL*85 +00374 * BENEFIT FILE PROCESS * CL*85 +00375 ****************************************************************** CL*85 +00376 PROC1000-GET-UI-DATA. CL*85 +00377 DISPLAY ' '. CL*85 +00378 * DISPLAY '****** START SEARCH FOR MISSING TDEC REPORTS'. CL241 +00379 DISPLAY '### TDEC REPORT(S) NOT RETURNED FROM ESSP: ' CL241 +00380 DISPLAY 'EMP NO NAME QTR '. CL241 +00381 DISPLAY ' '. CL241 +00382 DTSBX629 +00383 PERFORM PROC2000-UI-PROCESS THRU DTSBX629 +00384 PROC2000-UI-EXIT DTSBX629 +00385 UNTIL MASTER-END. CL195 +00386 DTSBX629 +00387 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++'. DTSBX629 +00388 DISPLAY ' '. DTSBX629 +00389 DISPLAY ' PROGRAM DTSBX627 RECORD COUNTS:'. CL230 +00390 DISPLAY ' '. DTSBX629 +00391 DISPLAY ' '. CL**2 +00392 DISPLAY 'TOTAL X147 RECORDS READ = ' MASTER-READ-COUNT. CL113 +00393 DISPLAY ' MATCHING X144 RES FOUND = ' WS-TOTAL-YES-X144-SSN. CL115 +00394 DISPLAY 'TOTAL X147 CLAIMS FOUND = ' WS-TOTAL-NDEL. CL115 +00395 DISPLAY 'TOTAL X147 REC DELETED = ' WS-TOTAL-DELQ. CL115 +00396 DISPLAY 'TOTAL X147 DUP OR ALL 9 = ' WS-TOTAL-OTH-X144-SSN. CL114 +00397 DISPLAY 'TOTAL X144 REC NOT FOUND = ' WS-TOTAL-NO-X144-SSN. CL113 +00398 DISPLAY ' '. DTSBX629 +00399 DISPLAY ' '. DTSBX629 +00400 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++'. DTSBX629 +00401 MOVE MASTER-READ-COUNT TO WS-OUT-READ WS-OUT-READ1. CL248 +00402 MOVE WS-TOTAL-NDEL TO WS-OUT-NDEL. CL126 +00403 MOVE WS-TOTAL-DELQ TO WS-OUT-DELQ. CL126 +00404 * MOVE WS-TOTAL-YES-X144-SSN TO WS-OUT-M144. CL167 +00405 * MOVE WS-X147-SSN-IN-DOCS TO RP-X147-SSN-IN-DOCS. CL248 +00406 * MOVE WS-X147-SSN-NOT-DOCS TO RP-X147-SSN-NOT-DOCS. CL248 +00407 * MOVE WS-TOTAL-NO-X144-SSN TO RP-TOTAL-NO-X144-SSN CL248 +00408 * MOVE WS-X147-SSN-N99-DOCS TO RP-X147-SSN-N99-DOCS. CL248 +00409 CL*11 +00410 WRITE PRINT-RECORD FROM WS-TOTAL-LINE1 AFTER 2. CL*93 +00411 WRITE PRINT-RECORD FROM WS-TOTAL-LINE10 AFTER 1. CL211 +00412 WRITE PRINT-RECORD FROM WS-TOTAL-LINE11 AFTER 1. CL211 +00413 WRITE PRINT-RECORD FROM WS-TOTAL-LINE12 AFTER 1. CL169 +00414 WRITE PRINT-RECORD FROM WS-TOTAL-LINE2 AFTER 3. CL255 +00415 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE3 AFTER 1. CL247 +00416 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE4 AFTER 1. CL247 +00417 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE45 AFTER 3. CL246 +00418 CL*11 +00419 MOVE ZEROES TO RETURN-CODE. DTSBX629 +00420 DTSBX629 +00421 CLOSE X144SSN-IN, REPORT-FILE. CL239 +00422 * CLOSE X147SSN-OUTB. CL225 +00423 DTSBX629 +00424 GOBACK. DTSBX629 +00425 DTSBX629 +00426 MAIN0100-CONTROL-EXIT. DTSBX629 +00427 EXIT. DTSBX629 +00428 DTSBX629 +00429 ******************************************************************DTSBX629 +00430 * PROC2000-UI-PROCESS *DTSBX629 +00431 ******************************************************************DTSBX629 +00432 DTSBX629 +00433 PROC2000-UI-PROCESS. DTSBX629 +00434 DTSBX629 +00435 PERFORM PROC3000-READ-MASTER-FILE THRU DTSBX629 +00436 PROC3000-READ-EXIT. DTSBX629 +00437 DTSBX629 +00438 IF MASTER-END DTSBX629 +00439 GO TO PROC2000-UI-EXIT. DTSBX629 +00440 DTSBX629 +00441 * MOVE Z147-EMP-NOA TO WS-EMP-NOA CL239 +00442 * MOVE Z147-EMP-NOB TO WS-EMP-NOB CL239 +00443 * IF WS-X144-SSN-FOUND = 3 CL133 +00444 * ADD 1 TO WS-TOTAL-OTH-X144-SSN CL133 +00445 * GO TO PROC2000-UI-EXIT. CL133 +00446 CL116 +00447 * IF X147-SSN = 999999999 CL228 +00448 * ADD 1 TO WS-X147-SSN-N99-DOCS CL228 +00449 * GO TO PROC2000-UI-EXIT. CL228 +00450 CL116 +00451 * DISPLAY '------' CL230 +00452 * DISPLAY '+++< TDEC X144 REPORTS MISSING : ' CL230 +00453 CL195 +00454 MOVE 0 TO WS-X144-SSN-FOUND. CL101 +00455 MOVE 0 TO WS-X140-RPT-FOUND. CL138 +00456 * OPEN INPUT X144SSN-IN. CL239 +00457 OPEN INPUT X140RPT-IN. CL239 +00458 CL161 +00459 PERFORM PROC2250-X140-RPT THRU PROC2250-EXIT. CL239 +00460 CL161 +00461 IF WS-X140-RPT-FOUND = 0 CL*11 +00462 * DISPLAY ' RPT NOT FOUND= ' WS-X140-RPT-FOUND CL*15 +00463 PERFORM PROC2275-MPRF-RPT THRU PROC2275-EXIT. CL**4 +00464 * CLOSE X144SSN-IN. CL239 +00465 CLOSE X140RPT-IN. CL239 +00466 CL102 +00467 IF WS-X140-RPT-FOUND > 0 CL**2 +00468 ADD 1 TO WS-TOTAL-NDEL CL**2 +00469 GO TO PROC2000-UI-EXIT. CL**2 +00470 CL**2 +00471 ADD 1 TO WS-TOTAL-DELQ CL249 +00472 MOVE Z144-EMP-NO TO WS-OUT-EMP-NO CL243 +00473 MOVE Z144-EMP-NAME TO WS-OUT-NAME CL243 +00474 MOVE Z144-QUARTER TO WS-OUT-QUARTER CL243 +00475 CL**2 +00476 IF Z144-DATE-SENT-ESSP > SPACES CL**2 +00477 MOVE Z144-DATE-SENT-ESSP TO WS-OUT-DATE CL**2 +00478 ELSE CL**2 +00479 MOVE REPORTING-DATE TO Z144-DATE-SENT-ESSP CL**2 +00480 MOVE Z144-DATE-SENT-ESSP TO WS-OUT-DATE. CL**2 +00481 CL**2 +00482 WRITE PRINT-RECORD FROM WS-OUTPUT CL247 +00483 WRITE X144-RECORD-OUT FROM Z144-REC CL**1 +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 +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 diff --git a/Batch/DTSBX630.cob b/Batch/DTSBX630.cob new file mode 100644 index 0000000..1217635 --- /dev/null +++ b/Batch/DTSBX630.cob @@ -0,0 +1,991 @@ +00001 IDENTIFICATION DIVISION. 08/16/18 +00002 PROGRAM-ID. DTSBX630. DTSBX630 +00003 LV025 +00004 ******************************************************************DTSBX630 +00005 * *DTSBX630 +00006 * FUNCTION: *DTSBX630 +00007 * *DTSBX630 +00008 * PROGRAM WILL READ ALL ESSP INPUT FILES DO DUTAS AND COUNT * CL**1 +00009 * RECORDS SENT VIA FTP VERSUS TOTALS SENT IN X999 FILE. . CL**1 +00010 * 07/07/18 ZL1 * CL254 +00011 * * CL*53 +00012 ******************************************************************DTSBX630 +00013 DTSBX630 +00014 ENVIRONMENT DIVISION. DTSBX630 +00015 DTSBX630 +00016 CONFIGURATION SECTION. DTSBX630 +00017 DTSBX630 +00018 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX630 +00019 DTSBX630 +00020 INPUT-OUTPUT SECTION. DTSBX630 +00021 DTSBX630 +00022 FILE-CONTROL. DTSBX630 +00023 DTSBX630 +00024 SELECT X102REG-IN ASSIGN TO DTSFX102. CL**1 +00025 SELECT X104REG-IN ASSIGN TO DTSFX104. CL**1 +00026 SELECT X106REG-IN ASSIGN TO DTSFX106. CL**1 +00027 SELECT X106AREG-IN ASSIGN TO DTSFA106. CL**1 +00028 SELECT X108REG-IN ASSIGN TO DTSFX108. CL**1 +00029 SELECT X110REG-IN ASSIGN TO DTSFX110. CL**1 +00030 SELECT X110AREG-IN ASSIGN TO DTSFA110. CL**1 +00031 SELECT X120REG-IN ASSIGN TO DTSFX120. CL**1 +00032 SELECT X120AREG-IN ASSIGN TO DTSFA120. CL**1 +00033 SELECT X140RPT-IN ASSIGN TO DTSFX140. CL**1 +00034 SELECT X144WGE-IN ASSIGN TO DTSFX144. CL**1 +00035 SELECT X145PAY-IN ASSIGN TO DTSFX145. CL**1 +00036 SELECT X147SSN-IN ASSIGN TO DTSFX147. CL**1 +00037 SELECT X998ACH-IN ASSIGN TO DTSFX998. CL**8 +00038 SELECT X999ESSP-IN ASSIGN TO DTSFX999. CL**8 +00039 SELECT REPORT-FILE ASSIGN TO RPT630R1. CL**1 +00040 DTSBX630 +00041 DTSBX630 +00042 DATA DIVISION. DTSBX630 +00043 FILE SECTION. DTSBX630 +00044 CL101 +00045 FD X102REG-IN CL**1 +00046 RECORDING MODE IS F. CL101 +00047 01 X102-REC PIC X(512). CL**1 +00048 CL138 +00049 FD X104REG-IN CL**1 +00050 RECORDING MODE IS F. CL**1 +00051 01 X104-REC PIC X(512). CL**1 +00052 CL**1 +00053 FD X106REG-IN CL**1 +00054 RECORDING MODE IS F. CL**1 +00055 01 X106-REC PIC X(512). CL**1 +00056 CL**1 +00057 FD X106AREG-IN CL**1 +00058 RECORDING MODE IS F. CL**1 +00059 01 X106-AREC PIC X(512). CL**1 +00060 CL123 +00061 FD X108REG-IN CL**1 +00062 RECORDING MODE IS F. CL**1 +00063 01 X108-REC PIC X(512). CL**1 +00064 CL**1 +00065 FD X110REG-IN CL**1 +00066 RECORDING MODE IS F. CL**1 +00067 01 X110-REC PIC X(512). CL**1 +00068 CL**1 +00069 FD X110AREG-IN CL**1 +00070 RECORDING MODE IS F. CL**1 +00071 01 X110-AREC PIC X(512). CL**1 +00072 CL**1 +00073 FD X120REG-IN CL**1 +00074 RECORDING MODE IS F. CL**1 +00075 01 X120-REC PIC X(512). CL**1 +00076 CL**1 +00077 FD X120AREG-IN CL**1 +00078 RECORDING MODE IS F. CL**1 +00079 01 X120-AREC PIC X(512). CL**1 +00080 CL**1 +00081 FD X140RPT-IN CL**1 +00082 RECORDING MODE IS F. CL**1 +00083 01 X140-REC PIC X(512). CL**1 +00084 CL**1 +00085 FD X144WGE-IN CL**1 +00086 RECORDING MODE IS F. CL**1 +00087 01 X144-REC PIC X(512). CL**1 +00088 CL**1 +00089 FD X145PAY-IN CL**1 +00090 RECORDING MODE IS F. CL**1 +00091 01 X145-REC PIC X(512). CL**1 +00092 CL**1 +00093 FD X147SSN-IN CL**1 +00094 RECORDING MODE IS F. CL**1 +00095 01 X147-REC PIC X(512). CL**1 +00096 CL**1 +00097 FD X999ESSP-IN CL**5 +00098 RECORDING MODE IS F. CL**1 +00099 01 X999-REC. CL**1 +00100 05 X999-NAME PIC X(4). CL**1 +00101 05 FILLER PIC X(1). CL**1 +00102 05 X999-TYPE PIC 9(1). CL**7 +00103 05 FILLER PIC X(1). CL**7 +00104 05 X999-CNT PIC 9(6). CL**7 +00105 05 FILLER PIC X(67). CL**7 +00106 CL**8 +00107 FD X998ACH-IN CL**8 +00108 RECORDING MODE IS F. CL**8 +00109 01 X998-REC. CL**8 +00110 05 X998-TYPE PIC 9(1). CL**8 +00111 05 FILLER PIC X(511). CL**8 +00112 CL**1 +00113 FD REPORT-FILE DTSBX630 +00114 RECORDING MODE IS F DTSBX630 +00115 RECORD CONTAINS 133 CHARACTERS DTSBX630 +00116 BLOCK CONTAINS 0 RECORDS DTSBX630 +00117 LABEL RECORDS ARE OMITTED DTSBX630 +00118 DATA RECORD IS PRINT-RECORD. DTSBX630 +00119 DTSBX630 +00120 01 PRINT-RECORD PIC X(133). DTSBX630 +00121 DTSBX630 +00122 ******************************************************************DTSBX630 +00123 * WORKING STORAGE SECTION *DTSBX630 +00124 ******************************************************************DTSBX630 +00125 WORKING-STORAGE SECTION. DTSBX630 +001255 77 PAN-VALET PICTURE X(24) VALUE '025DTSBX630 08/16/18'. DTSBX630 +00126 DTSBX630 +00127 01 ENDOFSEG PIC 9 VALUE ZEROES. DTSBX630 +00128 DTSBX630 +00129 01 EMPLOYER-FOUND-IND PIC X VALUE SPACE. CL*87 +00130 DTSBX630 +00131 01 MASTER-END-IND PIC X VALUE SPACE. DTSBX630 +00132 88 MASTER-END VALUE 'Y'. DTSBX630 +00133 DTSBX630 +00134 CL*70 +00135 01 WRK-AREA. CL*79 +00136 05 WRK-ABEND-CODE PIC X(04) VALUE 'X552'. CL*91 +00137 05 WS-ABEND-JOB PIC 9(01) VALUE ZEROS. CL**6 +00138 CL*70 +00139 01 WRK-SEG01-SSN-FOUND PIC 9(01) VALUE ZEROES. CL147 +00140 01 WS-X144-NOT-RETURNED PIC 9(05) VALUE ZEROES. CL243 +00141 01 WS-X144-SSN-FOUND PIC 9(01) VALUE ZEROES. CL243 +00142 01 WS-CLAIM-SSN-FOUND PIC 9(01) VALUE ZEROES. CL182 +00143 01 WS-X140-RPT-FOUND PIC 9(01) VALUE ZEROES. CL138 +00144 01 WS-X147-SSN-NOT-DOCS PIC 9(05) VALUE ZEROES. CL168 +00145 01 WS-X147-SSN-N99-DOCS PIC 9(05) VALUE ZEROES. CL211 +00146 01 WS-X147-SSN-IN-DOCS PIC 9(05) VALUE ZEROES. CL168 +00147 01 SSN-HIT-COUNT PIC 9(03) VALUE ZEROES. CL106 +00148 01 WS-HOLD-X147-SSN PIC 9(09) VALUE ZEROES. CL*91 +00149 01 WS-TOTAL-NO-X144-SSN PIC 9(05) VALUE ZEROES. CL108 +00150 01 WS-TOTAL-YES-X144-SSN PIC 9(05) VALUE ZEROES. CL113 +00151 01 WS-TOTAL-OTH-X144-SSN PIC 9(05) VALUE ZEROES. CL113 +00152 01 WS-HOLD-X147-EMP-NO PIC 9(06) VALUE ZEROES. CL*91 +00153 01 WS-SAV-X147 PIC 9(01) VALUE ZEROES. CL129 +00154 01 WRK-MODULE-NAME PIC X(08) VALUE 'DTSBX551'. CL138 +00155 01 WRK-ABEND-CD PIC X(04) VALUE 'X551'. CL138 +00156 01 WRK-ABEND-MSG PIC X(60). CL*62 +00157 DTSBX630 +00158 01 WS-HOLD-PAY-DATE. DTSBX630 +00159 05 WS-HOLD-PAY-DATE-CEN PIC 9(02) VALUE ZEROS. DTSBX630 +00160 05 WS-HOLD-PAY-DATE-YY PIC 9(02) VALUE ZEROES. DTSBX630 +00161 05 WS-HOLD-PAY-DATE-MM PIC 9(02) VALUE ZEROES. DTSBX630 +00162 05 WS-HOLD-PAY-DATE-DD PIC 9(02) VALUE ZEROES. DTSBX630 +00163 DTSBX630 +00164 01 WS-X147-SSN PIC 9(09) VALUE ZEROS. CL106 +00165 01 WS-X147-EMP-NO PIC 9(06) VALUE ZEROS. CL104 +00166 01 WS-X147-QUARTER. CL150 +00167 05 WS-X147-YR PIC 9(04) VALUE ZEROS. CL152 +00168 05 WS-X147-QTR PIC 9(01) VALUE ZEROS. CL150 +00169 CL*34 +00170 01 WS-X140-QUARTER. CL240 +00171 05 WS-X140-YR PIC 9(04) VALUE ZEROS. CL240 +00172 05 WS-X140-QTR PIC 9(01) VALUE ZEROS. CL240 +00173 CL240 +00174 01 WS-HOLD-DATE. CL*25 +00175 05 WS-HOLD-DATE-CEN PIC 9(02) VALUE ZEROS. CL*26 +00176 05 WS-HOLD-DATE-YY PIC 9(02) VALUE ZEROES. CL*26 +00177 05 WS-HOLD-DATE-MM PIC 9(02) VALUE ZEROES. CL*26 +00178 05 WS-HOLD-DATE-DD PIC 9(02) VALUE ZEROES. CL*26 +00179 DTSBX630 +00180 CL*86 +00181 01 WS-COUNTERS. DTSBX630 +00182 05 LINE-COUNT PIC 9(03) VALUE 99. DTSBX630 +00183 05 PAGE-COUNT PIC 9(03) VALUE ZEROES. DTSBX630 +00184 05 TRANS-READ-COUNT PIC 9(06) VALUE ZEROES. DTSBX630 +00185 05 MASTER-READ-COUNT PIC 9(06) VALUE ZEROES. DTSBX630 +00186 05 WS-TOTAL-READ PIC 9(05) VALUE ZEROES. CL*93 +00187 05 WS-TOTAL-NDEL PIC 9(05) VALUE ZEROES. CL*93 +00188 05 WS-TOTAL-DELQ PIC 9(05) VALUE ZEROES. CL*93 +00189 05 WS-TOTAL-X102-CNT PIC 9(06) VALUE ZEROES. CL**6 +00190 05 WS-TOTAL-X104-CNT PIC 9(06) VALUE ZEROES. CL**6 +00191 05 WS-TOTAL-X106-CNT PIC 9(06) VALUE ZEROES. CL**6 +00192 05 WS-TOTAL-X106A-CNT PIC 9(06) VALUE ZEROES. CL**6 +00193 05 WS-TOTAL-X108-CNT PIC 9(06) VALUE ZEROES. CL**6 +00194 05 WS-TOTAL-X110-CNT PIC 9(06) VALUE ZEROES. CL**6 +00195 05 WS-TOTAL-X110A-CNT PIC 9(06) VALUE ZEROES. CL**6 +00196 05 WS-TOTAL-X120-CNT PIC 9(06) VALUE ZEROES. CL**6 +00197 05 WS-TOTAL-X120A-CNT PIC 9(06) VALUE ZEROES. CL**6 +00198 05 WS-TOTAL-X140-CNT PIC 9(06) VALUE ZEROES. CL**6 +00199 05 WS-TOTAL-X144-CNT PIC 9(06) VALUE ZEROES. CL**6 +00200 05 WS-TOTAL-X145-CNT PIC 9(06) VALUE ZEROES. CL**6 +00201 05 WS-TOTAL-X147-CNT PIC 9(06) VALUE ZEROES. CL**6 +00202 05 WS-TOTAL-X998-CNT PIC 9(06) VALUE ZEROES. CL**8 +00203 05 WS-TOTAL-X999-CNT PIC 9(06) VALUE ZEROES. CL**9 +00204 CL**4 +00205 05 WS-READ-X102 PIC 9(06) VALUE ZEROES. CL**4 +00206 05 WS-READ-X104 PIC 9(06) VALUE ZEROES. CL**4 +00207 05 WS-READ-X106 PIC 9(06) VALUE ZEROES. CL**4 +00208 05 WS-READ-X106A PIC 9(06) VALUE ZEROES. CL**4 +00209 05 WS-READ-X108 PIC 9(06) VALUE ZEROES. CL**4 +00210 05 WS-READ-X110 PIC 9(06) VALUE ZEROES. CL**4 +00211 05 WS-READ-X110A PIC 9(06) VALUE ZEROES. CL**4 +00212 05 WS-READ-X120 PIC 9(06) VALUE ZEROES. CL**4 +00213 05 WS-READ-X120A PIC 9(06) VALUE ZEROES. CL**4 +00214 05 WS-READ-X140 PIC 9(06) VALUE ZEROES. CL**4 +00215 05 WS-READ-X144 PIC 9(06) VALUE ZEROES. CL**4 +00216 05 WS-READ-X145 PIC 9(06) VALUE ZEROES. CL**4 +00217 05 WS-READ-X147 PIC 9(06) VALUE ZEROES. CL**4 +00218 05 WS-READ-X998 PIC 9(06) VALUE ZEROES. CL**8 +00219 DTSBX630 +00220 01 WS-OUTPUT. DTSBX630 +00221 03 FILLER PIC X(03) VALUE SPACES. CL*20 +00222 03 WS-OUT-EMP-NO PIC 9(06). CL*92 +00223 03 FILLER PIC X(04) VALUE SPACES. CL243 +00224 03 WS-OUT-NAME PIC X(04). CL243 +00225 03 FILLER PIC X(04) VALUE SPACES. CL243 +00226 03 WS-OUT-QUARTER PIC X(06). CL*92 +00227 03 FILLER PIC X(04) VALUE SPACES. CL129 +00228 03 WS-OUT-MESSAGE PIC X(40). CL137 +00229 CL*25 +00230 CL*11 +00231 01 WS-TOTAL-LINE1. CL*92 +00232 03 FIL PIC X(2) VALUE SPACES. CL249 +00233 03 FIL PIC X(23) VALUE CL*19 +00234 'X102-PROFILE........: '. CL*19 +00235 03 WS-TOTAL-X102-ZCNT PIC ZZZZZ9. CL*12 +00236 03 FIL PIC X(3) VALUE SPACES. CL*16 +00237 03 FIL PIC X(02) VALUE CL*19 +00238 'º '. CL*15 +00239 03 WS-READ-Z102 PIC ZZZZZ9. CL*12 +00240 03 FIL PIC X(05) VALUE SPACES. CL*21 +00241 03 Z102-MSG PIC X(45) VALUE SPACES. CL*21 +00242 CL*12 +00243 01 WS-TOTAL-LINE2. CL*12 +00244 03 FIL PIC X(2) VALUE SPACES. CL*12 +00245 03 FIL PIC X(23) VALUE CL*19 +00246 'X104-DETERMINATION..: '. CL*19 +00247 03 WS-TOTAL-X104-ZCNT PIC ZZZZZ9. CL*12 +00248 03 FIL PIC X(3) VALUE SPACES. CL*18 +00249 03 FIL PIC X(02) VALUE CL*15 +00250 'º '. CL*15 +00251 03 WS-READ-Z104 PIC ZZZZZ9. CL*12 +00252 03 FIL PIC X(05) VALUE SPACES. CL*21 +00253 03 Z104-MSG PIC X(45) VALUE SPACES. CL*21 +00254 01 WS-TOTAL-LINE3. CL*12 +00255 03 FIL PIC X(2) VALUE SPACES. CL*12 +00256 03 FIL PIC X(23) VALUE CL*19 +00257 'X106-EMPL NAME......: '. CL*19 +00258 03 WS-TOTAL-X106-ZCNT PIC ZZZZZ9. CL*12 +00259 03 FIL PIC X(3) VALUE SPACES. CL*18 +00260 03 FIL PIC X(02) VALUE CL*15 +00261 'º '. CL*15 +00262 03 WS-READ-Z106 PIC ZZZZZ9. CL*12 +00263 03 FIL PIC X(05) VALUE SPACES. CL*21 +00264 03 Z106-MSG PIC X(45) VALUE SPACES. CL*21 +00265 01 WS-TOTAL-LINE4. CL*12 +00266 03 FIL PIC X(2) VALUE SPACES. CL*12 +00267 03 FIL PIC X(23) VALUE CL*19 +00268 'X106-EMPL NAME UPD..: '. CL*19 +00269 03 WS-TOTAL-X106A-ZCNT PIC ZZZZZ9. CL*12 +00270 03 FIL PIC X(3) VALUE SPACES. CL*18 +00271 03 FIL PIC X(02) VALUE CL*15 +00272 'º '. CL*15 +00273 03 WS-READ-Z106A PIC ZZZZZ9. CL*12 +00274 03 FIL PIC X(05) VALUE SPACES. CL*21 +00275 03 Z106A-MSG PIC X(45) VALUE SPACES. CL*21 +00276 01 WS-TOTAL-LINE5. CL*13 +00277 03 FIL PIC X(2) VALUE SPACES. CL*13 +00278 03 FIL PIC X(23) VALUE CL*19 +00279 'X108-RATES..........: '. CL*19 +00280 03 WS-TOTAL-X108-ZCNT PIC ZZZZZ9. CL*13 +00281 03 FIL PIC X(3) VALUE SPACES. CL*18 +00282 03 FIL PIC X(02) VALUE CL*15 +00283 'º '. CL*15 +00284 03 WS-READ-Z108 PIC ZZZZZ9. CL*13 +00285 03 FIL PIC X(05) VALUE SPACES. CL*21 +00286 03 Z108-MSG PIC X(45) VALUE SPACES. CL*21 +00287 01 WS-TOTAL-LINE6. CL*13 +00288 03 FIL PIC X(2) VALUE SPACES. CL*13 +00289 03 FIL PIC X(23) VALUE CL*19 +00290 'X110-ADDRESS........: '. CL*19 +00291 03 WS-TOTAL-X110-ZCNT PIC ZZZZZ9. CL*13 +00292 03 FIL PIC X(3) VALUE SPACES. CL*18 +00293 03 FIL PIC X(02) VALUE CL*15 +00294 'º '. CL*15 +00295 03 WS-READ-Z110 PIC ZZZZZ9. CL*13 +00296 03 FIL PIC X(05) VALUE SPACES. CL*21 +00297 03 Z110-MSG PIC X(45) VALUE SPACES. CL*21 +00298 01 WS-TOTAL-LINE7. CL*13 +00299 03 FIL PIC X(2) VALUE SPACES. CL*13 +00300 03 FIL PIC X(23) VALUE CL*19 +00301 'X110-ADDRESS UPD....: '. CL*19 +00302 03 WS-TOTAL-X110A-ZCNT PIC ZZZZZ9. CL*13 +00303 03 FIL PIC X(3) VALUE SPACES. CL*18 +00304 03 FIL PIC X(02) VALUE CL*15 +00305 'º '. CL*15 +00306 03 WS-READ-Z110A PIC ZZZZZ9. CL*13 +00307 03 FIL PIC X(05) VALUE SPACES. CL*21 +00308 03 Z110A-MSG PIC X(45) VALUE SPACES. CL*21 +00309 01 WS-TOTAL-LINE8. CL*13 +00310 03 FIL PIC X(2) VALUE SPACES. CL*13 +00311 03 FIL PIC X(23) VALUE CL*19 +00312 'X120-OPO ADDRESS....: '. CL*19 +00313 03 WS-TOTAL-X120-ZCNT PIC ZZZZZ9. CL*13 +00314 03 FIL PIC X(3) VALUE SPACES. CL*18 +00315 03 FIL PIC X(02) VALUE CL*15 +00316 'º '. CL*15 +00317 03 WS-READ-Z120 PIC ZZZZZ9. CL*13 +00318 03 FIL PIC X(05) VALUE SPACES. CL*21 +00319 03 Z120-MSG PIC X(45) VALUE SPACES. CL*21 +00320 01 WS-TOTAL-LINE9. CL*13 +00321 03 FIL PIC X(2) VALUE SPACES. CL*13 +00322 03 FIL PIC X(23) VALUE CL*19 +00323 'X120-OPO ADDR UPD...: '. CL*19 +00324 03 WS-TOTAL-X120A-ZCNT PIC ZZZZZ9. CL*13 +00325 03 FIL PIC X(3) VALUE SPACES. CL*18 +00326 03 FIL PIC X(02) VALUE CL*15 +00327 'º '. CL*15 +00328 03 WS-READ-Z120A PIC ZZZZZ9. CL*13 +00329 03 FIL PIC X(05) VALUE SPACES. CL*21 +00330 03 Z120A-MSG PIC X(45) VALUE SPACES. CL*21 +00331 01 WS-TOTAL-LINE10. CL*13 +00332 03 FIL PIC X(2) VALUE SPACES. CL*13 +00333 03 FIL PIC X(23) VALUE CL*19 +00334 'X140-REPORTS........: '. CL*19 +00335 03 WS-TOTAL-X140-ZCNT PIC ZZZZZ9. CL*13 +00336 03 FIL PIC X(3) VALUE SPACES. CL*18 +00337 03 FIL PIC X(02) VALUE CL*15 +00338 'º '. CL*15 +00339 03 WS-READ-Z140 PIC ZZZZZ9. CL*13 +00340 03 FIL PIC X(05) VALUE SPACES. CL*21 +00341 03 Z140-MSG PIC X(45) VALUE SPACES. CL*21 +00342 01 WS-TOTAL-LINE11. CL*13 +00343 03 FIL PIC X(2) VALUE SPACES. CL*13 +00344 03 FIL PIC X(23) VALUE CL*19 +00345 'X144-WAGES..........: '. CL*19 +00346 03 WS-TOTAL-X144-ZCNT PIC ZZZZZ9. CL*13 +00347 03 FIL PIC X(3) VALUE SPACES. CL*18 +00348 03 FIL PIC X(02) VALUE CL*15 +00349 'º '. CL*15 +00350 03 WS-READ-Z144 PIC ZZZZZ9. CL*13 +00351 03 FIL PIC X(05) VALUE SPACES. CL*21 +00352 03 Z144-MSG PIC X(45) VALUE SPACES. CL*21 +00353 01 WS-TOTAL-LINE12. CL*13 +00354 03 FIL PIC X(2) VALUE SPACES. CL*13 +00355 03 FIL PIC X(23) VALUE CL*19 +00356 'X145-PAYMENTS.......: '. CL*25 +00357 03 WS-TOTAL-X145-ZCNT PIC ZZZZZ9. CL*13 +00358 03 FIL PIC X(03) VALUE SPACES. CL*18 +00359 03 FIL PIC X(02) VALUE CL*15 +00360 'º '. CL*15 +00361 03 WS-READ-Z145 PIC ZZZZZ9. CL*13 +00362 03 FIL PIC X(05) VALUE SPACES. CL*21 +00363 03 Z145-MSG PIC X(45) VALUE SPACES. CL*21 +00364 01 WS-TOTAL-LINE13. CL*13 +00365 03 FIL PIC X(2) VALUE SPACES. CL*13 +00366 03 FIL PIC X(23) VALUE CL*19 +00367 'X147-SSN DELETIONS..: '. CL*19 +00368 03 WS-TOTAL-X147-ZCNT PIC ZZZZZ9. CL*13 +00369 03 FIL PIC X(03) VALUE SPACES. CL*18 +00370 03 FIL PIC X(02) VALUE CL*15 +00371 'º '. CL*15 +00372 03 WS-READ-Z147 PIC ZZZZZ9. CL*13 +00373 03 FIL PIC X(05) VALUE SPACES. CL*21 +00374 03 Z147-MSG PIC X(45) VALUE SPACES. CL*21 +00375 01 WS-TOTAL-LINE14. CL*13 +00376 03 FIL PIC X(2) VALUE SPACES. CL*13 +00377 03 FIL PIC X(23) VALUE CL*19 +00378 'X998-ACH DEPOSITS...: '. CL*19 +00379 03 WS-TOTAL-X998-ZCNT PIC ZZZZZ9. CL*13 +00380 03 FIL PIC X(03) VALUE SPACES. CL*18 +00381 03 FIL PIC X(02) VALUE CL*15 +00382 'º '. CL*19 +00383 03 WS-READ-Z998 PIC ZZZZZ9. CL*13 +00384 03 FIL PIC X(05) VALUE SPACES. CL*21 +00385 03 Z998-MSG PIC X(45) VALUE SPACES. CL*21 +00386 01 WS-TOTAL-LINE45. CL*21 +00387 03 FIL PIC X(5) VALUE SPACES. CL*21 +00388 03 FIL PIC X(53) VALUE CL*21 +00389 '****** ESSP FILES TRANSFER TO DUTAS SUCESSFULL ******'. CL*21 +00390 03 FIL PIC X(43) VALUE CL*21 +00391 ' '. CL*21 +00392 03 FIL PIC X(030) VALUE SPACES. CL*21 +00393 CL*21 +00394 01 WS-TOTAL-LINE46. CL*21 +00395 03 FIL PIC X(5) VALUE SPACES. CL*21 +00396 03 FIL PIC X(55) VALUE CL*22 +00397 '++++++ ESSP FILES TRANSFER TO DUTAS HAS ERRORS !!!!!!!Z'. CL*21 +00398 03 FIL PIC X(43) VALUE CL*21 +00399 ' '. CL*21 +00400 03 FIL PIC X(030) VALUE SPACES. CL*21 +00401 CL*21 +00402 CL172 +00403 01 WS-RUN-DATE. DTSBX630 +00404 03 RUN-YR PIC 99. CL*54 +00405 03 RUN-MO PIC 99. CL*54 +00406 03 RUN-DA PIC 99. CL*54 +00407 DTSBX630 +00408 DTSBX630 +00409 01 HEADER1. DTSBX630 +00410 03 FILLER PIC X(05) VALUE SPACES. DTSBX630 +00411 03 FILLER PIC X(31) VALUE DTSBX630 +00412 'DISTRICT OF COLUMBIA GOVERNMENT'. DTSBX630 +00413 03 FILLER PIC X(05) VALUE SPACES. CL247 +00414 03 REPORTING-DATE. CL247 +00415 05 RUN-MO1 PIC 99. CL247 +00416 05 FIL PIC X VALUE '/'. CL247 +00417 05 RUN-DA1 PIC 99. CL247 +00418 05 FIL PIC X VALUE '/'. CL247 +00419 05 RUN-CEN PIC 99. CL247 +00420 05 RUN-YR1 PIC 99. CL247 +00421 * DTSBX630 +00422 01 HEADER2. DTSBX630 +00423 03 FILLER PIC X(04) VALUE SPACES. CL247 +00424 03 FILLER PIC X(33) VALUE DTSBX630 +00425 'DEPARTMENT OF EMPLOYMENT SERVICES'. DTSBX630 +00426 03 FILLER PIC X(30) VALUE SPACES. CL*99 +00427 * 03 FILLER PIC X(10) VALUE CL249 +00428 * 'PAGE NO. '. CL249 +00429 * 03 HD-PAGE PIC 9(03). CL249 +00430 03 FILLER PIC X(07) VALUE SPACES. DTSBX630 +00431 DTSBX630 +00432 01 HEADER3. DTSBX630 +00433 03 FILLER PIC X(02) VALUE SPACES. CL249 +00434 03 FILLER PIC X(50) VALUE CL220 +00435 'ESSP DAILY FILE/RECORD COUNTS SENT TO DUTAS'. CL*12 +00436 03 FILLER PIC X(30) VALUE SPACES. CL201 +00437 DTSBX630 +00438 01 COLUMN-HD1. CL*44 +00439 03 FILLER PIC X(02) VALUE SPACES. CL*16 +00440 03 FILLER PIC X(50) VALUE CL*24 +00441 '+----- ESSP (SENT) ------------+º+--DUTAS (RECV)-+'. CL*23 +00442 03 FILLER PIC X(35) VALUE CL*23 +00443 '----FILE TRANSFER MESSAGES----+'. CL*24 +00444 CL*15 +00445 ++INCLUDE WSDATES DTSBX630 +00446 01 L001-LINK-AREA. CL*61 +00447 ++INCLUDE DTSIL001 CL*60 +00448 01 ESSP-FILE-IN. CL**4 +00449 05 ESSP-NAME PIC X(03). CL*10 +00450 05 FILLER PIC X(509). CL*10 +00451 CL**4 +00452 ******************************************************************DTSBX630 +00453 * PROCEDURE DIVISION *DTSBX630 +00454 ******************************************************************DTSBX630 +00455 DTSBX630 +00456 PROCEDURE DIVISION. DTSBX630 +00457 DTSBX630 +00458 MAIN0100-CONTROL. DTSBX630 +00459 DTSBX630 +00460 OPEN INPUT X999ESSP-IN CL**2 +00461 X998ACH-IN CL**8 +00462 X102REG-IN CL**2 +00463 X104REG-IN CL**2 +00464 X106REG-IN CL**2 +00465 X106AREG-IN CL**2 +00466 X108REG-IN CL**2 +00467 X110REG-IN CL**2 +00468 X110AREG-IN CL**2 +00469 X120REG-IN CL**2 +00470 X120AREG-IN CL**2 +00471 X140RPT-IN CL**2 +00472 X144WGE-IN CL**2 +00473 X145PAY-IN CL**2 +00474 X147SSN-IN. CL**2 +00475 CL**2 +00476 OPEN OUTPUT REPORT-FILE. CL*87 +00477 ++INCLUDE CODEDATE DTSBX630 +00478 MOVE ZEROS TO WS-RUN-DATE. DTSBX630 +00479 MOVE WS-SYSTEM-DATE TO WS-RUN-DATE. DTSBX630 +00480 MOVE RUN-DA TO RUN-DA1. DTSBX630 +00481 MOVE RUN-MO TO RUN-MO1. DTSBX630 +00482 MOVE 20 TO RUN-CEN. DTSBX630 +00483 MOVE RUN-YR TO RUN-YR1. DTSBX630 +00484 DTSBX630 +00485 ADD 1 TO PAGE-COUNT CL*98 +00486 * MOVE PAGE-COUNT TO HD-PAGE CL249 +00487 WRITE PRINT-RECORD FROM HEADER1 AFTER ADVANCING CL*98 +00488 TOP-OF-PAGE CL*98 +00489 WRITE PRINT-RECORD FROM HEADER2 AFTER ADVANCING 1 CL*98 +00490 WRITE PRINT-RECORD FROM HEADER3 AFTER ADVANCING 1 CL*98 +00491 MOVE SPACES TO PRINT-RECORD CL*98 +00492 WRITE PRINT-RECORD AFTER ADVANCING 1 CL*98 +00493 WRITE PRINT-RECORD FROM COLUMN-HD1 AFTER 1. CL132 +00494 MOVE ZEROES TO MASTER-READ-COUNT. DTSBX630 +00495 ****************************************************************** CL*85 +00496 * BENEFIT FILE PROCESS * CL*85 +00497 ****************************************************************** CL*85 +00498 PROC1000-GET-UI-DATA. CL*85 +00499 DISPLAY ' '. CL*85 +00500 DISPLAY '### ESSP DAILY FILE RECORD COUNTS TO DUTAS:' CL**2 +00501 DISPLAY ' '. CL241 +00502 DTSBX630 +00503 PERFORM PROC2000-UI-PROCESS THRU DTSBX630 +00504 PROC2000-UI-EXIT. CL**3 +00505 * UNTIL MASTER-END. CL**3 +00506 DTSBX630 +00507 DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++'. DTSBX630 +00508 * MOVE MASTER-READ-COUNT TO WS-OUT-READ WS-OUT-READ1. CL*13 +00509 * MOVE WS-TOTAL-NDEL TO WS-OUT-NDEL. CL*13 +00510 * MOVE WS-TOTAL-DELQ TO WS-OUT-DELQ. CL*13 +00511 MOVE WS-READ-X102 TO WS-READ-Z102. CL*13 +00512 MOVE WS-READ-X104 TO WS-READ-Z104. CL*13 +00513 MOVE WS-READ-X106 TO WS-READ-Z106. CL*13 +00514 MOVE WS-READ-X106A TO WS-READ-Z106A. CL*13 +00515 MOVE WS-READ-X108 TO WS-READ-Z108. CL*13 +00516 MOVE WS-READ-X110 TO WS-READ-Z110. CL*13 +00517 MOVE WS-READ-X110A TO WS-READ-Z110A CL*13 +00518 MOVE WS-READ-X120 TO WS-READ-Z120. CL*13 +00519 MOVE WS-READ-X120A TO WS-READ-Z120A. CL*13 +00520 MOVE WS-READ-X140 TO WS-READ-Z140. CL*13 +00521 MOVE WS-READ-X144 TO WS-READ-Z144. CL*13 +00522 MOVE WS-READ-X145 TO WS-READ-Z145. CL*13 +00523 MOVE WS-READ-X147 TO WS-READ-Z147. CL*13 +00524 MOVE WS-READ-X998 TO WS-READ-Z998. CL*13 +00525 CL*11 +00526 MOVE WS-TOTAL-X102-CNT TO WS-TOTAL-X102-ZCNT CL*14 +00527 MOVE WS-TOTAL-X104-CNT TO WS-TOTAL-X104-ZCNT CL*14 +00528 MOVE WS-TOTAL-X106-CNT TO WS-TOTAL-X106-ZCNT CL*14 +00529 MOVE WS-TOTAL-X106A-CNT TO WS-TOTAL-X106A-ZCNT. CL*14 +00530 MOVE WS-TOTAL-X108-CNT TO WS-TOTAL-X108-ZCNT CL*14 +00531 MOVE WS-TOTAL-X110-CNT TO WS-TOTAL-X110-ZCNT CL*14 +00532 MOVE WS-TOTAL-X110A-CNT TO WS-TOTAL-X110A-ZCNT CL*14 +00533 MOVE WS-TOTAL-X120-CNT TO WS-TOTAL-X120-ZCNT CL*14 +00534 MOVE WS-TOTAL-X120A-CNT TO WS-TOTAL-X120A-ZCNT CL*14 +00535 MOVE WS-TOTAL-X140-CNT TO WS-TOTAL-X140-ZCNT CL*14 +00536 MOVE WS-TOTAL-X144-CNT TO WS-TOTAL-X144-ZCNT. CL*14 +00537 MOVE WS-TOTAL-X145-CNT TO WS-TOTAL-X145-ZCNT. CL*14 +00538 MOVE WS-TOTAL-X147-CNT TO WS-TOTAL-X147-ZCNT. CL*14 +00539 MOVE WS-TOTAL-X998-CNT TO WS-TOTAL-X998-ZCNT. CL*14 +00540 CL*13 +00541 WRITE PRINT-RECORD FROM WS-TOTAL-LINE1 AFTER 2. CL*93 +00542 WRITE PRINT-RECORD FROM WS-TOTAL-LINE2 AFTER 1. CL*13 +00543 WRITE PRINT-RECORD FROM WS-TOTAL-LINE3 AFTER 1. CL*13 +00544 WRITE PRINT-RECORD FROM WS-TOTAL-LINE4 AFTER 1. CL*13 +00545 WRITE PRINT-RECORD FROM WS-TOTAL-LINE5 AFTER 1. CL*13 +00546 WRITE PRINT-RECORD FROM WS-TOTAL-LINE6 AFTER 1. CL*13 +00547 WRITE PRINT-RECORD FROM WS-TOTAL-LINE7 AFTER 1. CL*13 +00548 WRITE PRINT-RECORD FROM WS-TOTAL-LINE8 AFTER 1. CL*13 +00549 WRITE PRINT-RECORD FROM WS-TOTAL-LINE9 AFTER 1. CL*13 +00550 WRITE PRINT-RECORD FROM WS-TOTAL-LINE10 AFTER 1. CL211 +00551 WRITE PRINT-RECORD FROM WS-TOTAL-LINE11 AFTER 1. CL211 +00552 WRITE PRINT-RECORD FROM WS-TOTAL-LINE12 AFTER 1. CL169 +00553 WRITE PRINT-RECORD FROM WS-TOTAL-LINE13 AFTER 1. CL*13 +00554 WRITE PRINT-RECORD FROM WS-TOTAL-LINE14 AFTER 1. CL*15 +00555 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE3 AFTER 1. CL247 +00556 * WRITE PRINT-RECORD FROM WS-TOTAL-LINE4 AFTER 1. CL247 +00557 IF WS-ABEND-JOB = 0 CL*23 +00558 WRITE PRINT-RECORD FROM WS-TOTAL-LINE45 AFTER 3 CL*21 +00559 ELSE CL*21 +00560 WRITE PRINT-RECORD FROM WS-TOTAL-LINE46 AFTER 3. CL*21 +00561 CL*11 +00562 IF WS-ABEND-JOB = 1 CL**7 +00563 MOVE +05 TO RETURN-CODE. CL**7 +00564 DTSBX630 +00565 CLOSE X144WGE-IN, X102REG-IN, X104REG-IN, REPORT-FILE, CL**6 +00566 X106REG-IN, X106AREG-IN, X108REG-IN, X110REG-IN, CL**2 +00567 X110AREG-IN, X120REG-IN, X120AREG-IN,X147SSN-IN, CL**2 +00568 X140RPT-IN, X145PAY-IN, X999ESSP-IN, CL*11 +00569 X998ACH-IN. CL**8 +00570 * CLOSE X147SSN-OUTB. CL225 +00571 DTSBX630 +00572 GOBACK. DTSBX630 +00573 DTSBX630 +00574 MAIN0100-CONTROL-EXIT. DTSBX630 +00575 EXIT. DTSBX630 +00576 DTSBX630 +00577 ******************************************************************DTSBX630 +00578 * PROC2000-UI-PROCESS *DTSBX630 +00579 ******************************************************************DTSBX630 +00580 DTSBX630 +00581 PROC2000-UI-PROCESS. DTSBX630 +00582 DTSBX630 +00583 PERFORM PROC3000-READ-MASTER-FILE THRU DTSBX630 +00584 PROC3000-READ-EXIT UNTIL MASTER-END. CL**3 +00585 DTSBX630 +00586 CL195 +00587 PERFORM PROC0100-X102-REG THRU PROC0100-EXIT. CL**4 +00588 PERFORM PROC0200-X104-REG THRU PROC0200-EXIT. CL**7 +00589 PERFORM PROC0300-X106-REG THRU PROC0300-EXIT. CL**7 +00590 PERFORM PROC0400-X106A-REG THRU PROC0400-EXIT. CL**7 +00591 PERFORM PROC0500-X108-REG THRU PROC0500-EXIT. CL**7 +00592 PERFORM PROC0600-X110-REG THRU PROC0600-EXIT. CL**7 +00593 PERFORM PROC0700-X110A-REG THRU PROC0700-EXIT. CL**7 +00594 PERFORM PROC0800-X120-REG THRU PROC0800-EXIT. CL**7 +00595 PERFORM PROC0900-X120A-REG THRU PROC0900-EXIT. CL**7 +00596 PERFORM PROC1000-X140-RPT THRU PROC1000-EXIT. CL**7 +00597 PERFORM PROC1100-X144-WGE THRU PROC1100-EXIT. CL**7 +00598 PERFORM PROC1200-X145-PAY THRU PROC1200-EXIT. CL**7 +00599 PERFORM PROC1300-X147-SSN THRU PROC1300-EXIT. CL**7 +00600 PERFORM PROC1400-X998-ACH THRU PROC1400-EXIT. CL**7 +00601 CL161 +00602 PROC2000-UI-EXIT. EXIT. CL**4 +00603 CL**4 +00604 PROC0100-X102-REG. CL**4 +00605 READ X102REG-IN INTO ESSP-FILE-IN CL**4 +00606 AT END CL138 +00607 GO TO PROC0100-CONTINUE. CL**4 +00608 IF ESSP-NAME = '102' CL*10 +00609 ADD 1 TO WS-READ-X102 CL**4 +00610 ELSE CL**4 +00611 DISPLAY '### X102 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**4 +00612 GO TO PROC0100-X102-REG. CL**6 +00613 PROC0100-CONTINUE. CL**4 +00614 IF WS-READ-X102 NOT EQUAL WS-TOTAL-X102-CNT CL**7 +00615 DISPLAY '### X102 COUNTS NOT MATCHING- ESSP SENT ' CL**4 +00616 WS-TOTAL-X102-CNT ' DUTAS RECEIVED ' WS-READ-X102 CL**7 +00617 MOVE 1 TO WS-ABEND-JOB CL**7 +00618 MOVE '### X102 COUNTS NOT MATCHING <<<<< ' TO Z102-MSG CL*23 +00619 ELSE CL**7 +00620 DISPLAY 'TOTAL X102 ESSP SENT ' CL*11 +00621 WS-TOTAL-X102-CNT ' DUTAS RECEIVED ' WS-READ-X102. CL**7 +00622 PROC0100-EXIT. EXIT. CL**4 +00623 CL**4 +00624 PROC0200-X104-REG. CL**7 +00625 READ X104REG-IN INTO ESSP-FILE-IN CL**7 +00626 AT END CL**7 +00627 GO TO PROC0200-CONTINUE. CL**7 +00628 IF ESSP-NAME = '104' CL*10 +00629 ADD 1 TO WS-READ-X104 CL**7 +00630 ELSE CL**7 +00631 DISPLAY '### X104 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00632 GO TO PROC0200-X104-REG. CL**8 +00633 PROC0200-CONTINUE. CL**7 +00634 IF WS-READ-X104 NOT EQUAL WS-TOTAL-X104-CNT CL**7 +00635 DISPLAY '### X104 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00636 WS-TOTAL-X104-CNT ' DUTAS RECEIVED ' WS-READ-X104 CL**7 +00637 MOVE 1 TO WS-ABEND-JOB CL**7 +00638 MOVE '### X104 COUNTS NOT MATCHING <<<<< ' TO Z104-MSG CL*23 +00639 ELSE CL**7 +00640 DISPLAY 'TOTAL X104 ESSP SENT ' CL*11 +00641 WS-TOTAL-X104-CNT ' DUTAS RECEIVED ' WS-READ-X104. CL**7 +00642 PROC0200-EXIT. EXIT. CL**7 +00643 CL**7 +00644 PROC0300-X106-REG. CL**7 +00645 READ X106REG-IN INTO ESSP-FILE-IN CL**7 +00646 AT END CL**7 +00647 GO TO PROC0300-CONTINUE. CL**7 +00648 IF ESSP-NAME = '106' CL*10 +00649 ADD 1 TO WS-READ-X106 CL**7 +00650 ELSE CL**7 +00651 DISPLAY '### X106 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00652 GO TO PROC0300-X106-REG. CL**7 +00653 PROC0300-CONTINUE. CL**7 +00654 IF WS-READ-X106 NOT EQUAL WS-TOTAL-X106-CNT CL**7 +00655 DISPLAY '### X106 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00656 WS-TOTAL-X106-CNT ' DUTAS RECEIVED ' WS-READ-X106 CL**7 +00657 MOVE 1 TO WS-ABEND-JOB CL**7 +00658 MOVE '### X106 COUNTS NOT MATCHING <<<<< ' TO Z106-MSG CL*23 +00659 ELSE CL**7 +00660 DISPLAY 'TOTAL X106 ESSP SENT ' CL*11 +00661 WS-TOTAL-X106-CNT ' DUTAS RECEIVED ' WS-READ-X106. CL**7 +00662 PROC0300-EXIT. EXIT. CL**7 +00663 CL**7 +00664 PROC0400-X106A-REG. CL**7 +00665 READ X106AREG-IN INTO ESSP-FILE-IN CL**7 +00666 AT END CL**7 +00667 GO TO PROC0400-CONTINUE. CL**7 +00668 IF ESSP-NAME = '106' CL*10 +00669 ADD 1 TO WS-READ-X106A CL**7 +00670 ELSE CL**7 +00671 DISPLAY '### X106A RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00672 GO TO PROC0400-X106A-REG. CL**7 +00673 PROC0400-CONTINUE. CL**7 +00674 IF WS-READ-X106A NOT EQUAL WS-TOTAL-X106A-CNT CL**7 +00675 DISPLAY '### X106 UPD COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00676 WS-TOTAL-X106A-CNT ' DUTAS RECEIVED ' WS-READ-X106A CL**7 +00677 MOVE '### X106A COUNTS NOT MATCHING <<<<< ' TO Z106A-MSG CL*21 +00678 MOVE 1 TO WS-ABEND-JOB CL**7 +00679 ELSE CL**7 +00680 DISPLAY 'TOTAL X106A ESSP SENT ' CL**7 +00681 WS-TOTAL-X106A-CNT ' DUTAS RECEIVED ' WS-READ-X106A. CL**7 +00682 PROC0400-EXIT. EXIT. CL**7 +00683 CL**7 +00684 PROC0500-X108-REG. CL**7 +00685 READ X108REG-IN INTO ESSP-FILE-IN CL**7 +00686 AT END CL**7 +00687 GO TO PROC0500-CONTINUE. CL**7 +00688 IF ESSP-NAME = '108' CL*10 +00689 ADD 1 TO WS-READ-X108 CL**7 +00690 ELSE CL**7 +00691 DISPLAY '### X108 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00692 GO TO PROC0500-X108-REG. CL**7 +00693 PROC0500-CONTINUE. CL**7 +00694 IF WS-READ-X108 NOT EQUAL WS-TOTAL-X108-CNT CL**7 +00695 DISPLAY '### X108 UPD COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00696 WS-TOTAL-X108-CNT ' DUTAS RECEIVED ' WS-READ-X108 CL**7 +00697 MOVE 1 TO WS-ABEND-JOB CL**7 +00698 MOVE '### X108 COUNTS NOT MATCHING <<<<< ' TO Z108-MSG CL*21 +00699 ELSE CL**7 +00700 DISPLAY 'TOTAL X108 ESSP SENT ' CL**7 +00701 WS-TOTAL-X108-CNT ' DUTAS RECEIVED ' WS-READ-X108. CL**7 +00702 PROC0500-EXIT. EXIT. CL**7 +00703 CL**7 +00704 PROC0600-X110-REG. CL**7 +00705 READ X110REG-IN INTO ESSP-FILE-IN CL**7 +00706 AT END CL**7 +00707 GO TO PROC0600-CONTINUE. CL**7 +00708 IF ESSP-NAME = '110' CL*10 +00709 ADD 1 TO WS-READ-X110 CL**7 +00710 ELSE CL**7 +00711 DISPLAY '### X110 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00712 GO TO PROC0600-X110-REG. CL**7 +00713 PROC0600-CONTINUE. CL**7 +00714 IF WS-READ-X110 NOT EQUAL WS-TOTAL-X110-CNT CL**7 +00715 DISPLAY '### X110 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00716 WS-TOTAL-X110-CNT ' DUTAS RECEIVED ' WS-READ-X110 CL**7 +00717 MOVE 1 TO WS-ABEND-JOB CL**7 +00718 MOVE '### X110 COUNTS NOT MATCHING <<<<< ' TO Z110-MSG CL*21 +00719 ELSE CL**7 +00720 DISPLAY 'TOTAL X110 ESSP SENT ' CL**7 +00721 WS-TOTAL-X110-CNT ' DUTAS RECEIVED ' WS-READ-X110. CL**7 +00722 PROC0600-EXIT. EXIT. CL**7 +00723 CL**7 +00724 PROC0700-X110A-REG. CL**7 +00725 READ X110AREG-IN INTO ESSP-FILE-IN CL**7 +00726 AT END CL**7 +00727 GO TO PROC0700-CONTINUE. CL**7 +00728 IF ESSP-NAME = '110' CL*10 +00729 ADD 1 TO WS-READ-X110A CL**7 +00730 ELSE CL**7 +00731 DISPLAY '### X110A RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00732 GO TO PROC0700-X110A-REG. CL**7 +00733 PROC0700-CONTINUE. CL**7 +00734 IF WS-READ-X110A NOT EQUAL WS-TOTAL-X110A-CNT CL**7 +00735 DISPLAY '### X110 UPD COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00736 WS-TOTAL-X110A-CNT ' DUTAS RECEIVED ' WS-READ-X110A CL**7 +00737 MOVE 1 TO WS-ABEND-JOB CL**7 +00738 MOVE '### X110A COUNTS NOT MATCHING <<<<< ' TO Z110A-MSG CL*21 +00739 ELSE CL**7 +00740 DISPLAY 'TOTAL X110A ESSP SENT ' CL**7 +00741 WS-TOTAL-X110A-CNT ' DUTAS RECEIVED ' WS-READ-X110A. CL**7 +00742 PROC0700-EXIT. EXIT. CL**7 +00743 CL**7 +00744 PROC0800-X120-REG. CL**7 +00745 READ X120REG-IN INTO ESSP-FILE-IN CL**7 +00746 AT END CL**7 +00747 GO TO PROC0800-CONTINUE. CL**7 +00748 IF ESSP-NAME = '120' CL*10 +00749 ADD 1 TO WS-READ-X120 CL**7 +00750 ELSE CL**7 +00751 DISPLAY '### X120 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00752 GO TO PROC0800-X120-REG. CL**7 +00753 PROC0800-CONTINUE. CL**7 +00754 IF WS-READ-X120 NOT EQUAL WS-TOTAL-X120-CNT CL**7 +00755 DISPLAY '### X120 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00756 WS-TOTAL-X120-CNT ' DUTAS RECEIVED ' WS-READ-X120 CL**7 +00757 MOVE 1 TO WS-ABEND-JOB CL**7 +00758 MOVE '### X120 COUNTS NOT MATCHING <<<<< ' TO Z120-MSG CL*21 +00759 ELSE CL**7 +00760 DISPLAY 'TOTAL X120 ESSP SENT ' CL**7 +00761 WS-TOTAL-X120-CNT ' DUTAS RECEIVED ' WS-READ-X120. CL**7 +00762 PROC0800-EXIT. EXIT. CL**7 +00763 CL**7 +00764 PROC0900-X120A-REG. CL**7 +00765 READ X120AREG-IN INTO ESSP-FILE-IN CL**7 +00766 AT END CL**7 +00767 GO TO PROC0900-CONTINUE. CL**7 +00768 IF ESSP-NAME = '120' CL*10 +00769 ADD 1 TO WS-READ-X120A CL**7 +00770 ELSE CL**7 +00771 DISPLAY '### X120A RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00772 GO TO PROC0900-X120A-REG. CL**7 +00773 PROC0900-CONTINUE. CL**7 +00774 IF WS-READ-X120A NOT EQUAL WS-TOTAL-X120A-CNT CL**7 +00775 DISPLAY '### X120 UPD COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00776 WS-TOTAL-X120A-CNT ' DUTAS RECEIVED ' WS-READ-X120A CL**7 +00777 MOVE 1 TO WS-ABEND-JOB CL**7 +00778 MOVE '### X120A COUNTS NOT MATCHING <<<<< ' TO Z120A-MSG CL*21 +00779 ELSE CL**7 +00780 DISPLAY 'TOTAL X120A ESSP SENT ' CL**7 +00781 WS-TOTAL-X120A-CNT ' DUTAS RECEIVED ' WS-READ-X120A. CL**7 +00782 PROC0900-EXIT. EXIT. CL**7 +00783 CL**7 +00784 PROC1000-X140-RPT. CL**7 +00785 READ X140RPT-IN INTO ESSP-FILE-IN CL**7 +00786 AT END CL**7 +00787 GO TO PROC1000-CONTINUE. CL**7 +00788 IF ESSP-NAME = '140' CL*10 +00789 ADD 1 TO WS-READ-X140 CL**7 +00790 ELSE CL**7 +00791 DISPLAY '### X140 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00792 GO TO PROC1000-X140-RPT. CL**7 +00793 PROC1000-CONTINUE. CL**7 +00794 IF WS-READ-X140 NOT EQUAL WS-TOTAL-X140-CNT CL**7 +00795 DISPLAY '### X140 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00796 WS-TOTAL-X140-CNT ' DUTAS RECEIVED ' WS-READ-X140 CL**7 +00797 MOVE 1 TO WS-ABEND-JOB CL**7 +00798 MOVE '### X140 COUNTS NOT MATCHING <<<<< ' TO Z140-MSG CL*21 +00799 ELSE CL**7 +00800 DISPLAY 'TOTAL X140 ESSP SENT ' CL**7 +00801 WS-TOTAL-X140-CNT ' DUTAS RECEIVED ' WS-READ-X140. CL**7 +00802 PROC1000-EXIT. EXIT. CL**7 +00803 PROC1100-X144-WGE. CL**7 +00804 READ X144WGE-IN INTO ESSP-FILE-IN CL**7 +00805 AT END CL**7 +00806 GO TO PROC1100-CONTINUE. CL**7 +00807 IF ESSP-NAME = '144' CL*10 +00808 ADD 1 TO WS-READ-X144 CL**7 +00809 ELSE CL**7 +00810 DISPLAY '### X144 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00811 GO TO PROC1100-X144-WGE. CL**8 +00812 PROC1100-CONTINUE. CL**7 +00813 IF WS-READ-X144 NOT EQUAL WS-TOTAL-X144-CNT CL**7 +00814 DISPLAY '### X144 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00815 WS-TOTAL-X144-CNT ' DUTAS RECEIVED ' WS-READ-X144 CL**7 +00816 MOVE 1 TO WS-ABEND-JOB CL**7 +00817 MOVE '### X144 COUNTS NOT MATCHING <<<<< ' TO Z144-MSG CL*21 +00818 ELSE CL**7 +00819 DISPLAY 'TOTAL X144 ESSP SENT ' CL**7 +00820 WS-TOTAL-X144-CNT ' DUTAS RECEIVED ' WS-READ-X144. CL**7 +00821 PROC1100-EXIT. EXIT. CL**7 +00822 PROC1200-X145-PAY. CL**7 +00823 READ X145PAY-IN INTO ESSP-FILE-IN CL**7 +00824 AT END CL**7 +00825 GO TO PROC1200-CONTINUE. CL**7 +00826 IF ESSP-NAME = '145' CL*10 +00827 ADD 1 TO WS-READ-X145 CL**7 +00828 ELSE CL**7 +00829 DISPLAY '### X145 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**7 +00830 GO TO PROC1200-X145-PAY. CL**8 +00831 PROC1200-CONTINUE. CL**7 +00832 IF WS-READ-X145 NOT EQUAL WS-TOTAL-X145-CNT CL**7 +00833 DISPLAY '### X145 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00834 WS-TOTAL-X145-CNT ' DUTAS RECEIVED ' WS-READ-X145 CL**7 +00835 MOVE 1 TO WS-ABEND-JOB CL**7 +00836 MOVE '### X145 COUNTS NOT MATCHING <<<<< ' TO Z145-MSG CL*21 +00837 ELSE CL**7 +00838 DISPLAY 'TOTAL X145 ESSP SENT ' CL**7 +00839 WS-TOTAL-X145-CNT ' DUTAS RECEIVED ' WS-READ-X145. CL**7 +00840 PROC1200-EXIT. EXIT. CL**7 +00841 PROC1300-X147-SSN. CL**7 +00842 READ X147SSN-IN INTO ESSP-FILE-IN CL**7 +00843 AT END CL**7 +00844 GO TO PROC1300-CONTINUE. CL**7 +00845 IF ESSP-NAME = '147' CL*10 +00846 ADD 1 TO WS-READ-X147 CL**7 +00847 ELSE CL**7 +00848 DISPLAY '### X147 RECORD HAS OTHER TYPE REC ' ESSP-NAME. CL**8 +00849 GO TO PROC1300-X147-SSN. CL**8 +00850 PROC1300-CONTINUE. CL**7 +00851 IF WS-READ-X147 NOT EQUAL WS-TOTAL-X147-CNT CL**7 +00852 DISPLAY '### X147 COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00853 WS-TOTAL-X147-CNT ' DUTAS RECEIVED ' WS-READ-X147 CL**7 +00854 MOVE 1 TO WS-ABEND-JOB CL**7 +00855 MOVE '### X147 COUNTS NOT MATCHING <<<<< ' TO Z147-MSG CL*21 +00856 ELSE CL**7 +00857 DISPLAY 'TOTAL X147 ESSP SENT ' CL**7 +00858 WS-TOTAL-X147-CNT ' DUTAS RECEIVED ' WS-READ-X147. CL**7 +00859 PROC1300-EXIT. EXIT. CL**7 +00860 PROC1400-X998-ACH. CL**7 +00861 READ X998ACH-IN CL**8 +00862 AT END CL**7 +00863 GO TO PROC1400-CONTINUE. CL**7 +00864 IF X998-TYPE = '6' CL**9 +00865 ADD 1 TO WS-READ-X998. CL*12 +00866 GO TO PROC1400-X998-ACH. CL**7 +00867 PROC1400-CONTINUE. CL**7 +00868 IF WS-READ-X998 NOT EQUAL WS-TOTAL-X998-CNT CL**7 +00869 DISPLAY '### ACH COUNTS NOT MATCHING- ESSP SENT ' CL**7 +00870 WS-TOTAL-X998-CNT ' DUTAS RECEIVED ' WS-READ-X998 CL**7 +00871 MOVE 1 TO WS-ABEND-JOB CL**7 +00872 MOVE '### X998 COUNTS NOT MATCHING <<<<< ' TO Z998-MSG CL*21 +00873 ELSE CL**7 +00874 DISPLAY 'TOTAL XACH ESSP SENT ' CL**7 +00875 WS-TOTAL-X998-CNT ' DUTAS RECEIVED ' WS-READ-X998. CL**7 +00876 PROC1400-EXIT. EXIT. CL**7 +00877 ******************************************************************DTSBX630 +00878 * PROC3000-READ-MASTER-FILE *DTSBX630 +00879 ******************************************************************DTSBX630 +00880 DTSBX630 +00881 PROC3000-READ-MASTER-FILE. DTSBX630 +00882 DTSBX630 +00883 READ X999ESSP-IN CL**3 +00884 AT END DTSBX630 +00885 MOVE 'Y' TO MASTER-END-IND CL*63 +00886 GO TO PROC3000-READ-EXIT. DTSBX630 +00887 DTSBX630 +00888 ADD 1 TO WS-TOTAL-X999-CNT. CL**3 +00889 CL**4 +00890 IF WS-TOTAL-X999-CNT = 1 CL**4 +00891 GO TO PROC3000-READ-EXIT. CL**4 +00892 CL**4 +00893 IF X999-NAME = 'X102' CL*10 +00894 MOVE X999-CNT TO WS-TOTAL-X102-CNT CL**3 +00895 ELSE CL**3 +00896 IF X999-NAME = 'X104' CL*10 +00897 MOVE X999-CNT TO WS-TOTAL-X104-CNT CL**3 +00898 ELSE CL**3 +00899 IF X999-NAME = 'X106' AND X999-TYPE = 0 CL*10 +00900 MOVE X999-CNT TO WS-TOTAL-X106-CNT CL**3 +00901 ELSE CL**3 +00902 IF X999-NAME = 'X106' AND X999-TYPE = 1 CL*10 +00903 MOVE X999-CNT TO WS-TOTAL-X106A-CNT CL**3 +00904 ELSE CL**3 +00905 IF X999-NAME = 'X108' CL*10 +00906 MOVE X999-CNT TO WS-TOTAL-X108-CNT CL**3 +00907 ELSE CL**3 +00908 IF X999-NAME = 'X110' AND X999-TYPE = 0 CL*10 +00909 MOVE X999-CNT TO WS-TOTAL-X110-CNT CL**3 +00910 ELSE CL**3 +00911 IF X999-NAME = 'X110' AND X999-TYPE = 1 CL*10 +00912 MOVE X999-CNT TO WS-TOTAL-X110A-CNT CL**3 +00913 ELSE CL**3 +00914 IF X999-NAME = 'X120' AND X999-TYPE = 0 CL*10 +00915 MOVE X999-CNT TO WS-TOTAL-X120-CNT CL**3 +00916 ELSE CL**3 +00917 IF X999-NAME = 'X120' AND X999-TYPE = 1 CL*10 +00918 MOVE X999-CNT TO WS-TOTAL-X120A-CNT CL**3 +00919 ELSE CL**3 +00920 IF X999-NAME = 'X140' CL*10 +00921 MOVE X999-CNT TO WS-TOTAL-X140-CNT CL**3 +00922 ELSE CL**3 +00923 IF X999-NAME = 'X144' CL*10 +00924 MOVE X999-CNT TO WS-TOTAL-X144-CNT CL**3 +00925 ELSE CL**3 +00926 IF X999-NAME = 'X145' CL*10 +00927 MOVE X999-CNT TO WS-TOTAL-X145-CNT CL**3 +00928 ELSE CL**3 +00929 IF X999-NAME = 'X147' CL*10 +00930 MOVE X999-CNT TO WS-TOTAL-X147-CNT CL**3 +00931 ELSE CL**3 +00932 IF X999-NAME = 'X998' CL*10 +00933 MOVE X999-CNT TO WS-TOTAL-X998-CNT CL**8 +00934 ELSE CL**3 +00935 DISPLAY '*** ERROR UNKNOWN RECORD IN ESSP ' X999-NAME CL**3 +00936 GO TO S999-ABEND. CL**6 +00937 PROC3000-READ-EXIT. DTSBX630 +00938 EXIT. DTSBX630 +00939 DTSBX630 +00940 DTSBX630 +00941 ******************************************************************DTSBX630 +00942 * PROC5000-WRITE-RECORD-PAID *DTSBX630 +00943 ******************************************************************DTSBX630 +00944 DTSBX630 +00945 DTSBX630 +00946 PROC5000-X147-NOT-DELETED. CL*94 +00947 * MOVE X147-SSN TO WS-INPUT-SSN. CL**7 +00948 * MOVE WS-INPUT-SSN1 TO WS-OUT-SSN1. CL245 +00949 * MOVE WS-INPUT-SSN2 TO WS-OUT-SSN2 CL245 +00950 * MOVE WS-INPUT-SSN3 TO WS-OUT-SSN3. CL245 +00951 * MOVE DB-SEQ-9 TO WS-OUT-SEQ. CL245 +00952 * CL245 +00953 * MOVE X147-EMP-NO TO WS-OUT-EMP-NO CL245 +00954 * MOVE X147-QUARTER TO WS-OUT-QUARTER. CL245 +00955 * MOVE X147-FNAME TO WS-OUT-FNAME. CL245 +00956 * MOVE X147-LNAME TO WS-OUT-LNAME. CL245 +00957 * MOVE X147-WAGES TO WS-OUT-WAGES. CL245 +00958 * MOVE 'Y ' TO WS-OUT-X144. CL245 +00959 * MOVE '++ CLAIM FOUND ON DOCS - VERIFY' TO WS-OUT-MESSAGE. CL245 +00960 DTSBX630 +00961 * IF LINE-COUNT GREATER 55 CL*74 +00962 * MOVE ZEROES TO LINE-COUNT CL*74 +00963 ADD 1 TO LINE-COUNT. CL126 +00964 WRITE PRINT-RECORD FROM WS-OUTPUT. CL*92 +00965 PROC5000-EXIT. CL*94 +00966 EXIT. DTSBX630 +00967 DTSBX630 +00968 CL*69 +00969 S001-FROM-CAL-6. CL*55 +00970 SET L001-FROM-CAL-6 TO TRUE. CL*55 +00971 GO TO S001-DATE-CONVERT. CL*55 +00972 CL*55 +00973 S001-FROM-ABS-DAY. CL*55 +00974 SET L001-FROM-ABS-DAY TO TRUE. CL*55 +00975 GO TO S001-DATE-CONVERT. CL*55 +00976 CL*55 +00977 S001-DATE-CONVERT. CL*55 +00978 CALL 'DTSBU001' USING L001-LINK-AREA. CL*55 +00979 S001-EXIT. CL*55 +00980 EXIT. CL*55 +00981 SKIP3 CL*55 +00982 S999-ABEND. CL*55 +00983 DISPLAY '*** ' CL*55 +00984 WRK-MODULE-NAME CL*55 +00985 ' IS ABENDING: ' CL*55 +00986 WRK-ABEND-MSG. CL*55 +00987 CL*55 +00988 CALL 'DTSBU999' USING WRK-ABEND-CD. CL*55 +00989 S999-EXIT. CL*55 +00990 EXIT. CL*55 diff --git a/Batch/DTSBX655.cob b/Batch/DTSBX655.cob new file mode 100644 index 0000000..eb4d196 --- /dev/null +++ b/Batch/DTSBX655.cob @@ -0,0 +1,1447 @@ +00001 IDENTIFICATION DIVISION. 10/02/24 +00002 PROGRAM-ID. DTSBX655. DTSBX655 +00003 AUTHOR. NGUPTA LV238 +00004 DATE-WRITTEN. JAN2017 CL154 +00005 DATE-COMPILED. DTSBX655 +00006 SKIP3 DTSBX655 +00007 ***** DTSBX655 +00008 * DTSBX655 +00009 * FUNCTION: UPDATE MPRF RETURN MAIL FLAG TO Y AND ADD CL217 +00010 * EVENT LOGH. CL217 +00011 * DTSBX655 +00012 ***** DTSBX655 +00013 SKIP3 DTSBX655 +00014 ENVIRONMENT DIVISION. DTSBX655 +00015 SKIP2 DTSBX655 +00016 CONFIGURATION SECTION. DTSBX655 +00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX655 +00018 DTSBX655 +00019 INPUT-OUTPUT SECTION. DTSBX655 +00020 DTSBX655 +00021 FILE-CONTROL. DTSBX655 +00022 SELECT EMP-FILE1 ASSIGN TO EMPFILE1 CL122 +00023 FILE STATUS IS EXP-STATUS. DTSBX655 +00024 DTSBX655 +00025 CL*71 +00026 DATA DIVISION. DTSBX655 +00027 DTSBX655 +00028 FILE SECTION. DTSBX655 +00029 DTSBX655 +00030 FD EMP-FILE1 CL122 +00031 RECORDING MODE IS F. DTSBX655 +00032 01 EMP-REC1. CL122 +00033 * 05 FILLER PIC X(215). CL233 +00034 05 INEMP-NO PIC 9(06). CL217 +00035 05 FILLER PIC X(74). CL233 +00036 * 05 FILLER PIC X(331). CL233 +00037 EJECT DTSBX655 +00038 DTSBX655 +00039 CL*71 +00040 WORKING-STORAGE SECTION. DTSBX655 +000405 77 PAN-VALET PICTURE X(24) VALUE '238DTSBX655 10/02/24'. DTSBX655 +00041 SKIP3 DTSBX655 +00042 01 WRK-AREA. DTSBX655 +00043 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSBX655 +00044 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL211 +00045 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +1000. CL211 +00046 DTSBX655 +00047 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'.DTSBX655 +00048 DTSBX655 +00049 ** 05 WRK-RPT-DATE PIC S9(09) COMP-3 DTSBX655 +00050 * VALUE +20070328. DTSBX655 +00051 * 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX655 +00052 ** VALUE +20061. DTSBX655 +00053 05 WRK-RPT-DATE PIC S9(09) COMP-3 DTSBX655 +00054 VALUE +20170124. CL154 +00055 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX655 +00056 VALUE +0. DTSBX655 +00057 05 WRK-MPRF-REC-CNT PIC S9(07) COMP-3. CL192 +00058 05 WRK-RATE-TYPE-AREA. DTSBX655 +00059 10 WRK-RATE-YR-SCHED PIC X(01). DTSBX655 +00060 88 WRK-RATE-YR-ANN-88 VALUE 'Y'. DTSBX655 +00061 10 WRK-RATE-YR-MINUS-1-SCHED PIC X(01). DTSBX655 +00062 88 WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'. DTSBX655 +00063 10 WRK-RATE-YR-MINUS-2-SCHED PIC X(01). DTSBX655 +00064 88 WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'. DTSBX655 +00065 05 FILLER REDEFINES WRK-RATE-TYPE-AREA PIC X(03). DTSBX655 +00066 88 WRK-ESTIMATE-NEEDED-88 VALUE 'YYY' 'NYY'. DTSBX655 +00067 88 WRK-TRANSITION-YEAR-88 VALUE 'YYN' 'NYN'. DTSBX655 +00068 88 WRK-INIT-VALUES-88 VALUE 'NNN'. DTSBX655 +00069 DTSBX655 +00070 05 WRK-CLASSIFIED-IND PIC X(01). DTSBX655 +00071 88 WRK-CLASSIFIED-YES-88 VALUE 'Y'. DTSBX655 +00072 88 WRK-CLASSIFIED-NO-88 VALUE 'N'. DTSBX655 +00073 05 WRK-EXIT-LOOP-IND PIC X(01). DTSBX655 +00074 88 WRK-EXIT-LOOP-YES-88 VALUE 'Y'. DTSBX655 +00075 88 WRK-EXIT-LOOP-NO-88 VALUE 'N'. DTSBX655 +00076 05 WRK-BATCH PIC S9(05) COMP-3. DTSBX655 +00077 05 WRK-ITEM PIC S9(03) COMP-3. DTSBX655 +00078 05 WRK-SEQ PIC 9(05) DTSBX655 +00079 VALUE ZERO. DTSBX655 +00080 05 WRK-UCFE-FEIN PIC 9(09) DTSBX655 +00081 VALUE 000000000. DTSBX655 +00082 05 WRK-UCX-FEIN PIC 9(09) DTSBX655 +00083 VALUE 330000000. DTSBX655 +00084 05 WRK-CWC-FEIN PIC 9(09) DTSBX655 +00085 VALUE 440000000. DTSBX655 +00086 05 WRK-FED-EMP PIC 9(06). DTSBX655 +00087 05 FILLER REDEFINES WRK-FED-EMP. DTSBX655 +00088 10 FILLER PIC X(02). DTSBX655 +00089 10 WRK-FED-EMP-3 PIC X(01). DTSBX655 +00090 88 WRK-FED-EMP-BYPASS-88 VALUE '1'. DTSBX655 +00091 10 FILLER PIC 9(03). DTSBX655 +00092 05 WRK-ZIP PIC X(10). DTSBX655 +00093 05 FILLER REDEFINES WRK-ZIP. DTSBX655 +00094 10 WRK-ZIP5 PIC X(05). DTSBX655 +00095 10 FILLER PIC X(05). DTSBX655 +00096 DTSBX655 +00097 05 WS-EMP-NO1 PIC X(06). CL159 +00098 05 EXP-STATUS PIC X(02). DTSBX655 +00099 88 EXP-STATUS-OK-88 VALUE '00'. DTSBX655 +00100 05 EXP2-STATUS PIC X(02). CL*71 +00101 88 EXP2-STATUS-OK-88 VALUE '00'. CL*71 +00102 05 WRK-ERROR-IND PIC X(01). DTSBX655 +00103 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX655 +00104 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX655 +00105 05 WRK-WRITE-REC-IND PIC X(01). DTSBX655 +00106 88 WRK-WRITE-REC-YES-88 VALUE 'Y'. DTSBX655 +00107 88 WRK-WRITE-REC-NO-88 VALUE 'N'. DTSBX655 +00108 05 WRK-OP-ID PIC X(08). DTSBX655 +00109 05 WRK-ASSIGN PIC 9(09). DTSBX655 +00110 05 FILLER REDEFINES WRK-ASSIGN. DTSBX655 +00111 10 WRK-ASSIGN-CC PIC 9(02). DTSBX655 +00112 10 WRK-ASSIGN-YY PIC 9(02). DTSBX655 +00113 10 WRK-ASSIGN-NBR PIC 9(05). DTSBX655 +00114 05 WRK-FLD-ASSIGN. DTSBX655 +00115 10 WRK-FLD-ASSIGN-YEAR PIC 9(02). DTSBX655 +00116 10 FILLER PIC X(01) VALUE SPACE. DTSBX655 +00117 10 WRK-FLD-ASSIGN-NBR PIC 9(05). DTSBX655 +00118 05 WRK-LIEN PIC 9(08). CL*25 +00119 05 WRK-LIEN-X REDEFINES WRK-LIEN. CL*25 +00120 10 FILLER PIC X(02). CL*26 +00121 10 WRK-LIEN6 PIC X(06). CL*25 +00122 05 WRK-LIEN-REF. CL*23 +00123 10 WRK-LIEN-YR PIC 9(02). CL*23 +00124 10 WRK-LIEN-NBR PIC 9(04). CL*23 +00125 DTSBX655 +00126 05 WRK-IND-CODE PIC X(06). DTSBX655 +00127 05 WRK-REC1. DTSBX655 +00128 10 REC1-EMP-NO PIC 999999. DTSBX655 +00129 10 FILLER PIC X(01) VALUE ';'. DTSBX655 +00130 ** 10 REC1-NAME PIC X(32). CL100 +00131 ** 10 REC1-EARLY-LIAB-DT PIC X(32). CL110 +00132 10 REC1-EARLY-LIAB-DT PIC X(10). CL110 +00133 10 FILLER PIC X(01) VALUE ';'. CL*82 +00134 ** 10 REC1-YRQ2 PIC X(06). CL100 +00135 ** 10 FILLER PIC X(01) VALUE ';'. CL100 +00136 10 REC1-FIRS-DATE PIC X(10). CL100 +00137 10 FILLER PIC X(01) VALUE ';'. CL*88 +00138 10 REC1-PRIOR PIC 9.9999. CL100 +00139 10 FILLER PIC X(01) VALUE ';'. CL*95 +00140 10 REC1-CURR PIC 9.9999. CL100 +00141 10 FILLER PIC X(01) VALUE ';'. CL*98 +00142 CL*75 +00143 05 WRK-REC1-OLD. CL*15 +00144 10 REC1-ESTB-DATE PIC X(10). CL*98 +00145 10 REC1-LIEN-NO PIC 9(08). CL*98 +00146 10 REC1-STATUS PIC X(01). CL*98 +00147 10 REC1-SOURCE PIC X(02). CL*88 +00148 10 REC1-YRQ PIC X(06). CL*85 +00149 10 REC1-OP-ID PIC X(08). CL*75 +00150 10 REC1-STATUS-OP-ID PIC X(08). CL*75 +00151 10 REC1-STMT-DATE PIC X(10). CL*95 +00152 10 REC1-STATUS-DATE PIC X(10). CL*75 +00153 10 REC1-BALANCE PIC --------9.99. CL*75 +00154 10 REC1-FREQUENCY PIC X(01). CL*75 +00155 10 REC1-START-DATE PIC X(10). CL*75 +00156 10 REC1-TAX-DUE PIC --------9.99. CL*75 +00157 10 REC1-DATA-ELEMENT PIC X(40). CL*68 +00158 10 REC1-PRE-MOD-VALUE PIC X(40). CL*68 +00159 10 REC1-POST-MOD-VALUE PIC X(40). CL*68 +00160 10 REC1-MLOG-DATE PIC X(10). CL*68 +00161 10 REC1-EMP-NAME PIC X(40). CL*68 +00162 10 REC1-CURR-RESERVE PIC --------9.99. CL*59 +00163 10 REC1-ATTN PIC X(40). CL*57 +00164 10 REC1-STREET2 PIC X(40). CL*57 +00165 10 REC1-STREET1 PIC X(40). CL*57 +00166 10 REC1-CITY PIC X(25). CL*57 +00167 10 REC1-STATE PIC X(02). CL*57 +00168 10 REC1-ZIP PIC X(10). CL*57 +00169 10 REC1-PHONE PIC X(15). CL*57 +00170 10 REC1-FAX PIC X(15). CL*57 +00171 10 REC1-EMAIL PIC X(40). CL*57 +00172 10 REC1-ASSIGN PIC X(08). CL*51 +00173 10 REC1-ASSIGN-TYPE PIC X(02). CL*51 +00174 10 REC1-PROCESS-DATE PIC X(10). CL*51 +00175 10 REC1-COMP-DATE PIC X(10). CL*51 +00176 10 REC1-FLD-REP-ID PIC X(02). CL*46 +00177 10 REC1-INACT-OPID PIC X(08). CL*43 +00178 10 REC1-INACT-ENTER-DT PIC X(10). CL*38 +00179 10 REC1-OPO-NAME PIC X(32). CL*27 +00180 10 REC1-ELIG-CD PIC 9(03). CL*17 +00181 10 REC1-FEIN PIC 9(09). DTSBX655 +00182 10 REC1-COUNT PIC 9(07). DTSBX655 +00183 10 REC1-CLASS PIC X(02). DTSBX655 +00184 10 REC1-MLIN-STATUS PIC X(01). DTSBX655 +00185 10 REC1-BATCH PIC 9(05). DTSBX655 +00186 10 REC1-ITEM PIC 9(03). DTSBX655 +00187 10 REC1-RPTS-DUE PIC 999. DTSBX655 +00188 10 REC1-COMPLETE-DATE PIC X(10). DTSBX655 +00189 10 REC1-PAY-TYPE PIC X(02). DTSBX655 +00190 10 REC1-TAX-PAID PIC --------9.99. DTSBX655 +00191 10 REC1-DEPOSIT-DATE PIC X(10). DTSBX655 +00192 10 REC1-NAICS PIC X(06). DTSBX655 +00193 10 REC1-SIC PIC X(04). DTSBX655 +00194 10 REC1-YEAR PIC 9(04). DTSBX655 +00195 10 REC1-AMT PIC ----------9.99. DTSBX655 +00196 10 REC1-OPO-SSN PIC X(09). DTSBX655 +00197 10 REC1-PRIOR-RESERVE PIC --------9.99. DTSBX655 +00198 10 REC1-INTEREST PIC --------9.99. DTSBX655 +00199 10 REC1-BEN-CHG PIC --------9.99. DTSBX655 +00200 10 REC1-AVG-TAX-WAGE PIC --------9.99. DTSBX655 +00201 10 REC1-RATE-PCT PIC 9.9. DTSBX655 +00202 10 REC1-DUE-DATE PIC X(10). DTSBX655 +00203 10 REC1-INACT-YRQ PIC X(06). DTSBX655 +00204 10 REC1-RCVD-DATE PIC X(10). DTSBX655 +00205 10 REC1-TOT-WAGE PIC ----------9.99. DTSBX655 +00206 10 REC1-SUR-BAL PIC ----------9.99. DTSBX655 +00207 10 REC1-LP-BAL PIC ----------9.99. DTSBX655 +00208 10 REC1-INT-BAL PIC ----------9.99. DTSBX655 +00209 10 REC1-SEQ PIC 999999. DTSBX655 +00210 10 REC1-PRED PIC 999999. DTSBX655 +00211 10 REC1-REL-CD PIC X(02). DTSBX655 +00212 10 REC1-TRAN PIC X(02). DTSBX655 +00213 10 REC1-CREDIT PIC --------9.99. DTSBX655 +00214 10 REC1-ACCOUNT PIC X(02). DTSBX655 +00215 10 REC1-NEW-RATE PIC 9.9999. DTSBX655 +00216 10 REC1-EMP-TYPE PIC X(05). DTSBX655 +00217 10 REC1-CHG PIC --------9.99. DTSBX655 +00218 10 REC1-DESC PIC X(40). DTSBX655 +00219 10 REC1-LIAB-QTRS PIC 999. DTSBX655 +00220 10 REC1-ORG-TYPE PIC X(03). DTSBX655 +00221 10 REC1-LIAB-CD PIC X(02). DTSBX655 +00222 10 REC1-LP-CHG PIC --------9.99. DTSBX655 +00223 10 REC1-INT-CHG PIC --------9.99. DTSBX655 +00224 10 REC1-IND-CODE PIC X(06). DTSBX655 +00225 10 REC1-LIAB-ENTER-DATE PIC X(10). DTSBX655 +00226 10 REC1-INACT-CODE PIC X(05). DTSBX655 +00227 88 REC1-INACT-YES-88 VALUE 'INACT'. DTSBX655 +00228 88 REC1-INACT-NO-88 VALUE 'ACT '. DTSBX655 +00229 10 REC1-REACT PIC X(05). DTSBX655 +00230 88 REC1-REACT-NO-88 VALUE 'NEW '. DTSBX655 +00231 88 REC1-REACT-YES-88 VALUE 'REACT'. DTSBX655 +00232 10 REC1-AREA PIC X(03). DTSBX655 +00233 10 REC1-PFX PIC X(03). DTSBX655 +00234 10 REC1-SFX PIC X(04). DTSBX655 +00235 10 REC1-EXT PIC X(05). DTSBX655 +00236 10 REC1-INT-CHARGE-IND PIC X(01). CL*84 +00237 88 REC1-INT-CHARGE-MANUAL-88 VALUE 'M'. CL*84 +00238 88 REC1-INT-CHARGE-AUTO-88 VALUE 'A'. CL*84 +00239 10 FILLER PIC X(01) VALUE ';'. CL*84 +00240 10 REC1-INT-START-DATE1 PIC X(10). CL*84 +00241 10 FILLER PIC X(01) VALUE ';'. CL*84 +00242 10 REC1-INT-END-DATE1 PIC X(10). CL*84 +00243 10 FILLER PIC X(01) VALUE ';'. CL*84 +00244 10 REC1-INT-RATE1 PIC 9.9999. CL*84 +00245 10 FILLER PIC X(01) VALUE ';'. CL*84 +00246 10 REC1-INT-START-DATE2 PIC X(10). CL*84 +00247 10 FILLER PIC X(01) VALUE ';'. CL*84 +00248 10 REC1-INT-END-DATE2 PIC X(10). CL*84 +00249 10 FILLER PIC X(01) VALUE ';'. CL*84 +00250 10 REC1-INT-RATE2 PIC 9.9999. CL*84 +00251 10 FILLER PIC X(01) VALUE ';'. CL*84 +00252 10 REC1-WAIVE-INT-START-DATE PIC X(10). CL*84 +00253 10 FILLER PIC X(01) VALUE ';'. CL*84 +00254 10 REC1-WAIVE-INT-END-DATE PIC X(10). CL*84 +00255 CL*71 +00256 05 WRK-REC2. CL*71 +00257 10 REC2-EMP-NO PIC 999999. CL*71 +00258 10 FILLER PIC X(01) VALUE ';'. CL*71 +00259 10 REC2-ESTB-DATE PIC X(10). CL*71 +00260 10 FILLER PIC X(01) VALUE ';'. CL*71 +00261 10 REC2-QTR PIC X(06). CL*71 +00262 CL*71 +00263 05 WRK-ABS-QTR1 PIC S9(04) COMP-3 DTSBX655 +00264 VALUE +0. DTSBX655 +00265 05 WRK-ABS-QTR2 PIC S9(04) COMP-3 DTSBX655 +00266 VALUE +0. DTSBX655 +00267 05 WRK-ABS-DATE1 PIC S9(08) COMP. DTSBX655 +00268 05 WRK-ABS-DATE2 PIC S9(08) COMP. DTSBX655 +00269 05 WRK-DIFF PIC S9(07) COMP-3. DTSBX655 +00270 05 WRK-UNDER-30-CNT PIC S9(04) COMP-3 DTSBX655 +00271 VALUE +0. DTSBX655 +00272 05 WRK-OVER-31-CNT PIC S9(04) COMP-3 DTSBX655 +00273 VALUE +0. DTSBX655 +00274 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSBX655 +00275 05 WRK-FISCAL-AGENT-CD PIC X(03). DTSBX655 +00276 05 WRK-BNK-IND PIC X(02). DTSBX655 +00277 05 WRK-FIRST-NEW-EMP-NO PIC S9(07) COMP-3. DTSBX655 +00278 *& VALUE +123778. DTSBX655 +00279 05 WRK-FEIN PIC 9(09). DTSBX655 +00280 05 WRK-MQTR-BAL PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 +00281 05 WRK-MQTR-BAL1 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 +00282 05 WRK-MQTR-BAL2 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 +00283 05 WRK-MQTR-BAL3 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 +00284 05 WRK-RESERVE PIC S9(09)V99 COMP-3. DTSBX655 +00285 05 WRK-MQTR-CHG PIC S9(09)V99 COMP-3. DTSBX655 +00286 05 WRK-MQTR-ANN-BAL PIC S9(07)V99 COMP-3. DTSBX655 +00287 05 WRK-MQTR-PEN-BAL PIC S9(07)V99 COMP-3. DTSBX655 +00288 05 WRK-MQTR-PEN-CHG PIC S9(07)V99 COMP-3. DTSBX655 +00289 05 WRK-MQTR-INT-BAL PIC S9(07)V99 COMP-3. DTSBX655 +00290 05 WRK-MQTR-INT-CHG PIC S9(07)V99 COMP-3. DTSBX655 +00291 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3 CL*91 +00292 VALUE +0. CL*91 +00293 05 WRK-RPT-BAL-CNT PIC S9(07) COMP-3. DTSBX655 +00294 05 WRK-RPT-CNT PIC S9(07) COMP-3. DTSBX655 +00295 05 WRK-BAL-CNT PIC S9(07) COMP-3. DTSBX655 +00296 05 WRK-REL-CNT PIC S9(07) COMP-3. DTSBX655 +00297 05 WRK-RATED-CNT PIC S9(07) COMP-3. DTSBX655 +00298 05 WRK-SELF-INS-CNT PIC S9(07) COMP-3. DTSBX655 +00299 05 WRK-HOTEL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX655 +00300 05 WRK-TOT-EMPS PIC S9(07) COMP-3 VALUE +0. DTSBX655 +00301 05 WRK-TOT-WORKERS PIC S9(11) COMP-3 VALUE +0. DTSBX655 +00302 05 WRK-PURSUED-RPT-CNT PIC S9(07) COMP-3. DTSBX655 +00303 05 WRK-LATE-RPT-CNT PIC S9(07) COMP-3. DTSBX655 +00304 05 WRK-MEVL-REWRITE-CNT PIC S9(03) COMP-3 VALUE 0. CL141 +00305 05 WRK-MEVL-DELETED-CNT PIC S9(03) COMP-3 VALUE 0. CL141 +00306 05 WRK-MEVL-FOUND-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00307 05 WRK-MQTR-UPDATED-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00308 05 WRK-MQTR-FOUND-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00309 05 MPRF-REC-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00310 05 MPRF-WRK-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00311 05 IN-REC-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00312 05 WRK-UC30-SENT-CNT PIC S9(07) COMP-3. DTSBX655 +00313 05 WRK-UC30-RCVD-CNT PIC S9(07) COMP-3. DTSBX655 +00314 05 WRK-OVER-1000-CNT PIC S9(07) COMP-3. DTSBX655 +00315 05 WRK-UNDER-1000-CNT PIC S9(07) COMP-3. DTSBX655 +00316 05 WRK-HOUSEHOLD-PAYMENTS PIC S9(11)V99 COMP-3. DTSBX655 +00317 05 WRK-TOT-WAGES PIC S9(11)V99 COMP-3. DTSBX655 +00318 05 WRK-ALL-BNK-RATED PIC S9(11)V99 COMP-3. DTSBX655 +00319 05 WRK-OPN-BNK-RATED PIC S9(11)V99 COMP-3. DTSBX655 +00320 05 WRK-ALL-BNK-SI PIC S9(11)V99 COMP-3. DTSBX655 +00321 05 WRK-OPN-BNK-SI PIC S9(11)V99 COMP-3. DTSBX655 +00322 05 WRK-BOND-AMT PIC S9(11)V99 COMP-3. DTSBX655 +00323 05 WRK-OVER-100-CNT PIC S9(07) COMP-3 DTSBX655 +00324 VALUE +0. DTSBX655 +00325 05 WRK-OVER-100-AMT PIC S9(11)V99 COMP-3 DTSBX655 +00326 VALUE +0. DTSBX655 +00327 05 WRK-1-10-CNT PIC S9(07) COMP-3 DTSBX655 +00328 VALUE +0. DTSBX655 +00329 05 WRK-1-10-AMT PIC S9(11)V99 COMP-3 DTSBX655 +00330 VALUE +0. DTSBX655 +00331 05 WRK-11-100-CNT PIC S9(07) COMP-3 DTSBX655 +00332 VALUE +0. DTSBX655 +00333 05 WRK-11-100-AMT PIC S9(11)V99 COMP-3 DTSBX655 +00334 VALUE +0. DTSBX655 +00335 05 WRK-OVER-100-WRKRS PIC S9(07) COMP-3. DTSBX655 +00336 05 WRK-100-249-CNT PIC S9(07) COMP-3. DTSBX655 +00337 05 WRK-100-249-WRKRS PIC S9(07) COMP-3. DTSBX655 +00338 05 WRK-50-100-CNT PIC S9(07) COMP-3. DTSBX655 +00339 05 WRK-50-100-WRKRS PIC S9(07) COMP-3. DTSBX655 +00340 05 WRK-25-49-CNT PIC S9(07) COMP-3. DTSBX655 +00341 05 WRK-25-49-WRKRS PIC S9(07) COMP-3. DTSBX655 +00342 05 WRK-10-24-CNT PIC S9(07) COMP-3. DTSBX655 +00343 05 WRK-10-24-WRKRS PIC S9(07) COMP-3. DTSBX655 +00344 05 WRK-6-9-CNT PIC S9(07) COMP-3. DTSBX655 +00345 05 WRK-5-9-WRKRS PIC S9(07) COMP-3. DTSBX655 +00346 05 WRK-5-CNT PIC S9(07) COMP-3. DTSBX655 +00347 05 WRK-4-CNT PIC S9(07) COMP-3. DTSBX655 +00348 05 WRK-3-CNT PIC S9(07) COMP-3. DTSBX655 +00349 05 WRK-2-CNT PIC S9(07) COMP-3. DTSBX655 +00350 05 WRK-1-CNT PIC S9(07) COMP-3. DTSBX655 +00351 05 WRK-UNDER-5-CNT PIC S9(07) COMP-3. DTSBX655 +00352 05 WRK-UNDER-5-WRKRS PIC S9(07) COMP-3. DTSBX655 +00353 05 WRK-UNDER-10-CNT PIC S9(07) COMP-3. DTSBX655 +00354 05 WRK-OVER-10-CNT PIC S9(07) COMP-3. DTSBX655 +00355 05 WRK-UNDER-10-WRKRS PIC S9(07) COMP-3. DTSBX655 +00356 05 WRK-NO-EMPS-CNT PIC S9(07) COMP-3. DTSBX655 +00357 05 WRK-MRCT-TOT-WAGES PIC S9(11)V99 COMP-3. DTSBX655 +00358 05 WRK-MRCT-TAX-WAGES PIC S9(11)V99 COMP-3. DTSBX655 +00359 05 WRK-MRCT-UI-PAID PIC S9(11)V99 COMP-3. DTSBX655 +00360 05 WRK-TOT-UI PIC S9(11)V99 COMP-3. DTSBX655 +00361 05 WRK-TOT-INT PIC S9(11)V99 COMP-3. DTSBX655 +00362 05 WRK-TOT-PEN PIC S9(11)V99 COMP-3. DTSBX655 +00363 05 WRK-MQTR-ANN-TOT-WAGE PIC S9(12)V99 COMP-3. DTSBX655 +00364 05 WRK-MQTR-ANN-TAX-WAGE PIC S9(12)V99 COMP-3. DTSBX655 +00365 05 WRK-MJRN-TOT-NEG-CHG PIC S9(11)V99 COMP-3 DTSBX655 +00366 VALUE +0. DTSBX655 +00367 05 WRK-MQTR-TOT-UI-CHARGED PIC S9(11)V99 COMP-3. DTSBX655 +00368 05 WRK-START-DATE PIC S9(09) COMP-3. DTSBX655 +00369 05 WRK-END-DATE PIC S9(09) COMP-3. DTSBX655 +00370 05 WRK-LIAB-DATE PIC S9(09) COMP-3. DTSBX655 +00371 05 WRK-FIRST-LIAB-DATE PIC S9(09) COMP-3. DTSBX655 +00372 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBX655 +00373 VALUE +999999999. DTSBX655 +00374 CL104 +00375 05 WRK-UI-RATE-CATEGORY PIC X(01). CL104 +00376 88 WRK-CLASSIFIED-88 VALUE 'C'. CL104 +00377 88 WRK-NONCLASSIFIED-88 VALUE 'N'. CL104 +00378 CL104 +00379 CL104 +00380 05 WRK-BNK-PETITION-DATE PIC 9(08). DTSBX655 +00381 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. DTSBX655 +00382 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). DTSBX655 +00383 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). DTSBX655 +00384 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). DTSBX655 +00385 05 WRK-BNK-PETITION-YRQ PIC 9(05). DTSBX655 +00386 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. DTSBX655 +00387 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). DTSBX655 +00388 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). DTSBX655 +00389 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. DTSBX655 +00390 05 WRK-EST-RPT-IND PIC X(01). DTSBX655 +00391 88 WRK-EST-RPT-YES VALUE 'Y'. DTSBX655 +00392 88 WRK-EST-RPT-NO VALUE 'N'. DTSBX655 +00393 DTSBX655 +00394 05 WRK-ZERO-FOUND-IND PIC X(01). DTSBX655 +00395 88 WRK-ZERO-FOUND-YES-88 VALUE 'Y'. DTSBX655 +00396 88 WRK-ZERO-FOUND-NO-88 VALUE 'N'. DTSBX655 +00397 DTSBX655 +00398 05 WRK-WITHDRAWN-IND PIC X(01). DTSBX655 +00399 88 WRK-WITHDRAWN-YES VALUE 'Y'. DTSBX655 +00400 88 WRK-WITHDRAWN-NO VALUE 'N'. DTSBX655 +00401 DTSBX655 +00402 05 WRK-ORIG-IND PIC X(01). DTSBX655 +00403 88 WRK-ORIG-YES VALUE 'Y'. DTSBX655 +00404 88 WRK-ORIG-NO VALUE 'N'. DTSBX655 +00405 DTSBX655 +00406 05 WRK-MQTR-CNT PIC S9(07) COMP-3. DTSBX655 +00407 05 WRK-MRPT-CNT PIC S9(07) COMP-3. DTSBX655 +00408 05 WRK-MSOL-CNT PIC S9(07) COMP-3. DTSBX655 +00409 05 WRK-MLIN-CNT PIC S9(07) COMP-3. DTSBX655 +00410 05 WRK-MFAS-CNT PIC S9(07) COMP-3. DTSBX655 +00411 05 WRK-MFAE-CNT PIC S9(07) COMP-3. DTSBX655 +00412 05 WRK-MPAY-CNT PIC S9(07) COMP-3. DTSBX655 +00413 05 WRK-MADJ-CNT PIC S9(07) COMP-3. DTSBX655 +00414 05 WRK-MJRN-CNT PIC S9(08) COMP-3. DTSBX655 +00415 05 WRK-MERA-CNT PIC S9(08) COMP-3. DTSBX655 +00416 05 WRK-MRTE-CNT PIC S9(08) COMP-3. DTSBX655 +00417 05 WRK-MRTE-CNT1 PIC S9(08) COMP-3. DTSBX655 +00418 05 WRK-MLOG-CNT PIC S9(08) COMP-3. DTSBX655 +00419 05 WRK-MFSC-CNT PIC S9(08) COMP-3 DTSBX655 +00420 VALUE +0. DTSBX655 +00421 05 WRK-CR-TOL-CNT PIC S9(07) COMP-3. DTSBX655 +00422 05 SUB PIC S9(04) COMP. DTSBX655 +00423 05 RPT-SUB PIC S9(04) COMP. DTSBX655 +00424 05 QTR-SUB PIC S9(04) COMP. DTSBX655 +00425 05 WRK-QTR-AREA OCCURS 20 TIMES. DTSBX655 +00426 10 WRK-QTR-YRQ PIC S9(05) COMP-3. DTSBX655 +00427 10 WRK-QTR-CHG PIC S9(09)V99 COMP-3. DTSBX655 +00428 10 WRK-QTR-PAID PIC S9(09)V99 COMP-3. DTSBX655 +00429 10 WRK-QTR-WAIVED PIC S9(09)V99 COMP-3. DTSBX655 +00430 10 WRK-QTR-TOLERATED PIC S9(09)V99 COMP-3. DTSBX655 +00431 05 WRK-JRN-AREA OCCURS 100 TIMES. DTSBX655 +00432 *** 10 WRK-JRN-EMP-NO PIC 9(06). DTSBX655 +00433 *** 10 WRK-JRN-EMP-NAME PIC X(40). DTSBX655 +00434 10 WRK-JRN-RCVD PIC X(10). DTSBX655 +00435 10 WRK-JRN-TRAN PIC X(02). DTSBX655 +00436 10 WRK-JRN-BATCH PIC 9(05). DTSBX655 +00437 10 WRK-JRN-ITEM PIC 9(03). DTSBX655 +00438 10 WRK-JRN-AMT PIC --------9.99. DTSBX655 +00439 05 WRK-TIMELY-PMT-AREA. DTSBX655 +00440 10 WRK-PEN-INT-BAL-CNT PIC S9(07) COMP-3. DTSBX655 +00441 10 WRK-INT-MANUAL-CNT PIC S9(07) COMP-3. DTSBX655 +00442 10 WRK-QTR-TAX-BAL PIC S9(09)V9(02) COMP-3. DTSBX655 +00443 10 WRK-QTR-TAX-CHG PIC S9(09)V9(02) COMP-3. DTSBX655 +00444 10 WRK-QTR-INT-PEN-BAL PIC S9(09)V9(02) COMP-3. DTSBX655 +00445 10 WRK-AVG-PMT PIC S9(09)V9(02) COMP-3. DTSBX655 +00446 10 WRK-TIMELY-PMT PIC S9(09)V9(02) COMP-3. DTSBX655 +00447 10 WRK-OLD-PEN-CHG PIC S9(09)V9(02) COMP-3. DTSBX655 +00448 DTSBX655 +00449 05 WRK-PCT PIC S9(03)V9(04) COMP-3 DTSBX655 +00450 VALUE +0. DTSBX655 +00451 05 WRK-AVG-PCT PIC S9(09)V9(04) COMP-3 DTSBX655 +00452 VALUE +0. DTSBX655 +00453 05 WRK-PCT-DISP PIC Z(02)9.9999. DTSBX655 +00454 05 WRK-PCT-DISP1 PIC Z(02)9.9999. DTSBX655 +00455 05 WRK-UI-RATE PIC S9(01)V9(04) COMP-3. DTSBX655 +00456 05 DISP-UI-RATE1 PIC 9.9(04). DTSBX655 +00457 05 DISP-UI-RATE2 PIC 9.9(04). DTSBX655 +00458 05 AMT-DISP PIC ---,---,--9.99. DTSBX655 +00459 05 AMT-DISP1 PIC Z(11)9.99-. DTSBX655 +00460 05 AMT-DISP2 PIC Z(11)9.99-. DTSBX655 +00461 05 AMT-DISP3 PIC Z(11)9-. DTSBX655 +00462 05 EMP-ACCT-DISP PIC 9(06). DTSBX655 +00463 05 EMP-SUCC-DISP PIC 9(06). DTSBX655 +00464 05 EMP-SUCC-DISP-X REDEFINES EMP-SUCC-DISP DTSBX655 +00465 PIC X(06). DTSBX655 +00466 05 DISP-DATE1 PIC X(10). DTSBX655 +00467 05 DISP-DATE2 PIC X(10). DTSBX655 +00468 05 INACT-LBL PIC X(10). DTSBX655 +00469 05 WRK-MPRF-IND PIC X(01). DTSBX655 +00470 88 WRK-MPRF-OK VALUE 'Y'. DTSBX655 +00471 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX655 +00472 05 WRK-MQTR-IND PIC X(01). DTSBX655 +00473 88 WRK-MQTR-OK VALUE 'Y'. DTSBX655 +00474 88 WRK-MQTR-NO-REC VALUE 'N'. DTSBX655 +00475 05 WRK-MRPT-IND PIC X(01). DTSBX655 +00476 88 WRK-MRPT-OK VALUE 'Y'. DTSBX655 +00477 88 WRK-MRPT-NO-REC VALUE 'N'. DTSBX655 +00478 05 WRK-MDST-IND PIC X(01). DTSBX655 +00479 88 WRK-MDST-OK VALUE 'Y'. DTSBX655 +00480 88 WRK-MDST-NO-REC VALUE 'N'. DTSBX655 +00481 05 WRK-MEVL-IND PIC X(01). DTSBX655 +00482 88 WRK-MEVL-OK VALUE 'Y'. DTSBX655 +00483 88 WRK-MEVL-NO-REC VALUE 'N'. DTSBX655 +00484 05 WRK-MLIN-IND PIC X(01). DTSBX655 +00485 88 WRK-MLIN-OK VALUE 'Y'. DTSBX655 +00486 88 WRK-MLIN-NO-REC VALUE 'N'. DTSBX655 +00487 05 WRK-MDPC-IND PIC X(01). DTSBX655 +00488 88 WRK-MDPC-OK VALUE 'Y'. DTSBX655 +00489 88 WRK-MDPC-NO-REC VALUE 'N'. DTSBX655 +00490 05 WRK-MFAS-IND PIC X(01). DTSBX655 +00491 88 WRK-MFAS-OK VALUE 'Y'. DTSBX655 +00492 88 WRK-MFAS-NO-REC VALUE 'N'. DTSBX655 +00493 05 WRK-MFAE-IND PIC X(01). DTSBX655 +00494 88 WRK-MFAE-OK VALUE 'Y'. DTSBX655 +00495 88 WRK-MFAE-NO-REC VALUE 'N'. DTSBX655 +00496 05 WRK-MSOL-IND PIC X(01). DTSBX655 +00497 88 WRK-MSOL-OK VALUE 'Y'. DTSBX655 +00498 88 WRK-MSOL-NO-REC VALUE 'N'. DTSBX655 +00499 05 WRK-MLOG-IND PIC X(01). DTSBX655 +00500 88 WRK-MLOG-OK VALUE 'Y'. DTSBX655 +00501 88 WRK-MLOG-NO-REC VALUE 'N'. DTSBX655 +00502 88 WRK-MLOG-COMPLETE VALUE 'C'. DTSBX655 +00503 05 WRK-MRPT-FOUND-IND PIC X(01). DTSBX655 +00504 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSBX655 +00505 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSBX655 +00506 05 WRK-MTAD-FOUND-IND PIC X(01). CL**6 +00507 88 WRK-MTAD-FOUND-YES VALUE 'Y'. CL**6 +00508 88 WRK-MTAD-FOUND-NO VALUE 'N'. CL**6 +00509 05 WRK-CR-TOL-IND PIC X(01). DTSBX655 +00510 88 WRK-CR-TOL-YES VALUE 'Y'. DTSBX655 +00511 88 WRK-CR-TOL-NO VALUE 'N'. DTSBX655 +00512 05 WRK-DUP-FOUND-IND PIC X(01). DTSBX655 +00513 88 WRK-DUP-FOUND-YES VALUE 'Y'. DTSBX655 +00514 88 WRK-DUP-FOUND-NO VALUE 'N'. DTSBX655 +00515 05 WRK-SELECT-IND PIC X(01). DTSBX655 +00516 88 WRK-SELECT-YES-88 VALUE 'Y'. DTSBX655 +00517 88 WRK-SELECT-NO-88 VALUE 'N'. DTSBX655 +00518 05 WRK-LAST-MRPT-TYPE PIC X(02). DTSBX655 +00519 05 WRK-DISP-AREA. DTSBX655 +00520 10 WRK-DISP-STAR PIC X(01). DTSBX655 +00521 10 FILLER PIC X(01) VALUE SPACE. DTSBX655 +00522 10 WRK-DISP-AMT PIC Z(10)9.99-. DTSBX655 +00523 DTSBX655 +00524 05 WRK-INACT-DATE PIC S9(09) COMP-3 DTSBX655 +00525 VALUE +0. DTSBX655 +00526 05 WRK-INACT-CODE PIC X(02). DTSBX655 +00527 05 WRK-INACT-YRQ PIC S9(05) COMP-3 DTSBX655 +00528 VALUE +0. DTSBX655 +00529 05 WRK-LAST-YRQ PIC S9(05) COMP-3 DTSBX655 +00530 VALUE +0. DTSBX655 +00531 05 WRK-FIRST-LIAB-YRQ PIC S9(05) COMP-3 DTSBX655 +00532 VALUE +0. DTSBX655 +00533 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 DTSBX655 +00534 VALUE +0. DTSBX655 +00535 05 WRK-NEXT-YRQ PIC S9(05) COMP-3 DTSBX655 +00536 VALUE +0. DTSBX655 +00537 05 WRK-UPDATED-CNT PIC S9(07) COMP-3. DTSBX655 +00538 DTSBX655 +00539 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBX655 +00540 DTSBX655 +00541 05 PARM-EOF-IND PIC X(01). DTSBX655 +00542 DTSBX655 +00543 05 WRK-EMP-NO PIC 9(06). DTSBX655 +00544 DTSBX655 +00545 05 WRK-TRACE-IND PIC X(01). DTSBX655 +00546 DTSBX655 +00547 05 WRK-MST-OPEN-IND PIC X(01). DTSBX655 +00548 DTSBX655 +00549 05 WRK-REF-OPEN-IND PIC X(01). DTSBX655 +00550 DTSBX655 +00551 05 WRK-SIC-SCAN-AREA. DTSBX655 +00552 10 WRK-RPT-FOUND-IND PIC X(01). DTSBX655 +00553 88 WRK-RPT-FOUND-YES VALUE 'Y'. DTSBX655 +00554 88 WRK-RPT-FOUND-NO VALUE 'N'. DTSBX655 +00555 10 WRK-EMPL-CNT PIC S9(07) COMP-3. DTSBX655 +00556 10 WRK-SIC-4 PIC X(04). DTSBX655 +00557 10 FILLER REDEFINES WRK-SIC-4. DTSBX655 +00558 15 WRK-SIC-3 PIC X(03). DTSBX655 +00559 15 FILLER PIC X(01). DTSBX655 +00560 10 WRK-NO-SIC-CNT PIC S9(07) COMP-3. DTSBX655 +00561 10 WRK-SIC-7911-AREA. DTSBX655 +00562 15 WRK-SIC-7911-WORKERS PIC S9(07) COMP-3. DTSBX655 +00563 15 WRK-SIC-7911-BUSINESSES PIC S9(07) COMP-3. DTSBX655 +00564 10 WRK-SIC-794-AREA. DTSBX655 +00565 15 WRK-SIC-794-WORKERS PIC S9(07) COMP-3. DTSBX655 +00566 15 WRK-SIC-794-BUSINESSES PIC S9(07) COMP-3. DTSBX655 +00567 10 WRK-SIC-799-AREA. DTSBX655 +00568 15 WRK-SIC-799-WORKERS PIC S9(07) COMP-3. DTSBX655 +00569 15 WRK-SIC-799-BUSINESSES PIC S9(07) COMP-3. DTSBX655 +00570 10 WRK-SIC-8351-AREA. DTSBX655 +00571 15 WRK-SIC-8351-WORKERS PIC S9(07) COMP-3. DTSBX655 +00572 15 WRK-SIC-8351-BUSINESSES PIC S9(07) COMP-3. DTSBX655 +00573 10 WRK-SIC-8641-AREA. DTSBX655 +00574 15 WRK-SIC-8641-WORKERS PIC S9(07) COMP-3. DTSBX655 +00575 15 WRK-SIC-8641-BUSINESSES PIC S9(07) COMP-3. DTSBX655 +00576 10 WRK-NAICS-6 PIC X(06). DTSBX655 +00577 10 FILLER REDEFINES WRK-NAICS-6. DTSBX655 +00578 15 WRK-NAICS-2 PIC X(02). DTSBX655 +00579 15 FILLER PIC X(04). DTSBX655 +00580 *RW1 DTSBX655 +00581 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBX655 +00582 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBX655 +00583 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBX655 +00584 DTSBX655 +00585 05 DISP-DATE PIC X(08). DTSBX655 +00586 05 DISP-TIME PIC X(08). DTSBX655 +00587 DTSBX655 +00588 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBX655 +00589 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBX655 +00590 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBX655 +00591 05 WRK-T003-CNT PIC S9(07) COMP-3 VALUE +0. CL184 +00592 DTSBX655 +00593 * 05 EVL-TEXT PIC X(50). CL154 +00594 01 MNT-LOG-AREA. CL183 +00595 10 WRK-MNTE-MSG-LINE1. CL183 +00596 15 FILLER PIC X(53) VALUE CL214 +00597 'AT THE REQUEST OF PROGRAM, ACCT RETURN MAIL FLAG HAS '. CL234 +00598 15 FILLER PIC X(20) VALUE CL217 +00599 'BEEN UPDATED TO "Y" '. CL238 +00600 10 WRK-MNTE-MSG-LINE2. CL183 +00601 15 FILLER PIC X(53) VALUE CL214 +00602 '(BAD ADDRRESS). '. CL238 +00603 15 FILLER PIC X(19) VALUE CL214 +00604 ' '. CL229 +00605 10 WRK-MNTE-MSG-LINE3. CL183 +00606 15 FILLER PIC X(53) VALUE CL214 +00607 ' '. CL229 +00608 15 FILLER PIC X(19) VALUE CL214 +00609 ' '. CL216 +00610 * 'CORRESPONDENCE RESUMED.'. CL198 +00611 * CL190 +00612 01 HEADER-1. DTSBX655 +00613 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 +00614 05 FILLER PIC X(49) VALUE '016R1'. DTSBX655 +00615 05 FILLER PIC X(60) VALUE DTSBX655 +00616 'DISTRICT OF COLUMBIA'. DTSBX655 +00617 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBX655 +00618 05 HDR1-LRCM-SYS-DATE PIC X(08). DTSBX655 +00619 DTSBX655 +00620 01 HEADER-2. DTSBX655 +00621 05 FILLER PIC X(54) VALUE SPACES. DTSBX655 +00622 05 FILLER PIC X(56) VALUE DTSBX655 +00623 'TAX DIVISION'. DTSBX655 +00624 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBX655 +00625 05 HDR2-LRCM-SYS-TIME PIC X(08). DTSBX655 +00626 DTSBX655 +00627 01 HEADER-3. DTSBX655 +00628 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 +00629 05 FILLER PIC X(38) VALUE DTSBX655 +00630 'ROUTE TO: ACCOUNTING UNIT'. DTSBX655 +00631 05 HDR3-LITERAL PIC X(43) VALUE DTSBX655 +00632 ' EMPLOYERS REGISTERED SINCE 09/11/01 '. DTSBX655 +00633 05 FILLER PIC X(28) VALUE SPACES. DTSBX655 +00634 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBX655 +00635 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBX655 +00636 DTSBX655 +00637 01 HEADER-4. DTSBX655 +00638 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 +00639 05 FILLER PIC X(132) VALUE SPACES. DTSBX655 +00640 DTSBX655 +00641 01 HEADER-5. DTSBX655 +00642 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 +00643 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 +00644 05 FILLER PIC X(06) VALUE DTSBX655 +00645 'EMP NO'. DTSBX655 +00646 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 +00647 05 FILLER PIC X(12) VALUE DTSBX655 +00648 'PRIMARY NAME'. DTSBX655 +00649 05 FILLER PIC X(28) VALUE SPACES. DTSBX655 +00650 05 FILLER PIC X(04) VALUE SPACES. DTSBX655 +00651 05 FILLER PIC X(14) VALUE DTSBX655 +00652 'LIABILITY DATE'. DTSBX655 +00653 05 FILLER PIC X(04) VALUE SPACES. DTSBX655 +00654 05 FILLER PIC X(13) VALUE DTSBX655 +00655 'INACTIVE DATE'. DTSBX655 +00656 05 FILLER PIC X(12) VALUE SPACES. DTSBX655 +00657 05 FILLER PIC X(18) VALUE SPACES. DTSBX655 +00658 DTSBX655 +00659 01 HEADER-6. DTSBX655 +00660 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 +00661 05 FILLER PIC X(132) VALUE SPACES. DTSBX655 +00662 DTSBX655 +00663 01 DETAIL-LINE-1. DTSBX655 +00664 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 +00665 05 WS-EMP-NO PIC 999B999. DTSBX655 +00666 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 +00667 05 WS-PRIMARY-NAME PIC X(40). DTSBX655 +00668 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 +00669 05 WS-DATE1 PIC X(10). DTSBX655 +00670 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 +00671 05 WS-DATE2 PIC X(10). DTSBX655 +00672 * 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 +00673 * 05 WS-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBX655 +00674 * 05 FILLER PIC X(09) VALUE SPACES. DTSBX655 +00675 * 05 WS-PURSUED-RPT PIC ZZ9. DTSBX655 +00676 * 05 FILLER PIC X(10) VALUE SPACES. DTSBX655 +00677 * 05 WS-DPC PIC X(01). DTSBX655 +00678 * 05 FILLER PIC X(06) VALUE SPACES. DTSBX655 +00679 * 05 WS-LIEN PIC X(01). DTSBX655 +00680 * 05 FILLER PIC X(21) VALUE SPACES. DTSBX655 +00681 DTSBX655 +00682 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSBX655 +00683 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSBX655 +00684 DTSBX655 +00685 01 FOOTING-LINE-3. DTSBX655 +00686 05 FILLER PIC X(25) VALUE SPACES. DTSBX655 +00687 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSBX655 +00688 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 +00689 05 FILLER PIC X(43) VALUE DTSBX655 +00690 'DEBIT WRITE OFF CANDIDATES LISTED ON REPORT'.DTSBX655 +00691 05 FILLER PIC X(23) VALUE SPACES. DTSBX655 +00692 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. DTSBX655 +00693 01 FOOTING-LINE-5 PIC X(133) VALUE SPACES. DTSBX655 +00694 01 FOOTING-LINE-6. DTSBX655 +00695 05 FILLER PIC X(25) VALUE SPACES. DTSBX655 +00696 05 FILLER PIC X(17) VALUE DTSBX655 +00697 '*** END OF REPORT'. DTSBX655 +00698 *RW2 DTSBX655 +00699 DTSBX655 +00700 01 TSKL-REC. CL183 +00701 ++INCLUDE DTSITSKL CL183 +00702 EJECT CL183 +00703 01 T003-REC. CL183 +00704 ++INCLUDE DTSIT003 CL183 +00705 EJECT CL183 +00706 01 L001-LINK-AREA. DTSBX655 +00707 ++INCLUDE DTSIL001 DTSBX655 +00708 EJECT DTSBX655 +00709 01 L005-LINK-AREA. CL157 +00710 ++INCLUDE DTSIL005 DTSBX655 +00711 EJECT DTSBX655 +00712 01 L331-LINK-AREA. CL209 +00713 ++INCLUDE DTSIL331 CL209 +00714 EJECT DTSBX655 +00715 01 L039-LINK-AREA. CL209 +00716 ++INCLUDE DTSIL039 CL209 +00717 EJECT CL209 +00718 01 L101-LINK-AREA. CL*23 +00719 ++INCLUDE DTSIL101 CL*23 +00720 EJECT DTSBX655 +00721 01 L102-LINK-AREA. CL*23 +00722 ++INCLUDE DTSIL102 CL*23 +00723 EJECT CL*23 +00724 01 L109-LINK-AREA. CL*23 +00725 ++INCLUDE DTSIL109 CL*23 +00726 CL*23 +00727 01 L054-LINK-AREA. DTSBX655 +00728 ++INCLUDE DTSIL054 DTSBX655 +00729 EJECT DTSBX655 +00730 01 L410-LINK-AREA. DTSBX655 +00731 ++INCLUDE DTSIL410 DTSBX655 +00732 EJECT DTSBX655 +00733 01 L600-LINK-AREA. DTSBX655 +00734 ++INCLUDE DTSIL600 DTSBX655 +00735 EJECT DTSBX655 +00736 01 L910-LINK-AREA. DTSBX655 +00737 ++INCLUDE DTSIL910 DTSBX655 +00738 EJECT DTSBX655 +00739 01 MSKL-REC. DTSBX655 +00740 ++INCLUDE DTSIMSKL DTSBX655 +00741 EJECT DTSBX655 +00742 01 MNTE-REC. CL183 +00743 ++INCLUDE DTSIMNTE CL183 +00744 EJECT CL183 +00745 01 MHDR-REC. DTSBX655 +00746 ++INCLUDE DTSIMHDR DTSBX655 +00747 EJECT DTSBX655 +00748 01 MPRF-REC. CL164 +00749 ++INCLUDE DTSIMPRF CL164 +00750 EJECT CL164 +00751 01 MQTR-REC. DTSBX655 +00752 ++INCLUDE DTSIMQTR DTSBX655 +00753 EJECT DTSBX655 +00754 01 MRPT-REC. DTSBX655 +00755 ++INCLUDE DTSIMRPT DTSBX655 +00756 EJECT DTSBX655 +00757 01 MSOL-REC. DTSBX655 +00758 ++INCLUDE DTSIMSOL DTSBX655 +00759 EJECT DTSBX655 +00760 01 MRCT-REC. DTSBX655 +00761 ++INCLUDE DTSIMRCT DTSBX655 +00762 EJECT DTSBX655 +00763 01 MREL-REC. DTSBX655 +00764 ++INCLUDE DTSIMREL DTSBX655 +00765 EJECT DTSBX655 +00766 01 MEVL-REC. DTSBX655 +00767 ++INCLUDE DTSIMEVL DTSBX655 +00768 EJECT DTSBX655 +00769 01 MLIN-REC. DTSBX655 +00770 ++INCLUDE DTSIMLIN DTSBX655 +00771 EJECT DTSBX655 +00772 01 MRTE-REC. DTSBX655 +00773 ++INCLUDE DTSIMRTE DTSBX655 +00774 EJECT DTSBX655 +00775 01 MDST-REC. DTSBX655 +00776 ++INCLUDE DTSIMDST DTSBX655 +00777 EJECT DTSBX655 +00778 01 MPAY-REC. DTSBX655 +00779 ++INCLUDE DTSIMPAY DTSBX655 +00780 EJECT DTSBX655 +00781 01 MADJ-REC. DTSBX655 +00782 ++INCLUDE DTSIMADJ DTSBX655 +00783 EJECT DTSBX655 +00784 01 MJRN-REC. DTSBX655 +00785 ++INCLUDE DTSIMJRN DTSBX655 +00786 EJECT DTSBX655 +00787 01 MERA-REC. DTSBX655 +00788 ++INCLUDE DTSIMERA DTSBX655 +00789 EJECT DTSBX655 +00790 01 MCOL-REC. DTSBX655 +00791 ++INCLUDE DTSIMCOL DTSBX655 +00792 EJECT DTSBX655 +00793 01 MFAS-REC. DTSBX655 +00794 ++INCLUDE DTSIMFAS DTSBX655 +00795 01 MAUR-REC. DTSBX655 +00796 ++INCLUDE DTSIMAUR DTSBX655 +00797 EJECT DTSBX655 +00798 01 MFAE-REC. DTSBX655 +00799 ++INCLUDE DTSIMFAE DTSBX655 +00800 EJECT DTSBX655 +00801 01 MLOG-REC. DTSBX655 +00802 ++INCLUDE DTSIMLOG DTSBX655 +00803 EJECT DTSBX655 +00804 01 MOPO-REC. DTSBX655 +00805 ++INCLUDE DTSIMOPO DTSBX655 +00806 EJECT DTSBX655 +00807 01 MTAD-REC. DTSBX655 +00808 ++INCLUDE DTSIMTAD DTSBX655 +00809 EJECT DTSBX655 +00810 01 MTAA-REC. DTSBX655 +00811 ++INCLUDE DTSIMTAA DTSBX655 +00812 EJECT DTSBX655 +00813 01 MBAA-REC. DTSBX655 +00814 ++INCLUDE DTSIMBAA DTSBX655 +00815 EJECT DTSBX655 +00816 01 MFSC-REC. DTSBX655 +00817 ++INCLUDE DTSIMFSC DTSBX655 +00818 EJECT DTSBX655 +00819 01 MERD-REC. DTSBX655 +00820 ++INCLUDE DTSIMERD DTSBX655 +00821 EJECT DTSBX655 +00822 01 MDPC-REC. DTSBX655 +00823 ++INCLUDE DTSIMDPC DTSBX655 +00824 EJECT DTSBX655 +00825 01 L921-LINK-AREA. DTSBX655 +00826 ++INCLUDE DTSIL921 DTSBX655 +00827 EJECT DTSBX655 +00828 01 ISKL-REC. DTSBX655 +00829 ++INCLUDE DTSIISKL DTSBX655 +00830 EJECT DTSBX655 +00831 01 IPES-REC. DTSBX655 +00832 ++INCLUDE DTSIIPES DTSBX655 +00833 EJECT DTSBX655 +00834 01 L931-LINK-AREA. DTSBX655 +00835 ++INCLUDE DTSIL931 DTSBX655 +00836 EJECT DTSBX655 +00837 01 FSKL-REC. DTSBX655 +00838 ++INCLUDE DTSIFSKL DTSBX655 +00839 EJECT DTSBX655 +00840 01 FQTR-REC. DTSBX655 +00841 ++INCLUDE DTSIFQTR DTSBX655 +00842 EJECT DTSBX655 +00843 01 FFIS-REC. DTSBX655 +00844 ++INCLUDE DTSIFFIS DTSBX655 +00845 EJECT DTSBX655 +00846 01 FFAZ-REC. DTSBX655 +00847 ++INCLUDE DTSIFFAZ DTSBX655 +00848 EJECT DTSBX655 +00849 01 FOPR-REC. DTSBX655 +00850 ++INCLUDE DTSIFOPR DTSBX655 +00851 EJECT DTSBX655 +00852 01 L933-LINK-AREA. DTSBX655 +00853 ++INCLUDE DTSIL933 DTSBX655 +00854 EJECT DTSBX655 +00855 01 XSIC-REC. DTSBX655 +00856 ++INCLUDE DTSIXSIC DTSBX655 +00857 EJECT DTSBX655 +00858 01 L004-COMM-AREA. DTSBX655 +00859 ++INCLUDE DTSIL004 DTSBX655 +00860 DTSBX655 +00861 01 L061-LINK-AREA. DTSBX655 +00862 ++INCLUDE DTSIL061 DTSBX655 +00863 DTSBX655 +00864 01 L062-LINK-AREA. DTSBX655 +00865 ++INCLUDE DTSIL062 DTSBX655 +00866 DTSBX655 +00867 01 L516-LINK-AREA. DTSBX655 +00868 ++INCLUDE DTSIL516 DTSBX655 +00869 EJECT DTSBX655 +00870 01 LBCM-LINK-AREA. CL173 +00871 ++INCLUDE DTSILBCM CL173 +00872 EJECT CL154 +00873 01 L923-LINK-AREA. CL183 +00874 ++INCLUDE DTSIL923 CL183 +00875 EJECT CL183 +00876 01 ASKL-REC. CL183 +00877 ++INCLUDE DTSIASKL CL183 +00878 EJECT CL183 +00879 01 AHDR-REC. CL183 +00880 ++INCLUDE DTSIAHDR CL183 +00881 EJECT CL183 +00882 01 AADJ-REC. CL183 +00883 ++INCLUDE DTSIAADJ CL183 +00884 EJECT CL183 +00885 01 L927-LINK-AREA. CL183 +00886 ++INCLUDE DTSIL927 CL183 +00887 EJECT CL183 +00888 PROCEDURE DIVISION. CL228 +00889 CL164 +00890 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX655 +00891 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX655 +00892 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX655 +00893 SKIP2 DTSBX655 +00894 GOBACK. DTSBX655 +00895 EJECT DTSBX655 +00896 I0000-INITIATE. DTSBX655 +00897 SKIP2 DTSBX655 +00898 MOVE 'N' TO WRK-TRACE-IND. DTSBX655 +00899 SET WRK-ERROR-NO-88 TO TRUE. DTSBX655 +00900 MOVE +0 TO WRK-MPRF-REC-CNT CL193 +00901 DTSBX655 +00902 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBX655 +00903 DTSBX655 +00904 MOVE +0 TO WRK-MPRF-CNT CL120 +00905 WRK-MQTR-CNT CL120 +00906 WRK-MLOG-CNT CL120 +00907 WRK-MEVL-DELETED-CNT. CL120 +00908 CL120 +00909 I0000-EXIT. DTSBX655 +00910 EXIT. DTSBX655 +00911 I2000-OPEN-FILES-1. DTSBX655 +00912 DISPLAY 'UPDATE RETURN FLAG TO Y - BAD ADDRESS FROM NCOA' CL220 +00913 DISPLAY ' '. CL220 +00914 OPEN INPUT EMP-FILE1. CL120 +00915 IF NOT EXP-STATUS-OK-88 DTSBX655 +00916 DISPLAY 'CANNOT OPEN EXP FILE ' EXP-STATUS DTSBX655 +00917 SET WRK-ERROR-YES-88 TO TRUE DTSBX655 +00918 GO TO I2000-EXIT. DTSBX655 +00919 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX655 +00920 DTSBX655 +00921 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX655 +00922 DTSBX655 +00923 * PERFORM S910-OPEN-READ THRU S910-EXIT. CL171 +00924 PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL176 +00925 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. CL189 +00926 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. CL189 +00927 DTSBX655 +00928 * PERFORM S921-OPEN-READ THRU S921-EXIT. CL123 +00929 PERFORM S005-FROM-SYS THRU S005-EXIT. CL187 +00930 DTSBX655 +00931 ** PERFORM S931-OPEN-READ THRU S931-EXIT. CL122 +00932 * PERFORM S931-OPEN-UPDATE THRU S931-EXIT. CL176 +00933 DTSBX655 +00934 MOVE WRK-MOD-NAME TO L933-MOD-NAME. DTSBX655 +00935 DTSBX655 +00936 *** PERFORM S933-OPEN-READ THRU S933-EXIT. DTSBX655 +00937 DTSBX655 +00938 I2000-EXIT. DTSBX655 +00939 EXIT. DTSBX655 +00940 DTSBX655 +00941 P0000-PROCESS. DTSBX655 +00942 * DISPLAY 'IN P0000-PROCESS'. CL220 +00943 READ EMP-FILE1 AT END GO TO P0000-EXIT. CL122 +00944 DTSBX655 +00945 MOVE INEMP-NO TO WS-EMP-NO1. CL196 +00946 ADD 1 TO IN-REC-CNT. CL122 +00947 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL129 +00948 SET MPRF-PRF-88 TO TRUE. CL129 +00949 DTSBX655 +00950 MOVE WS-EMP-NO1 TO MPRF-EMP-NO. CL159 +00951 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL119 +00952 DTSBX655 +00953 PERFORM S910-READ THRU S910-EXIT. DTSBX655 +00954 IF L910-NO-REC-88 CL119 +00955 DISPLAY ' EMP NOT FOUND ' INEMP-NO CL196 +00956 GO TO P0000-PROCESS. CL119 +00957 ADD 1 TO MPRF-REC-CNT. CL122 +00958 MOVE MSKL-REC TO MPRF-REC CL119 +00959 * DISPLAY'MPRF-RETURN-MAIL-FLAG: ' MPRF-EMP-NO CL217 +00960 * ' ' MPRF-RETURN-MAIL-IND. CL217 +00961 * PERFORM P6000-SCAN-EVL THRU P6000-EXIT. CL207 +00962 * GO TO P0000-PROCESS. CL207 +00963 CL204 +00964 * IF MPRF-TOT-CREDIT-AMT < 1 CL231 +00965 * DISPLAY MPRF-EMP-NO ';' CL231 +00966 * ';' MPRF-RETURN-MAIL-IND ';' MPRF-TOT-CREDIT-AMT CL231 +00967 * ELSE CL231 +00968 * DISPLAY MPRF-EMP-NO ';' CL231 +00969 * ';' MPRF-RETURN-MAIL-IND ';' MPRF-TOT-CREDIT-AMT. CL231 +00970 CL226 +00971 * IF MPRF-RETURN-MAIL-NO-88 CL232 +00972 * DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL FLAG = N NCOA = Y '. CL232 +00973 * '---- RTN FLAG NOT UPDATED' CL231 +00974 * GO TO P0000-PROCESS. CL231 +00975 CL227 +00976 PERFORM P6000-SCAN-EVL THRU P6000-EXIT. CL231 +00977 CL231 +00978 IF WRK-MEVL-REWRITE-CNT = 1 CL231 +00979 DISPLAY MEVL-EMP-NO ' MEVL REWRITTEN AFTER NCOA ' CL231 +00980 GO TO P0000-PROCESS. CL231 +00981 CL231 +00982 PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT. CL217 +00983 PERFORM P3000-ADD-MNTE THRU P3000-EXIT CL225 +00984 SET MPRF-RETURN-MAIL-YES-88 TO TRUE CL221 +00985 MOVE L005-DATE TO MPRF-CHNG-DATE CL228 +00986 MOVE MPRF-REC TO MSKL-REC CL228 +00987 PERFORM S910-REWRITE THRU S910-EXIT CL221 +00988 DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL UPDATED; NCOA = Y '. CL232 +00989 ADD +1 TO WRK-MPRF-REC-CNT CL221 +00990 GO TO P0000-PROCESS. CL155 +00991 P0000-EXIT. CL119 +00992 EXIT. DTSBX655 +00993 P1100-CHECK-FOR-MLOG. CL208 +00994 ADD +5000 TO WRK-ABSTIME CL222 +00995 PERFORM S005-FROM-SYS THRU S005-EXIT CL208 +00996 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL208 +00997 MOVE MPRF-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL208 +00998 MOVE L005-DATE TO L331-CURR-RUN-DATE CL212 +00999 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL208 +01000 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL208 +01001 MOVE 'NCOAX655' TO L331-OP-ID CL224 +01002 MOVE 'RETURN MAIL IND' TO L331-FIELD-NAME CL208 +01003 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE CL221 +01004 * MOVE 'N' TO L331-FROM-VALUE CL221 +01005 MOVE 'Y' TO L331-TO-VALUE CL213 +01006 MOVE 'Y' TO MPRF-RETURN-MAIL-IND CL213 +01007 * MOVE +1 TO WRK-MPRF-MAIL-UPD-CNT CL211 +01008 * DISPLAY ' RETURN MAIL UPDATED: ' WRK-EMP-NO CL220 +01009 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL208 +01010 P1100-EXIT. EXIT. CL208 +01011 DTSBX655 +01012 P6000-SCAN-EVL. CL122 +01013 MOVE +0 TO WRK-MEVL-REWRITE-CNT CL231 +01014 SET WRK-MEVL-OK TO TRUE. CL122 +01015 MOVE +0 TO WRK-RECEIVED-DATE. CL122 +01016 MOVE LOW-VALUES TO MEVL-KEY-AREA. CL122 +01017 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL122 +01018 MOVE +0 TO MEVL-DATE. CL122 +01019 SET MEVL-EVL-88 TO TRUE. CL122 +01020 MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA. CL122 +01021 CL122 +01022 PERFORM S910-START-BROWSE THRU S910-EXIT. CL122 +01023 IF L910-NO-REC-88 CL122 +01024 DISPLAY ' EVENT LOG NOT FOUND ' MPRF-EMP-NO CL122 +01025 SET WRK-MEVL-NO-REC TO TRUE CL206 +01026 GO TO P6000-EXIT CL122 +01027 ELSE CL122 +01028 PERFORM P6100-SCAN-MEVL THRU P6100-EXIT CL122 +01029 UNTIL WRK-MEVL-NO-REC. CL122 +01030 CL122 +01031 P6000-EXIT. CL122 +01032 EXIT. CL122 +01033 P6100-SCAN-MEVL. CL122 +01034 MOVE MSKL-REC TO MEVL-REC. DTSBX655 +01035 CL126 +01036 IF MEVL-DATE > 20190527 CL231 +01037 IF MEVL-TEXT (1:20) = 'MPRF-RETURN-MAIL-IND' OR CL200 +01038 MEVL-TEXT (1:15) = 'RETURN MAIL IND' CL200 +01039 MOVE +1 TO WRK-MEVL-REWRITE-CNT CL231 +01040 DISPLAY ' MEVL REWRITTEN ' MEVL-EMP-NO ' ' MEVL-TEXT CL203 +01041 SET WRK-MEVL-NO-REC TO TRUE CL204 +01042 GO TO P6100-EXIT. CL204 +01043 CL204 +01044 P6100-READ-NEXT. CL204 +01045 CL132 +01046 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX655 +01047 IF L910-NO-REC-88 DTSBX655 +01048 SET WRK-MEVL-NO-REC TO TRUE. DTSBX655 +01049 DTSBX655 +01050 P6100-EXIT. DTSBX655 +01051 EXIT. DTSBX655 +01052 DTSBX655 +01053 S6000-WRITE-MEVL. CL154 +01054 MOVE LOW-VALUES TO MEVL-REC. CL165 +01055 MOVE LOW-VALUES TO LBCM-RUN-AREA. CL173 +01056 CL173 +01057 MOVE ZERO TO LBCM-EMP-ABSTIME. CL173 +01058 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL165 +01059 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 +01060 SET MEVL-EVL-88 TO TRUE. CL165 +01061 ADD +6000 TO LBCM-EMP-ABSTIME. CL182 +01062 CL154 +01063 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. CL173 +01064 CL154 +01065 PERFORM S005-FROM-ABSTIME THRU S005-A-EXIT. CL173 +01066 CL154 +01067 CL154 +01068 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 +01069 CL154 +01070 MOVE L005-DATE TO MEVL-DATE. CL181 +01071 CL154 +01072 MOVE L005-TIME TO MEVL-TIME. CL181 +01073 CL154 +01074 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 +01075 CL154 +01076 MOVE ZEROS TO MEVL-PURGE-DATE. CL154 +01077 CL154 +01078 CL154 +01079 * MOVE EVL-TEXT TO MEVL-TEXT. CL184 +01080 CL154 +01081 **** SET MEVL-SOURCE-SYSTEM-88 TO TRUE. CL154 +01082 ** MOVE MPAY-RESPONSIBLE-OP-ID TO MEVL-SOURCE. CL180 +01083 CL154 +01084 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL154 +01085 * MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL180 +01086 MOVE 20170127 TO MEVL-ESTB-DATE CL180 +01087 MEVL-CHNG-DATE. CL154 +01088 CL154 +01089 CL154 +01090 MOVE MEVL-REC TO MSKL-REC. CL154 +01091 CL154 +01092 PERFORM S910-WRITE THRU S910-EXIT. CL154 +01093 S6000-EXIT. CL154 +01094 EXIT. CL154 +01095 EJECT CL154 +01096 DTSBX655 +01097 P3000-ADD-MNTE. CL183 +01098 MOVE LENGTH OF T003-REC TO T003-LENGTH. CL183 +01099 MOVE '003' TO T003-REC-TYPE. CL183 +01100 MOVE 'SYSTEM ' TO T003-ORIGIN. CL183 +01101 MOVE L005-DATE TO T003-SYS-DATE. CL183 +01102 MOVE L005-TIME TO T003-SYS-TIME. CL183 +01103 SET T003-ADD-MNTE-88 TO TRUE. CL183 +01104 CL183 +01105 MOVE LOW-VALUES TO CL183 +01106 MNTE-KEY-AREA. CL183 +01107 MOVE MPRF-EMP-NO TO MNTE-EMP-NO. CL183 +01108 SET MNTE-NTE-88 TO TRUE. CL183 +01109 MOVE +0 TO MNTE-PURGE-DATE. CL183 +01110 SET MNTE-NOT-CONVERTED-88 TO TRUE. CL183 +01111 CL183 +01112 MOVE L005-DATE TO MNTE-ESTB-DATE CL183 +01113 MNTE-CHNG-DATE. CL183 +01114 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME CL183 +01115 MNTE-DATA-ESTB-ABSTIME CL183 +01116 MNTE-CHNG-ABSTIME. CL183 +01117 MOVE 'DTSBX655' TO MNTE-ESTB-OP-ID CL234 +01118 MNTE-CHNG-OP-ID. CL183 +01119 CL183 +01120 MOVE 'RETURN MAIL FLAG UPDATED TO YES ' CL229 +01121 TO MNTE-SUBJECT. CL183 +01122 CL183 +01123 MOVE +3 TO MNTE-TEXT-CNT. CL190 +01124 CL183 +01125 MOVE WRK-MNTE-MSG-LINE1 TO MNTE-TEXT (1). CL183 +01126 MOVE WRK-MNTE-MSG-LINE2 TO MNTE-TEXT (2). CL183 +01127 * MOVE WRK-MNTE-MSG-LINE3 TO MNTE-TEXT (3). CL229 +01128 CL183 +01129 MOVE MPRF-EMP-NO TO T003-EMP-NO. CL183 +01130 MOVE MNTE-REC TO T003-MNTE-REC. CL183 +01131 CL183 +01132 MOVE T003-REC TO TSKL-REC. CL183 +01133 PERFORM S927-WRITE THRU S927-EXIT. CL183 +01134 ADD +1 TO WRK-T003-CNT. CL183 +01135 CL183 +01136 P3000-EXIT. CL183 +01137 EXIT. CL183 +01138 CL183 +01139 SKIP3 CL183 +01140 T0000-TERMINATE. DTSBX655 +01141 DTSBX655 +01142 DISPLAY ' '. DTSBX655 +01143 DTSBX655 +01144 DISPLAY '*** DTSBX655 TERMINATION STATISTICS ***'. CL238 +01145 DTSBX655 +01146 DISPLAY ' '. DTSBX655 +01147 DTSBX655 +01148 DISPLAY 'INPUT RECORDS READ : ' CL123 +01149 IN-REC-CNT CL123 +01150 CL123 +01151 DISPLAY 'RETURN MAIL UPDATE : ' CL192 +01152 WRK-MPRF-REC-CNT CL192 +01153 CL192 +01154 CL123 +01155 DISPLAY 'ACTIVE EMPLOYERS FOUND : ' CL123 +01156 MPRF-WRK-CNT. CL123 +01157 CL123 +01158 DISPLAY 'QTR RECS FOUND : ' CL123 +01159 WRK-MQTR-FOUND-CNT. CL123 +01160 CL123 +01161 DISPLAY 'QTR RECS UPDATED : ' CL123 +01162 WRK-MQTR-UPDATED-CNT. CL123 +01163 DTSBX655 +01164 DISPLAY 'MEVL REC FOUND : ' CL123 +01165 WRK-MEVL-FOUND-CNT. CL123 +01166 DTSBX655 +01167 DISPLAY 'MEVL REC UPDATED : ' CL123 +01168 ** WRK-MEVL-DELETED-CNT. CL149 +01169 WRK-MEVL-REWRITE-CNT. CL149 +01170 CL123 +01171 CLOSE EMP-FILE1. CL123 +01172 DTSBX655 +01173 PERFORM S923-CLOSE THRU S923-EXIT. CL189 +01174 PERFORM S927-CLOSE THRU S927-EXIT. CL189 +01175 CL183 +01176 PERFORM S910-CLOSE THRU S910-EXIT. CL176 +01177 * PERFORM S921-CLOSE THRU S921-EXIT. CL123 +01178 * PERFORM S931-CLOSE THRU S931-EXIT. CL176 +01179 *** PERFORM S933-CLOSE THRU S933-EXIT. DTSBX655 +01180 DTSBX655 +01181 T0000-EXIT. DTSBX655 +01182 EXIT. DTSBX655 +01183 EJECT DTSBX655 +01184 S001-FROM-FED-8. DTSBX655 +01185 SET L001-FROM-FED-8 TO TRUE. DTSBX655 +01186 GO TO S001-DATE. DTSBX655 +01187 DTSBX655 +01188 S001-FROM-ABS-DAY. DTSBX655 +01189 SET L001-FROM-ABS-DAY TO TRUE. DTSBX655 +01190 GO TO S001-DATE. DTSBX655 +01191 DTSBX655 +01192 S001-DATE. DTSBX655 +01193 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX655 +01194 DTSBX655 +01195 S001-EXIT. DTSBX655 +01196 EXIT. DTSBX655 +01197 SKIP3 DTSBX655 +01198 S004-FROM-5. DTSBX655 +01199 SET L004-FROM-5 TO TRUE. DTSBX655 +01200 GO TO S004-EDIT-QTR. DTSBX655 +01201 DTSBX655 +01202 S004-FROM-ABS. DTSBX655 +01203 SET L004-FROM-ABS TO TRUE. DTSBX655 +01204 GO TO S004-EDIT-QTR. DTSBX655 +01205 DTSBX655 +01206 S004-EDIT-QTR. DTSBX655 +01207 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBX655 +01208 DTSBX655 +01209 S004-EXIT. DTSBX655 +01210 EXIT. DTSBX655 +01211 SKIP3 DTSBX655 +01212 DTSBX655 +01213 S005-FROM-SYS. CL187 +01214 SET L005-FROM-SYS TO TRUE. CL187 +01215 CALL 'DTSBU005' USING L005-LINK-AREA. CL187 +01216 CL187 +01217 S005-EXIT. CL187 +01218 EXIT. CL187 +01219 CL187 +01220 S005-FROM-ABSTIME. CL156 +01221 SET L005-FROM-ABSTIME TO TRUE. CL156 +01222 GO TO S005-ABSTIME. CL156 +01223 CL156 +01224 S005-ABSTIME. CL156 +01225 CALL 'DTSBU005' USING L005-LINK-AREA. CL156 +01226 S005-A-EXIT. CL156 +01227 EXIT. CL156 +01228 SKIP3 CL156 +01229 S910-WRITE. CL156 +01230 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL173 +01231 SET L910-WRITE-88 TO TRUE. CL156 +01232 GO TO S910-MSTR-IO. CL156 +01233 S039-SIC-EDIT. DTSBX655 +01234 CALL 'DTSBU039' USING L039-LINK-AREA. DTSBX655 +01235 S039-EXIT. DTSBX655 +01236 EXIT. DTSBX655 +01237 DTSBX655 +01238 S054-RATE-DETERMINATION. DTSBX655 +01239 CALL 'DTSBU054' USING L054-LINK-AREA DTSBX655 +01240 MRCT-REC. DTSBX655 +01241 DTSBX655 +01242 S054-EXIT. DTSBX655 +01243 EXIT. DTSBX655 +01244 SKIP3 DTSBX655 +01245 S061-FLD-REP-INFO. DTSBX655 +01246 SKIP1 DTSBX655 +01247 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBX655 +01248 SKIP2 DTSBX655 +01249 S061-EXIT. DTSBX655 +01250 EXIT. DTSBX655 +01251 DTSBX655 +01252 S062-FLD-REP-LOOKUP. DTSBX655 +01253 DTSBX655 +01254 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBX655 +01255 DTSBX655 +01256 S062-EXIT. DTSBX655 +01257 EXIT. DTSBX655 +01258 DTSBX655 +01259 S101-PER-MONTH-NO. CL*23 +01260 SET L101-PER-MONTH-NO-88 TO TRUE. CL*23 +01261 GO TO S101-INT-CHARGE. CL*23 +01262 CL*23 +01263 S101-INT-CHARGE. CL*23 +01264 CALL 'DTSBU101' USING L101-LINK-AREA. CL*23 +01265 S101-EXIT. CL*23 +01266 EXIT. CL*23 +01267 CL*23 +01268 S109-FIRST-PEN-INT-YRQ. CL*23 +01269 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. CL*23 +01270 CALL 'DTSBU109' USING L109-LINK-AREA. CL*23 +01271 S109-EXIT. CL*23 +01272 EXIT. CL*23 +01273 S331-WRITE-MLOG. CL210 +01274 CALL 'DTSBU331' USING L331-LINK-AREA. CL210 +01275 S331-EXIT. CL210 +01276 EXIT. CL210 +01277 SKIP3 CL210 +01278 CL*23 +01279 S410-FILING-SCHED. DTSBX655 +01280 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBX655 +01281 DTSBX655 +01282 S410-EXIT. DTSBX655 +01283 EXIT. DTSBX655 +01284 SKIP3 DTSBX655 +01285 S516-LIABILITY. DTSBX655 +01286 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX655 +01287 MPRF-REC. DTSBX655 +01288 DTSBX655 +01289 S516-EXIT. DTSBX655 +01290 EXIT. DTSBX655 +01291 SKIP3 DTSBX655 +01292 S910-OPEN-READ. DTSBX655 +01293 SET L910-OPEN-READ-88 TO TRUE. DTSBX655 +01294 GO TO S910-MSTR-IO. DTSBX655 +01295 DTSBX655 +01296 S910-OPEN-UPDATE-NO-AIX. DTSBX655 +01297 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX655 +01298 GO TO S910-MSTR-IO. DTSBX655 +01299 DTSBX655 +01300 S910-READ. DTSBX655 +01301 SET L910-READ-88 TO TRUE. DTSBX655 +01302 GO TO S910-MSTR-IO. DTSBX655 +01303 DTSBX655 +01304 S910-START-BROWSE. DTSBX655 +01305 SET L910-START-BROWSE-88 TO TRUE. DTSBX655 +01306 GO TO S910-MSTR-IO. DTSBX655 +01307 DTSBX655 +01308 S910-READ-NEXT. DTSBX655 +01309 SET L910-READ-NEXT-88 TO TRUE. DTSBX655 +01310 GO TO S910-MSTR-IO. DTSBX655 +01311 DTSBX655 +01312 S910-COUNT. DTSBX655 +01313 SET L910-COUNT-88 TO TRUE. DTSBX655 +01314 GO TO S910-MSTR-IO. DTSBX655 +01315 DTSBX655 +01316 S910-REWRITE. DTSBX655 +01317 SET L910-REWRITE-88 TO TRUE. DTSBX655 +01318 GO TO S910-MSTR-IO. DTSBX655 +01319 DTSBX655 +01320 S910-DELETE. DTSBX655 +01321 SET L910-DELETE-88 TO TRUE. DTSBX655 +01322 GO TO S910-MSTR-IO. DTSBX655 +01323 DTSBX655 +01324 S910-CLOSE. DTSBX655 +01325 SET L910-CLOSE-88 TO TRUE. DTSBX655 +01326 GO TO S910-MSTR-IO. DTSBX655 +01327 DTSBX655 +01328 S910-MSTR-IO. DTSBX655 +01329 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX655 +01330 MSKL-REC. DTSBX655 +01331 S910-EXIT. DTSBX655 +01332 EXIT. DTSBX655 +01333 SKIP3 DTSBX655 +01334 S921-OPEN-READ. DTSBX655 +01335 SET L921-OPEN-READ-88 TO TRUE. DTSBX655 +01336 GO TO S921-AIX-IO. DTSBX655 +01337 DTSBX655 +01338 S921-START-BROWSE. DTSBX655 +01339 SET L921-START-BROWSE-88 TO TRUE. DTSBX655 +01340 GO TO S921-AIX-IO. DTSBX655 +01341 DTSBX655 +01342 S921-CLOSE. DTSBX655 +01343 SET L921-CLOSE-88 TO TRUE. DTSBX655 +01344 GO TO S921-AIX-IO. DTSBX655 +01345 DTSBX655 +01346 S923-CLOSE. CL183 +01347 SET L923-CLOSE-88 TO TRUE. CL183 +01348 GO TO S923-ATC-IO. CL183 +01349 CL183 +01350 S923-ATC-IO. CL183 +01351 CALL 'DTSBU923' USING L923-LINK-AREA CL183 +01352 ASKL-REC. CL183 +01353 S923-EXIT. CL183 +01354 EXIT. CL183 +01355 SKIP3 CL183 +01356 S921-AIX-IO. DTSBX655 +01357 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX655 +01358 ISKL-REC. DTSBX655 +01359 S921-EXIT. DTSBX655 +01360 EXIT. DTSBX655 +01361 SKIP3 DTSBX655 +01362 DTSBX655 +01363 S923-OPEN-UPDATE. CL183 +01364 SET L923-OPEN-UPDATE-88 TO TRUE. CL183 +01365 GO TO S923-ATC-IO. CL183 +01366 CL183 +01367 SKIP3 CL183 +01368 S927-OPEN-UPDATE. CL183 +01369 SET L927-OPEN-UPDATE-88 TO TRUE. CL183 +01370 GO TO S927-BTC-O. CL183 +01371 CL183 +01372 S927-WRITE. CL183 +01373 SET L927-WRITE-88 TO TRUE. CL183 +01374 GO TO S927-BTC-O. CL183 +01375 CL183 +01376 S927-CLOSE. CL183 +01377 SET L927-CLOSE-88 TO TRUE. CL183 +01378 GO TO S927-BTC-O. CL183 +01379 CL183 +01380 S927-BTC-O. CL183 +01381 CALL 'DTSBU927' USING L927-LINK-AREA CL183 +01382 TSKL-REC. CL183 +01383 S927-EXIT. CL183 +01384 EXIT. CL183 +01385 CL183 +01386 SKIP3 CL183 +01387 S931-OPEN-READ. DTSBX655 +01388 SET L931-OPEN-READ-88 TO TRUE. DTSBX655 +01389 GO TO S931-REF-IO. DTSBX655 +01390 DTSBX655 +01391 S931-OPEN-UPDATE. DTSBX655 +01392 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBX655 +01393 GO TO S931-REF-IO. DTSBX655 +01394 DTSBX655 +01395 S931-START-BROWSE. DTSBX655 +01396 SET L931-START-BROWSE-88 TO TRUE. DTSBX655 +01397 GO TO S931-REF-IO. DTSBX655 +01398 DTSBX655 +01399 S931-READ. DTSBX655 +01400 SET L931-READ-88 TO TRUE. DTSBX655 +01401 GO TO S931-REF-IO. DTSBX655 +01402 DTSBX655 +01403 S931-READ-NEXT. DTSBX655 +01404 SET L931-READ-NEXT-88 TO TRUE. DTSBX655 +01405 GO TO S931-REF-IO. DTSBX655 +01406 DTSBX655 +01407 S931-DELETE. DTSBX655 +01408 SET L931-DELETE-88 TO TRUE. DTSBX655 +01409 GO TO S931-REF-IO. DTSBX655 +01410 DTSBX655 +01411 S931-REWRITE. DTSBX655 +01412 SET L931-REWRITE-88 TO TRUE. DTSBX655 +01413 GO TO S931-REF-IO. DTSBX655 +01414 DTSBX655 +01415 S931-WRITE. DTSBX655 +01416 SET L931-WRITE-88 TO TRUE. DTSBX655 +01417 GO TO S931-REF-IO. DTSBX655 +01418 DTSBX655 +01419 S931-CLOSE. DTSBX655 +01420 SET L931-CLOSE-88 TO TRUE. DTSBX655 +01421 GO TO S931-REF-IO. DTSBX655 +01422 DTSBX655 +01423 S931-REF-IO. DTSBX655 +01424 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX655 +01425 FSKL-REC. DTSBX655 +01426 S931-EXIT. DTSBX655 +01427 EXIT. DTSBX655 +01428 SKIP3 DTSBX655 +01429 S933-OPEN-READ. DTSBX655 +01430 SET L933-OPEN-READ-88 TO TRUE. DTSBX655 +01431 GO TO S933-SIC-I. DTSBX655 +01432 DTSBX655 +01433 S933-CLOSE. DTSBX655 +01434 SET L933-CLOSE-88 TO TRUE. DTSBX655 +01435 GO TO S933-SIC-I. DTSBX655 +01436 DTSBX655 +01437 S933-SIC-I. DTSBX655 +01438 CALL 'DTSBU933' USING L933-LINK-AREA DTSBX655 +01439 XSIC-REC. DTSBX655 +01440 S933-EXIT. DTSBX655 +01441 EXIT. DTSBX655 +01442 DTSBX655 +01443 S999-ABEND. DTSBX655 +01444 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX655 +01445 S999-EXIT. DTSBX655 +01446 EXIT. DTSBX655 diff --git a/Batch/DTSBX657.cob b/Batch/DTSBX657.cob new file mode 100644 index 0000000..34789e0 --- /dev/null +++ b/Batch/DTSBX657.cob @@ -0,0 +1,1523 @@ +00001 IDENTIFICATION DIVISION. 10/31/23 +00002 PROGRAM-ID. DTSBX657. DTSBX657 +00003 AUTHOR. NGUPTA LV002 +00004 DATE-WRITTEN. JAN2017 CL154 +00005 DATE-COMPILED. DTSBX657 +00006 SKIP3 DTSBX657 +00007 ***** DTSBX657 +00008 * DTSBX657 +00009 * FUNCTION: UPDATE MPRF RETURN MAIL FLAG TO Y AND ADD CL217 +00010 * EVENT LOGH. CL217 +00011 * DTSBX657 +00012 ***** DTSBX657 +00013 SKIP3 DTSBX657 +00014 ENVIRONMENT DIVISION. DTSBX657 +00015 SKIP2 DTSBX657 +00016 CONFIGURATION SECTION. DTSBX657 +00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX657 +00018 DTSBX657 +00019 INPUT-OUTPUT SECTION. DTSBX657 +00020 DTSBX657 +00021 FILE-CONTROL. DTSBX657 +00022 SELECT EMP-FILE1 ASSIGN TO EMPFILE1 CL122 +00023 FILE STATUS IS EXP-STATUS. DTSBX657 +00024 DTSBX657 +00025 CL*71 +00026 DATA DIVISION. DTSBX657 +00027 DTSBX657 +00028 FILE SECTION. DTSBX657 +00029 DTSBX657 +00030 FD EMP-FILE1 CL122 +00031 RECORDING MODE IS F. DTSBX657 +00032 01 EMP-REC1. CL122 +00033 05 INEMP-NOA PIC 9(03). CL254 +00034 05 FILLER PIC X. CL254 +00035 05 INEMP-NOB PIC 9(03). CL254 +00036 05 FILLER PIC X(73). CL254 +00037 EJECT DTSBX657 +00038 DTSBX657 +00039 CL*71 +00040 WORKING-STORAGE SECTION. DTSBX657 +000405 77 PAN-VALET PICTURE X(24) VALUE '002DTSBX657 10/31/23'. DTSBX657 +00041 SKIP3 DTSBX657 +00042 01 WRK-AREA. DTSBX657 +00043 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSBX657 +00044 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL211 +00045 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +1000. CL211 +00046 DTSBX657 +00047 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'.DTSBX657 +00048 DTSBX657 +00049 ** 05 WRK-RPT-DATE PIC S9(09) COMP-3 DTSBX657 +00050 * VALUE +20070328. DTSBX657 +00051 * 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX657 +00052 ** VALUE +20061. DTSBX657 +00053 05 WRK-RPT-DATE PIC S9(09) COMP-3 DTSBX657 +00054 VALUE +20170124. CL154 +00055 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX657 +00056 VALUE +0. DTSBX657 +00057 05 WRK-MPRF-REC-CNT PIC S9(07) COMP-3. CL192 +00058 05 WRK-RATE-TYPE-AREA. DTSBX657 +00059 10 WRK-RATE-YR-SCHED PIC X(01). DTSBX657 +00060 88 WRK-RATE-YR-ANN-88 VALUE 'Y'. DTSBX657 +00061 10 WRK-RATE-YR-MINUS-1-SCHED PIC X(01). DTSBX657 +00062 88 WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'. DTSBX657 +00063 10 WRK-RATE-YR-MINUS-2-SCHED PIC X(01). DTSBX657 +00064 88 WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'. DTSBX657 +00065 05 FILLER REDEFINES WRK-RATE-TYPE-AREA PIC X(03). DTSBX657 +00066 88 WRK-ESTIMATE-NEEDED-88 VALUE 'YYY' 'NYY'. DTSBX657 +00067 88 WRK-TRANSITION-YEAR-88 VALUE 'YYN' 'NYN'. DTSBX657 +00068 88 WRK-INIT-VALUES-88 VALUE 'NNN'. DTSBX657 +00069 DTSBX657 +00070 05 WRK-CLASSIFIED-IND PIC X(01). DTSBX657 +00071 88 WRK-CLASSIFIED-YES-88 VALUE 'Y'. DTSBX657 +00072 88 WRK-CLASSIFIED-NO-88 VALUE 'N'. DTSBX657 +00073 05 WRK-EXIT-LOOP-IND PIC X(01). DTSBX657 +00074 88 WRK-EXIT-LOOP-YES-88 VALUE 'Y'. DTSBX657 +00075 88 WRK-EXIT-LOOP-NO-88 VALUE 'N'. DTSBX657 +00076 05 WRK-TEST-EMP PIC S9(07) COMP-3 CL249 +00077 VALUE +330099. CL249 +00078 05 WRK-BATCH PIC S9(05) COMP-3. CL249 +00079 05 WRK-ITEM PIC S9(03) COMP-3. DTSBX657 +00080 05 WRK-SEQ PIC 9(05) DTSBX657 +00081 VALUE ZERO. DTSBX657 +00082 05 WRK-UCFE-FEIN PIC 9(09) CL254 +00083 VALUE 000000000. DTSBX657 +00084 05 WRK-UCX-FEIN PIC 9(09) DTSBX657 +00085 VALUE 330000000. DTSBX657 +00086 05 WRK-CWC-FEIN PIC 9(09) DTSBX657 +00087 VALUE 440000000. DTSBX657 +00088 05 WRK-FED-EMP PIC 9(06). DTSBX657 +00089 05 FILLER REDEFINES WRK-FED-EMP. DTSBX657 +00090 10 FILLER PIC X(02). DTSBX657 +00091 10 WRK-FED-EMP-3 PIC X(01). DTSBX657 +00092 88 WRK-FED-EMP-BYPASS-88 VALUE '1'. DTSBX657 +00093 10 FILLER PIC 9(03). DTSBX657 +00094 05 WRK-ZIP PIC X(10). DTSBX657 +00095 05 FILLER REDEFINES WRK-ZIP. DTSBX657 +00096 10 WRK-ZIP5 PIC X(05). DTSBX657 +00097 10 FILLER PIC X(05). DTSBX657 +00098 DTSBX657 +00099 05 WS-EMP-NO1. CL255 +00100 10 WS-EMP-NOA PIC 9(03). CL255 +00101 10 WS-EMP-NOB PIC 9(03). CL255 +00102 CL**2 +00103 CL**2 +00104 05 WS-EMP-NOZ PIC 9(6) VALUE ZERO. CL**2 +00105 CL**2 +00106 05 EXP-STATUS PIC X(02). DTSBX657 +00107 88 EXP-STATUS-OK-88 VALUE '00'. DTSBX657 +00108 05 EXP2-STATUS PIC X(02). CL*71 +00109 88 EXP2-STATUS-OK-88 VALUE '00'. CL*71 +00110 05 WRK-ERROR-IND PIC X(01). DTSBX657 +00111 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX657 +00112 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX657 +00113 05 WRK-WRITE-REC-IND PIC X(01). DTSBX657 +00114 88 WRK-WRITE-REC-YES-88 VALUE 'Y'. DTSBX657 +00115 88 WRK-WRITE-REC-NO-88 VALUE 'N'. DTSBX657 +00116 05 WRK-OP-ID PIC X(08). DTSBX657 +00117 05 WRK-ASSIGN PIC 9(09). DTSBX657 +00118 05 FILLER REDEFINES WRK-ASSIGN. DTSBX657 +00119 10 WRK-ASSIGN-CC PIC 9(02). DTSBX657 +00120 10 WRK-ASSIGN-YY PIC 9(02). DTSBX657 +00121 10 WRK-ASSIGN-NBR PIC 9(05). DTSBX657 +00122 05 WRK-FLD-ASSIGN. DTSBX657 +00123 10 WRK-FLD-ASSIGN-YEAR PIC 9(02). DTSBX657 +00124 10 FILLER PIC X(01) VALUE SPACE. DTSBX657 +00125 10 WRK-FLD-ASSIGN-NBR PIC 9(05). DTSBX657 +00126 05 WRK-LIEN PIC 9(08). CL*25 +00127 05 WRK-LIEN-X REDEFINES WRK-LIEN. CL*25 +00128 10 FILLER PIC X(02). CL*26 +00129 10 WRK-LIEN6 PIC X(06). CL*25 +00130 05 WRK-LIEN-REF. CL*23 +00131 10 WRK-LIEN-YR PIC 9(02). CL*23 +00132 10 WRK-LIEN-NBR PIC 9(04). CL*23 +00133 DTSBX657 +00134 05 WRK-IND-CODE PIC X(06). DTSBX657 +00135 05 WRK-REC1. DTSBX657 +00136 10 REC1-EMP-NO PIC 999999. DTSBX657 +00137 10 FILLER PIC X(01) VALUE ';'. DTSBX657 +00138 ** 10 REC1-NAME PIC X(32). CL100 +00139 ** 10 REC1-EARLY-LIAB-DT PIC X(32). CL110 +00140 10 REC1-EARLY-LIAB-DT PIC X(10). CL110 +00141 10 FILLER PIC X(01) VALUE ';'. CL*82 +00142 ** 10 REC1-YRQ2 PIC X(06). CL100 +00143 ** 10 FILLER PIC X(01) VALUE ';'. CL100 +00144 10 REC1-FIRS-DATE PIC X(10). CL100 +00145 10 FILLER PIC X(01) VALUE ';'. CL*88 +00146 10 REC1-PRIOR PIC 9.9999. CL100 +00147 10 FILLER PIC X(01) VALUE ';'. CL*95 +00148 10 REC1-CURR PIC 9.9999. CL100 +00149 10 FILLER PIC X(01) VALUE ';'. CL*98 +00150 CL*75 +00151 05 WRK-REC1-OLD. CL*15 +00152 10 REC1-ESTB-DATE PIC X(10). CL*98 +00153 10 REC1-LIEN-NO PIC 9(08). CL*98 +00154 10 REC1-STATUS PIC X(01). CL*98 +00155 10 REC1-SOURCE PIC X(02). CL*88 +00156 10 REC1-YRQ PIC X(06). CL*85 +00157 10 REC1-OP-ID PIC X(08). CL*75 +00158 10 REC1-STATUS-OP-ID PIC X(08). CL*75 +00159 10 REC1-STMT-DATE PIC X(10). CL*95 +00160 10 REC1-STATUS-DATE PIC X(10). CL*75 +00161 10 REC1-BALANCE PIC --------9.99. CL*75 +00162 10 REC1-FREQUENCY PIC X(01). CL*75 +00163 10 REC1-START-DATE PIC X(10). CL*75 +00164 10 REC1-TAX-DUE PIC --------9.99. CL*75 +00165 10 REC1-DATA-ELEMENT PIC X(40). CL*68 +00166 10 REC1-PRE-MOD-VALUE PIC X(40). CL*68 +00167 10 REC1-POST-MOD-VALUE PIC X(40). CL*68 +00168 10 REC1-MLOG-DATE PIC X(10). CL*68 +00169 10 REC1-EMP-NAME PIC X(40). CL*68 +00170 10 REC1-CURR-RESERVE PIC --------9.99. CL*59 +00171 10 REC1-ATTN PIC X(40). CL*57 +00172 10 REC1-STREET2 PIC X(40). CL*57 +00173 10 REC1-STREET1 PIC X(40). CL*57 +00174 10 REC1-CITY PIC X(25). CL*57 +00175 10 REC1-STATE PIC X(02). CL*57 +00176 10 REC1-ZIP PIC X(10). CL*57 +00177 10 REC1-PHONE PIC X(15). CL*57 +00178 10 REC1-FAX PIC X(15). CL*57 +00179 10 REC1-EMAIL PIC X(40). CL*57 +00180 10 REC1-ASSIGN PIC X(08). CL*51 +00181 10 REC1-ASSIGN-TYPE PIC X(02). CL*51 +00182 10 REC1-PROCESS-DATE PIC X(10). CL*51 +00183 10 REC1-COMP-DATE PIC X(10). CL*51 +00184 10 REC1-FLD-REP-ID PIC X(02). CL*46 +00185 10 REC1-INACT-OPID PIC X(08). CL*43 +00186 10 REC1-INACT-ENTER-DT PIC X(10). CL*38 +00187 10 REC1-OPO-NAME PIC X(32). CL*27 +00188 10 REC1-ELIG-CD PIC 9(03). CL*17 +00189 10 REC1-FEIN PIC 9(09). DTSBX657 +00190 10 REC1-COUNT PIC 9(07). DTSBX657 +00191 10 REC1-CLASS PIC X(02). DTSBX657 +00192 10 REC1-MLIN-STATUS PIC X(01). DTSBX657 +00193 10 REC1-BATCH PIC 9(05). DTSBX657 +00194 10 REC1-ITEM PIC 9(03). DTSBX657 +00195 10 REC1-RPTS-DUE PIC 999. DTSBX657 +00196 10 REC1-COMPLETE-DATE PIC X(10). DTSBX657 +00197 10 REC1-PAY-TYPE PIC X(02). DTSBX657 +00198 10 REC1-TAX-PAID PIC --------9.99. DTSBX657 +00199 10 REC1-DEPOSIT-DATE PIC X(10). DTSBX657 +00200 10 REC1-NAICS PIC X(06). DTSBX657 +00201 10 REC1-SIC PIC X(04). DTSBX657 +00202 10 REC1-YEAR PIC 9(04). DTSBX657 +00203 10 REC1-AMT PIC ----------9.99. DTSBX657 +00204 10 REC1-OPO-SSN PIC X(09). DTSBX657 +00205 10 REC1-PRIOR-RESERVE PIC --------9.99. DTSBX657 +00206 10 REC1-INTEREST PIC --------9.99. DTSBX657 +00207 10 REC1-BEN-CHG PIC --------9.99. DTSBX657 +00208 10 REC1-AVG-TAX-WAGE PIC --------9.99. DTSBX657 +00209 10 REC1-RATE-PCT PIC 9.9. DTSBX657 +00210 10 REC1-DUE-DATE PIC X(10). DTSBX657 +00211 10 REC1-INACT-YRQ PIC X(06). DTSBX657 +00212 10 REC1-RCVD-DATE PIC X(10). DTSBX657 +00213 10 REC1-TOT-WAGE PIC ----------9.99. DTSBX657 +00214 10 REC1-SUR-BAL PIC ----------9.99. DTSBX657 +00215 10 REC1-LP-BAL PIC ----------9.99. DTSBX657 +00216 10 REC1-INT-BAL PIC ----------9.99. DTSBX657 +00217 10 REC1-SEQ PIC 999999. DTSBX657 +00218 10 REC1-PRED PIC 999999. DTSBX657 +00219 10 REC1-REL-CD PIC X(02). DTSBX657 +00220 10 REC1-TRAN PIC X(02). DTSBX657 +00221 10 REC1-CREDIT PIC --------9.99. DTSBX657 +00222 10 REC1-ACCOUNT PIC X(02). DTSBX657 +00223 10 REC1-NEW-RATE PIC 9.9999. DTSBX657 +00224 10 REC1-EMP-TYPE PIC X(05). DTSBX657 +00225 10 REC1-CHG PIC --------9.99. DTSBX657 +00226 10 REC1-DESC PIC X(40). DTSBX657 +00227 10 REC1-LIAB-QTRS PIC 999. DTSBX657 +00228 10 REC1-ORG-TYPE PIC X(03). DTSBX657 +00229 10 REC1-LIAB-CD PIC X(02). DTSBX657 +00230 10 REC1-LP-CHG PIC --------9.99. DTSBX657 +00231 10 REC1-INT-CHG PIC --------9.99. DTSBX657 +00232 10 REC1-IND-CODE PIC X(06). DTSBX657 +00233 10 REC1-LIAB-ENTER-DATE PIC X(10). DTSBX657 +00234 10 REC1-INACT-CODE PIC X(05). DTSBX657 +00235 88 REC1-INACT-YES-88 VALUE 'INACT'. DTSBX657 +00236 88 REC1-INACT-NO-88 VALUE 'ACT '. DTSBX657 +00237 10 REC1-REACT PIC X(05). DTSBX657 +00238 88 REC1-REACT-NO-88 VALUE 'NEW '. DTSBX657 +00239 88 REC1-REACT-YES-88 VALUE 'REACT'. DTSBX657 +00240 10 REC1-AREA PIC X(03). DTSBX657 +00241 10 REC1-PFX PIC X(03). DTSBX657 +00242 10 REC1-SFX PIC X(04). DTSBX657 +00243 10 REC1-EXT PIC X(05). DTSBX657 +00244 10 REC1-INT-CHARGE-IND PIC X(01). CL*84 +00245 88 REC1-INT-CHARGE-MANUAL-88 VALUE 'M'. CL*84 +00246 88 REC1-INT-CHARGE-AUTO-88 VALUE 'A'. CL*84 +00247 10 FILLER PIC X(01) VALUE ';'. CL*84 +00248 10 REC1-INT-START-DATE1 PIC X(10). CL*84 +00249 10 FILLER PIC X(01) VALUE ';'. CL*84 +00250 10 REC1-INT-END-DATE1 PIC X(10). CL*84 +00251 10 FILLER PIC X(01) VALUE ';'. CL*84 +00252 10 REC1-INT-RATE1 PIC 9.9999. CL*84 +00253 10 FILLER PIC X(01) VALUE ';'. CL*84 +00254 10 REC1-INT-START-DATE2 PIC X(10). CL*84 +00255 10 FILLER PIC X(01) VALUE ';'. CL*84 +00256 10 REC1-INT-END-DATE2 PIC X(10). CL*84 +00257 10 FILLER PIC X(01) VALUE ';'. CL*84 +00258 10 REC1-INT-RATE2 PIC 9.9999. CL*84 +00259 10 FILLER PIC X(01) VALUE ';'. CL*84 +00260 10 REC1-WAIVE-INT-START-DATE PIC X(10). CL*84 +00261 10 FILLER PIC X(01) VALUE ';'. CL*84 +00262 10 REC1-WAIVE-INT-END-DATE PIC X(10). CL*84 +00263 CL*71 +00264 05 WRK-REC2. CL*71 +00265 10 REC2-EMP-NO PIC 999999. CL*71 +00266 10 FILLER PIC X(01) VALUE ';'. CL*71 +00267 10 REC2-ESTB-DATE PIC X(10). CL*71 +00268 10 FILLER PIC X(01) VALUE ';'. CL*71 +00269 10 REC2-QTR PIC X(06). CL*71 +00270 CL*71 +00271 05 WRK-ABS-QTR1 PIC S9(04) COMP-3 DTSBX657 +00272 VALUE +0. DTSBX657 +00273 05 WRK-ABS-QTR2 PIC S9(04) COMP-3 DTSBX657 +00274 VALUE +0. DTSBX657 +00275 05 WRK-ABS-DATE1 PIC S9(08) COMP. DTSBX657 +00276 05 WRK-ABS-DATE2 PIC S9(08) COMP. DTSBX657 +00277 05 WRK-DIFF PIC S9(07) COMP-3. DTSBX657 +00278 05 WRK-UNDER-30-CNT PIC S9(04) COMP-3 DTSBX657 +00279 VALUE +0. DTSBX657 +00280 05 WRK-OVER-31-CNT PIC S9(04) COMP-3 DTSBX657 +00281 VALUE +0. DTSBX657 +00282 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSBX657 +00283 05 WRK-FISCAL-AGENT-CD PIC X(03). DTSBX657 +00284 05 WRK-BNK-IND PIC X(02). DTSBX657 +00285 05 WRK-FIRST-NEW-EMP-NO PIC S9(07) COMP-3. DTSBX657 +00286 *& VALUE +123778. DTSBX657 +00287 05 WRK-FEIN PIC 9(09). DTSBX657 +00288 05 WRK-MQTR-BAL PIC S9(11)V99 COMP-3 VALUE +0. DTSBX657 +00289 05 WRK-MQTR-BAL1 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX657 +00290 05 WRK-MQTR-BAL2 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX657 +00291 05 WRK-MQTR-BAL3 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX657 +00292 05 WRK-RESERVE PIC S9(09)V99 COMP-3. DTSBX657 +00293 05 WRK-MQTR-CHG PIC S9(09)V99 COMP-3. DTSBX657 +00294 05 WRK-MQTR-ANN-BAL PIC S9(07)V99 COMP-3. DTSBX657 +00295 05 WRK-MQTR-PEN-BAL PIC S9(07)V99 COMP-3. DTSBX657 +00296 05 WRK-MQTR-PEN-CHG PIC S9(07)V99 COMP-3. DTSBX657 +00297 05 WRK-MQTR-INT-BAL PIC S9(07)V99 COMP-3. DTSBX657 +00298 05 WRK-MQTR-INT-CHG PIC S9(07)V99 COMP-3. DTSBX657 +00299 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3 CL*91 +00300 VALUE +0. CL*91 +00301 05 WRK-RPT-BAL-CNT PIC S9(07) COMP-3. DTSBX657 +00302 05 WRK-RPT-CNT PIC S9(07) COMP-3. DTSBX657 +00303 05 WRK-BAL-CNT PIC S9(07) COMP-3. DTSBX657 +00304 05 WRK-REL-CNT PIC S9(07) COMP-3. DTSBX657 +00305 05 WRK-RATED-CNT PIC S9(07) COMP-3. DTSBX657 +00306 05 WRK-SELF-INS-CNT PIC S9(07) COMP-3. DTSBX657 +00307 05 WRK-HOTEL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX657 +00308 05 WRK-TOT-EMPS PIC S9(07) COMP-3 VALUE +0. DTSBX657 +00309 05 WRK-TOT-WORKERS PIC S9(11) COMP-3 VALUE +0. DTSBX657 +00310 05 WRK-PURSUED-RPT-CNT PIC S9(07) COMP-3. DTSBX657 +00311 05 WRK-LATE-RPT-CNT PIC S9(07) COMP-3. DTSBX657 +00312 05 WRK-MEVL-REWRITE-CNT PIC S9(03) COMP-3 VALUE 0. CL141 +00313 05 WRK-MEVL-DELETED-CNT PIC S9(03) COMP-3 VALUE 0. CL141 +00314 05 WRK-MEVL-FOUND-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00315 05 WRK-MQTR-UPDATED-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00316 05 WRK-MQTR-FOUND-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00317 05 MPRF-REC-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00318 05 MPRF-WRK-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00319 05 IN-REC-CNT PIC S9(03) COMP-3 VALUE 0. CL128 +00320 05 WRK-UC30-SENT-CNT PIC S9(07) COMP-3. DTSBX657 +00321 05 WRK-UC30-RCVD-CNT PIC S9(07) COMP-3. DTSBX657 +00322 05 WRK-OVER-1000-CNT PIC S9(07) COMP-3. DTSBX657 +00323 05 WRK-UNDER-1000-CNT PIC S9(07) COMP-3. DTSBX657 +00324 05 WRK-HOUSEHOLD-PAYMENTS PIC S9(11)V99 COMP-3. DTSBX657 +00325 05 WRK-TOT-WAGES PIC S9(11)V99 COMP-3. DTSBX657 +00326 05 WRK-ALL-BNK-RATED PIC S9(11)V99 COMP-3. DTSBX657 +00327 05 WRK-OPN-BNK-RATED PIC S9(11)V99 COMP-3. DTSBX657 +00328 05 WRK-ALL-BNK-SI PIC S9(11)V99 COMP-3. DTSBX657 +00329 05 WRK-OPN-BNK-SI PIC S9(11)V99 COMP-3. DTSBX657 +00330 05 WRK-BOND-AMT PIC S9(11)V99 COMP-3. DTSBX657 +00331 05 WRK-OVER-100-CNT PIC S9(07) COMP-3 DTSBX657 +00332 VALUE +0. DTSBX657 +00333 05 WRK-OVER-100-AMT PIC S9(11)V99 COMP-3 DTSBX657 +00334 VALUE +0. DTSBX657 +00335 05 WRK-1-10-CNT PIC S9(07) COMP-3 DTSBX657 +00336 VALUE +0. DTSBX657 +00337 05 WRK-1-10-AMT PIC S9(11)V99 COMP-3 DTSBX657 +00338 VALUE +0. DTSBX657 +00339 05 WRK-11-100-CNT PIC S9(07) COMP-3 DTSBX657 +00340 VALUE +0. DTSBX657 +00341 05 WRK-11-100-AMT PIC S9(11)V99 COMP-3 DTSBX657 +00342 VALUE +0. DTSBX657 +00343 05 WRK-OVER-100-WRKRS PIC S9(07) COMP-3. DTSBX657 +00344 05 WRK-100-249-CNT PIC S9(07) COMP-3. DTSBX657 +00345 05 WRK-100-249-WRKRS PIC S9(07) COMP-3. DTSBX657 +00346 05 WRK-50-100-CNT PIC S9(07) COMP-3. DTSBX657 +00347 05 WRK-50-100-WRKRS PIC S9(07) COMP-3. DTSBX657 +00348 05 WRK-25-49-CNT PIC S9(07) COMP-3. DTSBX657 +00349 05 WRK-25-49-WRKRS PIC S9(07) COMP-3. DTSBX657 +00350 05 WRK-10-24-CNT PIC S9(07) COMP-3. DTSBX657 +00351 05 WRK-10-24-WRKRS PIC S9(07) COMP-3. DTSBX657 +00352 05 WRK-6-9-CNT PIC S9(07) COMP-3. DTSBX657 +00353 05 WRK-5-9-WRKRS PIC S9(07) COMP-3. DTSBX657 +00354 05 WRK-5-CNT PIC S9(07) COMP-3. DTSBX657 +00355 05 WRK-4-CNT PIC S9(07) COMP-3. DTSBX657 +00356 05 WRK-3-CNT PIC S9(07) COMP-3. DTSBX657 +00357 05 WRK-2-CNT PIC S9(07) COMP-3. DTSBX657 +00358 05 WRK-1-CNT PIC S9(07) COMP-3. DTSBX657 +00359 05 WRK-UNDER-5-CNT PIC S9(07) COMP-3. DTSBX657 +00360 05 WRK-UNDER-5-WRKRS PIC S9(07) COMP-3. DTSBX657 +00361 05 WRK-UNDER-10-CNT PIC S9(07) COMP-3. DTSBX657 +00362 05 WRK-OVER-10-CNT PIC S9(07) COMP-3. DTSBX657 +00363 05 WRK-UNDER-10-WRKRS PIC S9(07) COMP-3. DTSBX657 +00364 05 WRK-NO-EMPS-CNT PIC S9(07) COMP-3. DTSBX657 +00365 05 WRK-MRCT-TOT-WAGES PIC S9(11)V99 COMP-3. DTSBX657 +00366 05 WRK-MRCT-TAX-WAGES PIC S9(11)V99 COMP-3. DTSBX657 +00367 05 WRK-MRCT-UI-PAID PIC S9(11)V99 COMP-3. DTSBX657 +00368 05 WRK-TOT-UI PIC S9(11)V99 COMP-3. DTSBX657 +00369 05 WRK-TOT-INT PIC S9(11)V99 COMP-3. DTSBX657 +00370 05 WRK-TOT-PEN PIC S9(11)V99 COMP-3. DTSBX657 +00371 05 WRK-MQTR-ANN-TOT-WAGE PIC S9(12)V99 COMP-3. DTSBX657 +00372 05 WRK-MQTR-ANN-TAX-WAGE PIC S9(12)V99 COMP-3. DTSBX657 +00373 05 WRK-MJRN-TOT-NEG-CHG PIC S9(11)V99 COMP-3 DTSBX657 +00374 VALUE +0. DTSBX657 +00375 05 WRK-MQTR-TOT-UI-CHARGED PIC S9(11)V99 COMP-3. DTSBX657 +00376 05 WRK-START-DATE PIC S9(09) COMP-3. DTSBX657 +00377 05 WRK-END-DATE PIC S9(09) COMP-3. DTSBX657 +00378 05 WRK-LIAB-DATE PIC S9(09) COMP-3. DTSBX657 +00379 05 WRK-FIRST-LIAB-DATE PIC S9(09) COMP-3. DTSBX657 +00380 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBX657 +00381 VALUE +999999999. DTSBX657 +00382 CL104 +00383 05 WRK-UI-RATE-CATEGORY PIC X(01). CL104 +00384 88 WRK-CLASSIFIED-88 VALUE 'C'. CL104 +00385 88 WRK-NONCLASSIFIED-88 VALUE 'N'. CL104 +00386 CL104 +00387 CL104 +00388 05 WRK-BNK-PETITION-DATE PIC 9(08). DTSBX657 +00389 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. DTSBX657 +00390 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). DTSBX657 +00391 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). DTSBX657 +00392 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). DTSBX657 +00393 05 WRK-BNK-PETITION-YRQ PIC 9(05). DTSBX657 +00394 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. DTSBX657 +00395 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). DTSBX657 +00396 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). DTSBX657 +00397 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. DTSBX657 +00398 05 WRK-EST-RPT-IND PIC X(01). DTSBX657 +00399 88 WRK-EST-RPT-YES VALUE 'Y'. DTSBX657 +00400 88 WRK-EST-RPT-NO VALUE 'N'. DTSBX657 +00401 DTSBX657 +00402 05 WRK-ZERO-FOUND-IND PIC X(01). DTSBX657 +00403 88 WRK-ZERO-FOUND-YES-88 VALUE 'Y'. DTSBX657 +00404 88 WRK-ZERO-FOUND-NO-88 VALUE 'N'. DTSBX657 +00405 DTSBX657 +00406 05 WRK-WITHDRAWN-IND PIC X(01). DTSBX657 +00407 88 WRK-WITHDRAWN-YES VALUE 'Y'. DTSBX657 +00408 88 WRK-WITHDRAWN-NO VALUE 'N'. DTSBX657 +00409 DTSBX657 +00410 05 WRK-ORIG-IND PIC X(01). DTSBX657 +00411 88 WRK-ORIG-YES VALUE 'Y'. DTSBX657 +00412 88 WRK-ORIG-NO VALUE 'N'. DTSBX657 +00413 DTSBX657 +00414 05 WRK-MQTR-CNT PIC S9(07) COMP-3. DTSBX657 +00415 05 WRK-MRPT-CNT PIC S9(07) COMP-3. DTSBX657 +00416 05 WRK-MSOL-CNT PIC S9(07) COMP-3. DTSBX657 +00417 05 WRK-MLIN-CNT PIC S9(07) COMP-3. DTSBX657 +00418 05 WRK-MFAS-CNT PIC S9(07) COMP-3. DTSBX657 +00419 05 WRK-MFAE-CNT PIC S9(07) COMP-3. DTSBX657 +00420 05 WRK-MPAY-CNT PIC S9(07) COMP-3. DTSBX657 +00421 05 WRK-MADJ-CNT PIC S9(07) COMP-3. DTSBX657 +00422 05 WRK-MJRN-CNT PIC S9(08) COMP-3. DTSBX657 +00423 05 WRK-MERA-CNT PIC S9(08) COMP-3. DTSBX657 +00424 05 WRK-MRTE-CNT PIC S9(08) COMP-3. DTSBX657 +00425 05 WRK-MRTE-CNT1 PIC S9(08) COMP-3. DTSBX657 +00426 05 WRK-MLOG-CNT PIC S9(08) COMP-3. DTSBX657 +00427 05 WRK-MFSC-CNT PIC S9(08) COMP-3 DTSBX657 +00428 VALUE +0. DTSBX657 +00429 05 WRK-CR-TOL-CNT PIC S9(07) COMP-3. DTSBX657 +00430 05 SUB PIC S9(04) COMP. DTSBX657 +00431 05 RPT-SUB PIC S9(04) COMP. DTSBX657 +00432 05 QTR-SUB PIC S9(04) COMP. DTSBX657 +00433 05 WRK-QTR-AREA OCCURS 20 TIMES. DTSBX657 +00434 10 WRK-QTR-YRQ PIC S9(05) COMP-3. DTSBX657 +00435 10 WRK-QTR-CHG PIC S9(09)V99 COMP-3. DTSBX657 +00436 10 WRK-QTR-PAID PIC S9(09)V99 COMP-3. DTSBX657 +00437 10 WRK-QTR-WAIVED PIC S9(09)V99 COMP-3. DTSBX657 +00438 10 WRK-QTR-TOLERATED PIC S9(09)V99 COMP-3. DTSBX657 +00439 05 WRK-JRN-AREA OCCURS 100 TIMES. DTSBX657 +00440 *** 10 WRK-JRN-EMP-NO PIC 9(06). DTSBX657 +00441 *** 10 WRK-JRN-EMP-NAME PIC X(40). DTSBX657 +00442 10 WRK-JRN-RCVD PIC X(10). DTSBX657 +00443 10 WRK-JRN-TRAN PIC X(02). DTSBX657 +00444 10 WRK-JRN-BATCH PIC 9(05). DTSBX657 +00445 10 WRK-JRN-ITEM PIC 9(03). DTSBX657 +00446 10 WRK-JRN-AMT PIC --------9.99. DTSBX657 +00447 05 WRK-TIMELY-PMT-AREA. DTSBX657 +00448 10 WRK-PEN-INT-BAL-CNT PIC S9(07) COMP-3. DTSBX657 +00449 10 WRK-INT-MANUAL-CNT PIC S9(07) COMP-3. DTSBX657 +00450 10 WRK-QTR-TAX-BAL PIC S9(09)V9(02) COMP-3. DTSBX657 +00451 10 WRK-QTR-TAX-CHG PIC S9(09)V9(02) COMP-3. DTSBX657 +00452 10 WRK-QTR-INT-PEN-BAL PIC S9(09)V9(02) COMP-3. DTSBX657 +00453 10 WRK-AVG-PMT PIC S9(09)V9(02) COMP-3. DTSBX657 +00454 10 WRK-TIMELY-PMT PIC S9(09)V9(02) COMP-3. DTSBX657 +00455 10 WRK-OLD-PEN-CHG PIC S9(09)V9(02) COMP-3. DTSBX657 +00456 DTSBX657 +00457 05 WRK-PCT PIC S9(03)V9(04) COMP-3 DTSBX657 +00458 VALUE +0. DTSBX657 +00459 05 WRK-AVG-PCT PIC S9(09)V9(04) COMP-3 DTSBX657 +00460 VALUE +0. DTSBX657 +00461 05 WRK-PCT-DISP PIC Z(02)9.9999. DTSBX657 +00462 05 WRK-PCT-DISP1 PIC Z(02)9.9999. DTSBX657 +00463 05 WRK-UI-RATE PIC S9(01)V9(04) COMP-3. DTSBX657 +00464 05 DISP-UI-RATE1 PIC 9.9(04). DTSBX657 +00465 05 DISP-UI-RATE2 PIC 9.9(04). DTSBX657 +00466 05 AMT-DISP PIC ---,---,--9.99. DTSBX657 +00467 05 AMT-DISP1 PIC Z(11)9.99-. DTSBX657 +00468 05 AMT-DISP2 PIC Z(11)9.99-. DTSBX657 +00469 05 AMT-DISP3 PIC Z(11)9-. DTSBX657 +00470 05 EMP-ACCT-DISP PIC 9(06). DTSBX657 +00471 05 EMP-SUCC-DISP PIC 9(06). DTSBX657 +00472 05 EMP-SUCC-DISP-X REDEFINES EMP-SUCC-DISP DTSBX657 +00473 PIC X(06). DTSBX657 +00474 05 DISP-DATE1 PIC X(10). DTSBX657 +00475 05 DISP-DATE2 PIC X(10). DTSBX657 +00476 05 INACT-LBL PIC X(10). DTSBX657 +00477 05 WRK-MPRF-IND PIC X(01). DTSBX657 +00478 88 WRK-MPRF-OK VALUE 'Y'. DTSBX657 +00479 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX657 +00480 05 WRK-MQTR-IND PIC X(01). DTSBX657 +00481 88 WRK-MQTR-OK VALUE 'Y'. DTSBX657 +00482 88 WRK-MQTR-NO-REC VALUE 'N'. DTSBX657 +00483 05 WRK-MRPT-IND PIC X(01). DTSBX657 +00484 88 WRK-MRPT-OK VALUE 'Y'. DTSBX657 +00485 88 WRK-MRPT-NO-REC VALUE 'N'. DTSBX657 +00486 05 WRK-MDST-IND PIC X(01). DTSBX657 +00487 88 WRK-MDST-OK VALUE 'Y'. DTSBX657 +00488 88 WRK-MDST-NO-REC VALUE 'N'. DTSBX657 +00489 05 WRK-MEVL-IND PIC X(01). DTSBX657 +00490 88 WRK-MEVL-OK VALUE 'Y'. DTSBX657 +00491 88 WRK-MEVL-NO-REC VALUE 'N'. DTSBX657 +00492 05 WRK-MLIN-IND PIC X(01). DTSBX657 +00493 88 WRK-MLIN-OK VALUE 'Y'. DTSBX657 +00494 88 WRK-MLIN-NO-REC VALUE 'N'. DTSBX657 +00495 05 WRK-MDPC-IND PIC X(01). DTSBX657 +00496 88 WRK-MDPC-OK VALUE 'Y'. DTSBX657 +00497 88 WRK-MDPC-NO-REC VALUE 'N'. DTSBX657 +00498 05 WRK-MFAS-IND PIC X(01). DTSBX657 +00499 88 WRK-MFAS-OK VALUE 'Y'. DTSBX657 +00500 88 WRK-MFAS-NO-REC VALUE 'N'. DTSBX657 +00501 05 WRK-MFAE-IND PIC X(01). DTSBX657 +00502 88 WRK-MFAE-OK VALUE 'Y'. DTSBX657 +00503 88 WRK-MFAE-NO-REC VALUE 'N'. DTSBX657 +00504 05 WRK-MSOL-IND PIC X(01). DTSBX657 +00505 88 WRK-MSOL-OK VALUE 'Y'. DTSBX657 +00506 88 WRK-MSOL-NO-REC VALUE 'N'. DTSBX657 +00507 05 WRK-MLOG-IND PIC X(01). DTSBX657 +00508 88 WRK-MLOG-OK VALUE 'Y'. DTSBX657 +00509 88 WRK-MLOG-NO-REC VALUE 'N'. DTSBX657 +00510 88 WRK-MLOG-COMPLETE VALUE 'C'. DTSBX657 +00511 05 WRK-MRPT-FOUND-IND PIC X(01). DTSBX657 +00512 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSBX657 +00513 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSBX657 +00514 05 WRK-MTAD-FOUND-IND PIC X(01). CL**6 +00515 88 WRK-MTAD-FOUND-YES VALUE 'Y'. CL**6 +00516 88 WRK-MTAD-FOUND-NO VALUE 'N'. CL**6 +00517 05 WRK-CR-TOL-IND PIC X(01). DTSBX657 +00518 88 WRK-CR-TOL-YES VALUE 'Y'. DTSBX657 +00519 88 WRK-CR-TOL-NO VALUE 'N'. DTSBX657 +00520 05 WRK-DUP-FOUND-IND PIC X(01). DTSBX657 +00521 88 WRK-DUP-FOUND-YES VALUE 'Y'. DTSBX657 +00522 88 WRK-DUP-FOUND-NO VALUE 'N'. DTSBX657 +00523 05 WRK-SELECT-IND PIC X(01). DTSBX657 +00524 88 WRK-SELECT-YES-88 VALUE 'Y'. DTSBX657 +00525 88 WRK-SELECT-NO-88 VALUE 'N'. DTSBX657 +00526 05 WRK-LAST-MRPT-TYPE PIC X(02). DTSBX657 +00527 05 WRK-DISP-AREA. DTSBX657 +00528 10 WRK-DISP-STAR PIC X(01). DTSBX657 +00529 10 FILLER PIC X(01) VALUE SPACE. DTSBX657 +00530 10 WRK-DISP-AMT PIC Z(10)9.99-. DTSBX657 +00531 DTSBX657 +00532 05 WRK-INACT-DATE PIC S9(09) COMP-3 DTSBX657 +00533 VALUE +0. DTSBX657 +00534 05 WRK-INACT-CODE PIC X(02). DTSBX657 +00535 05 WRK-INACT-YRQ PIC S9(05) COMP-3 DTSBX657 +00536 VALUE +0. DTSBX657 +00537 05 WRK-LAST-YRQ PIC S9(05) COMP-3 DTSBX657 +00538 VALUE +0. DTSBX657 +00539 05 WRK-FIRST-LIAB-YRQ PIC S9(05) COMP-3 DTSBX657 +00540 VALUE +0. DTSBX657 +00541 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 DTSBX657 +00542 VALUE +0. DTSBX657 +00543 05 WRK-NEXT-YRQ PIC S9(05) COMP-3 DTSBX657 +00544 VALUE +0. DTSBX657 +00545 05 WRK-UPDATED-CNT PIC S9(07) COMP-3. DTSBX657 +00546 DTSBX657 +00547 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBX657 +00548 DTSBX657 +00549 05 PARM-EOF-IND PIC X(01). DTSBX657 +00550 DTSBX657 +00551 05 WRK-EMP-NO PIC 9(06). DTSBX657 +00552 DTSBX657 +00553 05 WRK-TRACE-IND PIC X(01). DTSBX657 +00554 DTSBX657 +00555 05 WRK-MST-OPEN-IND PIC X(01). DTSBX657 +00556 DTSBX657 +00557 05 WRK-REF-OPEN-IND PIC X(01). DTSBX657 +00558 DTSBX657 +00559 05 WRK-SIC-SCAN-AREA. DTSBX657 +00560 10 WRK-RPT-FOUND-IND PIC X(01). DTSBX657 +00561 88 WRK-RPT-FOUND-YES VALUE 'Y'. DTSBX657 +00562 88 WRK-RPT-FOUND-NO VALUE 'N'. DTSBX657 +00563 10 WRK-EMPL-CNT PIC S9(07) COMP-3. DTSBX657 +00564 10 WRK-SIC-4 PIC X(04). DTSBX657 +00565 10 FILLER REDEFINES WRK-SIC-4. DTSBX657 +00566 15 WRK-SIC-3 PIC X(03). DTSBX657 +00567 15 FILLER PIC X(01). DTSBX657 +00568 10 WRK-NO-SIC-CNT PIC S9(07) COMP-3. DTSBX657 +00569 10 WRK-SIC-7911-AREA. DTSBX657 +00570 15 WRK-SIC-7911-WORKERS PIC S9(07) COMP-3. DTSBX657 +00571 15 WRK-SIC-7911-BUSINESSES PIC S9(07) COMP-3. DTSBX657 +00572 10 WRK-SIC-794-AREA. DTSBX657 +00573 15 WRK-SIC-794-WORKERS PIC S9(07) COMP-3. DTSBX657 +00574 15 WRK-SIC-794-BUSINESSES PIC S9(07) COMP-3. DTSBX657 +00575 10 WRK-SIC-799-AREA. DTSBX657 +00576 15 WRK-SIC-799-WORKERS PIC S9(07) COMP-3. DTSBX657 +00577 15 WRK-SIC-799-BUSINESSES PIC S9(07) COMP-3. DTSBX657 +00578 10 WRK-SIC-8351-AREA. DTSBX657 +00579 15 WRK-SIC-8351-WORKERS PIC S9(07) COMP-3. DTSBX657 +00580 15 WRK-SIC-8351-BUSINESSES PIC S9(07) COMP-3. DTSBX657 +00581 10 WRK-SIC-8641-AREA. DTSBX657 +00582 15 WRK-SIC-8641-WORKERS PIC S9(07) COMP-3. DTSBX657 +00583 15 WRK-SIC-8641-BUSINESSES PIC S9(07) COMP-3. DTSBX657 +00584 10 WRK-NAICS-6 PIC X(06). DTSBX657 +00585 10 FILLER REDEFINES WRK-NAICS-6. DTSBX657 +00586 15 WRK-NAICS-2 PIC X(02). DTSBX657 +00587 15 FILLER PIC X(04). DTSBX657 +00588 *RW1 DTSBX657 +00589 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBX657 +00590 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBX657 +00591 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBX657 +00592 DTSBX657 +00593 05 DISP-DATE PIC X(08). DTSBX657 +00594 05 DISP-TIME PIC X(08). DTSBX657 +00595 DTSBX657 +00596 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBX657 +00597 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBX657 +00598 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBX657 +00599 05 WRK-T003-CNT PIC S9(07) COMP-3 VALUE +0. CL184 +00600 DTSBX657 +00601 * 05 EVL-TEXT PIC X(50). CL154 +00602 01 MNT-LOG-AREA. CL183 +00603 10 WRK-MNTE-MSG-LINE1. CL183 +00604 15 FILLER PIC X(53) VALUE CL214 +00605 'PER RETURNED TAX RATE NOTICE RECEIVED, RETURN MAIL FL'. CL231 +00606 15 FILLER PIC X(20) VALUE CL217 +00607 'AG HAS BEEN UPDATED '. CL231 +00608 10 WRK-MNTE-MSG-LINE2. CL183 +00609 15 FILLER PIC X(53) VALUE CL214 +00610 'TO YES. MAILING ADDRESS VERIFICATION PROCESS IN PROGR'. CL231 +00611 15 FILLER PIC X(19) VALUE CL214 +00612 'ESS. '. CL231 +00613 10 WRK-MNTE-MSG-LINE3. CL183 +00614 15 FILLER PIC X(53) VALUE CL214 +00615 ' '. CL229 +00616 15 FILLER PIC X(19) VALUE CL214 +00617 ' '. CL216 +00618 * 'CORRESPONDENCE RESUMED.'. CL198 +00619 * CL190 +00620 01 HEADER-1. DTSBX657 +00621 05 FILLER PIC X(01) VALUE SPACES. DTSBX657 +00622 05 FILLER PIC X(49) VALUE '016R1'. DTSBX657 +00623 05 FILLER PIC X(60) VALUE DTSBX657 +00624 'DISTRICT OF COLUMBIA'. DTSBX657 +00625 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBX657 +00626 05 HDR1-LRCM-SYS-DATE PIC X(08). DTSBX657 +00627 DTSBX657 +00628 01 HEADER-2. DTSBX657 +00629 05 FILLER PIC X(54) VALUE SPACES. DTSBX657 +00630 05 FILLER PIC X(56) VALUE DTSBX657 +00631 'TAX DIVISION'. DTSBX657 +00632 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBX657 +00633 05 HDR2-LRCM-SYS-TIME PIC X(08). DTSBX657 +00634 DTSBX657 +00635 01 HEADER-3. DTSBX657 +00636 05 FILLER PIC X(01) VALUE SPACES. DTSBX657 +00637 05 FILLER PIC X(38) VALUE DTSBX657 +00638 'ROUTE TO: ACCOUNTING UNIT'. DTSBX657 +00639 05 HDR3-LITERAL PIC X(43) VALUE DTSBX657 +00640 ' EMPLOYERS REGISTERED SINCE 09/11/01 '. DTSBX657 +00641 05 FILLER PIC X(28) VALUE SPACES. DTSBX657 +00642 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBX657 +00643 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBX657 +00644 DTSBX657 +00645 01 HEADER-4. DTSBX657 +00646 05 FILLER PIC X(01) VALUE SPACES. DTSBX657 +00647 05 FILLER PIC X(132) VALUE SPACES. DTSBX657 +00648 DTSBX657 +00649 01 HEADER-5. DTSBX657 +00650 05 FILLER PIC X(01) VALUE SPACES. DTSBX657 +00651 05 FILLER PIC X(05) VALUE SPACES. DTSBX657 +00652 05 FILLER PIC X(06) VALUE DTSBX657 +00653 'EMP NO'. DTSBX657 +00654 05 FILLER PIC X(05) VALUE SPACES. DTSBX657 +00655 05 FILLER PIC X(12) VALUE DTSBX657 +00656 'PRIMARY NAME'. DTSBX657 +00657 05 FILLER PIC X(28) VALUE SPACES. DTSBX657 +00658 05 FILLER PIC X(04) VALUE SPACES. DTSBX657 +00659 05 FILLER PIC X(14) VALUE DTSBX657 +00660 'LIABILITY DATE'. DTSBX657 +00661 05 FILLER PIC X(04) VALUE SPACES. DTSBX657 +00662 05 FILLER PIC X(13) VALUE DTSBX657 +00663 'INACTIVE DATE'. DTSBX657 +00664 05 FILLER PIC X(12) VALUE SPACES. DTSBX657 +00665 05 FILLER PIC X(18) VALUE SPACES. DTSBX657 +00666 DTSBX657 +00667 01 HEADER-6. DTSBX657 +00668 05 FILLER PIC X(01) VALUE SPACES. DTSBX657 +00669 05 FILLER PIC X(132) VALUE SPACES. DTSBX657 +00670 DTSBX657 +00671 01 DETAIL-LINE-1. DTSBX657 +00672 05 FILLER PIC X(05) VALUE SPACES. DTSBX657 +00673 05 WS-EMP-NO PIC 999B999. DTSBX657 +00674 05 FILLER PIC X(02) VALUE SPACES. DTSBX657 +00675 05 WS-PRIMARY-NAME PIC X(40). DTSBX657 +00676 05 FILLER PIC X(02) VALUE SPACES. DTSBX657 +00677 05 WS-DATE1 PIC X(10). DTSBX657 +00678 05 FILLER PIC X(02) VALUE SPACES. DTSBX657 +00679 05 WS-DATE2 PIC X(10). DTSBX657 +00680 * 05 FILLER PIC X(05) VALUE SPACES. DTSBX657 +00681 * 05 WS-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBX657 +00682 * 05 FILLER PIC X(09) VALUE SPACES. DTSBX657 +00683 * 05 WS-PURSUED-RPT PIC ZZ9. DTSBX657 +00684 * 05 FILLER PIC X(10) VALUE SPACES. DTSBX657 +00685 * 05 WS-DPC PIC X(01). DTSBX657 +00686 * 05 FILLER PIC X(06) VALUE SPACES. DTSBX657 +00687 * 05 WS-LIEN PIC X(01). DTSBX657 +00688 * 05 FILLER PIC X(21) VALUE SPACES. DTSBX657 +00689 DTSBX657 +00690 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSBX657 +00691 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSBX657 +00692 DTSBX657 +00693 01 FOOTING-LINE-3. DTSBX657 +00694 05 FILLER PIC X(25) VALUE SPACES. DTSBX657 +00695 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSBX657 +00696 05 FILLER PIC X(02) VALUE SPACES. DTSBX657 +00697 05 FILLER PIC X(43) VALUE DTSBX657 +00698 'DEBIT WRITE OFF CANDIDATES LISTED ON REPORT'.DTSBX657 +00699 05 FILLER PIC X(23) VALUE SPACES. DTSBX657 +00700 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. DTSBX657 +00701 01 FOOTING-LINE-5 PIC X(133) VALUE SPACES. DTSBX657 +00702 01 FOOTING-LINE-6. DTSBX657 +00703 05 FILLER PIC X(25) VALUE SPACES. DTSBX657 +00704 05 FILLER PIC X(17) VALUE DTSBX657 +00705 '*** END OF REPORT'. DTSBX657 +00706 *RW2 DTSBX657 +00707 DTSBX657 +00708 01 TSKL-REC. CL183 +00709 ++INCLUDE DTSITSKL CL183 +00710 EJECT CL183 +00711 01 T003-REC. CL183 +00712 ++INCLUDE DTSIT003 CL183 +00713 EJECT CL183 +00714 01 L001-LINK-AREA. DTSBX657 +00715 ++INCLUDE DTSIL001 DTSBX657 +00716 EJECT DTSBX657 +00717 01 L005-LINK-AREA. CL157 +00718 ++INCLUDE DTSIL005 DTSBX657 +00719 EJECT DTSBX657 +00720 01 L331-LINK-AREA. CL209 +00721 ++INCLUDE DTSIL331 CL209 +00722 EJECT DTSBX657 +00723 01 L039-LINK-AREA. CL209 +00724 ++INCLUDE DTSIL039 CL209 +00725 EJECT CL209 +00726 01 L101-LINK-AREA. CL*23 +00727 ++INCLUDE DTSIL101 CL*23 +00728 EJECT DTSBX657 +00729 01 L102-LINK-AREA. CL*23 +00730 ++INCLUDE DTSIL102 CL*23 +00731 EJECT CL*23 +00732 01 L109-LINK-AREA. CL*23 +00733 ++INCLUDE DTSIL109 CL*23 +00734 CL*23 +00735 01 L054-LINK-AREA. DTSBX657 +00736 ++INCLUDE DTSIL054 DTSBX657 +00737 EJECT DTSBX657 +00738 01 L410-LINK-AREA. DTSBX657 +00739 ++INCLUDE DTSIL410 DTSBX657 +00740 EJECT DTSBX657 +00741 01 L600-LINK-AREA. DTSBX657 +00742 ++INCLUDE DTSIL600 DTSBX657 +00743 EJECT DTSBX657 +00744 01 L910-LINK-AREA. DTSBX657 +00745 ++INCLUDE DTSIL910 DTSBX657 +00746 EJECT DTSBX657 +00747 01 MSKL-REC. DTSBX657 +00748 ++INCLUDE DTSIMSKL DTSBX657 +00749 EJECT DTSBX657 +00750 01 MLOG-REC. CL240 +00751 ++INCLUDE DTSIMLOG CL240 +00752 01 MNTE-REC. CL240 +00753 ++INCLUDE DTSIMNTE CL240 +00754 EJECT CL183 +00755 01 MHDR-REC. DTSBX657 +00756 ++INCLUDE DTSIMHDR DTSBX657 +00757 EJECT DTSBX657 +00758 01 MPRF-REC. CL164 +00759 ++INCLUDE DTSIMPRF CL164 +00760 EJECT CL164 +00761 01 MQTR-REC. DTSBX657 +00762 ++INCLUDE DTSIMQTR DTSBX657 +00763 EJECT DTSBX657 +00764 01 MRPT-REC. DTSBX657 +00765 ++INCLUDE DTSIMRPT DTSBX657 +00766 EJECT DTSBX657 +00767 01 MSOL-REC. DTSBX657 +00768 ++INCLUDE DTSIMSOL DTSBX657 +00769 EJECT DTSBX657 +00770 01 MRCT-REC. DTSBX657 +00771 ++INCLUDE DTSIMRCT DTSBX657 +00772 EJECT DTSBX657 +00773 01 MREL-REC. DTSBX657 +00774 ++INCLUDE DTSIMREL DTSBX657 +00775 EJECT DTSBX657 +00776 01 MEVL-REC. DTSBX657 +00777 ++INCLUDE DTSIMEVL DTSBX657 +00778 EJECT DTSBX657 +00779 01 MLIN-REC. DTSBX657 +00780 ++INCLUDE DTSIMLIN DTSBX657 +00781 EJECT DTSBX657 +00782 01 MRTE-REC. DTSBX657 +00783 ++INCLUDE DTSIMRTE DTSBX657 +00784 EJECT DTSBX657 +00785 01 MDST-REC. DTSBX657 +00786 ++INCLUDE DTSIMDST DTSBX657 +00787 EJECT DTSBX657 +00788 01 MPAY-REC. DTSBX657 +00789 ++INCLUDE DTSIMPAY DTSBX657 +00790 EJECT DTSBX657 +00791 01 MADJ-REC. DTSBX657 +00792 ++INCLUDE DTSIMADJ DTSBX657 +00793 EJECT DTSBX657 +00794 01 MJRN-REC. DTSBX657 +00795 ++INCLUDE DTSIMJRN DTSBX657 +00796 EJECT DTSBX657 +00797 01 MERA-REC. DTSBX657 +00798 ++INCLUDE DTSIMERA DTSBX657 +00799 EJECT DTSBX657 +00800 01 MCOL-REC. DTSBX657 +00801 ++INCLUDE DTSIMCOL DTSBX657 +00802 EJECT DTSBX657 +00803 01 MFAS-REC. DTSBX657 +00804 ++INCLUDE DTSIMFAS DTSBX657 +00805 01 MAUR-REC. DTSBX657 +00806 ++INCLUDE DTSIMAUR DTSBX657 +00807 EJECT DTSBX657 +00808 01 MFAE-REC. DTSBX657 +00809 ++INCLUDE DTSIMFAE DTSBX657 +00810 EJECT DTSBX657 +00811 EJECT DTSBX657 +00812 01 MOPO-REC. DTSBX657 +00813 ++INCLUDE DTSIMOPO DTSBX657 +00814 EJECT DTSBX657 +00815 01 MTAD-REC. DTSBX657 +00816 ++INCLUDE DTSIMTAD DTSBX657 +00817 EJECT DTSBX657 +00818 01 MTAA-REC. DTSBX657 +00819 ++INCLUDE DTSIMTAA DTSBX657 +00820 EJECT DTSBX657 +00821 01 MBAA-REC. DTSBX657 +00822 ++INCLUDE DTSIMBAA DTSBX657 +00823 EJECT DTSBX657 +00824 01 MFSC-REC. DTSBX657 +00825 ++INCLUDE DTSIMFSC DTSBX657 +00826 EJECT DTSBX657 +00827 01 MERD-REC. DTSBX657 +00828 ++INCLUDE DTSIMERD DTSBX657 +00829 EJECT DTSBX657 +00830 01 MDPC-REC. DTSBX657 +00831 ++INCLUDE DTSIMDPC DTSBX657 +00832 EJECT DTSBX657 +00833 01 L921-LINK-AREA. DTSBX657 +00834 ++INCLUDE DTSIL921 DTSBX657 +00835 EJECT DTSBX657 +00836 01 ISKL-REC. DTSBX657 +00837 ++INCLUDE DTSIISKL DTSBX657 +00838 EJECT DTSBX657 +00839 01 IPES-REC. DTSBX657 +00840 ++INCLUDE DTSIIPES DTSBX657 +00841 EJECT DTSBX657 +00842 01 L931-LINK-AREA. DTSBX657 +00843 ++INCLUDE DTSIL931 DTSBX657 +00844 EJECT DTSBX657 +00845 01 FSKL-REC. DTSBX657 +00846 ++INCLUDE DTSIFSKL DTSBX657 +00847 EJECT DTSBX657 +00848 01 FQTR-REC. DTSBX657 +00849 ++INCLUDE DTSIFQTR DTSBX657 +00850 EJECT DTSBX657 +00851 01 FFIS-REC. DTSBX657 +00852 ++INCLUDE DTSIFFIS DTSBX657 +00853 EJECT DTSBX657 +00854 01 FFAZ-REC. DTSBX657 +00855 ++INCLUDE DTSIFFAZ DTSBX657 +00856 EJECT DTSBX657 +00857 01 FOPR-REC. DTSBX657 +00858 ++INCLUDE DTSIFOPR DTSBX657 +00859 EJECT DTSBX657 +00860 01 L933-LINK-AREA. DTSBX657 +00861 ++INCLUDE DTSIL933 DTSBX657 +00862 EJECT DTSBX657 +00863 01 XSIC-REC. DTSBX657 +00864 ++INCLUDE DTSIXSIC DTSBX657 +00865 EJECT DTSBX657 +00866 01 L004-COMM-AREA. DTSBX657 +00867 ++INCLUDE DTSIL004 DTSBX657 +00868 DTSBX657 +00869 01 L061-LINK-AREA. DTSBX657 +00870 ++INCLUDE DTSIL061 DTSBX657 +00871 DTSBX657 +00872 01 L062-LINK-AREA. DTSBX657 +00873 ++INCLUDE DTSIL062 DTSBX657 +00874 DTSBX657 +00875 01 L516-LINK-AREA. DTSBX657 +00876 ++INCLUDE DTSIL516 DTSBX657 +00877 EJECT DTSBX657 +00878 01 LBCM-LINK-AREA. CL173 +00879 ++INCLUDE DTSILBCM CL173 +00880 EJECT CL154 +00881 01 L923-LINK-AREA. CL183 +00882 ++INCLUDE DTSIL923 CL183 +00883 EJECT CL183 +00884 01 ASKL-REC. CL183 +00885 ++INCLUDE DTSIASKL CL183 +00886 EJECT CL183 +00887 01 AHDR-REC. CL183 +00888 ++INCLUDE DTSIAHDR CL183 +00889 EJECT CL183 +00890 01 AADJ-REC. CL183 +00891 ++INCLUDE DTSIAADJ CL183 +00892 EJECT CL183 +00893 01 L927-LINK-AREA. CL183 +00894 ++INCLUDE DTSIL927 CL183 +00895 EJECT CL183 +00896 PROCEDURE DIVISION. CL228 +00897 CL164 +00898 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX657 +00899 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX657 +00900 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX657 +00901 SKIP2 DTSBX657 +00902 GOBACK. DTSBX657 +00903 EJECT DTSBX657 +00904 I0000-INITIATE. DTSBX657 +00905 SKIP2 DTSBX657 +00906 MOVE 'N' TO WRK-TRACE-IND. DTSBX657 +00907 SET WRK-ERROR-NO-88 TO TRUE. DTSBX657 +00908 MOVE +0 TO WRK-MPRF-REC-CNT CL193 +00909 DTSBX657 +00910 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBX657 +00911 DTSBX657 +00912 MOVE +0 TO WRK-MPRF-CNT CL120 +00913 WRK-MQTR-CNT CL120 +00914 WRK-MLOG-CNT CL120 +00915 WRK-MEVL-DELETED-CNT. CL120 +00916 CL120 +00917 I0000-EXIT. DTSBX657 +00918 EXIT. DTSBX657 +00919 I2000-OPEN-FILES-1. DTSBX657 +00920 DISPLAY 'UPD RETURN FLAG TO Y - BAD ADDR TAX RATE RETURNED' CL231 +00921 DISPLAY ' '. CL220 +00922 OPEN INPUT EMP-FILE1. CL120 +00923 IF NOT EXP-STATUS-OK-88 DTSBX657 +00924 DISPLAY 'CANNOT OPEN EXP FILE ' EXP-STATUS DTSBX657 +00925 SET WRK-ERROR-YES-88 TO TRUE DTSBX657 +00926 GO TO I2000-EXIT. DTSBX657 +00927 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX657 +00928 DTSBX657 +00929 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX657 +00930 DTSBX657 +00931 * PERFORM S910-OPEN-READ THRU S910-EXIT. CL171 +00932 PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL176 +00933 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. CL189 +00934 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. CL189 +00935 DTSBX657 +00936 * PERFORM S921-OPEN-READ THRU S921-EXIT. CL123 +00937 PERFORM S005-FROM-SYS THRU S005-EXIT. CL187 +00938 DTSBX657 +00939 ** PERFORM S931-OPEN-READ THRU S931-EXIT. CL122 +00940 * PERFORM S931-OPEN-UPDATE THRU S931-EXIT. CL176 +00941 DTSBX657 +00942 MOVE WRK-MOD-NAME TO L933-MOD-NAME. DTSBX657 +00943 DTSBX657 +00944 *** PERFORM S933-OPEN-READ THRU S933-EXIT. DTSBX657 +00945 DTSBX657 +00946 I2000-EXIT. DTSBX657 +00947 EXIT. DTSBX657 +00948 DTSBX657 +00949 P0000-PROCESS. DTSBX657 +00950 * DISPLAY 'IN P0000-PROCESS'. CL220 +00951 READ EMP-FILE1 AT END GO TO P0000-EXIT. CL122 +00952 DTSBX657 +00953 MOVE INEMP-NOA TO WS-EMP-NOA. CL254 +00954 MOVE INEMP-NOB TO WS-EMP-NOB. CL254 +00955 ADD 1 TO IN-REC-CNT. CL122 +00956 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL129 +00957 SET MPRF-PRF-88 TO TRUE. CL129 +00958 DTSBX657 +00959 MOVE WS-EMP-NO1 TO WS-EMP-NOZ. CL**2 +00960 MOVE WS-EMP-NOZ TO MPRF-EMP-NO. CL**2 +00961 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL119 +00962 DTSBX657 +00963 PERFORM S910-READ THRU S910-EXIT. DTSBX657 +00964 IF L910-NO-REC-88 CL119 +00965 DISPLAY ' EMP NOT FOUND ' WS-EMP-NOZ CL**2 +00966 GO TO P0000-PROCESS. CL119 +00967 ADD 1 TO MPRF-REC-CNT. CL122 +00968 MOVE MSKL-REC TO MPRF-REC CL119 +00969 CL204 +00970 IF MPRF-RETURN-MAIL-YES-88 CL252 +00971 DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL FLAG = Y ' CL252 +00972 '----**** FLAG NOT UPDATED' CL252 +00973 GO TO P0000-PROCESS. CL252 +00974 CL227 +00975 MOVE +0 TO WRK-MEVL-REWRITE-CNT CL231 +00976 PERFORM P6000-SCAN-EVL THRU P6000-EXIT. CL231 +00977 IF WRK-MEVL-REWRITE-CNT = 1 CL231 +00978 DISPLAY MPRF-EMP-NO ' DUTAS ADDRESS UPDATED ' CL253 +00979 '----++++ FLAG NOT UPDATED' CL253 +00980 GO TO P0000-PROCESS. CL231 +00981 PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT. CL217 +00982 PERFORM P3000-ADD-MNTE THRU P3000-EXIT CL225 +00983 SET MPRF-RETURN-MAIL-YES-88 TO TRUE CL221 +00984 MOVE L005-DATE TO MPRF-CHNG-DATE CL228 +00985 MOVE MPRF-REC TO MSKL-REC CL228 +00986 PERFORM S910-REWRITE THRU S910-EXIT CL221 +00987 DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL FLAG UPDATED TO Y ' CL231 +00988 '---- RTN FLAG UPDATED' CL231 +00989 ADD +1 TO WRK-MPRF-REC-CNT CL221 +00990 GO TO P0000-PROCESS. CL155 +00991 P0000-EXIT. CL119 +00992 EXIT. DTSBX657 +00993 P1100-CHECK-FOR-MLOG. CL208 +00994 ADD +5000 TO WRK-ABSTIME CL222 +00995 PERFORM S005-FROM-SYS THRU S005-EXIT CL208 +00996 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL208 +00997 MOVE MPRF-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL208 +00998 MOVE L005-DATE TO L331-CURR-RUN-DATE CL212 +00999 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL208 +01000 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL208 +01001 MOVE 'DTSBX657' TO L331-OP-ID CL254 +01002 MOVE 'RETURN MAIL IND' TO L331-FIELD-NAME CL208 +01003 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE CL221 +01004 * MOVE 'N' TO L331-FROM-VALUE CL221 +01005 MOVE 'Y' TO L331-TO-VALUE CL213 +01006 MOVE 'Y' TO MPRF-RETURN-MAIL-IND CL213 +01007 * MOVE +1 TO WRK-MPRF-MAIL-UPD-CNT CL211 +01008 * DISPLAY ' RETURN MAIL UPDATED: ' WRK-EMP-NO CL220 +01009 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL208 +01010 P1100-EXIT. EXIT. CL208 +01011 CL208 +01012 P1600-FIND-QTR. CL208 +01013 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBX657 +01014 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBX657 +01015 SET MQTR-QTR-88 TO TRUE. DTSBX657 +01016 MOVE 20134 TO MQTR-YRQ. CL119 +01017 MOVE MQTR-REC TO MSKL-REC. DTSBX657 +01018 DTSBX657 +01019 PERFORM S910-READ THRU S910-EXIT. DTSBX657 +01020 IF L910-NO-REC-88 DTSBX657 +01021 DISPLAY ' QTR REC NOT FOUND ' MPRF-EMP-NO ' ' MQTR-YRQ CL119 +01022 GO TO P1600-EXIT DTSBX657 +01023 ELSE DTSBX657 +01024 MOVE MSKL-REC TO MQTR-REC. DTSBX657 +01025 DTSBX657 +01026 ADD 1 TO WRK-MQTR-FOUND-CNT. CL124 +01027 DISPLAY MPRF-EMP-NO CL121 +01028 'B CURR TYPE ' MQTR-CURR-RPT-TYPE CL121 +01029 'B CUTOFF CD ' MQTR-MISS-RPT-CUTOFF-CD CL124 +01030 'B PURSUD ID ' MQTR-PURSUED-RPT-IND. CL121 +01031 DTSBX657 +01032 IF MQTR-CURR-RCVD-88 OR CL135 +01033 MQTR-CURR-NOT-LIABLE-88 CL135 +01034 * SET MQTR-CURR-ORIG-88 TO TRUE CL133 +01035 * SET MQTR-RPT-NOT-PURSUED-88 TO TRUE CL133 +01036 SET MQTR-MISS-NOT-YET-RUN-88 TO TRUE CL122 +01037 MOVE MQTR-REC TO MSKL-REC CL119 +01038 PERFORM S910-REWRITE THRU S910-EXIT CL136 +01039 ADD 1 TO WRK-MQTR-UPDATED-CNT CL131 +01040 CL122 +01041 DISPLAY MPRF-EMP-NO CL122 +01042 'A CURR TYPE ' MQTR-CURR-RPT-TYPE CL122 +01043 'A CUTOFF CD ' MQTR-MISS-RPT-CUTOFF-CD CL124 +01044 'A PURSUD ID ' MQTR-PURSUED-RPT-IND CL134 +01045 ELSE CL134 +01046 DISPLAY MPRF-EMP-NO CL134 +01047 'Z CURR TYPE ' MQTR-CURR-RPT-TYPE CL134 +01048 'Z CUTOFF CD ' MQTR-MISS-RPT-CUTOFF-CD CL134 +01049 'Z PURSUD ID ' MQTR-PURSUED-RPT-IND. CL134 +01050 P1600-EXIT. DTSBX657 +01051 EXIT. DTSBX657 +01052 DTSBX657 +01053 P6000-SCAN-EVL. CL122 +01054 SET WRK-MEVL-OK TO TRUE. CL122 +01055 MOVE +0 TO WRK-RECEIVED-DATE. CL122 +01056 MOVE LOW-VALUES TO MLOG-KEY-AREA CL242 +01057 MSKL-KEY-AREA. CL242 +01058 MOVE MPRF-EMP-NO TO MLOG-EMP-NO. CL240 +01059 SET MLOG-LOG-88 TO TRUE. CL240 +01060 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. CL240 +01061 CL122 +01062 PERFORM S910-START-BROWSE THRU S910-EXIT. CL122 +01063 IF L910-NO-REC-88 CL122 +01064 DISPLAY ' EVENT LOG NOT FOUND ' MPRF-EMP-NO CL122 +01065 SET WRK-MEVL-NO-REC TO TRUE CL206 +01066 GO TO P6000-EXIT CL122 +01067 ELSE CL122 +01068 PERFORM P6100-SCAN-MEVL THRU P6100-EXIT CL122 +01069 UNTIL WRK-MEVL-NO-REC. CL122 +01070 CL122 +01071 P6000-EXIT. CL122 +01072 EXIT. CL122 +01073 P6100-SCAN-MEVL. CL122 +01074 MOVE MSKL-REC TO MLOG-REC. CL240 +01075 * ADD 1 TO WRK-MEVL-FOUND-CNT. CL127 +01076 CL200 +01077 * DISPLAY 'MLOG EMP+ ' MLOG-EMP-NO. CL250 +01078 * IF MLOG-EMP-NO = 330099 CL252 +01079 * DISPLAY 'MLOG DAE+ ' MLOG-ESTB-DATE. CL252 +01080 IF MLOG-ESTB-DATE > 20190106 CL251 +01081 NEXT SENTENCE CL245 +01082 ELSE CL245 +01083 GO TO P6100-READ-NEXT. CL251 +01084 * SET WRK-MEVL-NO-REC TO TRUE CL251 +01085 * MOVE +1 TO WRK-MEVL-REWRITE-CNT CL251 +01086 * GO TO P6100-EXIT. CL251 +01087 CL200 +01088 DISPLAY ' MNTE PRIOR UPD ' MLOG-EMP-NO ' '. CL246 +01089 * IF MLOG-EMP-NO = 330099 CL252 +01090 IF MLOG-DATA-ELEMENT-NAME = 'MTAD-ATTN-LINE' OR CL244 +01091 MLOG-DATA-ELEMENT-NAME = 'MTAD-DELIV-LINE-1' OR CL244 +01092 MLOG-DATA-ELEMENT-NAME = 'MTAD-DELIV-LINE-2' OR CL244 +01093 MLOG-DATA-ELEMENT-NAME = 'MTAD-CITY' OR CL244 +01094 MLOG-DATA-ELEMENT-NAME = 'MTAD-ST' OR CL244 +01095 MLOG-DATA-ELEMENT-NAME = 'MTAD-ZIP' CL244 +01096 DISPLAY ' MLOG REWRITTEN ' MLOG-EMP-NO ' ' MLOG-ESTB-DATE CL252 +01097 SET WRK-MEVL-NO-REC TO TRUE CL252 +01098 MOVE +1 TO WRK-MEVL-REWRITE-CNT CL246 +01099 GO TO P6100-EXIT. CL237 +01100 CL204 +01101 GO TO P6100-READ-NEXT. CL204 +01102 * MOVE CL231 +01103 * 'DELINQUENCY NOTICE FOR 13/1 SENT TO MTAD 1 ' CL231 +01104 * TO MEVL-TEXT (1:46) CL231 +01105 * MOVE MEVL-REC TO MSKL-REC CL231 +01106 * PERFORM S910-REWRITE THRU S910-EXIT CL231 +01107 * PERFORM S910-DELETE THRU S910-EXIT CL139 +01108 * SET WRK-MEVL-OK-88 TO TRUE CL205 +01109 * DISPLAY ' MEVL REWRITTEN ' MEVL-EMP-NO ' ' MEVL-TEXT. CL231 +01110 * GO TO P6100-EXIT. CL204 +01111 CL122 +01112 * IF MEVL-DATE < 20140228 CL133 +01113 * SET WRK-MEVL-NO-REC TO TRUE CL133 +01114 * GO TO P6100-EXIT. CL133 +01115 P6100-READ-NEXT. CL204 +01116 CL132 +01117 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX657 +01118 IF L910-NO-REC-88 DTSBX657 +01119 SET WRK-MEVL-NO-REC TO TRUE. DTSBX657 +01120 DTSBX657 +01121 P6100-EXIT. DTSBX657 +01122 EXIT. DTSBX657 +01123 DTSBX657 +01124 P6150-MNTE-NOTE. CL237 +01125 DISPLAY MNTE-TEXT(MNTE-TEXT-CNT). CL238 +01126 P6150-EXIT. CL237 +01127 EXIT. CL237 +01128 CL237 +01129 S6000-WRITE-MEVL. CL154 +01130 MOVE LOW-VALUES TO MEVL-REC. CL165 +01131 MOVE LOW-VALUES TO LBCM-RUN-AREA. CL173 +01132 CL173 +01133 MOVE ZERO TO LBCM-EMP-ABSTIME. CL173 +01134 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL165 +01135 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 +01136 SET MEVL-EVL-88 TO TRUE. CL165 +01137 ADD +6000 TO LBCM-EMP-ABSTIME. CL182 +01138 CL154 +01139 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. CL173 +01140 CL154 +01141 PERFORM S005-FROM-ABSTIME THRU S005-A-EXIT. CL173 +01142 CL154 +01143 CL154 +01144 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 +01145 CL154 +01146 MOVE L005-DATE TO MEVL-DATE. CL181 +01147 CL154 +01148 MOVE L005-TIME TO MEVL-TIME. CL181 +01149 CL154 +01150 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 +01151 CL154 +01152 MOVE ZEROS TO MEVL-PURGE-DATE. CL154 +01153 CL154 +01154 CL154 +01155 * MOVE EVL-TEXT TO MEVL-TEXT. CL184 +01156 CL154 +01157 **** SET MEVL-SOURCE-SYSTEM-88 TO TRUE. CL154 +01158 ** MOVE MPAY-RESPONSIBLE-OP-ID TO MEVL-SOURCE. CL180 +01159 CL154 +01160 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL154 +01161 * MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL180 +01162 MOVE 20170127 TO MEVL-ESTB-DATE CL180 +01163 MEVL-CHNG-DATE. CL154 +01164 CL154 +01165 CL154 +01166 MOVE MEVL-REC TO MSKL-REC. CL154 +01167 CL154 +01168 PERFORM S910-WRITE THRU S910-EXIT. CL154 +01169 S6000-EXIT. CL154 +01170 EXIT. CL154 +01171 EJECT CL154 +01172 DTSBX657 +01173 P3000-ADD-MNTE. CL183 +01174 MOVE LENGTH OF T003-REC TO T003-LENGTH. CL183 +01175 MOVE '003' TO T003-REC-TYPE. CL183 +01176 MOVE 'SYSTEM ' TO T003-ORIGIN. CL183 +01177 MOVE L005-DATE TO T003-SYS-DATE. CL183 +01178 MOVE L005-TIME TO T003-SYS-TIME. CL183 +01179 SET T003-ADD-MNTE-88 TO TRUE. CL183 +01180 CL183 +01181 MOVE LOW-VALUES TO CL183 +01182 MNTE-KEY-AREA. CL183 +01183 MOVE MPRF-EMP-NO TO MNTE-EMP-NO. CL183 +01184 SET MNTE-NTE-88 TO TRUE. CL183 +01185 MOVE +0 TO MNTE-PURGE-DATE. CL183 +01186 SET MNTE-NOT-CONVERTED-88 TO TRUE. CL183 +01187 CL183 +01188 MOVE L005-DATE TO MNTE-ESTB-DATE CL183 +01189 MNTE-CHNG-DATE. CL183 +01190 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME CL183 +01191 MNTE-DATA-ESTB-ABSTIME CL183 +01192 MNTE-CHNG-ABSTIME. CL183 +01193 MOVE 'NCOAX655' TO MNTE-ESTB-OP-ID CL228 +01194 MNTE-CHNG-OP-ID. CL183 +01195 CL183 +01196 MOVE 'RETURN MAIL FLAG UPDATED TO YES ' CL229 +01197 TO MNTE-SUBJECT. CL183 +01198 CL183 +01199 MOVE +3 TO MNTE-TEXT-CNT. CL190 +01200 CL183 +01201 MOVE WRK-MNTE-MSG-LINE1 TO MNTE-TEXT (1). CL183 +01202 MOVE WRK-MNTE-MSG-LINE2 TO MNTE-TEXT (2). CL183 +01203 * MOVE WRK-MNTE-MSG-LINE3 TO MNTE-TEXT (3). CL229 +01204 CL183 +01205 MOVE MPRF-EMP-NO TO T003-EMP-NO. CL183 +01206 MOVE MNTE-REC TO T003-MNTE-REC. CL183 +01207 CL183 +01208 MOVE T003-REC TO TSKL-REC. CL183 +01209 PERFORM S927-WRITE THRU S927-EXIT. CL183 +01210 ADD +1 TO WRK-T003-CNT. CL183 +01211 CL183 +01212 P3000-EXIT. CL183 +01213 EXIT. CL183 +01214 CL183 +01215 SKIP3 CL183 +01216 T0000-TERMINATE. DTSBX657 +01217 DTSBX657 +01218 DISPLAY ' '. DTSBX657 +01219 DTSBX657 +01220 DISPLAY '*** DTSZX016 TERMINATION STATISTICS ***'. CL123 +01221 DTSBX657 +01222 DISPLAY ' '. DTSBX657 +01223 DTSBX657 +01224 DISPLAY 'INPUT RECORDS READ : ' CL123 +01225 IN-REC-CNT CL123 +01226 CL123 +01227 DISPLAY 'RETURN MAIL UPDATE : ' CL192 +01228 WRK-MPRF-REC-CNT CL192 +01229 CL192 +01230 CL123 +01231 DISPLAY 'ACTIVE EMPLOYERS FOUND : ' CL123 +01232 MPRF-WRK-CNT. CL123 +01233 CL123 +01234 DISPLAY 'QTR RECS FOUND : ' CL123 +01235 WRK-MQTR-FOUND-CNT. CL123 +01236 CL123 +01237 DISPLAY 'QTR RECS UPDATED : ' CL123 +01238 WRK-MQTR-UPDATED-CNT. CL123 +01239 DTSBX657 +01240 DISPLAY 'MEVL REC FOUND : ' CL123 +01241 WRK-MEVL-FOUND-CNT. CL123 +01242 DTSBX657 +01243 DISPLAY 'MEVL REC UPDATED : ' CL123 +01244 ** WRK-MEVL-DELETED-CNT. CL149 +01245 WRK-MEVL-REWRITE-CNT. CL149 +01246 CL123 +01247 CLOSE EMP-FILE1. CL123 +01248 DTSBX657 +01249 PERFORM S923-CLOSE THRU S923-EXIT. CL189 +01250 PERFORM S927-CLOSE THRU S927-EXIT. CL189 +01251 CL183 +01252 PERFORM S910-CLOSE THRU S910-EXIT. CL176 +01253 * PERFORM S921-CLOSE THRU S921-EXIT. CL123 +01254 * PERFORM S931-CLOSE THRU S931-EXIT. CL176 +01255 *** PERFORM S933-CLOSE THRU S933-EXIT. DTSBX657 +01256 DTSBX657 +01257 T0000-EXIT. DTSBX657 +01258 EXIT. DTSBX657 +01259 EJECT DTSBX657 +01260 S001-FROM-FED-8. DTSBX657 +01261 SET L001-FROM-FED-8 TO TRUE. DTSBX657 +01262 GO TO S001-DATE. DTSBX657 +01263 DTSBX657 +01264 S001-FROM-ABS-DAY. DTSBX657 +01265 SET L001-FROM-ABS-DAY TO TRUE. DTSBX657 +01266 GO TO S001-DATE. DTSBX657 +01267 DTSBX657 +01268 S001-DATE. DTSBX657 +01269 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX657 +01270 DTSBX657 +01271 S001-EXIT. DTSBX657 +01272 EXIT. DTSBX657 +01273 SKIP3 DTSBX657 +01274 S004-FROM-5. DTSBX657 +01275 SET L004-FROM-5 TO TRUE. DTSBX657 +01276 GO TO S004-EDIT-QTR. DTSBX657 +01277 DTSBX657 +01278 S004-FROM-ABS. DTSBX657 +01279 SET L004-FROM-ABS TO TRUE. DTSBX657 +01280 GO TO S004-EDIT-QTR. DTSBX657 +01281 DTSBX657 +01282 S004-EDIT-QTR. DTSBX657 +01283 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBX657 +01284 DTSBX657 +01285 S004-EXIT. DTSBX657 +01286 EXIT. DTSBX657 +01287 SKIP3 DTSBX657 +01288 DTSBX657 +01289 S005-FROM-SYS. CL187 +01290 SET L005-FROM-SYS TO TRUE. CL187 +01291 CALL 'DTSBU005' USING L005-LINK-AREA. CL187 +01292 CL187 +01293 S005-EXIT. CL187 +01294 EXIT. CL187 +01295 CL187 +01296 S005-FROM-ABSTIME. CL156 +01297 SET L005-FROM-ABSTIME TO TRUE. CL156 +01298 GO TO S005-ABSTIME. CL156 +01299 CL156 +01300 S005-ABSTIME. CL156 +01301 CALL 'DTSBU005' USING L005-LINK-AREA. CL156 +01302 S005-A-EXIT. CL156 +01303 EXIT. CL156 +01304 SKIP3 CL156 +01305 S910-WRITE. CL156 +01306 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL173 +01307 SET L910-WRITE-88 TO TRUE. CL156 +01308 GO TO S910-MSTR-IO. CL156 +01309 S039-SIC-EDIT. DTSBX657 +01310 CALL 'DTSBU039' USING L039-LINK-AREA. DTSBX657 +01311 S039-EXIT. DTSBX657 +01312 EXIT. DTSBX657 +01313 DTSBX657 +01314 S054-RATE-DETERMINATION. DTSBX657 +01315 CALL 'DTSBU054' USING L054-LINK-AREA DTSBX657 +01316 MRCT-REC. DTSBX657 +01317 DTSBX657 +01318 S054-EXIT. DTSBX657 +01319 EXIT. DTSBX657 +01320 SKIP3 DTSBX657 +01321 S061-FLD-REP-INFO. DTSBX657 +01322 SKIP1 DTSBX657 +01323 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBX657 +01324 SKIP2 DTSBX657 +01325 S061-EXIT. DTSBX657 +01326 EXIT. DTSBX657 +01327 DTSBX657 +01328 S062-FLD-REP-LOOKUP. DTSBX657 +01329 DTSBX657 +01330 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBX657 +01331 DTSBX657 +01332 S062-EXIT. DTSBX657 +01333 EXIT. DTSBX657 +01334 DTSBX657 +01335 S101-PER-MONTH-NO. CL*23 +01336 SET L101-PER-MONTH-NO-88 TO TRUE. CL*23 +01337 GO TO S101-INT-CHARGE. CL*23 +01338 CL*23 +01339 S101-INT-CHARGE. CL*23 +01340 CALL 'DTSBU101' USING L101-LINK-AREA. CL*23 +01341 S101-EXIT. CL*23 +01342 EXIT. CL*23 +01343 CL*23 +01344 S109-FIRST-PEN-INT-YRQ. CL*23 +01345 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. CL*23 +01346 CALL 'DTSBU109' USING L109-LINK-AREA. CL*23 +01347 S109-EXIT. CL*23 +01348 EXIT. CL*23 +01349 S331-WRITE-MLOG. CL210 +01350 CALL 'DTSBU331' USING L331-LINK-AREA. CL210 +01351 S331-EXIT. CL210 +01352 EXIT. CL210 +01353 SKIP3 CL210 +01354 CL*23 +01355 S410-FILING-SCHED. DTSBX657 +01356 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBX657 +01357 DTSBX657 +01358 S410-EXIT. DTSBX657 +01359 EXIT. DTSBX657 +01360 SKIP3 DTSBX657 +01361 S516-LIABILITY. DTSBX657 +01362 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX657 +01363 MPRF-REC. DTSBX657 +01364 DTSBX657 +01365 S516-EXIT. DTSBX657 +01366 EXIT. DTSBX657 +01367 SKIP3 DTSBX657 +01368 S910-OPEN-READ. DTSBX657 +01369 SET L910-OPEN-READ-88 TO TRUE. DTSBX657 +01370 GO TO S910-MSTR-IO. DTSBX657 +01371 DTSBX657 +01372 S910-OPEN-UPDATE-NO-AIX. DTSBX657 +01373 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX657 +01374 GO TO S910-MSTR-IO. DTSBX657 +01375 DTSBX657 +01376 S910-READ. DTSBX657 +01377 SET L910-READ-88 TO TRUE. DTSBX657 +01378 GO TO S910-MSTR-IO. DTSBX657 +01379 DTSBX657 +01380 S910-START-BROWSE. DTSBX657 +01381 SET L910-START-BROWSE-88 TO TRUE. DTSBX657 +01382 GO TO S910-MSTR-IO. DTSBX657 +01383 DTSBX657 +01384 S910-READ-NEXT. DTSBX657 +01385 SET L910-READ-NEXT-88 TO TRUE. DTSBX657 +01386 GO TO S910-MSTR-IO. DTSBX657 +01387 DTSBX657 +01388 S910-COUNT. DTSBX657 +01389 SET L910-COUNT-88 TO TRUE. DTSBX657 +01390 GO TO S910-MSTR-IO. DTSBX657 +01391 DTSBX657 +01392 S910-REWRITE. DTSBX657 +01393 SET L910-REWRITE-88 TO TRUE. DTSBX657 +01394 GO TO S910-MSTR-IO. DTSBX657 +01395 DTSBX657 +01396 S910-DELETE. DTSBX657 +01397 SET L910-DELETE-88 TO TRUE. DTSBX657 +01398 GO TO S910-MSTR-IO. DTSBX657 +01399 DTSBX657 +01400 S910-CLOSE. DTSBX657 +01401 SET L910-CLOSE-88 TO TRUE. DTSBX657 +01402 GO TO S910-MSTR-IO. DTSBX657 +01403 DTSBX657 +01404 S910-MSTR-IO. DTSBX657 +01405 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX657 +01406 MSKL-REC. DTSBX657 +01407 S910-EXIT. DTSBX657 +01408 EXIT. DTSBX657 +01409 SKIP3 DTSBX657 +01410 S921-OPEN-READ. DTSBX657 +01411 SET L921-OPEN-READ-88 TO TRUE. DTSBX657 +01412 GO TO S921-AIX-IO. DTSBX657 +01413 DTSBX657 +01414 S921-START-BROWSE. DTSBX657 +01415 SET L921-START-BROWSE-88 TO TRUE. DTSBX657 +01416 GO TO S921-AIX-IO. DTSBX657 +01417 DTSBX657 +01418 S921-CLOSE. DTSBX657 +01419 SET L921-CLOSE-88 TO TRUE. DTSBX657 +01420 GO TO S921-AIX-IO. DTSBX657 +01421 DTSBX657 +01422 S923-CLOSE. CL183 +01423 SET L923-CLOSE-88 TO TRUE. CL183 +01424 GO TO S923-ATC-IO. CL183 +01425 CL183 +01426 S923-ATC-IO. CL183 +01427 CALL 'DTSBU923' USING L923-LINK-AREA CL183 +01428 ASKL-REC. CL183 +01429 S923-EXIT. CL183 +01430 EXIT. CL183 +01431 SKIP3 CL183 +01432 S921-AIX-IO. DTSBX657 +01433 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX657 +01434 ISKL-REC. DTSBX657 +01435 S921-EXIT. DTSBX657 +01436 EXIT. DTSBX657 +01437 SKIP3 DTSBX657 +01438 DTSBX657 +01439 S923-OPEN-UPDATE. CL183 +01440 SET L923-OPEN-UPDATE-88 TO TRUE. CL183 +01441 GO TO S923-ATC-IO. CL183 +01442 CL183 +01443 SKIP3 CL183 +01444 S927-OPEN-UPDATE. CL183 +01445 SET L927-OPEN-UPDATE-88 TO TRUE. CL183 +01446 GO TO S927-BTC-O. CL183 +01447 CL183 +01448 S927-WRITE. CL183 +01449 SET L927-WRITE-88 TO TRUE. CL183 +01450 GO TO S927-BTC-O. CL183 +01451 CL183 +01452 S927-CLOSE. CL183 +01453 SET L927-CLOSE-88 TO TRUE. CL183 +01454 GO TO S927-BTC-O. CL183 +01455 CL183 +01456 S927-BTC-O. CL183 +01457 CALL 'DTSBU927' USING L927-LINK-AREA CL183 +01458 TSKL-REC. CL183 +01459 S927-EXIT. CL183 +01460 EXIT. CL183 +01461 CL183 +01462 SKIP3 CL183 +01463 S931-OPEN-READ. DTSBX657 +01464 SET L931-OPEN-READ-88 TO TRUE. DTSBX657 +01465 GO TO S931-REF-IO. DTSBX657 +01466 DTSBX657 +01467 S931-OPEN-UPDATE. DTSBX657 +01468 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBX657 +01469 GO TO S931-REF-IO. DTSBX657 +01470 DTSBX657 +01471 S931-START-BROWSE. DTSBX657 +01472 SET L931-START-BROWSE-88 TO TRUE. DTSBX657 +01473 GO TO S931-REF-IO. DTSBX657 +01474 DTSBX657 +01475 S931-READ. DTSBX657 +01476 SET L931-READ-88 TO TRUE. DTSBX657 +01477 GO TO S931-REF-IO. DTSBX657 +01478 DTSBX657 +01479 S931-READ-NEXT. DTSBX657 +01480 SET L931-READ-NEXT-88 TO TRUE. DTSBX657 +01481 GO TO S931-REF-IO. DTSBX657 +01482 DTSBX657 +01483 S931-DELETE. DTSBX657 +01484 SET L931-DELETE-88 TO TRUE. DTSBX657 +01485 GO TO S931-REF-IO. DTSBX657 +01486 DTSBX657 +01487 S931-REWRITE. DTSBX657 +01488 SET L931-REWRITE-88 TO TRUE. DTSBX657 +01489 GO TO S931-REF-IO. DTSBX657 +01490 DTSBX657 +01491 S931-WRITE. DTSBX657 +01492 SET L931-WRITE-88 TO TRUE. DTSBX657 +01493 GO TO S931-REF-IO. DTSBX657 +01494 DTSBX657 +01495 S931-CLOSE. DTSBX657 +01496 SET L931-CLOSE-88 TO TRUE. DTSBX657 +01497 GO TO S931-REF-IO. DTSBX657 +01498 DTSBX657 +01499 S931-REF-IO. DTSBX657 +01500 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX657 +01501 FSKL-REC. DTSBX657 +01502 S931-EXIT. DTSBX657 +01503 EXIT. DTSBX657 +01504 SKIP3 DTSBX657 +01505 S933-OPEN-READ. DTSBX657 +01506 SET L933-OPEN-READ-88 TO TRUE. DTSBX657 +01507 GO TO S933-SIC-I. DTSBX657 +01508 DTSBX657 +01509 S933-CLOSE. DTSBX657 +01510 SET L933-CLOSE-88 TO TRUE. DTSBX657 +01511 GO TO S933-SIC-I. DTSBX657 +01512 DTSBX657 +01513 S933-SIC-I. DTSBX657 +01514 CALL 'DTSBU933' USING L933-LINK-AREA DTSBX657 +01515 XSIC-REC. DTSBX657 +01516 S933-EXIT. DTSBX657 +01517 EXIT. DTSBX657 +01518 DTSBX657 +01519 S999-ABEND. DTSBX657 +01520 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX657 +01521 S999-EXIT. DTSBX657 +01522 EXIT. DTSBX657 diff --git a/Batch/DTSBX706.cob b/Batch/DTSBX706.cob new file mode 100644 index 0000000..c75817b --- /dev/null +++ b/Batch/DTSBX706.cob @@ -0,0 +1,355 @@ +00001 IDENTIFICATION DIVISION. 12/22/16 +00002 PROGRAM-ID. DTSBX706. DTSBX706 +00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV023 +00004 DATE-WRITTEN. DECEMBER 1994. DTSBX706 +00005 DATE-COMPILED. DTSBX706 +00006 DTSBX706 +00007 ***** DTSBX706 +00008 * DTSBX706 +00009 * FUNCTION: FAILED FUTA CERTIFICATIONS- SAMPLES CL**3 +00010 * DTSBX706 +00011 * DTSBX706 +00012 * CALLING SEQUENCE: DTSBD300 CALLS DTSBD610 DTSBX706 +00013 * WHICH CREATES DTSIR705 RECORDS. DTSBX706 +00014 * DTSBD800 CALLS DTSBR705 DTSBX706 +00015 * WHICH PRODUCES THE FUTA FAILED DTSBX706 +00016 * CERTIFICATION LISTING. DTSBX706 +00017 * MODIFICATION HISTORY: DTSBX706 +00018 * DTSBX706 +00019 * 12-09-94 INITIAL DEVELOPMENT DTSBX706 +00020 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBX706 +00021 * DTSBX706 +00022 * 11-13-97 TAX YEAR 1996 MODIFICATIONS. FOUR DIGIT YEAR. DTSBX706 +00023 * REFERENCE RFP #TCL 222 AUTHOR OF CHANGE - EHH DTSBX706 +00024 * DTSBX706 +00025 * 02-22-99 MODIFIED TO MEET DUTAS PROGRAMMING SPAECIFICATIONS. DTSBX706 +00026 * REFERENCE RFP #**** AUTHOR OF CHANGE - DVS DTSBX706 +00027 * DTSBX706 +00028 * CL**3 +00029 * 10-08-16 MODIFIED TO PRINT 100 SAMPLES OF FAILED CERT FOR TAX. CL**3 +00030 * REFERENCE RFP TPM 12/08/16 AUTHOR OF CHANGE - ZL1 CL**3 +00031 * CL**3 +00032 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX706 +00033 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX706 +00034 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBX706 +00035 * DTSBX706 +00036 * DTSBX706 +00037 * DESCRIPTION: DTSBX706 +00038 * DTSBX706 +00039 * THIS MODULE GENERATES A DETAIL LINE FOR EVERY IRS FORM DTSBX706 +00040 * 940 IDENTIFICATION TAPE RECORD FOR WHICH THERE WAS NO DTSBX706 +00041 * MATCH ON THE MONTANA TAX SYSTEM MASTER FILE DURING DTSBX706 +00042 * YEARLY FUTA PROCESSING. DTSBX706 +00043 * DTSBX706 +00044 * DTSBX706 +00045 * RECORDS READ: DTSBX706 +00046 * DTSBX706 +00047 * NONE. DTSBX706 +00048 * DTSBX706 +00049 * DTSBX706 +00050 * PRINTED OUTPUTS: DTSBX706 +00051 * DTSBX706 +00052 * 705R1 FAILED FUTA CERTIFICATIONS DTSBX706 +00053 * DTSBX706 +00054 * DTSBX706 +00055 * RECORDS WRITTEN: DTSBX706 +00056 * DTSBX706 +00057 * NONE. DTSBX706 +00058 * DTSBX706 +00059 * DTSBX706 +00060 * MODULES CALLED: DTSBX706 +00061 * DTSBX706 +00062 * NONE. DTSBX706 +00063 * DTSBX706 +00064 * DTSBX706 +00065 ***** DTSBX706 +00066 EJECT DTSBX706 +00067 ENVIRONMENT DIVISION. DTSBX706 +00068 DTSBX706 +00069 CONFIGURATION SECTION. DTSBX706 +00070 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX706 +00071 DTSBX706 +00072 INPUT-OUTPUT SECTION. DTSBX706 +00073 DTSBX706 +00074 FILE-CONTROL. DTSBX706 +00075 SELECT ACHLOG-FILE ASSIGN TO DTSPACHF CL*16 +00076 file status is achlog-status. CL*16 +00077 DATA DIVISION. DTSBX706 +00078 DTSBX706 +00079 FILE SECTION. DTSBX706 +00080 DTSBX706 +00081 FD ACHLOG-FILE CL**4 +00082 RECORDING MODE IS V. CL*20 +00083 01 ACHLOG-REC. CL**4 +00084 05 ACH-RTN-CODE PIC X(08). CL**4 +00085 05 FILLER PIC X(01). CL**4 +00086 05 ACH-RTN-DETAIL PIC X(22). CL**4 +00087 05 FILLER PIC X(48). CL**4 +00088 05 FILLER PIC X(945). CL*22 +00089 DTSBX706 +00090 EJECT DTSBX706 +00091 WORKING-STORAGE SECTION. DTSBX706 +000915 77 PAN-VALET PICTURE X(24) VALUE '023DTSBX706 12/22/16'. DTSBX706 +00092 DTSBX706 +00093 01 WRK-AREA. DTSBX706 +00094 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +706. CL**7 +00095 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBX706 +00096 05 WS-NUMBER-ONE PIC S9(05) COMP-3 DTSBX706 +00097 VALUE +0. DTSBX706 +00098 DTSBX706 +00099 05 WS-SAMP-CNT PIC S9(03) COMP-3 VALUE 0. CL**3 +00100 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL**3 +00101 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBX706 +00102 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBX706 +00103 05 BLANK-LINE PIC X(133) VALUE SPACES. DTSBX706 +00104 05 ACHLOG-STATUS PIC X(02) VALUE SPACES. CL**4 +00105 88 WS-ACHLOG-EOF-88 VALUE '10'. CL**4 +00106 88 WS-ACHLOG-OK-88 VALUE '00'. CL**4 +00107 CL**4 +00108 DTSBX706 +00109 05 WS-EMP-NO PIC X(07). DTSBX706 +00110 05 WS-EMP-NO-EDIT REDEFINES WS-EMP-NO DTSBX706 +00111 PIC 999B999. DTSBX706 +00112 05 WS-SUB PIC S9(04) COMP. DTSBX706 +00113 05 WS-NAME-ADD-CNT PIC S9(04) COMP. DTSBX706 +00114 05 WS-NAME-ADD OCCURS 6 TIMES PIC X(35). DTSBX706 +00115 EJECT DTSBX706 +00116 01 ACHLOG-CLOSE. CL**5 +00117 05 FILLER PIC X(43). CL*23 +00118 05 ACH-CLOSE-BYTES PIC X(20). CL**5 +00119 05 FILLER PIC X(17). CL*23 +00120 05 FILLER PIC X(948). CL*23 +00121 CL**5 +00122 01 ACHCLOSE PIC X(10) VALUE ALL '9'. CL*14 +00123 01 ACHCLOSE9 REDEFINES ACHCLOSE PIC 9(10). CL**5 +00124 CL**5 +00125 01 ACHLOG-TRANF. CL**5 +00126 05 FILLER PIC X(09). CL*23 +00127 05 ACH-TRANF-BYTES PIC X(20). CL**5 +00128 05 FILLER PIC X(51). CL*23 +00129 05 FILLER PIC X(948). CL*23 +00130 CL**5 +00131 01 ACHTRANF PIC X(10) VALUE ALL '9'. CL**6 +00132 01 ACHTRANF9 REDEFINES ACHTRANF PIC 9(10). CL**5 +00133 CL**5 +00134 01 PAGE-HEADING. DTSBX706 +00135 05 HDR-LINE-1. DTSBX706 +00136 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00137 10 FILLER PIC X(05) DTSBX706 +00138 VALUE '705R1'. DTSBX706 +00139 10 FILLER PIC X(35) VALUE SPACES. DTSBX706 +00140 10 HDR-AGY-NAME-LINE1 PIC X(50). DTSBX706 +00141 10 FILLER PIC X(28) VALUE SPACES. DTSBX706 +00142 10 FILLER PIC X(05) DTSBX706 +00143 VALUE 'DATE:'. DTSBX706 +00144 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00145 10 HDR-SYS-DATE PIC X(08). DTSBX706 +00146 DTSBX706 +00147 05 HDR-LINE-2. DTSBX706 +00148 10 FILLER PIC X(41) VALUE SPACES. DTSBX706 +00149 10 HDR-AGY-NAME-LINE2 PIC X(50). DTSBX706 +00150 10 FILLER PIC X(28) VALUE SPACES. DTSBX706 +00151 10 FILLER PIC X(05) DTSBX706 +00152 VALUE 'TIME:'. DTSBX706 +00153 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00154 10 HDR-SYS-TIME PIC X(08). DTSBX706 +00155 DTSBX706 +00156 05 HDR-LINE-3. DTSBX706 +00157 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00158 10 FILLER PIC X(30) DTSBX706 +00159 VALUE 'ROUTE TO: CHIEF, TAX DIVISION'. DTSBX706 +00160 10 FILLER PIC X(88) VALUE SPACES. DTSBX706 +00161 10 FILLER PIC X(05) DTSBX706 +00162 VALUE 'PAGE:'. DTSBX706 +00163 10 FILLER PIC X(03) VALUE SPACES. DTSBX706 +00164 10 HDR-PAGE-CNT PIC ZZ,ZZ9. DTSBX706 +00165 DTSBX706 +00166 05 HDR-LINE-4. DTSBX706 +00167 10 FILLER PIC X(12) VALUE SPACES. DTSBX706 +00168 10 FILLER PIC X(20) DTSBX706 +00169 VALUE ' '. DTSBX706 +00170 10 FILLER PIC X(21) VALUE SPACES. DTSBX706 +00171 10 FILLER PIC X(26) DTSBX706 +00172 VALUE 'FAILED FUTA CERT SAMPLES '. CL**2 +00173 DTSBX706 +00174 05 HDR-LINE-5 PIC X(133) VALUE SPACES. DTSBX706 +00175 05 HDR-LINE-6 PIC X(133) VALUE SPACES. DTSBX706 +00176 05 HDR-LINE-7. DTSBX706 +00177 10 FILLER PIC X(11) VALUE SPACES. DTSBX706 +00178 10 FILLER PIC X(03) DTSBX706 +00179 VALUE 'TAX'. DTSBX706 +00180 10 FILLER PIC X(15) VALUE SPACES. DTSBX706 +00181 10 FILLER PIC X(14) DTSBX706 +00182 VALUE ALL '*'. DTSBX706 +00183 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00184 10 FILLER PIC X(24) DTSBX706 +00185 VALUE 'CERT REQUEST RECORD INFO'. DTSBX706 +00186 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00187 10 FILLER PIC X(13) DTSBX706 +00188 VALUE ALL '*'. DTSBX706 +00189 DTSBX706 +00190 05 HDR-LINE-8. DTSBX706 +00191 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00192 10 FILLER PIC X(40) DTSBX706 +00193 VALUE 'EMP NO PER FEIN NAME/ADDRE'. DTSBX706 +00194 10 FILLER PIC X(02) DTSBX706 +00195 VALUE 'SS'. DTSBX706 +00196 10 FILLER PIC X(23) VALUE SPACES. DTSBX706 +00197 10 FILLER PIC X(34) DTSBX706 +00198 VALUE 'XREF FEIN NCRL ERROR MESSAGE'. DTSBX706 +00199 05 HDR-LINE-9 PIC X(133) VALUE SPACES. DTSBX706 +00200 DTSBX706 +00201 01 DETAIL-LINE1. DTSBX706 +00202 05 DTL1-LINE-1. DTSBX706 +00203 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00204 10 DTL1-EMP-NO PIC 999B999. DTSBX706 +00205 10 FILLER PIC X(02) VALUE SPACES. DTSBX706 +00206 10 DTL1-TAX-YEAR PIC 9(04). DTSBX706 +00207 10 FILLER PIC X(03) VALUE SPACES. DTSBX706 +00208 10 DTL1-FEIN PIC 99B9(07). DTSBX706 +00209 10 FILLER PIC X(02) VALUE SPACES. DTSBX706 +00210 10 DTL1-NAME-ADD-1 PIC X(35). DTSBX706 +00211 10 FILLER PIC X(02) VALUE SPACES. DTSBX706 +00212 10 DTL1-XREF-FEIN PIC 99B9(07). DTSBX706 +00213 10 FILLER PIC X(02) VALUE SPACES. DTSBX706 +00214 10 DTL1-NAME-CONTROL PIC X(04). DTSBX706 +00215 10 FILLER PIC X(04) VALUE SPACES. DTSBX706 +00216 10 DTL1-MSG-TEXT-1 PIC X(40). DTSBX706 +00217 DTSBX706 +00218 01 DETAIL-LINE2. DTSBX706 +00219 05 DTL2-LINE-1. DTSBX706 +00220 10 FILLER PIC X(29) VALUE SPACES. DTSBX706 +00221 10 DTL2-NAME-ADD-2 PIC X(35). DTSBX706 +00222 10 FILLER PIC X(02) VALUE SPACES. DTSBX706 +00223 10 DTL2-MSG-TEXT-2 PIC X(40). DTSBX706 +00224 DTSBX706 +00225 01 DETAIL-LINE3. DTSBX706 +00226 05 DTL3-LINE-1. DTSBX706 +00227 10 FILLER PIC X(29) VALUE SPACES. DTSBX706 +00228 10 DTL3-NAME-ADD-3 PIC X(35). DTSBX706 +00229 DTSBX706 +00230 01 CONTROL-FOOTING-FINAL. DTSBX706 +00231 05 CFF-LINE-4. DTSBX706 +00232 10 FILLER PIC X(11) VALUE SPACES. DTSBX706 +00233 10 CFF-NUMBER-ONE PIC ZZZZ,ZZ9. DTSBX706 +00234 10 FILLER PIC X(01) VALUE SPACE. DTSBX706 +00235 10 FILLER PIC X(26) DTSBX706 +00236 VALUE 'FAILED FUTA CERTIFICATIONS'. DTSBX706 +00237 10 FILLER PIC X(26) CL**2 +00238 VALUE ' SAMPLED FOR TAX '. CL**2 +00239 EJECT DTSBX706 +00240 LINKAGE SECTION. DTSBX706 +00241 DTSBX706 +00242 PROCEDURE DIVISION. CL**4 +00243 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBX706 +00244 DTSBX706 +00245 PERFORM P1000-PROCESS THRU P1000-EXIT. CL**5 +00246 CL**4 +00247 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBX706 +00248 DTSBX706 +00249 GOBACK. DTSBX706 +00250 EJECT DTSBX706 +00251 I1000-INITIATE. DTSBX706 +00252 DTSBX706 +00253 OPEN INPUT ACHLOG-FILE. CL**4 +00254 IF WS-ACHLOG-EOF-88 CL**4 +00255 DISPLAY '************************************* ' CL**4 +00256 DISPLAY '*** ESSP ACH FTP DEPOSIT FAILED **** ' CL**4 +00257 DISPLAY '******** ACH FILE EMPTY (open)******* ' CL*17 +00258 DISPLAY '************************************* ' CL**4 +00259 MOVE +3 TO WRK-ABEND-CD CL*18 +00260 PERFORM S999-ABEND THRU S999-EXIT CL**4 +00261 END-IF. CL**4 +00262 DTSBX706 +00263 I1000-EXIT. DTSBX706 +00264 EXIT. DTSBX706 +00265 EJECT DTSBX706 +00266 P1000-PROCESS. DTSBX706 +00267 READ ACHLOG-FILE AT END CL**9 +00268 SET WS-ACHLOG-EOF-88 TO TRUE. CL**9 +00269 CL**9 +00270 IF WS-ACHLOG-EOF-88 CL**4 +00271 DISPLAY '************************************* ' CL**4 +00272 DISPLAY '*** ESSP ACH FTP DEPOSIT FAILED **** ' CL**4 +00273 DISPLAY '******** ACH FILE EMPTY (read)******* ' CL*17 +00274 DISPLAY '************************************* ' CL**4 +00275 MOVE +3 TO WRK-ABEND-CD CL**4 +00276 PERFORM S999-ABEND THRU S999-EXIT CL**4 +00277 END-IF. CL**4 +00278 CL**4 +00279 MOVE +4 TO WRK-ABEND-CD. CL*18 +00280 PERFORM UNTIL WS-ACHLOG-EOF-88 CL**4 +00281 PERFORM P1100-FTPLOG THRU P1100-EXIT CL**4 +00282 END-PERFORM. CL**4 +00283 CL**5 +00284 IF ACHCLOSE9 = 9999999999 AND CL*14 +00285 ACHTRANF9 = 9999999999 CL*14 +00286 MOVE +4 TO WRK-ABEND-CD CL*18 +00287 DISPLAY '************************************* ' CL*14 +00288 DISPLAY '### ESSP ACH *** FTP *** FAILED #### ' CL*14 +00289 DISPLAY '******** ACH FILE EMPTY (read)******* ' CL*17 +00290 DISPLAY '************************************* ' CL*14 +00291 PERFORM S999-ABEND THRU S999-EXIT CL*14 +00292 END-IF. CL*14 +00293 CL*14 +00294 CL*14 +00295 IF ACHCLOSE9 = ACHTRANF9 CL**5 +00296 MOVE +0 TO WRK-ABEND-CD CL**6 +00297 DISPLAY '************************************* ' CL**5 +00298 DISPLAY '!!! ESSP ACH FTP DEPOSIT SUCESSFULL!! ' CL**5 +00299 DISPLAY ' ' CL**5 +00300 DISPLAY ' TOTAL BYTES IN FTP FILE = ' ACHCLOSE9 CL**5 +00301 DISPLAY ' TOTAL BYTES TRANSFERRED = ' ACHTRANF9 CL**5 +00302 DISPLAY ' ' CL**5 +00303 DISPLAY '!!! ESSP ACH FTP DEPOSIT SUCESSFULL!! zl1' CL*17 +00304 DISPLAY '************************************* ' CL**5 +00305 ELSE CL**5 +00306 MOVE +3 TO WRK-ABEND-CD CL*18 +00307 DISPLAY '************************************* ' CL**5 +00308 DISPLAY '### ESSP ACH FTP DEPOSIT FAILED #### ' CL**5 +00309 DISPLAY ' TOTAL BYTES IN FTP FILE = ' ACHCLOSE9 CL*17 +00310 DISPLAY ' TOTAL BYTES TRANSFERRED = ' ACHTRANF9 CL*17 +00311 DISPLAY '### completed data file not tranfered ###' CL*17 +00312 DISPLAY '************************************* ' CL**5 +00313 PERFORM S999-ABEND THRU S999-EXIT CL**5 +00314 END-IF. CL**5 +00315 CL**4 +00316 DTSBX706 +00317 P1000-EXIT. DTSBX706 +00318 EXIT. DTSBX706 +00319 DTSBX706 +00320 P1100-FTPLOG. CL**4 +00321 CL**4 +00322 if ach-rtn-code = '226 Clos' CL**5 +00323 MOVE ACHLOG-REC TO ACHLOG-CLOSE CL**5 +00324 STRING ACH-CLOSE-BYTES DELIMITED BY '/' INTO ACHCLOSE CL**5 +00325 DISPLAY 'no of bytes in file CSTRING ' ACH-CLOSE-BYTES CL*17 +00326 DISPLAY 'no of bytes detected CBYTES ' ACHCLOSE9 CL*17 +00327 END-IF. CL**5 +00328 CL**5 +00329 if ach-rtn-code = 'EZA1617I' CL**5 +00330 MOVE ACHLOG-REC TO ACHLOG-TRANF CL*17 +00331 STRING ACH-TRANF-BYTES DELIMITED BY ' ' INTO ACHTRANF CL*17 +00332 DISPLAY 'no of bytes transfered TSTRING ' ACH-TRANF-BYTES CL*17 +00333 DISPLAY 'no of bytes detected TBYTES ' ACHTRANF9 CL*17 +00334 END-IF. CL**5 +00335 CL**5 +00336 READ ACHLOG-FILE AT END CL*12 +00337 SET WS-ACHLOG-EOF-88 TO TRUE. CL*12 +00338 P1100-EXIT. CL**4 +00339 EXIT. CL**4 +00340 CL**4 +00341 T1000-TERMINATE. DTSBX706 +00342 DTSBX706 +00343 CLOSE ACHLOG-FILE. CL**4 +00344 DTSBX706 +00345 T1000-EXIT. DTSBX706 +00346 EXIT. DTSBX706 +00347 DTSBX706 +00348 S999-ABEND. CL**4 +00349 CL**4 +00350 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**4 +00351 CL**4 +00352 S999-EXIT. CL**4 +00353 EXIT. CL**4 +00354 DTSBX706 diff --git a/Batch/DTSBX770.cob b/Batch/DTSBX770.cob index def3be4..cbed0fa 100644 --- a/Batch/DTSBX770.cob +++ b/Batch/DTSBX770.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 06/19/13 +00001 IDENTIFICATION DIVISION. 10/17/24 00002 PROGRAM-ID. DTSBX770. DTSBX770 -00003 AUTHOR. TRW. LV009 +00003 AUTHOR. TRW. LV015 00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX770 00005 DATE-COMPILED. DTSBX770 00006 SKIP3 DTSBX770 @@ -49,7 +49,7 @@ 00049 01 ETA581-PARM-REC PIC X(77). DTSBX770 00050 DTSBX770 00051 WORKING-STORAGE SECTION. DTSBX770 -000515 77 PAN-VALET PICTURE X(24) VALUE '009DTSBX770 06/19/13'. DTSBX770 +000515 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX770 10/17/24'. DTSBX770 00052 77 PAN-VALET PICTURE X(24) VALUE '002DTSBX770 04/24/13'. DTSBX770 00053 77 PAN-VALET PICTURE X(24) VALUE '007DTSBX770 03/31/11'. DTSBX770 00054 SKIP3 DTSBX770 @@ -82,542 +82,553 @@ 00081 DTSBX770 00082 05 WRK-OUTSTANDING-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX770 00083 05 WRK-OUTSTANDING-BAL PIC S9(11)V99 COMP-3 VALUE +0. DTSBX770 -00084 05 WRK-WAGE-ITEM-CNT PIC S9(09) COMP-3 VALUE +0. DTSBX770 +00084 05 WRK-WAGE-ITEM-CNT PIC S9(09) COMP-3 VALUE +0. CL*14 00085 05 WRK-MANDATORY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX770 -00086 05 WRK-PROHIBITED-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX770 -00087 05 WRK-SUTA-DMP-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX770 -00088 DTSBX770 -00089 01 L001-LINK-AREA. DTSBX770 -00090 ++INCLUDE DTSIL001 DTSBX770 -00091 DTSBX770 -00092 01 WRK-PARM-REC. DTSBX770 -00093 ++INCLUDE DTSIX770 DTSBX770 -00094 DTSBX770 -00095 01 XL771-LINK-AREA. DTSBX770 -00096 ++INCLUDE DTSXL771 DTSBX770 -00097 DTSBX770 -00098 01 XL772-LINK-AREA. DTSBX770 -00099 ++INCLUDE DTSXL772 DTSBX770 -00100 DTSBX770 -00101 01 XL773-LINK-AREA. DTSBX770 -00102 ++INCLUDE DTSXL773 DTSBX770 -00103 DTSBX770 -00104 01 XL774-LINK-AREA. DTSBX770 -00105 ++INCLUDE DTSXL774 DTSBX770 -00106 DTSBX770 -00107 01 XL775-LINK-AREA. DTSBX770 -00108 ++INCLUDE DTSXL775 DTSBX770 -00109 DTSBX770 -00110 01 L926-LINK-AREA. DTSBX770 -00111 ++INCLUDE DTSIL926 DTSBX770 -00112 DTSBX770 -00113 01 RSKL-REC. DTSBX770 -00114 ++INCLUDE DTSIRSK1 DTSBX770 -00115 DTSBX770 -00116 01 Y779-REC. DTSBX770 -00117 ++INCLUDE DTSIY779 DTSBX770 -00118 DTSBX770 -00119 01 L931-LINK-AREA. DTSBX770 -00120 ++INCLUDE DTSIL931 DTSBX770 -00121 SKIP3 DTSBX770 -00122 01 FSKL-REC. DTSBX770 -00123 ++INCLUDE DTSIFSKL DTSBX770 -00124 SKIP3 DTSBX770 -00125 01 F581-REC. DTSBX770 -00126 ++INCLUDE DTSIF581 DTSBX770 -00127 DTSBX770 -00128 01 R713-REC. DTSBX770 -00129 ++INCLUDE DTSIR713 DTSBX770 -00130 DTSBX770 -00131 PROCEDURE DIVISION. DTSBX770 -00132 DTSBX770 -00133 DTSBD770-MAIN. DTSBX770 -00134 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX770 -00135 IF WRK-ERROR-YES-88 DTSBX770 -00136 GO TO DTSBD770-MAIN-EXIT. DTSBX770 -00137 DTSBX770 -00138 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX770 -00139 DTSBX770 -00140 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX770 +00086 05 FWRK-AUDIT-INDCON-EMPL-CNT PIC S9(07) COMP-3 VALUE +0. CL*14 +00087 05 WRK-PROHIBITED-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX770 +00088 05 WRK-SUTA-DMP-AMT PIC S9(11)V99 COMP-3 VALUE +0. DTSBX770 +00089 05 WRK-TAXAVD-MAN-CNT PIC S9(07) COMP-3 VALUE +0. CL*12 +00090 05 WRK-TAXAVD-PROH-CNT PIC S9(07) COMP-3 VALUE +0. CL*12 +00091 05 WRK-TAXAVD-CONT-AMT PIC S9(11)V99 COMP-3 VALUE +0. CL*13 +00092 DTSBX770 +00093 01 L001-LINK-AREA. DTSBX770 +00094 ++INCLUDE DTSIL001 DTSBX770 +00095 DTSBX770 +00096 01 WRK-PARM-REC. DTSBX770 +00097 ++INCLUDE DTSIX770 DTSBX770 +00098 DTSBX770 +00099 01 XL771-LINK-AREA. DTSBX770 +00100 ++INCLUDE DTSXL771 DTSBX770 +00101 DTSBX770 +00102 01 XL772-LINK-AREA. DTSBX770 +00103 ++INCLUDE DTSXL772 DTSBX770 +00104 DTSBX770 +00105 01 XL773-LINK-AREA. DTSBX770 +00106 ++INCLUDE DTSXL773 DTSBX770 +00107 DTSBX770 +00108 01 XL774-LINK-AREA. DTSBX770 +00109 ++INCLUDE DTSXL774 DTSBX770 +00110 DTSBX770 +00111 01 XL775-LINK-AREA. DTSBX770 +00112 ++INCLUDE DTSXL775 DTSBX770 +00113 DTSBX770 +00114 01 L926-LINK-AREA. DTSBX770 +00115 ++INCLUDE DTSIL926 DTSBX770 +00116 DTSBX770 +00117 01 RSKL-REC. DTSBX770 +00118 ++INCLUDE DTSIRSK1 DTSBX770 +00119 DTSBX770 +00120 01 Y779-REC. DTSBX770 +00121 ++INCLUDE DTSIY779 DTSBX770 +00122 DTSBX770 +00123 01 L931-LINK-AREA. DTSBX770 +00124 ++INCLUDE DTSIL931 DTSBX770 +00125 SKIP3 DTSBX770 +00126 01 FSKL-REC. DTSBX770 +00127 ++INCLUDE DTSIFSKL DTSBX770 +00128 SKIP3 DTSBX770 +00129 01 F581-REC. DTSBX770 +00130 ++INCLUDE DTSIF581 DTSBX770 +00131 DTSBX770 +00132 01 R713-REC. DTSBX770 +00133 ++INCLUDE DTSIR713 DTSBX770 +00134 DTSBX770 +00135 PROCEDURE DIVISION. DTSBX770 +00136 DTSBX770 +00137 DTSBD770-MAIN. DTSBX770 +00138 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX770 +00139 IF WRK-ERROR-YES-88 DTSBX770 +00140 GO TO DTSBD770-MAIN-EXIT. DTSBX770 00141 DTSBX770 -00142 DTSBD770-MAIN-EXIT. DTSBX770 -00143 GOBACK. DTSBX770 -00144 EJECT DTSBX770 -00145 I0000-INITIATE. DTSBX770 -00146 SET WRK-ERROR-NO-88 TO TRUE. DTSBX770 -00147 DTSBX770 -00148 MOVE LENGTH OF R713-REC TO R713-LENGTH. DTSBX770 -00149 MOVE '713' TO R713-REC-TYPE. DTSBX770 -00150 DTSBX770 -00151 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX770 -00152 IF WRK-ERROR-YES-88 DTSBX770 -00153 GO TO I0000-EXIT. DTSBX770 +00142 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX770 +00143 DTSBX770 +00144 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX770 +00145 DTSBX770 +00146 DTSBD770-MAIN-EXIT. DTSBX770 +00147 GOBACK. DTSBX770 +00148 EJECT DTSBX770 +00149 I0000-INITIATE. DTSBX770 +00150 SET WRK-ERROR-NO-88 TO TRUE. DTSBX770 +00151 DTSBX770 +00152 MOVE LENGTH OF R713-REC TO R713-LENGTH. DTSBX770 +00153 MOVE '713' TO R713-REC-TYPE. DTSBX770 00154 DTSBX770 -00155 PERFORM I2000-PARMS THRU I2000-EXIT. DTSBX770 -00156 DTSBX770 -00157 PERFORM I3000-INITIAL-CALL THRU I3000-EXIT. DTSBX770 +00155 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX770 +00156 IF WRK-ERROR-YES-88 DTSBX770 +00157 GO TO I0000-EXIT. DTSBX770 00158 DTSBX770 -00159 PERFORM I4000-INITIALIZE-F581 THRU I4000-EXIT. DTSBX770 +00159 PERFORM I2000-PARMS THRU I2000-EXIT. DTSBX770 00160 DTSBX770 -00161 I0000-EXIT. DTSBX770 -00162 EXIT. DTSBX770 -00163 DTSBX770 -00164 I1000-OPEN-FILES. DTSBX770 -00165 MOVE WRK-TRACE-IND TO L926-TRACE-IND DTSBX770 -00166 L931-TRACE-IND. DTSBX770 +00161 PERFORM I3000-INITIAL-CALL THRU I3000-EXIT. DTSBX770 +00162 DTSBX770 +00163 PERFORM I4000-INITIALIZE-F581 THRU I4000-EXIT. DTSBX770 +00164 DTSBX770 +00165 I0000-EXIT. DTSBX770 +00166 EXIT. DTSBX770 00167 DTSBX770 -00168 MOVE WRK-MOD-NAME TO L926-MOD-NAME DTSBX770 -00169 L931-MOD-NAME. DTSBX770 -00170 DTSBX770 -00171 *& PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX770 -00172 PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DTSBX770 -00173 DTSBX770 -00174 SET L926-OPEN-READ-88 TO TRUE. DTSBX770 -00175 PERFORM S926-BD770-INPUT THRU S926-EXIT. DTSBX770 -00176 DTSBX770 -00177 I1000-EXIT. DTSBX770 -00178 EXIT. DTSBX770 -00179 DTSBX770 -00180 I2000-PARMS. DTSBX770 -00181 OPEN INPUT ETA581-PARM-FILE. DTSBX770 -00182 IF NOT BE770-STATUS-OK-88 DTSBX770 -00183 DISPLAY 'CANNOT OPEN PARM FILE ' BE770-STATUS DTSBX770 -00184 PERFORM S999-ABEND THRU S999-EXIT. DTSBX770 -00185 DTSBX770 -00186 READ ETA581-PARM-FILE INTO WRK-PARM-REC. DTSBX770 -00187 IF NOT BE770-STATUS-OK-88 DTSBX770 -00188 DISPLAY 'CANNOT READ PARM FILE ' BE770-STATUS DTSBX770 -00189 PERFORM S999-ABEND THRU S999-EXIT. DTSBX770 -00190 DTSBX770 -00191 CLOSE ETA581-PARM-FILE. DTSBX770 -00192 DTSBX770 -00193 I2000-EXIT. DTSBX770 -00194 EXIT. DTSBX770 -00195 DTSBX770 -00196 I3000-INITIAL-CALL. DTSBX770 -00197 MOVE ZERO TO XL771-CON-EMP-CNT DTSBX770 -00198 XL771-REIMB-EMP-CNT DTSBX770 -00199 XL771-TOT-EMP-CNT DTSBX770 -00200 XL773-NEW-DETERM-CNT DTSBX770 -00201 XL773-NEW-DETERM-T90-CNT DTSBX770 -00202 XL773-NEW-DETERM-T180-CNT DTSBX770 -00203 XL773-SUC-DETERM-CNT DTSBX770 -00204 XL773-SUC-DETERM-T90-CNT DTSBX770 -00205 XL773-SUC-DETERM-T180-CNT DTSBX770 -00206 XL773-TERMINATION-CNT. DTSBX770 -00207 DTSBX770 -00208 SET XL771-CMD-INIT-88 TO TRUE. DTSBX770 -00209 PERFORM S771-CALL THRU S771-EXIT. DTSBX770 -00210 DTSBX770 -00211 SET XL772-CMD-INIT-88 TO TRUE. DTSBX770 -00212 PERFORM S772-CALL THRU S772-EXIT. DTSBX770 -00213 DTSBX770 -00214 SET XL773-CMD-INIT-88 TO TRUE. DTSBX770 -00215 PERFORM S773-CALL THRU S773-EXIT. DTSBX770 -00216 DTSBX770 -00217 SET XL774-CMD-INIT-88 TO TRUE. DTSBX770 -00218 PERFORM S774-CALL THRU S774-EXIT. DTSBX770 -00219 DTSBX770 -00220 SET XL775-CMD-INIT-88 TO TRUE. DTSBX770 -00221 PERFORM S775-CALL THRU S775-EXIT. DTSBX770 -00222 DTSBX770 -00223 I3000-EXIT. DTSBX770 -00224 EXIT. DTSBX770 -00225 DTSBX770 -00226 I4000-INITIALIZE-F581. DTSBX770 -00227 MOVE LOW-VALUES TO F581-KEY-AREA. DTSBX770 -00228 SET F581-581-88 TO TRUE. DTSBX770 -00229 MOVE X770-SUBJECT-QTR TO F581-YRQ. DTSBX770 -00230 MOVE F581-KEY-AREA TO FSKL-KEY-AREA. DTSBX770 -00231 PERFORM S931-READ THRU S931-EXIT. DTSBX770 -00232 IF L931-NO-REC-88 DTSBX770 -00233 MOVE X770-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSBX770 -00234 ELSE DTSBX770 -00235 MOVE FSKL-REC TO F581-REC DTSBX770 -00236 MOVE F581-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX770 -00237 MOVE LOW-VALUES TO F581-REC. DTSBX770 -00238 SET F581-581-88 TO TRUE. DTSBX770 -00239 MOVE X770-SUBJECT-QTR TO F581-YRQ. DTSBX770 -00240 INITIALIZE F581-DATA-AREA. DTSBX770 -00241 MOVE L001-FED-8-DATE-9 TO F581-ESTB-DATE. DTSBX770 -00242 MOVE X770-CURR-RUN-DATE TO F581-CHNG-DATE. DTSBX770 -00243 DTSBX770 -00244 I4000-EXIT. DTSBX770 -00245 EXIT. DTSBX770 -00246 DTSBX770 +00168 I1000-OPEN-FILES. DTSBX770 +00169 MOVE WRK-TRACE-IND TO L926-TRACE-IND DTSBX770 +00170 L931-TRACE-IND. DTSBX770 +00171 DTSBX770 +00172 MOVE WRK-MOD-NAME TO L926-MOD-NAME DTSBX770 +00173 L931-MOD-NAME. DTSBX770 +00174 DTSBX770 +00175 *& PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX770 +00176 PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DTSBX770 +00177 DTSBX770 +00178 SET L926-OPEN-READ-88 TO TRUE. DTSBX770 +00179 PERFORM S926-BD770-INPUT THRU S926-EXIT. DTSBX770 +00180 DTSBX770 +00181 I1000-EXIT. DTSBX770 +00182 EXIT. DTSBX770 +00183 DTSBX770 +00184 I2000-PARMS. DTSBX770 +00185 OPEN INPUT ETA581-PARM-FILE. DTSBX770 +00186 IF NOT BE770-STATUS-OK-88 DTSBX770 +00187 DISPLAY 'CANNOT OPEN PARM FILE ' BE770-STATUS DTSBX770 +00188 PERFORM S999-ABEND THRU S999-EXIT. DTSBX770 +00189 DTSBX770 +00190 READ ETA581-PARM-FILE INTO WRK-PARM-REC. DTSBX770 +00191 IF NOT BE770-STATUS-OK-88 DTSBX770 +00192 DISPLAY 'CANNOT READ PARM FILE ' BE770-STATUS DTSBX770 +00193 PERFORM S999-ABEND THRU S999-EXIT. DTSBX770 +00194 DTSBX770 +00195 CLOSE ETA581-PARM-FILE. DTSBX770 +00196 DTSBX770 +00197 I2000-EXIT. DTSBX770 +00198 EXIT. DTSBX770 +00199 DTSBX770 +00200 I3000-INITIAL-CALL. DTSBX770 +00201 MOVE ZERO TO XL771-CON-EMP-CNT DTSBX770 +00202 XL771-REIMB-EMP-CNT DTSBX770 +00203 XL771-TOT-EMP-CNT DTSBX770 +00204 XL773-NEW-DETERM-CNT DTSBX770 +00205 XL773-NEW-DETERM-T90-CNT DTSBX770 +00206 XL773-NEW-DETERM-T180-CNT DTSBX770 +00207 XL773-SUC-DETERM-CNT DTSBX770 +00208 XL773-SUC-DETERM-T90-CNT DTSBX770 +00209 XL773-SUC-DETERM-T180-CNT DTSBX770 +00210 XL773-TERMINATION-CNT. DTSBX770 +00211 DTSBX770 +00212 SET XL771-CMD-INIT-88 TO TRUE. DTSBX770 +00213 PERFORM S771-CALL THRU S771-EXIT. DTSBX770 +00214 DTSBX770 +00215 SET XL772-CMD-INIT-88 TO TRUE. DTSBX770 +00216 PERFORM S772-CALL THRU S772-EXIT. DTSBX770 +00217 DTSBX770 +00218 SET XL773-CMD-INIT-88 TO TRUE. DTSBX770 +00219 PERFORM S773-CALL THRU S773-EXIT. DTSBX770 +00220 DTSBX770 +00221 SET XL774-CMD-INIT-88 TO TRUE. DTSBX770 +00222 PERFORM S774-CALL THRU S774-EXIT. DTSBX770 +00223 DTSBX770 +00224 SET XL775-CMD-INIT-88 TO TRUE. DTSBX770 +00225 PERFORM S775-CALL THRU S775-EXIT. DTSBX770 +00226 DTSBX770 +00227 I3000-EXIT. DTSBX770 +00228 EXIT. DTSBX770 +00229 DTSBX770 +00230 I4000-INITIALIZE-F581. DTSBX770 +00231 MOVE LOW-VALUES TO F581-KEY-AREA. DTSBX770 +00232 SET F581-581-88 TO TRUE. DTSBX770 +00233 MOVE X770-SUBJECT-QTR TO F581-YRQ. DTSBX770 +00234 MOVE F581-KEY-AREA TO FSKL-KEY-AREA. DTSBX770 +00235 PERFORM S931-READ THRU S931-EXIT. DTSBX770 +00236 IF L931-NO-REC-88 DTSBX770 +00237 MOVE X770-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSBX770 +00238 ELSE DTSBX770 +00239 MOVE FSKL-REC TO F581-REC DTSBX770 +00240 MOVE F581-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX770 +00241 MOVE LOW-VALUES TO F581-REC. DTSBX770 +00242 SET F581-581-88 TO TRUE. DTSBX770 +00243 MOVE X770-SUBJECT-QTR TO F581-YRQ. DTSBX770 +00244 INITIALIZE F581-DATA-AREA. DTSBX770 +00245 MOVE L001-FED-8-DATE-9 TO F581-ESTB-DATE. DTSBX770 +00246 MOVE X770-CURR-RUN-DATE TO F581-CHNG-DATE. DTSBX770 00247 DTSBX770 -00248 P0000-PROCESS. DTSBX770 -00249 PERFORM UNTIL L926-NO-REC-88 DTSBX770 -00250 SET L926-READ-NEXT-88 TO TRUE DTSBX770 -00251 PERFORM S926-BD770-INPUT THRU S926-EXIT DTSBX770 -00252 IF L926-OK-88 DTSBX770 -00253 PERFORM P1000-SELECT-PROGRAM THRU P1000-EXIT DTSBX770 -00254 END-IF DTSBX770 -00255 END-PERFORM. DTSBX770 -00256 DTSBX770 -00257 P0000-EXIT. DTSBX770 -00258 EXIT. DTSBX770 -00259 DTSBX770 -00260 P1000-SELECT-PROGRAM. DTSBX770 -00261 ADD +1 TO WRK-RECORDS-READ-CNT. DTSBX770 -00262 DTSBX770 -00263 EVALUATE TRUE DTSBX770 -00264 WHEN RSK1-REC-TYPE = '771' DTSBX770 -00265 PERFORM P1100-REC-771 THRU P1100-EXIT DTSBX770 +00248 I4000-EXIT. DTSBX770 +00249 EXIT. DTSBX770 +00250 DTSBX770 +00251 DTSBX770 +00252 P0000-PROCESS. DTSBX770 +00253 PERFORM UNTIL L926-NO-REC-88 DTSBX770 +00254 SET L926-READ-NEXT-88 TO TRUE DTSBX770 +00255 PERFORM S926-BD770-INPUT THRU S926-EXIT DTSBX770 +00256 IF L926-OK-88 DTSBX770 +00257 PERFORM P1000-SELECT-PROGRAM THRU P1000-EXIT DTSBX770 +00258 END-IF DTSBX770 +00259 END-PERFORM. DTSBX770 +00260 DTSBX770 +00261 P0000-EXIT. DTSBX770 +00262 EXIT. DTSBX770 +00263 DTSBX770 +00264 P1000-SELECT-PROGRAM. DTSBX770 +00265 ADD +1 TO WRK-RECORDS-READ-CNT. DTSBX770 00266 DTSBX770 -00267 WHEN RSK1-REC-TYPE = '772' DTSBX770 -00268 PERFORM P1200-REC-772 THRU P1200-EXIT DTSBX770 -00269 DTSBX770 -00270 WHEN RSK1-REC-TYPE = '773' DTSBX770 -00271 PERFORM P1300-REC-773 THRU P1300-EXIT DTSBX770 -00272 DTSBX770 -00273 WHEN RSK1-REC-TYPE = '774' DTSBX770 -00274 PERFORM P1400-REC-774 THRU P1400-EXIT DTSBX770 -00275 DTSBX770 -00276 WHEN RSK1-REC-TYPE = '775' DTSBX770 -00277 PERFORM P1500-REC-775 THRU P1500-EXIT DTSBX770 -00278 DTSBX770 -00279 WHEN RSK1-REC-TYPE = '779' DTSBX770 -00280 PERFORM P1900-REC-779 THRU P1900-EXIT DTSBX770 -00281 DTSBX770 -00282 WHEN OTHER DTSBX770 -00283 DISPLAY 'DTSBX770: INVALID RECORD TYPE ' DTSBX770 -00284 RSK1-REC-TYPE DTSBX770 -00285 END-EVALUATE. DTSBX770 -00286 DTSBX770 -00287 P1000-EXIT. DTSBX770 -00288 EXIT. DTSBX770 -00289 DTSBX770 -00290 P1100-REC-771. DTSBX770 -00291 SET XL771-CMD-PROCESS-88 TO TRUE. DTSBX770 -00292 PERFORM S771-CALL THRU S771-EXIT. DTSBX770 +00267 EVALUATE TRUE DTSBX770 +00268 WHEN RSK1-REC-TYPE = '771' DTSBX770 +00269 PERFORM P1100-REC-771 THRU P1100-EXIT DTSBX770 +00270 DTSBX770 +00271 WHEN RSK1-REC-TYPE = '772' DTSBX770 +00272 PERFORM P1200-REC-772 THRU P1200-EXIT DTSBX770 +00273 DTSBX770 +00274 WHEN RSK1-REC-TYPE = '773' DTSBX770 +00275 PERFORM P1300-REC-773 THRU P1300-EXIT DTSBX770 +00276 DTSBX770 +00277 WHEN RSK1-REC-TYPE = '774' DTSBX770 +00278 PERFORM P1400-REC-774 THRU P1400-EXIT DTSBX770 +00279 DTSBX770 +00280 WHEN RSK1-REC-TYPE = '775' DTSBX770 +00281 PERFORM P1500-REC-775 THRU P1500-EXIT DTSBX770 +00282 DTSBX770 +00283 WHEN RSK1-REC-TYPE = '779' DTSBX770 +00284 PERFORM P1900-REC-779 THRU P1900-EXIT DTSBX770 +00285 DTSBX770 +00286 WHEN OTHER DTSBX770 +00287 DISPLAY 'DTSBX770: INVALID RECORD TYPE ' DTSBX770 +00288 RSK1-REC-TYPE DTSBX770 +00289 END-EVALUATE. DTSBX770 +00290 DTSBX770 +00291 P1000-EXIT. DTSBX770 +00292 EXIT. DTSBX770 00293 DTSBX770 -00294 P1100-EXIT. DTSBX770 -00295 EXIT. DTSBX770 -00296 DTSBX770 -00297 P1200-REC-772. DTSBX770 -00298 SET XL772-CMD-PROCESS-88 TO TRUE. DTSBX770 -00299 PERFORM S772-CALL THRU S772-EXIT. DTSBX770 +00294 P1100-REC-771. DTSBX770 +00295 SET XL771-CMD-PROCESS-88 TO TRUE. DTSBX770 +00296 PERFORM S771-CALL THRU S771-EXIT. DTSBX770 +00297 DTSBX770 +00298 P1100-EXIT. DTSBX770 +00299 EXIT. DTSBX770 00300 DTSBX770 -00301 P1200-EXIT. DTSBX770 -00302 EXIT. DTSBX770 -00303 DTSBX770 -00304 P1300-REC-773. DTSBX770 -00305 SET XL773-CMD-PROCESS-88 TO TRUE. DTSBX770 -00306 PERFORM S773-CALL THRU S773-EXIT. DTSBX770 +00301 P1200-REC-772. DTSBX770 +00302 SET XL772-CMD-PROCESS-88 TO TRUE. DTSBX770 +00303 PERFORM S772-CALL THRU S772-EXIT. DTSBX770 +00304 DTSBX770 +00305 P1200-EXIT. DTSBX770 +00306 EXIT. DTSBX770 00307 DTSBX770 -00308 P1300-EXIT. DTSBX770 -00309 EXIT. DTSBX770 -00310 DTSBX770 -00311 P1400-REC-774. DTSBX770 -00312 SET XL774-CMD-PROCESS-88 TO TRUE. DTSBX770 -00313 PERFORM S774-CALL THRU S774-EXIT. DTSBX770 +00308 P1300-REC-773. DTSBX770 +00309 SET XL773-CMD-PROCESS-88 TO TRUE. DTSBX770 +00310 PERFORM S773-CALL THRU S773-EXIT. DTSBX770 +00311 DTSBX770 +00312 P1300-EXIT. DTSBX770 +00313 EXIT. DTSBX770 00314 DTSBX770 -00315 P1400-EXIT. DTSBX770 -00316 EXIT. DTSBX770 -00317 DTSBX770 -00318 P1500-REC-775. DTSBX770 -00319 SET XL775-CMD-PROCESS-88 TO TRUE. DTSBX770 -00320 PERFORM S775-CALL THRU S775-EXIT. DTSBX770 +00315 P1400-REC-774. DTSBX770 +00316 SET XL774-CMD-PROCESS-88 TO TRUE. DTSBX770 +00317 PERFORM S774-CALL THRU S774-EXIT. DTSBX770 +00318 DTSBX770 +00319 P1400-EXIT. DTSBX770 +00320 EXIT. DTSBX770 00321 DTSBX770 -00322 P1500-EXIT. DTSBX770 -00323 EXIT. DTSBX770 -00324 DTSBX770 -00325 P1900-REC-779. DTSBX770 -00326 MOVE RSKL-REC TO Y779-REC. DTSBX770 -00327 DTSBX770 -00328 DISPLAY 'P1000 Y779 REC FOUND'. DTSBX770 -00329 DISPLAY 'ITEM 12 OUTSTANDING QTRS ' DTSBX770 -00330 Y779-OUTSTANDING-BAL. DTSBX770 -00331 DISPLAY 'ITEM 13 OUTSTANDING BAL ' DTSBX770 -00332 Y779-OUTSTANDING-QTR-CNT. DTSBX770 -00333 DTSBX770 -00334 MOVE Y779-OUTSTANDING-QTR-CNT TO WRK-OUTSTANDING-QTR-CNT. DTSBX770 -00335 MOVE Y779-OUTSTANDING-BAL TO WRK-OUTSTANDING-BAL. DTSBX770 -00336 MOVE Y779-WAGE-ITEM-CNT TO WRK-WAGE-ITEM-CNT. DTSBX770 -00337 MOVE Y779-MANDATORY-XFER-CNT TO WRK-MANDATORY-CNT. DTSBX770 -00338 MOVE Y779-PROHIBITED-XFER-CNT TO WRK-PROHIBITED-CNT. DTSBX770 -00339 MOVE Y779-SUTA-CONTRIB-DUE TO WRK-SUTA-DMP-AMT. DTSBX770 -00340 DTSBX770 -00341 P1900-EXIT. DTSBX770 -00342 EXIT. DTSBX770 -00343 DTSBX770 -00344 T0000-TERMINATE. DTSBX770 -00345 DTSBX770 -00346 PERFORM T1000-FINAL-CALL THRU T1000-EXIT. DTSBX770 +00322 P1500-REC-775. DTSBX770 +00323 SET XL775-CMD-PROCESS-88 TO TRUE. DTSBX770 +00324 PERFORM S775-CALL THRU S775-EXIT. DTSBX770 +00325 DTSBX770 +00326 P1500-EXIT. DTSBX770 +00327 EXIT. DTSBX770 +00328 DTSBX770 +00329 P1900-REC-779. DTSBX770 +00330 MOVE RSKL-REC TO Y779-REC. DTSBX770 +00331 DTSBX770 +00332 DISPLAY 'P1000 Y779 REC FOUND'. DTSBX770 +00333 DISPLAY 'ITEM 12 OUTSTANDING QTRS ' DTSBX770 +00334 Y779-OUTSTANDING-BAL. DTSBX770 +00335 DISPLAY 'ITEM 13 OUTSTANDING BAL ' DTSBX770 +00336 Y779-OUTSTANDING-QTR-CNT. DTSBX770 +00337 DTSBX770 +00338 MOVE Y779-OUTSTANDING-QTR-CNT TO WRK-OUTSTANDING-QTR-CNT. DTSBX770 +00339 MOVE Y779-OUTSTANDING-BAL TO WRK-OUTSTANDING-BAL. DTSBX770 +00340 MOVE Y779-WAGE-ITEM-CNT TO WRK-WAGE-ITEM-CNT. DTSBX770 +00341 MOVE Y779-MANDATORY-XFER-CNT TO WRK-MANDATORY-CNT. DTSBX770 +00342 MOVE Y779-PROHIBITED-XFER-CNT TO WRK-PROHIBITED-CNT. DTSBX770 +00343 MOVE Y779-SUTA-CONTRIB-DUE TO WRK-SUTA-DMP-AMT. DTSBX770 +00344 * MOVE Y779-TAXAVD-MAN-XFER-CNT TO WRK-TAXAVD-MAN-CNT. CL*15 +00345 * MOVE Y779-TAXAVD-PROH-XFER-CNT TO WRK-TAXAVD-PROH-CNT. CL*15 +00346 * MOVE Y779-TAXAVD-CONTRIB-DUE TO WRK-TAXAVD-CONT-AMT. CL*15 00347 DTSBX770 -00348 PERFORM T2000-BUILD-F581 THRU T2000-EXIT. DTSBX770 -00349 DTSBX770 -00350 DISPLAY ' '. DTSBX770 -00351 DTSBX770 -00352 DISPLAY '*** DTSBX770 TERMINATION STATISTICS ***'. DTSBX770 -00353 DTSBX770 -00354 DISPLAY ' '. DTSBX770 -00355 DTSBX770 -00356 MOVE WRK-RECORDS-READ-CNT TO WRK-CNT-DISP. DTSBX770 -00357 DISPLAY ' INPUT RECORDS READ: ' DTSBX770 -00358 WRK-CNT-DISP. DTSBX770 -00359 DTSBX770 -00360 DISPLAY ' ACTIVE SELF-INS ' F581-REIMB-EMP-CNT. DTSBX770 -00361 DISPLAY ' ACTIVE RATED ' F581-CON-EMP-CNT. DTSBX770 -00362 DISPLAY SPACE. DTSBX770 -00363 DISPLAY ' NEW DETERMS ' F581-NEW-DETERM-CNT. DTSBX770 -00364 DISPLAY ' NEW DETERMS T90 ' F581-NEW-DETERM-T90-CNT. DTSBX770 -00365 DISPLAY ' NEW DETERMS T180 ' F581-NEW-DETERM-T180-CNT. DTSBX770 -00366 DISPLAY ' SUC DETERMS ' F581-SUC-DETERM-CNT. DTSBX770 -00367 DISPLAY ' SUC DETERMS T90 ' F581-SUC-DETERM-T90-CNT. DTSBX770 -00368 DISPLAY ' SUC DETERMS T180 ' F581-SUC-DETERM-T180-CNT. DTSBX770 -00369 DISPLAY ' INACT DETERMS ' F581-TERMINATION-CNT. DTSBX770 -00370 DTSBX770 -00371 SET L926-CLOSE-88 TO TRUE. DTSBX770 -00372 PERFORM S926-BD770-INPUT THRU S926-EXIT. DTSBX770 -00373 DTSBX770 -00374 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX770 -00375 DTSBX770 -00376 T0000-EXIT. DTSBX770 -00377 EXIT. DTSBX770 -00378 DTSBX770 -00379 T1000-FINAL-CALL. DTSBX770 -00380 SET XL771-CMD-TERMINATE-88 TO TRUE. DTSBX770 -00381 PERFORM S771-CALL THRU S771-EXIT. DTSBX770 +00348 P1900-EXIT. DTSBX770 +00349 EXIT. DTSBX770 +00350 DTSBX770 +00351 T0000-TERMINATE. DTSBX770 +00352 DTSBX770 +00353 PERFORM T1000-FINAL-CALL THRU T1000-EXIT. DTSBX770 +00354 DTSBX770 +00355 PERFORM T2000-BUILD-F581 THRU T2000-EXIT. DTSBX770 +00356 DTSBX770 +00357 DISPLAY ' '. DTSBX770 +00358 DTSBX770 +00359 DISPLAY '*** DTSBX770 TERMINATION STATISTICS ***'. DTSBX770 +00360 DTSBX770 +00361 DISPLAY ' '. DTSBX770 +00362 DTSBX770 +00363 MOVE WRK-RECORDS-READ-CNT TO WRK-CNT-DISP. DTSBX770 +00364 DISPLAY ' INPUT RECORDS READ: ' DTSBX770 +00365 WRK-CNT-DISP. DTSBX770 +00366 DTSBX770 +00367 DISPLAY ' ACTIVE SELF-INS ' F581-REIMB-EMP-CNT. DTSBX770 +00368 DISPLAY ' ACTIVE RATED ' F581-CON-EMP-CNT. DTSBX770 +00369 DISPLAY SPACE. DTSBX770 +00370 DISPLAY ' NEW DETERMS ' F581-NEW-DETERM-CNT. DTSBX770 +00371 DISPLAY ' NEW DETERMS T90 ' F581-NEW-DETERM-T90-CNT. DTSBX770 +00372 DISPLAY ' NEW DETERMS T180 ' F581-NEW-DETERM-T180-CNT. DTSBX770 +00373 DISPLAY ' SUC DETERMS ' F581-SUC-DETERM-CNT. DTSBX770 +00374 DISPLAY ' SUC DETERMS T90 ' F581-SUC-DETERM-T90-CNT. DTSBX770 +00375 DISPLAY ' SUC DETERMS T180 ' F581-SUC-DETERM-T180-CNT. DTSBX770 +00376 DISPLAY ' INACT DETERMS ' F581-TERMINATION-CNT. DTSBX770 +00377 DTSBX770 +00378 SET L926-CLOSE-88 TO TRUE. DTSBX770 +00379 PERFORM S926-BD770-INPUT THRU S926-EXIT. DTSBX770 +00380 DTSBX770 +00381 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX770 00382 DTSBX770 -00383 SET XL772-CMD-TERMINATE-88 TO TRUE. DTSBX770 -00384 PERFORM S772-CALL THRU S772-EXIT. DTSBX770 +00383 T0000-EXIT. DTSBX770 +00384 EXIT. DTSBX770 00385 DTSBX770 -00386 SET XL773-CMD-TERMINATE-88 TO TRUE. DTSBX770 -00387 PERFORM S773-CALL THRU S773-EXIT. DTSBX770 -00388 DTSBX770 -00389 SET XL774-CMD-TERMINATE-88 TO TRUE. DTSBX770 -00390 PERFORM S774-CALL THRU S774-EXIT. DTSBX770 -00391 DTSBX770 -00392 SET XL775-CMD-TERMINATE-88 TO TRUE. DTSBX770 -00393 PERFORM S775-CALL THRU S775-EXIT. DTSBX770 -00394 DTSBX770 -00395 T1000-EXIT. DTSBX770 -00396 EXIT. DTSBX770 -00397 DTSBX770 -00398 T2000-BUILD-F581. DTSBX770 -00399 MOVE X770-SUBJECT-QTR-START TO F581-PERIOD-BEGIN-DATE. DTSBX770 -00400 MOVE X770-SUBJECT-QTR-END TO F581-PERIOD-END-DATE. DTSBX770 +00386 T1000-FINAL-CALL. DTSBX770 +00387 SET XL771-CMD-TERMINATE-88 TO TRUE. DTSBX770 +00388 PERFORM S771-CALL THRU S771-EXIT. DTSBX770 +00389 DTSBX770 +00390 SET XL772-CMD-TERMINATE-88 TO TRUE. DTSBX770 +00391 PERFORM S772-CALL THRU S772-EXIT. DTSBX770 +00392 DTSBX770 +00393 SET XL773-CMD-TERMINATE-88 TO TRUE. DTSBX770 +00394 PERFORM S773-CALL THRU S773-EXIT. DTSBX770 +00395 DTSBX770 +00396 SET XL774-CMD-TERMINATE-88 TO TRUE. DTSBX770 +00397 PERFORM S774-CALL THRU S774-EXIT. DTSBX770 +00398 DTSBX770 +00399 SET XL775-CMD-TERMINATE-88 TO TRUE. DTSBX770 +00400 PERFORM S775-CALL THRU S775-EXIT. DTSBX770 00401 DTSBX770 -00402 MOVE XL771-CON-EMP-CNT TO F581-CON-EMP-CNT. DTSBX770 -00403 MOVE XL771-REIMB-EMP-CNT TO F581-REIMB-EMP-CNT. DTSBX770 -00404 MOVE XL771-TOT-EMP-CNT TO F581-TOTAL-EMP-CNT. DTSBX770 -00405 DTSBX770 -00406 MOVE X770-DELINQUENT-DATE TO F581-DEL-CUTOFF-DATE. DTSBX770 -00407 MOVE ZERO TO F581-WAGE-ITEM-RCVD-CNT. DTSBX770 -00408 MOVE XL772-CON-TIMELY-CNT TO F581-CON-TIMELY-CNT. DTSBX770 -00409 MOVE XL772-CON-SECURED-CNT TO F581-CON-SECURED-CNT. DTSBX770 -00410 MOVE XL772-CON-RESOLVED-CNT TO F581-CON-RESOLVED-CNT. DTSBX770 -00411 DISPLAY 'BX770 T2000 CON SECURED: ' DTSBX770 -00412 F581-CON-SECURED-CNT. DTSBX770 -00413 DISPLAY 'BX770 T2000 CON RESOLVED: ' DTSBX770 -00414 F581-CON-RESOLVED-CNT. DTSBX770 -00415 ** COMPUTE F581-CON-RESOLVED-CNT = DTSBX770 -00416 * (XL772-CON-RESOLVED-CNT + WRK-ANNUAL-RPT-CNT). DTSBX770 -00417 * DISPLAY 'BX770 T2000 CON RESOLVED TOTAL: ' DTSBX770 -00418 ** F581-CON-RESOLVED-CNT. DTSBX770 -00419 MOVE XL772-REIMB-TIMELY-CNT TO F581-REIMB-TIMELY-CNT. DTSBX770 -00420 MOVE XL772-REIMB-SECURED-CNT TO F581-REIMB-SECURED-CNT. DTSBX770 -00421 MOVE XL772-REIMB-RESOLVED-CNT TO F581-REIMB-RESOLVED-CNT. DTSBX770 -00422 DTSBX770 -00423 MOVE XL773-NEW-DETERM-CNT TO F581-NEW-DETERM-CNT. DTSBX770 -00424 MOVE XL773-NEW-DETERM-T90-CNT DTSBX770 -00425 TO F581-NEW-DETERM-T90-CNT. DTSBX770 -00426 MOVE XL773-NEW-DETERM-T180-CNT DTSBX770 -00427 TO F581-NEW-DETERM-T180-CNT. DTSBX770 -00428 MOVE XL773-SUC-DETERM-CNT TO F581-SUC-DETERM-CNT. DTSBX770 -00429 MOVE XL773-SUC-DETERM-T90-CNT DTSBX770 -00430 TO F581-SUC-DETERM-T90-CNT. DTSBX770 -00431 MOVE XL773-SUC-DETERM-T180-CNT DTSBX770 -00432 TO F581-SUC-DETERM-T180-CNT. DTSBX770 -00433 MOVE XL773-TERMINATION-CNT TO F581-TERMINATION-CNT. DTSBX770 -00434 DTSBX770 -00435 MOVE XL774-CON-RECVBL-BEG-PERIOD DTSBX770 -00436 TO F581-CON-RECVBL-BEG-PERIOD. DTSBX770 -00437 MOVE XL774-CON-RECVBL-DETERM DTSBX770 -00438 TO F581-CON-RECVBL-DETERM. DTSBX770 -00439 MOVE XL774-CON-RECVBL-LIQUID DTSBX770 -00440 TO F581-CON-RECVBL-LIQUID. DTSBX770 -00441 MOVE XL774-CON-RECVBL-UNCOLLECT DTSBX770 -00442 TO F581-CON-RECVBL-UNCOLLECT. DTSBX770 -00443 MOVE XL774-CON-RECVBL-REMOVED DTSBX770 -00444 TO F581-CON-RECVBL-REMOVED. DTSBX770 -00445 MOVE XL774-CON-RECVBL-END-PERIOD DTSBX770 -00446 TO F581-CON-RECVBL-END-PERIOD. DTSBX770 -00447 MOVE XL774-CON-RECVBL-EMP-CNT DTSBX770 -00448 TO F581-CON-RECVBL-EMP-CNT. DTSBX770 -00449 MOVE XL774-CON-RECVBL-6-MOS DTSBX770 -00450 TO F581-CON-RECVBL-6-MOS. DTSBX770 -00451 MOVE XL774-CON-RECVBL-9-MOS DTSBX770 -00452 TO F581-CON-RECVBL-9-MOS. DTSBX770 -00453 MOVE XL774-CON-RECVBL-12-MOS DTSBX770 -00454 TO F581-CON-RECVBL-12-MOS. DTSBX770 -00455 MOVE XL774-CON-RECVBL-15-MOS DTSBX770 -00456 TO F581-CON-RECVBL-15-MOS. DTSBX770 -00457 MOVE XL774-CON-RECVBL-OVER15-MOS DTSBX770 -00458 TO F581-CON-RECVBL-OVER15-MOS. DTSBX770 -00459 DTSBX770 -00460 MOVE XL774-REIMB-RECVBL-BEG-PERIOD DTSBX770 -00461 TO F581-REIMB-RECVBL-BEG-PERIOD. DTSBX770 -00462 MOVE XL774-REIMB-RECVBL-DETERM DTSBX770 -00463 TO F581-REIMB-RECVBL-DETERM. DTSBX770 -00464 MOVE XL774-REIMB-RECVBL-LIQUID DTSBX770 -00465 TO F581-REIMB-RECVBL-LIQUID. DTSBX770 -00466 MOVE XL774-REIMB-RECVBL-UNCOLLECT DTSBX770 -00467 TO F581-REIMB-RECVBL-UNCOLLECT. DTSBX770 -00468 MOVE XL774-REIMB-RECVBL-REMOVED DTSBX770 -00469 TO F581-REIMB-RECVBL-REMOVED. DTSBX770 -00470 MOVE XL774-REIMB-RECVBL-END-PERIOD DTSBX770 -00471 TO F581-REIMB-RECVBL-END-PERIOD. DTSBX770 -00472 MOVE XL774-REIMB-RECVBL-EMP-CNT DTSBX770 -00473 TO F581-REIMB-RECVBL-EMP-CNT. DTSBX770 -00474 MOVE XL774-REIMB-RECVBL-6-MOS DTSBX770 -00475 TO F581-REIMB-RECVBL-6-MOS. DTSBX770 -00476 MOVE XL774-REIMB-RECVBL-9-MOS DTSBX770 -00477 TO F581-REIMB-RECVBL-9-MOS. DTSBX770 -00478 MOVE XL774-REIMB-RECVBL-12-MOS DTSBX770 -00479 TO F581-REIMB-RECVBL-12-MOS. DTSBX770 -00480 MOVE XL774-REIMB-RECVBL-15-MOS DTSBX770 -00481 TO F581-REIMB-RECVBL-15-MOS. DTSBX770 -00482 MOVE XL774-REIMB-RECVBL-OVER15-MOS DTSBX770 -00483 TO F581-REIMB-RECVBL-OVER15-MOS. DTSBX770 -00484 DTSBX770 -00485 MOVE XL775-AUDIT-LARGE-EMP-CNT TO F581-AUDIT-LARGE-EMP-CNT. DTSBX770 -00486 MOVE XL775-AUDIT-TOT-EMP-CNT TO F581-AUDIT-TOT-EMP-CNT. DTSBX770 -00487 MOVE XL775-AUDIT-QTR-CNT TO F581-AUDIT-QTR-CNT. DTSBX770 -00488 MOVE XL775-AUDIT-TOT-WAGES-PRE TO F581-AUDIT-TOT-WAGES-PRE. DTSBX770 -00489 MOVE XL775-AUDIT-TOT-WAGES-POST TO F581-AUDIT-TOT-WAGES-POST.DTSBX770 -00490 MOVE XL775-AUDIT-CHANGE-CNT TO F581-AUDIT-CHANGE-CNT. DTSBX770 -00491 MOVE XL775-AUDIT-HOURS-CNT TO F581-AUDIT-HOURS-CNT. DTSBX770 -00492 MOVE XL775-AUDIT-UNDERRPT-TOT-WAGES TO DTSBX770 -00493 F581-AUDIT-UNDERRPT-TOT-WAGES. DTSBX770 -00494 MOVE XL775-AUDIT-UNDERRPT-TAX-WAGES TO DTSBX770 -00495 F581-AUDIT-UNDERRPT-TAX-WAGES. DTSBX770 -00496 MOVE XL775-AUDIT-UNDERRPT-CONTRIB TO DTSBX770 -00497 F581-AUDIT-UNDERRPT-CONTRIB. DTSBX770 -00498 MOVE XL775-AUDIT-OVERRPT-TOT-WAGES TO DTSBX770 -00499 F581-AUDIT-OVERRPT-TOT-WAGES. DTSBX770 -00500 MOVE XL775-AUDIT-OVERRPT-TAX-WAGES TO DTSBX770 -00501 F581-AUDIT-OVERRPT-TAX-WAGES. DTSBX770 -00502 MOVE XL775-AUDIT-OVERRPT-CONTRIB TO DTSBX770 -00503 F581-AUDIT-OVERRPT-CONTRIB. DTSBX770 -00504 MOVE XL775-AUDIT-INDCON-TO-EMPL-CNT TO DTSBX770 -00505 F581-AUDIT-INDCON-TO-EMPL-CNT. DTSBX770 -00506 DTSBX770 -00507 MOVE WRK-OUTSTANDING-QTR-CNT TO F581-OUTSTDG-QTRS-CNT. DTSBX770 -00508 MOVE WRK-OUTSTANDING-BAL TO F581-EST-UI-DUE-AMT. DTSBX770 -00509 MOVE WRK-WAGE-ITEM-CNT TO F581-WAGE-ITEM-RCVD-CNT. DTSBX770 -00510 MOVE WRK-MANDATORY-CNT TO F581-MANDATORY-XFER-CNT. DTSBX770 -00511 MOVE WRK-PROHIBITED-CNT TO F581-PROHIBITED-XFER-CNT. DTSBX770 -00512 MOVE WRK-SUTA-DMP-AMT TO F581-SUTA-CONTRIB-DUE. DTSBX770 -00513 DTSBX770 -00514 MOVE LOW-VALUES TO F581-KEY-AREA. DTSBX770 -00515 SET F581-581-88 TO TRUE. DTSBX770 -00516 MOVE X770-SUBJECT-QTR TO F581-YRQ. DTSBX770 -00517 MOVE F581-KEY-AREA TO FSKL-KEY-AREA. DTSBX770 -00518 PERFORM S931-READ THRU S931-EXIT. DTSBX770 -00519 IF L931-NO-REC-88 DTSBX770 -00520 MOVE F581-REC TO FSKL-REC DTSBX770 -00521 PERFORM S931-WRITE THRU S931-EXIT DTSBX770 -00522 ELSE DTSBX770 -00523 MOVE F581-REC TO FSKL-REC DTSBX770 -00524 PERFORM S931-REWRITE THRU S931-EXIT. DTSBX770 -00525 DTSBX770 -00526 MOVE X770-SUBJECT-QTR TO R713-YRQ. DTSBX770 -00527 PERFORM S946-WRITE-R713 THRU S946-EXIT. DTSBX770 -00528 DTSBX770 -00529 T2000-EXIT. DTSBX770 -00530 EXIT. DTSBX770 -00531 DTSBX770 -00532 S771-CALL. DTSBX770 -00533 SET PROG-NAME-771 TO TRUE. DTSBX770 -00534 CALL PROG-NAME USING XL771-LINK-AREA DTSBX770 -00535 WRK-PARM-REC DTSBX770 -00536 RSKL-REC. DTSBX770 -00537 S771-EXIT. DTSBX770 -00538 EXIT. DTSBX770 +00402 T1000-EXIT. DTSBX770 +00403 EXIT. DTSBX770 +00404 DTSBX770 +00405 T2000-BUILD-F581. DTSBX770 +00406 MOVE X770-SUBJECT-QTR-START TO F581-PERIOD-BEGIN-DATE. DTSBX770 +00407 MOVE X770-SUBJECT-QTR-END TO F581-PERIOD-END-DATE. DTSBX770 +00408 DTSBX770 +00409 MOVE XL771-CON-EMP-CNT TO F581-CON-EMP-CNT. DTSBX770 +00410 MOVE XL771-REIMB-EMP-CNT TO F581-REIMB-EMP-CNT. DTSBX770 +00411 MOVE XL771-TOT-EMP-CNT TO F581-TOTAL-EMP-CNT. DTSBX770 +00412 DTSBX770 +00413 MOVE X770-DELINQUENT-DATE TO F581-DEL-CUTOFF-DATE. DTSBX770 +00414 MOVE ZERO TO F581-WAGE-ITEM-RCVD-CNT. DTSBX770 +00415 MOVE XL772-CON-TIMELY-CNT TO F581-CON-TIMELY-CNT. DTSBX770 +00416 MOVE XL772-CON-SECURED-CNT TO F581-CON-SECURED-CNT. DTSBX770 +00417 MOVE XL772-CON-RESOLVED-CNT TO F581-CON-RESOLVED-CNT. DTSBX770 +00418 DISPLAY 'BX770 T2000 CON SECURED: ' DTSBX770 +00419 F581-CON-SECURED-CNT. DTSBX770 +00420 DISPLAY 'BX770 T2000 CON RESOLVED: ' DTSBX770 +00421 F581-CON-RESOLVED-CNT. DTSBX770 +00422 ** COMPUTE F581-CON-RESOLVED-CNT = DTSBX770 +00423 * (XL772-CON-RESOLVED-CNT + WRK-ANNUAL-RPT-CNT). DTSBX770 +00424 * DISPLAY 'BX770 T2000 CON RESOLVED TOTAL: ' DTSBX770 +00425 ** F581-CON-RESOLVED-CNT. DTSBX770 +00426 MOVE XL772-REIMB-TIMELY-CNT TO F581-REIMB-TIMELY-CNT. DTSBX770 +00427 MOVE XL772-REIMB-SECURED-CNT TO F581-REIMB-SECURED-CNT. DTSBX770 +00428 MOVE XL772-REIMB-RESOLVED-CNT TO F581-REIMB-RESOLVED-CNT. DTSBX770 +00429 DTSBX770 +00430 MOVE XL773-NEW-DETERM-CNT TO F581-NEW-DETERM-CNT. DTSBX770 +00431 MOVE XL773-NEW-DETERM-T90-CNT DTSBX770 +00432 TO F581-NEW-DETERM-T90-CNT. DTSBX770 +00433 MOVE XL773-NEW-DETERM-T180-CNT DTSBX770 +00434 TO F581-NEW-DETERM-T180-CNT. DTSBX770 +00435 MOVE XL773-SUC-DETERM-CNT TO F581-SUC-DETERM-CNT. DTSBX770 +00436 MOVE XL773-SUC-DETERM-T90-CNT DTSBX770 +00437 TO F581-SUC-DETERM-T90-CNT. DTSBX770 +00438 MOVE XL773-SUC-DETERM-T180-CNT DTSBX770 +00439 TO F581-SUC-DETERM-T180-CNT. DTSBX770 +00440 MOVE XL773-TERMINATION-CNT TO F581-TERMINATION-CNT. DTSBX770 +00441 DTSBX770 +00442 MOVE XL774-CON-RECVBL-BEG-PERIOD DTSBX770 +00443 TO F581-CON-RECVBL-BEG-PERIOD. DTSBX770 +00444 MOVE XL774-CON-RECVBL-DETERM DTSBX770 +00445 TO F581-CON-RECVBL-DETERM. DTSBX770 +00446 MOVE XL774-CON-RECVBL-LIQUID DTSBX770 +00447 TO F581-CON-RECVBL-LIQUID. DTSBX770 +00448 MOVE XL774-CON-RECVBL-UNCOLLECT DTSBX770 +00449 TO F581-CON-RECVBL-UNCOLLECT. DTSBX770 +00450 MOVE XL774-CON-RECVBL-REMOVED DTSBX770 +00451 TO F581-CON-RECVBL-REMOVED. DTSBX770 +00452 MOVE XL774-CON-RECVBL-END-PERIOD DTSBX770 +00453 TO F581-CON-RECVBL-END-PERIOD. DTSBX770 +00454 MOVE XL774-CON-RECVBL-EMP-CNT DTSBX770 +00455 TO F581-CON-RECVBL-EMP-CNT. DTSBX770 +00456 MOVE XL774-CON-RECVBL-6-MOS DTSBX770 +00457 TO F581-CON-RECVBL-6-MOS. DTSBX770 +00458 MOVE XL774-CON-RECVBL-9-MOS DTSBX770 +00459 TO F581-CON-RECVBL-9-MOS. DTSBX770 +00460 MOVE XL774-CON-RECVBL-12-MOS DTSBX770 +00461 TO F581-CON-RECVBL-12-MOS. DTSBX770 +00462 MOVE XL774-CON-RECVBL-15-MOS DTSBX770 +00463 TO F581-CON-RECVBL-15-MOS. DTSBX770 +00464 MOVE XL774-CON-RECVBL-OVER15-MOS DTSBX770 +00465 TO F581-CON-RECVBL-OVER15-MOS. DTSBX770 +00466 DTSBX770 +00467 MOVE XL774-REIMB-RECVBL-BEG-PERIOD DTSBX770 +00468 TO F581-REIMB-RECVBL-BEG-PERIOD. DTSBX770 +00469 MOVE XL774-REIMB-RECVBL-DETERM DTSBX770 +00470 TO F581-REIMB-RECVBL-DETERM. DTSBX770 +00471 MOVE XL774-REIMB-RECVBL-LIQUID DTSBX770 +00472 TO F581-REIMB-RECVBL-LIQUID. DTSBX770 +00473 MOVE XL774-REIMB-RECVBL-UNCOLLECT DTSBX770 +00474 TO F581-REIMB-RECVBL-UNCOLLECT. DTSBX770 +00475 MOVE XL774-REIMB-RECVBL-REMOVED DTSBX770 +00476 TO F581-REIMB-RECVBL-REMOVED. DTSBX770 +00477 MOVE XL774-REIMB-RECVBL-END-PERIOD DTSBX770 +00478 TO F581-REIMB-RECVBL-END-PERIOD. DTSBX770 +00479 MOVE XL774-REIMB-RECVBL-EMP-CNT DTSBX770 +00480 TO F581-REIMB-RECVBL-EMP-CNT. DTSBX770 +00481 MOVE XL774-REIMB-RECVBL-6-MOS DTSBX770 +00482 TO F581-REIMB-RECVBL-6-MOS. DTSBX770 +00483 MOVE XL774-REIMB-RECVBL-9-MOS DTSBX770 +00484 TO F581-REIMB-RECVBL-9-MOS. DTSBX770 +00485 MOVE XL774-REIMB-RECVBL-12-MOS DTSBX770 +00486 TO F581-REIMB-RECVBL-12-MOS. DTSBX770 +00487 MOVE XL774-REIMB-RECVBL-15-MOS DTSBX770 +00488 TO F581-REIMB-RECVBL-15-MOS. DTSBX770 +00489 MOVE XL774-REIMB-RECVBL-OVER15-MOS DTSBX770 +00490 TO F581-REIMB-RECVBL-OVER15-MOS. DTSBX770 +00491 DTSBX770 +00492 MOVE XL775-AUDIT-LARGE-EMP-CNT TO F581-AUDIT-LARGE-EMP-CNT. DTSBX770 +00493 MOVE XL775-AUDIT-TOT-EMP-CNT TO F581-AUDIT-TOT-EMP-CNT. DTSBX770 +00494 MOVE XL775-AUDIT-QTR-CNT TO F581-AUDIT-QTR-CNT. DTSBX770 +00495 MOVE XL775-AUDIT-TOT-WAGES-PRE TO F581-AUDIT-TOT-WAGES-PRE. DTSBX770 +00496 MOVE XL775-AUDIT-TOT-WAGES-POST TO F581-AUDIT-TOT-WAGES-POST.DTSBX770 +00497 MOVE XL775-AUDIT-CHANGE-CNT TO F581-AUDIT-CHANGE-CNT. DTSBX770 +00498 MOVE XL775-AUDIT-HOURS-CNT TO F581-AUDIT-HOURS-CNT. DTSBX770 +00499 MOVE XL775-AUDIT-UNDERRPT-TOT-WAGES TO DTSBX770 +00500 F581-AUDIT-UNDERRPT-TOT-WAGES. DTSBX770 +00501 MOVE XL775-AUDIT-UNDERRPT-TAX-WAGES TO DTSBX770 +00502 F581-AUDIT-UNDERRPT-TAX-WAGES. DTSBX770 +00503 MOVE XL775-AUDIT-UNDERRPT-CONTRIB TO DTSBX770 +00504 F581-AUDIT-UNDERRPT-CONTRIB. DTSBX770 +00505 MOVE XL775-AUDIT-OVERRPT-TOT-WAGES TO DTSBX770 +00506 F581-AUDIT-OVERRPT-TOT-WAGES. DTSBX770 +00507 MOVE XL775-AUDIT-OVERRPT-TAX-WAGES TO DTSBX770 +00508 F581-AUDIT-OVERRPT-TAX-WAGES. DTSBX770 +00509 MOVE XL775-AUDIT-OVERRPT-CONTRIB TO DTSBX770 +00510 F581-AUDIT-OVERRPT-CONTRIB. DTSBX770 +00511 ADD XL775-AUDIT-INDCON-TO-EMPL-CNT TO CL*14 +00512 FWRK-AUDIT-INDCON-EMPL-CNT. CL*14 +00513 ADD XL775-AUDIT-NEW-EMPLOYEES-CNT TO CL*14 +00514 FWRK-AUDIT-INDCON-EMPL-CNT. CL*14 +00515 MOVE FWRK-AUDIT-INDCON-EMPL-CNT TO CL*14 +00516 F581-AUDIT-INDCON-TO-EMPL-CNT. CL*14 +00517 DTSBX770 +00518 MOVE WRK-OUTSTANDING-QTR-CNT TO F581-OUTSTDG-QTRS-CNT. DTSBX770 +00519 MOVE WRK-OUTSTANDING-BAL TO F581-EST-UI-DUE-AMT. DTSBX770 +00520 MOVE WRK-WAGE-ITEM-CNT TO F581-WAGE-ITEM-RCVD-CNT. DTSBX770 +00521 MOVE WRK-MANDATORY-CNT TO F581-MANDATORY-XFER-CNT. DTSBX770 +00522 MOVE WRK-PROHIBITED-CNT TO F581-PROHIBITED-XFER-CNT. DTSBX770 +00523 MOVE WRK-SUTA-DMP-AMT TO F581-SUTA-CONTRIB-DUE. DTSBX770 +00524 DTSBX770 +00525 MOVE LOW-VALUES TO F581-KEY-AREA. DTSBX770 +00526 SET F581-581-88 TO TRUE. DTSBX770 +00527 MOVE X770-SUBJECT-QTR TO F581-YRQ. DTSBX770 +00528 MOVE F581-KEY-AREA TO FSKL-KEY-AREA. DTSBX770 +00529 PERFORM S931-READ THRU S931-EXIT. DTSBX770 +00530 IF L931-NO-REC-88 DTSBX770 +00531 MOVE F581-REC TO FSKL-REC DTSBX770 +00532 PERFORM S931-WRITE THRU S931-EXIT DTSBX770 +00533 ELSE DTSBX770 +00534 MOVE F581-REC TO FSKL-REC DTSBX770 +00535 PERFORM S931-REWRITE THRU S931-EXIT. DTSBX770 +00536 DTSBX770 +00537 MOVE X770-SUBJECT-QTR TO R713-YRQ. DTSBX770 +00538 PERFORM S946-WRITE-R713 THRU S946-EXIT. DTSBX770 00539 DTSBX770 -00540 S772-CALL. DTSBX770 -00541 SET PROG-NAME-772 TO TRUE. DTSBX770 -00542 CALL PROG-NAME USING XL772-LINK-AREA DTSBX770 -00543 WRK-PARM-REC DTSBX770 -00544 RSKL-REC. DTSBX770 -00545 S772-EXIT. DTSBX770 -00546 EXIT. DTSBX770 -00547 DTSBX770 -00548 S773-CALL. DTSBX770 -00549 SET PROG-NAME-773 TO TRUE. DTSBX770 -00550 CALL PROG-NAME USING XL773-LINK-AREA DTSBX770 -00551 WRK-PARM-REC DTSBX770 -00552 RSKL-REC. DTSBX770 -00553 S773-EXIT. DTSBX770 -00554 EXIT. DTSBX770 -00555 DTSBX770 -00556 S774-CALL. DTSBX770 -00557 SET PROG-NAME-774 TO TRUE. DTSBX770 -00558 CALL PROG-NAME USING XL774-LINK-AREA DTSBX770 -00559 WRK-PARM-REC DTSBX770 -00560 RSKL-REC. DTSBX770 -00561 S774-EXIT. DTSBX770 -00562 EXIT. DTSBX770 -00563 DTSBX770 -00564 S775-CALL. DTSBX770 -00565 SET PROG-NAME-775 TO TRUE. DTSBX770 -00566 CALL PROG-NAME USING XL775-LINK-AREA DTSBX770 -00567 WRK-PARM-REC DTSBX770 -00568 RSKL-REC. DTSBX770 -00569 S775-EXIT. DTSBX770 -00570 EXIT. DTSBX770 -00571 DTSBX770 -00572 S926-BD770-INPUT. DTSBX770 -00573 CALL 'DTSBU926' USING L926-LINK-AREA DTSBX770 -00574 RSKL-REC. DTSBX770 -00575 DTSBX770 -00576 S926-EXIT. DTSBX770 -00577 EXIT. DTSBX770 -00578 DTSBX770 -00579 S931-OPEN-READ. DTSBX770 -00580 SET L931-OPEN-READ-88 TO TRUE. DTSBX770 -00581 GO TO S931-REF-IO. DTSBX770 +00540 T2000-EXIT. DTSBX770 +00541 EXIT. DTSBX770 +00542 DTSBX770 +00543 S771-CALL. DTSBX770 +00544 SET PROG-NAME-771 TO TRUE. DTSBX770 +00545 CALL PROG-NAME USING XL771-LINK-AREA DTSBX770 +00546 WRK-PARM-REC DTSBX770 +00547 RSKL-REC. DTSBX770 +00548 S771-EXIT. DTSBX770 +00549 EXIT. DTSBX770 +00550 DTSBX770 +00551 S772-CALL. DTSBX770 +00552 SET PROG-NAME-772 TO TRUE. DTSBX770 +00553 CALL PROG-NAME USING XL772-LINK-AREA DTSBX770 +00554 WRK-PARM-REC DTSBX770 +00555 RSKL-REC. DTSBX770 +00556 S772-EXIT. DTSBX770 +00557 EXIT. DTSBX770 +00558 DTSBX770 +00559 S773-CALL. DTSBX770 +00560 SET PROG-NAME-773 TO TRUE. DTSBX770 +00561 CALL PROG-NAME USING XL773-LINK-AREA DTSBX770 +00562 WRK-PARM-REC DTSBX770 +00563 RSKL-REC. DTSBX770 +00564 S773-EXIT. DTSBX770 +00565 EXIT. DTSBX770 +00566 DTSBX770 +00567 S774-CALL. DTSBX770 +00568 SET PROG-NAME-774 TO TRUE. DTSBX770 +00569 CALL PROG-NAME USING XL774-LINK-AREA DTSBX770 +00570 WRK-PARM-REC DTSBX770 +00571 RSKL-REC. DTSBX770 +00572 S774-EXIT. DTSBX770 +00573 EXIT. DTSBX770 +00574 DTSBX770 +00575 S775-CALL. DTSBX770 +00576 SET PROG-NAME-775 TO TRUE. DTSBX770 +00577 CALL PROG-NAME USING XL775-LINK-AREA DTSBX770 +00578 WRK-PARM-REC DTSBX770 +00579 RSKL-REC. DTSBX770 +00580 S775-EXIT. DTSBX770 +00581 EXIT. DTSBX770 00582 DTSBX770 -00583 S931-OPEN-UPDATE. DTSBX770 -00584 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBX770 -00585 GO TO S931-REF-IO. DTSBX770 +00583 S926-BD770-INPUT. DTSBX770 +00584 CALL 'DTSBU926' USING L926-LINK-AREA DTSBX770 +00585 RSKL-REC. DTSBX770 00586 DTSBX770 -00587 S931-READ. DTSBX770 -00588 SET L931-READ-88 TO TRUE. DTSBX770 -00589 GO TO S931-REF-IO. DTSBX770 -00590 DTSBX770 -00591 S931-WRITE. DTSBX770 -00592 SET L931-WRITE-88 TO TRUE. DTSBX770 -00593 GO TO S931-REF-IO. DTSBX770 -00594 DTSBX770 -00595 S931-REWRITE. DTSBX770 -00596 SET L931-REWRITE-88 TO TRUE. DTSBX770 -00597 GO TO S931-REF-IO. DTSBX770 -00598 DTSBX770 -00599 S931-CLOSE. DTSBX770 -00600 SET L931-CLOSE-88 TO TRUE. DTSBX770 -00601 GO TO S931-REF-IO. DTSBX770 -00602 DTSBX770 -00603 S931-REF-IO. DTSBX770 -00604 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX770 -00605 FSKL-REC. DTSBX770 -00606 S931-EXIT. DTSBX770 -00607 EXIT. DTSBX770 -00608 DTSBX770 -00609 S946-WRITE-R713. DTSBX770 -00610 CALL 'DTSBU946' USING R713-REC. DTSBX770 -00611 GO TO S946-EXIT. DTSBX770 -00612 DTSBX770 -00613 S946-EXIT. DTSBX770 -00614 EXIT. DTSBX770 -00615 DTSBX770 -00616 S999-ABEND. DTSBX770 -00617 DISPLAY '*** DTSBX770 ABENDING ' DTSBX770 -00618 WRK-ABEND-MSG. DTSBX770 -00619 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX770 -00620 DTSBX770 -00621 S999-EXIT. DTSBX770 -00622 EXIT. DTSBX770 +00587 S926-EXIT. DTSBX770 +00588 EXIT. DTSBX770 +00589 DTSBX770 +00590 S931-OPEN-READ. DTSBX770 +00591 SET L931-OPEN-READ-88 TO TRUE. DTSBX770 +00592 GO TO S931-REF-IO. DTSBX770 +00593 DTSBX770 +00594 S931-OPEN-UPDATE. DTSBX770 +00595 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBX770 +00596 GO TO S931-REF-IO. DTSBX770 +00597 DTSBX770 +00598 S931-READ. DTSBX770 +00599 SET L931-READ-88 TO TRUE. DTSBX770 +00600 GO TO S931-REF-IO. DTSBX770 +00601 DTSBX770 +00602 S931-WRITE. DTSBX770 +00603 SET L931-WRITE-88 TO TRUE. DTSBX770 +00604 GO TO S931-REF-IO. DTSBX770 +00605 DTSBX770 +00606 S931-REWRITE. DTSBX770 +00607 SET L931-REWRITE-88 TO TRUE. DTSBX770 +00608 GO TO S931-REF-IO. DTSBX770 +00609 DTSBX770 +00610 S931-CLOSE. DTSBX770 +00611 SET L931-CLOSE-88 TO TRUE. DTSBX770 +00612 GO TO S931-REF-IO. DTSBX770 +00613 DTSBX770 +00614 S931-REF-IO. DTSBX770 +00615 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX770 +00616 FSKL-REC. DTSBX770 +00617 S931-EXIT. DTSBX770 +00618 EXIT. DTSBX770 +00619 DTSBX770 +00620 S946-WRITE-R713. DTSBX770 +00621 CALL 'DTSBU946' USING R713-REC. DTSBX770 +00622 GO TO S946-EXIT. DTSBX770 +00623 DTSBX770 +00624 S946-EXIT. DTSBX770 +00625 EXIT. DTSBX770 +00626 DTSBX770 +00627 S999-ABEND. DTSBX770 +00628 DISPLAY '*** DTSBX770 ABENDING ' DTSBX770 +00629 WRK-ABEND-MSG. DTSBX770 +00630 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX770 +00631 DTSBX770 +00632 S999-EXIT. DTSBX770 +00633 EXIT. DTSBX770 diff --git a/Batch/DTSBX775.cob b/Batch/DTSBX775.cob index f66c8d2..88b6baa 100644 --- a/Batch/DTSBX775.cob +++ b/Batch/DTSBX775.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 08/02/13 +00001 IDENTIFICATION DIVISION. 10/17/24 00002 PROGRAM-ID. DTSBX775. DTSBX775 -00003 AUTHOR. TRW. LV003 +00003 AUTHOR. TRW. LV002 00004 DATE-WRITTEN. JANUARY 2002. DTSBX775 00005 DATE-COMPILED. DTSBX775 00006 SKIP3 DTSBX775 @@ -98,407 +98,410 @@ 00098 01 DETERM-REC PIC X(250). DTSBX775 00099 DTSBX775 00100 WORKING-STORAGE SECTION. DTSBX775 -001005 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX775 08/02/13'. DTSBX775 -00101 77 PAN-VALET PICTURE X(24) VALUE '002DTSBX775 07/30/13'. DTSBX775 -00102 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX775 02/01/04'. DTSBX775 -00103 DTSBX775 -00104 01 WRK-AREA. DTSBX775 -00105 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +775.DTSBX775 -00106 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX775'.DTSBX775 -00107 05 ABEND-MSG PIC X(60). DTSBX775 -00108 DTSBX775 -00109 05 X775-STATUS PIC X(02) VALUE SPACES. DTSBX775 -00110 88 X775-STATUS-OK-88 VALUE ZERO. DTSBX775 -00111 DTSBX775 -00112 05 WRK-VALID-EMP-SIZE-IND PIC X(01). DTSBX775 -00113 88 WRK-VALID-EMP-SIZE-YES-88 VALUE 'Y'. DTSBX775 -00114 88 WRK-VALID-EMP-SIZE-NO-88 VALUE 'N'. DTSBX775 -00115 DTSBX775 -00116 05 WRK-OBS-NBR PIC S9(07) COMP-3 VALUE +0. DTSBX775 -00117 05 WRK-RECS-WRITTEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 -00118 DTSBX775 -00119 05 WRK-AUDIT-LARGE-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 -00120 05 WRK-AUDIT-TOT-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 -00121 05 WRK-AUDIT-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 -00122 05 WRK-AUDIT-TOT-WAGES-PRE PIC S9(11)V9(02) COMP-3 DTSBX775 -00123 VALUE +0. DTSBX775 -00124 05 WRK-AUDIT-TOT-WAGES-POST PIC S9(11)V9(02) COMP-3 DTSBX775 -00125 VALUE +0. DTSBX775 -00126 05 WRK-AUDIT-CHANGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 -00127 05 WRK-AUDIT-HOURS-CNT PIC S9(08)V9(01) COMP-3 DTSBX775 -00128 VALUE +0. DTSBX775 -00129 05 WRK-AUDIT-UNDERRPT-TOT-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 -00130 VALUE +0. DTSBX775 -00131 05 WRK-AUDIT-UNDERRPT-TAX-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 -00132 VALUE +0. DTSBX775 -00133 05 WRK-AUDIT-UNDERRPT-CONTRIB PIC S9(11)V9(02) COMP-3 DTSBX775 -00134 VALUE +0. DTSBX775 -00135 05 WRK-AUDIT-OVERRPT-TOT-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 -00136 VALUE +0. DTSBX775 -00137 05 WRK-AUDIT-OVERRPT-TAX-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 -00138 VALUE +0. DTSBX775 -00139 05 WRK-AUDIT-OVERRPT-CONTRIB PIC S9(11)V9(02) COMP-3 DTSBX775 -00140 VALUE +0. DTSBX775 -00141 05 WRK-AUDIT-INDCON-TO-EMPL-CNT PIC S9(09) COMP-3 VALUE +0. DTSBX775 -00142 DTSBX775 -00143 05 DISPLAY-CNT PIC Z(13)9. DTSBX775 -00144 05 DISPLAY-AMT-X PIC X(15). DTSBX775 -00145 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX775 -00146 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX775 -00147 05 DISPLAY-HRS-X PIC X(14). DTSBX775 -00148 05 DISPLAY-HOURS-CNT REDEFINES DISPLAY-HRS-X DTSBX775 -00149 PIC ZZZ,ZZZ,ZZ9.9-. DTSBX775 -00150 EJECT DTSBX775 -00151 01 L001-LINK-AREA. DTSBX775 -00152 ++INCLUDE DTSIL001 DTSBX775 -00153 EJECT DTSBX775 -00154 01 L004-LINK-AREA. DTSBX775 -00155 ++INCLUDE DTSIL004 DTSBX775 -00156 EJECT DTSBX775 -00157 01 L005-LINK-AREA. DTSBX775 -00158 ++INCLUDE DTSIL005 DTSBX775 -00159 EJECT DTSBX775 -00160 01 Y775-REC. DTSBX775 -00161 ++INCLUDE DTSIY775 DTSBX775 -00162 DTSBX775 -00163 01 X775-REC. DTSBX775 -00164 ++INCLUDE DTSIX775 DTSBX775 -00165 EJECT DTSBX775 -00166 LINKAGE SECTION. DTSBX775 -00167 SKIP3 DTSBX775 -00168 01 XL775-LINK-AREA. DTSBX775 -00169 ++INCLUDE DTSXL775 DTSBX775 -00170 SKIP3 DTSBX775 -00171 01 X770-PARM-REC. DTSBX775 -00172 ++INCLUDE DTSIX770 DTSBX775 -00173 SKIP3 DTSBX775 -00174 01 RSKL-REC. DTSBX775 -00175 ++INCLUDE DTSIRSK1 DTSBX775 -00176 EJECT DTSBX775 -00177 PROCEDURE DIVISION USING XL775-LINK-AREA DTSBX775 -00178 X770-PARM-REC DTSBX775 -00179 RSKL-REC. DTSBX775 -00180 DTSBX775 -00181 IF XL775-CMD-PROCESS-88 DTSBX775 -00182 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX775 -00183 ELSE DTSBX775 -00184 IF XL775-CMD-INIT-88 DTSBX775 -00185 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX775 -00186 ELSE DTSBX775 -00187 IF XL775-CMD-TERMINATE-88 DTSBX775 -00188 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX775 -00189 ELSE DTSBX775 -00190 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBX775 -00191 TO ABEND-MSG DTSBX775 -00192 PERFORM S999-ABEND THRU S999-EXIT. DTSBX775 -00193 SKIP2 DTSBX775 -00194 GOBACK. DTSBX775 -00195 EJECT DTSBX775 -00196 I0000-INITIALIZE. DTSBX775 -00197 OPEN OUTPUT STATUS-DETERM. DTSBX775 -00198 IF NOT X775-STATUS-OK-88 DTSBX775 -00199 DISPLAY 'FILE STATUS IS : ' X775-STATUS DTSBX775 -00200 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX775 -00201 PERFORM S999-ABEND THRU S999-EXIT. DTSBX775 -00202 DTSBX775 -00203 MOVE +0 TO XL775-AUDIT-LARGE-EMP-CNT DTSBX775 -00204 XL775-AUDIT-TOT-EMP-CNT DTSBX775 -00205 XL775-AUDIT-QTR-CNT DTSBX775 -00206 XL775-AUDIT-TOT-WAGES-PRE DTSBX775 -00207 XL775-AUDIT-TOT-WAGES-POST DTSBX775 -00208 XL775-AUDIT-CHANGE-CNT DTSBX775 -00209 XL775-AUDIT-HOURS-CNT DTSBX775 -00210 XL775-AUDIT-UNDERRPT-TOT-WAGES DTSBX775 -00211 XL775-AUDIT-UNDERRPT-TAX-WAGES DTSBX775 -00212 XL775-AUDIT-UNDERRPT-CONTRIB DTSBX775 -00213 XL775-AUDIT-OVERRPT-TOT-WAGES DTSBX775 -00214 XL775-AUDIT-OVERRPT-TAX-WAGES DTSBX775 -00215 XL775-AUDIT-OVERRPT-CONTRIB DTSBX775 -00216 XL775-AUDIT-INDCON-TO-EMPL-CNT. DTSBX775 -00217 I0000-EXIT. DTSBX775 -00218 EXIT. DTSBX775 -00219 EJECT DTSBX775 -00220 P0000-PROCESS. DTSBX775 -00221 MOVE RSKL-REC TO Y775-REC. DTSBX775 -00222 DTSBX775 -00223 PERFORM P1000-WRITE-OUTPUT THRU P1000-EXIT. DTSBX775 +001005 77 PAN-VALET PICTURE X(24) VALUE '002DTSBX775 10/17/24'. DTSBX775 +00101 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX775 08/02/13'. DTSBX775 +00102 77 PAN-VALET PICTURE X(24) VALUE '002DTSBX775 07/30/13'. DTSBX775 +00103 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX775 02/01/04'. DTSBX775 +00104 DTSBX775 +00105 01 WRK-AREA. DTSBX775 +00106 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +775.DTSBX775 +00107 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX775'.DTSBX775 +00108 05 ABEND-MSG PIC X(60). DTSBX775 +00109 DTSBX775 +00110 05 X775-STATUS PIC X(02) VALUE SPACES. DTSBX775 +00111 88 X775-STATUS-OK-88 VALUE ZERO. DTSBX775 +00112 DTSBX775 +00113 05 WRK-VALID-EMP-SIZE-IND PIC X(01). DTSBX775 +00114 88 WRK-VALID-EMP-SIZE-YES-88 VALUE 'Y'. DTSBX775 +00115 88 WRK-VALID-EMP-SIZE-NO-88 VALUE 'N'. DTSBX775 +00116 DTSBX775 +00117 05 WRK-OBS-NBR PIC S9(07) COMP-3 VALUE +0. DTSBX775 +00118 05 WRK-RECS-WRITTEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 +00119 DTSBX775 +00120 05 WRK-AUDIT-LARGE-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 +00121 05 WRK-AUDIT-TOT-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 +00122 05 WRK-AUDIT-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 +00123 05 WRK-AUDIT-TOT-WAGES-PRE PIC S9(11)V9(02) COMP-3 DTSBX775 +00124 VALUE +0. DTSBX775 +00125 05 WRK-AUDIT-TOT-WAGES-POST PIC S9(11)V9(02) COMP-3 DTSBX775 +00126 VALUE +0. DTSBX775 +00127 05 WRK-AUDIT-CHANGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX775 +00128 05 WRK-AUDIT-HOURS-CNT PIC S9(08)V9(01) COMP-3 DTSBX775 +00129 VALUE +0. DTSBX775 +00130 05 WRK-AUDIT-UNDERRPT-TOT-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 +00131 VALUE +0. DTSBX775 +00132 05 WRK-AUDIT-UNDERRPT-TAX-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 +00133 VALUE +0. DTSBX775 +00134 05 WRK-AUDIT-UNDERRPT-CONTRIB PIC S9(11)V9(02) COMP-3 DTSBX775 +00135 VALUE +0. DTSBX775 +00136 05 WRK-AUDIT-OVERRPT-TOT-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 +00137 VALUE +0. DTSBX775 +00138 05 WRK-AUDIT-OVERRPT-TAX-WAGES PIC S9(11)V9(02) COMP-3 DTSBX775 +00139 VALUE +0. DTSBX775 +00140 05 WRK-AUDIT-OVERRPT-CONTRIB PIC S9(11)V9(02) COMP-3 DTSBX775 +00141 VALUE +0. DTSBX775 +00142 05 WRK-AUDIT-INDCON-TO-EMPL-CNT PIC S9(09) COMP-3 VALUE +0. DTSBX775 +00143 DTSBX775 +00144 05 DISPLAY-CNT PIC Z(13)9. DTSBX775 +00145 05 DISPLAY-AMT-X PIC X(15). DTSBX775 +00146 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX775 +00147 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX775 +00148 05 DISPLAY-HRS-X PIC X(14). DTSBX775 +00149 05 DISPLAY-HOURS-CNT REDEFINES DISPLAY-HRS-X DTSBX775 +00150 PIC ZZZ,ZZZ,ZZ9.9-. DTSBX775 +00151 EJECT DTSBX775 +00152 01 L001-LINK-AREA. DTSBX775 +00153 ++INCLUDE DTSIL001 DTSBX775 +00154 EJECT DTSBX775 +00155 01 L004-LINK-AREA. DTSBX775 +00156 ++INCLUDE DTSIL004 DTSBX775 +00157 EJECT DTSBX775 +00158 01 L005-LINK-AREA. DTSBX775 +00159 ++INCLUDE DTSIL005 DTSBX775 +00160 EJECT DTSBX775 +00161 01 Y775-REC. DTSBX775 +00162 ++INCLUDE DTSIY775 DTSBX775 +00163 DTSBX775 +00164 01 X775-REC. DTSBX775 +00165 ++INCLUDE DTSIX775 DTSBX775 +00166 EJECT DTSBX775 +00167 LINKAGE SECTION. DTSBX775 +00168 SKIP3 DTSBX775 +00169 01 XL775-LINK-AREA. DTSBX775 +00170 ++INCLUDE DTSXL775 DTSBX775 +00171 SKIP3 DTSBX775 +00172 01 X770-PARM-REC. DTSBX775 +00173 ++INCLUDE DTSIX770 DTSBX775 +00174 SKIP3 DTSBX775 +00175 01 RSKL-REC. DTSBX775 +00176 ++INCLUDE DTSIRSK1 DTSBX775 +00177 EJECT DTSBX775 +00178 PROCEDURE DIVISION USING XL775-LINK-AREA DTSBX775 +00179 X770-PARM-REC DTSBX775 +00180 RSKL-REC. DTSBX775 +00181 DTSBX775 +00182 IF XL775-CMD-PROCESS-88 DTSBX775 +00183 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX775 +00184 ELSE DTSBX775 +00185 IF XL775-CMD-INIT-88 DTSBX775 +00186 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX775 +00187 ELSE DTSBX775 +00188 IF XL775-CMD-TERMINATE-88 DTSBX775 +00189 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX775 +00190 ELSE DTSBX775 +00191 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBX775 +00192 TO ABEND-MSG DTSBX775 +00193 PERFORM S999-ABEND THRU S999-EXIT. DTSBX775 +00194 SKIP2 DTSBX775 +00195 GOBACK. DTSBX775 +00196 EJECT DTSBX775 +00197 I0000-INITIALIZE. DTSBX775 +00198 OPEN OUTPUT STATUS-DETERM. DTSBX775 +00199 IF NOT X775-STATUS-OK-88 DTSBX775 +00200 DISPLAY 'FILE STATUS IS : ' X775-STATUS DTSBX775 +00201 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX775 +00202 PERFORM S999-ABEND THRU S999-EXIT. DTSBX775 +00203 DTSBX775 +00204 MOVE +0 TO XL775-AUDIT-LARGE-EMP-CNT DTSBX775 +00205 XL775-AUDIT-TOT-EMP-CNT DTSBX775 +00206 XL775-AUDIT-QTR-CNT DTSBX775 +00207 XL775-AUDIT-TOT-WAGES-PRE DTSBX775 +00208 XL775-AUDIT-TOT-WAGES-POST DTSBX775 +00209 XL775-AUDIT-CHANGE-CNT DTSBX775 +00210 XL775-AUDIT-HOURS-CNT DTSBX775 +00211 XL775-AUDIT-UNDERRPT-TOT-WAGES DTSBX775 +00212 XL775-AUDIT-UNDERRPT-TAX-WAGES DTSBX775 +00213 XL775-AUDIT-UNDERRPT-CONTRIB DTSBX775 +00214 XL775-AUDIT-OVERRPT-TOT-WAGES DTSBX775 +00215 XL775-AUDIT-OVERRPT-TAX-WAGES DTSBX775 +00216 XL775-AUDIT-OVERRPT-CONTRIB DTSBX775 +00217 XL775-AUDIT-INDCON-TO-EMPL-CNT CL**2 +00218 XL775-AUDIT-NEW-EMPLOYEES-CNT. CL**2 +00219 I0000-EXIT. DTSBX775 +00220 EXIT. DTSBX775 +00221 EJECT DTSBX775 +00222 P0000-PROCESS. DTSBX775 +00223 MOVE RSKL-REC TO Y775-REC. DTSBX775 00224 DTSBX775 -00225 P0000-EXIT. DTSBX775 -00226 EXIT. DTSBX775 -00227 DTSBX775 -00228 P1000-WRITE-OUTPUT. DTSBX775 -00229 *& DISPLAY 'DTSBX775 ' Y775-EMP-NO. DTSBX775 -00230 INITIALIZE X775-REC. DTSBX775 -00231 DTSBX775 -00232 SET WRK-VALID-EMP-SIZE-YES-88 TO TRUE. DTSBX775 -00233 EVALUATE TRUE DTSBX775 -00234 WHEN Y775-EMP-SIZE-LARGE-88 DTSBX775 -00235 SET X775-EMP-SIZE-LARGE-88 TO TRUE DTSBX775 -00236 DTSBX775 -00237 WHEN Y775-EMP-SIZE-SMALL-88 DTSBX775 -00238 SET X775-EMP-SIZE-SMALL-88 TO TRUE DTSBX775 -00239 DTSBX775 -00240 WHEN OTHER DTSBX775 -00241 DISPLAY 'Y775-EMP-SIZE-IND INVALID ' Y775-EMP-SIZE-IND DTSBX775 -00242 ' EMP-NO: ' Y775-EMP-NO DTSBX775 -00243 SET WRK-VALID-EMP-SIZE-NO-88 TO TRUE DTSBX775 -00244 DTSBX775 -00245 END-EVALUATE. DTSBX775 +00225 PERFORM P1000-WRITE-OUTPUT THRU P1000-EXIT. DTSBX775 +00226 DTSBX775 +00227 P0000-EXIT. DTSBX775 +00228 EXIT. DTSBX775 +00229 DTSBX775 +00230 P1000-WRITE-OUTPUT. DTSBX775 +00231 *& DISPLAY 'DTSBX775 ' Y775-EMP-NO. DTSBX775 +00232 INITIALIZE X775-REC. DTSBX775 +00233 DTSBX775 +00234 SET WRK-VALID-EMP-SIZE-YES-88 TO TRUE. DTSBX775 +00235 EVALUATE TRUE DTSBX775 +00236 WHEN Y775-EMP-SIZE-LARGE-88 DTSBX775 +00237 SET X775-EMP-SIZE-LARGE-88 TO TRUE DTSBX775 +00238 DTSBX775 +00239 WHEN Y775-EMP-SIZE-SMALL-88 DTSBX775 +00240 SET X775-EMP-SIZE-SMALL-88 TO TRUE DTSBX775 +00241 DTSBX775 +00242 WHEN OTHER DTSBX775 +00243 DISPLAY 'Y775-EMP-SIZE-IND INVALID ' Y775-EMP-SIZE-IND DTSBX775 +00244 ' EMP-NO: ' Y775-EMP-NO DTSBX775 +00245 SET WRK-VALID-EMP-SIZE-NO-88 TO TRUE DTSBX775 00246 DTSBX775 -00247 IF WRK-VALID-EMP-SIZE-NO-88 DTSBX775 -00248 GO TO P1000-EXIT. DTSBX775 -00249 DTSBX775 -00250 EVALUATE TRUE DTSBX775 -00251 WHEN Y775-CHANGE-AUDIT-YES-88 DTSBX775 -00252 SET X775-CHANGE-AUDIT-YES-88 TO TRUE DTSBX775 -00253 DTSBX775 -00254 WHEN Y775-CHANGE-AUDIT-NO-88 DTSBX775 -00255 SET X775-CHANGE-AUDIT-NO-88 TO TRUE DTSBX775 -00256 DTSBX775 -00257 WHEN OTHER DTSBX775 -00258 DISPLAY 'Y775-CHANGE-AUDIT-IND INVALID ' DTSBX775 -00259 Y775-CHANGE-AUDIT-IND ' EMP-NO: ' Y775-EMP-NO DTSBX775 -00260 SET WRK-VALID-EMP-SIZE-NO-88 TO TRUE DTSBX775 -00261 DTSBX775 -00262 END-EVALUATE. DTSBX775 +00247 END-EVALUATE. DTSBX775 +00248 DTSBX775 +00249 IF WRK-VALID-EMP-SIZE-NO-88 DTSBX775 +00250 GO TO P1000-EXIT. DTSBX775 +00251 DTSBX775 +00252 EVALUATE TRUE DTSBX775 +00253 WHEN Y775-CHANGE-AUDIT-YES-88 DTSBX775 +00254 SET X775-CHANGE-AUDIT-YES-88 TO TRUE DTSBX775 +00255 DTSBX775 +00256 WHEN Y775-CHANGE-AUDIT-NO-88 DTSBX775 +00257 SET X775-CHANGE-AUDIT-NO-88 TO TRUE DTSBX775 +00258 DTSBX775 +00259 WHEN OTHER DTSBX775 +00260 DISPLAY 'Y775-CHANGE-AUDIT-IND INVALID ' DTSBX775 +00261 Y775-CHANGE-AUDIT-IND ' EMP-NO: ' Y775-EMP-NO DTSBX775 +00262 SET WRK-VALID-EMP-SIZE-NO-88 TO TRUE DTSBX775 00263 DTSBX775 -00264 IF WRK-VALID-EMP-SIZE-NO-88 DTSBX775 -00265 GO TO P1000-EXIT. DTSBX775 -00266 DTSBX775 -00267 ADD +1 TO WRK-OBS-NBR. DTSBX775 +00264 END-EVALUATE. DTSBX775 +00265 DTSBX775 +00266 IF WRK-VALID-EMP-SIZE-NO-88 DTSBX775 +00267 GO TO P1000-EXIT. DTSBX775 00268 DTSBX775 -00269 MOVE Y775-EMP-NO TO X775-EMP-NO. DTSBX775 -00270 MOVE WRK-OBS-NBR TO X775-OBS-NBR. DTSBX775 -00271 MOVE Y775-AUDIT-ID TO X775-AUDIT-ID. DTSBX775 -00272 DTSBX775 -00273 IF Y775-AUDIT-CMPL-DATE > ZERO DTSBX775 -00274 MOVE Y775-AUDIT-CMPL-DATE TO L001-FED-8-DATE-9 DTSBX775 -00275 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX775 -00276 MOVE L001-SLASH-8-DATE TO X775-AUDIT-CMPL-DATE DTSBX775 -00277 ELSE DTSBX775 -00278 MOVE SPACES TO X775-AUDIT-CMPL-DATE. DTSBX775 -00279 DTSBX775 -00280 MOVE Y775-PRE-AUDIT-TOT-WAGE TO X775-PRE-AUDIT-TOT-WAGE. DTSBX775 -00281 MOVE Y775-POST-AUDIT-TOT-WAGE TO X775-POST-AUDIT-TOT-WAGE. DTSBX775 -00282 MOVE Y775-UNDER-RPT-TOT-WAGE TO X775-UNDER-RPT-TOT-WAGE. DTSBX775 -00283 MOVE Y775-OVER-RPT-TOT-WAGE TO X775-OVER-RPT-TOT-WAGE. DTSBX775 -00284 MOVE ZEROS TO X775-TOTAL-RECON. DTSBX775 -00285 DTSBX775 -00286 MOVE Y775-PRE-AUDIT-TAX-WAGE TO X775-PRE-AUDIT-TAX-WAGE. DTSBX775 -00287 MOVE Y775-POST-AUDIT-TAX-WAGE TO X775-POST-AUDIT-TAX-WAGE. DTSBX775 -00288 MOVE Y775-UNDER-RPT-TAX-WAGE TO X775-UNDER-RPT-TAX-WAGE. DTSBX775 -00289 MOVE Y775-OVER-RPT-TAX-WAGE TO X775-OVER-RPT-TAX-WAGE. DTSBX775 -00290 MOVE ZEROS TO X775-TAX-RECON. DTSBX775 -00291 DTSBX775 -00292 MOVE Y775-PRE-AUDIT-CONTRIB TO X775-PRE-AUDIT-CONTRIB. DTSBX775 -00293 MOVE Y775-POST-AUDIT-CONTRIB TO X775-POST-AUDIT-CONTRIB. DTSBX775 -00294 MOVE Y775-UNDER-RPT-CONTRIB TO X775-UNDER-RPT-CONTRIB. DTSBX775 -00295 MOVE Y775-OVER-RPT-CONTRIB TO X775-OVER-RPT-CONTRIB. DTSBX775 -00296 MOVE ZEROS TO X775-CONTRIB-RECON. DTSBX775 -00297 DTSBX775 -00298 MOVE SPACES TO X775-USER-FIELD. DTSBX775 +00269 ADD +1 TO WRK-OBS-NBR. DTSBX775 +00270 DTSBX775 +00271 MOVE Y775-EMP-NO TO X775-EMP-NO. DTSBX775 +00272 MOVE WRK-OBS-NBR TO X775-OBS-NBR. DTSBX775 +00273 MOVE Y775-AUDIT-ID TO X775-AUDIT-ID. DTSBX775 +00274 DTSBX775 +00275 IF Y775-AUDIT-CMPL-DATE > ZERO DTSBX775 +00276 MOVE Y775-AUDIT-CMPL-DATE TO L001-FED-8-DATE-9 DTSBX775 +00277 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX775 +00278 MOVE L001-SLASH-8-DATE TO X775-AUDIT-CMPL-DATE DTSBX775 +00279 ELSE DTSBX775 +00280 MOVE SPACES TO X775-AUDIT-CMPL-DATE. DTSBX775 +00281 DTSBX775 +00282 MOVE Y775-PRE-AUDIT-TOT-WAGE TO X775-PRE-AUDIT-TOT-WAGE. DTSBX775 +00283 MOVE Y775-POST-AUDIT-TOT-WAGE TO X775-POST-AUDIT-TOT-WAGE. DTSBX775 +00284 MOVE Y775-UNDER-RPT-TOT-WAGE TO X775-UNDER-RPT-TOT-WAGE. DTSBX775 +00285 MOVE Y775-OVER-RPT-TOT-WAGE TO X775-OVER-RPT-TOT-WAGE. DTSBX775 +00286 MOVE ZEROS TO X775-TOTAL-RECON. DTSBX775 +00287 DTSBX775 +00288 MOVE Y775-PRE-AUDIT-TAX-WAGE TO X775-PRE-AUDIT-TAX-WAGE. DTSBX775 +00289 MOVE Y775-POST-AUDIT-TAX-WAGE TO X775-POST-AUDIT-TAX-WAGE. DTSBX775 +00290 MOVE Y775-UNDER-RPT-TAX-WAGE TO X775-UNDER-RPT-TAX-WAGE. DTSBX775 +00291 MOVE Y775-OVER-RPT-TAX-WAGE TO X775-OVER-RPT-TAX-WAGE. DTSBX775 +00292 MOVE ZEROS TO X775-TAX-RECON. DTSBX775 +00293 DTSBX775 +00294 MOVE Y775-PRE-AUDIT-CONTRIB TO X775-PRE-AUDIT-CONTRIB. DTSBX775 +00295 MOVE Y775-POST-AUDIT-CONTRIB TO X775-POST-AUDIT-CONTRIB. DTSBX775 +00296 MOVE Y775-UNDER-RPT-CONTRIB TO X775-UNDER-RPT-CONTRIB. DTSBX775 +00297 MOVE Y775-OVER-RPT-CONTRIB TO X775-OVER-RPT-CONTRIB. DTSBX775 +00298 MOVE ZEROS TO X775-CONTRIB-RECON. DTSBX775 00299 DTSBX775 -00300 WRITE DETERM-REC FROM X775-REC. DTSBX775 +00300 MOVE SPACES TO X775-USER-FIELD. DTSBX775 00301 DTSBX775 -00302 IF NOT X775-STATUS-OK-88 DTSBX775 -00303 DISPLAY 'FILE STATUS IS : ' X775-STATUS DTSBX775 -00304 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX775 -00305 PERFORM S999-ABEND THRU S999-EXIT DTSBX775 -00306 ELSE DTSBX775 -00307 ADD +1 TO WRK-RECS-WRITTEN-CNT DTSBX775 -00308 PERFORM P2000-XL775-LINK-SUMM THRU P2000-EXIT. DTSBX775 -00309 DTSBX775 -00310 P1000-EXIT. DTSBX775 -00311 EXIT. DTSBX775 -00312 DTSBX775 -00313 P2000-XL775-LINK-SUMM. DTSBX775 +00302 WRITE DETERM-REC FROM X775-REC. DTSBX775 +00303 DTSBX775 +00304 IF NOT X775-STATUS-OK-88 DTSBX775 +00305 DISPLAY 'FILE STATUS IS : ' X775-STATUS DTSBX775 +00306 MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG DTSBX775 +00307 PERFORM S999-ABEND THRU S999-EXIT DTSBX775 +00308 ELSE DTSBX775 +00309 ADD +1 TO WRK-RECS-WRITTEN-CNT DTSBX775 +00310 PERFORM P2000-XL775-LINK-SUMM THRU P2000-EXIT. DTSBX775 +00311 DTSBX775 +00312 P1000-EXIT. DTSBX775 +00313 EXIT. DTSBX775 00314 DTSBX775 -00315 IF Y775-EMP-SIZE-LARGE-88 DTSBX775 -00316 ADD +1 TO WRK-AUDIT-LARGE-EMP-CNT. DTSBX775 -00317 DTSBX775 -00318 ADD +1 TO WRK-AUDIT-TOT-EMP-CNT. DTSBX775 -00319 ADD Y775-QTR-CNT TO WRK-AUDIT-QTR-CNT. DTSBX775 -00320 DTSBX775 -00321 ADD Y775-PRE-AUDIT-TOT-WAGE TO WRK-AUDIT-TOT-WAGES-PRE. DTSBX775 -00322 ADD Y775-POST-AUDIT-TOT-WAGE TO WRK-AUDIT-TOT-WAGES-POST. DTSBX775 -00323 DTSBX775 -00324 IF Y775-CHANGE-AUDIT-YES-88 DTSBX775 -00325 ADD +1 TO WRK-AUDIT-CHANGE-CNT. DTSBX775 -00326 DTSBX775 -00327 ADD Y775-HOURS TO WRK-AUDIT-HOURS-CNT. DTSBX775 +00315 P2000-XL775-LINK-SUMM. DTSBX775 +00316 DTSBX775 +00317 IF Y775-EMP-SIZE-LARGE-88 DTSBX775 +00318 ADD +1 TO WRK-AUDIT-LARGE-EMP-CNT. DTSBX775 +00319 DTSBX775 +00320 ADD +1 TO WRK-AUDIT-TOT-EMP-CNT. DTSBX775 +00321 ADD Y775-QTR-CNT TO WRK-AUDIT-QTR-CNT. DTSBX775 +00322 DTSBX775 +00323 ADD Y775-PRE-AUDIT-TOT-WAGE TO WRK-AUDIT-TOT-WAGES-PRE. DTSBX775 +00324 ADD Y775-POST-AUDIT-TOT-WAGE TO WRK-AUDIT-TOT-WAGES-POST. DTSBX775 +00325 DTSBX775 +00326 IF Y775-CHANGE-AUDIT-YES-88 DTSBX775 +00327 ADD +1 TO WRK-AUDIT-CHANGE-CNT. DTSBX775 00328 DTSBX775 -00329 ADD Y775-UNDER-RPT-TOT-WAGE TO WRK-AUDIT-UNDERRPT-TOT-WAGES.DTSBX775 -00330 ADD Y775-UNDER-RPT-TAX-WAGE TO WRK-AUDIT-UNDERRPT-TAX-WAGES.DTSBX775 -00331 ADD Y775-UNDER-RPT-CONTRIB TO WRK-AUDIT-UNDERRPT-CONTRIB. DTSBX775 -00332 DTSBX775 -00333 ADD Y775-OVER-RPT-TOT-WAGE TO WRK-AUDIT-OVERRPT-TOT-WAGES. DTSBX775 -00334 ADD Y775-OVER-RPT-TAX-WAGE TO WRK-AUDIT-OVERRPT-TAX-WAGES. DTSBX775 -00335 ADD Y775-OVER-RPT-CONTRIB TO WRK-AUDIT-OVERRPT-CONTRIB. DTSBX775 -00336 DTSBX775 -00337 ADD Y775-IND-CON-CNT TO WRK-AUDIT-INDCON-TO-EMPL-CNT.DTSBX775 +00329 ADD Y775-HOURS TO WRK-AUDIT-HOURS-CNT. DTSBX775 +00330 DTSBX775 +00331 ADD Y775-UNDER-RPT-TOT-WAGE TO WRK-AUDIT-UNDERRPT-TOT-WAGES.DTSBX775 +00332 ADD Y775-UNDER-RPT-TAX-WAGE TO WRK-AUDIT-UNDERRPT-TAX-WAGES.DTSBX775 +00333 ADD Y775-UNDER-RPT-CONTRIB TO WRK-AUDIT-UNDERRPT-CONTRIB. DTSBX775 +00334 DTSBX775 +00335 ADD Y775-OVER-RPT-TOT-WAGE TO WRK-AUDIT-OVERRPT-TOT-WAGES. DTSBX775 +00336 ADD Y775-OVER-RPT-TAX-WAGE TO WRK-AUDIT-OVERRPT-TAX-WAGES. DTSBX775 +00337 ADD Y775-OVER-RPT-CONTRIB TO WRK-AUDIT-OVERRPT-CONTRIB. DTSBX775 00338 DTSBX775 -00339 P2000-EXIT. DTSBX775 -00340 EXIT. DTSBX775 +00339 ADD Y775-IND-CON-CNT TO WRK-AUDIT-INDCON-TO-EMPL-CNT.DTSBX775 +00340 ADD Y775-NEW-EMPLOYEE-CNT TO WRK-AUDIT-INDCON-TO-EMPL-CNT. CL**2 00341 DTSBX775 -00342 T0000-TERMINATE. DTSBX775 -00343 PERFORM T1000-UPDATE-LINK THRU T1000-EXIT. DTSBX775 +00342 P2000-EXIT. DTSBX775 +00343 EXIT. DTSBX775 00344 DTSBX775 -00345 DISPLAY ' '. DTSBX775 -00346 DTSBX775 -00347 DISPLAY '*** DTSBX775 TERMINATION STATISTICS ***'. DTSBX775 -00348 DTSBX775 -00349 DISPLAY ' '. DTSBX775 -00350 MOVE WRK-RECS-WRITTEN-CNT TO DISPLAY-CNT. DTSBX775 -00351 DISPLAY 'AUDIT RECORDS WRITTEN : ' DTSBX775 -00352 DISPLAY-CNT. DTSBX775 -00353 DTSBX775 -00354 MOVE WRK-AUDIT-LARGE-EMP-CNT TO DISPLAY-CNT. DTSBX775 -00355 DISPLAY 'AUDIT LARGE EMPLOYER COUNT : ' DTSBX775 -00356 DISPLAY-CNT. DTSBX775 -00357 DTSBX775 -00358 MOVE WRK-AUDIT-TOT-EMP-CNT TO DISPLAY-CNT. DTSBX775 -00359 DISPLAY 'AUDIT TOTAL EMPLOYER COUNT : ' DTSBX775 -00360 DISPLAY-CNT. DTSBX775 -00361 DTSBX775 -00362 MOVE WRK-AUDIT-QTR-CNT TO DISPLAY-CNT. DTSBX775 -00363 DISPLAY 'AUDIT QUARTER COUNT : ' DTSBX775 -00364 DISPLAY-CNT. DTSBX775 -00365 DTSBX775 -00366 MOVE WRK-AUDIT-TOT-WAGES-PRE TO DISPLAY-AMT. DTSBX775 -00367 DISPLAY 'AUDIT TOTAL WAGES - PREVIOUS : ' DTSBX775 -00368 DISPLAY-AMT. DTSBX775 -00369 DTSBX775 -00370 MOVE WRK-AUDIT-TOT-WAGES-POST TO DISPLAY-AMT. DTSBX775 -00371 DISPLAY 'AUDIT TOTAL WAGES - POST : ' DTSBX775 -00372 DISPLAY-AMT. DTSBX775 -00373 DTSBX775 -00374 MOVE WRK-AUDIT-CHANGE-CNT TO DISPLAY-CNT. DTSBX775 -00375 DISPLAY 'AUDIT CHANGE COUNT : ' DTSBX775 -00376 DISPLAY-CNT. DTSBX775 -00377 DTSBX775 -00378 MOVE WRK-AUDIT-HOURS-CNT TO DISPLAY-HOURS-CNT. DTSBX775 -00379 DISPLAY 'AUDIT HOURS COUNT : ' DTSBX775 -00380 DISPLAY-HOURS-CNT. DTSBX775 -00381 DTSBX775 -00382 MOVE WRK-AUDIT-UNDERRPT-TOT-WAGES TO DISPLAY-AMT. DTSBX775 -00383 DISPLAY 'AUDIT UNDER REPORT TOTAL WAGES : ' DTSBX775 -00384 DISPLAY-AMT. DTSBX775 -00385 DTSBX775 -00386 MOVE WRK-AUDIT-UNDERRPT-TAX-WAGES TO DISPLAY-AMT. DTSBX775 -00387 DISPLAY 'AUDIT UNDER REPORT TAX WAGES : ' DTSBX775 -00388 DISPLAY-AMT. DTSBX775 -00389 DTSBX775 -00390 MOVE WRK-AUDIT-UNDERRPT-CONTRIB TO DISPLAY-AMT. DTSBX775 -00391 DISPLAY 'AUDIT UNDER REPORT CONTRIBUTION : ' DTSBX775 -00392 DISPLAY-AMT. DTSBX775 -00393 DTSBX775 -00394 MOVE WRK-AUDIT-OVERRPT-TOT-WAGES TO DISPLAY-AMT. DTSBX775 -00395 DISPLAY 'AUDIT OVER REPORT TOTAL WAGES : ' DTSBX775 -00396 DISPLAY-AMT. DTSBX775 -00397 DTSBX775 -00398 MOVE WRK-AUDIT-OVERRPT-TAX-WAGES TO DISPLAY-AMT. DTSBX775 -00399 DISPLAY 'AUDIT OVER REPORT TAX WAGES : ' DTSBX775 -00400 DISPLAY-AMT. DTSBX775 -00401 DTSBX775 -00402 MOVE WRK-AUDIT-OVERRPT-CONTRIB TO DISPLAY-AMT. DTSBX775 -00403 DISPLAY 'AUDIT OVER REPORT CONTRIBUTION : ' DTSBX775 -00404 DISPLAY-AMT. DTSBX775 -00405 DTSBX775 -00406 MOVE WRK-AUDIT-INDCON-TO-EMPL-CNT TO DISPLAY-CNT. DTSBX775 -00407 DISPLAY 'AUDIT INDCON TO EMPLOYER COUNT : ' DTSBX775 -00408 DISPLAY-CNT. DTSBX775 -00409 DTSBX775 -00410 DISPLAY ' '. DTSBX775 -00411 DTSBX775 -00412 CLOSE STATUS-DETERM. DTSBX775 -00413 DTSBX775 -00414 T0000-EXIT. DTSBX775 -00415 EXIT. DTSBX775 +00345 T0000-TERMINATE. DTSBX775 +00346 PERFORM T1000-UPDATE-LINK THRU T1000-EXIT. DTSBX775 +00347 DTSBX775 +00348 DISPLAY ' '. DTSBX775 +00349 DTSBX775 +00350 DISPLAY '*** DTSBX775 TERMINATION STATISTICS ***'. DTSBX775 +00351 DTSBX775 +00352 DISPLAY ' '. DTSBX775 +00353 MOVE WRK-RECS-WRITTEN-CNT TO DISPLAY-CNT. DTSBX775 +00354 DISPLAY 'AUDIT RECORDS WRITTEN : ' DTSBX775 +00355 DISPLAY-CNT. DTSBX775 +00356 DTSBX775 +00357 MOVE WRK-AUDIT-LARGE-EMP-CNT TO DISPLAY-CNT. DTSBX775 +00358 DISPLAY 'AUDIT LARGE EMPLOYER COUNT : ' DTSBX775 +00359 DISPLAY-CNT. DTSBX775 +00360 DTSBX775 +00361 MOVE WRK-AUDIT-TOT-EMP-CNT TO DISPLAY-CNT. DTSBX775 +00362 DISPLAY 'AUDIT TOTAL EMPLOYER COUNT : ' DTSBX775 +00363 DISPLAY-CNT. DTSBX775 +00364 DTSBX775 +00365 MOVE WRK-AUDIT-QTR-CNT TO DISPLAY-CNT. DTSBX775 +00366 DISPLAY 'AUDIT QUARTER COUNT : ' DTSBX775 +00367 DISPLAY-CNT. DTSBX775 +00368 DTSBX775 +00369 MOVE WRK-AUDIT-TOT-WAGES-PRE TO DISPLAY-AMT. DTSBX775 +00370 DISPLAY 'AUDIT TOTAL WAGES - PREVIOUS : ' DTSBX775 +00371 DISPLAY-AMT. DTSBX775 +00372 DTSBX775 +00373 MOVE WRK-AUDIT-TOT-WAGES-POST TO DISPLAY-AMT. DTSBX775 +00374 DISPLAY 'AUDIT TOTAL WAGES - POST : ' DTSBX775 +00375 DISPLAY-AMT. DTSBX775 +00376 DTSBX775 +00377 MOVE WRK-AUDIT-CHANGE-CNT TO DISPLAY-CNT. DTSBX775 +00378 DISPLAY 'AUDIT CHANGE COUNT : ' DTSBX775 +00379 DISPLAY-CNT. DTSBX775 +00380 DTSBX775 +00381 MOVE WRK-AUDIT-HOURS-CNT TO DISPLAY-HOURS-CNT. DTSBX775 +00382 DISPLAY 'AUDIT HOURS COUNT : ' DTSBX775 +00383 DISPLAY-HOURS-CNT. DTSBX775 +00384 DTSBX775 +00385 MOVE WRK-AUDIT-UNDERRPT-TOT-WAGES TO DISPLAY-AMT. DTSBX775 +00386 DISPLAY 'AUDIT UNDER REPORT TOTAL WAGES : ' DTSBX775 +00387 DISPLAY-AMT. DTSBX775 +00388 DTSBX775 +00389 MOVE WRK-AUDIT-UNDERRPT-TAX-WAGES TO DISPLAY-AMT. DTSBX775 +00390 DISPLAY 'AUDIT UNDER REPORT TAX WAGES : ' DTSBX775 +00391 DISPLAY-AMT. DTSBX775 +00392 DTSBX775 +00393 MOVE WRK-AUDIT-UNDERRPT-CONTRIB TO DISPLAY-AMT. DTSBX775 +00394 DISPLAY 'AUDIT UNDER REPORT CONTRIBUTION : ' DTSBX775 +00395 DISPLAY-AMT. DTSBX775 +00396 DTSBX775 +00397 MOVE WRK-AUDIT-OVERRPT-TOT-WAGES TO DISPLAY-AMT. DTSBX775 +00398 DISPLAY 'AUDIT OVER REPORT TOTAL WAGES : ' DTSBX775 +00399 DISPLAY-AMT. DTSBX775 +00400 DTSBX775 +00401 MOVE WRK-AUDIT-OVERRPT-TAX-WAGES TO DISPLAY-AMT. DTSBX775 +00402 DISPLAY 'AUDIT OVER REPORT TAX WAGES : ' DTSBX775 +00403 DISPLAY-AMT. DTSBX775 +00404 DTSBX775 +00405 MOVE WRK-AUDIT-OVERRPT-CONTRIB TO DISPLAY-AMT. DTSBX775 +00406 DISPLAY 'AUDIT OVER REPORT CONTRIBUTION : ' DTSBX775 +00407 DISPLAY-AMT. DTSBX775 +00408 DTSBX775 +00409 MOVE WRK-AUDIT-INDCON-TO-EMPL-CNT TO DISPLAY-CNT. DTSBX775 +00410 DISPLAY 'AUDIT INDCON TO EMPLOYER COUNT : ' DTSBX775 +00411 DISPLAY-CNT. DTSBX775 +00412 DTSBX775 +00413 DISPLAY ' '. DTSBX775 +00414 DTSBX775 +00415 CLOSE STATUS-DETERM. DTSBX775 00416 DTSBX775 -00417 T1000-UPDATE-LINK. DTSBX775 -00418 DTSBX775 -00419 MOVE WRK-AUDIT-LARGE-EMP-CNT TO XL775-AUDIT-LARGE-EMP-CNT. DTSBX775 -00420 MOVE WRK-AUDIT-TOT-EMP-CNT TO XL775-AUDIT-TOT-EMP-CNT. DTSBX775 -00421 MOVE WRK-AUDIT-QTR-CNT TO XL775-AUDIT-QTR-CNT. DTSBX775 -00422 MOVE WRK-AUDIT-TOT-WAGES-PRE TO XL775-AUDIT-TOT-WAGES-PRE. DTSBX775 -00423 MOVE WRK-AUDIT-TOT-WAGES-POST TO XL775-AUDIT-TOT-WAGES-POST.DTSBX775 -00424 MOVE WRK-AUDIT-CHANGE-CNT TO XL775-AUDIT-CHANGE-CNT. DTSBX775 -00425 MOVE WRK-AUDIT-HOURS-CNT TO XL775-AUDIT-HOURS-CNT. DTSBX775 -00426 MOVE WRK-AUDIT-UNDERRPT-TOT-WAGES TO DTSBX775 -00427 XL775-AUDIT-UNDERRPT-TOT-WAGES. DTSBX775 -00428 MOVE WRK-AUDIT-UNDERRPT-TAX-WAGES TO DTSBX775 -00429 XL775-AUDIT-UNDERRPT-TAX-WAGES. DTSBX775 -00430 MOVE WRK-AUDIT-UNDERRPT-CONTRIB TO DTSBX775 -00431 XL775-AUDIT-UNDERRPT-CONTRIB. DTSBX775 -00432 MOVE WRK-AUDIT-OVERRPT-TOT-WAGES TO DTSBX775 -00433 XL775-AUDIT-OVERRPT-TOT-WAGES. DTSBX775 -00434 MOVE WRK-AUDIT-OVERRPT-TAX-WAGES TO DTSBX775 -00435 XL775-AUDIT-OVERRPT-TAX-WAGES. DTSBX775 -00436 MOVE WRK-AUDIT-OVERRPT-CONTRIB TO DTSBX775 -00437 XL775-AUDIT-OVERRPT-CONTRIB. DTSBX775 -00438 MOVE WRK-AUDIT-INDCON-TO-EMPL-CNT TO DTSBX775 -00439 XL775-AUDIT-INDCON-TO-EMPL-CNT. DTSBX775 -00440 DTSBX775 -00441 T1000-EXIT. DTSBX775 -00442 EXIT. DTSBX775 +00417 T0000-EXIT. DTSBX775 +00418 EXIT. DTSBX775 +00419 DTSBX775 +00420 T1000-UPDATE-LINK. DTSBX775 +00421 DTSBX775 +00422 MOVE WRK-AUDIT-LARGE-EMP-CNT TO XL775-AUDIT-LARGE-EMP-CNT. DTSBX775 +00423 MOVE WRK-AUDIT-TOT-EMP-CNT TO XL775-AUDIT-TOT-EMP-CNT. DTSBX775 +00424 MOVE WRK-AUDIT-QTR-CNT TO XL775-AUDIT-QTR-CNT. DTSBX775 +00425 MOVE WRK-AUDIT-TOT-WAGES-PRE TO XL775-AUDIT-TOT-WAGES-PRE. DTSBX775 +00426 MOVE WRK-AUDIT-TOT-WAGES-POST TO XL775-AUDIT-TOT-WAGES-POST.DTSBX775 +00427 MOVE WRK-AUDIT-CHANGE-CNT TO XL775-AUDIT-CHANGE-CNT. DTSBX775 +00428 MOVE WRK-AUDIT-HOURS-CNT TO XL775-AUDIT-HOURS-CNT. DTSBX775 +00429 MOVE WRK-AUDIT-UNDERRPT-TOT-WAGES TO DTSBX775 +00430 XL775-AUDIT-UNDERRPT-TOT-WAGES. DTSBX775 +00431 MOVE WRK-AUDIT-UNDERRPT-TAX-WAGES TO DTSBX775 +00432 XL775-AUDIT-UNDERRPT-TAX-WAGES. DTSBX775 +00433 MOVE WRK-AUDIT-UNDERRPT-CONTRIB TO DTSBX775 +00434 XL775-AUDIT-UNDERRPT-CONTRIB. DTSBX775 +00435 MOVE WRK-AUDIT-OVERRPT-TOT-WAGES TO DTSBX775 +00436 XL775-AUDIT-OVERRPT-TOT-WAGES. DTSBX775 +00437 MOVE WRK-AUDIT-OVERRPT-TAX-WAGES TO DTSBX775 +00438 XL775-AUDIT-OVERRPT-TAX-WAGES. DTSBX775 +00439 MOVE WRK-AUDIT-OVERRPT-CONTRIB TO DTSBX775 +00440 XL775-AUDIT-OVERRPT-CONTRIB. DTSBX775 +00441 MOVE WRK-AUDIT-INDCON-TO-EMPL-CNT TO DTSBX775 +00442 XL775-AUDIT-INDCON-TO-EMPL-CNT. DTSBX775 00443 DTSBX775 -00444 S001-FROM-FED-8. DTSBX775 -00445 SET L001-FROM-FED-8 TO TRUE. DTSBX775 -00446 GO TO S001-DATE. DTSBX775 -00447 DTSBX775 -00448 S001-FROM-ABS-DAY. DTSBX775 -00449 SET L001-FROM-ABS-DAY TO TRUE. DTSBX775 -00450 GO TO S001-DATE. DTSBX775 -00451 DTSBX775 -00452 S001-FROM-CAL-6. DTSBX775 -00453 SET L001-FROM-CAL-6 TO TRUE. DTSBX775 -00454 GO TO S001-DATE. DTSBX775 -00455 DTSBX775 -00456 S001-DATE. DTSBX775 -00457 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX775 -00458 S001-EXIT. DTSBX775 -00459 EXIT. DTSBX775 -00460 SKIP3 DTSBX775 -00461 S004-FROM-5. DTSBX775 -00462 SET L004-FROM-5 TO TRUE. DTSBX775 -00463 GO TO S004-QTR. DTSBX775 -00464 DTSBX775 -00465 S004-FROM-ABS. DTSBX775 -00466 SET L004-FROM-ABS TO TRUE. DTSBX775 -00467 GO TO S004-QTR. DTSBX775 -00468 DTSBX775 -00469 S004-FROM-3. DTSBX775 -00470 SET L004-FROM-3 TO TRUE. DTSBX775 -00471 GO TO S004-QTR. DTSBX775 -00472 DTSBX775 -00473 S004-FROM-DATE. DTSBX775 -00474 SET L004-FROM-DATE TO TRUE. DTSBX775 -00475 GO TO S004-QTR. DTSBX775 -00476 DTSBX775 -00477 S004-QTR. DTSBX775 -00478 DTSBX775 -00479 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX775 -00480 DTSBX775 -00481 S004-EXIT. DTSBX775 -00482 EXIT. DTSBX775 -00483 SKIP3 DTSBX775 -00484 S005-FROM-ABSTIME. DTSBX775 -00485 SET L005-FROM-ABSTIME TO TRUE. DTSBX775 -00486 GO TO S005-ABSTIME. DTSBX775 -00487 DTSBX775 -00488 S005-FROM-DATE-TIME. DTSBX775 -00489 SET L005-FROM-DATE-TIME TO TRUE. DTSBX775 -00490 GO TO S005-ABSTIME. DTSBX775 -00491 DTSBX775 -00492 S005-ABSTIME. DTSBX775 -00493 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX775 -00494 S005-EXIT. DTSBX775 -00495 EXIT. DTSBX775 -00496 SKIP3 DTSBX775 -00497 S999-ABEND. DTSBX775 -00498 DISPLAY '*** DTSBX775 ABENDING. ' DTSBX775 -00499 ABEND-MSG. DTSBX775 -00500 DTSBX775 -00501 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX775 -00502 S999-EXIT. DTSBX775 -00503 EXIT. DTSBX775 +00444 T1000-EXIT. DTSBX775 +00445 EXIT. DTSBX775 +00446 DTSBX775 +00447 S001-FROM-FED-8. DTSBX775 +00448 SET L001-FROM-FED-8 TO TRUE. DTSBX775 +00449 GO TO S001-DATE. DTSBX775 +00450 DTSBX775 +00451 S001-FROM-ABS-DAY. DTSBX775 +00452 SET L001-FROM-ABS-DAY TO TRUE. DTSBX775 +00453 GO TO S001-DATE. DTSBX775 +00454 DTSBX775 +00455 S001-FROM-CAL-6. DTSBX775 +00456 SET L001-FROM-CAL-6 TO TRUE. DTSBX775 +00457 GO TO S001-DATE. DTSBX775 +00458 DTSBX775 +00459 S001-DATE. DTSBX775 +00460 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX775 +00461 S001-EXIT. DTSBX775 +00462 EXIT. DTSBX775 +00463 SKIP3 DTSBX775 +00464 S004-FROM-5. DTSBX775 +00465 SET L004-FROM-5 TO TRUE. DTSBX775 +00466 GO TO S004-QTR. DTSBX775 +00467 DTSBX775 +00468 S004-FROM-ABS. DTSBX775 +00469 SET L004-FROM-ABS TO TRUE. DTSBX775 +00470 GO TO S004-QTR. DTSBX775 +00471 DTSBX775 +00472 S004-FROM-3. DTSBX775 +00473 SET L004-FROM-3 TO TRUE. DTSBX775 +00474 GO TO S004-QTR. DTSBX775 +00475 DTSBX775 +00476 S004-FROM-DATE. DTSBX775 +00477 SET L004-FROM-DATE TO TRUE. DTSBX775 +00478 GO TO S004-QTR. DTSBX775 +00479 DTSBX775 +00480 S004-QTR. DTSBX775 +00481 DTSBX775 +00482 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX775 +00483 DTSBX775 +00484 S004-EXIT. DTSBX775 +00485 EXIT. DTSBX775 +00486 SKIP3 DTSBX775 +00487 S005-FROM-ABSTIME. DTSBX775 +00488 SET L005-FROM-ABSTIME TO TRUE. DTSBX775 +00489 GO TO S005-ABSTIME. DTSBX775 +00490 DTSBX775 +00491 S005-FROM-DATE-TIME. DTSBX775 +00492 SET L005-FROM-DATE-TIME TO TRUE. DTSBX775 +00493 GO TO S005-ABSTIME. DTSBX775 +00494 DTSBX775 +00495 S005-ABSTIME. DTSBX775 +00496 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX775 +00497 S005-EXIT. DTSBX775 +00498 EXIT. DTSBX775 +00499 SKIP3 DTSBX775 +00500 S999-ABEND. DTSBX775 +00501 DISPLAY '*** DTSBX775 ABENDING. ' DTSBX775 +00502 ABEND-MSG. DTSBX775 +00503 DTSBX775 +00504 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX775 +00505 S999-EXIT. DTSBX775 +00506 EXIT. DTSBX775 diff --git a/Batch/DTSBX800.cob b/Batch/DTSBX800.cob index 0857d67..826f944 100644 --- a/Batch/DTSBX800.cob +++ b/Batch/DTSBX800.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 01/16/08 +00001 IDENTIFICATION DIVISION. 12/23/19 00002 PROGRAM-ID. DTSBX800. DTSBX800 -00003 AUTHOR. NGC. LV001 +00003 AUTHOR. NGC. LV009 00004 DATE-WRITTEN. OCTOBER 2006. DTSBX800 00005 DATE-COMPILED. DTSBX800 00006 SKIP3 DTSBX800 @@ -16,268 +16,287 @@ 00016 * >>> THE 'SELECT ALL' SETTING IS USED IN PROCESSING ICESA DTSBX800 00017 * >>> REPORTS (DTSBD551). DTSBX800 00018 * DTSBX800 -00019 ***** DTSBX800 -00020 SKIP3 DTSBX800 -00021 ENVIRONMENT DIVISION. DTSBX800 -00022 SKIP2 DTSBX800 -00023 INPUT-OUTPUT SECTION. DTSBX800 -00024 DTSBX800 -00025 FILE-CONTROL. DTSBX800 -00026 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSBX800 -00027 DTSBX800 -00028 SELECT ESP-FILE ASSIGN TO DTSFIESP DTSBX800 -00029 FILE STATUS IS ESP-STATUS. DTSBX800 -00030 DTSBX800 -00031 DATA DIVISION. DTSBX800 -00032 DTSBX800 -00033 FILE SECTION. DTSBX800 -00034 DTSBX800 -00035 SD SORT-FILE. DTSBX800 +00019 * 07/11/2019 MODIFIED TO NOT EXCLUDE EMPLOYER FROM THE SUC TAB CL**9 +00020 * PROGRAM DTSZX800 NEED TO RUN BEFORE THIS PROGRAM CL**9 +00021 * REBUILT THE PRED/SUCC REL TABLE. CL**9 +00022 * REFERENCE: PROGRAMMER: ZL1 CL**9 +00023 * CL**9 +00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9 +00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9 +00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: CL**9 +00027 * CL**9 +00028 ***** DTSBX800 +00029 SKIP3 DTSBX800 +00030 ENVIRONMENT DIVISION. DTSBX800 +00031 SKIP2 DTSBX800 +00032 INPUT-OUTPUT SECTION. DTSBX800 +00033 DTSBX800 +00034 FILE-CONTROL. DTSBX800 +00035 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSBX800 00036 DTSBX800 -00037 01 SORT-REC. DTSBX800 -00038 05 SORT-KEY PIC X(16). DTSBX800 +00037 SELECT ESP-FILE ASSIGN TO DTSFIESP DTSBX800 +00038 FILE STATUS IS ESP-STATUS. DTSBX800 00039 DTSBX800 -00040 FD ESP-FILE DTSBX800 -00041 RECORDING MODE IS F DTSBX800 -00042 BLOCK CONTAINS 0 RECORDS DTSBX800 -00043 LABEL RECORDS ARE OMITTED. DTSBX800 -00044 DTSBX800 -00045 01 ESP-FILE-REC PIC X(16). DTSBX800 -00046 DTSBX800 -00047 DTSBX800 -00048 WORKING-STORAGE SECTION. DTSBX800 -000485 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX800 01/16/08'. DTSBX800 -00049 SKIP3 DTSBX800 -00050 01 WRK-AREA. DTSBX800 -00051 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +340. DTSBX800 -00052 DTSBX800 -00053 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ340'.DTSBX800 -00054 DTSBX800 -00055 05 WRK-SRT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX800 -00056 05 WRK-ESP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX800 -00057 DTSBX800 -00058 05 WRK-ERROR-IND PIC X(01). DTSBX800 -00059 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX800 -00060 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX800 -00061 DTSBX800 -00062 05 ESP-STATUS PIC X(02). DTSBX800 -00063 88 ESP-STATUS-OK-88 VALUE '00'. DTSBX800 +00040 DATA DIVISION. DTSBX800 +00041 DTSBX800 +00042 FILE SECTION. DTSBX800 +00043 DTSBX800 +00044 SD SORT-FILE. DTSBX800 +00045 DTSBX800 +00046 01 SORT-REC. DTSBX800 +00047 05 SORT-KEY PIC X(16). DTSBX800 +00048 DTSBX800 +00049 FD ESP-FILE DTSBX800 +00050 RECORDING MODE IS F DTSBX800 +00051 BLOCK CONTAINS 0 RECORDS DTSBX800 +00052 LABEL RECORDS ARE OMITTED. DTSBX800 +00053 DTSBX800 +00054 01 ESP-FILE-REC PIC X(16). DTSBX800 +00055 DTSBX800 +00056 DTSBX800 +00057 WORKING-STORAGE SECTION. DTSBX800 +000575 77 PAN-VALET PICTURE X(24) VALUE '009DTSBX800 12/23/19'. DTSBX800 +00058 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX800 01/16/08'. DTSBX800 +00059 SKIP3 DTSBX800 +00060 01 WRK-AREA. DTSBX800 +00061 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +340. DTSBX800 +00062 DTSBX800 +00063 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ340'.DTSBX800 00064 DTSBX800 -00065 05 SORT-STATUS PIC X(02) VALUE '00'. DTSBX800 -00066 88 SORT-OK-88 VALUE '00'. DTSBX800 -00067 88 SORT-EOF-88 VALUE '10'. DTSBX800 -00068 DTSBX800 -00069 05 WRK-TRACE-IND PIC X(01). DTSBX800 -00070 DTSBX800 -00071 05 PCT-DISP PIC 9.9999. DTSBX800 -00072 DTSBX800 -00073 05 WRK-ESP-REC. DTSBX800 -00074 10 WRK-ESP-EFF-DT PIC S9(09) COMP-3. DTSBX800 -00075 10 WRK-ESP-PRED PIC S9(07) COMP-3. DTSBX800 -00076 10 WRK-ESP-SUC PIC S9(07) COMP-3. DTSBX800 -00077 10 WRK-ESP-PCT PIC S9V9(04) COMP-3. DTSBX800 +00065 05 WRK-SRT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX800 +00066 05 WRK-ESP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX800 +00067 DTSBX800 +00068 05 WRK-ERROR-IND PIC X(01). DTSBX800 +00069 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX800 +00070 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX800 +00071 DTSBX800 +00072 05 ESP-STATUS PIC X(02). DTSBX800 +00073 88 ESP-STATUS-OK-88 VALUE '00'. DTSBX800 +00074 DTSBX800 +00075 05 SORT-STATUS PIC X(02) VALUE '00'. DTSBX800 +00076 88 SORT-OK-88 VALUE '00'. DTSBX800 +00077 88 SORT-EOF-88 VALUE '10'. DTSBX800 00078 DTSBX800 -00079 01 L921-LINK-AREA. DTSBX800 -00080 ++INCLUDE DTSIL921 DTSBX800 -00081 DTSBX800 -00082 01 ISKL-REC. DTSBX800 -00083 ++INCLUDE DTSIISKL DTSBX800 -00084 DTSBX800 -00085 01 IPES-REC. DTSBX800 -00086 ++INCLUDE DTSIIPES DTSBX800 -00087 DTSBX800 -00088 LINKAGE SECTION. DTSBX800 -00089 DTSBX800 -00090 01 PARM-AREA. DTSBX800 -00091 05 PARM-LENGTH PIC S9(04) COMP. DTSBX800 -00092 DTSBX800 -00093 *********************************************************** DTSBX800 -00094 * PARM = 0: SELECT ONLY 'EXPERIENCE RATING' RELATIONSHIPS. DTSBX800 -00095 * PARM = 1: SELECT ALL RELATIONSHIPS. DTSBX800 -00096 *********************************************************** DTSBX800 -00097 05 PARM-DATA. DTSBX800 -00098 10 PARM-EMP-NO PIC X(01). DTSBX800 -00099 88 PARM-RATING-ONLY-88 VALUE '0'. DTSBX800 -00100 88 PARM-SELECT-ALL-88 VALUE '1'. DTSBX800 -00101 DTSBX800 -00102 PROCEDURE DIVISION. DTSBX800 -00103 DTSBX800 -00104 DTSBX800-MAIN. DTSBX800 -00105 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX800 -00106 IF WRK-ERROR-YES-88 DTSBX800 -00107 GO TO DTSBX800-MAIN-EXIT. DTSBX800 -00108 DTSBX800 -00109 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX800 -00110 DTSBX800 -00111 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX800 -00112 DTSBX800 -00113 DTSBX800-MAIN-EXIT. DTSBX800 -00114 GOBACK. DTSBX800 -00115 EJECT DTSBX800 -00116 I0000-INITIATE. DTSBX800 -00117 DTSBX800 -00118 SET WRK-ERROR-NO-88 TO TRUE. DTSBX800 -00119 DTSBX800 -00120 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX800 -00121 IF WRK-ERROR-YES-88 DTSBX800 -00122 GO TO I0000-EXIT. DTSBX800 -00123 DTSBX800 -00124 I0000-EXIT. DTSBX800 -00125 EXIT. DTSBX800 -00126 I1000-OPEN-FILES. DTSBX800 -00127 MOVE WRK-TRACE-IND TO L921-TRACE-IND. DTSBX800 -00128 DTSBX800 -00129 MOVE WRK-MOD-NAME TO L921-MOD-NAME. DTSBX800 -00130 DTSBX800 -00131 OPEN OUTPUT ESP-FILE. DTSBX800 -00132 IF NOT ESP-STATUS-OK-88 DTSBX800 -00133 DISPLAY 'CANNOT OPEN ESP OUTPUT FILE ' ESP-STATUS DTSBX800 -00134 SET WRK-ERROR-YES-88 TO TRUE DTSBX800 -00135 GO TO I1000-EXIT DTSBX800 -00136 END-IF. DTSBX800 -00137 PERFORM S921A-OPEN-READ THRU S921A-EXIT. DTSBX800 +00079 05 WRK-TRACE-IND PIC X(01). DTSBX800 +00080 DTSBX800 +00081 05 PCT-DISP PIC 9.9999. DTSBX800 +00082 DTSBX800 +00083 05 WRK-ESP-REC. DTSBX800 +00084 10 WRK-ESP-EFF-DT PIC S9(09) COMP-3. DTSBX800 +00085 10 WRK-ESP-PRED PIC S9(07) COMP-3. DTSBX800 +00086 10 WRK-ESP-SUC PIC S9(07) COMP-3. DTSBX800 +00087 10 WRK-ESP-PCT PIC S9V9(04) COMP-3. DTSBX800 +00088 DTSBX800 +00089 01 L921-LINK-AREA. DTSBX800 +00090 ++INCLUDE DTSIL921 DTSBX800 +00091 DTSBX800 +00092 01 ISKL-REC. DTSBX800 +00093 ++INCLUDE DTSIISKL DTSBX800 +00094 DTSBX800 +00095 01 IPES-REC. DTSBX800 +00096 ++INCLUDE DTSIIPES DTSBX800 +00097 DTSBX800 +00098 LINKAGE SECTION. DTSBX800 +00099 DTSBX800 +00100 01 PARM-AREA. DTSBX800 +00101 05 PARM-LENGTH PIC S9(04) COMP. DTSBX800 +00102 DTSBX800 +00103 *********************************************************** DTSBX800 +00104 * PARM = 0: SELECT ONLY 'EXPERIENCE RATING' RELATIONSHIPS. DTSBX800 +00105 * PARM = 1: SELECT ALL RELATIONSHIPS. DTSBX800 +00106 *********************************************************** DTSBX800 +00107 05 PARM-DATA. DTSBX800 +00108 10 PARM-EMP-NO PIC X(01). DTSBX800 +00109 88 PARM-RATING-ONLY-88 VALUE '0'. DTSBX800 +00110 88 PARM-SELECT-ALL-88 VALUE '1'. DTSBX800 +00111 DTSBX800 +00112 PROCEDURE DIVISION. DTSBX800 +00113 DTSBX800 +00114 DTSBX800-MAIN. DTSBX800 +00115 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX800 +00116 IF WRK-ERROR-YES-88 DTSBX800 +00117 GO TO DTSBX800-MAIN-EXIT. DTSBX800 +00118 DTSBX800 +00119 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX800 +00120 DTSBX800 +00121 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX800 +00122 DTSBX800 +00123 DTSBX800-MAIN-EXIT. DTSBX800 +00124 GOBACK. DTSBX800 +00125 EJECT DTSBX800 +00126 I0000-INITIATE. DTSBX800 +00127 DTSBX800 +00128 SET WRK-ERROR-NO-88 TO TRUE. DTSBX800 +00129 DTSBX800 +00130 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX800 +00131 IF WRK-ERROR-YES-88 DTSBX800 +00132 GO TO I0000-EXIT. DTSBX800 +00133 DTSBX800 +00134 I0000-EXIT. DTSBX800 +00135 EXIT. DTSBX800 +00136 I1000-OPEN-FILES. DTSBX800 +00137 MOVE WRK-TRACE-IND TO L921-TRACE-IND. DTSBX800 00138 DTSBX800 -00139 I1000-EXIT. DTSBX800 -00140 EXIT. DTSBX800 -00141 DTSBX800 -00142 EJECT DTSBX800 -00143 P0000-PROCESS. DTSBX800 -00144 SORT SORT-FILE DTSBX800 -00145 ON ASCENDING KEY SORT-KEY DTSBX800 -00146 INPUT PROCEDURE P1000-GET-IPES THRU P1000-EXIT DTSBX800 -00147 OUTPUT PROCEDURE P2000-WRITE-ESP THRU P2000-EXIT. DTSBX800 +00139 MOVE WRK-MOD-NAME TO L921-MOD-NAME. DTSBX800 +00140 DTSBX800 +00141 OPEN OUTPUT ESP-FILE. DTSBX800 +00142 IF NOT ESP-STATUS-OK-88 DTSBX800 +00143 DISPLAY 'CANNOT OPEN ESP OUTPUT FILE ' ESP-STATUS DTSBX800 +00144 SET WRK-ERROR-YES-88 TO TRUE DTSBX800 +00145 GO TO I1000-EXIT DTSBX800 +00146 END-IF. DTSBX800 +00147 PERFORM S921A-OPEN-READ THRU S921A-EXIT. DTSBX800 00148 DTSBX800 -00149 P0000-EXIT. DTSBX800 +00149 I1000-EXIT. DTSBX800 00150 EXIT. DTSBX800 00151 DTSBX800 -00152 P1000-GET-IPES. DTSBX800 -00153 MOVE LOW-VALUES TO IPES-KEY-AREA. DTSBX800 -00154 SET IPES-PES-88 TO TRUE. DTSBX800 -00155 MOVE IPES-KEY-AREA TO ISKL-KEY-AREA. DTSBX800 -00156 PERFORM S921B-START-BROWSE THRU S921B-EXIT. DTSBX800 -00157 DTSBX800 -00158 PERFORM UNTIL L921-NO-REC-88 DTSBX800 -00159 MOVE ISKL-REC TO IPES-REC DTSBX800 -00160 IF PARM-RATING-ONLY-88 DTSBX800 -00161 IF IPES-EXP-TRNSF-YES-88 DTSBX800 -00162 PERFORM P1100-WRITE-SORT-REC THRU P1100-EXIT DTSBX800 -00163 ADD +1 TO WRK-SRT-CNT DTSBX800 -00164 END-IF DTSBX800 -00165 ELSE DTSBX800 -00166 PERFORM P1100-WRITE-SORT-REC THRU P1100-EXIT DTSBX800 -00167 ADD +1 TO WRK-SRT-CNT DTSBX800 -00168 END-IF DTSBX800 -00169 PERFORM S921D-READ-NEXT THRU S921D-EXIT DTSBX800 -00170 END-PERFORM. DTSBX800 -00171 DTSBX800 -00172 P1000-EXIT. DTSBX800 -00173 EXIT. DTSBX800 -00174 DTSBX800 -00175 P1100-WRITE-SORT-REC. DTSBX800 -00176 MOVE IPES-EFF-DATE TO WRK-ESP-EFF-DT. DTSBX800 -00177 MOVE IPES-PRED-EMP-NO TO WRK-ESP-PRED. DTSBX800 -00178 MOVE IPES-SUC-EMP-NO TO WRK-ESP-SUC. DTSBX800 -00179 MOVE IPES-PERCENT-TRNSFRD TO WRK-ESP-PCT. DTSBX800 -00180 DTSBX800 -00181 * DISPLAY 'IN ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED DTSBX800 -00182 * ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT. DTSBX800 -00183 DTSBX800 -00184 RELEASE SORT-REC FROM WRK-ESP-REC. DTSBX800 -00185 DTSBX800 -00186 P1100-EXIT. DTSBX800 -00187 EXIT. DTSBX800 -00188 DTSBX800 -00189 DTSBX800 -00190 P2000-WRITE-ESP. DTSBX800 -00191 DTSBX800 -00192 SET SORT-OK-88 TO TRUE. DTSBX800 -00193 RETURN SORT-FILE DTSBX800 -00194 AT END DTSBX800 -00195 SET SORT-EOF-88 TO TRUE. DTSBX800 -00196 DTSBX800 -00197 PERFORM P2100-WRITE-ESP THRU P2100-EXIT DTSBX800 -00198 UNTIL SORT-EOF-88. DTSBX800 +00152 EJECT DTSBX800 +00153 P0000-PROCESS. DTSBX800 +00154 SORT SORT-FILE DTSBX800 +00155 ON ASCENDING KEY SORT-KEY DTSBX800 +00156 INPUT PROCEDURE P1000-GET-IPES THRU P1000-EXIT DTSBX800 +00157 OUTPUT PROCEDURE P2000-WRITE-ESP THRU P2000-EXIT. DTSBX800 +00158 DTSBX800 +00159 P0000-EXIT. DTSBX800 +00160 EXIT. DTSBX800 +00161 DTSBX800 +00162 P1000-GET-IPES. DTSBX800 +00163 MOVE LOW-VALUES TO IPES-KEY-AREA. DTSBX800 +00164 SET IPES-PES-88 TO TRUE. DTSBX800 +00165 MOVE IPES-KEY-AREA TO ISKL-KEY-AREA. DTSBX800 +00166 PERFORM S921B-START-BROWSE THRU S921B-EXIT. DTSBX800 +00167 DTSBX800 +00168 PERFORM UNTIL L921-NO-REC-88 DTSBX800 +00169 MOVE ISKL-REC TO IPES-REC DTSBX800 +00170 DISPLAY 'TRANSFER EXP RATING ' IPES-SUC-EMP-NO CL**7 +00171 ' TRANSFER CODE ' IPES-EXP-TRNSF-CD CL**7 +00172 CL**7 +00173 IF PARM-RATING-ONLY-88 DTSBX800 +00174 IF IPES-EXP-TRNSF-YES-88 DTSBX800 +00175 PERFORM P1100-WRITE-SORT-REC THRU P1100-EXIT DTSBX800 +00176 ADD +1 TO WRK-SRT-CNT DTSBX800 +00177 END-IF DTSBX800 +00178 ELSE DTSBX800 +00179 PERFORM P1100-WRITE-SORT-REC THRU P1100-EXIT DTSBX800 +00180 ADD +1 TO WRK-SRT-CNT DTSBX800 +00181 END-IF DTSBX800 +00182 PERFORM S921D-READ-NEXT THRU S921D-EXIT DTSBX800 +00183 END-PERFORM. DTSBX800 +00184 DTSBX800 +00185 P1000-EXIT. DTSBX800 +00186 EXIT. DTSBX800 +00187 DTSBX800 +00188 P1100-WRITE-SORT-REC. DTSBX800 +00189 * IF IPES-SUC-EMP-NO = 582326 OR 813262 OR 862472 CL**8 +00190 * OR 753582 CL**8 +00191 * DISPLAY 'PASS ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED CL**8 +00192 * ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT CL**8 +00193 * GO TO P1100-EXIT. CL**8 +00194 CL**3 +00195 MOVE IPES-EFF-DATE TO WRK-ESP-EFF-DT. DTSBX800 +00196 MOVE IPES-PRED-EMP-NO TO WRK-ESP-PRED. DTSBX800 +00197 MOVE IPES-SUC-EMP-NO TO WRK-ESP-SUC. DTSBX800 +00198 MOVE IPES-PERCENT-TRNSFRD TO WRK-ESP-PCT. DTSBX800 00199 DTSBX800 -00200 P2000-EXIT. DTSBX800 -00201 EXIT. DTSBX800 +00200 DISPLAY 'IN ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED CL**2 +00201 ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT. CL**7 00202 DTSBX800 -00203 P2100-WRITE-ESP. DTSBX800 -00204 IF SORT-RETURN NOT = +0 DTSBX800 -00205 DISPLAY 'BAD RETURN ON SORT FILE ' SORT-RETURN DTSBX800 -00206 SET SORT-EOF-88 TO TRUE DTSBX800 -00207 GO TO P2100-EXIT DTSBX800 -00208 END-IF. DTSBX800 -00209 DTSBX800 -00210 MOVE SORT-REC TO WRK-ESP-REC. DTSBX800 -00211 ** DISPLAY 'OUT ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED DTSBX800 -00212 ** ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT. DTSBX800 -00213 WRITE ESP-FILE-REC FROM SORT-REC. DTSBX800 -00214 IF NOT ESP-STATUS-OK-88 DTSBX800 -00215 DISPLAY 'CANNOT WRITE ESP REC ' ESP-STATUS DTSBX800 -00216 SET SORT-EOF-88 TO TRUE DTSBX800 -00217 GO TO P2100-EXIT DTSBX800 -00218 ELSE DTSBX800 -00219 ADD +1 TO WRK-ESP-CNT DTSBX800 -00220 END-IF. DTSBX800 +00203 RELEASE SORT-REC FROM WRK-ESP-REC. DTSBX800 +00204 DTSBX800 +00205 P1100-EXIT. DTSBX800 +00206 EXIT. DTSBX800 +00207 DTSBX800 +00208 DTSBX800 +00209 P2000-WRITE-ESP. DTSBX800 +00210 DTSBX800 +00211 SET SORT-OK-88 TO TRUE. DTSBX800 +00212 RETURN SORT-FILE DTSBX800 +00213 AT END DTSBX800 +00214 SET SORT-EOF-88 TO TRUE. DTSBX800 +00215 DTSBX800 +00216 PERFORM P2100-WRITE-ESP THRU P2100-EXIT DTSBX800 +00217 UNTIL SORT-EOF-88. DTSBX800 +00218 DTSBX800 +00219 P2000-EXIT. DTSBX800 +00220 EXIT. DTSBX800 00221 DTSBX800 -00222 RETURN SORT-FILE DTSBX800 -00223 AT END DTSBX800 -00224 SET SORT-EOF-88 TO TRUE DTSBX800 -00225 GO TO P2100-EXIT DTSBX800 -00226 END-RETURN. DTSBX800 -00227 P2100-EXIT. DTSBX800 -00228 EXIT. DTSBX800 -00229 DTSBX800 -00230 T0000-TERMINATE. DTSBX800 -00231 DTSBX800 -00232 DISPLAY ' '. DTSBX800 -00233 DTSBX800 -00234 DISPLAY '*** DTSBX800 TERMINATION STATISTICS ***'. DTSBX800 -00235 DTSBX800 -00236 DISPLAY ' '. DTSBX800 -00237 DTSBX800 -00238 DISPLAY 'IPES AIX RECORDS READ : ' DTSBX800 -00239 WRK-SRT-CNT. DTSBX800 +00222 P2100-WRITE-ESP. DTSBX800 +00223 IF SORT-RETURN NOT = +0 DTSBX800 +00224 DISPLAY 'BAD RETURN ON SORT FILE ' SORT-RETURN DTSBX800 +00225 SET SORT-EOF-88 TO TRUE DTSBX800 +00226 GO TO P2100-EXIT DTSBX800 +00227 END-IF. DTSBX800 +00228 DTSBX800 +00229 MOVE SORT-REC TO WRK-ESP-REC. DTSBX800 +00230 ** DISPLAY 'OUT ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED DTSBX800 +00231 ** ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT. DTSBX800 +00232 WRITE ESP-FILE-REC FROM SORT-REC. DTSBX800 +00233 IF NOT ESP-STATUS-OK-88 DTSBX800 +00234 DISPLAY 'CANNOT WRITE ESP REC ' ESP-STATUS DTSBX800 +00235 SET SORT-EOF-88 TO TRUE DTSBX800 +00236 GO TO P2100-EXIT DTSBX800 +00237 ELSE DTSBX800 +00238 ADD +1 TO WRK-ESP-CNT DTSBX800 +00239 END-IF. DTSBX800 00240 DTSBX800 -00241 DISPLAY 'NUMBER OF ESP RECORDS WRITTEN : ' DTSBX800 -00242 WRK-ESP-CNT. DTSBX800 -00243 DTSBX800 -00244 PERFORM S921C-CLOSE THRU S921C-EXIT. DTSBX800 -00245 DTSBX800 -00246 T0000-EXIT. DTSBX800 +00241 RETURN SORT-FILE DTSBX800 +00242 AT END DTSBX800 +00243 SET SORT-EOF-88 TO TRUE DTSBX800 +00244 GO TO P2100-EXIT DTSBX800 +00245 END-RETURN. DTSBX800 +00246 P2100-EXIT. DTSBX800 00247 EXIT. DTSBX800 -00248 EJECT DTSBX800 -00249 S921A-OPEN-READ. DTSBX800 -00250 SET L921-OPEN-READ-88 TO TRUE. DTSBX800 -00251 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 -00252 ISKL-REC. DTSBX800 -00253 S921A-EXIT. DTSBX800 -00254 EXIT. DTSBX800 -00255 DTSBX800 -00256 S921B-START-BROWSE. DTSBX800 -00257 SET L921-START-BROWSE-88 TO TRUE. DTSBX800 -00258 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 -00259 ISKL-REC. DTSBX800 -00260 S921B-EXIT. DTSBX800 -00261 EXIT. DTSBX800 +00248 DTSBX800 +00249 T0000-TERMINATE. DTSBX800 +00250 DTSBX800 +00251 DISPLAY ' '. DTSBX800 +00252 DTSBX800 +00253 DISPLAY '*** DTSBX800 TERMINATION STATISTICS ***'. DTSBX800 +00254 DTSBX800 +00255 DISPLAY ' '. DTSBX800 +00256 DTSBX800 +00257 DISPLAY 'IPES AIX RECORDS READ : ' DTSBX800 +00258 WRK-SRT-CNT. DTSBX800 +00259 DTSBX800 +00260 DISPLAY 'NUMBER OF ESP RECORDS WRITTEN : ' DTSBX800 +00261 WRK-ESP-CNT. DTSBX800 00262 DTSBX800 -00263 S921C-CLOSE. DTSBX800 -00264 SET L921-CLOSE-88 TO TRUE. DTSBX800 -00265 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 -00266 ISKL-REC. DTSBX800 -00267 S921C-EXIT. DTSBX800 -00268 EXIT. DTSBX800 -00269 DTSBX800 -00270 S921D-READ-NEXT. DTSBX800 -00271 SET L921-READ-NEXT-88 TO TRUE. DTSBX800 -00272 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 -00273 ISKL-REC. DTSBX800 -00274 S921D-EXIT. DTSBX800 -00275 EXIT. DTSBX800 -00276 DTSBX800 -00277 DTSBX800 -00278 S999-ABEND. DTSBX800 -00279 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX800 -00280 S999-EXIT. DTSBX800 -00281 EXIT. DTSBX800 -00282 DTSBX800 +00263 PERFORM S921C-CLOSE THRU S921C-EXIT. DTSBX800 +00264 DTSBX800 +00265 T0000-EXIT. DTSBX800 +00266 EXIT. DTSBX800 +00267 EJECT DTSBX800 +00268 S921A-OPEN-READ. DTSBX800 +00269 SET L921-OPEN-READ-88 TO TRUE. DTSBX800 +00270 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 +00271 ISKL-REC. DTSBX800 +00272 S921A-EXIT. DTSBX800 +00273 EXIT. DTSBX800 +00274 DTSBX800 +00275 S921B-START-BROWSE. DTSBX800 +00276 SET L921-START-BROWSE-88 TO TRUE. DTSBX800 +00277 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 +00278 ISKL-REC. DTSBX800 +00279 S921B-EXIT. DTSBX800 +00280 EXIT. DTSBX800 +00281 DTSBX800 +00282 S921C-CLOSE. DTSBX800 +00283 SET L921-CLOSE-88 TO TRUE. DTSBX800 +00284 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 +00285 ISKL-REC. DTSBX800 +00286 S921C-EXIT. DTSBX800 +00287 EXIT. DTSBX800 +00288 DTSBX800 +00289 S921D-READ-NEXT. DTSBX800 +00290 SET L921-READ-NEXT-88 TO TRUE. DTSBX800 +00291 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX800 +00292 ISKL-REC. DTSBX800 +00293 S921D-EXIT. DTSBX800 +00294 EXIT. DTSBX800 +00295 DTSBX800 +00296 DTSBX800 +00297 S999-ABEND. DTSBX800 +00298 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX800 +00299 S999-EXIT. DTSBX800 +00300 EXIT. DTSBX800 +00301 DTSBX800 diff --git a/Batch/DTSBX801.cob b/Batch/DTSBX801.cob new file mode 100644 index 0000000..def154d --- /dev/null +++ b/Batch/DTSBX801.cob @@ -0,0 +1,266 @@ +00001 IDENTIFICATION DIVISION. 06/17/13 +00002 PROGRAM-ID. DTSBX801. DTSBX801 +00003 AUTHOR. NGC. LV022 +00004 DATE-WRITTEN. JANUARY 2008. CL**6 +00005 DATE-COMPILED. DTSBX801 +00006 SKIP3 DTSBX801 +00007 ***** DTSBX801 +00008 * DTSBX801 +00009 * FUNCTION: BUILD PREDECESSOR/SUCCESSOR FILE FOR SDDS CL*15 +00010 * DTSBX801 +00011 ***** DTSBX801 +00012 SKIP3 DTSBX801 +00013 ENVIRONMENT DIVISION. DTSBX801 +00014 SKIP2 DTSBX801 +00015 INPUT-OUTPUT SECTION. DTSBX801 +00016 DTSBX801 +00017 FILE-CONTROL. DTSBX801 +00018 SELECT PRED-FILE ASSIGN TO DTSFPRED CL*15 +00019 FILE STATUS IS PRED-STATUS. CL*15 +00020 DTSBX801 +00021 DATA DIVISION. DTSBX801 +00022 DTSBX801 +00023 FILE SECTION. DTSBX801 +00024 FD PRED-FILE CL*15 +00025 RECORDING MODE IS F DTSBX801 +00026 BLOCK CONTAINS 0 RECORDS DTSBX801 +00027 LABEL RECORDS ARE OMITTED. DTSBX801 +00028 DTSBX801 +00029 01 PRED-FILE-REC PIC X(22). CL*15 +00030 DTSBX801 +00031 DTSBX801 +00032 WORKING-STORAGE SECTION. DTSBX801 +000325 77 PAN-VALET PICTURE X(24) VALUE '022DTSBX801 06/17/13'. DTSBX801 +00033 SKIP3 DTSBX801 +00034 01 WRK-AREA. DTSBX801 +00035 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +801. CL**6 +00036 DTSBX801 +00037 05 W-PRED-CNT PIC S9(07) COMP-3 VALUE +0. CL*15 +00038 DTSBX801 +00039 05 W-ERROR-IND PIC X(01). CL**6 +00040 88 W-ERROR-YES-88 VALUE 'Y'. CL**6 +00041 88 W-ERROR-NO-88 VALUE 'N'. CL**6 +00042 DTSBX801 +00043 05 W-SUCCESSOR-IND PIC X(01). CL**6 +00044 88 W-SUCCESSOR-NO-88 VALUE '0'. CL**6 +00045 88 W-SUCCESSOR-YES-88 VALUE '1'. CL**6 +00046 88 W-PARTIAL-XFER-88 VALUE '2'. CL**8 +00047 CL**6 +00048 05 PRED-STATUS PIC X(02). CL*15 +00049 88 PRED-STATUS-OK-88 VALUE '00'. CL*15 +00050 88 PRED-STATUS-EOF-88 VALUE '10'. CL*15 +00051 DTSBX801 +00052 05 W-PRED-RECORD. CL*16 +00053 10 W-STATE-CODE PIC X(02) VALUE '11'. CL*18 +00054 10 W-PRED-UI-ACCT. CL*18 +00055 15 FILLER PIC X(04) VALUE '0000'. CL*18 +00056 15 W-PRED-ACCT-NO PIC 9(06). CL*18 +00057 10 W-SUCC-UI-ACCT. CL*18 +00058 15 FILLER PIC X(04) VALUE '0000'. CL*18 +00059 15 W-SUCC-ACCT-NO PIC 9(06). CL*18 +00060 CL*16 +00061 01 L910-LINK-AREA. CL*19 +00062 ++INCLUDE DTSIL910 CL*19 +00063 CL*16 +00064 01 MSKL-REC. CL*19 +00065 ++INCLUDE DTSIMSKL CL*19 +00066 CL*16 +00067 01 MPRF-REC. CL*19 +00068 ++INCLUDE DTSIMPRF CL*19 +00069 DTSBX801 +00070 01 L921-LINK-AREA. CL*19 +00071 ++INCLUDE DTSIL921 CL*19 +00072 CL*19 +00073 01 ISKL-REC. CL*19 +00074 ++INCLUDE DTSIISKL CL*19 +00075 CL*19 +00076 01 IPES-REC. CL*19 +00077 ++INCLUDE DTSIIPES CL*19 +00078 CL*19 +00079 PROCEDURE DIVISION. CL*15 +00080 CL*12 +00081 DTSBX801-MAIN. CL**6 +00082 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX801 +00083 IF W-ERROR-YES-88 CL**6 +00084 GO TO DTSBX801-MAIN-EXIT. CL**6 +00085 DTSBX801 +00086 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX801 +00087 DTSBX801 +00088 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX801 +00089 DTSBX801 +00090 DTSBX801-MAIN-EXIT. CL**6 +00091 GOBACK. DTSBX801 +00092 EJECT DTSBX801 +00093 I0000-INITIATE. DTSBX801 +00094 DTSBX801 +00095 SET W-ERROR-NO-88 TO TRUE. CL**6 +00096 DTSBX801 +00097 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX801 +00098 IF W-ERROR-YES-88 CL**6 +00099 GO TO I0000-EXIT. DTSBX801 +00100 DTSBX801 +00101 I0000-EXIT. DTSBX801 +00102 EXIT. DTSBX801 +00103 I1000-OPEN-FILES. DTSBX801 +00104 OPEN OUTPUT PRED-FILE. CL*16 +00105 IF NOT PRED-STATUS-OK-88 CL*15 +00106 DISPLAY 'CANNOT OPEN PREDECESSOR FILE ' PRED-STATUS CL*16 +00107 SET W-ERROR-YES-88 TO TRUE CL**6 +00108 GO TO I1000-EXIT DTSBX801 +00109 END-IF. DTSBX801 +00110 DTSBX801 +00111 PERFORM S910A-OPEN-READ THRU S910A-EXIT. CL*22 +00112 PERFORM S921A-OPEN-READ THRU S921A-EXIT. CL*22 +00113 CL*16 +00114 I1000-EXIT. DTSBX801 +00115 EXIT. DTSBX801 +00116 DTSBX801 +00117 P0000-PROCESS. DTSBX801 +00118 MOVE LOW-VALUES TO IPES-KEY-AREA. CL*16 +00119 SET IPES-PES-88 TO TRUE. CL*16 +00120 MOVE IPES-KEY-AREA TO ISKL-KEY-AREA. CL*16 +00121 PERFORM S921B-START-BROWSE THRU S921B-EXIT. CL*16 +00122 CL*16 +00123 PERFORM UNTIL L921-NO-REC-88 CL*16 +00124 MOVE ISKL-REC TO IPES-REC CL*16 +00125 IF IPES-EXP-TRNSF-YES-88 CL*16 +00126 PERFORM P1000-BUILD-OUTPUT THRU P1000-EXIT CL*16 +00127 END-IF CL*16 +00128 PERFORM S921D-READ-NEXT THRU S921D-EXIT CL*16 +00129 END-PERFORM. CL*16 +00130 CL*16 +00131 P0000-EXIT. DTSBX801 +00132 EXIT. DTSBX801 +00133 DTSBX801 +00134 DTSBX801 +00135 P1000-BUILD-OUTPUT. CL*16 +00136 SET W-ERROR-NO-88 TO TRUE. CL*20 +00137 CL*20 +00138 PERFORM P1100-CHECK-MPRF THRU P1100-EXIT. CL*20 +00139 IF W-ERROR-NO-88 CL*20 +00140 PERFORM P1200-WRITE THRU P1200-EXIT CL*20 +00141 END-IF. CL*20 +00142 P1000-EXIT. DTSBX801 +00143 EXIT. DTSBX801 +00144 DTSBX801 +00145 P1100-CHECK-MPRF. CL*20 +00146 PERFORM P1110-PREDECESSOR THRU P1110-EXIT. CL*20 +00147 IF W-ERROR-NO-88 CL*20 +00148 PERFORM P1120-SUCCESSOR THRU P1120-EXIT CL*20 +00149 END-IF. CL*20 +00150 CL*20 +00151 P1100-EXIT. CL*20 +00152 EXIT. CL*20 +00153 CL*20 +00154 P1110-PREDECESSOR. CL*20 +00155 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*20 +00156 MOVE IPES-PRED-EMP-NO TO MSKL-EMP-NO. CL*20 +00157 SET MSKL-PRF-88 TO TRUE. CL*20 +00158 PERFORM S910B-READ THRU S910B-EXIT. CL*21 +00159 IF L910-NO-REC-88 CL*20 +00160 SET W-ERROR-YES-88 TO TRUE CL*20 +00161 END-IF. CL*20 +00162 CL*20 +00163 P1110-EXIT. CL*20 +00164 EXIT. CL*20 +00165 CL*20 +00166 P1120-SUCCESSOR. CL*21 +00167 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*20 +00168 MOVE IPES-SUC-EMP-NO TO MSKL-EMP-NO. CL*20 +00169 SET MSKL-PRF-88 TO TRUE. CL*20 +00170 PERFORM S910B-READ THRU S910B-EXIT. CL*21 +00171 IF L910-NO-REC-88 CL*20 +00172 SET W-ERROR-YES-88 TO TRUE CL*20 +00173 END-IF. CL*20 +00174 CL*20 +00175 P1120-EXIT. CL*20 +00176 EXIT. CL*20 +00177 CL*20 +00178 P1200-WRITE. CL*20 +00179 MOVE IPES-PRED-EMP-NO TO W-PRED-ACCT-NO. CL*20 +00180 MOVE IPES-SUC-EMP-NO TO W-SUCC-ACCT-NO. CL*20 +00181 CL*20 +00182 WRITE PRED-FILE-REC FROM W-PRED-RECORD. CL*20 +00183 IF PRED-STATUS-OK-88 CL*20 +00184 ADD +1 TO W-PRED-CNT CL*20 +00185 ELSE CL*20 +00186 DISPLAY 'CANNOT WRITE PRED RECORD ' PRED-STATUS CL*20 +00187 END-IF. CL*20 +00188 CL*20 +00189 P1200-EXIT. CL*20 +00190 EXIT. CL*20 +00191 CL*20 +00192 T0000-TERMINATE. DTSBX801 +00193 DTSBX801 +00194 DISPLAY ' '. DTSBX801 +00195 DTSBX801 +00196 DISPLAY '*** DTSBX801 TERMINATION STATISTICS ***'. CL**7 +00197 DTSBX801 +00198 DISPLAY ' '. DTSBX801 +00199 DTSBX801 +00200 DISPLAY 'RECORDS WRITTEN : ' CL*16 +00201 W-PRED-CNT. CL*16 +00202 DTSBX801 +00203 DTSBX801 +00204 CLOSE PRED-FILE. CL*16 +00205 PERFORM S910C-CLOSE THRU S910C-EXIT. CL*22 +00206 PERFORM S921C-CLOSE THRU S921C-EXIT. CL*22 +00207 DTSBX801 +00208 T0000-EXIT. DTSBX801 +00209 EXIT. DTSBX801 +00210 CL*19 +00211 S910A-OPEN-READ. CL*19 +00212 SET L910-OPEN-READ-88 TO TRUE. CL*19 +00213 CALL 'DTSBU910' USING L910-LINK-AREA CL*19 +00214 MSKL-REC. CL*19 +00215 S910A-EXIT. CL*19 +00216 EXIT. CL*19 +00217 CL*19 +00218 S910B-READ. CL*19 +00219 SET L910-READ-88 TO TRUE. CL*19 +00220 CALL 'DTSBU910' USING L910-LINK-AREA CL*19 +00221 MSKL-REC. CL*19 +00222 S910B-EXIT. CL*19 +00223 EXIT. CL*19 +00224 CL*19 +00225 S910C-CLOSE. CL*19 +00226 SET L910-CLOSE-88 TO TRUE. CL*19 +00227 CALL 'DTSBU910' USING L910-LINK-AREA CL*19 +00228 MSKL-REC. CL*19 +00229 S910C-EXIT. CL*19 +00230 EXIT. CL*19 +00231 CL*19 +00232 CL*16 +00233 S921A-OPEN-READ. CL*16 +00234 SET L921-OPEN-READ-88 TO TRUE. CL*16 +00235 CALL 'DTSBU921' USING L921-LINK-AREA CL*16 +00236 ISKL-REC. CL*16 +00237 S921A-EXIT. CL*16 +00238 EXIT. CL*16 +00239 CL*16 +00240 S921B-START-BROWSE. CL*16 +00241 SET L921-START-BROWSE-88 TO TRUE. CL*16 +00242 CALL 'DTSBU921' USING L921-LINK-AREA CL*16 +00243 ISKL-REC. CL*16 +00244 S921B-EXIT. CL*16 +00245 EXIT. CL*16 +00246 CL*16 +00247 S921C-CLOSE. CL*16 +00248 SET L921-CLOSE-88 TO TRUE. CL*16 +00249 CALL 'DTSBU921' USING L921-LINK-AREA CL*16 +00250 ISKL-REC. CL*16 +00251 S921C-EXIT. CL*16 +00252 EXIT. CL*16 +00253 CL*16 +00254 S921D-READ-NEXT. CL*16 +00255 SET L921-READ-NEXT-88 TO TRUE. CL*16 +00256 CALL 'DTSBU921' USING L921-LINK-AREA CL*16 +00257 ISKL-REC. CL*16 +00258 S921D-EXIT. CL*16 +00259 EXIT. CL*16 +00260 DTSBX801 +00261 S999-ABEND. DTSBX801 +00262 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX801 +00263 S999-EXIT. DTSBX801 +00264 EXIT. DTSBX801 +00265 DTSBX801 diff --git a/Batch/DTSBZ249.cob b/Batch/DTSBZ249.cob new file mode 100644 index 0000000..97ea9b9 --- /dev/null +++ b/Batch/DTSBZ249.cob @@ -0,0 +1,612 @@ +000010 IDENTIFICATION DIVISION. 07/02/03 +000020 PROGRAM-ID. DTSBZ249. DTSBZ249 +000030 AUTHOR. TRW. LV036 +000040 DATE-WRITTEN. MARCH 2003. CL**4 +000050 DATE-COMPILED. CL**4 +000060 SKIP3 CL**4 +000070***** CL**4 +000080* CL**4 +000090* MODIFICATION LOG: CL**4 +000100* CL**4 +000110* 03/05/2003 INITIAL DEVELOPMENT. CL**4 +000120* WORK ORDER: PROGRAMMER: GD CL**4 +000130* CL**4 +000140* MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**4 +000150* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**4 +000160* REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**4 +000170* CL**4 +000180* CL**4 +000190* DESCRIPTION: CL**4 +000200* CL**5 +000210* DESCRIPTION: CREATE W2 AND W4 TRANSACTIONS FOR THE FOLLOWING CL**5 +000220* INVALID ACCOUNT NUMBERS. CL**5 +000230* 087353 INVALID 120536 VALID CL**5 +000240* 123827 INVALID 127369 VALID CL**5 +000250* 123828 INVALID 127270 VALID CL**5 +000260* 120865 INVALID 129491 VALID CL**5 +000270* FROM THE SEGO4 OF THE CLAIM. CL**5 +000280* CL**5 +000290* USE THE PARAMETER CARD TO PROCESS CL*36 +000300* ONE ACCOUNT NUMBER AT A TIME. CL*36 +000310 CL*36 +000320* MODULES CALLED: CL**4 +000330* CL**4 +000340* CL**4 +000350* CL**4 +000360***** CL**4 +000370 SKIP3 CL**4 +000380 ENVIRONMENT DIVISION. CL**4 +000390 INPUT-OUTPUT SECTION. CL**4 +000400 CL**4 +000410 FILE-CONTROL. CL**4 +000420 CL**4 +000430 CL**4 +000440 SELECT W4-OUT-FILE ASSIGN TO W4FILE CL**4 +000450 FILE STATUS IS W4-STATUS. CL**4 +000460 CL**4 +000470 CL**4 +000480 SELECT W2-OUT-FILE ASSIGN TO W2FILE CL**4 +000490 FILE STATUS IS W2-STATUS. CL**4 +000500 CL**4 +000510 SKIP3 CL**4 +000520 DATA DIVISION. CL**4 +000530 FILE SECTION. CL**4 +000540 CL**4 +000550 CL**4 +000560 CL**4 +000570 FD W4-OUT-FILE CL**4 +000580 RECORDING MODE IS F CL**4 +000590 BLOCK CONTAINS 0 RECORDS CL**4 +000600 LABEL RECORDS ARE OMITTED. CL**4 +000610 CL**4 +000620 01 W4-OUT-REC PIC X(80). CL**4 +000630 CL**4 +000640 CL**4 +000650 FD W2-OUT-FILE CL**4 +000660 RECORDING MODE IS F CL**4 +000670 BLOCK CONTAINS 0 RECORDS CL**4 +000680 LABEL RECORDS ARE OMITTED. CL**4 +000690 CL**4 +000700 01 W2-OUT-REC PIC X(80). CL**4 +000710 CL**4 +000720 WORKING-STORAGE SECTION. CL**4 +000725 77 PAN-VALET PICTURE X(24) VALUE '001DTSBZ249 04/19/07'. CL**4 +000730 CL*17 +000740 01 WRK-PARM-IN. CL*16 +000750 05 PGM-NAME PIC X(8). CL*34 +000760 05 WRK-PARM-FIL PIC X. CL*34 +000770 05 WRK-PARM-ACCT-OLD PIC 9(6). CL*34 +000780 05 WRK-PARM-FIL PIC X. CL*34 +000790 05 WRK-PARM-ACCT-NEW PIC 9(6). CL*34 +000800 05 WRK-PARM-FIL PIC X. CL*35 +000810 05 WRK-PARM-EMPL-NAME PIC X(4). CL*35 +000820 CL*34 +000830 01 WRK-AREA. CL**4 +000840 CL**4 +000850 05 WRK-DTSBU005-IND PIC X(01). CL*16 +000860 88 WRK-DTSBU005-YES VALUE 'Y'. CL**4 +000870 88 WRK-DTSBU005-NO VALUE 'N'. CL**4 +000880 CL**4 +000890 05 WRK-CURR-DATE PIC S9(15) COMP-3 VALUE 0. CL**4 +000900 05 WRK-CURR-TIME PIC S9(09) COMP-3 VALUE 0. CL**4 +000910 CL**4 +000920 05 WRK-CORRECT-EMPLOYER. CL**4 +000930 10 WRK-LEADING-ZERO PIC 9. CL**4 +000940 10 WRK-EMP-ACCT5 PIC 9(5). CL**4 +000950 CL**4 +000960 05 WRK-ABEND-CODE PIC X(04) VALUE 'Z240'. CL**4 +000970 CL**4 +000980 05 IN-STATUS PIC X(02). CL**4 +000990 88 IN-STATUS-OK-88 VALUE '00'. CL**4 +001000 88 IN-STATUS-EOF-88 VALUE '10'. CL**4 +001010 CL**4 +001020 05 OUT-STATUS PIC X(02). CL**4 +001030 88 OUT-STATUS-OK-88 VALUE '00'. CL**4 +001040 CL**4 +001050 05 W4-STATUS PIC X(02). CL**4 +001060 88 W4-STATUS-OK-88 VALUE '00'. CL**4 +001070 CL**4 +001080 05 W2-STATUS PIC X(02). CL**4 +001090 88 W2-STATUS-OK-88 VALUE '00'. CL**4 +001100 CL**4 +001110 05 WRK-ERROR-IND PIC X(01). CL**4 +001120 88 WRK-ERROR-YES-88 VALUE 'Y'. CL**4 +001130 CL**4 +001140 05 WRK-CURR-SSN PIC 9(09) VALUE ZERO. CL**4 +001150 05 WRK-SSN-IN-COUNT PIC 9(09) VALUE ZERO. CL**4 +001160 05 WRK-SSN-OUT-COUNT PIC 9(09) VALUE ZERO. CL**4 +001170 05 WRK-CLAIM-OUT-COUNT PIC 9(09) VALUE ZERO. CL**4 +001180 05 WRK-W2-COUNT PIC 9(09) VALUE ZERO. CL**4 +001190 05 WRK-CLAIM-OUT-COUNT-W4 PIC 9(09) VALUE ZERO. CL**4 +001200 CL**4 +001210 05 WRK-SSN-IN. CL**4 +001220 10 WRK-SSN1-IN PIC 9(03). CL**4 +001230 10 FILLER PIC X(01). CL**4 +001240 10 WRK-SSN2-IN PIC 9(02). CL**4 +001250 10 FILLER PIC X(01). CL**4 +001260 10 WRK-SSN3-IN PIC 9(04). CL**4 +001270 CL**4 +001280 05 WRK-SSN. CL**4 +001290 10 WRK-SSN1 PIC 9(03). CL**4 +001300 10 WRK-SSN2 PIC 9(02). CL**4 +001310 10 WRK-SSN3 PIC 9(04). CL**4 +001320 05 WRK-SSN9 PIC 9(09). CL**4 +001330 CL**4 +001340 05 WRK-OLD-EMP PIC 9(06) VALUE 085350. CL**4 +001350 CL**4 +001360 05 WRK-OUT-REC. CL**4 +001370 10 WRK-OUT-SSN PIC 9(09). CL**4 +001380 10 WRK-OUT-SEQ PIC 9(01). CL**4 +001390 10 WRK-OUT-NAME-CHK PIC X(03). CL**4 +001400 10 WRK-OUT-B-PERIOD-1ST-YRQTR PIC 9(5). CL**4 +001410 10 WRK-OUT-B-PERIOD-2ND-YRQTR. CL**4 +001420 15 WRK-OUT-B-PERIOD-2ND-CENYR PIC 9(04). CL**4 +001430 15 WRK-OUT-B-PERIOD-2ND-QTR PIC 9(01). CL**4 +001440 10 WRK-OUT-B-PERIOD-3RD-YRQTR. CL**4 +001450 15 WRK-OUT-B-PERIOD-3RD-CENYR PIC 9(04). CL**4 +001460 15 WRK-OUT-B-PERIOD-3RD-QTR PIC 9(01). CL**4 +001470 10 WRK-OUT-B-PERIOD-4TH-YRQTR. CL**4 +001480 15 WRK-OUT-B-PERIOD-4TH-CENYR PIC 9(04). CL**4 +001490 15 WRK-OUT-B-PERIOD-4TH-QTR PIC 9(01). CL**4 +001500 10 WRK-OUT-TOT-WAGE PIC 9(07)V99. CL**4 +001510 10 WRK-OUT-CORRECT-EMPLOYER PIC 9(6). CL**4 +001520 CL**4 +001530 01 WRK-AREA-QTR-CODE. CL**4 +001540 CL**4 +001550 05 WS-QTR-CODE PIC 9(5). CL**4 +001560 05 WS-QTR-BRK REDEFINES WS-QTR-CODE. CL**4 +001570 10 WS-QTR-YR PIC 9(4). CL**4 +001580 10 WS-QTR-NUM PIC 9(1). CL**4 +001590 CL**4 +001600 05 WS-YEAR. CL**4 +001610 10 WS-CENTURY PIC 9(2). CL**4 +001620 10 WS-YEAR-BRK PIC 9(2). CL**4 +001630 CL**4 +001640 CL**4 +001650 01 WRK-IN-REC. CL**4 +001660 05 SSN-IN-SSN PIC X(11). CL**4 +001670 05 FILLER PIC X(01). CL**4 +001680 05 SSN-IN-NEW-EMP PIC 9(05). CL**4 +001690 CL**4 +001700 01 EMSG-LITERALS. CL**4 +001710 05 EMSG-NO-REC. CL**4 +001720 10 FILLER PIC X(31) CL**4 +001730 VALUE 'NO BENEFITS RECORD FOUND '. CL**4 +001740 10 FILLER PIC X(16) CL**4 +001750 VALUE SPACES. CL**4 +001760 05 EMSG-EOF. CL**4 +001770 10 FILLER PIC X(31) CL**4 +001780 VALUE 'END OF FILE '. CL**4 +001790 10 FILLER PIC X(16) CL**4 +001800 VALUE SPACES. CL**4 +001810 CL**4 +001820 01 COMMON-LINKAGE-SECTION. CL**4 +001830 CL**4 +001840 ++INCLUDE ESPLINKB CL**4 +001850 CL**4 +001860 ++INCLUDE EWGLINKB CL**4 +001870 CL**4 +001880 ++INCLUDE EWGTRNB0 CL**4 +001890 CL**4 +001900 01 TRANSACTION-WORK-AREA. CL**4 +001910 CL**4 +001920 ++INCLUDE ESPTRAND CL**4 +001930 CL**4 +001940 ++INCLUDE EWGTRNW2 CL**4 +001950 CL**4 +001960 ++INCLUDE EWGTRNW4 CL**4 +001970 CL**4 +001980 CL**4 +001990 01 L005-LINK-AREA. CL**4 +002000 ++INCLUDE DTSIL005 CL**4 +002010 CL**4 +002020 PROCEDURE DIVISION. CL**4 +002030 CL*16 +002040 ACCEPT WRK-PARM-IN. CL*16 +002050 DISPLAY 'WRK-PARM-IN ' WRK-PARM-IN. CL*28 +002060 CL*16 +002070* DISPLAY ' 1311 BEFORE INIT '. CL**4 +002080 PERFORM I0000-INIT THRU I0000-EXIT. CL**4 +002090 CL**4 +002100* DISPLAY '1340 AFTER I0000-INIT HERE ' CL**4 +002110 CL**4 +002120 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**4 +002130 CL**4 +002140 GOBACK. CL**4 +002150 EJECT CL**4 +002160 I0000-INIT. CL**4 +002170 CL**4 +002180 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. CL**4 +002190 CL**4 +002200 MOVE ZEROS TO WRK-AREA-QTR-CODE. CL**4 +002210 CL**4 +002220 CL**4 +002230 PERFORM S005-FROM-SYS THRU S005-EXIT. CL**4 +002240 CL**4 +002250 MOVE L005-DATE TO WRK-CURR-DATE. CL**4 +002260 MOVE L005-TIME TO WRK-CURR-TIME. CL**4 +002270 CL**4 +002280 I0000-EXIT. CL**4 +002290 EXIT. CL**4 +002300 CL**4 +002310 I1000-OPEN-FILES. CL**4 +002320 CL**4 +002330 CL**4 +002340 OPEN OUTPUT W4-OUT-FILE. CL**4 +002350 OPEN OUTPUT W2-OUT-FILE. CL**4 +002360 CL**4 +002370 MOVE 'DTSBZ240' TO DB-PROGRAM-NAME. CL**4 +002380 SET DB-HEADER-RECORD TO TRUE. CL**4 +002390 SET DB-RANDOM-PROCESSING TO TRUE. CL**4 +002400 SET DB-OPEN-INPUT TO TRUE. CL**4 +002410 MOVE ZEROS TO DB-KEY. CL**4 +002420 CL**4 +002430 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4 +002440 IF DB-SUCCESSFUL-COMPLETION CL**4 +002450 NEXT SENTENCE CL**4 +002460 ELSE CL**4 +002470 DISPLAY 'CANNOT OPEN BENEFITS FILE' CL**4 +002480 PERFORM S9999-ABEND THRU S9999-EXIT. CL**4 +002490 CL**4 +002500 I1000-EXIT. CL**4 +002510 EXIT. CL**4 +002520 CL**4 +002530 P0000-PROCESS. CL**4 +002540 CL**4 +002550 PERFORM S1000-RESET-ALL THRU S1000-EXIT. CL**4 +002560 CL**4 +002570 PERFORM P1000-SCAN-CLAIMS THRU P1000-EXIT CL**4 +002580 UNTIL DB-END-OF-FILE. CL**7 +002590 CL**4 +002600 PERFORM S3000-TERMINATE THRU S3000-EXIT. CL**4 +002610 CL**4 +002620 P0000-EXIT. CL**4 +002630 EXIT. CL**4 +002640 CL**4 +002650 P1000-SCAN-CLAIMS. CL**4 +002660* DISPLAY 'P1000 SCAN CLAIM HERE ' CL**4 +002670*& CL**4 +002680** DISPLAY 'P1000 CPD ' CPD-SSN ' IN ' WRK-SSN9. CL*23 +002690 CL**7 +002700 PERFORM S1100-READ-SEG01 THRU S1100-EXIT CL**7 +002710 CL*29 +002720** DISPLAY '2660 CPD-SSN ' CPD-SSN. CL*31 +002730 CL*29 +002740 IF DB-END-OF-FILE CL*23 +002750 GO TO P1000-EXIT. CL*23 +002760 CL*23 +002770 PERFORM P2000-PROCESS-CLAIM THRU P2000-EXIT. CL*24 +002780 CL**4 +002790 P1000-EXIT. CL**4 +002800 EXIT. CL**4 +002810 CL**4 +002820 P2000-PROCESS-CLAIM. CL**4 +002830 CL*23 +002840** DISPLAY '2781 CPD-SSN ' CPD-SSN. CL*33 +002850 IF CPD-LIABLE-STATE-DC CL**4 +002860 PERFORM P2100-FIND-EMPLOYERS THRU P2100-EXIT CL**4 +002870 END-IF. CL**4 +002880 CL**4 +002890 P2000-EXIT. CL**4 +002900 EXIT. CL**4 +002910 CL**4 +002920 P2100-FIND-EMPLOYERS. CL**4 +002930*& CL**4 +002940*& CL**4 +002950 CL**4 +002960** DISPLAY '2891 CPD-SSN ' CPD-SSN. CL*31 +002970 PERFORM S1200-RESET-SEG04 THRU S1200-EXIT. CL**4 +002980 CL**4 +002990 PERFORM P2110-SCAN-SEG04 THRU P2110-EXIT CL**4 +003000 UNTIL DB-NO-RECORD-FOUND. CL**4 +003010 CL**4 +003020 P2100-EXIT. CL**4 +003030 EXIT. CL**4 +003040 CL**4 +003050 P2110-SCAN-SEG04. CL**4 +003060 CL**4 +003070 PERFORM S1300-READ-SEG04 THRU S1300-EXIT. CL**4 +003080 CL**4 +003090 IF DB-NO-RECORD-FOUND CL**4 +003100 GO TO P2110-EXIT. CL**4 +003110 CL**4 +003120** DISPLAY '3061 CPD-SSN ' CPD-SSN. CL*32 +003130** DISPLAY '3062 BPE-ACCT ' BPE-EMPLOYER-ACCT. CL*32 +003140** DISPLAY '3063 WRK-PARM ' WRK-PARM-ACCT. CL*32 +003150 CL*31 +003160 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +003170 CL**7 +003180 PERFORM P2111-BPE-QTR-CODE THRU P2111-EXIT CL*14 +003190 CL**8 +003200 PERFORM P2112-CAPTURE-PURGED-WAGES THRU P2112-EXIT. CL*14 +003210 CL**4 +003220 P2110-EXIT. CL**4 +003230 EXIT. CL**4 +003240 CL**4 +003250 CL**8 +003260 P2111-BPE-QTR-CODE. CL**8 +003270 CL**8 +003280* DISPLAY 'P2111 BPE-QTR-CODE ' BPE-QTR-CODE. CL*23 +003290* DISPLAY 'P2111 CPD-SSN ' CPD-SSN. CL*33 +003300 CL**8 +003310 CL**8 +003320 CL**8 +003330 MOVE BPE-QTR-CODE TO WRK-OUT-B-PERIOD-1ST-YRQTR CL**8 +003340 WS-QTR-CODE. CL**8 +003350** DISPLAY '3071 WRK-OUT-B-PERIOD-1ST-YRQTR' CL*23 +003360** WRK-OUT-B-PERIOD-1ST-YRQTR. CL*23 +003370** DISPLAY '3073 BPE-QTR-CODE ' WS-QTR-CODE. CL*23 +003380 CL**8 +003390 MOVE WS-QTR-YR TO WS-YEAR. CL**8 +003400 ADD +1 TO WS-QTR-NUM. CL**8 +003410*** DISPLAY '3171 WS-QTR-NUM ' WS-QTR-NUM CL*23 +003420 CL**8 +003430 IF WS-QTR-NUM < +5 CL**8 +003440 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-2ND-CENYR CL**8 +003450 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-2ND-QTR CL**8 +003460** DISPLAY '3140WS-QTR-YR ' WS-QTR-YR CL*23 +003470 ELSE CL**8 +003480 MOVE +1 TO WS-QTR-NUM CL**8 +003490 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-2ND-QTR CL**8 +003500** DISPLAY '3241 WS-QTR-NUM ' WS-QTR-NUM CL*23 +003510 ADD +1 TO WS-QTR-YR CL**8 +003520 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-2ND-CENYR. CL**8 +003530 CL**8 +003540** DISPLAY '3271 WS-QTR-YR ' WS-QTR-YR CL*23 +003550 CL**8 +003560 ADD +1 TO WS-QTR-NUM. CL**8 +003570** DISPLAY '3301 WS-QTR-NUM ' WS-QTR-NUM. CL*23 +003580 CL**8 +003590 IF WS-QTR-NUM < +5 CL**8 +003600 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-3RD-CENYR CL**8 +003610 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-3RD-QTR CL**8 +003620 DISPLAY '3270WS-QTR-YR ' WS-QTR-YR CL**8 +003630 ELSE CL**8 +003640 MOVE +1 TO WS-QTR-NUM CL**8 +003650 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-3RD-QTR CL**8 +003660** DISPLAY '3381 WS-QTR-NUM ' WS-QTR-NUM CL*23 +003670 ADD +1 TO WS-QTR-YR CL**8 +003680 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-3RD-CENYR. CL**8 +003690 CL**8 +003700 CL**8 +003710 ADD +1 TO WS-QTR-NUM. CL**8 +003720** DISPLAY '3441 WS-QTR-NUM ' WS-QTR-NUM CL*23 +003730 CL**8 +003740 IF WS-QTR-NUM < +5 CL**8 +003750** DISPLAY '3410WS-QTR-YR ' WS-QTR-YR CL*23 +003760 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-4TH-CENYR CL**8 +003770 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-4TH-QTR CL**8 +003780 ELSE CL**8 +003790 MOVE +1 TO WS-QTR-NUM CL**8 +003800 MOVE WS-QTR-NUM TO WRK-OUT-B-PERIOD-4TH-QTR CL**8 +003810** DISPLAY '3531 WS-QTR-NUM ' WS-QTR-NUM CL*23 +003820 DISPLAY '3500WS-QTR-YR ' WS-QTR-YR CL**8 +003830 ADD +1 TO WS-QTR-YR CL**8 +003840 DISPLAY '3571WS-QTR-YR ' WS-QTR-YR CL**8 +003850 MOVE WS-QTR-YR TO WRK-OUT-B-PERIOD-4TH-CENYR. CL**8 +003860 CL**8 +003870** DISPLAY '4451 P2111-EXIT HERE '. CL*23 +003880 P2111-EXIT. CL**8 +003890 EXIT. CL**8 +003900 CL**4 +003910 P2112-CAPTURE-PURGED-WAGES. CL**4 +003920 DISPLAY '3790 P2112-HERE '. CL*27 +003930 CL**4 +003940 PERFORM P2113-LOAD-W2-EARNINGS THRU P2113-EXIT. CL*14 +003950 CL**4 +003960 PERFORM P2114-LOAD-W4-EARNINGS THRU P2114-EXIT. CL*24 +003970 CL**4 +003980 CL**4 +003990 P2112-EXIT. CL**4 +004000 EXIT. CL**4 +004010 CL**4 +004020 CL*13 +004030 P2113-LOAD-W2-EARNINGS. CL*13 +004040 CL*13 +004050 DISPLAY '4671 P2113-HERE '. CL*27 +004060 CL*13 +004070 IF BPE-WAGES-QTR1 > ZERO CL*13 +004080 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004090 MOVE CPD-SSN TO W2-SSN CL*13 +004100 MOVE 'W2' TO W2-TRAN-ID CL*13 +004110 MOVE '00044405' TO W2-OPER-ID CL*13 +004120 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13 +004130 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13 +004140 MOVE CPD-NAME TO W2-NAME CL*13 +004150 MOVE WRK-OUT-B-PERIOD-1ST-YRQTR TO W2-QTR CL*13 +004160 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34 +004170 CL*13 +004180 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13 +004190 CL*13 +004200 ADD 1 TO WRK-W2-COUNT. CL*13 +004210 CL*13 +004220 IF BPE-WAGES-QTR2 > ZERO CL*13 +004230 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004240 CL*13 +004250 MOVE CPD-SSN TO W2-SSN CL*13 +004260 MOVE 'W2' TO W2-TRAN-ID CL*13 +004270 MOVE '00044405' TO W2-OPER-ID CL*13 +004280 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13 +004290 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13 +004300 MOVE CPD-NAME TO W2-NAME CL*13 +004310 MOVE WRK-OUT-B-PERIOD-2ND-YRQTR TO W2-QTR CL*13 +004320 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34 +004330 CL*13 +004340 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13 +004350 CL*13 +004360 ADD 1 TO WRK-W2-COUNT. CL*13 +004370 CL*13 +004380 IF BPE-WAGES-QTR3 > ZERO CL*13 +004390 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004400 CL*13 +004410 MOVE CPD-SSN TO W2-SSN CL*13 +004420 MOVE 'W2' TO W2-TRAN-ID CL*13 +004430 MOVE '00044405' TO W2-OPER-ID CL*13 +004440 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13 +004450 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13 +004460 MOVE CPD-NAME TO W2-NAME CL*13 +004470 MOVE WRK-OUT-B-PERIOD-3RD-YRQTR TO W2-QTR CL*13 +004480 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34 +004490 CL*13 +004500 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13 +004510 CL*13 +004520 ADD 1 TO WRK-W2-COUNT. CL*13 +004530 CL*13 +004540 IF BPE-WAGES-QTR4 > ZERO CL*13 +004550 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004560 CL*13 +004570 MOVE CPD-SSN TO W2-SSN CL*13 +004580 MOVE 'W2' TO W2-TRAN-ID CL*13 +004590 MOVE '00044405' TO W2-OPER-ID CL*13 +004600 MOVE WRK-CURR-DATE TO W2-DATE-ENTERED CL*13 +004610 MOVE WRK-CURR-TIME TO W2-TIME-ENTERED CL*13 +004620 MOVE CPD-NAME TO W2-NAME CL*13 +004630 MOVE WRK-OUT-B-PERIOD-4TH-YRQTR TO W2-QTR CL*13 +004640 MOVE WRK-PARM-ACCT-OLD TO W2-ACCOUNT-NUMBER CL*34 +004650 CL*13 +004660 WRITE W2-OUT-REC FROM W2-TRAN-AREA CL*13 +004670 CL*13 +004680 ADD 1 TO WRK-W2-COUNT. CL*13 +004690 CL*13 +004700 P2113-EXIT. CL*24 +004710 EXIT. CL*13 +004720 CL*13 +004730 P2114-LOAD-W4-EARNINGS. CL**4 +004740 CL**4 +004750 IF BPE-WAGES-QTR1 > ZERO CL**4 +004760 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004770 MOVE WRK-OUT-B-PERIOD-1ST-YRQTR TO W4-QUARTER CL**4 +004780 MOVE BPE-WAGES-QTR1 TO W4-QUARTER-EARNINGS CL**4 +004790 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4 +004800 CL**4 +004810 IF BPE-WAGES-QTR2 > ZERO CL**4 +004820 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004830 MOVE WRK-OUT-B-PERIOD-2ND-YRQTR TO W4-QUARTER CL**4 +004840 MOVE BPE-WAGES-QTR2 TO W4-QUARTER-EARNINGS CL**4 +004850 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4 +004860 CL**4 +004870 CL**4 +004880 IF BPE-WAGES-QTR3 > ZERO CL**4 +004890 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004900 MOVE WRK-OUT-B-PERIOD-3RD-YRQTR TO W4-QUARTER CL**4 +004910 MOVE BPE-WAGES-QTR3 TO W4-QUARTER-EARNINGS CL**4 +004920 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4 +004930 CL**4 +004940 CL**4 +004950 IF BPE-WAGES-QTR4 > ZERO CL**4 +004960 IF BPE-EMPLOYER-ACCT = WRK-PARM-ACCT-OLD CL*34 +004970 MOVE WRK-OUT-B-PERIOD-4TH-YRQTR TO W4-QUARTER CL**4 +004980 MOVE BPE-WAGES-QTR4 TO W4-QUARTER-EARNINGS CL**4 +004990 PERFORM P2115-LOAD-W4 THRU P2115-EXIT. CL**4 +005000 CL**4 +005010 P2114-EXIT. CL**4 +005020 EXIT. CL**4 +005030 CL**4 +005040 P2115-LOAD-W4. CL**4 +005050 CL**4 +005060 MOVE CPD-SSN TO W4-SSN. CL**4 +005070 MOVE 'W4' TO W4-TRAN-ID. CL**4 +005080 MOVE '00044405' TO W4-TRAN-OPER-ID. CL**4 +005090 MOVE WRK-CURR-DATE TO W4-DATE-ENTERED. CL**4 +005100 MOVE WRK-CURR-TIME TO W4-TIME-ENTERED. CL**4 +005110 MOVE CPD-NAME TO W4-NAME-CHECK. CL**4 +005120 MOVE 'N' TO W4-AFFI-CODE CL**4 +005130 MOVE WRK-PARM-ACCT-NEW TO W4-ACCOUNT. CL*34 +005140 MOVE WRK-PARM-EMPL-NAME TO W4-EMP-NAME. CL*35 +005150 WRITE W4-OUT-REC FROM W4-TRAN-AREA. CL**4 +005160 CL**4 +005170 ADD 1 TO WRK-CLAIM-OUT-COUNT-W4. CL**4 +005180 CL**4 +005190 P2115-EXIT. CL**4 +005200 EXIT. CL**4 +005210 CL**4 +005220 CL**4 +005230 S1000-RESET-ALL. CL**4 +005240 SET DB-RESET-POINTERS TO TRUE. CL**4 +005250 SET DB-RANDOM-PROCESSING TO TRUE. CL**4 +005260 SET DB-BENEFIT-PAYMENTS TO TRUE. CL**4 +005270 SET DB-ALL-SEGMENTS TO TRUE. CL**4 +005280 CL**4 +005290 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4 +005300 CL**4 +005310 S1000-EXIT. CL**4 +005320 EXIT. CL**4 +005330 CL**4 +005340 S1100-READ-SEG01. CL**4 +005350 SET DB-SEQUENTIAL-PROCESSING TO TRUE. CL**4 +005360 SET DB-CLAIMANT-PROFILE TO TRUE. CL**4 +005370 SET DB-READ-SEGMENT TO TRUE. CL**4 +005380 CL**4 +005390 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4 +005400 CL**4 +005410 IF DB-SUCCESSFUL-COMPLETION CL**4 +005420 OR DB-END-OF-FILE CL**4 +005430 NEXT SENTENCE CL**4 +005440 ELSE CL**4 +005450 DISPLAY 'BAD READ ON SEG01 ' DB-COMPLETION-CODE CL**4 +005460 SET DB-END-OF-FILE TO TRUE. CL**4 +005470 CL**4 +005480 S1100-EXIT. CL**4 +005490 EXIT. CL**4 +005500 CL**4 +005510 S1200-RESET-SEG04. CL**4 +005520 SET DB-RESET-POINTERS TO TRUE. CL**4 +005530 SET DB-RANDOM-PROCESSING TO TRUE. CL**4 +005540 SET DB-BASE-PERIOD-EMP TO TRUE. CL**4 +005550 CL**4 +005560 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4 +005570 CL**4 +005580 S1200-EXIT. CL**4 +005590 EXIT. CL**4 +005600 CL**4 +005610 S1300-READ-SEG04. CL**4 +005620 SET DB-RANDOM-PROCESSING TO TRUE. CL**4 +005630 SET DB-BASE-PERIOD-EMP TO TRUE. CL**4 +005640 SET DB-READ-SEGMENT TO TRUE. CL**4 +005650 CL**4 +005660 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4 +005670 IF DB-SUCCESSFUL-COMPLETION CL**4 +005680 OR DB-NO-RECORD-FOUND CL**4 +005690 NEXT SENTENCE CL**4 +005700 ELSE CL**4 +005710 DISPLAY 'BAD READ ON SEG04 ' DB-COMPLETION-CODE CL**4 +005720 SET DB-END-OF-FILE TO TRUE. CL**4 +005730 CL**4 +005740 S1300-EXIT. CL**4 +005750 EXIT. CL**4 +005760 CL**4 +005770 CL**4 +005780 CL**4 +005790 S3000-TERMINATE. CL**4 +005800 CL**4 +005810 CLOSE W4-OUT-FILE, W2-OUT-FILE. CL*25 +005820 CL**4 +005830 MOVE 'C' TO DB-COMMAND-CODE. CL**4 +005840 CL**4 +005850 CALL 'ESP960D' USING COMMON-LINKAGE-SECTION. CL**4 +005860 CL**4 +005870 DISPLAY 'WRK W4 COUNT ' WRK-CLAIM-OUT-COUNT-W4. CL**4 +005880 DISPLAY 'WRK W2 COUNT ' WRK-W2-COUNT. CL**4 +005890 CL**4 +005900 S3000-EXIT. CL**4 +005910 EXIT. CL**4 +005920 CL**4 +005930 CL**4 +005940 S005-FROM-SYS. CL**4 +005950 CL**4 +005960 SET L005-FROM-SYS TO TRUE. CL**4 +005970 GO TO S005-ABSTIME. CL**4 +005980 CL**4 +005990 S005-ABSTIME. CL**4 +006000 CL**4 +006010 CALL 'DTSBU005' USING L005-LINK-AREA. CL**4 +006020 CL**4 +006030 S005-EXIT. CL**4 +006040 EXIT. CL**4 +006050 CL**4 +006060 S9999-ABEND. CL**4 +006070 SKIP1 CL**4 +006080 CALL 'DTSBU999' USING WRK-ABEND-CODE. CL**4 +006090 SKIP1 CL**4 +006100 S9999-EXIT. CL**4 +006110 EXIT. CL**4 diff --git a/Batch/DTSSC432.cob b/Batch/DTSSC432.cob new file mode 100644 index 0000000..87b60e2 --- /dev/null +++ b/Batch/DTSSC432.cob @@ -0,0 +1,3116 @@ +00001 IDENTIFICATION DIVISION. 11/26/24 +00002 PROGRAM-ID. DTSSC432. DTSSC432 +00003 AUTHOR. NGC. LV070 +00004 DATE-WRITTEN. NOVEMBER 2004. DTSSC432 +00005 DATE-COMPILED. DTSSC432 +00006 SKIP3 DTSSC432 +00007 ***** DTSSC432 +00008 * DTSSC432 +00009 * DTSSC432 +00010 * FUNCTION: EXTRACT EMPLOYER DATA FOR ESSP SERVER CL*43 +00011 * DATABASE. DTSSC432 +00012 * DTSSC432 +00013 * THIS JOB RUNS NIGHTLY FOLLOWING THE DAILY TAX DTSSC432 +00014 * UPDATE. IF SELECTS EMPLOYERS WHOSE RECORDS DTSSC432 +00015 * HAVE BEEN UPDATED DURING THE CURRENT BUSINESS CYCLDTSSC432 +00016 * BY LOOKING AT THE MOST RECENT MLOG AND MJRN DTSSC432 +00017 * RECORDS. IF THE ESTABLISHED DATE ON EITHER DTSSC432 +00018 * RECORD = MHDR-PRIOR-RUN DATE, THE EMPLOYER DTSSC432 +00019 * IS SELECTED. DTSSC432 +00020 * DTSSC432 +00021 * MODIFICATION LOG: DTSSC432 +00022 * DTSSC432 +00023 * 11/24/2004 INITIAL DEVELOPMENT. DTSSC432 +00024 * REFERENCE: WEB REGISTRATION PROGRAMMER: GD DTSSC432 +00025 * DTSSC432 +00026 * 08/26/2009 MODIFIED P3820: MOST RECENT AMOUNT PAID NOW DTSSC432 +00027 * EQUALS THE SUM OF ALL PAYMENTS MADE DURING THE DTSSC432 +00028 * DAY. DTSSC432 +00029 * REFERENCE: PROGRAMMER: GD DTSSC432 +00030 * DTSSC432 +00031 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSSC432 +00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSSC432 +00033 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSSC432 +00034 * DTSSC432 +00035 * DESCRIPTION: DTSSC432 +00036 * DTSSC432 +00037 * DTSSC432 +00038 * RECORDS READ: DTSSC432 +00039 * DTSSC432 +00040 * MASTER: DTSSC432 +00041 * DTSSC432 +00042 * MPRF DTSSC432 +00043 * MQTR DTSSC432 +00044 * DTSSC432 +00045 * ALTERNATE INDEX: DTSSC432 +00046 * DTSSC432 +00047 * NONE. DTSSC432 +00048 * DTSSC432 +00049 * REFERENCE: DTSSC432 +00050 * DTSSC432 +00051 * DTSSC432 +00052 * RECORDS UPDATED: DTSSC432 +00053 * DTSSC432 +00054 * NONE DTSSC432 +00055 * DTSSC432 +00056 * OUTPUT RECORDS WRITTEN: DTSSC432 +00057 * DTSSC432 +00058 * DTSSC432 +00059 * DTSSC432 +00060 * REPORT RECORDS WRITTEN: DTSSC432 +00061 * DTSSC432 +00062 * NONE. DTSSC432 +00063 * DTSSC432 +00064 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSSC432 +00065 * DTSSC432 +00066 * NONE. DTSSC432 +00067 * DTSSC432 +00068 * DTSSC432 +00069 * MODULES CALLED: DTSSC432 +00070 * DTSSC432 +00071 * DTSBU910 MASTER FILE I/O DRIVER. DTSSC432 +00072 * DTSBU946 WRITE VARIABLE OUTPUT RECORD(S). DTSSC432 +00073 * DTSBU004 QUARTER CONVERSION/EDIT. DTSSC432 +00074 * DTSBU516 DETERMINE LIABILITY, DUE DATE, DTSSC432 +00075 * AND RATE FOR A GIVEN QUARTER. DTSSC432 +00076 * DTSBU981 VSAM WAGES FILE I/O DRIVER. DTSSC432 +00077 * DTSBU982 VSAM SSN-NAME FILE I/O DRIVER. DTSSC432 +00078 * DTSSC432 +00079 ***** DTSSC432 +00080 DTSSC432 +00081 ENVIRONMENT DIVISION. DTSSC432 +00082 INPUT-OUTPUT SECTION. DTSSC432 +00083 DTSSC432 +00084 FILE-CONTROL. DTSSC432 +00085 DTSSC432 +00086 ** SELECT PARM-FILE ASSIGN TO BX412PRM DTSSC432 +00087 ** FILE STATUS IS PARM-STATUS. DTSSC432 +00088 DTSSC432 +00089 SELECT SERVER-FILE ASSIGN TO IMPBX101 DTSSC432 +00090 FILE STATUS IS X101-STATUS. DTSSC432 +00091 DTSSC432 +00092 SELECT EMPLOYER-TEMP ASSIGN TO BX410TMP CL*15 +00093 FILE STATUS IS TEMP-STATUS. CL*15 +00094 DTSSC432 +00095 SELECT X100-REF-FILE ASSIGN TO EXPBX100 DTSSC432 +00096 FILE STATUS IS X100-STATUS. DTSSC432 +00097 DTSSC432 +00098 SELECT X102-PRF-FILE ASSIGN TO EXPBX102 DTSSC432 +00099 FILE STATUS IS X102-STATUS. DTSSC432 +00100 DTSSC432 +00101 SELECT X104-DETERM-FILE ASSIGN TO EXPBX104 DTSSC432 +00102 FILE STATUS IS X104-STATUS. DTSSC432 +00103 DTSSC432 +00104 SELECT X106-NAME-FILE ASSIGN TO EXPBX106 DTSSC432 +00105 FILE STATUS IS X106-STATUS. DTSSC432 +00106 DTSSC432 +00107 SELECT X108-RATE-FILE ASSIGN TO EXPBX108 DTSSC432 +00108 FILE STATUS IS X108-STATUS. DTSSC432 +00109 DTSSC432 +00110 SELECT X110-ADDR-FILE ASSIGN TO EXPBX110 DTSSC432 +00111 FILE STATUS IS X110-STATUS. DTSSC432 +00112 DTSSC432 +00113 SELECT X120-OPO-FILE ASSIGN TO EXPBX120 DTSSC432 +00114 FILE STATUS IS X120-STATUS. DTSSC432 +00115 DTSSC432 +00116 SELECT X131-REL-FILE ASSIGN TO EXPBX131 DTSSC432 +00117 FILE STATUS IS X131-STATUS. DTSSC432 +00118 DTSSC432 +00119 SELECT X140-REPORT-FILE ASSIGN TO EXPBX140 DTSSC432 +00120 FILE STATUS IS X140-STATUS. DTSSC432 +00121 CL223 +00122 SELECT X141-QTR-STATUS-FILE ASSIGN TO EXPBX141 DTSSC432 +00123 FILE STATUS IS X141-STATUS. DTSSC432 +00124 DTSSC432 +00125 SELECT X142-LAST-RPT-PAY-FILE ASSIGN TO EXPBX142 DTSSC432 +00126 FILE STATUS IS X142-STATUS. DTSSC432 +00127 DTSSC432 +00128 SELECT X145-PAYMENT-FILE ASSIGN TO EXPBX145 DTSSC432 +00129 FILE STATUS IS X145-STATUS. DTSSC432 +00130 DTSSC432 +00131 DATA DIVISION. DTSSC432 +00132 FILE SECTION. DTSSC432 +00133 DTSSC432 +00134 *FD PARM-FILE DTSSC432 +00135 * RECORDING MODE IS F. DTSSC432 +00136 *01 PARM-REC. DTSSC432 +00137 * 05 PARM-FIRST-WAGE-QTR PIC S9(05) COMP-3. DTSSC432 +00138 DTSSC432 +00139 FD SERVER-FILE DTSSC432 +00140 RECORDING MODE IS F. CL220 +00141 01 X101-REC. DTSSC432 +00142 05 X101-EMP-NO PIC 9(6). CL187 +00143 ** 05 FILLER PIC X(246). CL219 +00144 DTSSC432 +00145 FD EMPLOYER-TEMP CL*13 +00146 RECORDING MODE IS F. CL*13 +00147 01 EMPLOYER-TEMP-REC. CL*13 +00148 05 TEMP-REC-TYPE PIC X(03). CL226 +00149 05 FILLER PIC X(01). CL226 +00150 05 TEMP-EMP-NO PIC 9(06). CL*13 +00151 05 FILLER PIC X(502). CL226 +00152 DTSSC432 +00153 FD X100-REF-FILE DTSSC432 +00154 RECORDING MODE IS F. DTSSC432 +00155 01 X100-REC PIC X(30). DTSSC432 +00156 DTSSC432 +00157 FD X102-PRF-FILE DTSSC432 +00158 RECORDING MODE IS F. DTSSC432 +00159 01 X102-REC PIC X(29). DTSSC432 +00160 DTSSC432 +00161 FD X104-DETERM-FILE DTSSC432 +00162 RECORDING MODE IS F. DTSSC432 +00163 01 X104-REC PIC X(119). CL**5 +00164 DTSSC432 +00165 FD X106-NAME-FILE DTSSC432 +00166 RECORDING MODE IS F. DTSSC432 +00167 01 X106-REC PIC X(53). DTSSC432 +00168 DTSSC432 +00169 FD X108-RATE-FILE DTSSC432 +00170 RECORDING MODE IS F. DTSSC432 +00171 01 X108-REC PIC X(24). DTSSC432 +00172 DTSSC432 +00173 FD X110-ADDR-FILE DTSSC432 +00174 RECORDING MODE IS F. DTSSC432 +00175 01 X110-REC PIC X(249). DTSSC432 +00176 DTSSC432 +00177 FD X120-OPO-FILE DTSSC432 +00178 RECORDING MODE IS F. DTSSC432 +00179 01 X120-REC PIC X(385). DTSSC432 +00180 DTSSC432 +00181 FD X131-REL-FILE DTSSC432 +00182 RECORDING MODE IS F. DTSSC432 +00183 01 X131-REC PIC X(28). DTSSC432 +00184 DTSSC432 +00185 FD X140-REPORT-FILE DTSSC432 +00186 RECORDING MODE IS F. DTSSC432 +00187 01 X140-REC PIC X(143). DTSSC432 +00188 DTSSC432 +00189 FD X141-QTR-STATUS-FILE DTSSC432 +00190 RECORDING MODE IS F. DTSSC432 +00191 01 X141-REC PIC X(102). DTSSC432 +00192 DTSSC432 +00193 FD X142-LAST-RPT-PAY-FILE DTSSC432 +00194 RECORDING MODE IS F. DTSSC432 +00195 01 X142-REC PIC X(54). DTSSC432 +00196 DTSSC432 +00197 FD X145-PAYMENT-FILE DTSSC432 +00198 RECORDING MODE IS F. DTSSC432 +00199 01 X145-REC PIC X(69). DTSSC432 +00200 DTSSC432 +00201 WORKING-STORAGE SECTION. DTSSC432 +002015 77 PAN-VALET PICTURE X(24) VALUE '070DTSSC432 11/26/24'. DTSSC432 +00202 DTSSC432 +00203 01 WRK-AREA. DTSSC432 +00204 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +410.DTSSC432 +00205 05 ABEND-MSG PIC X(60). DTSSC432 +00206 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX410'.DTSSC432 +00207 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DTSSC432 +00208 DTSSC432 +00209 05 PSUB PIC S9(04) COMP. DTSSC432 +00210 05 PAY-MAX PIC S9(04) COMP DTSSC432 +00211 VALUE +500. DTSSC432 +00212 05 PAY-LAST PIC S9(04) COMP DTSSC432 +00213 VALUE +0. DTSSC432 +00214 05 MAX-PAY-DATE PIC S9(09) COMP-3. DTSSC432 +00215 05 MAX-PAY-BATCH PIC S9(05) COMP-3. DTSSC432 +00216 05 MAX-PAY-ITEM PIC S9(03) COMP-3. DTSSC432 +00217 05 MAX-PAY-AMT PIC S9(09)V99 COMP-3. DTSSC432 +00218 DTSSC432 +00219 05 PAY-TABLE OCCURS 500 TIMES. DTSSC432 +00220 10 PAY-BATCH PIC S9(05) COMP-3. DTSSC432 +00221 10 PAY-ITEM PIC S9(03) COMP-3. DTSSC432 +00222 10 PAY-RCVD-DATE PIC S9(09) COMP-3. DTSSC432 +00223 10 PAY-PROCESS-DATE PIC S9(09) COMP-3. DTSSC432 +00224 10 PAY-ORIG-AMT PIC S9(09)V99 COMP-3. DTSSC432 +00225 10 PAY-ADJ-AMT PIC S9(09)V99 COMP-3. DTSSC432 +00226 DTSSC432 +00227 05 RSUB PIC S9(04) COMP. DTSSC432 +00228 05 RPT-MAX PIC S9(04) COMP DTSSC432 +00229 VALUE +400. DTSSC432 +00230 05 MAX-RPT-DATE PIC S9(09) COMP-3. DTSSC432 +00231 05 MAX-RPT-YRQ PIC S9(05) COMP-3. DTSSC432 +00232 05 MAX-RPT-TYPE PIC X(02). DTSSC432 +00233 DTSSC432 +00234 05 RPT-TABLE OCCURS 400 TIMES. DTSSC432 +00235 10 RPT-YRQ PIC S9(05) COMP-3. DTSSC432 +00236 10 RPT-TYPE PIC X(02). DTSSC432 +00237 10 RPT-RCVD-DATE PIC S9(09) COMP-3. DTSSC432 +00238 10 RPT-PROCESS-DATE PIC S9(09) COMP-3. DTSSC432 +00239 DTSSC432 +00240 05 GLOBAL-DATA-AREA. DTSSC432 +00241 10 WRK-PRIOR-RUN-DATE PIC S9(09) COMP-3 VALUE +0. CL183 +00242 ** 10 WRK-PRIOR-RUN-DATE PIC S9(09) COMP-3 CL183 +00243 ** VALUE +20150113. CL183 +00244 10 WRK-CURR-RUN-DATE PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00245 10 FIRST-QTR-WRK-DAY PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00246 10 WRK-CURR-QTR PIC S9(05) COMP-3 VALUE +0. DTSSC432 +00247 10 WRK-CURR-QTR-START PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00248 10 WRK-PRIOR-QTR PIC S9(05) COMP-3 VALUE +0. DTSSC432 +00249 10 WRK-LAST-DEL-YRQ PIC S9(05) COMP-3 VALUE +0. DTSSC432 +00250 10 WRK-CURR-QTR-MINUS-8 PIC S9(05) COMP-3 VALUE +0. DTSSC432 +00251 *** 10 WRK-FIRST-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSSC432 +00252 *** 10 WRK-FIRST-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSSC432 +00253 10 WRK-ABS-QTR PIC S9(04) COMP VALUE +0. DTSSC432 +00254 10 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSSC432 +00255 10 WRK-RATE-YRQ-1 PIC 9(05). DTSSC432 +00256 10 FILLER REDEFINES WRK-RATE-YRQ-1. DTSSC432 +00257 15 WRK-RATE-YRQ-1-CCYY PIC 9(04). DTSSC432 +00258 15 WRK-RATE-YRQ-1-Q PIC 9(01). DTSSC432 +00259 10 WRK-NEW-EMP-RATE-1 PIC 9.9999. DTSSC432 +00260 10 WRK-TAX-TABLE-1 PIC X(05). DTSSC432 +00261 10 WRK-TAX-WAGE-BASE-1 PIC 9(05).99. DTSSC432 +00262 10 WRK-RATE-YRQ-2 PIC 9(05). DTSSC432 +00263 10 FILLER REDEFINES WRK-RATE-YRQ-2. DTSSC432 +00264 15 WRK-RATE-YRQ-2-CCYY PIC 9(04). DTSSC432 +00265 15 WRK-RATE-YRQ-2-Q PIC 9(01). DTSSC432 +00266 10 WRK-NEW-EMP-RATE-2 PIC 9.9999. DTSSC432 +00267 10 WRK-TAX-TABLE-2 PIC X(05). DTSSC432 +00268 10 WRK-TAX-WAGE-BASE-2 PIC 9(05).99. DTSSC432 +00269 10 WRK-RATE-YRQ-3 PIC 9(05). DTSSC432 +00270 10 FILLER REDEFINES WRK-RATE-YRQ-3. DTSSC432 +00271 15 WRK-RATE-YRQ-3-CCYY PIC 9(04). DTSSC432 +00272 15 WRK-RATE-YRQ-3-Q PIC 9(01). DTSSC432 +00273 10 WRK-NEW-EMP-RATE-3 PIC 9.9999. DTSSC432 +00274 10 WRK-TAX-TABLE-3 PIC X(05). DTSSC432 +00275 10 WRK-TAX-WAGE-BASE-3 PIC 9(05).99. DTSSC432 +00276 DTSSC432 +00277 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00278 05 WRK-TRACE-NO PIC 9(13). DTSSC432 +00279 05 WRK-TRACE-NO-X REDEFINES WRK-TRACE-NO DTSSC432 +00280 PIC B(12)9. DTSSC432 +00281 DTSSC432 +00282 05 WRK-2-YEARS-AGO PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00283 05 WRK-1-QTR-AGO PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00284 05 WRK-YRQ PIC 9(05). DTSSC432 +00285 05 FILLER REDEFINES WRK-YRQ. DTSSC432 +00286 10 WRK-YRQ-CCYY PIC 9(04). DTSSC432 +00287 10 WRK-YRQ-Q PIC 9(01). DTSSC432 +00288 DTSSC432 +00289 05 WRK-LAST-LIAB-YRQ PIC 9(05). DTSSC432 +00290 05 WRK-INACT-DATE PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00291 05 WRK-LIAB-ENTR-DATE PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00292 05 WRK-INACT-ENTR-DATE PIC S9(09) COMP-3 VALUE +0. DTSSC432 +00293 05 WRK-MERA-SOURCE-CD PIC X(02) VALUE ' '. DTSSC432 +00294 05 WRK-INACTIVE-DATE PIC X(10) VALUE SPACE. CL118 +00295 05 WRK-NEW-LIAB-DATE PIC X(08) VALUE SPACE. CL172 +00296 05 WS-MLOG-LIAB-DATE PIC X(08) VALUE SPACE. CL*10 +00297 05 WS-MLOG-INACT-DATE PIC X(08) VALUE SPACE. CL*10 +00298 05 WS-MLOG-EMP-IND PIC X(01) VALUE SPACE. CL*10 +00299 * 05 WS-HOLD-LIAB-DATE PIC X(10) VALUE SPACE. CL*37 +00300 05 WS-HOLD-INACT-DATE PIC X(10) VALUE SPACE. CL*10 +00301 05 WS-HOLD-1-LIAB-DT PIC X(10) VALUE SPACE. CL*27 +00302 05 WS-HOLD-2-LIAB-DT PIC X(10) VALUE SPACE. CL*27 +00303 05 WS-MSOL-EMP-IND PIC X(01) VALUE SPACE. CL*10 +00304 05 WRK-LEN PIC S9(04) COMP. DTSSC432 +00305 DTSSC432 +00306 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSSC432 +00307 VALUE +999999999. DTSSC432 +00308 DTSSC432 +00309 05 WRK-ERROR-IND PIC X(01). DTSSC432 +00310 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSSC432 +00311 88 WRK-ERROR-NO-88 VALUE 'N'. DTSSC432 +00312 DTSSC432 +00313 05 WRK-SELECT-NAME-IND PIC X(01). DTSSC432 +00314 88 WRK-SELECT-NAME-YES-88 VALUE 'Y'. DTSSC432 +00315 88 WRK-SELECT-NAME-NO-88 VALUE 'N'. DTSSC432 +00316 05 WRK-SELECT-ADDR-IND PIC X(01). DTSSC432 +00317 88 WRK-SELECT-ADDR-YES-88 VALUE 'Y'. DTSSC432 +00318 88 WRK-SELECT-ADDR-NO-88 VALUE 'N'. DTSSC432 +00319 05 WRK-SELECT-OPO-IND PIC X(01). DTSSC432 +00320 88 WRK-SELECT-OPO-YES-88 VALUE 'Y'. DTSSC432 +00321 88 WRK-SELECT-OPO-NO-88 VALUE 'N'. DTSSC432 +00322 05 WRK-SELECT-SOL-IND PIC X(01). DTSSC432 +00323 88 WRK-SELECT-SOL-YES-88 VALUE 'Y'. DTSSC432 +00324 88 WRK-SELECT-SOL-NO-88 VALUE 'N'. DTSSC432 +00325 CL*38 +00326 05 WRK-SOL-INACTDT-IND PIC X(01). CL**7 +00327 88 WRK-SOL-INACT-DT-YES-88 VALUE 'Y'. CL**7 +00328 88 WRK-SOL-INACT-DT-NO-88 VALUE 'N'. CL**7 +00329 CL**7 +00330 05 WRK-STATUS-CHNG-IND PIC X(01). CL*47 +00331 88 WRK-STATUS-CHNG-YES-88 VALUE 'Y'. CL*47 +00332 88 WRK-STATUS-CHNG-NO-88 VALUE 'N'. CL*47 +00333 CL*47 +00334 05 WRK-SOL-LIABESTDT-IND PIC X(01). CL**7 +00335 88 WRK-SOL-LIABEST-DT-YES-88 VALUE 'Y'. CL**7 +00336 88 WRK-SOL-LIABEST-DT-NO-88 VALUE 'N'. CL**7 +00337 CL**7 +00338 05 WRK-SOL-NEWEMP-IND PIC X(01). CL**7 +00339 88 WRK-SOL-NEWEMP-IND-YES-88 VALUE 'Y'. CL**7 +00340 88 WRK-SOL-NEWEMP-IND-NO-88 VALUE 'N'. CL**7 +00341 CL*13 +00342 05 WRK-WRITE-X104-IND PIC X(01). CL*13 +00343 88 WRK-WRITE-X104-YES-88 VALUE 'Y'. CL*13 +00344 88 WRK-WRITE-X104-NO-88 VALUE 'N'. CL*13 +00345 CL*38 +00346 05 WRK-SELECT-RATE-IND PIC X(01). CL138 +00347 88 WRK-SELECT-RATE-YES-88 VALUE 'Y'. CL138 +00348 88 WRK-SELECT-RATE-NO-88 VALUE 'N'. CL138 +00349 05 WRK-SELECT-IND PIC X(01). DTSSC432 +00350 88 WRK-SELECT-NO-88 VALUE '0'. DTSSC432 +00351 88 WRK-SELECT-ALL-88 VALUE '1'. DTSSC432 +00352 88 WRK-SELECT-UPD-88 VALUE '2'. DTSSC432 +00353 88 WRK-SELECT-PRF-88 VALUE '3'. DTSSC432 +00354 05 WRK-DELETE-DUP-IND PIC X(01). DTSSC432 +00355 88 WRK-DELETE-YES-88 VALUE 'Y'. DTSSC432 +00356 88 WRK-DELETE-NO-88 VALUE 'N'. DTSSC432 +00357 DTSSC432 +00358 05 WRK-SELECT-INACT-IND PIC X(01). DTSSC432 +00359 88 WRK-SELECT-INACT-YES-88 VALUE 'Y'. DTSSC432 +00360 88 WRK-SELECT-INACT-NO-88 VALUE 'N'. DTSSC432 +00361 DTSSC432 +00362 05 WRK-CURR-QTR-IND PIC X(01). DTSSC432 +00363 88 WRK-CURR-QTR-YES-88 VALUE 'Y'. DTSSC432 +00364 88 WRK-CURR-QTR-NO-88 VALUE 'N'. DTSSC432 +00365 DTSSC432 +00366 05 WRK-PRIOR-QTR-IND PIC X(01). DTSSC432 +00367 88 WRK-PRIOR-QTR-YES-88 VALUE 'Y'. DTSSC432 +00368 88 WRK-PRIOR-QTR-NO-88 VALUE 'N'. DTSSC432 +00369 DTSSC432 +00370 05 WRK-SOURCE-WEB-IND PIC X(01). DTSSC432 +00371 88 WRK-SOURCE-WEB-YES-88 VALUE 'Y'. DTSSC432 +00372 88 WRK-SOURCE-WEB-NO-88 VALUE 'N'. DTSSC432 +00373 DTSSC432 +00374 05 WRK-MOPO-IND PIC X(01). DTSSC432 +00375 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. DTSSC432 +00376 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. DTSSC432 +00377 DTSSC432 +00378 * 05 PARM-STATUS PIC X(02). DTSSC432 +00379 * 88 PARM-STATUS-OK-88 VALUE '00'. DTSSC432 +00380 05 X101-STATUS PIC X(02). DTSSC432 +00381 88 X101-STATUS-OK-88 VALUE '00'. DTSSC432 +00382 88 X101-STATUS-EOF-88 VALUE '10'. DTSSC432 +00383 05 TEMP-STATUS PIC X(02). DTSSC432 +00384 88 TEMP-STATUS-OK-88 VALUE '00'. DTSSC432 +00385 88 TEMP-STATUS-EOF-88 VALUE '10'. DTSSC432 +00386 05 X100-STATUS PIC X(02). DTSSC432 +00387 88 X100-STATUS-OK-88 VALUE '00'. DTSSC432 +00388 05 X102-STATUS PIC X(02). DTSSC432 +00389 88 X102-STATUS-OK-88 VALUE '00'. DTSSC432 +00390 05 X104-STATUS PIC X(02). DTSSC432 +00391 88 X104-STATUS-OK-88 VALUE '00'. DTSSC432 +00392 05 X106-STATUS PIC X(02). DTSSC432 +00393 88 X106-STATUS-OK-88 VALUE '00'. DTSSC432 +00394 05 X108-STATUS PIC X(02). DTSSC432 +00395 88 X108-STATUS-OK-88 VALUE '00'. DTSSC432 +00396 05 X110-STATUS PIC X(02). DTSSC432 +00397 88 X110-STATUS-OK-88 VALUE '00'. DTSSC432 +00398 05 X120-STATUS PIC X(02). DTSSC432 +00399 88 X120-STATUS-OK-88 VALUE '00'. DTSSC432 +00400 05 X131-STATUS PIC X(02). DTSSC432 +00401 88 X131-STATUS-OK-88 VALUE '00'. DTSSC432 +00402 05 X140-STATUS PIC X(02). DTSSC432 +00403 88 X140-STATUS-OK-88 VALUE '00'. DTSSC432 +00404 05 X141-STATUS PIC X(02). DTSSC432 +00405 88 X141-STATUS-OK-88 VALUE '00'. DTSSC432 +00406 05 X142-STATUS PIC X(02). DTSSC432 +00407 88 X142-STATUS-OK-88 VALUE '00'. DTSSC432 +00408 05 X145-STATUS PIC X(02). DTSSC432 +00409 88 X145-STATUS-OK-88 VALUE '00'. DTSSC432 +00410 DTSSC432 +00411 05 WRK-ACQUIRED-IND PIC X(01). DTSSC432 +00412 88 WRK-ACQUIRED-YES-88 VALUE 'Y'. DTSSC432 +00413 88 WRK-ACQUIRED-NO-88 VALUE 'N'. DTSSC432 +00414 DTSSC432 +00415 05 WRK-MERGER-SPLIT-IND PIC X(01). DTSSC432 +00416 88 WRK-MERGER-SPLIT-YES-88 VALUE 'Y'. DTSSC432 +00417 88 WRK-MERGER-SPLIT-NO-88 VALUE 'N'. DTSSC432 +00418 DTSSC432 +00419 05 WRK-REORG-IND PIC X(01). DTSSC432 +00420 88 WRK-REORG-YES-88 VALUE 'Y'. DTSSC432 +00421 88 WRK-REORG-NO-88 VALUE 'N'. DTSSC432 +00422 DTSSC432 +00423 05 WRK-ADDRESS. DTSSC432 +00424 10 WRK-ATTN-LINE PIC X(40). DTSSC432 +00425 10 WRK-DELIV-LINE-1 PIC X(40). DTSSC432 +00426 10 WRK-DELIV-LINE-2 PIC X(40). DTSSC432 +00427 10 WRK-CITY PIC X(25). DTSSC432 +00428 10 WRK-ST PIC X(02). DTSSC432 +00429 10 WRK-ZIP PIC X(10). DTSSC432 +00430 10 WRK-ADVANCED-BARCODE DTSSC432 +00431 PIC X(14). DTSSC432 +00432 DTSSC432 +00433 05 WRK-PHONE PIC X(15). DTSSC432 +00434 05 WRK-FAX PIC X(15). DTSSC432 +00435 05 WRK-EMAIL PIC X(40). DTSSC432 +00436 DTSSC432 +00437 05 WRK-UI-RATE PIC S9(03)V9(04) COMP-3. DTSSC432 +00438 DTSSC432 +00439 05 WRK-ANNUAL-STATUS. DTSSC432 +00440 10 WRK-ANN-YEAR PIC S9(04) COMP-3 VALUE +0.DTSSC432 +00441 10 WRK-HOLD-YRQ PIC S9(05) COMP-3 VALUE +0.DTSSC432 +00442 10 WRK-FILING-SCHED PIC X(01). DTSSC432 +00443 88 WRK-FILE-QTRLY-88 VALUE '0'. DTSSC432 +00444 88 WRK-FILE-ANN-LIAB-88 VALUE '1'. DTSSC432 +00445 88 WRK-FILE-ANN-NOT-LIAB-88 VALUE '2'. DTSSC432 +00446 DTSSC432 +00447 05 WRK-TAX-BAL PIC S9(09)V99 COMP-3 DTSSC432 +00448 VALUE +0. DTSSC432 +00449 05 WRK-SUR-BAL PIC S9(09)V99 COMP-3 DTSSC432 +00450 VALUE +0. DTSSC432 +00451 05 WRK-INT-BAL PIC S9(09)V99 COMP-3 DTSSC432 +00452 VALUE +0. DTSSC432 +00453 05 WRK-PEN-BAL PIC S9(09)V99 COMP-3 DTSSC432 +00454 VALUE +0. DTSSC432 +00455 DTSSC432 +00456 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00457 05 WRK-SELECTED-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00458 05 WRK-PRF-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00459 05 WRK-TEST-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00460 05 X101-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00461 05 X102-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00462 05 X104-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00463 05 X106-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00464 05 X110-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00465 05 X108-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00466 05 X120-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00467 05 X131-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00468 05 X140-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00469 05 X141-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00470 05 X142-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00471 05 X145-CNT PIC S9(07) COMP-3 VALUE +0. DTSSC432 +00472 DTSSC432 +00473 05 WRK-SSN-ERROR-DISP PIC --,---,--9. DTSSC432 +00474 05 WRK-AMT-DISP PIC --,---,---,--9.99. DTSSC432 +00475 05 WRK-AMT-DISP1 PIC --,---,---,--9.99. DTSSC432 +00476 05 WRK-PCT-DISP PIC ZZ9.9999-. DTSSC432 +00477 DTSSC432 +00478 05 WORK-HOLD-DATE1 PIC X(10) VALUE SPACE. CL**2 +00479 CL**2 +00480 05 WRK-INACT-SLASH-DT. CL**2 +00481 15 WRK-INACT-MM PIC X(02) VALUE SPACE. CL**2 +00482 15 FILLER PIC X(01) VALUE '/'. CL**2 +00483 15 WRK-INACT-DD PIC X(02) VALUE SPACE. CL**2 +00484 15 FILLER PIC X(01) VALUE '/'. CL**2 +00485 15 WRK-INACT-YYYY PIC X(04) VALUE SPACE. CL**2 +00486 CL**2 +00487 DTSSC432 +00488 01 MSG-AREA. DTSSC432 +00489 05 MSG1-AREA. DTSSC432 +00490 10 MSG1-ID PIC X(03) VALUE '800'. DTSSC432 +00491 10 MSG1-TEXT. DTSSC432 +00492 15 FILLER PIC X(40) DTSSC432 +00493 VALUE ' '. DTSSC432 +00494 15 FILLER PIC X(40) DTSSC432 +00495 VALUE ' '. DTSSC432 +00496 DTSSC432 +00497 01 TALLY-AREA. DTSSC432 +00498 05 SLASH-NAME. DTSSC432 +00499 10 SLASH-NAME-CHAR OCCURS 40 TIMES PIC X(01). DTSSC432 +00500 05 FIRST-NAME PIC X(40) VALUE SPACE. DTSSC432 +00501 05 MIDDLE-INIT PIC X(01) VALUE SPACE. DTSSC432 +00502 05 LAST-NAME PIC X(40) VALUE SPACE. DTSSC432 +00503 05 NSUB PIC S9(04) COMP. DTSSC432 +00504 05 FSUB PIC S9(04) COMP. DTSSC432 +00505 05 LSUB PIC S9(04) COMP. DTSSC432 +00506 05 LAST-NAME-COMPLETE-IND PIC X(01). DTSSC432 +00507 88 LAST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSSC432 +00508 88 LAST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSSC432 +00509 05 FIRST-NAME-COMPLETE-IND PIC X(01). DTSSC432 +00510 88 FIRST-NAME-COMPLETE-YES-88 VALUE 'Y'. DTSSC432 +00511 88 FIRST-NAME-COMPLETE-NO-88 VALUE 'N'. DTSSC432 +00512 05 MID-INIT-COMPLETE-IND PIC X(01). DTSSC432 +00513 88 MID-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSSC432 +00514 88 MID-INIT-COMPLETE-NO-88 VALUE 'N'. DTSSC432 +00515 05 D-S PIC X(02) VALUE SPACE. DTSSC432 +00516 05 SLASH-TALLY PIC S9(04) COMP. DTSSC432 +00517 05 LAST-NAME-LEN PIC S9(04) COMP. DTSSC432 +00518 05 FIRST-MID-LEN PIC S9(04) COMP. DTSSC432 +00519 05 FIRST-NAME-LEN PIC S9(04) COMP. DTSSC432 +00520 05 TOTAL-LEN PIC S9(04) COMP. DTSSC432 +00521 EJECT DTSSC432 +00522 01 WRK-X100-REC. DTSSC432 +00523 ++INCLUDE DTSIX100 DTSSC432 +00524 DTSSC432 +00525 *01 WRK-X101-REC. DTSSC432 +00526 ***INCLUDE DTSIX101 DTSSC432 +00527 DTSSC432 +00528 01 WRK-X102-REC. DTSSC432 +00529 ++INCLUDE DTSIX102 DTSSC432 +00530 DTSSC432 +00531 01 WRK-X104-REC. CL**5 +00532 ++INCLUDE DTSNH104 CL217 +00533 DTSSC432 +00534 01 WRK-X106-REC. DTSSC432 +00535 ++INCLUDE DTSIX106 DTSSC432 +00536 DTSSC432 +00537 01 WRK-X108-REC. DTSSC432 +00538 ++INCLUDE DTSIX108 DTSSC432 +00539 DTSSC432 +00540 01 WRK-X110-REC. DTSSC432 +00541 ++INCLUDE DTSIX110 DTSSC432 +00542 DTSSC432 +00543 01 WRK-X120-REC. DTSSC432 +00544 ++INCLUDE DTSIX120 DTSSC432 +00545 DTSSC432 +00546 01 WRK-X131-REC. DTSSC432 +00547 ++INCLUDE DTSIX131 DTSSC432 +00548 DTSSC432 +00549 01 WRK-X140-REC. DTSSC432 +00550 ++INCLUDE DTSIX140 DTSSC432 +00551 DTSSC432 +00552 01 WRK-X141-REC. DTSSC432 +00553 ++INCLUDE DTSIX141 DTSSC432 +00554 DTSSC432 +00555 01 WRK-X142-REC. DTSSC432 +00556 ++INCLUDE DTSIX142 DTSSC432 +00557 DTSSC432 +00558 01 WRK-X145-REC. DTSSC432 +00559 ++INCLUDE DTSIX145 DTSSC432 +00560 DTSSC432 +00561 01 L001-LINK-AREA. DTSSC432 +00562 ++INCLUDE DTSIL001 DTSSC432 +00563 DTSSC432 +00564 01 L003-LINK-AREA. DTSSC432 +00565 ++INCLUDE DTSIL003 DTSSC432 +00566 DTSSC432 +00567 01 L004-LINK-AREA. DTSSC432 +00568 ++INCLUDE DTSIL004 DTSSC432 +00569 DTSSC432 +00570 01 L005-LINK-AREA. DTSSC432 +00571 ++INCLUDE DTSIL005 DTSSC432 +00572 DTSSC432 +00573 01 L109-LINK-AREA. DTSSC432 +00574 ++INCLUDE DTSIL109 DTSSC432 +00575 DTSSC432 +00576 01 L410-LINK-AREA. DTSSC432 +00577 ++INCLUDE DTSIL410 DTSSC432 +00578 DTSSC432 +00579 01 L516-LINK-AREA. DTSSC432 +00580 ++INCLUDE DTSIL516 DTSSC432 +00581 DTSSC432 +00582 01 L600-LINK-AREA. DTSSC432 +00583 ++INCLUDE DTSIL600 DTSSC432 +00584 DTSSC432 +00585 01 L101-LINK-AREA. DTSSC432 +00586 ++INCLUDE DTSIL101 DTSSC432 +00587 DTSSC432 +00588 01 L910-LINK-AREA. DTSSC432 +00589 ++INCLUDE DTSIL910 DTSSC432 +00590 SKIP3 DTSSC432 +00591 01 MSKL-REC. DTSSC432 +00592 ++INCLUDE DTSIMSKL DTSSC432 +00593 SKIP3 DTSSC432 +00594 01 MHDR-REC. DTSSC432 +00595 ++INCLUDE DTSIMHDR DTSSC432 +00596 SKIP3 DTSSC432 +00597 01 MPRF-REC. DTSSC432 +00598 ++INCLUDE DTSIMPRF DTSSC432 +00599 DTSSC432 +00600 01 MSOL-REC. DTSSC432 +00601 ++INCLUDE DTSIMSOL DTSSC432 +00602 DTSSC432 +00603 01 MERA-REC. DTSSC432 +00604 ++INCLUDE DTSIMERA DTSSC432 +00605 DTSSC432 +00606 01 MQTR-REC. DTSSC432 +00607 ++INCLUDE DTSIMQTR DTSSC432 +00608 DTSSC432 +00609 01 MFAE-REC. DTSSC432 +00610 ++INCLUDE DTSIMFAE DTSSC432 +00611 DTSSC432 +00612 01 MOPO-REC. DTSSC432 +00613 ++INCLUDE DTSIMOPO DTSSC432 +00614 DTSSC432 +00615 01 MTAD-REC. DTSSC432 +00616 ++INCLUDE DTSIMTAD DTSSC432 +00617 DTSSC432 +00618 01 MTAA-REC. DTSSC432 +00619 ++INCLUDE DTSIMTAA DTSSC432 +00620 DTSSC432 +00621 01 MREL-REC. DTSSC432 +00622 ++INCLUDE DTSIMREL DTSSC432 +00623 DTSSC432 +00624 01 MRTE-REC. DTSSC432 +00625 ++INCLUDE DTSIMRTE DTSSC432 +00626 DTSSC432 +00627 01 MLOG-REC. DTSSC432 +00628 ++INCLUDE DTSIMLOG DTSSC432 +00629 DTSSC432 +00630 01 MJRN-REC. DTSSC432 +00631 ++INCLUDE DTSIMJRN DTSSC432 +00632 DTSSC432 +00633 01 MRPT-REC. DTSSC432 +00634 ++INCLUDE DTSIMRPT DTSSC432 +00635 DTSSC432 +00636 01 MPAY-REC. DTSSC432 +00637 ++INCLUDE DTSIMPAY DTSSC432 +00638 DTSSC432 +00639 01 L921-LINK-AREA. DTSSC432 +00640 ++INCLUDE DTSIL921 DTSSC432 +00641 SKIP3 DTSSC432 +00642 01 ISKL-REC. DTSSC432 +00643 ++INCLUDE DTSIISKL DTSSC432 +00644 SKIP3 DTSSC432 +00645 01 IPES-REC. DTSSC432 +00646 ++INCLUDE DTSIIPES DTSSC432 +00647 DTSSC432 +00648 01 L931-LINK-AREA. DTSSC432 +00649 ++INCLUDE DTSIL931 DTSSC432 +00650 EJECT DTSSC432 +00651 01 FSKL-REC. DTSSC432 +00652 ++INCLUDE DTSIFSKL DTSSC432 +00653 EJECT DTSSC432 +00654 01 FCYR-REC. DTSSC432 +00655 ++INCLUDE DTSIFCYR DTSSC432 +00656 DTSSC432 +00657 01 FUIR-REC. DTSSC432 +00658 ++INCLUDE DTSIFUIR DTSSC432 +00659 DTSSC432 +00660 01 L981-LINK-AREA. DTSSC432 +00661 ++INCLUDE DTSIL981 DTSSC432 +00662 SKIP3 DTSSC432 +00663 01 WWGH-REC. DTSSC432 +00664 ++INCLUDE DTSIWWGH DTSSC432 +00665 EJECT DTSSC432 +00666 01 L982-LINK-AREA. DTSSC432 +00667 ++INCLUDE DTSIL982 DTSSC432 +00668 SKIP3 DTSSC432 +00669 01 WNAM-REC. DTSSC432 +00670 ++INCLUDE DTSIWNAM DTSSC432 +00671 EJECT DTSSC432 +00672 DTSSC432 +00673 PROCEDURE DIVISION. DTSSC432 +00674 DTSSC432 +00675 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSSC432 +00676 IF WRK-ERROR-NO-88 DTSSC432 +00677 PERFORM P0000-PROCESS THRU P0000-EXIT DTSSC432 +00678 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSSC432 +00679 END-IF. DTSSC432 +00680 DTSSC432 +00681 GOBACK. DTSSC432 +00682 EJECT DTSSC432 +00683 I0000-INITIALIZE. DTSSC432 +00684 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSSC432 +00685 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSSC432 +00686 SET WRK-ERROR-NO-88 TO TRUE. DTSSC432 +00687 DTSSC432 +00688 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSSC432 +00689 IF WRK-ERROR-YES-88 DTSSC432 +00690 GO TO I0000-EXIT DTSSC432 +00691 END-IF. DTSSC432 +00692 DTSSC432 +00693 PERFORM I3000-GLOBAL-DATA THRU I3000-EXIT. DTSSC432 +00694 DTSSC432 +00695 I0000-EXIT. DTSSC432 +00696 EXIT. DTSSC432 +00697 DTSSC432 +00698 I2000-OPEN-FILES. DTSSC432 +00699 *** OPEN OUTPUT PARM-FILE. DTSSC432 +00700 * IF PARM-STATUS-OK-88 DTSSC432 +00701 * NEXT SENTENCE DTSSC432 +00702 * ELSE DTSSC432 +00703 * DISPLAY 'OPEN ERROR ON PARM FILE ' PARM-STATUS DTSSC432 +00704 * SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00705 * GO TO I2000-EXIT DTSSC432 +00706 *** END-IF. DTSSC432 +00707 DTSSC432 +00708 OPEN INPUT SERVER-FILE. DTSSC432 +00709 IF NOT X101-STATUS-OK-88 DTSSC432 +00710 DISPLAY 'OPEN ERROR ON X101 FILE ' X101-STATUS DTSSC432 +00711 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00712 GO TO I2000-EXIT DTSSC432 +00713 END-IF. DTSSC432 +00714 DTSSC432 +00715 OPEN OUTPUT EMPLOYER-TEMP. CL*16 +00716 IF TEMP-STATUS-OK-88 CL*16 +00717 NEXT SENTENCE CL*16 +00718 ELSE CL*16 +00719 DISPLAY 'OPEN ERROR ON TEMP FILE ' TEMP-STATUS CL*16 +00720 SET WRK-ERROR-YES-88 TO TRUE CL*16 +00721 GO TO I2000-EXIT CL*16 +00722 END-IF. CL*16 +00723 DTSSC432 +00724 OPEN OUTPUT X100-REF-FILE. DTSSC432 +00725 IF X100-STATUS-OK-88 DTSSC432 +00726 NEXT SENTENCE DTSSC432 +00727 ELSE DTSSC432 +00728 DISPLAY 'OPEN ERROR ON X100 FILE ' X100-STATUS DTSSC432 +00729 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00730 GO TO I2000-EXIT DTSSC432 +00731 END-IF. DTSSC432 +00732 DTSSC432 +00733 OPEN OUTPUT X102-PRF-FILE. DTSSC432 +00734 IF X102-STATUS-OK-88 DTSSC432 +00735 NEXT SENTENCE DTSSC432 +00736 ELSE DTSSC432 +00737 DISPLAY 'OPEN ERROR ON X102 FILE ' X102-STATUS DTSSC432 +00738 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00739 GO TO I2000-EXIT DTSSC432 +00740 END-IF. DTSSC432 +00741 DTSSC432 +00742 OPEN OUTPUT X104-DETERM-FILE. CL**5 +00743 IF X104-STATUS-OK-88 CL**5 +00744 NEXT SENTENCE CL**5 +00745 ELSE CL**5 +00746 DISPLAY 'OPEN ERROR ON X104 FILE ' X104-STATUS CL**5 +00747 SET WRK-ERROR-YES-88 TO TRUE CL**5 +00748 GO TO I2000-EXIT CL**5 +00749 END-IF. CL**5 +00750 DTSSC432 +00751 OPEN OUTPUT X106-NAME-FILE. DTSSC432 +00752 IF X106-STATUS-OK-88 DTSSC432 +00753 NEXT SENTENCE DTSSC432 +00754 ELSE DTSSC432 +00755 DISPLAY 'OPEN ERROR ON X106 FILE ' X106-STATUS DTSSC432 +00756 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00757 GO TO I2000-EXIT DTSSC432 +00758 END-IF. DTSSC432 +00759 DTSSC432 +00760 OPEN OUTPUT X108-RATE-FILE. CL**5 +00761 IF X108-STATUS-OK-88 CL**5 +00762 NEXT SENTENCE CL**5 +00763 ELSE CL**5 +00764 DISPLAY 'OPEN ERROR ON X108 FILE ' X108-STATUS CL**5 +00765 SET WRK-ERROR-YES-88 TO TRUE CL**5 +00766 GO TO I2000-EXIT CL**5 +00767 END-IF. CL**5 +00768 DTSSC432 +00769 OPEN OUTPUT X110-ADDR-FILE. DTSSC432 +00770 IF X110-STATUS-OK-88 DTSSC432 +00771 NEXT SENTENCE DTSSC432 +00772 ELSE DTSSC432 +00773 DISPLAY 'OPEN ERROR ON X110 FILE ' X110-STATUS DTSSC432 +00774 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00775 GO TO I2000-EXIT DTSSC432 +00776 END-IF. DTSSC432 +00777 DTSSC432 +00778 OPEN OUTPUT X120-OPO-FILE. CL**8 +00779 IF X120-STATUS-OK-88 CL**8 +00780 NEXT SENTENCE CL**8 +00781 ELSE CL**8 +00782 DISPLAY 'OPEN ERROR ON X120 FILE ' X120-STATUS CL**8 +00783 SET WRK-ERROR-YES-88 TO TRUE CL**8 +00784 GO TO I2000-EXIT CL**8 +00785 END-IF. CL**8 +00786 DTSSC432 +00787 ** OPEN OUTPUT X131-REL-FILE. DTSSC432 +00788 * IF X131-STATUS-OK-88 DTSSC432 +00789 * NEXT SENTENCE DTSSC432 +00790 * ELSE DTSSC432 +00791 * DISPLAY 'OPEN ERROR ON X131 FILE ' X131-STATUS DTSSC432 +00792 * SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00793 * GO TO I2000-EXIT DTSSC432 +00794 ** END-IF. DTSSC432 +00795 DTSSC432 +00796 OPEN OUTPUT X140-REPORT-FILE. CL**9 +00797 IF X140-STATUS-OK-88 CL**9 +00798 NEXT SENTENCE CL**9 +00799 ELSE CL**9 +00800 DISPLAY 'OPEN ERROR ON X140 FILE ' X140-STATUS CL**9 +00801 SET WRK-ERROR-YES-88 TO TRUE CL**9 +00802 GO TO I2000-EXIT CL**9 +00803 END-IF. CL**9 +00804 DTSSC432 +00805 OPEN OUTPUT X141-QTR-STATUS-FILE. DTSSC432 +00806 IF X141-STATUS-OK-88 DTSSC432 +00807 NEXT SENTENCE DTSSC432 +00808 ELSE DTSSC432 +00809 DISPLAY 'OPEN ERROR ON X141 FILE ' X141-STATUS DTSSC432 +00810 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00811 GO TO I2000-EXIT DTSSC432 +00812 END-IF. DTSSC432 +00813 DTSSC432 +00814 OPEN OUTPUT X142-LAST-RPT-PAY-FILE. DTSSC432 +00815 IF X142-STATUS-OK-88 DTSSC432 +00816 NEXT SENTENCE DTSSC432 +00817 ELSE DTSSC432 +00818 DISPLAY 'OPEN ERROR ON X142 FILE ' X142-STATUS DTSSC432 +00819 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00820 GO TO I2000-EXIT DTSSC432 +00821 END-IF. DTSSC432 +00822 DTSSC432 +00823 OPEN OUTPUT X145-PAYMENT-FILE. DTSSC432 +00824 IF X145-STATUS-OK-88 DTSSC432 +00825 NEXT SENTENCE DTSSC432 +00826 ELSE DTSSC432 +00827 DISPLAY 'OPEN ERROR ON X145 FILE ' X145-STATUS DTSSC432 +00828 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00829 GO TO I2000-EXIT DTSSC432 +00830 END-IF. DTSSC432 +00831 DTSSC432 +00832 PERFORM S910A-OPEN-READ THRU S910A-EXIT. DTSSC432 +00833 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSSC432 +00834 PERFORM S931A-OPEN-READ THRU S931A-EXIT. DTSSC432 +00835 DTSSC432 +00836 I2000-EXIT. DTSSC432 +00837 EXIT. DTSSC432 +00838 DTSSC432 +00839 I3000-GLOBAL-DATA. DTSSC432 +00840 PERFORM I3100-TAX-HEADER THRU I3100-EXIT. DTSSC432 +00841 PERFORM I3200-TAX-REF THRU I3200-EXIT. DTSSC432 +00842 PERFORM I3400-BUILD-X100 THRU I3400-EXIT. DTSSC432 +00843 DTSSC432 +00844 I3000-EXIT. DTSSC432 +00845 EXIT. DTSSC432 +00846 DTSSC432 +00847 I3100-TAX-HEADER. DTSSC432 +00848 MOVE LOW-VALUES TO MSKL-REC. DTSSC432 +00849 MOVE +0 TO MSKL-EMP-NO. DTSSC432 +00850 SET MSKL-HDR-88 TO TRUE. DTSSC432 +00851 DTSSC432 +00852 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +00853 IF L910-NO-REC-88 DTSSC432 +00854 DISPLAY 'DTSBX410: MHDR RECORD IS MISSING' DTSSC432 +00855 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00856 GO TO I3100-EXIT DTSSC432 +00857 ELSE DTSSC432 +00858 MOVE MSKL-REC TO MHDR-REC DTSSC432 +00859 END-IF. DTSSC432 +00860 DTSSC432 +00861 MOVE MHDR-PRIOR-RUN-DATE TO WRK-PRIOR-RUN-DATE. CL184 +00862 MOVE MHDR-CURR-RUN-DATE TO WRK-CURR-RUN-DATE CL*54 +00863 L004-DATE. DTSSC432 +00864 DISPLAY 'WRK-PRIOR-RUN-DATE ' WRK-PRIOR-RUN-DATE. CL108 +00865 DISPLAY 'WRK-CURR-RUN-DATE ' WRK-CURR-RUN-DATE. CL108 +00866 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSSC432 +00867 MOVE L004-QTR-5-9 TO WRK-CURR-QTR. DTSSC432 +00868 MOVE L004-QTR-START-DATE TO WRK-CURR-QTR-START. DTSSC432 +00869 SUBTRACT +8 FROM L004-ABS-QTR. DTSSC432 +00870 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSSC432 +00871 MOVE L004-QTR-5-9 TO WRK-CURR-QTR-MINUS-8. DTSSC432 +00872 DTSSC432 +00873 MOVE WRK-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSSC432 +00874 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +00875 SUBTRACT +91 FROM L001-JUL-ABS-DAY. DTSSC432 +00876 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSSC432 +00877 MOVE L001-FED-8-DATE-9 TO WRK-1-QTR-AGO. DTSSC432 +00878 DTSSC432 +00879 MOVE WRK-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSSC432 +00880 SUBTRACT 2 FROM L001-FED-8-YR DTSSC432 +00881 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +00882 MOVE L001-FED-8-DATE-9 TO WRK-2-YEARS-AGO DTSSC432 +00883 L004-DATE. DTSSC432 +00884 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSSC432 +00885 MOVE L004-QTR-5-9 TO WRK-LAST-DEL-YRQ. DTSSC432 +00886 DTSSC432 +00887 MOVE MHDR-LAST-RATE-END-YRQ TO WRK-YRQ. DTSSC432 +00888 MOVE 1 TO WRK-YRQ-Q. DTSSC432 +00889 MOVE WRK-YRQ TO WRK-RATE-YRQ-1. DTSSC432 +00890 SUBTRACT 1 FROM WRK-YRQ-CCYY. DTSSC432 +00891 MOVE WRK-YRQ TO WRK-RATE-YRQ-2. DTSSC432 +00892 SUBTRACT 1 FROM WRK-YRQ-CCYY. DTSSC432 +00893 MOVE WRK-YRQ TO WRK-RATE-YRQ-3. DTSSC432 +00894 DTSSC432 +00895 *** MOVE WRK-CURR-QTR TO L004-QTR-5-9. DTSSC432 +00896 * IF L004-QTR-5-Q > 1 DTSSC432 +00897 * MOVE WRK-FIRST-RPT-QTR TO WRK-FIRST-WAGE-QTR DTSSC432 +00898 * ELSE DTSSC432 +00899 * PERFORM S004-FROM-5 THRU S004-EXIT DTSSC432 +00900 * SUBTRACT +1 FROM L004-ABS-QTR DTSSC432 +00901 * PERFORM S004-FROM-ABS THRU S004-EXIT DTSSC432 +00902 * MOVE L004-QTR-5-9 TO WRK-FIRST-WAGE-QTR DTSSC432 +00903 *** END-IF. DTSSC432 +00904 DTSSC432 +00905 MOVE WRK-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. CL161 +00906 ** MOVE MHDR-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. CL161 +00907 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +00908 SUBTRACT +1 FROM L001-JUL-ABS-DAY. DTSSC432 +00909 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSSC432 +00910 MOVE L001-FED-8-DATE-9 TO L005-DATE. DTSSC432 +00911 MOVE ZERO TO L005-TIME. DTSSC432 +00912 SET L005-FROM-DATE-TIME TO TRUE. DTSSC432 +00913 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSSC432 +00914 MOVE L005-ABSTIME TO WRK-ABSTIME. DTSSC432 +00915 DTSSC432 +00916 ***** DTSSC432 +00917 ** WRK-PRIOR-QTR IS THE MOST RECENTLY COMPLETED DTSSC432 +00918 ** QUARTER. DTSSC432 +00919 ** WRK-CURR-QTR IS THE QUARTER IN WHICH DTSSC432 +00920 ** MHDR-CURR-RUN-DATE FALLS. DTSSC432 +00921 ** THESE FIELDS ARE USED IN P3700 WHICH EXTRACTS DTSSC432 +00922 ** QUARTER INFORMATION. DTSSC432 +00923 ***** DTSSC432 +00924 DTSSC432 +00925 MOVE MHDR-LAST-PEN-ASSESSED-YRQ DTSSC432 +00926 TO L004-QTR-5-9. DTSSC432 +00927 PERFORM S004-FROM-5 THRU S004-EXIT. DTSSC432 +00928 ADD +1 TO L004-ABS-QTR. DTSSC432 +00929 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSSC432 +00930 MOVE L004-QTR-5-9 TO WRK-PRIOR-QTR. DTSSC432 +00931 DTSSC432 +00932 MOVE MHDR-CURR-RUN-DATE TO L004-DATE. DTSSC432 +00933 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSSC432 +00934 SUBTRACT +1 FROM L004-ABS-QTR. DTSSC432 +00935 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSSC432 +00936 IF WRK-PRIOR-QTR < L004-QTR-5-9 DTSSC432 +00937 DISPLAY '>>> MORE THAN 1 QUARTER NOT DELINQUENT ' DTSSC432 +00938 WRK-PRIOR-QTR ' ' L004-QTR-5-9 DTSSC432 +00939 DISPLAY 'BX410 ABENDING ' DTSSC432 +00940 PERFORM S999-ABEND THRU S999-EXIT DTSSC432 +00941 END-IF. DTSSC432 +00942 DTSSC432 +00943 DISPLAY SPACE. DTSSC432 +00944 DISPLAY 'DTSBX410 DATES:' DTSSC432 +00945 DISPLAY ' PRIOR RUN DATE ' WRK-PRIOR-RUN-DATE. DTSSC432 +00946 DISPLAY ' CURR RUN DATE ' WRK-CURR-RUN-DATE. DTSSC432 +00947 DISPLAY ' CURR QUARTER ' WRK-CURR-QTR. DTSSC432 +00948 DISPLAY ' PRIOR QUARTER ' WRK-PRIOR-QTR. DTSSC432 +00949 DISPLAY ' CURR QTR - 8 ' WRK-CURR-QTR-MINUS-8. DTSSC432 +00950 DISPLAY ' 2 YEARS AGO ' WRK-2-YEARS-AGO. DTSSC432 +00951 DISPLAY ' RATE YEAR 1 ' WRK-RATE-YRQ-1. DTSSC432 +00952 DISPLAY ' RATE YEAR 2 ' WRK-RATE-YRQ-2. DTSSC432 +00953 DISPLAY ' RATE YEAR 3 ' WRK-RATE-YRQ-3. DTSSC432 +00954 DTSSC432 +00955 I3100-EXIT. DTSSC432 +00956 EXIT. DTSSC432 +00957 DTSSC432 +00958 I3200-TAX-REF. DTSSC432 +00959 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSSC432 +00960 SET FCYR-CYR-88 TO TRUE. DTSSC432 +00961 MOVE WRK-RATE-YRQ-3-CCYY TO FCYR-YR. DTSSC432 +00962 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSSC432 +00963 DTSSC432 +00964 PERFORM S931B-START-BROWSE THRU S931B-EXIT. DTSSC432 +00965 IF L931-NO-REC-88 DTSSC432 +00966 DISPLAY 'DTSBX410: FCYR RECORD IS MISSING' DTSSC432 +00967 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +00968 GO TO I3200-EXIT DTSSC432 +00969 ELSE DTSSC432 +00970 PERFORM DTSSC432 +00971 UNTIL L931-NO-REC-88 DTSSC432 +00972 MOVE FSKL-REC TO FCYR-REC DTSSC432 +00973 PERFORM I3210-WAGE-BASE THRU I3210-EXIT DTSSC432 +00974 PERFORM S931C-READ-NEXT THRU S931C-EXIT DTSSC432 +00975 END-PERFORM DTSSC432 +00976 END-IF. DTSSC432 +00977 DTSSC432 +00978 MOVE LOW-VALUE TO FUIR-KEY-AREA. DTSSC432 +00979 SET FUIR-UIR-88 TO TRUE. DTSSC432 +00980 MOVE WRK-RATE-YRQ-3 TO FUIR-EFF-YRQ. DTSSC432 +00981 MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA. DTSSC432 +00982 PERFORM S931B-START-BROWSE THRU S931B-EXIT. DTSSC432 +00983 IF L931-OK-88 DTSSC432 +00984 PERFORM DTSSC432 +00985 UNTIL L931-NO-REC-88 DTSSC432 +00986 MOVE FSKL-REC TO FUIR-REC DTSSC432 +00987 PERFORM I3220-RATES THRU I3220-EXIT DTSSC432 +00988 PERFORM S931C-READ-NEXT THRU S931C-EXIT DTSSC432 +00989 END-PERFORM DTSSC432 +00990 END-IF. DTSSC432 +00991 DTSSC432 +00992 DISPLAY SPACE. DTSSC432 +00993 DISPLAY 'DTSBX410 RATES: ' DTSSC432 +00994 DISPLAY ' YEAR 1 ' WRK-RATE-YRQ-1 DTSSC432 +00995 ' ' WRK-NEW-EMP-RATE-1 DTSSC432 +00996 ' ' WRK-TAX-TABLE-1. DTSSC432 +00997 DISPLAY ' YEAR 2 ' WRK-RATE-YRQ-2 DTSSC432 +00998 ' ' WRK-NEW-EMP-RATE-2 DTSSC432 +00999 ' ' WRK-TAX-TABLE-2. DTSSC432 +01000 DISPLAY ' YEAR 3 ' WRK-RATE-YRQ-3 DTSSC432 +01001 ' ' WRK-NEW-EMP-RATE-3 DTSSC432 +01002 ' ' WRK-TAX-TABLE-3. DTSSC432 +01003 DTSSC432 +01004 I3200-EXIT. DTSSC432 +01005 EXIT. DTSSC432 +01006 DTSSC432 +01007 I3210-WAGE-BASE. DTSSC432 +01008 EVALUATE TRUE DTSSC432 +01009 WHEN FCYR-YR = WRK-RATE-YRQ-1-CCYY DTSSC432 +01010 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-1 DTSSC432 +01011 DTSSC432 +01012 WHEN FCYR-YR = WRK-RATE-YRQ-2-CCYY DTSSC432 +01013 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-2 DTSSC432 +01014 DTSSC432 +01015 WHEN FCYR-YR = WRK-RATE-YRQ-3-CCYY DTSSC432 +01016 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE-3 DTSSC432 +01017 DTSSC432 +01018 END-EVALUATE. DTSSC432 +01019 DTSSC432 +01020 I3210-EXIT. DTSSC432 +01021 EXIT. DTSSC432 +01022 DTSSC432 +01023 I3220-RATES. DTSSC432 +01024 EVALUATE TRUE DTSSC432 +01025 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-1 DTSSC432 +01026 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-1 DTSSC432 +01027 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-1 DTSSC432 +01028 DTSSC432 +01029 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-2 DTSSC432 +01030 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-2 DTSSC432 +01031 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-2 DTSSC432 +01032 DTSSC432 +01033 WHEN FUIR-EFF-YRQ = WRK-RATE-YRQ-3 DTSSC432 +01034 MOVE FUIR-DEFAULT-NEW-EMP-RATE TO WRK-NEW-EMP-RATE-3 DTSSC432 +01035 MOVE FUIR-RATE-TABLE TO WRK-TAX-TABLE-3 DTSSC432 +01036 DTSSC432 +01037 END-EVALUATE. DTSSC432 +01038 DTSSC432 +01039 I3220-EXIT. DTSSC432 +01040 EXIT. DTSSC432 +01041 DTSSC432 +01042 I3400-BUILD-X100. DTSSC432 +01043 MOVE WRK-RATE-YRQ-1-CCYY TO X100-RATE-YEAR. DTSSC432 +01044 MOVE WRK-NEW-EMP-RATE-1 TO X100-NEW-EMP-RATE. DTSSC432 +01045 MOVE WRK-TAX-TABLE-1 TO X100-TAX-TABLE. DTSSC432 +01046 MOVE WRK-TAX-WAGE-BASE-1 TO X100-TAX-WAGE-BASE. DTSSC432 +01047 DTSSC432 +01048 WRITE X100-REC FROM WRK-X100-REC. DTSSC432 +01049 IF NOT X100-STATUS-OK-88 DTSSC432 +01050 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSSC432 +01051 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01052 END-IF. DTSSC432 +01053 DTSSC432 +01054 MOVE WRK-RATE-YRQ-2-CCYY TO X100-RATE-YEAR. DTSSC432 +01055 MOVE WRK-NEW-EMP-RATE-2 TO X100-NEW-EMP-RATE. DTSSC432 +01056 MOVE WRK-TAX-TABLE-2 TO X100-TAX-TABLE. DTSSC432 +01057 MOVE WRK-TAX-WAGE-BASE-2 TO X100-TAX-WAGE-BASE. DTSSC432 +01058 DTSSC432 +01059 WRITE X100-REC FROM WRK-X100-REC. DTSSC432 +01060 IF NOT X100-STATUS-OK-88 DTSSC432 +01061 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSSC432 +01062 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01063 END-IF. DTSSC432 +01064 DTSSC432 +01065 MOVE WRK-RATE-YRQ-3-CCYY TO X100-RATE-YEAR. DTSSC432 +01066 MOVE WRK-NEW-EMP-RATE-3 TO X100-NEW-EMP-RATE. DTSSC432 +01067 MOVE WRK-TAX-TABLE-3 TO X100-TAX-TABLE. DTSSC432 +01068 MOVE WRK-TAX-WAGE-BASE-3 TO X100-TAX-WAGE-BASE. DTSSC432 +01069 DTSSC432 +01070 WRITE X100-REC FROM WRK-X100-REC. DTSSC432 +01071 IF NOT X100-STATUS-OK-88 DTSSC432 +01072 DISPLAY 'CANNOT WRITE X100 ' X100-STATUS DTSSC432 +01073 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01074 END-IF. DTSSC432 +01075 DTSSC432 +01076 I3400-EXIT. DTSSC432 +01077 EXIT. DTSSC432 +01078 DTSSC432 +01079 DTSSC432 +01080 P0000-PROCESS. DTSSC432 +01081 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSSC432 +01082 MOVE +0 TO MSKL-EMP-NO. CL*67 +01083 SET MSKL-PRF-88 TO TRUE. DTSSC432 +01084 DTSSC432 +01085 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +01086 IF NOT L910-OK-88 DTSSC432 +01087 DISPLAY 'CANNOT READ MASTER FILE ' DTSSC432 +01088 GO TO P0000-EXIT DTSSC432 +01089 ELSE DTSSC432 +01090 MOVE MSKL-REC TO MPRF-REC DTSSC432 +01091 ADD +1 TO WRK-MPRF-CNT DTSSC432 +01092 END-IF. DTSSC432 +01093 DTSSC432 +01094 PERFORM S1000-READ-X101 THRU S1000-EXIT. CL*96 +01095 IF WRK-ERROR-YES-88 CL*96 +01096 GO TO P0000-EXIT CL*96 +01097 END-IF. CL*96 +01098 DTSSC432 +01099 PERFORM DTSSC432 +01100 UNTIL (L910-NO-REC-88 CL*96 +01101 OR X101-STATUS-EOF-88) CL*96 +01102 OR WRK-ERROR-YES-88 DTSSC432 +01103 SET WRK-SELECT-NO-88 TO TRUE DTSSC432 +01104 IF MPRF-EMP-NO < X101-EMP-NO DTSSC432 +01105 PERFORM P1000-EXTRACT THRU P1000-EXIT DTSSC432 +01106 MOVE MPRF-REC TO MSKL-REC DTSSC432 +01107 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01108 MOVE MSKL-REC TO MPRF-REC DTSSC432 +01109 ELSE DTSSC432 +01110 IF MPRF-EMP-NO = X101-EMP-NO DTSSC432 +01111 SET WRK-SELECT-UPD-88 TO TRUE DTSSC432 +01112 PERFORM P1000-EXTRACT THRU P1000-EXIT DTSSC432 +01113 MOVE MPRF-REC TO MSKL-REC DTSSC432 +01114 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01115 MOVE MSKL-REC TO MPRF-REC DTSSC432 +01116 PERFORM S1000-READ-X101 THRU S1000-EXIT DTSSC432 +01117 ELSE CL*96 +01118 ** DISPLAY 'P0000 ERROR > NO MPRF ' X101-EMP-NO CL208 +01119 PERFORM S1000-READ-X101 THRU S1000-EXIT CL*96 +01120 END-IF CL*94 +01121 END-IF DTSSC432 +01122 END-PERFORM. DTSSC432 +01123 DTSSC432 +01124 ** DISPLAY 'P0000 EOF ' L910-RESULT-IND ' ' X101-STATUS. CL*28 +01125 DTSSC432 +01126 IF X101-STATUS-EOF-88 CL*96 +01127 AND L910-OK-88 CL*96 +01128 PERFORM UNTIL L910-NO-REC-88 DTSSC432 +01129 SET WRK-SELECT-NO-88 TO TRUE DTSSC432 +01130 PERFORM P1000-EXTRACT THRU P1000-EXIT DTSSC432 +01131 MOVE MPRF-REC TO MSKL-REC DTSSC432 +01132 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01133 MOVE MSKL-REC TO MPRF-REC DTSSC432 +01134 END-PERFORM CL*98 +01135 END-IF. CL*96 +01136 DTSSC432 +01137 IF X101-STATUS-OK-88 CL*96 +01138 AND L910-NO-REC-88 CL*96 +01139 PERFORM UNTIL X101-STATUS-EOF-88 CL*96 +01140 ** DISPLAY 'P0000 EOF ERR > NO MPRF ' X101-EMP-NO CL209 +01141 READ SERVER-FILE CL*96 +01142 END-PERFORM CL*96 +01143 END-IF. CL*96 +01144 DTSSC432 +01145 P0000-EXIT. DTSSC432 +01146 EXIT. DTSSC432 +01147 DTSSC432 +01148 P1000-EXTRACT. DTSSC432 +01149 ** IF MPRF-EMP-NO = 010187 CL*29 +01150 ** DISPLAY 'P1000 - 1 ' MPRF-EMP-NO ' ' WRK-SELECT-IND CL*29 +01151 ** END-IF. CL*29 +01152 IF MPRF-CLASS-CHG-ONLY-88 DTSSC432 +01153 GO TO P1000-EXIT DTSSC432 +01154 END-IF. DTSSC432 +01155 DTSSC432 +01156 MOVE MPRF-EMP-NO TO WRK-EMP-NO. DTSSC432 +01157 PERFORM P1005-INITIALIZE-EMP THRU P1005-EXIT. DTSSC432 +01158 DTSSC432 +01159 PERFORM P1100-FIND-CHANGES THRU P1100-EXIT. DTSSC432 +01160 DTSSC432 +01161 IF WRK-SELECT-NO-88 DTSSC432 +01162 GO TO P1000-EXIT DTSSC432 +01163 ELSE DTSSC432 +01164 ADD +1 TO WRK-SELECTED-CNT DTSSC432 +01165 END-IF. DTSSC432 +01166 DTSSC432 +01167 ** PERFORM P2000-PROFILE THRU P2000-EXIT. CL*32 +01168 ** PERFORM P2100-NAMES THRU P2100-EXIT. CL*32 +01169 ** PERFORM P2300-EMP-ADDR THRU P2300-EXIT. CL*32 +01170 **** PERFORM P2500-OPO THRU P2500-EXIT. DTSSC432 +01171 ** PERFORM P3600-REPORT THRU P3600-EXIT. CL*32 +01172 PERFORM P3700-QTRS-DUE THRU P3700-EXIT. CL*79 +01173 ** PERFORM P3800-PAYMENT THRU P3800-EXIT. CL*32 +01174 **** PERFORM P3000-REL THRU P3000-EXIT. DTSSC432 +01175 PERFORM P3200-DETERM THRU P3200-EXIT CL246 +01176 PERFORM P3400-RATE THRU P3400-EXIT. CL162 +01177 DTSSC432 +01178 IF X142-EMP-NO > ZERO DTSSC432 +01179 WRITE X142-REC FROM WRK-X142-REC DTSSC432 +01180 IF X142-STATUS-OK-88 DTSSC432 +01181 ADD +1 TO X142-CNT DTSSC432 +01182 ELSE DTSSC432 +01183 DISPLAY 'CANNOT WRITE X142 ' MPRF-EMP-NO DTSSC432 +01184 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01185 END-IF DTSSC432 +01186 END-IF. DTSSC432 +01187 DTSSC432 +01188 P1000-EXIT. DTSSC432 +01189 EXIT. DTSSC432 +01190 DTSSC432 +01191 P1005-INITIALIZE-EMP. DTSSC432 +01192 MOVE SPACES TO WRK-MERA-SOURCE-CD. DTSSC432 +01193 DTSSC432 +01194 SET WRK-SELECT-NAME-NO-88 TO TRUE. DTSSC432 +01195 SET WRK-SELECT-ADDR-NO-88 TO TRUE. DTSSC432 +01196 SET WRK-SELECT-OPO-NO-88 TO TRUE. DTSSC432 +01197 SET WRK-SELECT-SOL-NO-88 TO TRUE. DTSSC432 +01198 SET WRK-SELECT-RATE-NO-88 TO TRUE. CL139 +01199 SET WRK-DELETE-NO-88 TO TRUE. DTSSC432 +01200 DTSSC432 +01201 MOVE ZERO TO X142-EMP-NO DTSSC432 +01202 X142-PAY-DATE DTSSC432 +01203 X142-PAY-AMT. DTSSC432 +01204 MOVE SPACES TO X142-RPT-TYPE DTSSC432 +01205 X142-REPORT-QTR DTSSC432 +01206 X142-REPORT-YEAR. DTSSC432 +01207 DTSSC432 +01208 MOVE +0 TO PAY-LAST DTSSC432 +01209 MAX-PAY-DATE DTSSC432 +01210 MAX-PAY-BATCH DTSSC432 +01211 MAX-PAY-ITEM DTSSC432 +01212 MAX-PAY-AMT. DTSSC432 +01213 PERFORM DTSSC432 +01214 VARYING PSUB FROM +1 BY +1 DTSSC432 +01215 UNTIL PSUB > PAY-MAX DTSSC432 +01216 MOVE +0 TO PAY-BATCH (PSUB) DTSSC432 +01217 PAY-ITEM (PSUB) DTSSC432 +01218 PAY-RCVD-DATE (PSUB) DTSSC432 +01219 PAY-PROCESS-DATE (PSUB) DTSSC432 +01220 PAY-ORIG-AMT (PSUB) DTSSC432 +01221 PAY-ADJ-AMT (PSUB) DTSSC432 +01222 END-PERFORM. DTSSC432 +01223 DTSSC432 +01224 MOVE +0 TO MAX-RPT-DATE DTSSC432 +01225 MAX-RPT-YRQ. DTSSC432 +01226 MOVE SPACES TO MAX-RPT-TYPE. DTSSC432 +01227 PERFORM DTSSC432 +01228 VARYING RSUB FROM +1 BY +1 DTSSC432 +01229 UNTIL RSUB > RPT-MAX DTSSC432 +01230 MOVE +0 TO RPT-YRQ (RSUB) DTSSC432 +01231 RPT-TYPE (RSUB) DTSSC432 +01232 RPT-RCVD-DATE (RSUB) DTSSC432 +01233 RPT-PROCESS-DATE (RSUB) DTSSC432 +01234 END-PERFORM. DTSSC432 +01235 DTSSC432 +01236 P1005-EXIT. DTSSC432 +01237 EXIT. DTSSC432 +01238 DTSSC432 +01239 P1100-FIND-CHANGES. DTSSC432 +01240 ** IF MPRF-EMP-NO = 010187 CL*42 +01241 ** DISPLAY 'P1100 - 1 ' MPRF-EMP-NO ' ' WRK-SELECT-IND CL*42 +01242 ** END-IF. CL*42 +01243 MOVE LOW-VALUES TO MERA-REC. DTSSC432 +01244 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSSC432 +01245 SET MERA-ERA-88 TO TRUE. DTSSC432 +01246 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01247 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +01248 IF L910-OK-88 DTSSC432 +01249 MOVE MSKL-REC TO MERA-REC DTSSC432 +01250 IF MERA-SOURCE-OTH-88 DTSSC432 +01251 OR MERA-SOURCE-UNK-88 DTSSC432 +01252 OR MERA-SOURCE-CD = LOW-VALUES DTSSC432 +01253 OR MERA-SOURCE-CD = SPACES DTSSC432 +01254 SET MERA-SOURCE-VOL-88 TO TRUE DTSSC432 +01255 END-IF DTSSC432 +01256 ELSE DTSSC432 +01257 SET MERA-SOURCE-VOL-88 TO TRUE DTSSC432 +01258 END-IF. DTSSC432 +01259 DTSSC432 +01260 MOVE MERA-SOURCE-CD TO WRK-MERA-SOURCE-CD. DTSSC432 +01261 IF L910-NO-REC-88 DTSSC432 +01262 ** OR WRK-SELECT-UPD-88 DTSSC432 +01263 NEXT SENTENCE DTSSC432 +01264 ELSE DTSSC432 +01265 IF MERA-ESTB-DATE >= WRK-PRIOR-RUN-DATE CL*89 +01266 IF MERA-SOURCE-WEB-88 DTSSC432 +01267 SET WRK-SELECT-PRF-88 TO TRUE DTSSC432 +01268 DISPLAY 'CURR DAY WEB REG ' WRK-EMP-NO DTSSC432 +01269 ' ' MERA-ESTB-DATE DTSSC432 +01270 ELSE DTSSC432 +01271 IF WRK-SELECT-UPD-88 DTSSC432 +01272 DISPLAY 'MAINFRAME/WEB DUP ' MPRF-EMP-NO DTSSC432 +01273 SET WRK-DELETE-YES-88 TO TRUE DTSSC432 +01274 ELSE DTSSC432 +01275 DISPLAY 'P1100 NEW MF ' MPRF-EMP-NO DTSSC432 +01276 SET WRK-SELECT-ALL-88 TO TRUE DTSSC432 +01277 END-IF DTSSC432 +01278 END-IF DTSSC432 +01279 ELSE DTSSC432 +01280 IF MERA-SOURCE-WEB-88 DTSSC432 +01281 AND MERA-STATUS-CHNG-DATE >= WRK-PRIOR-RUN-DATE CL*89 +01282 SET WRK-SELECT-PRF-88 TO TRUE DTSSC432 +01283 DISPLAY 'STAFF REVIEW - MADE LIABLE ' DTSSC432 +01284 WRK-EMP-NO ' ' MERA-STATUS-CHNG-DATE DTSSC432 +01285 END-IF DTSSC432 +01286 END-IF DTSSC432 +01287 END-IF. DTSSC432 +01288 DTSSC432 +01289 ** IF WRK-SELECT-NO-88 CL*52 +01290 ** OR WRK-SELECT-PRF-88 CL*52 +01291 ** OR WRK-SELECT-ALL-88 CL*52 +01292 ** GO TO P1100-EXIT CL*52 +01293 ** END-IF. CL*52 +01294 DTSSC432 +01295 ** IF MPRF-EMP-NO = 011656 CL*42 +01296 ** DISPLAY 'P1100 - 2 ' MPRF-EMP-NO ' ' WRK-SELECT-IND CL*42 +01297 ** END-IF. CL*42 +01298 MOVE LOW-VALUES TO MLOG-REC. DTSSC432 +01299 MOVE WRK-EMP-NO TO MLOG-EMP-NO. DTSSC432 +01300 SET MLOG-LOG-88 TO TRUE. DTSSC432 +01301 MOVE WRK-ABSTIME TO MLOG-ESTB-ABSTIME. DTSSC432 +01302 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01303 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +01304 DTSSC432 +01305 PERFORM UNTIL L910-NO-REC-88 DTSSC432 +01306 MOVE MSKL-REC TO MLOG-REC DTSSC432 +01307 IF MLOG-ESTB-DATE >= WRK-PRIOR-RUN-DATE CL*88 +01308 CL*23 +01309 DISPLAY 'MLOG-DATA-ELEMENT-NAME' MLOG-DATA-ELEMENT-NAME CL*23 +01310 CL*23 +01311 ** AND MLOG-ESTB-DATE <= WRK-CURR-RUN-DATE CL*63 +01312 ** IF MPRF-EMP-NO = 011656 CL*29 +01313 ** DISPLAY MPRF-EMP-NO ' ' MLOG-DATA-ELEMENT-NAME CL*29 +01314 ** END-IF CL*29 +01315 EVALUATE TRUE DTSSC432 +01316 WHEN MLOG-DATA-ELEMENT-NAME = 'MPRF-PRIMARY-NAME' DTSSC432 +01317 SET WRK-SELECT-NAME-YES-88 TO TRUE DTSSC432 +01318 DISPLAY 'NAME ' WRK-EMP-NO ' ' MLOG-ESTB-DATE DTSSC432 +01319 DTSSC432 +01320 WHEN MLOG-DE-REC-TYPE = 'MTAD' DTSSC432 +01321 SET WRK-SELECT-ADDR-YES-88 TO TRUE DTSSC432 +01322 DISPLAY 'ADDR ' WRK-EMP-NO ' ' MLOG-ESTB-DATE DTSSC432 +01323 DTSSC432 +01324 WHEN MLOG-DE-REC-TYPE = 'MOPO' DTSSC432 +01325 SET WRK-SELECT-OPO-YES-88 TO TRUE DTSSC432 +01326 DISPLAY 'OPO ' WRK-EMP-NO ' ' MLOG-ESTB-DATE DTSSC432 +01327 DTSSC432 +01328 WHEN MLOG-DATA-ELEMENT-NAME = 'MPRF-EMP-STATUS' CL*47 +01329 IF MLOG-POST-MODIFICATION-VALUE = 'A' CL*47 +01330 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL*49 +01331 DISPLAY 'EMP STATUS TURNED ACTIVE ' WRK-EMP-NO CL*47 +01332 END-IF CL*47 +01333 CL*47 +01334 ** WHEN MLOG-DATA-ELEMENT-NAME = 'MSOL-INACT-CD' OR CL113 +01335 WHEN MLOG-DATA-ELEMENT-NAME = 'MSOL-INACT-DATE' CL114 +01336 ** MLOG-DATA-ELEMENT-NAME = 'MSOL-LIAB-ESTB-DATE' CL114 +01337 IF (MLOG-PRE-MODIFICATION-VALUE (1:2) = SPACES CL*68 +01338 AND MLOG-POST-MODIFICATION-VALUE (1:2) > SPACES) CL*68 +01339 OR (MLOG-PRE-MODIFICATION-VALUE (1:2) > SPACES CL*68 +01340 AND MLOG-POST-MODIFICATION-VALUE (1:2) = SPACES) CL*68 +01341 OR (MLOG-PRE-MODIFICATION-VALUE (1:2) > SPACES CL113 +01342 AND MLOG-POST-MODIFICATION-VALUE (1:2) > SPACES) CL113 +01343 SET WRK-SELECT-SOL-YES-88 TO TRUE DTSSC432 +01344 SET WRK-SOL-INACT-DT-YES-88 TO TRUE CL*13 +01345 MOVE MLOG-POST-MODIFICATION-VALUE TO CL**7 +01346 WS-MLOG-INACT-DATE CL*10 +01347 * X104-INACTIVE-DATE CL*40 +01348 DISPLAY 'SOL ' WRK-EMP-NO ' ' MLOG-ESTB-DATE DTSSC432 +01349 DISPLAY 'WS-MLOG-INACT-DATE ' WS-MLOG-INACT-DATE CL*18 +01350 DISPLAY 'SET SWITCH FOR INACT-DATE' CL*23 +01351 END-IF CL*68 +01352 CL103 +01353 WHEN MLOG-DATA-ELEMENT-NAME = 'MSOL-NEW-EMPLOYER-IND' CL104 +01354 IF MLOG-OP-ID = 'WEB REG' CL158 +01355 ** IF ((MLOG-PRE-MODIFICATION-VALUE (1:2) = SPACES CL158 +01356 ** AND MLOG-POST-MODIFICATION-VALUE (1:2) > SPACES) CL158 +01357 ** OR (MLOG-PRE-MODIFICATION-VALUE (1:2) > SPACES CL158 +01358 ** AND MLOG-POST-MODIFICATION-VALUE (1:2) = SPACES) CL158 +01359 SET WRK-SELECT-SOL-NO-88 TO TRUE CL103 +01360 DISPLAY 'SOL ' WRK-EMP-NO ' ' MLOG-ESTB-DATE CL103 +01361 ELSE CL158 +01362 SET WRK-SELECT-SOL-YES-88 TO TRUE CL158 +01363 SET WRK-SOL-NEWEMP-IND-YES-88 TO TRUE CL**7 +01364 MOVE MLOG-POST-MODIFICATION-VALUE TO CL**7 +01365 WS-MLOG-EMP-IND CL*10 +01366 DISPLAY 'SET SWITCH FOR NEW EMP IND' CL*23 +01367 END-IF CL104 +01368 CL137 +01369 WHEN MLOG-DATA-ELEMENT-NAME = 'MSOL-LIAB-ESTB-DATE' CL172 +01370 IF MLOG-OP-ID = 'WEB REG' CL172 +01371 ** IF ((MLOG-PRE-MODIFICATION-VALUE (1:2) = SPACES CL172 +01372 ** AND MLOG-POST-MODIFICATION-VALUE (1:2) > SPACES) CL172 +01373 ** OR (MLOG-PRE-MODIFICATION-VALUE (1:2) > SPACES CL172 +01374 ** AND MLOG-POST-MODIFICATION-VALUE (1:2) = SPACES) CL172 +01375 SET WRK-SELECT-SOL-NO-88 TO TRUE CL172 +01376 DISPLAY 'SOL ' WRK-EMP-NO ' ' MLOG-ESTB-DATE CL172 +01377 ELSE CL172 +01378 SET WRK-SELECT-SOL-YES-88 TO TRUE CL172 +01379 SET WRK-SOL-LIABEST-DT-YES-88 TO TRUE CL**7 +01380 MOVE MLOG-POST-MODIFICATION-VALUE TO CL*69 +01381 * WS-MLOG-LIAB-DATE CL*69 +01382 WRK-NEW-LIAB-DATE CL*69 +01383 DISPLAY 'SET SWITCH FOR LIAB-EST-DATE' CL*23 +01384 END-IF CL172 +01385 CL172 +01386 WHEN MLOG-DATA-ELEMENT-NAME = 'MRTE-UI-RATE' CL137 +01387 IF (MLOG-PRE-MODIFICATION-VALUE (1:2) > SPACES CL168 +01388 AND MLOG-POST-MODIFICATION-VALUE (1:2) > SPACES) CL168 +01389 ** OR (MLOG-PRE-MODIFICATION-VALUE (1:2) > SPACES CL164 +01390 ** AND MLOG-POST-MODIFICATION-VALUE (1:2) > SPACES) CL164 +01391 SET WRK-SELECT-RATE-YES-88 TO TRUE CL139 +01392 DISPLAY 'RATE ' WRK-EMP-NO ' ' MLOG-ESTB-DATE CL139 +01393 END-IF CL169 +01394 END-EVALUATE DTSSC432 +01395 END-IF DTSSC432 +01396 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01397 END-PERFORM. DTSSC432 +01398 P1100-EXIT. DTSSC432 +01399 EXIT. DTSSC432 +01400 DTSSC432 +01401 P2000-PROFILE. DTSSC432 +01402 IF WRK-SELECT-ALL-88 DTSSC432 +01403 OR WRK-SELECT-PRF-88 DTSSC432 +01404 OR WRK-SELECT-ADDR-YES-88 DTSSC432 +01405 OR WRK-SELECT-SOL-YES-88 DTSSC432 +01406 OR WRK-SELECT-NAME-YES-88 DTSSC432 +01407 OR WRK-SELECT-OPO-YES-88 DTSSC432 +01408 NEXT SENTENCE DTSSC432 +01409 ELSE DTSSC432 +01410 GO TO P2000-EXIT DTSSC432 +01411 END-IF. DTSSC432 +01412 DTSSC432 +01413 MOVE WRK-EMP-NO TO X102-EMP-NO. DTSSC432 +01414 MOVE MPRF-FEIN TO X102-EMP-FEIN. DTSSC432 +01415 MOVE MPRF-EMP-CLASS TO X102-EMP-CLASS. DTSSC432 +01416 MOVE MPRF-EMP-STATUS TO X102-EMP-STATUS. DTSSC432 +01417 MOVE WRK-MERA-SOURCE-CD TO X102-SOURCE-CD. DTSSC432 +01418 DTSSC432 +01419 EVALUATE TRUE DTSSC432 +01420 WHEN WRK-DELETE-YES-88 DTSSC432 +01421 SET X102-ACTION-DELETE-88 TO TRUE DTSSC432 +01422 DTSSC432 +01423 WHEN WRK-SELECT-ALL-88 DTSSC432 +01424 SET X102-ACTION-INSERT-88 TO TRUE DTSSC432 +01425 DTSSC432 +01426 WHEN OTHER DTSSC432 +01427 SET X102-ACTION-UPDATE-88 TO TRUE DTSSC432 +01428 DTSSC432 +01429 END-EVALUATE. DTSSC432 +01430 DTSSC432 +01431 WRITE X102-REC FROM WRK-X102-REC. DTSSC432 +01432 IF X102-STATUS-OK-88 DTSSC432 +01433 ADD +1 TO X102-CNT DTSSC432 +01434 ELSE DTSSC432 +01435 DISPLAY 'CANNOT WRITE X102 ' MPRF-EMP-NO DTSSC432 +01436 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01437 END-IF. DTSSC432 +01438 DTSSC432 +01439 P2000-EXIT. DTSSC432 +01440 EXIT. DTSSC432 +01441 DTSSC432 +01442 P2100-NAMES. DTSSC432 +01443 IF WRK-SELECT-ALL-88 DTSSC432 +01444 OR WRK-SELECT-NAME-YES-88 DTSSC432 +01445 NEXT SENTENCE DTSSC432 +01446 ELSE DTSSC432 +01447 GO TO P2100-EXIT DTSSC432 +01448 END-IF. DTSSC432 +01449 DTSSC432 +01450 IF MPRF-PRIMARY-IS-ENTITY-88 DTSSC432 +01451 SET X106-NAME-TYPE-ENTITY-88 TO TRUE DTSSC432 +01452 MOVE MPRF-PRIMARY-NAME TO X106-EMP-NAME DTSSC432 +01453 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSSC432 +01454 ELSE DTSSC432 +01455 IF MPRF-ENTITY-NAME > SPACES DTSSC432 +01456 SET X106-NAME-TYPE-ENTITY-88 TO TRUE DTSSC432 +01457 MOVE MPRF-ENTITY-NAME TO X106-EMP-NAME DTSSC432 +01458 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSSC432 +01459 ELSE DTSSC432 +01460 SET X106-NAME-TYPE-TRADE-88 TO TRUE DTSSC432 +01461 MOVE MPRF-PRIMARY-NAME TO X106-EMP-NAME DTSSC432 +01462 PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSSC432 +01463 END-IF DTSSC432 +01464 END-IF. DTSSC432 +01465 DTSSC432 +01466 *** PERFORM P2110-ALT-NAMES THRU P2110-EXIT. DTSSC432 +01467 DTSSC432 +01468 P2100-EXIT. DTSSC432 +01469 EXIT. DTSSC432 +01470 DTSSC432 +01471 *P2110-ALT-NAMES. DTSSC432 +01472 * MOVE LOW-VALUES TO MTAA-REC. DTSSC432 +01473 * MOVE WRK-EMP-NO TO MTAA-EMP-NO. DTSSC432 +01474 * SET MTAA-TAA-88 TO TRUE. DTSSC432 +01475 * MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01476 * PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +01477 * PERFORM DTSSC432 +01478 * UNTIL L910-NO-REC-88 DTSSC432 +01479 * MOVE MSKL-REC TO MTAA-REC DTSSC432 +01480 * IF MTAA-NAME > SPACES DTSSC432 +01481 * SET X106-NAME-TYPE-TRADE-88 TO TRUE DTSSC432 +01482 * MOVE MTAA-NAME TO X106-EMP-NAME DTSSC432 +01483 * PERFORM P2190-WRITE-X106 THRU P2190-EXIT DTSSC432 +01484 * END-IF DTSSC432 +01485 * PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01486 * END-PERFORM. DTSSC432 +01487 * DTSSC432 +01488 *P2110-EXIT. DTSSC432 +01489 * EXIT. DTSSC432 +01490 DTSSC432 +01491 P2190-WRITE-X106. DTSSC432 +01492 MOVE WRK-EMP-NO TO X106-EMP-NO. DTSSC432 +01493 INSPECT X106-EMP-NAME REPLACING ALL ',' BY SPACE. DTSSC432 +01494 DTSSC432 +01495 WRITE X106-REC FROM WRK-X106-REC. DTSSC432 +01496 IF X106-STATUS-OK-88 DTSSC432 +01497 ADD +1 TO X106-CNT DTSSC432 +01498 ELSE DTSSC432 +01499 DISPLAY 'CANNOT WRITE X106 ' MPRF-EMP-NO DTSSC432 +01500 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01501 END-IF. DTSSC432 +01502 DTSSC432 +01503 P2190-EXIT. DTSSC432 +01504 EXIT. DTSSC432 +01505 DTSSC432 +01506 P2300-EMP-ADDR. DTSSC432 +01507 IF WRK-SELECT-ALL-88 DTSSC432 +01508 OR WRK-SELECT-ADDR-YES-88 DTSSC432 +01509 NEXT SENTENCE DTSSC432 +01510 ELSE DTSSC432 +01511 GO TO P2300-EXIT DTSSC432 +01512 END-IF. DTSSC432 +01513 DTSSC432 +01514 PERFORM P2310-MTAD THRU P2310-EXIT. DTSSC432 +01515 *** PERFORM P2320-MTAA THRU P2320-EXIT. DTSSC432 +01516 P2300-EXIT. DTSSC432 +01517 EXIT. DTSSC432 +01518 DTSSC432 +01519 P2310-MTAD. DTSSC432 +01520 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSSC432 +01521 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSSC432 +01522 SET MTAD-TAD-88 TO TRUE. DTSSC432 +01523 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSSC432 +01524 DTSSC432 +01525 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01526 DTSSC432 +01527 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +01528 DTSSC432 +01529 IF L910-NO-REC-88 DTSSC432 +01530 GO TO P2310-EXIT DTSSC432 +01531 ELSE DTSSC432 +01532 MOVE MSKL-REC TO MTAD-REC DTSSC432 +01533 MOVE MTAD-ADDRESS TO WRK-ADDRESS DTSSC432 +01534 SET X110-ADDR-TYPE-MAIL-88 TO TRUE DTSSC432 +01535 MOVE MTAD-VOICE-1 TO WRK-PHONE DTSSC432 +01536 MOVE MTAD-FAX TO WRK-FAX DTSSC432 +01537 MOVE MTAD-EMAIL-ADDRESS TO WRK-EMAIL DTSSC432 +01538 PERFORM P2390-WRITE-X110 THRU P2390-EXIT DTSSC432 +01539 END-IF. DTSSC432 +01540 DTSSC432 +01541 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSSC432 +01542 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01543 DTSSC432 +01544 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +01545 DTSSC432 +01546 IF L910-NO-REC-88 DTSSC432 +01547 GO TO P2310-EXIT DTSSC432 +01548 ELSE DTSSC432 +01549 MOVE MSKL-REC TO MTAD-REC DTSSC432 +01550 MOVE MTAD-ADDRESS TO WRK-ADDRESS DTSSC432 +01551 SET X110-ADDR-TYPE-RECS-88 TO TRUE DTSSC432 +01552 MOVE MTAD-VOICE-1 TO WRK-PHONE DTSSC432 +01553 MOVE MTAD-FAX TO WRK-FAX DTSSC432 +01554 MOVE MTAD-EMAIL-ADDRESS TO WRK-EMAIL DTSSC432 +01555 PERFORM P2390-WRITE-X110 THRU P2390-EXIT DTSSC432 +01556 SET X110-ADDR-TYPE-WORK-88 TO TRUE DTSSC432 +01557 PERFORM P2390-WRITE-X110 THRU P2390-EXIT DTSSC432 +01558 END-IF. DTSSC432 +01559 DTSSC432 +01560 P2310-EXIT. DTSSC432 +01561 EXIT. DTSSC432 +01562 DTSSC432 +01563 *P2320-MTAA. DTSSC432 +01564 * MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSSC432 +01565 * MOVE WRK-EMP-NO TO MTAA-EMP-NO. DTSSC432 +01566 * SET MTAA-TAA-88 TO TRUE. DTSSC432 +01567 * DTSSC432 +01568 * MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01569 * DTSSC432 +01570 * PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +01571 * DTSSC432 +01572 * IF L910-NO-REC-88 DTSSC432 +01573 * GO TO P2320-EXIT DTSSC432 +01574 * ELSE DTSSC432 +01575 * PERFORM DTSSC432 +01576 * UNTIL L910-NO-REC-88 DTSSC432 +01577 * MOVE MSKL-REC TO MTAA-REC DTSSC432 +01578 * IF MTAA-ST = 'DC' DTSSC432 +01579 * MOVE MTAA-ADDRESS TO WRK-ADDRESS DTSSC432 +01580 * SET X110-ADDR-TYPE-WORK-88 TO TRUE DTSSC432 +01581 * MOVE MTAA-VOICE-1 TO WRK-PHONE DTSSC432 +01582 * MOVE MTAA-FAX TO WRK-FAX DTSSC432 +01583 * MOVE MTAA-EMAIL-ADDRESS TO WRK-EMAIL DTSSC432 +01584 * PERFORM P2390-WRITE-X110 THRU P2390-EXIT DTSSC432 +01585 * END-IF DTSSC432 +01586 * PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01587 * END-PERFORM DTSSC432 +01588 * END-IF. DTSSC432 +01589 * DTSSC432 +01590 *P2320-EXIT. DTSSC432 +01591 * EXIT. DTSSC432 +01592 DTSSC432 +01593 P2390-WRITE-X110. DTSSC432 +01594 MOVE WRK-EMP-NO TO X110-EMP-NO. DTSSC432 +01595 MOVE WRK-ATTN-LINE TO X110-ATTENTION. DTSSC432 +01596 MOVE WRK-DELIV-LINE-1 TO X110-STREET-1. DTSSC432 +01597 MOVE WRK-DELIV-LINE-2 TO X110-STREET-2. DTSSC432 +01598 MOVE WRK-CITY TO X110-CITY. DTSSC432 +01599 MOVE WRK-ST TO X110-STATE. DTSSC432 +01600 MOVE WRK-ZIP TO X110-ZIP. DTSSC432 +01601 MOVE WRK-PHONE TO X110-PHONE. DTSSC432 +01602 MOVE WRK-FAX TO X110-FAX. DTSSC432 +01603 IF WRK-EMAIL = LOW-VALUES DTSSC432 +01604 MOVE SPACES TO X110-EMAIL DTSSC432 +01605 ELSE DTSSC432 +01606 MOVE WRK-EMAIL TO X110-EMAIL DTSSC432 +01607 END-IF. DTSSC432 +01608 DTSSC432 +01609 INSPECT X110-ATTENTION REPLACING ALL ',' BY SPACE. DTSSC432 +01610 INSPECT X110-STREET-1 REPLACING ALL ',' BY SPACE. DTSSC432 +01611 INSPECT X110-STREET-2 REPLACING ALL ',' BY SPACE. DTSSC432 +01612 INSPECT X110-EMAIL REPLACING ALL ',' BY SPACE. DTSSC432 +01613 DTSSC432 +01614 WRITE X110-REC FROM WRK-X110-REC. DTSSC432 +01615 IF X110-STATUS-OK-88 DTSSC432 +01616 ADD +1 TO X110-CNT DTSSC432 +01617 ELSE DTSSC432 +01618 DISPLAY 'CANNOT WRITE X110 ' MPRF-EMP-NO DTSSC432 +01619 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01620 END-IF. DTSSC432 +01621 DTSSC432 +01622 P2390-EXIT. DTSSC432 +01623 EXIT. DTSSC432 +01624 DTSSC432 +01625 P2500-OPO. DTSSC432 +01626 IF MSOL-LIAB-RATED-DOMESTIC-88 DTSSC432 +01627 GO TO P2500-EXIT DTSSC432 +01628 END-IF. DTSSC432 +01629 DTSSC432 +01630 IF WRK-SELECT-ALL-88 DTSSC432 +01631 OR WRK-SELECT-OPO-YES-88 DTSSC432 +01632 NEXT SENTENCE DTSSC432 +01633 ELSE DTSSC432 +01634 GO TO P2500-EXIT DTSSC432 +01635 END-IF. DTSSC432 +01636 DTSSC432 +01637 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSSC432 +01638 MOVE WRK-EMP-NO TO MOPO-EMP-NO. DTSSC432 +01639 SET MOPO-OPO-88 TO TRUE. DTSSC432 +01640 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01641 DTSSC432 +01642 SET WRK-MOPO-FOUND-NO-88 TO TRUE. DTSSC432 +01643 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +01644 IF L910-NO-REC-88 DTSSC432 +01645 NEXT SENTENCE DTSSC432 +01646 ELSE DTSSC432 +01647 PERFORM DTSSC432 +01648 UNTIL L910-NO-REC-88 DTSSC432 +01649 MOVE MSKL-REC TO MOPO-REC DTSSC432 +01650 PERFORM P2510-PARSE-NAME THRU P2510-EXIT DTSSC432 +01651 PERFORM P2590-WRITE-X120 THRU P2590-EXIT DTSSC432 +01652 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01653 END-PERFORM DTSSC432 +01654 END-IF. DTSSC432 +01655 DTSSC432 +01656 DTSSC432 +01657 P2500-EXIT. DTSSC432 +01658 EXIT. DTSSC432 +01659 DTSSC432 +01660 P2510-PARSE-NAME. DTSSC432 +01661 *& DTSSC432 +01662 * DISPLAY 'P2510 NAME ' MOPO-NAME ' ' MOPO-EMP-NO. DTSSC432 +01663 *& DTSSC432 +01664 MOVE +0 TO FSUB DTSSC432 +01665 LSUB. DTSSC432 +01666 MOVE SPACES TO FIRST-NAME DTSSC432 +01667 MIDDLE-INIT DTSSC432 +01668 LAST-NAME. DTSSC432 +01669 SET FIRST-NAME-COMPLETE-NO-88 TO TRUE. DTSSC432 +01670 SET LAST-NAME-COMPLETE-NO-88 TO TRUE. DTSSC432 +01671 SET MID-INIT-COMPLETE-NO-88 TO TRUE. DTSSC432 +01672 DTSSC432 +01673 MOVE MOPO-NAME TO SLASH-NAME. DTSSC432 +01674 PERFORM DTSSC432 +01675 VARYING NSUB FROM +1 BY +1 DTSSC432 +01676 UNTIL NSUB > +40 DTSSC432 +01677 OR MID-INIT-COMPLETE-YES-88 DTSSC432 +01678 IF FIRST-NAME-COMPLETE-YES-88 DTSSC432 +01679 PERFORM P2513-MID-INIT THRU P2513-EXIT DTSSC432 +01680 ELSE DTSSC432 +01681 IF LAST-NAME-COMPLETE-YES-88 DTSSC432 +01682 PERFORM P2512-FIRST-NAME THRU P2512-EXIT DTSSC432 +01683 ELSE DTSSC432 +01684 PERFORM P2511-LAST-NAME THRU P2511-EXIT DTSSC432 +01685 END-IF DTSSC432 +01686 END-IF DTSSC432 +01687 END-PERFORM. DTSSC432 +01688 DTSSC432 +01689 *& DTSSC432 +01690 * DISPLAY ' P2510 ' FIRST-NAME ' ' MIDDLE-INIT DTSSC432 +01691 * ' ' LAST-NAME. DTSSC432 +01692 DTSSC432 +01693 P2510-EXIT. DTSSC432 +01694 EXIT. DTSSC432 +01695 DTSSC432 +01696 P2511-LAST-NAME. DTSSC432 +01697 IF SLASH-NAME-CHAR (NSUB) = '/' DTSSC432 +01698 SET LAST-NAME-COMPLETE-YES-88 TO TRUE DTSSC432 +01699 GO TO P2511-EXIT DTSSC432 +01700 ELSE DTSSC432 +01701 IF LSUB < +40 DTSSC432 +01702 ADD +1 TO LSUB DTSSC432 +01703 MOVE SLASH-NAME-CHAR (NSUB) TO LAST-NAME (LSUB:1) DTSSC432 +01704 *& DTSSC432 +01705 * DISPLAY ' P2511 LAST ' NSUB ' ' LSUB ' ' LAST-NAME DTSSC432 +01706 *& DTSSC432 +01707 END-IF DTSSC432 +01708 END-IF. DTSSC432 +01709 DTSSC432 +01710 P2511-EXIT. DTSSC432 +01711 EXIT. DTSSC432 +01712 DTSSC432 +01713 P2512-FIRST-NAME. DTSSC432 +01714 IF SLASH-NAME-CHAR (NSUB) = SPACE DTSSC432 +01715 SET FIRST-NAME-COMPLETE-YES-88 TO TRUE DTSSC432 +01716 GO TO P2512-EXIT DTSSC432 +01717 ELSE DTSSC432 +01718 IF FSUB < +20 DTSSC432 +01719 ADD +1 TO FSUB DTSSC432 +01720 MOVE SLASH-NAME-CHAR (NSUB) TO FIRST-NAME (FSUB:1) DTSSC432 +01721 *& DTSSC432 +01722 * DISPLAY ' P2512 FIRST ' NSUB ' ' FSUB ' ' FIRST-NAME DTSSC432 +01723 *& DTSSC432 +01724 END-IF DTSSC432 +01725 END-IF. DTSSC432 +01726 DTSSC432 +01727 P2512-EXIT. DTSSC432 +01728 EXIT. DTSSC432 +01729 DTSSC432 +01730 P2513-MID-INIT. DTSSC432 +01731 IF MID-INIT-COMPLETE-NO-88 DTSSC432 +01732 MOVE SLASH-NAME-CHAR (NSUB) TO MIDDLE-INIT (1:1) DTSSC432 +01733 SET MID-INIT-COMPLETE-YES-88 TO TRUE DTSSC432 +01734 *& DTSSC432 +01735 * DISPLAY ' P2513 MID ' NSUB ' ' MIDDLE-INIT DTSSC432 +01736 *& DTSSC432 +01737 END-IF. DTSSC432 +01738 DTSSC432 +01739 P2513-EXIT. DTSSC432 +01740 EXIT. DTSSC432 +01741 DTSSC432 +01742 P2590-WRITE-X120. DTSSC432 +01743 IF LAST-NAME = SPACES DTSSC432 +01744 GO TO P2590-EXIT DTSSC432 +01745 END-IF. DTSSC432 +01746 DTSSC432 +01747 MOVE WRK-EMP-NO TO X120-EMP-NO. DTSSC432 +01748 IF FIRST-NAME = SPACES DTSSC432 +01749 MOVE LAST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSSC432 +01750 MOVE LAST-NAME (21:1) TO X120-OPO-MID-INIT DTSSC432 +01751 MOVE LAST-NAME (22:19) TO X120-OPO-LAST-NAME DTSSC432 +01752 ELSE DTSSC432 +01753 MOVE FIRST-NAME (1:20) TO X120-OPO-FIRST-NAME DTSSC432 +01754 MOVE MIDDLE-INIT TO X120-OPO-MID-INIT DTSSC432 +01755 MOVE LAST-NAME (1:20) TO X120-OPO-LAST-NAME DTSSC432 +01756 END-IF. DTSSC432 +01757 MOVE SPACES TO X120-OPO-MEMBER-NAME. DTSSC432 +01758 MOVE MOPO-SSN TO X120-OPO-SSN. DTSSC432 +01759 MOVE MOPO-TITLE TO X120-OPO-TITLE. DTSSC432 +01760 MOVE MOPO-TYPE-IND TO X120-TYPE-IND. DTSSC432 +01761 IF MOPO-ATTN-LINE = LOW-VALUES DTSSC432 +01762 MOVE SPACES TO X120-OPO-ATTENTION DTSSC432 +01763 ELSE DTSSC432 +01764 MOVE MOPO-ATTN-LINE TO X120-OPO-ATTENTION DTSSC432 +01765 END-IF. DTSSC432 +01766 MOVE MOPO-DELIV-LINE-1 TO X120-OPO-STREET-1. DTSSC432 +01767 MOVE MOPO-DELIV-LINE-2 TO X120-OPO-STREET-2. DTSSC432 +01768 MOVE MOPO-CITY TO X120-OPO-CITY. DTSSC432 +01769 MOVE MOPO-ST TO X120-OPO-STATE. DTSSC432 +01770 MOVE MOPO-ZIP TO X120-OPO-ZIP. DTSSC432 +01771 MOVE MOPO-VOICE-1 TO X120-OPO-PHONE. DTSSC432 +01772 MOVE MOPO-FAX TO X120-OPO-FAX. DTSSC432 +01773 IF MOPO-EMAIL-ADDRESS = LOW-VALUES DTSSC432 +01774 MOVE SPACES TO X120-OPO-EMAIL DTSSC432 +01775 ELSE DTSSC432 +01776 MOVE MOPO-EMAIL-ADDRESS TO X120-OPO-EMAIL DTSSC432 +01777 END-IF. DTSSC432 +01778 DTSSC432 +01779 INSPECT X120-OPO-FIRST-NAME REPLACING ALL ',' BY SPACE. DTSSC432 +01780 INSPECT X120-OPO-MID-INIT REPLACING ALL ',' BY SPACE. DTSSC432 +01781 INSPECT X120-OPO-LAST-NAME REPLACING ALL ',' BY SPACE. DTSSC432 +01782 INSPECT X120-OPO-TITLE REPLACING ALL ',' BY SPACE. DTSSC432 +01783 INSPECT X120-OPO-ATTENTION REPLACING ALL ',' BY SPACE. DTSSC432 +01784 INSPECT X120-OPO-STREET-1 REPLACING ALL ',' BY SPACE. DTSSC432 +01785 INSPECT X120-OPO-STREET-2 REPLACING ALL ',' BY SPACE. DTSSC432 +01786 INSPECT X120-OPO-EMAIL REPLACING ALL ',' BY SPACE. DTSSC432 +01787 DTSSC432 +01788 WRITE X120-REC FROM WRK-X120-REC. DTSSC432 +01789 IF X120-STATUS-OK-88 DTSSC432 +01790 ADD +1 TO X120-CNT DTSSC432 +01791 ELSE DTSSC432 +01792 DISPLAY 'CANNOT WRITE X120 ' MPRF-EMP-NO DTSSC432 +01793 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01794 END-IF. DTSSC432 +01795 DTSSC432 +01796 P2590-EXIT. DTSSC432 +01797 EXIT. DTSSC432 +01798 DTSSC432 +01799 *P3000-REL. DTSSC432 +01800 * MOVE LOW-VALUES TO MREL-KEY-AREA. DTSSC432 +01801 * MOVE WRK-EMP-NO TO MREL-EMP-NO. DTSSC432 +01802 * SET MREL-REL-88 TO TRUE. DTSSC432 +01803 * MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +01804 * DTSSC432 +01805 * PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +01806 * IF L910-NO-REC-88 DTSSC432 +01807 * NEXT SENTENCE DTSSC432 +01808 * ELSE DTSSC432 +01809 * PERFORM DTSSC432 +01810 * UNTIL L910-NO-REC-88 DTSSC432 +01811 * MOVE MSKL-REC TO MREL-REC DTSSC432 +01812 * IF MREL-REL-REC-VOID-88 DTSSC432 +01813 * OR MREL-REL-REC-TRNSF-88 DTSSC432 +01814 * NEXT SENTENCE DTSSC432 +01815 * ELSE DTSSC432 +01816 * IF MREL-ESTB-DATE = WRK-PRIOR-RUN-DATE DTSSC432 +01817 * OR MREL-CHNG-DATE = WRK-PRIOR-RUN-DATE DTSSC432 +01818 * PERFORM P3010-WRITE-X131 THRU P3010-EXIT DTSSC432 +01819 * END-IF DTSSC432 +01820 * END-IF DTSSC432 +01821 * MOVE MREL-REC TO MSKL-REC DTSSC432 +01822 * PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +01823 * END-PERFORM DTSSC432 +01824 * END-IF. DTSSC432 +01825 * DTSSC432 +01826 *P3000-EXIT. DTSSC432 +01827 * EXIT. DTSSC432 +01828 * DTSSC432 +01829 *P3010-WRITE-X131. DTSSC432 +01830 * MOVE MPRF-EMP-NO TO X131-SUCC-EMP-NO. DTSSC432 +01831 * DTSSC432 +01832 * MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9. DTSSC432 +01833 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +01834 * MOVE L001-SLASH-8-DATE TO X131-EFF-DATE. DTSSC432 +01835 * DTSSC432 +01836 * MOVE MREL-PRED-EMP-NO TO X131-PRED-EMP-NO. DTSSC432 +01837 * DTSSC432 +01838 * WRITE EMPLOYER-TEMP-REC FROM WRK-X131-REC DTSSC432 +01839 * IF TEMP-STATUS-OK-88 DTSSC432 +01840 * ADD +1 TO WRK-TEMP-CNT DTSSC432 +01841 * ELSE DTSSC432 +01842 * DISPLAY 'CANNOT WRITE TEMP X131 ' WRK-EMP-NO DTSSC432 +01843 * SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +01844 * END-IF. DTSSC432 +01845 * DTSSC432 +01846 *P3010-EXIT. DTSSC432 +01847 * EXIT. DTSSC432 +01848 CL*92 +01849 P3200-DETERM. CL**5 +01850 *LOGIC TO CHANGE MLOG-INACT-DT TO / FORMAT CL*38 +01851 CL*10 +01852 IF WS-MLOG-INACT-DATE > SPACE CL*10 +01853 MOVE WS-MLOG-INACT-DATE(1:6) TO WS-HOLD-INACT-DATE(1:6) CL*10 +01854 MOVE '20' TO WS-HOLD-INACT-DATE(7:2) CL*10 +01855 MOVE WS-MLOG-INACT-DATE(7:2) TO WS-HOLD-INACT-DATE(9:2) CL*10 +01856 END-IF. CL*10 +01857 CL*10 +01858 MOVE LOW-VALUES TO MSOL-REC. CL**5 +01859 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL239 +01860 MOVE WRK-EMP-NO TO MSOL-EMP-NO. CL**5 +01861 SET MSOL-SOL-88 TO TRUE. CL**5 +01862 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. CL**5 +01863 CL239 +01864 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL**5 +01865 CL246 +01866 IF L910-NO-REC-88 CL246 +01867 GO TO P3200-EXIT. CL246 +01868 CL*27 +01869 * LOGIC TO HOLD LIAB DATE FROM THE 1ST SPAN CL*38 +01870 CL*30 +01871 MOVE MSKL-REC TO MSOL-REC CL*30 +01872 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9 CL*27 +01873 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*27 +01874 MOVE L001-SLASH-8-DATE TO WS-HOLD-1-LIAB-DT CL*27 +01875 CL*27 +01876 PERFORM P3210-BUILD-X104 THRU P3210-EXIT CL246 +01877 UNTIL L910-NO-REC-88 CL246 +01878 CL*66 +01879 * LOGIC TO MOVE THE HH FILING SCHEDULE CL*66 +01880 IF MSOL-LIAB-RATED-DOMESTIC-88 CL*66 +01881 PERFORM P3211-FILE-SCHED THRU P3211-EXIT CL*66 +01882 END-IF. CL*66 +01883 CL*66 +01884 * LOGIC TO MOVE THE LIAB-DT TO X104-FIRST-WAGE-DT CL*38 +01885 IF WS-HOLD-2-LIAB-DT > SPACES CL*27 +01886 MOVE WS-HOLD-2-LIAB-DT TO X104-FIRST-WAGE-DT CL*27 +01887 ELSE CL*27 +01888 IF WS-HOLD-2-LIAB-DT = SPACES AND MSOL-LIAB-CD = 04 CL*34 +01889 MOVE WS-HOLD-2-LIAB-DT TO X104-FIRST-WAGE-DT CL*31 +01890 ELSE CL*31 +01891 MOVE WS-HOLD-1-LIAB-DT TO X104-FIRST-WAGE-DT CL*31 +01892 END-IF CL*31 +01893 END-IF CL*27 +01894 CL*27 +01895 IF WRK-SOL-INACT-DT-YES-88 CL*11 +01896 IF X104-INACTIVE-DATE = WS-HOLD-INACT-DATE CL*46 +01897 SET WRK-WRITE-X104-YES-88 TO TRUE CL*11 +01898 DISPLAY 'SETTING WRITE SWITCH FOR INACT-DATE' CL*20 +01899 END-IF CL*11 +01900 END-IF. CL*11 +01901 CL*11 +01902 IF WRK-STATUS-CHNG-YES-88 CL*47 +01903 SET WRK-WRITE-X104-YES-88 TO TRUE CL*47 +01904 DISPLAY 'SETTING WRITE SWITCH FOR EMP STATUS-ACT' CL*47 +01905 END-IF. CL*47 +01906 CL*47 +01907 IF WRK-SOL-NEWEMP-IND-YES-88 CL*11 +01908 IF WS-MSOL-EMP-IND = WS-MLOG-EMP-IND CL*11 +01909 SET WRK-WRITE-X104-YES-88 TO TRUE CL*11 +01910 DISPLAY 'SETTING WRITE SWITCH FOR EMP-IND' CL*20 +01911 END-IF CL*11 +01912 END-IF. CL*11 +01913 CL*11 +01914 IF WRK-WRITE-X104-YES-88 OR WRK-SOL-LIABEST-DT-YES-88 CL*27 +01915 WRITE X104-REC FROM WRK-X104-REC CL*11 +01916 DISPLAY ' WRITING X104-REC' CL*18 +01917 END-IF. CL*19 +01918 CL*19 +01919 SET WRK-SELECT-SOL-NO-88 TO TRUE CL*19 +01920 SET WRK-WRITE-X104-NO-88 TO TRUE CL*19 +01921 SET WRK-SOL-INACT-DT-NO-88 TO TRUE CL*19 +01922 SET WRK-SOL-NEWEMP-IND-NO-88 TO TRUE CL*19 +01923 SET WRK-SOL-LIABEST-DT-NO-88 TO TRUE CL*19 +01924 SET WRK-STATUS-CHNG-NO-88 TO TRUE CL*49 +01925 MOVE SPACES TO WS-HOLD-INACT-DATE CL*37 +01926 WS-MLOG-INACT-DATE CL*22 +01927 WS-MLOG-EMP-IND CL*27 +01928 WS-HOLD-1-LIAB-DT CL*27 +01929 WS-HOLD-2-LIAB-DT CL*47 +01930 WRK-NEW-LIAB-DATE CL*69 +01931 WS-MSOL-EMP-IND. CL*47 +01932 P3200-EXIT. CL**5 +01933 EXIT. CL**5 +01934 CL**5 +01935 P3210-BUILD-X104. CL**5 +01936 CL*67 +01937 MOVE MSKL-REC TO MSOL-REC CL**4 +01938 MOVE WRK-EMP-NO TO X104-EMP-NO. CL251 +01939 SET X104-STAFF-REVIEW-NO-88 TO TRUE. CL**5 +01940 CL**5 +01941 EVALUATE TRUE CL**5 +01942 WHEN MSOL-LIAB-RATED-REG-88 CL**5 +01943 SET X104-ELIG-RATED-88 TO TRUE CL**5 +01944 CL**5 +01945 WHEN MSOL-LIAB-RATED-SUCC-88 CL**5 +01946 OR MSOL-LIAB-RATED-FUTA-88 CL**5 +01947 OR MSOL-LIAB-RATED-VOLUNT-88 CL**5 +01948 OR MSOL-LIAB-RATED-OTH-88 CL**5 +01949 OR MSOL-LIAB-RATED-CONV-88 CL**5 +01950 OR MSOL-LIAB-RATED-UNK-88 CL**5 +01951 SET MSOL-LIAB-RATED-REG-88 TO TRUE CL**5 +01952 SET X104-ELIG-RATED-88 TO TRUE CL**5 +01953 CL**5 +01954 WHEN MSOL-LIAB-RATED-DOMESTIC-88 CL**5 +01955 SET X104-ELIG-RATED-88 TO TRUE CL**5 +01956 CL**5 +01957 WHEN MSOL-LIAB-SELF-INS-OTH-88 CL**5 +01958 OR MSOL-LIAB-SELF-INS-CONV-88 CL**5 +01959 OR MSOL-LIAB-SELF-INS-UNK-88 CL**5 +01960 OR MSOL-LIAB-SELF-INS-VOLUNT-88 CL**5 +01961 SET MSOL-LIAB-SELF-INS-NON-PROF-88 TO TRUE CL**5 +01962 SET X104-ELIG-SELF-INS-88 TO TRUE CL**5 +01963 CL**5 +01964 WHEN MSOL-LIAB-SELF-INS-NON-PROF-88 CL**5 +01965 OR MSOL-LIAB-SELF-INS-SCHOOL-88 CL**5 +01966 OR MSOL-LIAB-SELF-INS-CITY-88 CL**5 +01967 OR MSOL-LIAB-SELF-INS-COUNTY-88 CL**5 +01968 OR MSOL-LIAB-SELF-INS-STATE-88 CL**5 +01969 OR MSOL-LIAB-SELF-INS-CHURCH-88 CL**5 +01970 SET X104-ELIG-SELF-INS-88 TO TRUE CL**5 +01971 END-EVALUATE. CL**5 +01972 CL**5 +01973 MOVE MSOL-LIAB-CD TO X104-LIAB-CD. CL**5 +01974 MOVE MSOL-INACT-CD TO X104-INACTIVE-CODE. CL225 +01975 MOVE MSOL-INACT-DATE TO X104-INACTIVE-DATE. CL250 +01976 MOVE MSOL-NEW-EMPLOYER-IND TO WS-MSOL-EMP-IND. CL*10 +01977 MOVE MPRF-NAICS-CD TO X104-NAICS-CD. CL**5 +01978 CL**5 +01979 IF X104-ELIG-SELF-INS-88 CL**5 +01980 IF NOT MPRF-ORG-CORPORATION-88 CL**5 +01981 DISPLAY 'P3210 SI/ORG INCONSISTENT ' WRK-EMP-NO CL*37 +01982 SET MPRF-ORG-CORPORATION-88 TO TRUE CL**5 +01983 END-IF CL**5 +01984 END-IF. CL**5 +01985 CL**5 +01986 MOVE MPRF-ORG-TYPE TO X104-ORG-TYPE. CL**5 +01987 CL**5 +01988 MOVE SPACES TO X104-HOUSEHOLD-FILING CL*67 +01989 CL**5 +01990 MOVE SPACES TO X104-INCORP-STATE CL**5 +01991 X104-INCORP-DATE. CL*39 +01992 CL*39 +01993 IF MSOL-LIAB-RATED-DOMESTIC-88 CL**5 +01994 MOVE SPACES TO X104-FIRST-WAGE-DT CL**5 +01995 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 CL**5 +01996 PERFORM S004-FROM-5 THRU S004-EXIT CL**5 +01997 MOVE L004-SLASH-5-QTR TO X104-FIRST-500-QTR CL**5 +01998 ELSE CL**5 +01999 MOVE SPACES TO X104-FIRST-500-QTR CL**5 +02000 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9 CL178 +02001 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL178 +02002 MOVE L001-SLASH-8-DATE TO X104-FIRST-WAGE-DT CL178 +02003 CL173 +02004 END-IF. CL173 +02005 CL*27 +02006 IF WRK-NEW-LIAB-DATE > SPACE CL*69 +02007 MOVE WRK-NEW-LIAB-DATE(1:6) TO X104-FIRST-WAGE-DT(1:6) CL*69 +02008 MOVE '20' TO X104-FIRST-WAGE-DT(7:2) CL*69 +02009 MOVE WRK-NEW-LIAB-DATE(7:2) TO X104-FIRST-WAGE-DT(9:2) CL*69 +02010 END-IF. CL*69 +02011 CL*69 +02012 * LOGIC TO HOLD LIAB-DT FOR EVERY SPAN CL*38 +02013 CL*38 +02014 IF MSOL-INACT-CD = 05 CL*31 +02015 NEXT SENTENCE CL*27 +02016 ELSE CL*27 +02017 MOVE X104-FIRST-WAGE-DT TO WS-HOLD-2-LIAB-DT CL*28 +02018 END-IF. CL*27 +02019 * CL*38 +02020 IF X104-INACTIVE-DATE(1:2) = '99' OR '00' CL159 +02021 MOVE '0000000000' TO X104-INACTIVE-DATE CL*10 +02022 MOVE SPACE TO X104-INACTIVE-CODE CL*10 +02023 ELSE CL**8 +02024 MOVE X104-INACTIVE-DATE TO WORK-HOLD-DATE1 CL**8 +02025 MOVE WORK-HOLD-DATE1(2:4) TO WRK-INACT-YYYY CL**8 +02026 MOVE WORK-HOLD-DATE1(6:2) TO WRK-INACT-MM CL**8 +02027 MOVE WORK-HOLD-DATE1(8:2) TO WRK-INACT-DD CL**8 +02028 MOVE WRK-INACT-SLASH-DT TO X104-INACTIVE-DATE CL**8 +02029 END-IF. CL123 +02030 CL123 +02031 MOVE WRK-ACQUIRED-IND TO X104-ACQUIRE-IND. CL**5 +02032 MOVE WRK-MERGER-SPLIT-IND TO X104-MERGER-SPLIT-IND. CL**5 +02033 MOVE WRK-REORG-IND TO X104-REORG-IND. CL**5 +02034 SET X104-COMMON-OWN-NO-88 TO TRUE. CL**5 +02035 SET X104-SALE-TRANSFER-NO-88 TO TRUE. CL**5 +02036 SET X104-NOT-LIAB-NULL-88 TO TRUE. CL**5 +02037 CL**5 +02038 IF MSOL-INACT-INACTIVE-88 CL241 +02039 IF MSOL-LAST-LIAB-YRQ > WRK-LAST-LIAB-YRQ CL241 +02040 MOVE MSOL-LAST-LIAB-YRQ TO WRK-LAST-LIAB-YRQ CL241 +02041 END-IF CL241 +02042 END-IF CL241 +02043 CL239 +02044 PERFORM S910D-READ-NEXT THRU S910D-EXIT. CL239 +02045 CL*62 +02046 P3210-EXIT. CL**5 +02047 EXIT. CL**5 +02048 CL**5 +02049 P3211-FILE-SCHED. CL**5 +02050 SET L410-MODE-INPUT-YRQ-88 TO TRUE CL**5 +02051 MOVE WRK-EMP-NO TO L410-EMP-NO CL**5 +02052 MOVE WRK-CURR-QTR TO L410-YRQ CL**5 +02053 PERFORM S410-FILE-SCHED THRU S410-EXIT CL**5 +02054 IF L410-ANN-SCHED-88 CL**5 +02055 SET X104-HH-ANNUAL-88 TO TRUE CL**5 +02056 ELSE CL**5 +02057 SET X104-HH-QUARTERLY-88 TO TRUE CL**5 +02058 END-IF. CL**5 +02059 CL**5 +02060 P3211-EXIT. CL**5 +02061 EXIT. CL**5 +02062 CL**5 +02063 P3400-RATE. CL**5 +02064 IF NOT MPRF-CLASS-RATED-88 CL**5 +02065 GO TO P3400-EXIT CL**5 +02066 ** ELSE CL131 +02067 ** IF WRK-SELECT-ALL-88 CL131 +02068 ** NEXT SENTENCE CL131 +02069 ** ELSE CL131 +02070 ** GO TO P3400-EXIT CL131 +02071 ** END-IF CL131 +02072 END-IF. CL**5 +02073 CL**5 +02074 MOVE LOW-VALUES TO MRTE-KEY-AREA. CL**5 +02075 MOVE WRK-EMP-NO TO MRTE-EMP-NO. CL**5 +02076 MOVE WRK-RATE-YRQ-2 TO MRTE-EFF-YRQ. CL**5 +02077 SET MRTE-RTE-88 TO TRUE. CL**5 +02078 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. CL**5 +02079 CL**5 +02080 PERFORM S910C-START-BROWSE THRU S910C-EXIT. CL**5 +02081 IF L910-NO-REC-88 CL**5 +02082 ** DISPLAY 'P3400 RATE MISSING ' MPRF-EMP-NO CL166 +02083 SET WRK-SELECT-NO-88 TO TRUE CL*17 +02084 ELSE CL**5 +02085 PERFORM UNTIL L910-NO-REC-88 CL**5 +02086 MOVE MSKL-REC TO MRTE-REC CL**5 +02087 ** IF WRK-SELECT-ALL-88 CL140 +02088 IF WRK-SELECT-RATE-YES-88 AND CL140 +02089 ** OR MRTE-ESTB-DATE >= WRK-PRIOR-RUN-DATE CL140 +02090 ** OR MRTE-CHNG-DATE >= WRK-PRIOR-RUN-DATE CL140 +02091 MRTE-ESTB-DATE >= WRK-PRIOR-RUN-DATE CL164 +02092 PERFORM P3410-WRITE-X108 THRU P3410-EXIT CL**5 +02093 END-IF CL**5 +02094 PERFORM S910D-READ-NEXT THRU S910D-EXIT CL**5 +02095 END-PERFORM CL**5 +02096 END-IF. CL**5 +02097 CL**5 +02098 P3400-EXIT. CL**5 +02099 EXIT. CL**5 +02100 CL**5 +02101 P3410-WRITE-X108. CL**5 +02102 MOVE WRK-EMP-NO TO X108-EMP-NO. CL**5 +02103 CL**5 +02104 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. CL**5 +02105 PERFORM S004-FROM-5 THRU S004-EXIT. CL**5 +02106 MOVE L004-SLASH-5-QTR TO X108-RATE-YEAR. CL**5 +02107 CL**5 +02108 COMPUTE MRTE-UI-RATE = (MRTE-UI-RATE * 100). CL**5 +02109 MOVE MRTE-UI-RATE TO X108-RATE. CL**5 +02110 DISPLAY 'WRK-EMP-NO ' WRK-EMP-NO CL129 +02111 DISPLAY 'X108-RATE ' X108-RATE CL129 +02112 WRITE X108-REC FROM WRK-X108-REC. CL165 +02113 ** WRITE EMPLOYER-TEMP-REC FROM WRK-X108-REC. CL165 +02114 ** IF TEMP-STATUS-OK-88 CL*14 +02115 ** ADD +1 TO WRK-TEMP-CNT CL*14 +02116 ** ELSE CL*14 +02117 ** DISPLAY 'CANNOT WRITE TEMP X108 ' WRK-EMP-NO CL*14 +02118 ** SET WRK-ERROR-YES-88 TO TRUE CL*14 +02119 ** END-IF. CL*14 +02120 CL**5 +02121 P3410-EXIT. CL**5 +02122 EXIT. CL**5 +02123 DTSSC432 +02124 P3600-REPORT. DTSSC432 +02125 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSSC432 +02126 MOVE WRK-EMP-NO TO MRPT-EMP-NO. DTSSC432 +02127 *** MOVE WRK-FIRST-RPT-QTR TO MRPT-YRQ. DTSSC432 +02128 SET MRPT-RPT-88 TO TRUE. DTSSC432 +02129 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +02130 DTSSC432 +02131 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +02132 PERFORM UNTIL L910-NO-REC-88 DTSSC432 +02133 MOVE MSKL-REC TO MRPT-REC DTSSC432 +02134 IF MRPT-ESTB-DATE > WRK-2-YEARS-AGO DTSSC432 +02135 IF NOT MRPT-ESTIM-88 DTSSC432 +02136 PERFORM P3620-RECENT-REPORT THRU P3620-EXIT DTSSC432 +02137 END-IF DTSSC432 +02138 END-IF DTSSC432 +02139 *** PERFORM P3610-WRITE-X140 THRU P3610-EXIT DTSSC432 +02140 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +02141 END-PERFORM DTSSC432 +02142 DTSSC432 +02143 PERFORM P3630-LAST-REPORT THRU P3630-EXIT. DTSSC432 +02144 DTSSC432 +02145 P3600-EXIT. DTSSC432 +02146 EXIT. DTSSC432 +02147 DTSSC432 +02148 *P3610-WRITE-X140. DTSSC432 +02149 * MOVE WRK-EMP-NO TO X140-EMP-NO. DTSSC432 +02150 * DTSSC432 +02151 * MOVE MRPT-YRQ TO L004-QTR-5-9. DTSSC432 +02152 * PERFORM S004-FROM-5 THRU S004-EXIT. DTSSC432 +02153 * MOVE L004-SLASH-5-QTR TO X140-QUARTER. DTSSC432 +02154 * DTSSC432 +02155 * MOVE MRPT-BATCH-NO TO X140-BATCH-NO. DTSSC432 +02156 * MOVE MRPT-ITEM-NO TO X140-ITEM-NO. DTSSC432 +02157 *** MOVE MRPT-RPT-TYPE TO X140-RPT-TYPE. DTSSC432 +02158 * MOVE MRPT-TOT-WAGE TO X140-TOTAL-WAGES. DTSSC432 +02159 * MOVE MRPT-TAX-WAGE TO X140-TAX-WAGES. DTSSC432 +02160 * MOVE MRPT-REMIT-AMT TO X140-REMITTANCE. DTSSC432 +02161 * MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSSC432 +02162 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +02163 * MOVE L001-SLASH-8-DATE TO X140-RCVD-DATE. DTSSC432 +02164 * MOVE MRPT-1ST-MTH-EMPL-CNT TO X140-WRKR-CNT-1ST-MNTH. DTSSC432 +02165 * MOVE MRPT-2ND-MTH-EMPL-CNT TO X140-WRKR-CNT-2ND-MNTH. DTSSC432 +02166 * MOVE MRPT-3RD-MTH-EMPL-CNT TO X140-WRKR-CNT-3RD-MNTH. DTSSC432 +02167 * DTSSC432 +02168 * WRITE EMPLOYER-TEMP-REC FROM WRK-X140-REC. DTSSC432 +02169 * IF TEMP-STATUS-OK-88 DTSSC432 +02170 * ADD +1 TO WRK-TEMP-CNT DTSSC432 +02171 * ELSE DTSSC432 +02172 * DISPLAY 'CANNOT WRITE TEMP X140 ' WRK-EMP-NO DTSSC432 +02173 * SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +02174 * END-IF. DTSSC432 +02175 * DTSSC432 +02176 *P3610-EXIT. DTSSC432 +02177 * EXIT. DTSSC432 +02178 * DTSSC432 +02179 P3620-RECENT-REPORT. DTSSC432 +02180 MOVE MRPT-YRQ TO L004-QTR-5-9. DTSSC432 +02181 PERFORM S004-FROM-5 THRU S004-EXIT. DTSSC432 +02182 MOVE L004-ABS-QTR TO RSUB. DTSSC432 +02183 DTSSC432 +02184 IF MRPT-ESTB-DATE > RPT-PROCESS-DATE (RSUB) DTSSC432 +02185 MOVE MRPT-YRQ TO RPT-YRQ (RSUB) DTSSC432 +02186 MOVE MRPT-RPT-TYPE TO RPT-TYPE (RSUB) DTSSC432 +02187 MOVE MRPT-RECEIVED-DATE TO RPT-RCVD-DATE (RSUB) DTSSC432 +02188 MOVE MRPT-ESTB-DATE TO RPT-PROCESS-DATE (RSUB) DTSSC432 +02189 END-IF. DTSSC432 +02190 DTSSC432 +02191 P3620-EXIT. DTSSC432 +02192 EXIT. DTSSC432 +02193 DTSSC432 +02194 P3630-LAST-REPORT. DTSSC432 +02195 PERFORM DTSSC432 +02196 VARYING RSUB FROM +1 BY +1 DTSSC432 +02197 UNTIL RSUB > RPT-MAX DTSSC432 +02198 IF RPT-PROCESS-DATE (RSUB) > MAX-RPT-DATE DTSSC432 +02199 IF RPT-TYPE (RSUB) NOT = 'WD' DTSSC432 +02200 MOVE RPT-YRQ (RSUB) TO MAX-RPT-YRQ DTSSC432 +02201 MOVE RPT-PROCESS-DATE (RSUB) TO MAX-RPT-DATE DTSSC432 +02202 MOVE RPT-TYPE (RSUB) TO MAX-RPT-TYPE DTSSC432 +02203 END-IF DTSSC432 +02204 END-IF DTSSC432 +02205 END-PERFORM. DTSSC432 +02206 DTSSC432 +02207 IF MAX-RPT-DATE NOT = ZERO DTSSC432 +02208 MOVE MPRF-EMP-NO TO X142-EMP-NO DTSSC432 +02209 MOVE SPACES TO X142-PAY-DATE DTSSC432 +02210 MOVE ZERO TO X142-PAY-AMT DTSSC432 +02211 MOVE MAX-RPT-YRQ TO L004-QTR-5-9 DTSSC432 +02212 MOVE L004-QTR-5-YR TO X142-REPORT-YEAR DTSSC432 +02213 MOVE L004-QTR-5-Q TO X142-REPORT-QTR DTSSC432 +02214 MOVE MAX-RPT-DATE TO L001-FED-8-DATE-9 DTSSC432 +02215 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSSC432 +02216 MOVE L001-SLASH-8-DATE TO X142-REPORT-DATE DTSSC432 +02217 IF MAX-RPT-TYPE = 'OR' DTSSC432 +02218 SET X142-RPT-TYPE-ORIG-88 TO TRUE DTSSC432 +02219 ELSE DTSSC432 +02220 SET X142-RPT-TYPE-AMND-88 TO TRUE DTSSC432 +02221 END-IF DTSSC432 +02222 IF X142-EMP-NO = 013794 DTSSC432 +02223 DISPLAY 'P3630 LAST RPT ' X142-EMP-NO DTSSC432 +02224 ' ' X142-REPORT-YEAR '/' X142-REPORT-QTR DTSSC432 +02225 ' ' X142-RPT-TYPE ' ' X142-REPORT-DATE DTSSC432 +02226 END-IF DTSSC432 +02227 END-IF. DTSSC432 +02228 DTSSC432 +02229 P3630-EXIT. DTSSC432 +02230 EXIT. DTSSC432 +02231 DTSSC432 +02232 DTSSC432 +02233 P3700-QTRS-DUE. DTSSC432 +02234 SET WRK-CURR-QTR-NO-88 TO TRUE. DTSSC432 +02235 SET WRK-PRIOR-QTR-NO-88 TO TRUE. DTSSC432 +02236 DTSSC432 +02237 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSSC432 +02238 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSSC432 +02239 SET MQTR-QTR-88 TO TRUE. DTSSC432 +02240 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +02241 DTSSC432 +02242 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +02243 PERFORM UNTIL L910-NO-REC-88 DTSSC432 +02244 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02245 IF WRK-SELECT-ALL-88 DTSSC432 +02246 OR MQTR-ESTB-DATE = WRK-PRIOR-RUN-DATE DTSSC432 +02247 OR MQTR-CHNG-DATE = WRK-PRIOR-RUN-DATE DTSSC432 +02248 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSSC432 +02249 PERFORM P3705-HOUSEHOLD THRU P3705-EXIT DTSSC432 +02250 ELSE DTSSC432 +02251 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSSC432 +02252 ** DISPLAY 'P3700 ' MPRF-EMP-NO ' ' MQTR-CHNG-DATE DTSSC432 +02253 END-IF DTSSC432 +02254 END-IF DTSSC432 +02255 IF L910-OK-88 DTSSC432 +02256 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +02257 END-IF DTSSC432 +02258 END-PERFORM. DTSSC432 +02259 DTSSC432 +02260 PERFORM P3720-CURR-QUARTERS THRU P3720-EXIT. DTSSC432 +02261 DTSSC432 +02262 P3700-EXIT. DTSSC432 +02263 EXIT. DTSSC432 +02264 DTSSC432 +02265 P3705-HOUSEHOLD. DTSSC432 +02266 ** DISPLAY 'ANNUAL ' MQTR-YRQ. DTSSC432 +02267 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSSC432 +02268 DTSSC432 +02269 MOVE 1 TO L004-QTR-5-Q. DTSSC432 +02270 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02271 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02272 IF L516-ANN-SCHED-88 DTSSC432 +02273 NEXT SENTENCE DTSSC432 +02274 ELSE DTSSC432 +02275 SET WRK-FILE-QTRLY-88 TO TRUE DTSSC432 +02276 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSSC432 +02277 END-IF. DTSSC432 +02278 DTSSC432 +02279 IF L516-LIABLE-88 DTSSC432 +02280 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02281 ELSE DTSSC432 +02282 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02283 END-IF. DTSSC432 +02284 DTSSC432 +02285 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02286 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02287 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02288 IF L910-OK-88 DTSSC432 +02289 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02290 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSSC432 +02291 END-IF. DTSSC432 +02292 DTSSC432 +02293 MOVE 2 TO L004-QTR-5-Q. DTSSC432 +02294 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02295 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02296 IF L516-LIABLE-88 DTSSC432 +02297 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02298 ELSE DTSSC432 +02299 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02300 END-IF. DTSSC432 +02301 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02302 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02303 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02304 IF L910-OK-88 DTSSC432 +02305 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02306 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSSC432 +02307 END-IF. DTSSC432 +02308 DTSSC432 +02309 MOVE 3 TO L004-QTR-5-Q. DTSSC432 +02310 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02311 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02312 IF L516-LIABLE-88 DTSSC432 +02313 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02314 ELSE DTSSC432 +02315 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02316 END-IF. DTSSC432 +02317 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02318 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02319 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02320 IF L910-OK-88 DTSSC432 +02321 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02322 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSSC432 +02323 END-IF. DTSSC432 +02324 DTSSC432 +02325 MOVE 4 TO L004-QTR-5-Q. DTSSC432 +02326 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02327 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02328 IF L516-LIABLE-88 DTSSC432 +02329 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02330 ELSE DTSSC432 +02331 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02332 END-IF. DTSSC432 +02333 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02334 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02335 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02336 IF L910-OK-88 DTSSC432 +02337 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02338 PERFORM P3710-WRITE-X141 THRU P3710-EXIT DTSSC432 +02339 END-IF. DTSSC432 +02340 DTSSC432 +02341 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02342 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +02343 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +02344 DTSSC432 +02345 P3705-EXIT. DTSSC432 +02346 EXIT. DTSSC432 +02347 DTSSC432 +02348 P3710-WRITE-X141. DTSSC432 +02349 MOVE ZERO TO WRK-TAX-BAL DTSSC432 +02350 WRK-SUR-BAL DTSSC432 +02351 WRK-INT-BAL DTSSC432 +02352 WRK-PEN-BAL. DTSSC432 +02353 DTSSC432 +02354 IF MQTR-YRQ = WRK-CURR-QTR DTSSC432 +02355 *** DISPLAY 'P3710 CURR ' MPRF-EMP-NO DTSSC432 +02356 SET WRK-CURR-QTR-YES-88 TO TRUE DTSSC432 +02357 END-IF. DTSSC432 +02358 IF MQTR-YRQ = WRK-PRIOR-QTR DTSSC432 +02359 *** DISPLAY 'P3710 PRIOR ' MPRF-EMP-NO DTSSC432 +02360 SET WRK-PRIOR-QTR-YES-88 TO TRUE DTSSC432 +02361 END-IF. DTSSC432 +02362 DTSSC432 +02363 MOVE MPRF-EMP-NO TO X141-EMP-NO. DTSSC432 +02364 DTSSC432 +02365 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSSC432 +02366 PERFORM S004-FROM-5 THRU S004-EXIT. DTSSC432 +02367 MOVE L004-SLASH-5-QTR TO X141-QUARTER. DTSSC432 +02368 DTSSC432 +02369 EVALUATE TRUE DTSSC432 +02370 WHEN MQTR-CURR-RCVD-88 DTSSC432 +02371 SET X141-QTR-RECEIVED-88 TO TRUE DTSSC432 +02372 DTSSC432 +02373 WHEN MQTR-CURR-MISSING-88 DTSSC432 +02374 SET X141-QTR-DELINQUENT-88 TO TRUE DTSSC432 +02375 DTSSC432 +02376 WHEN MQTR-CURR-NOT-LIABLE-88 DTSSC432 +02377 SET X141-QTR-NOT-LIABLE-88 TO TRUE DTSSC432 +02378 DTSSC432 +02379 WHEN OTHER DTSSC432 +02380 SET X141-QTR-CURRENT-88 TO TRUE DTSSC432 +02381 DTSSC432 +02382 END-EVALUATE. DTSSC432 +02383 DTSSC432 +02384 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSSC432 +02385 MOVE WRK-FILING-SCHED TO X141-FILING-SCHEDULE DTSSC432 +02386 ELSE DTSSC432 +02387 SET X141-FILE-QTRLY-88 TO TRUE DTSSC432 +02388 END-IF. DTSSC432 +02389 DTSSC432 +02390 IF MQTR-NO-UI-RATE-88 DTSSC432 +02391 MOVE ZERO TO X141-RATE DTSSC432 +02392 ELSE DTSSC432 +02393 COMPUTE WRK-UI-RATE = (MQTR-UI-RATE * 100) DTSSC432 +02394 MOVE WRK-UI-RATE TO X141-RATE DTSSC432 +02395 END-IF. DTSSC432 +02396 DTSSC432 +02397 *** MOVE MQTR-TOT-WAGE TO X141-TOTAL-WAGE. DTSSC432 +02398 *** MOVE MQTR-TAX-WAGE TO X141-TAX-WAGE. DTSSC432 +02399 DTSSC432 +02400 PERFORM P3711-BALANCES THRU P3711-EXIT. DTSSC432 +02401 DTSSC432 +02402 MOVE WRK-TAX-BAL TO X141-UI-TAX-BAL. DTSSC432 +02403 MOVE WRK-SUR-BAL TO X141-SUR-BAL. DTSSC432 +02404 MOVE WRK-INT-BAL TO X141-INT-BAL. DTSSC432 +02405 MOVE WRK-PEN-BAL TO X141-PEN-BAL. DTSSC432 +02406 DTSSC432 +02407 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSSC432 +02408 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +02409 MOVE L001-SLASH-8-DATE TO X141-REPORT-DUE-DATE. DTSSC432 +02410 DTSSC432 +02411 MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSSC432 +02412 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +02413 MOVE L001-SLASH-8-DATE TO X141-TAX-DUE-DATE. DTSSC432 +02414 DTSSC432 +02415 WRITE X141-REC FROM WRK-X141-REC. DTSSC432 +02416 IF X141-STATUS-OK-88 DTSSC432 +02417 ADD +1 TO X141-CNT DTSSC432 +02418 ELSE DTSSC432 +02419 DISPLAY 'CANNOT WRITE X141 ' MPRF-EMP-NO DTSSC432 +02420 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +02421 END-IF. DTSSC432 +02422 DTSSC432 +02423 P3710-EXIT. DTSSC432 +02424 EXIT. DTSSC432 +02425 DTSSC432 +02426 P3711-BALANCES. DTSSC432 +02427 IF MQTR-CURR-MISSING-88 DTSSC432 +02428 GO TO P3711-EXIT DTSSC432 +02429 END-IF. DTSSC432 +02430 DTSSC432 +02431 PERFORM DTSSC432 +02432 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSSC432 +02433 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSSC432 +02434 EVALUATE TRUE DTSSC432 +02435 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSSC432 +02436 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSSC432 +02437 TO WRK-TAX-BAL DTSSC432 +02438 DTSSC432 +02439 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSSC432 +02440 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSSC432 +02441 TO WRK-SUR-BAL DTSSC432 +02442 DTSSC432 +02443 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSSC432 +02444 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSSC432 +02445 TO WRK-PEN-BAL DTSSC432 +02446 DTSSC432 +02447 WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSSC432 +02448 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSSC432 +02449 TO WRK-PEN-BAL DTSSC432 +02450 DTSSC432 +02451 WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSSC432 +02452 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSSC432 +02453 TO WRK-PEN-BAL DTSSC432 +02454 DTSSC432 +02455 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSSC432 +02456 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSSC432 +02457 TO WRK-INT-BAL DTSSC432 +02458 DTSSC432 +02459 END-EVALUATE DTSSC432 +02460 END-PERFORM. DTSSC432 +02461 DTSSC432 +02462 P3711-EXIT. DTSSC432 +02463 EXIT. DTSSC432 +02464 DTSSC432 +02465 P3720-CURR-QUARTERS. DTSSC432 +02466 IF WRK-PRIOR-QTR-NO-88 DTSSC432 +02467 MOVE WRK-PRIOR-QTR TO L516-YRQ DTSSC432 +02468 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02469 IF L516-LIABLE-88 DTSSC432 +02470 ** DISPLAY 'P3720 BUILD PRIOR ' MPRF-EMP-NO DTSSC432 +02471 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSSC432 +02472 PERFORM P3722-BUILD-HH THRU P3722-EXIT DTSSC432 +02473 ELSE DTSSC432 +02474 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSSC432 +02475 END-IF DTSSC432 +02476 END-IF DTSSC432 +02477 END-IF. DTSSC432 +02478 DTSSC432 +02479 IF MPRF-STATUS-INACT-88 DTSSC432 +02480 IF WRK-INACT-DATE > WRK-CURR-QTR-START DTSSC432 +02481 AND WRK-INACT-ENTR-DATE = WRK-PRIOR-RUN-DATE DTSSC432 +02482 IF WRK-CURR-QTR-NO-88 DTSSC432 +02483 MOVE WRK-CURR-QTR TO L516-YRQ DTSSC432 +02484 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02485 IF L516-LIABLE-88 DTSSC432 +02486 ** DISPLAY 'P3720 BUILD CURR ' MPRF-EMP-NO DTSSC432 +02487 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSSC432 +02488 END-IF DTSSC432 +02489 END-IF DTSSC432 +02490 END-IF DTSSC432 +02491 END-IF. DTSSC432 +02492 DTSSC432 +02493 P3720-EXIT. DTSSC432 +02494 EXIT. DTSSC432 +02495 DTSSC432 +02496 P3721-BUILD-QTR. DTSSC432 +02497 MOVE MPRF-EMP-NO TO X141-EMP-NO. DTSSC432 +02498 DTSSC432 +02499 MOVE L516-YRQ TO L004-QTR-5-9. DTSSC432 +02500 PERFORM S004-FROM-5 THRU S004-EXIT. DTSSC432 +02501 MOVE L004-SLASH-5-QTR TO X141-QUARTER. DTSSC432 +02502 DTSSC432 +02503 SET X141-QTR-CURRENT-88 TO TRUE. DTSSC432 +02504 DTSSC432 +02505 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSSC432 +02506 MOVE WRK-FILING-SCHED TO X141-FILING-SCHEDULE DTSSC432 +02507 ELSE DTSSC432 +02508 SET X141-FILE-QTRLY-88 TO TRUE DTSSC432 +02509 END-IF. DTSSC432 +02510 DTSSC432 +02511 MOVE ZERO TO X141-UI-TAX-BAL DTSSC432 +02512 X141-SUR-BAL DTSSC432 +02513 X141-INT-BAL DTSSC432 +02514 X141-PEN-BAL. DTSSC432 +02515 DTSSC432 +02516 IF MQTR-NO-UI-RATE-88 DTSSC432 +02517 MOVE ZERO TO X141-RATE DTSSC432 +02518 ELSE DTSSC432 +02519 COMPUTE WRK-UI-RATE = (MQTR-UI-RATE * 100) DTSSC432 +02520 MOVE WRK-UI-RATE TO X141-RATE DTSSC432 +02521 END-IF. DTSSC432 +02522 DTSSC432 +02523 MOVE L516-DEFAULT-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSSC432 +02524 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +02525 MOVE L001-SLASH-8-DATE TO X141-REPORT-DUE-DATE. DTSSC432 +02526 DTSSC432 +02527 MOVE L516-DEFAULT-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSSC432 +02528 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +02529 MOVE L001-SLASH-8-DATE TO X141-TAX-DUE-DATE. DTSSC432 +02530 DTSSC432 +02531 WRITE X141-REC FROM WRK-X141-REC. DTSSC432 +02532 IF X141-STATUS-OK-88 DTSSC432 +02533 ADD +1 TO X141-CNT DTSSC432 +02534 ELSE DTSSC432 +02535 DISPLAY 'CANNOT WRITE X141 ' MPRF-EMP-NO DTSSC432 +02536 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +02537 END-IF. DTSSC432 +02538 DTSSC432 +02539 P3721-EXIT. DTSSC432 +02540 EXIT. DTSSC432 +02541 DTSSC432 +02542 P3722-BUILD-HH. DTSSC432 +02543 MOVE L516-DEFAULT-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSSC432 +02544 MOVE 01 TO L001-FED-8-MO. DTSSC432 +02545 MOVE 01 TO L001-FED-8-DA. DTSSC432 +02546 IF WRK-CURR-RUN-DATE < L001-FED-8-DATE-9 DTSSC432 +02547 ** REPORT CAN NOT YET BE FILED ** DTSSC432 +02548 GO TO P3722-EXIT DTSSC432 +02549 END-IF. DTSSC432 +02550 DTSSC432 +02551 MOVE L516-YRQ TO L004-QTR-5-9 DTSSC432 +02552 DTSSC432 +02553 MOVE 1 TO L004-QTR-5-Q. DTSSC432 +02554 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02555 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02556 IF L516-ANN-SCHED-88 DTSSC432 +02557 NEXT SENTENCE DTSSC432 +02558 ELSE DTSSC432 +02559 SET WRK-FILE-QTRLY-88 TO TRUE DTSSC432 +02560 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSSC432 +02561 END-IF. DTSSC432 +02562 DTSSC432 +02563 IF L516-LIABLE-88 DTSSC432 +02564 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02565 ELSE DTSSC432 +02566 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02567 END-IF. DTSSC432 +02568 DTSSC432 +02569 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02570 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02571 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02572 IF L910-OK-88 DTSSC432 +02573 NEXT SENTENCE DTSSC432 +02574 ELSE DTSSC432 +02575 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02576 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSSC432 +02577 END-IF. DTSSC432 +02578 DTSSC432 +02579 MOVE 2 TO L004-QTR-5-Q. DTSSC432 +02580 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02581 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02582 IF L516-LIABLE-88 DTSSC432 +02583 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02584 ELSE DTSSC432 +02585 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02586 END-IF. DTSSC432 +02587 DTSSC432 +02588 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02589 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02590 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02591 IF L910-OK-88 DTSSC432 +02592 NEXT SENTENCE DTSSC432 +02593 ELSE DTSSC432 +02594 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02595 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSSC432 +02596 END-IF. DTSSC432 +02597 DTSSC432 +02598 MOVE 3 TO L004-QTR-5-Q. DTSSC432 +02599 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02600 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02601 IF L516-LIABLE-88 DTSSC432 +02602 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02603 ELSE DTSSC432 +02604 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02605 END-IF. DTSSC432 +02606 DTSSC432 +02607 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02608 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02609 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02610 IF L910-OK-88 DTSSC432 +02611 NEXT SENTENCE DTSSC432 +02612 ELSE DTSSC432 +02613 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02614 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSSC432 +02615 END-IF. DTSSC432 +02616 DTSSC432 +02617 MOVE 4 TO L004-QTR-5-Q. DTSSC432 +02618 MOVE L004-QTR-5-9 TO L516-YRQ DTSSC432 +02619 PERFORM S516-LIABILITY THRU S516-EXIT DTSSC432 +02620 IF L516-LIABLE-88 DTSSC432 +02621 SET WRK-FILE-ANN-LIAB-88 TO TRUE DTSSC432 +02622 ELSE DTSSC432 +02623 SET WRK-FILE-ANN-NOT-LIAB-88 TO TRUE DTSSC432 +02624 END-IF. DTSSC432 +02625 DTSSC432 +02626 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSSC432 +02627 MOVE MQTR-REC TO MSKL-REC. DTSSC432 +02628 PERFORM S910B-READ THRU S910B-EXIT. DTSSC432 +02629 IF L910-OK-88 DTSSC432 +02630 NEXT SENTENCE DTSSC432 +02631 ELSE DTSSC432 +02632 MOVE MSKL-REC TO MQTR-REC DTSSC432 +02633 PERFORM P3721-BUILD-QTR THRU P3721-EXIT DTSSC432 +02634 END-IF. DTSSC432 +02635 DTSSC432 +02636 P3722-EXIT. DTSSC432 +02637 EXIT. DTSSC432 +02638 DTSSC432 +02639 P3800-PAYMENT. DTSSC432 +02640 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSSC432 +02641 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSSC432 +02642 SET MPAY-PAY-88 TO TRUE. DTSSC432 +02643 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSSC432 +02644 DTSSC432 +02645 PERFORM S910C-START-BROWSE THRU S910C-EXIT. DTSSC432 +02646 PERFORM UNTIL L910-NO-REC-88 DTSSC432 +02647 MOVE MSKL-REC TO MPAY-REC DTSSC432 +02648 IF MPAY-ESTB-DATE > WRK-2-YEARS-AGO DTSSC432 +02649 PERFORM P3820-RECENT-PAYMENT THRU P3820-EXIT DTSSC432 +02650 END-IF DTSSC432 +02651 IF MPAY-TRACE-NO NOT = ZERO DTSSC432 +02652 IF MPAY-ESTB-DATE = WRK-PRIOR-RUN-DATE DTSSC432 +02653 PERFORM P3810-WRITE-X145 THRU P3810-EXIT DTSSC432 +02654 END-IF DTSSC432 +02655 END-IF DTSSC432 +02656 IF L910-OK-88 DTSSC432 +02657 PERFORM S910D-READ-NEXT THRU S910D-EXIT DTSSC432 +02658 END-IF DTSSC432 +02659 END-PERFORM. DTSSC432 +02660 DTSSC432 +02661 IF PAY-LAST > ZERO DTSSC432 +02662 PERFORM P3830-UPDATE-X142 THRU P3830-EXIT DTSSC432 +02663 END-IF. DTSSC432 +02664 DTSSC432 +02665 P3800-EXIT. DTSSC432 +02666 EXIT. DTSSC432 +02667 DTSSC432 +02668 P3810-WRITE-X145. DTSSC432 +02669 MOVE MPRF-EMP-NO TO X145-EMP-NO. DTSSC432 +02670 DTSSC432 +02671 MOVE MPAY-PAY-TYPE TO X145-PAY-TYPE. DTSSC432 +02672 DTSSC432 +02673 IF MPAY-APPLIC-YRQ = ZEROS DTSSC432 +02674 MOVE SPACES TO X145-QTR DTSSC432 +02675 ELSE DTSSC432 +02676 MOVE MPAY-APPLIC-YRQ TO L004-QTR-5-9 DTSSC432 +02677 PERFORM S004-FROM-5 THRU S004-EXIT DTSSC432 +02678 MOVE L004-SLASH-5-QTR TO X145-QTR DTSSC432 +02679 END-IF. DTSSC432 +02680 DTSSC432 +02681 MOVE MPAY-REMIT-AMT TO X145-REMITTANCE. DTSSC432 +02682 DTSSC432 +02683 MOVE MPAY-TRACE-NO TO WRK-TRACE-NO. DTSSC432 +02684 MOVE WRK-TRACE-NO-X TO X145-TRACE-NO. DTSSC432 +02685 DTSSC432 +02686 MOVE MPAY-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSSC432 +02687 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +02688 MOVE L001-SLASH-8-DATE TO X145-RCVD-DATE. DTSSC432 +02689 DTSSC432 +02690 MOVE MPAY-ESTB-DATE TO L001-FED-8-DATE-9. DTSSC432 +02691 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSSC432 +02692 ** MOVE L001-SLASH-8-DATE TO X145-PROCESS-DATE. CL**4 +02693 DTSSC432 +02694 WRITE X145-REC FROM WRK-X145-REC. DTSSC432 +02695 IF X145-STATUS-OK-88 DTSSC432 +02696 ADD +1 TO X145-CNT DTSSC432 +02697 ELSE DTSSC432 +02698 DISPLAY 'CANNOT WRITE X145 ' MPRF-EMP-NO DTSSC432 +02699 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +02700 END-IF. DTSSC432 +02701 DTSSC432 +02702 P3810-EXIT. DTSSC432 +02703 EXIT. DTSSC432 +02704 DTSSC432 +02705 P3820-RECENT-PAYMENT. DTSSC432 +02706 IF MPAY-APPLIC-BATCH-NO = ZERO DTSSC432 +02707 AND MPAY-PAYMENT-88 DTSSC432 +02708 PERFORM P3821-PAYMENTS THRU P3821-EXIT DTSSC432 +02709 ELSE DTSSC432 +02710 PERFORM P3822-ADJUSTMENTS THRU P3822-EXIT DTSSC432 +02711 END-IF. DTSSC432 +02712 DTSSC432 +02713 P3820-EXIT. DTSSC432 +02714 EXIT. DTSSC432 +02715 DTSSC432 +02716 P3821-PAYMENTS. DTSSC432 +02717 IF PAY-LAST < PAY-MAX DTSSC432 +02718 ADD +1 TO PAY-LAST DTSSC432 +02719 MOVE PAY-LAST TO PSUB DTSSC432 +02720 ELSE DTSSC432 +02721 DISPLAY 'P3821 PAY TABLE LENGTH EXCEEDED' DTSSC432 +02722 GO TO P3821-EXIT DTSSC432 +02723 END-IF. DTSSC432 +02724 DTSSC432 +02725 MOVE MPAY-BATCH-NO TO PAY-BATCH (PSUB). DTSSC432 +02726 MOVE MPAY-ITEM-NO TO PAY-ITEM (PSUB). DTSSC432 +02727 MOVE MPAY-ESTB-DATE TO PAY-PROCESS-DATE (PSUB). DTSSC432 +02728 MOVE MPAY-RECEIVED-DATE TO PAY-RCVD-DATE (PSUB). DTSSC432 +02729 MOVE MPAY-REMIT-AMT TO PAY-ORIG-AMT (PSUB) DTSSC432 +02730 PAY-ADJ-AMT (PSUB). DTSSC432 +02731 DTSSC432 +02732 P3821-EXIT. DTSSC432 +02733 EXIT. DTSSC432 +02734 DTSSC432 +02735 P3822-ADJUSTMENTS. DTSSC432 +02736 IF MPAY-EMP-NO = 013794 DTSSC432 +02737 DISPLAY 'P3821 ' MPAY-ESTB-DATE DTSSC432 +02738 ' ' MPAY-REMIT-AMT DTSSC432 +02739 END-IF. DTSSC432 +02740 PERFORM DTSSC432 +02741 VARYING PSUB FROM +1 BY +1 DTSSC432 +02742 UNTIL PSUB > PAY-LAST DTSSC432 +02743 IF MPAY-APPLIC-BATCH-NO = PAY-BATCH (PSUB) DTSSC432 +02744 AND MPAY-APPLIC-ITEM-NO = PAY-ITEM (PSUB) DTSSC432 +02745 ADD MPAY-REMIT-AMT TO PAY-ADJ-AMT (PSUB) DTSSC432 +02746 END-IF DTSSC432 +02747 END-PERFORM. DTSSC432 +02748 DTSSC432 +02749 P3822-EXIT. DTSSC432 +02750 EXIT. DTSSC432 +02751 DTSSC432 +02752 P3830-UPDATE-X142. DTSSC432 +02753 PERFORM DTSSC432 +02754 VARYING PSUB FROM +1 BY +1 DTSSC432 +02755 UNTIL PSUB > PAY-LAST DTSSC432 +02756 IF PAY-ADJ-AMT (PSUB) > ZERO DTSSC432 +02757 IF PAY-PROCESS-DATE (PSUB) > MAX-PAY-DATE DTSSC432 +02758 MOVE PAY-PROCESS-DATE (PSUB) TO MAX-PAY-DATE DTSSC432 +02759 END-IF DTSSC432 +02760 END-IF DTSSC432 +02761 END-PERFORM. DTSSC432 +02762 DTSSC432 +02763 IF MAX-PAY-DATE NOT = ZERO DTSSC432 +02764 PERFORM DTSSC432 +02765 VARYING PSUB FROM +1 BY +1 DTSSC432 +02766 UNTIL PSUB > PAY-LAST DTSSC432 +02767 IF PAY-PROCESS-DATE (PSUB) = MAX-PAY-DATE DTSSC432 +02768 ADD PAY-ADJ-AMT (PSUB) TO MAX-PAY-AMT DTSSC432 +02769 END-IF DTSSC432 +02770 END-PERFORM DTSSC432 +02771 MOVE MPRF-EMP-NO TO X142-EMP-NO DTSSC432 +02772 MOVE MAX-PAY-DATE TO L001-FED-8-DATE-9 DTSSC432 +02773 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSSC432 +02774 MOVE L001-SLASH-8-DATE TO X142-PAY-DATE DTSSC432 +02775 MOVE MAX-PAY-AMT TO X142-PAY-AMT DTSSC432 +02776 END-IF. DTSSC432 +02777 DTSSC432 +02778 P3830-EXIT. DTSSC432 +02779 EXIT. DTSSC432 +02780 DTSSC432 +02781 DTSSC432 +02782 T0000-TERMINATE. DTSSC432 +02783 DTSSC432 +02784 DISPLAY '*********************************************'. DTSSC432 +02785 DISPLAY '* DTSBX410 TERMINATION STATISTICS'. DTSSC432 +02786 DISPLAY '* '. DTSSC432 +02787 DISPLAY '* MPRF RECORDS READ : ' DTSSC432 +02788 WRK-MPRF-CNT. DTSSC432 +02789 DISPLAY '* X101 RECORDS READ : ' DTSSC432 +02790 X101-CNT. DTSSC432 +02791 DISPLAY '* EMPLOYERS SELECTED : ' DTSSC432 +02792 WRK-SELECTED-CNT. DTSSC432 +02793 DISPLAY '* PROFILE RECORDS WRITTEN : ' DTSSC432 +02794 X102-CNT. DTSSC432 +02795 DISPLAY '* DETERMINATION RECS WRITTEN : ' CL**6 +02796 X104-CNT. CL**6 +02797 DISPLAY '* NAME RECORDS WRITTEN : ' DTSSC432 +02798 X106-CNT. DTSSC432 +02799 DISPLAY '* EMP ADDRESS RECS WRITTEN : ' DTSSC432 +02800 X110-CNT. DTSSC432 +02801 DISPLAY '* EMP RATE RECS WRITTEN : ' CL**6 +02802 X108-CNT. CL**6 +02803 DISPLAY '* OPO RECORDS WRITTEN : ' DTSSC432 +02804 X120-CNT. DTSSC432 +02805 ** DISPLAY '* REL RECORDS WRITTEN : ' DTSSC432 +02806 ** X131-CNT. DTSSC432 +02807 ** DISPLAY '* REPORT RECORDS WRITTEN : ' DTSSC432 +02808 ** X140-CNT. DTSSC432 +02809 DISPLAY '* QTR STATUS RECS WRITTEN : ' DTSSC432 +02810 X141-CNT. DTSSC432 +02811 DISPLAY '* RCNT RPT-PAY RECS WRITTEN : ' DTSSC432 +02812 X142-CNT. DTSSC432 +02813 ** DISPLAY '* PAYMENT RECORDS WRITTEN : ' DTSSC432 +02814 ** X145-CNT. DTSSC432 +02815 DISPLAY '*********************************************'. DTSSC432 +02816 DTSSC432 +02817 DTSSC432 +02818 CLOSE X100-REF-FILE DTSSC432 +02819 X102-PRF-FILE DTSSC432 +02820 X104-DETERM-FILE CL**6 +02821 X106-NAME-FILE DTSSC432 +02822 X110-ADDR-FILE DTSSC432 +02823 X108-RATE-FILE CL**6 +02824 X120-OPO-FILE CL**6 +02825 ** X131-REL-FILE DTSSC432 +02826 ** X140-REPORT-FILE DTSSC432 +02827 X141-QTR-STATUS-FILE DTSSC432 +02828 X142-LAST-RPT-PAY-FILE DTSSC432 +02829 X145-PAYMENT-FILE. DTSSC432 +02830 DTSSC432 +02831 PERFORM S910G-CLOSE THRU S910G-EXIT. DTSSC432 +02832 PERFORM S921-CLOSE THRU S921-EXIT. DTSSC432 +02833 PERFORM S931D-CLOSE THRU S931D-EXIT. DTSSC432 +02834 DTSSC432 +02835 T0000-EXIT. DTSSC432 +02836 EXIT. DTSSC432 +02837 DTSSC432 +02838 S001-FROM-FED-8. DTSSC432 +02839 SET L001-FROM-FED-8 TO TRUE. DTSSC432 +02840 GO TO S001-DATE. DTSSC432 +02841 DTSSC432 +02842 S001-FROM-ABS-DAY. DTSSC432 +02843 SET L001-FROM-ABS-DAY TO TRUE. DTSSC432 +02844 GO TO S001-DATE. DTSSC432 +02845 DTSSC432 +02846 S001-DATE. DTSSC432 +02847 CALL 'DTSBU001' USING L001-LINK-AREA. DTSSC432 +02848 S001-EXIT. DTSSC432 +02849 EXIT. DTSSC432 +02850 DTSSC432 +02851 S003-AGENCY-DAY. DTSSC432 +02852 SET L003-AGENCY-DAY TO TRUE. DTSSC432 +02853 GO TO S003-WORK-DAY. DTSSC432 +02854 DTSSC432 +02855 S003-WORK-DAY. DTSSC432 +02856 CALL 'DTSBU003' USING L003-LINK-AREA. DTSSC432 +02857 S003-EXIT. DTSSC432 +02858 EXIT. DTSSC432 +02859 DTSSC432 +02860 S004-FROM-DATE. DTSSC432 +02861 SET L004-FROM-DATE TO TRUE. DTSSC432 +02862 GO TO S004-QTR. DTSSC432 +02863 DTSSC432 +02864 S004-FROM-5. DTSSC432 +02865 SET L004-FROM-5 TO TRUE. DTSSC432 +02866 GO TO S004-QTR. DTSSC432 +02867 DTSSC432 +02868 S004-FROM-ABS. DTSSC432 +02869 SET L004-FROM-ABS TO TRUE. DTSSC432 +02870 GO TO S004-QTR. DTSSC432 +02871 DTSSC432 +02872 S004-FROM-3. DTSSC432 +02873 SET L004-FROM-3 TO TRUE. DTSSC432 +02874 GO TO S004-QTR. DTSSC432 +02875 DTSSC432 +02876 S004-QTR. DTSSC432 +02877 CALL 'DTSBU004' USING L004-LINK-AREA. DTSSC432 +02878 S004-EXIT. DTSSC432 +02879 EXIT. DTSSC432 +02880 DTSSC432 +02881 S005-SYS-DATE. DTSSC432 +02882 CALL 'DTSBU005' USING L005-LINK-AREA. DTSSC432 +02883 DTSSC432 +02884 S005-EXIT. DTSSC432 +02885 EXIT. DTSSC432 +02886 DTSSC432 +02887 S101-PER-MONTH-NO. DTSSC432 +02888 SET L101-PER-MONTH-NO-88 TO TRUE. DTSSC432 +02889 GO TO S101-INT-CHARGE. DTSSC432 +02890 DTSSC432 +02891 S101-INT-CHARGE. DTSSC432 +02892 CALL 'DTSBU101' USING L101-LINK-AREA. DTSSC432 +02893 S101-EXIT. DTSSC432 +02894 EXIT. DTSSC432 +02895 DTSSC432 +02896 S109-SUR-BY-QTR. DTSSC432 +02897 SET L109-CLASS-SELF-INS-88 TO TRUE. DTSSC432 +02898 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSSC432 +02899 CALL 'DTSBU109' USING L109-LINK-AREA. DTSSC432 +02900 DTSSC432 +02901 S109-QTR-EXIT. DTSSC432 +02902 EXIT. DTSSC432 +02903 DTSSC432 +02904 S410-FILE-SCHED. DTSSC432 +02905 CALL 'DTSBU410' USING L410-LINK-AREA. DTSSC432 +02906 S410-EXIT. DTSSC432 +02907 EXIT. DTSSC432 +02908 DTSSC432 +02909 S516-LIABILITY. DTSSC432 +02910 CALL 'DTSBU516' USING L516-LINK-AREA DTSSC432 +02911 MPRF-REC. DTSSC432 +02912 S516-EXIT. DTSSC432 +02913 EXIT. DTSSC432 +02914 DTSSC432 +02915 S910A-OPEN-READ. DTSSC432 +02916 SET L910-OPEN-READ-88 TO TRUE. DTSSC432 +02917 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSSC432 +02918 DTSSC432 +02919 S910A-EXIT. DTSSC432 +02920 EXIT. DTSSC432 +02921 DTSSC432 +02922 S910B-READ. DTSSC432 +02923 SET L910-READ-88 TO TRUE. DTSSC432 +02924 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSSC432 +02925 DTSSC432 +02926 S910B-EXIT. DTSSC432 +02927 EXIT. DTSSC432 +02928 DTSSC432 +02929 S910C-START-BROWSE. DTSSC432 +02930 SET L910-START-BROWSE-88 TO TRUE. DTSSC432 +02931 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSSC432 +02932 DTSSC432 +02933 S910C-EXIT. DTSSC432 +02934 EXIT. DTSSC432 +02935 DTSSC432 +02936 S910D-READ-NEXT. DTSSC432 +02937 SET L910-READ-NEXT-88 TO TRUE. DTSSC432 +02938 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSSC432 +02939 IF L910-OK-88 DTSSC432 +02940 IF MSKL-PRF-88 DTSSC432 +02941 ADD +1 TO WRK-MPRF-CNT DTSSC432 +02942 END-IF DTSSC432 +02943 END-IF. DTSSC432 +02944 DTSSC432 +02945 S910D-EXIT. DTSSC432 +02946 EXIT. DTSSC432 +02947 DTSSC432 +02948 S910E-COUNT. DTSSC432 +02949 SET L910-COUNT-88 TO TRUE. DTSSC432 +02950 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSSC432 +02951 DTSSC432 +02952 S910E-EXIT. DTSSC432 +02953 EXIT. DTSSC432 +02954 DTSSC432 +02955 S910F-REWRITE. DTSSC432 +02956 SET L910-REWRITE-88 TO TRUE. DTSSC432 +02957 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSSC432 +02958 DTSSC432 +02959 S910F-EXIT. DTSSC432 +02960 EXIT. DTSSC432 +02961 DTSSC432 +02962 S910G-CLOSE. DTSSC432 +02963 SET L910-CLOSE-88 TO TRUE. DTSSC432 +02964 PERFORM S910Z-MSTR-IO THRU S910Z-EXIT. DTSSC432 +02965 DTSSC432 +02966 S910G-EXIT. DTSSC432 +02967 EXIT. DTSSC432 +02968 DTSSC432 +02969 S910Z-MSTR-IO. DTSSC432 +02970 CALL 'DTSBU910' USING L910-LINK-AREA DTSSC432 +02971 MSKL-REC. DTSSC432 +02972 S910Z-EXIT. DTSSC432 +02973 EXIT. DTSSC432 +02974 DTSSC432 +02975 S921-OPEN-READ. DTSSC432 +02976 SET L921-OPEN-READ-88 TO TRUE. DTSSC432 +02977 GO TO S921-AIX-IO. DTSSC432 +02978 DTSSC432 +02979 S921-START-BROWSE. DTSSC432 +02980 SET L921-START-BROWSE-88 TO TRUE. DTSSC432 +02981 GO TO S921-AIX-IO. DTSSC432 +02982 DTSSC432 +02983 S921-READ-NEXT. DTSSC432 +02984 SET L921-READ-NEXT-88 TO TRUE. DTSSC432 +02985 GO TO S921-AIX-IO. DTSSC432 +02986 DTSSC432 +02987 S921-CLOSE. DTSSC432 +02988 SET L921-CLOSE-88 TO TRUE. DTSSC432 +02989 GO TO S921-AIX-IO. DTSSC432 +02990 DTSSC432 +02991 S921-AIX-IO. DTSSC432 +02992 CALL 'DTSBU921' DTSSC432 +02993 USING L921-LINK-AREA DTSSC432 +02994 ISKL-REC. DTSSC432 +02995 DTSSC432 +02996 S921-EXIT. EXIT. DTSSC432 +02997 DTSSC432 +02998 S931A-OPEN-READ. DTSSC432 +02999 SET L931-OPEN-READ-88 TO TRUE. DTSSC432 +03000 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSSC432 +03001 DTSSC432 +03002 S931A-EXIT. DTSSC432 +03003 EXIT. DTSSC432 +03004 DTSSC432 +03005 S931B-START-BROWSE. DTSSC432 +03006 SET L931-START-BROWSE-88 TO TRUE. DTSSC432 +03007 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSSC432 +03008 DTSSC432 +03009 S931B-EXIT. DTSSC432 +03010 EXIT. DTSSC432 +03011 DTSSC432 +03012 S931C-READ-NEXT. DTSSC432 +03013 SET L931-READ-NEXT-88 TO TRUE. DTSSC432 +03014 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSSC432 +03015 DTSSC432 +03016 S931C-EXIT. DTSSC432 +03017 EXIT. DTSSC432 +03018 DTSSC432 +03019 S931D-CLOSE. DTSSC432 +03020 SET L931-CLOSE-88 TO TRUE. DTSSC432 +03021 PERFORM S931Z-REF-IO THRU S931Z-EXIT. DTSSC432 +03022 DTSSC432 +03023 S931D-EXIT. DTSSC432 +03024 EXIT. DTSSC432 +03025 DTSSC432 +03026 S931Z-REF-IO. DTSSC432 +03027 CALL 'DTSBU931' USING L931-LINK-AREA DTSSC432 +03028 FSKL-REC. DTSSC432 +03029 S931Z-EXIT. EXIT. DTSSC432 +03030 DTSSC432 +03031 S981A-OPEN-READ. DTSSC432 +03032 SET L981-OPEN-READ-88 TO TRUE. DTSSC432 +03033 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSSC432 +03034 DTSSC432 +03035 S981A-EXIT. DTSSC432 +03036 EXIT. DTSSC432 +03037 DTSSC432 +03038 S981C-CLOSE. DTSSC432 +03039 SET L981-CLOSE-88 TO TRUE. DTSSC432 +03040 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSSC432 +03041 DTSSC432 +03042 S981C-EXIT. DTSSC432 +03043 EXIT. DTSSC432 +03044 DTSSC432 +03045 S981D-START-BROWSE. DTSSC432 +03046 SET L981-START-BROWSE-88 TO TRUE. DTSSC432 +03047 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSSC432 +03048 DTSSC432 +03049 S981D-EXIT. DTSSC432 +03050 EXIT. DTSSC432 +03051 DTSSC432 +03052 S981E-READ-NEXT. DTSSC432 +03053 SET L981-READ-NEXT-88 TO TRUE. DTSSC432 +03054 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSSC432 +03055 DTSSC432 +03056 S981E-EXIT. DTSSC432 +03057 EXIT. DTSSC432 +03058 DTSSC432 +03059 S981Z-WAGE-I. DTSSC432 +03060 CALL 'DTSBU981' USING L981-LINK-AREA DTSSC432 +03061 WWGH-REC. DTSSC432 +03062 S981Z-EXIT. DTSSC432 +03063 EXIT. DTSSC432 +03064 DTSSC432 +03065 S982A-START-BROWSE. DTSSC432 +03066 SET L982-START-BROWSE-88 TO TRUE. DTSSC432 +03067 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSSC432 +03068 DTSSC432 +03069 S982A-EXIT. DTSSC432 +03070 EXIT. DTSSC432 +03071 DTSSC432 +03072 S982C-OPEN-READ. DTSSC432 +03073 SET L982-OPEN-READ-88 TO TRUE. DTSSC432 +03074 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSSC432 +03075 DTSSC432 +03076 S982C-EXIT. DTSSC432 +03077 EXIT. DTSSC432 +03078 DTSSC432 +03079 S982D-CLOSE. DTSSC432 +03080 SET L982-CLOSE-88 TO TRUE. DTSSC432 +03081 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DTSSC432 +03082 DTSSC432 +03083 S982D-EXIT. DTSSC432 +03084 EXIT. DTSSC432 +03085 DTSSC432 +03086 S982Z-WNAM-IO. DTSSC432 +03087 CALL 'DTSBU982' USING L982-LINK-AREA DTSSC432 +03088 WNAM-REC. DTSSC432 +03089 S982Z-EXIT. DTSSC432 +03090 EXIT. DTSSC432 +03091 DTSSC432 +03092 S1000-READ-X101. DTSSC432 +03093 ** READ SERVER-FILE INTO WRK-X101-REC. DTSSC432 +03094 READ SERVER-FILE. DTSSC432 +03095 IF NOT X101-STATUS-OK-88 DTSSC432 +03096 IF X101-STATUS-EOF-88 DTSSC432 +03097 NEXT SENTENCE DTSSC432 +03098 ELSE DTSSC432 +03099 DISPLAY 'SERVER FILE READ ERROR ' X101-STATUS DTSSC432 +03100 SET WRK-ERROR-YES-88 TO TRUE DTSSC432 +03101 END-IF DTSSC432 +03102 ELSE DTSSC432 +03103 ADD +1 TO X101-CNT DTSSC432 +03104 END-IF. DTSSC432 +03105 DTSSC432 +03106 S1000-EXIT. DTSSC432 +03107 EXIT. DTSSC432 +03108 DTSSC432 +03109 S999-ABEND. DTSSC432 +03110 DISPLAY '*** DTSBX410 ABENDING. ' DTSSC432 +03111 ABEND-MSG. DTSSC432 +03112 DTSSC432 +03113 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSSC432 +03114 S999-EXIT. DTSSC432 +03115 EXIT. DTSSC432 diff --git a/Batch/DTSTOP00.cob b/Batch/DTSTOP00.cob new file mode 100644 index 0000000..aaa2b2f --- /dev/null +++ b/Batch/DTSTOP00.cob @@ -0,0 +1,1127 @@ +00001 IDENTIFICATION DIVISION. 01/22/25 +00002 PROGRAM-ID. DTSTOP00. DTSTOP00 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV097 +00004 DATE-WRITTEN. DECEMBER 1998. DTSTOP00 +00005 DATE-COMPILED. DTSTOP00 +00006 SKIP3 DTSTOP00 +00007 ***** DTSTOP00 +00008 * DTSTOP00 +00009 * FUNCTION: CALCULATE TOP AMOUNT OWED AND WRITE PRINT FILE CL*95 +00010 * FOR PROGRAM DTSTOP01. CL*95 +00011 * DTSTOP00 +00012 ***** DTSTOP00 +00013 SKIP3 DTSTOP00 +00014 ENVIRONMENT DIVISION. DTSTOP00 +00015 INPUT-OUTPUT SECTION. DTSTOP00 +00016 SKIP3 DTSTOP00 +00017 FILE-CONTROL. DTSTOP00 +00018 SELECT IN-FILE ASSIGN TO DTSIZ058 DTSTOP00 +00019 FILE STATUS IS ZI57-STATUS. DTSTOP00 +00020 DTSTOP00 +00021 SELECT OUT-FILE ASSIGN TO DTSOZ058 DTSTOP00 +00022 FILE STATUS IS Z057-STATUS. DTSTOP00 +00023 SELECT LET-FILE ASSIGN TO DTSOTOPL CL*36 +00024 FILE STATUS IS Z057-STATUS. CL*36 +00025 SKIP2 DTSTOP00 +00026 DATA DIVISION. DTSTOP00 +00027 FILE SECTION. DTSTOP00 +00028 DTSTOP00 +00029 FD IN-FILE DTSTOP00 +00030 RECORDING MODE IS F DTSTOP00 +00031 BLOCK CONTAINS 0 RECORDS DTSTOP00 +00032 LABEL RECORDS ARE OMITTED. DTSTOP00 +00033 DTSTOP00 +00034 DTSTOP00 +00035 01 IN-REC. DTSTOP00 +00036 05 IN-EAN PIC X(06). DTSTOP00 +00037 05 FILLER PIC X(194). CL*67 +00038 DTSTOP00 +00039 FD OUT-FILE DTSTOP00 +00040 RECORDING MODE IS F DTSTOP00 +00041 BLOCK CONTAINS 0 RECORDS DTSTOP00 +00042 LABEL RECORDS ARE OMITTED. DTSTOP00 +00043 DTSTOP00 +00044 01 OUT-REC PIC X(200). DTSTOP00 +00045 CL*35 +00046 FD LET-FILE CL*35 +00047 RECORDING MODE IS F CL*35 +00048 BLOCK CONTAINS 0 RECORDS CL*35 +00049 LABEL RECORDS ARE OMITTED. CL*35 +00050 CL*35 +00051 01 LET-REC PIC X(200). CL*35 +00052 DTSTOP00 +00053 DTSTOP00 +00054 WORKING-STORAGE SECTION. DTSTOP00 +000545 77 PAN-VALET PICTURE X(24) VALUE '097DTSTOP00 01/22/25'. DTSTOP00 +00055 SKIP3 DTSTOP00 +00056 01 WRK-AREA. DTSTOP00 +00057 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +057.DTSTOP00 +00058 05 ABEND-MSG PIC X(60). DTSTOP00 +00059 DTSTOP00 +00060 05 W-IN-QTR PIC S9(05) COMP-3. DTSTOP00 +00061 05 HOLD-LAST-USED-BATCH-NO PIC S9(05) COMP-3. DTSTOP00 +00062 DTSTOP00 +00063 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ057'.DTSTOP00 +00064 CL*37 +00065 05 WS-AMT PIC 9(10)V99 VALUE 0. CL*37 +00066 05 WS-AMT-DISP PIC 9999999999.99. CL*56 +00067 DTSTOP00 +00068 05 Z057-STATUS PIC X(02). DTSTOP00 +00069 88 Z057-FILE-OK-88 VALUE '00'. DTSTOP00 +00070 DTSTOP00 +00071 05 ZI57-STATUS PIC X(02). DTSTOP00 +00072 88 ZI57-FILE-OK-88 VALUE '00'. DTSTOP00 +00073 DTSTOP00 +00074 05 SEQ PIC S9(07) COMP-3 VALUE +0. DTSTOP00 +00075 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSTOP00 +00076 05 WRK-UPDATE-CNT PIC S9(07) COMP-3. DTSTOP00 +00077 05 WRK-READ-CNT PIC 9(07) VALUE 0. DTSTOP00 +00078 05 WRK-LIEN-CNT PIC 9(07) VALUE 0. CL*70 +00079 05 WRK-FEIN-CNT PIC 9(07) VALUE 0. CL*70 +00080 05 WRK-BANK-CNT PIC 9(07) VALUE 0. CL*70 +00081 05 WRK-COLL-CNT PIC 9(07) VALUE 0. CL*70 +00082 05 WRK-WOFF-CNT PIC 9(07) VALUE 0. CL*70 +00083 05 WRK-WAPP-CNT PIC 9(07) VALUE 0. CL*70 +00084 05 WRK-WDPC-CNT PIC 9(07) VALUE 0. CL*70 +00085 05 WRK-PRNT-CNT PIC 9(07) VALUE 0. CL*70 +00086 05 WRK-FILE-CNT PIC 9(07) VALUE 0. CL*70 +00087 05 WRK-LESS-CNT PIC 9(07) VALUE 0. CL*70 +00088 05 WRK-ADDR-CNT PIC 9(07) VALUE 0. CL*71 +00089 05 WRK-APPS-CNT PIC 9(07) VALUE 0. CL*70 +00090 05 WS-REC-CNT PIC 9(07) VALUE 0. CL*17 +00091 05 ACNT PIC 9(02) VALUE 0. CL*64 +00092 05 LET-COUNT PIC 9(07) VALUE 0. CL*64 +00093 05 PRINT-LETTER PIC 9(01) VALUE 0. CL*37 +00094 05 WRK-T1-CNT PIC 9(07) VALUE 0. CL*17 +00095 05 WRK-EXCLUDE-CNT PIC S9(07) COMP-3. DTSTOP00 +00096 05 WRK-MPRF-AMT PIC S9(09)V99 COMP-3. DTSTOP00 +00097 05 WRK-INTEREST-AMT PIC S9(09)V99 COMP-3. DTSTOP00 +00098 05 WRK-PENALTY-AMT PIC S9(09)V99 COMP-3 VALUE 0.DTSTOP00 +00099 05 WRK-T1-AMT PIC 9(12)V99 VALUE 0. CL*30 +00100 05 WRK-TOT-T1-AMT PIC 9(12)V99 VALUE 0. CL*30 +00101 05 WRK-TOT-EMP-AMT PIC 9(12)V99 VALUE 0. CL*97 +00102 05 WRK-SUR-DUE PIC 9(10)V99 VALUE 0. CL*51 +00103 05 WRK-SUR-BAL PIC 9(10)V99 VALUE 0. CL*51 +00104 05 WRK-INT-DUE PIC 9(10)V99 VALUE 0. CL*51 +00105 05 WRK-NSF-DUE PIC 9(10)V99 VALUE 0. CL*43 +00106 05 WRK-MIS-DUE PIC 9(10)V99 VALUE 0. CL*43 +00107 05 WRK-LP-DUE PIC 9(10)V99 VALUE 0. CL*43 +00108 05 WRK-MLIN-QTR-AMT PIC 9(10)V99 VALUE 0. CL*42 +00109 05 WRK-MLIN-EMP-AMT PIC 9(10)V99 VALUE 0. CL*59 +00110 05 WRK-MLIN-AMT PIC 9(10)V99 VALUE 0. CL*30 +00111 05 WRK-LIEN-AMT PIC 9(10)V99 VALUE 0. CL*30 +00112 05 WRK-MLIN-AMTD PIC $$$$$$$$9.99. DTSTOP00 +00113 05 DIS-MLIN-AMT PIC --------9.99. DTSTOP00 +00114 05 DIS-MPRF-AMT PIC --------9.99. DTSTOP00 +00115 05 WRK-REMIT-AMT PIC S9(09)V99 COMP-3. DTSTOP00 +00116 05 WRK-UI-BAL PIC S9(09)V99 COMP-3. DTSTOP00 +00117 05 WRK-MLIN-IND PIC X(01). DTSTOP00 +00118 88 WRK-MLIN-OK VALUE 'Y'. DTSTOP00 +00119 88 WRK-MLIN-NO-REC VALUE 'N'. DTSTOP00 +00120 DTSTOP00 +00121 05 WS-ALPHA OCCURS 26 TIMES PIC X(1). CL*32 +00122 DTSTOP00 +00123 DTSTOP00 +00124 05 WRK-MQTR-CNT PIC S9(07) COMP-3. DTSTOP00 +00125 05 EMP-ACCT-DISP PIC 9(06). DTSTOP00 +00126 05 WRK-TIMELY-PMT-AREA. DTSTOP00 +00127 10 WRK-ERROR-IND PIC X(01). DTSTOP00 +00128 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSTOP00 +00129 88 WRK-ERROR-NO-88 VALUE 'N'. DTSTOP00 +00130 10 WRK-MPAY-FOUND-IND PIC X(01). DTSTOP00 +00131 88 WRK-MPAY-FOUND-YES VALUE 'Y'. DTSTOP00 +00132 88 WRK-MPAY-FOUND-NO VALUE 'N'. DTSTOP00 +00133 10 WRK-MRPT-FOUND-IND PIC X(01). DTSTOP00 +00134 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSTOP00 +00135 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSTOP00 +00136 10 WRK-EMP-SELECTED-IND PIC X(01). DTSTOP00 +00137 88 WRK-EMP-SELECTED-YES VALUE 'Y'. DTSTOP00 +00138 88 WRK-EMP-SELECTED-NO VALUE 'N'. DTSTOP00 +00139 10 WRK-SUPPL-RPT-IND PIC X(01). DTSTOP00 +00140 88 WRK-SUPPL-RPT-YES VALUE 'Y'. DTSTOP00 +00141 88 WRK-SUPPL-RPT-NO VALUE 'N'. DTSTOP00 +00142 10 WRK-WITHDRAWN-RPT-IND PIC X(01). DTSTOP00 +00143 88 WRK-WITHDRAWN-RPT-YES VALUE 'Y'. DTSTOP00 +00144 88 WRK-WITHDRAWN-RPT-NO VALUE 'N'. DTSTOP00 +00145 10 WRK-RPT-BATCH-NO PIC S9(05) COMP-3. DTSTOP00 +00146 10 WRK-RPT-ITEM-NO PIC S9(03) COMP-3. DTSTOP00 +00147 10 WRK-OPID PIC X(08). DTSTOP00 +00148 10 WRITE-OFF PIC X(01) VALUE SPACES. DTSTOP00 +00149 10 WRK-BALANCE-AMT PIC ----------9.99. DTSTOP00 +00150 DTSTOP00 +00151 05 WRK-CERTIFICATE-DATE PIC 9(8) VALUE 0. DTSTOP00 +00152 05 WRK-TIMELY-RPT-AREA. DTSTOP00 +00153 10 WRK-RPT-RECEIVED-DATE PIC S9(09) COMP-3. DTSTOP00 +00154 DTSTOP00 +00155 05 WRK-MNTE-MSG-LINE1. DTSTOP00 +00156 10 WRK-MNTE-MSG-YR PIC X(04). DTSTOP00 +00157 10 FILLER PIC X(01) VALUE '/'. DTSTOP00 +00158 10 WRK-MNTE-MSG-QTR PIC X(01). DTSTOP00 +00159 10 FILLER PIC X(44) VALUE DTSTOP00 +00160 ' QUARTER ANNUAL REPORT FROM TDEC WAS PROCESS'. DTSTOP00 +00161 10 FILLER PIC X(23) VALUE DTSTOP00 +00162 'ED INCORRECTLY BY ESSP '. DTSTOP00 +00163 05 WRK-MNTE-MSG-LINE2. DTSTOP00 +00164 10 FILLER PIC X(48) VALUE DTSTOP00 +00165 'REPORT WITHDRAWN AND REPOSTED CORRECTLY. '. DTSTOP00 +00166 10 FILLER PIC X(23) VALUE DTSTOP00 +00167 ' '. DTSTOP00 +00168 05 WRK-MNTE-MSG-LINE3. DTSTOP00 +00169 10 FILLER PIC X(12) VALUE DTSTOP00 +00170 ' '. DTSTOP00 +00171 DTSTOP00 +00172 05 WRK-MPRF-IND PIC X(01). DTSTOP00 +00173 88 WRK-MPRF-OK VALUE 'Y'. DTSTOP00 +00174 88 WRK-MPRF-NO-REC VALUE 'N'. DTSTOP00 +00175 05 WRK-MQTR-IND PIC X(01). DTSTOP00 +00176 88 WRK-MQTR-OK VALUE 'Y'. DTSTOP00 +00177 88 WRK-MQTR-NO-REC VALUE 'N'. DTSTOP00 +00178 05 WRK-MRPT-IND PIC X(01). DTSTOP00 +00179 88 WRK-MRPT-OK VALUE 'Y'. DTSTOP00 +00180 88 WRK-MRPT-NO-REC VALUE 'N'. DTSTOP00 +00181 DTSTOP00 +00182 05 WRK-T003-CNT PIC S9(07) COMP-3 VALUE +0. DTSTOP00 +00183 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSTOP00 +00184 DTSTOP00 +00185 05 PARM-EOF-IND PIC X(01). DTSTOP00 +00186 DTSTOP00 +00187 05 WRK-EMP-NO PIC 9(06). DTSTOP00 +00188 DTSTOP00 +00189 05 WRK-TRACE-IND PIC X(01). DTSTOP00 +00190 DTSTOP00 +00191 DTSTOP00 +00192 05 WRK-MST-OPEN-IND PIC X(01). DTSTOP00 +00193 DTSTOP00 +00194 05 WRK-REF-OPEN-IND PIC X(01). DTSTOP00 +00195 01 TOP-LETTER. CL*36 +00196 10 LET-EMP-NO PIC 999999. CL*36 +00197 10 FILLER PIC X VALUE ';'. CL*36 +00198 10 LET-EMP-FEIN PIC 999999999. CL*39 +00199 10 FILLER PIC X VALUE ';'. CL*36 +00200 10 LET-EMP-NAME PIC X(40). CL*36 +00201 10 FILLER PIC X VALUE ';'. CL*36 +00202 10 LET-EMP-ADDR1 PIC X(40). CL*36 +00203 10 FILLER PIC X VALUE ';'. CL*36 +00204 10 LET-EMP-ADDR2 PIC X(40). CL*36 +00205 10 FILLER PIC X VALUE ';'. CL*36 +00206 10 LET-EMP-CITZ PIC X(20). CL*36 +00207 10 FILLER PIC X VALUE ';'. CL*36 +00208 10 LET-EMP-ST PIC X(02). CL*36 +00209 10 FILLER PIC X VALUE ';'. CL*36 +00210 10 LET-EMP-ZIPP PIC X(10). CL*36 +00211 10 FILLER PIC X VALUE ';'. CL*36 +00212 10 LET-EMP-AMT PIC 9999999.99. CL*36 +00213 DTSTOP00 +00214 01 TOP-T1-REC. CL*11 +00215 ++INCLUDE DTST1TOP CL*11 +00216 CL*11 +00217 CL*11 +00218 01 TOP-D1-REC. CL*11 +00219 ++INCLUDE DTSD1TOP CL*11 +00220 CL*11 +00221 CL*11 +00222 01 TOP-D2-REC. CL*11 +00223 ++INCLUDE DTSD2TOP CL*11 +00224 CL*11 +00225 01 TOP-TC-REC. CL*11 +00226 ++INCLUDE DTSTCTOP CL*11 +00227 CL*11 +00228 CL*11 +00229 ** EJECT DTSTOP00 +00230 01 TSKL-REC. DTSTOP00 +00231 ++INCLUDE DTSITSKL DTSTOP00 +00232 DTSTOP00 +00233 01 L005-LINK-AREA. DTSTOP00 +00234 ++INCLUDE DTSIL005 DTSTOP00 +00235 DTSTOP00 +00236 01 L910-LINK-AREA. DTSTOP00 +00237 ++INCLUDE DTSIL910 DTSTOP00 +00238 EJECT DTSTOP00 +00239 01 MSKL-REC. DTSTOP00 +00240 ++INCLUDE DTSIMSKL DTSTOP00 +00241 EJECT DTSTOP00 +00242 01 MHDR-REC. DTSTOP00 +00243 ++INCLUDE DTSIMHDR DTSTOP00 +00244 EJECT DTSTOP00 +00245 01 MPRF-REC. DTSTOP00 +00246 ++INCLUDE DTSIMPRF DTSTOP00 +00247 EJECT DTSTOP00 +00248 01 MQTR-REC. DTSTOP00 +00249 ++INCLUDE DTSIMQTR DTSTOP00 +00250 EJECT DTSTOP00 +00251 01 MRPT-REC. DTSTOP00 +00252 ++INCLUDE DTSIMRPT DTSTOP00 +00253 EJECT DTSTOP00 +00254 01 MDST-REC. DTSTOP00 +00255 ++INCLUDE DTSIMDST DTSTOP00 +00256 EJECT DTSTOP00 +00257 01 L111-LINK-AREA. DTSTOP00 +00258 ++INCLUDE DTSIL111 DTSTOP00 +00259 EJECT DTSTOP00 +00260 01 MPAY-REC. DTSTOP00 +00261 ++INCLUDE DTSIMPAY DTSTOP00 +00262 EJECT DTSTOP00 +00263 01 MTAD-REC. DTSTOP00 +00264 ++INCLUDE DTSIMTAD DTSTOP00 +00265 EJECT DTSTOP00 +00266 01 MNTE-REC. DTSTOP00 +00267 ++INCLUDE DTSIMNTE DTSTOP00 +00268 EJECT DTSTOP00 +00269 01 L923-LINK-AREA. DTSTOP00 +00270 ++INCLUDE DTSIL923 DTSTOP00 +00271 EJECT DTSTOP00 +00272 01 ASKL-REC. DTSTOP00 +00273 ++INCLUDE DTSIASKL DTSTOP00 +00274 EJECT DTSTOP00 +00275 01 MLIN-REC. DTSTOP00 +00276 ++INCLUDE DTSIMLIN DTSTOP00 +00277 EJECT DTSTOP00 +00278 01 AHDR-REC. DTSTOP00 +00279 ++INCLUDE DTSIAHDR DTSTOP00 +00280 EJECT DTSTOP00 +00281 01 ARPT-REC. DTSTOP00 +00282 ++INCLUDE DTSIARPT DTSTOP00 +00283 EJECT DTSTOP00 +00284 01 APAY-REC. DTSTOP00 +00285 ++INCLUDE DTSIAPAY DTSTOP00 +00286 EJECT DTSTOP00 +00287 01 L927-LINK-AREA. DTSTOP00 +00288 ++INCLUDE DTSIL927 DTSTOP00 +00289 DTSTOP00 +00290 01 L101-LINK-AREA. DTSTOP00 +00291 ++INCLUDE DTSIL101 DTSTOP00 +00292 CL*48 +00293 01 L109-LINK-AREA. CL*50 +00294 ++INCLUDE DTSIL109 CL*48 +00295 DTSTOP00 +00296 01 L004-COMM-AREA. DTSTOP00 +00297 ++INCLUDE DTSIL004 DTSTOP00 +00298 EJECT DTSTOP00 +00299 01 TOP-HEADER. DTSTOP00 +00300 ++INCLUDE DTSIXTPH DTSTOP00 +00301 DTSTOP00 +00302 01 TOP-REC-1. DTSTOP00 +00303 ++INCLUDE DTSIXTD1 DTSTOP00 +00304 DTSTOP00 +00305 01 L001-LINK-AREA. DTSTOP00 +00306 ++INCLUDE DTSIL001 DTSTOP00 +00307 01 L112-LINK-AREA. DTSTOP00 +00308 ++INCLUDE DTSIL112 DTSTOP00 +00309 EJECT DTSTOP00 +00310 DTSTOP00 +00311 PROCEDURE DIVISION. DTSTOP00 +00312 DTSTOP00 +00313 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSTOP00 +00314 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSTOP00 +00315 DTSTOP00 +00316 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSTOP00 +00317 SKIP2 DTSTOP00 +00318 GOBACK. DTSTOP00 +00319 EJECT DTSTOP00 +00320 I0000-INITIATE. DTSTOP00 +00321 DTSTOP00 +00322 MOVE 'N' TO WRK-TRACE-IND. DTSTOP00 +00323 DTSTOP00 +00324 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSTOP00 +00325 DTSTOP00 +00326 PERFORM I3000-BATCH-HEADER THRU I3000-EXIT. DTSTOP00 +00327 DTSTOP00 +00328 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSTOP00 +00329 DTSTOP00 +00330 I0000-EXIT. DTSTOP00 +00331 EXIT. DTSTOP00 +00332 DTSTOP00 +00333 I2000-OPEN-FILES-1. DTSTOP00 +00334 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSTOP00 +00335 DTSTOP00 +00336 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSTOP00 +00337 DTSTOP00 +00338 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSTOP00 +00339 ** PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. DTSTOP00 +00340 ** PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT. DTSTOP00 +00341 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSTOP00 +00342 ** PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSTOP00 +00343 DTSTOP00 +00344 OPEN OUTPUT OUT-FILE. DTSTOP00 +00345 IF NOT Z057-FILE-OK-88 DTSTOP00 +00346 DISPLAY 'OUTPUT FILE OPEN ERROR: ' Z057-STATUS DTSTOP00 +00347 PERFORM S999-ABEND THRU S999-EXIT DTSTOP00 +00348 END-IF. DTSTOP00 +00349 DTSTOP00 +00350 OPEN OUTPUT LET-FILE. CL*37 +00351 IF NOT Z057-FILE-OK-88 CL*37 +00352 DISPLAY 'LETTER FILE OPEN ERROR: ' Z057-STATUS CL*37 +00353 PERFORM S999-ABEND THRU S999-EXIT CL*37 +00354 END-IF. CL*37 +00355 CL*37 +00356 OPEN INPUT IN-FILE. DTSTOP00 +00357 IF NOT ZI57-FILE-OK-88 DTSTOP00 +00358 DISPLAY 'INPUT FILE OPEN ERROR: ' ZI57-STATUS DTSTOP00 +00359 PERFORM S999-ABEND THRU S999-EXIT DTSTOP00 +00360 END-IF. DTSTOP00 +00361 DTSTOP00 +00362 I2000-EXIT. DTSTOP00 +00363 EXIT. DTSTOP00 +00364 DTSTOP00 +00365 I3000-BATCH-HEADER. DTSTOP00 +00366 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSTOP00 +00367 MOVE +0 TO MHDR-EMP-NO. DTSTOP00 +00368 SET MHDR-HDR-88 TO TRUE. DTSTOP00 +00369 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP00 +00370 PERFORM S910-READ THRU S910-EXIT. DTSTOP00 +00371 DTSTOP00 +00372 IF L910-NO-REC-88 DTSTOP00 +00373 MOVE 'MHDR RECORD NOT FOUND (I0000)' DTSTOP00 +00374 TO ABEND-MSG DTSTOP00 +00375 PERFORM S999-ABEND THRU S999-EXIT. DTSTOP00 +00376 DTSTOP00 +00377 MOVE MSKL-REC TO MHDR-REC. DTSTOP00 +00378 DTSTOP00 +00379 MOVE MHDR-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSTOP00 +00380 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSTOP00 +00381 MOVE L001-SLASH-8-DATE(1:2) TO T1-BATCH-MM CL*11 +00382 TC-BATCH-MONTH. CL*11 +00383 MOVE L001-SLASH-8-DATE(4:2) TO T1-BATCH-DD CL*11 +00384 TC-BATCH-DAY. CL*11 +00385 MOVE L001-SLASH-8-DATE(7:4) TO T1-BATCH-YR CL*11 +00386 TC-BATCH-YEAR. CL*11 +00387 WRITE OUT-REC FROM T1-HEADER. CL*11 +00388 DTSTOP00 +00389 ** PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP00 +00390 DISPLAY 'FIRST BATCH: ' AHDR-BATCH-NO. DTSTOP00 +00391 DTSTOP00 +00392 I3000-EXIT. DTSTOP00 +00393 EXIT. DTSTOP00 +00394 DTSTOP00 +00395 EJECT DTSTOP00 +00396 P0000-PROCESS. DTSTOP00 +00397 DTSTOP00 +00398 READ IN-FILE AT END GO TO P0000-EXIT. DTSTOP00 +00399 DTSTOP00 +00400 MOVE +0 TO WRK-MPRF-CNT DTSTOP00 +00401 WRK-EXCLUDE-CNT DTSTOP00 +00402 WRK-UPDATE-CNT DTSTOP00 +00403 DIS-MLIN-AMT DTSTOP00 +00404 DIS-MPRF-AMT DTSTOP00 +00405 WRK-INTEREST-AMT. DTSTOP00 +00406 SET WRK-ERROR-NO-88 TO TRUE. DTSTOP00 +00407 DTSTOP00 +00408 MOVE 'A' TO WS-ALPHA(1). DTSTOP00 +00409 MOVE 'B' TO WS-ALPHA(2). DTSTOP00 +00410 MOVE 'C' TO WS-ALPHA(3). DTSTOP00 +00411 MOVE 'D' TO WS-ALPHA(4). DTSTOP00 +00412 MOVE 'E' TO WS-ALPHA(5). DTSTOP00 +00413 MOVE 'F' TO WS-ALPHA(6). DTSTOP00 +00414 MOVE 'G' TO WS-ALPHA(7). DTSTOP00 +00415 MOVE 'H' TO WS-ALPHA(8). DTSTOP00 +00416 MOVE 'I' TO WS-ALPHA(9). DTSTOP00 +00417 MOVE 'J' TO WS-ALPHA(10). DTSTOP00 +00418 MOVE 'K' TO WS-ALPHA(11). DTSTOP00 +00419 MOVE 'L' TO WS-ALPHA(12). DTSTOP00 +00420 MOVE 'M' TO WS-ALPHA(13). DTSTOP00 +00421 MOVE 'N' TO WS-ALPHA(14). DTSTOP00 +00422 MOVE 'O' TO WS-ALPHA(15). DTSTOP00 +00423 MOVE 'P' TO WS-ALPHA(16). DTSTOP00 +00424 MOVE 'Q' TO WS-ALPHA(17). DTSTOP00 +00425 MOVE 'R' TO WS-ALPHA(18). DTSTOP00 +00426 MOVE 'S' TO WS-ALPHA(19). DTSTOP00 +00427 MOVE 'T' TO WS-ALPHA(20). DTSTOP00 +00428 MOVE 'U' TO WS-ALPHA(21). CL*31 +00429 MOVE 'V' TO WS-ALPHA(22). CL*31 +00430 MOVE 'W' TO WS-ALPHA(23). CL*31 +00431 MOVE 'X' TO WS-ALPHA(24). CL*31 +00432 MOVE 'Y' TO WS-ALPHA(25). CL*31 +00433 MOVE 'Z' TO WS-ALPHA(26). CL*31 +00434 DTSTOP00 +00435 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSTOP00 +00436 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSTOP00 +00437 DTSTOP00 +00438 MOVE +0 TO MSKL-EMP-NO. DTSTOP00 +00439 DTSTOP00 +00440 SET MPRF-PRF-88 TO TRUE. DTSTOP00 +00441 MOVE IN-EAN TO MPRF-EMP-NO DTSTOP00 +00442 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSTOP00 +00443 PERFORM S910-READ THRU S910-EXIT. DTSTOP00 +00444 IF L910-OK-88 DTSTOP00 +00445 MOVE MSKL-REC TO MPRF-REC DTSTOP00 +00446 SET WRK-MPRF-OK TO TRUE DTSTOP00 +00447 ELSE DTSTOP00 +00448 DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSTOP00 +00449 SET L910-NO-REC-88 TO TRUE DTSTOP00 +00450 GO TO P1000-READ-CONTINUE. CL**2 +00451 DTSTOP00 +00452 DISPLAY 'LIST OF EMPLOYERS -FOR TOP FILE AND LETTERS '. CL**3 +00453 DTSTOP00 +00454 PERFORM P1000-READ-NEXT THRU P1000-EXIT DTSTOP00 +00455 UNTIL WRK-MPRF-NO-REC DTSTOP00 +00456 OR WRK-ERROR-YES-88. DTSTOP00 +00457 ** OR MPRF-EMP-NO > 020999. DTSTOP00 +00458 ** OR WRK-REL-CNT > +100. DTSTOP00 +00459 P0000-EXIT. DTSTOP00 +00460 EXIT. DTSTOP00 +00461 EJECT DTSTOP00 +00462 P1000-READ-NEXT. DTSTOP00 +00463 DTSTOP00 +00464 MOVE ZEROS TO DIS-MLIN-AMT WRK-MLIN-AMT DTSTOP00 +00465 DIS-MPRF-AMT WRK-MPRF-AMT. DTSTOP00 +00466 * MOVE ZEROS TO WRK-CERTIFICATE-DATE CL**2 +00467 CL**2 +00468 ADD 1 TO WRK-READ-CNT. DTSTOP00 +00469 DISPLAY '>>>>>>INREC-EAN ' IN-EAN DTSTOP00 +00470 CL**2 +00471 IF MPRF-MLIN-IND NOT = 'Y' CL*68 +00472 ADD 1 TO WRK-LIEN-CNT CL*69 +00473 DISPLAY '>>>>>>MLIN-NOT Y ' MPRF-MLIN-IND. CL*71 +00474 * GO TO P1000-READ-CONTINUE. CL*69 +00475 * CL*13 +00476 *+++++ CANNOT SEND ZEROS FEIN TO IRS CL*13 +00477 * CL*13 +00478 IF MPRF-FEIN = ZEROS CL*10 +00479 ADD 1 TO WRK-FEIN-CNT CL*69 +00480 DISPLAY '>>>>>>FEIN ZEROS ' MPRF-FEIN CL*10 +00481 GO TO P1000-READ-CONTINUE. CL*10 +00482 CL*69 +00483 IF MPRF-RETURN-MAIL-IND = 'Y' CL*71 +00484 ADD 1 TO WRK-ADDR-CNT CL*71 +00485 DISPLAY '>>>>>>BAD ADDR ' MPRF-EMP-NO. CL*71 +00486 * GO TO P1000-READ-CONTINUE. CL*71 +00487 CL*71 +00488 IF MPRF-BANKRP-OPEN-88 CL*33 +00489 ADD 1 TO WRK-BANK-CNT CL*69 +00490 DISPLAY 'IN-BANKRUPT ' IN-EAN CL*74 +00491 GO TO P1000-READ-CONTINUE. CL*74 +00492 CL*69 +00493 IF MPRF-SUSPEND-COLL-IND = 'Y' CL*33 +00494 ADD 1 TO WRK-COLL-CNT CL*69 +00495 DISPLAY 'IN-SUS COLL ' IN-EAN CL*74 +00496 GO TO P1000-READ-CONTINUE. CL*74 +00497 CL*69 +00498 IF MPRF-WRITE-OFF-DATE > 0 CL*33 +00499 ADD 1 TO WRK-WOFF-CNT CL*69 +00500 DISPLAY 'IN-WRITTEN OFF ' IN-EAN CL*74 +00501 GO TO P1000-READ-CONTINUE. CL*74 +00502 CL*69 +00503 IF MPRF-MAPL-IND = 'Y' CL*33 +00504 ADD 1 TO WRK-WAPP-CNT CL*69 +00505 DISPLAY 'IN-APPEAL ' IN-EAN CL*74 +00506 GO TO P1000-READ-CONTINUE. CL*74 +00507 CL*69 +00508 IF MPRF-MDPC-IND = 'Y' CL*33 +00509 ADD 1 TO WRK-WDPC-CNT CL*69 +00510 DISPLAY 'IN-DPC ' IN-EAN CL*74 +00511 GO TO P1000-READ-CONTINUE. CL*74 +00512 CL**2 +00513 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. CL*49 +00514 CL*49 +00515 MOVE ZEROS TO ACNT CL*78 +00516 MOVE ZERO TO PRINT-LETTER. CL*36 +00517 * PERFORM P7000-SCAN-LIN THRU P7000-EXIT. CL*73 +00518 PERFORM P5000-READ-MQTR THRU P5000-EXIT CL*73 +00519 CL*36 +00520 MOVE WRK-MLIN-EMP-AMT TO WS-AMT CL*88 +00521 CL*88 +00522 IF WS-AMT > 1000.00 CL*89 +00523 NEXT SENTENCE CL*88 +00524 ELSE CL*88 +00525 DISPLAY 'AMT LESS THAN 1000 ' MPRF-EMP-NO ' ' WS-AMT CL*90 +00526 GO TO P1000-READ-CONTINUE. CL*90 +00527 CL*88 +00528 IF PRINT-LETTER = 1 CL*36 +00529 PERFORM P9000-LETTER THRU P9000-EXIT. CL*88 +00530 DTSTOP00 +00531 P1000-READ-CONTINUE. DTSTOP00 +00532 DTSTOP00 +00533 READ IN-FILE AT END DTSTOP00 +00534 SET WRK-MPRF-NO-REC TO TRUE DTSTOP00 +00535 GO TO P1000-EXIT. DTSTOP00 +00536 SET MPRF-PRF-88 TO TRUE. DTSTOP00 +00537 MOVE IN-EAN TO MPRF-EMP-NO DTSTOP00 +00538 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSTOP00 +00539 PERFORM S910-READ THRU S910-EXIT. DTSTOP00 +00540 IF L910-OK-88 DTSTOP00 +00541 MOVE MSKL-REC TO MPRF-REC DTSTOP00 +00542 SET WRK-MPRF-OK TO TRUE DTSTOP00 +00543 ELSE DTSTOP00 +00544 ** DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSTOP00 +00545 SET L910-NO-REC-88 TO TRUE. CL**3 +00546 DTSTOP00 +00547 P1000-EXIT. DTSTOP00 +00548 EXIT. DTSTOP00 +00549 DTSTOP00 +00550 P7000-SCAN-LIN. DTSTOP00 +00551 DTSTOP00 +00552 MOVE 'Y' TO WRK-MLIN-IND. DTSTOP00 +00553 MOVE ZEROS TO WRK-MLIN-AMT DTSTOP00 +00554 MOVE ZEROS TO DIS-MLIN-AMT DTSTOP00 +00555 MOVE ZEROS TO WRK-MLIN-EMP-AMT CL*60 +00556 MOVE LOW-VALUES TO MLIN-KEY-AREA. DTSTOP00 +00557 MOVE MPRF-EMP-NO TO MLIN-EMP-NO. DTSTOP00 +00558 SET MLIN-LIN-88 TO TRUE. DTSTOP00 +00559 MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA. DTSTOP00 +00560 DTSTOP00 +00561 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP00 +00562 IF L910-NO-REC-88 DTSTOP00 +00563 GO TO P7000-EXIT DTSTOP00 +00564 ELSE DTSTOP00 +00565 PERFORM P7100-SCAN-MLIN THRU P7100-EXIT DTSTOP00 +00566 UNTIL WRK-MLIN-NO-REC. DTSTOP00 +00567 DTSTOP00 +00568 P7000-EXIT. DTSTOP00 +00569 EXIT. DTSTOP00 +00570 P7100-SCAN-MLIN. DTSTOP00 +00571 DTSTOP00 +00572 DTSTOP00 +00573 MOVE ZEROS TO ACNT CL*65 +00574 MOVE MSKL-REC TO MLIN-REC. DTSTOP00 +00575 DTSTOP00 +00576 DISPLAY 'P7100 ' MLIN-EMP-NO ' ' MLIN-STMT-DUE-AMT CL*26 +00577 ' CNT ' MLIN-COV-CNT. CL*26 +00578 IF MLIN-STATUS-ACTIVE-88 DTSTOP00 +00579 PERFORM CL**3 +00580 VARYING MLIN-COV-IDX FROM +1 BY +1 CL**3 +00581 UNTIL MLIN-COV-IDX > MLIN-COV-CNT CL**3 +00582 PERFORM P5000-READ-MQTR THRU P5000-EXIT CL**3 +00583 END-PERFORM. CL**3 +00584 DTSTOP00 +00585 MOVE MLIN-REC TO MSKL-REC. CL**8 +00586 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP00 +00587 IF L910-NO-REC-88 DTSTOP00 +00588 DISPLAY '>>>> LIEN AMT: ' MLIN-EMP-NO ' ' WRK-MLIN-AMT DTSTOP00 +00589 SET WRK-MLIN-NO-REC TO TRUE. DTSTOP00 +00590 DTSTOP00 +00591 P7100-EXIT. DTSTOP00 +00592 EXIT. DTSTOP00 +00593 DTSTOP00 +00594 P9000-LETTER. CL*36 +00595 ADD 1 TO WRK-PRNT-CNT. CL*69 +00596 MOVE IN-EAN TO LET-EMP-NO. CL*36 +00597 MOVE D1-EMP-LNAME TO LET-EMP-NAME. CL*36 +00598 IF D2-EMP-ADDR-LINE2 > SPACES CL*63 +00599 MOVE D2-EMP-ADDR-LINE1 TO LET-EMP-ADDR1 CL*96 +00600 MOVE D2-EMP-ADDR-LINE2 TO LET-EMP-ADDR2 CL*37 +00601 ELSE CL*36 +00602 MOVE D2-EMP-ADDR-LINE1 TO LET-EMP-ADDR2 CL*37 +00603 MOVE SPACES TO LET-EMP-ADDR1. CL*36 +00604 MOVE D2-EMP-CITY TO LET-EMP-CITZ. CL*36 +00605 MOVE D2-EMP-STATE TO LET-EMP-ST. CL*36 +00606 MOVE D2-EMP-ZIP TO LET-EMP-ZIPP. CL*36 +00607 MOVE D1-EMP-FEIN TO LET-EMP-FEIN. CL*39 +00608 MOVE WRK-MLIN-EMP-AMT TO WS-AMT CL*58 +00609 MOVE WS-AMT TO WS-AMT-DISP. CL*36 +00610 MOVE WS-AMT-DISP TO LET-EMP-AMT. CL*36 +00611 WRITE LET-REC FROM TOP-LETTER. CL*36 +00612 CL*96 +00613 * ADD WRK-MLIN-QTR-AMT TO WRK-TOT-T1-AMT. CL*96 +00614 ADD WRK-MLIN-EMP-AMT TO WRK-TOT-EMP-AMT. CL*97 +00615 CL*36 +00616 DISPLAY 'QTR-EMP-AMT ' LET-EMP-NO ' ' WRK-MLIN-EMP-AMT. CL*97 +00617 DISPLAY 'TOT-EMP-AMT ' LET-EMP-NO ' ' WRK-TOT-EMP-AMT. CL*97 +00618 DISPLAY 'TOT TOP AMT ' LET-EMP-NO ' ' WRK-TOT-T1-AMT. CL*96 +00619 P9000-EXIT. CL*36 +00620 EXIT. CL*36 +00621 CL*36 +00622 P5000-READ-MQTR. CL*36 +00623 MOVE ZEROS TO ACNT CL*82 +00624 MOVE ZEROS TO WRK-MLIN-AMT CL*80 +00625 MOVE ZEROS TO DIS-MLIN-AMT CL*80 +00626 MOVE ZEROS TO WRK-MLIN-EMP-AMT CL*80 +00627 * DISPLAY '>>>> P5000-READ-MQTR>>>> ' MPRF-EMP-NO CL*73 +00628 * ' ' MLIN-COVERED-YRQ(MLIN-COV-IDX) CL*73 +00629 * ' CNT ' MLIN-COV-CNT. CL*73 +00630 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSTOP00 +00631 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSTOP00 +00632 * MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO CL*73 +00633 CL*73 +00634 MOVE 20001 TO MQTR-YRQ. CL*74 +00635 MOVE ZEROS TO WRK-T1-AMT. CL*13 +00636 DTSTOP00 +00637 SET MQTR-QTR-88 TO TRUE. DTSTOP00 +00638 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP00 +00639 DTSTOP00 +00640 * PERFORM S910-READ THRU S910-EXIT. CL*74 +00641 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*74 +00642 DTSTOP00 +00643 IF L910-NO-REC-88 DTSTOP00 +00644 DISPLAY ' MQTR REC NOT FOUND ' MPRF-EMP-NO ' ' MQTR-YRQ CL*13 +00645 PERFORM S999-ABEND THRU S999-EXIT. CL*13 +00646 CL*13 +00647 DTSTOP00 +00648 MOVE MSKL-REC TO MQTR-REC. DTSTOP00 +00649 DISPLAY ' MQTR ' MPRF-EMP-NO ' ' MQTR-YRQ CL*26 +00650 PERFORM P5100-MQTR-SCAN THRU P5100-EXIT CL*73 +00651 UNTIL L910-NO-REC-88. CL*73 +00652 DTSTOP00 +00653 DTSTOP00 +00654 P5000-EXIT. DTSTOP00 +00655 EXIT. DTSTOP00 +00656 DTSTOP00 +00657 P5100-MQTR-SCAN. DTSTOP00 +00658 * DISPLAY '>>>> P5100-READ-MQTR>>> ' MPRF-EMP-NO ' ' MQTR-YRQ. CL*75 +00659 CL*87 +00660 IF MQTR-CURR-MISSING-88 CL*91 +00661 GO TO P5100-READ-NEXT. CL*94 +00662 CL*87 +00663 MOVE ZEROS TO WRK-MLIN-QTR-AMT CL*66 +00664 MOVE ZEROS TO L101-INT-CHARGE-CHNG. CL*44 +00665 MOVE ZEROS TO L101-PAID-CHNG WRK-SUR-DUE WRK-SUR-BAL CL*51 +00666 MOVE ZEROS TO WRK-T1-CNT. CL*13 +00667 MOVE ZEROS TO WRK-INT-DUE WRK-LP-DUE WRK-NSF-DUE WRK-MIS-DUE CL*43 +00668 PERFORM CL**6 +00669 VARYING MQTR-ACCT-IDX FROM +1 BY +1 CL**6 +00670 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT CL**6 +00671 EVALUATE TRUE CL**6 +00672 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) CL*45 +00673 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL**6 +00674 TO L101-PAID-CHNG CL**6 +00675 * DISPLAY 'UI DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*75 +00676 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) CL*51 +00677 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*45 +00678 TO WRK-SUR-DUE CL*51 +00679 * DISPLAY 'SUR DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*75 +00680 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) CL*42 +00681 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*42 +00682 TO WRK-INT-DUE CL*42 +00683 * DISPLAY 'INT DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*75 +00684 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) CL*33 +00685 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*33 +00686 TO WRK-LP-DUE CL*43 +00687 * DISPLAY 'LP DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*75 +00688 WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) CL*34 +00689 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*33 +00690 TO WRK-NSF-DUE CL*43 +00691 * DISPLAY 'NSF DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*75 +00692 WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) CL*33 +00693 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*33 +00694 TO WRK-MIS-DUE CL*43 +00695 * DISPLAY 'MIS DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*75 +00696 END-EVALUATE CL**7 +00697 END-PERFORM. CL**6 +00698 CL**6 +00699 IF MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ CL*51 +00700 ADD WRK-SUR-DUE TO L101-PAID-CHNG CL*51 +00701 ELSE CL*51 +00702 MOVE WRK-SUR-DUE TO WRK-SUR-BAL. CL*52 +00703 CL*51 +00704 IF L101-PAID-CHNG > +0 DTSTOP00 +00705 NEXT SENTENCE DTSTOP00 +00706 ELSE DTSTOP00 +00707 DISPLAY 'NO BALANE DUE : ' MQTR-EMP-NO ' ' MQTR-YRQ CL*33 +00708 GO TO P5100-CONTINUE. CL*44 +00709 DTSTOP00 +00710 * DISPLAY 'BAL DUE ' L101-PAID-CHNG CL*75 +00711 * ADD 1 TO WRK-T1-CNT. CL*25 +00712 MOVE 20240710 TO L101-RECEIVED-DATE. CL*69 +00713 * DTSTOP00 +00714 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSTOP00 +00715 * DTSTOP00 +00716 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSTOP00 +00717 * DTSTOP00 +00718 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSTOP00 +00719 * DTSTOP00 +00720 PERFORM S101-PER-MONTH-YES THRU S101-EXIT. DTSTOP00 +00721 * DTSTOP00 +00722 P5100-CONTINUE. CL*44 +00723 * DISPLAY ' INT CHRG ' MQTR-EMP-NO ' ' L101-INT-CHARGE-CHNG CL*75 +00724 CL*13 +00725 COMPUTE WRK-MLIN-QTR-AMT = L101-INT-CHARGE-CHNG + CL*27 +00726 L101-PAID-CHNG + WRK-INT-DUE + WRK-LP-DUE CL*43 +00727 + WRK-NSF-DUE + WRK-MIS-DUE + WRK-SUR-BAL. CL*51 +00728 * DISPLAY 'BAL DUE ' L101-PAID-CHNG CL*75 +00729 CL*53 +00730 MOVE WRK-MLIN-QTR-AMT TO WS-AMT CL*55 +00731 MOVE WS-AMT TO WS-AMT-DISP CL*55 +00732 * DISPLAY 'QTR DUE ' MQTR-YRQ ' ' WS-AMT-DISP CL*81 +00733 CL*76 +00734 IF WS-AMT < 24.95 CL*57 +00735 * DISPLAY 'QTR DUE LESS 2495 ' WS-AMT CL*77 +00736 ADD 1 TO WRK-LESS-CNT CL*69 +00737 GO TO P5100-READ-NEXT. CL*76 +00738 CL*73 +00739 ADD 1 TO WRK-FILE-CNT CL*69 +00740 ADD WRK-MLIN-QTR-AMT TO WRK-TOT-T1-AMT. CL*27 +00741 ADD WRK-MLIN-QTR-AMT TO WRK-MLIN-EMP-AMT. CL*58 +00742 MOVE WRK-MLIN-QTR-AMT TO WRK-MLIN-AMT. CL*62 +00743 * DTSTOP00 +00744 * DISPLAY 'MQTR YRQ ' MQTR-EMP-NO ' ' MQTR-YRQ. CL*75 +00745 * DISPLAY 'LIEN YRQ ' MLIN-EMP-NO CL*74 +00746 * ' ' MLIN-COVERED-YRQ(MLIN-COV-IDX) CL*74 +00747 * MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO D1-LIEN-DATE CL*74 +00748 MOVE MQTR-YRQ TO D1-LIEN-DATE CL*74 +00749 IF D1-LIEN-DATE(5:1) = 1 CL*17 +00750 MOVE 0531 TO D1-LIEN-DATE(5:4) CL*74 +00751 ELSE CL**3 +00752 IF D1-LIEN-DATE(5:1) = 2 CL*17 +00753 MOVE 0831 TO D1-LIEN-DATE(5:4) CL*74 +00754 ELSE CL**3 +00755 IF D1-LIEN-DATE(5:1) = 3 CL*17 +00756 MOVE 1130 TO D1-LIEN-DATE(5:4) CL*74 +00757 ELSE CL**3 +00758 MOVE 0228 TO D1-LIEN-DATE(5:4). CL*74 +00759 CL**2 +00760 ADD 1 TO ACNT. CL*77 +00761 CL*77 +00762 * DISPLAY 'ALPH ' WS-ALPHA(MLIN-COV-IDX) ' ' IN-EAN ' ' CL*74 +00763 * DISPLAY 'ALPH ' WS-ALPHA(ACNT) ' ' IN-EAN ' ' CL*77 +00764 * ' CNT ' MLIN-COV-CNT ' ' CL*78 +00765 * ' D1 ' D1-SEQ-NO(18:1) CL*78 +00766 * ' D2 ' D1-SEQ-NO(18:1). CL*78 +00767 MOVE WRK-MLIN-AMT TO D1-DEBT-AMOUNT CL*17 +00768 CL**3 +00769 MOVE MPRF-FEIN TO D1-EMP-FEIN CL*17 +00770 MOVE MPRF-PRIMARY-NAME(1:35) TO D1-EMP-LNAME CL*22 +00771 CL**3 +00772 CL**3 +00773 * MOVE WRK-MLIN-AMT TO D2-DEBT-AMT CL*19 +00774 DISPLAY '*<<< SPACES CL*19 +00808 MOVE MTAD-DELIV-LINE-1(1:30) TO D2-EMP-ADDR-LINE1 CL*21 +00809 MOVE MTAD-DELIV-LINE-2(1:30) TO D2-EMP-ADDR-LINE2 CL*21 +00810 ELSE CL*19 +00811 MOVE MTAD-DELIV-LINE-2 TO D2-EMP-ADDR-LINE1 CL*20 +00812 MOVE SPACES TO D2-EMP-ADDR-LINE2 CL*20 +00813 END-IF. CL*20 +00814 CL**3 +00815 MOVE MTAD-CITY TO D2-EMP-CITY CL*11 +00816 MOVE MTAD-ST TO D2-EMP-STATE CL*11 +00817 MOVE MTAD-ZIP(1:5) TO D2-EMP-ZIP(1:5) CL*11 +00818 MOVE MTAD-ZIP(7:4) TO D2-EMP-ZIP(6:4). CL*11 +00819 MOVE 1 TO PRINT-LETTER. CL*36 +00820 WRITE OUT-REC FROM TOP-D1-REC CL*17 +00821 WRITE OUT-REC FROM TOP-D2-REC. CL*17 +00822 ADD 2 TO WS-REC-CNT. CL*11 +00823 CL*76 +00824 P5100-READ-NEXT. CL*76 +00825 MOVE ZEROS TO WRK-MLIN-QTR-AMT CL*77 +00826 MOVE ZEROS TO L101-INT-CHARGE-CHNG. CL*77 +00827 MOVE ZEROS TO L101-PAID-CHNG WRK-SUR-DUE WRK-SUR-BAL CL*77 +00828 MOVE ZEROS TO WRK-T1-CNT. CL*77 +00829 MOVE ZEROS TO WRK-INT-DUE WRK-LP-DUE WRK-NSF-DUE WRK-MIS-DUE CL*77 +00830 MOVE MQTR-REC TO MSKL-REC. CL*74 +00831 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*74 +00832 IF L910-NO-REC-88 CL*74 +00833 SET L910-NO-REC-88 TO TRUE CL*74 +00834 GO TO P5100-EXIT. CL*74 +00835 CL*74 +00836 MOVE MSKL-REC TO MQTR-REC. CL*74 +00837 IF MQTR-YRQ > 20234 CL*85 +00838 SET L910-NO-REC-88 TO TRUE. CL*74 +00839 DTSTOP00 +00840 P5100-EXIT. DTSTOP00 +00841 EXIT. DTSTOP00 +00842 DTSTOP00 +00843 DTSTOP00 +00844 T0000-TERMINATE. DTSTOP00 +00845 DTSTOP00 +00846 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT. DTSTOP00 +00847 MOVE WRK-TOT-T1-AMT TO TC-TOTAL-DEBT. CL*14 +00848 MOVE WS-REC-CNT TO TC-RECORD-CNT. CL*11 +00849 WRITE OUT-REC FROM TC-REC. CL*11 +00850 PERFORM S923-CLOSE THRU S923-EXIT. DTSTOP00 +00851 ** PERFORM S927-CLOSE THRU S927-EXIT. DTSTOP00 +00852 DTSTOP00 +00853 * MOVE MHDR-LAST-USED-BATCH-NO TO HOLD-LAST-USED-BATCH-NO. DTSTOP00 +00854 DTSTOP00 +00855 * MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP00 +00856 DTSTOP00 +00857 * PERFORM S910-READ THRU S910-EXIT. DTSTOP00 +00858 * IF L910-NO-REC-88 DTSTOP00 +00859 * MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSTOP00 +00860 * TO ABEND-MSG DTSTOP00 +00861 * PERFORM S999-ABEND THRU S999-EXIT. DTSTOP00 +00862 DTSTOP00 +00863 * MOVE MSKL-REC TO MHDR-REC. DTSTOP00 +00864 * MOVE HOLD-LAST-USED-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSTOP00 +00865 * MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSTOP00 +00866 * MOVE MHDR-REC TO MSKL-REC. DTSTOP00 +00867 DTSTOP00 +00868 * PERFORM S910-REWRITE THRU S910-EXIT. DTSTOP00 +00869 * DISPLAY 'LAST BATCH: ' AHDR-BATCH-NO. DTSTOP00 +00870 DTSTOP00 +00871 DISPLAY ' '. DTSTOP00 +00872 DTSTOP00 +00873 DISPLAY '*** DTSTOP00 TERMINATION STATISTICS ***'. CL*68 +00874 DTSTOP00 +00875 DISPLAY ' '. DTSTOP00 +00876 DTSTOP00 +00877 * DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: ' CL*68 +00878 * WRK-MPRF-CNT. CL*68 +00879 DTSTOP00 +00880 DISPLAY 'NUMBER OF ACCOUNTS READ FOR TOP SELECTION : ' CL*68 +00881 WRK-READ-CNT. DTSTOP00 +00882 DTSTOP00 +00883 DISPLAY 'MUMBER OF EMPLOYERS HAS NO LIEN : ' CL*68 +00884 WRK-LIEN-CNT. CL*68 +00885 CL*68 +00886 DISPLAY 'MUMBER OF EMPLOYERS WITH FEIN = 0 : ' CL*68 +00887 WRK-FEIN-CNT. CL*68 +00888 CL*68 +00889 DISPLAY 'MUMBER OF EMPLOYERS WITH DPC : ' CL*69 +00890 WRK-WDPC-CNT. CL*69 +00891 CL*69 +00892 DISPLAY 'MUMBER OF EMPLOYERS WRITTEN OFF : ' CL*69 +00893 WRK-WOFF-CNT. CL*69 +00894 CL*69 +00895 DISPLAY 'MUMBER OF EMPLOYERS WITH COLLECTIONS SUSPENDED : ' CL*69 +00896 WRK-COLL-CNT. CL*69 +00897 CL*69 +00898 DISPLAY 'MUMBER OF EMPLOYERS IN BANKRUPTCY : ' CL*69 +00899 WRK-BANK-CNT. CL*69 +00900 CL*69 +00901 DISPLAY 'MUMBER OF EMPLOYERS WITH BAD ADDRESS : ' CL*69 +00902 WRK-ADDR-CNT. CL*69 +00903 CL*69 +00904 DISPLAY 'MUMBER OF EMPLOYERS WITH APPEALS : ' CL*69 +00905 WRK-APPS-CNT. CL*69 +00906 CL*69 +00907 DISPLAY 'MUMBER OF LETTERS TO BE PRINTED : ' CL*69 +00908 WRK-PRNT-CNT. CL*69 +00909 CL*69 +00910 DISPLAY 'MUMBER OF EMPLOYERS SENT TO TOPS : ' CL*69 +00911 WRK-FILE-CNT. CL*69 +00912 DTSTOP00 +00913 PERFORM S910-CLOSE THRU S910-EXIT. DTSTOP00 +00914 CLOSE IN-FILE DTSTOP00 +00915 LET-FILE CL*37 +00916 OUT-FILE. CL*37 +00917 DTSTOP00 +00918 T0000-EXIT. DTSTOP00 +00919 EXIT. DTSTOP00 +00920 EJECT DTSTOP00 +00921 DTSTOP00 +00922 **1000-INITIATE-AHDR. DTSTOP00 +00923 ** MOVE LOW-VALUES TO AHDR-REC. DTSTOP00 +00924 ** DTSTOP00 +00925 ** IF MHDR-LAST-USED-BATCH-NO < +99999 DTSTOP00 +00926 ** COMPUTE AHDR-BATCH-NO = MHDR-LAST-USED-BATCH-NO + 1 DTSTOP00 +00927 ** ELSE DTSTOP00 +00928 ** MOVE +1 TO AHDR-BATCH-NO. DTSTOP00 +00929 ** DTSTOP00 +00930 ** MOVE +0 TO AHDR-ITEM-NO. DTSTOP00 +00931 ** SET AHDR-HDR-88 TO TRUE. DTSTOP00 +00932 ** SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSTOP00 +00933 ** SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSTOP00 +00934 ** SET AHDR-ESTB-SYSTEM-88 TO TRUE. DTSTOP00 +00935 ** MOVE SPACES TO AHDR-CHNG-OP-ID. DTSTOP00 +00936 ** MOVE +0 TO AHDR-CHNG-DATE. DTSTOP00 +00937 ** MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE DTSTOP00 +00938 ** AHDR-RECEIVED-DATE DTSTOP00 +00939 ** AHDR-DEPOSIT-DATE. DTSTOP00 +00940 ** MOVE +0 TO AHDR-LAST-USED-ITEM-NO DTSTOP00 +00941 ** AHDR-CONTROL-TRAN-CNT DTSTOP00 +00942 ** AHDR-ATC-FILE-TRAN-CNT DTSTOP00 +00943 ** AHDR-PROC-TRAN-CNT DTSTOP00 +00944 ** AHDR-CONTROL-REMIT-AMT DTSTOP00 +00945 ** AHDR-ATC-FILE-REMIT-AMT DTSTOP00 +00946 ** AHDR-PROC-REMIT-AMT DTSTOP00 +00947 ** AHDR-BANK-BATCH-NO. DTSTOP00 +00948 ** DTSTOP00 +00949 **1000-EXIT. DTSTOP00 +00950 ** EXIT. DTSTOP00 +00951 DTSTOP00 +00952 S2000-TERMINATE-AHDR. DTSTOP00 +00953 IF AHDR-ATC-FILE-TRAN-CNT = +0 DTSTOP00 +00954 GO TO S2000-EXIT. DTSTOP00 +00955 DTSTOP00 +00956 MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSTOP00 +00957 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-LAST-USED-ITEM-NO. DTSTOP00 +00958 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT. DTSTOP00 +00959 MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT. DTSTOP00 +00960 MOVE AHDR-REC TO ASKL-REC. DTSTOP00 +00961 DTSTOP00 +00962 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP00 +00963 DTSTOP00 +00964 S2000-EXIT. DTSTOP00 +00965 EXIT. DTSTOP00 +00966 DTSTOP00 +00967 S004-EDIT-QTR. DTSTOP00 +00968 CALL 'DTSBU004' USING L004-COMM-AREA. DTSTOP00 +00969 DTSTOP00 +00970 S004-EXIT. DTSTOP00 +00971 EXIT. DTSTOP00 +00972 SKIP3 DTSTOP00 +00973 S005-FROM-SYS. DTSTOP00 +00974 SET L005-FROM-SYS TO TRUE. DTSTOP00 +00975 CALL 'DTSBU005' USING L005-LINK-AREA. DTSTOP00 +00976 DTSTOP00 +00977 S005-EXIT. DTSTOP00 +00978 EXIT. DTSTOP00 +00979 DTSTOP00 +00980 DTSTOP00 +00981 S001-FROM-FED-8. DTSTOP00 +00982 SET L001-FROM-FED-8 TO TRUE. DTSTOP00 +00983 GO TO S001-DATE. DTSTOP00 +00984 DTSTOP00 +00985 DTSTOP00 +00986 S001-DATE. DTSTOP00 +00987 CALL 'DTSBU001' USING L001-LINK-AREA. DTSTOP00 +00988 S001-EXIT. DTSTOP00 +00989 EXIT. DTSTOP00 +00990 DTSTOP00 +00991 S101-PER-MONTH-NO. DTSTOP00 +00992 SET L101-PER-MONTH-NO-88 TO TRUE. DTSTOP00 +00993 GO TO S101-INT-PEN-COMP. DTSTOP00 +00994 DTSTOP00 +00995 S101-PER-MONTH-YES. DTSTOP00 +00996 SET L101-PER-MONTH-YES-88 TO TRUE. DTSTOP00 +00997 GO TO S101-INT-PEN-COMP. DTSTOP00 +00998 DTSTOP00 +00999 S101-INT-PEN-COMP. DTSTOP00 +01000 CALL 'DTSBU101' USING L101-LINK-AREA. DTSTOP00 +01001 S101-EXIT. DTSTOP00 +01002 EXIT. DTSTOP00 +01003 S109-SUR-TAX-QTR. CL*49 +01004 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. CL*49 +01005 CL*49 +01006 CALL 'DTSBU109' USING L109-LINK-AREA. CL*49 +01007 S109-EXIT. CL*49 +01008 EXIT. CL*49 +01009 S910-OPEN-READ. DTSTOP00 +01010 SET L910-OPEN-READ-88 TO TRUE. DTSTOP00 +01011 GO TO S910-MSTR-IO. DTSTOP00 +01012 DTSTOP00 +01013 S910-OPEN-UPDATE-NO-AIX. DTSTOP00 +01014 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSTOP00 +01015 GO TO S910-MSTR-IO. DTSTOP00 +01016 DTSTOP00 +01017 S910-OPEN-UPDATE-HDR. DTSTOP00 +01018 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DTSTOP00 +01019 GO TO S910-MSTR-IO. DTSTOP00 +01020 DTSTOP00 +01021 S910-READ. DTSTOP00 +01022 SET L910-READ-88 TO TRUE. DTSTOP00 +01023 GO TO S910-MSTR-IO. DTSTOP00 +01024 DTSTOP00 +01025 S910-START-BROWSE. DTSTOP00 +01026 SET L910-START-BROWSE-88 TO TRUE. DTSTOP00 +01027 GO TO S910-MSTR-IO. DTSTOP00 +01028 DTSTOP00 +01029 S910-READ-NEXT. DTSTOP00 +01030 SET L910-READ-NEXT-88 TO TRUE. DTSTOP00 +01031 GO TO S910-MSTR-IO. DTSTOP00 +01032 DTSTOP00 +01033 S910-COUNT. DTSTOP00 +01034 SET L910-COUNT-88 TO TRUE. DTSTOP00 +01035 GO TO S910-MSTR-IO. DTSTOP00 +01036 DTSTOP00 +01037 S910-REWRITE. DTSTOP00 +01038 SET L910-REWRITE-88 TO TRUE. DTSTOP00 +01039 GO TO S910-MSTR-IO. DTSTOP00 +01040 DTSTOP00 +01041 S910-DELETE. DTSTOP00 +01042 SET L910-DELETE-88 TO TRUE. DTSTOP00 +01043 GO TO S910-MSTR-IO. DTSTOP00 +01044 DTSTOP00 +01045 S910-CLOSE. DTSTOP00 +01046 SET L910-CLOSE-88 TO TRUE. DTSTOP00 +01047 GO TO S910-MSTR-IO. DTSTOP00 +01048 DTSTOP00 +01049 S910-MSTR-IO. DTSTOP00 +01050 CALL 'DTSBU910' USING L910-LINK-AREA DTSTOP00 +01051 MSKL-REC. DTSTOP00 +01052 S910-EXIT. DTSTOP00 +01053 EXIT. DTSTOP00 +01054 SKIP3 DTSTOP00 +01055 S111-LOOKUP-ADDR. DTSTOP00 +01056 CALL 'DTSBU111' USING L111-LINK-AREA. DTSTOP00 +01057 S111-EXIT. DTSTOP00 +01058 EXIT. DTSTOP00 +01059 S923-OPEN-UPDATE. DTSTOP00 +01060 SET L923-OPEN-UPDATE-88 TO TRUE. DTSTOP00 +01061 GO TO S923-ATC-IO. DTSTOP00 +01062 DTSTOP00 +01063 S923-OPEN-READ. DTSTOP00 +01064 SET L923-OPEN-READ-88 TO TRUE. DTSTOP00 +01065 GO TO S923-ATC-IO. DTSTOP00 +01066 DTSTOP00 +01067 S923-READ. DTSTOP00 +01068 SET L923-READ-88 TO TRUE. DTSTOP00 +01069 GO TO S923-ATC-IO. DTSTOP00 +01070 DTSTOP00 +01071 S923-START-BROWSE. DTSTOP00 +01072 SET L923-START-BROWSE-88 TO TRUE. DTSTOP00 +01073 GO TO S923-ATC-IO. DTSTOP00 +01074 DTSTOP00 +01075 S923-READ-NEXT. DTSTOP00 +01076 SET L923-READ-NEXT-88 TO TRUE. DTSTOP00 +01077 GO TO S923-ATC-IO. DTSTOP00 +01078 DTSTOP00 +01079 S923-WRITE. DTSTOP00 +01080 ** DISPLAY 'S923 WRITE ' DTSTOP00 +01081 SET L923-WRITE-88 TO TRUE. DTSTOP00 +01082 GO TO S923-ATC-IO. DTSTOP00 +01083 DTSTOP00 +01084 S923-REWRITE. DTSTOP00 +01085 SET L923-REWRITE-88 TO TRUE. DTSTOP00 +01086 GO TO S923-ATC-IO. DTSTOP00 +01087 DTSTOP00 +01088 S923-DELETE. DTSTOP00 +01089 SET L923-DELETE-88 TO TRUE. DTSTOP00 +01090 GO TO S923-ATC-IO. DTSTOP00 +01091 DTSTOP00 +01092 S923-CLOSE. DTSTOP00 +01093 SET L923-CLOSE-88 TO TRUE. DTSTOP00 +01094 GO TO S923-ATC-IO. DTSTOP00 +01095 DTSTOP00 +01096 S923-ATC-IO. DTSTOP00 +01097 ** DISPLAY 'DTSBU923 ' DTSTOP00 +01098 ** DISPLAY 'L923 LINK AREA ' L923-LINK-AREA DTSTOP00 +01099 CALL 'DTSBU923' USING L923-LINK-AREA DTSTOP00 +01100 ASKL-REC. DTSTOP00 +01101 S923-EXIT. DTSTOP00 +01102 EXIT. DTSTOP00 +01103 SKIP3 DTSTOP00 +01104 S927-OPEN-UPDATE. DTSTOP00 +01105 SET L927-OPEN-UPDATE-88 TO TRUE. DTSTOP00 +01106 GO TO S927-BTC-O. DTSTOP00 +01107 DTSTOP00 +01108 S927-WRITE. DTSTOP00 +01109 SET L927-WRITE-88 TO TRUE. DTSTOP00 +01110 GO TO S927-BTC-O. DTSTOP00 +01111 DTSTOP00 +01112 S927-CLOSE. DTSTOP00 +01113 SET L927-CLOSE-88 TO TRUE. DTSTOP00 +01114 GO TO S927-BTC-O. DTSTOP00 +01115 DTSTOP00 +01116 S927-BTC-O. DTSTOP00 +01117 CALL 'DTSBU927' USING L927-LINK-AREA DTSTOP00 +01118 TSKL-REC. DTSTOP00 +01119 S927-EXIT. DTSTOP00 +01120 EXIT. DTSTOP00 +01121 DTSTOP00 +01122 SKIP3 DTSTOP00 +01123 S999-ABEND. DTSTOP00 +01124 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSTOP00 +01125 S999-EXIT. DTSTOP00 +01126 EXIT. DTSTOP00 diff --git a/Batch/DTSTOP01.cob b/Batch/DTSTOP01.cob new file mode 100644 index 0000000..7a2e3e1 --- /dev/null +++ b/Batch/DTSTOP01.cob @@ -0,0 +1,1469 @@ +00001 IDENTIFICATION DIVISION. 11/08/22 +00002 PROGRAM-ID. DTSBZTOP. DTSTOP01 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV022 +00004 DATE-WRITTEN. DECEMBER 1998. DTSTOP01 +00005 DATE-COMPILED. DTSTOP01 +00006 SKIP3 DTSTOP01 +00007 ***** DTSTOP01 +00008 * DTSTOP01 +00009 * FUNCTION: LIST EMPLOYERS WITH BALANCE GT ZERO DTSTOP01 +00010 * DTSTOP01 +00011 * DTSTOP01 +00012 ***** DTSTOP01 +00013 SKIP3 DTSTOP01 +00014 ENVIRONMENT DIVISION. DTSTOP01 +00015 INPUT-OUTPUT SECTION. DTSTOP01 +00016 SKIP3 DTSTOP01 +00017 FILE-CONTROL. DTSTOP01 +00018 SELECT IN-FILE ASSIGN TO DTSIZ058 DTSTOP01 +00019 FILE STATUS IS ZI57-STATUS. DTSTOP01 +00020 DTSTOP01 +00021 SELECT OUT-FILE ASSIGN TO DTSOZ058 DTSTOP01 +00022 FILE STATUS IS Z057-STATUS. DTSTOP01 +00023 SKIP2 DTSTOP01 +00024 DATA DIVISION. DTSTOP01 +00025 FILE SECTION. DTSTOP01 +00026 DTSTOP01 +00027 FD IN-FILE DTSTOP01 +00028 RECORDING MODE IS F DTSTOP01 +00029 BLOCK CONTAINS 0 RECORDS DTSTOP01 +00030 LABEL RECORDS ARE OMITTED. DTSTOP01 +00031 DTSTOP01 +00032 DTSTOP01 +00033 01 IN-REC. DTSTOP01 +00034 05 IN-EAN PIC X(06). DTSTOP01 +00035 05 FILLER PIC X(14). CL**7 +00036 DTSTOP01 +00037 FD OUT-FILE DTSTOP01 +00038 RECORDING MODE IS F DTSTOP01 +00039 BLOCK CONTAINS 0 RECORDS DTSTOP01 +00040 LABEL RECORDS ARE OMITTED. DTSTOP01 +00041 DTSTOP01 +00042 DTSTOP01 +00043 01 OUT-REC PIC X(200). DTSTOP01 +00044 DTSTOP01 +00045 DTSTOP01 +00046 WORKING-STORAGE SECTION. DTSTOP01 +000465 77 PAN-VALET PICTURE X(24) VALUE '022DTSTOP01 11/08/22'. DTSTOP01 +00047 SKIP3 DTSTOP01 +00048 01 WRK-AREA. DTSTOP01 +00049 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +057.DTSTOP01 +00050 05 ABEND-MSG PIC X(60). DTSTOP01 +00051 DTSTOP01 +00052 05 W-IN-QTR PIC S9(05) COMP-3. DTSTOP01 +00053 05 HOLD-LAST-USED-BATCH-NO PIC S9(05) COMP-3. DTSTOP01 +00054 DTSTOP01 +00055 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ057'.DTSTOP01 +00056 DTSTOP01 +00057 05 Z057-STATUS PIC X(02). DTSTOP01 +00058 88 Z057-FILE-OK-88 VALUE '00'. DTSTOP01 +00059 DTSTOP01 +00060 05 ZI57-STATUS PIC X(02). DTSTOP01 +00061 88 ZI57-FILE-OK-88 VALUE '00'. DTSTOP01 +00062 DTSTOP01 +00063 05 SEQ PIC S9(07) COMP-3 VALUE +0. DTSTOP01 +00064 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSTOP01 +00065 05 WRK-UPDATE-CNT PIC S9(07) COMP-3. DTSTOP01 +00066 05 WRK-READ-CNT PIC 9(07) VALUE 0. CL*17 +00067 05 WRK-EXCLUDE-CNT PIC S9(07) COMP-3. DTSTOP01 +00068 05 WRK-MPRF-AMT PIC S9(09)V99 COMP-3. DTSTOP01 +00069 05 WRK-INTEREST-AMT PIC S9(09)V99 COMP-3. DTSTOP01 +00070 05 WRK-PENALTY-AMT PIC S9(09)V99 COMP-3 VALUE 0.DTSTOP01 +00071 05 WRK-TOT-MLIN-AMT PIC 9(12)V99 VALUE 0. CL*13 +00072 05 WRK-MLIN-AMT PIC 9(10)V99 VALUE 0. CL*13 +00073 05 WRK-LIEN-AMT PIC 9(10)V99 VALUE 0. CL*13 +00074 05 WRK-MLIN-AMTD PIC $$$$$$$$9.99. CL*15 +00075 05 DIS-MLIN-AMT PIC --------9.99. CL*16 +00076 05 DIS-MPRF-AMT PIC --------9.99. CL*16 +00077 05 WRK-REMIT-AMT PIC S9(09)V99 COMP-3. DTSTOP01 +00078 05 WRK-UI-BAL PIC S9(09)V99 COMP-3. DTSTOP01 +00079 05 WRK-MLIN-IND PIC X(01). DTSTOP01 +00080 88 WRK-MLIN-OK VALUE 'Y'. DTSTOP01 +00081 88 WRK-MLIN-NO-REC VALUE 'N'. DTSTOP01 +00082 DTSTOP01 +00083 05 WS-ALPHA OCCURS 20 TIMES PIC X(1). DTSTOP01 +00084 DTSTOP01 +00085 DTSTOP01 +00086 05 TOP-HEADER-OUT. DTSTOP01 +00087 10 OUT-IND PIC X(09) DTSTOP01 +00088 VALUE ' T1'. DTSTOP01 +00089 10 OUT-BATCH-ID. DTSTOP01 +00090 15 OUT-BATCH-YR PIC X(04). DTSTOP01 +00091 15 OUT-BATCH-MM PIC X(02). DTSTOP01 +00092 15 OUT-BATCH-DD PIC X(02). DTSTOP01 +00093 10 FILLER PIC X(182) VALUE SPACES. DTSTOP01 +00094 10 FILLER PIC X(1) VALUE '%'. DTSTOP01 +00095 DTSTOP01 +00096 05 TOP-DETAIL-REC1. DTSTOP01 +00097 10 OUT-AGENCY-ID PIC X(08) VALUE 'D4 '. DTSTOP01 +00098 10 OUT-AGENCY-SITE-ID PIC X(08) VALUE 'TX '. DTSTOP01 +00099 10 OUT-SEQ-NO PIC 9(18). DTSTOP01 +00100 10 OUT-ACTION PIC X(01) VALUE 'A'. DTSTOP01 +00101 10 OUT-REC-TYPE PIC X(01) VALUE '1'. DTSTOP01 +00102 10 OUT-FEIN PIC X(09). DTSTOP01 +00103 10 OUT-EMP-LNAME PIC X(35). DTSTOP01 +00104 10 OUT-EMP-FNAME PIC X(35). DTSTOP01 +00105 10 OUT-EMP-MNAME PIC X(01) VALUE SPACES. DTSTOP01 +00106 10 OUT-DEL-DATE PIC X(08). DTSTOP01 +00107 10 OUT-CONTACT-CODE PIC X(03) VALUE SPACES. DTSTOP01 +00108 10 FILLER PIC X(04) VALUE SPACES. DTSTOP01 +00109 10 OUT-DEBTOR-STATUS PIC X(02) VALUE SPACES. DTSTOP01 +00110 10 FILLER PIC X(01) VALUE SPACES. DTSTOP01 +00111 10 OUT-AMOUNT PIC 9(10)V99. CL*14 +00112 10 OUT-DEBT-TYPE PIC X(02) VALUE 'UT'. CL**5 +00113 10 OUT-FEIN-TYPE PIC X(01) VALUE 'B'. DTSTOP01 +00114 10 OUT-JUDGE-DEBT PIC X(01) VALUE 'J'. DTSTOP01 +00115 10 FILLER PIC X(49) VALUE SPACES. DTSTOP01 +00116 10 FILLER PIC X(01) VALUE '%'. DTSTOP01 +00117 05 TOP-DETAIL-REC2. DTSTOP01 +00118 10 OUT-AGENCY-ID-2 PIC X(08) VALUE 'D4 '. DTSTOP01 +00119 10 OUT-AGENCY-SITE-ID-2 PIC X(08) VALUE 'TX '. DTSTOP01 +00120 10 OUT-SEQ-NO-2 PIC 9(18). DTSTOP01 +00121 10 OUT-ACTION-2 PIC X(01) VALUE 'A'. DTSTOP01 +00122 10 OUT-REC-TYPE-2 PIC X(01) VALUE '2'. DTSTOP01 +00123 10 OUT-EMP-ADDRESS-1 PIC X(30). DTSTOP01 +00124 10 OUT-EMP-ADDRESS-2 PIC X(30) VALUE SPACES. DTSTOP01 +00125 10 OUT-EMP-CITY PIC X(25) VALUE SPACES. DTSTOP01 +00126 10 OUT-EMP-STATE PIC X(02). DTSTOP01 +00127 10 OUT-EMP-ZIP PIC X(09) VALUE SPACES. DTSTOP01 +00128 10 OUT-EMP-COUNTRY PIC X(03) VALUE SPACES. DTSTOP01 +00129 10 OUT-DATE-DEBT PIC X(08) VALUE SPACES. DTSTOP01 +00130 10 OUT-AMOUNT-2 PIC 9(10)V99. CL*14 +00131 10 FILLER PIC X(44) VALUE SPACES. DTSTOP01 +00132 10 FILLER PIC X(1) VALUE '%'. DTSTOP01 +00133 05 TOP-TRAILER. DTSTOP01 +00134 10 FILLER PIC X(04) VALUE 'TOP '. DTSTOP01 +00135 10 OUT-RECORDS PIC 9(08) VALUE ZERO. DTSTOP01 +00136 10 OUT-TOTAL-DEBT PIC 99999999999999. DTSTOP01 +00137 10 OUT-BATCH-DATE. DTSTOP01 +00138 15 OUT-BATCH-YEAR PIC 9(04). DTSTOP01 +00139 15 OUT-BATCH-MONTH PIC 9(02). DTSTOP01 +00140 15 OUT-BATCH-DAY PIC 9(02). DTSTOP01 +00141 10 FILLER PIC X(165) VALUE SPACES. DTSTOP01 +00142 10 FILLER PIC X(1) VALUE '%'. DTSTOP01 +00143 DTSTOP01 +00144 05 WRK-MQTR-CNT PIC S9(07) COMP-3. DTSTOP01 +00145 05 EMP-ACCT-DISP PIC 9(06). DTSTOP01 +00146 05 WRK-TIMELY-PMT-AREA. DTSTOP01 +00147 10 WRK-ERROR-IND PIC X(01). DTSTOP01 +00148 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSTOP01 +00149 88 WRK-ERROR-NO-88 VALUE 'N'. DTSTOP01 +00150 10 WRK-MPAY-FOUND-IND PIC X(01). DTSTOP01 +00151 88 WRK-MPAY-FOUND-YES VALUE 'Y'. DTSTOP01 +00152 88 WRK-MPAY-FOUND-NO VALUE 'N'. DTSTOP01 +00153 10 WRK-MRPT-FOUND-IND PIC X(01). DTSTOP01 +00154 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSTOP01 +00155 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSTOP01 +00156 10 WRK-EMP-SELECTED-IND PIC X(01). DTSTOP01 +00157 88 WRK-EMP-SELECTED-YES VALUE 'Y'. DTSTOP01 +00158 88 WRK-EMP-SELECTED-NO VALUE 'N'. DTSTOP01 +00159 10 WRK-SUPPL-RPT-IND PIC X(01). DTSTOP01 +00160 88 WRK-SUPPL-RPT-YES VALUE 'Y'. DTSTOP01 +00161 88 WRK-SUPPL-RPT-NO VALUE 'N'. DTSTOP01 +00162 10 WRK-WITHDRAWN-RPT-IND PIC X(01). DTSTOP01 +00163 88 WRK-WITHDRAWN-RPT-YES VALUE 'Y'. DTSTOP01 +00164 88 WRK-WITHDRAWN-RPT-NO VALUE 'N'. DTSTOP01 +00165 10 WRK-RPT-BATCH-NO PIC S9(05) COMP-3. DTSTOP01 +00166 10 WRK-RPT-ITEM-NO PIC S9(03) COMP-3. DTSTOP01 +00167 10 WRK-OPID PIC X(08). DTSTOP01 +00168 10 WRITE-OFF PIC X(01) VALUE SPACES. DTSTOP01 +00169 10 WRK-BALANCE-AMT PIC ----------9.99. DTSTOP01 +00170 DTSTOP01 +00171 05 WRK-CERTIFICATE-DATE PIC 9(8) VALUE 0. DTSTOP01 +00172 05 WRK-TIMELY-RPT-AREA. DTSTOP01 +00173 10 WRK-RPT-RECEIVED-DATE PIC S9(09) COMP-3. DTSTOP01 +00174 DTSTOP01 +00175 05 WRK-MNTE-MSG-LINE1. DTSTOP01 +00176 10 WRK-MNTE-MSG-YR PIC X(04). DTSTOP01 +00177 10 FILLER PIC X(01) VALUE '/'. DTSTOP01 +00178 10 WRK-MNTE-MSG-QTR PIC X(01). DTSTOP01 +00179 10 FILLER PIC X(44) VALUE DTSTOP01 +00180 ' QUARTER ANNUAL REPORT FROM TDEC WAS PROCESS'. DTSTOP01 +00181 10 FILLER PIC X(23) VALUE DTSTOP01 +00182 'ED INCORRECTLY BY ESSP '. DTSTOP01 +00183 05 WRK-MNTE-MSG-LINE2. DTSTOP01 +00184 10 FILLER PIC X(48) VALUE DTSTOP01 +00185 'REPORT WITHDRAWN AND REPOSTED CORRECTLY. '. DTSTOP01 +00186 10 FILLER PIC X(23) VALUE DTSTOP01 +00187 ' '. DTSTOP01 +00188 05 WRK-MNTE-MSG-LINE3. DTSTOP01 +00189 10 FILLER PIC X(12) VALUE DTSTOP01 +00190 ' '. DTSTOP01 +00191 DTSTOP01 +00192 05 WRK-MPRF-IND PIC X(01). DTSTOP01 +00193 88 WRK-MPRF-OK VALUE 'Y'. DTSTOP01 +00194 88 WRK-MPRF-NO-REC VALUE 'N'. DTSTOP01 +00195 05 WRK-MQTR-IND PIC X(01). DTSTOP01 +00196 88 WRK-MQTR-OK VALUE 'Y'. DTSTOP01 +00197 88 WRK-MQTR-NO-REC VALUE 'N'. DTSTOP01 +00198 05 WRK-MRPT-IND PIC X(01). DTSTOP01 +00199 88 WRK-MRPT-OK VALUE 'Y'. DTSTOP01 +00200 88 WRK-MRPT-NO-REC VALUE 'N'. DTSTOP01 +00201 DTSTOP01 +00202 05 WRK-T003-CNT PIC S9(07) COMP-3 VALUE +0. DTSTOP01 +00203 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSTOP01 +00204 DTSTOP01 +00205 05 PARM-EOF-IND PIC X(01). DTSTOP01 +00206 DTSTOP01 +00207 05 WRK-EMP-NO PIC 9(06). DTSTOP01 +00208 DTSTOP01 +00209 05 WRK-TRACE-IND PIC X(01). DTSTOP01 +00210 DTSTOP01 +00211 05 WRK-ADDR-CNT PIC 9(01). DTSTOP01 +00212 DTSTOP01 +00213 05 WRK-MST-OPEN-IND PIC X(01). DTSTOP01 +00214 DTSTOP01 +00215 05 WRK-REF-OPEN-IND PIC X(01). DTSTOP01 +00216 DTSTOP01 +00217 ** EJECT DTSTOP01 +00218 01 TSKL-REC. DTSTOP01 +00219 ++INCLUDE DTSITSKL DTSTOP01 +00220 DTSTOP01 +00221 01 L005-LINK-AREA. DTSTOP01 +00222 ++INCLUDE DTSIL005 DTSTOP01 +00223 DTSTOP01 +00224 01 L910-LINK-AREA. DTSTOP01 +00225 ++INCLUDE DTSIL910 DTSTOP01 +00226 EJECT DTSTOP01 +00227 01 MSKL-REC. DTSTOP01 +00228 ++INCLUDE DTSIMSKL DTSTOP01 +00229 EJECT DTSTOP01 +00230 01 MHDR-REC. DTSTOP01 +00231 ++INCLUDE DTSIMHDR DTSTOP01 +00232 EJECT DTSTOP01 +00233 01 MPRF-REC. DTSTOP01 +00234 ++INCLUDE DTSIMPRF DTSTOP01 +00235 EJECT DTSTOP01 +00236 01 MQTR-REC. DTSTOP01 +00237 ++INCLUDE DTSIMQTR DTSTOP01 +00238 EJECT DTSTOP01 +00239 01 MRPT-REC. DTSTOP01 +00240 ++INCLUDE DTSIMRPT DTSTOP01 +00241 EJECT DTSTOP01 +00242 01 MDST-REC. DTSTOP01 +00243 ++INCLUDE DTSIMDST DTSTOP01 +00244 EJECT DTSTOP01 +00245 01 L111-LINK-AREA. DTSTOP01 +00246 ++INCLUDE DTSIL111 DTSTOP01 +00247 EJECT DTSTOP01 +00248 01 MPAY-REC. DTSTOP01 +00249 ++INCLUDE DTSIMPAY DTSTOP01 +00250 EJECT DTSTOP01 +00251 01 MTAD-REC. DTSTOP01 +00252 ++INCLUDE DTSIMTAD DTSTOP01 +00253 EJECT DTSTOP01 +00254 01 MNTE-REC. DTSTOP01 +00255 ++INCLUDE DTSIMNTE DTSTOP01 +00256 EJECT DTSTOP01 +00257 01 L923-LINK-AREA. DTSTOP01 +00258 ++INCLUDE DTSIL923 DTSTOP01 +00259 EJECT DTSTOP01 +00260 01 ASKL-REC. DTSTOP01 +00261 ++INCLUDE DTSIASKL DTSTOP01 +00262 EJECT DTSTOP01 +00263 01 MLIN-REC. DTSTOP01 +00264 ++INCLUDE DTSIMLIN DTSTOP01 +00265 EJECT DTSTOP01 +00266 01 AHDR-REC. DTSTOP01 +00267 ++INCLUDE DTSIAHDR DTSTOP01 +00268 EJECT DTSTOP01 +00269 01 ARPT-REC. DTSTOP01 +00270 ++INCLUDE DTSIARPT DTSTOP01 +00271 EJECT DTSTOP01 +00272 01 APAY-REC. DTSTOP01 +00273 ++INCLUDE DTSIAPAY DTSTOP01 +00274 EJECT DTSTOP01 +00275 01 L927-LINK-AREA. DTSTOP01 +00276 ++INCLUDE DTSIL927 DTSTOP01 +00277 DTSTOP01 +00278 01 L101-LINK-AREA. DTSTOP01 +00279 ++INCLUDE DTSIL101 DTSTOP01 +00280 DTSTOP01 +00281 01 L004-COMM-AREA. DTSTOP01 +00282 ++INCLUDE DTSIL004 DTSTOP01 +00283 EJECT DTSTOP01 +00284 01 TOP-HEADER. DTSTOP01 +00285 ++INCLUDE DTSIXTPH DTSTOP01 +00286 DTSTOP01 +00287 01 TOP-REC-1. DTSTOP01 +00288 ++INCLUDE DTSIXTD1 DTSTOP01 +00289 DTSTOP01 +00290 01 L001-LINK-AREA. DTSTOP01 +00291 ++INCLUDE DTSIL001 DTSTOP01 +00292 01 L112-LINK-AREA. DTSTOP01 +00293 ++INCLUDE DTSIL112 DTSTOP01 +00294 EJECT DTSTOP01 +00295 DTSTOP01 +00296 PROCEDURE DIVISION. DTSTOP01 +00297 DTSTOP01 +00298 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSTOP01 +00299 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSTOP01 +00300 DTSTOP01 +00301 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSTOP01 +00302 SKIP2 DTSTOP01 +00303 GOBACK. DTSTOP01 +00304 EJECT DTSTOP01 +00305 I0000-INITIATE. DTSTOP01 +00306 DTSTOP01 +00307 MOVE 'N' TO WRK-TRACE-IND. DTSTOP01 +00308 DTSTOP01 +00309 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSTOP01 +00310 DTSTOP01 +00311 PERFORM I3000-BATCH-HEADER THRU I3000-EXIT. DTSTOP01 +00312 DTSTOP01 +00313 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSTOP01 +00314 DTSTOP01 +00315 I0000-EXIT. DTSTOP01 +00316 EXIT. DTSTOP01 +00317 DTSTOP01 +00318 I2000-OPEN-FILES-1. DTSTOP01 +00319 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSTOP01 +00320 DTSTOP01 +00321 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSTOP01 +00322 DTSTOP01 +00323 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSTOP01 +00324 ** PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. DTSTOP01 +00325 ** PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT. DTSTOP01 +00326 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSTOP01 +00327 ** PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSTOP01 +00328 DTSTOP01 +00329 OPEN OUTPUT OUT-FILE. DTSTOP01 +00330 IF NOT Z057-FILE-OK-88 DTSTOP01 +00331 DISPLAY 'OUTPUT FILE OPEN ERROR: ' Z057-STATUS DTSTOP01 +00332 PERFORM S999-ABEND THRU S999-EXIT DTSTOP01 +00333 END-IF. DTSTOP01 +00334 DTSTOP01 +00335 OPEN INPUT IN-FILE. DTSTOP01 +00336 IF NOT ZI57-FILE-OK-88 DTSTOP01 +00337 DISPLAY 'INPUT FILE OPEN ERROR: ' ZI57-STATUS DTSTOP01 +00338 PERFORM S999-ABEND THRU S999-EXIT DTSTOP01 +00339 END-IF. DTSTOP01 +00340 DTSTOP01 +00341 I2000-EXIT. DTSTOP01 +00342 EXIT. DTSTOP01 +00343 DTSTOP01 +00344 I3000-BATCH-HEADER. DTSTOP01 +00345 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSTOP01 +00346 MOVE +0 TO MHDR-EMP-NO. DTSTOP01 +00347 SET MHDR-HDR-88 TO TRUE. DTSTOP01 +00348 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +00349 PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +00350 DTSTOP01 +00351 IF L910-NO-REC-88 DTSTOP01 +00352 MOVE 'MHDR RECORD NOT FOUND (I0000)' DTSTOP01 +00353 TO ABEND-MSG DTSTOP01 +00354 PERFORM S999-ABEND THRU S999-EXIT. DTSTOP01 +00355 DTSTOP01 +00356 MOVE MSKL-REC TO MHDR-REC. DTSTOP01 +00357 DTSTOP01 +00358 MOVE MHDR-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSTOP01 +00359 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSTOP01 +00360 MOVE L001-SLASH-8-DATE(1:2) TO OUT-BATCH-MM DTSTOP01 +00361 OUT-BATCH-MONTH. DTSTOP01 +00362 MOVE L001-SLASH-8-DATE(4:2) TO OUT-BATCH-DD DTSTOP01 +00363 OUT-BATCH-DAY. DTSTOP01 +00364 MOVE L001-SLASH-8-DATE(7:4) TO OUT-BATCH-YR DTSTOP01 +00365 OUT-BATCH-YEAR. DTSTOP01 +00366 WRITE OUT-REC FROM TOP-HEADER-OUT. DTSTOP01 +00367 DTSTOP01 +00368 ** PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP01 +00369 DISPLAY 'FIRST BATCH: ' AHDR-BATCH-NO. DTSTOP01 +00370 DTSTOP01 +00371 I3000-EXIT. DTSTOP01 +00372 EXIT. DTSTOP01 +00373 DTSTOP01 +00374 EJECT DTSTOP01 +00375 P0000-PROCESS. DTSTOP01 +00376 DTSTOP01 +00377 READ IN-FILE AT END GO TO P0000-EXIT. DTSTOP01 +00378 DTSTOP01 +00379 MOVE +0 TO WRK-MPRF-CNT DTSTOP01 +00380 WRK-EXCLUDE-CNT DTSTOP01 +00381 WRK-UPDATE-CNT DTSTOP01 +00382 DIS-MLIN-AMT DTSTOP01 +00383 DIS-MPRF-AMT DTSTOP01 +00384 WRK-INTEREST-AMT. DTSTOP01 +00385 SET WRK-ERROR-NO-88 TO TRUE. DTSTOP01 +00386 DTSTOP01 +00387 MOVE 'A' TO WS-ALPHA(1). DTSTOP01 +00388 MOVE 'B' TO WS-ALPHA(2). DTSTOP01 +00389 MOVE 'C' TO WS-ALPHA(3). DTSTOP01 +00390 MOVE 'D' TO WS-ALPHA(4). DTSTOP01 +00391 MOVE 'E' TO WS-ALPHA(5). DTSTOP01 +00392 MOVE 'F' TO WS-ALPHA(6). DTSTOP01 +00393 MOVE 'G' TO WS-ALPHA(7). DTSTOP01 +00394 MOVE 'H' TO WS-ALPHA(8). DTSTOP01 +00395 MOVE 'I' TO WS-ALPHA(9). DTSTOP01 +00396 MOVE 'J' TO WS-ALPHA(10). DTSTOP01 +00397 MOVE 'K' TO WS-ALPHA(11). DTSTOP01 +00398 MOVE 'L' TO WS-ALPHA(12). DTSTOP01 +00399 MOVE 'M' TO WS-ALPHA(13). DTSTOP01 +00400 MOVE 'N' TO WS-ALPHA(14). DTSTOP01 +00401 MOVE 'O' TO WS-ALPHA(15). DTSTOP01 +00402 MOVE 'P' TO WS-ALPHA(16). DTSTOP01 +00403 MOVE 'Q' TO WS-ALPHA(17). DTSTOP01 +00404 MOVE 'R' TO WS-ALPHA(18). DTSTOP01 +00405 MOVE 'S' TO WS-ALPHA(19). DTSTOP01 +00406 MOVE 'T' TO WS-ALPHA(20). DTSTOP01 +00407 DTSTOP01 +00408 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSTOP01 +00409 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSTOP01 +00410 DTSTOP01 +00411 MOVE +0 TO MSKL-EMP-NO. DTSTOP01 +00412 DTSTOP01 +00413 SET MPRF-PRF-88 TO TRUE. DTSTOP01 +00414 MOVE IN-EAN TO MPRF-EMP-NO DTSTOP01 +00415 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +00416 PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +00417 IF L910-OK-88 DTSTOP01 +00418 MOVE MSKL-REC TO MPRF-REC DTSTOP01 +00419 SET WRK-MPRF-OK TO TRUE DTSTOP01 +00420 ELSE DTSTOP01 +00421 DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSTOP01 +00422 SET L910-NO-REC-88 TO TRUE DTSTOP01 +00423 GO TO P0000-EXIT. DTSTOP01 +00424 DTSTOP01 +00425 DISPLAY 'LIST OF EMPLOYERS WITH BALANCE DUE GT ZERO. '. DTSTOP01 +00426 * DISPLAY 'REPORT DTSBZ063 - AUTOMATIC WITHDRAWALS '. DTSTOP01 +00427 * DISPLAY SPACE. DTSTOP01 +00428 DTSTOP01 +00429 PERFORM P1000-READ-NEXT THRU P1000-EXIT DTSTOP01 +00430 UNTIL WRK-MPRF-NO-REC DTSTOP01 +00431 OR WRK-ERROR-YES-88. DTSTOP01 +00432 ** OR MPRF-EMP-NO > 020999. DTSTOP01 +00433 ** OR WRK-REL-CNT > +100. DTSTOP01 +00434 P0000-EXIT. DTSTOP01 +00435 EXIT. DTSTOP01 +00436 EJECT DTSTOP01 +00437 P1000-READ-NEXT. DTSTOP01 +00438 DTSTOP01 +00439 IF MPRF-BANKRP-OPEN-88 DTSTOP01 +00440 DISPLAY 'IN-EAN1' IN-EAN DTSTOP01 +00441 GO TO P1000-READ-CONTINUE. DTSTOP01 +00442 DTSTOP01 +00443 IF MPRF-TOT-BALANCE-AMT < 99 DTSTOP01 +00444 DISPLAY 'IN-EAN2' IN-EAN DTSTOP01 +00445 GO TO P1000-READ-CONTINUE. DTSTOP01 +00446 DTSTOP01 +00447 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSTOP01 +00448 DISPLAY 'IN-EAN3' IN-EAN DTSTOP01 +00449 GO TO P1000-READ-CONTINUE. DTSTOP01 +00450 DTSTOP01 +00451 ** IF MPRF-ESTB-DATE < 20050101 DTSTOP01 +00452 ** DISPLAY 'IN-EAN4' IN-EAN DTSTOP01 +00453 ** GO TO P1000-READ-CONTINUE. DTSTOP01 +00454 DTSTOP01 +00455 ** IF MPRF-ESTB-DATE > 20140701 DTSTOP01 +00456 ** DISPLAY 'IN-EAN5' IN-EAN DTSTOP01 +00457 ** GO TO P1000-READ-CONTINUE. DTSTOP01 +00458 DTSTOP01 +00459 IF MPRF-NOT-WRITTEN-OFF-88 DTSTOP01 +00460 MOVE 'N' TO WRITE-OFF DTSTOP01 +00461 ELSE DTSTOP01 +00462 MOVE 'Y' TO WRITE-OFF. DTSTOP01 +00463 DTSTOP01 +00464 MOVE ZEROS TO DIS-MLIN-AMT WRK-MLIN-AMT DTSTOP01 +00465 DIS-MPRF-AMT WRK-MPRF-AMT. DTSTOP01 +00466 ** MOVE ZEROS TO WRK-CERTIFICATE-DATE DTSTOP01 +00467 ADD 1 TO WRK-READ-CNT. CL*17 +00468 DISPLAY '>>>>>>INREC-EAN ' IN-EAN CL*17 +00469 IF MPRF-MLIN-IND NOT = 'Y' CL**9 +00470 DISPLAY '>>>>>>MLIN-NOT Y ' MPRF-MLIN-IND CL*17 +00471 GO TO P1000-READ-CONTINUE. CL**9 +00472 MOVE MPRF-FEIN TO OUT-FEIN DTSTOP01 +00473 MOVE MPRF-PRIMARY-NAME TO OUT-EMP-LNAME DTSTOP01 +00474 PERFORM P7000-SCAN-LIN THRU P7000-EXIT DTSTOP01 +00475 MOVE WRK-MLIN-AMT TO OUT-AMOUNT-2 CL**5 +00476 DISPLAY 'MLIN-AMT; ' WRK-MLIN-AMT CL*10 +00477 DISPLAY 'MLIN-OUT; ' OUT-AMOUNT-2 CL*10 +00478 ADD WRK-MLIN-AMT TO WRK-LIEN-AMT DTSTOP01 +00479 IF WRK-MLIN-AMT > 0.00 DTSTOP01 +00480 MOVE ZEROS TO OUT-SEQ-NO(1:17) DTSTOP01 +00481 OUT-SEQ-NO-2(1:17) DTSTOP01 +00482 MOVE IN-EAN TO OUT-SEQ-NO(12:6) DTSTOP01 +00483 OUT-SEQ-NO-2(12:6) DTSTOP01 +00484 MOVE MPRF-EMP-STATUS TO OUT-DEBTOR-STATUS DTSTOP01 +00485 ** ELSE DTSTOP01 +00486 ** GO TO P1000-READ-CONTINUE DTSTOP01 +00487 DTSTOP01 +00488 ** MOVE MPRF-EMP-STATUS TO OUT-DEBTOR-STATUS DTSTOP01 +00489 DTSTOP01 +00490 ** IF OUT-DEBTOR-STATUS = 'A' DTSTOP01 +00491 MOVE SPACES TO OUT-DEBTOR-STATUS DTSTOP01 +00492 ** END-IF DTSTOP01 +00493 ** WRITE OUT-REC FROM TOP-DETAIL-REC1 DTSTOP01 +00494 MOVE 1 TO WRK-ADDR-CNT DTSTOP01 +00495 * DISPLAY 'MLIN-COVERED-YRQ ' MLIN-COVERED-YRQ(1) CL**4 +00496 PERFORM P4000-PROCESS-MTAD THRU P4000-EXIT. CL**8 +00497 * UNTIL L910-NO-REC-88. CL**8 +00498 CL*11 +00499 GO TO P1000-READ-CONTINUE. CL*11 +00500 DTSTOP01 +00501 P4000-PROCESS-MTAD. DTSTOP01 +00502 IF MPRF-EMP-NO = 022647 DTSTOP01 +00503 DISPLAY 'P4 ' MPRF-EMP-NO DTSTOP01 +00504 END-IF. DTSTOP01 +00505 DTSTOP01 +00506 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSTOP01 +00507 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSTOP01 +00508 SET MTAD-TAD-88 TO TRUE. DTSTOP01 +00509 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. CL**4 +00510 CL**4 +00511 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +00512 DTSTOP01 +00513 * PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 +00514 PERFORM S910-READ THRU S910-EXIT. CL**4 +00515 DTSTOP01 +00516 PERFORM P4100-SCAN-MTAD THRU P4100-EXIT. CL**4 +00517 * UNTIL L910-NO-REC-88. CL**4 +00518 DTSTOP01 +00519 P4000-EXIT. DTSTOP01 +00520 EXIT. DTSTOP01 +00521 EJECT DTSTOP01 +00522 DTSTOP01 +00523 DTSTOP01 +00524 P4100-SCAN-MTAD. DTSTOP01 +00525 DTSTOP01 +00526 MOVE MSKL-REC TO MTAD-REC. DTSTOP01 +00527 IF MTAD-ID-NO = +001 DTSTOP01 +00528 ** AND WRK-ADDR-CNT = 0 DTSTOP01 +00529 PERFORM P4110-WRITE-MTAD-REC THRU P4110-EXIT. DTSTOP01 +00530 DTSTOP01 +00531 * PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 +00532 DTSTOP01 +00533 P4100-EXIT. DTSTOP01 +00534 EXIT. DTSTOP01 +00535 EJECT DTSTOP01 +00536 DTSTOP01 +00537 DTSTOP01 +00538 P4110-WRITE-MTAD-REC. DTSTOP01 +00539 DTSTOP01 +00540 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSTOP01 +00541 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSTOP01 +00542 SET L111-LOOKUP-TAD-88 TO TRUE. DTSTOP01 +00543 DTSTOP01 +00544 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSTOP01 +00545 MOVE MTAD-ID-NO TO L111-ID-NO. DTSTOP01 +00546 DTSTOP01 +00547 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSTOP01 +00548 DTSTOP01 +00549 IF L111-ADDR-FOUND-88 DTSTOP01 +00550 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE DTSTOP01 +00551 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSTOP01 +00552 SET L112-TAD-ADDR-88 TO TRUE DTSTOP01 +00553 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSTOP01 +00554 ** PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT DTSTOP01 +00555 DTSTOP01 +00556 DTSTOP01 +00557 * MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. CL**4 +00558 * PERFORM S910-READ THRU S910-EXIT. CL**4 +00559 * IF L910-NO-REC-88 CL**4 +00560 * PERFORM S999-ABEND THRU S999-EXIT. CL**4 +00561 DTSTOP01 +00562 DTSTOP01 +00563 * MOVE MSKL-REC TO MTAD-REC. CL**4 +00564 DTSTOP01 +00565 IF MTAD-DELIV-LINE-2 > SPACES CL*21 +00566 MOVE MTAD-DELIV-LINE-1 TO OUT-EMP-ADDRESS-1 DTSTOP01 +00567 MOVE MTAD-DELIV-LINE-2 TO OUT-EMP-ADDRESS-2 DTSTOP01 +00568 ELSE CL*21 +00569 MOVE MTAD-DELIV-LINE-1 TO OUT-EMP-ADDRESS-2 CL*20 +00570 MOVE SPACES TO OUT-EMP-ADDRESS-1 CL*20 +00571 END-IF. CL*20 +00572 CL*21 +00573 MOVE MTAD-CITY TO OUT-EMP-CITY DTSTOP01 +00574 MOVE MTAD-ST TO OUT-EMP-STATE DTSTOP01 +00575 MOVE MTAD-ZIP(1:5) TO OUT-EMP-ZIP(1:5) DTSTOP01 +00576 MOVE MTAD-ZIP(7:4) TO OUT-EMP-ZIP(6:4) DTSTOP01 +00577 CL**4 +00578 GO TO P4110-CONTINUE. CL**4 +00579 CL**4 +00580 IF MTAD-ID-NO = +001 AND WRK-ADDR-CNT = 1 DTSTOP01 +00581 * PERFORM CL**5 +00582 * VARYING MLIN-COV-IDX FROM +1 BY +1 CL**5 +00583 * UNTIL MLIN-COV-IDX > MLIN-COV-CNT CL**5 +00584 PERFORM P5000-READ-MQTR THRU P5000-EXIT CL**4 +00585 IF L101-PAID-CHNG > ZEROS CL**4 +00586 MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO OUT-DEL-DATE CL**4 +00587 IF OUT-DEL-DATE(5:1) = 1 CL**4 +00588 MOVE 0101 TO OUT-DEL-DATE(5:4) DTSTOP01 +00589 ELSE CL**4 +00590 IF OUT-DEL-DATE(5:1) = 2 DTSTOP01 +00591 MOVE 0401 TO OUT-DEL-DATE(5:4) DTSTOP01 +00592 ELSE DTSTOP01 +00593 IF OUT-DEL-DATE(5:1) = 3 DTSTOP01 +00594 MOVE 0701 TO OUT-DEL-DATE(5:4) DTSTOP01 +00595 ELSE DTSTOP01 +00596 MOVE 1001 TO OUT-DEL-DATE(5:4) DTSTOP01 +00597 END-IF DTSTOP01 +00598 END-IF DTSTOP01 +00599 END-IF CL**4 +00600 END-IF CL**4 +00601 ADD 2 TO OUT-RECORDS. CL**5 +00602 CL**5 +00603 P4110-CONTINUE. CL**4 +00604 MOVE WS-ALPHA(MLIN-COV-IDX) TO OUT-SEQ-NO(18:1) DTSTOP01 +00605 OUT-SEQ-NO-2(18:1) DTSTOP01 +00606 MOVE WRK-MPRF-AMT TO OUT-AMOUNT CL**4 +00607 * MOVE WRK-LIEN-AMT TO OUT-AMOUNT CL**4 +00608 * DISPLAY 'WAMT ' WRK-LIEN-AMT CL**4 +00609 * DISPLAY 'OAMT ' OUT-AMOUNT CL**4 +00610 WRITE OUT-REC FROM TOP-DETAIL-REC1 DTSTOP01 +00611 WRITE OUT-REC FROM TOP-DETAIL-REC2 DTSTOP01 +00612 * END-PERFORM CL**5 +00613 * END-IF. CL**5 +00614 DTSTOP01 +00615 ADD 1 TO WRK-ADDR-CNT. DTSTOP01 +00616 DISPLAY 'OUT-RECORDS ' OUT-RECORDS. DTSTOP01 +00617 ** ELSE DTSTOP01 +00618 ** PERFORM P1000-READ-CONTINUE. DTSTOP01 +00619 DTSTOP01 +00620 P4110-EXIT. DTSTOP01 +00621 EXIT. DTSTOP01 +00622 DTSTOP01 +00623 P1000-READ-CONTINUE. DTSTOP01 +00624 DTSTOP01 +00625 READ IN-FILE AT END DTSTOP01 +00626 SET WRK-MPRF-NO-REC TO TRUE DTSTOP01 +00627 GO TO P1000-EXIT. DTSTOP01 +00628 SET MPRF-PRF-88 TO TRUE. DTSTOP01 +00629 MOVE IN-EAN TO MPRF-EMP-NO DTSTOP01 +00630 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +00631 PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +00632 IF L910-OK-88 DTSTOP01 +00633 MOVE MSKL-REC TO MPRF-REC DTSTOP01 +00634 SET WRK-MPRF-OK TO TRUE DTSTOP01 +00635 ELSE DTSTOP01 +00636 ** DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSTOP01 +00637 SET L910-NO-REC-88 TO TRUE DTSTOP01 +00638 GO TO P0000-EXIT. DTSTOP01 +00639 ** PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP01 +00640 DTSTOP01 +00641 ** MOVE IN-EAN TO MSKL-REC. DTSTOP01 +00642 DTSTOP01 +00643 ** READ IN-FILE AT END DTSTOP01 +00644 ** SET WRK-MPRF-NO-REC TO TRUE DTSTOP01 +00645 ** GO TO P1000-EXIT. DTSTOP01 +00646 DTSTOP01 +00647 ** IF NOT L910-OK-88 DTSTOP01 +00648 ** SET WRK-MPRF-NO-REC TO TRUE DTSTOP01 +00649 ** ELSE DTSTOP01 +00650 ** SET WRK-MPRF-OK TO TRUE DTSTOP01 +00651 ** MOVE MSKL-REC TO MPRF-REC. DTSTOP01 +00652 DTSTOP01 +00653 P1000-EXIT. DTSTOP01 +00654 EXIT. DTSTOP01 +00655 DTSTOP01 +00656 P7000-SCAN-LIN. DTSTOP01 +00657 DTSTOP01 +00658 MOVE 'Y' TO WRK-MLIN-IND. DTSTOP01 +00659 MOVE ZEROS TO WRK-MLIN-AMT DTSTOP01 +00660 MOVE ZEROS TO DIS-MLIN-AMT DTSTOP01 +00661 MOVE LOW-VALUES TO MLIN-KEY-AREA. DTSTOP01 +00662 MOVE MPRF-EMP-NO TO MLIN-EMP-NO. DTSTOP01 +00663 SET MLIN-LIN-88 TO TRUE. DTSTOP01 +00664 MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +00665 DTSTOP01 +00666 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP01 +00667 IF L910-NO-REC-88 DTSTOP01 +00668 GO TO P7000-EXIT DTSTOP01 +00669 ELSE DTSTOP01 +00670 PERFORM P7100-SCAN-MLIN THRU P7100-EXIT DTSTOP01 +00671 UNTIL WRK-MLIN-NO-REC. DTSTOP01 +00672 DTSTOP01 +00673 P7000-EXIT. DTSTOP01 +00674 EXIT. DTSTOP01 +00675 P7100-SCAN-MLIN. DTSTOP01 +00676 DTSTOP01 +00677 DTSTOP01 +00678 MOVE MSKL-REC TO MLIN-REC. DTSTOP01 +00679 DTSTOP01 +00680 IF MLIN-STATUS-ACTIVE-88 DTSTOP01 +00681 * PERFORM 7200-READ-PROFILE THRU 7200-EXIT DTSTOP01 +00682 * MOVE MLIN-COMP-DATE TO WRK-CERTIFICATE-DATE DTSTOP01 +00683 P5000-READ-MQTR THRU P5000-EXIT CL*22 +00684 ADD MLIN-STMT-DUE-AMT TO WRK-TOT-MLIN-AMT CL*19 +00685 ADD MLIN-STMT-DUE-AMT TO WRK-MLIN-AMT CL*19 +00686 MOVE WRK-MLIN-AMT TO WRK-MLIN-AMTD. CL*15 +00687 ** SET WRK-MLIN-NO-REC TO TRUE DTSTOP01 +00688 ** GO TO P7100-EXIT. DTSTOP01 +00689 DTSTOP01 +00690 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP01 +00691 IF L910-NO-REC-88 DTSTOP01 +00692 DISPLAY '>>>> LIEN AMT: ' MLIN-EMP-NO ' ' WRK-MLIN-AMT CL*19 +00693 DISPLAY ' DISPLIEN AMT: ' WRK-MLIN-AMTD CL*19 +00694 SET WRK-MLIN-NO-REC TO TRUE. DTSTOP01 +00695 DTSTOP01 +00696 P7100-EXIT. DTSTOP01 +00697 EXIT. DTSTOP01 +00698 DTSTOP01 +00699 P5000-READ-MQTR. DTSTOP01 +00700 DISPLAY '>>>> P5000-READ-MQTR>>>> ' MPRF-EMP-NO. DTSTOP01 +00701 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSTOP01 +00702 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSTOP01 +00703 MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO DTSTOP01 +00704 MQTR-YRQ. DTSTOP01 +00705 MOVE ZEROS TO WRK-MPRF-AMT. DTSTOP01 +00706 DTSTOP01 +00707 SET MQTR-QTR-88 TO TRUE. DTSTOP01 +00708 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +00709 DTSTOP01 +00710 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP01 +00711 DTSTOP01 +00712 IF L910-NO-REC-88 DTSTOP01 +00713 DISPLAY ' BQTR REC NOT FOUND ' MPRF-EMP-NO DTSTOP01 +00714 GO TO P5000-EXIT. DTSTOP01 +00715 PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +00716 DTSTOP01 +00717 IF L910-NO-REC-88 DTSTOP01 +00718 DISPLAY ' RQTR REC NOT FOUND ' MPRF-EMP-NO DTSTOP01 +00719 GO TO P5000-EXIT. DTSTOP01 +00720 DTSTOP01 +00721 MOVE MSKL-REC TO MQTR-REC. DTSTOP01 +00722 PERFORM P5100-MQTR-SCAN THRU P5100-EXIT. DTSTOP01 +00723 ** UNTIL L910-NO-REC-88. DTSTOP01 +00724 DTSTOP01 +00725 DTSTOP01 +00726 P5000-EXIT. DTSTOP01 +00727 EXIT. DTSTOP01 +00728 DTSTOP01 +00729 P5100-MQTR-SCAN. DTSTOP01 +00730 DISPLAY '>>>> P5100-READ-MQTR>>> ' MPRF-EMP-NO. DTSTOP01 +00731 MOVE ZEROS TO L101-PAID-CHNG. DTSTOP01 +00732 ** PERFORM DTSTOP01 +00733 ** VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSTOP01 +00734 ** UNTIL MQTR-ACCT-IDX > 3 DTSTOP01 +00735 ** VARYING DTSTOP01 +00736 ** UNTIL MLIN-COVERED-YRQ(MLIN-COV-IDX) = DTSTOP01 +00737 ** MQTR-YRQ DTSTOP01 +00738 DTSTOP01 +00739 ** DISPLAY ' MLIN-COVERED-YRQ(MLIN-COV-IDX) ' DTSTOP01 +00740 ** MLIN-COVERED-YRQ(MLIN-COV-IDX) DTSTOP01 +00741 * DISPLAY ' MQTR-BALANCE-AMT ' CL**4 +00742 * MQTR-BALANCE-AMT(1) CL**4 +00743 * MOVE MQTR-BALANCE-AMT (1) CL**4 +00744 * TO WRK-MPRF-AMT CL**4 +00745 * ADD WRK-MPRF-AMT TO WRK-MLIN-AMT CL**4 +00746 * DISPLAY 'WRK-MPRF-AMT ' WRK-MPRF-AMT CL**4 +00747 * DISPLAY 'WRK-MLIN-AMT ' WRK-MLIN-AMT CL**4 +00748 ** END-PERFORM. DTSTOP01 +00749 * DISPLAY 'MQTR AMT: ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL**4 +00750 * DISPLAY 'WRK AMT: ' WRK-MPRF-AMT. CL**4 +00751 * IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 0 DTSTOP01 +00752 * PERFORM P5001-READ-MRPT THRU P5001-EXIT DTSTOP01 +00753 * END-IF DTSTOP01 +00754 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL**4 +00755 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL**4 +00756 TO L101-PAID-CHNG CL**4 +00757 END-IF CL**4 +00758 CL**4 +00759 IF L101-PAID-CHNG > +0 CL**4 +00760 NEXT SENTENCE CL**4 +00761 ELSE CL**4 +00762 GO TO P5100-EXIT. CL**5 +00763 CL**4 +00764 MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE. CL**4 +00765 * IF L101-RECEIVED-DATE > 0 DTSTOP01 +00766 * NEXT SENTENCE DTSTOP01 +00767 * ELSE DTSTOP01 +00768 * DISPLAY ' RPT REC NOT FOUND- NO INT ' MPRF-EMP-NO DTSTOP01 +00769 * GO TO P5100-CONTINUE. DTSTOP01 +00770 * DTSTOP01 +00771 SET L101-WAIVE-INT-NO-88 TO TRUE. CL**4 +00772 * SET L101-ABATE-PEN-NO-88 TO TRUE. CL**5 +00773 * DTSTOP01 +00774 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. CL**4 +00775 * DTSTOP01 +00776 MOVE MQTR-INT-AREA TO L101-INT-AREA. CL**4 +00777 * DTSTOP01 +00778 PERFORM S101-PER-MONTH-YES THRU S101-EXIT. CL**4 +00779 * DTSTOP01 +00780 * ADD L101-INT-CHARGE-CHNG TO WRK-MPRF-AMT. CL**4 +00781 MOVE L101-INT-CHARGE-CHNG TO WRK-MPRF-AMT. CL**4 +00782 * DTSTOP01 +00783 *P5100-CONTINUE. DTSTOP01 +00784 * MOVE MQTR-REC TO MSKL-REC. DTSTOP01 +00785 * PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP01 +00786 * IF L910-NO-REC-88 DTSTOP01 +00787 * SET L910-NO-REC-88 TO TRUE DTSTOP01 +00788 * GO TO P5100-EXIT. DTSTOP01 +00789 * DTSTOP01 +00790 * MOVE MSKL-REC TO MQTR-REC. DTSTOP01 +00791 DTSTOP01 +00792 P5100-EXIT. DTSTOP01 +00793 EXIT. DTSTOP01 +00794 DTSTOP01 +00795 P5001-READ-MRPT. DTSTOP01 +00796 * DISPLAY '>>>> P5001-READ-MRPT>>>>> ' MPRF-EMP-NO. DTSTOP01 +00797 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP01 +00798 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP01 +00799 MOVE MQTR-YRQ TO MRPT-YRQ DTSTOP01 +00800 DTSTOP01 +00801 SET MRPT-RPT-88 TO TRUE. DTSTOP01 +00802 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +00803 DTSTOP01 +00804 MOVE ZEROS TO L101-RECEIVED-DATE. DTSTOP01 +00805 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP01 +00806 DTSTOP01 +00807 IF L910-NO-REC-88 DTSTOP01 +00808 DISPLAY ' RPT REC NOT FOUND ' MPRF-EMP-NO DTSTOP01 +00809 MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE DTSTOP01 +00810 GO TO P5001-EXIT. DTSTOP01 +00811 DTSTOP01 +00812 PERFORM P5002-MRPT-SCAN THRU P5002-EXIT DTSTOP01 +00813 UNTIL L910-NO-REC-88. DTSTOP01 +00814 DTSTOP01 +00815 DTSTOP01 +00816 P5001-EXIT. DTSTOP01 +00817 EXIT. DTSTOP01 +00818 DTSTOP01 +00819 P5002-MRPT-SCAN. DTSTOP01 +00820 * DISPLAY '>>>> P5002-SCAN-MRPT>>> ' MPRF-EMP-NO. DTSTOP01 +00821 MOVE MSKL-REC TO MRPT-REC. DTSTOP01 +00822 IF MRPT-ORIG-88 OR MRPT-ESTIM-88 DTSTOP01 +00823 MOVE MRPT-RECEIVED-DATE TO L101-RECEIVED-DATE DTSTOP01 +00824 SET L910-NO-REC-88 TO TRUE DTSTOP01 +00825 GO TO P5002-EXIT. DTSTOP01 +00826 DTSTOP01 +00827 MOVE MRPT-REC TO MSKL-REC. DTSTOP01 +00828 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP01 +00829 IF L910-NO-REC-88 DTSTOP01 +00830 SET L910-NO-REC-88 TO TRUE DTSTOP01 +00831 GO TO P5002-EXIT. DTSTOP01 +00832 DTSTOP01 +00833 DTSTOP01 +00834 P5002-EXIT. DTSTOP01 +00835 EXIT. DTSTOP01 +00836 P5111-SUM-PENALTY. DTSTOP01 +00837 PERFORM DTSTOP01 +00838 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSTOP01 +00839 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSTOP01 +00840 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSTOP01 +00841 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSTOP01 +00842 TO WRK-PENALTY-AMT DTSTOP01 +00843 ELSE DTSTOP01 +00844 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSTOP01 +00845 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSTOP01 +00846 TO WRK-UI-BAL DTSTOP01 +00847 END-IF DTSTOP01 +00848 END-IF DTSTOP01 +00849 END-PERFORM. DTSTOP01 +00850 DTSTOP01 +00851 P5111-EXIT. DTSTOP01 +00852 EXIT. DTSTOP01 +00853 DTSTOP01 +00854 DTSTOP01 +00855 **5120-FIND-REPORT. DTSTOP01 +00856 ** DTSTOP01 +00857 ** DISPLAY '*** P5120-1 ' MPRF-EMP-NO DTSTOP01 +00858 ** ' ' MQTR-YRQ. DTSTOP01 +00859 ** DTSTOP01 +00860 ** SET WRK-EMP-SELECTED-NO TO TRUE DTSTOP01 +00861 ** MOVE ZERO TO WRK-RPT-RECEIVED-DATE DTSTOP01 +00862 ** WRK-RPT-BATCH-NO DTSTOP01 +00863 ** WRK-RPT-ITEM-NO. DTSTOP01 +00864 ** SET WRK-SUPPL-RPT-NO TO TRUE. DTSTOP01 +00865 ** SET WRK-WITHDRAWN-RPT-NO TO TRUE. DTSTOP01 +00866 ** DTSTOP01 +00867 ** MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP01 +00868 ** MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP01 +00869 ** MOVE MQTR-YRQ TO MRPT-YRQ. DTSTOP01 +00870 ** MOVE ZEROS TO MRPT-BATCH-NO. DTSTOP01 +00871 ** MOVE ZEROS TO MRPT-ITEM-NO DTSTOP01 +00872 ** DTSTOP01 +00873 ** SET MRPT-RPT-88 TO TRUE. DTSTOP01 +00874 ** MOVE MRPT-REC TO MSKL-REC. DTSTOP01 +00875 ** DTSTOP01 +00876 ** PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP01 +00877 ** IF L910-OK-88 DTSTOP01 +00878 ** PERFORM P5121-SCAN-MRPT THRU P5121-EXIT DTSTOP01 +00879 ** UNTIL L910-NO-REC-88. DTSTOP01 +00880 ** DTSTOP01 +00881 ** IF WRK-EMP-SELECTED-YES DTSTOP01 +00882 ** SET WRK-MRPT-OK TO TRUE DTSTOP01 +00883 ** DISPLAY ' MRPT REPORT SELECTED ' MPRF-EMP-NO ' ' MRPT-YRQ DTSTOP01 +00884 ** GO TO P5120-EXIT DTSTOP01 +00885 ** END-IF. DTSTOP01 +00886 ** DTSTOP01 +00887 ** DTSTOP01 +00888 **5120-EXIT. DTSTOP01 +00889 ** EXIT. DTSTOP01 +00890 DTSTOP01 +00891 **5121-SCAN-MRPT. DTSTOP01 +00892 ** MOVE MSKL-REC TO MRPT-REC. DTSTOP01 +00893 IF MRPT-YRQ = MQTR-YRQ DTSTOP01 +00894 NEXT SENTENCE DTSTOP01 +00895 ELSE DTSTOP01 +00896 IF MRPT-YRQ > MQTR-YRQ DTSTOP01 +00897 SET WRK-EMP-SELECTED-NO TO TRUE DTSTOP01 +00898 SET L910-NO-REC-88 TO TRUE DTSTOP01 +00899 GO TO P5121-EXIT DTSTOP01 +00900 ELSE DTSTOP01 +00901 GO TO P5121-READ-NEXT DTSTOP01 +00902 END-IF DTSTOP01 +00903 END-IF. DTSTOP01 +00904 DTSTOP01 +00905 IF MRPT-ORIG-88 AND MRPT-RESPONSIBLE-OP-ID = 'WEBESSP ' DTSTOP01 +00906 MOVE MRPT-BATCH-NO TO WRK-RPT-BATCH-NO DTSTOP01 +00907 MOVE MRPT-ITEM-NO TO WRK-RPT-ITEM-NO DTSTOP01 +00908 SET WRK-EMP-SELECTED-YES TO TRUE DTSTOP01 +00909 SET L910-NO-REC-88 TO TRUE DTSTOP01 +00910 GO TO P5121-EXIT DTSTOP01 +00911 END-IF. DTSTOP01 +00912 DTSTOP01 +00913 DTSTOP01 +00914 P5121-READ-NEXT. DTSTOP01 +00915 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP01 +00916 IF L910-NO-REC-88 DTSTOP01 +00917 SET WRK-MRPT-NO-REC TO TRUE. DTSTOP01 +00918 DTSTOP01 +00919 P5121-EXIT. DTSTOP01 +00920 EXIT. DTSTOP01 +00921 DTSTOP01 +00922 DTSTOP01 +00923 P5131-READ-MRPT-MPAY. DTSTOP01 +00924 ** DISPLAY 'P5131 READ MRPT MPAY ' DTSTOP01 +00925 SET WRK-MPAY-FOUND-YES TO TRUE. DTSTOP01 +00926 SET WRK-MRPT-FOUND-YES TO TRUE. DTSTOP01 +00927 MOVE ZERO TO WRK-REMIT-AMT. DTSTOP01 +00928 DTSTOP01 +00929 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP01 +00930 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP01 +00931 MOVE MQTR-YRQ TO MRPT-YRQ. DTSTOP01 +00932 MOVE WRK-RPT-BATCH-NO TO MRPT-BATCH-NO DTSTOP01 +00933 MOVE WRK-RPT-ITEM-NO TO MRPT-ITEM-NO. DTSTOP01 +00934 SET MRPT-RPT-88 TO TRUE. DTSTOP01 +00935 MOVE MRPT-REC TO MSKL-REC. DTSTOP01 +00936 DTSTOP01 +00937 PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +00938 IF L910-OK-88 DTSTOP01 +00939 DISPLAY ' MRPT-EMP-NO ' MRPT-EMP-NO DTSTOP01 +00940 DISPLAY ' MRPT-YRQ ' MRPT-YRQ DTSTOP01 +00941 DISPLAY ' MRPT-BATCH-NO ' MRPT-BATCH-NO DTSTOP01 +00942 DISPLAY ' MRPT-ITEM-NO ' MRPT-ITEM-NO DTSTOP01 +00943 MOVE MSKL-REC TO MRPT-REC DTSTOP01 +00944 ELSE DTSTOP01 +00945 DISPLAY 'CANNOT FIND MRPT ' MPRF-EMP-NO DTSTOP01 +00946 SET WRK-MRPT-FOUND-NO TO TRUE DTSTOP01 +00947 GO TO P5131-EXIT. DTSTOP01 +00948 DTSTOP01 +00949 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSTOP01 +00950 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSTOP01 +00951 MOVE WRK-RPT-BATCH-NO TO MPAY-BATCH-NO DTSTOP01 +00952 MOVE WRK-RPT-ITEM-NO TO MPAY-ITEM-NO. DTSTOP01 +00953 SET MPAY-PAY-88 TO TRUE. DTSTOP01 +00954 MOVE MPAY-REC TO MSKL-REC. DTSTOP01 +00955 DTSTOP01 +00956 PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +00957 IF L910-OK-88 DTSTOP01 +00958 MOVE MSKL-REC TO MPAY-REC DTSTOP01 +00959 MOVE MPAY-REMIT-AMT TO WRK-REMIT-AMT DTSTOP01 +00960 DISPLAY 'MPAY-EMP-NO ' MPAY-EMP-NO DTSTOP01 +00961 DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO DTSTOP01 +00962 DISPLAY 'MPAY-ITEM-NO ' MPAY-ITEM-NO DTSTOP01 +00963 ELSE DTSTOP01 +00964 DISPLAY 'CANNOT FIND MPAY ' MPRF-EMP-NO DTSTOP01 +00965 SET WRK-MPAY-FOUND-NO TO TRUE DTSTOP01 +00966 GO TO P5131-EXIT. DTSTOP01 +00967 DTSTOP01 +00968 P5131-EXIT. DTSTOP01 +00969 EXIT. DTSTOP01 +00970 DTSTOP01 +00971 P5132-WITHDRAW-MRPT. DTSTOP01 +00972 * DISPLAY 'P5132 WITHDRAW MRPT ' DTSTOP01 +00973 IF WRK-MRPT-FOUND-NO DTSTOP01 +00974 GO TO P5132-EXIT. DTSTOP01 +00975 DTSTOP01 +00976 MOVE LOW-VALUES TO ARPT-REC. DTSTOP01 +00977 DTSTOP01 +00978 IF AHDR-ATC-FILE-TRAN-CNT < +999 DTSTOP01 +00979 NEXT SENTENCE DTSTOP01 +00980 ELSE DTSTOP01 +00981 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSTOP01 +00982 ** PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP01 +00983 DTSTOP01 +00984 MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO. DTSTOP01 +00985 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT. DTSTOP01 +00986 MOVE AHDR-ATC-FILE-TRAN-CNT TO ARPT-ITEM-NO. DTSTOP01 +00987 SET ARPT-RPT-88 TO TRUE. DTSTOP01 +00988 DTSTOP01 +00989 MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK. DTSTOP01 +00990 MOVE MPRF-EMP-NO TO ARPT-EMP-NO. DTSTOP01 +00991 SET ARPT-WITHDRW-88 TO TRUE. DTSTOP01 +00992 MOVE MQTR-YRQ TO ARPT-YRQ. DTSTOP01 +00993 DTSTOP01 +00994 COMPUTE ARPT-TOT-WAGE = DTSTOP01 +00995 -1 * MRPT-TOT-WAGE. DTSTOP01 +00996 COMPUTE ARPT-TAX-WAGE = DTSTOP01 +00997 -1 * MRPT-TAX-WAGE. DTSTOP01 +00998 COMPUTE ARPT-EXCESS-WAGE = DTSTOP01 +00999 -1 * MRPT-EXCESS-WAGE. DTSTOP01 +01000 DTSTOP01 +01001 MOVE +0 TO ARPT-REMIT-AMT. DTSTOP01 +01002 SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE. DTSTOP01 +01003 SET ARPT-WAIVE-BOTH-NO-88 DTSTOP01 +01004 ARPT-WAIVE-INT-NO-88 DTSTOP01 +01005 ARPT-WAIVE-LATE-PEN-NO-88 DTSTOP01 +01006 ARPT-STATUS-CHNG-NO-88 TO TRUE. DTSTOP01 +01007 DTSTOP01 +01008 SET ARPT-TOTAL-NO-ENTRY-88 DTSTOP01 +01009 ARPT-1ST-MTH-NO-ENTRY-88 DTSTOP01 +01010 ARPT-2ND-MTH-NO-ENTRY-88 DTSTOP01 +01011 ARPT-3RD-MTH-NO-ENTRY-88 TO TRUE. DTSTOP01 +01012 DTSTOP01 +01013 SET ARPT-VERIFIED-NO-88 TO TRUE. DTSTOP01 +01014 MOVE +0 TO ARPT-RECEIVED-DATE DTSTOP01 +01015 ARPT-DEPOSIT-DATE. DTSTOP01 +01016 MOVE 'SYS' TO ARPT-RESPONSIBLE-ACTIVITY. DTSTOP01 +01017 MOVE SPACES TO ARPT-RESPONSIBLE-OP-ID. DTSTOP01 +01018 MOVE SPACE TO ARPT-DISREGARD-EDITS-IND. DTSTOP01 +01019 SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE. DTSTOP01 +01020 MOVE +0 TO ARPT-PROCESSED-DATE DTSTOP01 +01021 ARPT-TRACE-NO DTSTOP01 +01022 ARPT-PSEUDO-BATCH-NO DTSTOP01 +01023 ARPT-PSEUDO-ITEM-NO. DTSTOP01 +01024 DTSTOP01 +01025 MOVE ARPT-REC TO ASKL-REC. DTSTOP01 +01026 ** DISPLAY 'ARPT-NAME-CHECK ' ARPT-NAME-CHECK DTSTOP01 +01027 ** DISPLAY 'ARPT-EMP-NO ' ARPT-EMP-NO DTSTOP01 +01028 ** DISPLAY 'ARPT-YRQ ' ARPT-YRQ DTSTOP01 +01029 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP01 +01030 DTSTOP01 +01031 DISPLAY 'P5132 REPORT WITHDRAWN ' ARPT-EMP-NO ' ' ARPT-YRQ. DTSTOP01 +01032 P5132-EXIT. DTSTOP01 +01033 EXIT. DTSTOP01 +01034 DTSTOP01 +01035 P5133-REVERSE-MPAY. DTSTOP01 +01036 DTSTOP01 +01037 ** DISPLAY 'P5133 REVERSE MPAY ' DTSTOP01 +01038 IF WRK-MPAY-FOUND-NO DTSTOP01 +01039 GO TO P5133-EXIT. DTSTOP01 +01040 DTSTOP01 +01041 MOVE LOW-VALUES TO APAY-REC. DTSTOP01 +01042 DTSTOP01 +01043 IF AHDR-ATC-FILE-TRAN-CNT < +999 DTSTOP01 +01044 NEXT SENTENCE DTSTOP01 +01045 ELSE DTSTOP01 +01046 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSTOP01 +01047 ** PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP01 +01048 DTSTOP01 +01049 MOVE AHDR-BATCH-NO TO APAY-BATCH-NO. DTSTOP01 +01050 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT. DTSTOP01 +01051 MOVE AHDR-ATC-FILE-TRAN-CNT TO APAY-ITEM-NO. DTSTOP01 +01052 SET APAY-PAY-88 TO TRUE. DTSTOP01 +01053 DTSTOP01 +01054 MOVE MPRF-PRIMARY-NAME TO APAY-NAME-CHECK. DTSTOP01 +01055 MOVE MPRF-EMP-NO TO APAY-EMP-NO. DTSTOP01 +01056 SET APAY-PAY-REV-88 TO TRUE. DTSTOP01 +01057 DTSTOP01 +01058 COMPUTE APAY-REMIT-AMT = DTSTOP01 +01059 -1 * MPAY-REMIT-AMT. DTSTOP01 +01060 DTSTOP01 +01061 ADD APAY-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT. DTSTOP01 +01062 DTSTOP01 +01063 SET APAY-WAIVE-INT-NO-88 DTSTOP01 +01064 APAY-WAIVE-LATE-PEN-NO-88 DTSTOP01 +01065 APAY-NSF-PEN-CHARGE-NO-88 TO TRUE. DTSTOP01 +01066 DTSTOP01 +01067 MOVE +0 TO APAY-RECEIVED-DATE DTSTOP01 +01068 APAY-DEPOSIT-DATE DTSTOP01 +01069 APAY-APPLIC-YRQ. DTSTOP01 +01070 MOVE SPACES TO APAY-APPLIC-IND. DTSTOP01 +01071 DTSTOP01 +01072 MOVE MPAY-BATCH-NO TO APAY-APPLIC-BATCH-NO. DTSTOP01 +01073 MOVE MPAY-ITEM-NO TO APAY-APPLIC-ITEM-NO. DTSTOP01 +01074 DTSTOP01 +01075 MOVE 'SYS' TO APAY-RESPONSIBLE-ACTIVITY. DTSTOP01 +01076 MOVE SPACES TO APAY-RESPONSIBLE-OP-ID. DTSTOP01 +01077 MOVE SPACE TO APAY-DISREGARD-EDITS-IND. DTSTOP01 +01078 MOVE +0 TO APAY-PROCESSED-DATE. DTSTOP01 +01079 MOVE +0 TO APAY-NSF-MNTE-ABSTIME. DTSTOP01 +01080 MOVE +0 TO APAY-TRACE-NO. DTSTOP01 +01081 SET APAY-ANNUAL-RPT-NULL-88 TO TRUE. DTSTOP01 +01082 ** DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO DTSTOP01 +01083 ** DISPLAY 'MPAY-ITEM-NO ' MPAY-ITEM-NO DTSTOP01 +01084 MOVE APAY-REC TO ASKL-REC. DTSTOP01 +01085 DTSTOP01 +01086 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP01 +01087 DTSTOP01 +01088 DISPLAY 'MPAY REVERSED ' MPAY-BATCH-NO ' ' MPAY-ITEM-NO DTSTOP01 +01089 ' ' MPAY-EMP-NO. DTSTOP01 +01090 P5133-EXIT. DTSTOP01 +01091 EXIT. DTSTOP01 +01092 DTSTOP01 +01093 P5134-ENTER-ARPT. DTSTOP01 +01094 DTSTOP01 +01095 ** DISPLAY 'P5134 ENTER APRT ' DTSTOP01 +01096 DTSTOP01 +01097 IF WRK-MRPT-FOUND-NO DTSTOP01 +01098 GO TO P5134-EXIT. DTSTOP01 +01099 DTSTOP01 +01100 MOVE LOW-VALUES TO ARPT-REC. DTSTOP01 +01101 DTSTOP01 +01102 IF AHDR-ATC-FILE-TRAN-CNT < +999 DTSTOP01 +01103 NEXT SENTENCE DTSTOP01 +01104 ELSE DTSTOP01 +01105 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSTOP01 +01106 ** PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP01 +01107 DTSTOP01 +01108 MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO. DTSTOP01 +01109 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT. DTSTOP01 +01110 MOVE AHDR-ATC-FILE-TRAN-CNT TO ARPT-ITEM-NO. DTSTOP01 +01111 SET ARPT-RPT-88 TO TRUE. DTSTOP01 +01112 DTSTOP01 +01113 MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK. DTSTOP01 +01114 MOVE MPRF-EMP-NO TO ARPT-EMP-NO. DTSTOP01 +01115 SET ARPT-ORIG-88 TO TRUE. DTSTOP01 +01116 MOVE MQTR-YRQ TO ARPT-YRQ. DTSTOP01 +01117 DTSTOP01 +01118 COMPUTE ARPT-TOT-WAGE = DTSTOP01 +01119 MRPT-TOT-WAGE. DTSTOP01 +01120 COMPUTE ARPT-TAX-WAGE = DTSTOP01 +01121 MRPT-TAX-WAGE. DTSTOP01 +01122 COMPUTE ARPT-EXCESS-WAGE = DTSTOP01 +01123 MRPT-EXCESS-WAGE. DTSTOP01 +01124 DTSTOP01 +01125 MOVE WRK-REMIT-AMT TO ARPT-REMIT-AMT. DTSTOP01 +01126 ADD ARPT-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT. DTSTOP01 +01127 SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE. DTSTOP01 +01128 SET ARPT-WAIVE-BOTH-NO-88 DTSTOP01 +01129 ARPT-WAIVE-INT-NO-88 DTSTOP01 +01130 ARPT-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSTOP01 +01131 DTSTOP01 +01132 MOVE MRPT-TOTAL-EMPL-CNT TO ARPT-TOTAL-EMPL-CNT. DTSTOP01 +01133 MOVE MRPT-1ST-MTH-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSTOP01 +01134 MOVE MRPT-2ND-MTH-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSTOP01 +01135 MOVE MRPT-3RD-MTH-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSTOP01 +01136 DTSTOP01 +01137 SET ARPT-VERIFIED-NO-88 TO TRUE. DTSTOP01 +01138 ****FIX RECEIVED DATE HERE DTSTOP01 +01139 EVALUATE MPRF-EMP-NO DTSTOP01 +01140 WHEN 179242 DTSTOP01 +01141 MOVE 20131127 TO ARPT-RECEIVED-DATE DTSTOP01 +01142 ARPT-DEPOSIT-DATE DTSTOP01 +01143 WHEN 173938 DTSTOP01 +01144 MOVE 20131120 TO ARPT-RECEIVED-DATE DTSTOP01 +01145 ARPT-DEPOSIT-DATE DTSTOP01 +01146 WHEN 178627 DTSTOP01 +01147 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP01 +01148 ARPT-DEPOSIT-DATE DTSTOP01 +01149 WHEN 178646 DTSTOP01 +01150 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP01 +01151 ARPT-DEPOSIT-DATE DTSTOP01 +01152 WHEN 178842 DTSTOP01 +01153 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP01 +01154 ARPT-DEPOSIT-DATE DTSTOP01 +01155 WHEN 179229 DTSTOP01 +01156 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP01 +01157 ARPT-DEPOSIT-DATE DTSTOP01 +01158 WHEN 179678 DTSTOP01 +01159 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP01 +01160 ARPT-DEPOSIT-DATE DTSTOP01 +01161 WHEN 179748 DTSTOP01 +01162 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP01 +01163 ARPT-DEPOSIT-DATE DTSTOP01 +01164 WHEN OTHER DTSTOP01 +01165 DISPLAY 'ERROR IN FIXING RECEIVED DATE' DTSTOP01 +01166 END-EVALUATE. DTSTOP01 +01167 DTSTOP01 +01168 MOVE MRPT-RESPONSIBLE-ACTIVITY DTSTOP01 +01169 TO ARPT-RESPONSIBLE-ACTIVITY DTSTOP01 +01170 MOVE 'SYS' TO ARPT-RESPONSIBLE-ACTIVITY. DTSTOP01 +01171 MOVE MRPT-RESPONSIBLE-OP-ID DTSTOP01 +01172 TO ARPT-RESPONSIBLE-OP-ID. DTSTOP01 +01173 MOVE SPACE TO ARPT-DISREGARD-EDITS-IND. DTSTOP01 +01174 SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE. DTSTOP01 +01175 MOVE +0 TO ARPT-PROCESSED-DATE. DTSTOP01 +01176 MOVE +0 TO ARPT-PSEUDO-BATCH-NO DTSTOP01 +01177 ARPT-PSEUDO-ITEM-NO DTSTOP01 +01178 ARPT-TRACE-NO. DTSTOP01 +01179 SET ARPT-STATUS-CHNG-NO-88 TO TRUE. DTSTOP01 +01180 DTSTOP01 +01181 MOVE ARPT-REC TO ASKL-REC. DTSTOP01 +01182 ** DISPLAY 'ARPT-BATCH-NO ' ARPT-BATCH-NO DTSTOP01 +01183 ** DISPLAY 'ARPT-EMP-NO ' ARPT-EMP-NO DTSTOP01 +01184 ** DISPLAY 'ARPT-YRQ ' ARPT-YRQ DTSTOP01 +01185 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP01 +01186 DTSTOP01 +01187 DTSTOP01 +01188 P5134-EXIT. DTSTOP01 +01189 EXIT. DTSTOP01 +01190 DTSTOP01 +01191 DTSTOP01 +01192 P5141-READ-MRPT. DTSTOP01 +01193 SET WRK-MRPT-FOUND-YES TO TRUE. DTSTOP01 +01194 DTSTOP01 +01195 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP01 +01196 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP01 +01197 MOVE MQTR-YRQ TO MRPT-YRQ. DTSTOP01 +01198 MOVE WRK-RPT-BATCH-NO TO MRPT-BATCH-NO DTSTOP01 +01199 MOVE WRK-RPT-ITEM-NO TO MRPT-ITEM-NO. DTSTOP01 +01200 SET MRPT-RPT-88 TO TRUE. DTSTOP01 +01201 MOVE MRPT-REC TO MSKL-REC. DTSTOP01 +01202 DTSTOP01 +01203 PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +01204 IF L910-OK-88 DTSTOP01 +01205 MOVE MSKL-REC TO MRPT-REC DTSTOP01 +01206 ELSE DTSTOP01 +01207 ** DISPLAY 'CANNOT FIND MRPT ' MPRF-EMP-NO DTSTOP01 +01208 SET WRK-MRPT-FOUND-NO TO TRUE DTSTOP01 +01209 GO TO P5141-EXIT. DTSTOP01 +01210 DTSTOP01 +01211 P5141-EXIT. DTSTOP01 +01212 EXIT. DTSTOP01 +01213 DTSTOP01 +01214 T0000-TERMINATE. DTSTOP01 +01215 DTSTOP01 +01216 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT. DTSTOP01 +01217 MOVE WRK-LIEN-AMT TO OUT-TOTAL-DEBT. DTSTOP01 +01218 ** MOVE OUT-SEQ-NO TO OUT-RECORDS. DTSTOP01 +01219 WRITE OUT-REC FROM TOP-TRAILER. DTSTOP01 +01220 PERFORM S923-CLOSE THRU S923-EXIT. DTSTOP01 +01221 ** PERFORM S927-CLOSE THRU S927-EXIT. DTSTOP01 +01222 DTSTOP01 +01223 * MOVE MHDR-LAST-USED-BATCH-NO TO HOLD-LAST-USED-BATCH-NO. DTSTOP01 +01224 DTSTOP01 +01225 * MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP01 +01226 DTSTOP01 +01227 * PERFORM S910-READ THRU S910-EXIT. DTSTOP01 +01228 * IF L910-NO-REC-88 DTSTOP01 +01229 * MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSTOP01 +01230 * TO ABEND-MSG DTSTOP01 +01231 * PERFORM S999-ABEND THRU S999-EXIT. DTSTOP01 +01232 DTSTOP01 +01233 * MOVE MSKL-REC TO MHDR-REC. DTSTOP01 +01234 * MOVE HOLD-LAST-USED-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSTOP01 +01235 * MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSTOP01 +01236 * MOVE MHDR-REC TO MSKL-REC. DTSTOP01 +01237 DTSTOP01 +01238 * PERFORM S910-REWRITE THRU S910-EXIT. DTSTOP01 +01239 * DISPLAY 'LAST BATCH: ' AHDR-BATCH-NO. DTSTOP01 +01240 DTSTOP01 +01241 DISPLAY ' '. DTSTOP01 +01242 DTSTOP01 +01243 DISPLAY '*** DTSBZ058 TERMINATION STATISTICS ***'. DTSTOP01 +01244 DTSTOP01 +01245 DISPLAY ' '. DTSTOP01 +01246 DTSTOP01 +01247 DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DTSTOP01 +01248 WRK-MPRF-CNT. DTSTOP01 +01249 DTSTOP01 +01250 DISPLAY 'NUMBER OF ACCOUNTS READ : ' CL*17 +01251 WRK-READ-CNT. CL*17 +01252 DTSTOP01 +01253 DISPLAY 'NUMBER OF EMPLOYERS EXCLUDED : 'DTSTOP01 +01254 WRK-EXCLUDE-CNT. DTSTOP01 +01255 DTSTOP01 +01256 DISPLAY 'NOTEPAD RECORDS CREATED : 'DTSTOP01 +01257 WRK-T003-CNT. DTSTOP01 +01258 DTSTOP01 +01259 DISPLAY 'AMOUNT OF INTEREST REVERSED : 'DTSTOP01 +01260 WRK-INTEREST-AMT. DTSTOP01 +01261 DTSTOP01 +01262 PERFORM S910-CLOSE THRU S910-EXIT. DTSTOP01 +01263 CLOSE IN-FILE DTSTOP01 +01264 OUT-FILE. DTSTOP01 +01265 DTSTOP01 +01266 T0000-EXIT. DTSTOP01 +01267 EXIT. DTSTOP01 +01268 EJECT DTSTOP01 +01269 DTSTOP01 +01270 **1000-INITIATE-AHDR. DTSTOP01 +01271 ** MOVE LOW-VALUES TO AHDR-REC. DTSTOP01 +01272 ** DTSTOP01 +01273 ** IF MHDR-LAST-USED-BATCH-NO < +99999 DTSTOP01 +01274 ** COMPUTE AHDR-BATCH-NO = MHDR-LAST-USED-BATCH-NO + 1 DTSTOP01 +01275 ** ELSE DTSTOP01 +01276 ** MOVE +1 TO AHDR-BATCH-NO. DTSTOP01 +01277 ** DTSTOP01 +01278 ** MOVE +0 TO AHDR-ITEM-NO. DTSTOP01 +01279 ** SET AHDR-HDR-88 TO TRUE. DTSTOP01 +01280 ** SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSTOP01 +01281 ** SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSTOP01 +01282 ** SET AHDR-ESTB-SYSTEM-88 TO TRUE. DTSTOP01 +01283 ** MOVE SPACES TO AHDR-CHNG-OP-ID. DTSTOP01 +01284 ** MOVE +0 TO AHDR-CHNG-DATE. DTSTOP01 +01285 ** MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE DTSTOP01 +01286 ** AHDR-RECEIVED-DATE DTSTOP01 +01287 ** AHDR-DEPOSIT-DATE. DTSTOP01 +01288 ** MOVE +0 TO AHDR-LAST-USED-ITEM-NO DTSTOP01 +01289 ** AHDR-CONTROL-TRAN-CNT DTSTOP01 +01290 ** AHDR-ATC-FILE-TRAN-CNT DTSTOP01 +01291 ** AHDR-PROC-TRAN-CNT DTSTOP01 +01292 ** AHDR-CONTROL-REMIT-AMT DTSTOP01 +01293 ** AHDR-ATC-FILE-REMIT-AMT DTSTOP01 +01294 ** AHDR-PROC-REMIT-AMT DTSTOP01 +01295 ** AHDR-BANK-BATCH-NO. DTSTOP01 +01296 ** DTSTOP01 +01297 **1000-EXIT. DTSTOP01 +01298 ** EXIT. DTSTOP01 +01299 DTSTOP01 +01300 S2000-TERMINATE-AHDR. DTSTOP01 +01301 IF AHDR-ATC-FILE-TRAN-CNT = +0 DTSTOP01 +01302 GO TO S2000-EXIT. DTSTOP01 +01303 DTSTOP01 +01304 MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSTOP01 +01305 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-LAST-USED-ITEM-NO. DTSTOP01 +01306 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT. DTSTOP01 +01307 MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT. DTSTOP01 +01308 MOVE AHDR-REC TO ASKL-REC. DTSTOP01 +01309 DTSTOP01 +01310 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP01 +01311 DTSTOP01 +01312 S2000-EXIT. DTSTOP01 +01313 EXIT. DTSTOP01 +01314 DTSTOP01 +01315 S004-EDIT-QTR. DTSTOP01 +01316 CALL 'DTSBU004' USING L004-COMM-AREA. DTSTOP01 +01317 DTSTOP01 +01318 S004-EXIT. DTSTOP01 +01319 EXIT. DTSTOP01 +01320 SKIP3 DTSTOP01 +01321 S005-FROM-SYS. DTSTOP01 +01322 SET L005-FROM-SYS TO TRUE. DTSTOP01 +01323 CALL 'DTSBU005' USING L005-LINK-AREA. DTSTOP01 +01324 DTSTOP01 +01325 S005-EXIT. DTSTOP01 +01326 EXIT. DTSTOP01 +01327 DTSTOP01 +01328 DTSTOP01 +01329 S001-FROM-FED-8. DTSTOP01 +01330 SET L001-FROM-FED-8 TO TRUE. DTSTOP01 +01331 GO TO S001-DATE. DTSTOP01 +01332 DTSTOP01 +01333 DTSTOP01 +01334 S001-DATE. DTSTOP01 +01335 CALL 'DTSBU001' USING L001-LINK-AREA. DTSTOP01 +01336 S001-EXIT. DTSTOP01 +01337 EXIT. DTSTOP01 +01338 DTSTOP01 +01339 S101-PER-MONTH-NO. DTSTOP01 +01340 SET L101-PER-MONTH-NO-88 TO TRUE. DTSTOP01 +01341 GO TO S101-INT-PEN-COMP. DTSTOP01 +01342 DTSTOP01 +01343 S101-PER-MONTH-YES. DTSTOP01 +01344 SET L101-PER-MONTH-YES-88 TO TRUE. DTSTOP01 +01345 GO TO S101-INT-PEN-COMP. DTSTOP01 +01346 DTSTOP01 +01347 S101-INT-PEN-COMP. DTSTOP01 +01348 CALL 'DTSBU101' USING L101-LINK-AREA. DTSTOP01 +01349 S101-EXIT. DTSTOP01 +01350 EXIT. DTSTOP01 +01351 S910-OPEN-READ. DTSTOP01 +01352 SET L910-OPEN-READ-88 TO TRUE. DTSTOP01 +01353 GO TO S910-MSTR-IO. DTSTOP01 +01354 DTSTOP01 +01355 S910-OPEN-UPDATE-NO-AIX. DTSTOP01 +01356 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSTOP01 +01357 GO TO S910-MSTR-IO. DTSTOP01 +01358 DTSTOP01 +01359 S910-OPEN-UPDATE-HDR. DTSTOP01 +01360 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DTSTOP01 +01361 GO TO S910-MSTR-IO. DTSTOP01 +01362 DTSTOP01 +01363 S910-READ. DTSTOP01 +01364 SET L910-READ-88 TO TRUE. DTSTOP01 +01365 GO TO S910-MSTR-IO. DTSTOP01 +01366 DTSTOP01 +01367 S910-START-BROWSE. DTSTOP01 +01368 SET L910-START-BROWSE-88 TO TRUE. DTSTOP01 +01369 GO TO S910-MSTR-IO. DTSTOP01 +01370 DTSTOP01 +01371 S910-READ-NEXT. DTSTOP01 +01372 SET L910-READ-NEXT-88 TO TRUE. DTSTOP01 +01373 GO TO S910-MSTR-IO. DTSTOP01 +01374 DTSTOP01 +01375 S910-COUNT. DTSTOP01 +01376 SET L910-COUNT-88 TO TRUE. DTSTOP01 +01377 GO TO S910-MSTR-IO. DTSTOP01 +01378 DTSTOP01 +01379 S910-REWRITE. DTSTOP01 +01380 SET L910-REWRITE-88 TO TRUE. DTSTOP01 +01381 GO TO S910-MSTR-IO. DTSTOP01 +01382 DTSTOP01 +01383 S910-DELETE. DTSTOP01 +01384 SET L910-DELETE-88 TO TRUE. DTSTOP01 +01385 GO TO S910-MSTR-IO. DTSTOP01 +01386 DTSTOP01 +01387 S910-CLOSE. DTSTOP01 +01388 SET L910-CLOSE-88 TO TRUE. DTSTOP01 +01389 GO TO S910-MSTR-IO. DTSTOP01 +01390 DTSTOP01 +01391 S910-MSTR-IO. DTSTOP01 +01392 CALL 'DTSBU910' USING L910-LINK-AREA DTSTOP01 +01393 MSKL-REC. DTSTOP01 +01394 S910-EXIT. DTSTOP01 +01395 EXIT. DTSTOP01 +01396 SKIP3 DTSTOP01 +01397 S111-LOOKUP-ADDR. DTSTOP01 +01398 CALL 'DTSBU111' USING L111-LINK-AREA. DTSTOP01 +01399 S111-EXIT. DTSTOP01 +01400 EXIT. DTSTOP01 +01401 S923-OPEN-UPDATE. DTSTOP01 +01402 SET L923-OPEN-UPDATE-88 TO TRUE. DTSTOP01 +01403 GO TO S923-ATC-IO. DTSTOP01 +01404 DTSTOP01 +01405 S923-OPEN-READ. DTSTOP01 +01406 SET L923-OPEN-READ-88 TO TRUE. DTSTOP01 +01407 GO TO S923-ATC-IO. DTSTOP01 +01408 DTSTOP01 +01409 S923-READ. DTSTOP01 +01410 SET L923-READ-88 TO TRUE. DTSTOP01 +01411 GO TO S923-ATC-IO. DTSTOP01 +01412 DTSTOP01 +01413 S923-START-BROWSE. DTSTOP01 +01414 SET L923-START-BROWSE-88 TO TRUE. DTSTOP01 +01415 GO TO S923-ATC-IO. DTSTOP01 +01416 DTSTOP01 +01417 S923-READ-NEXT. DTSTOP01 +01418 SET L923-READ-NEXT-88 TO TRUE. DTSTOP01 +01419 GO TO S923-ATC-IO. DTSTOP01 +01420 DTSTOP01 +01421 S923-WRITE. DTSTOP01 +01422 ** DISPLAY 'S923 WRITE ' DTSTOP01 +01423 SET L923-WRITE-88 TO TRUE. DTSTOP01 +01424 GO TO S923-ATC-IO. DTSTOP01 +01425 DTSTOP01 +01426 S923-REWRITE. DTSTOP01 +01427 SET L923-REWRITE-88 TO TRUE. DTSTOP01 +01428 GO TO S923-ATC-IO. DTSTOP01 +01429 DTSTOP01 +01430 S923-DELETE. DTSTOP01 +01431 SET L923-DELETE-88 TO TRUE. DTSTOP01 +01432 GO TO S923-ATC-IO. DTSTOP01 +01433 DTSTOP01 +01434 S923-CLOSE. DTSTOP01 +01435 SET L923-CLOSE-88 TO TRUE. DTSTOP01 +01436 GO TO S923-ATC-IO. DTSTOP01 +01437 DTSTOP01 +01438 S923-ATC-IO. DTSTOP01 +01439 ** DISPLAY 'DTSBU923 ' DTSTOP01 +01440 ** DISPLAY 'L923 LINK AREA ' L923-LINK-AREA DTSTOP01 +01441 CALL 'DTSBU923' USING L923-LINK-AREA DTSTOP01 +01442 ASKL-REC. DTSTOP01 +01443 S923-EXIT. DTSTOP01 +01444 EXIT. DTSTOP01 +01445 SKIP3 DTSTOP01 +01446 S927-OPEN-UPDATE. DTSTOP01 +01447 SET L927-OPEN-UPDATE-88 TO TRUE. DTSTOP01 +01448 GO TO S927-BTC-O. DTSTOP01 +01449 DTSTOP01 +01450 S927-WRITE. DTSTOP01 +01451 SET L927-WRITE-88 TO TRUE. DTSTOP01 +01452 GO TO S927-BTC-O. DTSTOP01 +01453 DTSTOP01 +01454 S927-CLOSE. DTSTOP01 +01455 SET L927-CLOSE-88 TO TRUE. DTSTOP01 +01456 GO TO S927-BTC-O. DTSTOP01 +01457 DTSTOP01 +01458 S927-BTC-O. DTSTOP01 +01459 CALL 'DTSBU927' USING L927-LINK-AREA DTSTOP01 +01460 TSKL-REC. DTSTOP01 +01461 S927-EXIT. DTSTOP01 +01462 EXIT. DTSTOP01 +01463 DTSTOP01 +01464 SKIP3 DTSTOP01 +01465 S999-ABEND. DTSTOP01 +01466 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSTOP01 +01467 S999-EXIT. DTSTOP01 +01468 EXIT. DTSTOP01 diff --git a/Batch/DTSTOP02.cob b/Batch/DTSTOP02.cob new file mode 100644 index 0000000..70e3557 --- /dev/null +++ b/Batch/DTSTOP02.cob @@ -0,0 +1,648 @@ +00001 IDENTIFICATION DIVISION. 11/09/22 +00002 PROGRAM-ID. DTSTOP02. DTSTOP02 +00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV033 +00004 DATE-WRITTEN. OCTOBER 1994. DTSTOP02 +00005 DATE-COMPILED. DTSTOP02 +00006 SKIP3 DTSTOP02 +00007 ***** DTSTOP02 +00008 * DTSTOP02 +00009 * DTSTOP02 +00010 * CALLING SEQUENCE: DTSBD800 CALLS DTSTOP02 +00011 * DTSBR795 READS DTSIXTOP RECORDS. DTSTOP02 +00012 * DTSTOP02 +00013 * FUNCTION: GENERATE LETTERS TO EMPLOYERS SELECTED. DTSTOP02 +00014 * DTSTOP02 +00015 * DTSTOP02 +00016 * MODIFICATION HISTORY: DTSTOP02 +00017 * DTSTOP02 +00018 * 11/07/2000 MODIFIED FOR DC REQUIREMENTS AND LAZER PRINTING. DTSTOP02 +00019 * REFERENCE: PROGRAMMER: ZL1 DTSTOP02 +00020 * DTSTOP02 +00021 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSTOP02 +00022 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSTOP02 +00023 * REFERENCE: XXXXXXXXXXXXXXXX PROGRAMMER: XXX DTSTOP02 +00024 * DTSTOP02 +00025 * DTSTOP02 +00026 * DESCRIPTION: DTSTOP02 +00027 * DTSTOP02 +00028 * THIS MODULE GENERATES LETTERS TO EMPLOYERS MISSING DTSTOP02 +00029 * SIC/NAIC CODES. DTSTOP02 +00030 * DTSTOP02 +00031 * DTSTOP02 +00032 * RECORDS READ: DTSTOP02 +00033 * DTSTOP02 +00034 * NONE. DTSTOP02 +00035 * DTSTOP02 +00036 * DTSTOP02 +00037 * PRINTED OUTPUTS: DTSTOP02 +00038 * DTSTOP02 +00039 * 909R1 SELF MAILER LETTERS DTSTOP02 +00040 * DTSTOP02 +00041 * DTSTOP02 +00042 * RECORDS WRITTEN: DTSTOP02 +00043 * DTSTOP02 +00044 * NONE. DTSTOP02 +00045 * DTSTOP02 +00046 * DTSTOP02 +00047 * MODULES CALLED: DTSTOP02 +00048 * DTSTOP02 +00049 * DTSBU009 CONVERSION TO CAPS MODULE DTSTOP02 +00050 * DTSBU062 FIELD REP ID EDIT/DESCRIPTION MODULE DTSTOP02 +00051 * DTSBU071 NAME EDIT/CONVERSION MODULE DTSTOP02 +00052 * DTSBU082 OPERATOR ID EDIT/LOOKUP MODULE DTSTOP02 +00053 * DTSBU119 AGENCY FACTS MODULE DTSTOP02 +00054 * DTSTOP02 +00055 ***** DTSTOP02 +00056 EJECT DTSTOP02 +00057 ENVIRONMENT DIVISION. DTSTOP02 +00058 DTSTOP02 +00059 CONFIGURATION SECTION. DTSTOP02 +00060 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSTOP02 +00061 DTSTOP02 +00062 INPUT-OUTPUT SECTION. DTSTOP02 +00063 DTSTOP02 +00064 FILE-CONTROL. DTSTOP02 +00065 SELECT TOP-OUTFILE ASSIGN TO DTSFTOP2. DTSTOP02 +00066 SELECT TOP-FILE ASSIGN TO DTSFTOP1. DTSTOP02 +00067 SELECT PRT-FILE ASSIGN TO RPT909R1. DTSTOP02 +00068 SELECT PRT-FILE2 ASSIGN TO RPT909R2. DTSTOP02 +00069 SELECT PRT-FILE3 ASSIGN TO RPT909R3. DTSTOP02 +00070 SELECT PRT-FILE4 ASSIGN TO RPT909R4. DTSTOP02 +00071 SELECT PRT-FILE5 ASSIGN TO RPT909R5. DTSTOP02 +00072 SELECT PRT-FILE6 ASSIGN TO RPT909R6. DTSTOP02 +00073 SELECT PRT-FILE7 ASSIGN TO RPT909R7. DTSTOP02 +00074 DTSTOP02 +00075 DATA DIVISION. DTSTOP02 +00076 DTSTOP02 +00077 FILE SECTION. DTSTOP02 +00078 DTSTOP02 +00079 FD TOP-FILE DTSTOP02 +00080 LABEL RECORDS ARE OMITTED. DTSTOP02 +00081 01 TOP-RECORD PIC X(200). CL*32 +00082 DTSTOP02 +00083 DTSTOP02 +00084 FD TOP-OUTFILE DTSTOP02 +00085 LABEL RECORDS ARE OMITTED. DTSTOP02 +00086 01 TOPOUT-REC PIC X(177). CL*29 +00087 CL*29 +00088 FD PRT-FILE DTSTOP02 +00089 RECORDING MODE IS F DTSTOP02 +00090 BLOCK CONTAINS 0 RECORDS DTSTOP02 +00091 LABEL RECORDS ARE OMITTED. DTSTOP02 +00092 01 XEROX-REPORT. DTSTOP02 +00093 * 05 FILLER PIC X(1). DTSTOP02 +00094 05 XEROX-RPT PIC X(132). DTSTOP02 +00095 DTSTOP02 +00096 FD PRT-FILE2 DTSTOP02 +00097 RECORDING MODE IS F DTSTOP02 +00098 BLOCK CONTAINS 0 RECORDS DTSTOP02 +00099 LABEL RECORDS ARE OMITTED. DTSTOP02 +00100 01 XEROX-REPORT2. DTSTOP02 +00101 * 05 FILLER PIC X(1). DTSTOP02 +00102 05 XEROX-RPT2 PIC X(132). DTSTOP02 +00103 DTSTOP02 +00104 FD PRT-FILE3 DTSTOP02 +00105 RECORDING MODE IS F DTSTOP02 +00106 BLOCK CONTAINS 0 RECORDS DTSTOP02 +00107 LABEL RECORDS ARE OMITTED. DTSTOP02 +00108 01 XEROX-REPORT3. DTSTOP02 +00109 * 05 FILLER PIC X(1). DTSTOP02 +00110 05 XEROX-RPT3 PIC X(132). DTSTOP02 +00111 DTSTOP02 +00112 FD PRT-FILE4 DTSTOP02 +00113 RECORDING MODE IS F DTSTOP02 +00114 BLOCK CONTAINS 0 RECORDS DTSTOP02 +00115 LABEL RECORDS ARE OMITTED. DTSTOP02 +00116 01 XEROX-REPORT4. DTSTOP02 +00117 * 05 FILLER PIC X(1). DTSTOP02 +00118 05 XEROX-RPT4 PIC X(132). DTSTOP02 +00119 DTSTOP02 +00120 FD PRT-FILE5 DTSTOP02 +00121 RECORDING MODE IS F DTSTOP02 +00122 BLOCK CONTAINS 0 RECORDS DTSTOP02 +00123 LABEL RECORDS ARE OMITTED. DTSTOP02 +00124 01 XEROX-REPORT5. DTSTOP02 +00125 * 05 FILLER PIC X(1). DTSTOP02 +00126 05 XEROX-RPT5 PIC X(132). DTSTOP02 +00127 DTSTOP02 +00128 FD PRT-FILE6 DTSTOP02 +00129 RECORDING MODE IS F DTSTOP02 +00130 BLOCK CONTAINS 0 RECORDS DTSTOP02 +00131 LABEL RECORDS ARE OMITTED. DTSTOP02 +00132 01 XEROX-REPORT6. DTSTOP02 +00133 * 05 FILLER PIC X(1). DTSTOP02 +00134 05 XEROX-RPT6 PIC X(132). DTSTOP02 +00135 DTSTOP02 +00136 FD PRT-FILE7 DTSTOP02 +00137 RECORDING MODE IS F DTSTOP02 +00138 BLOCK CONTAINS 0 RECORDS DTSTOP02 +00139 LABEL RECORDS ARE OMITTED. DTSTOP02 +00140 01 XEROX-REPORT7 PIC X(212). DTSTOP02 +00141 EJECT DTSTOP02 +00142 WORKING-STORAGE SECTION. DTSTOP02 +001425 77 PAN-VALET PICTURE X(24) VALUE '033DTSTOP02 11/09/22'. DTSTOP02 +00143 77 PAN-VALET PICTURE X(24) VALUE '069DTSBR909 12/21/10'. DTSTOP02 +00144 DTSTOP02 +00145 01 WRK-AREA. DTSTOP02 +00146 05 WRK-EMP-ZIP. DTSTOP02 +00147 10 WRK-EMP-ZIPA PIC X(5) VALUE SPACES. DTSTOP02 +00148 10 WRK-EMP-ZIPB PIC X(4) VALUE SPACES. DTSTOP02 +00149 DTSTOP02 +00150 05 WS-AMT PIC 9(10)V99 VALUE 0. CL*25 +00151 CL*25 +00152 05 WS-AMT-DISP PIC $$$$$$$$99.99. CL*26 +00153 CL*25 +00154 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +909.DTSTOP02 +00155 05 TOP-EOF PIC X(01) VALUE 'N'. DTSTOP02 +00156 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSTOP02 +00157 * 05 WS-AMT. PIC 9(10)V99. CL*18 +00158 05 REC-COUNT PIC 9(7) VALUE ZEROS. CL**8 +00159 05 DTL-EMP-NO4 PIC 9(7) VALUE ZEROS. DTSTOP02 +00160 05 DTL-EMP-NO4X REDEFINES DTL-EMP-NO4. DTSTOP02 +00161 10 EMPNOA PIC 999. DTSTOP02 +00162 10 EMPNOB PIC 9. DTSTOP02 +00163 10 EMPNOC PIC 999. DTSTOP02 +00164 DTSTOP02 +00165 05 WS-OP-ID-HOLD PIC X(08) VALUE SPACE. DTSTOP02 +00166 05 WS-FIELD-NAME-FIRST-MI PIC X(40) VALUE SPACE. DTSTOP02 +00167 05 WS-FIELD-NAME-LAST PIC X(40) VALUE SPACE. DTSTOP02 +00168 05 WS-ADDR-FMT-AREA PIC X(200) VALUE SPACE. DTSTOP02 +00169 05 WS-ADDR-FMT-AREA-X REDEFINES WS-ADDR-FMT-AREA. DTSTOP02 +00170 10 ADDR-FMT-LINE OCCURS 5 TIMES PIC X(40). DTSTOP02 +00171 DTSTOP02 +00172 01 TOP-LET. CL*32 +00173 10 LET-EMP-NO PIC 999999. CL*32 +00174 10 FILLER PIC X VALUE ';'. CL*32 +00175 10 LET-EMP-FEIN PIC 999999999. CL*32 +00176 10 FILLER PIC X VALUE ';'. CL*29 +00177 10 LET-EMP-NAME PIC X(40). CL*32 +00178 10 FILLER PIC X VALUE ';'. CL*29 +00179 10 LET-EMP-ADDR1 PIC X(40). CL*32 +00180 10 FILLER PIC X VALUE ';'. CL*29 +00181 10 LET-EMP-ADDR2 PIC X(40). CL*32 +00182 10 FILLER PIC X VALUE ';'. CL*29 +00183 10 LET-EMP-CITZ PIC X(20). CL*32 +00184 10 FILLER PIC X VALUE ';'. CL*29 +00185 10 LET-EMP-ST PIC X(02). CL*32 +00186 10 FILLER PIC X VALUE ';'. CL*29 +00187 10 LET-EMP-ZIPP PIC X(10). CL*32 +00188 10 FILLER PIC X VALUE ';'. CL*29 +00189 10 LET-EMP-AMT PIC 9999999.99. CL*32 +00190 01 MAIL-LINE. DTSTOP02 +00191 05 MAIL-DATA PIC X(133) VALUE SPACES. DTSTOP02 +00192 DTSTOP02 +00193 EJECT DTSTOP02 +00194 01 L009-LINK-AREA. DTSTOP02 +00195 ++INCLUDE DTSIL009 DTSTOP02 +00196 EJECT DTSTOP02 +00197 01 L119-LINK-AREA. DTSTOP02 +00198 ++INCLUDE DTSIL119 DTSTOP02 +00199 EJECT DTSTOP02 +00200 ++INCLUDE DTSXL909 DTSTOP02 +00201 01 CHKLTZ. DTSTOP02 +00202 05 DTZ-LINE-2. DTSTOP02 +00203 * 10 FILLER PIC X(37) VALUE SPACES. DTSTOP02 +00204 * 10 DTZ-EMP-NO PIC 999B999. DTSTOP02 +00205 10 FILLER PIC X(07) VALUE SPACES. DTSTOP02 +00206 10 DTZ-EMP-NAME PIC X(40) VALUE SPACES. DTSTOP02 +00207 05 DTZ-LINE-3. DTSTOP02 +00208 10 FILLER PIC X(07) VALUE SPACES. DTSTOP02 +00209 10 DTZ-EMP-ADDR1 PIC X(40) VALUE SPACES. DTSTOP02 +00210 10 FILLER PIC X(15) VALUE SPACES. DTSTOP02 +00211 05 DTZ-LINE-4. DTSTOP02 +00212 10 FILLER PIC X(07) VALUE SPACES. DTSTOP02 +00213 10 DTZ-EMP-ADDR2 PIC X(40) VALUE SPACES. DTSTOP02 +00214 10 FILLER PIC X(15) VALUE SPACES. DTSTOP02 +00215 05 DTZ-LINE-5. DTSTOP02 +00216 10 FILLER PIC X(07) VALUE SPACES. DTSTOP02 +00217 10 DTZ-EMP-CITY PIC X(20) VALUE SPACES. DTSTOP02 +00218 10 FILLER PIC X(05) VALUE SPACES. DTSTOP02 +00219 10 DTZ-EMP-ST PIC X(02) VALUE SPACES. DTSTOP02 +00220 10 FILLER PIC X(05) VALUE SPACES. DTSTOP02 +00221 10 DTZ-EMP-ZIP. DTSTOP02 +00222 15 DTZ-EMP-ZIPA PIC X(05) VALUE SPACES. DTSTOP02 +00223 15 FILLERZ PIC X(01) VALUE '-'. CL*27 +00224 15 DTZ-EMP-ZIPB PIC X(04) VALUE SPACES. DTSTOP02 +00225 DTSTOP02 +00226 05 DTZ-LINE-6. DTSTOP02 +00227 10 FILLER PIC X(67) VALUE SPACES. DTSTOP02 +00228 10 DTZ-EMP-FEIN PIC 99B9999999. DTSTOP02 +00229 10 FILLER PIC X(14) VALUE SPACES. DTSTOP02 +00230 DTSTOP02 +00231 05 DTZ-LINE-7. DTSTOP02 +00232 10 FILLER PIC X(27) VALUE SPACES. DTSTOP02 +00233 10 DTZ-EMP-AMT PIC $$$$$$$$99.99. CL*23 +00234 10 FILLER PIC X(14) VALUE SPACES. DTSTOP02 +00235 01 CHKLTR. DTSTOP02 +00236 05 DTL-LINE-1. DTSTOP02 +00237 10 FILLER PIC X(60) VALUE SPACES. DTSTOP02 +00238 10 DTL-DATE PIC X(10) VALUE SPACES. DTSTOP02 +00239 05 DTL-LINE-3. DTSTOP02 +00240 10 FILLER PIC X(06) VALUE SPACES. DTSTOP02 +00241 10 DTL-EMP-ADDR1 PIC X(40) VALUE SPACES. DTSTOP02 +00242 10 FILLER PIC X(15) VALUE SPACES. DTSTOP02 +00243 05 DTL-LINE-4. DTSTOP02 +00244 10 FILLER PIC X(06) VALUE SPACES. DTSTOP02 +00245 10 DTL-EMP-ADDR2 PIC X(40) VALUE SPACES. DTSTOP02 +00246 10 FILLER PIC X(15) VALUE SPACES. DTSTOP02 +00247 05 DTL-LINE-5. DTSTOP02 +00248 10 FILLER PIC X(06) VALUE SPACES. DTSTOP02 +00249 10 DTL-EMP-ADDR3 PIC X(40) VALUE SPACES. DTSTOP02 +00250 10 FILLER PIC X(15) VALUE SPACES. DTSTOP02 +00251 05 DTL-LINE-6. DTSTOP02 +00252 10 FILLER PIC X(06) VALUE SPACES. DTSTOP02 +00253 10 DTL-EMP-ADDR4 PIC X(40) VALUE SPACES. DTSTOP02 +00254 10 FILLER PIC X(15) VALUE SPACES. DTSTOP02 +00255 05 DTL-LINE-7. DTSTOP02 +00256 10 FILLER PIC X(06) VALUE SPACES. DTSTOP02 +00257 10 DTL-EMP-ADDR5 PIC X(40) VALUE SPACES. DTSTOP02 +00258 10 FILLER PIC X(15) VALUE SPACES. DTSTOP02 +00259 05 DTL-LINE-8. DTSTOP02 +00260 10 FILLER PIC X(06) VALUE SPACES. DTSTOP02 +00261 10 FILLER PIC X(11) VALUE 'ACCOUNT NO:'. DTSTOP02 +00262 10 FILLER PIC X(02) VALUE SPACES. DTSTOP02 +00263 10 DTL-EMP-NO2 PIC 999B999. DTSTOP02 +00264 10 FILLER PIC X(10) VALUE SPACES. DTSTOP02 +00265 * 10 DTL-EMP-NAME PIC X(40) VALUE SPACES. DTSTOP02 +00266 * 05 DTL-LINE-9. DTSTOP02 +00267 * 10 FILLER PIC X(18) VALUE SPACES. DTSTOP02 +00268 * 10 DTL-EMP-NO3 PIC 999B999. DTSTOP02 +00269 * 05 DTL-STAPL. DTSTOP02 +00270 * 10 FILLER PIC X(126) VALUE SPACES. DTSTOP02 +00271 * 10 DTL-EMP-STPL PIC 999. DTSTOP02 +00272 EJECT DTSTOP02 +00273 01 RPT7-LINE. DTSTOP02 +00274 * 05 FILLER PIC X(1). DTSTOP02 +00275 05 RPT7-EMP PIC X(07). DTSTOP02 +00276 05 FILLER PIC X(1) VALUE ','. DTSTOP02 +00277 05 RPT7-ADDR1 PIC X(40). DTSTOP02 +00278 05 FILLER PIC X(1) VALUE ','. DTSTOP02 +00279 05 RPT7-ADDR2 PIC X(40). DTSTOP02 +00280 05 FILLER PIC X(1) VALUE ','. DTSTOP02 +00281 05 RPT7-ADDR3 PIC X(40). DTSTOP02 +00282 05 FILLER PIC X(1) VALUE ','. DTSTOP02 +00283 05 RPT7-ADDR4 PIC X(40). DTSTOP02 +00284 05 FILLER PIC X(1) VALUE ','. DTSTOP02 +00285 05 RPT7-ADDR5 PIC X(40). DTSTOP02 +00286 DTSTOP02 +00287 01 R795-REC. DTSTOP02 +00288 ++INCLUDE DTSIX795 DTSTOP02 +00289 LINKAGE SECTION. DTSTOP02 +00290 DTSTOP02 +00291 PROCEDURE DIVISION. DTSTOP02 +00292 IF FIRST-TIME-IND = 'Y' DTSTOP02 +00293 PERFORM I1000-INITIATE THRU I1000-EXIT DTSTOP02 +00294 MOVE 'N' TO FIRST-TIME-IND. DTSTOP02 +00295 DTSTOP02 +00296 PERFORM P1000-PROCESS THRU P1000-EXIT UNTIL TOP-EOF = 'Y'. DTSTOP02 +00297 DTSTOP02 +00298 PERFORM T1000-TERMINATE THRU T1000-EXIT. DTSTOP02 +00299 GOBACK. DTSTOP02 +00300 EJECT DTSTOP02 +00301 I1000-INITIATE. DTSTOP02 +00302 DTSTOP02 +00303 OPEN INPUT TOP-FILE DTSTOP02 +00304 OPEN OUTPUT PRT-FILE DTSTOP02 +00305 TOP-OUTFILE DTSTOP02 +00306 PRT-FILE2 DTSTOP02 +00307 PRT-FILE3 DTSTOP02 +00308 PRT-FILE4 DTSTOP02 +00309 PRT-FILE5 DTSTOP02 +00310 PRT-FILE6 DTSTOP02 +00311 PRT-FILE7. DTSTOP02 +00312 * SET L119-REQ-MIXED-88 TO TRUE. DTSTOP02 +00313 * SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSTOP02 +00314 * PERFORM S119-AGY-FACTS THRU S119-EXIT. DTSTOP02 +00315 * MOVE L119-UNIT-CHIEF-NAME TO WS-OPR-NAME DTSTOP02 +00316 * MOVE L119-UNIT-CHIEF-TITLE TO WS-OPR-UNIT-NAME DTSTOP02 +00317 DTSTOP02 +00318 MOVE SPACES TO XEROX-REPORT. DTSTOP02 +00319 DTSTOP02 +00320 WRITE XEROX-REPORT FROM XEROX-CNTL-LINE DTSTOP02 +00321 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00322 WRITE XEROX-REPORT FROM MAIL-LINE DTSTOP02 +00323 AFTER ADVANCING 1 LINE. DTSTOP02 +00324 WRITE XEROX-REPORT FROM MAIL-LINE AFTER ADVANCING 13. DTSTOP02 +00325 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE1 AFTER 1. DTSTOP02 +00326 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE2 AFTER 1. DTSTOP02 +00327 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE3 AFTER 1 DTSTOP02 +00328 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE4 AFTER 1. DTSTOP02 +00329 WRITE XEROX-REPORT FROM ROUTE-INFO-LINE5 AFTER 1. DTSTOP02 +00330 DTSTOP02 +00331 WRITE XEROX-REPORT FROM MAIL-LINE DTSTOP02 +00332 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00333 WRITE XEROX-REPORT FROM MAIL-LINE DTSTOP02 +00334 AFTER ADVANCING 1 LINE. DTSTOP02 +00335 DTSTOP02 +00336 DTSTOP02 +00337 GO TO I1000-EXIT. DTSTOP02 +00338 DTSTOP02 +00339 WRITE XEROX-REPORT2 FROM XEROX-CNTL-LINE3 DTSTOP02 +00340 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00341 WRITE XEROX-REPORT2 FROM MAIL-LINE DTSTOP02 +00342 AFTER ADVANCING 1 LINE. DTSTOP02 +00343 WRITE XEROX-REPORT2 FROM MAIL-LINE AFTER ADVANCING 13. DTSTOP02 +00344 WRITE XEROX-REPORT2 FROM ROUTE-INFO-LINE1 AFTER 1. DTSTOP02 +00345 WRITE XEROX-REPORT2 FROM ROUTE-INFO-LINE2 AFTER 1. DTSTOP02 +00346 WRITE XEROX-REPORT2 FROM ROUTE-INFO-LINE3 AFTER 1 DTSTOP02 +00347 WRITE XEROX-REPORT2 FROM ROUTE-INFO-LINE4 AFTER 1. DTSTOP02 +00348 WRITE XEROX-REPORT2 FROM ROUTE-INFO-LINE5 AFTER 1. DTSTOP02 +00349 WRITE XEROX-REPORT2 FROM MAIL-LINE DTSTOP02 +00350 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00351 WRITE XEROX-REPORT2 FROM MAIL-LINE DTSTOP02 +00352 AFTER ADVANCING 1 LINE. DTSTOP02 +00353 DTSTOP02 +00354 DTSTOP02 +00355 WRITE XEROX-REPORT3 FROM XEROX-CNTL-LINE3 DTSTOP02 +00356 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00357 WRITE XEROX-REPORT3 FROM MAIL-LINE AFTER ADVANCING 13. DTSTOP02 +00358 WRITE XEROX-REPORT3 FROM ROUTE-INFO-LINE1 AFTER 1. DTSTOP02 +00359 WRITE XEROX-REPORT3 FROM ROUTE-INFO-LINE2 AFTER 1. DTSTOP02 +00360 WRITE XEROX-REPORT3 FROM ROUTE-INFO-LINE3 AFTER 1 DTSTOP02 +00361 WRITE XEROX-REPORT3 FROM ROUTE-INFO-LINE4 AFTER 1. DTSTOP02 +00362 WRITE XEROX-REPORT3 FROM ROUTE-INFO-LINE5 AFTER 1. DTSTOP02 +00363 WRITE XEROX-REPORT3 FROM MAIL-LINE DTSTOP02 +00364 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00365 DTSTOP02 +00366 WRITE XEROX-REPORT3 FROM MAIL-LINE DTSTOP02 +00367 AFTER ADVANCING 1 LINE. DTSTOP02 +00368 WRITE XEROX-REPORT4 FROM XEROX-CNTL-LINE3 DTSTOP02 +00369 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00370 WRITE XEROX-REPORT4 FROM MAIL-LINE DTSTOP02 +00371 AFTER ADVANCING 1 LINE. DTSTOP02 +00372 WRITE XEROX-REPORT4 FROM MAIL-LINE AFTER ADVANCING 13. DTSTOP02 +00373 WRITE XEROX-REPORT4 FROM ROUTE-INFO-LINE1 AFTER 1. DTSTOP02 +00374 WRITE XEROX-REPORT4 FROM ROUTE-INFO-LINE2 AFTER 1. DTSTOP02 +00375 WRITE XEROX-REPORT4 FROM ROUTE-INFO-LINE3 AFTER 1 DTSTOP02 +00376 WRITE XEROX-REPORT4 FROM ROUTE-INFO-LINE4 AFTER 1. DTSTOP02 +00377 WRITE XEROX-REPORT4 FROM ROUTE-INFO-LINE5 AFTER 1. DTSTOP02 +00378 WRITE XEROX-REPORT4 FROM MAIL-LINE DTSTOP02 +00379 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00380 WRITE XEROX-REPORT4 FROM MAIL-LINE DTSTOP02 +00381 AFTER ADVANCING 1 LINE. DTSTOP02 +00382 DTSTOP02 +00383 WRITE XEROX-REPORT5 FROM XEROX-CNTL-LINE3 DTSTOP02 +00384 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00385 WRITE XEROX-REPORT5 FROM MAIL-LINE AFTER ADVANCING 13. DTSTOP02 +00386 WRITE XEROX-REPORT5 FROM ROUTE-INFO-LINE1 AFTER 1. DTSTOP02 +00387 WRITE XEROX-REPORT5 FROM ROUTE-INFO-LINE2 AFTER 1. DTSTOP02 +00388 WRITE XEROX-REPORT5 FROM ROUTE-INFO-LINE3 AFTER 1 DTSTOP02 +00389 WRITE XEROX-REPORT5 FROM ROUTE-INFO-LINE4 AFTER 1. DTSTOP02 +00390 WRITE XEROX-REPORT5 FROM ROUTE-INFO-LINE5 AFTER 1. DTSTOP02 +00391 WRITE XEROX-REPORT5 FROM MAIL-LINE DTSTOP02 +00392 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00393 WRITE XEROX-REPORT5 FROM MAIL-LINE DTSTOP02 +00394 AFTER ADVANCING 1 LINE. DTSTOP02 +00395 DTSTOP02 +00396 DTSTOP02 +00397 WRITE XEROX-REPORT6 FROM XEROX-CNTL-LINE3 DTSTOP02 +00398 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00399 WRITE XEROX-REPORT6 FROM MAIL-LINE AFTER ADVANCING 13. DTSTOP02 +00400 WRITE XEROX-REPORT6 FROM ROUTE-INFO-LINE1 AFTER 1. DTSTOP02 +00401 WRITE XEROX-REPORT6 FROM ROUTE-INFO-LINE2 AFTER 1. DTSTOP02 +00402 WRITE XEROX-REPORT6 FROM ROUTE-INFO-LINE3 AFTER 1 DTSTOP02 +00403 WRITE XEROX-REPORT6 FROM ROUTE-INFO-LINE4 AFTER 1. DTSTOP02 +00404 WRITE XEROX-REPORT6 FROM ROUTE-INFO-LINE5 AFTER 1. DTSTOP02 +00405 WRITE XEROX-REPORT6 FROM MAIL-LINE DTSTOP02 +00406 AFTER ADVANCING TOP-OF-PAGE. DTSTOP02 +00407 WRITE XEROX-REPORT6 FROM MAIL-LINE DTSTOP02 +00408 AFTER ADVANCING 1 LINE. DTSTOP02 +00409 DTSTOP02 +00410 I1000-EXIT. DTSTOP02 +00411 EXIT. DTSTOP02 +00412 DTSTOP02 +00413 P1000-PROCESS. DTSTOP02 +00414 READ TOP-FILE INTO TOP-LET AT END MOVE 'Y' TO TOP-EOF CL*32 +00415 GO TO P1000-EXIT. DTSTOP02 +00416 DTSTOP02 +00417 DTSTOP02 +00418 * MOVE LRCM-SYS-8-DATE TO DTL-DATE. DTSTOP02 +00419 MOVE '10/13/2022' TO DTL-DATE. CL**2 +00420 ADD 1 TO REC-COUNT. DTSTOP02 +00421 MOVE LET-EMP-NAME TO DTZ-EMP-NAME CL*33 +00422 * IF LET-EMP-ADDRESS-2 > SPACES CL*32 +00423 MOVE LET-EMP-ADDR1 TO DTZ-EMP-ADDR1 CL*33 +00424 MOVE LET-EMP-ADDR2 TO DTZ-EMP-ADDR2 CL*33 +00425 * ELSE CL*32 +00426 * MOVE TOP-EMP-ADDRESS-1 TO DTZ-EMP-ADDR2 CL*32 +00427 * MOVE SPACES TO DTZ-EMP-ADDR1 CL*32 +00428 MOVE LET-EMP-CITZ TO DTZ-EMP-CITY CL*33 +00429 MOVE LET-EMP-ST TO DTZ-EMP-ST CL*33 +00430 MOVE LET-EMP-ZIPP TO WRK-EMP-ZIP CL*33 +00431 MOVE WRK-EMP-ZIPA TO DTZ-EMP-ZIPA. DTSTOP02 +00432 CL*32 +00433 IF WRK-EMP-ZIPB = SPACES CL*27 +00434 MOVE SPACES TO FILLERZ CL*27 +00435 ELSE CL*27 +00436 MOVE '-' TO FILLERZ. CL*27 +00437 MOVE WRK-EMP-ZIPB TO DTZ-EMP-ZIPB. CL*27 +00438 MOVE LET-EMP-FEIN TO DTZ-EMP-FEIN CL*33 +00439 * MOVE TOP-AMOUNT-2 TO DTZ-EMP-AMT TOP-EMP-AMT. CL*20 +00440 MOVE LET-EMP-AMT TO WS-AMT CL*33 +00441 MOVE WS-AMT TO WS-AMT-DISP. CL*25 +00442 MOVE WS-AMT-DISP TO DTZ-EMP-AMT CL*32 +00443 DISPLAY 'TAMT: ' TOP-AMOUNT-2 CL**7 +00444 DISPLAY 'WAMT: ' WS-AMT CL*25 +00445 DISPLAY 'DISP: ' WS-AMT-DISP. CL*25 +00446 * DISPLAY 'XAMC: ' WS-AMT-C CL*19 +00447 * DISPLAY 'ZAMT: ' WS-AMTZ CL*19 +00448 * DISPLAY 'TDTZ: ' DTZ-EMP-AMT CL*19 +00449 * DISPLAY 'RAMT: ' DTZ-EMP-AMT CL*19 +00450 PERFORM P2000-PRINT-LETTER THRU P2000-EXIT. DTSTOP02 +00451 * WRITE TOPOUT-REC FROM TOPOUT. CL*32 +00452 * PERFORM P2100-PRINT-APPLIC THRU P2100-EXIT. DTSTOP02 +00453 PERFORM P1500-SELF-MAILER-RTN THRU P1500-EXIT. DTSTOP02 +00454 DTSTOP02 +00455 * IF REC-COUNT > 5 DTSTOP02 +00456 * SET LRCM-EOR-88 TO TRUE. DTSTOP02 +00457 P1000-EXIT. DTSTOP02 +00458 EXIT. DTSTOP02 +00459 DTSTOP02 +00460 P1500-SELF-MAILER-RTN. DTSTOP02 +00461 DTSTOP02 +00462 * MOVE R909-FMT-LINE(1) TO WS-ADDR-FMT-LINE-1. DTSTOP02 +00463 * MOVE R909-FMT-LINE(2) TO WS-ADDR-FMT-LINE-2. DTSTOP02 +00464 * MOVE R909-FMT-LINE(3) TO WS-ADDR-FMT-LINE-3. DTSTOP02 +00465 * MOVE R909-FMT-LINE(4) TO WS-ADDR-FMT-LINE-4. DTSTOP02 +00466 * MOVE R909-FMT-LINE(5) TO WS-ADDR-FMT-LINE-5. DTSTOP02 +00467 PERFORM P3000-PRINT-MAIL-ADDR THRU P3000-EXIT. DTSTOP02 +00468 DTSTOP02 +00469 P1500-EXIT. DTSTOP02 +00470 EXIT. DTSTOP02 +00471 DTSTOP02 +00472 P2000-PRINT-LETTER. DTSTOP02 +00473 * IF REC-COUNT > 0 AND < 59999 DTSTOP02 +00474 * IF REC-COUNT > 0 AND < 5000 DTSTOP02 +00475 WRITE XEROX-REPORT FROM MAIL-LINE DTSTOP02 +00476 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00477 WRITE XEROX-REPORT FROM MAIL-LINE DTSTOP02 +00478 AFTER ADVANCING 5 LINES DTSTOP02 +00479 WRITE XEROX-REPORT FROM DTZ-LINE-2 DTSTOP02 +00480 AFTER ADVANCING 3 LINE DTSTOP02 +00481 WRITE XEROX-REPORT FROM DTZ-LINE-3 DTSTOP02 +00482 AFTER ADVANCING 1 LINE DTSTOP02 +00483 WRITE XEROX-REPORT FROM DTZ-LINE-4 DTSTOP02 +00484 AFTER ADVANCING 1 LINE DTSTOP02 +00485 WRITE XEROX-REPORT FROM DTZ-LINE-5 DTSTOP02 +00486 AFTER ADVANCING 1 LINE DTSTOP02 +00487 WRITE XEROX-REPORT FROM DTZ-LINE-6 DTSTOP02 +00488 AFTER ADVANCING 3 LINE DTSTOP02 +00489 WRITE XEROX-REPORT FROM DTZ-LINE-7 DTSTOP02 +00490 AFTER ADVANCING 2 LINE DTSTOP02 +00491 * WRITE XEROX-REPORT FROM DTL-LINE-8 DTSTOP02 +00492 * AFTER ADVANCING 1 LINE DTSTOP02 +00493 * WRITE XEROX-REPORT7 FROM RPT7-LINE. DTSTOP02 +00494 GO TO P2000-EXIT. DTSTOP02 +00495 IF REC-COUNT > 4999 AND < 10000 DTSTOP02 +00496 WRITE XEROX-REPORT2 FROM MAIL-LINE DTSTOP02 +00497 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00498 WRITE XEROX-REPORT2 FROM MAIL-LINE DTSTOP02 +00499 AFTER ADVANCING 1 LINE DTSTOP02 +00500 ELSE DTSTOP02 +00501 IF REC-COUNT > 9999 AND < 15000 DTSTOP02 +00502 WRITE XEROX-REPORT3 FROM MAIL-LINE DTSTOP02 +00503 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00504 WRITE XEROX-REPORT3 FROM MAIL-LINE DTSTOP02 +00505 AFTER ADVANCING 1 LINE DTSTOP02 +00506 ELSE DTSTOP02 +00507 IF REC-COUNT > 14999 AND < 20000 DTSTOP02 +00508 WRITE XEROX-REPORT4 FROM MAIL-LINE DTSTOP02 +00509 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00510 WRITE XEROX-REPORT4 FROM MAIL-LINE DTSTOP02 +00511 AFTER ADVANCING 1 LINE DTSTOP02 +00512 ELSE DTSTOP02 +00513 IF REC-COUNT > 19999 AND < 25000 DTSTOP02 +00514 WRITE XEROX-REPORT5 FROM MAIL-LINE DTSTOP02 +00515 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00516 WRITE XEROX-REPORT5 FROM MAIL-LINE DTSTOP02 +00517 AFTER ADVANCING 1 LINE DTSTOP02 +00518 ELSE DTSTOP02 +00519 IF REC-COUNT > 24999 AND < 30000 DTSTOP02 +00520 WRITE XEROX-REPORT6 FROM MAIL-LINE DTSTOP02 +00521 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00522 WRITE XEROX-REPORT6 FROM MAIL-LINE DTSTOP02 +00523 AFTER ADVANCING 1 LINE. DTSTOP02 +00524 DTSTOP02 +00525 P2000-EXIT. DTSTOP02 +00526 EXIT. DTSTOP02 +00527 DTSTOP02 +00528 P3000-PRINT-MAIL-ADDR. DTSTOP02 +00529 WRITE XEROX-REPORT FROM MAIL-LINE DTSTOP02 +00530 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00531 * WRITE XEROX-REPORT FROM MAIL-LINE AFTER ADVANCING 13 LINES DTSTOP02 +00532 * WRITE XEROX-REPORT FROM MAIL-ADDR-LINE-1 DTSTOP02 +00533 * AFTER ADVANCING 2 LINE DTSTOP02 +00534 * WRITE XEROX-REPORT FROM MAIL-ADDR-LINE-2 DTSTOP02 +00535 * AFTER ADVANCING 1 LINE DTSTOP02 +00536 * WRITE XEROX-REPORT FROM MAIL-ADDR-LINE-3 DTSTOP02 +00537 * AFTER ADVANCING 1 LINE DTSTOP02 +00538 * WRITE XEROX-REPORT FROM MAIL-ADDR-LINE-4 DTSTOP02 +00539 * AFTER ADVANCING 1 LINE DTSTOP02 +00540 * WRITE XEROX-REPORT FROM MAIL-ADDR-LINE-5 DTSTOP02 +00541 * AFTER ADVANCING 1 LINE DTSTOP02 +00542 GO TO P3000-EXIT. DTSTOP02 +00543 IF REC-COUNT > 4999 AND < 10000 DTSTOP02 +00544 WRITE XEROX-REPORT2 FROM MAIL-LINE DTSTOP02 +00545 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00546 WRITE XEROX-REPORT2 FROM MAIL-LINE AFTER ADVANCING 15 LINES DTSTOP02 +00547 WRITE XEROX-REPORT2 FROM MAIL-ADDR-LINE-1 DTSTOP02 +00548 AFTER ADVANCING 1 LINE DTSTOP02 +00549 WRITE XEROX-REPORT2 FROM MAIL-ADDR-LINE-2 DTSTOP02 +00550 AFTER ADVANCING 1 LINE DTSTOP02 +00551 WRITE XEROX-REPORT2 FROM MAIL-ADDR-LINE-3 DTSTOP02 +00552 AFTER ADVANCING 1 LINE DTSTOP02 +00553 WRITE XEROX-REPORT2 FROM MAIL-ADDR-LINE-4 DTSTOP02 +00554 AFTER ADVANCING 1 LINE DTSTOP02 +00555 WRITE XEROX-REPORT2 FROM MAIL-ADDR-LINE-5 DTSTOP02 +00556 AFTER ADVANCING 1 LINE DTSTOP02 +00557 ELSE DTSTOP02 +00558 IF REC-COUNT > 9999 AND < 15000 DTSTOP02 +00559 WRITE XEROX-REPORT3 FROM MAIL-LINE DTSTOP02 +00560 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00561 WRITE XEROX-REPORT3 FROM MAIL-LINE AFTER ADVANCING 15 LINES DTSTOP02 +00562 WRITE XEROX-REPORT3 FROM MAIL-ADDR-LINE-1 DTSTOP02 +00563 AFTER ADVANCING 1 LINE DTSTOP02 +00564 WRITE XEROX-REPORT3 FROM MAIL-ADDR-LINE-2 DTSTOP02 +00565 AFTER ADVANCING 1 LINE DTSTOP02 +00566 WRITE XEROX-REPORT3 FROM MAIL-ADDR-LINE-3 DTSTOP02 +00567 AFTER ADVANCING 1 LINE DTSTOP02 +00568 WRITE XEROX-REPORT3 FROM MAIL-ADDR-LINE-4 DTSTOP02 +00569 AFTER ADVANCING 1 LINE DTSTOP02 +00570 WRITE XEROX-REPORT3 FROM MAIL-ADDR-LINE-5 DTSTOP02 +00571 AFTER ADVANCING 1 LINE DTSTOP02 +00572 ELSE DTSTOP02 +00573 IF REC-COUNT > 14999 AND < 20000 DTSTOP02 +00574 WRITE XEROX-REPORT4 FROM MAIL-LINE DTSTOP02 +00575 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00576 WRITE XEROX-REPORT4 FROM MAIL-LINE AFTER ADVANCING 15 LINES DTSTOP02 +00577 WRITE XEROX-REPORT4 FROM MAIL-ADDR-LINE-1 DTSTOP02 +00578 AFTER ADVANCING 1 LINE DTSTOP02 +00579 WRITE XEROX-REPORT4 FROM MAIL-ADDR-LINE-2 DTSTOP02 +00580 AFTER ADVANCING 1 LINE DTSTOP02 +00581 WRITE XEROX-REPORT4 FROM MAIL-ADDR-LINE-3 DTSTOP02 +00582 AFTER ADVANCING 1 LINE DTSTOP02 +00583 WRITE XEROX-REPORT4 FROM MAIL-ADDR-LINE-4 DTSTOP02 +00584 AFTER ADVANCING 1 LINE DTSTOP02 +00585 WRITE XEROX-REPORT4 FROM MAIL-ADDR-LINE-5 DTSTOP02 +00586 AFTER ADVANCING 1 LINE DTSTOP02 +00587 ELSE DTSTOP02 +00588 IF REC-COUNT > 19999 AND < 25000 DTSTOP02 +00589 WRITE XEROX-REPORT5 FROM MAIL-LINE DTSTOP02 +00590 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00591 WRITE XEROX-REPORT5 FROM MAIL-LINE AFTER ADVANCING 15 LINES DTSTOP02 +00592 WRITE XEROX-REPORT5 FROM MAIL-ADDR-LINE-1 DTSTOP02 +00593 AFTER ADVANCING 1 LINE DTSTOP02 +00594 WRITE XEROX-REPORT5 FROM MAIL-ADDR-LINE-2 DTSTOP02 +00595 AFTER ADVANCING 1 LINE DTSTOP02 +00596 WRITE XEROX-REPORT5 FROM MAIL-ADDR-LINE-3 DTSTOP02 +00597 AFTER ADVANCING 1 LINE DTSTOP02 +00598 WRITE XEROX-REPORT5 FROM MAIL-ADDR-LINE-4 DTSTOP02 +00599 AFTER ADVANCING 1 LINE DTSTOP02 +00600 WRITE XEROX-REPORT5 FROM MAIL-ADDR-LINE-5 DTSTOP02 +00601 AFTER ADVANCING 1 LINE DTSTOP02 +00602 ELSE DTSTOP02 +00603 IF REC-COUNT > 24999 AND < 30000 DTSTOP02 +00604 WRITE XEROX-REPORT6 FROM MAIL-LINE DTSTOP02 +00605 AFTER ADVANCING TOP-OF-PAGE DTSTOP02 +00606 WRITE XEROX-REPORT6 FROM MAIL-LINE AFTER ADVANCING 15 LINES DTSTOP02 +00607 WRITE XEROX-REPORT6 FROM MAIL-ADDR-LINE-1 DTSTOP02 +00608 AFTER ADVANCING 1 LINE DTSTOP02 +00609 WRITE XEROX-REPORT6 FROM MAIL-ADDR-LINE-2 DTSTOP02 +00610 AFTER ADVANCING 1 LINE DTSTOP02 +00611 WRITE XEROX-REPORT6 FROM MAIL-ADDR-LINE-3 DTSTOP02 +00612 AFTER ADVANCING 1 LINE DTSTOP02 +00613 WRITE XEROX-REPORT6 FROM MAIL-ADDR-LINE-4 DTSTOP02 +00614 AFTER ADVANCING 1 LINE DTSTOP02 +00615 WRITE XEROX-REPORT6 FROM MAIL-ADDR-LINE-5 DTSTOP02 +00616 AFTER ADVANCING 1 LINE. DTSTOP02 +00617 P3000-EXIT. DTSTOP02 +00618 EXIT. DTSTOP02 +00619 T1000-TERMINATE. DTSTOP02 +00620 DTSTOP02 +00621 CLOSE PRT-FILE6 DTSTOP02 +00622 PRT-FILE5 DTSTOP02 +00623 PRT-FILE4 DTSTOP02 +00624 PRT-FILE3 DTSTOP02 +00625 PRT-FILE2 DTSTOP02 +00626 TOP-OUTFILE DTSTOP02 +00627 PRT-FILE7 DTSTOP02 +00628 PRT-FILE DTSTOP02 +00629 TOP-FILE. DTSTOP02 +00630 DTSTOP02 +00631 T1000-EXIT. DTSTOP02 +00632 EXIT. DTSTOP02 +00633 DTSTOP02 +00634 S119-AGY-FACTS. DTSTOP02 +00635 DTSTOP02 +00636 CALL 'DTSBU119' USING L119-LINK-AREA. DTSTOP02 +00637 DTSTOP02 +00638 S119-EXIT. DTSTOP02 +00639 EXIT. DTSTOP02 +00640 DTSTOP02 +00641 *S999-ABEND. DTSTOP02 +00642 * DTSTOP02 +00643 * CALL 'DTSBU999' USING WRK-ABEND-CD. DTSTOP02 +00644 * DTSTOP02 +00645 *S999-EXIT. DTSTOP02 +00646 * EXIT. DTSTOP02 +00647 DTSTOP02 diff --git a/Batch/DTSTOP03.cob b/Batch/DTSTOP03.cob new file mode 100644 index 0000000..12bf9ac --- /dev/null +++ b/Batch/DTSTOP03.cob @@ -0,0 +1,1302 @@ +00001 IDENTIFICATION DIVISION. 11/01/22 +00002 PROGRAM-ID. DTSTOP03. DTSTOP03 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV015 +00004 DATE-WRITTEN. DECEMBER 1998. DTSTOP03 +00005 DATE-COMPILED. DTSTOP03 +00006 SKIP3 DTSTOP03 +00007 ***** DTSTOP03 +00008 * DTSTOP03 +00009 * FUNCTION: LIST EMPLOYERS WITH BALANCE GT ZERO DTSTOP03 +00010 * DTSTOP03 +00011 * DTSTOP03 +00012 ***** DTSTOP03 +00013 SKIP3 DTSTOP03 +00014 ENVIRONMENT DIVISION. DTSTOP03 +00015 INPUT-OUTPUT SECTION. DTSTOP03 +00016 SKIP3 DTSTOP03 +00017 FILE-CONTROL. DTSTOP03 +00018 SELECT OUT-FILE ASSIGN TO DTSOZ058 DTSTOP03 +00019 FILE STATUS IS Z057-STATUS. DTSTOP03 +00020 SKIP2 DTSTOP03 +00021 SELECT IN-FILE ASSIGN TO DTSIZ058 DTSTOP03 +00022 FILE STATUS IS Z058-STATUS. DTSTOP03 +00023 SKIP2 DTSTOP03 +00024 DATA DIVISION. DTSTOP03 +00025 FILE SECTION. DTSTOP03 +00026 FD OUT-FILE DTSTOP03 +00027 RECORD CONTAINS 23 CHARACTERS DTSTOP03 +00028 DATA RECORD IS MRRA-FILE-REC. DTSTOP03 +00029 01 OUT-REC PIC X(23). DTSTOP03 +00030 SKIP3 DTSTOP03 +00031 FD IN-FILE. DTSTOP03 +00032 01 IN-REC. DTSTOP03 +00033 05 IN-EMP-NO PIC X(06). DTSTOP03 +00034 05 FILLER PIC X(01). DTSTOP03 +00035 05 IN-QTR PIC 9(05). DTSTOP03 +00036 05 FILLER PIC X(68). DTSTOP03 +00037 SKIP3 DTSTOP03 +00038 EJECT DTSTOP03 +00039 WORKING-STORAGE SECTION. DTSTOP03 +000395 77 PAN-VALET PICTURE X(24) VALUE '015DTSTOP03 11/01/22'. DTSTOP03 +00040 SKIP3 DTSTOP03 +00041 01 WRK-AREA. DTSTOP03 +00042 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +057.DTSTOP03 +00043 05 ABEND-MSG PIC X(60). DTSTOP03 +00044 DTSTOP03 +00045 05 W-IN-QTR PIC S9(05) COMP-3. DTSTOP03 +00046 05 HOLD-LAST-USED-BATCH-NO PIC S9(05) COMP-3. DTSTOP03 +00047 DTSTOP03 +00048 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ057'.DTSTOP03 +00049 05 Z057-STATUS PIC X(02). DTSTOP03 +00050 88 Z057-FILE-OK-88 VALUE '00'. DTSTOP03 +00051 DTSTOP03 +00052 05 Z058-STATUS PIC X(02). DTSTOP03 +00053 88 Z058-FILE-OK-88 VALUE '00'. DTSTOP03 +00054 DTSTOP03 +00055 05 SEQ PIC S9(07) COMP-3 VALUE +0. DTSTOP03 +00056 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSTOP03 +00057 05 WRK-UPDATE-CNT PIC S9(07) COMP-3. DTSTOP03 +00058 05 WRK-EXCLUDE-CNT PIC S9(07) COMP-3. DTSTOP03 +00059 05 WRK-MPRF-AMT PIC S9(09)V99 COMP-3. DTSTOP03 +00060 05 WRK-INTEREST-AMT PIC S9(09)V99 COMP-3. DTSTOP03 +00061 05 WRK-PENALTY-AMT PIC S9(09)V99 COMP-3 VALUE 0.DTSTOP03 +00062 05 WRK-MLIN-AMT PIC S9(09)V99 COMP-3 VALUE 0.DTSTOP03 +00063 05 DIS-MLIN-AMT PIC --------9.99. DTSTOP03 +00064 05 DIS-MPRF-AMT PIC --------9.99. DTSTOP03 +00065 05 WRK-REMIT-AMT PIC S9(09)V99 COMP-3. DTSTOP03 +00066 05 WRK-UI-BAL PIC S9(09)V99 COMP-3. DTSTOP03 +00067 05 WRK-MLIN-IND PIC X(01). DTSTOP03 +00068 88 WRK-MLIN-OK VALUE 'Y'. DTSTOP03 +00069 88 WRK-MLIN-NO-REC VALUE 'N'. DTSTOP03 +00070 DTSTOP03 +00071 05 WRK-OUT-REC. DTSTOP03 +00072 10 OUT-EMP PIC 9(06). DTSTOP03 +00073 10 FILLER PIC X(01) VALUE ','. DTSTOP03 +00074 10 OUT-QTR PIC X(06). DTSTOP03 +00075 10 FILLER PIC X(01) VALUE ','. DTSTOP03 +00076 10 OUT-BATCH PIC 9(05). DTSTOP03 +00077 10 FILLER PIC X(01) VALUE ','. DTSTOP03 +00078 10 OUT-ITEM PIC 9(03). DTSTOP03 +00079 DTSTOP03 +00080 05 WRK-MQTR-CNT PIC S9(07) COMP-3. DTSTOP03 +00081 05 EMP-ACCT-DISP PIC 9(06). DTSTOP03 +00082 05 WRK-TIMELY-PMT-AREA. DTSTOP03 +00083 10 WRK-ERROR-IND PIC X(01). DTSTOP03 +00084 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSTOP03 +00085 88 WRK-ERROR-NO-88 VALUE 'N'. DTSTOP03 +00086 10 WRK-MPAY-FOUND-IND PIC X(01). DTSTOP03 +00087 88 WRK-MPAY-FOUND-YES VALUE 'Y'. DTSTOP03 +00088 88 WRK-MPAY-FOUND-NO VALUE 'N'. DTSTOP03 +00089 10 WRK-MRPT-FOUND-IND PIC X(01). DTSTOP03 +00090 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSTOP03 +00091 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSTOP03 +00092 10 WRK-EMP-SELECTED-IND PIC X(01). DTSTOP03 +00093 88 WRK-EMP-SELECTED-YES VALUE 'Y'. DTSTOP03 +00094 88 WRK-EMP-SELECTED-NO VALUE 'N'. DTSTOP03 +00095 10 WRK-SUPPL-RPT-IND PIC X(01). DTSTOP03 +00096 88 WRK-SUPPL-RPT-YES VALUE 'Y'. DTSTOP03 +00097 88 WRK-SUPPL-RPT-NO VALUE 'N'. DTSTOP03 +00098 10 WRK-WITHDRAWN-RPT-IND PIC X(01). DTSTOP03 +00099 88 WRK-WITHDRAWN-RPT-YES VALUE 'Y'. DTSTOP03 +00100 88 WRK-WITHDRAWN-RPT-NO VALUE 'N'. DTSTOP03 +00101 10 WRK-RPT-BATCH-NO PIC S9(05) COMP-3. DTSTOP03 +00102 10 WRK-RPT-ITEM-NO PIC S9(03) COMP-3. DTSTOP03 +00103 10 WRK-OPID PIC X(08). DTSTOP03 +00104 10 WRITE-OFF PIC X(01) VALUE SPACES. DTSTOP03 +00105 10 WRK-BALANCE-AMT PIC ----------9.99. DTSTOP03 +00106 DTSTOP03 +00107 05 WRK-CERTIFICATE-DATE PIC 9(8) VALUE 0. DTSTOP03 +00108 05 WRK-TIMELY-RPT-AREA. DTSTOP03 +00109 10 WRK-RPT-RECEIVED-DATE PIC S9(09) COMP-3. DTSTOP03 +00110 DTSTOP03 +00111 05 WRK-MNTE-MSG-LINE1. DTSTOP03 +00112 10 WRK-MNTE-MSG-YR PIC X(04). DTSTOP03 +00113 10 FILLER PIC X(01) VALUE '/'. DTSTOP03 +00114 10 WRK-MNTE-MSG-QTR PIC X(01). DTSTOP03 +00115 10 FILLER PIC X(44) VALUE DTSTOP03 +00116 ' QUARTER ANNUAL REPORT FROM TDEC WAS PROCESS'. DTSTOP03 +00117 10 FILLER PIC X(23) VALUE DTSTOP03 +00118 'ED INCORRECTLY BY ESSP '. DTSTOP03 +00119 05 WRK-MNTE-MSG-LINE2. DTSTOP03 +00120 10 FILLER PIC X(48) VALUE DTSTOP03 +00121 'REPORT WITHDRAWN AND REPOSTED CORRECTLY. '. DTSTOP03 +00122 10 FILLER PIC X(23) VALUE DTSTOP03 +00123 ' '. DTSTOP03 +00124 05 WRK-MNTE-MSG-LINE3. DTSTOP03 +00125 10 FILLER PIC X(12) VALUE DTSTOP03 +00126 ' '. DTSTOP03 +00127 DTSTOP03 +00128 05 WRK-MPRF-IND PIC X(01). DTSTOP03 +00129 88 WRK-MPRF-OK VALUE 'Y'. DTSTOP03 +00130 88 WRK-MPRF-NO-REC VALUE 'N'. DTSTOP03 +00131 05 WRK-MQTR-IND PIC X(01). DTSTOP03 +00132 88 WRK-MQTR-OK VALUE 'Y'. DTSTOP03 +00133 88 WRK-MQTR-NO-REC VALUE 'N'. DTSTOP03 +00134 05 WRK-MRPT-IND PIC X(01). DTSTOP03 +00135 88 WRK-MRPT-OK VALUE 'Y'. DTSTOP03 +00136 88 WRK-MRPT-NO-REC VALUE 'N'. DTSTOP03 +00137 DTSTOP03 +00138 05 WRK-T003-CNT PIC S9(07) COMP-3 VALUE +0. DTSTOP03 +00139 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSTOP03 +00140 DTSTOP03 +00141 05 PARM-EOF-IND PIC X(01). DTSTOP03 +00142 DTSTOP03 +00143 05 WRK-EMP-NO PIC 9(06). DTSTOP03 +00144 DTSTOP03 +00145 05 WRK-TRACE-IND PIC X(01). DTSTOP03 +00146 DTSTOP03 +00147 05 WRK-MST-OPEN-IND PIC X(01). DTSTOP03 +00148 DTSTOP03 +00149 05 WRK-REF-OPEN-IND PIC X(01). DTSTOP03 +00150 DTSTOP03 +00151 EJECT DTSTOP03 +00152 01 TSKL-REC. DTSTOP03 +00153 ++INCLUDE DTSITSKL DTSTOP03 +00154 DTSTOP03 +00155 01 T003-REC. DTSTOP03 +00156 ++INCLUDE DTSIT003 DTSTOP03 +00157 DTSTOP03 +00158 01 L005-LINK-AREA. DTSTOP03 +00159 ++INCLUDE DTSIL005 DTSTOP03 +00160 DTSTOP03 +00161 01 L910-LINK-AREA. DTSTOP03 +00162 ++INCLUDE DTSIL910 DTSTOP03 +00163 EJECT DTSTOP03 +00164 01 MSKL-REC. DTSTOP03 +00165 ++INCLUDE DTSIMSKL DTSTOP03 +00166 EJECT DTSTOP03 +00167 01 MHDR-REC. DTSTOP03 +00168 ++INCLUDE DTSIMHDR DTSTOP03 +00169 EJECT DTSTOP03 +00170 01 MPRF-REC. DTSTOP03 +00171 ++INCLUDE DTSIMPRF DTSTOP03 +00172 EJECT DTSTOP03 +00173 01 MQTR-REC. DTSTOP03 +00174 ++INCLUDE DTSIMQTR DTSTOP03 +00175 EJECT DTSTOP03 +00176 01 MRPT-REC. DTSTOP03 +00177 ++INCLUDE DTSIMRPT DTSTOP03 +00178 EJECT DTSTOP03 +00179 01 MDST-REC. DTSTOP03 +00180 ++INCLUDE DTSIMDST DTSTOP03 +00181 EJECT DTSTOP03 +00182 01 MPAY-REC. DTSTOP03 +00183 ++INCLUDE DTSIMPAY DTSTOP03 +00184 EJECT DTSTOP03 +00185 01 MNTE-REC. DTSTOP03 +00186 ++INCLUDE DTSIMNTE DTSTOP03 +00187 EJECT DTSTOP03 +00188 01 L923-LINK-AREA. DTSTOP03 +00189 ++INCLUDE DTSIL923 DTSTOP03 +00190 EJECT DTSTOP03 +00191 01 ASKL-REC. DTSTOP03 +00192 ++INCLUDE DTSIASKL DTSTOP03 +00193 EJECT DTSTOP03 +00194 01 MLIN-REC. DTSTOP03 +00195 ++INCLUDE DTSIMLIN DTSTOP03 +00196 EJECT DTSTOP03 +00197 01 AHDR-REC. DTSTOP03 +00198 ++INCLUDE DTSIAHDR DTSTOP03 +00199 EJECT DTSTOP03 +00200 01 ARPT-REC. DTSTOP03 +00201 ++INCLUDE DTSIARPT DTSTOP03 +00202 EJECT DTSTOP03 +00203 01 APAY-REC. DTSTOP03 +00204 ++INCLUDE DTSIAPAY DTSTOP03 +00205 EJECT DTSTOP03 +00206 01 L927-LINK-AREA. DTSTOP03 +00207 ++INCLUDE DTSIL927 DTSTOP03 +00208 DTSTOP03 +00209 01 L101-LINK-AREA. DTSTOP03 +00210 ++INCLUDE DTSIL101 DTSTOP03 +00211 DTSTOP03 +00212 01 L004-COMM-AREA. DTSTOP03 +00213 ++INCLUDE DTSIL004 DTSTOP03 +00214 EJECT DTSTOP03 +00215 PROCEDURE DIVISION. DTSTOP03 +00216 SKIP2 DTSTOP03 +00217 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSTOP03 +00218 DTSTOP03 +00219 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSTOP03 +00220 DTSTOP03 +00221 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSTOP03 +00222 SKIP2 DTSTOP03 +00223 GOBACK. DTSTOP03 +00224 EJECT DTSTOP03 +00225 I0000-INITIATE. DTSTOP03 +00226 SKIP2 DTSTOP03 +00227 MOVE 'N' TO WRK-TRACE-IND. DTSTOP03 +00228 DTSTOP03 +00229 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSTOP03 +00230 DTSTOP03 +00231 PERFORM I3000-BATCH-HEADER THRU I3000-EXIT. DTSTOP03 +00232 DTSTOP03 +00233 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSTOP03 +00234 DTSTOP03 +00235 I0000-EXIT. DTSTOP03 +00236 EXIT. DTSTOP03 +00237 DTSTOP03 +00238 I2000-OPEN-FILES-1. DTSTOP03 +00239 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSTOP03 +00240 DTSTOP03 +00241 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSTOP03 +00242 DTSTOP03 +00243 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSTOP03 +00244 ** PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. DTSTOP03 +00245 ** PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT. DTSTOP03 +00246 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSTOP03 +00247 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSTOP03 +00248 DTSTOP03 +00249 OPEN OUTPUT OUT-FILE. DTSTOP03 +00250 IF NOT Z057-FILE-OK-88 DTSTOP03 +00251 DISPLAY 'OUTPUT FILE OPEN ERROR: ' Z057-STATUS DTSTOP03 +00252 PERFORM S999-ABEND THRU S999-EXIT DTSTOP03 +00253 END-IF. DTSTOP03 +00254 DTSTOP03 +00255 OPEN INPUT IN-FILE. DTSTOP03 +00256 IF NOT Z058-FILE-OK-88 DTSTOP03 +00257 DISPLAY 'INPUT FILE OPEN ERROR: ' Z058-STATUS DTSTOP03 +00258 PERFORM S999-ABEND THRU S999-EXIT DTSTOP03 +00259 END-IF. DTSTOP03 +00260 DTSTOP03 +00261 I2000-EXIT. DTSTOP03 +00262 EXIT. DTSTOP03 +00263 DTSTOP03 +00264 I3000-BATCH-HEADER. DTSTOP03 +00265 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSTOP03 +00266 MOVE +0 TO MHDR-EMP-NO. DTSTOP03 +00267 SET MHDR-HDR-88 TO TRUE. DTSTOP03 +00268 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP03 +00269 PERFORM S910-READ THRU S910-EXIT. DTSTOP03 +00270 DTSTOP03 +00271 IF L910-NO-REC-88 DTSTOP03 +00272 MOVE 'MHDR RECORD NOT FOUND (I0000)' DTSTOP03 +00273 TO ABEND-MSG DTSTOP03 +00274 PERFORM S999-ABEND THRU S999-EXIT. DTSTOP03 +00275 DTSTOP03 +00276 MOVE MSKL-REC TO MHDR-REC. DTSTOP03 +00277 DTSTOP03 +00278 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP03 +00279 DISPLAY 'FIRST BATCH: ' AHDR-BATCH-NO. DTSTOP03 +00280 DTSTOP03 +00281 I3000-EXIT. DTSTOP03 +00282 EXIT. DTSTOP03 +00283 DTSTOP03 +00284 EJECT DTSTOP03 +00285 P0000-PROCESS. DTSTOP03 +00286 READ IN-FILE AT END GO TO P0000-EXIT. DTSTOP03 +00287 DTSTOP03 +00288 MOVE +0 TO WRK-MPRF-CNT DTSTOP03 +00289 WRK-EXCLUDE-CNT DTSTOP03 +00290 WRK-UPDATE-CNT DTSTOP03 +00291 DIS-MLIN-AMT DTSTOP03 +00292 DIS-MPRF-AMT DTSTOP03 +00293 WRK-INTEREST-AMT. DTSTOP03 +00294 SET WRK-ERROR-NO-88 TO TRUE. DTSTOP03 +00295 DTSTOP03 +00296 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSTOP03 +00297 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSTOP03 +00298 DTSTOP03 +00299 MOVE +0 TO MSKL-EMP-NO. DTSTOP03 +00300 DTSTOP03 +00301 SET MPRF-PRF-88 TO TRUE. DTSTOP03 +00302 MOVE +000001 TO MPRF-EMP-NO DTSTOP03 +00303 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSTOP03 +00304 PERFORM S910-READ THRU S910-EXIT. DTSTOP03 +00305 IF L910-OK-88 DTSTOP03 +00306 MOVE MSKL-REC TO MPRF-REC DTSTOP03 +00307 SET WRK-MPRF-OK TO TRUE DTSTOP03 +00308 ELSE DTSTOP03 +00309 DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSTOP03 +00310 SET L910-NO-REC-88 TO TRUE DTSTOP03 +00311 GO TO P0000-EXIT. DTSTOP03 +00312 DTSTOP03 +00313 DISPLAY 'LIST OF EMPLOYERS WITH BALANCE DUE GT ZERO. '. DTSTOP03 +00314 * DISPLAY 'REPORT DTSBZ063 - AUTOMATIC WITHDRAWALS '. DTSTOP03 +00315 DISPLAY SPACE. DTSTOP03 +00316 DTSTOP03 +00317 PERFORM P1000-READ-NEXT THRU P1000-EXIT DTSTOP03 +00318 UNTIL WRK-MPRF-NO-REC DTSTOP03 +00319 OR WRK-ERROR-YES-88. DTSTOP03 +00320 ** OR MPRF-EMP-NO > 020999. DTSTOP03 +00321 ** OR WRK-REL-CNT > +100. DTSTOP03 +00322 P0000-EXIT. DTSTOP03 +00323 EXIT. DTSTOP03 +00324 EJECT DTSTOP03 +00325 P1000-READ-NEXT. DTSTOP03 +00326 DTSTOP03 +00327 ADD +1 TO WRK-MPRF-CNT DTSTOP03 +00328 DTSTOP03 +00329 IF MPRF-BANKRP-OPEN-88 DTSTOP03 +00330 GO TO P1000-READ-CONTINUE. DTSTOP03 +00331 DTSTOP03 +00332 IF MPRF-TOT-BALANCE-AMT < 99 DTSTOP03 +00333 GO TO P1000-READ-CONTINUE. DTSTOP03 +00334 DTSTOP03 +00335 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSTOP03 +00336 GO TO P1000-READ-CONTINUE. DTSTOP03 +00337 DTSTOP03 +00338 ** IF MPRF-ESTB-DATE < 20050101 DTSTOP03 +00339 ** GO TO P1000-READ-CONTINUE. DTSTOP03 +00340 DTSTOP03 +00341 ** IF MPRF-ESTB-DATE > 20190501 DTSTOP03 +00342 ** GO TO P1000-READ-CONTINUE. DTSTOP03 +00343 DTSTOP03 +00344 IF MPRF-NOT-WRITTEN-OFF-88 DTSTOP03 +00345 MOVE 'N' TO WRITE-OFF DTSTOP03 +00346 ELSE DTSTOP03 +00347 MOVE 'Y' TO WRITE-OFF. DTSTOP03 +00348 DTSTOP03 +00349 MOVE ZEROS TO DIS-MLIN-AMT WRK-MLIN-AMT DTSTOP03 +00350 DIS-MPRF-AMT WRK-MPRF-AMT. DTSTOP03 +00351 MOVE ZEROS TO WRK-CERTIFICATE-DATE DTSTOP03 +00352 CL**2 +00353 IF MPRF-MLIN-IND NOT = 'Y' CL*10 +00354 GO TO P1000-READ-CONTINUE. CL*10 +00355 CL*11 +00356 CL*12 +00357 PERFORM P7000-SCAN-LIN THRU P7000-EXIT CL**2 +00358 MOVE WRK-MLIN-AMT TO DIS-MLIN-AMT. CL*11 +00359 * DISPLAY '>>MPRF TOT: ' MPRF-EMP-NO ' ' MPRF-TOT-BALANCE-AMT CL**2 +00360 CL*11 +00361 DISPLAY '>>MLIN LIN: ' MLIN-EMP-NO ' ' WRK-MLIN-IND. CL*15 +00362 IF WRK-MLIN-IND = 'Y' CL**7 +00363 PERFORM P5000-READ-MQTR THRU P5000-EXIT CL**8 +00364 * MOVE MPRF-TOT-BALANCE-AMT TO WRK-BALANCE-AMT CL**4 +00365 MOVE WRK-MPRF-AMT TO DIS-MPRF-AMT CL**4 +00366 DISPLAY 'TOTAL LIEN: ' MPRF-EMP-NO ';' CL**2 +00367 MPRF-PRIMARY-NAME(1:20) ';' DTSTOP03 +00368 MPRF-EMP-CLASS ';' DTSTOP03 +00369 MPRF-EMP-STATUS ';' DTSTOP03 +00370 * MPRF-ORG-TYPE ',' DTSTOP03 +00371 * WRITE-OFF ',' DTSTOP03 +00372 * MPRF-PURSUED-RPT-CNT ',' DTSTOP03 +00373 MPRF-BANKRUPTCY-OPEN-IND ';' DTSTOP03 +00374 MPRF-MDPC-IND ';' DTSTOP03 +00375 MPRF-MAPL-IND ';' DTSTOP03 +00376 MPRF-MLIN-IND ';' DTSTOP03 +00377 WRK-CERTIFICATE-DATE ';' DTSTOP03 +00378 DIS-MPRF-AMT ';' DTSTOP03 +00379 DIS-MLIN-AMT ';' DTSTOP03 +00380 MPRF-RETURN-MAIL-IND ';'. DTSTOP03 +00381 DTSTOP03 +00382 P1000-READ-CONTINUE. DTSTOP03 +00383 DTSTOP03 +00384 MOVE MPRF-REC TO MSKL-REC. DTSTOP03 +00385 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP03 +00386 DTSTOP03 +00387 IF NOT L910-OK-88 DTSTOP03 +00388 DISPLAY ' EMPLOYER NOT FOUND ' MPRF-EMP-NO CL*11 +00389 SET WRK-MPRF-NO-REC TO TRUE DTSTOP03 +00390 ELSE DTSTOP03 +00391 SET WRK-MPRF-OK TO TRUE DTSTOP03 +00392 MOVE MSKL-REC TO MPRF-REC. DTSTOP03 +00393 DTSTOP03 +00394 P1000-EXIT. DTSTOP03 +00395 EXIT. DTSTOP03 +00396 DTSTOP03 +00397 P7000-SCAN-LIN. DTSTOP03 +00398 MOVE 'N' TO WRK-MLIN-IND. CL**6 +00399 MOVE ZEROS TO WRK-MLIN-AMT DTSTOP03 +00400 MOVE ZEROS TO DIS-MLIN-AMT DTSTOP03 +00401 MOVE LOW-VALUES TO MLIN-KEY-AREA. DTSTOP03 +00402 MOVE MPRF-EMP-NO TO MLIN-EMP-NO. DTSTOP03 +00403 SET MLIN-LIN-88 TO TRUE. DTSTOP03 +00404 MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA. DTSTOP03 +00405 DTSTOP03 +00406 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP03 +00407 PERFORM S910-READ THRU S910-EXIT. CL*15 +00408 IF L910-NO-REC-88 DTSTOP03 +00409 DISPLAY 'NO 1LIEN: ' MPRF-EMP-NO ';' CL*15 +00410 GO TO P7000-EXIT DTSTOP03 +00411 ELSE DTSTOP03 +00412 PERFORM P7100-SCAN-MLIN THRU P7100-EXIT DTSTOP03 +00413 UNTIL WRK-MLIN-NO-REC. DTSTOP03 +00414 DTSTOP03 +00415 P7000-EXIT. DTSTOP03 +00416 EXIT. DTSTOP03 +00417 P7100-SCAN-MLIN. DTSTOP03 +00418 MOVE MSKL-REC TO MLIN-REC. DTSTOP03 +00419 DISPLAY 'NO 1LIEN: ' MLIN-EMP-NO ' ' MLIN-STATUS-CD. CL*15 +00420 IF MLIN-STATUS-ACTIVE-88 DTSTOP03 +00421 NEXT SENTENCE CL**2 +00422 ELSE CL**2 +00423 GO TO P7100-CONTINUE. CL**2 +00424 CL**2 +00425 DISPLAY '1LIEN: ' MPRF-EMP-NO ';' CL*14 +00426 IF MLIN-ESTB-DATE < 20130101 OR CL**2 +00427 MLIN-ESTB-DATE > 20191231 CL**2 +00428 GO TO P7100-CONTINUE. CL**2 +00429 CL**2 +00430 DISPLAY '2LIEN: ' MPRF-EMP-NO ';' CL*14 +00431 DISPLAY ' MLIN AMT; ' MLIN-STMT-DUE-AMT. CL**9 +00432 IF MLIN-STMT-DUE-AMT < .01 CL**9 +00433 GO TO P7100-CONTINUE. CL**3 +00434 CL**6 +00435 MOVE 'Y' TO WRK-MLIN-IND. CL**6 +00436 CL**3 +00437 MOVE MLIN-COMP-DATE TO WRK-CERTIFICATE-DATE DTSTOP03 +00438 ADD MLIN-STMT-DUE-AMT TO WRK-MLIN-AMT. DTSTOP03 +00439 MOVE MLIN-STMT-DUE-AMT TO DIS-MLIN-AMT CL**2 +00440 CL**2 +00441 DISPLAY 'MLIEN: ' MPRF-EMP-NO ';' CL**2 +00442 WRK-CERTIFICATE-DATE ';' CL**2 +00443 DIS-MLIN-AMT ';' CL**2 +00444 MLIN-COV-CNT ';' CL**2 +00445 MLIN-COVERED-YRQ(1) ';' CL**2 +00446 MLIN-COVERED-YRQ(2) ';' CL**2 +00447 MLIN-COVERED-YRQ(3) ';' CL**2 +00448 MLIN-COVERED-YRQ(4) ';' CL**2 +00449 MLIN-COVERED-YRQ(5) ';' CL**2 +00450 MLIN-COVERED-YRQ(6) ';' CL**2 +00451 MLIN-COVERED-YRQ(7) ';' CL**2 +00452 MLIN-COVERED-YRQ(8) ';' CL**2 +00453 MLIN-COVERED-YRQ(9) ';'. CL**2 +00454 * SET WRK-MLIN-NO-REC TO TRUE DTSTOP03 +00455 * GO TO P7100-EXIT. DTSTOP03 +00456 DTSTOP03 +00457 P7100-CONTINUE. CL**2 +00458 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP03 +00459 IF L910-NO-REC-88 DTSTOP03 +00460 SET WRK-MLIN-NO-REC TO TRUE. DTSTOP03 +00461 DTSTOP03 +00462 P7100-EXIT. DTSTOP03 +00463 EXIT. DTSTOP03 +00464 P5000-READ-MQTR. DTSTOP03 +00465 * DISPLAY '>>>> P5000-READ-MQTR>>>> ' MPRF-EMP-NO. DTSTOP03 +00466 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSTOP03 +00467 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSTOP03 +00468 MOVE ZEROS TO WRK-MPRF-AMT. DTSTOP03 +00469 DTSTOP03 +00470 SET MQTR-QTR-88 TO TRUE. DTSTOP03 +00471 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP03 +00472 DTSTOP03 +00473 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP03 +00474 DTSTOP03 +00475 IF L910-NO-REC-88 DTSTOP03 +00476 DISPLAY ' BQTR REC NOT FOUND ' MPRF-EMP-NO DTSTOP03 +00477 GO TO P5000-EXIT. DTSTOP03 +00478 PERFORM S910-READ THRU S910-EXIT. DTSTOP03 +00479 DTSTOP03 +00480 IF L910-NO-REC-88 DTSTOP03 +00481 DISPLAY ' RQTR REC NOT FOUND ' MPRF-EMP-NO DTSTOP03 +00482 GO TO P5000-EXIT. DTSTOP03 +00483 DTSTOP03 +00484 MOVE MSKL-REC TO MQTR-REC. DTSTOP03 +00485 PERFORM P5100-MQTR-SCAN THRU P5100-EXIT DTSTOP03 +00486 UNTIL L910-NO-REC-88. DTSTOP03 +00487 DTSTOP03 +00488 DTSTOP03 +00489 P5000-EXIT. DTSTOP03 +00490 EXIT. DTSTOP03 +00491 DTSTOP03 +00492 P5100-MQTR-SCAN. DTSTOP03 +00493 * DISPLAY '>>>> P5100-READ-MQTR>>> ' MPRF-EMP-NO. DTSTOP03 +00494 MOVE ZEROS TO L101-PAID-CHNG. DTSTOP03 +00495 PERFORM DTSTOP03 +00496 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSTOP03 +00497 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSTOP03 +00498 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSTOP03 +00499 TO WRK-MPRF-AMT DTSTOP03 +00500 * DISPLAY 'MQTR AMT: ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSTOP03 +00501 * DISPLAY 'WRK AMT: ' WRK-MPRF-AMT DTSTOP03 +00502 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 0 DTSTOP03 +00503 PERFORM P5001-READ-MRPT THRU P5001-EXIT DTSTOP03 +00504 END-IF DTSTOP03 +00505 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSTOP03 +00506 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSTOP03 +00507 TO L101-PAID-CHNG DTSTOP03 +00508 END-IF DTSTOP03 +00509 END-PERFORM. DTSTOP03 +00510 IF L101-PAID-CHNG > +0 DTSTOP03 +00511 NEXT SENTENCE DTSTOP03 +00512 ELSE DTSTOP03 +00513 GO TO P5100-CONTINUE. DTSTOP03 +00514 DTSTOP03 +00515 * MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE. CL**4 +00516 * IF L101-RECEIVED-DATE > 0 DTSTOP03 +00517 * NEXT SENTENCE DTSTOP03 +00518 * ELSE DTSTOP03 +00519 * DISPLAY ' RPT REC NOT FOUND- NO INT ' MPRF-EMP-NO DTSTOP03 +00520 * GO TO P5100-CONTINUE. DTSTOP03 +00521 DTSTOP03 +00522 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSTOP03 +00523 * SET L101-ABATE-PEN-NO-88 TO TRUE. DTSTOP03 +00524 DTSTOP03 +00525 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSTOP03 +00526 DTSTOP03 +00527 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSTOP03 +00528 DTSTOP03 +00529 PERFORM S101-PER-MONTH-YES THRU S101-EXIT. DTSTOP03 +00530 DTSTOP03 +00531 ADD L101-INT-CHARGE-CHNG TO WRK-MPRF-AMT. DTSTOP03 +00532 DTSTOP03 +00533 DISPLAY 'BAL AMT: ' MQTR-EMP-NO ' ' WRK-MPRF-AMT CL**4 +00534 ' TAX AMT: ' L101-PAID-CHNG CL**4 +00535 ' INT AMT: ' L101-INT-CHARGE-CHNG. CL**5 +00536 P5100-CONTINUE. DTSTOP03 +00537 MOVE MQTR-REC TO MSKL-REC. DTSTOP03 +00538 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP03 +00539 IF L910-NO-REC-88 DTSTOP03 +00540 SET L910-NO-REC-88 TO TRUE DTSTOP03 +00541 GO TO P5100-EXIT. DTSTOP03 +00542 DTSTOP03 +00543 MOVE MSKL-REC TO MQTR-REC. DTSTOP03 +00544 DTSTOP03 +00545 P5100-EXIT. DTSTOP03 +00546 EXIT. DTSTOP03 +00547 DTSTOP03 +00548 P5001-READ-MRPT. DTSTOP03 +00549 * DISPLAY '>>>> P5001-READ-MRPT>>>>> ' MPRF-EMP-NO. DTSTOP03 +00550 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP03 +00551 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP03 +00552 MOVE MQTR-YRQ TO MRPT-YRQ DTSTOP03 +00553 DTSTOP03 +00554 SET MRPT-RPT-88 TO TRUE. DTSTOP03 +00555 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSTOP03 +00556 DTSTOP03 +00557 MOVE ZEROS TO L101-RECEIVED-DATE. DTSTOP03 +00558 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP03 +00559 DTSTOP03 +00560 IF L910-NO-REC-88 DTSTOP03 +00561 DISPLAY ' RPT REC NOT FOUND ' MPRF-EMP-NO DTSTOP03 +00562 MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE DTSTOP03 +00563 GO TO P5001-EXIT. DTSTOP03 +00564 DTSTOP03 +00565 PERFORM P5002-MRPT-SCAN THRU P5002-EXIT DTSTOP03 +00566 UNTIL L910-NO-REC-88. DTSTOP03 +00567 DTSTOP03 +00568 DTSTOP03 +00569 P5001-EXIT. DTSTOP03 +00570 EXIT. DTSTOP03 +00571 DTSTOP03 +00572 P5002-MRPT-SCAN. DTSTOP03 +00573 * DISPLAY '>>>> P5002-SCAN-MRPT>>> ' MPRF-EMP-NO. DTSTOP03 +00574 MOVE MSKL-REC TO MRPT-REC. DTSTOP03 +00575 IF MRPT-ORIG-88 OR MRPT-ESTIM-88 DTSTOP03 +00576 MOVE MRPT-RECEIVED-DATE TO L101-RECEIVED-DATE DTSTOP03 +00577 SET L910-NO-REC-88 TO TRUE DTSTOP03 +00578 GO TO P5002-EXIT. DTSTOP03 +00579 DTSTOP03 +00580 MOVE MRPT-REC TO MSKL-REC. DTSTOP03 +00581 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP03 +00582 IF L910-NO-REC-88 DTSTOP03 +00583 SET L910-NO-REC-88 TO TRUE DTSTOP03 +00584 GO TO P5002-EXIT. DTSTOP03 +00585 DTSTOP03 +00586 DTSTOP03 +00587 P5002-EXIT. DTSTOP03 +00588 EXIT. DTSTOP03 +00589 P5111-SUM-PENALTY. DTSTOP03 +00590 PERFORM DTSTOP03 +00591 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSTOP03 +00592 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSTOP03 +00593 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSTOP03 +00594 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSTOP03 +00595 TO WRK-PENALTY-AMT DTSTOP03 +00596 ELSE DTSTOP03 +00597 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSTOP03 +00598 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSTOP03 +00599 TO WRK-UI-BAL DTSTOP03 +00600 END-IF DTSTOP03 +00601 END-IF DTSTOP03 +00602 END-PERFORM. DTSTOP03 +00603 DTSTOP03 +00604 P5111-EXIT. DTSTOP03 +00605 EXIT. DTSTOP03 +00606 DTSTOP03 +00607 DTSTOP03 +00608 P5120-FIND-REPORT. DTSTOP03 +00609 DTSTOP03 +00610 DISPLAY '*** P5120-1 ' MPRF-EMP-NO DTSTOP03 +00611 ' ' MQTR-YRQ. DTSTOP03 +00612 DTSTOP03 +00613 SET WRK-EMP-SELECTED-NO TO TRUE DTSTOP03 +00614 MOVE ZERO TO WRK-RPT-RECEIVED-DATE DTSTOP03 +00615 WRK-RPT-BATCH-NO DTSTOP03 +00616 WRK-RPT-ITEM-NO. DTSTOP03 +00617 * SET WRK-SUPPL-RPT-NO TO TRUE. DTSTOP03 +00618 * SET WRK-WITHDRAWN-RPT-NO TO TRUE. DTSTOP03 +00619 DTSTOP03 +00620 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP03 +00621 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP03 +00622 MOVE MQTR-YRQ TO MRPT-YRQ. DTSTOP03 +00623 MOVE ZEROS TO MRPT-BATCH-NO. DTSTOP03 +00624 MOVE ZEROS TO MRPT-ITEM-NO DTSTOP03 +00625 DTSTOP03 +00626 SET MRPT-RPT-88 TO TRUE. DTSTOP03 +00627 MOVE MRPT-REC TO MSKL-REC. DTSTOP03 +00628 DTSTOP03 +00629 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSTOP03 +00630 IF L910-OK-88 DTSTOP03 +00631 PERFORM P5121-SCAN-MRPT THRU P5121-EXIT DTSTOP03 +00632 UNTIL L910-NO-REC-88. DTSTOP03 +00633 DTSTOP03 +00634 IF WRK-EMP-SELECTED-YES DTSTOP03 +00635 SET WRK-MRPT-OK TO TRUE DTSTOP03 +00636 DISPLAY ' MRPT REPORT SELECTED ' MPRF-EMP-NO ' ' MRPT-YRQ DTSTOP03 +00637 GO TO P5120-EXIT DTSTOP03 +00638 END-IF. DTSTOP03 +00639 DTSTOP03 +00640 DTSTOP03 +00641 P5120-EXIT. DTSTOP03 +00642 EXIT. DTSTOP03 +00643 DTSTOP03 +00644 P5121-SCAN-MRPT. DTSTOP03 +00645 MOVE MSKL-REC TO MRPT-REC. DTSTOP03 +00646 IF MRPT-YRQ = MQTR-YRQ DTSTOP03 +00647 NEXT SENTENCE DTSTOP03 +00648 ELSE DTSTOP03 +00649 IF MRPT-YRQ > MQTR-YRQ DTSTOP03 +00650 SET WRK-EMP-SELECTED-NO TO TRUE DTSTOP03 +00651 SET L910-NO-REC-88 TO TRUE DTSTOP03 +00652 GO TO P5121-EXIT DTSTOP03 +00653 ELSE DTSTOP03 +00654 GO TO P5121-READ-NEXT DTSTOP03 +00655 END-IF DTSTOP03 +00656 END-IF. DTSTOP03 +00657 DTSTOP03 +00658 IF MRPT-ORIG-88 AND MRPT-RESPONSIBLE-OP-ID = 'WEBESSP ' DTSTOP03 +00659 MOVE MRPT-BATCH-NO TO WRK-RPT-BATCH-NO DTSTOP03 +00660 MOVE MRPT-ITEM-NO TO WRK-RPT-ITEM-NO DTSTOP03 +00661 SET WRK-EMP-SELECTED-YES TO TRUE DTSTOP03 +00662 SET L910-NO-REC-88 TO TRUE DTSTOP03 +00663 GO TO P5121-EXIT DTSTOP03 +00664 END-IF. DTSTOP03 +00665 DTSTOP03 +00666 DTSTOP03 +00667 P5121-READ-NEXT. DTSTOP03 +00668 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSTOP03 +00669 IF L910-NO-REC-88 DTSTOP03 +00670 SET WRK-MRPT-NO-REC TO TRUE. DTSTOP03 +00671 DTSTOP03 +00672 P5121-EXIT. DTSTOP03 +00673 EXIT. DTSTOP03 +00674 DTSTOP03 +00675 P5130-ACCT-TRANS. DTSTOP03 +00676 ** DISPLAY 'P5130 ' DTSTOP03 +00677 ADD +1 TO SEQ. DTSTOP03 +00678 ** MOVE MPRF-EMP-NO TO EMP-ACCT-DISP. DTSTOP03 +00679 * DISPLAY SEQ ' RATED ' EMP-ACCT-DISP DTSTOP03 +00680 * ' RPT DOC # ' WRK-RPT-BATCH-NO DTSTOP03 +00681 ** ' ' WRK-RPT-ITEM-NO. DTSTOP03 +00682 MOVE MPRF-EMP-NO TO OUT-EMP. DTSTOP03 +00683 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSTOP03 +00684 SET L004-FROM-5 TO TRUE. DTSTOP03 +00685 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSTOP03 +00686 MOVE L004-SLASH-5-QTR TO OUT-QTR. DTSTOP03 +00687 MOVE WRK-RPT-BATCH-NO TO OUT-BATCH. DTSTOP03 +00688 MOVE WRK-RPT-ITEM-NO TO OUT-ITEM. DTSTOP03 +00689 WRITE OUT-REC FROM WRK-OUT-REC. DTSTOP03 +00690 IF NOT Z057-FILE-OK-88 DTSTOP03 +00691 DISPLAY 'CANNOT WRITE OUTPUT FILE ' Z057-STATUS DTSTOP03 +00692 SET WRK-ERROR-YES-88 TO TRUE DTSTOP03 +00693 GO TO P5130-EXIT DTSTOP03 +00694 END-IF. DTSTOP03 +00695 PERFORM P5131-READ-MRPT-MPAY THRU P5131-EXIT. DTSTOP03 +00696 PERFORM P5132-WITHDRAW-MRPT THRU P5132-EXIT. DTSTOP03 +00697 PERFORM P5133-REVERSE-MPAY THRU P5133-EXIT. DTSTOP03 +00698 * PERFORM P5134-ENTER-ARPT THRU P5134-EXIT. DTSTOP03 +00699 DTSTOP03 +00700 P5130-EXIT. DTSTOP03 +00701 EXIT. DTSTOP03 +00702 DTSTOP03 +00703 P5131-READ-MRPT-MPAY. DTSTOP03 +00704 ** DISPLAY 'P5131 READ MRPT MPAY ' DTSTOP03 +00705 SET WRK-MPAY-FOUND-YES TO TRUE. DTSTOP03 +00706 SET WRK-MRPT-FOUND-YES TO TRUE. DTSTOP03 +00707 MOVE ZERO TO WRK-REMIT-AMT. DTSTOP03 +00708 DTSTOP03 +00709 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP03 +00710 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP03 +00711 MOVE MQTR-YRQ TO MRPT-YRQ. DTSTOP03 +00712 MOVE WRK-RPT-BATCH-NO TO MRPT-BATCH-NO DTSTOP03 +00713 MOVE WRK-RPT-ITEM-NO TO MRPT-ITEM-NO. DTSTOP03 +00714 SET MRPT-RPT-88 TO TRUE. DTSTOP03 +00715 MOVE MRPT-REC TO MSKL-REC. DTSTOP03 +00716 DTSTOP03 +00717 PERFORM S910-READ THRU S910-EXIT. DTSTOP03 +00718 IF L910-OK-88 DTSTOP03 +00719 DISPLAY ' MRPT-EMP-NO ' MRPT-EMP-NO DTSTOP03 +00720 DISPLAY ' MRPT-YRQ ' MRPT-YRQ DTSTOP03 +00721 DISPLAY ' MRPT-BATCH-NO ' MRPT-BATCH-NO DTSTOP03 +00722 DISPLAY ' MRPT-ITEM-NO ' MRPT-ITEM-NO DTSTOP03 +00723 MOVE MSKL-REC TO MRPT-REC DTSTOP03 +00724 ELSE DTSTOP03 +00725 DISPLAY 'CANNOT FIND MRPT ' MPRF-EMP-NO DTSTOP03 +00726 SET WRK-MRPT-FOUND-NO TO TRUE DTSTOP03 +00727 GO TO P5131-EXIT. DTSTOP03 +00728 DTSTOP03 +00729 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSTOP03 +00730 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSTOP03 +00731 MOVE WRK-RPT-BATCH-NO TO MPAY-BATCH-NO DTSTOP03 +00732 MOVE WRK-RPT-ITEM-NO TO MPAY-ITEM-NO. DTSTOP03 +00733 SET MPAY-PAY-88 TO TRUE. DTSTOP03 +00734 MOVE MPAY-REC TO MSKL-REC. DTSTOP03 +00735 DTSTOP03 +00736 PERFORM S910-READ THRU S910-EXIT. DTSTOP03 +00737 IF L910-OK-88 DTSTOP03 +00738 MOVE MSKL-REC TO MPAY-REC DTSTOP03 +00739 MOVE MPAY-REMIT-AMT TO WRK-REMIT-AMT DTSTOP03 +00740 DISPLAY 'MPAY-EMP-NO ' MPAY-EMP-NO DTSTOP03 +00741 DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO DTSTOP03 +00742 DISPLAY 'MPAY-ITEM-NO ' MPAY-ITEM-NO DTSTOP03 +00743 ELSE DTSTOP03 +00744 DISPLAY 'CANNOT FIND MPAY ' MPRF-EMP-NO DTSTOP03 +00745 SET WRK-MPAY-FOUND-NO TO TRUE DTSTOP03 +00746 GO TO P5131-EXIT. DTSTOP03 +00747 DTSTOP03 +00748 P5131-EXIT. DTSTOP03 +00749 EXIT. DTSTOP03 +00750 DTSTOP03 +00751 P5132-WITHDRAW-MRPT. DTSTOP03 +00752 * DISPLAY 'P5132 WITHDRAW MRPT ' DTSTOP03 +00753 IF WRK-MRPT-FOUND-NO DTSTOP03 +00754 GO TO P5132-EXIT. DTSTOP03 +00755 DTSTOP03 +00756 MOVE LOW-VALUES TO ARPT-REC. DTSTOP03 +00757 DTSTOP03 +00758 IF AHDR-ATC-FILE-TRAN-CNT < +999 DTSTOP03 +00759 NEXT SENTENCE DTSTOP03 +00760 ELSE DTSTOP03 +00761 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSTOP03 +00762 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP03 +00763 DTSTOP03 +00764 MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO. DTSTOP03 +00765 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT. DTSTOP03 +00766 MOVE AHDR-ATC-FILE-TRAN-CNT TO ARPT-ITEM-NO. DTSTOP03 +00767 SET ARPT-RPT-88 TO TRUE. DTSTOP03 +00768 DTSTOP03 +00769 MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK. DTSTOP03 +00770 MOVE MPRF-EMP-NO TO ARPT-EMP-NO. DTSTOP03 +00771 SET ARPT-WITHDRW-88 TO TRUE. DTSTOP03 +00772 MOVE MQTR-YRQ TO ARPT-YRQ. DTSTOP03 +00773 DTSTOP03 +00774 COMPUTE ARPT-TOT-WAGE = DTSTOP03 +00775 -1 * MRPT-TOT-WAGE. DTSTOP03 +00776 COMPUTE ARPT-TAX-WAGE = DTSTOP03 +00777 -1 * MRPT-TAX-WAGE. DTSTOP03 +00778 COMPUTE ARPT-EXCESS-WAGE = DTSTOP03 +00779 -1 * MRPT-EXCESS-WAGE. DTSTOP03 +00780 DTSTOP03 +00781 MOVE +0 TO ARPT-REMIT-AMT. DTSTOP03 +00782 SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE. DTSTOP03 +00783 SET ARPT-WAIVE-BOTH-NO-88 DTSTOP03 +00784 ARPT-WAIVE-INT-NO-88 DTSTOP03 +00785 ARPT-WAIVE-LATE-PEN-NO-88 DTSTOP03 +00786 ARPT-STATUS-CHNG-NO-88 TO TRUE. DTSTOP03 +00787 DTSTOP03 +00788 SET ARPT-TOTAL-NO-ENTRY-88 DTSTOP03 +00789 ARPT-1ST-MTH-NO-ENTRY-88 DTSTOP03 +00790 ARPT-2ND-MTH-NO-ENTRY-88 DTSTOP03 +00791 ARPT-3RD-MTH-NO-ENTRY-88 TO TRUE. DTSTOP03 +00792 DTSTOP03 +00793 SET ARPT-VERIFIED-NO-88 TO TRUE. DTSTOP03 +00794 MOVE +0 TO ARPT-RECEIVED-DATE DTSTOP03 +00795 ARPT-DEPOSIT-DATE. DTSTOP03 +00796 MOVE 'SYS' TO ARPT-RESPONSIBLE-ACTIVITY. DTSTOP03 +00797 MOVE SPACES TO ARPT-RESPONSIBLE-OP-ID. DTSTOP03 +00798 MOVE SPACE TO ARPT-DISREGARD-EDITS-IND. DTSTOP03 +00799 SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE. DTSTOP03 +00800 MOVE +0 TO ARPT-PROCESSED-DATE DTSTOP03 +00801 ARPT-TRACE-NO DTSTOP03 +00802 ARPT-PSEUDO-BATCH-NO DTSTOP03 +00803 ARPT-PSEUDO-ITEM-NO. DTSTOP03 +00804 DTSTOP03 +00805 MOVE ARPT-REC TO ASKL-REC. DTSTOP03 +00806 ** DISPLAY 'ARPT-NAME-CHECK ' ARPT-NAME-CHECK DTSTOP03 +00807 ** DISPLAY 'ARPT-EMP-NO ' ARPT-EMP-NO DTSTOP03 +00808 ** DISPLAY 'ARPT-YRQ ' ARPT-YRQ DTSTOP03 +00809 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP03 +00810 DTSTOP03 +00811 DISPLAY 'P5132 REPORT WITHDRAWN ' ARPT-EMP-NO ' ' ARPT-YRQ. DTSTOP03 +00812 P5132-EXIT. DTSTOP03 +00813 EXIT. DTSTOP03 +00814 DTSTOP03 +00815 P5133-REVERSE-MPAY. DTSTOP03 +00816 DTSTOP03 +00817 ** DISPLAY 'P5133 REVERSE MPAY ' DTSTOP03 +00818 IF WRK-MPAY-FOUND-NO DTSTOP03 +00819 GO TO P5133-EXIT. DTSTOP03 +00820 DTSTOP03 +00821 MOVE LOW-VALUES TO APAY-REC. DTSTOP03 +00822 DTSTOP03 +00823 IF AHDR-ATC-FILE-TRAN-CNT < +999 DTSTOP03 +00824 NEXT SENTENCE DTSTOP03 +00825 ELSE DTSTOP03 +00826 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSTOP03 +00827 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP03 +00828 DTSTOP03 +00829 MOVE AHDR-BATCH-NO TO APAY-BATCH-NO. DTSTOP03 +00830 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT. DTSTOP03 +00831 MOVE AHDR-ATC-FILE-TRAN-CNT TO APAY-ITEM-NO. DTSTOP03 +00832 SET APAY-PAY-88 TO TRUE. DTSTOP03 +00833 DTSTOP03 +00834 MOVE MPRF-PRIMARY-NAME TO APAY-NAME-CHECK. DTSTOP03 +00835 MOVE MPRF-EMP-NO TO APAY-EMP-NO. DTSTOP03 +00836 SET APAY-PAY-REV-88 TO TRUE. DTSTOP03 +00837 DTSTOP03 +00838 COMPUTE APAY-REMIT-AMT = DTSTOP03 +00839 -1 * MPAY-REMIT-AMT. DTSTOP03 +00840 DTSTOP03 +00841 ADD APAY-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT. DTSTOP03 +00842 DTSTOP03 +00843 SET APAY-WAIVE-INT-NO-88 DTSTOP03 +00844 APAY-WAIVE-LATE-PEN-NO-88 DTSTOP03 +00845 APAY-NSF-PEN-CHARGE-NO-88 TO TRUE. DTSTOP03 +00846 DTSTOP03 +00847 MOVE +0 TO APAY-RECEIVED-DATE DTSTOP03 +00848 APAY-DEPOSIT-DATE DTSTOP03 +00849 APAY-APPLIC-YRQ. DTSTOP03 +00850 MOVE SPACES TO APAY-APPLIC-IND. DTSTOP03 +00851 DTSTOP03 +00852 MOVE MPAY-BATCH-NO TO APAY-APPLIC-BATCH-NO. DTSTOP03 +00853 MOVE MPAY-ITEM-NO TO APAY-APPLIC-ITEM-NO. DTSTOP03 +00854 DTSTOP03 +00855 MOVE 'SYS' TO APAY-RESPONSIBLE-ACTIVITY. DTSTOP03 +00856 MOVE SPACES TO APAY-RESPONSIBLE-OP-ID. DTSTOP03 +00857 MOVE SPACE TO APAY-DISREGARD-EDITS-IND. DTSTOP03 +00858 MOVE +0 TO APAY-PROCESSED-DATE. DTSTOP03 +00859 MOVE +0 TO APAY-NSF-MNTE-ABSTIME. DTSTOP03 +00860 MOVE +0 TO APAY-TRACE-NO. DTSTOP03 +00861 SET APAY-ANNUAL-RPT-NULL-88 TO TRUE. DTSTOP03 +00862 ** DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO DTSTOP03 +00863 ** DISPLAY 'MPAY-ITEM-NO ' MPAY-ITEM-NO DTSTOP03 +00864 MOVE APAY-REC TO ASKL-REC. DTSTOP03 +00865 DTSTOP03 +00866 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP03 +00867 DTSTOP03 +00868 DISPLAY 'MPAY REVERSED ' MPAY-BATCH-NO ' ' MPAY-ITEM-NO DTSTOP03 +00869 ' ' MPAY-EMP-NO. DTSTOP03 +00870 P5133-EXIT. DTSTOP03 +00871 EXIT. DTSTOP03 +00872 DTSTOP03 +00873 P5134-ENTER-ARPT. DTSTOP03 +00874 DTSTOP03 +00875 ** DISPLAY 'P5134 ENTER APRT ' DTSTOP03 +00876 DTSTOP03 +00877 IF WRK-MRPT-FOUND-NO DTSTOP03 +00878 GO TO P5134-EXIT. DTSTOP03 +00879 DTSTOP03 +00880 MOVE LOW-VALUES TO ARPT-REC. DTSTOP03 +00881 DTSTOP03 +00882 IF AHDR-ATC-FILE-TRAN-CNT < +999 DTSTOP03 +00883 NEXT SENTENCE DTSTOP03 +00884 ELSE DTSTOP03 +00885 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSTOP03 +00886 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. DTSTOP03 +00887 DTSTOP03 +00888 MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO. DTSTOP03 +00889 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT. DTSTOP03 +00890 MOVE AHDR-ATC-FILE-TRAN-CNT TO ARPT-ITEM-NO. DTSTOP03 +00891 SET ARPT-RPT-88 TO TRUE. DTSTOP03 +00892 DTSTOP03 +00893 MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK. DTSTOP03 +00894 MOVE MPRF-EMP-NO TO ARPT-EMP-NO. DTSTOP03 +00895 SET ARPT-ORIG-88 TO TRUE. DTSTOP03 +00896 MOVE MQTR-YRQ TO ARPT-YRQ. DTSTOP03 +00897 DTSTOP03 +00898 COMPUTE ARPT-TOT-WAGE = DTSTOP03 +00899 MRPT-TOT-WAGE. DTSTOP03 +00900 COMPUTE ARPT-TAX-WAGE = DTSTOP03 +00901 MRPT-TAX-WAGE. DTSTOP03 +00902 COMPUTE ARPT-EXCESS-WAGE = DTSTOP03 +00903 MRPT-EXCESS-WAGE. DTSTOP03 +00904 DTSTOP03 +00905 MOVE WRK-REMIT-AMT TO ARPT-REMIT-AMT. DTSTOP03 +00906 ADD ARPT-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT. DTSTOP03 +00907 SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE. DTSTOP03 +00908 SET ARPT-WAIVE-BOTH-NO-88 DTSTOP03 +00909 ARPT-WAIVE-INT-NO-88 DTSTOP03 +00910 ARPT-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSTOP03 +00911 DTSTOP03 +00912 MOVE MRPT-TOTAL-EMPL-CNT TO ARPT-TOTAL-EMPL-CNT. DTSTOP03 +00913 MOVE MRPT-1ST-MTH-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSTOP03 +00914 MOVE MRPT-2ND-MTH-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSTOP03 +00915 MOVE MRPT-3RD-MTH-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSTOP03 +00916 DTSTOP03 +00917 SET ARPT-VERIFIED-NO-88 TO TRUE. DTSTOP03 +00918 ****FIX RECEIVED DATE HERE DTSTOP03 +00919 EVALUATE MPRF-EMP-NO DTSTOP03 +00920 WHEN 179242 DTSTOP03 +00921 MOVE 20131127 TO ARPT-RECEIVED-DATE DTSTOP03 +00922 ARPT-DEPOSIT-DATE DTSTOP03 +00923 WHEN 173938 DTSTOP03 +00924 MOVE 20131120 TO ARPT-RECEIVED-DATE DTSTOP03 +00925 ARPT-DEPOSIT-DATE DTSTOP03 +00926 WHEN 178627 DTSTOP03 +00927 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP03 +00928 ARPT-DEPOSIT-DATE DTSTOP03 +00929 WHEN 178646 DTSTOP03 +00930 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP03 +00931 ARPT-DEPOSIT-DATE DTSTOP03 +00932 WHEN 178842 DTSTOP03 +00933 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP03 +00934 ARPT-DEPOSIT-DATE DTSTOP03 +00935 WHEN 179229 DTSTOP03 +00936 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP03 +00937 ARPT-DEPOSIT-DATE DTSTOP03 +00938 WHEN 179678 DTSTOP03 +00939 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP03 +00940 ARPT-DEPOSIT-DATE DTSTOP03 +00941 WHEN 179748 DTSTOP03 +00942 MOVE 20131125 TO ARPT-RECEIVED-DATE DTSTOP03 +00943 ARPT-DEPOSIT-DATE DTSTOP03 +00944 WHEN OTHER DTSTOP03 +00945 DISPLAY 'ERROR IN FIXING RECEIVED DATE' DTSTOP03 +00946 END-EVALUATE. DTSTOP03 +00947 DTSTOP03 +00948 MOVE MRPT-RESPONSIBLE-ACTIVITY DTSTOP03 +00949 TO ARPT-RESPONSIBLE-ACTIVITY DTSTOP03 +00950 MOVE 'SYS' TO ARPT-RESPONSIBLE-ACTIVITY. DTSTOP03 +00951 MOVE MRPT-RESPONSIBLE-OP-ID DTSTOP03 +00952 TO ARPT-RESPONSIBLE-OP-ID. DTSTOP03 +00953 MOVE SPACE TO ARPT-DISREGARD-EDITS-IND. DTSTOP03 +00954 SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE. DTSTOP03 +00955 MOVE +0 TO ARPT-PROCESSED-DATE. DTSTOP03 +00956 MOVE +0 TO ARPT-PSEUDO-BATCH-NO DTSTOP03 +00957 ARPT-PSEUDO-ITEM-NO DTSTOP03 +00958 ARPT-TRACE-NO. DTSTOP03 +00959 SET ARPT-STATUS-CHNG-NO-88 TO TRUE. DTSTOP03 +00960 DTSTOP03 +00961 MOVE ARPT-REC TO ASKL-REC. DTSTOP03 +00962 ** DISPLAY 'ARPT-BATCH-NO ' ARPT-BATCH-NO DTSTOP03 +00963 ** DISPLAY 'ARPT-EMP-NO ' ARPT-EMP-NO DTSTOP03 +00964 ** DISPLAY 'ARPT-YRQ ' ARPT-YRQ DTSTOP03 +00965 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP03 +00966 DTSTOP03 +00967 DTSTOP03 +00968 P5134-EXIT. DTSTOP03 +00969 EXIT. DTSTOP03 +00970 DTSTOP03 +00971 P5140-ACCT-TRANS. DTSTOP03 +00972 MOVE ZERO TO WRK-REMIT-AMT. DTSTOP03 +00973 ADD +1 TO SEQ. DTSTOP03 +00974 ** MOVE MPRF-EMP-NO TO EMP-ACCT-DISP DTSTOP03 +00975 * DISPLAY SEQ ' SELF INS ' EMP-ACCT-DISP DTSTOP03 +00976 * ' RPT DOC # ' WRK-RPT-BATCH-NO DTSTOP03 +00977 ** ' ' WRK-RPT-ITEM-NO. DTSTOP03 +00978 MOVE MPRF-EMP-NO TO OUT-EMP. DTSTOP03 +00979 MOVE MRPT-YRQ TO L004-QTR-5-9. DTSTOP03 +00980 SET L004-FROM-5 TO TRUE. DTSTOP03 +00981 PERFORM S004-EDIT-QTR THRU S004-EXIT. DTSTOP03 +00982 MOVE L004-SLASH-5-QTR TO OUT-QTR. DTSTOP03 +00983 MOVE WRK-RPT-BATCH-NO TO OUT-BATCH. DTSTOP03 +00984 MOVE WRK-RPT-ITEM-NO TO OUT-ITEM. DTSTOP03 +00985 WRITE OUT-REC FROM WRK-OUT-REC. DTSTOP03 +00986 IF NOT Z058-FILE-OK-88 DTSTOP03 +00987 DISPLAY 'CANNOT WRITE OUTPUT FILE ' Z058-STATUS DTSTOP03 +00988 SET WRK-ERROR-YES-88 TO TRUE DTSTOP03 +00989 GO TO P5140-EXIT DTSTOP03 +00990 END-IF. DTSTOP03 +00991 PERFORM P5141-READ-MRPT THRU P5141-EXIT. DTSTOP03 +00992 PERFORM P5132-WITHDRAW-MRPT THRU P5132-EXIT. DTSTOP03 +00993 * PERFORM P5134-ENTER-ARPT THRU P5134-EXIT. DTSTOP03 +00994 DTSTOP03 +00995 P5140-EXIT. DTSTOP03 +00996 EXIT. DTSTOP03 +00997 DTSTOP03 +00998 P5141-READ-MRPT. DTSTOP03 +00999 SET WRK-MRPT-FOUND-YES TO TRUE. DTSTOP03 +01000 DTSTOP03 +01001 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSTOP03 +01002 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSTOP03 +01003 MOVE MQTR-YRQ TO MRPT-YRQ. DTSTOP03 +01004 MOVE WRK-RPT-BATCH-NO TO MRPT-BATCH-NO DTSTOP03 +01005 MOVE WRK-RPT-ITEM-NO TO MRPT-ITEM-NO. DTSTOP03 +01006 SET MRPT-RPT-88 TO TRUE. DTSTOP03 +01007 MOVE MRPT-REC TO MSKL-REC. DTSTOP03 +01008 DTSTOP03 +01009 PERFORM S910-READ THRU S910-EXIT. DTSTOP03 +01010 IF L910-OK-88 DTSTOP03 +01011 MOVE MSKL-REC TO MRPT-REC DTSTOP03 +01012 ELSE DTSTOP03 +01013 ** DISPLAY 'CANNOT FIND MRPT ' MPRF-EMP-NO DTSTOP03 +01014 SET WRK-MRPT-FOUND-NO TO TRUE DTSTOP03 +01015 GO TO P5141-EXIT. DTSTOP03 +01016 DTSTOP03 +01017 P5141-EXIT. DTSTOP03 +01018 EXIT. DTSTOP03 +01019 DTSTOP03 +01020 P5200-ADD-MNTE. DTSTOP03 +01021 MOVE LENGTH OF T003-REC TO T003-LENGTH. DTSTOP03 +01022 MOVE '003' TO T003-REC-TYPE. DTSTOP03 +01023 MOVE 'SYSTEM ' TO T003-ORIGIN. DTSTOP03 +01024 MOVE L005-DATE TO T003-SYS-DATE. DTSTOP03 +01025 MOVE L005-TIME TO T003-SYS-TIME. DTSTOP03 +01026 SET T003-ADD-MNTE-88 TO TRUE. DTSTOP03 +01027 DTSTOP03 +01028 MOVE LOW-VALUES TO DTSTOP03 +01029 MNTE-KEY-AREA. DTSTOP03 +01030 MOVE MPRF-EMP-NO TO MNTE-EMP-NO. DTSTOP03 +01031 SET MNTE-NTE-88 TO TRUE. DTSTOP03 +01032 MOVE +0 TO MNTE-PURGE-DATE. DTSTOP03 +01033 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSTOP03 +01034 DTSTOP03 +01035 MOVE L005-DATE TO MNTE-ESTB-DATE DTSTOP03 +01036 MNTE-CHNG-DATE. DTSTOP03 +01037 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSTOP03 +01038 MNTE-DATA-ESTB-ABSTIME DTSTOP03 +01039 MNTE-CHNG-ABSTIME. DTSTOP03 +01040 MOVE 'SYSTEM ' TO MNTE-ESTB-OP-ID DTSTOP03 +01041 MNTE-CHNG-OP-ID. DTSTOP03 +01042 DTSTOP03 +01043 MOVE '4TH QTR ANNUAL REPORT CORRECTION ' DTSTOP03 +01044 TO MNTE-SUBJECT. DTSTOP03 +01045 DTSTOP03 +01046 MOVE +2 TO MNTE-TEXT-CNT. DTSTOP03 +01047 DTSTOP03 +01048 MOVE 2014 TO WRK-MNTE-MSG-YR DTSTOP03 +01049 MOVE 4 TO WRK-MNTE-MSG-QTR DTSTOP03 +01050 MOVE WRK-MNTE-MSG-LINE1 TO MNTE-TEXT (1). DTSTOP03 +01051 MOVE WRK-MNTE-MSG-LINE2 TO MNTE-TEXT (2). DTSTOP03 +01052 ** MOVE WRK-MNTE-MSG-LINE3 TO MNTE-TEXT (3). DTSTOP03 +01053 DTSTOP03 +01054 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSTOP03 +01055 MOVE MNTE-REC TO T003-MNTE-REC. DTSTOP03 +01056 DTSTOP03 +01057 MOVE T003-REC TO TSKL-REC. DTSTOP03 +01058 PERFORM S927-WRITE THRU S927-EXIT. DTSTOP03 +01059 ADD +1 TO WRK-T003-CNT. DTSTOP03 +01060 DTSTOP03 +01061 P5200-EXIT. DTSTOP03 +01062 EXIT. DTSTOP03 +01063 DTSTOP03 +01064 SKIP3 DTSTOP03 +01065 T0000-TERMINATE. DTSTOP03 +01066 DTSTOP03 +01067 * PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT. DTSTOP03 +01068 DTSTOP03 +01069 PERFORM S923-CLOSE THRU S923-EXIT. DTSTOP03 +01070 PERFORM S927-CLOSE THRU S927-EXIT. DTSTOP03 +01071 DTSTOP03 +01072 * MOVE MHDR-LAST-USED-BATCH-NO TO HOLD-LAST-USED-BATCH-NO. DTSTOP03 +01073 DTSTOP03 +01074 * MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSTOP03 +01075 DTSTOP03 +01076 * PERFORM S910-READ THRU S910-EXIT. DTSTOP03 +01077 * IF L910-NO-REC-88 DTSTOP03 +01078 * MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSTOP03 +01079 * TO ABEND-MSG DTSTOP03 +01080 * PERFORM S999-ABEND THRU S999-EXIT. DTSTOP03 +01081 DTSTOP03 +01082 * MOVE MSKL-REC TO MHDR-REC. DTSTOP03 +01083 * MOVE HOLD-LAST-USED-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSTOP03 +01084 * MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSTOP03 +01085 * MOVE MHDR-REC TO MSKL-REC. DTSTOP03 +01086 DTSTOP03 +01087 * PERFORM S910-REWRITE THRU S910-EXIT. DTSTOP03 +01088 * DISPLAY 'LAST BATCH: ' AHDR-BATCH-NO. DTSTOP03 +01089 DTSTOP03 +01090 DISPLAY ' '. DTSTOP03 +01091 DTSTOP03 +01092 DISPLAY '*** DTSBZ058 TERMINATION STATISTICS ***'. DTSTOP03 +01093 DTSTOP03 +01094 DISPLAY ' '. DTSTOP03 +01095 DTSTOP03 +01096 DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DTSTOP03 +01097 WRK-MPRF-CNT. DTSTOP03 +01098 DTSTOP03 +01099 DISPLAY 'NUMBER OF ACCOUNTS UPDATED : 'DTSTOP03 +01100 WRK-UPDATE-CNT. DTSTOP03 +01101 DTSTOP03 +01102 DISPLAY 'NUMBER OF EMPLOYERS EXCLUDED : 'DTSTOP03 +01103 WRK-EXCLUDE-CNT. DTSTOP03 +01104 DTSTOP03 +01105 DISPLAY 'NOTEPAD RECORDS CREATED : 'DTSTOP03 +01106 WRK-T003-CNT. DTSTOP03 +01107 DTSTOP03 +01108 DISPLAY 'AMOUNT OF INTEREST REVERSED : 'DTSTOP03 +01109 WRK-INTEREST-AMT. DTSTOP03 +01110 DTSTOP03 +01111 PERFORM S910-CLOSE THRU S910-EXIT. DTSTOP03 +01112 CLOSE OUT-FILE IN-FILE. DTSTOP03 +01113 DTSTOP03 +01114 T0000-EXIT. DTSTOP03 +01115 EXIT. DTSTOP03 +01116 EJECT DTSTOP03 +01117 DTSTOP03 +01118 S1000-INITIATE-AHDR. DTSTOP03 +01119 MOVE LOW-VALUES TO AHDR-REC. DTSTOP03 +01120 DTSTOP03 +01121 IF MHDR-LAST-USED-BATCH-NO < +99999 DTSTOP03 +01122 COMPUTE AHDR-BATCH-NO = MHDR-LAST-USED-BATCH-NO + 1 DTSTOP03 +01123 ELSE DTSTOP03 +01124 MOVE +1 TO AHDR-BATCH-NO. DTSTOP03 +01125 DTSTOP03 +01126 MOVE +0 TO AHDR-ITEM-NO. DTSTOP03 +01127 SET AHDR-HDR-88 TO TRUE. DTSTOP03 +01128 SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSTOP03 +01129 SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSTOP03 +01130 SET AHDR-ESTB-SYSTEM-88 TO TRUE. DTSTOP03 +01131 MOVE SPACES TO AHDR-CHNG-OP-ID. DTSTOP03 +01132 MOVE +0 TO AHDR-CHNG-DATE. DTSTOP03 +01133 MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE DTSTOP03 +01134 AHDR-RECEIVED-DATE DTSTOP03 +01135 AHDR-DEPOSIT-DATE. DTSTOP03 +01136 MOVE +0 TO AHDR-LAST-USED-ITEM-NO DTSTOP03 +01137 AHDR-CONTROL-TRAN-CNT DTSTOP03 +01138 AHDR-ATC-FILE-TRAN-CNT DTSTOP03 +01139 AHDR-PROC-TRAN-CNT DTSTOP03 +01140 AHDR-CONTROL-REMIT-AMT DTSTOP03 +01141 AHDR-ATC-FILE-REMIT-AMT DTSTOP03 +01142 AHDR-PROC-REMIT-AMT DTSTOP03 +01143 AHDR-BANK-BATCH-NO. DTSTOP03 +01144 DTSTOP03 +01145 S1000-EXIT. DTSTOP03 +01146 EXIT. DTSTOP03 +01147 DTSTOP03 +01148 S2000-TERMINATE-AHDR. DTSTOP03 +01149 IF AHDR-ATC-FILE-TRAN-CNT = +0 DTSTOP03 +01150 GO TO S2000-EXIT. DTSTOP03 +01151 DTSTOP03 +01152 MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSTOP03 +01153 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-LAST-USED-ITEM-NO. DTSTOP03 +01154 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT. DTSTOP03 +01155 MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT. DTSTOP03 +01156 MOVE AHDR-REC TO ASKL-REC. DTSTOP03 +01157 DTSTOP03 +01158 PERFORM S923-WRITE THRU S923-EXIT. DTSTOP03 +01159 DTSTOP03 +01160 S2000-EXIT. DTSTOP03 +01161 EXIT. DTSTOP03 +01162 DTSTOP03 +01163 S004-EDIT-QTR. DTSTOP03 +01164 CALL 'DTSBU004' USING L004-COMM-AREA. DTSTOP03 +01165 DTSTOP03 +01166 S004-EXIT. DTSTOP03 +01167 EXIT. DTSTOP03 +01168 SKIP3 DTSTOP03 +01169 S005-FROM-SYS. DTSTOP03 +01170 SET L005-FROM-SYS TO TRUE. DTSTOP03 +01171 CALL 'DTSBU005' USING L005-LINK-AREA. DTSTOP03 +01172 DTSTOP03 +01173 S005-EXIT. DTSTOP03 +01174 EXIT. DTSTOP03 +01175 DTSTOP03 +01176 S101-PER-MONTH-NO. DTSTOP03 +01177 SET L101-PER-MONTH-NO-88 TO TRUE. DTSTOP03 +01178 GO TO S101-INT-PEN-COMP. DTSTOP03 +01179 DTSTOP03 +01180 S101-PER-MONTH-YES. DTSTOP03 +01181 SET L101-PER-MONTH-YES-88 TO TRUE. DTSTOP03 +01182 GO TO S101-INT-PEN-COMP. DTSTOP03 +01183 DTSTOP03 +01184 S101-INT-PEN-COMP. DTSTOP03 +01185 CALL 'DTSBU101' USING L101-LINK-AREA. DTSTOP03 +01186 S101-EXIT. DTSTOP03 +01187 EXIT. DTSTOP03 +01188 S910-OPEN-READ. DTSTOP03 +01189 SET L910-OPEN-READ-88 TO TRUE. DTSTOP03 +01190 GO TO S910-MSTR-IO. DTSTOP03 +01191 DTSTOP03 +01192 S910-OPEN-UPDATE-NO-AIX. DTSTOP03 +01193 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSTOP03 +01194 GO TO S910-MSTR-IO. DTSTOP03 +01195 DTSTOP03 +01196 S910-OPEN-UPDATE-HDR. DTSTOP03 +01197 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DTSTOP03 +01198 GO TO S910-MSTR-IO. DTSTOP03 +01199 DTSTOP03 +01200 S910-READ. DTSTOP03 +01201 SET L910-READ-88 TO TRUE. DTSTOP03 +01202 GO TO S910-MSTR-IO. DTSTOP03 +01203 DTSTOP03 +01204 S910-START-BROWSE. DTSTOP03 +01205 SET L910-START-BROWSE-88 TO TRUE. DTSTOP03 +01206 GO TO S910-MSTR-IO. DTSTOP03 +01207 DTSTOP03 +01208 S910-READ-NEXT. DTSTOP03 +01209 SET L910-READ-NEXT-88 TO TRUE. DTSTOP03 +01210 GO TO S910-MSTR-IO. DTSTOP03 +01211 DTSTOP03 +01212 S910-COUNT. DTSTOP03 +01213 SET L910-COUNT-88 TO TRUE. DTSTOP03 +01214 GO TO S910-MSTR-IO. DTSTOP03 +01215 DTSTOP03 +01216 S910-REWRITE. DTSTOP03 +01217 SET L910-REWRITE-88 TO TRUE. DTSTOP03 +01218 GO TO S910-MSTR-IO. DTSTOP03 +01219 DTSTOP03 +01220 S910-DELETE. DTSTOP03 +01221 SET L910-DELETE-88 TO TRUE. DTSTOP03 +01222 GO TO S910-MSTR-IO. DTSTOP03 +01223 DTSTOP03 +01224 S910-CLOSE. DTSTOP03 +01225 SET L910-CLOSE-88 TO TRUE. DTSTOP03 +01226 GO TO S910-MSTR-IO. DTSTOP03 +01227 DTSTOP03 +01228 S910-MSTR-IO. DTSTOP03 +01229 CALL 'DTSBU910' USING L910-LINK-AREA DTSTOP03 +01230 MSKL-REC. DTSTOP03 +01231 S910-EXIT. DTSTOP03 +01232 EXIT. DTSTOP03 +01233 SKIP3 DTSTOP03 +01234 S923-OPEN-UPDATE. DTSTOP03 +01235 SET L923-OPEN-UPDATE-88 TO TRUE. DTSTOP03 +01236 GO TO S923-ATC-IO. DTSTOP03 +01237 DTSTOP03 +01238 S923-OPEN-READ. DTSTOP03 +01239 SET L923-OPEN-READ-88 TO TRUE. DTSTOP03 +01240 GO TO S923-ATC-IO. DTSTOP03 +01241 DTSTOP03 +01242 S923-READ. DTSTOP03 +01243 SET L923-READ-88 TO TRUE. DTSTOP03 +01244 GO TO S923-ATC-IO. DTSTOP03 +01245 DTSTOP03 +01246 S923-START-BROWSE. DTSTOP03 +01247 SET L923-START-BROWSE-88 TO TRUE. DTSTOP03 +01248 GO TO S923-ATC-IO. DTSTOP03 +01249 DTSTOP03 +01250 S923-READ-NEXT. DTSTOP03 +01251 SET L923-READ-NEXT-88 TO TRUE. DTSTOP03 +01252 GO TO S923-ATC-IO. DTSTOP03 +01253 DTSTOP03 +01254 S923-WRITE. DTSTOP03 +01255 ** DISPLAY 'S923 WRITE ' DTSTOP03 +01256 SET L923-WRITE-88 TO TRUE. DTSTOP03 +01257 GO TO S923-ATC-IO. DTSTOP03 +01258 DTSTOP03 +01259 S923-REWRITE. DTSTOP03 +01260 SET L923-REWRITE-88 TO TRUE. DTSTOP03 +01261 GO TO S923-ATC-IO. DTSTOP03 +01262 DTSTOP03 +01263 S923-DELETE. DTSTOP03 +01264 SET L923-DELETE-88 TO TRUE. DTSTOP03 +01265 GO TO S923-ATC-IO. DTSTOP03 +01266 DTSTOP03 +01267 S923-CLOSE. DTSTOP03 +01268 SET L923-CLOSE-88 TO TRUE. DTSTOP03 +01269 GO TO S923-ATC-IO. DTSTOP03 +01270 DTSTOP03 +01271 S923-ATC-IO. DTSTOP03 +01272 ** DISPLAY 'DTSBU923 ' DTSTOP03 +01273 ** DISPLAY 'L923 LINK AREA ' L923-LINK-AREA DTSTOP03 +01274 CALL 'DTSBU923' USING L923-LINK-AREA DTSTOP03 +01275 ASKL-REC. DTSTOP03 +01276 S923-EXIT. DTSTOP03 +01277 EXIT. DTSTOP03 +01278 SKIP3 DTSTOP03 +01279 S927-OPEN-UPDATE. DTSTOP03 +01280 SET L927-OPEN-UPDATE-88 TO TRUE. DTSTOP03 +01281 GO TO S927-BTC-O. DTSTOP03 +01282 DTSTOP03 +01283 S927-WRITE. DTSTOP03 +01284 SET L927-WRITE-88 TO TRUE. DTSTOP03 +01285 GO TO S927-BTC-O. DTSTOP03 +01286 DTSTOP03 +01287 S927-CLOSE. DTSTOP03 +01288 SET L927-CLOSE-88 TO TRUE. DTSTOP03 +01289 GO TO S927-BTC-O. DTSTOP03 +01290 DTSTOP03 +01291 S927-BTC-O. DTSTOP03 +01292 CALL 'DTSBU927' USING L927-LINK-AREA DTSTOP03 +01293 TSKL-REC. DTSTOP03 +01294 S927-EXIT. DTSTOP03 +01295 EXIT. DTSTOP03 +01296 DTSTOP03 +01297 SKIP3 DTSTOP03 +01298 S999-ABEND. DTSTOP03 +01299 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSTOP03 +01300 S999-EXIT. DTSTOP03 +01301 EXIT. DTSTOP03 diff --git a/Batch/DTSVAL04.cob b/Batch/DTSVAL04.cob new file mode 100644 index 0000000..274e00a --- /dev/null +++ b/Batch/DTSVAL04.cob @@ -0,0 +1,792 @@ +00001 IDENTIFICATION DIVISION. 08/23/25 +00002 PROGRAM-ID. DTSVAL04. DTSVAL04 +00003 LV027 +00004 ******************************************************************DTSVAL04 +00005 * *DTSVAL04 +00006 * * CL**7 +00007 * FUNCTION: *DTSVAL04 +00008 * THIS PROGRAM IS WRITTEN TO PRODUCE W4 WAGE TRANSACTIONS, *DTSVAL04 +00009 * USING THE ICESA WAGE FORMAT. (FOR dcgov) * CL**7 +00010 * 08/11/11 zl1 * CL*12 +00011 ******************************************************************DTSVAL04 +00012 * FOR INPUT FILES THAT ARE 275 BYTES, USE THIS PROGRAM. * CL*12 +00013 ******************************************************************DTSVAL04 +00014 ******************************************************************DTSVAL04 +00015 * MODIFICATION HISTORY: *DTSVAL04 +00016 * *DTSVAL04 +00017 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSVAL04 +00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSVAL04 +00019 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *DTSVAL04 +00020 ******************************************************************DTSVAL04 +00021 DTSVAL04 +00022 ENVIRONMENT DIVISION. DTSVAL04 +00023 DTSVAL04 +00024 CONFIGURATION SECTION. DTSVAL04 +00025 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSVAL04 +00026 INPUT-OUTPUT SECTION. DTSVAL04 +00027 DTSVAL04 +00028 FILE-CONTROL. DTSVAL04 +00029 DTSVAL04 +00030 SELECT ICESA-FILE ASSIGN TO ICESA. DTSVAL04 +00031 SELECT ICERR-FILE ASSIGN TO ICERR. CL*14 +00032 DTSVAL04 +00033 SELECT W4-FILE ASSIGN TO W4FILE. DTSVAL04 +00034 DTSVAL04 +00035 SELECT PRINT-FILE ASSIGN TO PRINT. DTSVAL04 +00036 DTSVAL04 +00037 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. DTSVAL04 +00038 DTSVAL04 +00039 DATA DIVISION. DTSVAL04 +00040 FILE SECTION. DTSVAL04 +00041 DTSVAL04 +00042 FD ICESA-FILE DTSVAL04 +00043 RECORDING MODE F DTSVAL04 +00044 BLOCK CONTAINS 0 RECORDS DTSVAL04 +00045 LABEL RECORDS ARE STANDARD DTSVAL04 +00046 DATA RECORD IS ICESA-REC. DTSVAL04 +00047 DTSVAL04 +00048 01 ICESA-REC. DTSVAL04 +00049 05 ICESA-REC-TYPE PIC X(01). DTSVAL04 +00050 05 FILLER PIC X(274). DTSVAL04 +00051 DTSVAL04 +00052 FD ICERR-FILE CL*14 +00053 RECORDING MODE F CL*13 +00054 BLOCK CONTAINS 0 RECORDS CL*13 +00055 LABEL RECORDS ARE STANDARD CL*13 +00056 DATA RECORD IS ICERR-REC. CL*13 +00057 CL*13 +00058 01 ICERR-REC. CL*13 +00059 05 ICERR-REC-TYPE PIC X(01). CL*13 +00060 05 FILLER PIC X(274). CL*13 +00061 CL*13 +00062 FD W4-FILE DTSVAL04 +00063 RECORDING MODE F DTSVAL04 +00064 BLOCK CONTAINS 0 CHARACTERS DTSVAL04 +00065 LABEL RECORDS ARE STANDARD DTSVAL04 +00066 DATA RECORD IS W4-OUT-RECORD. DTSVAL04 +00067 DTSVAL04 +00068 01 W4-OUT-RECORD PIC X(80). CL**7 +00069 DTSVAL04 +00070 FD PRINT-FILE DTSVAL04 +00071 RECORDING MODE F DTSVAL04 +00072 LABEL RECORDS ARE OMITTED DTSVAL04 +00073 DATA RECORD IS PRINT-REC. DTSVAL04 +00074 DTSVAL04 +00075 01 PRINT-REC PIC X(133). DTSVAL04 +00076 DTSVAL04 +00077 FD LISTOUT DTSVAL04 +00078 RECORD CONTAINS 133 CHARACTERS DTSVAL04 +00079 LABEL RECORDS ARE OMITTED DTSVAL04 +00080 DATA RECORD IS LIST-REC. DTSVAL04 +00081 01 LIST-REC PIC X(133). DTSVAL04 +00082 DTSVAL04 +00083 ******************************************************************DTSVAL04 +00084 * WORKING STORAGE SECTION *DTSVAL04 +00085 ******************************************************************DTSVAL04 +00086 DTSVAL04 +00087 WORKING-STORAGE SECTION. DTSVAL04 +000875 77 PAN-VALET PICTURE X(24) VALUE '027DTSVAL04 08/23/25'. DTSVAL04 +00088 01 WS-LOWER PIC X(26) VALUE 'abcdefghijklmnopqrstuvwxyz'. CL**3 +00089 01 WS-UPPER PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. CL**3 +00090 DTSVAL04 +00091 01 WRK-AREA. DTSVAL04 +00092 05 ABEND-CD PIC X(05) VALUE 'val04'. CL**7 +00093 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. DTSVAL04 +00094 05 ABEND-MSG PIC X(60). DTSVAL04 +00095 05 WRK-MOD-NAME PIC X(08) VALUE 'dtsval04'. CL**7 +00096 05 ERROR-SW PIC 9. DTSVAL04 +00097 DTSVAL04 +00098 01 COUNTERS. DTSVAL04 +00099 03 FILE-STATUS-FILE PIC 99. DTSVAL04 +00100 03 EMP-QTR-TOT-EARNINGS PIC 9(7). DTSVAL04 +00101 03 RECS-IN PIC 9(5). DTSVAL04 +00102 03 RECS-OUT PIC 9(5). DTSVAL04 +00103 03 QTR-RECS-OUT PIC 9(5). DTSVAL04 +00104 03 PAGE-CTR PIC 9(5). DTSVAL04 +00105 03 ERROR-RECS PIC 9(5). DTSVAL04 +00106 03 ZERO-WAGE-CNT PIC 9(5). DTSVAL04 +00107 03 EXCEPTION-CNT PIC 9(5). DTSVAL04 +00108 03 WS-ZERO-WAGE-NO PIC 9(5). DTSVAL04 +00109 DTSVAL04 +00110 01 LINE-CTR PIC 9(5) VALUE 56. DTSVAL04 +00111 DTSVAL04 +00112 01 WS-QUARTER-YR-QTR PIC 9(05). DTSVAL04 +00113 01 FILLER REDEFINES WS-QUARTER-YR-QTR. DTSVAL04 +00114 05 WS-QUARTER-YEAR PIC 9(4). DTSVAL04 +00115 05 WS-QUARTER-QTR PIC 9(1). DTSVAL04 +00116 DTSVAL04 +00117 01 L004-LINK-AREA. DTSVAL04 +00118 ++INCLUDE DTSIL004 DTSVAL04 +00119 EJECT DTSVAL04 +00120 DTSVAL04 +00121 ++INCLUDE EWGRECS DTSVAL04 +00122 DTSVAL04 +00123 01 REC-END-IND PIC X(01) VALUE 'N'. DTSVAL04 +00124 88 REC-END VALUE 'Y'. DTSVAL04 +00125 01 WS-REPT-YEAR PIC X(04). DTSVAL04 +00126 01 WS-FILL-YR REDEFINES WS-REPT-YEAR. DTSVAL04 +00127 05 WS-REPT-MM PIC X(02). DTSVAL04 +00128 05 WS-REPT-YR PIC X(02). DTSVAL04 +00129 DTSVAL04 +00130 01 WS-TODAY PIC 9(06). DTSVAL04 +00131 01 WS-TODAY-REDEF REDEFINES WS-TODAY. DTSVAL04 +00132 05 WS-TODAY-YY PIC 9(02). DTSVAL04 +00133 05 WS-TODAY-MM PIC 9(02). DTSVAL04 +00134 05 WS-TODAY-DD PIC 9(02). DTSVAL04 +00135 DTSVAL04 +00136 01 WS-AFFI-CODE PIC 9(01) VALUE 2. DTSVAL04 +00137 DTSVAL04 +00138 01 WS-QTR-NEW. DTSVAL04 +00139 05 WS-QTR-QTR PIC 9(01). DTSVAL04 +00140 05 WS-QTR-YY PIC 9(02). DTSVAL04 +00141 DTSVAL04 +00142 01 WS-YQTR. DTSVAL04 +00143 05 WS-YQTR-Y PIC 9(02). DTSVAL04 +00144 05 WS-YQTR-Q PIC 9(01). DTSVAL04 +00145 DTSVAL04 +00146 DTSVAL04 +00147 01 WS-LAST-NAME PIC X(20). DTSVAL04 +00148 01 WS-LAST-NAMES REDEFINES WS-LAST-NAME. DTSVAL04 +00149 05 WS-LAST PIC X(03). DTSVAL04 +00150 05 WS-LAST-FILLER PIC X(17). DTSVAL04 +00151 DTSVAL04 +00152 01 WS-HOLD-SSN. DTSVAL04 +00153 05 WS-HOLD-SSN-1 PIC 9(03). DTSVAL04 +00154 05 WS-HOLD-SSN-2 PIC 9(02). DTSVAL04 +00155 05 WS-HOLD-SSN-3 PIC 9(04). DTSVAL04 +00156 DTSVAL04 +00157 01 TIME-FIXED PIC X(06) VALUE '170000'. DTSVAL04 +00158 01 WRITE-CNT PIC 9(08) VALUE ZEROES. DTSVAL04 +00159 DTSVAL04 +00160 01 WS-ACCOUNT PIC X(15) VALUE SPACES. DTSVAL04 +00161 01 WS-ACCOUNT-NO REDEFINES WS-ACCOUNT. DTSVAL04 +00162 05 WS-WAGE-ACCOUNT PIC 9(06). DTSVAL04 +00163 05 FILLER PIC X(09). DTSVAL04 +00164 DTSVAL04 +00165 01 WS-TRN-OPER-ID. DTSVAL04 +00166 05 WS-TRN-CLM PIC X(06) VALUE '000444'. DTSVAL04 +00167 05 WS-TRN-OPR-ID PIC X(02) VALUE '05'. DTSVAL04 +00168 DTSVAL04 +00169 01 ICESA-CNT PIC 9(08) VALUE ZEROES. DTSVAL04 +00170 01 EMPLOYEE-CNT-TAPE PIC 9(07) VALUE ZEROES. DTSVAL04 +00171 01 GRAND-EMPLOYEE-CNT PIC 9(08) VALUE ZEROES. DTSVAL04 +00172 01 TOTAL-EMPLOYER-CNT PIC 9(06) VALUE ZEROES. DTSVAL04 +00173 DTSVAL04 +00174 01 WS-HOLDING-AREA PIC 9(12) VALUE ZEROES. DTSVAL04 +00175 DTSVAL04 +00176 01 QTR-TOTL-GROS-WAGE PIC 9(12)V99. DTSVAL04 +00177 01 QTR-WGES-REDEF REDEFINES QTR-TOTL-GROS-WAGE. DTSVAL04 +00178 05 WS-FILL-WGE PIC 9(07). DTSVAL04 +00179 05 WS-EMPL-WAGE-CENTS PIC 9(05)V99. DTSVAL04 +00180 DTSVAL04 +00181 01 GRAND-GROS-WAGE PIC 9(13)V99. DTSVAL04 +00182 DTSVAL04 +00183 01 GRAND-S-RECORD-TOTAL PIC 9(12)V99. DTSVAL04 +00184 DTSVAL04 +00185 DTSVAL04 +00186 01 LINE-COUNT-DETAIL PIC 9(02) VALUE 99. DTSVAL04 +00187 01 PAGE-COUNT-1 PIC 9(04) VALUE ZEROES. DTSVAL04 +00188 01 PAGE-COUNT-2 PIC 9(04) VALUE ZEROES. DTSVAL04 +00189 DTSVAL04 +00190 ******************************************************************DTSVAL04 +00191 * TRANSACTION W4 - ADD WAGE INFORMATION *DTSVAL04 +00192 ******************************************************************DTSVAL04 +00193 DTSVAL04 +00194 01 W4-TRAN-AREA. DTSVAL04 +00195 10 W4-KEY-DATA. DTSVAL04 +00196 15 W4-SSN PIC 9(09). DTSVAL04 +00197 15 FILLER DTSVAL04 +00198 REDEFINES DTSVAL04 +00199 W4-SSN. DTSVAL04 +00200 20 W4-SSN1 PIC X(03). DTSVAL04 +00201 20 W4-SSN2 PIC X(02). DTSVAL04 +00202 20 W4-SSN3 PIC X(04). DTSVAL04 +00203 15 FILLER PIC 9(01). DTSVAL04 +00204 15 W4-TRAN-ID PIC X(02). DTSVAL04 +00205 15 W4-TRAN-OPER-ID. DTSVAL04 +00206 20 W4-TRAN-CLM-CNTR PIC 9(06). DTSVAL04 +00207 20 W4-TRAN-OPR-ID PIC 9(02). DTSVAL04 +00208 15 W4-DATE-ENTERED PIC 9(08). DTSVAL04 +00209 15 FILLER REDEFINES W4-DATE-ENTERED. DTSVAL04 +00210 20 W4-CENTURY-ENTERED PIC 9(2). DTSVAL04 +00211 20 W4-DTE-ENTERED PIC 9(6). DTSVAL04 +00212 15 W4-TIME-ENTERED PIC 9(06). DTSVAL04 +00213 15 FILLER PIC X(6). DTSVAL04 +00214 10 W4-TRAN-DATA. DTSVAL04 +00215 15 W4-NAME-CHECK PIC X(03). DTSVAL04 +00216 15 W4-QUARTER PIC 9(5). DTSVAL04 +00217 15 FILLER REDEFINES W4-QUARTER. DTSVAL04 +00218 20 W4-QTR-CENTURY PIC 9(2). DTSVAL04 +00219 20 W4-QTR PIC 9(3). DTSVAL04 +00220 15 W4-AFFI-CODE PIC X(1). DTSVAL04 +00221 15 W4-QUARTER-EARNINGS PIC 9(7). DTSVAL04 +00222 15 W4-ACCOUNT PIC 9(6). DTSVAL04 +00223 15 W4-EMP-NAME PIC X(4). DTSVAL04 +00224 15 W4-ZFILLER pic x(14). CL*24 +00225 ******************************************************************DTSVAL04 +00226 * DETAIL REPORT FOR WAGES *DTSVAL04 +00227 ******************************************************************DTSVAL04 +00228 01 DETAIL-LINE. DTSVAL04 +00229 05 FILLER PIC X(10) VALUE SPACES. DTSVAL04 +00230 05 DETAIL-SSN. DTSVAL04 +00231 10 DETAIL-SSN1 PIC 9(03). DTSVAL04 +00232 10 FILLER PIC X(01) VALUE '-'. DTSVAL04 +00233 10 DETAIL-SSN2 PIC 9(02). DTSVAL04 +00234 10 FILLER PIC X(01) VALUE '-'. DTSVAL04 +00235 10 DETAIL-SSN3 PIC 9(04). DTSVAL04 +00236 05 FILLER PIC X(25) VALUE SPACES. DTSVAL04 +00237 05 DETAIL-NAME PIC X(03). DTSVAL04 +00238 05 FILLER PIC X(33) VALUE SPACES. DTSVAL04 +00239 05 DETAIL-EARNINGS PIC ZZZ,Z(03).99. DTSVAL04 +00240 DTSVAL04 +00241 01 SUMMARY-LINE. DTSVAL04 +00242 05 FILLER PIC X(07) VALUE SPACES. DTSVAL04 +00243 05 SUM-EMPL-COUNT PIC Z,ZZZ,ZZ9. DTSVAL04 +00244 05 FILLER PIC X(11) VALUE SPACES. DTSVAL04 +00245 05 SUM-EMPL-FROM-TAPE PIC Z,ZZZ,ZZ9. DTSVAL04 +00246 05 FILLER PIC X(12) VALUE SPACES. DTSVAL04 +00247 05 SUM-EMPL-MATCH PIC X(03). DTSVAL04 +00248 05 FILLER PIC X(03) VALUE SPACES. DTSVAL04 +00249 05 SUM-EMPL-GROSS-COUNT DTSVAL04 +00250 PIC ZZZ,ZZZ,ZZZ,ZZZ.99. DTSVAL04 +00251 05 FILLER PIC X(06) VALUE SPACES. DTSVAL04 +00252 05 SUM-EMPL-GROSS-FROM-TAPE DTSVAL04 +00253 PIC ZZZ,ZZZ,ZZZ,ZZZ.99. DTSVAL04 +00254 05 FILLER PIC X(11) VALUE SPACES. DTSVAL04 +00255 05 SUM-EMPL-TOTALS-MATCH PIC X(03). DTSVAL04 +00256 DTSVAL04 +00257 01 HEADER1. DTSVAL04 +00258 03 FILLER PIC X(05) VALUE SPACES. DTSVAL04 +00259 03 REPORTING-DATE. DTSVAL04 +00260 05 REPORTING-DATE-MM PIC X(02). DTSVAL04 +00261 05 FILLER PIC X(01) VALUE '/'. DTSVAL04 +00262 05 REPORTING-DATE-DD PIC X(02). DTSVAL04 +00263 05 FILLER PIC X(01) VALUE '/'. DTSVAL04 +00264 05 REPORTING-DATE-YY PIC X(02). DTSVAL04 +00265 03 FILLER PIC X(38) VALUE SPACES. DTSVAL04 +00266 03 FILLER PIC X(31) VALUE DTSVAL04 +00267 'DISTRICT OF COLUMBIA GOVERNMENT'. DTSVAL04 +00268 03 FILLER PIC X(30) VALUE SPACES. DTSVAL04 +00269 03 FILLER PIC X(16) VALUE DTSVAL04 +00270 'REPORT: dtsval04'. CL**9 +00271 03 FILLER PIC X(05) VALUE SPACES. DTSVAL04 +00272 DTSVAL04 +00273 01 HEADER2. DTSVAL04 +00274 03 FILLER PIC X(50) VALUE SPACES. DTSVAL04 +00275 03 FILLER PIC X(33) VALUE DTSVAL04 +00276 'DEPARTMENT OF EMPLOYMENT SERVICES'. DTSVAL04 +00277 03 FILLER PIC X(30) VALUE SPACES. DTSVAL04 +00278 03 FILLER PIC X(10) VALUE DTSVAL04 +00279 'PAGE NO. '. DTSVAL04 +00280 03 HD-PAGE PIC 9(03). DTSVAL04 +00281 03 FILLER PIC X(07) VALUE SPACES. DTSVAL04 +00282 DTSVAL04 +00283 01 HEADER3. DTSVAL04 +00284 03 FILLER PIC X(40) VALUE SPACES. DTSVAL04 +00285 03 FILLER PIC X(47) VALUE DTSVAL04 +00286 'ICESA FORMAT QUARTERLY WAGE REPORT FOR ACCOUNT '. DTSVAL04 +00287 03 HD-ACCOUNT PIC 9(06). DTSVAL04 +00288 03 FILLER PIC X(40) VALUE SPACES. DTSVAL04 +00289 DTSVAL04 +00290 01 HEADER3-A. DTSVAL04 +00291 03 FILLER PIC X(50) VALUE SPACES. DTSVAL04 +00292 03 FILLER PIC X(33) VALUE DTSVAL04 +00293 'ICESA FORMAT QUARTERLY TAX REPORT'. DTSVAL04 +00294 03 FILLER PIC X(50) VALUE SPACES. DTSVAL04 +00295 DTSVAL04 +00296 01 HEADER4. DTSVAL04 +00297 03 FILLER PIC X(57) VALUE SPACES. DTSVAL04 +00298 03 HD-QUARTER PIC X(06). DTSVAL04 +00299 03 FILLER PIC X(12) VALUE DTSVAL04 +00300 ' QUARTER OF '. DTSVAL04 +00301 03 HD-YEAR PIC 9(02). DTSVAL04 +00302 03 FILLER PIC X(56) VALUE SPACES. DTSVAL04 +00303 DTSVAL04 +00304 01 COLUMN-DETAIL-HD1. DTSVAL04 +00305 03 FILLER PIC X(14) VALUE SPACES. DTSVAL04 +00306 03 FILLER PIC X(03) VALUE 'SSN'. DTSVAL04 +00307 03 FILLER PIC X(29) VALUE SPACES. DTSVAL04 +00308 03 FILLER PIC X(04) VALUE 'NAME'. DTSVAL04 +00309 03 FILLER PIC X(32) VALUE SPACES. DTSVAL04 +00310 03 FILLER PIC X(08) VALUE DTSVAL04 +00311 'EARNINGS'. DTSVAL04 +00312 DTSVAL04 +00313 01 COLUMN-SUMMARY-HD1. DTSVAL04 +00314 03 FILLER PIC X(10) VALUE SPACES. DTSVAL04 +00315 03 FILLER PIC X(08) VALUE DTSVAL04 +00316 'EMPLOYEE'. DTSVAL04 +00317 03 FILLER PIC X(08) VALUE SPACES. DTSVAL04 +00318 03 FILLER PIC X(14) VALUE DTSVAL04 +00319 'EMPLOYEE COUNT'. DTSVAL04 +00320 03 FILLER PIC X(07) VALUE SPACES. DTSVAL04 +00321 03 FILLER PIC X(06) VALUE DTSVAL04 +00322 'TOTALS'. DTSVAL04 +00323 03 FILLER PIC X(12) VALUE SPACES. DTSVAL04 +00324 03 FILLER PIC X(05) VALUE DTSVAL04 +00325 'GROSS'. DTSVAL04 +00326 03 FILLER PIC X(17) VALUE SPACES. DTSVAL04 +00327 03 FILLER PIC X(15) VALUE DTSVAL04 +00328 'GROSS AMOUNT'. DTSVAL04 +00329 03 FILLER PIC X(10) VALUE SPACES. DTSVAL04 +00330 03 FILLER PIC X(06) VALUE DTSVAL04 +00331 'TOTALS'. DTSVAL04 +00332 DTSVAL04 +00333 01 COLUMN-SUMMARY-HD2. DTSVAL04 +00334 03 FILLER PIC X(11) VALUE SPACES. DTSVAL04 +00335 03 FILLER PIC X(05) VALUE DTSVAL04 +00336 'COUNT'. DTSVAL04 +00337 03 FILLER PIC X(13) VALUE SPACES. DTSVAL04 +00338 03 FILLER PIC X(09) VALUE DTSVAL04 +00339 'FROM TAPE'. DTSVAL04 +00340 03 FILLER PIC X(09) VALUE SPACES. DTSVAL04 +00341 03 FILLER PIC X(06) VALUE DTSVAL04 +00342 'MATCH?'. DTSVAL04 +00343 03 FILLER PIC X(12) VALUE SPACES. DTSVAL04 +00344 03 FILLER PIC X(06) VALUE DTSVAL04 +00345 'AMOUNT'. DTSVAL04 +00346 03 FILLER PIC X(17) VALUE SPACES. DTSVAL04 +00347 03 FILLER PIC X(09) VALUE DTSVAL04 +00348 'FROM TAPE'. DTSVAL04 +00349 03 FILLER PIC X(15) VALUE SPACES. DTSVAL04 +00350 03 FILLER PIC X(06) VALUE DTSVAL04 +00351 'MATCH?'. DTSVAL04 +00352 DTSVAL04 +00353 01 COLUMN-TAX-HD1. DTSVAL04 +00354 03 FILLER PIC X(01) VALUE SPACES. DTSVAL04 +00355 03 FILLER PIC X(07) VALUE DTSVAL04 +00356 'ACCOUNT'. DTSVAL04 +00357 03 FILLER PIC X(22) VALUE SPACES. DTSVAL04 +00358 03 FILLER PIC X(09) VALUE DTSVAL04 +00359 'NUMBER OF'. DTSVAL04 +00360 03 FILLER PIC X(16) VALUE SPACES. DTSVAL04 +00361 03 FILLER PIC X(03) VALUE DTSVAL04 +00362 'TAX'. DTSVAL04 +00363 03 FILLER PIC X(34) VALUE SPACES. DTSVAL04 +00364 03 FILLER PIC X(05) VALUE DTSVAL04 +00365 'GROSS'. DTSVAL04 +00366 DTSVAL04 +00367 01 COLUMN-TAX-HD2. DTSVAL04 +00368 03 FILLER PIC X(02) VALUE SPACES. DTSVAL04 +00369 03 FILLER PIC X(06) VALUE DTSVAL04 +00370 'NUMBER'. DTSVAL04 +00371 03 FILLER PIC X(22) VALUE SPACES. DTSVAL04 +00372 03 FILLER PIC X(09) VALUE DTSVAL04 +00373 'EMPLOYEES'. DTSVAL04 +00374 03 FILLER PIC X(15) VALUE SPACES. DTSVAL04 +00375 03 FILLER PIC X(04) VALUE DTSVAL04 +00376 'RATE'. DTSVAL04 +00377 03 FILLER PIC X(34) VALUE SPACES. DTSVAL04 +00378 03 FILLER PIC X(05) VALUE DTSVAL04 +00379 'WAGES'. DTSVAL04 +00380 DTSVAL04 +00381 01 COLUMN-TAX-HD3. DTSVAL04 +00382 03 FILLER PIC X(13) VALUE SPACES. DTSVAL04 +00383 03 FILLER PIC X(02) VALUE DTSVAL04 +00384 'UI'. DTSVAL04 +00385 03 FILLER PIC X(27) VALUE SPACES. DTSVAL04 +00386 03 FILLER PIC X(06) VALUE DTSVAL04 +00387 'EXCESS'. DTSVAL04 +00388 03 FILLER PIC X(23) VALUE SPACES. DTSVAL04 +00389 03 FILLER PIC X(07) VALUE DTSVAL04 +00390 'TAXABLE'. DTSVAL04 +00391 03 FILLER PIC X(38) VALUE SPACES. DTSVAL04 +00392 03 FILLER PIC X(06) VALUE DTSVAL04 +00393 'AMOUNT'. DTSVAL04 +00394 DTSVAL04 +00395 01 COLUMN-TAX-HD4. DTSVAL04 +00396 03 FILLER PIC X(12) VALUE SPACES. DTSVAL04 +00397 03 FILLER PIC X(05) VALUE DTSVAL04 +00398 'WAGES'. DTSVAL04 +00399 03 FILLER PIC X(26) VALUE SPACES. DTSVAL04 +00400 03 FILLER PIC X(05) VALUE DTSVAL04 +00401 'WAGES'. DTSVAL04 +00402 03 FILLER PIC X(24) VALUE SPACES. DTSVAL04 +00403 03 FILLER PIC X(05) VALUE DTSVAL04 +00404 'WAGES'. DTSVAL04 +00405 03 FILLER PIC X(41) VALUE SPACES. DTSVAL04 +00406 03 FILLER PIC X(03) VALUE DTSVAL04 +00407 'DUE'. DTSVAL04 +00408 DTSVAL04 +00409 01 EMPLOYER-STATUS-RECORD-DATA. DTSVAL04 +00410 *++INCLUDE ESPTAXAD CL*27 +00411 EJECT DTSVAL04 +00412 DTSVAL04 +00413 01 HD1. DTSVAL04 +00414 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 +00415 03 FIL PIC X(8) VALUE 'dtsval04'. CL**9 +00416 03 FIL PIC X(31) VALUE SPACES. DTSVAL04 +00417 03 FIL PIC X(42) VALUE DTSVAL04 +00418 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. DTSVAL04 +00419 03 FIL PIC X(35) VALUE SPACES. DTSVAL04 +00420 03 FIL PIC X(5) VALUE 'PAGE:'. DTSVAL04 +00421 03 PAGE-CTR-PRT PIC ZZ,ZZ9. DTSVAL04 +00422 DTSVAL04 +00423 01 HD2. DTSVAL04 +00424 03 FIL PIC X(49) VALUE SPACES. DTSVAL04 +00425 03 FIL PIC X(39) VALUE DTSVAL04 +00426 'DOES UI WAGE RECORD EDIT REPORT'. DTSVAL04 +00427 DTSVAL04 +00428 01 HD3. DTSVAL04 +00429 03 FIL PIC X(57) VALUE SPACES. DTSVAL04 +00430 03 FIL PIC X(9) VALUE 'RUN DATE:'. DTSVAL04 +00431 03 REPORT-DATE-MM PIC X(2). DTSVAL04 +00432 03 FILLER PIC X VALUE '/'. DTSVAL04 +00433 03 REPORT-DATE-DD PIC X(2). DTSVAL04 +00434 03 FILLER PIC X VALUE '/'. DTSVAL04 +00435 03 REPORT-DATE-YY PIC X(2). DTSVAL04 +00436 DTSVAL04 +00437 01 HD4 PIC X(133) VALUE SPACES. DTSVAL04 +00438 DTSVAL04 +00439 01 HD5. DTSVAL04 +00440 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 +00441 03 FIL PIC X(3) VALUE 'SSN'. DTSVAL04 +00442 03 FIL PIC X(7) VALUE SPACES. DTSVAL04 +00443 03 FIL PIC X(12) VALUE 'DATE ENTERED'. DTSVAL04 +00444 03 FIL PIC X(02) VALUE SPACES. DTSVAL04 +00445 03 FIL PIC X(13) VALUE 'EMPLOYEE NAME'. DTSVAL04 +00446 03 FIL PIC X(2) VALUE SPACES. DTSVAL04 +00447 03 FIL PIC X(7) VALUE 'QUARTER'. DTSVAL04 +00448 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 +00449 03 FIL PIC X(8) VALUE 'EARNINGS'. DTSVAL04 +00450 03 FIL PIC X(7) VALUE SPACES. DTSVAL04 +00451 03 FIL PIC X(14) VALUE 'ACCOUNT NUMBER'. DTSVAL04 +00452 03 FIL PIC X(2) VALUE SPACES. DTSVAL04 +00453 03 FIL PIC X(13) VALUE 'EMPLOYER NAME'. DTSVAL04 +00454 03 FIL PIC X(04) VALUE SPACES. DTSVAL04 +00455 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'.DTSVAL04 +00456 DTSVAL04 +00457 01 HD6 PIC X(133) VALUE SPACES. DTSVAL04 +00458 DTSVAL04 +00459 01 DTL1. DTSVAL04 +00460 03 FIL PIC X(5) VALUE SPACES. DTSVAL04 +00461 03 SSN-PRT PIC X(9). DTSVAL04 +00462 03 FIL PIC XX VALUE SPACES. DTSVAL04 +00463 03 DATE-ENTERED-PRT PIC X(08). DTSVAL04 +00464 03 FIL PIC X(10) VALUE SPACES. DTSVAL04 +00465 03 EMPEE-NAME PIC X(3). DTSVAL04 +00466 03 FIL PIC X(07) VALUE SPACES. DTSVAL04 +00467 03 QTR-PRT PIC X(6). DTSVAL04 +00468 03 FIL PIC X(06) VALUE SPACES. DTSVAL04 +00469 03 EARNINGS-PRT PIC 9(7)V99. DTSVAL04 +00470 03 EARNINGS-PRT-X REDEFINES EARNINGS-PRT DTSVAL04 +00471 PIC X(9). DTSVAL04 +00472 03 FIL PIC X(10) VALUE SPACES. DTSVAL04 +00473 03 ACCT-NUM-PRT PIC X(6). DTSVAL04 +00474 03 FIL PIC X(9) VALUE SPACES. DTSVAL04 +00475 03 EMPOR-PRT PIC X(6). DTSVAL04 +00476 03 FIL PIC X(08) VALUE SPACES. DTSVAL04 +00477 03 MESSAGE-AREA PIC X(30) VALUE SPACES. DTSVAL04 +00478 DTSVAL04 +00479 01 TOT1. DTSVAL04 +00480 03 FIL PIC X(2) VALUE SPACES. DTSVAL04 +00481 03 FIL PIC X(21) VALUE 'TOTAL WAGE RECS READ:'. DTSVAL04 +00482 03 WAGE-CNT-PRT PIC ZZZ,ZZ9. DTSVAL04 +00483 03 FIL PIC X(6) VALUE SPACES. DTSVAL04 +00484 03 FIL PIC X(24) VALUE 'TOTAL WAGE RECS WRITTEN:'.DTSVAL04 +00485 03 WAGE-OUT-PRT PIC ZZZ,ZZ9. DTSVAL04 +00486 03 FIL PIC X(6) VALUE SPACES. DTSVAL04 +00487 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. DTSVAL04 +00488 03 ERRORS-PRT PIC ZZ,ZZ9. DTSVAL04 +00489 03 FIL PIC X(6) VALUE SPACES. DTSVAL04 +00490 03 FIL PIC X(20) VALUE 'TOTAL ZERO WAGE REC:'. DTSVAL04 +00491 03 ZERO-WAGE-PRT PIC ZZ,ZZ9. DTSVAL04 +00492 DTSVAL04 +00493 03 BLANK-LINE PIC X(133) VALUE SPACES. DTSVAL04 +00494 DTSVAL04 +00495 LINKAGE SECTION. DTSVAL04 +00496 ******************************************************************DTSVAL04 +00497 * *DTSVAL04 +00498 * THIS PROCEDURE WILL WRITE THE SELECTED RECORDS *DTSVAL04 +00499 * *DTSVAL04 +00500 * FOR THE EWGTRNW4 WAGE FORMAT *DTSVAL04 +00501 * *DTSVAL04 +00502 ******************************************************************DTSVAL04 +00503 DTSVAL04 +00504 PROCEDURE DIVISION. CL**7 +00505 DTSVAL04 +00506 MAIN0100-CONTROL. DTSVAL04 +00507 DTSVAL04 +00508 OPEN INPUT ICESA-FILE DTSVAL04 +00509 OUTPUT W4-FILE LISTOUT ICERR-FILE CL*14 +00510 PRINT-FILE. DTSVAL04 +00511 DTSVAL04 +00512 ACCEPT WS-TODAY FROM DATE. DTSVAL04 +00513 MOVE WS-TODAY-YY TO REPORT-DATE-YY REPORTING-DATE-YY. DTSVAL04 +00514 MOVE WS-TODAY-MM TO REPORT-DATE-MM REPORTING-DATE-MM. DTSVAL04 +00515 MOVE WS-TODAY-DD TO REPORT-DATE-DD REPORTING-DATE-DD. DTSVAL04 +00516 DTSVAL04 +00517 MOVE ZEROS TO COUNTERS. DTSVAL04 +00518 DTSVAL04 +00519 MOVE LOW-VALUE TO W4-TRAN-AREA. DTSVAL04 +00520 DTSVAL04 +00521 MOVE ZEROES TO GRAND-GROS-WAGE DTSVAL04 +00522 GRAND-S-RECORD-TOTAL DTSVAL04 +00523 QTR-TOTL-GROS-WAGE. DTSVAL04 +00524 DTSVAL04 +00525 PERFORM PROC1000-WAGE-SEARCH THRU DTSVAL04 +00526 PROC1000-WAGE-EXIT until rec-end. CL**7 +00527 CL**7 +00528 CL**7 +00529 DTSVAL04 +00530 MAIN0100-CONTINUE. DTSVAL04 +00531 DTSVAL04 +00532 IF ERROR-SW = 1 CL*12 +00533 MOVE +3 TO RETURN-CODE CL*12 +00534 ELSE DTSVAL04 +00535 MOVE ZEROES TO RETURN-CODE. DTSVAL04 +00536 DTSVAL04 +00537 PERFORM 999-CLOSE-FILES THRU 999-EXIT. DTSVAL04 +00538 DTSVAL04 +00539 GOBACK. DTSVAL04 +00540 DTSVAL04 +00541 MAIN0100-CONTROL-EXIT. DTSVAL04 +00542 EXIT. DTSVAL04 +00543 DTSVAL04 +00544 PROC1000-WAGE-SEARCH. DTSVAL04 +00545 DTSVAL04 +00546 READ ICESA-FILE DTSVAL04 +00547 AT END DTSVAL04 +00548 MOVE 'Y' TO REC-END-IND CL*19 +00549 go to PROC1000-WAGE-EXIT. CL*19 +00550 DTSVAL04 +00551 MOVE SPACES TO W4-TRAN-AREA. CL*24 +00552 MOVE ICESA-REC TO WAGE-RECORD-S CL*14 +00553 PERFORM PROC2000-S-RECORD THRU CL*14 +00554 PROC2000-S-EXIT. CL*14 +00555 PROC1000-WAGE-EXIT. DTSVAL04 +00556 EXIT. DTSVAL04 +00557 DTSVAL04 +00558 DTSVAL04 +00559 PROC2000-S-RECORD. DTSVAL04 +00560 DTSVAL04 +00561 MOVE LOW-VALUES TO W4-TRAN-AREA. CL*26 +00562 MOVE 998888 TO W4-ACCOUNT CL*13 +00563 HD-ACCOUNT. CL*11 +00564 MOVE 'DIST' TO W4-EMP-NAME. CL*13 +00565 CL*11 +00566 INSPECT S-GROSS-WAGE REPLACING DTSVAL04 +00567 LEADING ' ' BY ZERO. DTSVAL04 +00568 CL**6 +00569 IF S-GROSS-WAGE = ZEROS CL**6 +00570 MOVE S-UNEMP-WAGE TO S-GROSS-WAGE. CL**6 +00571 DTSVAL04 +00572 IF S-GROSS-WAGE NOT NUMERIC DTSVAL04 +00573 MOVE 'GROSS-WAGE NOT NUMERIC' TO MESSAGE-AREA DTSVAL04 +00574 MOVE 1 TO ERROR-SW DTSVAL04 +00575 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*15 +00576 DTSVAL04 +00577 IF S-GROSS-WAGE = ZEROS DTSVAL04 +00578 IF WS-ZERO-WAGE-NO = EXCEPTION-CNT DTSVAL04 +00579 ADD 1 TO ZERO-WAGE-CNT DTSVAL04 +00580 GO TO PROC1000-WAGE-SEARCH DTSVAL04 +00581 ELSE DTSVAL04 +00582 MOVE 'GROSS-WAGE EQUAL ZEROS' TO MESSAGE-AREA DTSVAL04 +00583 MOVE 1 TO ERROR-SW CL*12 +00584 ADD 1 TO ZERO-WAGE-CNT DTSVAL04 +00585 ADD 1 TO EXCEPTION-CNT DTSVAL04 +00586 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT DTSVAL04 +00587 MOVE ZERO TO ERROR-SW DTSVAL04 +00588 GO TO PROC2000-S-EXIT. DTSVAL04 +00589 DTSVAL04 +00590 ADD S-GROSS-WAGE TO grand-gros-wage. CL*21 +00591 CL*20 +00592 MOVE WS-TODAY TO W4-DTE-ENTERED. DTSVAL04 +00593 MOVE 20 TO W4-CENTURY-ENTERED. DTSVAL04 +00594 DTSVAL04 +00595 IF S-SSN NOT NUMERIC DTSVAL04 +00596 OR (S-SSN NOT GREATER THAN ZEROES) DTSVAL04 +00597 MOVE 'SSN NOT NUMERIC' TO MESSAGE-AREA DTSVAL04 +00598 MOVE 1 TO ERROR-SW DTSVAL04 +00599 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT DTSVAL04 +00600 ELSE DTSVAL04 +00601 MOVE S-SSN TO W4-SSN DTSVAL04 +00602 WS-HOLD-SSN DTSVAL04 +00603 MOVE WS-HOLD-SSN-1 TO DETAIL-SSN1 DTSVAL04 +00604 MOVE WS-HOLD-SSN-2 TO DETAIL-SSN2 DTSVAL04 +00605 MOVE WS-HOLD-SSN-3 TO DETAIL-SSN3. DTSVAL04 +00606 DTSVAL04 +00607 MOVE SPACES TO W4-NAME-CHECK. DTSVAL04 +00608 CL**2 +00609 INSPECT S-LAST-NAME CONVERTING WS-LOWER TO WS-UPPER. CL**2 +00610 CL**2 +00611 MOVE S-LAST-NAME TO WS-LAST-NAME. DTSVAL04 +00612 DTSVAL04 +00613 IF WS-LAST EQUAL SPACES DTSVAL04 +00614 MOVE 'EMPLOYEE-NAME EQUAL SPACES' TO MESSAGE-AREA DTSVAL04 +00615 MOVE 1 TO ERROR-SW DTSVAL04 +00616 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT DTSVAL04 +00617 ELSE DTSVAL04 +00618 MOVE WS-LAST TO W4-NAME-CHECK DTSVAL04 +00619 DETAIL-NAME. DTSVAL04 +00620 DTSVAL04 +00621 IF S-REPT-MTH NUMERIC AND S-REPT-YR NUMERIC CL**4 +00622 MOVE S-REPT-MTH TO WS-REPT-MM DTSVAL04 +00623 MOVE S-REPT-YR TO WS-REPT-YR DTSVAL04 +00624 MOVE WS-REPT-YR TO WS-QTR-YY DTSVAL04 +00625 ELSE DTSVAL04 +00626 MOVE 'QTR OR YEAR NOT NUMERIC' TO MESSAGE-AREA DTSVAL04 +00627 MOVE 1 TO ERROR-SW DTSVAL04 +00628 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*15 +00629 DTSVAL04 +00630 IF WS-REPT-MM = '03' DTSVAL04 +00631 MOVE 1 TO WS-QTR-QTR DTSVAL04 +00632 ELSE DTSVAL04 +00633 IF WS-REPT-MM = '06' DTSVAL04 +00634 MOVE 2 TO WS-QTR-QTR DTSVAL04 +00635 ELSE DTSVAL04 +00636 IF WS-REPT-MM = '09' DTSVAL04 +00637 MOVE 3 TO WS-QTR-QTR DTSVAL04 +00638 ELSE DTSVAL04 +00639 IF WS-REPT-MM = '12' DTSVAL04 +00640 MOVE 4 TO WS-QTR-QTR DTSVAL04 +00641 ELSE DTSVAL04 +00642 MOVE 'QUARTER ERROR WITH MONTH' DTSVAL04 +00643 TO MESSAGE-AREA DTSVAL04 +00644 MOVE 1 TO ERROR-SW DTSVAL04 +00645 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*15 +00646 DTSVAL04 +00647 MOVE WS-QTR-QTR TO WS-YQTR-Q. DTSVAL04 +00648 MOVE WS-QTR-YY TO WS-YQTR-Y. DTSVAL04 +00649 MOVE WS-YQTR TO L004-QTR-3-X. DTSVAL04 +00650 PERFORM S004-FROM-3 THRU S004-EXIT. DTSVAL04 +00651 IF L004-VALID-QTR DTSVAL04 +00652 MOVE L004-QTR-5-9 TO WS-QUARTER-YR-QTR DTSVAL04 +00653 W4-QUARTER. DTSVAL04 +00654 DTSVAL04 +00655 MOVE S-GROSS-WAGE TO QTR-TOTL-GROS-WAGE. DTSVAL04 +00656 DTSVAL04 +00657 COMPUTE WS-HOLDING-AREA = (QTR-TOTL-GROS-WAGE / 100) * 100 DTSVAL04 +00658 MOVE WS-HOLDING-AREA TO W4-QUARTER-EARNINGS DTSVAL04 +00659 DETAIL-EARNINGS. DTSVAL04 +00660 DTSVAL04 +00661 MOVE WS-AFFI-CODE TO W4-AFFI-CODE. DTSVAL04 +00662 MOVE 'W4' TO W4-TRAN-ID. DTSVAL04 +00663 DTSVAL04 +00664 MOVE WS-TRN-OPER-ID TO W4-TRAN-OPER-ID. DTSVAL04 +00665 MOVE TIME-FIXED TO W4-TIME-ENTERED. DTSVAL04 +00666 DTSVAL04 +00667 IF ERROR-SW = 1 CL*14 +00668 WRITE ICERR-REC FROM WAGE-RECORD-S CL*14 +00669 MOVE ZERO TO ERROR-SW CL*14 +00670 ELSE CL*14 +00671 * move W4-TRAN-AREA to w4-out-record CL*26 +00672 WRITE W4-OUT-RECORD FROM W4-TRAN-AREA CL*26 +00673 ADD 1 TO WRITE-CNT CL*16 +00674 MOVE ZERO TO ERROR-SW. CL*14 +00675 DTSVAL04 +00676 ADD 1 TO LINE-COUNT-DETAIL CL*16 +00677 EMPLOYEE-CNT-TAPE DTSVAL04 +00678 GRAND-EMPLOYEE-CNT. DTSVAL04 +00679 DTSVAL04 +00680 PROC2000-S-EXIT. DTSVAL04 +00681 EXIT. DTSVAL04 +00682 ******************************************************************DTSVAL04 +00683 * *DTSVAL04 +00684 ******************************************************************DTSVAL04 +00685 DTSVAL04 +00686 PROC4000-F-RECORD. DTSVAL04 +00687 DTSVAL04 +00688 DISPLAY 'ICESA COUNTS '. DTSVAL04 +00689 DTSVAL04 +00690 DISPLAY ' '. DTSVAL04 +00691 DISPLAY 'TOTAL NUMBER OF S-TYPE REC READ = ' ICESA-CNT. DTSVAL04 +00692 DTSVAL04 +00693 DISPLAY ' '. DTSVAL04 +00694 DISPLAY 'TOTAL NUMBER OF S-TYPE REC GOOD = ' WRITE-CNT. DTSVAL04 +00695 DISPLAY ' '. CL*22 +00696 DISPLAY 'TOTAL gross wates for dc gov = ' grand-gros-wage. CL*22 +00697 DTSVAL04 +00698 PROC4000-F-EXIT. DTSVAL04 +00699 EXIT. DTSVAL04 +00700 DTSVAL04 +00701 ******************************************************************DTSVAL04 +00702 * *DTSVAL04 +00703 ******************************************************************DTSVAL04 +00704 DTSVAL04 +00705 PROC5000-HEADER-ROUTINE. DTSVAL04 +00706 DTSVAL04 +00707 MOVE SPACES TO PRINT-REC. DTSVAL04 +00708 DTSVAL04 +00709 ADD 1 TO PAGE-COUNT-1. DTSVAL04 +00710 DTSVAL04 +00711 MOVE WS-REPT-YR TO HD-YEAR. DTSVAL04 +00712 MOVE PAGE-COUNT-1 TO HD-PAGE. DTSVAL04 +00713 DTSVAL04 +00714 WRITE PRINT-REC FROM HEADER1 AFTER ADVANCING TOP-OF-PAGE. DTSVAL04 +00715 WRITE PRINT-REC FROM HEADER2 AFTER ADVANCING 1. DTSVAL04 +00716 WRITE PRINT-REC FROM HEADER3 AFTER ADVANCING 1. DTSVAL04 +00717 WRITE PRINT-REC FROM HEADER4 AFTER ADVANCING 2. DTSVAL04 +00718 WRITE PRINT-REC FROM COLUMN-DETAIL-HD1 AFTER ADVANCING 2. DTSVAL04 +00719 DTSVAL04 +00720 MOVE SPACES TO PRINT-REC. DTSVAL04 +00721 WRITE PRINT-REC AFTER ADVANCING 2. DTSVAL04 +00722 DTSVAL04 +00723 MOVE 9 TO LINE-COUNT-DETAIL. DTSVAL04 +00724 DTSVAL04 +00725 PROC5000-HEADER-EXIT. DTSVAL04 +00726 EXIT. DTSVAL04 +00727 DTSVAL04 +00728 125-WAGE-REPORT. DTSVAL04 +00729 MOVE S-SSN TO SSN-PRT. DTSVAL04 +00730 MOVE W4-DATE-ENTERED TO DATE-ENTERED-PRT. DTSVAL04 +00731 MOVE S-LAST-NAME TO EMPEE-NAME. DTSVAL04 +00732 MOVE S-GROSS-WAGE TO EARNINGS-PRT. DTSVAL04 +00733 MOVE S-REPORTING-QTR-YR TO QTR-PRT. DTSVAL04 +00734 MOVE WS-WAGE-ACCOUNT TO ACCT-NUM-PRT. DTSVAL04 +00735 MOVE 'DC GOV' TO EMPOR-PRT. CL*15 +00736 IF LINE-CTR > 55 DTSVAL04 +00737 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. DTSVAL04 +00738 WRITE LIST-REC FROM DTL1. DTSVAL04 +00739 IF S-GROSS-WAGE NOT = ZEROS DTSVAL04 +00740 ADD 1 TO ERROR-RECS. DTSVAL04 +00741 ADD 1 TO LINE-CTR. DTSVAL04 +00742 125-WR-EXIT. DTSVAL04 +00743 EXIT. DTSVAL04 +00744 DTSVAL04 +00745 130-WAGE-HEADER. DTSVAL04 +00746 ADD 1 TO PAGE-CTR. DTSVAL04 +00747 MOVE PAGE-CTR TO PAGE-CTR-PRT. DTSVAL04 +00748 WRITE LIST-REC FROM HD1 AFTER TOP-OF-PAGE. DTSVAL04 +00749 WRITE LIST-REC FROM HD2. DTSVAL04 +00750 WRITE LIST-REC FROM HD3. DTSVAL04 +00751 WRITE LIST-REC FROM HD4. DTSVAL04 +00752 WRITE LIST-REC FROM HD5. DTSVAL04 +00753 WRITE LIST-REC FROM HD6. DTSVAL04 +00754 MOVE 6 TO LINE-CTR. DTSVAL04 +00755 130-WH-EXIT. DTSVAL04 +00756 EXIT. DTSVAL04 +00757 DTSVAL04 +00758 ******************************************************************DTSVAL04 +00759 * OBTAIN YYYYQ YEAR-QUARTER INFORMATION. *DTSVAL04 +00760 ******************************************************************DTSVAL04 +00761 S004-FROM-3. DTSVAL04 +00762 SET L004-FROM-3 TO TRUE. DTSVAL04 +00763 GO TO S004-YRQ. DTSVAL04 +00764 DTSVAL04 +00765 S004-YRQ. DTSVAL04 +00766 CALL 'DTSBU004' USING L004-LINK-AREA. DTSVAL04 +00767 DTSVAL04 +00768 S004-EXIT. DTSVAL04 +00769 EXIT. DTSVAL04 +00770 EJECT DTSVAL04 +00771 DTSVAL04 +00772 SERV9999-ABEND. DTSVAL04 +00773 DISPLAY '****ICESA *** DTSVAL04 ABENDING ' ABEND-MSG. CL**7 +00774 CALL ABEND-MOD USING ABEND-CD. DTSVAL04 +00775 SERV9999-EXIT. DTSVAL04 +00776 EXIT. DTSVAL04 +00777 DTSVAL04 +00778 999-CLOSE-FILES. DTSVAL04 +00779 MOVE ICESA-CNT TO WAGE-CNT-PRT. DTSVAL04 +00780 MOVE WRITE-CNT TO WAGE-OUT-PRT. DTSVAL04 +00781 MOVE ERROR-RECS TO ERRORS-PRT. DTSVAL04 +00782 MOVE ZERO-WAGE-CNT TO ZERO-WAGE-PRT. DTSVAL04 +00783 IF LINE-CTR > 55 DTSVAL04 +00784 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. DTSVAL04 +00785 WRITE LIST-REC FROM TOT1 AFTER 2. DTSVAL04 +00786 CLOSE ICESA-FILE LISTOUT PRINT-FILE CL*14 +00787 ICERR-FILE. CL*14 +00788 DISPLAY 'TOTAL QTR WAGES ' grand-gros-wage. CL*21 +00789 DTSVAL04 +00790 999-EXIT. DTSVAL04 +00791 EXIT. DTSVAL04 diff --git a/Batch/DTSVAL05.cob b/Batch/DTSVAL05.cob new file mode 100644 index 0000000..82a438d --- /dev/null +++ b/Batch/DTSVAL05.cob @@ -0,0 +1,312 @@ +00001 IDENTIFICATION DIVISION. 08/11/16 +00002 PROGRAM-ID. DTSVAL05. DTSVAL05 +00003 LV059 +00004 ******************************************************************DTSVAL05 +00005 * *DTSVAL05 +00006 * FUNCTION: *DTSVAL05 +00007 * THE FUNCTION OF DTSVAL05 IS TO VALIDATE WAGE RECORDS * CL*33 +00008 * FROM DUTAS. IF MORE THAN ONE RECORD FOR THE SAME EMPLOYER * CL*33 +00009 * SAME SSN AND SAME QUARTER THE PRORAM WILL ADD ALL RECORDS CL*33 +00010 * AND CREATE ONE W4 TRANSACTION. * CL*33 +00011 * *DTSVAL05 +00012 ******************************************************************DTSVAL05 +00013 DTSVAL05 +00014 ENVIRONMENT DIVISION. DTSVAL05 +00015 CONFIGURATION SECTION. DTSVAL05 +00016 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSVAL05 +00017 INPUT-OUTPUT SECTION. DTSVAL05 +00018 FILE-CONTROL. DTSVAL05 +00019 SELECT DTS4FILE ASSIGN TO DTS4FILE CL*37 +00020 FILE STATUS IS WAGE-IN-STATUS. CL*37 +00021 SELECT WAGEFILE ASSIGN TO WAGEFILE. CL*31 +00022 SELECT ERRFILE ASSIGN TO ERRFILE. CL*31 +00023 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. CL*16 +00024 DATA DIVISION. DTSVAL05 +00025 FILE SECTION. DTSVAL05 +00026 FD DTS4FILE CL*34 +00027 RECORDING MODE IS F DTSVAL05 +00028 BLOCK CONTAINS 0 CHARACTERS DTSVAL05 +00029 LABEL RECORDS ARE STANDARD DTSVAL05 +00030 DATA RECORD IS TDECREC. DTSVAL05 +00031 01 TRANSACTION-RECORD PIC X(80). CL*16 +00032 CL*16 +00033 FD WAGEFILE CL*31 +00034 RECORDING MODE IS F CL*31 +00035 BLOCK CONTAINS 0 CHARACTERS CL*31 +00036 LABEL RECORDS ARE STANDARD CL*31 +00037 DATA RECORD IS TDECREC. CL*31 +00038 01 WAGE-RECORD PIC X(80). CL*31 +00039 CL*31 +00040 FD ERRFILE CL*31 +00041 RECORDING MODE IS F CL*31 +00042 BLOCK CONTAINS 0 CHARACTERS CL*31 +00043 LABEL RECORDS ARE STANDARD CL*31 +00044 DATA RECORD IS TDECREC. CL*31 +00045 01 ERROR-RECORD PIC X(80). CL*31 +00046 CL*31 +00047 FD LISTOUT DTSVAL05 +00048 RECORD CONTAINS 133 CHARACTERS DTSVAL05 +00049 LABEL RECORDS ARE OMITTED DTSVAL05 +00050 RECORDING MODE IS F DTSVAL05 +00051 DATA RECORD IS PRINT-REC. DTSVAL05 +00052 01 PRINT-REC PIC X(133). CL*16 +00053 CL*16 +00054 WORKING-STORAGE SECTION. DTSVAL05 +000545 77 PAN-VALET PICTURE X(24) VALUE '059DTSVAL05 08/11/16'. DTSVAL05 +00055 01 WS-ETA-PRIMARY-NAME-FOUR PIC X(4). CL*16 +00056 01 WS-ETA-ENTITY-NAME-FOUR PIC X(4). CL*16 +00057 01 WEG-ERR-CNT PIC 9(1). CL*32 +00058 01 W4E-ERR-CNT PIC 9(1). CL*40 +00059 CL*18 +00060 01 TRANSACTION-WORK-AREA. DTSVAL05 +00061 ******************************************************************DTSVAL05 +00062 * ESP TRANSACTION RECORD DESCRIPTIONS *DTSVAL05 +00063 ******************************************************************DTSVAL05 +00064 05 ESP-TRANSACTION-AREA. DTSVAL05 +00065 10 TRAN-SSN PIC 9(10). DTSVAL05 +00066 10 FILLER REDEFINES TRAN-SSN. DTSVAL05 +00067 15 TR-SSN PIC 9(9). DTSVAL05 +00068 15 TR-SSN-SEQ PIC 9(1). DTSVAL05 +00069 10 TRAN-ID PIC X(02). DTSVAL05 +00070 10 FILLER REDEFINES TRAN-ID. DTSVAL05 +00071 15 TRAN-ID-PFX PIC X(1). DTSVAL05 +00072 88 TRAN-ID-PFX-WAGE VALUE 'W'. DTSVAL05 +00073 15 FILLER PIC X(1). DTSVAL05 +00074 10 TRAN-OPER-ID PIC 9(8). DTSVAL05 +00075 10 FILLER REDEFINES TRAN-OPER-ID. DTSVAL05 +00076 15 BATCH-NUMBER PIC 9(03). DTSVAL05 +00077 15 FILLER REDEFINES BATCH-NUMBER. DTSVAL05 +00078 20 BATCH-NUMBER-NN PIC 9(02). DTSVAL05 +00079 20 FILLER PIC X(01). DTSVAL05 +00080 15 TRAN-LOCAL-OFFICE PIC 9(02). DTSVAL05 +00081 15 TRAN-OPERATOR-ID PIC 9(03). DTSVAL05 +00082 10 TRAN-DATE-ENTERED PIC 9(08). DTSVAL05 +00083 10 TRAN-TIME-ENTERED PIC 9(06). DTSVAL05 +00084 10 FILLER PIC 9(06). DTSVAL05 +00085 10 TRAN-NAME-CHECK PIC X(3). DTSVAL05 +00086 10 TRAN-QUARTER-YR-QTR PIC 9(5). DTSVAL05 +00087 10 TRAN-AFFI-CODE PIC 9(1). DTSVAL05 +00088 10 TRAN-QUARTER-EARNINGS PIC 9(7). DTSVAL05 +00089 10 TRAN-ACCOUNT PIC 9(6). DTSVAL05 +00090 10 TRAN-EMP-NAME PIC X(4). DTSVAL05 +00091 10 TRAN-FILLER PIC X(299). DTSVAL05 +00092 01 COUNTERS. DTSVAL05 +00093 03 RECS-IN PIC 9(5). CL*16 +00094 03 RECS-OUT PIC 9(5). CL*16 +00095 03 PAGE-CTR PIC 9(5). CL*16 +00096 03 ERROR-RECS PIC 9(5). CL*16 +00097 03 WS-RUN-DATE. DTSVAL05 +00098 05 RUN-YR PIC 99. CL*16 +00099 05 RUN-MO PIC 99. CL*16 +00100 05 RUN-DA PIC 99. CL*16 +00101 CL*16 +00102 01 HOLD-WORK-AREA. CL*34 +00103 ****************************************************************** CL*34 +00104 * ESP TRANSACTION RECORD DESCRIPTIONS * CL*34 +00105 ****************************************************************** CL*34 +00106 05 WRK-TRANSACTION-AREA. CL*34 +00107 10 HOLD-SSN PIC 9(10). CL*34 +00108 10 FILLER REDEFINES HOLD-SSN. CL*34 +00109 15 HLD-SSN PIC 9(9). CL*34 +00110 15 HLD-SSN-SEQ PIC 9(1). CL*34 +00111 10 HOLD-ID PIC X(02). CL*34 +00112 10 FILLER REDEFINES HOLD-ID. CL*34 +00113 15 HOLD-ID-PFX-HLD PIC X(1). CL*34 +00114 15 FILLER PIC X(1). CL*34 +00115 10 HOLD-OPER-ID PIC 9(8). CL*34 +00116 10 FILLER REDEFINES HOLD-OPER-ID. CL*34 +00117 15 BATCH-NUMBER-HLD PIC 9(03). CL*34 +00118 15 HOLD-LOCAL-OFFICE PIC 9(02). CL*34 +00119 15 HOLD-OPERATOR-ID PIC 9(03). CL*34 +00120 10 HOLD-DATE-ENTERED PIC 9(08). CL*34 +00121 10 HOLD-TIME-ENTERED PIC 9(06). CL*34 +00122 10 FILLER PIC 9(06). CL*34 +00123 10 HOLD-NAME-CHECK PIC X(3). CL*34 +00124 10 HOLD-QUARTER-YR-QTR PIC 9(5). CL*34 +00125 10 HOLD-AFFI-CODE PIC 9(1). CL*34 +00126 10 HOLD-QUARTER-EARNINGS PIC 9(7). CL*34 +00127 10 HOLD-ACCOUNT PIC 9(6). CL*34 +00128 10 HOLD-EMP-NAME PIC X(4). CL*34 +00129 10 HOLD-FILLER PIC X(299). CL*34 +00130 01 HOLD-WRK-AREA. CL*34 +00131 03 HOLD-WRK-SSN PIC 9(9) VALUE ZEROS. CL*34 +00132 03 HOLD-WRK-QTR PIC 9(5) VALUE ZEROS. CL*34 +00133 03 HOLD-WRK-EMP PIC 9(6) VALUE ZEROS. CL*34 +00134 03 HOLD-WRK-WAGE PIC 9(7) VALUE ZEROS. CL*34 +00135 01 CURR-YRQ. CL*29 +00136 05 CUR-CEN PIC 99. CL*29 +00137 05 CUR-YR1 PIC 99. CL*29 +00138 05 CUR-QTR PIC 9. CL*29 +00139 01 LINE-CTR PIC 9(5) VALUE 56. CL*16 +00140 01 EOF PIC X. CL*16 +00141 CL*16 +00142 CL*37 +00143 01 FILE-STATUS. CL*37 +00144 05 WAGE-IN-STATUS PIC X(02). CL*37 +00145 88 WAGE-IN-OK-88 VALUE '00'. CL*37 +00146 88 WAGE-IN-EOF-88 VALUE '10'. CL*37 +00147 CL*37 +00148 01 HD1. DTSVAL05 +00149 03 FIL PIC X(5) VALUE SPACES. CL*16 +00150 03 FIL PIC X(8) VALUE 'DTSVAL05'. CL*38 +00151 03 FIL PIC X(31) VALUE SPACES. CL*16 +00152 03 FIL PIC X(42) VALUE CL*16 +00153 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. DTSVAL05 +00154 03 FIL PIC X(35) VALUE SPACES. CL*16 +00155 03 FIL PIC X(5) VALUE 'PAGE:'. CL*16 +00156 03 PAGE-CTR-PRT PIC ZZ,ZZ9. CL*16 +00157 01 HD2. DTSVAL05 +00158 03 FIL PIC X(29) VALUE SPACES. CL*50 +00159 03 FIL PIC X(52) VALUE CL*50 +00160 'DUPLICATE SSN WAGE RECORD - WAGES ADDED TO FIRST SSN'. CL*51 +00161 01 HD3. DTSVAL05 +00162 03 FIL PIC X(55) VALUE SPACES. CL*16 +00163 03 FIL PIC X(10) VALUE 'RUN DATE: '. CL*16 +00164 03 RUN-DATE. DTSVAL05 +00165 05 RUN-MO1 PIC 99. CL*16 +00166 05 FIL PIC X VALUE '/'. CL*16 +00167 05 RUN-DA1 PIC 99. CL*16 +00168 05 FIL PIC X VALUE '/'. CL*16 +00169 05 RUN-CEN PIC 99. CL*16 +00170 05 RUN-YR1 PIC 99. CL*16 +00171 01 HD4. DTSVAL05 +00172 03 FIL PIC X(5) VALUE SPACES. CL*16 +00173 03 FIL PIC X(3) VALUE 'SSN'. CL*16 +00174 03 FIL PIC X(7) VALUE SPACES. CL*16 +00175 03 FIL PIC X(12) VALUE 'DATE ENT EN'. CL*26 +00176 03 FIL PIC X(13) VALUE 'AME QTR '. CL*27 +00177 03 FIL PIC X(7) VALUE ' EARNI'. CL*27 +00178 03 FIL PIC X(8) VALUE 'NGS AC'. CL*27 +00179 03 FIL PIC X(14) VALUE 'CT NUM TDEC '. CL*27 +00180 03 FIL PIC X(11) VALUE 'NAME '. CL*27 +00181 03 FIL PIC X(07) VALUE SPACES. CL*26 +00182 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'. CL*16 +00183 01 DTL1. DTSVAL05 +00184 03 FIL PIC X(5) VALUE SPACES. CL*16 +00185 03 SSN-PRT PIC X(9). CL*16 +00186 03 FIL PIC XX VALUE SPACES. CL*16 +00187 03 DATE-ENTERED-PRT PIC X(06). CL*16 +00188 03 FIL PIC X(04) VALUE SPACES. CL*25 +00189 03 EMPEE-NAME PIC X(3). CL*16 +00190 03 FIL PIC X(04) VALUE SPACES. CL*25 +00191 03 QTR-PRT PIC X(5). CL*16 +00192 03 FIL PIC X(4) VALUE SPACES. CL*25 +00193 03 EARNINGS-PRT PIC X(7). CL*16 +00194 03 FIL PIC X(4) VALUE SPACES. CL*25 +00195 03 ACCT-NUM-PRT PIC X(6). CL*16 +00196 03 FIL PIC X(4) VALUE SPACES. CL*25 +00197 03 EMPOR-PRT PIC X(6). CL*16 +00198 03 FIL PIC X(04) VALUE SPACES. CL*25 +00199 03 MESSAGE-AREA PIC X(50) VALUE SPACES. CL*25 +00200 01 TOT1. DTSVAL05 +00201 03 FIL PIC X(5) VALUE SPACES. CL*16 +00202 03 FIL PIC X(19) VALUE 'TOTAL WAGE RECORDS:'. CL*16 +00203 03 WAGE-CNT-PRT PIC ZZZ,ZZZ,ZZ9. CL*16 +00204 03 FIL PIC X(5) VALUE SPACES. CL*16 +00205 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. CL*18 +00206 03 ERRORS-PRT PIC ZZZ,ZZ9. CL*16 +00207 CL*16 +00208 01 BLANK-LINE PIC X(133) VALUE SPACES. CL*16 +00209 CL*16 +00210 PROCEDURE DIVISION. DTSVAL05 +00211 OPEN OUTPUT LISTOUT WAGEFILE ERRFILE. CL*39 +00212 OPEN INPUT DTS4FILE CL*34 +00213 IF NOT WAGE-IN-OK-88 CL*37 +00214 DISPLAY 'DAY1 W4FILE INPUT IS EMPTY ' CL*37 +00215 WAGE-IN-STATUS CL*37 +00216 DISPLAY '***************************************' CL*37 +00217 MOVE +01 TO RETURN-CODE CL*40 +00218 GOBACK. CL*37 +00219 CL*31 +00220 MOVE ZEROS TO COUNTERS. DTSVAL05 +00221 DTSVAL05 +00222 PERFORM 100-READ-WAGE THRU 100-RW-EXIT DTSVAL05 +00223 UNTIL EOF = 1. CL*16 +00224 MOVE HOLD-WRK-WAGE TO HOLD-QUARTER-EARNINGS CL*35 +00225 MOVE HOLD-WORK-AREA TO WAGE-RECORD CL*41 +00226 WRITE WAGE-RECORD CL*35 +00227 IF ERROR-RECS > 0 CL*40 +00228 MOVE +02 TO RETURN-CODE CL*47 +00229 ELSE CL*40 +00230 MOVE +00 TO RETURN-CODE. CL*40 +00231 GO TO 999-CLOSE-FILES. CL*41 +00232 100-READ-WAGE. DTSVAL05 +00233 READ DTS4FILE INTO TRANSACTION-WORK-AREA CL*36 +00234 AT END MOVE 1 TO EOF CL*29 +00235 GO TO 100-RW-EXIT. CL*42 +00236 CL*42 +00237 ADD 1 TO RECS-OUT. DTSVAL05 +00238 CL*34 +00239 IF RECS-OUT = 1 CL*34 +00240 MOVE TR-SSN TO HOLD-WRK-SSN CL*34 +00241 MOVE TRAN-QUARTER-YR-QTR TO HOLD-WRK-QTR CL*34 +00242 MOVE TRAN-ACCOUNT TO HOLD-WRK-EMP CL*34 +00243 MOVE TRAN-QUARTER-EARNINGS TO HOLD-WRK-WAGE CL*34 +00244 MOVE TRANSACTION-WORK-AREA TO HOLD-WORK-AREA CL*41 +00245 GO TO 100-RW-EXIT. CL*34 +00246 * IF HOLD-WRK-SSN = 274585210 CL*53 +00247 * GO TO 100-RW-EXIT. CL*53 +00248 PERFORM 110-VALIDATE-WAGE THRU 110-VAL-EXIT. CL*36 +00249 100-RW-EXIT. DTSVAL05 +00250 EXIT. DTSVAL05 +00251 110-VALIDATE-WAGE. DTSVAL05 +00252 MOVE SPACES TO MESSAGE-AREA. DTSVAL05 +00253 MOVE 0 TO WEG-ERR-CNT. CL*30 +00254 * DISPLAY 'TR-SSN ' TR-SSN ' HOLD SSN ' HOLD-WRK-SSN CL*59 +00255 * DISPLAY 'TR-QTR ' TRAN-QUARTER-YR-QTR ' HLD Q ' HOLD-WRK-QTR CL*59 +00256 * DISPLAY 'TR-ACC ' TRAN-ACCOUNT 'HLD ACC ' HOLD-WRK-EMP CL*59 +00257 IF TR-SSN = HOLD-WRK-SSN AND CL*35 +00258 TRAN-QUARTER-YR-QTR = HOLD-WRK-QTR AND CL*35 +00259 TRAN-ACCOUNT = HOLD-WRK-EMP CL*35 +00260 * ADD TRAN-QUARTER-EARNINGS TO HOLD-WRK-WAGE CL*58 +00261 MOVE TRANSACTION-WORK-AREA TO HOLD-WORK-AREA CL*41 +00262 MOVE 1 TO WEG-ERR-CNT CL*30 +00263 DISPLAY '*ERROR** DUPLICATE SSN ' CL*46 +00264 MOVE '*ERROR** DUPLICATE SSN ' TO MESSAGE-AREA CL*45 +00265 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT CL*35 +00266 ELSE CL*35 +00267 MOVE HOLD-WRK-WAGE TO HOLD-QUARTER-EARNINGS CL*35 +00268 MOVE HOLD-WORK-AREA TO WAGE-RECORD CL*41 +00269 WRITE WAGE-RECORD CL*35 +00270 MOVE TRANSACTION-WORK-AREA TO HOLD-WORK-AREA CL*41 +00271 MOVE TRAN-QUARTER-EARNINGS TO HOLD-WRK-WAGE CL*44 +00272 MOVE TR-SSN TO HOLD-WRK-SSN CL*44 +00273 MOVE TRAN-QUARTER-YR-QTR TO HOLD-WRK-QTR CL*44 +00274 MOVE TRAN-ACCOUNT TO HOLD-WRK-EMP. CL*44 +00275 CL*31 +00276 110-VAL-EXIT. CL*36 +00277 EXIT. CL*31 +00278 125-WAGE-REPORT. DTSVAL05 +00279 ADD 1 TO ERROR-RECS. DTSVAL05 +00280 MOVE TR-SSN TO SSN-PRT. CL*16 +00281 MOVE TRAN-DATE-ENTERED TO DATE-ENTERED-PRT. CL*16 +00282 MOVE TRAN-NAME-CHECK TO EMPEE-NAME. CL*16 +00283 MOVE TRAN-QUARTER-EARNINGS TO EARNINGS-PRT. DTSVAL05 +00284 MOVE TRAN-QUARTER-YR-QTR TO QTR-PRT. CL*16 +00285 MOVE TRAN-ACCOUNT TO ACCT-NUM-PRT. CL*16 +00286 CL*16 +00287 IF LINE-CTR > 55 DTSVAL05 +00288 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. DTSVAL05 +00289 CL*16 +00290 WRITE PRINT-REC FROM DTL1. CL*49 +00291 MOVE SPACES TO DTL1. DTSVAL05 +00292 ADD 1 TO LINE-CTR. DTSVAL05 +00293 125-WR-EXIT. DTSVAL05 +00294 EXIT. DTSVAL05 +00295 130-WAGE-HEADER. DTSVAL05 +00296 ADD 1 TO PAGE-CTR. DTSVAL05 +00297 MOVE PAGE-CTR TO PAGE-CTR-PRT. DTSVAL05 +00298 WRITE PRINT-REC FROM HD1 AFTER TOP-OF-PAGE. CL*49 +00299 WRITE PRINT-REC FROM HD2. CL*49 +00300 WRITE PRINT-REC FROM HD3. CL*49 +00301 WRITE PRINT-REC FROM HD4. CL*49 +00302 MOVE 4 TO LINE-CTR. DTSVAL05 +00303 130-WH-EXIT. DTSVAL05 +00304 EXIT. DTSVAL05 +00305 999-CLOSE-FILES. DTSVAL05 +00306 MOVE RECS-OUT TO WAGE-CNT-PRT. DTSVAL05 +00307 MOVE ERROR-RECS TO ERRORS-PRT. DTSVAL05 +00308 WRITE PRINT-REC FROM TOT1 AFTER 2. DTSVAL05 +00309 CLOSE DTS4FILE LISTOUT WAGEFILE ERRFILE. CL*35 +00310 STOP RUN. DTSVAL05 +00311 EJECT DTSVAL05 diff --git a/Batch/DTSZX550.cob b/Batch/DTSZX550.cob new file mode 100644 index 0000000..df7e46b --- /dev/null +++ b/Batch/DTSZX550.cob @@ -0,0 +1,1553 @@ +00001 IDENTIFICATION DIVISION. 12/05/16 +00002 PROGRAM-ID. DTSZX550. DTSZX550 +00003 AUTHOR. NGC. LV095 +00004 DATE-WRITTEN. APRIL 2005. DTSZX550 +00005 DATE-COMPILED. DTSZX550 +00006 SKIP3 DTSZX550 +00007 ***** DTSZX550 +00008 * DTSZX550 +00009 * FUNCTION: AMENDED REPORTS IMPORT DRIVER CL*95 +00010 * READ DATA PASSED FROM WEB APPLICATION SERVER DTSZX550 +00011 * AND CALL THE APPROPRIATE PROCESSING PROGRAM DTSZX550 +00012 * FOR AMENDED, REPORTS, PAYMENTS, WAGES DELETIONS CL*95 +00013 * AND ADDITIONS. CL*95 +00014 * DTSZX550 +00015 * ACCOUNTING BATCH HEADERS, REPORTS AND PAYMENTS DTSZX550 +00016 * COMING FROM THE IN-HOUSE CASHIERING PROCESS ARE DTSZX550 +00017 * PROCESSED LAST. IN THE SORT KEY, THE FIRST DTSZX550 +00018 * ELEMENT (USED FOR THE EMPLOYER NUMBER FOR OTHER DTSZX550 +00019 * PROCESSES) IS SET TO 999999. DTSZX550 +00020 * DTSZX550 +00021 * MODIFICATION HISTORY: DTSZX550 +00022 * DTSZX550 +00023 * 08-30-2015 INITIAL DEVELOPMENT COPIED FROM BX417 CL*63 +00024 * REFERENCE RFP: ESSP AMENDED REPORTING ZL1 CL*63 +00025 * DTSZX550 +00026 * DTSZX550 +00027 * CL*23 +00028 * 10-22-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00029 * CHANGED SORT SEQUENCE FOR PROCESS X104 RECORDS CL*23 +00030 * BEFORE PROCESSING NAMES X106. CL*23 +00031 * RECORDS 102 AND 106 MUST BE PRESENT TO ADD A CL*23 +00032 * NEW EMPLOYER TO DUTAS. IF X102 AND X104 PASS CL*23 +00033 * ALL EDITS THEN NAME RECORD X106 RATE X108 AND CL*23 +00034 * ADDRESS X110 MUST BE PRESENT FOR EMPLOYER TO ADD CL*23 +00035 * CL*23 +00036 * REFERENCE RFP: ZL1 CL*23 +00037 * CL*23 +00038 * DTSZX550 +00039 * 11-01-2014 MODIFIED FOR ESSP INTERFACE CL*23 +00040 * MODIFIED PROGRAM TO CALL A NEW PROGRAM BX430 TO CL*23 +00041 * PROCESS REPORTS,WAGES AND PAYMENTS. CL*23 +00042 * REPORTS X140 COMING FROM ESSP CANNOT BE PROCESSED CL*23 +00043 * UNTIL A PAYMENT X145 IS PRESENT UNLESS IT IS A CL*23 +00044 * ZERO WAGE REPORT (REMIT AMT = 0). ALSO CHANGED CL*23 +00045 * THE SORT SEQ TO SORT PAYMENT X145 BEFORE X140 CL*23 +00046 * PREVIOUS SORT KEY WAS 30 NOW 19. CL*23 +00047 * REFERENCE RFP: ZL1 CL*23 +00048 * CL*23 +00049 * CL*23 +00050 * 12-02-2016 MODIFIED FOR ESSP INTERFACE CL*95 +00051 * DUTAS REJECTING AMENDMENTS THAT ARE NOT IN SEQUENC CL*95 +00052 * E. MODIFIED PROGRAM TO MOVE SEQ NUMBER TO T28 LOG CL*95 +00053 * NO. WITH BD140 SORT PROCESS ALL TRANSACTIONS WILL CL*95 +00054 * BE PROCESSED AS RECEIVED. CL*95 +00055 * CL*95 +00056 * REFERENCE RFP: ESSP AMENDMENTS ZL1 CL*95 +00057 * CL*40 +00058 * CL*40 +00059 ***** DTSZX550 +00060 SKIP3 DTSZX550 +00061 ENVIRONMENT DIVISION. DTSZX550 +00062 SKIP2 DTSZX550 +00063 INPUT-OUTPUT SECTION. DTSZX550 +00064 DTSZX550 +00065 FILE-CONTROL. DTSZX550 +00066 DTSZX550 +00067 SELECT WEB-IMP-FILE ASSIGN TO WEBREG DTSZX550 +00068 FILE STATUS IS WEB-IMP-STATUS. DTSZX550 +00069 DTSZX550 +00070 ** SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSZX550 +00071 ** FILE STATUS IS BATCH-STATUS. DTSZX550 +00072 DTSZX550 +00073 SELECT SORT-FILE ASSIGN TO SORTFILE. DTSZX550 +00074 DTSZX550 +00075 DATA DIVISION. DTSZX550 +00076 DTSZX550 +00077 FILE SECTION. DTSZX550 +00078 DTSZX550 +00079 FD WEB-IMP-FILE DTSZX550 +00080 RECORDING MODE IS F DTSZX550 +00081 BLOCK CONTAINS 0 RECORDS DTSZX550 +00082 LABEL RECORDS ARE OMITTED. DTSZX550 +00083 DTSZX550 +00084 01 WEB-IMP-REC. DTSZX550 +00085 05 WEB-IMP-TYPE PIC X(03). DTSZX550 +00086 88 WEB-IMP-TYPE-PRF-88 VALUE '102'. DTSZX550 +00087 88 WEB-IMP-TYPE-DETERM-88 VALUE '104'. DTSZX550 +00088 88 WEB-IMP-TYPE-NAME-88 VALUE '106'. DTSZX550 +00089 88 WEB-IMP-TYPE-RATE-88 VALUE '108'. DTSZX550 +00090 88 WEB-IMP-TYPE-ADDR-88 VALUE '110'. DTSZX550 +00091 88 WEB-IMP-TYPE-OPO-88 VALUE '120'. DTSZX550 +00092 88 WEB-IMP-TYPE-REL-88 VALUE '130'. DTSZX550 +00093 *** 88 WEB-IMP-TYPE-IND-88 VALUE '132'. DTSZX550 +00094 88 WEB-IMP-TYPE-RPT-88 VALUE '140'. DTSZX550 +00095 88 WEB-IMP-TYPE-WAGE-88 VALUE '144'. DTSZX550 +00096 88 WEB-IMP-TYPE-PAY-88 VALUE '145'. DTSZX550 +00097 88 WEB-IMP-TYPE-AWAGE-88 VALUE '147'. CL*63 +00098 88 WEB-IMP-TYPE-BHDR-88 VALUE '149'. DTSZX550 +00099 88 WEB-TYPE-REG-88 VALUE '102' '104' '106' DTSZX550 +00100 '108' '130' '132'. DTSZX550 +00101 88 WEB-TYPE-RPT-88 VALUE '140' '144' '147'. CL*63 +00102 88 WEB-TYPE-PAY-88 VALUE '145'. DTSZX550 +00103 88 WEB-TYPE-PRF-88 VALUE '110' '120'. DTSZX550 +00104 05 FILLER PIC X(01). DTSZX550 +00105 05 WEB-IMP-EMP-NO PIC 9(06). DTSZX550 +00106 05 FILLER PIC X(01). DTSZX550 +00107 05 WEB-IMP-QTR PIC X(06). DTSZX550 +00108 05 FILLER PIC X(495). DTSZX550 +00109 DTSZX550 +00110 *FD CURR-BATCH-NO DTSZX550 +00111 * RECORDING MODE IS F DTSZX550 +00112 * BLOCK CONTAINS 0 RECORDS DTSZX550 +00113 * LABEL RECORDS ARE OMITTED. DTSZX550 +00114 * DTSZX550 +00115 *01 CURR-BATCH-NO-REC. DTSZX550 +00116 * 05 CURRENT-BATCH-NO PIC 9(05). DTSZX550 +00117 * 05 CURRENT-ITEM-NO PIC 9(03). DTSZX550 +00118 * 05 FILLER PIC X(01). DTSZX550 +00119 * 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSZX550 +00120 * 05 FILLER PIC X(01). DTSZX550 +00121 * 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSZX550 +00122 * 05 FILLER PIC X(62). DTSZX550 +00123 DTSZX550 +00124 SD SORT-FILE. DTSZX550 +00125 DTSZX550 +00126 01 SORT-REC. DTSZX550 +00127 05 SORT-KEY. DTSZX550 +00128 10 SORT-EMP-NO PIC 9(06). DTSZX550 +00129 10 SORT-SEQ2 PIC X(16). DTSZX550 +00130 10 SORT-SEQ1 PIC S9(04) COMP. CL*60 +00131 05 RPT-PAY-SORT-KEY REDEFINES SORT-KEY. CL*57 +00132 10 SORT-PAY-EMP-NO PIC 9(06). CL*57 +00133 10 SORT-PAY-QTR PIC X(06). CL*57 +00134 10 SORT-FILLER PIC X(10). DTSZX550 +00135 10 SORT-PAY-SEQ1 PIC S9(04) COMP. CL*60 +00136 05 IN-HOUSE-SORT-KEY REDEFINES SORT-KEY. CL*57 +00137 10 SORT-IN-HOUSE-SEQ PIC 9(06). CL*57 +00138 10 SORT-BATCH PIC 9(05). CL*57 +00139 10 SORT-ITEM PIC 9(03). CL*57 +00140 10 SORT-FILLER PIC X(10). CL*57 +00141 05 SORT-DATA PIC X(512). DTSZX550 +00142 DTSZX550 +00143 WORKING-STORAGE SECTION. DTSZX550 +001435 77 PAN-VALET PICTURE X(24) VALUE '095DTSZX550 12/05/16'. DTSZX550 +00144 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX420 10/07/14'. DTSZX550 +00145 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX420 10/07/14'. DTSZX550 +00146 SKIP3 DTSZX550 +00147 01 WRK-AREA. DTSZX550 +00148 05 W-ABEND-CD PIC S9(04) COMP VALUE 420. DTSZX550 +00149 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX420'.DTSZX550 +00150 DTSZX550 +00151 05 WEB-IMP-STATUS PIC X(02). DTSZX550 +00152 88 WEB-IMP-STATUS-OK-88 VALUE '00'. DTSZX550 +00153 88 WEB-IMP-STATUS-EOF-88 VALUE '10'. DTSZX550 +00154 DTSZX550 +00155 ** 05 BATCH-STATUS PIC X(02). DTSZX550 +00156 * 88 BATCH-STATUS-OK-88 VALUE '00'. DTSZX550 +00157 ** 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSZX550 +00158 DTSZX550 +00159 05 SORT-EOF-IND PIC X(01). DTSZX550 +00160 88 SORT-OK-88 VALUE '0'. DTSZX550 +00161 88 SORT-EOF-88 VALUE '1'. DTSZX550 +00162 DTSZX550 +00163 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSZX550 +00164 88 W-ERROR-YES-88 VALUE 'Y'. DTSZX550 +00165 88 W-ERROR-NO-88 VALUE 'N'. DTSZX550 +00166 DTSZX550 +00167 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSZX550 +00168 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSZX550 +00169 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSZX550 +00170 DTSZX550 +00171 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSZX550 +00172 05 W-PAY-QTR PIC X(06) VALUE SPACES. CL*57 +00173 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSZX550 +00174 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSZX550 +00175 05 W-LAST-RATE-YEAR PIC 9(04). DTSZX550 +00176 05 X102-KEY-AREA PIC X(06) VALUE SPACES. CL*15 +00177 DTSZX550 +00178 05 SUB PIC S9(04) COMP. DTSZX550 +00179 ** 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSZX550 +00180 * 05 FILLER REDEFINES W-PSEUDO-BATCH-NO. DTSZX550 +00181 * 10 W-PSEUDO-DAYS PIC 9(03). DTSZX550 +00182 ** 10 W-PSEUDO-BATCH-SEQ PIC 9(02). DTSZX550 +00183 DTSZX550 +00184 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSZX550 +00185 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSZX550 +00186 DTSZX550 +00187 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSZX550 +00188 DTSZX550 +00189 05 W-500-DATE. DTSZX550 +00190 10 W-500-DATE-MM PIC XX. DTSZX550 +00191 10 FILLER PIC X. DTSZX550 +00192 10 W-500-DATE-DD PIC XX. DTSZX550 +00193 10 FILLER PIC X. DTSZX550 +00194 10 W-500-DATE-YY PIC XXXX. DTSZX550 +00195 DTSZX550 +00196 05 W-500-FQTR. DTSZX550 +00197 10 W-500-FQTR-YY PIC XXXX. DTSZX550 +00198 10 FILLER PIC X VALUE '/'. DTSZX550 +00199 10 W-500-FQTR-NO PIC X. DTSZX550 +00200 DTSZX550 +00201 05 W-INT-9 PIC 9(13). DTSZX550 +00202 05 W-INT-X REDEFINES W-INT-9 DTSZX550 +00203 PIC X(13). DTSZX550 +00204 CL*70 +00205 05 Z-INT-X. CL*78 +00206 15 Z-INT-A PIC S9(11) VALUE ZEROS. CL*78 +00207 15 Z-INT-B PIC X(01) VALUE '.'. CL*79 +00208 15 Z-INT-C PIC 9(02) VALUE ZEROS. CL*78 +00209 05 Z-INT-9. CL*78 +00210 15 Z-INT-A9 PIC S9(11) VALUE ZEROS. CL*78 +00211 15 Z-INT-C9 PIC 9(02) VALUE ZEROS. CL*78 +00212 05 Z-INT-Z9 REDEFINES Z-INT-9 CL*78 +00213 PIC S9(11)V99. CL*77 +00214 CL*70 +00215 05 W-INTEGER PIC S9(11) COMP-3. DTSZX550 +00216 05 W-FRACTION PIC SV9(11) COMP-3. DTSZX550 +00217 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSZX550 +00218 05 Z-NUMBER PIC S9(11)V9(05) VALUE 0. CL*69 +00219 DTSZX550 +00220 ** 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSZX550 +00221 * VALUE +0. DTSZX550 +00222 * 05 W-DIGIT PIC 9. DTSZX550 +00223 * 05 W-AMT PIC S9(09)V99 COMP-3 DTSZX550 +00224 * VALUE +0. DTSZX550 +00225 * DTSZX550 +00226 * 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSZX550 +00227 * 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSZX550 +00228 * 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSZX550 +00229 * DTSZX550 +00230 * 05 W-WAGES PIC S9(11)V99. DTSZX550 +00231 * 05 W-WAGES-X PIC X(14). DTSZX550 +00232 * 05 W-WAGES-9 REDEFINES W-WAGES-X DTSZX550 +00233 * PIC 9(11).99. DTSZX550 +00234 * 05 W-REMIT-X PIC X(12). DTSZX550 +00235 * 05 W-REMIT-9 REDEFINES W-REMIT-X DTSZX550 +00236 * PIC 9(09).99. DTSZX550 +00237 05 W-TRACE-X. DTSZX550 +00238 10 W-TRACE-A PIC X(05) VALUE '00000'. DTSZX550 +00239 10 W-TRACE-B PIC X(08) VALUE ZEROS. DTSZX550 +00240 05 W-TRACE-9 REDEFINES W-TRACE-X DTSZX550 +00241 PIC 9(13). DTSZX550 +00242 * 05 W-COUNT-X PIC X(07). DTSZX550 +00243 * 05 W-COUNT-9 REDEFINES W-COUNT-X DTSZX550 +00244 * PIC 9(07). DTSZX550 +00245 * 05 W-EARNINGS-X PIC X(12). DTSZX550 +00246 * 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSZX550 +00247 * PIC 9(09).99. DTSZX550 +00248 * 05 W-EARNINGS PIC S9(07)V99. DTSZX550 +00249 * 05 W-RATE PIC S9V9(04). DTSZX550 +00250 * 05 W-RATE-X PIC X(06). DTSZX550 +00251 * 05 W-RATE-9 REDEFINES W-RATE-X DTSZX550 +00252 * PIC 9.9999. DTSZX550 +00253 * DTSZX550 +00254 * 05 ISUB1 PIC S9(04) COMP. DTSZX550 +00255 * 05 ISUB2 PIC S9(04) COMP. DTSZX550 +00256 * 05 ISUB3 PIC S9(04) COMP. DTSZX550 +00257 * 05 ISUB4 PIC S9(04) COMP. DTSZX550 +00258 * 05 ISUB5 PIC S9(04) COMP. DTSZX550 +00259 * 05 ISUB6 PIC S9(04) COMP. DTSZX550 +00260 * 05 W-SLASH1 PIC S9(04) COMP. DTSZX550 +00261 * 05 W-SLASH2 PIC S9(04) COMP. DTSZX550 +00262 * 05 W-CURR-FIELD PIC S9(04) COMP. DTSZX550 +00263 * 05 W-LAST-FIELD PIC S9(04) COMP. DTSZX550 +00264 * 05 W-LAST-FIELD-LEN PIC S9(04) COMP. DTSZX550 +00265 * 05 W-INPUT-LENGTH PIC S9(04) COMP DTSZX550 +00266 * VALUE +502. DTSZX550 +00267 * 05 W-INPUT-LINE PIC X(500). DTSZX550 +00268 * 05 W-PARSE-COMPLETE-IND PIC X(01). DTSZX550 +00269 * 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSZX550 +00270 * 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSZX550 +00271 * 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSZX550 +00272 * 05 W-CONV-LINE PIC X(32). DTSZX550 +00273 * DTSZX550 +00274 * 05 W-MDY PIC X(04). DTSZX550 +00275 * 05 FILLER REDEFINES W-MDY. DTSZX550 +00276 * 10 FILLER PIC X(02). DTSZX550 +00277 * 10 W-MDY-X-2 PIC X(02). DTSZX550 +00278 * 10 FILLER REDEFINES W-MDY-X-2. DTSZX550 +00279 * 15 FILLER PIC X(01). DTSZX550 +00280 ** 15 W-MDY-X-1 PIC X(01). DTSZX550 +00281 DTSZX550 +00282 05 W-WEB-IMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX550 +00283 05 W-102-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00284 05 W-104-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00285 05 W-106-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00286 05 W-108-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00287 05 W-110-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00288 05 W-120-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00289 05 W-140-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00290 05 W-144-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00291 05 W-145-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*38 +00292 05 W-147-IMP-CNT PIC S9(07) COMP-3 VALUE +0. CL*63 +00293 DTSZX550 +00294 05 W-WEB-IMP-LENGTH PIC S9(04) COMP. DTSZX550 +00295 DTSZX550 +00296 05 W-AMT-DISP1 PIC ----------9.99. DTSZX550 +00297 05 W-AMT-DISP2 PIC ----------9.99. DTSZX550 +00298 05 W-AMT-DISP4 PIC -.99999999999. DTSZX550 +00299 05 W-AMT-DISP3 PIC ------------9. DTSZX550 +00300 DTSZX550 +00301 * PROFILE DTSZX550 +00302 01 X102-REC. DTSZX550 +00303 ++INCLUDE DTSIX102 DTSZX550 +00304 DTSZX550 +00305 * DETERMINATION DTSZX550 +00306 01 X104-REC. DTSZX550 +00307 ++INCLUDE DTSIX104 DTSZX550 +00308 DTSZX550 +00309 * NAME DTSZX550 +00310 01 X106-REC. DTSZX550 +00311 ++INCLUDE DTSIX106 DTSZX550 +00312 DTSZX550 +00313 * RATE DTSZX550 +00314 01 X108-REC. DTSZX550 +00315 ++INCLUDE DTSIX108 DTSZX550 +00316 DTSZX550 +00317 * ADDRESS DTSZX550 +00318 01 X110-REC. DTSZX550 +00319 ++INCLUDE DTSIX110 DTSZX550 +00320 DTSZX550 +00321 * OPO DTSZX550 +00322 01 X120-REC. DTSZX550 +00323 ++INCLUDE DTSIX120 DTSZX550 +00324 DTSZX550 +00325 * WORKING COPY OF X120 CL*41 +00326 01 W120-REC. CL*41 +00327 ++INCLUDE DTSWX120 CL*43 +00328 CL*41 +00329 * RELATIONSHIP DTSZX550 +00330 01 X130-REC. DTSZX550 +00331 ++INCLUDE DTSIX130 DTSZX550 +00332 DTSZX550 +00333 ** INDUSTRY DESCRIPTION DTSZX550 +00334 *01 X132-REC. DTSZX550 +00335 ***INCLUDE DTSIX132 DTSZX550 +00336 DTSZX550 +00337 * REPORT DUTAS CL*73 +00338 01 X140-REC. DTSZX550 +00339 ++INCLUDE DTSIX140 DTSZX550 +00340 DTSZX550 +00341 * REPORT ESSP CL*73 +00342 01 W140-REC. CL*73 +00343 ++INCLUDE DTSIW140 CL*73 +00344 CL*73 +00345 * EMPLOYEE WAGES DTSZX550 +00346 01 X144-REC. DTSZX550 +00347 ++INCLUDE DTSIX144 DTSZX550 +00348 DTSZX550 +00349 * EMPLOYEE WAGES-WORK COPY CL*50 +00350 01 W144-REC. CL*50 +00351 ++INCLUDE DTSIW144 CL*50 +00352 CL*50 +00353 * EMPLOYEE AMENDED WAGES (W2) CL*63 +00354 01 X147-REC. CL*63 +00355 ++INCLUDE DTSIX147 CL*63 +00356 CL*63 +00357 * PAYMENT DTSZX550 +00358 01 X145-REC. DTSZX550 +00359 ++INCLUDE DTSIX145 DTSZX550 +00360 DTSZX550 +00361 01 X149-REC. DTSZX550 +00362 ++INCLUDE DTSIX149 DTSZX550 +00363 DTSZX550 +00364 01 L001-LINK-AREA. DTSZX550 +00365 ++INCLUDE DTSIL001 DTSZX550 +00366 DTSZX550 +00367 01 L003-LINK-AREA. DTSZX550 +00368 ++INCLUDE DTSIL003 DTSZX550 +00369 DTSZX550 +00370 01 L004-LINK-AREA. DTSZX550 +00371 ++INCLUDE DTSIL004 DTSZX550 +00372 DTSZX550 +00373 01 L005-LINK-AREA. DTSZX550 +00374 ++INCLUDE DTSIL005 DTSZX550 +00375 DTSZX550 +00376 01 L205-LINK-AREA. DTSZX550 +00377 ++INCLUDE DTSIL205 DTSZX550 +00378 DTSZX550 +00379 01 LX42-LINK-AREA. DTSZX550 +00380 ++INCLUDE DTSILX42 CL*39 +00381 DTSZX550 +00382 01 L910-LINK-AREA. DTSZX550 +00383 ++INCLUDE DTSIL910 DTSZX550 +00384 01 MSKL-REC. DTSZX550 +00385 ++INCLUDE DTSIMSKL DTSZX550 +00386 DTSZX550 +00387 01 MHDR-REC. DTSZX550 +00388 ++INCLUDE DTSIMHDR DTSZX550 +00389 DTSZX550 +00390 01 MPRF-REC. DTSZX550 +00391 ++INCLUDE DTSIMPRF DTSZX550 +00392 DTSZX550 +00393 01 MSOL-REC. DTSZX550 +00394 ++INCLUDE DTSIMSOL DTSZX550 +00395 DTSZX550 +00396 01 MQTR-REC. DTSZX550 +00397 ++INCLUDE DTSIMQTR DTSZX550 +00398 DTSZX550 +00399 01 MOPO-REC. DTSZX550 +00400 ++INCLUDE DTSIMOPO DTSZX550 +00401 DTSZX550 +00402 01 MTAD-REC. DTSZX550 +00403 ++INCLUDE DTSIMTAD DTSZX550 +00404 DTSZX550 +00405 01 MNTE-REC. DTSZX550 +00406 ++INCLUDE DTSIMNTE DTSZX550 +00407 DTSZX550 +00408 01 L921-LINK-AREA. DTSZX550 +00409 ++INCLUDE DTSIL921 DTSZX550 +00410 SKIP3 DTSZX550 +00411 01 ISKL-REC. DTSZX550 +00412 ++INCLUDE DTSIISKL DTSZX550 +00413 SKIP3 DTSZX550 +00414 01 IEIN-REC. DTSZX550 +00415 ++INCLUDE DTSIIEIN DTSZX550 +00416 DTSZX550 +00417 01 L923-LINK-AREA. DTSZX550 +00418 ++INCLUDE DTSIL923 DTSZX550 +00419 EJECT DTSZX550 +00420 01 ASKL-REC. DTSZX550 +00421 ++INCLUDE DTSIASKL DTSZX550 +00422 EJECT DTSZX550 +00423 01 AHDR-REC. DTSZX550 +00424 ++INCLUDE DTSIAHDR DTSZX550 +00425 DTSZX550 +00426 01 ARPT-REC. DTSZX550 +00427 ++INCLUDE DTSIARPT DTSZX550 +00428 DTSZX550 +00429 01 APAY-REC. DTSZX550 +00430 ++INCLUDE DTSIAPAY DTSZX550 +00431 DTSZX550 +00432 DTSZX550 +00433 01 L927-LINK-AREA. DTSZX550 +00434 ++INCLUDE DTSIL927 DTSZX550 +00435 DTSZX550 +00436 01 TSKL-REC. DTSZX550 +00437 ++INCLUDE DTSITSKL DTSZX550 +00438 DTSZX550 +00439 01 L931-LINK-AREA. DTSZX550 +00440 ++INCLUDE DTSIL931 DTSZX550 +00441 DTSZX550 +00442 01 FSKL-REC. DTSZX550 +00443 ++INCLUDE DTSIFSKL DTSZX550 +00444 DTSZX550 +00445 PROCEDURE DIVISION. DTSZX550 +00446 DTSZX550 +00447 DTSBX420-MAIN. DTSZX550 +00448 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSZX550 +00449 IF W-FATAL-ERROR-YES-88 DTSZX550 +00450 GO TO DTSBX420-MAIN-EXIT DTSZX550 +00451 END-IF. DTSZX550 +00452 DTSZX550 +00453 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSZX550 +00454 DTSZX550 +00455 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSZX550 +00456 IF W-ERROR-YES-88 DTSZX550 +00457 MOVE +2 TO RETURN-CODE. DTSZX550 +00458 DTSBX420-MAIN-EXIT. DTSZX550 +00459 GOBACK. DTSZX550 +00460 EJECT DTSZX550 +00461 I0000-INITIATE. DTSZX550 +00462 SET W-ERROR-NO-88 TO TRUE. DTSZX550 +00463 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSZX550 +00464 DTSZX550 +00465 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSZX550 +00466 DTSZX550 +00467 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSZX550 +00468 IF W-FATAL-ERROR-YES-88 DTSZX550 +00469 GO TO I0000-EXIT DTSZX550 +00470 END-IF. DTSZX550 +00471 DTSZX550 +00472 PERFORM I3000-READ-HEADER THRU I3000-EXIT. DTSZX550 +00473 IF W-FATAL-ERROR-YES-88 DTSZX550 +00474 GO TO I0000-EXIT DTSZX550 +00475 END-IF. DTSZX550 +00476 DTSZX550 +00477 ** PERFORM I4000-CURRENT-BATCH THRU I4000-EXIT DTSZX550 +00478 * IF W-FATAL-ERROR-YES-88 DTSZX550 +00479 * GO TO I0000-EXIT DTSZX550 +00480 ** END-IF. DTSZX550 +00481 DTSZX550 +00482 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSZX550 +00483 DTSZX550 +00484 I0000-EXIT. DTSZX550 +00485 EXIT. DTSZX550 +00486 DTSZX550 +00487 I2000-OPEN-FILES. DTSZX550 +00488 OPEN INPUT WEB-IMP-FILE. DTSZX550 +00489 IF NOT WEB-IMP-STATUS-OK-88 DTSZX550 +00490 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 +00491 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSZX550 +00492 MOVE +3 TO RETURN-CODE DTSZX550 +00493 SET W-ERROR-YES-88 TO TRUE DTSZX550 +00494 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSZX550 +00495 WEB-IMP-STATUS DTSZX550 +00496 GO TO I2000-EXIT DTSZX550 +00497 END-IF. DTSZX550 +00498 DTSZX550 +00499 READ WEB-IMP-FILE. DTSZX550 +00500 IF NOT WEB-IMP-STATUS-OK-88 DTSZX550 +00501 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 +00502 DISPLAY 'NO ESSP FTP UPDATE FILES TO PROCESS' DTSZX550 +00503 MOVE +3 TO RETURN-CODE DTSZX550 +00504 SET W-ERROR-YES-88 TO TRUE DTSZX550 +00505 DISPLAY 'NO RECORDS ON WEB-IMP-FILE ' DTSZX550 +00506 WEB-IMP-STATUS DTSZX550 +00507 GO TO I2000-EXIT DTSZX550 +00508 END-IF. DTSZX550 +00509 CLOSE WEB-IMP-FILE. DTSZX550 +00510 OPEN INPUT WEB-IMP-FILE. DTSZX550 +00511 IF NOT WEB-IMP-STATUS-OK-88 DTSZX550 +00512 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 +00513 DISPLAY 'NO ESSP UPDATES FILE TO PROCESS' DTSZX550 +00514 MOVE +3 TO RETURN-CODE DTSZX550 +00515 SET W-ERROR-YES-88 TO TRUE DTSZX550 +00516 DISPLAY 'CANNOT OPEN WEB-IMP-FILE ' DTSZX550 +00517 WEB-IMP-STATUS DTSZX550 +00518 GO TO I2000-EXIT DTSZX550 +00519 END-IF. DTSZX550 +00520 DTSZX550 +00521 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSZX550 +00522 DTSZX550 +00523 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSZX550 +00524 DTSZX550 +00525 PERFORM S923-OPEN-READ THRU S923-EXIT. DTSZX550 +00526 DTSZX550 +00527 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSZX550 +00528 DTSZX550 +00529 * MOVE 'N' TO L927-TRACE-IND. CL*44 +00530 * MOVE W-MOD-NAME TO L927-MOD-NAME. CL*44 +00531 * PERFORM S927A-OPEN THRU S927A-EXIT. CL*44 +00532 DTSZX550 +00533 I2000-EXIT. DTSZX550 +00534 EXIT. DTSZX550 +00535 DTSZX550 +00536 I3000-READ-HEADER. DTSZX550 +00537 MOVE LOW-VALUES TO MSKL-REC. DTSZX550 +00538 MOVE +0 TO MSKL-EMP-NO. DTSZX550 +00539 SET MSKL-HDR-88 TO TRUE. DTSZX550 +00540 DTSZX550 +00541 PERFORM S910-READ THRU S910-EXIT. DTSZX550 +00542 IF L910-NO-REC-88 DTSZX550 +00543 DISPLAY 'DTSBX420: MHDR RECORD IS MISSING' DTSZX550 +00544 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX550 +00545 MOVE +6 TO RETURN-CODE DTSZX550 +00546 GO TO I3000-EXIT DTSZX550 +00547 ELSE DTSZX550 +00548 MOVE MSKL-REC TO MHDR-REC DTSZX550 +00549 END-IF. DTSZX550 +00550 DTSZX550 +00551 MOVE MHDR-CURR-RUN-DATE TO W-CURR-RUN-DATE. DTSZX550 +00552 DTSZX550 +00553 MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9. DTSZX550 +00554 MOVE L004-QTR-5-YR TO W-LAST-RATE-YEAR. DTSZX550 +00555 DISPLAY 'LAST RATE YEAR ' W-LAST-RATE-YEAR. DTSZX550 +00556 DTSZX550 +00557 I3000-EXIT. DTSZX550 +00558 EXIT. DTSZX550 +00559 DTSZX550 +00560 I5000-INITIAL-CALLS. DTSZX550 +00561 DISPLAY '!!!!! BX420- INITILIZE RECORDS START BX420' CL*12 +00562 SET LX42-INITIALIZE-88 TO TRUE. DTSZX550 +00563 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSZX550 +00564 MOVE L005-DATE TO LX42-SYS-DATE. DTSZX550 +00565 MOVE L005-TIME TO LX42-SYS-TIME. DTSZX550 +00566 * MOVE ZERO TO LX42-BATCH-NO DTSZX550 +00566 MOVE ZERO TO LX42-PSEUDO-BATCH-NO DTSZX550 +00568 LX42-LAST-DETERM-EMP DTSZX550 +00569 LX42-RPT-CNT DTSZX550 +00570 LX42-RPT-REMIT-AMT DTSZX550 +00571 LX42-PAY-CNT DTSZX550 +00572 LX42-PAY-REMIT-AMT. DTSZX550 +00573 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSZX550 +00574 SET LX42-ERROR-NO-88 TO TRUE. DTSZX550 +00575 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +00576 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSZX550 +00577 DTSZX550 +00578 MOVE ZERO TO W-102-IMP-CNT CL*38 +00579 W-104-IMP-CNT CL*38 +00580 W-106-IMP-CNT CL*38 +00581 W-108-IMP-CNT CL*38 +00582 W-110-IMP-CNT CL*38 +00583 W-120-IMP-CNT CL*38 +00584 W-140-IMP-CNT CL*38 +00585 W-144-IMP-CNT CL*38 +00586 W-145-IMP-CNT. CL*38 +00587 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +00588 * PERFORM S423-REPORT-WAGE THRU S423-EXIT. CL*59 +00589 DTSZX550 +00590 I5000-EXIT. DTSZX550 +00591 EXIT. DTSZX550 +00592 DTSZX550 +00593 DTSZX550 +00594 P0000-PROCESS. DTSZX550 +00595 DISPLAY '!!!! BX420- START WEB IMPORT PRELIMINARY EDIT'. CL*12 +00596 DISPLAY SPACE. DTSZX550 +00597 DTSZX550 +00598 SET W-ERROR-NO-88 TO TRUE. DTSZX550 +00599 DTSZX550 +00600 SORT SORT-FILE DTSZX550 +00601 ON ASCENDING KEY SORT-KEY DTSZX550 +00602 INPUT PROCEDURE P1000-PRE-SORT THRU P1000-EXIT DTSZX550 +00603 OUTPUT PROCEDURE P2000-POST-SORT THRU P2000-EXIT. DTSZX550 +00604 DTSZX550 +00605 IF SORT-RETURN NOT = +0 DTSZX550 +00606 DISPLAY 'SORT FAILED ' SORT-RETURN DTSZX550 +00607 END-IF. DTSZX550 +00608 DTSZX550 +00609 P0000-EXIT. DTSZX550 +00610 EXIT. DTSZX550 +00611 DTSZX550 +00612 DTSZX550 +00613 P1000-PRE-SORT. DTSZX550 +00614 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT. DTSZX550 +00615 PERFORM UNTIL WEB-IMP-STATUS-EOF-88 DTSZX550 +00616 PERFORM P1100-PARSE-IMPORT-REC THRU P1100-EXIT DTSZX550 +00617 PERFORM P1200-BUILD-SORT-REC THRU P1200-EXIT DTSZX550 +00618 PERFORM S1000-READ-WEB-IMP THRU S1000-EXIT DTSZX550 +00619 END-PERFORM. DTSZX550 +00620 DTSZX550 +00621 DISPLAY '!!!!! BX420- ENDOF INPUT SORT PROCEDURE ****'. CL*12 +00622 P1000-EXIT. DTSZX550 +00623 EXIT. DTSZX550 +00624 DTSZX550 +00625 P1100-PARSE-IMPORT-REC. DTSZX550 +00626 IF WEB-IMP-TYPE-BHDR-88 DTSZX550 +00627 DISPLAY 'BX420 P1000 HDR ' WEB-IMP-REC(1:14) DTSZX550 +00628 END-IF. DTSZX550 +00629 CL*20 +00630 * DISPLAY 'P1000 ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*88 +00631 DTSZX550 +00632 PERFORM DTSZX550 +00633 VARYING SUB FROM +1 BY +1 DTSZX550 +00634 UNTIL SUB > +100 DTSZX550 +00635 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSZX550 +00636 L205-INTEGER (SUB) DTSZX550 +00637 L205-FRACTION (SUB) DTSZX550 +00638 MOVE SPACES TO L205-TEXT (SUB) DTSZX550 +00639 L205-DATE (SUB) DTSZX550 +00640 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSZX550 +00641 END-PERFORM. DTSZX550 +00642 DTSZX550 +00643 EVALUATE TRUE DTSZX550 +00644 DTSZX550 +00645 * WHEN WEB-IMP-TYPE-RPT-88 CL*81 +00646 * PERFORM P1100H-RPT THRU P1100H-EXIT CL*81 +00647 DTSZX550 +00648 WHEN WEB-IMP-TYPE-WAGE-88 DTSZX550 +00649 PERFORM P1100I-WAGE THRU P1100I-EXIT DTSZX550 +00650 DTSZX550 +00651 WHEN WEB-IMP-TYPE-AWAGE-88 CL*85 +00652 PERFORM P1100X-AWAGE THRU P1100X-EXIT CL*85 +00653 CL*85 +00654 WHEN WEB-IMP-TYPE-PAY-88 DTSZX550 +00655 PERFORM P1100J-PAY THRU P1100J-EXIT DTSZX550 +00656 DTSZX550 +00657 DTSZX550 +00658 END-EVALUATE. DTSZX550 +00659 DTSZX550 +00660 IF WEB-IMP-TYPE-RPT-88 CL*83 +00661 GO TO P1100-EXIT. CL*83 +00662 MOVE WEB-IMP-REC TO L205-INPUT-DATA. DTSZX550 +00663 CALL 'DTSBU205' USING L205-LINK-AREA. DTSZX550 +00664 DTSZX550 +00665 P1100-EXIT. DTSZX550 +00666 EXIT. DTSZX550 +00667 DTSZX550 +00668 P1100H-RPT. DTSZX550 +00669 * DISPLAY 'P1100H-RPT ' WEB-IMP-REC(1:126). CL*23 +00670 MOVE +16 TO L205-LAST-FIELD. CL*24 +00671 MOVE +14 TO L205-LAST-FIELD-LEN. CL*27 +00672 DTSZX550 +00673 MOVE +3 TO L205-FIELD-LENGTH (1). DTSZX550 +00674 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSZX550 +00675 DTSZX550 +00676 MOVE +6 TO L205-FIELD-LENGTH (2). DTSZX550 +00677 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSZX550 +00678 DTSZX550 +00679 MOVE +4 TO L205-FIELD-LENGTH (3). DTSZX550 +00680 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSZX550 +00681 DTSZX550 +00682 MOVE +1 TO L205-FIELD-LENGTH (4). DTSZX550 +00683 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSZX550 +00684 DTSZX550 +00685 MOVE +8 TO L205-FIELD-LENGTH (5). DTSZX550 +00686 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSZX550 +00687 DTSZX550 +00688 MOVE +8 TO L205-FIELD-LENGTH (6). DTSZX550 +00689 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSZX550 +00690 DTSZX550 +00691 MOVE +14 TO L205-FIELD-LENGTH (7). DTSZX550 +00692 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSZX550 +00693 DTSZX550 +00694 MOVE +14 TO L205-FIELD-LENGTH (8). DTSZX550 +00695 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSZX550 +00696 DTSZX550 +00697 MOVE +14 TO L205-FIELD-LENGTH (9). DTSZX550 +00698 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSZX550 +00699 DTSZX550 +00700 MOVE +04 TO L205-FIELD-LENGTH (10). DTSZX550 +00701 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSZX550 +00702 DTSZX550 +00703 MOVE +10 TO L205-FIELD-LENGTH (11). DTSZX550 +00704 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSZX550 +00705 DTSZX550 +00706 MOVE +8 TO L205-FIELD-LENGTH (12). DTSZX550 +00707 SET L205-TYPE-TEXT-88 (12) TO TRUE. CL*48 +00708 DTSZX550 +00709 MOVE +8 TO L205-FIELD-LENGTH (13). DTSZX550 +00710 SET L205-TYPE-TEXT-88 (13) TO TRUE. CL*48 +00711 DTSZX550 +00712 MOVE +8 TO L205-FIELD-LENGTH (14). DTSZX550 +00713 SET L205-TYPE-TEXT-88 (14) TO TRUE. CL*48 +00714 DTSZX550 +00715 MOVE +4 TO L205-FIELD-LENGTH (15). DTSZX550 +00716 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSZX550 +00717 DTSZX550 +00718 MOVE +14 TO L205-FIELD-LENGTH (16). CL*27 +00719 SET L205-TYPE-NUMBER-88 (16) TO TRUE. CL*26 +00720 CL*24 +00721 ** MOVE +1 TO L205-FIELD-LENGTH (16). DTSZX550 +00722 ** SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSZX550 +00723 DTSZX550 +00724 ** MOVE +1 TO L205-FIELD-LENGTH (17). DTSZX550 +00725 ** SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSZX550 +00726 DTSZX550 +00727 ** MOVE +3 TO L205-FIELD-LENGTH (18). DTSZX550 +00728 ** SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSZX550 +00729 DTSZX550 +00730 ** MOVE +8 TO L205-FIELD-LENGTH (19). DTSZX550 +00731 ** SET L205-TYPE-TEXT-88 (21) TO TRUE. DTSZX550 +00732 ** DISPLAY 'NANCY '. CL*31 +00733 P1100H-EXIT. DTSZX550 +00734 EXIT. DTSZX550 +00735 DTSZX550 +00736 P1100I-WAGE. DTSZX550 +00737 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*10 +00738 INITIALIZE X144-REC. DTSZX550 +00739 MOVE +10 TO L205-LAST-FIELD. DTSZX550 +00740 MOVE +14 TO L205-LAST-FIELD-LEN. DTSZX550 +00741 DTSZX550 +00742 MOVE +3 TO L205-FIELD-LENGTH (1). DTSZX550 +00743 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSZX550 +00744 DTSZX550 +00745 MOVE +6 TO L205-FIELD-LENGTH (2). DTSZX550 +00746 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSZX550 +00747 DTSZX550 +00748 MOVE +4 TO L205-FIELD-LENGTH (3). DTSZX550 +00749 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSZX550 +00750 DTSZX550 +00751 MOVE +1 TO L205-FIELD-LENGTH (4). DTSZX550 +00752 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSZX550 +00753 DTSZX550 +00754 MOVE +8 TO L205-FIELD-LENGTH (5). DTSZX550 +00755 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSZX550 +00756 DTSZX550 +00757 MOVE +9 TO L205-FIELD-LENGTH (6). DTSZX550 +00758 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSZX550 +00759 DTSZX550 +00760 MOVE +30 TO L205-FIELD-LENGTH (7). DTSZX550 +00761 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSZX550 +00762 DTSZX550 +00763 MOVE +30 TO L205-FIELD-LENGTH (8). DTSZX550 +00764 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSZX550 +00765 DTSZX550 +00766 MOVE +1 TO L205-FIELD-LENGTH (9). DTSZX550 +00767 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSZX550 +00768 DTSZX550 +00769 MOVE +14 TO L205-FIELD-LENGTH (10). DTSZX550 +00770 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSZX550 +00771 P1100I-EXIT. DTSZX550 +00772 EXIT. DTSZX550 +00773 DTSZX550 +00774 P1100J-PAY. DTSZX550 +00775 * DISPLAY 'P1100J-PAY ' WEB-IMP-REC(1:84). CL*10 +00776 INITIALIZE X145-REC. DTSZX550 +00777 MOVE +12 TO L205-LAST-FIELD. DTSZX550 +00778 MOVE +8 TO L205-LAST-FIELD-LEN. DTSZX550 +00779 DTSZX550 +00780 MOVE +3 TO L205-FIELD-LENGTH (1). DTSZX550 +00781 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSZX550 +00782 DTSZX550 +00783 MOVE +6 TO L205-FIELD-LENGTH (2). DTSZX550 +00784 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSZX550 +00785 DTSZX550 +00786 MOVE +6 TO L205-FIELD-LENGTH (3). DTSZX550 +00787 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSZX550 +00788 DTSZX550 +00789 MOVE +6 TO L205-FIELD-LENGTH (4). DTSZX550 +00790 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSZX550 +00791 DTSZX550 +00792 MOVE +3 TO L205-FIELD-LENGTH (5). DTSZX550 +00793 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSZX550 +00794 DTSZX550 +00795 MOVE +2 TO L205-FIELD-LENGTH (6). DTSZX550 +00796 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSZX550 +00797 DTSZX550 +00798 MOVE +2 TO L205-FIELD-LENGTH (7). DTSZX550 +00799 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSZX550 +00800 DTSZX550 +00801 MOVE +2 TO L205-FIELD-LENGTH (8). DTSZX550 +00802 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSZX550 +00803 DTSZX550 +00804 MOVE +14 TO L205-FIELD-LENGTH (9). DTSZX550 +00805 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSZX550 +00806 DTSZX550 +00807 MOVE +10 TO L205-FIELD-LENGTH (10). DTSZX550 +00808 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSZX550 +00809 DTSZX550 +00810 MOVE +10 TO L205-FIELD-LENGTH (11). DTSZX550 +00811 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSZX550 +00812 DTSZX550 +00813 MOVE +8 TO L205-FIELD-LENGTH (12). DTSZX550 +00814 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSZX550 +00815 DTSZX550 +00816 DTSZX550 +00817 P1100J-EXIT. DTSZX550 +00818 EXIT. DTSZX550 +00819 DTSZX550 +00820 CL*85 +00821 P1100X-AWAGE. CL*85 +00822 * DISPLAY 'P1100I-WAGE ' WEB-IMP-REC(1:126). CL*85 +00823 INITIALIZE X147-REC. CL*85 +00824 MOVE +10 TO L205-LAST-FIELD. CL*85 +00825 MOVE +14 TO L205-LAST-FIELD-LEN. CL*85 +00826 CL*85 +00827 MOVE +3 TO L205-FIELD-LENGTH (1). CL*85 +00828 SET L205-TYPE-TEXT-88 (1) TO TRUE. CL*85 +00829 CL*85 +00830 MOVE +6 TO L205-FIELD-LENGTH (2). CL*85 +00831 SET L205-TYPE-TEXT-88 (2) TO TRUE. CL*85 +00832 CL*85 +00833 MOVE +4 TO L205-FIELD-LENGTH (3). CL*85 +00834 SET L205-TYPE-TEXT-88 (3) TO TRUE. CL*85 +00835 CL*85 +00836 MOVE +1 TO L205-FIELD-LENGTH (4). CL*85 +00837 SET L205-TYPE-TEXT-88 (4) TO TRUE. CL*85 +00838 CL*85 +00839 MOVE +8 TO L205-FIELD-LENGTH (5). CL*85 +00840 SET L205-TYPE-TEXT-88 (5) TO TRUE. CL*85 +00841 CL*85 +00842 MOVE +9 TO L205-FIELD-LENGTH (6). CL*85 +00843 SET L205-TYPE-TEXT-88 (6) TO TRUE. CL*85 +00844 CL*85 +00845 MOVE +30 TO L205-FIELD-LENGTH (7). CL*85 +00846 SET L205-TYPE-TEXT-88 (7) TO TRUE. CL*85 +00847 CL*85 +00848 MOVE +30 TO L205-FIELD-LENGTH (8). CL*85 +00849 SET L205-TYPE-TEXT-88 (8) TO TRUE. CL*85 +00850 CL*85 +00851 MOVE +1 TO L205-FIELD-LENGTH (9). CL*85 +00852 SET L205-TYPE-TEXT-88 (9) TO TRUE. CL*85 +00853 CL*85 +00854 MOVE +14 TO L205-FIELD-LENGTH (10). CL*85 +00855 SET L205-TYPE-NUMBER-88 (10) TO TRUE. CL*85 +00856 P1100X-EXIT. CL*85 +00857 EXIT. CL*85 +00858 CL*85 +00859 DTSZX550 +00860 P1200-BUILD-SORT-REC. DTSZX550 +00861 MOVE LOW-VALUES TO SORT-REC. DTSZX550 +00862 MOVE WEB-IMP-EMP-NO TO SORT-EMP-NO. DTSZX550 +00863 DTSZX550 +00864 EVALUATE TRUE DTSZX550 +00865 DTSZX550 +00866 WHEN WEB-IMP-TYPE-RPT-88 DTSZX550 +00867 PERFORM P1200H-RPT THRU P1200H-EXIT CL*33 +00868 MOVE +20 TO SORT-SEQ1 CL*33 +00869 MOVE X140-QUARTER TO SORT-SEQ2 CL*56 +00870 * STRING CL*56 +00871 * X140-QUARTER '0' DELIMITED BY SIZE CL*56 +00872 * INTO SORT-SEQ2 CL*56 +00873 * END-STRING CL*56 +00874 * END-IF CL*35 +00875 MOVE X140-REC TO SORT-DATA CL*36 +00876 DTSZX550 +00877 WHEN WEB-IMP-TYPE-WAGE-88 DTSZX550 +00878 PERFORM P1200I-WAGE THRU P1200I-EXIT DTSZX550 +00879 MOVE +21 TO SORT-SEQ1 CL*61 +00880 MOVE X144-QUARTER TO SORT-SEQ2 CL*61 +00881 * STRING CL*61 +00882 * X140-QUARTER '1' CL*61 +00883 * DELIMITED BY SIZE CL*61 +00884 * INTO CL*61 +00885 * SORT-SEQ2 CL*61 +00886 * END-STRING CL*61 +00887 MOVE X144-REC TO SORT-DATA CL*36 +00888 DTSZX550 +00889 CL*85 +00890 WHEN WEB-IMP-TYPE-AWAGE-88 CL*85 +00891 PERFORM P1200X-AWAGE THRU P1200X-EXIT CL*86 +00892 MOVE +21 TO SORT-SEQ1 CL*85 +00893 MOVE X144-QUARTER TO SORT-SEQ2 CL*85 +00894 * STRING CL*85 +00895 * X140-QUARTER '1' CL*85 +00896 * DELIMITED BY SIZE CL*85 +00897 * INTO CL*85 +00898 * SORT-SEQ2 CL*85 +00899 * END-STRING CL*85 +00900 MOVE X147-REC TO SORT-DATA CL*85 +00901 CL*85 +00902 ************************************************************ CL*23 +00903 * CHANGED SORT SEQ FOR PAYMENT RECORDS FROM 30 TO 19 DUE TO ESSP CL*23 +00904 * REPORTS X140 CANNOT BE PROCESSED WITHOUT A PAYMENT TRANSACTION CL*23 +00905 * UNLESS IT IS A 0 WAGE REPORT = REMIT AMOUNT = 0 CL*23 +00906 ************************************************************ CL*23 +00907 CL*23 +00908 WHEN WEB-IMP-TYPE-PAY-88 DTSZX550 +00909 PERFORM P1200J-PAY THRU P1200J-EXIT DTSZX550 +00910 MOVE +19 TO SORT-SEQ1 CL*23 +00911 MOVE X145-QTR TO SORT-SEQ2 CL*56 +00912 MOVE X145-REC TO SORT-DATA DTSZX550 +00913 ** DISPLAY 'P2 PAY ' X145-REC DTSZX550 +00914 DTSZX550 +00915 DTSZX550 +00916 END-EVALUATE. DTSZX550 +00917 DTSZX550 +00918 RELEASE SORT-REC. DTSZX550 +00919 DTSZX550 +00920 P1200-EXIT. DTSZX550 +00921 EXIT. DTSZX550 +00922 DTSZX550 +00923 P1200H-RPT. DTSZX550 +00924 * DISPLAY '01200H-RPT ' CL**9 +00925 INITIALIZE X140-REC. CL*84 +00926 MOVE WEB-IMP-REC TO W140-REC. CL*82 +00927 DTSZX550 +00928 MOVE W140-REC-TYPE TO X140-REC-TYPE. CL*73 +00929 * DISPLAY 'X140-REC-TYPE' X140-REC-TYPE CL**9 +00930 DTSZX550 +00931 MOVE W140-EMP-NO TO X140-EMP-NO. CL*73 +00932 DISPLAY 'X140-EMP-NO ' X140-EMP-NO CL*62 +00933 DTSZX550 +00934 MOVE W140-QUARTER-YR TO X140-QUARTER(1:04). CL*73 +00935 MOVE '/' TO X140-QUARTER(5:01). DTSZX550 +00936 MOVE W140-QUARTER-Q TO X140-QUARTER(6:01). CL*76 +00937 DISPLAY 'X140 QTR' X140-QUARTER. CL*56 +00938 DTSZX550 +00939 MOVE '00' TO X140-SOURCE. DTSZX550 +00940 ** DISPLAY 'X140-EMP-NO ' X140-EMP-NO DTSZX550 +00941 DTSZX550 +00942 IF W140-REPORT-TYPE = ZERO CL*73 +00943 MOVE 'OR' TO X140-REPORT-TYPE DTSZX550 +00944 ELSE DTSZX550 +00945 MOVE 'EA' TO X140-REPORT-TYPE DTSZX550 +00946 END-IF. DTSZX550 +00947 CL*90 +00948 IF W140-AMEND-TYPE > ZERO CL*90 +00949 MOVE 'EA' TO X140-REPORT-TYPE CL*91 +00950 END-IF. CL*90 +00951 DTSZX550 +00952 MOVE W140-WRKR-CNT-TOTAL TO X140-WRKR-CNT-TOTAL. CL*74 +00953 * DISPLAY 'L205-TEXT (6) (2:07) ' L205-TEXT (6) (2:07) CL*53 +00954 DTSZX550 +00955 MOVE ZEROS TO X140-PSEUDO-BATCH-NO. DTSZX550 +00956 ** DISPLAY 'X140-PSEUDO-BATCH-NO ' X140-PSEUDO-BATCH-NO DTSZX550 +00957 DTSZX550 +00958 MOVE ZEROS TO X140-PSEUDO-ITEM-NO. DTSZX550 +00959 ** DISPLAY 'X140-PSEUDO-ITEM-NO ' X140-PSEUDO-ITEM-NO DTSZX550 +00960 DTSZX550 +00961 * MOVE L205-INTEGER (8) TO W-INTEGER. CL*66 +00962 * MOVE L205-FRACTION (8) TO W-FRACTION. CL*66 +00963 * COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*66 +00964 * MOVE L205-TYPE-NUMBER-88 (8) Z-INT-X CL*74 +00965 * MOVE Z-INT-X TO AMT-DISP1. CL*74 +00966 * DISPLAY 'ZINTX ' AMT-DISP1 CL*74 +00967 * MOVE Z-INT-9 TO AMT-DISP1. CL*74 +00968 * DISPLAY 'ZINT9 ' AMT-DISP1 CL*74 +00969 * MOVE Z-INT-X TO X140-TAX-WAGES. CL*74 +00970 * DISPLAY 'X140-TAX-WAGES ' X140-TAX-WAGES CL*74 +00971 CL*74 +00972 CL*78 +00973 CL*78 +00974 MOVE W140-TAX-WAGES TO X140-TAX-WAGES CL*80 +00975 MOVE X140-TAX-WAGES TO W-AMT-DISP1. CL*80 +00976 DISPLAY 'TAX-WAGES ' W-AMT-DISP1 CL*80 +00977 CL*78 +00978 * MOVE L205-INTEGER (9) TO W-INTEGER. CL*66 +00979 * MOVE L205-FRACTION (9) TO W-FRACTION. CL*66 +00980 * COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*66 +00981 * MOVE L205-TYPE-NUMBER-88 (9) TO X140-TOTAL-WAGES CL*74 +00982 * MOVE W-NUMBER TO X140-TOTAL-WAGES. CL*66 +00983 * DISPLAY 'X140-TOTAL-WAGES ' X140-TOTAL-WAGES CL*80 +00984 DTSZX550 +00985 CL*80 +00986 MOVE W140-TOTAL-WAGES TO X140-TOTAL-WAGES CL*80 +00987 MOVE X140-TOTAL-WAGES TO W-AMT-DISP1. CL*80 +00988 DISPLAY 'TOTAL-WAGES ' W-AMT-DISP1 CL*80 +00989 CL*80 +00990 MOVE ZERO TO X140-CONFIRMATION. DTSZX550 +00991 DTSZX550 +00992 MOVE W140-RCVD-DATE TO X140-RCVD-DATE. CL*74 +00993 * DISPLAY 'RECV DATE ' X140-RCVD-DATE. CL**9 +00994 DTSZX550 +00995 * MOVE L205-TEXT (12) (2:07) TO X140-WRKR-CNT-1ST-MNTH. CL*74 +00996 MOVE W140-WRKR-CNT-1ST-MNTH TO X140-WRKR-CNT-1ST-MNTH CL*74 +00997 * DISPLAY 'X140-WRKR-CNT-1ST-MNTH ' X140-WRKR-CNT-1ST-MNTH CL*74 +00998 DTSZX550 +00999 * MOVE L205-TEXT (13) (2:07) TO X140-WRKR-CNT-2ND-MNTH. CL*74 +01000 MOVE W140-WRKR-CNT-2ND-MNTH TO X140-WRKR-CNT-2ND-MNTH CL*74 +01001 * DISPLAY 'X140-WRKR-CNT-2ND-MNTH ' X140-WRKR-CNT-2ND-MNTH CL*74 +01002 DTSZX550 +01003 * MOVE L205-TEXT (14) (2:07) TO X140-WRKR-CNT-3RD-MNTH. CL*74 +01004 MOVE W140-WRKR-CNT-3RD-MNTH TO X140-WRKR-CNT-3RD-MNTH CL*74 +01005 * DISPLAY 'X140-WRKR-CNT-3RD-MNTH ' X140-WRKR-CNT-3RD-MNTH CL*74 +01006 DTSZX550 +01007 CL*25 +01008 CL*82 +01009 MOVE W140-REMITTANCE TO X140-REMITTANCE CL*82 +01010 MOVE X140-REMITTANCE TO W-AMT-DISP1. CL*82 +01011 DISPLAY 'REMITTANCE ' W-AMT-DISP1 CL*82 +01012 CL*82 +01013 * MOVE L205-INTEGER (16) TO W-INTEGER. CL*82 +01014 * MOVE L205-FRACTION (16) TO W-FRACTION. CL*82 +01015 * COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. CL*82 +01016 * MOVE W-NUMBER TO X140-REMITTANCE. CL*82 +01017 * DISPLAY 'X140-REMITTANCE ' X140-REMITTANCE. CL*30 +01018 CL*25 +01019 MOVE SPACES TO X140-CHECK-SCAN-DT. DTSZX550 +01020 * DISPLAY 'X140-CHECK SCANDATE ' X140-CHECK-SCAN-DT. CL**9 +01021 DTSZX550 +01022 MOVE W140-AMEND-SEQ-NO TO X140-CHECK-SEQ-NBR. CL*93 +01023 DISPLAY 'X140-CHECK-SEQ-NBR ' X140-CHECK-SEQ-NBR CL*93 +01024 DTSZX550 +01025 MOVE 'N' TO X140-WAIVE-INTEREST. DTSZX550 +01026 * DISPLAY 'X140-WAIVE-INTEREST ' X140-WAIVE-INTEREST CL**9 +01027 DTSZX550 +01028 MOVE 'N' TO X140-WAIVE-PENALTY. DTSZX550 +01029 * DISPLAY 'X140-WAIVE-PENALTY ' X140-WAIVE-PENALTY CL**9 +01030 DTSZX550 +01031 MOVE ' ' TO X140-RESP-ACTIVITY. DTSZX550 +01032 * DISPLAY 'X140-RESP-ACTIVITY ' X140-RESP-ACTIVITY CL**9 +01033 DTSZX550 +01034 MOVE 'WEBESSP ' TO X140-RESP-OPID. DTSZX550 +01035 * DISPLAY 'X140-RESP-OPID ' X140-RESP-OPID CL**9 +01036 DTSZX550 +01037 *& DTSZX550 +01038 * DISPLAY 'BX420 P1200H: ' X140-REC. CL*30 +01039 P1200H-EXIT. DTSZX550 +01040 EXIT. DTSZX550 +01041 DTSZX550 +01042 P1200I-WAGE. DTSZX550 +01043 MOVE WEB-IMP-REC TO W144-REC. CL*50 +01044 CL*50 +01045 * DISPLAY 'WEB-REC-WORK: ' W144-REC. CL*55 +01046 MOVE W144-REC-TYPE TO X144-REC-TYPE. CL*50 +01047 DTSZX550 +01048 MOVE W144-EMP-NO TO X144-EMP-NO. CL*50 +01049 DTSZX550 +01050 DTSZX550 +01051 MOVE '/' TO W144-QUARTER-SLASH. CL*50 +01052 MOVE W144-QUARTER TO X144-QUARTER. CL*50 +01053 DTSZX550 +01054 MOVE W144-SSN TO X144-SSN. CL*50 +01055 DTSZX550 +01056 MOVE '5' TO X144-WAGE-STATUS. DTSZX550 +01057 DTSZX550 +01058 MOVE W144-LAST-NAME TO X144-LAST-NAME. CL*50 +01059 DTSZX550 +01060 MOVE W144-FIRST-NAME TO X144-FIRST-NAME. CL*50 +01061 DTSZX550 +01062 MOVE W144-MID-INIT TO X144-MID-INIT. CL*50 +01063 DTSZX550 +01064 MOVE W144-EARNINGS TO X144-EARNINGS. CL*50 +01065 DTSZX550 +01066 * DISPLAY 'W144REC: ' X144-REC. CL*55 +01067 P1200I-EXIT. DTSZX550 +01068 EXIT. DTSZX550 +01069 DTSZX550 +01070 P1200J-PAY. DTSZX550 +01071 MOVE L205-TEXT (1) (1:03) TO X145-REC-TYPE. DTSZX550 +01072 DTSZX550 +01073 MOVE L205-TEXT (2) (1:06) TO X145-EMP-NO. DTSZX550 +01074 DTSZX550 +01075 MOVE '0' TO X145-SOURCE. DTSZX550 +01076 DTSZX550 +01077 MOVE L205-TEXT (3) (1:06) TO X145-QTR. DTSZX550 +01078 DISPLAY 'X145 QTR ' X145-QTR. CL*56 +01079 DTSZX550 +01080 MOVE L205-TEXT (8) (1:02) TO X145-PAY-TYPE. DTSZX550 +01081 * DISPLAY 'X145 PAY TYPE ' X145-PAY-TYPE. CL**9 +01082 DTSZX550 +01083 MOVE L205-INTEGER (9) TO W-INTEGER. DTSZX550 +01084 MOVE L205-FRACTION (9) TO W-FRACTION. DTSZX550 +01085 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSZX550 +01086 MOVE W-NUMBER TO X145-REMITTANCE. DTSZX550 +01087 * DISPLAY 'X145 PAY AMT ' X145-REMITTANCE. CL**9 +01088 DTSZX550 +01089 MOVE L205-TEXT (10) (1:10) TO X145-RCVD-DATE. DTSZX550 +01090 * DISPLAY 'X145 PAY DATE ' X145-RCVD-DATE. CL**9 +01091 DTSZX550 +01092 MOVE L205-TEXT (12) TO W-TRACE-B. DTSZX550 +01093 MOVE W-TRACE-9 TO X145-TRACE-NO. DTSZX550 +01094 * DISPLAY 'X145 PAY NO ' X145-TRACE-NO. CL**9 +01095 DTSZX550 +01096 DTSZX550 +01097 MOVE ZEROS TO X145-PSEUDO-BATCH. DTSZX550 +01098 DTSZX550 +01099 MOVE ZEROS TO X145-PSEUDO-ITEM. DTSZX550 +01100 DTSZX550 +01101 MOVE SPACES TO X145-APPLIC-ACCT. DTSZX550 +01102 DTSZX550 +01103 MOVE SPACES TO X145-CHECK-SCAN-DT. DTSZX550 +01104 DTSZX550 +01105 MOVE ZEROS TO X145-CHECK-SEQ-NBR. DTSZX550 +01106 DTSZX550 +01107 MOVE 'N' TO X145-WAIVE-INTEREST. DTSZX550 +01108 DTSZX550 +01109 MOVE 'N' TO X145-WAIVE-PENALTY. DTSZX550 +01110 DTSZX550 +01111 MOVE 'VOL' TO X145-RESP-ACTIVITY. DTSZX550 +01112 DTSZX550 +01113 MOVE 'WEBESSP ' TO X145-RESP-OPID. DTSZX550 +01114 DTSZX550 +01115 P1200J-EXIT. DTSZX550 +01116 EXIT. DTSZX550 +01117 DTSZX550 +01118 P1200X-AWAGE. CL*86 +01119 MOVE WEB-IMP-REC TO W144-REC. CL*85 +01120 CL*85 +01121 * DISPLAY 'WEB-REC-WORK: ' W144-REC. CL*85 +01122 MOVE W144-REC-TYPE TO X147-REC-TYPE. CL*85 +01123 CL*85 +01124 MOVE W144-EMP-NO TO X147-EMP-NO. CL*85 +01125 CL*85 +01126 CL*85 +01127 MOVE '/' TO W144-QUARTER-SLASH. CL*87 +01128 MOVE W144-QUARTER TO X147-QUARTER. CL*85 +01129 CL*85 +01130 MOVE W144-SSN TO X147-SSN. CL*85 +01131 CL*85 +01132 MOVE '5' TO X147-WAGE-STATUS. CL*85 +01133 CL*85 +01134 MOVE W144-LAST-NAME TO X147-LAST-NAME. CL*85 +01135 CL*85 +01136 MOVE W144-FIRST-NAME TO X147-FIRST-NAME. CL*85 +01137 CL*85 +01138 MOVE W144-MID-INIT TO X147-MID-INIT. CL*85 +01139 CL*85 +01140 MOVE W144-EARNINGS TO X147-EARNINGS. CL*85 +01141 CL*85 +01142 * DISPLAY 'W144REC: ' X144-REC. CL*85 +01143 P1200X-EXIT. CL*86 +01144 EXIT. CL*85 +01145 CL*85 +01146 P2000-POST-SORT. DTSZX550 +01147 SET SORT-OK-88 TO TRUE. DTSZX550 +01148 DTSZX550 +01149 DISPLAY 'P2000 BEG READING SORT-FILE ' SORT-EMP-NO. CL**7 +01150 PERFORM P2100-PROCESS-SORT THRU P2100-EXIT DTSZX550 +01151 UNTIL SORT-EOF-88. DTSZX550 +01152 DTSZX550 +01153 * SET LX42-TERMINATE-88 TO TRUE CL**9 +01154 * DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-EMP-NO. CL**9 +01155 DISPLAY 'BX420 P2000 END READING SORT-FILE ' SORT-KEY ' ' CL**9 +01156 SORT-DATA (1:14). CL**7 +01157 P2000-EXIT. DTSZX550 +01158 EXIT. DTSZX550 +01159 DTSZX550 +01160 P2100-PROCESS-SORT. DTSZX550 +01161 * DISPLAY 'BX420 P2100 FIRST SORT-EMP-NO ' SORT-EMP-NO CL*38 +01162 * ' ' SORT-DATA (1:14). CL*38 +01163 RETURN SORT-FILE DTSZX550 +01164 AT END DTSZX550 +01165 SET SORT-EOF-88 TO TRUE DTSZX550 +01166 GO TO P2100-EXIT DTSZX550 +01167 END-RETURN. DTSZX550 +01168 DTSZX550 +01169 DISPLAY 'BX420 P2100 SORT-REC ' SORT-KEY ' ' CL*21 +01170 SORT-DATA (1:14). CL*21 +01171 DTSZX550 +01172 MOVE SORT-DATA TO LX42-DATA-AREA. DTSZX550 +01173 IF SORT-EMP-NO = 999999 DTSZX550 +01174 IF SORT-BATCH = W-PSEUDO-BATCH-NO DTSZX550 +01175 * DISPLAY 'BX420 NEW BATCH 999999 PROCESS' CL*53 +01176 SET LX42-PROCESS-88 TO TRUE DTSZX550 +01177 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 +01178 ELSE DTSZX550 +01179 MOVE SORT-BATCH TO W-PSEUDO-BATCH-NO DTSZX550 +01180 * DISPLAY 'BX420 NEW BATCH ' CL*53 +01181 ** PERFORM P2120-NEW-BATCH THRU P2120-EXIT DTSZX550 +01182 SET LX42-PROCESS-88 TO TRUE DTSZX550 +01183 SET LX42-ERROR-NO-88 TO TRUE DTSZX550 +01184 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01185 ** DISPLAY 'BX420 NEW BATCH 888888 PROCESS' CL*13 +01186 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 +01187 END-IF DTSZX550 +01188 ELSE CL*19 +01189 IF SORT-EMP-NO = W-EMP-NO AND SORT-PAY-QTR = W-PAY-QTR CL*57 +01190 * DISPLAY 'BX420 SORT-EMP-NO = W-EMP-NO ' CL*53 +01191 SET LX42-PROCESS-88 TO TRUE DTSZX550 +01192 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 +01193 ELSE DTSZX550 +01194 * DISPLAY 'BX420 SORT-EMP-NO < W-EMP-NO ' CL*53 +01195 MOVE SORT-EMP-NO TO W-EMP-NO DTSZX550 +01196 MOVE SORT-PAY-QTR TO W-PAY-QTR CL*57 +01197 PERFORM P2110-NEW-EMP THRU P2110-EXIT DTSZX550 +01198 SET LX42-PROCESS-88 TO TRUE DTSZX550 +01199 SET LX42-ERROR-NO-88 TO TRUE DTSZX550 +01200 SET LX42-RPT-ERROR-NO-88 TO TRUE CL*29 +01201 PERFORM P3000-PROCESS THRU P3000-EXIT DTSZX550 +01202 END-IF DTSZX550 +01203 END-IF. DTSZX550 +01204 DTSZX550 +01205 P2100-EXIT. DTSZX550 +01206 EXIT. DTSZX550 +01207 DTSZX550 +01208 P2110-NEW-EMP. DTSZX550 +01209 DTSZX550 +01210 DISPLAY 'BX420 >>>>>>>> NEW-EMP ' LX42-DATA-AREA (1:20). CL*11 +01211 DTSZX550 +01212 SET LX42-NEW-EMPLOYER-88 TO TRUE. DTSZX550 +01213 MOVE ZERO TO LX42-LAST-DETERM-EMP. DTSZX550 +01214 DTSZX550 +01215 * PERFORM S421-REGISTRATION THRU S421-EXIT. CL*63 +01216 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01217 * PERFORM S423-REPORT-WAGE THRU S423-EXIT. CL*59 +01218 * PERFORM S424-PROFILE THRU S424-EXIT. CL*63 +01219 DTSZX550 +01220 P2110-EXIT. DTSZX550 +01221 EXIT. DTSZX550 +01222 DTSZX550 +01223 P2120-NEW-BATCH. DTSZX550 +01224 *& DTSZX550 +01225 * DISPLAY 'BX420 P2120 NEW BATCH ' LX42-PSEUDO-BATCH-NO DTSZX550 +01226 * ' ' LX42-DATA-AREA (1:20). DTSZX550 +01227 *& DTSZX550 +01228 SET LX42-NEW-BATCH-88 TO TRUE. DTSZX550 +01229 DTSZX550 +01230 * PERFORM S426-HEADER THRU S426-EXIT. DTSZX550 +01231 * IF LX42-BATCH-ERR-YES-88 DTSZX550 +01232 * SET LX42-BATCH-ERROR-88 TO TRUE DTSZX550 +01233 * END-IF. DTSZX550 +01234 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01235 * PERFORM S423-PAYMENT THRU S423-EXIT. CL*23 +01236 DTSZX550 +01237 MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSZX550 +01238 MOVE ZERO TO LX42-RPT-CNT DTSZX550 +01239 LX42-RPT-REMIT-AMT DTSZX550 +01240 LX42-PAY-CNT DTSZX550 +01241 LX42-PAY-REMIT-AMT. DTSZX550 +01242 SET LX42-BATCH-ERR-NO-88 TO TRUE. DTSZX550 +01243 DTSZX550 +01244 P2120-EXIT. DTSZX550 +01245 EXIT. DTSZX550 +01246 DTSZX550 +01247 P3000-PROCESS. DTSZX550 +01248 *& DTSZX550 +01249 *& DTSZX550 +01250 **************************************************************** DTSZX550 +01251 * LX42-LAST-DETERM-EMP IS SET WHEN PROCESSING A DETERMINATION. DTSZX550 +01252 * THE EMPLOYER ACCOUNT NUMBER IS PASSED THROUGH THIS FIELD DTSZX550 +01253 * TO DTSBX422, WHICH PROCESSES REPORTS. IT IS USED DTSZX550 +01254 * TO DETERMINE WHEN TO WAIVE P & I. THE WAIVER IS AUTOMATIC DTSZX550 +01255 * FOR REPORTS WITHIN THE LAST 5 QUARTERS SUBMITTED ALONG DTSZX550 +01256 * WITH A WEB REGISTRATION. DTSZX550 +01257 **************************************************************** DTSZX550 +01258 DTSZX550 +01259 EVALUATE TRUE DTSZX550 +01260 DTSZX550 +01261 WHEN LX42-REC-TYPE-RPT-88 DTSZX550 +01262 ADD +1 TO W-140-IMP-CNT CL*38 +01263 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 +01264 CL**9 +01265 WHEN LX42-REC-TYPE-WAGE-88 DTSZX550 +01266 ADD +1 TO W-144-IMP-CNT CL*38 +01267 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*59 +01268 DTSZX550 +01269 WHEN LX42-REC-TYPE-AWAGE-88 CL*85 +01270 ADD +1 TO W-147-IMP-CNT CL*85 +01271 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*85 +01272 CL*85 +01273 WHEN LX42-REC-TYPE-PAY-88 DTSZX550 +01274 ADD +1 TO W-145-IMP-CNT CL*38 +01275 PERFORM S422-REPORT-PAYMT THRU S422-EXIT CL*23 +01276 DTSZX550 +01277 END-EVALUATE. DTSZX550 +01278 DTSZX550 +01279 P3000-EXIT. DTSZX550 +01280 EXIT. DTSZX550 +01281 DTSZX550 +01282 P3100-BATCH-NO. DTSZX550 +01283 *& IF W-PSEUDO-ITEM-NO < 999 DTSZX550 +01284 * ADD 1 TO W-PSEUDO-ITEM-NO DTSZX550 +01285 * ELSE DTSZX550 +01286 * ADD 1 TO W-PSEUDO-BATCH-NO DTSZX550 +01287 * MOVE 1 TO W-PSEUDO-ITEM-NO DTSZX550 +01288 * END-IF. DTSZX550 +01289 * DTSZX550 +01290 * MOVE W-PSEUDO-BATCH-NO TO LX42-PSEUDO-BATCH-NO. DTSZX550 +01291 *& MOVE W-PSEUDO-ITEM-NO TO LX42-PSEUDO-ITEM-NO. DTSZX550 +01292 DTSZX550 +01293 P3100-EXIT. DTSZX550 +01294 EXIT. DTSZX550 +01295 DTSZX550 +01296 DTSZX550 +01297 T0000-TERMINATE. DTSZX550 +01298 PERFORM T1000-FINAL-CALLS THRU T1000-EXIT. DTSZX550 +01299 DTSZX550 +01300 *** PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSZX550 +01301 DTSZX550 +01302 DISPLAY ' '. DTSZX550 +01303 DTSZX550 +01304 DISPLAY '*** DTSBX450 TERMINATION AMENDED RPTS *'. CL*64 +01305 DTSZX550 +01306 DISPLAY '***************************************'. CL*30 +01307 DISPLAY '*** WEB/ESSP IMPORT DRIVER COUNTS ***'. CL*38 +01308 DISPLAY '*** ***'. CL*30 +01309 DISPLAY 'TOTAL INPUT RECORDS READ: ' W-WEB-IMP-CNT. CL*38 +01310 DISPLAY ' X140 RECORDS READ: ' W-140-IMP-CNT. CL*38 +01311 DISPLAY ' X144 RECORDS READ: ' W-144-IMP-CNT. CL*38 +01312 DISPLAY ' X145 RECORDS READ: ' W-145-IMP-CNT. CL*38 +01313 DISPLAY ' X147 RECORDS READ: ' W-147-IMP-CNT. CL*63 +01314 DISPLAY ' ' CL*38 +01315 DISPLAY '*** ***'. CL*30 +01316 DISPLAY '*********** END OF RUN ****************'. CL*38 +01317 DTSZX550 +01318 CLOSE WEB-IMP-FILE. DTSZX550 +01319 *** CURR-BATCH-NO. DTSZX550 +01320 *** TEMP-BTC-FILE. DTSZX550 +01321 DTSZX550 +01322 PERFORM S910-CLOSE THRU S910-EXIT. DTSZX550 +01323 PERFORM S921-CLOSE THRU S921-EXIT. DTSZX550 +01324 PERFORM S923-CLOSE THRU S923-EXIT. DTSZX550 +01325 PERFORM S931-CLOSE THRU S931-EXIT. DTSZX550 +01326 * PERFORM S927C-CLOSE THRU S927C-EXIT. CL*44 +01327 DTSZX550 +01328 T0000-EXIT. DTSZX550 +01329 EXIT. DTSZX550 +01330 DTSZX550 +01331 T1000-FINAL-CALLS. DTSZX550 +01332 *& DTSZX550 +01333 DISPLAY 'BX420 T1000 ' LX42-DATA-AREA (1:20). CL**7 +01334 *& DTSZX550 +01335 SET LX42-TERMINATE-88 TO TRUE. DTSZX550 +01336 MOVE LOW-VALUES TO LX42-DATA-AREA. DTSZX550 +01337 DTSZX550 +01338 PERFORM S422-REPORT-PAYMT THRU S422-EXIT. CL*23 +01339 * PERFORM S423-REPORT-WAGE THRU S423-EXIT. CL*59 +01340 DTSZX550 +01341 T1000-EXIT. DTSZX550 +01342 EXIT. DTSZX550 +01343 DTSZX550 +01344 DTSZX550 +01345 S001-FROM-FED-8. DTSZX550 +01346 SET L001-FROM-FED-8 TO TRUE. DTSZX550 +01347 GO TO S001-DATE. DTSZX550 +01348 DTSZX550 +01349 S001-FROM-CAL-8. DTSZX550 +01350 SET L001-FROM-CAL-8 TO TRUE. DTSZX550 +01351 GO TO S001-DATE. DTSZX550 +01352 DTSZX550 +01353 S001-FROM-ABS-DAY. DTSZX550 +01354 SET L001-FROM-ABS-DAY TO TRUE. DTSZX550 +01355 GO TO S001-DATE. DTSZX550 +01356 DTSZX550 +01357 S001-DATE. DTSZX550 +01358 CALL 'DTSBU001' USING L001-LINK-AREA. DTSZX550 +01359 S001-EXIT. DTSZX550 +01360 EXIT. DTSZX550 +01361 DTSZX550 +01362 S003-AGENCY-DAY. DTSZX550 +01363 SET L003-AGENCY-DAY TO TRUE. DTSZX550 +01364 GO TO S003-WORK-DAY. DTSZX550 +01365 DTSZX550 +01366 S003-WORK-DAY. DTSZX550 +01367 CALL 'DTSBU003' USING L003-LINK-AREA. DTSZX550 +01368 S003-EXIT. DTSZX550 +01369 EXIT. DTSZX550 +01370 DTSZX550 +01371 S004-FROM-5. DTSZX550 +01372 SET L004-FROM-5 TO TRUE. DTSZX550 +01373 GO TO S004-YRQ. DTSZX550 +01374 DTSZX550 +01375 S004-FROM-DATE. DTSZX550 +01376 SET L004-FROM-DATE TO TRUE. DTSZX550 +01377 GO TO S004-YRQ. DTSZX550 +01378 DTSZX550 +01379 S004-FROM-ABS. DTSZX550 +01380 SET L004-FROM-ABS TO TRUE. DTSZX550 +01381 GO TO S004-YRQ. DTSZX550 +01382 DTSZX550 +01383 S004-YRQ. DTSZX550 +01384 CALL 'DTSBU004' USING L004-LINK-AREA. DTSZX550 +01385 DTSZX550 +01386 S004-EXIT. DTSZX550 +01387 EXIT. DTSZX550 +01388 DTSZX550 +01389 S005-FROM-SYS. DTSZX550 +01390 SET L005-FROM-SYS TO TRUE. DTSZX550 +01391 GO TO S005-ABSTIME. DTSZX550 +01392 DTSZX550 +01393 S005-ABSTIME. DTSZX550 +01394 CALL 'DTSBU005' USING L005-LINK-AREA. DTSZX550 +01395 S005-EXIT. DTSZX550 +01396 EXIT. DTSZX550 +01397 DTSZX550 +01398 DTSZX550 +01399 S422-REPORT-PAYMT. CL*23 +01400 * DISPLAY 'CALL S422-REPORTS- WAGES AND PAYMENTS'. CL*88 +01401 CALL 'DTSZX551' USING LX42-LINK-AREA. CL*92 +01402 S422-EXIT. DTSZX550 +01403 EXIT. DTSZX550 +01404 DTSZX550 +01405 *S423-REPORT-WAGE. CL*59 +01406 * DISPLAY 'CALL S423-RPT-WAGES'. CL*59 +01407 * CALL 'DTSBX423' USING LX42-LINK-AREA. CL*59 +01408 *S423-EXIT. CL*59 +01409 * EXIT. CL*59 +01410 DTSZX550 +01411 DTSZX550 +01412 S426-HEADER. DTSZX550 +01413 CALL 'DTSBX426' USING LX42-LINK-AREA. DTSZX550 +01414 S426-EXIT. DTSZX550 +01415 EXIT. DTSZX550 +01416 DTSZX550 +01417 DTSZX550 +01418 S910-OPEN-READ. DTSZX550 +01419 SET L910-OPEN-READ-88 TO TRUE. DTSZX550 +01420 GO TO S910-MSTR-IO. DTSZX550 +01421 DTSZX550 +01422 S910-OPEN-UPDATE. DTSZX550 +01423 SET L910-OPEN-UPDATE-88 TO TRUE. DTSZX550 +01424 GO TO S910-MSTR-IO. DTSZX550 +01425 DTSZX550 +01426 S910-READ. DTSZX550 +01427 SET L910-READ-88 TO TRUE. DTSZX550 +01428 GO TO S910-MSTR-IO. DTSZX550 +01429 DTSZX550 +01430 S910-START-BROWSE. DTSZX550 +01431 SET L910-START-BROWSE-88 TO TRUE. DTSZX550 +01432 GO TO S910-MSTR-IO. DTSZX550 +01433 DTSZX550 +01434 S910-READ-NEXT. DTSZX550 +01435 SET L910-READ-NEXT-88 TO TRUE. DTSZX550 +01436 GO TO S910-MSTR-IO. DTSZX550 +01437 DTSZX550 +01438 S910-CLOSE. DTSZX550 +01439 SET L910-CLOSE-88 TO TRUE. DTSZX550 +01440 GO TO S910-MSTR-IO. DTSZX550 +01441 DTSZX550 +01442 S910-MSTR-IO. DTSZX550 +01443 CALL 'DTSBU910' USING L910-LINK-AREA DTSZX550 +01444 MSKL-REC. DTSZX550 +01445 S910-EXIT. DTSZX550 +01446 EXIT. DTSZX550 +01447 DTSZX550 +01448 S921-OPEN-READ. DTSZX550 +01449 SET L921-OPEN-READ-88 TO TRUE. DTSZX550 +01450 GO TO S921-AIX-IO. DTSZX550 +01451 DTSZX550 +01452 S921-READ. DTSZX550 +01453 SET L921-READ-88 TO TRUE. DTSZX550 +01454 GO TO S921-AIX-IO. DTSZX550 +01455 DTSZX550 +01456 S921-START-BROWSE. DTSZX550 +01457 SET L921-START-BROWSE-88 TO TRUE. DTSZX550 +01458 GO TO S921-AIX-IO. DTSZX550 +01459 DTSZX550 +01460 S921-READ-NEXT. DTSZX550 +01461 SET L921-READ-NEXT-88 TO TRUE. DTSZX550 +01462 GO TO S921-AIX-IO. DTSZX550 +01463 DTSZX550 +01464 S921-CLOSE. DTSZX550 +01465 SET L921-CLOSE-88 TO TRUE. DTSZX550 +01466 GO TO S921-AIX-IO. DTSZX550 +01467 DTSZX550 +01468 S921-AIX-IO. DTSZX550 +01469 CALL 'DTSBU921' USING L921-LINK-AREA DTSZX550 +01470 ISKL-REC. DTSZX550 +01471 S921-EXIT. DTSZX550 +01472 EXIT. DTSZX550 +01473 DTSZX550 +01474 S923-OPEN-UPDATE. DTSZX550 +01475 SET L923-OPEN-UPDATE-88 TO TRUE. DTSZX550 +01476 GO TO S923-ATC-CALL. DTSZX550 +01477 DTSZX550 +01478 S923-OPEN-READ. DTSZX550 +01479 SET L923-OPEN-READ-88 TO TRUE. DTSZX550 +01480 GO TO S923-ATC-CALL. DTSZX550 +01481 DTSZX550 +01482 S923-WRITE. DTSZX550 +01483 SET L923-WRITE-88 TO TRUE. DTSZX550 +01484 GO TO S923-ATC-CALL. DTSZX550 +01485 DTSZX550 +01486 S923-CLOSE. DTSZX550 +01487 SET L923-CLOSE-88 TO TRUE. DTSZX550 +01488 GO TO S923-ATC-CALL. DTSZX550 +01489 DTSZX550 +01490 S923-ATC-CALL. DTSZX550 +01491 CALL 'DTSBU923' USING L923-LINK-AREA DTSZX550 +01492 ASKL-REC. DTSZX550 +01493 S923-EXIT. DTSZX550 +01494 EXIT. DTSZX550 +01495 DTSZX550 +01496 S927A-OPEN. DTSZX550 +01497 SET L927-OPEN-UPDATE-88 TO TRUE. DTSZX550 +01498 PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX550 +01499 DTSZX550 +01500 S927A-EXIT. DTSZX550 +01501 EXIT. DTSZX550 +01502 DTSZX550 +01503 S927C-CLOSE. DTSZX550 +01504 SET L927-CLOSE-88 TO TRUE. DTSZX550 +01505 PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX550 +01506 DTSZX550 +01507 S927C-EXIT. DTSZX550 +01508 EXIT. DTSZX550 +01509 DTSZX550 +01510 S927Z-IO. DTSZX550 +01511 CALL 'DTSBU927' USING L927-LINK-AREA DTSZX550 +01512 TSKL-REC. DTSZX550 +01513 S927Z-EXIT. DTSZX550 +01514 EXIT. DTSZX550 +01515 DTSZX550 +01516 S931-OPEN-READ. DTSZX550 +01517 SET L931-OPEN-READ-88 TO TRUE. DTSZX550 +01518 GO TO S931-REF-IO. DTSZX550 +01519 DTSZX550 +01520 S931-CLOSE. DTSZX550 +01521 SET L931-CLOSE-88 TO TRUE. DTSZX550 +01522 GO TO S931-REF-IO. DTSZX550 +01523 DTSZX550 +01524 S931-REF-IO. DTSZX550 +01525 CALL 'DTSBU931' USING L931-LINK-AREA DTSZX550 +01526 FSKL-REC. DTSZX550 +01527 S931-EXIT. DTSZX550 +01528 EXIT. DTSZX550 +01529 DTSZX550 +01530 S1000-READ-WEB-IMP. DTSZX550 +01531 READ WEB-IMP-FILE. DTSZX550 +01532 IF WEB-IMP-STATUS-OK-88 DTSZX550 +01533 ADD +1 TO W-WEB-IMP-CNT DTSZX550 +01534 ELSE DTSZX550 +01535 IF WEB-IMP-STATUS-EOF-88 DTSZX550 +01536 DISPLAY 'ENE OF WEB-IMP-FILE ' WEB-IMP-STATUS CL**3 +01537 ELSE DTSZX550 +01538 DISPLAY 'CANNOT READ WEB-IMP-FILE ' WEB-IMP-STATUS DTSZX550 +01539 SET W-ERROR-YES-88 TO TRUE DTSZX550 +01540 END-IF DTSZX550 +01541 END-IF. DTSZX550 +01542 DTSZX550 +01543 * DISPLAY 'S1000-READ WEB ' WEB-IMP-TYPE ' ' WEB-IMP-EMP-NO. CL*12 +01544 DTSZX550 +01545 S1000-EXIT. DTSZX550 +01546 EXIT. DTSZX550 +01547 DTSZX550 +01548 S999-ABEND. DTSZX550 +01549 CALL 'DTSBU999' USING W-ABEND-CD. DTSZX550 +01550 S999-EXIT. DTSZX550 +01551 EXIT. DTSZX550 +01552 DTSZX550 diff --git a/Batch/DTSZX551.cob b/Batch/DTSZX551.cob new file mode 100644 index 0000000..8d6be0c --- /dev/null +++ b/Batch/DTSZX551.cob @@ -0,0 +1,3306 @@ +00001 IDENTIFICATION DIVISION. 07/03/24 +00002 PROGRAM-ID. DTSZX551. DTSZX551 +00003 AUTHOR. NGC. LV024 +00004 DATE-WRITTEN. APRIL 2005. DTSZX551 +00005 DATE-COMPILED. DTSZX551 +00006 SKIP3 DTSZX551 +00007 ***** DTSZX551 +00008 * DTSZX551 +00009 * >>> PROCESSING FOR WEB REPORTS AND WAGES FOR AMENDED REPORTS CL*17 +00010 * >>> MODIFIED TO CREATE BATCH AND ITEM NUMBERS. THEY DTSZX551 +00011 * >>> WILL EITHER BE GROUPED INTO ACCOUNTING BATCHES DTSZX551 +00012 * >>> IN THE WEB APPLICATION, OR CONTINUE TO GO THROUGH DTSZX551 +00013 * >>> DTSBD140. MOVED AMENDMENT SEQ NUMBER TO T28 LOG NO FOR CL*17 +00014 * >>> CORRECT SORT PROCESSING. CL*17 +00015 * CL*17 +00016 * FUNCTION: EDIT REPORT DATA FROM WEB APPLICATION. DTSZX551 +00017 * DTSZX551 +00018 * MODIFICATION HISTORY: DTSZX551 +00019 * DTSZX551 +00020 * 04-05-2005 INITIAL DEVELOPMENT DTSZX551 +00021 * REFERENCE RFP: WEB REPORTING DTSZX551 +00022 * DTSZX551 +00023 * 10-21-2008 MODIFIED FOR NEW VERSION OF DTSIX144. DTSZX551 +00024 * NEW RECORD INCLUDES EMPLOYEE NAME. DTSZX551 +00025 * REFERENCE RFP: WEB REPORTING. DTSZX551 +00026 * DTSZX551 +00027 * DTSZX551 +00028 * 10-21-2009 MODIFIED TO SEPARATE REPORT PROCESSING FROM DTSZX551 +00029 * NEW WAGE-ONLY PROCESSING. P5000 CHANGED TO DTSZX551 +00030 * DETERMINE WHETHER ONLY WAGES OR WAGES DTSZX551 +00031 * ASSOCIATED WITH A REPORT ARE PRESENT. DTSZX551 +00032 * IF ONLY WAGES ARE PRESENT, COPY THE DTSZX551 +00033 * TEMPORARY WAGE FILE TO THE OUTPUT WAGE FILE. DTSZX551 +00034 * IF PROCESSING A REPORT, VERIFY THAT THE REPORTED DTSZX551 +00035 * AMOUNTS MATCH THE CALCULATED AMOUNTS, AND COPY DTSZX551 +00036 * BOTH THE REPORT AND WAGE TEMPORARY FILES DTSZX551 +00037 * TO THE OUTPUT. DTSZX551 +00038 * REFERENCE RFP: MAG MEDIA WAGE ONLY GD DTSZX551 +00039 * DTSZX551 +00040 * 06-09-2010 MODIFIED FOR IN-HOUSE CASHIERING. DTSZX551 +00041 * REFERENCE RFP: IN-HOUSE CASHIERING GD DTSZX551 +00042 * DTSZX551 +00043 * 11-10-2010 MODIFIED FOR WEB REPORTING. GD DTSZX551 +00044 * DTSZX551 +00045 * DTSZX551 +00046 * DTSZX551 +00047 * 12-05-2016 MODIFIED PROGRAM TO WRITE T28 RECORDS WITH CL*17 +00048 * THE AMENDMENT SEQ NUMBER MOVED TO T28-LOG-NO CL*17 +00049 * FOR PROPER SORT AND PROCESSING BY BD140. CL*17 +00050 ***** DTSZX551 +00051 SKIP3 DTSZX551 +00052 ENVIRONMENT DIVISION. DTSZX551 +00053 DTSZX551 +00054 CONFIGURATION SECTION. DTSZX551 +00055 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSZX551 +00056 DTSZX551 +00057 INPUT-OUTPUT SECTION. DTSZX551 +00058 DTSZX551 +00059 FILE-CONTROL. DTSZX551 +00060 DTSZX551 +00061 SELECT TEMP-BTC-FILE ASSIGN TO X451BTC DTSZX551 +00062 FILE STATUS IS TEMP-BTC-STATUS. DTSZX551 +00063 DTSZX551 +00064 SELECT PEND-X140-FILE ASSIGN TO PENDX140 DTSZX551 +00065 FILE STATUS IS REPT-140-STATUS. DTSZX551 +00066 DTSZX551 +00067 SELECT PEND-X144-FILE ASSIGN TO PENDX144 DTSZX551 +00068 FILE STATUS IS WAGE-144-STATUS. DTSZX551 +00069 DTSZX551 +00070 SELECT PEND-X147-FILE ASSIGN TO PENDX147 DTSZX551 +00071 FILE STATUS IS WAGE-144-STATUS. DTSZX551 +00072 DTSZX551 +00073 SELECT PEND-X145-FILE ASSIGN TO PENDX145 DTSZX551 +00074 FILE STATUS IS PAYT-145-STATUS. DTSZX551 +00075 DTSZX551 +00076 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSZX551 +00077 FILE STATUS IS WAGE-TEMP-STATUS. DTSZX551 +00078 DTSZX551 +00079 SELECT WAGE-FILE-OUT ASSIGN TO DTSFW4GE DTSZX551 +00080 FILE STATUS IS WAGE-OUT-STATUS. DTSZX551 +00081 DTSZX551 +00082 SELECT BATCH-XREF-FILE ASSIGN TO BX214422 DTSZX551 +00083 FILE STATUS IS BATCH-XREF-STATUS. DTSZX551 +00084 DTSZX551 +00085 SELECT REPT-PAID-FILE ASSIGN TO X451RPT1 DTSZX551 +00086 FILE STATUS IS REPT-STATUS. DTSZX551 +00087 DTSZX551 +00088 SELECT REPT-PEND-FILE ASSIGN TO X451RPT2 DTSZX551 +00089 FILE STATUS IS REPT-STATUS. DTSZX551 +00090 DTSZX551 +00091 DTSZX551 +00092 DATA DIVISION. DTSZX551 +00093 DTSZX551 +00094 FILE SECTION. DTSZX551 +00095 DTSZX551 +00096 FD TEMP-BTC-FILE DTSZX551 +00097 RECORDING MODE IS V DTSZX551 +00098 BLOCK CONTAINS 0 RECORDS. DTSZX551 +00099 DTSZX551 +00100 01 TEMP-BTC-REC. DTSZX551 +00101 ++INCLUDE DTSIRVAR DTSZX551 +00102 DTSZX551 +00103 01 TSKL-REC. DTSZX551 +00104 ++INCLUDE DTSITSKL DTSZX551 +00105 DTSZX551 +00106 FD WAGE-FILE-TEMP DTSZX551 +00107 RECORDING MODE IS F DTSZX551 +00108 BLOCK CONTAINS 0 RECORDS DTSZX551 +00109 LABEL RECORDS ARE OMITTED. DTSZX551 +00110 DTSZX551 +00111 01 WAGE-TEMP-REC PIC X(128). DTSZX551 +00112 DTSZX551 +00113 FD WAGE-FILE-OUT DTSZX551 +00114 RECORDING MODE IS F DTSZX551 +00115 BLOCK CONTAINS 0 RECORDS DTSZX551 +00116 LABEL RECORDS ARE OMITTED. DTSZX551 +00117 DTSZX551 +00118 01 WAGE-OUT-REC PIC X(80). DTSZX551 +00119 DTSZX551 +00120 FD BATCH-XREF-FILE DTSZX551 +00121 RECORDING MODE IS F DTSZX551 +00122 BLOCK CONTAINS 0 RECORDS DTSZX551 +00123 LABEL RECORDS ARE OMITTED. DTSZX551 +00124 DTSZX551 +00125 01 BATCH-XREF-REC PIC X(30). DTSZX551 +00126 DTSZX551 +00127 DTSZX551 +00128 FD PEND-X140-FILE DTSZX551 +00129 RECORDING MODE IS F DTSZX551 +00130 BLOCK CONTAINS 0 RECORDS DTSZX551 +00131 LABEL RECORDS ARE OMITTED. DTSZX551 +00132 DTSZX551 +00133 01 PEND-X140-REC PIC X(512). DTSZX551 +00134 DTSZX551 +00135 FD PEND-X144-FILE DTSZX551 +00136 RECORDING MODE IS F DTSZX551 +00137 BLOCK CONTAINS 0 RECORDS DTSZX551 +00138 LABEL RECORDS ARE OMITTED. DTSZX551 +00139 DTSZX551 +00140 01 PEND-X144-REC PIC X(512). DTSZX551 +00141 DTSZX551 +00142 FD PEND-X145-FILE DTSZX551 +00143 RECORDING MODE IS F DTSZX551 +00144 BLOCK CONTAINS 0 RECORDS DTSZX551 +00145 LABEL RECORDS ARE OMITTED. DTSZX551 +00146 DTSZX551 +00147 01 PEND-X145-REC PIC X(512). DTSZX551 +00148 DTSZX551 +00149 FD REPT-PAID-FILE DTSZX551 +00150 RECORDING MODE IS F DTSZX551 +00151 BLOCK CONTAINS 0 RECORDS DTSZX551 +00152 LABEL RECORDS ARE OMITTED. DTSZX551 +00153 DTSZX551 +00154 01 REPT-PAID-REC PIC X(133). DTSZX551 +00155 DTSZX551 +00156 FD PEND-X147-FILE DTSZX551 +00157 RECORDING MODE IS F DTSZX551 +00158 BLOCK CONTAINS 0 RECORDS DTSZX551 +00159 LABEL RECORDS ARE OMITTED. DTSZX551 +00160 DTSZX551 +00161 01 PEND-X147-REC PIC X(512). DTSZX551 +00162 DTSZX551 +00163 DTSZX551 +00164 DTSZX551 +00165 FD REPT-PEND-FILE DTSZX551 +00166 RECORDING MODE IS F DTSZX551 +00167 BLOCK CONTAINS 0 RECORDS DTSZX551 +00168 LABEL RECORDS ARE OMITTED. DTSZX551 +00169 DTSZX551 +00170 01 REPT-PEND-REC PIC X(133). DTSZX551 +00171 DTSZX551 +00172 DTSZX551 +00173 WORKING-STORAGE SECTION. DTSZX551 +001735 77 PAN-VALET PICTURE X(24) VALUE '024DTSZX551 07/03/24'. DTSZX551 +00174 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX422 10/07/14'. DTSZX551 +00175 77 PAN-VALET PICTURE X(24) VALUE '047DTSBX422 09/27/14'. DTSZX551 +00176 SKIP3 DTSZX551 +00177 01 WRK-AREA. DTSZX551 +00178 05 W-ABEND-CD PIC S9(04) COMP VALUE 436. DTSZX551 +00179 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX436'.DTSZX551 +00180 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSZX551 +00181 05 WSP-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0.DTSZX551 +00182 DTSZX551 +00183 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSZX551 +00184 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSZX551 +00185 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSZX551 +00186 DTSZX551 +00187 05 WSP-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSZX551 +00188 05 WSP-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSZX551 +00189 05 WSP-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSZX551 +00190 DTSZX551 +00191 05 W-PREV-REC-TYPE PIC X(03) VALUE SPACES. DTSZX551 +00192 88 W-PREV-REC-NULL-88 VALUE 'XXX'. DTSZX551 +00193 88 W-PREV-RPT-NULL-88 VALUE 'XXX'. DTSZX551 +00194 88 W-PREV-REC-PRF-88 VALUE '102'. DTSZX551 +00195 88 W-PREV-REC-DETERM-88 VALUE '104'. DTSZX551 +00196 88 W-PREV-REC-NAME-88 VALUE '106'. DTSZX551 +00197 88 W-PREV-REC-RATE-88 VALUE '108'. DTSZX551 +00198 88 W-PREV-REC-ADDR-88 VALUE '110'. DTSZX551 +00199 88 W-PREV-REC-OPO-88 VALUE '120'. DTSZX551 +00200 88 W-PREV-REC-REL-88 VALUE '130'. DTSZX551 +00201 88 W-PREV-REC-IND-88 VALUE '132'. DTSZX551 +00202 88 W-PREV-REC-RPT-88 VALUE '140'. DTSZX551 +00203 88 W-PREV-RPT-RPT-88 VALUE '140'. DTSZX551 +00204 88 W-PREV-REC-WAGE-88 VALUE '144'. DTSZX551 +00205 88 W-PREV-RPT-WAGE-88 VALUE '144'. DTSZX551 +00206 88 W-PREV-REC-PAY-88 VALUE '145'. DTSZX551 +00207 88 W-PREV-RPT-PAY-88 VALUE '145'. DTSZX551 +00208 88 W-PREV-REC-BHDR-88 VALUE '149'. DTSZX551 +00209 DTSZX551 +00210 05 TEMP-BTC-STATUS PIC X(02). DTSZX551 +00211 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSZX551 +00212 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSZX551 +00213 DTSZX551 +00214 05 WAGE-TEMP-STATUS PIC X(02). DTSZX551 +00215 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSZX551 +00216 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSZX551 +00217 DTSZX551 +00218 05 WAGE-OUT-STATUS PIC X(02). DTSZX551 +00219 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSZX551 +00220 DTSZX551 +00221 05 BATCH-XREF-STATUS PIC X(02). DTSZX551 +00222 88 BATCH-XREF-OK-88 VALUE '00'. DTSZX551 +00223 DTSZX551 +00224 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSZX551 +00225 DTSZX551 +00226 05 WAGE-TRANS-STATUS PIC X(02). DTSZX551 +00227 88 WAGE-TRANS-FILE-OK-88 VALUE '00' '97'. DTSZX551 +00228 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DTSZX551 +00229 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DTSZX551 +00230 DTSZX551 +00231 05 REPT-140-STATUS PIC X(02). DTSZX551 +00232 88 REPT-140-OK-88 VALUE '00' '97'. DTSZX551 +00233 88 REPT-140--NO-REC-88 VALUE '10' '23'. DTSZX551 +00234 DTSZX551 +00235 05 WAGE-144-STATUS PIC X(02). DTSZX551 +00236 88 WAGE-144-OK-88 VALUE '00' '97'. DTSZX551 +00237 88 WAGE-144--NO-REC-88 VALUE '10' '23'. DTSZX551 +00238 DTSZX551 +00239 05 PAYT-145-STATUS PIC X(02). DTSZX551 +00240 88 PAYT-145-OK-88 VALUE '00' '97'. DTSZX551 +00241 88 PAYT-145-NO-REC-88 VALUE '10' '23'. DTSZX551 +00242 DTSZX551 +00243 DTSZX551 +00244 05 REPT-STATUS PIC X(02). DTSZX551 +00245 88 REPT-STATUS-OK-88 VALUE '00'. DTSZX551 +00246 88 REPT-STATUS-EOF-88 VALUE '10'. DTSZX551 +00247 DTSZX551 +00248 05 W-RPT-DUPL-IND PIC X(01) VALUE 'N'. CL**5 +00249 88 W-RPT-DUPL-YES-88 VALUE 'Y'. CL**5 +00250 88 W-RPT-DUPL-NO-88 VALUE 'N'. CL**5 +00251 DTSZX551 +00252 CL**5 +00253 05 W-RPT-ERROR-IND PIC X(01) VALUE 'N'. CL**5 +00254 88 W-RPT-ERROR-YES-88 VALUE 'Y'. CL**5 +00255 88 W-RPT-ERROR-NO-88 VALUE 'N'. CL**5 +00256 CL**5 +00257 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSZX551 +00258 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSZX551 +00259 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSZX551 +00260 DTSZX551 +00261 05 W-X145-PAYMENT-FOUND-IND PIC X(01) VALUE 'N'. DTSZX551 +00262 88 W-X145-PAYMENT-YES-88 VALUE 'Y'. DTSZX551 +00263 88 W-X145-PAYMENT-NO-88 VALUE 'N'. DTSZX551 +00264 DTSZX551 +00265 05 W-WRITE-T025-TRAN PIC X(01) VALUE 'N'. DTSZX551 +00266 88 W-WRITE-T025-TRAN-YES-88 VALUE 'Y'. DTSZX551 +00267 88 W-WRITE-T025-TRAN-NO-88 VALUE 'N'. DTSZX551 +00268 DTSZX551 +00269 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSZX551 +00270 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSZX551 +00271 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSZX551 +00272 DTSZX551 +00273 05 W-RPT-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSZX551 +00274 88 W-RPT-IN-PROGRESS-YES-88 VALUE 'Y'. DTSZX551 +00275 88 W-RPT-IN-PROGRESS-NO-88 VALUE 'N'. DTSZX551 +00276 DTSZX551 +00277 05 W-WAGE-IN-PROGRESS-IND PIC X(01) VALUE 'N'. DTSZX551 +00278 88 W-WAGE-IN-PROGRESS-YES-88 VALUE 'Y'. DTSZX551 +00279 88 W-WAGE-IN-PROGRESS-NO-88 VALUE 'N'. DTSZX551 +00280 DTSZX551 +00281 05 W-ARPT-MAX PIC S9(04) COMP VALUE +100. DTSZX551 +00282 05 W-ARPT-LAST PIC S9(04) COMP VALUE +0. DTSZX551 +00283 05 RSUB PIC S9(04) COMP VALUE +0. DTSZX551 +00284 05 W-ARPT-TABLE. DTSZX551 +00285 10 W-ARPT-ENTRY OCCURS 100 TIMES PIC X(128). DTSZX551 +00286 DTSZX551 +00287 05 W-EMP-NO PIC S9(07) COMP-3. DTSZX551 +00288 05 W-X140-DUP PIC S9(03) COMP-3 VALUE +0. DTSZX551 +00289 05 W-TRAN-CNT PIC S9(03) COMP-3 VALUE +0. DTSZX551 +00290 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSZX551 +00291 05 W-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSZX551 +00292 05 WS-T025-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSZX551 +00293 05 W-CURR-RPT-QTR PIC S9(05) COMP-3 VALUE +0. DTSZX551 +00294 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSZX551 +00295 05 W-WAIVER-QTR PIC S9(05) COMP-3 VALUE +0. DTSZX551 +00296 05 W-X140-REPORT-QTR PIC S9(05) COMP-3. DTSZX551 +00297 05 W-X145-PAYMENT-QTR PIC S9(05) COMP-3. DTSZX551 +00298 05 W-X144-WAGE-QTR PIC S9(05) COMP-3. DTSZX551 +00299 05 W-X147-WAGE-QTR PIC S9(05) COMP-3. DTSZX551 +00300 05 WRK-REPORT-QTR PIC 9(05). DTSZX551 +00301 05 W-X145-TRACE-NO PIC X(13) VALUE SPACES. DTSZX551 +00302 05 W-X145-TRACE-NO-N REDEFINES W-X145-TRACE-NO. DTSZX551 +00303 10 W-X145-TRACE-NO-A PIC 9(08). DTSZX551 +00304 10 W-X145-TRACE-NO-B PIC 9(05). DTSZX551 +00305 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 +00306 05 W-TAX-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 +00307 05 W-EXX-WAGE PIC S9(11)V99 VALUE +0. CL**3 +00308 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 +00309 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. DTSZX551 +00310 05 WS-X140-REMITTANCE PIC S9(09)V99 VALUE +0. DTSZX551 +00311 05 W-X140-REMITTANCE PIC S9(09)V99 VALUE +0. DTSZX551 +00312 05 W-X145-REMITTANCE PIC S9(09)V99 VALUE +0. DTSZX551 +00313 05 W-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. DTSZX551 +00314 05 W-X145-TOT-REMIT-AMT PIC S9(09)V99 VALUE +0. DTSZX551 +00315 05 W-X145-RECEIVED-DATE PIC S9(09) COMP-3. DTSZX551 +00316 05 W-X140-RECEIVED-DATE PIC S9(09) COMP-3. DTSZX551 +00317 05 W-ESTB-DATE PIC S9(09) COMP-3. DTSZX551 +00318 05 W-X145-DEPOSIT-DATE PIC S9(09) COMP-3. DTSZX551 +00319 05 W-CHK-SCAN-DATE PIC S9(09) COMP-3. DTSZX551 +00320 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSZX551 +00321 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSZX551 +00322 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSZX551 +00323 05 W-WRKR-CNT-TOTAL PIC S9(07) COMP-3. DTSZX551 +00324 05 W-WAGE-QTR PIC S9(05) COMP-3. DTSZX551 +00325 05 W-SSN PIC S9(09) COMP-3. DTSZX551 +00326 05 W-EARNINGS-X PIC X(12). DTSZX551 +00327 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSZX551 +00328 PIC 9(09).99. DTSZX551 +00329 05 W-EARNINGS PIC S9(09)V99. DTSZX551 +00330 05 W-WORKER-NAME. DTSZX551 +00331 10 W-WRKR-FIRST-NAME PIC X(15). DTSZX551 +00332 10 W-WRKR-MID-INIT PIC X(01). DTSZX551 +00333 10 W-WRKR-LAST-NAME PIC X(20). DTSZX551 +00334 DTSZX551 +00335 05 W-RPT-TYPE PIC X(02). DTSZX551 +00336 88 W-ORIG-88 VALUE 'OR'. DTSZX551 +00337 88 W-EMP-AMEND-88 VALUE 'EA'. DTSZX551 +00338 88 W-AUDIT-88 VALUE 'AU'. DTSZX551 +00339 88 W-FLD-SUP-88 VALUE 'FS'. DTSZX551 +00340 88 W-ADMIN-CORR-88 VALUE 'AC'. DTSZX551 +00341 88 W-ESTIM-88 VALUE 'ES'. DTSZX551 +00342 88 W-WITHDRW-88 VALUE 'WD'. DTSZX551 +00343 88 W-SUPPLEM-88 VALUE 'EA' 'AU' DTSZX551 +00344 'FS' 'AC'. DTSZX551 +00345 88 W-RPT-TYPE-VALID-88 VALUE 'OR' 'EA' 'AU' DTSZX551 +00346 'FS' 'AC' 'ES'. DTSZX551 +00347 DTSZX551 +00348 05 W-PAY-TYPE PIC X(02). DTSZX551 +00349 88 W-PAY-ORIG-88 VALUE 'OR'. DTSZX551 +00350 88 W-PAY-REG-88 VALUE 'PA'. DTSZX551 +00351 88 W-VALID-PAY-88 VALUE 'OR' 'PA'. DTSZX551 +00352 DTSZX551 +00353 DTSZX551 +00354 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSZX551 +00355 DTSZX551 +00356 05 W-MNTE-SUBJECT PIC X(40). DTSZX551 +00357 88 W-MNTE-NOT-LIAB-88 VALUE DTSZX551 +00358 'REASON FOR NOT-LIABLE DETERMINATION '. DTSZX551 +00359 88 W-MNTE-KEY-WORD-88 VALUE DTSZX551 +00360 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSZX551 +00361 88 W-MNTE-DATA-ENTRY-88 VALUE DTSZX551 +00362 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSZX551 +00363 88 W-MNTE-RELATIONSHIP-88 VALUE DTSZX551 +00364 'WEB REGISTRATION RELATED EMPLOYER '. DTSZX551 +00365 DTSZX551 +00366 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSZX551 +00367 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSZX551 +00368 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSZX551 +00369 DTSZX551 +00370 05 TSUB1 PIC S9(04) COMP. DTSZX551 +00371 05 TSUB2 PIC S9(04) COMP. DTSZX551 +00372 05 W-LAST-SPACE PIC S9(04) COMP. DTSZX551 +00373 DTSZX551 +00374 05 W-MNTE-LINE PIC X(72). DTSZX551 +00375 DTSZX551 +00376 05 W-SLASH-DATE PIC X(10). DTSZX551 +00377 05 FILLER REDEFINES W-SLASH-DATE. DTSZX551 +00378 10 W-SLASH-DT-MM PIC X(02). DTSZX551 +00379 10 FILLER PIC X(01). DTSZX551 +00380 10 W-SLASH-DT-DD PIC X(02). DTSZX551 +00381 10 FILLER PIC X(01). DTSZX551 +00382 10 W-SLASH-DT-CCYY PIC X(04). DTSZX551 +00383 DTSZX551 +00384 05 WRK-CURR-RUN-DATE PIC 9(08). DTSZX551 +00385 05 FILLER REDEFINES WRK-CURR-RUN-DATE. DTSZX551 +00386 10 WRK-CURR-CCYY PIC 9(04). DTSZX551 +00387 10 WRK-CURR-MO PIC 9(02). DTSZX551 +00388 10 WRK-CURR-DD PIC 9(02). DTSZX551 +00389 DTSZX551 +00390 05 WRK-CURR-RPT-DATE. DTSZX551 +00391 10 RPT-CURR-MO PIC 9(02). DTSZX551 +00392 10 FILLER PIC X(01) VALUE '/'. DTSZX551 +00393 10 RPT-CURR-DD PIC 9(02). DTSZX551 +00394 10 FILLER PIC X(01) VALUE '/'. DTSZX551 +00395 10 RPT-CURR-CCYY PIC 9(04). DTSZX551 +00396 DTSZX551 +00397 05 W-SLASH-QTR PIC X(06). DTSZX551 +00398 05 FILLER REDEFINES W-SLASH-QTR. DTSZX551 +00399 10 W-SLASH-QTR-CCYY PIC X(04). DTSZX551 +00400 10 FILLER PIC X(01). DTSZX551 +00401 10 W-SLASH-QTR-Q PIC X(01). DTSZX551 +00402 DTSZX551 +00403 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00404 * BATCH HEADER DTSZX551 +00405 05 W-X149-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00406 * REPORT DTSZX551 +00407 05 W-X140-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00408 05 W-X140-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00409 05 W-X140-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00410 05 W-X140-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00411 05 W-X140-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00412 05 W-X140-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00413 * EMPLOYEE WAGES DTSZX551 +00414 05 W-X144-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00415 05 W-X144-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00416 05 W-X144-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00417 05 W-X144-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00418 05 W-X144-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00419 05 W-X144-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00420 DTSZX551 +00421 * AMENDED WAGES DELETED DTSZX551 +00422 05 W-X147-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00423 05 W-X147-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00424 05 W-X147-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00425 05 W-X147-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00426 05 W-X147-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00427 05 W-X147-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00428 DTSZX551 +00429 * EMPLOYER PAYMENT DTSZX551 +00430 05 W-X145-RED-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00431 05 W-X145-DUP-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00432 05 W-X145-ERR-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00433 05 W-X145-PEN-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00434 05 W-X145-PRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00435 05 W-X145-ZRO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00436 05 W-X145-SAV-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00437 * EMPLOYEE W4 COUNT DTSZX551 +00438 05 W-W4-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00439 05 W-W2-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00440 DTSZX551 +00441 ** 05 W-T027-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00442 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00443 05 W-T028-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00444 05 W-T028-WRITEE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00445 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00446 05 W-T025-WRITEO-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00447 05 W-W001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00448 05 W-ARPT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00449 05 W-BX214-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00450 DTSZX551 +00451 05 W-X140-LENGTH PIC S9(04) COMP. DTSZX551 +00452 05 W-X144-LENGTH PIC S9(04) COMP. DTSZX551 +00453 05 W-X145-LENGTH PIC S9(04) COMP. DTSZX551 +00454 05 W-X147-LENGTH PIC S9(04) COMP. DTSZX551 +00455 DTSZX551 +00456 05 W-AMT-DISP1 PIC ----------9.99. DTSZX551 +00457 05 W-AMT-DISP2 PIC ----------9.99. DTSZX551 +00458 *RW1 DTSZX551 +00459 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSZX551 +00460 05 DISPLAY-CNT PIC Z(06)9. DTSZX551 +00461 05 WRK-MPRF-EMP-NO PIC 9(06). DTSZX551 +00462 *RW2 DTSZX551 +00463 DTSZX551 +00464 01 MESSAGE-AREA. DTSZX551 +00465 *** FATAL ERRORS MSG-A DTSZX551 +00466 05 MSG-A1. DTSZX551 +00467 10 FILLER PIC X(32) DTSZX551 +00468 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSZX551 +00469 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSZX551 +00470 01 HEADER-1. DTSZX551 +00471 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00472 05 FILLER PIC X(49) VALUE '140R1'. DTSZX551 +00473 05 FILLER PIC X(60) VALUE DTSZX551 +00474 'DISTRICT OF COLUMBIA'. DTSZX551 +00475 05 FILLER PIC X(06) VALUE 'DATE:'. DTSZX551 +00476 05 HDR1-LRCM-SYS-DATE PIC X(10). DTSZX551 +00477 01 HEADER-2. DTSZX551 +00478 05 FILLER PIC X(54) VALUE SPACES. DTSZX551 +00479 05 FILLER PIC X(56) VALUE DTSZX551 +00480 'TAX DIVISION'. DTSZX551 +00481 05 FILLER PIC X(06) VALUE 'TIME:'. DTSZX551 +00482 05 HDR2-LRCM-SYS-TIME PIC X(08). DTSZX551 +00483 DTSZX551 +00484 01 HEADER-3. DTSZX551 +00485 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00486 05 FILLER PIC X(38) VALUE DTSZX551 +00487 'ROUTE TO: TAX ACCOUNTING STAFF'. DTSZX551 +00488 05 HDR3-LITERAL PIC X(43) VALUE DTSZX551 +00489 ' ESSP DAILY AMENDED REPORTS RELEASED '. CL*18 +00490 05 FILLER PIC X(28) VALUE SPACES. DTSZX551 +00491 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSZX551 +00492 05 HDR3-PAGE PIC ZZ,ZZ9. DTSZX551 +00493 DTSZX551 +00494 01 HEADER-31. DTSZX551 +00495 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00496 05 FILLER PIC X(38) VALUE DTSZX551 +00497 'ROUTE TO: TAX ACCOUNTING STAFF'. DTSZX551 +00498 05 HDR3-LITERAL PIC X(43) VALUE DTSZX551 +00499 ' ESSP DAILY AMENDED REPORTS IN ERROR '. CL*18 +00500 05 FILLER PIC X(28) VALUE SPACES. DTSZX551 +00501 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSZX551 +00502 05 HDR31-PAGE PIC ZZ,ZZ9. DTSZX551 +00503 DTSZX551 +00504 01 HEADER-4. DTSZX551 +00505 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00506 05 FILLER PIC X(132) VALUE SPACES. DTSZX551 +00507 01 HEADER-42. DTSZX551 +00508 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00509 05 FILLER PIC X(34) VALUE DTSZX551 +00510 ' '. DTSZX551 +00511 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00512 05 FILLER PIC X(25) VALUE DTSZX551 +00513 ' '. DTSZX551 +00514 05 FILLER PIC X(03) VALUE SPACES. DTSZX551 +00515 05 FILLER PIC X(43) VALUE DTSZX551 +00516 ' ESSP-CALC TPA/EMPL DIFF'. DTSZX551 +00517 05 FILLER PIC X(30) VALUE DTSZX551 +00518 ' EMPLOYEES '. DTSZX551 +00519 DTSZX551 +00520 01 HEADER-5. DTSZX551 +00521 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00522 05 FILLER PIC X(34) VALUE DTSZX551 +00523 'EMP NO NAME QTR RECV-DATE'. DTSZX551 +00524 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00525 05 FILLER PIC X(25) VALUE DTSZX551 +00526 ' TOTAL-AMT EXCESS-AMT '. DTSZX551 +00527 05 FILLER PIC X(03) VALUE SPACES. DTSZX551 +00528 05 FILLER PIC X(34) VALUE DTSZX551 +00529 ' TAX-AMT AMT-DUE PAID-AMT'. DTSZX551 +00530 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00531 05 HDR5-NAME PIC X(28) VALUE DTSZX551 +00532 '-/+ ----- MONTHLY COUNT'. DTSZX551 +00533 DTSZX551 +00534 01 HEADER-6. DTSZX551 +00535 05 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00536 05 FILLER PIC X(132) VALUE SPACES. DTSZX551 +00537 01 DETAIL-LINE-1. DTSZX551 +00538 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00539 15 X434-EMP-NO PIC 999B999 BLANK WHEN ZERO. DTSZX551 +00540 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00541 15 X434-NAME-CHECK PIC X(04) VALUE SPACES. DTSZX551 +00542 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00543 15 X434-QTR PIC X(06). DTSZX551 +00544 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00545 15 X434-RCVD-DATE PIC X(10). DTSZX551 +00546 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00547 15 X434-TOT-WAGE PIC --------9.99. DTSZX551 +00548 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00549 15 X434-EXC-WAGE PIC --------9.99. DTSZX551 +00550 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00551 15 X434-TAX-WAGE PIC --------9.99. DTSZX551 +00552 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00553 15 X434-X140-REMIT PIC -------9.99. DTSZX551 +00554 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00555 15 X434-X145-REMIT PIC -------9.99. DTSZX551 +00556 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00557 15 X434-DIFF PIC ------9.99. DTSZX551 +00558 * 15 X434-MESSAGE PIC X(20). DTSZX551 +00559 15 X434-M1-CNT PIC ZZZZZZ9. DTSZX551 +00560 15 X434-M2-CNT PIC ZZZZZZ9. DTSZX551 +00561 15 X434-M3-CNT PIC ZZZZZZ9. DTSZX551 +00562 DTSZX551 +00563 01 DETAIL-PEND-1. DTSZX551 +00564 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00565 15 P434-EMP-NO PIC 999B999 BLANK WHEN ZERO. DTSZX551 +00566 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00567 15 P434-NAME-CHECK PIC X(04) VALUE SPACES. DTSZX551 +00568 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00569 15 P434-QTR PIC X(06). DTSZX551 +00570 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00571 15 P434-RCVD-DATE PIC X(10). DTSZX551 +00572 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00573 15 P434-TOT-WAGE PIC --------9.99. DTSZX551 +00574 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00575 15 P434-EXC-WAGE PIC --------9.99. DTSZX551 +00576 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00577 15 P434-TAX-WAGE PIC --------9.99. DTSZX551 +00578 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00579 15 P434-X140-REMIT PIC --------9.99. DTSZX551 +00580 15 FILLER PIC X(01) VALUE SPACES. DTSZX551 +00581 15 P434-X145-REMIT PIC --------9.99. DTSZX551 +00582 15 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00583 15 P434-MESSAGE PIC X(30). DTSZX551 +00584 DTSZX551 +00585 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSZX551 +00586 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSZX551 +00587 DTSZX551 +00588 01 FOOTING-LINE-3. DTSZX551 +00589 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 +00590 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSZX551 +00591 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00592 05 FILLER PIC X(45) VALUE DTSZX551 +00593 'TOTAL PAYMENT RELEASED TO DUTAS '. DTSZX551 +00594 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00595 DTSZX551 +00596 01 FOOTING-LINE-4. DTSZX551 +00597 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 +00598 05 WS-X145-ERR-CNT PIC ZZ,ZZ9. DTSZX551 +00599 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00600 05 FILLER PIC X(34) VALUE DTSZX551 +00601 ' # OF PAYMENTS HAD ERRORS '. DTSZX551 +00602 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00603 DTSZX551 +00604 01 FOOTING-LINE-5. DTSZX551 +00605 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 +00606 05 WS-X145-PEN-CNT PIC ZZ,ZZ9. DTSZX551 +00607 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00608 05 FILLER PIC X(40) VALUE DTSZX551 +00609 ' # OF ZERO PAYMENTS DISCARDED '. DTSZX551 +00610 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00611 01 FOOTING-LINE-6. DTSZX551 +00612 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 +00613 05 WS-X140-RED-CNT PIC ZZ,ZZ9. DTSZX551 +00614 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00615 05 FILLER PIC X(45) VALUE DTSZX551 +00616 'TOTAL REPORT RELEASED TO DUTAS '. DTSZX551 +00617 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00618 01 FOOTING-LINE-7. DTSZX551 +00619 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 +00620 05 WS-X140-ERR-CNT PIC ZZ,ZZ9. DTSZX551 +00621 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00622 05 FILLER PIC X(34) VALUE DTSZX551 +00623 ' # OF REPORTS HAD ERRORS '. DTSZX551 +00624 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00625 DTSZX551 +00626 01 FOOTING-LINE-8. DTSZX551 +00627 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 +00628 05 WS-X140-PEN-CNT PIC ZZ,ZZ9. DTSZX551 +00629 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00630 05 FILLER PIC X(40) VALUE DTSZX551 +00631 ' # OF REPORTS DUTAS CANNOT PROCESS '. DTSZX551 +00632 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00633 DTSZX551 +00634 01 FOOTING-LINE-9. DTSZX551 +00635 05 FILLER PIC X(24) VALUE SPACES. DTSZX551 +00636 05 WS-X144-RED-CNT PIC ZZZ,ZZ9. DTSZX551 +00637 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00638 05 FILLER PIC X(45) VALUE DTSZX551 +00639 'TOTAL WAGES RELEASED TO DUTAS '. DTSZX551 +00640 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00641 01 FOOTING-LINE-10. DTSZX551 +00642 05 FILLER PIC X(24) VALUE SPACES. DTSZX551 +00643 05 WS-X144-ERR-CNT PIC ZZZ,ZZ9. DTSZX551 +00644 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00645 05 FILLER PIC X(34) VALUE DTSZX551 +00646 ' # OF WAGES HAD ERRORS '. DTSZX551 +00647 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00648 DTSZX551 +00649 01 FOOTING-LINE-11. DTSZX551 +00650 05 FILLER PIC X(24) VALUE SPACES. DTSZX551 +00651 05 WS-X144-PEN-CNT PIC ZZZ,ZZ9. DTSZX551 +00652 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00653 05 FILLER PIC X(40) VALUE DTSZX551 +00654 ' # OF WAGES DUTAS CANNOT PROCESS '. DTSZX551 +00655 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00656 01 FOOTING-LINE-12. DTSZX551 +00657 05 FILLER PIC X(19) VALUE SPACES. DTSZX551 +00658 05 WS-TOT-REMIT PIC $$$$$$$$9.99. DTSZX551 +00659 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00660 05 FILLER PIC X(45) VALUE DTSZX551 +00661 ' TOTAL PAYMENTS APPLIED TO DUTAS'. DTSZX551 +00662 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00663 DTSZX551 +00664 01 FOOTING-LINE-15. DTSZX551 +00665 05 FILLER PIC X(19) VALUE SPACES. DTSZX551 +00666 05 WS-TOT-CREDIT PIC $$$$$$$$9.99. DTSZX551 +00667 05 FILLER PIC X(02) VALUE SPACES. DTSZX551 +00668 05 FILLER PIC X(45) VALUE DTSZX551 +00669 ' TOTAL CREDITS APPLIED TO DUTAS'. DTSZX551 +00670 05 FILLER PIC X(32) VALUE SPACES. DTSZX551 +00671 DTSZX551 +00672 01 FOOTING-LINE-13. DTSZX551 +00673 05 FILLER PIC X(25) VALUE SPACES. DTSZX551 +00674 05 FILLER PIC X(67) VALUE DTSZX551 +00675 '*** END ESSP/DUTAS FINAL RPT/PAY/WAGE PROCESSING ***'. DTSZX551 +00676 01 FOOTING-LINE-14 PIC X(133) VALUE SPACES. DTSZX551 +00677 DTSZX551 +00678 01 T003-REC. DTSZX551 +00679 ++INCLUDE DTSIT003 DTSZX551 +00680 DTSZX551 +00681 01 T025-REC. DTSZX551 +00682 ++INCLUDE DTSIT025 DTSZX551 +00683 DTSZX551 +00684 *01 T027-REC. DTSZX551 +00685 *++INCLUDE DTSIT027 DTSZX551 +00686 DTSZX551 +00687 01 T028-REC. DTSZX551 +00688 ++INCLUDE DTSIT028 DTSZX551 +00689 DTSZX551 +00690 DTSZX551 +00691 01 W001-REC. DTSZX551 +00692 ++INCLUDE DTSIW001 DTSZX551 +00693 DTSZX551 +00694 01 WAGE-TRANS-AREA. DTSZX551 +00695 05 ESP-TRANSACTION-AREA PIC X(80). DTSZX551 +00696 ++INCLUDE EWGTRNW4 DTSZX551 +00697 DTSZX551 +00698 ++INCLUDE EWGTRNW2 DTSZX551 +00699 DTSZX551 +00700 DTSZX551 +00701 * ACCOUNTING BATCH HEADER DTSZX551 +00702 01 X149-REC. DTSZX551 +00703 ++INCLUDE DTSIX149 DTSZX551 +00704 DTSZX551 +00705 * REPORT DTSZX551 +00706 01 X140-REC. DTSZX551 +00707 ++INCLUDE DTSIX140 DTSZX551 +00708 DTSZX551 +00709 * EMPLOYEE WAGES DTSZX551 +00710 01 X144-REC. DTSZX551 +00711 ++INCLUDE DTSIX144 DTSZX551 +00712 DTSZX551 +00713 * EMPLOYEE AMENDED WAGES -W2 DTSZX551 +00714 01 X147-REC. DTSZX551 +00715 ++INCLUDE DTSIX147 DTSZX551 +00716 DTSZX551 +00717 * PAYMENTS DTSZX551 +00718 01 X145-REC. DTSZX551 +00719 ++INCLUDE DTSIX145 DTSZX551 +00720 DTSZX551 +00721 * BATCH - PSEUDO-BATCH XREF DTSZX551 +00722 01 X214-REC. DTSZX551 +00723 ++INCLUDE DTSIX214 DTSZX551 +00724 DTSZX551 +00725 * ERRORS DTSZX551 +00726 *01 X907-REC. DTSZX551 +00727 ***INCLUDE DTSIX907 DTSZX551 +00728 DTSZX551 +00729 01 L001-LINK-AREA. DTSZX551 +00730 ++INCLUDE DTSIL001 DTSZX551 +00731 DTSZX551 +00732 01 L003-LINK-AREA. DTSZX551 +00733 ++INCLUDE DTSIL003 DTSZX551 +00734 DTSZX551 +00735 01 L004-LINK-AREA. DTSZX551 +00736 ++INCLUDE DTSIL004 DTSZX551 +00737 DTSZX551 +00738 01 L516-LINK-AREA. DTSZX551 +00739 ++INCLUDE DTSIL516 DTSZX551 +00740 DTSZX551 +00741 01 L910-LINK-AREA. DTSZX551 +00742 ++INCLUDE DTSIL910 DTSZX551 +00743 01 MSKL-REC. DTSZX551 +00744 ++INCLUDE DTSIMSKL DTSZX551 +00745 DTSZX551 +00746 01 MHDR-REC. DTSZX551 +00747 ++INCLUDE DTSIMHDR DTSZX551 +00748 DTSZX551 +00749 01 MPRF-REC. DTSZX551 +00750 ++INCLUDE DTSIMPRF DTSZX551 +00751 DTSZX551 +00752 01 MSOL-REC. DTSZX551 +00753 ++INCLUDE DTSIMSOL DTSZX551 +00754 DTSZX551 +00755 01 MRPT-REC. DTSZX551 +00756 ++INCLUDE DTSIMRPT DTSZX551 +00757 DTSZX551 +00758 01 MQTR-REC. DTSZX551 +00759 ++INCLUDE DTSIMQTR DTSZX551 +00760 DTSZX551 +00761 01 MOPO-REC. DTSZX551 +00762 ++INCLUDE DTSIMOPO DTSZX551 +00763 DTSZX551 +00764 01 MTAD-REC. DTSZX551 +00765 ++INCLUDE DTSIMTAD DTSZX551 +00766 DTSZX551 +00767 01 MNTE-REC. DTSZX551 +00768 ++INCLUDE DTSIMNTE DTSZX551 +00769 DTSZX551 +00770 01 L921-LINK-AREA. DTSZX551 +00771 ++INCLUDE DTSIL921 DTSZX551 +00772 SKIP3 DTSZX551 +00773 01 ISKL-REC. DTSZX551 +00774 ++INCLUDE DTSIISKL DTSZX551 +00775 SKIP3 DTSZX551 +00776 01 IEIN-REC. DTSZX551 +00777 ++INCLUDE DTSIIEIN DTSZX551 +00778 DTSZX551 +00779 01 L923-LINK-AREA. DTSZX551 +00780 ++INCLUDE DTSIL923 DTSZX551 +00781 EJECT DTSZX551 +00782 01 ASKL-REC. DTSZX551 +00783 ++INCLUDE DTSIASKL DTSZX551 +00784 EJECT DTSZX551 +00785 01 AHDR-REC. DTSZX551 +00786 ++INCLUDE DTSIAHDR DTSZX551 +00787 EJECT DTSZX551 +00788 01 ARPT-REC. DTSZX551 +00789 ++INCLUDE DTSIARPT DTSZX551 +00790 EJECT DTSZX551 +00791 01 APAY-REC. DTSZX551 +00792 ++INCLUDE DTSIAPAY DTSZX551 +00793 DTSZX551 +00794 01 L927-LINK-AREA. DTSZX551 +00795 ++INCLUDE DTSIL927 DTSZX551 +00796 DTSZX551 +00797 01 L931-LINK-AREA. DTSZX551 +00798 ++INCLUDE DTSIL931 DTSZX551 +00799 DTSZX551 +00800 01 FSKL-REC. DTSZX551 +00801 ++INCLUDE DTSIFSKL DTSZX551 +00802 DTSZX551 +00803 01 R140-REC. DTSZX551 +00804 ++INCLUDE DTSIR140 DTSZX551 +00805 DTSZX551 +00806 LINKAGE DTSZX551 +00807 SECTION. DTSZX551 +00808 DTSZX551 +00809 01 LX42-LINK-AREA. DTSZX551 +00810 ++INCLUDE DTSILX42 DTSZX551 +00811 DTSZX551 +00812 PROCEDURE DIVISION USING LX42-LINK-AREA. DTSZX551 +00813 DTSZX551 +00814 DTSBX436-MAIN. DTSZX551 +00815 * DISPLAY 'LX42-LINK-AREA' LX42-LINK-AREA DTSZX551 +00816 MOVE LX42-RPT-ERROR-IND TO W-RPT-ERROR-IND. DTSZX551 +00817 DTSZX551 +00818 * IF W-RPT-ERROR-YES-88 DTSZX551 +00819 * DISPLAY 'BX436 LX42 EMP REC HAS ERROR ' LX42-EMP-NO DTSZX551 +00820 * ' ' LX42-RPT-ERROR-IND ' ' W-RPT-ERROR-IND DTSZX551 +00821 * ELSE DTSZX551 +00822 * DISPLAY 'BX436 EMP REC HAS NO ERROR ' W-RPT-ERROR-IND DTSZX551 +00823 * END-IF. DTSZX551 +00824 DTSZX551 +00825 EVALUATE TRUE DTSZX551 +00826 WHEN LX42-INITIALIZE-88 DTSZX551 +00827 PERFORM I0000-INITIATE THRU I0000-EXIT DTSZX551 +00828 DTSZX551 +00829 WHEN LX42-NEW-EMPLOYER-88 DTSZX551 +00830 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSZX551 +00831 DTSZX551 +00832 WHEN LX42-PROCESS-88 DTSZX551 +00833 PERFORM P0000-PROCESS THRU P0000-EXIT DTSZX551 +00834 DTSZX551 +00835 WHEN LX42-TERMINATE-88 DTSZX551 +00836 DISPLAY ' TERMINATE 430' DTSZX551 +00837 PERFORM P5000-NEW-EMP THRU P5000-EXIT DTSZX551 +00838 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSZX551 +00839 DTSZX551 +00840 END-EVALUATE. DTSZX551 +00841 DTSZX551 +00842 IF LX42-PROCESS-88 DTSZX551 +00843 MOVE W-RPT-ERROR-IND TO LX42-RPT-ERROR-IND DTSZX551 +00844 END-IF. DTSZX551 +00845 DTSZX551 +00846 DTSBX436-MAIN-EXIT. DTSZX551 +00847 GOBACK. DTSZX551 +00848 DTSZX551 +00849 I0000-INITIATE. DTSZX551 +00850 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 +00851 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSZX551 +00852 DTSZX551 +00853 MOVE LENGTH OF X140-REC TO W-X140-LENGTH. DTSZX551 +00854 MOVE LENGTH OF X144-REC TO W-X144-LENGTH. DTSZX551 +00855 MOVE LENGTH OF X145-REC TO W-X145-LENGTH. DTSZX551 +00856 MOVE LENGTH OF X147-REC TO W-X147-LENGTH. DTSZX551 +00857 DTSZX551 +00858 * FOR VARIABLE REPORT FILE. DTSZX551 +00859 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSZX551 +00860 MOVE '140' TO R140-REC-TYPE. DTSZX551 +00861 DTSZX551 +00862 MOVE LX42-CURR-RUN-DATE TO L004-DATE. DTSZX551 +00863 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSZX551 +00864 SUBTRACT +5 FROM L004-ABS-QTR. DTSZX551 +00865 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSZX551 +00866 MOVE L004-QTR-5-9 TO W-WAIVER-QTR. DTSZX551 +00867 DISPLAY 'BX451 CURR RUN DATE ' LX42-CURR-RUN-DATE. DTSZX551 +00868 * DISPLAY 'BX436 WAIVE QTR ' W-WAIVER-QTR. DTSZX551 +00869 DTSZX551 +00870 MOVE LX42-CURR-RUN-DATE TO WRK-CURR-RUN-DATE. DTSZX551 +00871 MOVE WRK-CURR-CCYY TO RPT-CURR-CCYY DTSZX551 +00872 MOVE WRK-CURR-MO TO RPT-CURR-MO DTSZX551 +00873 MOVE WRK-CURR-DD TO RPT-CURR-DD DTSZX551 +00874 DISPLAY 'RPT CURR RUN DATE ' WRK-CURR-RPT-DATE. DTSZX551 +00875 MOVE WRK-CURR-RPT-DATE TO HDR1-LRCM-SYS-DATE. DTSZX551 +00876 DTSZX551 +00877 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSZX551 +00878 IF W-FATAL-ERROR-YES-88 DTSZX551 +00879 GO TO I0000-EXIT DTSZX551 +00880 END-IF. DTSZX551 +00881 DTSZX551 +00882 MOVE +0 TO W-ARPT-LAST. DTSZX551 +00883 PERFORM DTSZX551 +00884 VARYING RSUB FROM +1 BY +1 DTSZX551 +00885 UNTIL RSUB > W-ARPT-MAX DTSZX551 +00886 MOVE LOW-VALUES TO W-ARPT-ENTRY (RSUB) DTSZX551 +00887 END-PERFORM. DTSZX551 +00888 DTSZX551 +00889 I0000-EXIT. DTSZX551 +00890 EXIT. DTSZX551 +00891 DTSZX551 +00892 I2000-OPEN-FILES. DTSZX551 +00893 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSZX551 +00894 IF W-FATAL-ERROR-YES-88 DTSZX551 +00895 DISPLAY 'CANNOT OPEN TEMP X436BTC FILE ' DTSZX551 +00896 TEMP-BTC-STATUS DTSZX551 +00897 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00898 END-IF. DTSZX551 +00899 DTSZX551 +00900 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSZX551 +00901 IF W-FATAL-ERROR-YES-88 DTSZX551 +00902 DISPLAY 'CANNOT OPEN WAGE TEMP FILE ' DTSZX551 +00903 WAGE-TEMP-STATUS DTSZX551 +00904 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00905 END-IF. DTSZX551 +00906 DTSZX551 +00907 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. DTSZX551 +00908 IF W-FATAL-ERROR-YES-88 DTSZX551 +00909 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' DTSZX551 +00910 WAGE-OUT-STATUS DTSZX551 +00911 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00912 END-IF. DTSZX551 +00913 DTSZX551 +00914 OPEN OUTPUT BATCH-XREF-FILE. DTSZX551 +00915 IF BATCH-XREF-OK-88 DTSZX551 +00916 NEXT SENTENCE DTSZX551 +00917 ELSE DTSZX551 +00918 DISPLAY 'CANNOT OPEN BATCH XREF FILE ' DTSZX551 +00919 BATCH-XREF-STATUS DTSZX551 +00920 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00921 END-IF. DTSZX551 +00922 DTSZX551 +00923 DTSZX551 +00924 OPEN OUTPUT PEND-X140-FILE. DTSZX551 +00925 IF REPT-140-OK-88 DTSZX551 +00926 NEXT SENTENCE DTSZX551 +00927 ELSE DTSZX551 +00928 DISPLAY 'CANNOT OPEN AMENDS X140 FILE' DTSZX551 +00929 REPT-140-STATUS DTSZX551 +00930 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00931 END-IF. DTSZX551 +00932 DTSZX551 +00933 OPEN OUTPUT PEND-X144-FILE. DTSZX551 +00934 IF WAGE-144-OK-88 DTSZX551 +00935 NEXT SENTENCE DTSZX551 +00936 ELSE DTSZX551 +00937 DISPLAY 'CANNOT OPEN AMENDS X144 FILE' DTSZX551 +00938 WAGE-144-STATUS DTSZX551 +00939 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00940 END-IF. DTSZX551 +00941 DTSZX551 +00942 DTSZX551 +00943 OPEN OUTPUT PEND-X147-FILE. DTSZX551 +00944 IF WAGE-144-OK-88 DTSZX551 +00945 NEXT SENTENCE DTSZX551 +00946 ELSE DTSZX551 +00947 DISPLAY 'CANNOT OPEN AMENDS X147 FILE' DTSZX551 +00948 WAGE-144-STATUS DTSZX551 +00949 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00950 END-IF. DTSZX551 +00951 DTSZX551 +00952 OPEN OUTPUT PEND-X145-FILE. DTSZX551 +00953 IF PAYT-145-OK-88 DTSZX551 +00954 NEXT SENTENCE DTSZX551 +00955 ELSE DTSZX551 +00956 DISPLAY 'CANNOT OPEN AMENDS X145 FILE' DTSZX551 +00957 PAYT-145-STATUS DTSZX551 +00958 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00959 END-IF. DTSZX551 +00960 DTSZX551 +00961 DTSZX551 +00962 OPEN OUTPUT REPT-PEND-FILE. DTSZX551 +00963 IF REPT-STATUS-OK-88 DTSZX551 +00964 NEXT SENTENCE DTSZX551 +00965 ELSE DTSZX551 +00966 DISPLAY 'CANNOT OPEN REPORT PENDING FILE ' DTSZX551 +00967 REPT-STATUS DTSZX551 +00968 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00969 END-IF. DTSZX551 +00970 DTSZX551 +00971 OPEN OUTPUT REPT-PAID-FILE. DTSZX551 +00972 IF REPT-STATUS-OK-88 DTSZX551 +00973 NEXT SENTENCE DTSZX551 +00974 ELSE DTSZX551 +00975 DISPLAY 'CANNOT OPEN REPORT PAID FILE ' DTSZX551 +00976 REPT-STATUS DTSZX551 +00977 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +00978 END-IF. DTSZX551 +00979 DTSZX551 +00980 I2000-EXIT. DTSZX551 +00981 EXIT. DTSZX551 +00982 DTSZX551 +00983 P0000-PROCESS. DTSZX551 +00984 DTSZX551 +00985 EVALUATE TRUE DTSZX551 +00986 WHEN LX42-REC-TYPE-PAY-88 DTSZX551 +00987 PERFORM P1000-PAYMENT THRU P1000-EXIT DTSZX551 +00988 DTSZX551 +00989 WHEN LX42-REC-TYPE-RPT-88 DTSZX551 +00990 PERFORM P2000-REPORT THRU P2000-EXIT DTSZX551 +00991 DTSZX551 +00992 WHEN LX42-REC-TYPE-WAGE-88 DTSZX551 +00993 PERFORM P3000-WAGES THRU P3000-EXIT DTSZX551 +00994 DTSZX551 +00995 WHEN LX42-REC-TYPE-AWAGE-88 DTSZX551 +00996 PERFORM P3500-WAGES THRU P3500-EXIT DTSZX551 +00997 DTSZX551 +00998 WHEN OTHER DTSZX551 +00999 DISPLAY 'DTSBX451 ABENDING - INVALID RECORD TYPE ' DTSZX551 +01000 LX42-REC-TYPE DTSZX551 +01001 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +01002 DTSZX551 +01003 END-EVALUATE. DTSZX551 +01004 DTSZX551 +01005 P0000-EXIT. DTSZX551 +01006 EXIT. DTSZX551 +01007 P1000-PAYMENT. DTSZX551 +01008 * SET W-EMP-IN-PROGRESS-YES-88 TO TRUE. DTSZX551 +01009 MOVE LX42-DATA-AREA TO X145-REC. DTSZX551 +01010 *& DTSZX551 +01011 MOVE X145-EMP-NO TO W-EMP-NO. DTSZX551 +01012 SET W-EMP-FOUND-NO-88 TO TRUE. DTSZX551 +01013 DTSZX551 +01014 ADD +1 TO W-X145-RED-CNT DTSZX551 +01015 DISPLAY SPACE. DTSZX551 +01016 DISPLAY 'BX451- NEW EMPLOYER PAYMENT ' X145-EMP-NO. DTSZX551 +01017 * DISPLAY ' X145-KEY ' X145-EMP-NO. DTSZX551 +01018 * DISPLAY 'LX145-KEY ' LX42-X145-KEY-AREA. DTSZX551 +01019 DTSZX551 +01020 * IF LX42-X145-EMP-NO = '999999' DTSZX551 +01021 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01022 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01023 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01024 * STRING DTSZX551 +01025 * 'PAYMENT CONTAINS ERRORS CANNOT PROCESS - PYMTS ' DTSZX551 +01026 * DELIMITED BY SIZE DTSZX551 +01027 * INTO R140-MESSAGE DTSZX551 +01028 * END-STRING DTSZX551 +01029 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01030 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01031 * MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 +01032 * ADD +1 TO W-X145-ERR-CNT DTSZX551 +01033 * ADD +1 TO W-X145-PEN-CNT DTSZX551 +01034 * WRITE PEND-X145-REC FROM X145-REC DTSZX551 +01035 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 +01036 * GO TO P1000-EXIT. DTSZX551 +01037 DTSZX551 +01038 DTSZX551 +01039 * IF LX42-REC-TYPE-PAY-88 DTSZX551 +01040 * IF LX42-X145-KEY-AREA = X145-EMP-NO AND DTSZX551 +01041 * LX42-X145-QTR-AREA = X145-QTR DTSZX551 +01042 * SET W-PREV-RPT-NULL-88 TO TRUE DTSZX551 +01043 * ADD +1 TO W-X145-DUP-CNT DTSZX551 +01044 * DISPLAY 'X145 DUPLICATE PAYMENT RECORD ' W-EMP-NO DTSZX551 +01045 * ' ERR IND ' W-RPT-ERROR-IND DTSZX551 +01046 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01047 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01048 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01049 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01050 * STRING DTSZX551 +01051 * ': DUPLICATE PAYMENT RECORD ----PROCESS ' DTSZX551 +01052 * DELIMITED BY SIZE DTSZX551 +01053 * INTO R140-MESSAGE DTSZX551 +01054 * END-STRING DTSZX551 +01055 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01056 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01057 * ELSE DTSZX551 +01058 * MOVE X145-EMP-NO TO LX42-X145-KEY-AREA DTSZX551 +01059 * END-IF DTSZX551 +01060 * END-IF. DTSZX551 +01061 DTSZX551 +01062 DTSZX551 +01063 MOVE X145-EMP-NO TO LX42-X145-EMP-NO. DTSZX551 +01064 MOVE X145-QTR TO LX42-X145-QTR-AREA DTSZX551 +01065 DTSZX551 +01066 * DISPLAY ' PREV REC TYPE ' W-PREV-REC-TYPE. DTSZX551 +01067 * IF W-PREV-RPT-NULL-88 OR DTSZX551 +01068 * LX42-REC-TYPE-PAY-88 DTSZX551 +01069 * SET W-PREV-RPT-PAY-88 TO TRUE DTSZX551 +01070 * SET W-PREV-REC-PAY-88 TO TRUE DTSZX551 +01071 ADD +1 TO W-X145-PRO-CNT DTSZX551 +01072 PERFORM P1110-EDIT-PAYMENT THRU P1110-EXIT DTSZX551 +01073 IF W-RPT-ERROR-NO-88 DTSZX551 +01074 PERFORM P1112-CHECK-PAYMENT THRU P1112-EXIT DTSZX551 +01075 IF W-RPT-ERROR-NO-88 DTSZX551 +01076 * DISPLAY 'X145 PAYMENT REC PASS EDITS ' W-EMP-NO DTSZX551 +01077 ADD +1 TO W-X145-SAV-CNT DTSZX551 +01078 PERFORM P1120-SAVE-PAYMENT THRU P1120-EXIT DTSZX551 +01079 ELSE DTSZX551 +01080 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 +01081 ADD +1 TO W-X145-ERR-CNT DTSZX551 +01082 ADD +1 TO W-X145-PEN-CNT DTSZX551 +01083 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01084 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 +01085 WRITE PEND-X145-REC FROM X145-REC DTSZX551 +01086 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 DTSZX551 +01087 END-IF DTSZX551 +01088 ELSE DTSZX551 +01089 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 +01090 ADD +1 TO W-X145-ERR-CNT DTSZX551 +01091 ADD +1 TO W-X145-PEN-CNT DTSZX551 +01092 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01093 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 +01094 WRITE PEND-X145-REC FROM X145-REC DTSZX551 +01095 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1 DTSZX551 +01096 END-IF. DTSZX551 +01097 DTSZX551 +01098 P1000-EXIT. DTSZX551 +01099 EXIT. DTSZX551 +01100 DTSZX551 +01101 P1110-EDIT-PAYMENT. DTSZX551 +01102 DTSZX551 +01103 MOVE X145-PAY-TYPE TO W-PAY-TYPE. DTSZX551 +01104 IF W-VALID-PAY-88 DTSZX551 +01105 NEXT SENTENCE DTSZX551 +01106 ELSE DTSZX551 +01107 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01108 MOVE SPACES TO R140-MESSAGE DTSZX551 +01109 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01110 STRING DTSZX551 +01111 ':PAY- INVALID PAYMENT TYPE ' DTSZX551 +01112 X145-PAY-TYPE DTSZX551 +01113 DELIMITED BY SIZE DTSZX551 +01114 INTO R140-MESSAGE DTSZX551 +01115 END-STRING DTSZX551 +01116 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 +01117 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01118 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01119 END-IF. DTSZX551 +01120 IF X145-QTR = SPACES DTSZX551 +01121 MOVE '2015/1' TO W-SLASH-QTR DTSZX551 +01122 ELSE DTSZX551 +01123 MOVE X145-QTR TO W-SLASH-QTR. DTSZX551 +01124 DTSZX551 +01125 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR DTSZX551 +01126 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q DTSZX551 +01127 PERFORM S004-FROM-5 THRU S004-EXIT DTSZX551 +01128 IF NOT L004-VALID-QTR DTSZX551 +01129 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01130 MOVE SPACES TO R140-MESSAGE DTSZX551 +01131 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01132 STRING DTSZX551 +01133 ':PAY- INVALID QUARTER ' W-SLASH-QTR DTSZX551 +01134 DELIMITED BY SIZE DTSZX551 +01135 INTO R140-MESSAGE DTSZX551 +01136 END-STRING DTSZX551 +01137 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01138 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 +01139 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01140 ELSE DTSZX551 +01141 MOVE L004-QTR-5-9 TO W-X145-PAYMENT-QTR DTSZX551 +01142 END-IF. DTSZX551 +01143 DTSZX551 +01144 * DISPLAY 'X145Q ' W-SLASH-QTR ' WQTR ' W-X145-PAYMENT-QTR DTSZX551 +01145 DTSZX551 +01146 MOVE X145-REMITTANCE TO W-X145-REMITTANCE. DTSZX551 +01147 * DISPLAY 'W145REMITCE ' W-X145-REMITTANCE. DTSZX551 +01148 * DISPLAY 'X145REMITCE ' X145-REMITTANCE. DTSZX551 +01149 DTSZX551 +01150 IF W-X145-REMITTANCE = ZEROS DTSZX551 +01151 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01152 ADD +1 TO W-X145-ZRO-CNT DTSZX551 +01153 MOVE SPACES TO R140-MESSAGE DTSZX551 +01154 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01155 * STRING DTSZX551 +01156 * 'X430- REVIEW REMITTANCE AMOUNT= 0 ' DTSZX551 +01157 * DELIMITED BY SIZE DTSZX551 +01158 * INTO R140-MESSAGE DTSZX551 +01159 * END-STRING DTSZX551 +01160 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01161 END-IF. DTSZX551 +01162 DTSZX551 +01163 MOVE ZEROS TO W-X145-RECEIVED-DATE DTSZX551 +01164 MOVE X145-RCVD-DATE TO W-SLASH-DATE DTSZX551 +01165 MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSZX551 +01166 MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSZX551 +01167 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSZX551 +01168 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSZX551 +01169 IF NOT L001-VALID-DATE DTSZX551 +01170 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01171 MOVE SPACES TO R140-MESSAGE DTSZX551 +01172 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01173 STRING DTSZX551 +01174 ':PAY- INVALID RECEIVED DATE ' DTSZX551 +01175 ' ' X145-RCVD-DATE DTSZX551 +01176 DELIMITED BY SIZE DTSZX551 +01177 INTO R140-MESSAGE DTSZX551 +01178 END-STRING DTSZX551 +01179 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01180 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01181 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 +01182 ELSE DTSZX551 +01183 MOVE L001-FED-8-DATE-9 TO W-X145-RECEIVED-DATE DTSZX551 +01184 END-IF. DTSZX551 +01185 DTSZX551 +01186 P1110-EXIT. DTSZX551 +01187 EXIT. DTSZX551 +01188 DTSZX551 +01189 P1112-CHECK-PAYMENT. DTSZX551 +01190 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSZX551 +01191 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSZX551 +01192 SET MPRF-PRF-88 TO TRUE. DTSZX551 +01193 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 +01194 DTSZX551 +01195 PERFORM S910-READ THRU S910-EXIT. DTSZX551 +01196 IF L910-NO-REC-88 DTSZX551 +01197 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01198 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 +01199 MOVE SPACES TO R140-MESSAGE DTSZX551 +01200 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01201 STRING DTSZX551 +01202 ':EMP NOT ON DUTAS -CANNOT PAY ' DTSZX551 +01203 X145-EMP-NO DTSZX551 +01204 DELIMITED BY SIZE DTSZX551 +01205 INTO R140-MESSAGE DTSZX551 +01206 END-STRING DTSZX551 +01207 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01208 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01209 MOVE '999999' TO LX42-X145-EMP-NO DTSZX551 +01210 ELSE DTSZX551 +01211 MOVE MSKL-REC TO MPRF-REC DTSZX551 +01212 SET W-EMP-FOUND-YES-88 TO TRUE DTSZX551 +01213 END-IF. DTSZX551 +01214 DTSZX551 +01215 P1112-EXIT. DTSZX551 +01216 EXIT. DTSZX551 +01217 DTSZX551 +01218 P1120-SAVE-PAYMENT. DTSZX551 +01219 IF W-X145-REMITTANCE = ZEROS DTSZX551 +01220 GO TO P1120-EXIT. DTSZX551 +01221 * DISPLAY ' SAVE PAYMENT RECORD ' W-EMP-NO. DTSZX551 +01222 MOVE W-X145-REMITTANCE TO W-X145-TOT-REMIT-AMT. DTSZX551 +01223 ADD W-X145-REMITTANCE TO W-TOT-REMIT-AMT. DTSZX551 +01224 ADD +1 TO W-X145-SAV-CNT. DTSZX551 +01225 PERFORM P2021-WRITE-T025 THRU P2021-EXIT. DTSZX551 +01226 P1120-EXIT. DTSZX551 +01227 EXIT. DTSZX551 +01228 DTSZX551 +01229 DTSZX551 +01230 DTSZX551 +01231 P2000-REPORT. DTSZX551 +01232 MOVE LX42-DATA-AREA TO X140-REC. DTSZX551 +01233 DTSZX551 +01234 * SET W-RPT-IN-PROGRESS-YES-88 TO TRUE DTSZX551 +01235 DTSZX551 +01236 MOVE X140-EMP-NO TO W-EMP-NO. DTSZX551 +01237 DTSZX551 +01238 ADD +1 TO W-X140-RED-CNT. DTSZX551 +01239 * DISPLAY ' PREV RPT REC TYPE ' W-PREV-REC-TYPE. DTSZX551 +01240 * IF W-PREV-RPT-NULL-88 DTSZX551 +01241 * SET W-PREV-RPT-RPT-88 TO TRUE DTSZX551 +01242 * SET W-X145-PAYMENT-NO-88 TO TRUE DTSZX551 +01243 * ELSE DTSZX551 +01244 * SET W-X145-PAYMENT-YES-88 TO TRUE DTSZX551 +01245 * END-IF. DTSZX551 +01246 DTSZX551 +01247 * IF LX42-REC-TYPE-RPT-88 CL**6 +01248 * IF LX42-X140-KEY-AREA = X140-EMP-NO AND CL**6 +01249 * LX42-X140-QTR-AREA = X140-QUARTER CL**6 +01250 * SET W-RPT-ERROR-YES-88 TO TRUE CL**6 +01251 * ADD +1 TO W-X140-DUP-CNT CL**6 +01252 * ADD +1 TO W-X140-PEN-CNT CL**6 +01253 * DISPLAY ':ERROR-RPT DUPLICATE REPORT D ' CL**6 +01254 * ' ERR IND ' W-RPT-ERROR-IND CL**6 +01255 * MOVE SPACES TO R140-MESSAGE CL**6 +01256 * MOVE W-EMP-NO TO R140-EMP-NO CL**6 +01257 * STRING CL**6 +01258 * ':RPT- DUPLICATE REPORT RECORD ' CL**6 +01259 * DELIMITED BY SIZE CL**6 +01260 * INTO R140-MESSAGE CL**6 +01261 * END-STRING CL**6 +01262 * MOVE R140-MESSAGE TO P434-MESSAGE CL**6 +01263 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**6 +01264 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT CL**6 +01265 * WRITE PEND-X140-REC FROM X140-REC CL**6 +01266 * MOVE '999999' TO LX42-X140-EMP-NO CL**6 +01267 * GO TO P2000-EXIT CL**6 +01268 * ELSE CL**6 +01269 * MOVE X140-EMP-NO TO LX42-X140-KEY-AREA CL**6 +01270 * END-IF CL**6 +01271 * END-IF. CL**6 +01272 DTSZX551 +01273 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 +01274 MOVE X140-EMP-NO TO LX42-X140-EMP-NO. DTSZX551 +01275 MOVE X140-QUARTER TO LX42-X140-QTR-AREA DTSZX551 +01276 SET W-EMP-FOUND-NO-88 TO TRUE. DTSZX551 +01277 DTSZX551 +01278 * IF LX42-X145-EMP-NO = '999999' DTSZX551 +01279 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01280 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01281 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01282 * STRING DTSZX551 +01283 * ':PAY RECORD INVALID -RPT BYPASSED ' DTSZX551 +01284 * DELIMITED BY SIZE DTSZX551 +01285 ** INTO R140-MESSAGE DTSZX551 +01286 * END-STRING DTSZX551 +01287 * MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 +01288 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01289 * ADD +1 TO W-X140-PEN-CNT DTSZX551 +01290 * WRITE PEND-X140-REC FROM X140-REC DTSZX551 +01291 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01292 * PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT DTSZX551 +01293 * GO TO P2000-EXIT. DTSZX551 +01294 DTSZX551 +01295 SET W-PREV-RPT-RPT-88 TO TRUE. DTSZX551 +01296 DTSZX551 +01297 DTSZX551 +01298 PERFORM P2010-EDIT-REPORT THRU P2010-EXIT DTSZX551 +01299 DTSZX551 +01300 IF W-RPT-ERROR-YES-88 DTSZX551 +01301 MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 +01302 DISPLAY ' REPORT HAS ERRORS - DATA ERRORS' DTSZX551 +01303 GO TO P2000-EDIT-REPORT-CONTINUE. DTSZX551 +01304 DTSZX551 +01305 PERFORM P2012-CHECK-MPRF THRU P2012-EXIT DTSZX551 +01306 IF W-RPT-ERROR-YES-88 DTSZX551 +01307 MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 +01308 DISPLAY ' REPORT HAS ERRORS - MPRF ERRORS' DTSZX551 +01309 GO TO P2000-EDIT-REPORT-CONTINUE. DTSZX551 +01310 DTSZX551 +01311 PERFORM P2013-CHECK-MQTR THRU P2013-EXIT DTSZX551 +01312 IF W-RPT-ERROR-YES-88 DTSZX551 +01313 MOVE '999999' TO LX42-X140-EMP-NO DTSZX551 +01314 DISPLAY ' REPORT HAS ERRORS - CANNOT-AMEND' DTSZX551 +01315 GO TO P2000-EDIT-REPORT-CONTINUE. DTSZX551 +01316 DTSZX551 +01317 P2000-EDIT-REPORT-CONTINUE. DTSZX551 +01318 IF W-RPT-ERROR-YES-88 DTSZX551 +01319 SET W-RPT-ERROR-NO-88 TO TRUE CL**8 +01320 MOVE SPACES TO R140-MESSAGE DTSZX551 +01321 * MOVE W-EMP-NO TO R140-EMP-NO CL**8 +01322 * STRING CL**8 +01323 * ': REPORT CONTAINS ERRORS CANNOT AMEND ' CL**8 +01324 * ' ' X140-QUARTER CL**8 +01325 * DELIMITED BY SIZE CL**8 +01326 * INTO R140-MESSAGE CL**8 +01327 * END-STRING CL**8 +01328 * PERFORM S946-WRITE-R140 THRU S946-EXIT CL**8 +01329 ADD +1 TO W-X140-PEN-CNT DTSZX551 +01330 WRITE PEND-X140-REC FROM X140-REC DTSZX551 +01331 PERFORM P6000-WRITE-PEND-X140 THRU P6000-EXIT DTSZX551 +01332 * MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01333 GO TO P2000-EXIT. DTSZX551 +01334 DTSZX551 +01335 PERFORM P2020-SAVE-EXT-REPORT THRU P2020-EXIT. DTSZX551 +01336 ADD +1 TO W-X140-SAV-CNT. DTSZX551 +01337 DTSZX551 +01338 DTSZX551 +01339 P2000-EXIT. DTSZX551 +01340 EXIT. DTSZX551 +01341 DTSZX551 +01342 P2010-EDIT-REPORT. DTSZX551 +01343 MOVE X140-QUARTER TO W-SLASH-QTR. DTSZX551 +01344 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSZX551 +01345 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSZX551 +01346 PERFORM S004-FROM-5 THRU S004-EXIT. DTSZX551 +01347 IF NOT L004-VALID-QTR DTSZX551 +01348 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01349 MOVE SPACES TO R140-MESSAGE DTSZX551 +01350 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01351 STRING DTSZX551 +01352 ':RPT- INVALID QUARTER ' DTSZX551 +01353 X140-QUARTER DTSZX551 +01354 DELIMITED BY SIZE DTSZX551 +01355 INTO R140-MESSAGE DTSZX551 +01356 END-STRING DTSZX551 +01357 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01358 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01359 ELSE DTSZX551 +01360 MOVE L004-QTR-5-9 TO W-X140-REPORT-QTR DTSZX551 +01361 END-IF. DTSZX551 +01362 DTSZX551 +01363 MOVE X140-REPORT-TYPE TO W-RPT-TYPE. DTSZX551 +01364 IF NOT W-RPT-TYPE-VALID-88 DTSZX551 +01365 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01366 MOVE SPACES TO R140-MESSAGE DTSZX551 +01367 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01368 STRING DTSZX551 +01369 'ERROR-RPT INVALID REPORT TYPE ' DTSZX551 +01370 X140-REPORT-TYPE DTSZX551 +01371 DELIMITED BY SIZE DTSZX551 +01372 INTO R140-MESSAGE DTSZX551 +01373 END-STRING DTSZX551 +01374 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01375 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01376 END-IF. DTSZX551 +01377 DTSZX551 +01378 IF W-RPT-TYPE NOT = 'EA' AND 'AC' DTSZX551 +01379 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01380 MOVE SPACES TO R140-MESSAGE DTSZX551 +01381 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01382 STRING DTSZX551 +01383 ':RPT- NOT AMENDED TYPE - CANNOT PROCESS ' CL**6 +01384 ' ' W-RPT-TYPE DTSZX551 +01385 DELIMITED BY SIZE DTSZX551 +01386 INTO R140-MESSAGE DTSZX551 +01387 END-STRING DTSZX551 +01388 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01389 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01390 END-IF. DTSZX551 +01391 DTSZX551 +01392 DTSZX551 +01393 * IF W-CURR-RPT-QTR NOT = W-X140-REPORT-QTR DTSZX551 +01394 * MOVE ZERO TO W-TOT-WAGE DTSZX551 +01395 * MOVE W-X140-REPORT-QTR TO W-CURR-RPT-QTR DTSZX551 +01396 * END-IF. DTSZX551 +01397 MOVE X140-TOTAL-WAGES TO W-TOT-WAGE. DTSZX551 +01398 MOVE X140-TAX-WAGES TO W-TAX-WAGE. DTSZX551 +01399 COMPUTE W-EXX-WAGE = W-TOT-WAGE - W-TAX-WAGE. CL*14 +01400 * MOVE W140-EXCESS-WAGES TO W-EXX-WAGE. CL*14 +01401 DTSZX551 +01402 * IF W-EMP-NO = 177462 DTSZX551 +01403 * MOVE 1352.07 TO X140-REMITTANCE DTSZX551 +01404 * DISPLAY ' X140-RMT ' X140-REMITTANCE. DTSZX551 +01405 DTSZX551 +01406 MOVE X140-REMITTANCE TO W-X140-REMITTANCE. DTSZX551 +01407 * DISPLAY ' W-X140-RMT ' W-X140-REMITTANCE. DTSZX551 +01408 *& DTSZX551 +01409 DTSZX551 +01410 * DISPLAY ' PAY FOUND IND ' W-X145-PAYMENT-FOUND-IND. DTSZX551 +01411 DTSZX551 +01412 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE > 0 DTSZX551 +01413 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01414 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01415 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01416 * STRING DTSZX551 +01417 * 'ESSP AMT DUE > 0 AND NO PAYMT ' DTSZX551 +01418 * DELIMITED BY SIZE DTSZX551 +01419 * INTO R140-MESSAGE DTSZX551 +01420 * END-STRING DTSZX551 +01421 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01422 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01423 * GO TO P2010-EDIT-CONTINUE DTSZX551 +01424 * END-IF. DTSZX551 +01425 DTSZX551 +01426 * IF W-X145-PAYMENT-NO-88 AND W-X140-REMITTANCE = 0 DTSZX551 +01427 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01428 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01429 * STRING DTSZX551 +01430 * 'X140 REMIT AMT = 0 AND NO X145 FOUND -PROCESS ' DTSZX551 +01431 * ' ' X140-REMITTANCE DTSZX551 +01432 * DELIMITED BY SIZE DTSZX551 +01433 * INTO R140-MESSAGE DTSZX551 +01434 * END-STRING DTSZX551 +01435 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01436 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01437 * GO TO P2010-EDIT-CONTINUE DTSZX551 +01438 * END-IF. DTSZX551 +01439 DTSZX551 +01440 * IF W-X145-TOT-REMIT-AMT > W-X140-REMITTANCE DTSZX551 +01441 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01442 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01443 * SET W-WRITE-T025-TRAN-YES-88 TO TRUE DTSZX551 +01444 * STRING DTSZX551 +01445 * 'X430 X145-PAY AMT > X140-REMIT AMT --PROCESS 'DTSZX551 +01446 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 +01447 * DELIMITED BY SIZE DTSZX551 +01448 * INTO R140-MESSAGE DTSZX551 +01449 * END-STRING DTSZX551 +01450 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01451 * END-IF. DTSZX551 +01452 DTSZX551 +01453 * IF W-X145-TOT-REMIT-AMT < W-X140-REMITTANCE DTSZX551 +01454 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01455 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01456 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01457 * STRING DTSZX551 +01458 * 'X430 X145-PAY AMT < X140-REMIT AMT ' DTSZX551 +01459 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 +01460 * DELIMITED BY SIZE DTSZX551 +01461 * INTO R140-MESSAGE DTSZX551 +01462 * END-STRING DTSZX551 +01463 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01464 * END-IF. DTSZX551 +01465 DTSZX551 +01466 * IF W-X145-TOT-REMIT-AMT > 0 AND W-X140-REMITTANCE = 0 DTSZX551 +01467 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01468 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01469 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01470 * STRING DTSZX551 +01471 * 'X430 X145-PAY AMT > 0 AND X140-REMIT AMT = 0 ' DTSZX551 +01472 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 +01473 * DELIMITED BY SIZE DTSZX551 +01474 * INTO R140-MESSAGE DTSZX551 +01475 * END-STRING DTSZX551 +01476 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01477 * END-IF. DTSZX551 +01478 DTSZX551 +01479 * IF W-X145-TOT-REMIT-AMT = W-X140-REMITTANCE DTSZX551 +01480 * ADD 1 TO W-T028-WRITEE-CNT DTSZX551 +01481 * SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 +01482 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01483 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01484 * STRING DTSZX551 +01485 * 'X430 ++++ X145-REMIT AMT = X140-REMIT AMT ' DTSZX551 +01486 * X145-REMITTANCE ' ' X140-REMITTANCE DTSZX551 +01487 * DELIMITED BY SIZE DTSZX551 +01488 * INTO R140-MESSAGE DTSZX551 +01489 * END-STRING DTSZX551 +01490 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01491 * END-IF. DTSZX551 +01492 DTSZX551 +01493 P2010-EDIT-CONTINUE. DTSZX551 +01494 * DISPLAY 'BX436 P1210: ' W-EMP-NO ' TAX: ' X140-TAX-WAGES DTSZX551 +01495 * ' TOT: ' X140-TOTAL-WAGES ' RMT: ' W-X140-REMITTANCE DTSZX551 +01496 *& DTSZX551 +01497 MOVE ZERO TO W-X140-RECEIVED-DATE. DTSZX551 +01498 MOVE X140-RCVD-DATE TO W-SLASH-DATE. DTSZX551 +01499 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSZX551 +01500 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSZX551 +01501 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSZX551 +01502 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSZX551 +01503 IF NOT L001-VALID-DATE DTSZX551 +01504 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01505 MOVE SPACES TO R140-MESSAGE DTSZX551 +01506 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01507 STRING DTSZX551 +01508 ':RPT- INVALID RECEIVED DATE ' DTSZX551 +01509 X140-RCVD-DATE DTSZX551 +01510 DELIMITED BY SIZE DTSZX551 +01511 INTO R140-MESSAGE DTSZX551 +01512 END-STRING DTSZX551 +01513 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01514 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01515 ELSE DTSZX551 +01516 MOVE L001-FED-8-DATE-9 TO W-X140-RECEIVED-DATE DTSZX551 +01517 END-IF. DTSZX551 +01518 DTSZX551 +01519 MOVE ZERO TO W-CHK-SCAN-DATE. DTSZX551 +01520 * IF X140-IN-HOUSE-88 DTSZX551 +01521 * MOVE X140-CHECK-SCAN-DT TO W-SLASH-DATE DTSZX551 +01522 * MOVE W-SLASH-DT-MM TO L001-FED-8-MO DTSZX551 +01523 * MOVE W-SLASH-DT-DD TO L001-FED-8-DA DTSZX551 +01524 * MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR DTSZX551 +01525 * PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSZX551 +01526 * IF NOT L001-VALID-DATE DTSZX551 +01527 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01528 * MOVE SPACES TO R140-MESSAGE DTSZX551 +01529 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01530 * STRING DTSZX551 +01531 * 'REPORT: INVALID CHK SCAN DATE ' DTSZX551 +01532 * X140-CHECK-SCAN-DT DTSZX551 +01533 * DELIMITED BY SIZE DTSZX551 +01534 * INTO R140-MESSAGE DTSZX551 +01535 * END-STRING DTSZX551 +01536 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01537 ** DISPLAY R140-MESSAGE DTSZX551 +01538 * ELSE DTSZX551 +01539 * MOVE L001-FED-8-DATE-9 TO W-CHK-SCAN-DATE DTSZX551 +01540 * END-IF DTSZX551 +01541 * END-IF. DTSZX551 +01542 DTSZX551 +01543 MOVE X140-WRKR-CNT-1ST-MNTH TO W-1ST-MNTH-CNT. DTSZX551 +01544 MOVE X140-WRKR-CNT-2ND-MNTH TO W-2ND-MNTH-CNT. DTSZX551 +01545 MOVE X140-WRKR-CNT-3RD-MNTH TO W-3RD-MNTH-CNT. DTSZX551 +01546 MOVE X140-WRKR-CNT-TOTAL TO W-WRKR-CNT-TOTAL. DTSZX551 +01547 DTSZX551 +01548 DTSZX551 +01549 P2010-EXIT. DTSZX551 +01550 EXIT. DTSZX551 +01551 DTSZX551 +01552 P2012-CHECK-MPRF. DTSZX551 +01553 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSZX551 +01554 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSZX551 +01555 SET MPRF-PRF-88 TO TRUE. DTSZX551 +01556 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 +01557 DTSZX551 +01558 PERFORM S910-READ THRU S910-EXIT. DTSZX551 +01559 DTSZX551 +01560 IF L910-OK-88 DTSZX551 +01561 MOVE MSKL-REC TO MPRF-REC DTSZX551 +01562 MOVE W-X140-REPORT-QTR TO L516-YRQ DTSZX551 +01563 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSZX551 +01564 IF L516-LIABLE-88 DTSZX551 +01565 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 +01566 SET W-EMP-FOUND-YES-88 TO TRUE DTSZX551 +01567 DISPLAY 'P2012 -EMPL FOUND LIAB FOR QTR ' MPRF-EMP-NO CL**9 +01568 GO TO P2012-EXIT DTSZX551 +01569 ELSE DTSZX551 +01570 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01571 MOVE SPACES TO R140-MESSAGE DTSZX551 +01572 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01573 STRING DTSZX551 +01574 ':EMP NOT LIABLE FOR QTRLY RPT -CANNOT AMEND' DTSZX551 +01575 X140-QUARTER DTSZX551 +01576 DELIMITED BY SIZE DTSZX551 +01577 INTO R140-MESSAGE DTSZX551 +01578 END-STRING DTSZX551 +01579 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01580 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01581 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 +01582 GO TO P2012-EXIT DTSZX551 +01583 ELSE DTSZX551 +01584 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01585 MOVE SPACES TO R140-MESSAGE DTSZX551 +01586 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01587 STRING DTSZX551 +01588 ':EMP NOT FOUND ON DUTAS-CANNOT AMEND RPT' DTSZX551 +01589 X140-EMP-NO DTSZX551 +01590 DELIMITED BY SIZE DTSZX551 +01591 INTO R140-MESSAGE DTSZX551 +01592 END-STRING DTSZX551 +01593 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +01594 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01595 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 +01596 END-IF. DTSZX551 +01597 DTSZX551 +01598 P2012-EXIT. DTSZX551 +01599 EXIT. DTSZX551 +01600 DTSZX551 +01601 DTSZX551 +01602 P2013-CHECK-MQTR. DTSZX551 +01603 DISPLAY 'P2013 X140 REPORT FROM ESSP- ' CL*19 +01604 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL*19 +01605 DISPLAY ' ' CL*19 +01606 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSZX551 +01607 MOVE W-EMP-NO TO MQTR-EMP-NO. DTSZX551 +01608 SET MQTR-QTR-88 TO TRUE. DTSZX551 +01609 MOVE W-X140-REPORT-QTR TO MQTR-YRQ. DTSZX551 +01610 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 +01611 DTSZX551 +01612 PERFORM S910-READ THRU S910-EXIT. DTSZX551 +01613 DTSZX551 +01614 IF L910-NO-REC-88 DTSZX551 +01615 DISPLAY 'P2013 -ORIG RPT NOT FOUND ' L910-RESULT-IND CL**6 +01616 ELSE DTSZX551 +01617 IF L910-OK-88 DTSZX551 +01618 DISPLAY 'P2013 MQTR REC FOUND ' L910-RESULT-IND CL**6 +01619 ELSE DTSZX551 +01620 DISPLAY 'P2013 X430 NOT SURE ' L910-RESULT-IND. DTSZX551 +01621 DTSZX551 +01622 IF L910-NO-REC-88 DTSZX551 +01623 DISPLAY 'P2013- ORIG RPT NOT ON ZUTAS- CANNOT AMEND ' CL*19 +01624 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO DTSZX551 +01625 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01626 MOVE SPACES TO R140-MESSAGE DTSZX551 +01627 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01628 STRING DTSZX551 +01629 'P2013 -ORIG REPORT NOT IN ZUTAS - CANNOT AMEND' CL*19 +01630 W-RPT-TYPE DTSZX551 +01631 DELIMITED BY SIZE DTSZX551 +01632 INTO R140-MESSAGE DTSZX551 +01633 END-STRING DTSZX551 +01634 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01635 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01636 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 +01637 GO TO P2013-EXIT. DTSZX551 +01638 DTSZX551 +01639 DTSZX551 +01640 MOVE MSKL-REC TO MQTR-REC DTSZX551 +01641 DTSZX551 +01642 DISPLAY 'P2013- QTR RPT FOUND ON DUTAS ' CL**6 +01643 MQTR-EMP-NO ' ' MQTR-YRQ ' RPT-TYP ' MQTR-CURR-RPT-TYPE DTSZX551 +01644 ' PUR-IND ' MQTR-PURSUED-RPT-IND DTSZX551 +01645 ' CUT-OFF ' MQTR-MISS-RPT-CUTOFF-CD DTSZX551 +01646 DTSZX551 +01647 *ZADD CL*23 +01648 IF MQTR-EMP-NO = 346251 CL*23 +01649 SET W-EMP-FOUND-NO-88 TO TRUE CL*23 +01650 GO TO P2013-EXIT. CL*23 +01651 CL*23 +01652 *ZEND CL*23 +01653 CL*23 +01654 * IF MQTR-CURR-MISSING-88 CL*24 +01655 IF MQTR-CURR-ESTIM-88 CL*24 +01656 DISPLAY 'X431 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL*22 +01657 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO DTSZX551 +01658 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01659 MOVE SPACES TO R140-MESSAGE DTSZX551 +01660 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01661 STRING DTSZX551 +01662 'P2013 -ORIG REPORT NOT IN DUTAS - CANNOT AMEND' DTSZX551 +01663 W-RPT-TYPE DTSZX551 +01664 DELIMITED BY SIZE DTSZX551 +01665 INTO R140-MESSAGE DTSZX551 +01666 END-STRING DTSZX551 +01667 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01668 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01669 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 +01670 GO TO P2013-EXIT. DTSZX551 +01671 DTSZX551 +01672 IF MQTR-CURR-ORIG-88 OR DTSZX551 +01673 MQTR-CURR-ORIG-ANN-NL-88 DTSZX551 +01674 DISPLAY 'X432 ORIG RPT FOUND ON DUTAS- PROCESS AMEND ' CL*22 +01675 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO DTSZX551 +01676 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 +01677 MOVE SPACES TO R140-MESSAGE DTSZX551 +01678 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01679 STRING DTSZX551 +01680 'P2013 -ORIG REPORT IN DUTAS - PROCESS AMEND' DTSZX551 +01681 W-RPT-TYPE DTSZX551 +01682 DELIMITED BY SIZE DTSZX551 +01683 INTO R140-MESSAGE DTSZX551 +01684 END-STRING DTSZX551 +01685 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01686 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 +01687 GO TO P2013-EXIT. CL**2 +01688 DTSZX551 +01689 IF MQTR-CURR-AMEND-88 OR CL**2 +01690 MQTR-CURR-AUDIT-88 OR CL**2 +01691 MQTR-CURR-ADMIN-88 OR CL**2 +01692 MQTR-CURR-FIELD-88 CL**2 +01693 PERFORM P2113-CHECK-MRPT THRU P2113-EXIT CL**6 +01694 ELSE CL**6 +01695 DISPLAY 'X433 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL*22 +01696 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO CL**6 +01697 SET W-RPT-ERROR-YES-88 TO TRUE CL**6 +01698 MOVE SPACES TO R140-MESSAGE CL**6 +01699 MOVE W-EMP-NO TO R140-EMP-NO CL**6 +01700 STRING CL**6 +01701 'P2013 -ORIG REPORT NOT IN DUTAS - CANNOT AMEND' CL**6 +01702 W-RPT-TYPE CL**6 +01703 DELIMITED BY SIZE CL**6 +01704 INTO R140-MESSAGE CL**6 +01705 END-STRING CL**6 +01706 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01707 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**6 +01708 SET W-EMP-FOUND-NO-88 TO TRUE CL**6 +01709 GO TO P2013-EXIT. CL**6 +01710 CL**2 +01711 IF W-RPT-DUPL-YES-88 CL**3 +01712 DISPLAY 'X434 DUPLICATE AMENDMENT--- CANNOT AMEND ' CL*22 +01713 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' MQTR-EMP-NO CL**7 +01714 SET W-RPT-ERROR-YES-88 TO TRUE CL**7 +01715 MOVE SPACES TO R140-MESSAGE CL**7 +01716 MOVE W-EMP-NO TO R140-EMP-NO CL**7 +01717 STRING CL**7 +01718 'MRPT-DUPLICATE AMENDMENT -CANNOT AMEND' CL**7 +01719 W-RPT-TYPE CL**7 +01720 DELIMITED BY SIZE CL**7 +01721 INTO R140-MESSAGE CL**7 +01722 END-STRING CL**7 +01723 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01724 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**7 +01725 SET W-EMP-FOUND-NO-88 TO TRUE CL**7 +01726 GO TO P2013-EXIT. CL**7 +01727 CL**7 +01728 SET W-RPT-DUPL-NO-88 TO TRUE CL**7 +01729 PERFORM P2015-CHECK-MQTR-DUP THRU P2015-EXIT. CL**7 +01730 CL**3 +01731 IF W-RPT-DUPL-NO-88 CL**3 +01732 SET W-RPT-ERROR-NO-88 TO TRUE CL**2 +01733 MOVE SPACES TO R140-MESSAGE CL**2 +01734 MOVE W-EMP-NO TO R140-EMP-NO CL**2 +01735 STRING CL**2 +01736 'P2013 -NO DUP REPORT IN DUTAS - PROCESS AMEND' CL**3 +01737 W-RPT-TYPE CL**2 +01738 DELIMITED BY SIZE CL**2 +01739 INTO R140-MESSAGE CL**2 +01740 END-STRING CL**2 +01741 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01742 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**2 +01743 GO TO P2013-EXIT CL**3 +01744 ELSE CL**3 +01745 SET W-RPT-ERROR-YES-88 TO TRUE CL**3 +01746 MOVE SPACES TO R140-MESSAGE CL**3 +01747 MOVE W-EMP-NO TO R140-EMP-NO CL**3 +01748 STRING CL**3 +01749 ':DUPLICATE AMENDMENT ---CANNOT AMEND RPT' CL**3 +01750 X140-EMP-NO CL**3 +01751 DELIMITED BY SIZE CL**3 +01752 INTO R140-MESSAGE CL**3 +01753 END-STRING CL**3 +01754 MOVE R140-MESSAGE TO P434-MESSAGE CL**3 +01755 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**3 +01756 SET W-EMP-FOUND-NO-88 TO TRUE CL**3 +01757 END-IF. CL**3 +01758 CL**2 +01759 P2013-EXIT. DTSZX551 +01760 EXIT. DTSZX551 +01761 DTSZX551 +01762 P2015-CHECK-MQTR-DUP. CL**3 +01763 DISPLAY 'P2015 FOUND AMENDED MQTR CHECK FOR DUPS ' CL*15 +01764 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL*15 +01765 CL*15 +01766 IF MPRF-CLASS-SELF-INS-88 CL*15 +01767 MOVE ZERO TO W-EXX-WAGE CL*15 +01768 W-TAX-WAGE. CL*15 +01769 CL*15 +01770 IF W-TOT-WAGE = MQTR-TOT-WAGE AND CL**3 +01771 W-EXX-WAGE = MQTR-EXCESS-WAGE AND CL**3 +01772 W-TAX-WAGE = MQTR-TAX-WAGE CL**3 +01773 SET W-RPT-DUPL-YES-88 TO TRUE. CL**3 +01774 P2015-EXIT. EXIT. CL**3 +01775 CL**3 +01776 DTSZX551 +01777 P2113-CHECK-MRPT. DTSZX551 +01778 DISPLAY 'P2113 - X140 REPORT FROM ESSP- ' CL**7 +01779 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. DTSZX551 +01780 DISPLAY ' ' DTSZX551 +01781 SET W-RPT-DUPL-NO-88 TO TRUE CL**3 +01782 MOVE LOW-VALUE TO MRPT-KEY-AREA. DTSZX551 +01783 MOVE W-EMP-NO TO MRPT-EMP-NO. DTSZX551 +01784 SET MRPT-RPT-88 TO TRUE. DTSZX551 +01785 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. DTSZX551 +01786 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSZX551 +01787 DTSZX551 +01788 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSZX551 +01789 IF L910-OK-88 DTSZX551 +01790 PERFORM P2116-SCAN-MRPT THRU P2116-EXIT DTSZX551 +01791 UNTIL L910-NO-REC-88 DTSZX551 +01792 ELSE DTSZX551 +01793 * SET W-RPT-DUPL-YES-88 TO TRUE CL**8 +01794 DISPLAY 'MRPT -ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL**7 +01795 W-EMP-NO ' ' W-X140-REPORT-QTR DTSZX551 +01796 DISPLAY ' ' DTSZX551 +01797 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01798 MOVE SPACES TO R140-MESSAGE DTSZX551 +01799 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +01800 STRING DTSZX551 +01801 'P2013 -ORIG REPORT NOT IN DUTAS CANNOT AMEND ' DTSZX551 +01802 W-RPT-TYPE DTSZX551 +01803 DELIMITED BY SIZE DTSZX551 +01804 INTO R140-MESSAGE DTSZX551 +01805 END-STRING DTSZX551 +01806 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01807 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +01808 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 +01809 GO TO P2113-EXIT. DTSZX551 +01810 DTSZX551 +01811 P2113-EXIT. DTSZX551 +01812 EXIT. DTSZX551 +01813 P2116-SCAN-MRPT. DTSZX551 +01814 MOVE MSKL-REC TO MRPT-REC. DTSZX551 +01815 IF MRPT-YRQ = W-X140-REPORT-QTR DTSZX551 +01816 NEXT SENTENCE DTSZX551 +01817 ELSE DTSZX551 +01818 IF MRPT-YRQ > W-X140-REPORT-QTR DTSZX551 +01819 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +01820 SET L910-NO-REC-88 TO TRUE DTSZX551 +01821 GO TO P2116-EXIT DTSZX551 +01822 ELSE DTSZX551 +01823 GO TO P2116-READ-NEXT DTSZX551 +01824 END-IF DTSZX551 +01825 END-IF. DTSZX551 +01826 DTSZX551 +01827 IF MRPT-SUPPLEM-88 CL**2 +01828 PERFORM P2117-CHECK-MRPT-DUP THRU P2117-EXIT CL**3 +01829 END-IF. DTSZX551 +01830 DTSZX551 +01831 P2116-READ-NEXT. DTSZX551 +01832 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSZX551 +01833 IF L910-NO-REC-88 DTSZX551 +01834 SET W-EMP-FOUND-NO-88 TO TRUE DTSZX551 +01835 SET W-RPT-ERROR-YES-88 TO TRUE. DTSZX551 +01836 P2116-EXIT. EXIT. DTSZX551 +01837 P2117-CHECK-MRPT-DUP. CL**2 +01838 IF MPRF-CLASS-SELF-INS-88 CL*15 +01839 MOVE ZERO TO W-EXX-WAGE CL*15 +01840 W-TAX-WAGE. CL*15 +01841 * IF MRPT-EMP-NO = 051334 CL*10 +01842 IF MRPT-EMP-NO = 316710 CL*10 +01843 DISPLAY 'P2117 FOUND AMENDED CHECK FOR DUPS ' CL**9 +01844 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE CL**9 +01845 DISPLAY ' WTOT ' W-TOT-WAGE ' MTOT ' MRPT-TOT-WAGE CL*11 +01846 DISPLAY ' WEXX ' W-EXX-WAGE ' MEXX ' MRPT-EXCESS-WAGE CL*11 +01847 DISPLAY ' WTAX ' W-TAX-WAGE ' MTAX ' MRPT-TAX-WAGE. CL*11 +01848 CL**9 +01849 IF W-TOT-WAGE = MRPT-TOT-WAGE AND CL**3 +01850 W-EXX-WAGE = MRPT-EXCESS-WAGE AND CL**3 +01851 W-TAX-WAGE = MRPT-TAX-WAGE CL**3 +01852 SET W-RPT-ERROR-YES-88 TO TRUE CL**8 +01853 SET L910-NO-REC-88 TO TRUE CL**8 +01854 SET W-RPT-DUPL-YES-88 TO TRUE. CL**8 +01855 P2117-EXIT. EXIT. CL**2 +01856 DTSZX551 +01857 P2119-CHECK-MRPT-ORIG. CL**4 +01858 DISPLAY 'P2119 X140 X140 REPORT FROM ESSP- ' CL**4 +01859 W-EMP-NO ' ' W-X140-REPORT-QTR ' ' W-RPT-TYPE. CL**4 +01860 DISPLAY ' ' CL**4 +01861 MOVE LOW-VALUE TO MRPT-KEY-AREA. CL**4 +01862 MOVE W-EMP-NO TO MRPT-EMP-NO. CL**4 +01863 SET MRPT-RPT-88 TO TRUE. CL**4 +01864 MOVE W-X140-REPORT-QTR TO MRPT-YRQ. CL**4 +01865 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL**4 +01866 CL**4 +01867 PERFORM S910-START-BROWSE THRU S910-EXIT. CL**4 +01868 IF L910-OK-88 CL**4 +01869 PERFORM P2120-SCAN-MRPT THRU P2120-EXIT CL**4 +01870 UNTIL L910-NO-REC-88 CL**4 +01871 ELSE CL**4 +01872 DISPLAY 'X451 ORIG RPT NOT ON DUTAS- CANNOT AMEND ' CL**4 +01873 W-EMP-NO ' ' W-X140-REPORT-QTR CL**4 +01874 DISPLAY ' ' CL**4 +01875 SET W-RPT-ERROR-YES-88 TO TRUE CL**4 +01876 MOVE SPACES TO R140-MESSAGE CL**4 +01877 MOVE W-EMP-NO TO R140-EMP-NO CL**4 +01878 STRING CL**4 +01879 'P2013 -ORIG REPORT NOT IN DUTAS CANNOT AMEND ' CL**4 +01880 W-RPT-TYPE CL**4 +01881 DELIMITED BY SIZE CL**4 +01882 INTO R140-MESSAGE CL**4 +01883 END-STRING CL**4 +01884 MOVE R140-MESSAGE TO P434-MESSAGE CL**8 +01885 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 +01886 SET W-EMP-FOUND-NO-88 TO TRUE CL**4 +01887 GO TO P2119-EXIT. CL**4 +01888 CL**4 +01889 CL**4 +01890 P2119-EXIT. CL**4 +01891 EXIT. CL**4 +01892 P2120-SCAN-MRPT. CL**4 +01893 MOVE MSKL-REC TO MRPT-REC. CL**4 +01894 IF MRPT-YRQ = W-X140-REPORT-QTR CL**4 +01895 NEXT SENTENCE CL**4 +01896 ELSE CL**4 +01897 IF MRPT-YRQ > W-X140-REPORT-QTR CL**4 +01898 SET W-RPT-ERROR-YES-88 TO TRUE CL**4 +01899 SET L910-NO-REC-88 TO TRUE CL**4 +01900 GO TO P2120-EXIT CL**4 +01901 ELSE CL**4 +01902 GO TO P2120-READ-NEXT CL**4 +01903 END-IF CL**4 +01904 END-IF. CL**4 +01905 CL**4 +01906 IF MRPT-ESTIM-88 OR MRPT-WITHDRW-88 CL**4 +01907 GO TO P2120-READ-NEXT CL**4 +01908 ELSE CL**4 +01909 SET W-RPT-ERROR-NO-88 TO TRUE CL**4 +01910 SET L910-NO-REC-88 TO TRUE CL**4 +01911 MOVE SPACES TO R140-MESSAGE CL**4 +01912 MOVE W-EMP-NO TO R140-EMP-NO CL**4 +01913 STRING CL**4 +01914 ':ORIGINAL RPT EXIST IN DUTAS -CONVERT EMP COUNTS' CL**4 +01915 X140-QUARTER CL**4 +01916 DELIMITED BY SIZE CL**4 +01917 INTO R140-MESSAGE CL**4 +01918 END-STRING CL**4 +01919 MOVE R140-MESSAGE TO P434-MESSAGE CL**4 +01920 PERFORM S946-WRITE-R140 THRU S946-EXIT CL**4 +01921 GO TO P2120-EXIT CL**4 +01922 END-IF. CL**4 +01923 P2120-READ-NEXT. CL**4 +01924 PERFORM S910-READ-NEXT THRU S910-EXIT. CL**4 +01925 IF L910-NO-REC-88 CL**4 +01926 SET W-EMP-FOUND-NO-88 TO TRUE CL**4 +01927 SET W-RPT-ERROR-YES-88 TO TRUE. CL**4 +01928 CL**4 +01929 P2120-EXIT. CL**4 +01930 EXIT. CL**4 +01931 CL**4 +01932 P2020-SAVE-EXT-REPORT. DTSZX551 +01933 * DISPLAY 'P2020-SAVE-EXT-REPORT ' DTSZX551 +01934 ************************************************************ DTSZX551 +01935 * DUE TO CONVERSION ERROR CHECK IS MADE WHEN EMPLOYEE COUNT DTSZX551 +01936 * IS = ALL 9. GET ORIGINAL REPORT AND MOVE EMPLOYEE COINT DTSZX551 +01937 * TO AMEND REPORT COUNTS ZL1 9/06/15 DTSZX551 +01938 ************************************************************ DTSZX551 +01939 IF W-1ST-MNTH-CNT = 9999999 OR DTSZX551 +01940 W-2ND-MNTH-CNT = 9999999 OR DTSZX551 +01941 W-3RD-MNTH-CNT = 9999999 DTSZX551 +01942 PERFORM P2119-CHECK-MRPT-ORIG THRU P2119-EXIT CL**4 +01943 IF W-RPT-ERROR-YES-88 DTSZX551 +01944 MOVE SPACES TO R140-MESSAGE DTSZX551 +01945 DISPLAY DTSZX551 +01946 'P2013 -FATAL ERROR REPORT NOT ON MRPT AMEND ' DTSZX551 +01947 W-RPT-TYPE DTSZX551 +01948 PERFORM S999-ABEND THRU S999-EXIT DTSZX551 +01949 ELSE DTSZX551 +01950 MOVE MRPT-1ST-MTH-EMPL-CNT TO W-1ST-MNTH-CNT DTSZX551 +01951 MOVE MRPT-2ND-MTH-EMPL-CNT TO W-2ND-MNTH-CNT DTSZX551 +01952 MOVE MRPT-3RD-MTH-EMPL-CNT TO W-3RD-MNTH-CNT DTSZX551 +01953 MOVE MRPT-TOTAL-EMPL-CNT TO W-WRKR-CNT-TOTAL. DTSZX551 +01954 DTSZX551 +01955 DTSZX551 +01956 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSZX551 +01957 MOVE '028' TO T028-REC-TYPE. DTSZX551 +01958 DTSZX551 +01959 MOVE W-EMP-NO TO T028-EMP-NO. DTSZX551 +01960 MOVE 'WEBESSP ' TO T028-ORIGIN. CL*16 +01961 MOVE LX42-SYS-DATE TO T028-SYS-DATE. DTSZX551 +01962 MOVE LX42-SYS-TIME TO T028-SYS-TIME. DTSZX551 +01963 SET T028-AMEND-RPT-88 TO TRUE. CL*16 +01964 DTSZX551 +01965 MOVE LX42-EXT-PSEUDO-BATCH TO T028-PSEUDO-BATCH-NO. DTSZX551 +01966 MOVE LX42-EXT-PSEUDO-ITEM TO T028-PSEUDO-ITEM-NO. DTSZX551 +01967 DTSZX551 +01968 MOVE W-X140-REPORT-QTR TO T028-YRQ. DTSZX551 +01969 IF W-EMP-FOUND-YES-88 DTSZX551 +01970 MOVE MPRF-PRIMARY-NAME (1:4) DTSZX551 +01971 TO T028-NAME-CHECK DTSZX551 +01972 ELSE DTSZX551 +01973 MOVE SPACES TO T028-NAME-CHECK DTSZX551 +01974 END-IF. DTSZX551 +01975 MOVE W-RPT-TYPE TO T028-RPT-TYPE. DTSZX551 +01976 DTSZX551 +01977 MOVE X140-CHECK-SEQ-NBR TO T028-LOG-NBR. CL*16 +01978 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSZX551 +01979 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSZX551 +01980 MOVE W-X140-RECEIVED-DATE TO T028-RECEIVED-DATE. DTSZX551 +01981 MOVE ZEROS TO T028-DEPOSIT-DATE. DTSZX551 +01982 DTSZX551 +01983 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSZX551 +01984 DTSZX551 +01985 IF W-EMP-FOUND-NO-88 DTSZX551 +01986 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSZX551 +01987 MOVE W-EXX-WAGE TO T028-EXCESS-WAGE CL*12 +01988 * COMPUTE T028-EXCESS-WAGE = CL*12 +01989 * (T028-TOT-WAGE - T028-TAX-WAGE) CL*12 +01990 ELSE DTSZX551 +01991 IF MPRF-CLASS-SELF-INS-88 DTSZX551 +01992 MOVE ZERO TO T028-TAX-WAGE DTSZX551 +01993 T028-EXCESS-WAGE DTSZX551 +01994 ELSE DTSZX551 +01995 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSZX551 +01996 MOVE W-EXX-WAGE TO T028-EXCESS-WAGE CL*12 +01997 * COMPUTE T028-EXCESS-WAGE = CL*12 +01998 * (T028-TOT-WAGE - T028-TAX-WAGE) CL*12 +01999 END-IF DTSZX551 +02000 END-IF. DTSZX551 +02001 DTSZX551 +02002 MOVE W-1ST-MNTH-CNT TO T028-1ST-MTH-EMPL-CNT. DTSZX551 +02003 MOVE W-2ND-MNTH-CNT TO T028-2ND-MTH-EMPL-CNT. DTSZX551 +02004 MOVE W-3RD-MNTH-CNT TO T028-3RD-MTH-EMPL-CNT. DTSZX551 +02005 MOVE W-1ST-MNTH-CNT TO T028-TOTAL-EMPL-CNT DTSZX551 +02006 DTSZX551 +02007 IF W-2ND-MNTH-CNT > T028-TOTAL-EMPL-CNT DTSZX551 +02008 MOVE W-2ND-MNTH-CNT TO T028-TOTAL-EMPL-CNT. DTSZX551 +02009 DTSZX551 +02010 IF W-3RD-MNTH-CNT > T028-TOTAL-EMPL-CNT DTSZX551 +02011 MOVE W-3RD-MNTH-CNT TO T028-TOTAL-EMPL-CNT. DTSZX551 +02012 DTSZX551 +02013 * DISPLAY ' X145 PAY AMT ' X145-REMITTANCE DTSZX551 +02014 * DISPLAY ' X140 PAY AMT ' X140-REMITTANCE DTSZX551 +02015 DTSZX551 +02016 MOVE W-X145-TOT-REMIT-AMT TO W-X140-REMITTANCE DTSZX551 +02017 MOVE ZEROS TO T028-REMIT-AMT. DTSZX551 +02018 DTSZX551 +02019 * ADD W-X145-TOT-REMIT-AMT TO W-TOT-REMIT-AMT. DTSZX551 +02020 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSZX551 +02021 DTSZX551 +02022 MOVE ZERO TO T028-TRACE-NO. DTSZX551 +02023 DTSZX551 +02024 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSZX551 +02025 MOVE 'WEBESSP ' TO T028-RESPONSIBLE-OP-ID. DTSZX551 +02026 DTSZX551 +02027 * DISPLAY 'BX436 WEB RPT ' X140-EMP-NO ' ' X140-QUARTER. DTSZX551 +02028 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSZX551 +02029 DTSZX551 +02030 PERFORM P4000-WRITE-X434-PAID-REPT THRU P4000-EXIT. DTSZX551 +02031 DTSZX551 +02032 * DISPLAY W-EMP-NO ',' T028-TOT-WAGE DTSZX551 +02033 * ',' T028-EXCESS-WAGE DTSZX551 +02034 * ',' T028-TAX-WAGE DTSZX551 +02035 * ',' X140-REMITTANCE DTSZX551 +02036 * ',' X145-REMITTANCE. DTSZX551 +02037 DTSZX551 +02038 IF W-X140-REMITTANCE > 0 DTSZX551 +02039 ADD 1 TO W-T028-WRITE-CNT DTSZX551 +02040 ELSE DTSZX551 +02041 ADD 1 TO W-T028-WRITE-CNT DTSZX551 +02042 ADD 1 TO W-T028-WRITEO-CNT. DTSZX551 +02043 DTSZX551 +02044 * IF W-WRITE-T025-TRAN-YES-88 DTSZX551 +02045 * PERFORM P2021-WRITE-T025 THRU P2021-EXIT DTSZX551 +02046 * ELSE DTSZX551 +02047 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 +02048 MOVE SPACES TO R140-MESSAGE DTSZX551 +02049 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02050 STRING DTSZX551 +02051 'X451 -:>AMENDED REPORT ADDED TO DUTAS - ' X140-QUARTERDTSZX551 +02052 DELIMITED BY SIZE DTSZX551 +02053 INTO R140-MESSAGE DTSZX551 +02054 END-STRING DTSZX551 +02055 PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSZX551 +02056 P2020-EXIT. DTSZX551 +02057 EXIT. DTSZX551 +02058 DTSZX551 +02059 P2021-WRITE-T025. DTSZX551 +02060 ** DTSZX551 +02061 **PAYMENT TRANSACTION REMIT AMT > THAN REPORT REMIT AMT, SUBTRACT DTSZX551 +02062 **DIFFERENCE AND WRITE A PA T025 TRANSACTION. DTSZX551 +02063 ** DTSZX551 +02064 DISPLAY 'PAYMENT OK ' X145-EMP-NO. DTSZX551 +02065 DTSZX551 +02066 MOVE LENGTH OF T025-REC TO T025-LENGTH DTSZX551 +02067 MOVE '025' TO T025-REC-TYPE. DTSZX551 +02068 DTSZX551 +02069 MOVE W-EMP-NO TO T025-EMP-NO. DTSZX551 +02070 MOVE 'WEB PAY' TO T025-ORIGIN. DTSZX551 +02071 MOVE LX42-SYS-DATE TO T025-SYS-DATE. DTSZX551 +02072 MOVE LX42-SYS-TIME TO T025-SYS-TIME. DTSZX551 +02073 * DTSZX551 +02074 MOVE W-X145-PAYMENT-QTR TO T025-APPLIC-YRQ DTSZX551 +02075 MOVE 'PA' TO T025-PAY-TYPE DTSZX551 +02076 DTSZX551 +02077 MOVE SPACES TO T025-APPLIC-IND. DTSZX551 +02078 MOVE ZERO TO T025-APPLIC-BATCH-NO DTSZX551 +02079 T025-APPLIC-ITEM-NO. DTSZX551 +02080 DTSZX551 +02081 IF W-EMP-FOUND-YES-88 DTSZX551 +02082 MOVE MPRF-PRIMARY-NAME (1:4) DTSZX551 +02083 TO T025-NAME-CHECK DTSZX551 +02084 ELSE DTSZX551 +02085 MOVE SPACES TO T025-NAME-CHECK DTSZX551 +02086 END-IF. DTSZX551 +02087 DTSZX551 +02088 MOVE W-X145-RECEIVED-DATE TO T025-RECEIVED-DATE DTSZX551 +02089 T025-DEPOSIT-DATE. DTSZX551 +02090 DTSZX551 +02091 MOVE W-X145-TOT-REMIT-AMT TO W-T025-REMIT-AMT DTSZX551 +02092 DTSZX551 +02093 MOVE W-T025-REMIT-AMT TO T025-REMIT-AMT. DTSZX551 +02094 DTSZX551 +02095 DTSZX551 +02096 IF X145-TRACE-NO > SPACES DTSZX551 +02097 MOVE X145-TRACE-NO TO T025-TRACE-NO DTSZX551 +02098 ELSE DTSZX551 +02099 MOVE ZEROS TO T025-TRACE-NO. DTSZX551 +02100 DTSZX551 +02101 MOVE 'VOL' TO T025-RESPONSIBLE-ACTIVITY. DTSZX551 +02102 MOVE 'WEBESSP' TO T025-RESPONSIBLE-OP-ID. DTSZX551 +02103 DTSZX551 +02104 * MOVE T025-REC TO TSKL-REC. DTSZX551 +02105 * PERFORM S927B-WRITE THRU S927B-EXIT. DTSZX551 +02106 DTSZX551 +02107 PERFORM S1033-WRITE-TEMP-T025 THRU S1033-EXIT. DTSZX551 +02108 ADD +1 TO W-T025-WRITE-CNT. DTSZX551 +02109 DTSZX551 +02110 PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT. DTSZX551 +02111 WRITE REPT-PAID-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 +02112 MOVE ZEROS TO W-T025-REMIT-AMT DTSZX551 +02113 W-X145-TOT-REMIT-AMT DTSZX551 +02114 W-X140-REMITTANCE. DTSZX551 +02115 DTSZX551 +02116 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. DTSZX551 +02117 DTSZX551 +02118 SET W-RPT-ERROR-NO-88 TO TRUE DTSZX551 +02119 MOVE SPACES TO R140-MESSAGE DTSZX551 +02120 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02121 STRING DTSZX551 +02122 'X430 -: >>>>> PAYMENT T025 CREATED ' DTSZX551 +02123 'REMIT AMT' DTSZX551 +02124 DELIMITED BY SIZE DTSZX551 +02125 INTO R140-MESSAGE DTSZX551 +02126 END-STRING DTSZX551 +02127 PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSZX551 +02128 P2021-EXIT. DTSZX551 +02129 EXIT. DTSZX551 +02130 DTSZX551 +02131 DTSZX551 +02132 P3000-WAGES. DTSZX551 +02133 MOVE LX42-DATA-AREA TO X144-REC. DTSZX551 +02134 * DISPLAY 'X144: ' X144-REC. DTSZX551 +02135 MOVE X144-EMP-NO TO W-EMP-NO. DTSZX551 +02136 * DTSZX551 +02137 ADD +1 TO W-X144-RED-CNT DTSZX551 +02138 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 +02139 * SET W-PREV-REC-WAGE-88 TO TRUE. DTSZX551 +02140 * DTSZX551 +02141 * DISPLAY 'LX-E ' LX42-X140-EMP-NO ' X145-E ' W-EMP-NO. DTSZX551 +02142 * IF LX42-X145-EMP-NO = '999999' OR DTSZX551 +02143 * LX42-X140-EMP-NO = '999999' OR DTSZX551 +02144 * LX42-X145-EMP-NO = SPACES OR DTSZX551 +02145 * LX42-X140-EMP-NO = SPACES OR DTSZX551 +02146 * W-PREV-RPT-NULL-88 DTSZX551 +02147 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02148 * MOVE SPACES TO R140-MESSAGE DTSZX551 +02149 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02150 * STRING DTSZX551 +02151 * 'X430 -: X144 WAGES HAS NO X140 REPORT -- CANCEL - WAGES 'DTSZX551 +02152 * ' ' X144-QUARTER DTSZX551 +02153 * DELIMITED BY SIZE DTSZX551 +02154 * INTO R140-MESSAGE DTSZX551 +02155 * END-STRING DTSZX551 +02156 * WRITE PEND-X144-REC FROM X144-REC DTSZX551 +02157 * ADD +1 TO W-X144-ERR-CNT DTSZX551 +02158 * ADD +1 TO W-X144-PEN-CNT DTSZX551 +02159 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT DTSZX551 +02160 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02161 * GO TO P3000-EXIT. DTSZX551 +02162 DTSZX551 +02163 * DTSZX551 +02164 * IF W-PREV-RPT-RPT-88 DTSZX551 +02165 * OR W-PREV-RPT-WAGE-88 DTSZX551 +02166 * SET W-PREV-RPT-WAGE-88 TO TRUE DTSZX551 +02167 ADD +1 TO W-X144-PRO-CNT DTSZX551 +02168 PERFORM P3010-EDIT-WAGES THRU P3010-EXIT DTSZX551 +02169 IF W-RPT-ERROR-NO-88 DTSZX551 +02170 PERFORM P3011-WRITE-WAGES-X144 THRU P3011-EXIT DTSZX551 +02171 ADD +1 TO W-X144-SAV-CNT DTSZX551 +02172 ELSE DTSZX551 +02173 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02174 MOVE SPACES TO R140-MESSAGE DTSZX551 +02175 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02176 STRING DTSZX551 +02177 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' DTSZX551 +02178 ' ' X144-SSN DTSZX551 +02179 DELIMITED BY SIZE DTSZX551 +02180 INTO R140-MESSAGE DTSZX551 +02181 END-STRING DTSZX551 +02182 ADD +1 TO W-X144-ERR-CNT DTSZX551 +02183 ADD +1 TO W-X144-PEN-CNT DTSZX551 +02184 WRITE PEND-X144-REC FROM X144-REC DTSZX551 +02185 PERFORM P6000-WRITE-PEND-X144 THRU P6000-EXIT DTSZX551 +02186 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02187 GO TO P3000-EXIT. DTSZX551 +02188 * ELSE DTSZX551 +02189 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02190 * MOVE SPACES TO R140-MESSAGE DTSZX551 +02191 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02192 * STRING DTSZX551 +02193 * 'X430 -: REPORT RECORD X140 NOT FOUND OR MISSING ' DTSZX551 +02194 * ' ' X144-SSN DTSZX551 +02195 * DELIMITED BY SIZE DTSZX551 +02196 * INTO R140-MESSAGE DTSZX551 +02197 * END-STRING DTSZX551 +02198 * WRITE PEND-X144-REC FROM X144-REC DTSZX551 +02199 * ADD +1 TO W-X144-ERR-CNT DTSZX551 +02200 * ADD +1 TO W-X144-PEN-CNT DTSZX551 +02201 * PERFORM P6000-WRITE-PEND-FILES THRU P6000-EXIT DTSZX551 +02202 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02203 * END-IF. DTSZX551 +02204 DTSZX551 +02205 P3000-EXIT. DTSZX551 +02206 EXIT. DTSZX551 +02207 DTSZX551 +02208 P3010-EDIT-WAGES. DTSZX551 +02209 * DISPLAY 'P3010-EDIT-WAGES ' DTSZX551 +02210 * DISPLAY 'X144-QUARTER ' X144-QUARTER DTSZX551 +02211 MOVE X144-QUARTER TO W-SLASH-QTR. DTSZX551 +02212 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSZX551 +02213 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSZX551 +02214 PERFORM S004-FROM-5 THRU S004-EXIT. DTSZX551 +02215 IF NOT L004-VALID-QTR DTSZX551 +02216 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02217 MOVE SPACES TO R140-MESSAGE DTSZX551 +02218 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02219 STRING DTSZX551 +02220 ': WAGE RECORD HAS INVALID QUARTER ' DTSZX551 +02221 X144-QUARTER ' ' X144-SSN DTSZX551 +02222 DELIMITED BY SIZE DTSZX551 +02223 INTO R140-MESSAGE DTSZX551 +02224 END-STRING DTSZX551 +02225 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02226 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02227 ELSE DTSZX551 +02228 MOVE L004-QTR-5-9 TO W-X144-WAGE-QTR DTSZX551 +02229 END-IF. DTSZX551 +02230 DTSZX551 +02231 * IF L004-QTR-5-9 NOT = W-X140-REPORT-QTR DTSZX551 +02232 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02233 * MOVE SPACES TO R140-MESSAGE DTSZX551 +02234 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02235 * MOVE W-X140-REPORT-QTR TO WRK-REPORT-QTR DTSZX551 +02236 * STRING DTSZX551 +02237 * ':WAGE QTR NOT = RPT QTR ' DTSZX551 +02238 * X144-QUARTER ' ' WRK-REPORT-QTR DTSZX551 +02239 * DELIMITED BY SIZE DTSZX551 +02240 * INTO R140-MESSAGE DTSZX551 +02241 * END-STRING DTSZX551 +02242 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02243 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02244 * END-IF. DTSZX551 +02245 DTSZX551 +02246 IF X144-SSN NOT NUMERIC DTSZX551 +02247 * DISPLAY 'X144-SSN ' X144-SSN DTSZX551 +02248 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02249 MOVE SPACES TO R140-MESSAGE DTSZX551 +02250 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02251 STRING DTSZX551 +02252 ':WAGE RECORD NON-NUMERIC SSN ' DTSZX551 +02253 X144-SSN DTSZX551 +02254 DELIMITED BY SIZE DTSZX551 +02255 INTO R140-MESSAGE DTSZX551 +02256 END-STRING DTSZX551 +02257 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02258 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02259 ELSE DTSZX551 +02260 MOVE X144-SSN TO W-SSN DTSZX551 +02261 END-IF. DTSZX551 +02262 DTSZX551 +02263 IF X144-SSN = ZEROS DTSZX551 +02264 * DISPLAY 'X144-SSN ' X144-SSN DTSZX551 +02265 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02266 MOVE SPACES TO R140-MESSAGE DTSZX551 +02267 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02268 STRING DTSZX551 +02269 ':WAGE RECORD SSN = ZEROS ' DTSZX551 +02270 X144-SSN DTSZX551 +02271 DELIMITED BY SIZE DTSZX551 +02272 INTO R140-MESSAGE DTSZX551 +02273 END-STRING DTSZX551 +02274 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02275 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02276 ELSE DTSZX551 +02277 MOVE X144-SSN TO W-SSN DTSZX551 +02278 END-IF. DTSZX551 +02279 DTSZX551 +02280 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME DTSZX551 +02281 * ' FN: ' X144-FIRST-NAME. DTSZX551 +02282 * IF X144-LAST-NAME = SPACES DTSZX551 +02283 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02284 * MOVE SPACES TO R140-MESSAGE DTSZX551 +02285 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02286 * STRING DTSZX551 +02287 * ':WARNING-SSN LNAME IS BLANK ' DTSZX551 +02288 * X144-SSN DTSZX551 +02289 * DELIMITED BY SIZE DTSZX551 +02290 * INTO R140-MESSAGE DTSZX551 +02291 * END-STRING DTSZX551 +02292 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02293 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02294 * END-IF. DTSZX551 +02295 DTSZX551 +02296 * IF X144-FIRST-NAME = SPACES DTSZX551 +02297 * SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02298 * MOVE SPACES TO R140-MESSAGE DTSZX551 +02299 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02300 * STRING DTSZX551 +02301 * ':WARNING - SSN FNAME IS BLANK ' DTSZX551 +02302 * X144-SSN DTSZX551 +02303 * DELIMITED BY SIZE DTSZX551 +02304 * INTO R140-MESSAGE DTSZX551 +02305 * END-STRING DTSZX551 +02306 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02307 * PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02308 * END-IF. DTSZX551 +02309 DTSZX551 +02310 * IF W-CURR-WAGE-QTR NOT = W-WAGE-QTR DTSZX551 +02311 * MOVE ZERO TO W-WRKR-TOT-WAGE DTSZX551 +02312 * MOVE W-WAGE-QTR TO W-CURR-WAGE-QTR DTSZX551 +02313 * END-IF. DTSZX551 +02314 DTSZX551 +02315 * MOVE X144-EARNINGS TO W-EARNINGS-X. DTSZX551 +02316 * MOVE W-EARNINGS-9 TO W-EARNINGS. DTSZX551 +02317 * ADD W-EARNINGS TO W-WRKR-TOT-WAGE. DTSZX551 +02318 * DISPLAY 'X144-LAST-NAME ' X144-LAST-NAME DTSZX551 +02319 * MOVE X144-LAST-NAME TO W-WRKR-LAST-NAME. DTSZX551 +02320 * MOVE X144-FIRST-NAME TO W-WRKR-FIRST-NAME. DTSZX551 +02321 * MOVE X144-MID-INIT TO W-WRKR-MID-INIT. DTSZX551 +02322 DTSZX551 +02323 P3010-EXIT. DTSZX551 +02324 EXIT. DTSZX551 +02325 DTSZX551 +02326 P3011-WRITE-WAGES-X144. DTSZX551 +02327 DTSZX551 +02328 ************************************************************** DTSZX551 +02329 * WRITE W4 WAGES FOR DOCS DTSZX551 +02330 ************************************************************** DTSZX551 +02331 * DTSZX551 +02332 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DTSZX551 +02333 MOVE X144-SSN TO W4-SSN. DTSZX551 +02334 MOVE 'W4' TO W4-TRAN-ID. DTSZX551 +02335 MOVE '00044001' TO W4-TRAN-OPER-ID. DTSZX551 +02336 MOVE LX42-CURR-RUN-DATE TO W4-DATE-ENTERED. DTSZX551 +02337 MOVE ZEROS TO W4-TIME-ENTERED. DTSZX551 +02338 MOVE X144-LAST-NAME (1:3) TO W4-NAME-CHECK. DTSZX551 +02339 MOVE W-X144-WAGE-QTR TO W4-QUARTER. DTSZX551 +02340 MOVE X144-EARNINGS TO W4-QUARTER-EARNINGS. DTSZX551 +02341 MOVE 2 TO W4-AFFI-CODE. DTSZX551 +02342 MOVE X144-EMP-NO TO W4-ACCOUNT. DTSZX551 +02343 MOVE MPRF-PRIMARY-NAME (1:4) TO W4-EMP-NAME. DTSZX551 +02344 DTSZX551 +02345 * MOVE ESP-TRANSACTION-AREA TO WAGE-TRANS-REC. DTSZX551 +02346 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. DTSZX551 +02347 DTSZX551 +02348 * WRITE WAGE-TRANS-REC. DTSZX551 +02349 WRITE WAGE-OUT-REC. DTSZX551 +02350 DTSZX551 +02351 IF WAGE-TEMP-STATUS-OK-88 DTSZX551 +02352 ADD +1 TO W-W4-CNT DTSZX551 +02353 * DISPLAY 'WRITE W4 ' W4-ACCOUNT ' ' W4-QUARTER DTSZX551 +02354 * ' ' W4-SSN DTSZX551 +02355 ELSE DTSZX551 +02356 DISPLAY 'ERROR WRITING W4- WAGE FILE ' DTSZX551 +02357 WAGE-TEMP-STATUS DTSZX551 +02358 END-IF. DTSZX551 +02359 DTSZX551 +02360 DTSZX551 +02361 P3011-EXIT. DTSZX551 +02362 EXIT. DTSZX551 +02363 DTSZX551 +02364 P3500-WAGES. DTSZX551 +02365 MOVE LX42-DATA-AREA TO X147-REC. DTSZX551 +02366 * DISPLAY 'X144: ' X144-REC. DTSZX551 +02367 MOVE X147-EMP-NO TO W-EMP-NO. DTSZX551 +02368 * DTSZX551 +02369 ADD +1 TO W-X147-RED-CNT DTSZX551 +02370 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 +02371 DTSZX551 +02372 ADD +1 TO W-X147-PRO-CNT DTSZX551 +02373 PERFORM P3510-EDIT-WAGES THRU P3510-EXIT DTSZX551 +02374 IF W-RPT-ERROR-NO-88 DTSZX551 +02375 PERFORM P3511-WRITE-WAGES-X147 THRU P3511-EXIT DTSZX551 +02376 ADD +1 TO W-X147-SAV-CNT DTSZX551 +02377 ELSE DTSZX551 +02378 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02379 MOVE SPACES TO R140-MESSAGE DTSZX551 +02380 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02381 STRING DTSZX551 +02382 'X430 -: WAGE RECORD CONTAINS ERRORS CANNOT PROCESS ' DTSZX551 +02383 ' ' X147-SSN DTSZX551 +02384 DELIMITED BY SIZE DTSZX551 +02385 INTO R140-MESSAGE DTSZX551 +02386 END-STRING DTSZX551 +02387 ADD +1 TO W-X147-ERR-CNT DTSZX551 +02388 ADD +1 TO W-X147-PEN-CNT DTSZX551 +02389 WRITE PEND-X147-REC FROM X147-REC DTSZX551 +02390 PERFORM P7000-WRITE-PEND-X147 THRU P7000-EXIT DTSZX551 +02391 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02392 GO TO P3500-EXIT. DTSZX551 +02393 DTSZX551 +02394 P3500-EXIT. DTSZX551 +02395 EXIT. DTSZX551 +02396 DTSZX551 +02397 P3510-EDIT-WAGES. DTSZX551 +02398 * DISPLAY 'P3010-EDIT-WAGES ' DTSZX551 +02399 * DISPLAY 'X144-QUARTER ' X144-QUARTER DTSZX551 +02400 MOVE X147-QUARTER TO W-SLASH-QTR. DTSZX551 +02401 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSZX551 +02402 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSZX551 +02403 PERFORM S004-FROM-5 THRU S004-EXIT. DTSZX551 +02404 IF NOT L004-VALID-QTR DTSZX551 +02405 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02406 MOVE SPACES TO R140-MESSAGE DTSZX551 +02407 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02408 STRING DTSZX551 +02409 ': WAGE RECORD HAS INVALID QUARTER ' DTSZX551 +02410 X147-QUARTER ' ' X147-SSN DTSZX551 +02411 DELIMITED BY SIZE DTSZX551 +02412 INTO R140-MESSAGE DTSZX551 +02413 END-STRING DTSZX551 +02414 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02415 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02416 ELSE DTSZX551 +02417 MOVE L004-QTR-5-9 TO W-X147-WAGE-QTR DTSZX551 +02418 END-IF. DTSZX551 +02419 DTSZX551 +02420 DTSZX551 +02421 IF X147-SSN NOT NUMERIC DTSZX551 +02422 * DISPLAY 'X144-SSN ' X144-SSN DTSZX551 +02423 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02424 MOVE SPACES TO R140-MESSAGE DTSZX551 +02425 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02426 STRING DTSZX551 +02427 ':WAGE RECORD NON-NUMERIC SSN ' DTSZX551 +02428 X147-SSN DTSZX551 +02429 DELIMITED BY SIZE DTSZX551 +02430 INTO R140-MESSAGE DTSZX551 +02431 END-STRING DTSZX551 +02432 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02433 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02434 ELSE DTSZX551 +02435 MOVE X147-SSN TO W-SSN DTSZX551 +02436 END-IF. DTSZX551 +02437 DTSZX551 +02438 IF X147-SSN = ZEROS DTSZX551 +02439 * DISPLAY 'X147-SSN ' X147-SSN DTSZX551 +02440 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +02441 MOVE SPACES TO R140-MESSAGE DTSZX551 +02442 MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02443 STRING DTSZX551 +02444 ':WAGE RECORD SSN = ZEROS ' DTSZX551 +02445 X147-SSN DTSZX551 +02446 DELIMITED BY SIZE DTSZX551 +02447 INTO R140-MESSAGE DTSZX551 +02448 END-STRING DTSZX551 +02449 MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02450 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSZX551 +02451 ELSE DTSZX551 +02452 MOVE X147-SSN TO W-SSN DTSZX551 +02453 END-IF. DTSZX551 +02454 DTSZX551 +02455 * DISPLAY 'SSN: ' X144-SSN ' LN: ' X144-LAST-NAME DTSZX551 +02456 * ' FN: ' X144-FIRST-NAME. DTSZX551 +02457 DTSZX551 +02458 P3510-EXIT. DTSZX551 +02459 EXIT. DTSZX551 +02460 DTSZX551 +02461 P3511-WRITE-WAGES-X147. DTSZX551 +02462 DTSZX551 +02463 ************************************************************** DTSZX551 +02464 * WRITE W2 WAGES FOR DOCS DTSZX551 +02465 ************************************************************** DTSZX551 +02466 MOVE LOW-VALUES TO ESP-TRANSACTION-AREA. DTSZX551 +02467 MOVE X147-SSN TO W2-SSN. DTSZX551 +02468 MOVE 'W2' TO W2-TRAN-ID. DTSZX551 +02469 MOVE '00044001' TO W2-OPER-ID. DTSZX551 +02470 MOVE LX42-CURR-RUN-DATE TO W2-DATE-ENTERED. DTSZX551 +02471 MOVE ZEROS TO W2-TIME-ENTERED. DTSZX551 +02472 MOVE 3 TO W2-OP-CAUSE. DTSZX551 +02473 MOVE SPACES TO W2-NAME. DTSZX551 +02474 MOVE W-X147-WAGE-QTR TO W2-QTR. DTSZX551 +02475 MOVE X147-EMP-NO TO W2-ACCOUNT-NUMBER DTSZX551 +02476 DTSZX551 +02477 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. DTSZX551 +02478 DTSZX551 +02479 WRITE WAGE-OUT-REC. DTSZX551 +02480 DTSZX551 +02481 IF WAGE-TEMP-STATUS-OK-88 DTSZX551 +02482 ADD +1 TO W-W2-CNT DTSZX551 +02483 * DISPLAY 'WRITE W2 ' W4-ACCOUNT ' ' W2-QUARTER DTSZX551 +02484 * ' ' W2-SSN DTSZX551 +02485 ELSE DTSZX551 +02486 DISPLAY 'ERROR WRITING W2- WAGE FILE ' DTSZX551 +02487 WAGE-TEMP-STATUS DTSZX551 +02488 END-IF. DTSZX551 +02489 DTSZX551 +02490 DTSZX551 +02491 P3511-EXIT. DTSZX551 +02492 EXIT. DTSZX551 +02493 P4000-WRITE-X434-PAID-REPT. DTSZX551 +02494 DTSZX551 +02495 MOVE X140-EMP-NO TO X434-EMP-NO DTSZX551 +02496 MOVE X140-QUARTER TO X434-QTR DTSZX551 +02497 * IF W-EMP-FOUND-YES-88 DTSZX551 +02498 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 +02499 * TO X434-NAME-CHECK DTSZX551 +02500 * ELSE DTSZX551 +02501 MOVE 'RPT' TO X434-NAME-CHECK DTSZX551 +02502 * END-IF. DTSZX551 +02503 DTSZX551 +02504 MOVE X140-RCVD-DATE TO X434-RCVD-DATE DTSZX551 +02505 MOVE T028-TOT-WAGE TO X434-TOT-WAGE DTSZX551 +02506 MOVE T028-EXCESS-WAGE TO X434-EXC-WAGE DTSZX551 +02507 MOVE T028-TAX-WAGE TO X434-TAX-WAGE DTSZX551 +02508 MOVE X140-REMITTANCE TO X434-X140-REMIT DTSZX551 +02509 WS-X140-REMITTANCE DTSZX551 +02510 MOVE W-X140-REMITTANCE TO X434-X145-REMIT DTSZX551 +02511 DTSZX551 +02512 COMPUTE W-T025-REMIT-AMT = W-X145-TOT-REMIT-AMT - DTSZX551 +02513 WS-X140-REMITTANCE. DTSZX551 +02514 DTSZX551 +02515 MOVE W-T025-REMIT-AMT TO X434-DIFF. DTSZX551 +02516 ADD W-T025-REMIT-AMT TO WS-T025-REMIT-AMT. DTSZX551 +02517 DTSZX551 +02518 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 +02519 MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 +02520 MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 +02521 MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 +02522 DTSZX551 +02523 * IF W-ERROR-NO-88 DTSZX551 +02524 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 +02525 * ELSE DTSZX551 +02526 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 +02527 * MOVE R140-MESSAGE TO X434-MESSAGE DTSZX551 +02528 DTSZX551 +02529 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. DTSZX551 +02530 WRITE REPT-PAID-REC FROM DETAIL-LINE-1 AFTER 1. DTSZX551 +02531 ADD 1 TO WS-LINE-CNT2. DTSZX551 +02532 ADD +1 TO WS-NUMBER-ONE. DTSZX551 +02533 DTSZX551 +02534 DTSZX551 +02535 P4000-EXIT. DTSZX551 +02536 EXIT. DTSZX551 +02537 P4100-PRINT-HEADER. DTSZX551 +02538 IF WS-LINE-CNT GREATER 58 OR DTSZX551 +02539 WS-LINE-CNT2 GREATER 58 DTSZX551 +02540 MOVE +0 TO WS-LINE-CNT DTSZX551 +02541 MOVE +0 TO WS-LINE-CNT2 DTSZX551 +02542 ADD +1 TO WS-PAGE-CNT DTSZX551 +02543 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSZX551 +02544 MOVE ' -/+ ----- MONTHLY COUNT' TO HDR5-NAME DTSZX551 +02545 WRITE REPT-PAID-REC FROM HEADER-1 AFTER TOP-OF-PAGE DTSZX551 +02546 WRITE REPT-PAID-REC FROM HEADER-2 AFTER 1 DTSZX551 +02547 WRITE REPT-PAID-REC FROM HEADER-3 AFTER 1 DTSZX551 +02548 WRITE REPT-PAID-REC FROM HEADER-4 AFTER 1 DTSZX551 +02549 WRITE REPT-PAID-REC FROM HEADER-42 AFTER 1 DTSZX551 +02550 WRITE REPT-PAID-REC FROM HEADER-5 AFTER 1 DTSZX551 +02551 WRITE REPT-PAID-REC FROM HEADER-6 AFTER 1 DTSZX551 +02552 ADD +6 TO WS-LINE-CNT2. DTSZX551 +02553 P4100-EXIT. DTSZX551 +02554 EXIT. DTSZX551 +02555 DTSZX551 +02556 P4200-PRINT-HEADER. DTSZX551 +02557 IF WSP-LINE-CNT GREATER 58 OR DTSZX551 +02558 WSP-LINE-CNT2 GREATER 58 DTSZX551 +02559 MOVE +0 TO WSP-LINE-CNT DTSZX551 +02560 MOVE +0 TO WSP-LINE-CNT2 DTSZX551 +02561 ADD +1 TO WSP-PAGE-CNT DTSZX551 +02562 MOVE WSP-PAGE-CNT TO HDR31-PAGE DTSZX551 +02563 MOVE ' * REASON FOR PENDING *' TO HDR5-NAME DTSZX551 +02564 WRITE REPT-PEND-REC FROM HEADER-1 AFTER TOP-OF-PAGE DTSZX551 +02565 WRITE REPT-PEND-REC FROM HEADER-2 AFTER 1 DTSZX551 +02566 WRITE REPT-PEND-REC FROM HEADER-31 AFTER 1 DTSZX551 +02567 WRITE REPT-PEND-REC FROM HEADER-4 AFTER 1 DTSZX551 +02568 WRITE REPT-PEND-REC FROM HEADER-42 AFTER 1 DTSZX551 +02569 WRITE REPT-PEND-REC FROM HEADER-5 AFTER 1 DTSZX551 +02570 WRITE REPT-PEND-REC FROM HEADER-6 AFTER 1 DTSZX551 +02571 ADD +6 TO WSP-LINE-CNT2. DTSZX551 +02572 P4200-EXIT. DTSZX551 +02573 EXIT. DTSZX551 +02574 DTSZX551 +02575 DTSZX551 +02576 P5000-NEW-EMP. DTSZX551 +02577 *& DTSZX551 +02578 DISPLAY ' 5000-NEW-EMP ' W-EMP-NO ' ' W-PREV-REC-TYPE DTSZX551 +02579 ' ERROR-IND ' W-RPT-ERROR-IND. DTSZX551 +02580 * IF W-PREV-RPT-PAY-88 AND DTSZX551 +02581 * W-RPT-ERROR-NO-88 DTSZX551 +02582 * LX42-X140-EMP-NO = SPACES AND DTSZX551 +02583 * LX42-X145-EMP-NO = SPACES DTSZX551 +02584 * ADD +1 TO W-X145-PEN-CNT DTSZX551 +02585 * WRITE PEND-X145-REC FROM X145-REC DTSZX551 +02586 * MOVE SPACES TO R140-MESSAGE DTSZX551 +02587 * MOVE W-EMP-NO TO R140-EMP-NO DTSZX551 +02588 * STRING DTSZX551 +02589 * ': NO REPORT FOR PAYMENT ' DTSZX551 +02590 * DELIMITED BY SIZE DTSZX551 +02591 * INTO R140-MESSAGE DTSZX551 +02592 * END-STRING DTSZX551 +02593 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02594 * PERFORM P6000-WRITE-PEND-X145 THRU P6000-EXIT DTSZX551 +02595 * PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSZX551 +02596 DTSZX551 +02597 * DISPLAY 'BX436 P5000-NEW-RPT-PAY ' W-EMP-NO ' ' LX42-EMP-NO.DTSZX551 +02598 DTSZX551 +02599 MOVE LX42-EMP-NO TO W-EMP-NO. DTSZX551 +02600 SET W-RPT-ERROR-NO-88 TO TRUE. DTSZX551 +02601 * SET W-PREV-REC-NULL-88 TO TRUE. DTSZX551 +02602 SET W-PREV-RPT-NULL-88 TO TRUE. DTSZX551 +02603 MOVE ZERO TO W-X140-REPORT-QTR DTSZX551 +02604 W-X145-PAYMENT-QTR DTSZX551 +02605 W-X144-WAGE-QTR DTSZX551 +02606 W-TOT-WAGE DTSZX551 +02607 W-TAX-WAGE DTSZX551 +02608 W-EXX-WAGE CL*12 +02609 W-WRKR-TOT-WAGE DTSZX551 +02610 W-X145-REMITTANCE DTSZX551 +02611 W-X140-REMITTANCE DTSZX551 +02612 W-X140-RECEIVED-DATE DTSZX551 +02613 W-X145-DEPOSIT-DATE DTSZX551 +02614 W-X145-RECEIVED-DATE DTSZX551 +02615 W-1ST-MNTH-CNT DTSZX551 +02616 W-2ND-MNTH-CNT DTSZX551 +02617 W-3RD-MNTH-CNT DTSZX551 +02618 W-SSN DTSZX551 +02619 W-EARNINGS DTSZX551 +02620 W-EMP-WAGE-CNT DTSZX551 +02621 W-SEQ-NO DTSZX551 +02622 W-T025-REMIT-AMT DTSZX551 +02623 W-X145-TOT-REMIT-AMT DTSZX551 +02624 W-X140-REMITTANCE DTSZX551 +02625 LX42-X140-KEY-AREA DTSZX551 +02626 LX42-X144-KEY-AREA DTSZX551 +02627 LX42-X145-KEY-AREA. DTSZX551 +02628 DTSZX551 +02629 SET W-WRITE-T025-TRAN-NO-88 TO TRUE. DTSZX551 +02630 DTSZX551 +02631 DTSZX551 +02632 MOVE SPACES TO W-WRKR-FIRST-NAME DTSZX551 +02633 W-WRKR-LAST-NAME DTSZX551 +02634 W-WRKR-MID-INIT DTSZX551 +02635 W-X145-PAYMENT-FOUND-IND DTSZX551 +02636 LX42-X140-EMP-NO DTSZX551 +02637 LX42-X144-EMP-NO DTSZX551 +02638 LX42-X145-EMP-NO DTSZX551 +02639 LX42-X140-QTR-AREA DTSZX551 +02640 LX42-X144-QTR-AREA DTSZX551 +02641 P434-MESSAGE DTSZX551 +02642 LX42-X145-QTR-AREA. DTSZX551 +02643 DTSZX551 +02644 INITIALIZE X140-REC DTSZX551 +02645 X144-REC DTSZX551 +02646 X145-REC. DTSZX551 +02647 DTSZX551 +02648 *& DTSZX551 +02649 * DISPLAY ' 5000-INI-EMP ' W-PREV-REC-TYPE DTSZX551 +02650 * ' W-RROR-IND ' W-RPT-ERROR-IND DTSZX551 +02651 * 'LX-W-RROR-IND ' W-RPT-ERROR-IND. DTSZX551 +02652 P5000-EXIT. DTSZX551 +02653 EXIT. DTSZX551 +02654 DTSZX551 +02655 P6000-WRITE-PEND-X145. DTSZX551 +02656 DTSZX551 +02657 MOVE X145-EMP-NO TO P434-EMP-NO DTSZX551 +02658 MOVE X145-QTR TO P434-QTR DTSZX551 +02659 * IF W-EMP-FOUND-YES-88 DTSZX551 +02660 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 +02661 * TO P434-NAME-CHECK DTSZX551 +02662 * ELSE DTSZX551 +02663 MOVE 'PAY' TO P434-NAME-CHECK DTSZX551 +02664 * END-IF. DTSZX551 +02665 DTSZX551 +02666 MOVE X145-RCVD-DATE TO P434-RCVD-DATE DTSZX551 +02667 MOVE ZEROS TO P434-TOT-WAGE DTSZX551 +02668 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 +02669 * MOVE ZEROS TO P434-EXC-WAGE DTSZX551 +02670 MOVE ZEROS TO P434-TAX-WAGE DTSZX551 +02671 MOVE ZEROS TO P434-X140-REMIT DTSZX551 +02672 MOVE W-X145-TOT-REMIT-AMT TO P434-X145-REMIT DTSZX551 +02673 DTSZX551 +02674 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 +02675 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 +02676 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 +02677 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 +02678 DTSZX551 +02679 * IF W-ERROR-NO-88 DTSZX551 +02680 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 +02681 * ELSE DTSZX551 +02682 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 +02683 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02684 DTSZX551 +02685 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT. DTSZX551 +02686 ADD 1 TO WS-LINE-CNT2. DTSZX551 +02687 ADD +1 TO WS-NUMBER-ONE. DTSZX551 +02688 GO TO P6000-EXIT. DTSZX551 +02689 DTSZX551 +02690 P6000-WRITE-PEND-X140. DTSZX551 +02691 DTSZX551 +02692 MOVE X140-EMP-NO TO P434-EMP-NO DTSZX551 +02693 MOVE X140-QUARTER TO P434-QTR DTSZX551 +02694 * IF W-EMP-FOUND-YES-88 DTSZX551 +02695 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 +02696 * TO P434-NAME-CHECK DTSZX551 +02697 * ELSE DTSZX551 +02698 MOVE 'RPT' TO P434-NAME-CHECK DTSZX551 +02699 * END-IF. DTSZX551 +02700 DTSZX551 +02701 MOVE X140-RCVD-DATE TO P434-RCVD-DATE DTSZX551 +02702 MOVE X140-TOTAL-WAGES TO P434-TOT-WAGE DTSZX551 +02703 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 +02704 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE DTSZX551 +02705 MOVE X140-TAX-WAGES TO P434-TAX-WAGE DTSZX551 +02706 MOVE X140-REMITTANCE TO P434-X140-REMIT DTSZX551 +02707 MOVE ZEROS TO P434-X145-REMIT DTSZX551 +02708 DTSZX551 +02709 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 +02710 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 +02711 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 +02712 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 +02713 DTSZX551 +02714 * IF W-ERROR-NO-88 DTSZX551 +02715 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 +02716 * ELSE DTSZX551 +02717 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 +02718 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02719 DTSZX551 +02720 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. DTSZX551 +02721 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 +02722 ADD 1 TO WSP-LINE-CNT2. DTSZX551 +02723 ADD +1 TO WSP-NUMBER-ONE. DTSZX551 +02724 GO TO P6000-EXIT. DTSZX551 +02725 DTSZX551 +02726 P6000-WRITE-PEND-X144. DTSZX551 +02727 DTSZX551 +02728 MOVE X140-EMP-NO TO P434-EMP-NO DTSZX551 +02729 MOVE X140-QUARTER TO P434-QTR DTSZX551 +02730 * IF W-EMP-FOUND-YES-88 DTSZX551 +02731 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 +02732 * TO P434-NAME-CHECK DTSZX551 +02733 * ELSE DTSZX551 +02734 MOVE 'WAGE' TO P434-NAME-CHECK DTSZX551 +02735 * END-IF. DTSZX551 +02736 DTSZX551 +02737 MOVE SPACES TO P434-RCVD-DATE DTSZX551 +02738 MOVE ZEROS TO P434-TOT-WAGE DTSZX551 +02739 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 +02740 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE DTSZX551 +02741 MOVE ZEROS TO P434-TAX-WAGE DTSZX551 +02742 MOVE ZEROS TO P434-X140-REMIT DTSZX551 +02743 MOVE ZEROS TO P434-X145-REMIT DTSZX551 +02744 DTSZX551 +02745 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 +02746 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 +02747 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 +02748 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 +02749 DTSZX551 +02750 * IF W-ERROR-NO-88 DTSZX551 +02751 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 +02752 * ELSE DTSZX551 +02753 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 +02754 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02755 DTSZX551 +02756 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. DTSZX551 +02757 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 +02758 ADD 1 TO WSP-LINE-CNT2. DTSZX551 +02759 ADD +1 TO WSP-NUMBER-ONE. DTSZX551 +02760 DTSZX551 +02761 DTSZX551 +02762 DTSZX551 +02763 P6000-EXIT. DTSZX551 +02764 EXIT. DTSZX551 +02765 DTSZX551 +02766 P7000-WRITE-PEND-X147. DTSZX551 +02767 DTSZX551 +02768 MOVE X147-EMP-NO TO P434-EMP-NO DTSZX551 +02769 MOVE X147-QUARTER TO P434-QTR DTSZX551 +02770 * IF W-EMP-FOUND-YES-88 DTSZX551 +02771 * MOVE MPRF-PRIMARY-NAME (1:15) DTSZX551 +02772 * TO P434-NAME-CHECK DTSZX551 +02773 * ELSE DTSZX551 +02774 MOVE 'WAGE' TO P434-NAME-CHECK DTSZX551 +02775 * END-IF. DTSZX551 +02776 DTSZX551 +02777 MOVE SPACES TO P434-RCVD-DATE DTSZX551 +02778 MOVE ZEROS TO P434-TOT-WAGE DTSZX551 +02779 MOVE ZEROS TO P434-EXC-WAGE DTSZX551 +02780 * MOVE T028-EXCESS-WAGE TO P434-EXC-WAGE DTSZX551 +02781 MOVE ZEROS TO P434-TAX-WAGE DTSZX551 +02782 MOVE ZEROS TO P434-X140-REMIT DTSZX551 +02783 MOVE ZEROS TO P434-X145-REMIT DTSZX551 +02784 DTSZX551 +02785 * MOVE ZERO TO X434-TOTAL-EMPL-CNT. DTSZX551 +02786 * MOVE X140-WRKR-CNT-1ST-MNTH TO X434-M1-CNT. DTSZX551 +02787 * MOVE X140-WRKR-CNT-2ND-MNTH TO X434-M2-CNT. DTSZX551 +02788 * MOVE X140-WRKR-CNT-3RD-MNTH TO X434-M3-CNT. DTSZX551 +02789 DTSZX551 +02790 * IF W-ERROR-NO-88 DTSZX551 +02791 * MOVE 'PROCESSED' TO X434-DISPOSITION DTSZX551 +02792 * ELSE DTSZX551 +02793 * MOVE 'PENDING ' TO X434-DISPOSITION. DTSZX551 +02794 * MOVE R140-MESSAGE TO P434-MESSAGE DTSZX551 +02795 DTSZX551 +02796 PERFORM P4200-PRINT-HEADER THRU P4200-EXIT. DTSZX551 +02797 WRITE REPT-PEND-REC FROM DETAIL-PEND-1 AFTER 1. DTSZX551 +02798 ADD 1 TO WSP-LINE-CNT2. DTSZX551 +02799 ADD +1 TO WSP-NUMBER-ONE. DTSZX551 +02800 DTSZX551 +02801 DTSZX551 +02802 DTSZX551 +02803 P7000-EXIT. DTSZX551 +02804 EXIT. DTSZX551 +02805 DTSZX551 +02806 T0000-TERMINATE. DTSZX551 +02807 IF WS-LINE-CNT2 > 52 OR WS-NUMBER-ONE = ZERO DTSZX551 +02808 PERFORM P4100-PRINT-HEADER THRU P4100-EXIT DTSZX551 +02809 END-IF. DTSZX551 +02810 MOVE W-X145-RED-CNT TO WS-FOOTING-CNT. DTSZX551 +02811 MOVE W-X145-ERR-CNT TO WS-X145-ERR-CNT. DTSZX551 +02812 MOVE W-X145-ZRO-CNT TO WS-X145-PEN-CNT. DTSZX551 +02813 MOVE W-X140-RED-CNT TO WS-X140-RED-CNT. DTSZX551 +02814 MOVE W-X140-ERR-CNT TO WS-X140-ERR-CNT. DTSZX551 +02815 MOVE W-X140-PEN-CNT TO WS-X140-PEN-CNT. DTSZX551 +02816 MOVE W-X144-RED-CNT TO WS-X144-RED-CNT. DTSZX551 +02817 MOVE W-X144-ERR-CNT TO WS-X144-ERR-CNT. DTSZX551 +02818 MOVE W-X144-PEN-CNT TO WS-X144-PEN-CNT. DTSZX551 +02819 MOVE W-TOT-REMIT-AMT TO WS-TOT-REMIT. DTSZX551 +02820 WRITE REPT-PAID-REC FROM FOOTING-LINE-1 AFTER 1. DTSZX551 +02821 WRITE REPT-PAID-REC FROM FOOTING-LINE-2 AFTER 1. DTSZX551 +02822 WRITE REPT-PAID-REC FROM FOOTING-LINE-3 AFTER 1. DTSZX551 +02823 WRITE REPT-PAID-REC FROM FOOTING-LINE-4 AFTER 1. DTSZX551 +02824 WRITE REPT-PAID-REC FROM FOOTING-LINE-5 AFTER 1. DTSZX551 +02825 WRITE REPT-PAID-REC FROM FOOTING-LINE-6 AFTER 1. DTSZX551 +02826 WRITE REPT-PAID-REC FROM FOOTING-LINE-7 AFTER 1. DTSZX551 +02827 WRITE REPT-PAID-REC FROM FOOTING-LINE-8 AFTER 1. DTSZX551 +02828 WRITE REPT-PAID-REC FROM FOOTING-LINE-9 AFTER 1. DTSZX551 +02829 WRITE REPT-PAID-REC FROM FOOTING-LINE-10 AFTER 1. DTSZX551 +02830 WRITE REPT-PAID-REC FROM FOOTING-LINE-11 AFTER 1. DTSZX551 +02831 WRITE REPT-PAID-REC FROM FOOTING-LINE-12 AFTER 1. DTSZX551 +02832 WRITE REPT-PAID-REC FROM FOOTING-LINE-13 AFTER 1. DTSZX551 +02833 WRITE REPT-PAID-REC FROM FOOTING-LINE-14 AFTER 1. DTSZX551 +02834 DTSZX551 +02835 DISPLAY ' '. DTSZX551 +02836 DTSZX551 +02837 DTSZX551 +02838 DISPLAY ' '. DTSZX551 +02839 DISPLAY '***************************************'. DTSZX551 +02840 DISPLAY '*** DTSBX451 TERMINATION AMENDED RPTS**'. DTSZX551 +02841 DISPLAY '*** ESSP-CLEARING RPT/PAYMTS/WAGES ***'. DTSZX551 +02842 DISPLAY '***************************************'. DTSZX551 +02843 DISPLAY ' '. DTSZX551 +02844 DTSZX551 +02845 PERFORM T2000-DISPLAY-TOTALS THRU T2000-EXIT. DTSZX551 +02846 DTSZX551 +02847 DISPLAY '***************************************'. DTSZX551 +02848 DTSZX551 +02849 CLOSE WAGE-FILE-OUT DTSZX551 +02850 PEND-X140-FILE DTSZX551 +02851 PEND-X144-FILE DTSZX551 +02852 PEND-X147-FILE DTSZX551 +02853 REPT-PAID-FILE DTSZX551 +02854 REPT-PEND-FILE DTSZX551 +02855 PEND-X145-FILE DTSZX551 +02856 TEMP-BTC-FILE DTSZX551 +02857 BATCH-XREF-FILE. DTSZX551 +02858 T0000-EXIT. DTSZX551 +02859 EXIT. DTSZX551 +02860 DTSZX551 +02861 DTSZX551 +02862 T2000-DISPLAY-TOTALS. DTSZX551 +02863 DISPLAY '***** QUARTERLY REPORTS ************* '. DTSZX551 +02864 DISPLAY 'TOTAL X140-REPORT RECORDS READ..........: ' DTSZX551 +02865 W-X140-RED-CNT. DTSZX551 +02866 DTSZX551 +02867 DISPLAY ' NO OF X140-REPORTS PASSED ALL EDITS....: ' DTSZX551 +02868 W-X140-SAV-CNT. DTSZX551 +02869 DTSZX551 +02870 DISPLAY ' NO OF X140-REPORTS T028 TRANS WRITTEN..: ' DTSZX551 +02871 W-T028-WRITE-CNT. DTSZX551 +02872 DTSZX551 +02873 * DISPLAY ' ##T028 TRANS WRITTEN - REMIT AMT ZERO.: ' DTSZX551 +02874 * W-T028-WRITEO-CNT. DTSZX551 +02875 DTSZX551 +02876 * DISPLAY ' #T028 TRANS WRITTEN - REMIT AMT EQUAL: ' DTSZX551 +02877 * W-T028-WRITEE-CNT. DTSZX551 +02878 DISPLAY ' NO OF X140-REPORTS WRITTEN TO PENDING..: ' DTSZX551 +02879 W-X140-PEN-CNT. DTSZX551 +02880 DISPLAY ' NO OF X140-REPORTS HAS ERRORS..........: ' DTSZX551 +02881 W-X140-ERR-CNT. DTSZX551 +02882 DISPLAY ' NO OF X140-REPORTS HAS DUPLICATE.......: ' DTSZX551 +02883 W-X140-DUP-CNT. DTSZX551 +02884 DTSZX551 +02885 DISPLAY ' '. DTSZX551 +02886 DISPLAY '***** QUARTERLY PAYMENTS ********* '. DTSZX551 +02887 DISPLAY 'TOTAL X145-PAYMENTS RECORDS READ.......: ' DTSZX551 +02888 W-X145-RED-CNT. DTSZX551 +02889 DTSZX551 +02890 DISPLAY ' NO OF X145-PAYMENTS PASSED ALL EDITS...: ' DTSZX551 +02891 W-X145-SAV-CNT. DTSZX551 +02892 DTSZX551 +02893 DISPLAY ' NO OF X145-PAYMENTS T025 TRANS WRITTEN.: ' DTSZX551 +02894 W-T025-WRITE-CNT. DTSZX551 +02895 DTSZX551 +02896 DISPLAY ' ## T025 TRANS WRITTEN-ZERO REMIT....: ' DTSZX551 +02897 W-T025-WRITEO-CNT. DTSZX551 +02898 DTSZX551 +02899 DISPLAY ' NO OF X145-PAYMENTS WRITTEN TO PENDING.: ' DTSZX551 +02900 W-X145-PEN-CNT. DTSZX551 +02901 DISPLAY ' NO OF X145-PAYMENTS HAS ERRORS.........: ' DTSZX551 +02902 W-X145-ERR-CNT. DTSZX551 +02903 DISPLAY ' NO OF X145-PAYMENTS HAS DUPLICATE......: ' DTSZX551 +02904 W-X145-DUP-CNT. DTSZX551 +02905 DTSZX551 +02906 DISPLAY ' '. DTSZX551 +02907 DISPLAY '***** QUARTERLY WAGES ************* '. DTSZX551 +02908 DISPLAY 'TOTAL X144-WAGES RECORDS READ..........: ' DTSZX551 +02909 W-X144-RED-CNT. DTSZX551 +02910 DTSZX551 +02911 DISPLAY ' NO OF X144-WAGES PASSED ALL EDITS......: ' DTSZX551 +02912 W-X144-SAV-CNT. DTSZX551 +02913 DTSZX551 +02914 DISPLAY ' NO OF X144-WAGES W004 TRANS WRITTEN....: ' DTSZX551 +02915 W-W4-CNT. DTSZX551 +02916 DTSZX551 +02917 DISPLAY ' NO OF X144-WAGES WRITTEN TO PENDING....: ' DTSZX551 +02918 W-X144-PEN-CNT. DTSZX551 +02919 DISPLAY ' NO OF X144-WAGES HAS ERRORS............: ' DTSZX551 +02920 W-X144-ERR-CNT. DTSZX551 +02921 DISPLAY ' NO OF X144-WAGES HAS DUPLICATE.........: ' DTSZX551 +02922 W-X144-DUP-CNT. DTSZX551 +02923 DTSZX551 +02924 DTSZX551 +02925 DISPLAY ' '. DTSZX551 +02926 DISPLAY '***** AMENDED WAGES DELETED ****** '. DTSZX551 +02927 DISPLAY 'TOTAL X147-WAGES RECORDS READ..........: ' DTSZX551 +02928 W-X147-RED-CNT. DTSZX551 +02929 DTSZX551 +02930 DISPLAY ' NO OF X147-WAGES PASSED ALL EDITS......: ' DTSZX551 +02931 W-X147-SAV-CNT. DTSZX551 +02932 DTSZX551 +02933 DISPLAY ' NO OF X147-WAGES W004 TRANS WRITTEN....: ' DTSZX551 +02934 W-W2-CNT. DTSZX551 +02935 DTSZX551 +02936 DISPLAY ' NO OF X147-WAGES WRITTEN TO PENDING....: ' DTSZX551 +02937 W-X147-PEN-CNT. DTSZX551 +02938 DISPLAY ' NO OF X147-WAGES HAS ERRORS............: ' DTSZX551 +02939 W-X147-ERR-CNT. DTSZX551 +02940 DISPLAY ' NO OF X147-WAGES HAS DUPLICATE.........: ' DTSZX551 +02941 W-X147-DUP-CNT. DTSZX551 +02942 DTSZX551 +02943 DTSZX551 +02944 DISPLAY ' '. DTSZX551 +02945 DISPLAY '***** END REPORTS/WAGES AND PAYMENTS **** '. DTSZX551 +02946 DTSZX551 +02947 T2000-EXIT. DTSZX551 +02948 EXIT. DTSZX551 +02949 DTSZX551 +02950 S001-FROM-FED-8. DTSZX551 +02951 SET L001-FROM-FED-8 TO TRUE. DTSZX551 +02952 GO TO S001-DATE. DTSZX551 +02953 DTSZX551 +02954 S001-FROM-CAL-8. DTSZX551 +02955 SET L001-FROM-CAL-8 TO TRUE. DTSZX551 +02956 GO TO S001-DATE. DTSZX551 +02957 DTSZX551 +02958 S001-FROM-ABS-DAY. DTSZX551 +02959 SET L001-FROM-ABS-DAY TO TRUE. DTSZX551 +02960 GO TO S001-DATE. DTSZX551 +02961 DTSZX551 +02962 S001-DATE. DTSZX551 +02963 CALL 'DTSBU001' USING L001-LINK-AREA. DTSZX551 +02964 S001-EXIT. DTSZX551 +02965 EXIT. DTSZX551 +02966 DTSZX551 +02967 S003-AGENCY-DAY. DTSZX551 +02968 SET L003-AGENCY-DAY TO TRUE. DTSZX551 +02969 GO TO S003-WORK-DAY. DTSZX551 +02970 DTSZX551 +02971 S003-WORK-DAY. DTSZX551 +02972 CALL 'DTSBU003' USING L003-LINK-AREA. DTSZX551 +02973 S003-EXIT. DTSZX551 +02974 EXIT. DTSZX551 +02975 DTSZX551 +02976 S004-FROM-5. DTSZX551 +02977 SET L004-FROM-5 TO TRUE. DTSZX551 +02978 GO TO S004-YRQ. DTSZX551 +02979 DTSZX551 +02980 S004-FROM-DATE. DTSZX551 +02981 SET L004-FROM-DATE TO TRUE. DTSZX551 +02982 GO TO S004-YRQ. DTSZX551 +02983 DTSZX551 +02984 S004-FROM-ABS. DTSZX551 +02985 SET L004-FROM-ABS TO TRUE. DTSZX551 +02986 GO TO S004-YRQ. DTSZX551 +02987 DTSZX551 +02988 S004-YRQ. DTSZX551 +02989 CALL 'DTSBU004' USING L004-LINK-AREA. DTSZX551 +02990 DTSZX551 +02991 S004-EXIT. DTSZX551 +02992 EXIT. DTSZX551 +02993 DTSZX551 +02994 S516-LIABILITY-INFO. DTSZX551 +02995 CALL 'DTSBU516' USING L516-LINK-AREA DTSZX551 +02996 MPRF-REC. DTSZX551 +02997 S516-EXIT. DTSZX551 +02998 EXIT. DTSZX551 +02999 DTSZX551 +03000 S910-OPEN-READ. DTSZX551 +03001 SET L910-OPEN-READ-88 TO TRUE. DTSZX551 +03002 GO TO S910-MSTR-IO. DTSZX551 +03003 DTSZX551 +03004 S910-READ. DTSZX551 +03005 SET L910-READ-88 TO TRUE. DTSZX551 +03006 GO TO S910-MSTR-IO. DTSZX551 +03007 DTSZX551 +03008 S910-START-BROWSE. DTSZX551 +03009 SET L910-START-BROWSE-88 TO TRUE. DTSZX551 +03010 GO TO S910-MSTR-IO. DTSZX551 +03011 DTSZX551 +03012 S910-READ-NEXT. DTSZX551 +03013 SET L910-READ-NEXT-88 TO TRUE. DTSZX551 +03014 GO TO S910-MSTR-IO. DTSZX551 +03015 DTSZX551 +03016 S910-CLOSE. DTSZX551 +03017 SET L910-CLOSE-88 TO TRUE. DTSZX551 +03018 GO TO S910-MSTR-IO. DTSZX551 +03019 DTSZX551 +03020 S910-MSTR-IO. DTSZX551 +03021 CALL 'DTSBU910' USING L910-LINK-AREA DTSZX551 +03022 MSKL-REC. DTSZX551 +03023 S910-EXIT. DTSZX551 +03024 EXIT. DTSZX551 +03025 DTSZX551 +03026 S921-OPEN-READ. DTSZX551 +03027 SET L921-OPEN-READ-88 TO TRUE. DTSZX551 +03028 GO TO S921-AIX-IO. DTSZX551 +03029 DTSZX551 +03030 S921-READ. DTSZX551 +03031 SET L921-READ-88 TO TRUE. DTSZX551 +03032 GO TO S921-AIX-IO. DTSZX551 +03033 DTSZX551 +03034 S921-START-BROWSE. DTSZX551 +03035 SET L921-START-BROWSE-88 TO TRUE. DTSZX551 +03036 GO TO S921-AIX-IO. DTSZX551 +03037 DTSZX551 +03038 S921-READ-NEXT. DTSZX551 +03039 SET L921-READ-NEXT-88 TO TRUE. DTSZX551 +03040 GO TO S921-AIX-IO. DTSZX551 +03041 DTSZX551 +03042 S921-CLOSE. DTSZX551 +03043 SET L921-CLOSE-88 TO TRUE. DTSZX551 +03044 GO TO S921-AIX-IO. DTSZX551 +03045 DTSZX551 +03046 S921-AIX-IO. DTSZX551 +03047 CALL 'DTSBU921' USING L921-LINK-AREA DTSZX551 +03048 ISKL-REC. DTSZX551 +03049 S921-EXIT. DTSZX551 +03050 EXIT. DTSZX551 +03051 DTSZX551 +03052 S923-OPEN-UPDATE. DTSZX551 +03053 SET L923-OPEN-UPDATE-88 TO TRUE. DTSZX551 +03054 GO TO S923-ATC-CALL. DTSZX551 +03055 DTSZX551 +03056 S923-WRITE. DTSZX551 +03057 SET L923-WRITE-88 TO TRUE. DTSZX551 +03058 GO TO S923-ATC-CALL. DTSZX551 +03059 DTSZX551 +03060 S923-CLOSE. DTSZX551 +03061 SET L923-CLOSE-88 TO TRUE. DTSZX551 +03062 GO TO S923-ATC-CALL. DTSZX551 +03063 DTSZX551 +03064 S923-ATC-CALL. DTSZX551 +03065 CALL 'DTSBU923' USING L923-LINK-AREA DTSZX551 +03066 ASKL-REC. DTSZX551 +03067 S923-EXIT. DTSZX551 +03068 EXIT. DTSZX551 +03069 DTSZX551 +03070 *S927A-OPEN. DTSZX551 +03071 * SET L927-OPEN-UPDATE-88 TO TRUE. DTSZX551 +03072 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX551 +03073 * DTSZX551 +03074 *S927A-EXIT. DTSZX551 +03075 * EXIT. DTSZX551 +03076 DTSZX551 +03077 S927B-WRITE. DTSZX551 +03078 SET L927-WRITE-88 TO TRUE. DTSZX551 +03079 PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX551 +03080 DTSZX551 +03081 S927B-EXIT. DTSZX551 +03082 EXIT. DTSZX551 +03083 DTSZX551 +03084 *S927C-CLOSE. DTSZX551 +03085 * SET L927-CLOSE-88 TO TRUE. DTSZX551 +03086 * PERFORM S927Z-IO THRU S927Z-EXIT. DTSZX551 +03087 * DTSZX551 +03088 *S927C-EXIT. DTSZX551 +03089 * EXIT. DTSZX551 +03090 DTSZX551 +03091 S927Z-IO. DTSZX551 +03092 CALL 'DTSBU927' USING L927-LINK-AREA DTSZX551 +03093 TSKL-REC. DTSZX551 +03094 S927Z-EXIT. DTSZX551 +03095 EXIT. DTSZX551 +03096 DTSZX551 +03097 S931-OPEN-READ. DTSZX551 +03098 SET L931-OPEN-READ-88 TO TRUE. DTSZX551 +03099 GO TO S931-REF-IO. DTSZX551 +03100 DTSZX551 +03101 S931-CLOSE. DTSZX551 +03102 SET L931-CLOSE-88 TO TRUE. DTSZX551 +03103 GO TO S931-REF-IO. DTSZX551 +03104 DTSZX551 +03105 S931-REF-IO. DTSZX551 +03106 CALL 'DTSBU931' USING L931-LINK-AREA DTSZX551 +03107 FSKL-REC. DTSZX551 +03108 S931-EXIT. DTSZX551 +03109 EXIT. DTSZX551 +03110 DTSZX551 +03111 S1032-WRITE-TEMP-T028. DTSZX551 +03112 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSZX551 +03113 MOVE T028-REC TO TEMP-BTC-REC. DTSZX551 +03114 WRITE TEMP-BTC-REC. DTSZX551 +03115 IF TEMP-BTC-STATUS-OK-88 DTSZX551 +03116 NEXT SENTENCE DTSZX551 +03117 ELSE DTSZX551 +03118 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +03119 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSZX551 +03120 TEMP-BTC-STATUS DTSZX551 +03121 END-IF. DTSZX551 +03122 DTSZX551 +03123 S1032-EXIT. DTSZX551 +03124 EXIT. DTSZX551 +03125 DTSZX551 +03126 S1033-WRITE-TEMP-T025. DTSZX551 +03127 MOVE T025-LENGTH TO VAR-CHAR-CNT. DTSZX551 +03128 MOVE T025-REC TO TEMP-BTC-REC. DTSZX551 +03129 WRITE TEMP-BTC-REC. DTSZX551 +03130 IF TEMP-BTC-STATUS-OK-88 DTSZX551 +03131 NEXT SENTENCE DTSZX551 +03132 ELSE DTSZX551 +03133 SET W-RPT-ERROR-YES-88 TO TRUE DTSZX551 +03134 DISPLAY 'CANNOT WRITE TEMP T025: ' DTSZX551 +03135 TEMP-BTC-STATUS DTSZX551 +03136 END-IF. DTSZX551 +03137 DTSZX551 +03138 S1033-EXIT. DTSZX551 +03139 EXIT. DTSZX551 +03140 DTSZX551 +03141 S1040-OPEN-TEMP-BTC-OUT. DTSZX551 +03142 OPEN OUTPUT TEMP-BTC-FILE. DTSZX551 +03143 IF TEMP-BTC-STATUS-OK-88 DTSZX551 +03144 NEXT SENTENCE DTSZX551 +03145 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSZX551 +03146 *** DISPLAY 'TEMP BTC OPENED OUTPUT ' DTSZX551 +03147 ELSE DTSZX551 +03148 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03149 DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: ' DTSZX551 +03150 TEMP-BTC-STATUS DTSZX551 +03151 END-IF. DTSZX551 +03152 DTSZX551 +03153 S1040-EXIT. DTSZX551 +03154 EXIT. DTSZX551 +03155 DTSZX551 +03156 S1050-OPEN-TEMP-BTC-IN. DTSZX551 +03157 OPEN INPUT TEMP-BTC-FILE. DTSZX551 +03158 IF TEMP-BTC-STATUS-OK-88 DTSZX551 +03159 NEXT SENTENCE DTSZX551 +03160 *** SET WAGE-TEMP-OPEN-88 TO TRUE DTSZX551 +03161 *** DISPLAY 'TEMP BTC OPENED INP ' DTSZX551 +03162 ELSE DTSZX551 +03163 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03164 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSZX551 +03165 TEMP-BTC-STATUS DTSZX551 +03166 END-IF. DTSZX551 +03167 DTSZX551 +03168 S1050-EXIT. DTSZX551 +03169 EXIT. DTSZX551 +03170 DTSZX551 +03171 S1060-CLOSE-TEMP-BTC. DTSZX551 +03172 CLOSE TEMP-BTC-FILE. DTSZX551 +03173 IF TEMP-BTC-STATUS-OK-88 DTSZX551 +03174 *** DISPLAY 'TEMP-BTC CLOSED' DTSZX551 +03175 NEXT SENTENCE DTSZX551 +03176 ELSE DTSZX551 +03177 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03178 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSZX551 +03179 TEMP-BTC-STATUS DTSZX551 +03180 END-IF. DTSZX551 +03181 DTSZX551 +03182 S1060-EXIT. DTSZX551 +03183 EXIT. DTSZX551 +03184 DTSZX551 +03185 S1070-READ-TEMP-BTC. DTSZX551 +03186 READ TEMP-BTC-FILE. DTSZX551 +03187 IF TEMP-BTC-STATUS-OK-88 DTSZX551 +03188 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSZX551 +03189 ELSE DTSZX551 +03190 IF TEMP-BTC-STATUS-EOF-88 DTSZX551 +03191 NEXT SENTENCE DTSZX551 +03192 ELSE DTSZX551 +03193 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSZX551 +03194 TEMP-BTC-STATUS DTSZX551 +03195 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03196 END-IF DTSZX551 +03197 END-IF. DTSZX551 +03198 DTSZX551 +03199 S1070-EXIT. DTSZX551 +03200 EXIT. DTSZX551 +03201 DTSZX551 +03202 S1100-OPEN-WAGE-TEMP-OUT. DTSZX551 +03203 OPEN OUTPUT WAGE-FILE-TEMP. DTSZX551 +03204 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 +03205 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03206 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSZX551 +03207 WAGE-TEMP-STATUS DTSZX551 +03208 END-IF. DTSZX551 +03209 DTSZX551 +03210 S1100-EXIT. DTSZX551 +03211 EXIT. DTSZX551 +03212 DTSZX551 +03213 S1110-CLOSE-WAGE-TEMP. DTSZX551 +03214 CLOSE WAGE-FILE-TEMP. DTSZX551 +03215 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 +03216 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03217 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSZX551 +03218 WAGE-TEMP-STATUS DTSZX551 +03219 END-IF. DTSZX551 +03220 DTSZX551 +03221 S1110-EXIT. DTSZX551 +03222 EXIT. DTSZX551 +03223 DTSZX551 +03224 S1120-WRITE-WAGE-TEMP. DTSZX551 +03225 WRITE WAGE-TEMP-REC FROM W001-REC. DTSZX551 +03226 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 +03227 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03228 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSZX551 +03229 WAGE-TEMP-STATUS DTSZX551 +03230 END-IF. DTSZX551 +03231 DTSZX551 +03232 S1120-EXIT. DTSZX551 +03233 EXIT. DTSZX551 +03234 DTSZX551 +03235 S1130-OPEN-WAGE-TEMP-IN. DTSZX551 +03236 OPEN INPUT WAGE-FILE-TEMP. DTSZX551 +03237 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 +03238 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03239 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSZX551 +03240 WAGE-TEMP-STATUS DTSZX551 +03241 END-IF. DTSZX551 +03242 DTSZX551 +03243 S1130-EXIT. DTSZX551 +03244 EXIT. DTSZX551 +03245 DTSZX551 +03246 S1140-READ-WAGE-TEMP. DTSZX551 +03247 READ WAGE-FILE-TEMP INTO W001-REC. DTSZX551 +03248 IF WAGE-TEMP-STATUS-EOF-88 DTSZX551 +03249 NEXT SENTENCE DTSZX551 +03250 ELSE DTSZX551 +03251 IF NOT WAGE-TEMP-STATUS-OK-88 DTSZX551 +03252 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03253 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSZX551 +03254 WAGE-TEMP-STATUS DTSZX551 +03255 END-IF DTSZX551 +03256 END-IF. DTSZX551 +03257 DTSZX551 +03258 S1140-EXIT. DTSZX551 +03259 EXIT. DTSZX551 +03260 DTSZX551 +03261 S1150-OPEN-WAGE-FILE-OUT. DTSZX551 +03262 OPEN OUTPUT WAGE-FILE-OUT. DTSZX551 +03263 IF NOT WAGE-OUT-STATUS-OK-88 DTSZX551 +03264 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03265 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' DTSZX551 +03266 WAGE-OUT-STATUS DTSZX551 +03267 END-IF. DTSZX551 +03268 DTSZX551 +03269 S1150-EXIT. DTSZX551 +03270 EXIT. DTSZX551 +03271 DTSZX551 +03272 S1160-CLOSE-WAGE-OUT. DTSZX551 +03273 CLOSE WAGE-FILE-OUT. DTSZX551 +03274 IF NOT WAGE-OUT-STATUS-OK-88 DTSZX551 +03275 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03276 DISPLAY 'CANNOT CLOSE WAGE FILE: ' DTSZX551 +03277 WAGE-OUT-STATUS DTSZX551 +03278 END-IF. DTSZX551 +03279 DTSZX551 +03280 S1160-EXIT. DTSZX551 +03281 EXIT. DTSZX551 +03282 DTSZX551 +03283 S1170-WRITE-WAGE-OUT. DTSZX551 +03284 MOVE ESP-TRANSACTION-AREA TO WAGE-OUT-REC. DTSZX551 +03285 WRITE WAGE-OUT-REC. DTSZX551 +03286 IF NOT WAGE-OUT-STATUS-OK-88 DTSZX551 +03287 SET W-FATAL-ERROR-YES-88 TO TRUE DTSZX551 +03288 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' DTSZX551 +03289 WAGE-OUT-STATUS DTSZX551 +03290 END-IF. DTSZX551 +03291 DTSZX551 +03292 S1170-EXIT. DTSZX551 +03293 EXIT. DTSZX551 +03294 DTSZX551 +03295 S946-WRITE-R140. DTSZX551 +03296 CALL 'DTSBU946' USING R140-REC. DTSZX551 +03297 DTSZX551 +03298 S946-EXIT. DTSZX551 +03299 EXIT. DTSZX551 +03300 DTSZX551 +03301 S999-ABEND. DTSZX551 +03302 CALL 'DTSBU999' USING W-ABEND-CD. DTSZX551 +03303 S999-EXIT. DTSZX551 +03304 EXIT. DTSZX551 +03305 DTSZX551 diff --git a/Batch/DTSZXPFL.cob b/Batch/DTSZXPFL.cob new file mode 100644 index 0000000..e4d22a4 --- /dev/null +++ b/Batch/DTSZXPFL.cob @@ -0,0 +1,781 @@ +00001 IDENTIFICATION DIVISION. 05/30/24 +00002 PROGRAM-ID. DTSZXPFL. DTSZXPFL +00003 AUTHOR. HUDAK. LV038 +00004 DATE-WRITTEN. JAN2021. CL**4 +00005 DATE-COMPILED. DTSZXPFL +00006 SKIP3 DTSZXPFL +00007 ***** DTSZXPFL +00008 * DTSZXPFL +00009 * FUNCTION: MERGE PFL AND UI TAX FILES FOR OTR DTSZXPFL +00010 * DTSZXPFL +00011 *5/30/24 CHG TOTAL AMOUNT OWED FROM 100 TO 1000 DOLLARS ZL1 CL*38 +00012 ***** DTSZXPFL +00013 SKIP3 DTSZXPFL +00014 ENVIRONMENT DIVISION. DTSZXPFL +00015 SKIP2 DTSZXPFL +00016 CONFIGURATION SECTION. DTSZXPFL +00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSZXPFL +00018 DTSZXPFL +00019 INPUT-OUTPUT SECTION. DTSZXPFL +00020 DTSZXPFL +00021 FILE-CONTROL. DTSZXPFL +00022 SELECT TAX-FILE1 ASSIGN TO TAXFILE1 DTSZXPFL +00023 FILE STATUS IS TAX-STATUS. DTSZXPFL +00024 SELECT PFL-FILE1 ASSIGN TO PFLFILE1 DTSZXPFL +00025 FILE STATUS IS PFL-STATUS. DTSZXPFL +00026 SELECT TAX-FILE2 ASSIGN TO TAXFILE2 DTSZXPFL +00027 FILE STATUS IS TAX2-STATUS. DTSZXPFL +00028 DTSZXPFL +00029 DTSZXPFL +00030 DATA DIVISION. DTSZXPFL +00031 DTSZXPFL +00032 FILE SECTION. DTSZXPFL +00033 DTSZXPFL +00034 FD TAX-FILE1 DTSZXPFL +00035 RECORDING MODE IS F. DTSZXPFL +00036 01 TAX-REC1. DTSZXPFL +00037 05 TAX-RECORD PIC X(386). DTSZXPFL +00038 DTSZXPFL +00039 DTSZXPFL +00040 FD PFL-FILE1 DTSZXPFL +00041 RECORDING MODE IS F. DTSZXPFL +00042 01 PFL-REC1. DTSZXPFL +00043 05 PFL-RECORD PIC X(386). DTSZXPFL +00044 DTSZXPFL +00045 DTSZXPFL +00046 FD TAX-FILE2 DTSZXPFL +00047 RECORDING MODE IS F. DTSZXPFL +00048 01 TAX-REC2. DTSZXPFL +00049 05 TAX-RECORD2 PIC X(386). DTSZXPFL +00050 DTSZXPFL +00051 DTSZXPFL +00052 WORKING-STORAGE SECTION. DTSZXPFL +000525 77 PAN-VALET PICTURE X(24) VALUE '038DTSZXPFL 05/30/24'. DTSZXPFL +00053 77 PAN-VALET PICTURE X(24) VALUE '053DTSBXPFL 10/05/21'. DTSZXPFL +00054 SKIP3 DTSZXPFL +00055 01 WRK-AREA. DTSZXPFL +00056 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSZXPFL +00057 DTSZXPFL +00058 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'.DTSZXPFL +00059 DTSZXPFL +00060 05 WRK-MPRF-IND PIC X(01). DTSZXPFL +00061 88 WRK-MPRF-OK VALUE 'Y'. DTSZXPFL +00062 88 WRK-MPRF-NO-REC VALUE 'N'. DTSZXPFL +00063 05 WRK-MEVL-IND PIC X(01). DTSZXPFL +00064 88 WRK-MEVL-OK VALUE 'Y'. DTSZXPFL +00065 88 WRK-MEVL-NO-REC VALUE 'N'. DTSZXPFL +00066 05 WRK-ERROR-IND PIC X(01). DTSZXPFL +00067 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSZXPFL +00068 88 WRK-ERROR-NO-88 VALUE 'N'. DTSZXPFL +00069 *RW1 DTSZXPFL +00070 05 HLD-ID PIC 9(01) VALUE ZEROS. CL*20 +00071 05 TAX-READ PIC 9(05) VALUE ZEROS. CL*20 +00072 05 DUP-CNT PIC 9(05) VALUE ZEROS. CL*36 +00073 05 ZUP-CNT PIC 9(05) VALUE ZEROS. CL*36 +00074 05 REC-CNT PIC 9(05) VALUE ZEROS. CL*35 +00075 05 ZEC-CNT PIC 9(05) VALUE ZEROS. CL*35 +00076 05 HLD-AGY-TRACKING-ID PIC X(13) VALUE SPACES. CL*18 +00077 05 EXP-STATUS PIC X(02). CL*17 +00078 88 EXP-STATUS-OK-88 VALUE '00'. DTSZXPFL +00079 05 TAX-STATUS PIC X(02). DTSZXPFL +00080 88 TAX-STATUS-OK-88 VALUE '00'. DTSZXPFL +00081 05 PFL-STATUS PIC X(02). DTSZXPFL +00082 88 PFL-STATUS-OK-88 VALUE '00'. DTSZXPFL +00083 05 TAX2-STATUS PIC X(02). DTSZXPFL +00084 88 TAX2-STATUS-OK-88 VALUE '00'. DTSZXPFL +00085 DTSZXPFL +00086 05 WRK-SPLIT. DTSZXPFL +00087 10 FILLER PIC X(1) VALUE '$'. DTSZXPFL +00088 10 WRK-DOL PIC 9(09). DTSZXPFL +00089 10 FILLER PIC X(1) VALUE '.'. DTSZXPFL +00090 10 WRK-CENT PIC 9(02). DTSZXPFL +00091 DTSZXPFL +00092 05 WS-TAX-AMT PIC 9(09)V99. CL*33 +00093 05 WS-PFL-AMT PIC 9(09)V99. CL*33 +00094 05 WS-TOTAL-AMT PIC 9(09)V99. CL*33 +00095 05 WRK-BAL PIC 9(09)V9(02) VALUE 999.99. CL*38 +00096 05 FILE-END PIC X(01) VALUE 'N'. DTSZXPFL +00097 05 PFL-FILE-END PIC X(01) VALUE 'N'. DTSZXPFL +00098 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSZXPFL +00099 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSZXPFL +00100 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSZXPFL +00101 05 WRK-TRACE-IND PIC X(01). DTSZXPFL +00102 05 WS-REC-CNT PIC 9(07). DTSZXPFL +00103 01 HEADER-REC. DTSZXPFL +00104 DTSZXPFL +00105 05 FILLER PIC X(07) VALUE 'HEADER='. DTSZXPFL +00106 05 HEADER-CNT PIC 9(07). DTSZXPFL +00107 05 HLD-DEBT-AMT PIC ----------9.99. CL*20 +00108 DTSZXPFL +00109 DTSZXPFL +00110 01 PFL-FILE. DTSZXPFL +00111 DTSZXPFL +00112 05 PFL-AGY-TRACKING-ID PIC X(13). DTSZXPFL +00113 05 FILLER PIC X(01). DTSZXPFL +00114 05 PFL-AGY-ID-ADM-DIV PIC X(06). DTSZXPFL +00115 05 FILLER PIC X(01). DTSZXPFL +00116 05 PFL-ENTITY-ID-TYPE PIC X(01). DTSZXPFL +00117 88 PFL-ENTITY-TYPE-SSN-88 VALUE 'S'. DTSZXPFL +00118 88 PFL-ENTITY-TYPE-EIN-88 VALUE 'E'. DTSZXPFL +00119 05 FILLER PIC X(01). DTSZXPFL +00120 05 PFL-ENTITY-ID PIC X(09). DTSZXPFL +00121 05 FILLER PIC X(01). DTSZXPFL +00122 05 PFL-RELATIONSHIP-IND PIC X(01). DTSZXPFL +00123 88 PFL-RELATION-EXISTS-88 VALUE 'R'. DTSZXPFL +00124 88 PFL-NO-RELATION-88 VALUE 'N'. DTSZXPFL +00125 05 FILLER PIC X(01). DTSZXPFL +00126 05 PFL-ENTITY-BUSNS-NAME PIC X(70). DTSZXPFL +00127 05 FILLER PIC X(01). DTSZXPFL +00128 05 PFL-ENTITY-LAST-NAME PIC X(35). DTSZXPFL +00129 05 FILLER PIC X(01). DTSZXPFL +00130 05 PFL-ENTITY-FIRST-NAME PIC X(35). DTSZXPFL +00131 05 FILLER PIC X(01). DTSZXPFL +00132 05 PFL-ENTITY-MID-INIT PIC X(01). DTSZXPFL +00133 05 FILLER PIC X(01). DTSZXPFL +00134 05 PFL-ENTITY-SUFFIX PIC X(10). DTSZXPFL +00135 05 FILLER PIC X(01). DTSZXPFL +00136 05 PFL-ENTITY-DOB PIC X(10). DTSZXPFL +00137 05 FILLER PIC X(01). DTSZXPFL +00138 05 PFL-STREET-NUMBER PIC X(10). DTSZXPFL +00139 05 FILLER PIC X(01). DTSZXPFL +00140 05 PFL-STREET-NAME PIC X(100). DTSZXPFL +00141 05 FILLER PIC X(01). DTSZXPFL +00142 05 PFL-CITY PIC X(30). DTSZXPFL +00143 05 FILLER PIC X(01). DTSZXPFL +00144 05 PFL-STATE PIC X(02). DTSZXPFL +00145 05 FILLER PIC X(01). DTSZXPFL +00146 05 PFL-ZIP PIC X(05). DTSZXPFL +00147 05 FILLER PIC X(01). DTSZXPFL +00148 05 PFL-ZIP-EXT PIC X(04). DTSZXPFL +00149 05 FILLER PIC X(01). DTSZXPFL +00150 05 PFL-FAILURE-TO-FILE-IND PIC X(01). DTSZXPFL +00151 88 PFL-FAIL-TO-FILE-YES-88 VALUE 'Y'. DTSZXPFL +00152 88 PFL-FAIL-TO-FILE-NO-88 VALUE 'N'. DTSZXPFL +00153 05 FILLER PIC X(01). DTSZXPFL +00154 05 PFL-DEBT-AMT PIC ----------9.99. DTSZXPFL +00155 05 FILLER PIC X(01). DTSZXPFL +00156 05 PFL-AGY-REPORT-DT PIC X(10). DTSZXPFL +00157 DTSZXPFL +00158 DTSZXPFL +00159 DTSZXPFL +00160 01 EMP-REC1. DTSZXPFL +00161 DTSZXPFL +00162 05 TAX-AGY-TRACKING-ID PIC X(13). DTSZXPFL +00163 05 FILLER PIC X(01). DTSZXPFL +00164 05 TAX-AGY-ID-ADM-DIV PIC X(06). DTSZXPFL +00165 05 FILLER PIC X(01). DTSZXPFL +00166 05 TAX-ENTITY-ID-TYPE PIC X(01). DTSZXPFL +00167 88 TAX-ENTITY-TYPE-SSN-88 VALUE 'S'. DTSZXPFL +00168 88 TAX-ENTITY-TYPE-EIN-88 VALUE 'E'. DTSZXPFL +00169 05 FILLER PIC X(01). DTSZXPFL +00170 05 TAX-ENTITY-ID PIC X(09). DTSZXPFL +00171 05 FILLER PIC X(01). DTSZXPFL +00172 05 TAX-RELATIONSHIP-IND PIC X(01). DTSZXPFL +00173 88 TAX0-RELATION-EXISTS-88 VALUE 'R'. DTSZXPFL +00174 88 TAX0-NO-RELATION-88 VALUE 'N'. DTSZXPFL +00175 05 FILLER PIC X(01). DTSZXPFL +00176 05 TAX-ENTITY-BUSNS-NAME PIC X(70). DTSZXPFL +00177 05 FILLER PIC X(01). DTSZXPFL +00178 05 TAX-ENTITY-LAST-NAME PIC X(35). DTSZXPFL +00179 05 FILLER PIC X(01). DTSZXPFL +00180 05 TAX-ENTITY-FIRST-NAME PIC X(35). DTSZXPFL +00181 05 FILLER PIC X(01). DTSZXPFL +00182 05 TAX-ENTITY-MID-INIT PIC X(01). DTSZXPFL +00183 05 FILLER PIC X(01). DTSZXPFL +00184 05 TAX-ENTITY-SUFFIX PIC X(10). DTSZXPFL +00185 05 FILLER PIC X(01). DTSZXPFL +00186 05 TAX-ENTITY-DOB PIC X(10). DTSZXPFL +00187 05 FILLER PIC X(01). DTSZXPFL +00188 05 TAX-STREET-NUMBER PIC X(10). DTSZXPFL +00189 05 FILLER PIC X(01). DTSZXPFL +00190 05 TAX-STREET-NAME PIC X(100). DTSZXPFL +00191 05 FILLER PIC X(01). DTSZXPFL +00192 05 TAX-CITY PIC X(30). DTSZXPFL +00193 05 FILLER PIC X(01). DTSZXPFL +00194 05 TAX-STATE PIC X(02). DTSZXPFL +00195 05 FILLER PIC X(01). DTSZXPFL +00196 05 TAX-ZIP PIC X(05). DTSZXPFL +00197 05 FILLER PIC X(01). DTSZXPFL +00198 05 TAX-ZIP-EXT PIC X(04). DTSZXPFL +00199 05 FILLER PIC X(01). DTSZXPFL +00200 05 TAX-FAILURE-TO-FILE-IND PIC X(01). DTSZXPFL +00201 88 TAX-FAIL-TO-FILE-YES-88 VALUE 'Y'. DTSZXPFL +00202 88 TAX-FAIL-TO-FILE-NO-88 VALUE 'N'. DTSZXPFL +00203 05 FILLER PIC X(01). DTSZXPFL +00204 05 TAX-DEBT-AMT PIC ----------9.99. DTSZXPFL +00205 05 FILLER PIC X(01). DTSZXPFL +00206 05 TAX-AGY-REPORT-DT PIC X(10). DTSZXPFL +00207 DTSZXPFL +00208 DTSZXPFL +00209 DTSZXPFL +00210 01 EMP-REC2. DTSZXPFL +00211 05 TAX2-AGY-TRACKING-ID PIC X(13). DTSZXPFL +00212 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00213 05 TAX2-AGY-ID-ADM-DIV PIC X(06). DTSZXPFL +00214 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00215 05 TAX2-ENTITY-ID-TYPE PIC X(01). DTSZXPFL +00216 88 TAX2-ENTITY-TYPE-SSN-88 VALUE 'S'. DTSZXPFL +00217 88 TAX2-ENTITY-TYPE-EIN-88 VALUE 'E'. DTSZXPFL +00218 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00219 05 TAX2-ENTITY-ID PIC X(09). DTSZXPFL +00220 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00221 05 TAX2-RELATIONSHIP-IND PIC X(01). DTSZXPFL +00222 88 TAX02-RELATION-EXISTS-88 VALUE 'R'. DTSZXPFL +00223 88 TAX02-NO-RELATION-88 VALUE 'N'. DTSZXPFL +00224 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00225 05 TAX2-ENTITY-BUSNS-NAME PIC X(70). DTSZXPFL +00226 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00227 05 TAX2-ENTITY-LAST-NAME PIC X(35). DTSZXPFL +00228 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00229 05 TAX2-ENTITY-FIRST-NAME PIC X(35). DTSZXPFL +00230 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00231 05 TAX2-ENTITY-MID-INIT PIC X(01). DTSZXPFL +00232 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00233 05 TAX2-ENTITY-SUFFIX PIC X(10). DTSZXPFL +00234 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00235 05 TAX2-ENTITY-DOB PIC X(10). DTSZXPFL +00236 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00237 05 TAX2-STREET-NUMBER PIC X(10). DTSZXPFL +00238 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00239 05 TAX2-STREET-NAME PIC X(100). DTSZXPFL +00240 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00241 05 TAX2-CITY PIC X(30). DTSZXPFL +00242 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00243 05 TAX2-STATE PIC X(02). DTSZXPFL +00244 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00245 05 TAX2-ZIP PIC X(05). DTSZXPFL +00246 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00247 05 TAX2-ZIP-EXT PIC X(04). DTSZXPFL +00248 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00249 05 TAX2-FAILURE-TO-FILE-IND PIC X(01). DTSZXPFL +00250 88 TAX2-FAIL-TO-FILE-YES-88 VALUE 'Y'. DTSZXPFL +00251 88 TAX2-FAIL-TO-FILE-NO-88 VALUE 'N'. DTSZXPFL +00252 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00253 05 TAX2-DEBT-AMT PIC ZZZZZZZZZZ9.99. DTSZXPFL +00254 05 FILLER PIC X(01) VALUE '|'. DTSZXPFL +00255 05 TAX2-AGY-REPORT-DT PIC X(10). DTSZXPFL +00256 01 TSKL-REC. DTSZXPFL +00257 ++INCLUDE DTSITSKL DTSZXPFL +00258 EJECT DTSZXPFL +00259 01 T003-REC. DTSZXPFL +00260 ++INCLUDE DTSIT003 DTSZXPFL +00261 EJECT DTSZXPFL +00262 01 L001-LINK-AREA. DTSZXPFL +00263 ++INCLUDE DTSIL001 DTSZXPFL +00264 EJECT DTSZXPFL +00265 01 L005-LINK-AREA. DTSZXPFL +00266 ++INCLUDE DTSIL005 DTSZXPFL +00267 EJECT DTSZXPFL +00268 01 L039-LINK-AREA. DTSZXPFL +00269 ++INCLUDE DTSIL039 DTSZXPFL +00270 EJECT DTSZXPFL +00271 01 L101-LINK-AREA. DTSZXPFL +00272 ++INCLUDE DTSIL101 DTSZXPFL +00273 EJECT DTSZXPFL +00274 01 L102-LINK-AREA. DTSZXPFL +00275 ++INCLUDE DTSIL102 DTSZXPFL +00276 EJECT DTSZXPFL +00277 01 L109-LINK-AREA. DTSZXPFL +00278 ++INCLUDE DTSIL109 DTSZXPFL +00279 DTSZXPFL +00280 01 L054-LINK-AREA. DTSZXPFL +00281 ++INCLUDE DTSIL054 DTSZXPFL +00282 EJECT DTSZXPFL +00283 01 L410-LINK-AREA. DTSZXPFL +00284 ++INCLUDE DTSIL410 DTSZXPFL +00285 EJECT DTSZXPFL +00286 01 L600-LINK-AREA. DTSZXPFL +00287 ++INCLUDE DTSIL600 DTSZXPFL +00288 EJECT DTSZXPFL +00289 01 L910-LINK-AREA. DTSZXPFL +00290 ++INCLUDE DTSIL910 DTSZXPFL +00291 EJECT DTSZXPFL +00292 01 MSKL-REC. DTSZXPFL +00293 ++INCLUDE DTSIMSKL DTSZXPFL +00294 EJECT DTSZXPFL +00295 EJECT DTSZXPFL +00296 01 L921-LINK-AREA. DTSZXPFL +00297 ++INCLUDE DTSIL921 DTSZXPFL +00298 EJECT DTSZXPFL +00299 01 ISKL-REC. DTSZXPFL +00300 ++INCLUDE DTSIISKL DTSZXPFL +00301 EJECT DTSZXPFL +00302 01 IPES-REC. DTSZXPFL +00303 ++INCLUDE DTSIIPES DTSZXPFL +00304 EJECT DTSZXPFL +00305 01 L931-LINK-AREA. DTSZXPFL +00306 ++INCLUDE DTSIL931 DTSZXPFL +00307 EJECT DTSZXPFL +00308 01 FSKL-REC. DTSZXPFL +00309 ++INCLUDE DTSIFSKL DTSZXPFL +00310 EJECT DTSZXPFL +00311 01 L933-LINK-AREA. DTSZXPFL +00312 ++INCLUDE DTSIL933 DTSZXPFL +00313 EJECT DTSZXPFL +00314 01 L004-COMM-AREA. DTSZXPFL +00315 ++INCLUDE DTSIL004 DTSZXPFL +00316 EJECT DTSZXPFL +00317 01 L923-LINK-AREA. DTSZXPFL +00318 ++INCLUDE DTSIL923 DTSZXPFL +00319 EJECT DTSZXPFL +00320 01 L927-LINK-AREA. DTSZXPFL +00321 ++INCLUDE DTSIL927 DTSZXPFL +00322 EJECT DTSZXPFL +00323 PROCEDURE DIVISION. DTSZXPFL +00324 DTSZXPFL +00325 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSZXPFL +00326 PERFORM P0000-PROCESS THRU P0000-EXIT DTSZXPFL +00327 UNTIL FILE-END = 'Y' CL*16 +00328 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSZXPFL +00329 SKIP2 DTSZXPFL +00330 GOBACK. DTSZXPFL +00331 EJECT DTSZXPFL +00332 I0000-INITIATE. DTSZXPFL +00333 SKIP2 DTSZXPFL +00334 MOVE 'N' TO WRK-TRACE-IND. DTSZXPFL +00335 SET WRK-ERROR-NO-88 TO TRUE. DTSZXPFL +00336 DTSZXPFL +00337 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSZXPFL +00338 DTSZXPFL +00339 DTSZXPFL +00340 I0000-EXIT. DTSZXPFL +00341 EXIT. DTSZXPFL +00342 I2000-OPEN-FILES-1. DTSZXPFL +00343 OPEN INPUT TAX-FILE1. DTSZXPFL +00344 IF NOT TAX-STATUS-OK-88 DTSZXPFL +00345 DISPLAY 'CANNOT OPEN TAX FILE ' TAX-STATUS DTSZXPFL +00346 SET WRK-ERROR-YES-88 TO TRUE DTSZXPFL +00347 GO TO I2000-EXIT. DTSZXPFL +00348 OPEN INPUT PFL-FILE1. DTSZXPFL +00349 IF NOT PFL-STATUS-OK-88 DTSZXPFL +00350 DISPLAY 'CANNOT OPEN PFL FILE ' PFL-STATUS DTSZXPFL +00351 SET WRK-ERROR-YES-88 TO TRUE DTSZXPFL +00352 GO TO I2000-EXIT. DTSZXPFL +00353 OPEN OUTPUT TAX-FILE2. DTSZXPFL +00354 IF NOT TAX2-STATUS-OK-88 DTSZXPFL +00355 DISPLAY 'CANNOT OPEN TAX FILE2 ' TAX2-STATUS DTSZXPFL +00356 SET WRK-ERROR-YES-88 TO TRUE DTSZXPFL +00357 GO TO I2000-EXIT. DTSZXPFL +00358 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSZXPFL +00359 DTSZXPFL +00360 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSZXPFL +00361 DTSZXPFL +00362 * PERFORM S910-OPEN-READ THRU S910-EXIT. CL*16 +00363 * PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL*11 +00364 * PERFORM S923-OPEN-UPDATE THRU S923-EXIT. DTSZXPFL +00365 * PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSZXPFL +00366 DTSZXPFL +00367 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSZXPFL +00368 DTSZXPFL +00369 * PERFORM S931-OPEN-UPDATE THRU S931-EXIT. DTSZXPFL +00370 DTSZXPFL +00371 MOVE WRK-MOD-NAME TO L933-MOD-NAME. DTSZXPFL +00372 MOVE ZERO TO WS-TOTAL-AMT. DTSZXPFL +00373 MOVE 'N' TO FILE-END. DTSZXPFL +00374 DTSZXPFL +00375 READ TAX-FILE1 DTSZXPFL +00376 INTO EMP-REC1 DTSZXPFL +00377 AT END MOVE 'Y' TO FILE-END DTSZXPFL +00378 END-READ. DTSZXPFL +00379 DTSZXPFL +00380 READ PFL-FILE1 DTSZXPFL +00381 INTO PFL-FILE DTSZXPFL +00382 AT END MOVE 'Y' TO PFL-FILE-END DTSZXPFL +00383 DTSZXPFL +00384 END-READ. DTSZXPFL +00385 DTSZXPFL +00386 IF TAX-AGY-TRACKING-ID NOT NUMERIC DTSZXPFL +00387 PERFORM S6200-READ-TAX DTSZXPFL +00388 END-IF. DTSZXPFL +00389 DTSZXPFL +00390 DTSZXPFL +00391 I2000-EXIT. DTSZXPFL +00392 EXIT. DTSZXPFL +00393 DTSZXPFL +00394 P0000-PROCESS. DTSZXPFL +00395 ADD 1 TO TAX-READ CL*16 +00396 IF TAX-READ = 1 CL*16 +00397 MOVE EMP-REC1 TO PFL-FILE CL*20 +00398 MOVE ZEROS TO WS-TOTAL-AMT CL*20 +00399 GO TO P0000-CONTINUE. CL*16 +00400 CL*16 +00401 IF TAX-AGY-TRACKING-ID = DTSZXPFL +00402 PFL-AGY-TRACKING-ID CL*20 +00403 DISPLAY 'TXID = ' TAX-AGY-TRACKING-ID CL*34 +00404 ' PFID ' PFL-AGY-TRACKING-ID CL*34 +00405 MOVE PFL-DEBT-AMT TO WS-PFL-AMT CL*20 +00406 ADD WS-PFL-AMT TO WS-TOTAL-AMT CL*20 +00407 MOVE EMP-REC1 TO PFL-FILE CL*20 +00408 ADD 1 TO DUP-CNT CL*35 +00409 GO TO P0000-CONTINUE CL*20 +00410 ELSE CL*20 +00411 ADD 1 TO ZUP-CNT CL*35 +00412 PERFORM S5000-WRITE-PFL CL*20 +00413 MOVE ZEROS TO WS-TOTAL-AMT CL*20 +00414 MOVE EMP-REC1 TO PFL-FILE CL*20 +00415 GO TO P0000-CONTINUE. CL*20 +00416 CL*20 +00417 P0000-CONTINUE. CL*16 +00418 PERFORM S6200-READ-TAX. CL*19 +00419 IF FILE-END = 'Y' CL*34 +00420 ADD 1 TO ZUP-CNT CL*36 +00421 PERFORM S5000-WRITE-PFL. CL*34 +00422 P0000-EXIT. CL*16 +00423 EXIT. CL*16 +00424 DTSZXPFL +00425 S6200-READ-TAX. DTSZXPFL +00426 DTSZXPFL +00427 READ TAX-FILE1 DTSZXPFL +00428 INTO EMP-REC1 DTSZXPFL +00429 AT END MOVE 'Y' TO FILE-END DTSZXPFL +00430 END-READ. DTSZXPFL +00431 DTSZXPFL +00432 S6200-EXIT. DTSZXPFL +00433 EXIT. DTSZXPFL +00434 EJECT DTSZXPFL +00435 DTSZXPFL +00436 SKIP3 DTSZXPFL +00437 S5000-WRITE-PFL. DTSZXPFL +00438 DTSZXPFL +00439 MOVE PFL-AGY-TRACKING-ID TO TAX2-AGY-TRACKING-ID. DTSZXPFL +00440 DTSZXPFL +00441 MOVE PFL-AGY-ID-ADM-DIV TO TAX2-AGY-ID-ADM-DIV. DTSZXPFL +00442 DTSZXPFL +00443 MOVE PFL-ENTITY-ID-TYPE TO TAX2-ENTITY-ID-TYPE. DTSZXPFL +00444 DTSZXPFL +00445 MOVE PFL-ENTITY-ID TO TAX2-ENTITY-ID. DTSZXPFL +00446 DTSZXPFL +00447 MOVE PFL-RELATIONSHIP-IND TO TAX2-RELATIONSHIP-IND. DTSZXPFL +00448 DTSZXPFL +00449 MOVE PFL-ENTITY-BUSNS-NAME TO TAX2-ENTITY-BUSNS-NAME. DTSZXPFL +00450 DTSZXPFL +00451 MOVE PFL-ENTITY-LAST-NAME TO TAX2-ENTITY-LAST-NAME. DTSZXPFL +00452 DTSZXPFL +00453 MOVE PFL-ENTITY-FIRST-NAME TO TAX2-ENTITY-FIRST-NAME. DTSZXPFL +00454 DTSZXPFL +00455 MOVE PFL-ENTITY-MID-INIT TO TAX2-ENTITY-MID-INIT. DTSZXPFL +00456 DTSZXPFL +00457 MOVE PFL-ENTITY-SUFFIX TO TAX2-ENTITY-SUFFIX. DTSZXPFL +00458 DTSZXPFL +00459 MOVE PFL-ENTITY-DOB TO TAX2-ENTITY-DOB. DTSZXPFL +00460 DTSZXPFL +00461 MOVE PFL-STREET-NUMBER TO TAX2-STREET-NUMBER. DTSZXPFL +00462 DTSZXPFL +00463 MOVE PFL-STREET-NAME TO TAX2-STREET-NAME. DTSZXPFL +00464 DTSZXPFL +00465 MOVE PFL-CITY TO TAX2-CITY. DTSZXPFL +00466 DTSZXPFL +00467 MOVE PFL-STATE TO TAX2-STATE. DTSZXPFL +00468 DTSZXPFL +00469 MOVE PFL-ZIP TO TAX2-ZIP. DTSZXPFL +00470 DTSZXPFL +00471 MOVE PFL-ZIP-EXT TO TAX2-ZIP-EXT. DTSZXPFL +00472 DTSZXPFL +00473 MOVE PFL-FAILURE-TO-FILE-IND DTSZXPFL +00474 TO TAX2-FAILURE-TO-FILE-IND. DTSZXPFL +00475 CL*20 +00476 MOVE PFL-AGY-REPORT-DT TO TAX2-AGY-REPORT-DT. CL*20 +00477 CL*20 +00478 MOVE PFL-DEBT-AMT TO WS-PFL-AMT CL*20 +00479 ADD WS-PFL-AMT TO WS-TOTAL-AMT CL*20 +00480 CL*20 +00481 IF WS-TOTAL-AMT > WRK-BAL CL*31 +00482 MOVE WS-TOTAL-AMT TO TAX2-DEBT-AMT DTSZXPFL +00483 WRITE TAX-REC2 FROM EMP-REC2 CL*20 +00484 ADD 1 TO REC-CNT CL*35 +00485 ELSE CL*24 +00486 ADD 1 TO ZEC-CNT CL*35 +00487 DISPLAY 'COMBINED DEBT NOT > 99D ' PFL-AGY-TRACKING-ID CL*30 +00488 ' TOTAL ' WS-TOTAL-AMT ' WRK-BAL ' WRK-BAL. CL*31 +00489 DTSZXPFL +00490 DTSZXPFL +00491 S5000-EXIT. DTSZXPFL +00492 EXIT. DTSZXPFL +00493 EJECT DTSZXPFL +00494 DTSZXPFL +00495 SKIP3 DTSZXPFL +00496 DTSZXPFL +00497 S5100-WRITE-TAX. DTSZXPFL +00498 DTSZXPFL +00499 DTSZXPFL +00500 DTSZXPFL +00501 MOVE TAX-AGY-TRACKING-ID TO TAX2-AGY-TRACKING-ID. DTSZXPFL +00502 DTSZXPFL +00503 MOVE TAX-AGY-ID-ADM-DIV TO TAX2-AGY-ID-ADM-DIV. DTSZXPFL +00504 DTSZXPFL +00505 MOVE TAX-ENTITY-ID-TYPE TO TAX2-ENTITY-ID-TYPE. DTSZXPFL +00506 DTSZXPFL +00507 MOVE TAX-ENTITY-ID TO TAX2-ENTITY-ID. DTSZXPFL +00508 DTSZXPFL +00509 MOVE TAX-RELATIONSHIP-IND TO TAX2-RELATIONSHIP-IND. DTSZXPFL +00510 DTSZXPFL +00511 MOVE TAX-ENTITY-BUSNS-NAME TO TAX2-ENTITY-BUSNS-NAME. DTSZXPFL +00512 DTSZXPFL +00513 MOVE TAX-ENTITY-LAST-NAME TO TAX2-ENTITY-LAST-NAME. DTSZXPFL +00514 DTSZXPFL +00515 MOVE TAX-ENTITY-FIRST-NAME TO TAX2-ENTITY-FIRST-NAME. DTSZXPFL +00516 DTSZXPFL +00517 MOVE TAX-ENTITY-MID-INIT TO TAX2-ENTITY-MID-INIT. DTSZXPFL +00518 DTSZXPFL +00519 MOVE TAX-ENTITY-SUFFIX TO TAX2-ENTITY-SUFFIX. DTSZXPFL +00520 DTSZXPFL +00521 MOVE TAX-ENTITY-DOB TO TAX2-ENTITY-DOB. DTSZXPFL +00522 DTSZXPFL +00523 MOVE TAX-STREET-NUMBER TO TAX2-STREET-NUMBER. DTSZXPFL +00524 DTSZXPFL +00525 MOVE TAX-STREET-NAME TO TAX2-STREET-NAME. DTSZXPFL +00526 DTSZXPFL +00527 MOVE TAX-CITY TO TAX2-CITY. DTSZXPFL +00528 DTSZXPFL +00529 MOVE TAX-STATE TO TAX2-STATE. DTSZXPFL +00530 DTSZXPFL +00531 MOVE TAX-ZIP TO TAX2-ZIP. DTSZXPFL +00532 DTSZXPFL +00533 MOVE TAX-ZIP-EXT TO TAX2-ZIP-EXT. DTSZXPFL +00534 DTSZXPFL +00535 MOVE TAX-FAILURE-TO-FILE-IND DTSZXPFL +00536 TO TAX2-FAILURE-TO-FILE-IND. DTSZXPFL +00537 DTSZXPFL +00538 IF WS-TOTAL-AMT > ZERO DTSZXPFL +00539 MOVE WS-TOTAL-AMT TO TAX2-DEBT-AMT DTSZXPFL +00540 ELSE DTSZXPFL +00541 MOVE TAX-DEBT-AMT TO TAX2-DEBT-AMT DTSZXPFL +00542 END-IF. DTSZXPFL +00543 DTSZXPFL +00544 MOVE TAX-AGY-REPORT-DT TO TAX2-AGY-REPORT-DT. DTSZXPFL +00545 DTSZXPFL +00546 WRITE TAX-REC2 FROM EMP-REC2. DTSZXPFL +00547 DTSZXPFL +00548 ADD 1 TO WS-REC-CNT. DTSZXPFL +00549 DTSZXPFL +00550 DTSZXPFL +00551 S5100-EXIT. DTSZXPFL +00552 EXIT. DTSZXPFL +00553 EJECT DTSZXPFL +00554 DTSZXPFL +00555 SKIP3 DTSZXPFL +00556 T0000-TERMINATE. DTSZXPFL +00557 DTSZXPFL +00558 DTSZXPFL +00559 DISPLAY ' '. DTSZXPFL +00560 DTSZXPFL +00561 DISPLAY '*** DTSZXPFL TERMINATION STATISTICS ***'. CL*35 +00562 DTSZXPFL +00563 DISPLAY ' '. DTSZXPFL +00564 DISPLAY 'TOTAL TAX-PFL (COMBINED) RECORDS READ ' TAX-READ. CL*35 +00565 DISPLAY 'TOTAL TAX-PFL (MATCH FEIN) RECORDS.. ' DUP-CNT. CL*37 +00566 DISPLAY 'TOTAL TAX-PFL (CLEAN HANDS) RECORDS.. ' ZUP-CNT. CL*37 +00567 DISPLAY 'TOTAL TAX-PFL (SENT TO OTR) AMT > 100 ' REC-CNT. CL*35 +00568 DISPLAY 'TOTAL TAX-PFL (NOT SENT TO OTR) < 100 ' ZEC-CNT. CL*35 +00569 MOVE REC-CNT TO HEADER-CNT. CL*35 +00570 WRITE TAX-REC2 FROM HEADER-REC. DTSZXPFL +00571 DTSZXPFL +00572 CLOSE TAX-FILE1 DTSZXPFL +00573 PFL-FILE1 DTSZXPFL +00574 TAX-FILE2. DTSZXPFL +00575 T0000-EXIT. DTSZXPFL +00576 EXIT. DTSZXPFL +00577 EJECT DTSZXPFL +00578 S001-FROM-FED-8. CL**9 +00579 SET L001-FROM-FED-8 TO TRUE. CL**9 +00580 GO TO S001-DATE. CL**9 +00581 DTSZXPFL +00582 S001-FROM-ABS-DAY. DTSZXPFL +00583 SET L001-FROM-ABS-DAY TO TRUE. DTSZXPFL +00584 GO TO S001-DATE. DTSZXPFL +00585 DTSZXPFL +00586 S001-DATE. DTSZXPFL +00587 CALL 'DTSBU001' USING L001-LINK-AREA. DTSZXPFL +00588 DTSZXPFL +00589 S001-EXIT. DTSZXPFL +00590 EXIT. DTSZXPFL +00591 SKIP3 DTSZXPFL +00592 S004-FROM-5. DTSZXPFL +00593 SET L004-FROM-5 TO TRUE. DTSZXPFL +00594 GO TO S004-EDIT-QTR. DTSZXPFL +00595 DTSZXPFL +00596 S004-FROM-ABS. DTSZXPFL +00597 SET L004-FROM-ABS TO TRUE. DTSZXPFL +00598 GO TO S004-EDIT-QTR. DTSZXPFL +00599 DTSZXPFL +00600 S004-EDIT-QTR. DTSZXPFL +00601 CALL 'DTSBU004' USING L004-COMM-AREA. DTSZXPFL +00602 DTSZXPFL +00603 S004-EXIT. DTSZXPFL +00604 EXIT. DTSZXPFL +00605 SKIP3 DTSZXPFL +00606 DTSZXPFL +00607 S005-FROM-SYS. DTSZXPFL +00608 SET L005-FROM-SYS TO TRUE. DTSZXPFL +00609 CALL 'DTSBU005' USING L005-LINK-AREA. DTSZXPFL +00610 DTSZXPFL +00611 S005-EXIT. DTSZXPFL +00612 EXIT. DTSZXPFL +00613 DTSZXPFL +00614 S005-FROM-ABSTIME. CL**9 +00615 SET L005-FROM-ABSTIME TO TRUE. CL**9 +00616 GO TO S005-ABSTIME. CL**9 +00617 DTSZXPFL +00618 S005-ABSTIME. DTSZXPFL +00619 CALL 'DTSBU005' USING L005-LINK-AREA. DTSZXPFL +00620 S005-A-EXIT. DTSZXPFL +00621 EXIT. DTSZXPFL +00622 SKIP3 DTSZXPFL +00623 S039-SIC-EDIT. DTSZXPFL +00624 CALL 'DTSBU039' USING L039-LINK-AREA. DTSZXPFL +00625 S039-EXIT. DTSZXPFL +00626 EXIT. DTSZXPFL +00627 DTSZXPFL +00628 S054-EXIT. DTSZXPFL +00629 EXIT. DTSZXPFL +00630 SKIP3 DTSZXPFL +00631 S101-PER-MONTH-NO. DTSZXPFL +00632 SET L101-PER-MONTH-NO-88 TO TRUE. DTSZXPFL +00633 GO TO S101-INT-CHARGE. DTSZXPFL +00634 DTSZXPFL +00635 S101-INT-CHARGE. DTSZXPFL +00636 CALL 'DTSBU101' USING L101-LINK-AREA. DTSZXPFL +00637 S101-EXIT. DTSZXPFL +00638 EXIT. DTSZXPFL +00639 DTSZXPFL +00640 S109-FIRST-PEN-INT-YRQ. DTSZXPFL +00641 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSZXPFL +00642 CALL 'DTSBU109' USING L109-LINK-AREA. DTSZXPFL +00643 S109-EXIT. DTSZXPFL +00644 EXIT. DTSZXPFL +00645 DTSZXPFL +00646 S410-FILING-SCHED. DTSZXPFL +00647 CALL 'DTSBU410' USING L410-LINK-AREA. DTSZXPFL +00648 DTSZXPFL +00649 S410-EXIT. DTSZXPFL +00650 EXIT. DTSZXPFL +00651 SKIP3 DTSZXPFL +00652 S910-OPEN-READ. DTSZXPFL +00653 SET L910-OPEN-READ-88 TO TRUE. DTSZXPFL +00654 GO TO S910-MSTR-IO. DTSZXPFL +00655 DTSZXPFL +00656 S910-OPEN-UPDATE-NO-AIX. DTSZXPFL +00657 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSZXPFL +00658 GO TO S910-MSTR-IO. DTSZXPFL +00659 DTSZXPFL +00660 S910-READ. CL**9 +00661 SET L910-READ-88 TO TRUE. CL**9 +00662 GO TO S910-MSTR-IO. CL**9 +00663 DTSZXPFL +00664 S910-START-BROWSE. DTSZXPFL +00665 SET L910-START-BROWSE-88 TO TRUE. DTSZXPFL +00666 GO TO S910-MSTR-IO. DTSZXPFL +00667 DTSZXPFL +00668 S910-READ-NEXT. DTSZXPFL +00669 SET L910-READ-NEXT-88 TO TRUE. DTSZXPFL +00670 GO TO S910-MSTR-IO. DTSZXPFL +00671 DTSZXPFL +00672 S910-COUNT. DTSZXPFL +00673 SET L910-COUNT-88 TO TRUE. DTSZXPFL +00674 GO TO S910-MSTR-IO. DTSZXPFL +00675 DTSZXPFL +00676 S910-REWRITE. DTSZXPFL +00677 SET L910-REWRITE-88 TO TRUE. DTSZXPFL +00678 GO TO S910-MSTR-IO. DTSZXPFL +00679 DTSZXPFL +00680 S910-DELETE. DTSZXPFL +00681 SET L910-DELETE-88 TO TRUE. DTSZXPFL +00682 GO TO S910-MSTR-IO. DTSZXPFL +00683 DTSZXPFL +00684 S910-CLOSE. DTSZXPFL +00685 SET L910-CLOSE-88 TO TRUE. DTSZXPFL +00686 GO TO S910-MSTR-IO. DTSZXPFL +00687 DTSZXPFL +00688 S910-MSTR-IO. DTSZXPFL +00689 CALL 'DTSBU910' USING L910-LINK-AREA DTSZXPFL +00690 MSKL-REC. DTSZXPFL +00691 S910-EXIT. DTSZXPFL +00692 EXIT. DTSZXPFL +00693 SKIP3 DTSZXPFL +00694 S921-OPEN-READ. CL**9 +00695 SET L921-OPEN-READ-88 TO TRUE. CL**9 +00696 GO TO S921-AIX-IO. CL**9 +00697 DTSZXPFL +00698 S921-START-BROWSE. DTSZXPFL +00699 SET L921-START-BROWSE-88 TO TRUE. DTSZXPFL +00700 GO TO S921-AIX-IO. DTSZXPFL +00701 DTSZXPFL +00702 S921-CLOSE. DTSZXPFL +00703 SET L921-CLOSE-88 TO TRUE. DTSZXPFL +00704 GO TO S921-AIX-IO. DTSZXPFL +00705 DTSZXPFL +00706 SKIP3 DTSZXPFL +00707 S921-AIX-IO. DTSZXPFL +00708 CALL 'DTSBU921' USING L921-LINK-AREA DTSZXPFL +00709 ISKL-REC. DTSZXPFL +00710 S921-EXIT. DTSZXPFL +00711 EXIT. DTSZXPFL +00712 SKIP3 DTSZXPFL +00713 DTSZXPFL +00714 SKIP3 DTSZXPFL +00715 S927-OPEN-UPDATE. DTSZXPFL +00716 SET L927-OPEN-UPDATE-88 TO TRUE. DTSZXPFL +00717 GO TO S927-BTC-O. DTSZXPFL +00718 DTSZXPFL +00719 S927-WRITE. DTSZXPFL +00720 SET L927-WRITE-88 TO TRUE. DTSZXPFL +00721 GO TO S927-BTC-O. DTSZXPFL +00722 DTSZXPFL +00723 S927-CLOSE. DTSZXPFL +00724 SET L927-CLOSE-88 TO TRUE. DTSZXPFL +00725 GO TO S927-BTC-O. DTSZXPFL +00726 DTSZXPFL +00727 S927-BTC-O. DTSZXPFL +00728 CALL 'DTSBU927' USING L927-LINK-AREA DTSZXPFL +00729 TSKL-REC. DTSZXPFL +00730 S927-EXIT. DTSZXPFL +00731 EXIT. DTSZXPFL +00732 DTSZXPFL +00733 SKIP3 DTSZXPFL +00734 S931-OPEN-READ. DTSZXPFL +00735 SET L931-OPEN-READ-88 TO TRUE. DTSZXPFL +00736 GO TO S931-REF-IO. DTSZXPFL +00737 DTSZXPFL +00738 S931-OPEN-UPDATE. DTSZXPFL +00739 SET L931-OPEN-UPDATE-88 TO TRUE. DTSZXPFL +00740 GO TO S931-REF-IO. DTSZXPFL +00741 DTSZXPFL +00742 S931-START-BROWSE. DTSZXPFL +00743 SET L931-START-BROWSE-88 TO TRUE. DTSZXPFL +00744 GO TO S931-REF-IO. DTSZXPFL +00745 DTSZXPFL +00746 S931-READ. DTSZXPFL +00747 SET L931-READ-88 TO TRUE. DTSZXPFL +00748 GO TO S931-REF-IO. DTSZXPFL +00749 DTSZXPFL +00750 S931-READ-NEXT. DTSZXPFL +00751 SET L931-READ-NEXT-88 TO TRUE. DTSZXPFL +00752 GO TO S931-REF-IO. DTSZXPFL +00753 DTSZXPFL +00754 S931-DELETE. DTSZXPFL +00755 SET L931-DELETE-88 TO TRUE. DTSZXPFL +00756 GO TO S931-REF-IO. DTSZXPFL +00757 DTSZXPFL +00758 S931-REWRITE. DTSZXPFL +00759 SET L931-REWRITE-88 TO TRUE. DTSZXPFL +00760 GO TO S931-REF-IO. DTSZXPFL +00761 DTSZXPFL +00762 S931-WRITE. DTSZXPFL +00763 SET L931-WRITE-88 TO TRUE. DTSZXPFL +00764 GO TO S931-REF-IO. DTSZXPFL +00765 DTSZXPFL +00766 S931-CLOSE. DTSZXPFL +00767 SET L931-CLOSE-88 TO TRUE. DTSZXPFL +00768 GO TO S931-REF-IO. DTSZXPFL +00769 DTSZXPFL +00770 S931-REF-IO. DTSZXPFL +00771 CALL 'DTSBU931' USING L931-LINK-AREA DTSZXPFL +00772 FSKL-REC. DTSZXPFL +00773 S931-EXIT. DTSZXPFL +00774 EXIT. DTSZXPFL +00775 SKIP3 DTSZXPFL +00776 DTSZXPFL +00777 S999-ABEND. DTSZXPFL +00778 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSZXPFL +00779 S999-EXIT. DTSZXPFL +00780 EXIT. DTSZXPFL diff --git a/Batch/EFTBD100.cob b/Batch/EFTBD100.cob new file mode 100644 index 0000000..056d2ab --- /dev/null +++ b/Batch/EFTBD100.cob @@ -0,0 +1,921 @@ +00001 IDENTIFICATION DIVISION. 10/24/03 +00002 PROGRAM-ID. EFTBD100. EFTBD100 +00003 *AUTHOR. TRW INC. LV070 +00004 *DATE-WRITTEN. AUGUST 2003. CL**8 +00005 DATE-COMPILED. EFTBD100 +00006 EFTBD100 +00007 ***** EFTBD100 +00008 * EFTBD100 +00009 * FUNCTION: EFTBD100 +00010 * EFTBD100 +00011 * DRIVER PROGRAM CONTROLS THE GOVONE EFT PROCESS CL**4 +00012 * EFTBD100 +00013 * INPUT: EFTBD100 +00014 * EFTBD100 +00015 * EFT100F1 - REPORT RECORDS PRODUCED DURING THE INPUT CL**8 +00016 * EDIT. CL**4 +00017 * EFTBD100 +00018 * OUTPUT: EFTBD100 +00019 * EFTBD100 +00020 * EFT100R1 - REPORT RECORDS SUMMARY COUNT REPORT. CL*58 +00021 ***** EFTBD100 +00022 EFTBD100 +00023 ******************************************************************EFTBD100 +00024 * MODIFICATION HISTORY: *EFTBD100 +00025 * *EFTBD100 +00026 * 08-26-2003 INITIAL DEVELOPMENT * CL**4 +00027 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**4 +00028 * *EFTBD100 +00029 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *EFTBD100 +00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *EFTBD100 +00031 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *EFTBD100 +00032 ******************************************************************EFTBD100 +00033 EFTBD100 +00034 ENVIRONMENT DIVISION. EFTBD100 +00035 EFTBD100 +00036 CONFIGURATION SECTION. EFTBD100 +00037 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. EFTBD100 +00038 EFTBD100 +00039 INPUT-OUTPUT SECTION. EFTBD100 +00040 EFTBD100 +00041 FILE-CONTROL. EFTBD100 +00042 SELECT EFT-REC-FILE ASSIGN TO EFT100F1 CL*12 +00043 FILE STATUS IS EFT-FILE-STATUS. CL*15 +00044 EFTBD100 +00045 SELECT PRT-FILE ASSIGN TO EFT100R1. CL*24 +00046 CL*18 +00047 DATA DIVISION. EFTBD100 +00048 EFTBD100 +00049 FILE SECTION. EFTBD100 +00050 EFTBD100 +00051 ************************************************************ EFTBD100 +00052 * REPORT FILE RECORD PASSED FROM BENEFITS UPDATE. EFTBD100 +00053 ************************************************************ EFTBD100 +00054 CL**8 +00055 FD EFT-REC-FILE CL*12 +00056 RECORDING MODE IS V CL**8 +00057 BLOCK CONTAINS 0 RECORDS. CL**8 +00058 01 EFT-TRANS-IN. CL**8 +00059 05 EFT-SORT-KEY. CL**8 +00060 10 EFT-SORT-TRACE-NO PIC 9(13). CL**8 +00061 10 EFT-SORT-TRAN PIC 9(02). CL**8 +00062 05 EFT-TRANS-REC PIC X(4074). CL**8 +00063 EFTBD100 +00064 FD PRT-FILE EFTBD100 +00065 RECORDING MODE IS F. EFTBD100 +00066 01 REPORT-LISTING1 PIC X(133). EFTBD100 +00067 CL*18 +00068 EFTBD100 +00069 WORKING-STORAGE SECTION. EFTBD100 +000695 77 PAN-VALET PICTURE X(24) VALUE '070EFTBD100 10/24/03'. EFTBD100 +00070 EFTBD100 +00071 01 WRK-AREA. EFTBD100 +00072 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD100'. CL*34 +00073 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL*46 +00074 05 ABEND-CODE PIC S9(04) COMP VALUE +0. EFTBD100 +00075 88 ABEND-NULL-88 VALUE +0. EFTBD100 +00076 88 ABEND-RPT-FILE-OPEN VALUE +1. EFTBD100 +00077 88 ABEND-RPT-FILE-READ VALUE +2. EFTBD100 +00078 88 ABEND-PRT-FILE-OPEN VALUE +3. CL*10 +00079 05 ABEND-CODE-DISP PIC 9(04). EFTBD100 +00080 05 ABEND-MOD PIC X(08) EFTBD100 +00081 VALUE 'ILBOABN0'. EFTBD100 +00082 EFTBD100 +00083 05 WS-REC-LEN PIC S9(04) COMP VALUE +0. CL*34 +00084 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. EFTBD100 +00085 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. EFTBD100 +00086 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. EFTBD100 +00087 EFTBD100 +00088 05 EFT-FILE-STATUS PIC X(02) VALUE SPACES. CL*15 +00089 88 EFT-FILE-OK-88 VALUE ZERO. CL**8 +00090 88 EFT-FILE-EOF-88 VALUE '10'. CL**8 +00091 EFTBD100 +00092 05 WS-EFT-PROGRAM PIC X(08). CL**4 +00093 88 WS-FENR-110-88 VALUE 'EFTBD110'. CL*38 +00094 88 WS-FEST-120-88 VALUE 'EFTBD120'. CL*38 +00095 88 WS-FDPT-130-88 VALUE 'EFTBD130'. CL**8 +00096 88 WS-FQTF-140-88 VALUE 'EFTBD140'. CL**8 +00097 88 WS-FDPT-140-88 VALUE 'EFTBD140'. CL**8 +00098 88 WS-FCQW-140-88 VALUE 'EFTBD140'. CL**8 +00099 EFTBD100 +00100 05 WRK-RPT-FILE-READ-CNT PIC 9(07) COMP-3. CL*69 +00101 05 WRK-FENR-REC-CNT PIC 9(07) COMP-3. CL*38 +00102 05 WRK-FEST-REC-CNT PIC 9(07) COMP-3. CL*38 +00103 05 WRK-FDPT-REC-CNT PIC 9(07) COMP-3. CL**4 +00104 05 WRK-FDPY-REC-CNT PIC 9(07) COMP-3. CL*10 +00105 05 WRK-FCQW-REC-CNT PIC 9(07) COMP-3. CL**4 +00106 05 WRK-FQTF-REC-CNT PIC 9(07) COMP-3. CL**8 +00107 EFTBD100 +00108 05 WRK-FED-8-DATE PIC X(08). EFTBD100 +00109 05 FILLER REDEFINES WRK-FED-8-DATE. EFTBD100 +00110 10 WRK-FED-CC PIC X(02). EFTBD100 +00111 10 WRK-FED-6-DATE. EFTBD100 +00112 15 WRK-FED-YY PIC X(02). EFTBD100 +00113 15 WRK-FED-MM PIC X(02). EFTBD100 +00114 15 WRK-FED-DD PIC X(02). EFTBD100 +00115 EFTBD100 +00116 05 WRK-DISPLAY-8-DATE. EFTBD100 +00117 10 WRK-DISPLAY-8-MM PIC X(02). EFTBD100 +00118 10 WRK-SLASH1 PIC X(01) VALUE '/'. EFTBD100 +00119 10 WRK-DISPLAY-8-DD PIC X(02). EFTBD100 +00120 10 WRK-SLASH2 PIC X(01) VALUE '/'. EFTBD100 +00121 10 WRK-DISPLAY-8-CC PIC X(02). EFTBD100 +00122 10 WRK-DISPLAY-8-YY PIC X(02). EFTBD100 +00123 EFTBD100 +00124 05 WRK-DISPLAY-6-DATE. EFTBD100 +00125 10 WRK-DISPLAY-6-MM PIC X(02). EFTBD100 +00126 10 WRK-SLASH3 PIC X(01) VALUE '/'. EFTBD100 +00127 10 WRK-DISPLAY-6-DD PIC X(02). EFTBD100 +00128 10 WRK-SLASH4 PIC X(01) VALUE '/'. EFTBD100 +00129 10 WRK-DISPLAY-6-YY PIC X(02). EFTBD100 +00130 EFTBD100 +00131 05 WRK-TIME PIC X(08). EFTBD100 +00132 05 FILLER REDEFINES WRK-TIME. EFTBD100 +00133 10 WRK-TIME-HOURS PIC X(02). EFTBD100 +00134 10 WRK-TIME-MINUTES PIC X(02). EFTBD100 +00135 10 WRK-TIME-SECONDS PIC X(02). EFTBD100 +00136 10 WRK-TIME-HUNDRETHS PIC X(02). EFTBD100 +00137 EFTBD100 +00138 05 WRK-DISPLAY-TIME. EFTBD100 +00139 10 WRK-DISPLAY-HOURS PIC X(02). EFTBD100 +00140 10 WRK-DOT1 PIC X(01) VALUE '.'. EFTBD100 +00141 10 WRK-DISPLAY-MINUTES PIC X(02). EFTBD100 +00142 10 WRK-DOT2 PIC X(01) VALUE '.'. EFTBD100 +00143 10 WRK-DISPLAY-SECONDS PIC X(02). EFTBD100 +00144 EFTBD100 +00145 01 EFT-REC-TYPE-LINK-AREA. CL*11 +00146 ++INCLUDE EFTIL100 CL*11 +00147 CL*45 +00148 01 L921-LINK-AREA. CL*45 +00149 ++INCLUDE DTSIL921 CL*45 +00150 CL*19 +00151 01 L931-LINK-AREA. CL*66 +00152 ++INCLUDE DTSIL931 CL*66 +00153 CL*66 +00154 01 L927-LINK-AREA. CL*19 +00155 ++INCLUDE DTSIL927 CL*19 +00156 CL*19 +00157 01 L910-LINK-AREA. CL*45 +00158 ++INCLUDE DTSIL910 CL*45 +00159 CL*64 +00160 01 L985-LINK-AREA. CL*64 +00161 ++INCLUDE DTSIL985 CL*64 +00162 CL*64 +00163 CL*45 +00164 01 RSKL-REC. CL*21 +00165 ++INCLUDE EFTIRSKL CL*21 +00166 CL*21 +00167 01 ISKL-REC. CL*45 +00168 ++INCLUDE DTSIISKL CL*46 +00169 CL*45 +00170 01 WSKL-REC. CL*54 +00171 ++INCLUDE DTSIWSKL CL*54 +00172 CL*54 +00173 01 MSKL-REC. CL*45 +00174 ++INCLUDE DTSIMSKL CL*47 +00175 CL*45 +00176 01 TSKL-REC. CL*41 +00177 ++INCLUDE DTSITSKL CL*41 +00178 CL*51 +00179 01 EROR-MSG. CL*51 +00180 ++INCLUDE EFTERMSG CL*51 +00181 CL*51 +00182 CL*38 +00183 01 R907-REC. CL*22 +00184 ++INCLUDE DTSIR907 CL*22 +00185 CL*21 +00186 01 F907-REC. CL*50 +00187 ++INCLUDE EFTIF907 CL*50 +00188 CL*50 +00189 CL*18 +00190 01 PAGE-HEADING. EFTBD100 +00191 05 HDR1-LINE-1. EFTBD100 +00192 10 FILLER PIC X(04) VALUE SPACES. EFTBD100 +00193 10 FILLER PIC X(05) EFTBD100 +00194 VALUE '100R1'. CL*58 +00195 10 FILLER PIC X(37) VALUE SPACES. EFTBD100 +00196 10 HDR1-AGY-NAME-LINE1 PIC X(20). EFTBD100 +00197 10 FILLER PIC X(25) VALUE SPACES. EFTBD100 +00198 10 FILLER PIC X(05) EFTBD100 +00199 VALUE 'DATE:'. EFTBD100 +00200 10 FILLER PIC X(01) VALUE SPACE. EFTBD100 +00201 10 HDR1-SYS-DATE PIC X(08). EFTBD100 +00202 05 HDR1-LINE-2. EFTBD100 +00203 10 FILLER PIC X(40) VALUE SPACES. EFTBD100 +00204 10 HDR1-AGY-NAME-LINE2 PIC X(34). EFTBD100 +00205 10 FILLER PIC X(17) VALUE SPACES. EFTBD100 +00206 10 FILLER PIC X(05) EFTBD100 +00207 VALUE 'TIME:'. EFTBD100 +00208 10 FILLER PIC X(01) VALUE SPACE. EFTBD100 +00209 10 HDR1-SYS-TIME PIC X(08). EFTBD100 +00210 05 HDR1-LINE-3. EFTBD100 +00211 10 FILLER PIC X(04) VALUE SPACES. EFTBD100 +00212 10 FILLER PIC X(30) EFTBD100 +00213 VALUE 'ROUTE TO: PROGRAMMING UNIT '. CL**4 +00214 10 FILLER PIC X(57) VALUE SPACES. EFTBD100 +00215 10 FILLER PIC X(05) EFTBD100 +00216 VALUE 'PAGE:'. EFTBD100 +00217 10 FILLER PIC X(01) VALUE SPACE. EFTBD100 +00218 10 HDR1-PAGE-CNT PIC Z9. EFTBD100 +00219 05 HDR1-LINE-4 PIC X(133) VALUE SPACES. EFTBD100 +00220 05 HDR1-LINE-5. EFTBD100 +00221 10 FILLER PIC X(30) VALUE SPACES. EFTBD100 +00222 10 FILLER PIC X(37) EFTBD100 +00223 VALUE 'GOVONE E.F.T. SUMMARY CONTROL REPORT'. CL**4 +00224 10 FILLER PIC X(66) VALUE SPACES. EFTBD100 +00225 05 HDR1-LINE-6 PIC X(133) VALUE SPACES. EFTBD100 +00226 05 HDR1-LINE-7 PIC X(133) VALUE SPACES. EFTBD100 +00227 05 HDR1-LINE-8. EFTBD100 +00228 10 FILLER PIC X(04) VALUE SPACES. EFTBD100 +00229 10 FILLER PIC X(17) EFTBD100 +00230 VALUE 'PROCESSING DATE: '. EFTBD100 +00231 10 HDR1-PROC-DATE PIC X(10) VALUE SPACES. EFTBD100 +00232 05 HDR1-LINE-9 PIC X(133) VALUE SPACES. EFTBD100 +00233 EFTBD100 +00234 01 DETAIL-LINE. EFTBD100 +00235 05 DTL-LINE-2. EFTBD100 +00236 10 FILLER PIC X(16) VALUE SPACES. EFTBD100 +00237 10 FILLER PIC X(40) CL*61 +00238 VALUE 'NUMBER OF INPUT REPORT RECORDS READ:'. EFTBD100 +00239 10 FILLER PIC X(05) VALUE SPACES. CL*63 +00240 10 DTL-READ-CNT PIC ZZZ,ZZ9. EFTBD100 +00241 10 FILLER PIC X(63) VALUE SPACES. EFTBD100 +00242 CL*42 +00243 05 DTL-LINE-3. CL*42 +00244 10 FILLER PIC X(16) VALUE SPACES. CL*42 +00245 10 FILLER PIC X(40) CL*60 +00246 VALUE 'NO. OF ENROLLMENT - FENR TYPE (00): '. CL*60 +00247 10 FILLER PIC X(05) VALUE SPACES. CL*63 +00248 10 DTL-FENR-CNT PIC ZZZ,ZZ9. CL*42 +00249 10 FILLER PIC X(63) VALUE SPACES. CL*42 +00250 CL*42 +00251 EFTBD100 +00252 05 DTL-LINE-5. EFTBD100 +00253 10 FILLER PIC X(16) VALUE SPACES. EFTBD100 +00254 10 FILLER PIC X(40) CL*60 +00255 VALUE 'NO. OF EMP STATUS - FEST TYPE (01): '. CL*60 +00256 10 FILLER PIC X(05) VALUE SPACES. CL*63 +00257 10 DTL-FEST-CNT PIC ZZZ,ZZ9. CL**4 +00258 10 FILLER PIC X(63) VALUE SPACES. EFTBD100 +00259 EFTBD100 +00260 05 DTL-LINE-6. CL*13 +00261 10 FILLER PIC X(16) VALUE SPACES. CL*13 +00262 10 FILLER PIC X(40) CL*60 +00263 VALUE 'NO. OF PAYMENT ONLY - FDPT TYPE (02): '. CL*60 +00264 10 FILLER PIC X(05) VALUE SPACES. CL*63 +00265 10 DTL-FDPT-CNT PIC ZZZ,ZZ9. CL*13 +00266 10 FILLER PIC X(63) VALUE SPACES. CL*13 +00267 CL*13 +00268 05 DTL-LINE-7. EFTBD100 +00269 10 FILLER PIC X(16) VALUE SPACES. CL*59 +00270 10 FILLER PIC X(40) CL*60 +00271 VALUE 'NO. OF REPORT RECS - FQTF TYPE (03): '. CL*60 +00272 10 FILLER PIC X(05) VALUE SPACES. CL*63 +00273 10 DTL-FQTF-CNT PIC ZZZ,ZZ9. CL*59 +00274 10 FILLER PIC X(63) VALUE SPACES. CL*59 +00275 CL*13 +00276 05 DTL-LINE-8. CL*13 +00277 10 FILLER PIC X(16) VALUE SPACES. CL*13 +00278 10 FILLER PIC X(40) CL*60 +00279 VALUE 'NO. PAYMENT WITH REP - FDPT TYPE (04): '. CL*60 +00280 10 FILLER PIC X(05) VALUE SPACES. CL*63 +00281 10 DTL-FDPY-CNT PIC ZZZ,ZZ9. CL*13 +00282 10 FILLER PIC X(63) VALUE SPACES. CL*13 +00283 CL*13 +00284 05 DTL-LINE-9. EFTBD100 +00285 10 FILLER PIC X(16) VALUE SPACES. CL*59 +00286 10 FILLER PIC X(40) CL*60 +00287 VALUE 'NO. OF WAGE RECORDS - FCQW TYPE (05): '. CL*60 +00288 10 FILLER PIC X(05) VALUE SPACES. CL*63 +00289 10 DTL-FCQW-CNT PIC ZZZ,ZZ9. CL*59 +00290 10 FILLER PIC X(63) VALUE SPACES. CL*59 +00291 CL*59 +00292 EFTBD100 +00293 05 DTL-LINE-12. EFTBD100 +00294 10 FILLER PIC X(36) VALUE SPACES. EFTBD100 +00295 10 FILLER PIC X(17) EFTBD100 +00296 VALUE '*** END OF REPORT'. EFTBD100 +00297 10 FILLER PIC X(80) VALUE SPACES. EFTBD100 +00298 EFTBD100 +00299 05 WRK-PARM-REC. CL*14 +00300 10 WRK-PARM-REC00 PIC X(02). CL*42 +00301 10 WRK-PARM-REC01 PIC X(02). CL*42 +00302 10 WRK-PARM-REC02 PIC X(02). CL*42 +00303 10 WRK-PARM-REC03 PIC X(02). CL*42 +00304 10 WRK-PARM-REC04 PIC X(02). CL*42 +00305 10 WRK-PARM-REC05 PIC X(02). CL*42 +00306 CL*13 +00307 EFTBD100 +00308 LINKAGE SECTION. EFTBD100 +00309 01 PARM-AREA. EFTBD100 +00310 05 PARM-LENGTH PIC S9(04) COMP. EFTBD100 +00311 05 PARM-REC00 PIC X(02). CL*42 +00312 05 FILLER PIC X(01). EFTBD100 +00313 05 PARM-REC01 PIC X(02). CL*42 +00314 05 FILLER PIC X(01). EFTBD100 +00315 05 PARM-REC02 PIC X(02). CL*42 +00316 05 FILLER PIC X(01). CL**4 +00317 05 PARM-REC03 PIC X(02). CL*42 +00318 05 FILLER PIC X(01). CL**4 +00319 05 PARM-REC04 PIC X(02). CL*42 +00320 05 FILLER PIC X(01). CL*42 +00321 05 PARM-REC05 PIC X(02). CL*42 +00322 CL*21 +00323 CL*21 +00324 PROCEDURE DIVISION USING PARM-AREA. EFTBD100 +00325 EFTBD100 +00326 PROC0000-MAIN. EFTBD100 +00327 PERFORM INIT0000-INITIATE THRU INIT0000-EXIT. EFTBD100 +00328 EFTBD100 +00329 PERFORM PROC1000-SCAN-EFT-FILE THRU PROC1000-EXIT CL*17 +00330 UNTIL EFT-FILE-EOF-88. CL*13 +00331 EFTBD100 +00332 PERFORM TERM0000-TERMINATE THRU TERM0000-EXIT. EFTBD100 +00333 EFTBD100 +00334 PROC0000-EXIT. EFTBD100 +00335 EFTBD100 +00336 GOBACK. EFTBD100 +00337 EFTBD100 +00338 INIT0000-INITIATE. EFTBD100 +00339 EFTBD100 +00340 PERFORM INIT0100-PARMS THRU INIT0100-EXIT. EFTBD100 +00341 EFTBD100 +00342 PERFORM INIT1000-INIT-WRK-DATA THRU INIT1000-EXIT. EFTBD100 +00343 PERFORM INIT2000-OPEN-FILES THRU INIT2000-EXIT. EFTBD100 +00344 PERFORM INIT4000-SYSTEM-DATE THRU INIT4000-EXIT. EFTBD100 +00345 PERFORM INIT5000-READ-FIRST THRU INIT5000-EXIT. CL*52 +00346 PERFORM INIT6000-INIT-REPORTS THRU INIT6000-EXIT. EFTBD100 +00347 EFTBD100 +00348 INIT0000-EXIT. EFTBD100 +00349 EXIT. EFTBD100 +00350 EFTBD100 +00351 INIT0100-PARMS. EFTBD100 +00352 MOVE SPACES TO WRK-PARM-REC00 CL*42 +00353 WRK-PARM-REC01 CL*42 +00354 WRK-PARM-REC02 CL*42 +00355 WRK-PARM-REC03 CL*42 +00356 WRK-PARM-REC04 CL*42 +00357 WRK-PARM-REC05. CL*42 +00358 EFTBD100 +00359 IF PARM-LENGTH = +0 CL*16 +00360 PERFORM INIT0120-DEFAULT-PARMS THRU INIT0120-EXIT CL*16 +00361 ELSE EFTBD100 +00362 PERFORM INIT0110-EDIT-PARMS THRU INIT0110-EXIT CL*16 +00363 END-IF. EFTBD100 +00364 EFTBD100 +00365 INIT0100-EXIT. EFTBD100 +00366 EXIT. EFTBD100 +00367 EFTBD100 +00368 INIT0110-EDIT-PARMS. EFTBD100 +00369 IF PARM-REC00 = '00' OR '01' OR '02' OR '03' OR CL*42 +00370 '04' OR '05' OR ' ' CL*42 +00371 MOVE PARM-REC00 TO WRK-PARM-REC00 CL*42 +00372 ELSE CL*42 +00373 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC00 CL*42 +00374 SET ABEND-RPT-FILE-READ TO TRUE CL*42 +00375 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*42 +00376 END-IF. CL*42 +00377 CL*42 +00378 IF PARM-REC01 = '00' OR '01' OR '02' OR '03' OR CL*42 +00379 '04' OR '05' OR ' ' CL*42 +00380 MOVE PARM-REC01 TO WRK-PARM-REC01 CL**6 +00381 ELSE CL*16 +00382 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC01 CL*16 +00383 SET ABEND-RPT-FILE-READ TO TRUE CL*16 +00384 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 +00385 END-IF. EFTBD100 +00386 CL*16 +00387 IF PARM-REC02 = '00' OR '01' OR '02' OR '03' OR CL*42 +00388 '04' OR '05' OR ' ' CL*42 +00389 MOVE PARM-REC02 TO WRK-PARM-REC02 CL*16 +00390 ELSE CL*16 +00391 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC02 CL*16 +00392 SET ABEND-RPT-FILE-READ TO TRUE CL*16 +00393 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 +00394 END-IF. CL*16 +00395 CL*16 +00396 IF PARM-REC03 = '00' OR '01' OR '02' OR '03' OR CL*42 +00397 '04' OR '05' OR ' ' CL*42 +00398 MOVE PARM-REC03 TO WRK-PARM-REC03 CL*16 +00399 ELSE CL*16 +00400 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC03 CL*16 +00401 SET ABEND-RPT-FILE-READ TO TRUE CL*16 +00402 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 +00403 END-IF. CL*16 +00404 CL*16 +00405 IF PARM-REC04 = '00' OR '01' OR '02' OR '03' OR CL*42 +00406 '04' OR '05' OR ' ' CL*42 +00407 MOVE PARM-REC04 TO WRK-PARM-REC04 CL*16 +00408 ELSE CL*16 +00409 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC04 CL*16 +00410 SET ABEND-RPT-FILE-READ TO TRUE CL*16 +00411 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 +00412 END-IF. CL*16 +00413 CL*16 +00414 IF PARM-REC05 = '00' OR '01' OR '02' OR '03' OR CL*42 +00415 '04' OR '05' OR ' ' CL*42 +00416 MOVE PARM-REC05 TO WRK-PARM-REC05 CL*16 +00417 ELSE CL*16 +00418 DISPLAY ' INVLAID VALUE IN PARM RECORD ' PARM-REC05 CL*16 +00419 SET ABEND-RPT-FILE-READ TO TRUE CL*16 +00420 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 +00421 END-IF. CL*16 +00422 INIT0110-EXIT. EFTBD100 +00423 EXIT. EFTBD100 +00424 EFTBD100 +00425 INIT0120-DEFAULT-PARMS. EFTBD100 +00426 MOVE '00' TO WRK-PARM-REC00. CL*42 +00427 MOVE '01' TO WRK-PARM-REC01. CL*42 +00428 MOVE '02' TO WRK-PARM-REC02. CL*42 +00429 MOVE '03' TO WRK-PARM-REC03. CL*42 +00430 MOVE '04' TO WRK-PARM-REC04. CL*42 +00431 MOVE '05' TO WRK-PARM-REC05. CL*42 +00432 EFTBD100 +00433 INIT0120-EXIT. EFTBD100 +00434 EXIT. EFTBD100 +00435 EFTBD100 +00436 INIT1000-INIT-WRK-DATA. EFTBD100 +00437 EFTBD100 +00438 MOVE ZERO TO WRK-RPT-FILE-READ-CNT EFTBD100 +00439 WRK-FENR-REC-CNT CL*39 +00440 WRK-FEST-REC-CNT CL*39 +00441 WRK-FDPT-REC-CNT CL**6 +00442 WRK-FDPY-REC-CNT CL*12 +00443 WRK-FQTF-REC-CNT CL**6 +00444 WRK-FCQW-REC-CNT. CL**7 +00445 EFTBD100 +00446 MOVE 'DISTRICT OF COLUMBIA' TO EFTBD100 +00447 HDR1-AGY-NAME-LINE1. EFTBD100 +00448 MOVE 'UNEMPLOYMENT COMPENSATION DIVISION' TO EFTBD100 +00449 HDR1-AGY-NAME-LINE2. EFTBD100 +00450 MOVE SPACES TO REPORT-LISTING1. EFTBD100 +00451 EFTBD100 +00452 INIT1000-EXIT. EFTBD100 +00453 EXIT. EFTBD100 +00454 EFTBD100 +00455 INIT2000-OPEN-FILES. EFTBD100 +00456 EFTBD100 +00457 PERFORM SERV1100-OPEN-FILES THRU SERV1100-EXIT. CL*33 +00458 EFTBD100 +00459 EFTBD100 +00460 INIT2000-EXIT. EFTBD100 +00461 EXIT. EFTBD100 +00462 EFTBD100 +00463 INIT4000-SYSTEM-DATE. EFTBD100 +00464 ACCEPT WRK-FED-6-DATE FROM DATE. EFTBD100 +00465 EFTBD100 +00466 MOVE WRK-FED-YY TO WRK-DISPLAY-6-YY. EFTBD100 +00467 MOVE WRK-FED-MM TO WRK-DISPLAY-6-MM. EFTBD100 +00468 MOVE WRK-FED-DD TO WRK-DISPLAY-6-DD. EFTBD100 +00469 EFTBD100 +00470 MOVE WRK-DISPLAY-6-DATE TO HDR1-SYS-DATE EFTBD100 +00471 EFTBD100 +00472 ACCEPT WRK-TIME FROM TIME. EFTBD100 +00473 EFTBD100 +00474 MOVE WRK-TIME-HOURS TO WRK-DISPLAY-HOURS. EFTBD100 +00475 MOVE WRK-TIME-MINUTES TO WRK-DISPLAY-MINUTES, EFTBD100 +00476 MOVE WRK-TIME-SECONDS TO WRK-DISPLAY-SECONDS. EFTBD100 +00477 EFTBD100 +00478 MOVE WRK-DISPLAY-TIME TO HDR1-SYS-TIME. CL*13 +00479 EFTBD100 +00480 INIT4000-EXIT. EFTBD100 +00481 EXIT. EFTBD100 +00482 EFTBD100 +00483 INIT5000-READ-FIRST. EFTBD100 +00484 EFTBD100 +00485 PERFORM SERV1200-READ-NEXT THRU SERV1200-EXIT. EFTBD100 +00486 EFTBD100 +00487 INIT5000-EXIT. EFTBD100 +00488 EXIT. EFTBD100 +00489 EFTBD100 +00490 INIT6000-INIT-REPORTS. EFTBD100 +00491 EFTBD100 +00492 SET EFT-L100-CMD-INIT-88 TO TRUE. CL*12 +00493 EFTBD100 +00494 SET WS-FENR-110-88 TO TRUE. CL*38 +00495 PERFORM PROC1100-FENR THRU PROC1100-EXIT. CL*43 +00496 EFTBD100 +00497 SET WS-FEST-120-88 TO TRUE. CL*38 +00498 PERFORM PROC1200-FEST THRU PROC1200-EXIT. CL*38 +00499 CL*38 +00500 SET WS-FDPT-130-88 TO TRUE. CL**8 +00501 PERFORM PROC1300-FDPT THRU PROC1300-EXIT. CL*38 +00502 EFTBD100 +00503 SET WS-FQTF-140-88 TO TRUE. CL*53 +00504 PERFORM PROC1400-FQTF THRU PROC1400-EXIT. CL*53 +00505 EFTBD100 +00506 INIT6000-EXIT. EFTBD100 +00507 EXIT. EFTBD100 +00508 EFTBD100 +00509 PROC1000-SCAN-EFT-FILE. CL*19 +00510 EFTBD100 +00511 SET EFT-L100-CMD-PROCESS-88 TO TRUE. CL*12 +00512 CL*26 +00513 IF EFT-SORT-TRAN NOT = WRK-PARM-REC00 CL*42 +00514 AND WRK-PARM-REC01 CL*42 +00515 AND WRK-PARM-REC02 CL*42 +00516 AND WRK-PARM-REC03 CL*16 +00517 AND WRK-PARM-REC04 CL*16 +00518 AND WRK-PARM-REC05 CL*16 +00519 GO TO PROC1000-READ-NEXT. CL*16 +00520 EFTBD100 +00521 IF EFT-SORT-TRAN = 00 CL*38 +00522 ADD +1 TO WRK-FENR-REC-CNT CL*52 +00523 PERFORM PROC1100-FENR THRU PROC1100-EXIT CL*39 +00524 ELSE EFTBD100 +00525 IF EFT-SORT-TRAN = 01 CL*38 +00526 ADD +1 TO WRK-FEST-REC-CNT CL*52 +00527 PERFORM PROC1200-FEST THRU PROC1200-EXIT CL*39 +00528 ELSE CL**8 +00529 IF EFT-SORT-TRAN = 02 CL*38 +00530 ADD +1 TO WRK-FDPT-REC-CNT CL*52 +00531 PERFORM PROC1300-FDPT THRU PROC1300-EXIT CL*39 +00532 ELSE CL**8 +00533 IF EFT-SORT-TRAN = 03 CL*38 +00534 ADD +1 TO WRK-FQTF-REC-CNT CL*52 +00535 PERFORM PROC1400-FQTF THRU PROC1400-EXIT CL*39 +00536 ELSE CL**8 +00537 IF EFT-SORT-TRAN = 04 CL*38 +00538 ADD +1 TO WRK-FDPY-REC-CNT CL*52 +00539 PERFORM PROC1500-FDPT THRU PROC1500-EXIT CL*39 +00540 ELSE CL**8 +00541 IF EFT-SORT-TRAN = 05 CL*38 +00542 ADD +1 TO WRK-FCQW-REC-CNT CL*52 +00543 PERFORM PROC1600-FCQW THRU PROC1600-EXIT CL*38 +00544 ELSE CL*38 +00545 DISPLAY '***** INVLAID RECORD TYPE**** ' CL*16 +00546 SET ABEND-RPT-FILE-READ TO TRUE CL*16 +00547 PERFORM SERV9999-ABEND THRU SERV9999-EXIT CL*16 +00548 END-IF CL*38 +00549 END-IF CL*38 +00550 END-IF CL**8 +00551 END-IF CL**8 +00552 END-IF CL**8 +00553 END-IF. EFTBD100 +00554 EFTBD100 +00555 EFTBD100 +00556 PROC1000-READ-NEXT. EFTBD100 +00557 PERFORM SERV1200-READ-NEXT THRU SERV1200-EXIT. EFTBD100 +00558 EFTBD100 +00559 PROC1000-EXIT. EFTBD100 +00560 EXIT. EFTBD100 +00561 EFTBD100 +00562 PROC1100-FENR. CL*38 +00563 DISPLAY ' CALLING 110' CL*49 +00564 SET WS-FENR-110-88 TO TRUE. CL*38 +00565 MOVE EFT-TRANS-REC TO RSKL-REC. CL*38 +00566 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*38 +00567 RSKL-REC. CL*39 +00568 CL*38 +00569 PROC1100-EXIT. EFTBD100 +00570 EXIT. EFTBD100 +00571 EFTBD100 +00572 PROC1200-FEST. CL*38 +00573 CL*38 +00574 DISPLAY ' CALLING 120' CL*49 +00575 SET WS-FEST-120-88 TO TRUE. CL*38 +00576 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 +00577 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 +00578 RSKL-REC. CL*42 +00579 CL*42 +00580 CL*38 +00581 PROC1200-EXIT. CL*38 +00582 EXIT. CL*38 +00583 CL*38 +00584 PROC1300-FDPT. CL*38 +00585 DISPLAY ' CALLING 130' CL*49 +00586 MOVE EFT-TRANS-REC TO RSKL-REC. CL*18 +00587 SET WS-FDPT-130-88 TO TRUE. CL**8 +00588 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*18 +00589 RSKL-REC. CL*39 +00590 CL*36 +00591 PROC1300-EXIT. CL*38 +00592 EXIT. EFTBD100 +00593 EFTBD100 +00594 PROC1400-FQTF. CL*38 +00595 EFTBD100 +00596 DISPLAY ' CALLING 140' CL*49 +00597 SET WS-FQTF-140-88 TO TRUE. CL**8 +00598 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 +00599 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 +00600 RSKL-REC. CL*42 +00601 CL*42 +00602 EFTBD100 +00603 PROC1400-EXIT. CL*38 +00604 EXIT. EFTBD100 +00605 EFTBD100 +00606 PROC1500-FDPT. CL*38 +00607 CL**8 +00608 SET WS-FDPT-140-88 TO TRUE. CL**8 +00609 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 +00610 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 +00611 RSKL-REC. CL*42 +00612 CL*42 +00613 CL**8 +00614 PROC1500-EXIT. CL*38 +00615 EXIT. CL**8 +00616 CL**8 +00617 CL**8 +00618 PROC1600-FCQW. CL*38 +00619 CL**8 +00620 SET WS-FCQW-140-88 TO TRUE. CL*13 +00621 MOVE EFT-TRANS-REC TO RSKL-REC. CL*42 +00622 CALL WS-EFT-PROGRAM USING EFT-REC-TYPE-LINK-AREA CL*42 +00623 RSKL-REC. CL*42 +00624 CL*42 +00625 CL**8 +00626 PROC1600-EXIT. CL*38 +00627 EXIT. CL**8 +00628 CL**8 +00629 PROC2000-PRINT-HEADER. EFTBD100 +00630 EFTBD100 +00631 IF WS-LINE-CNT GREATER 58 OR EFTBD100 +00632 WS-LINE-CNT2 GREATER 58 EFTBD100 +00633 MOVE +0 TO WS-LINE-CNT EFTBD100 +00634 MOVE +0 TO WS-LINE-CNT2 EFTBD100 +00635 ADD +1 TO WS-PAGE-CNT EFTBD100 +00636 MOVE WS-PAGE-CNT TO HDR1-PAGE-CNT EFTBD100 +00637 WRITE REPORT-LISTING1 FROM HDR1-LINE-1 EFTBD100 +00638 AFTER TOP-OF-PAGE EFTBD100 +00639 WRITE REPORT-LISTING1 FROM HDR1-LINE-2 AFTER 1 EFTBD100 +00640 WRITE REPORT-LISTING1 FROM HDR1-LINE-3 AFTER 1 EFTBD100 +00641 WRITE REPORT-LISTING1 FROM HDR1-LINE-4 AFTER 1 EFTBD100 +00642 WRITE REPORT-LISTING1 FROM HDR1-LINE-5 AFTER 1 EFTBD100 +00643 WRITE REPORT-LISTING1 FROM HDR1-LINE-6 AFTER 1 EFTBD100 +00644 WRITE REPORT-LISTING1 FROM HDR1-LINE-7 AFTER 1 EFTBD100 +00645 WRITE REPORT-LISTING1 FROM HDR1-LINE-8 AFTER 1 EFTBD100 +00646 WRITE REPORT-LISTING1 FROM HDR1-LINE-9 AFTER 1 EFTBD100 +00647 ADD +9 TO WS-LINE-CNT2. EFTBD100 +00648 EFTBD100 +00649 PROC2000-EXIT. EFTBD100 +00650 EXIT. EFTBD100 +00651 EFTBD100 +00652 EFTBD100 +00653 TERM0000-TERMINATE. EFTBD100 +00654 PERFORM TERM1000-CLOSE-REPORT THRU TERM1000-EXIT. EFTBD100 +00655 PERFORM TERM2000-CONTROL-REPORT THRU TERM2000-EXIT. EFTBD100 +00656 PERFORM TERM3000-CLOSE-FILES THRU TERM3000-EXIT. EFTBD100 +00657 EFTBD100 +00658 DISPLAY ' BD100 TERM END '. CL*28 +00659 TERM0000-EXIT. EFTBD100 +00660 EXIT. EFTBD100 +00661 EFTBD100 +00662 TERM1000-CLOSE-REPORT. EFTBD100 +00663 EFTBD100 +00664 SET EFT-L100-CMD-TERMINATE-88 TO TRUE. CL*12 +00665 CL**9 +00666 SET WS-FENR-110-88 TO TRUE. CL*43 +00667 PERFORM PROC1100-FENR THRU PROC1100-EXIT. CL*39 +00668 CL*38 +00669 SET WS-FEST-120-88 TO TRUE. CL*38 +00670 PERFORM PROC1200-FEST THRU PROC1200-EXIT. CL*39 +00671 EFTBD100 +00672 SET WS-FDPT-130-88 TO TRUE. CL**9 +00673 PERFORM PROC1300-FDPT THRU PROC1300-EXIT. CL*39 +00674 EFTBD100 +00675 SET WS-FQTF-140-88 TO TRUE. CL*53 +00676 PERFORM PROC1400-FQTF THRU PROC1400-EXIT. CL*53 +00677 EFTBD100 +00678 TERM1000-EXIT. EFTBD100 +00679 EXIT. EFTBD100 +00680 EFTBD100 +00681 TERM2000-CONTROL-REPORT. EFTBD100 +00682 EFTBD100 +00683 DISPLAY '**** BD100 STATS ***** : ' CL*42 +00684 DISPLAY 'BD110-35 FENR RECORDS CNT : ' CL*69 +00685 WRK-FENR-REC-CNT. CL*69 +00686 CL*69 +00687 DISPLAY 'BD120-34 FEST RECORDS CNT : ' CL*69 +00688 WRK-FEST-REC-CNT. CL**7 +00689 CL*42 +00690 DISPLAY 'FDPT -NO RPTS RECORDS CNT : ' CL*10 +00691 WRK-FDPT-REC-CNT. CL**7 +00692 EFTBD100 +00693 CL*10 +00694 DISPLAY 'FDPT -W/RPTS RECORDS CNT : ' CL*10 +00695 WRK-FDPY-REC-CNT. CL*10 +00696 CL*10 +00697 DISPLAY 'BD140-30 FQTF RECORDS CNT : ' CL*69 +00698 WRK-FQTF-REC-CNT. CL**7 +00699 EFTBD100 +00700 DISPLAY 'BD140-33 FCQW RECORDS CNT : ' CL*69 +00701 WRK-FCQW-REC-CNT. CL**8 +00702 CL**7 +00703 DISPLAY ' TOTAL GOV1 INPUT REPORT RECORDS READ : ' CL**7 +00704 WRK-RPT-FILE-READ-CNT. EFTBD100 +00705 EFTBD100 +00706 MOVE WRK-RPT-FILE-READ-CNT TO DTL-READ-CNT. EFTBD100 +00707 MOVE WRK-FENR-REC-CNT TO DTL-FENR-CNT. CL*42 +00708 MOVE WRK-FEST-REC-CNT TO DTL-FEST-CNT. CL*42 +00709 MOVE WRK-FDPT-REC-CNT TO DTL-FDPT-CNT. CL**7 +00710 MOVE WRK-FCQW-REC-CNT TO DTL-FCQW-CNT. CL**7 +00711 MOVE WRK-FQTF-REC-CNT TO DTL-FQTF-CNT. CL**7 +00712 MOVE WRK-FDPY-REC-CNT TO DTL-FDPY-CNT. CL*10 +00713 EFTBD100 +00714 PERFORM PROC2000-PRINT-HEADER THRU PROC2000-EXIT. EFTBD100 +00715 WRITE REPORT-LISTING1 FROM DTL-LINE-2 AFTER 2. EFTBD100 +00716 WRITE REPORT-LISTING1 FROM DTL-LINE-3 AFTER 2. CL*42 +00717 WRITE REPORT-LISTING1 FROM DTL-LINE-5 AFTER 2. CL*70 +00718 WRITE REPORT-LISTING1 FROM DTL-LINE-6 AFTER 2. CL*70 +00719 WRITE REPORT-LISTING1 FROM DTL-LINE-7 AFTER 2. EFTBD100 +00720 WRITE REPORT-LISTING1 FROM DTL-LINE-8 AFTER 2. CL*63 +00721 WRITE REPORT-LISTING1 FROM DTL-LINE-9 AFTER 2. EFTBD100 +00722 WRITE REPORT-LISTING1 FROM DTL-LINE-12 AFTER 3. EFTBD100 +00723 EFTBD100 +00724 EFTBD100 +00725 TERM2000-EXIT. EFTBD100 +00726 EXIT. EFTBD100 +00727 EFTBD100 +00728 TERM3000-CLOSE-FILES. EFTBD100 +00729 PERFORM SERV3300-CLOSE-FILE THRU SERV3300-EXIT. CL*33 +00730 EFTBD100 +00731 TERM3000-EXIT. EFTBD100 +00732 EXIT. EFTBD100 +00733 EFTBD100 +00734 SERV1100-OPEN-FILES. CL*34 +00735 OPEN INPUT EFT-REC-FILE. CL*12 +00736 EFTBD100 +00737 IF NOT EFT-FILE-OK-88 CL*13 +00738 DISPLAY 'REPORT FILE OPEN ERROR: ' EFT-FILE-STATUS CL*13 +00739 SET ABEND-RPT-FILE-OPEN TO TRUE EFTBD100 +00740 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. EFTBD100 +00741 EFTBD100 +00742 OPEN OUTPUT PRT-FILE. CL*33 +00743 CL*33 +00744 MOVE 'N' TO L927-TRACE-IND. CL*33 +00745 MOVE WRK-MOD-NAME TO L927-MOD-NAME. CL*33 +00746 PERFORM SERV2000-OPEN-BTC THRU SERV2000-EXIT. CL*33 +00747 CL*44 +00748 MOVE 'N' TO WRK-TRACE-IND. CL*44 +00749 MOVE WRK-TRACE-IND TO L910-TRACE-IND. CL*44 +00750 MOVE WRK-MOD-NAME TO L910-MOD-NAME. CL*44 +00751 * PERFORM S910-OPEN-UPDATE THRU S910-EXIT. CL*44 +00752 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*44 +00753 PERFORM S931-OPEN-READ THRU S931-EXIT. CL*65 +00754 CL*44 +00755 MOVE WRK-TRACE-IND TO L921-TRACE-IND. CL*44 +00756 MOVE WRK-MOD-NAME TO L921-MOD-NAME. CL*44 +00757 PERFORM S921-OPEN-READ THRU S921-EXIT. CL*55 +00758 CL*50 +00759 MOVE WRK-TRACE-IND TO L985-TRACE-IND. CL*64 +00760 MOVE WRK-MOD-NAME TO L985-MOD-NAME. CL*64 +00761 *** PERFORM S985-OPEN-UPDATE THRU S985-EXIT. CL*67 +00762 CL*54 +00763 MOVE LENGTH OF F907-REC TO F907-LENGTH. CL*50 +00764 MOVE '035' TO F907-MSG-ID CL*50 +00765 MOVE EFT035 TO F907-MSG-TEXT CL*50 +00766 MOVE ZEROS TO F907-EMP-NO CL*50 +00767 MOVE RSKL-REC-TYPE TO F907-GOV1-RECID CL*50 +00768 CALL 'DTSBU946' USING F907-REC. CL*50 +00769 CL*50 +00770 CL*44 +00771 CL*44 +00772 CL*33 +00773 SERV1100-EXIT. EFTBD100 +00774 EXIT. EFTBD100 +00775 EFTBD100 +00776 SERV1200-READ-NEXT. EFTBD100 +00777 EFTBD100 +00778 READ EFT-REC-FILE AT END CL*26 +00779 SET EFT-FILE-EOF-88 TO TRUE. CL*26 +00780 CL*26 +00781 IF EFT-FILE-OK-88 CL*13 +00782 ADD 1 TO WRK-RPT-FILE-READ-CNT EFTBD100 +00783 ELSE EFTBD100 +00784 IF EFT-FILE-EOF-88 CL*13 +00785 NEXT SENTENCE EFTBD100 +00786 ELSE EFTBD100 +00787 DISPLAY 'REPORT FILE READ ERROR: ' EFTBD100 +00788 EFT-FILE-STATUS CL*13 +00789 ' RECS READ ' WRK-RPT-FILE-READ-CNT EFTBD100 +00790 SET ABEND-RPT-FILE-READ TO TRUE EFTBD100 +00791 PERFORM SERV9999-ABEND THRU SERV9999-EXIT EFTBD100 +00792 END-IF EFTBD100 +00793 END-IF. EFTBD100 +00794 EFTBD100 +00795 SERV1200-EXIT. EFTBD100 +00796 EXIT. EFTBD100 +00797 EFTBD100 +00798 CL*18 +00799 SERV2000-OPEN-BTC. CL*33 +00800 CL*33 +00801 SET L927-OPEN-UPDATE-88 TO TRUE. CL*33 +00802 GO TO SERV2000-CALL-PROG. CL*33 +00803 CL*33 +00804 SERV2000-CLOS-BTC. CL*33 +00805 CL*33 +00806 SET L927-CLOSE-88 TO TRUE. CL*33 +00807 GO TO SERV2000-CALL-PROG. CL*33 +00808 CL*41 +00809 SERV2000-CALL-PROG. CL*41 +00810 CL*41 +00811 CALL 'DTSBU927' USING L927-LINK-AREA CL*41 +00812 TSKL-REC. CL*41 +00813 CL*41 +00814 CL*41 +00815 SERV2000-EXIT. CL*18 +00816 EXIT. CL*18 +00817 EFTBD100 +00818 SERV3300-CLOSE-FILE. CL*33 +00819 CLOSE PRT-FILE. CL**6 +00820 CL*42 +00821 CLOSE EFT-REC-FILE. CL*33 +00822 CL*42 +00823 PERFORM SERV2000-CLOS-BTC THRU SERV2000-EXIT. CL*33 +00824 CL*42 +00825 MOVE -1 TO R907-LENGTH. CL*42 +00826 CALL 'DTSBU946' USING R907-REC. CL*40 +00827 CL*44 +00828 PERFORM S910-CLOSE THRU S910-EXIT. CL*44 +00829 CL*44 +00830 PERFORM S921-CLOSE THRU S921-EXIT. CL*44 +00831 *** PERFORM S985-CLOSE THRU S985-EXIT. CL*67 +00832 CL*44 +00833 SERV3300-EXIT. CL*45 +00834 EXIT. CL*45 +00835 CL*45 +00836 S910-OPEN-READ. CL*44 +00837 SET L910-OPEN-READ-88 TO TRUE. CL*44 +00838 GO TO S910-MSTR-IO. CL*44 +00839 CL*44 +00840 S910-OPEN-UPDATE. CL*44 +00841 SET L910-OPEN-UPDATE-88 TO TRUE. CL*44 +00842 GO TO S910-MSTR-IO. CL*44 +00843 CL*44 +00844 S910-OPEN-UPDATE-NO-AIX. CL*44 +00845 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*44 +00846 GO TO S910-MSTR-IO. CL*44 +00847 CL*44 +00848 S910-READ. CL*44 +00849 SET L910-READ-88 TO TRUE. CL*44 +00850 GO TO S910-MSTR-IO. CL*44 +00851 CL*44 +00852 S910-START-BROWSE. CL*44 +00853 SET L910-START-BROWSE-88 TO TRUE. CL*44 +00854 GO TO S910-MSTR-IO. CL*44 +00855 CL*44 +00856 S910-READ-NEXT. CL*44 +00857 SET L910-READ-NEXT-88 TO TRUE. CL*44 +00858 GO TO S910-MSTR-IO. CL*44 +00859 CL*44 +00860 S910-COUNT. CL*44 +00861 SET L910-COUNT-88 TO TRUE. CL*44 +00862 GO TO S910-MSTR-IO. CL*44 +00863 CL*44 +00864 S910-CLOSE. CL*44 +00865 SET L910-CLOSE-88 TO TRUE. CL*44 +00866 GO TO S910-MSTR-IO. CL*44 +00867 CL*44 +00868 S910-MSTR-IO. CL*44 +00869 CALL 'DTSBU910' USING L910-LINK-AREA CL*44 +00870 MSKL-REC. CL*44 +00871 S910-EXIT. CL*44 +00872 EXIT. CL*44 +00873 CL*44 +00874 S921-OPEN-READ. CL*56 +00875 SET L921-OPEN-READ-88 TO TRUE. CL*56 +00876 GO TO S921-AIX-IO. CL*44 +00877 CL*44 +00878 S921-CLOSE. CL*44 +00879 SET L921-CLOSE-88 TO TRUE. CL*44 +00880 GO TO S921-AIX-IO. CL*44 +00881 CL*44 +00882 S921-AIX-IO. CL*44 +00883 CALL 'DTSBU921' USING L921-LINK-AREA CL*44 +00884 ISKL-REC. CL*44 +00885 S921-EXIT. CL*44 +00886 EXIT. EFTBD100 +00887 EFTBD100 +00888 S931-OPEN-READ. CL*65 +00889 SET L931-OPEN-READ-88 TO TRUE. CL*65 +00890 GO TO S931-CALL-931. CL*65 +00891 CL*65 +00892 S931-CLOSE. CL*65 +00893 SET L931-CLOSE-88 TO TRUE. CL*65 +00894 CL*65 +00895 S931-CALL-931. CL*65 +00896 CALL 'DTSBU931' USING L931-LINK-AREA. CL*65 +00897 S931-EXIT. CL*65 +00898 EXIT. CL*65 +00899 CL*65 +00900 CL*54 +00901 S985-OPEN-UPDATE. CL*64 +00902 SET L985-OPEN-UPDATE-88 TO TRUE. CL*64 +00903 GO TO S985-WAGE-IO. CL*64 +00904 CL*54 +00905 S985-CLOSE. CL*64 +00906 SET L985-CLOSE-88 TO TRUE. CL*64 +00907 GO TO S985-WAGE-IO. CL*64 +00908 CL*54 +00909 S985-WAGE-IO. CL*64 +00910 CALL 'DTSBU985' USING L985-LINK-AREA CL*64 +00911 WSKL-REC. CL*54 +00912 S985-EXIT. CL*64 +00913 EXIT. CL*54 +00914 CL*54 +00915 SERV9999-ABEND. EFTBD100 +00916 DISPLAY '**** EFTBD100 ABENDING '. CL**7 +00917 CALL ABEND-MOD USING ABEND-CODE. EFTBD100 +00918 SERV9999-EXIT. EFTBD100 +00919 EXIT. EFTBD100 +00920 EFTBD100 diff --git a/Batch/EFTBD110.cob b/Batch/EFTBD110.cob new file mode 100644 index 0000000..7230330 --- /dev/null +++ b/Batch/EFTBD110.cob @@ -0,0 +1,579 @@ +00001 IDENTIFICATION DIVISION. 02/09/04 +00002 PROGRAM-ID. EFTBD110. EFTBD110 +00003 AUTHOR. NORTHROP GRUMMAN. LV223 +00004 DATE-WRITTEN. APRIL 2003. CL129 +00005 DATE-COMPILED. CL146 +00006 SKIP3 CL146 +00007 ***** CL146 +00008 * CL146 +00009 * FUNCTION: PROCESS DAILY ENROLLMENT FILE FROM GOVONE AND CL201 +00010 * UPDATES THE TAX DATABASE. IT MODIFIES THE ENROLL- CL125 +00011 * MENT INDICATOR ON THR MPRF RECORD AND THE MOPO CL125 +00012 * RECORDS THAT CONTAIN CONTACT NAMES AND SET THE CL125 +00013 * MOPO-TYPR-EFT-VENDOR-88 TO TRUE. CL125 +00014 * CL146 +00015 * MODIFICATION LOG: CL146 +00016 * CL146 +00017 * 04/22/03 INITIAL DEVELOPMENT CL129 +00018 * WORK ORDER: PROGRAMMER: RW1 CL**3 +00019 * CL**3 +00020 * 02/04/04 NOTE**** OPO RECORD IS NOT DELETED WHEN EMPLOYER CL221 +00021 * UNENROLL FROM EFT PROGRAMMER: ZL1 CL221 +00022 * CL221 +00023 * 02/04/04 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL221 +00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 +00025 * WORK ORDER: PROGRAMMER: XXX CL**3 +00026 * CL146 +00027 * DESCRIPTION: CL146 +00028 * CL146 +00029 * INITIATION: CL146 +00030 * NONE CL*91 +00031 * CL146 +00032 * PARAMETERS INPUT: CL*50 +00033 * NONE CL*91 +00034 * CL*50 +00035 * PROCESSING: CL146 +00036 * READ THE ENROLLMENT FILE SEQUENTIALLY FROM GOVONE CL125 +00037 * AND COMPARES THE EMP-NO WITH THE MPRF MASTER FILE. CL125 +00038 * CL125 +00039 * TERMINATION: CL146 +00040 * OUTPUT STATISTICAL RECORDS COUNT. CL*50 +00041 * CL146 +00042 * RECORDS UPDATED: CL125 +00043 * MASTER: CL**3 +00044 * MPRF AND MOPO FILES CL125 +00045 * CL**3 +00046 * ALTERNATE INDEX: CL146 +00047 * NONE. CL146 +00048 * CL146 +00049 * REFERENCE: CL146 +00050 * NONE. CL146 +00051 * CL146 +00052 * REPORT RECORDS WRITTEN: CL146 +00053 * NONE CL125 +00054 * CL*50 +00055 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: CL241 +00056 * NONE CL125 +00057 * CL146 +00058 * MODULES CALLED: CL146 +00059 * DTSBU001 DATE CONVERSION/EDIT. CL146 +00060 * DTSBU004 QUARERLY SUMMARY REPORT REC. CL*47 +00061 * DTSBU910 VSAM MASTER FILES I/O. CL*74 +00062 * DTSBU927 VARIABLE LENGTH RECORDS BTC OUTPUT. CL166 +00063 * CL166 +00064 * CL146 +00065 ***** CL146 +00066 SKIP3 CL*13 +00067 ENVIRONMENT DIVISION. CL146 +00068 CL*58 +00069 INPUT-OUTPUT SECTION. CL*58 +00070 CL*58 +00071 DATA DIVISION. CL*13 +00072 CL*58 +00073 WORKING-STORAGE SECTION. CL146 +000735 77 PAN-VALET PICTURE X(24) VALUE '223EFTBD110 02/09/04'. CL146 +00074 CL*40 +00075 01 WRK-AREA. CL146 +00076 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +110. CL179 +00077 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD110'. CL179 +00078 05 WRK-ABEND-MSG PIC X(60). CL*83 +00079 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL126 +00080 CL*69 +00081 05 EFT-STATUS PIC X(02). CL*58 +00082 88 EFT-STATUS-OK-88 VALUE '00'. CL*58 +00083 88 EFT-STATUS-EOF-88 VALUE '10'. CL149 +00084 CL126 +00085 05 EMP-FOUND-IND PIC X(01). CL197 +00086 05 WRK-MPRF-IND PIC X(01). CL197 +00087 88 WRK-MPRF-OK-88 VALUE '0'. CL151 +00088 88 WRK-MPRF-EOF-88 VALUE '1'. CL151 +00089 CL126 +00090 05 EFT-CHAR-CNT PIC S9(04) COMP. CL151 +00091 05 WRK-NUMBER-ONE PIC S9(03) COMP-3 VALUE +0. CL*59 +00092 05 WRK-SUM-SSN-WAGES-AMT PIC S9(07)V99 VALUE +0. CL*59 +00093 05 WRK-TOTAL-WAGES-AMT PIC S9(09)V99 VALUE +0. CL*59 +00094 05 WRK-SSN-HOLD PIC S9(09) COMP-3 VALUE +0. CL*58 +00095 05 WRK-MOPO-ID-NO PIC S9(03) COMP-3 VALUE +0. CL140 +00096 CL101 +00097 05 WRK-PRIMARY-NAME. CL*98 +00098 10 WRK-FIRST4-NAME PIC X(04). CL101 +00099 10 WRK-REST-NAME PIC X(36). CL101 +00100 CL*98 +00101 05 WS-CONTACT-NAME. CL204 +00102 10 WS-FIRST1-NAME PIC X(01) VALUE SPACES. CL204 +00103 10 WS-REST-NAME PIC X(25) VALUE SPACES. CL204 +00104 CL204 +00105 05 WS-FIRST-NAME PIC X(15) VALUE SPACES. CL204 +00106 05 WS-LAST-NAME PIC X(20) VALUE SPACES. CL204 +00107 05 WS-MIDDLE-I PIC X(01) VALUE SPACES. CL204 +00108 CL204 +00109 05 DISP-DATE PIC X(10) VALUE SPACES. CL204 +00110 05 DISP-TIME PIC X(08) VALUE SPACES. CL*92 +00111 05 DISP-ABSTIME PIC X(16) VALUE SPACES. CL132 +00112 CL132 +00113 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. CL133 +00114 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. CL132 +00115 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. CL*92 +00116 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL132 +00117 CL132 +00118 05 WRK-EMP-NO PIC 9(06) VALUE 0. CL*77 +00119 05 WRK-EFT-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL136 +00120 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL101 +00121 05 WRK-MPRF-REWRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL136 +00122 05 WRK-MOPO-FIND-CNT PIC S9(07) COMP-3 VALUE +0. CL136 +00123 05 WRK-MOPO-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. CL136 +00124 05 WRK-MOPO-REWRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL136 +00125 05 WRK-MOPO-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL142 +00126 05 WRK-MATCHED-CNT PIC S9(07) COMP-3 VALUE +0. CL142 +00127 05 WRK-ERROR-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*78 +00128 05 WRK-BTC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL168 +00129 05 WRK-T001-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. CL177 +00130 05 WRK-T001-ADD-CNT PIC S9(07) COMP-3 VALUE +0. CL177 +00131 05 WRK-T001-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL177 +00132 05 WRK-T002-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL172 +00133 CL168 +00134 05 WRK-ERROR-IND PIC X(01). CL168 +00135 88 WRK-ERROR-YES-88 VALUE 'Y'. CL*37 +00136 88 WRK-ERROR-NO-88 VALUE 'N'. CL*37 +00137 CL125 +00138 05 FENR-CONTACT-NAME-IND PIC X(01). CL211 +00139 88 FENR-CONTACT-NAME-YES-88 VALUE 'Y'. CL211 +00140 88 FENR-CONTACT-NAME-NO-88 VALUE 'N'. CL211 +00141 CL141 +00142 05 WRK-MOPO-IND PIC X(01). CL141 +00143 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL149 +00144 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL149 +00145 CL*74 +00146 01 FENR-REC. CL125 +00147 ++INCLUDE EFTIFENR CL125 +00148 SKIP3 CL*58 +00149 01 TSKL-REC. CL190 +00150 ++INCLUDE DTSITSKL CL190 +00151 SKIP3 CL190 +00152 01 L001-LINK-AREA. CL146 +00153 ++INCLUDE DTSIL001 CL146 +00154 EJECT CL146 +00155 01 L004-LINK-AREA. CL*24 +00156 ++INCLUDE DTSIL004 CL*24 +00157 EJECT CL*24 +00158 01 L005-COMM-AREA. CL*61 +00159 ++INCLUDE DTSIL005 CL*61 +00160 EJECT CL100 +00161 01 L076-LINK-AREA. CL222 +00162 ++INCLUDE DTSIL076 CL222 +00163 EJECT CL204 +00164 01 L910-LINK-AREA. CL*94 +00165 ++INCLUDE DTSIL910 CL*94 +00166 EJECT CL162 +00167 01 L927-LINK-AREA. CL189 +00168 ++INCLUDE DTSIL927 CL189 +00169 EJECT CL189 +00170 01 EFTE-REC. CL205 +00171 ++INCLUDE EFTERMSG CL205 +00172 SKIP3 CL205 +00173 01 F907-REC. CL205 +00174 ++INCLUDE EFTIF907 CL205 +00175 SKIP3 CL205 +00176 *01 MOPO-REC. CL180 +00177 ***INCLUDE DTSIMOPO CL180 +00178 * EJECT CL180 +00179 01 MSKL-REC. CL*70 +00180 ++INCLUDE DTSIMSKL CL*70 +00181 EJECT CL*70 +00182 01 MPRF-REC. CL*70 +00183 ++INCLUDE DTSIMPRF CL*70 +00184 EJECT CL*70 +00185 01 ISKL-REC. CL157 +00186 ++INCLUDE DTSIISKL CL157 +00187 EJECT CL157 +00188 01 T001-REC. CL189 +00189 ++INCLUDE DTSIT001 CL188 +00190 01 T002-REC. CL188 +00191 ++INCLUDE DTSIT002 CL188 +00192 01 R907-REC. CL188 +00193 ++INCLUDE DTSIR907 CL188 +00194 EJECT CL188 +00195 CL188 +00196 LINKAGE SECTION. CL180 +00197 01 EFT-REC-TYPE-LINK-AREA. CL180 +00198 ++INCLUDE EFTIL100 CL180 +00199 CL180 +00200 01 RSKL-REC. CL180 +00201 ++INCLUDE EFTIRSKL CL180 +00202 CL189 +00203 PROCEDURE DIVISION USING CL180 +00204 EFT-REC-TYPE-LINK-AREA CL180 +00205 RSKL-REC. CL188 +00206 CL187 +00207 MOVE RSKL-REC TO FENR-REC. CL187 +00208 CL187 +00209 MOVE ZEROS TO EMP-FOUND-IND. CL196 +00210 CL200 +00211 IF EFT-L100-CMD-INIT-88 CL180 +00212 PERFORM I0000-INITIALIZE THRU I0000-EXIT CL180 +00213 ELSE CL180 +00214 IF EFT-L100-CMD-PROCESS-88 CL180 +00215 ADD +1 TO WRK-EFT-READ-CNT CL201 +00216 PERFORM P0000-PROCESS THRU P0000-EXIT UNTIL CL196 +00217 EMP-FOUND-IND = 1 CL196 +00218 ELSE CL180 +00219 IF EFT-L100-CMD-TERMINATE-88 CL192 +00220 PERFORM T0000-TERMINATE THRU T0000-EXIT CL180 +00221 ELSE CL180 +00222 DISPLAY 'INVLAID CALL FROM BD100 ' CL180 +00223 PERFORM S999-ABEND THRU S999-EXIT. CL180 +00224 CL180 +00225 CL*62 +00226 GOBACK. CL146 +00227 EJECT CL146 +00228 I0000-INITIALIZE. CL146 +00229 CL*72 +00230 MOVE ZERO TO WRK-EFT-READ-CNT. CL*74 +00231 SET WRK-MPRF-OK-88 TO TRUE. CL151 +00232 CL*72 +00233 PERFORM I1000-SYS-DATE THRU I1000-EXIT. CL*74 +00234 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*74 +00235 PERFORM I3000-START-BROW THRU I3000-EXIT. CL196 +00236 CL*63 +00237 I0000-EXIT. CL146 +00238 EXIT. CL146 +00239 CL107 +00240 I1000-SYS-DATE. CL*72 +00241 SET L005-FROM-SYS TO TRUE. CL*72 +00242 PERFORM S005-SYS-DATE THRU S005-EXIT. CL*72 +00243 MOVE L005-DATE TO DISP-DATE WRK-CURR-DATE. CL132 +00244 MOVE L005-TIME TO DISP-TIME WRK-CURR-TIME. CL132 +00245 MOVE L005-ABSTIME TO DISP-ABSTIME WRK-ABSTIME. CL132 +00246 CL132 +00247 * DISPLAY ' '. CL199 +00248 * DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME CL199 +00249 * ' L005-ABSTIME ' DISP-ABSTIME. CL199 +00250 I1000-EXIT. CL*72 +00251 EXIT. CL*72 +00252 CL**1 +00253 I2000-OPEN-FILES. CL*72 +00254 CL166 +00255 MOVE LENGTH OF T001-REC TO T001-LENGTH. CL191 +00256 MOVE LENGTH OF T002-REC TO T002-LENGTH. CL191 +00257 MOVE LENGTH OF F907-REC TO F907-LENGTH. CL212 +00258 MOVE WRK-MOD-NAME TO F907-MODULE-NAME. CL215 +00259 CL215 +00260 I2000-EXIT. CL*72 +00261 EXIT. CL*58 +00262 CL*58 +00263 I3000-START-BROW. CL196 +00264 CL196 +00265 CL196 +00266 MOVE +0 TO WRK-MPRF-READ-CNT. CL196 +00267 CL196 +00268 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL196 +00269 CL196 +00270 MOVE +0 TO MSKL-EMP-NO. CL196 +00271 SET MSKL-PRF-88 TO TRUE. CL196 +00272 CL196 +00273 PERFORM S910-START-BROWSE THRU S910-EXIT. CL196 +00274 IF L910-OK-88 CL196 +00275 MOVE MSKL-REC TO MPRF-REC CL196 +00276 ADD +1 TO WRK-MPRF-READ-CNT CL196 +00277 ELSE CL196 +00278 DISPLAY 'BAD FIRST READ ON MPRF ' L910-RESULT-IND CL196 +00279 PERFORM S999-ABEND THRU S999-EXIT. CL196 +00280 CL196 +00281 I3000-EXIT. CL196 +00282 EXIT. CL196 +00283 ************************************************************** CL146 +00284 * READ THE ELECTRONIC ENROLLMENT FILE FROM GOVONE AND * CL135 +00285 * COMPARES THE EMPLOYER NNUMBER WITH THE MPRF MASTER. * CL135 +00286 ************************************************************** CL146 +00287 CL146 +00288 P0000-PROCESS. CL146 +00289 CL130 +00290 IF RSKL-TYPE-ENROLL-88 CL186 +00291 NEXT SENTENCE CL200 +00292 ELSE CL185 +00293 MOVE 'THE WRONG RECORD TYPE SEND FROM PGM EFTBD100 ' TO CL185 +00294 WRK-ABEND-MSG CL185 +00295 PERFORM S999-ABEND THRU S999-EXIT CL186 +00296 END-IF. CL186 +00297 CL185 +00298 CL196 +00299 IF MPRF-EMP-NO < FENR-EMP-NO CL130 +00300 PERFORM P1000-MPRF-LESS-FENR THRU P1000-EXIT CL196 +00301 ELSE CL196 +00302 IF MPRF-EMP-NO = FENR-EMP-NO CL196 +00303 PERFORM P1100-MPRF-EQUAL-FENR THRU P1100-EXIT CL196 +00304 MOVE 1 TO EMP-FOUND-IND CL196 +00305 ELSE CL196 +00306 MOVE 1 TO EMP-FOUND-IND. CL196 +00307 CL196 +00308 PERFORM S2000-READ-MPRF THRU S2000-EXIT. CL196 +00309 CL130 +00310 P0000-EXIT. CL146 +00311 EXIT. CL146 +00312 CL135 +00313 P1000-MPRF-LESS-FENR. CL149 +00314 CL168 +00315 IF MPRF-EFT-ENROLLED-YES-88 CL196 +00316 SET T001-EFT-ENROLLMENT TO TRUE CL168 +00317 SET T001-EFT-ENROLL-DEL-88 TO TRUE CL173 +00318 PERFORM P2000-WRITE-T001 THRU P2000-EXIT CL168 +00319 ADD 1 TO WRK-T001-DELETE-CNT CL177 +00320 END-IF. CL149 +00321 CL149 +00322 P1000-EXIT. CL149 +00323 EXIT. CL149 +00324 CL149 +00325 P1100-MPRF-EQUAL-FENR. CL149 +00326 ADD +1 TO WRK-MATCHED-CNT. CL150 +00327 IF MPRF-EFT-ENROLLED-YES-88 CL149 +00328 DISPLAY ' EMP FOUND ON MPRF/UPD T002 ' MPRF-EMP-NO CL218 +00329 SET T002-UPD-CONTACT-88 TO TRUE CL197 +00330 SET T002-CONTACT-EFT-VENDOR-88 TO TRUE CL220 +00331 PERFORM P3000-WRITE-T002 THRU P3000-EXIT CL170 +00332 ELSE CL149 +00333 DISPLAY ' EMP NOT ON MPRF/ADD T001/T002 ' MPRF-EMP-NO CL218 +00334 SET T002-ADD-CONTACT-88 TO TRUE CL196 +00335 SET T002-CONTACT-EFT-VENDOR-88 TO TRUE CL220 +00336 SET T001-EFT-ENROLLMENT TO TRUE CL199 +00337 SET T001-EFT-ENROLL-ADD-88 TO TRUE CL199 +00338 ADD 1 TO WRK-T001-ADD-CNT CL199 +00339 PERFORM P2000-WRITE-T001 THRU P2000-EXIT CL168 +00340 PERFORM P3000-WRITE-T002 THRU P3000-EXIT CL168 +00341 END-IF. CL149 +00342 CL149 +00343 P1100-EXIT. CL149 +00344 EXIT. CL149 +00345 CL149 +00346 ************************************************************** CL*37 +00347 * FORMAT AND WRITE THE T001 RECORDS * CL168 +00348 ************************************************************** CL*37 +00349 CL*37 +00350 P2000-WRITE-T001. CL174 +00351 CL213 +00352 MOVE SPACES TO TSKL-REC. CL213 +00353 CL213 +00354 MOVE MPRF-EMP-NO TO T001-EMP-NO. CL169 +00355 MOVE 'IVRENRMT' TO T001-ORIGIN. CL170 +00356 MOVE L005-DATE TO T001-SYS-DATE. CL169 +00357 MOVE L005-TIME TO T001-SYS-TIME. CL169 +00358 MOVE SPACES TO T001-RESP-OP-ID. CL169 +00359 MOVE SPACE TO T001-NOT-LIABLE-LTR-TYPE. CL169 +00360 MOVE SPACE TO T001-WELCOME-LTR-IND. CL169 +00361 MOVE ZEROS TO T001-HH-START-YRQ. CL169 +00362 MOVE T001-REC TO TSKL-REC. CL188 +00363 CL188 +00364 PERFORM S927-WRITE THRU S927-EXIT. CL188 +00365 CL181 +00366 ADD 1 TO WRK-T001-WRITE-CNT. CL172 +00367 ADD 1 TO WRK-BTC-WRITE-CNT. CL168 +00368 CL*72 +00369 P2000-EXIT. CL168 +00370 EXIT. CL*72 +00371 CL168 +00372 ************************************************************** CL168 +00373 * FORMAT AND WRITE THE T002 RECORDS * CL168 +00374 ************************************************************** CL168 +00375 CL168 +00376 P3000-WRITE-T002. CL173 +00377 CL168 +00378 MOVE SPACES TO TSKL-REC. CL213 +00379 CL213 +00380 SET FENR-CONTACT-NAME-YES-88 TO TRUE. CL211 +00381 PERFORM P3001-EDIT-CONT-NAME THRU P3001-EXIT. CL211 +00382 CL202 +00383 IF FENR-CONTACT-NAME-NO-88 CL211 +00384 * DISPLAY ' T002 NOT ADDED NO NAME ' MPRF-EMP-NO CL220 +00385 GO TO P3000-EXIT. CL211 +00386 CL211 +00387 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL169 +00388 MOVE 'IVRENRMT' TO T002-ORIGIN. CL170 +00389 MOVE L005-DATE TO T002-SYS-DATE. CL169 +00390 MOVE L005-TIME TO T002-SYS-TIME. CL169 +00391 MOVE FENR-VOICE-1-AREA-CD TO T002-C-VOICE-AREA-CD. CL172 +00392 MOVE FENR-VOICE-1-PREFIX TO T002-C-VOICE-PREFIX. CL172 +00393 MOVE FENR-VOICE-1-SUFFIX TO T002-C-VOICE-SUFFIX. CL172 +00394 MOVE FENR-VOICE-1-EXT TO T002-C-VOICE-EXT. CL172 +00395 MOVE ZEROS TO T002-CONTACT-SSN. CL172 +00396 MOVE SPACES TO T002-CONTACT-TITLE. CL172 +00397 MOVE SPACES TO T002-CONTACT-FAX. CL172 +00398 MOVE SPACES TO T002-CONTACT-EMAIL. CL172 +00399 CL172 +00400 MOVE T002-REC TO TSKL-REC. CL188 +00401 CL188 +00402 PERFORM S927-WRITE THRU S927-EXIT. CL188 +00403 CL168 +00404 CL181 +00405 ADD 1 TO WRK-T002-WRITE-CNT. CL172 +00406 ADD 1 TO WRK-BTC-WRITE-CNT. CL172 +00407 CL168 +00408 P3000-EXIT. CL168 +00409 EXIT. CL168 +00410 CL136 +00411 P3001-EDIT-CONT-NAME. CL202 +00412 MOVE FENR-CONTACT-NAME TO WS-CONTACT-NAME CL207 +00413 CL204 +00414 * IF WS-FIRST1-NAME < 'A' OR > 'Z' OR = ' ' CL214 +00415 IF WS-CONTACT-NAME = SPACES OR LOW-VALUES CL219 +00416 SET FENR-CONTACT-NAME-NO-88 TO TRUE CL217 +00417 MOVE FENR-EMP-NO TO F907-EMP-NO CL217 +00418 MOVE '061' TO F907-MSG-ID CL217 +00419 MOVE EFT061 TO F907-MSG-TEXT CL217 +00420 MOVE RSKL-REC-TYPE TO F907-GOV1-RECID CL217 +00421 PERFORM S946-WRITE-R907 THRU S946-EXIT CL217 +00422 GO TO P3001-EXIT. CL217 +00423 CL204 +00424 UNSTRING WS-CONTACT-NAME CL204 +00425 DELIMITED BY ' ' INTO CL204 +00426 WS-FIRST-NAME CL204 +00427 WS-LAST-NAME CL204 +00428 WS-MIDDLE-I. CL204 +00429 CL204 +00430 MOVE WS-FIRST-NAME TO L076-NAMEF CL222 +00431 MOVE WS-LAST-NAME TO L076-NAMEL CL222 +00432 MOVE WS-MIDDLE-I TO L076-NAMEI CL222 +00433 PERFORM S076-NAME THRU S076-EXIT. CL222 +00434 IF L076-NAME-INVALID CL222 +00435 SET FENR-CONTACT-NAME-NO-88 TO TRUE CL211 +00436 MOVE FENR-EMP-NO TO F907-EMP-NO CL203 +00437 MOVE '037' TO F907-MSG-ID CL206 +00438 MOVE EFT037 TO F907-MSG-TEXT CL203 +00439 MOVE RSKL-REC-TYPE TO F907-GOV1-RECID CL203 +00440 MOVE WS-CONTACT-NAME TO F907-GOV1-DATA CL216 +00441 PERFORM S946-WRITE-R907 THRU S946-EXIT CL204 +00442 ELSE CL204 +00443 MOVE L076-NAM TO T002-CONTACT-NAME. CL222 +00444 CL207 +00445 CL203 +00446 P3001-EXIT. CL202 +00447 EXIT. CL202 +00448 CL202 +00449 T0000-TERMINATE. CL146 +00450 CL*59 +00451 DISPLAY ' '. CL221 +00452 DISPLAY ' '. CL221 +00453 CL*71 +00454 DISPLAY '*** EFTBD110 TERMINATION STATISTICS ***'. CL179 +00455 CL*71 +00456 DISPLAY ' '. CL237 +00457 DISPLAY ' NO. OF FENR RECORDS RECEIVED FROM BD100.... :' CL199 +00458 WRK-EFT-READ-CNT. CL*98 +00459 CL*98 +00460 DISPLAY ' NO. OF MPRF RECORDS READ................... :' CL199 +00461 WRK-MPRF-READ-CNT. CL144 +00462 CL144 +00463 DISPLAY ' NO.OF MPRF RECORD FOUND ................... :' CL199 +00464 WRK-MATCHED-CNT. CL142 +00465 CL144 +00466 DISPLAY ' NO. OF T001 RECORDS DELETED................ :' CL199 +00467 WRK-T001-DELETE-CNT. CL177 +00468 CL177 +00469 DISPLAY ' NO. OF TOO1 RECORDS ADDED.................. :' CL199 +00470 WRK-T001-ADD-CNT. CL177 +00471 CL177 +00472 DISPLAY ' NO. OF T001 RECORDS WRITTEN................ :' CL199 +00473 WRK-T001-WRITE-CNT. CL177 +00474 CL172 +00475 DISPLAY ' NO. OF T002 RECORDS WRITTEN................ :' CL199 +00476 WRK-T002-WRITE-CNT. CL172 +00477 CL172 +00478 DISPLAY ' '. CL172 +00479 DISPLAY ' NO. OF BTC RECORDS WRITTEN................ :' CL199 +00480 WRK-BTC-WRITE-CNT. CL172 +00481 CL**5 +00482 CL157 +00483 T0000-EXIT. CL146 +00484 EXIT. CL146 +00485 EJECT CL146 +00486 CL*59 +00487 CL149 +00488 ************************************************************** CL149 +00489 * READ THE MPRF MASTER SEQUENTIALLY. * CL149 +00490 ************************************************************** CL149 +00491 S2000-READ-MPRF. CL151 +00492 MOVE MPRF-REC TO MSKL-REC. CL151 +00493 PERFORM S910-READ-NEXT THRU S910-EXIT. CL151 +00494 IF L910-OK-88 CL151 +00495 ADD +1 TO WRK-MPRF-READ-CNT CL153 +00496 MOVE MSKL-REC TO MPRF-REC CL151 +00497 ELSE CL151 +00498 SET WRK-MPRF-EOF-88 TO TRUE. CL151 +00499 CL151 +00500 S2000-EXIT. CL151 +00501 EXIT. CL151 +00502 CL149 +00503 CL195 +00504 S001-FROM-FED-8. CL108 +00505 SET L001-FROM-FED-8 TO TRUE. CL108 +00506 GO TO S001-DATE. CL108 +00507 CL108 +00508 S001-FROM-ABS-DAY. CL108 +00509 SET L001-FROM-ABS-DAY TO TRUE. CL108 +00510 GO TO S001-DATE. CL108 +00511 CL108 +00512 S001-FROM-CAL-6. CL108 +00513 SET L001-FROM-CAL-6 TO TRUE. CL108 +00514 GO TO S001-DATE. CL108 +00515 CL108 +00516 S001-DATE. CL108 +00517 CALL 'DTSBU001' USING L001-LINK-AREA. CL108 +00518 S001-EXIT. CL108 +00519 EXIT. CL108 +00520 CL*15 +00521 CL204 +00522 S076-NAME. CL222 +00523 CALL 'DTSBU076' USING L076-LINK-AREA. CL223 +00524 S076-EXIT. CL222 +00525 EXIT. CL204 +00526 S004-FROM-3. CL*24 +00527 SET L004-FROM-3 TO TRUE. CL*24 +00528 GO TO S004-YRQ. CL*24 +00529 CL*24 +00530 S004-YRQ. CL*24 +00531 CALL 'DTSBU004' USING L004-LINK-AREA. CL*24 +00532 CL*24 +00533 S004-EXIT. CL*24 +00534 EXIT. CL*24 +00535 CL*24 +00536 S005-SYS-DATE. CL*61 +00537 CALL 'DTSBU005' USING L005-COMM-AREA. CL*61 +00538 CL*61 +00539 S005-EXIT. CL*61 +00540 EXIT. CL*61 +00541 CL*78 +00542 S910-READ. CL*70 +00543 SET L910-READ-88 TO TRUE. CL*70 +00544 GO TO S910-MSTR-IO. CL*70 +00545 CL*70 +00546 S910-START-BROWSE. CL*70 +00547 SET L910-START-BROWSE-88 TO TRUE. CL*70 +00548 GO TO S910-MSTR-IO. CL*70 +00549 CL*13 +00550 S910-READ-NEXT. CL*70 +00551 SET L910-READ-NEXT-88 TO TRUE. CL*70 +00552 GO TO S910-MSTR-IO. CL*70 +00553 CL*70 +00554 S910-MSTR-IO. CL*70 +00555 CALL 'DTSBU910' USING L910-LINK-AREA CL*70 +00556 MSKL-REC. CL*70 +00557 S910-EXIT. CL*70 +00558 EXIT. CL*70 +00559 CL*80 +00560 S927-WRITE. CL188 +00561 SET L927-WRITE-88 TO TRUE. CL188 +00562 CALL 'DTSBU927' USING L927-LINK-AREA CL188 +00563 TSKL-REC. CL188 +00564 S927-EXIT. CL188 +00565 EXIT. CL188 +00566 CL166 +00567 S946-WRITE-R907. CL205 +00568 CALL 'DTSBU946' USING F907-REC. CL205 +00569 S946-EXIT. CL205 +00570 EXIT. CL205 +00571 CL205 +00572 S999-ABEND. CL146 +00573 DISPLAY '*** EFTBD110 ABENDING : ' CL179 +00574 WRK-ABEND-MSG. CL*83 +00575 CL146 +00576 CALL 'DTSBU999' USING WRK-ABEND-CD. CL146 +00577 S999-EXIT. CL146 +00578 EXIT. CL146 diff --git a/Batch/EFTBD120.cob b/Batch/EFTBD120.cob new file mode 100644 index 0000000..c294e97 --- /dev/null +++ b/Batch/EFTBD120.cob @@ -0,0 +1,931 @@ +00001 IDENTIFICATION DIVISION. 03/18/04 +00002 PROGRAM-ID. EFTBD120. EFTBD120 +00003 AUTHOR. NORTHROP GRUMMAN. LV147 +00004 DATE-WRITTEN. JULY 2003. CL168 +00005 DATE-COMPILED. CL146 +00006 SKIP3 CL146 +00007 ***** CL146 +00008 * CL146 +00009 * FUNCTION: 1. THIS PROGRAM PROCESSES STATUS UPDATE RECORDS CL198 +00010 * FROM THE WEB REPORTING SYSTEM. THE EFTIFEST CL232 +00011 * RECORD WHICH CONTAINS THE STATUS OF EACH FIELD CL232 +00012 * TO BE CHANGED. CL*50 +00013 * 2. IT MATCHES THE EMP-NO WITH THE MTAD MASTER TO CL198 +00014 * PRODUCE A BUSINESS T002 STATUS CHANGE REC. ON CL199 +00015 * THE FIELDS OF BUSINESS NAME, ADDRESS, TELEPHONE CL232 +00016 * NUMBER, OR EMAIL ADDRESS. CL232 +00017 * 3. THEN IT MATCHES THE EMP-NO WITH THE MOPO MASTER CL199 +00018 * TO PRODUCE A CONTACT T002 STATUS CHANGE REC. ON CL199 +00019 * THE FIELDS OF CONTACT NAME, SSN, TITLE, TELEPHONE CL232 +00020 * NUMBER, OR FAX NUMBER. CL232 +00021 * 4. IT ALSO PRODUCES PRINTED REPORTS FOR OTHER CL198 +00022 * STATUS CHANGES. CL180 +00023 * CL146 +00024 * MODIFICATION LOG: CL146 +00025 * CL146 +00026 * 07/15/03 INITIAL DEVELOPMENT CL228 +00027 * WORK ORDER: PROGRAMMER: RW1 CL**3 +00028 * CL**3 +00029 * 99/99/99 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 +00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 +00031 * WORK ORDER: PROGRAMMER: XXX CL**3 +00032 * CL146 +00033 * DESCRIPTION: CL146 +00034 * CL146 +00035 * INITIATION: CL146 +00036 * NONE CL*91 +00037 * CL146 +00038 * PARAMETERS INPUT: CL*50 +00039 * NONE CL*91 +00040 * CL*50 +00041 * PROCESSING: CL146 +00042 * READ THE STATUS UPDATE FILE SEQUENTIALLY FROM GOVONE CL169 +00043 * AND MATCHES THE FEST-EMP-NO WITH THE MPRF MASTER FILE, CL170 +00044 * MTAD, AND MOPO FILES TO CREATE A T002 STATUS UPDATE CL*55 +00045 * FILE FOR ACCOUNT UPDATING PROCESSES. CL*50 +00046 * CL181 +00047 * TERMINATION: CL146 +00048 * OUTPUT STATISTICAL RECORDS COUNT. CL*50 +00049 * CL146 +00050 * RECORDS READ: CL206 +00051 * MASTER: CL**3 +00052 * MPRF, MTAD, AND MOPO MASTER FILES. CL*55 +00053 * CL**3 +00054 * ALTERNATE INDEX: CL146 +00055 * YES. CL170 +00056 * CL146 +00057 * REFERENCE: CL146 +00058 * NONE. CL146 +00059 * CL146 +00060 * REPORT RECORDS WRITTEN: CL146 +00061 * STATUS REPORT. CL170 +00062 * CL*50 +00063 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: CL241 +00064 * T002 CL170 +00065 * CL146 +00066 * MODULES CALLED: CL146 +00067 * DTSBU001 DATE CONVERSION/EDIT. CL146 +00068 * DTSBU004 QUARERLY SUMMARY REPORT REC. CL*47 +00069 * DTSBU910 VSAM MASTER FILES I/O. CL*74 +00070 * DTSBU927 VARIABLE LENGTH RECORD BTC OUTPUT. CL166 +00071 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. CL166 +00072 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. CL*35 +00073 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. CL*35 +00074 * CL146 +00075 * VERMONT REFERENCE: CL146 +00076 * NONE. CL146 +00077 * CL146 +00078 ***** CL146 +00079 SKIP3 CL*13 +00080 ENVIRONMENT DIVISION. CL146 +00081 CL211 +00082 INPUT-OUTPUT SECTION. CL*58 +00083 CL*58 +00084 DATA DIVISION. CL*13 +00085 CL*58 +00086 WORKING-STORAGE SECTION. CL146 +000865 77 PAN-VALET PICTURE X(24) VALUE '147EFTBD120 03/18/04'. CL146 +00087 CL*40 +00088 01 WRK-AREA. CL146 +00089 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120. CL243 +00090 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD120'. CL243 +00091 05 WRK-ABEND-MSG PIC X(60). CL*83 +00092 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL126 +00093 CL*98 +00094 05 DISP-DATE PIC X(10) VALUE SPACES. CL*92 +00095 05 DISP-TIME PIC X(08) VALUE SPACES. CL*92 +00096 05 DISP-ABSTIME PIC X(16) VALUE SPACES. CL132 +00097 05 WRK-L076-NAME PIC X(32) VALUE SPACES. CL125 +00098 CL132 +00099 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. CL133 +00100 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. CL132 +00101 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. CL*92 +00102 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL132 +00103 05 WRK-MPRF-FEIN PIC S9(09) COMP-3 VALUE +0. CL102 +00104 CL132 +00105 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL101 +00106 05 WRK-ERROR-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*78 +00107 05 WRK-STATUS-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL234 +00108 05 WRK-BTC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL172 +00109 05 WRK-R907-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL172 +00110 05 WRK-R120-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*23 +00111 05 WRK-T002-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. CL240 +00112 05 WRK-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. CL240 +00113 05 WRK-REPORT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL209 +00114 CL112 +00115 05 WRK-MPRF-IND PIC X(01). CL182 +00116 88 WRK-MPRF-OK-88 VALUE '0'. CL182 +00117 88 WRK-MPRF-NO-REC-88 VALUE '1'. CL235 +00118 CL182 +00119 05 WRK-ERROR-IND PIC X(01). CL*37 +00120 88 WRK-ERROR-YES-88 VALUE 'Y'. CL182 +00121 88 WRK-ERROR-NO-88 VALUE 'N'. CL182 +00122 CL141 +00123 05 WRK-MOPO-IND PIC X(01). CL141 +00124 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL182 +00125 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL182 +00126 CL176 +00127 05 WRK-STATUS-CHNG-IND PIC X(01). CL240 +00128 88 WRK-STATUS-CHNG-YES-88 VALUE 'Y'. CL240 +00129 88 WRK-STATUS-CHNG-NO-88 VALUE 'N'. CL240 +00130 CL241 +00131 05 WRK-MTAD-T002-IND PIC X(01). CL*18 +00132 88 WRK-MTAD-T002-YES-88 VALUE 'Y'. CL*18 +00133 88 WRK-MTAD-T002-NO-88 VALUE 'N'. CL*18 +00134 CL238 +00135 05 WRK-MOPO-T002-IND PIC X(01). CL*18 +00136 88 WRK-MOPO-T002-YES-88 VALUE 'Y'. CL*18 +00137 88 WRK-MOPO-T002-NO-88 VALUE 'N'. CL*18 +00138 CL*18 +00139 05 WRK-CONT-T002-IND PIC X(01). CL118 +00140 88 WRK-CONT-T002-YES-88 VALUE 'Y'. CL118 +00141 88 WRK-CONT-T002-NO-88 VALUE 'N'. CL118 +00142 CL118 +00143 05 WRK-NAME-IN PIC X(40). CL238 +00144 05 WRK-NAME-OUT PIC X(40). CL238 +00145 05 START-SUB PIC S9(04) COMP. CL238 +00146 05 SUB1 PIC S9(04) COMP. CL238 +00147 05 SUB2 PIC S9(04) COMP. CL238 +00148 CL*91 +00149 01 ERROR-ADDRESS-AREA. CL*91 +00150 05 FILLER PIC X(03). CL*95 +00151 05 WRK-ERROR-ADDR PIC X(26). CL100 +00152 05 WRK-ERROR-CITY PIC X(16). CL100 +00153 05 WRK-ERROR-STATE PIC X(02). CL*91 +00154 05 FILLER PIC X(01). CL*96 +00155 05 WRK-ERROR-ZIP PIC X(10). CL*91 +00156 CL*91 +00157 01 ERROR-MESSAGE-AREA. CL236 +00158 05 MSG1-CHG-ONLY. CL236 +00159 10 MSG1-ID PIC X(03) VALUE '001'. CL236 +00160 10 MSG1-TEXT. CL236 +00161 15 FILLER PIC X(30) CL236 +00162 VALUE 'TRANSACTION FAILED - CHARGING '. CL236 +00163 15 FILLER PIC X(30) CL236 +00164 VALUE 'ONLY EMPLOYER '. CL236 +00165 CL236 +00166 05 MSG2-INACTIVE. CL236 +00167 10 MSG2-ID PIC X(03) VALUE '002'. CL236 +00168 10 MSG2-TEXT. CL236 +00169 15 FILLER PIC X(30) CL236 +00170 VALUE 'STATUS CHANGE ACCEPTED FOR INA'. CL236 +00171 15 FILLER PIC X(30) CL236 +00172 VALUE 'CTIVE EMPLOYER '. CL236 +00173 CL236 +00174 05 MSG3-NOT-LIABLE. CL236 +00175 10 MSG3-ID PIC X(03) VALUE '003'. CL236 +00176 10 MSG3-TEXT. CL236 +00177 15 FILLER PIC X(30) CL236 +00178 VALUE 'STATUS CHANGE ACCEPTED FOR NON'. CL236 +00179 15 FILLER PIC X(30) CL236 +00180 VALUE '-LIABLE EMPLOYER '. CL236 +00181 CL236 +00182 05 MSG4-INVALID-ADDRESS. CL237 +00183 10 MSG4-ID PIC X(03) VALUE '004'. CL237 +00184 10 MSG4-TEXT. CL237 +00185 15 FILLER PIC X(30) CL237 +00186 VALUE 'TRANSACTION REJECTED - INVALID'. CL237 +00187 15 FILLER PIC X(30) CL237 +00188 VALUE ' ADDRESS '. CL237 +00189 CL237 +00190 05 MSG5-INCOMPLETE-NAMES. CL*71 +00191 10 MSG5-ID PIC X(03) VALUE '005'. CL238 +00192 10 MSG5-TEXT. CL238 +00193 15 FILLER PIC X(30) CL238 +00194 VALUE 'TRANSACTION REJECTED - NO TRAD'. CL*73 +00195 15 FILLER PIC X(30) CL238 +00196 VALUE 'E/ENTITY NAMES '. CL*73 +00197 CL238 +00198 05 MSG6-INCOMPLETE-CONTACT. CL*71 +00199 10 MSG6-ID PIC X(03) VALUE '006'. CL*71 +00200 10 MSG6-TEXT. CL*71 +00201 15 FILLER PIC X(30) CL*71 +00202 VALUE 'TRANSACTION REJECTED - CONTACT'. CL*71 +00203 15 FILLER PIC X(30) CL*71 +00204 VALUE ' INFORMATION NOT COMPLETE '. CL*71 +00205 CL*71 +00206 EJECT CL211 +00207 01 FEST-REC. CL176 +00208 ++INCLUDE EFTIFEST CL167 +00209 SKIP3 CL*58 +00210 01 T002-REC. CL167 +00211 ++INCLUDE DTSIT002 CL167 +00212 SKIP3 CL167 +00213 01 R120-REC. CL*22 +00214 ++INCLUDE EFTIR120 CL*22 +00215 SKIP3 CL*22 +00216 01 EFTE-REC. CL*22 +00217 ++INCLUDE EFTERMSG CL*22 +00218 SKIP3 CL*22 +00219 01 L001-LINK-AREA. CL146 +00220 ++INCLUDE DTSIL001 CL146 +00221 EJECT CL146 +00222 01 L004-LINK-AREA. CL*24 +00223 ++INCLUDE DTSIL004 CL*24 +00224 EJECT CL*24 +00225 01 L005-COMM-AREA. CL*61 +00226 ++INCLUDE DTSIL005 CL*61 +00227 EJECT CL100 +00228 01 L021-COMM-AREA. CL*17 +00229 ++INCLUDE DTSIL021 CL*17 +00230 EJECT CL*17 +00231 01 L072-LINK-AREA. CL242 +00232 ++INCLUDE DTSIL072 CL241 +00233 EJECT CL241 +00234 01 L076-LINK-AREA. CL125 +00235 ++INCLUDE DTSIL076 CL125 +00236 EJECT CL*15 +00237 01 L910-LINK-AREA. CL*94 +00238 ++INCLUDE DTSIL910 CL*94 +00239 EJECT CL162 +00240 01 MSKL-REC. CL234 +00241 ++INCLUDE DTSIMSKL CL234 +00242 EJECT CL234 +00243 01 MPRF-REC. CL234 +00244 ++INCLUDE DTSIMPRF CL234 +00245 EJECT CL234 +00246 01 MTAD-REC. CL234 +00247 ++INCLUDE DTSIMTAD CL234 +00248 EJECT CL234 +00249 01 MOPO-REC. CL234 +00250 ++INCLUDE DTSIMOPO CL234 +00251 EJECT CL234 +00252 01 L927-LINK-AREA. CL173 +00253 ++INCLUDE DTSIL927 CL167 +00254 EJECT CL167 +00255 01 TSKL-REC. CL167 +00256 ++INCLUDE DTSITSKL CL167 +00257 EJECT CL167 +00258 01 L941-LINK-AREA. CL162 +00259 ++INCLUDE DTSIL941 CL162 +00260 EJECT CL*94 +00261 01 STATUS-REC. CL234 +00262 ++INCLUDE DTSIRSK3 CL234 +00263 SKIP3 CL234 +00264 01 F907-REC. CL**8 +00265 ++INCLUDE EFTIF907 CL**6 +00266 EJECT CL226 +00267 CL249 +00268 LINKAGE SECTION. CL249 +00269 01 EFT-REC-TYPE-LINK-AREA. CL249 +00270 ++INCLUDE EFTIL100 CL249 +00271 CL249 +00272 01 RSKL-REC. CL249 +00273 ++INCLUDE EFTIRSKL CL249 +00274 CL249 +00275 PROCEDURE DIVISION USING CL248 +00276 EFT-REC-TYPE-LINK-AREA CL248 +00277 RSKL-REC. CL248 +00278 CL248 +00279 MOVE RSKL-REC TO FEST-REC. CL248 +00280 CL248 +00281 IF EFT-L100-CMD-INIT-88 CL248 +00282 PERFORM I0000-INITIALIZE THRU I0000-EXIT CL248 +00283 ELSE CL248 +00284 IF EFT-L100-CMD-PROCESS-88 CL248 +00285 PERFORM P0000-PROCESS THRU P0000-EXIT CL248 +00286 ELSE CL248 +00287 IF EFT-L100-CMD-TERMINATE-88 CL251 +00288 PERFORM T0000-TERMINATE THRU T0000-EXIT CL248 +00289 ELSE CL248 +00290 DISPLAY 'INVLAID CALL FROM BD100 ' CL248 +00291 PERFORM S999-ABEND THRU S999-EXIT. CL248 +00292 CL*62 +00293 GOBACK. CL146 +00294 EJECT CL146 +00295 I0000-INITIALIZE. CL146 +00296 CL*72 +00297 SET WRK-MPRF-OK-88 TO TRUE. CL151 +00298 CL*72 +00299 PERFORM I1000-SYS-DATE THRU I1000-EXIT. CL*74 +00300 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*74 +00301 CL*63 +00302 PERFORM I3000-INIT-T002 THRU I3000-EXIT. CL240 +00303 CL240 +00304 I0000-EXIT. CL146 +00305 EXIT. CL146 +00306 CL107 +00307 I1000-SYS-DATE. CL*72 +00308 SET L005-FROM-SYS TO TRUE. CL*72 +00309 PERFORM S005-SYS-DATE THRU S005-EXIT. CL*72 +00310 MOVE L005-DATE TO DISP-DATE WRK-CURR-DATE. CL132 +00311 MOVE L005-TIME TO DISP-TIME WRK-CURR-TIME. CL132 +00312 MOVE L005-ABSTIME TO DISP-ABSTIME WRK-ABSTIME. CL132 +00313 CL132 +00314 * DISPLAY ' '. CL245 +00315 * DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME CL245 +00316 * ' L005-ABSTIME ' DISP-ABSTIME. CL247 +00317 I1000-EXIT. CL*72 +00318 EXIT. CL*72 +00319 CL**1 +00320 I2000-OPEN-FILES. CL*72 +00321 CL172 +00322 MOVE LENGTH OF T002-REC TO T002-LENGTH. CL172 +00323 MOVE LENGTH OF F907-REC TO F907-LENGTH. CL**6 +00324 MOVE LENGTH OF R120-REC TO R120-LENGTH. CL*25 +00325 CL161 +00326 I2000-EXIT. CL*72 +00327 EXIT. CL*58 +00328 CL*58 +00329 I3000-INIT-T002. CL240 +00330 CL240 +00331 MOVE ZERO TO T002-EMP-NO CL240 +00332 T002-SYS-DATE CL240 +00333 T002-SYS-TIME. CL240 +00334 CL240 +00335 MOVE SPACES TO T002-ORIGIN CL240 +00336 T002-DATA-AREA. CL240 +00337 CL240 +00338 I3000-EXIT. CL240 +00339 EXIT. CL240 +00340 CL240 +00341 ************************************************************** CL146 +00342 * READ THE EFT STATUS CHANGE FILE FROM GOVONE AND * CL175 +00343 * MATCHES THE EMPLOYER NNUMBER WITH THE MPRF MASTER. * CL175 +00344 ************************************************************** CL146 +00345 CL146 +00346 P0000-PROCESS. CL146 +00347 DISPLAY ' FEST EMP NO...... ' FEST-EMP-NO CL127 +00348 SET WRK-MOPO-FOUND-NO-88 TO TRUE. CL*90 +00349 SET WRK-MTAD-T002-YES-88 TO TRUE. CL138 +00350 SET WRK-MOPO-T002-YES-88 TO TRUE. CL*90 +00351 SET WRK-CONT-T002-YES-88 TO TRUE. CL120 +00352 SET WRK-STATUS-CHNG-NO-88 TO TRUE. CL*90 +00353 ADD +1 TO WRK-STATUS-READ-CNT CL*90 +00354 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90 +00355 CL*18 +00356 PERFORM P1100-READ-MPRF THRU P1100-EXIT CL*90 +00357 CL*18 +00358 IF WRK-MPRF-NO-REC-88 CL*90 +00359 DISPLAY ' EMP REC NOT FOUND ' FEST-EMP-NO CL117 +00360 GO TO P0000-EXIT. CL*90 +00361 CL*18 +00362 PERFORM P1200-CHECK-FEST-NAME THRU P1200-EXIT. CL122 +00363 CL120 +00364 IF WRK-MTAD-T002-YES-88 CL*90 +00365 PERFORM P1300-CHECK-FEST-ADDRESS THRU P1300-EXIT CL135 +00366 PERFORM P1600-CHECK-FEST-DATA THRU P1600-EXIT CL120 +00367 PERFORM P1700-WRITE-MTAD-T002 THRU P1700-EXIT CL134 +00368 ELSE CL120 +00369 DISPLAY '***** NO MTAD T002 REC CREATED ' FEST-EMP-NO. CL134 +00370 * CL120 +00371 ***** WRITE T002 CONTACT REC. CL118 +00372 * CL118 +00373 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90 +00374 INITIALIZE MOPO-REC CL*90 +00375 PERFORM P2000-MOPO THRU P2000-EXIT CL*90 +00376 * CL128 +00377 PERFORM P2100-CONT-NAME THRU P2100-EXIT CL128 +00378 * CL118 +00379 IF WRK-CONT-T002-YES-88 CL118 +00380 DISPLAY ' T002 YES FOUND ' FEST-EMP-NO CL127 +00381 PERFORM P2300-WRITE-CONT-T002 THRU P2300-EXIT. CL118 +00382 * CL120 +00383 ***** WRITE 120 REPORT REC. CL118 +00384 * CL118 +00385 PERFORM P3000-STATUS-SALES THRU P3000-EXIT CL*90 +00386 PERFORM P3100-STATUS-PAID THRU P3100-EXIT CL*90 +00387 PERFORM P3200-STATUS-DESC THRU P3200-EXIT CL*90 +00388 PERFORM P3300-STATUS-FEIN THRU P3300-EXIT CL*90 +00389 PERFORM P3400-STATUS-TRACE THRU P3400-EXIT CL*90 +00390 CL*18 +00391 IF WRK-STATUS-CHNG-YES-88 CL*21 +00392 PERFORM P3500-WRITE-R120 THRU P3500-EXIT. CL*36 +00393 CL*18 +00394 P0000-EXIT. CL146 +00395 EXIT. CL146 +00396 CL135 +00397 CL234 +00398 P1100-READ-MPRF. CL235 +00399 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL235 +00400 MOVE FEST-EMP-NO TO MSKL-EMP-NO. CL235 +00401 SET MSKL-PRF-88 TO TRUE. CL235 +00402 PERFORM S910-READ THRU S910-EXIT. CL235 +00403 IF L910-NO-REC-88 CL235 +00404 SET WRK-MPRF-NO-REC-88 TO TRUE CL240 +00405 DISPLAY 'NO MPRF RECORD FOUND ' FEST-EMP-NO CL235 +00406 GO TO P1100-EXIT CL236 +00407 ELSE CL235 +00408 MOVE MSKL-REC TO MPRF-REC CL235 +00409 SET WRK-MPRF-OK-88 TO TRUE CL235 +00410 END-IF. CL235 +00411 CL235 +00412 EVALUATE TRUE CL236 +00413 WHEN MPRF-CLASS-CHG-ONLY-88 CL236 +00414 MOVE MSG1-ID TO F907-MSG-ID CL**6 +00415 MOVE MSG1-TEXT TO F907-MSG-TEXT CL*11 +00416 PERFORM S946-ERROR THRU S946-EXIT CL**6 +00417 CL236 +00418 WHEN MPRF-STATUS-INACT-88 CL236 +00419 MOVE MSG2-ID TO F907-MSG-ID CL**6 +00420 MOVE MSG2-TEXT TO F907-MSG-TEXT CL*11 +00421 PERFORM S946-ERROR THRU S946-EXIT CL**6 +00422 CL236 +00423 WHEN MPRF-STATUS-UNK-88 CL236 +00424 OR MPRF-STATUS-NEVERSUB-88 CL236 +00425 MOVE MSG3-ID TO F907-MSG-ID CL**6 +00426 MOVE MSG3-TEXT TO F907-MSG-TEXT CL*11 +00427 PERFORM S946-ERROR THRU S946-EXIT CL**6 +00428 CL236 +00429 END-EVALUATE. CL236 +00430 CL236 +00431 P1100-EXIT. CL235 +00432 EXIT. CL235 +00433 CL235 +00434 P1200-CHECK-FEST-NAME. CL122 +00435 *BW1 CL*71 +00436 MOVE SPACES TO T002-BSNS-ENTITY-NAME. CL122 +00437 MOVE SPACES TO T002-BSNS-TRADE-NAME. CL122 +00438 CL135 +00439 IF (FEST-TRADE-NAME = SPACES OR LOW-VALUES) AND CL*71 +00440 (FEST-ENTITY-NAME = SPACES OR LOW-VALUES) CL*71 +00441 MOVE MSG5-ID TO F907-MSG-ID CL*71 +00442 MOVE MSG5-TEXT TO F907-MSG-TEXT CL*71 +00443 PERFORM S946-ERROR THRU S946-EXIT CL*71 +00444 SET WRK-MTAD-T002-NO-88 TO TRUE CL135 +00445 GO TO P1200-EXIT. CL*71 +00446 *BW2 CL*71 +00447 CL*71 +00448 IF FEST-TRADE-NAME = SPACES OR LOW-VALUES CL244 +00449 MOVE SPACES TO T002-BSNS-TRADE-NAME CL*55 +00450 ELSE CL244 +00451 MOVE FEST-TRADE-NAME TO WRK-NAME-IN CL236 +00452 MOVE SPACES TO WRK-NAME-OUT CL236 +00453 PERFORM P1210-UPDATE-NAME THRU P1210-EXIT CL241 +00454 MOVE WRK-NAME-OUT TO T002-BSNS-TRADE-NAME CL120 +00455 END-IF. CL236 +00456 CL236 +00457 P1200-EXIT. CL235 +00458 EXIT. CL235 +00459 CL235 +00460 P1210-UPDATE-NAME. CL236 +00461 MOVE +0 TO START-SUB CL236 +00462 SUB2. CL236 +00463 CL236 +00464 IF WRK-NAME-IN (1:2) = 'A ' CL236 +00465 IF WRK-NAME-IN (4:1) = ' ' CL236 +00466 NEXT SENTENCE CL236 +00467 ELSE CL236 +00468 MOVE +3 TO START-SUB CL236 +00469 END-IF CL236 +00470 ELSE CL236 +00471 IF WRK-NAME-IN (1:3) = 'AN ' CL236 +00472 MOVE +4 TO START-SUB CL236 +00473 ELSE CL236 +00474 IF WRK-NAME-IN (1:4) = 'THE ' CL236 +00475 MOVE +5 TO START-SUB CL236 +00476 END-IF CL236 +00477 END-IF CL236 +00478 END-IF. CL236 +00479 CL236 +00480 IF START-SUB > +0 CL236 +00481 PERFORM CL236 +00482 VARYING SUB1 FROM START-SUB BY +1 CL236 +00483 UNTIL SUB1 > +40 CL236 +00484 ADD +1 TO SUB2 CL236 +00485 MOVE WRK-NAME-IN (SUB1:1) TO WRK-NAME-OUT (SUB2:1) CL236 +00486 END-PERFORM CL236 +00487 ELSE CL236 +00488 MOVE WRK-NAME-IN TO WRK-NAME-OUT CL236 +00489 END-IF. CL236 +00490 CL236 +00491 P1210-EXIT. CL236 +00492 EXIT. CL236 +00493 CL236 +00494 P1300-CHECK-FEST-ADDRESS. CL120 +00495 CL120 +00496 SET WRK-MTAD-T002-YES-88 TO TRUE CL120 +00497 MOVE SPACES TO T002-BSNS-ATTN CL120 +00498 MOVE SPACES TO T002-BSNS-DELV1 CL120 +00499 MOVE SPACES TO T002-BSNS-DELV2 CL120 +00500 MOVE SPACES TO T002-BSNS-CITY CL120 +00501 MOVE SPACES TO T002-BSNS-ST CL120 +00502 MOVE SPACES TO T002-BSNS-ZIP CL120 +00503 MOVE SPACES TO T002-BSNS-ENTITY-NAME CL142 +00504 CL**4 +00505 IF FEST-ADDRESS-AREA = SPACES OR LOW-VALUES CL236 +00506 SET WRK-MTAD-T002-NO-88 TO TRUE CL120 +00507 MOVE MSG4-ID TO F907-MSG-ID CL*55 +00508 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*55 +00509 PERFORM S946-ERROR THRU S946-EXIT CL*55 +00510 GO TO P1300-EXIT. CL238 +00511 CL236 +00512 MOVE SPACES TO L072-ADDRESS. CL237 +00513 MOVE 'Y' TO L072-CASS-IND. CL110 +00514 SET L072-MTAD-88 TO TRUE. CL236 +00515 MOVE MPRF-PRIMARY-NAME TO L072-NAME. CL237 +00516 MOVE FEST-ATTN-LINE TO L072-ATTN-LINE. CL237 +00517 MOVE FEST-STREET-ADDRESS-1 TO L072-DELIV-LINE-1. CL236 +00518 MOVE FEST-STREET-ADDRESS-2 TO L072-DELIV-LINE-2. CL236 +00519 MOVE FEST-CITY TO L072-CITY. CL237 +00520 MOVE FEST-STATE TO L072-ST. CL237 +00521 MOVE FEST-ZIP TO L072-ZIP. CL237 +00522 CL*27 +00523 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. CL236 +00524 CL120 +00525 IF L072-ADDRESS-NOT-VALID-88 CL*46 +00526 DISPLAY 'L072 ADDRESS INVALID ' L072-MSG-AREA CL120 +00527 SET WRK-MTAD-T002-NO-88 TO TRUE CL*47 +00528 MOVE MSG4-ID TO F907-MSG-ID CL*46 +00529 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*46 +00530 MOVE FEST-STREET-ADDRESS-2 TO WRK-ERROR-ADDR CL*91 +00531 MOVE FEST-CITY TO WRK-ERROR-CITY CL*91 +00532 MOVE FEST-STATE TO WRK-ERROR-STATE CL*91 +00533 MOVE FEST-ZIP TO WRK-ERROR-ZIP CL*91 +00534 MOVE ERROR-ADDRESS-AREA TO F907-GOV1-REC-ERR CL*93 +00535 PERFORM S946-ERROR THRU S946-EXIT CL*91 +00536 GO TO P1300-EXIT. CL*46 +00537 CL239 +00538 MOVE L072-ATTN-LINE TO T002-BSNS-ATTN. CL121 +00539 MOVE L072-DELIV-LINE-1 TO T002-BSNS-DELV1. CL121 +00540 MOVE L072-DELIV-LINE-2 TO T002-BSNS-DELV2. CL121 +00541 MOVE L072-CITY TO T002-BSNS-CITY. CL121 +00542 MOVE L072-ST TO T002-BSNS-ST. CL121 +00543 MOVE L072-ZIP TO T002-BSNS-ZIP. CL121 +00544 CL115 +00545 P1300-EXIT. CL120 +00546 EXIT. CL120 +00547 CL120 +00548 P1600-CHECK-FEST-DATA. CL120 +00549 CL120 +00550 IF FEST-BUSINESS-PHONE > SPACES CL120 +00551 MOVE FEST-BUSINESS-PHONE TO T002-BUSINESS-VOICE CL120 +00552 *RW1 CL144 +00553 * (THIS IS THE BUSINESS !!!) R120-CONTACT-PHONE CL145 +00554 *RW2 CL144 +00555 ELSE CL120 +00556 MOVE SPACES TO T002-BUSINESS-VOICE. CL120 +00557 CL*18 +00558 IF FEST-FAX > SPACES CL120 +00559 MOVE FEST-FAX TO T002-BUSINESS-FAX CL120 +00560 ELSE CL120 +00561 MOVE SPACES TO T002-BUSINESS-FAX. CL120 +00562 CL*19 +00563 IF FEST-EMAIL-ADDRESS > SPACES CL120 +00564 MOVE FEST-EMAIL-ADDRESS TO T002-BUSINESS-EMAIL CL120 +00565 ELSE CL120 +00566 MOVE SPACES TO T002-BUSINESS-EMAIL. CL120 +00567 CL*19 +00568 P1600-EXIT. CL*19 +00569 EXIT. CL*19 +00570 CL*18 +00571 P1700-WRITE-MTAD-T002. CL134 +00572 CL137 +00573 DISPLAY ' WRITING T002 STATUS REC ' T002-EMP-NO. CL137 +00574 CL137 +00575 IF WRK-MTAD-T002-NO-88 CL137 +00576 GO TO P1700-EXIT. CL137 +00577 CL137 +00578 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL237 +00579 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL237 +00580 MOVE L005-DATE TO T002-SYS-DATE. CL237 +00581 MOVE L005-TIME TO T002-SYS-TIME. CL237 +00582 SET T002-UPD-MAIL-ADDR-88 TO TRUE. CL237 +00583 CL237 +00584 MOVE T002-REC TO TSKL-REC. CL239 +00585 PERFORM S927B-WRITE THRU S927B-EXIT CL239 +00586 ADD +1 TO WRK-T002-ADDR-CNT. CL240 +00587 CL237 +00588 P1700-EXIT. CL*18 +00589 EXIT. CL237 +00590 CL237 +00591 ************************************************************** CL*37 +00592 * USING THE MPRF EMP-NO TO FIND MOPO RECORD. * CL135 +00593 ************************************************************** CL*37 +00594 CL176 +00595 P2000-MOPO. CL239 +00596 CL*17 +00597 MOVE LOW-VALUES TO MOPO-KEY-AREA. CL176 +00598 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. CL176 +00599 SET MOPO-OPO-88 TO TRUE. CL176 +00600 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. CL176 +00601 CL176 +00602 PERFORM S910-START-BROWSE THRU S910-EXIT. CL176 +00603 IF L910-NO-REC-88 CL176 +00604 NEXT SENTENCE CL238 +00605 ELSE CL176 +00606 PERFORM CL176 +00607 UNTIL L910-NO-REC-88 CL176 +00608 OR WRK-MOPO-FOUND-YES-88 CL176 +00609 MOVE MSKL-REC TO MOPO-REC CL*78 +00610 IF MOPO-TYPE-STATUS-88 CL*75 +00611 MOVE MOPO-REC TO MSKL-REC CL*79 +00612 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL192 +00613 ELSE CL192 +00614 PERFORM S910-READ-NEXT THRU S910-EXIT CL176 +00615 END-IF CL176 +00616 END-PERFORM CL176 +00617 END-IF. CL176 +00618 CL**1 +00619 CL179 +00620 P2000-EXIT. CL239 +00621 EXIT. CL176 +00622 CL135 +00623 P2100-CONT-NAME. CL*20 +00624 SET WRK-CONT-T002-YES-88 TO TRUE CL118 +00625 MOVE FEST-CONTACT-FIRST-NAME TO L076-NAMEF CL125 +00626 MOVE FEST-CONTACT-MI TO L076-NAMEI CL125 +00627 MOVE FEST-CONTACT-LAST-NAME TO L076-NAMEL CL125 +00628 CL*28 +00629 PERFORM S076-NAME THRU S076-EXIT CL125 +00630 CL*28 +00631 IF L076-NAME-INVALID CL125 +00632 MOVE '061' TO F907-MSG-ID CL139 +00633 MOVE L076-NAME-GROUP TO F907-GOV1-DATA CL133 +00634 MOVE EFT061 TO F907-MSG-TEXT CL139 +00635 PERFORM S946-ERROR THRU S946-EXIT CL*20 +00636 MOVE SPACES TO F907-GOV1-DATA CL*72 +00637 MOVE SPACES TO T002-CONTACT-NAME CL*20 +00638 *RW1 CL144 +00639 MOVE SPACES TO R120-CONTACT-NAME CL144 +00640 *RW2 CL144 +00641 SET WRK-CONT-T002-NO-88 TO TRUE CL118 +00642 DISPLAY ' INV CONT NAME NO T002 CREATED' FEST-EMP-NO CL118 +00643 ELSE CL118 +00644 DISPLAY ' L076 NAME STATUS CONT NAME ' L076-NAM CL126 +00645 MOVE L076-NAM TO T002-CONTACT-NAME CL142 +00646 R120-CONTACT-NAME. CL142 +00647 CL*28 +00648 P2100-EXIT. CL*20 +00649 EXIT. CL*20 +00650 CL*20 +00651 CL*20 +00652 P2300-WRITE-CONT-T002. CL*81 +00653 CL118 +00654 MOVE SPACES TO TSKL-REC. CL118 +00655 CL118 +00656 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL*20 +00657 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL*20 +00658 MOVE L005-DATE TO T002-SYS-DATE. CL*20 +00659 MOVE L005-TIME TO T002-SYS-TIME. CL*20 +00660 MOVE ZEROS TO T002-CONTACT-SSN. CL118 +00661 MOVE SPACES TO T002-CONTACT-TITLE. CL118 +00662 MOVE SPACES TO T002-CONTACT-FAX. CL118 +00663 MOVE SPACES TO T002-CONTACT-EMAIL. CL118 +00664 MOVE FEST-CONTACT-AREA-CD TO T002-C-VOICE-AREA-CD. CL119 +00665 MOVE FEST-CONTACT-PREFIX TO T002-C-VOICE-PREFIX. CL119 +00666 MOVE FEST-CONTACT-SUFFIX TO T002-C-VOICE-SUFFIX. CL119 +00667 MOVE FEST-CONTACT-EXT TO T002-C-VOICE-EXT. CL119 +00668 CL*20 +00669 IF WRK-MOPO-FOUND-YES-88 CL*20 +00670 SET T002-UPD-CONTACT-88 TO TRUE CL*20 +00671 ELSE CL*20 +00672 SET T002-ADD-CONTACT-88 TO TRUE CL*20 +00673 END-IF. CL*20 +00674 CL*20 +00675 SET T002-CONTACT-STATUS-88 TO TRUE. CL*76 +00676 CL*20 +00677 MOVE T002-REC TO TSKL-REC. CL*20 +00678 PERFORM S927B-WRITE THRU S927B-EXIT. CL*20 +00679 ADD +1 TO WRK-T002-CONTACT-CNT. CL*20 +00680 CL*81 +00681 CL118 +00682 P2300-EXIT. CL*20 +00683 EXIT. CL*20 +00684 CL*20 +00685 ************************************************************** CL207 +00686 * IF FEST SALE DATE, LAST WAGES PAID DATE, OR STATUS CHANGE * CL209 +00687 * DESCRIPTION FIELDS CONTAIN DATA, PRINT A STATUS CHANGE * CL207 +00688 * REPORT RECORD. * CL207 +00689 ************************************************************** CL207 +00690 CL207 +00691 P3000-STATUS-SALES. CL*21 +00692 CL207 +00693 IF FEST-SALE-DATE NUMERIC CL106 +00694 IF FEST-SALE-DATE > ZEROS CL106 +00695 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106 +00696 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106 +00697 ELSE CL106 +00698 MOVE ZEROS TO R120-SALE-DATE CL106 +00699 END-IF CL106 +00700 ELSE CL106 +00701 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106 +00702 END-IF. CL106 +00703 CL106 +00704 P3000-EXIT. CL*21 +00705 EXIT. CL*21 +00706 CL*21 +00707 P3100-STATUS-PAID. CL*21 +00708 CL209 +00709 IF FEST-LAST-WAGES-PAID-DATE NUMERIC CL106 +00710 IF FEST-LAST-WAGES-PAID-DATE > ZEROS CL106 +00711 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106 +00712 R120-LAST-WAGES-PAID-DATE CL106 +00713 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106 +00714 ELSE CL106 +00715 MOVE ZEROS TO R120-LAST-WAGES-PAID-DATE CL106 +00716 END-IF CL106 +00717 ELSE CL106 +00718 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106 +00719 R120-LAST-WAGES-PAID-DATE CL106 +00720 END-IF. CL209 +00721 CL209 +00722 P3100-EXIT. CL*21 +00723 EXIT. CL*21 +00724 CL*21 +00725 P3200-STATUS-DESC. CL*21 +00726 IF FEST-STATUS-CHG-DESCRIPTION NOT = SPACES CL209 +00727 MOVE FEST-STATUS-CHG-DESCRIPTION TO CL209 +00728 R120-STATUS-CHNG-DESC CL*23 +00729 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL241 +00730 ELSE CL221 +00731 MOVE SPACES TO R120-STATUS-CHNG-DESC CL*23 +00732 END-IF. CL209 +00733 CL209 +00734 P3200-EXIT. CL*21 +00735 EXIT. CL*21 +00736 CL*36 +00737 P3300-STATUS-FEIN. CL*36 +00738 * IF FEST-FEIN > ZEROS CL101 +00739 MOVE MPRF-FEIN TO WRK-MPRF-FEIN CL103 +00740 IF FEST-FEIN NOT = WRK-MPRF-FEIN CL102 +00741 MOVE FEST-FEIN TO R120-FEIN CL140 +00742 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL140 +00743 ELSE CL*36 +00744 MOVE ZEROS TO R120-FEIN CL140 +00745 END-IF. CL*36 +00746 CL*36 +00747 P3300-EXIT. CL*36 +00748 EXIT. CL*36 +00749 CL*36 +00750 P3400-STATUS-TRACE. CL*36 +00751 IF FEST-TRACE-NO > ZEROS CL*36 +00752 MOVE FEST-TRACE-NO TO R120-TRACE-NO CL*36 +00753 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL*36 +00754 ELSE CL*36 +00755 MOVE ZEROS TO R120-TRACE-NO CL*36 +00756 END-IF. CL*36 +00757 CL*36 +00758 P3400-EXIT. CL*36 +00759 EXIT. CL*36 +00760 CL*21 +00761 P3500-WRITE-R120. CL*36 +00762 MOVE '120' TO R120-REC-TYPE. CL105 +00763 MOVE MPRF-EMP-NO TO R120-EMP-NO CL105 +00764 *RW1 CL147 +00765 IF MPRF-PRIMARY-IS-ENTITY-88 CL147 +00766 IF FEST-ENTITY-NAME NOT = MPRF-PRIMARY-NAME CL147 +00767 IF FEST-ENTITY-NAME <= SPACES CL147 +00768 MOVE SPACES TO R120-ENTITY-NAME CL147 +00769 ELSE CL147 +00770 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147 +00771 END-IF CL147 +00772 ELSE CL147 +00773 MOVE SPACES TO R120-ENTITY-NAME CL147 +00774 END-IF CL147 +00775 ELSE CL147 +00776 IF FEST-ENTITY-NAME NOT = MPRF-ENTITY-NAME CL147 +00777 IF FEST-ENTITY-NAME <= SPACES CL147 +00778 MOVE SPACES TO R120-ENTITY-NAME CL147 +00779 ELSE CL147 +00780 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147 +00781 END-IF CL147 +00782 ELSE CL147 +00783 MOVE SPACES TO R120-ENTITY-NAME CL147 +00784 END-IF CL147 +00785 END-IF. CL147 +00786 CL147 +00787 IF FEST-CONTACT-PHONE > SPACES CL144 +00788 MOVE FEST-CONTACT-AREA-CD TO R120-VOICE-AREA-CD CL144 +00789 MOVE FEST-CONTACT-PREFIX TO R120-VOICE-PREFIX CL144 +00790 MOVE FEST-CONTACT-SUFFIX TO R120-VOICE-SUFFIX CL144 +00791 MOVE FEST-CONTACT-EXT TO R120-VOICE-EXT CL144 +00792 ELSE CL144 +00793 MOVE SPACES TO R120-CONTACT-PHONE. CL144 +00794 *RW2 CL144 +00795 MOVE R120-REC TO RSKL-REC CL105 +00796 PERFORM S946-RPT-O THRU S946-EXIT CL105 +00797 ADD +1 TO WRK-R120-WRITE-CNT. CL105 +00798 CL226 +00799 P3500-EXIT. CL*36 +00800 EXIT. CL207 +00801 CL207 +00802 T0000-TERMINATE. CL146 +00803 CL212 +00804 DISPLAY ' '. CL221 +00805 DISPLAY ' '. CL221 +00806 CL*71 +00807 DISPLAY '*** EFTBD120 TERMINATION STATISTICS ***'. CL243 +00808 CL*71 +00809 DISPLAY ' '. CL237 +00810 DISPLAY ' EFT-STATUS-(01) RECS PASSED FROM BD100 :' CL253 +00811 WRK-STATUS-READ-CNT. CL242 +00812 CL*98 +00813 DISPLAY ' '. CL205 +00814 CL195 +00815 DISPLAY ' T002 MTAD - BUSINESS TRANSACTIONS WRITTEN :' CL*37 +00816 WRK-T002-ADDR-CNT. CL240 +00817 CL205 +00818 DISPLAY ' T002 MOPO - CONTACT TRANSACTIONS WRITTEN :' CL*41 +00819 WRK-T002-CONTACT-CNT. CL240 +00820 CL205 +00821 DISPLAY ' '. CL205 +00822 CL210 +00823 DISPLAY ' REPORT RECS TYPE(120) WRITTEN TO ERROR FILE :' CL*51 +00824 WRK-R120-WRITE-CNT. CL*21 +00825 CL*41 +00826 DISPLAY ' EDIT ERRORS TYPE(907) WRITTEN TO ERROR FILE :' CL*41 +00827 WRK-R907-REC-CNT. CL*41 +00828 CL210 +00829 DISPLAY ' '. CL210 +00830 CL226 +00831 T0000-EXIT. CL146 +00832 EXIT. CL146 +00833 CL*59 +00834 S001-FROM-FED-8. CL108 +00835 SET L001-FROM-FED-8 TO TRUE. CL108 +00836 GO TO S001-DATE. CL108 +00837 CL108 +00838 S001-FROM-ABS-DAY. CL108 +00839 SET L001-FROM-ABS-DAY TO TRUE. CL108 +00840 GO TO S001-DATE. CL108 +00841 CL108 +00842 S001-FROM-CAL-6. CL108 +00843 SET L001-FROM-CAL-6 TO TRUE. CL108 +00844 GO TO S001-DATE. CL108 +00845 CL108 +00846 S001-DATE. CL108 +00847 CALL 'DTSBU001' USING L001-LINK-AREA. CL108 +00848 S001-EXIT. CL108 +00849 EXIT. CL108 +00850 CL*15 +00851 S004-FROM-3. CL*24 +00852 SET L004-FROM-3 TO TRUE. CL*24 +00853 GO TO S004-YRQ. CL*24 +00854 CL*24 +00855 S004-YRQ. CL*24 +00856 CALL 'DTSBU004' USING L004-LINK-AREA. CL*24 +00857 CL*24 +00858 S004-EXIT. CL*24 +00859 EXIT. CL*24 +00860 CL*24 +00861 S005-SYS-DATE. CL*61 +00862 CALL 'DTSBU005' USING L005-COMM-AREA. CL*61 +00863 CL*61 +00864 S005-EXIT. CL*61 +00865 EXIT. CL*61 +00866 CL*17 +00867 S072-ADDRESS-EDIT. CL242 +00868 CALL 'DTSBU072' USING L072-LINK-AREA. CL242 +00869 CL242 +00870 S072-EXIT. CL242 +00871 EXIT. CL242 +00872 CL*15 +00873 S076-NAME. CL126 +00874 CALL 'DTSBU076' USING L076-LINK-AREA. CL126 +00875 CL*15 +00876 S076-EXIT. CL126 +00877 EXIT. CL*15 +00878 CL*70 +00879 S910-READ. CL*70 +00880 SET L910-READ-88 TO TRUE. CL*70 +00881 GO TO S910-MSTR-IO. CL*70 +00882 CL*70 +00883 S910-START-BROWSE. CL*70 +00884 SET L910-START-BROWSE-88 TO TRUE. CL*70 +00885 GO TO S910-MSTR-IO. CL*70 +00886 CL*13 +00887 S910-READ-NEXT. CL*70 +00888 SET L910-READ-NEXT-88 TO TRUE. CL*70 +00889 GO TO S910-MSTR-IO. CL*70 +00890 CL*70 +00891 S910-COUNT. CL*70 +00892 SET L910-COUNT-88 TO TRUE. CL*70 +00893 GO TO S910-MSTR-IO. CL*70 +00894 CL*70 +00895 S910-MSTR-IO. CL*70 +00896 CALL 'DTSBU910' USING L910-LINK-AREA CL*70 +00897 MSKL-REC. CL*70 +00898 S910-EXIT. CL*70 +00899 EXIT. CL*70 +00900 CL*80 +00901 S927B-WRITE. CL238 +00902 SET L927-WRITE-88 TO TRUE. CL166 +00903 CALL 'DTSBU927' USING L927-LINK-AREA CL238 +00904 TSKL-REC. CL238 +00905 CL238 +00906 S927B-EXIT. CL238 +00907 EXIT. CL238 +00908 CL161 +00909 S946-RPT-O. CL226 +00910 CALL 'DTSBU946' USING RSKL-REC. CL252 +00911 GO TO S946-EXIT. CL**6 +00912 CL*42 +00913 S946-ERROR. CL**6 +00914 ADD +1 TO WRK-R907-REC-CNT. CL*43 +00915 MOVE FEST-EMP-NO TO F907-EMP-NO. CL**6 +00916 MOVE '34' TO F907-GOV1-RECID. CL*34 +00917 MOVE 'EFTBD120 ' TO F907-MODULE-NAME. CL*42 +00918 CALL 'DTSBU946' USING F907-REC. CL*42 +00919 CL*42 +00920 S946-EXIT. CL226 +00921 EXIT. CL226 +00922 CL226 +00923 S999-ABEND. CL146 +00924 DISPLAY '*** EFTBD120 ABENDING : ' CL243 +00925 WRK-ABEND-MSG. CL*83 +00926 CL146 +00927 CALL 'DTSBU999' USING WRK-ABEND-CD. CL146 +00928 S999-EXIT. CL146 +00929 EXIT. CL146 +00930 CL*42 diff --git a/Batch/EFTBD140.cob b/Batch/EFTBD140.cob new file mode 100644 index 0000000..0adba35 --- /dev/null +++ b/Batch/EFTBD140.cob @@ -0,0 +1,1268 @@ +00001 IDENTIFICATION DIVISION. 03/05/04 +00002 PROGRAM-ID. EFTBD140. EFTBD140 +00003 AUTHOR. NORTHROP GRUMMAN. LV118 +00004 DATE-WRITTEN. JULY 2003. CL131 +00005 DATE-COMPILED. EFTBD140 +00006 SKIP3 EFTBD140 +00007 ***** EFTBD140 +00008 * EFTBD140 +00009 * FUNCTION: READ THE DAILY FILE OF ELECTRONIC REPORT DATA CL131 +00010 * SENT FROM GOVONE WEB REPORTING SYSTEM TO DOES. CL195 +00011 * IT BUILDS DTSIT027 QUARTERLY TAX RPT TRANS REC CL105 +00012 * AND WRITES THESE RECORDS TO THE DAILY BTC FILE CL243 +00013 * WHICH IS INPUT TO THE NIGHTLY ACCOUNTING UPDATE. CL131 +00014 * IT ALSO WRITES DTSIW001 WAGE TRANSACTION RECORD CL**8 +00015 * TO THE WTC FILE. CL**8 +00016 * THE QUARTERLY REPORT PROCESSING PROGRAM (DTSBD371) CL131 +00017 * WILL RELEASE THE WAGE TRANSACTIONS FOR PROCESSING CL131 +00018 * WHEN IT SUCCESSFULLY ADDS A QUARTERLY REPORT RECS CL138 +00019 * (MRPT) TO THE TAX MASTER FILE. CL131 +00020 * CL131 +00021 * MODIFICATION LOG: EFTBD140 +00022 * EFTBD140 +00023 * 07/01/03 INITIAL DEVELOPMENT CL131 +00024 * WORK ORDER: PROGRAMMER: RW1 CL**3 +00025 * CL**3 +00026 * 99/99/99 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 +00027 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3 +00028 * WORK ORDER: PROGRAMMER: XXX CL**3 +00029 * EFTBD140 +00030 * DESCRIPTION: EFTBD140 +00031 * EFTBD140 +00032 * INITIATION: EFTBD140 +00033 * NONE CL*91 +00034 * EFTBD140 +00035 * INPUT FILE FORMATS: CL131 +00036 * EFTIFDPT PAYMENT TRANSACTION CL131 +00037 * EFTIFQTF QUARTERLY TAX REPORT TRANSACTION CL131 +00038 * EFTIFCQW EMPLOYEE CURRENT QUARTER WAGES CL248 +00039 * CL131 +00040 * OUTPUT FILE FORMATS: CL131 +00041 * DTSIT027 QUARTERLY TAX REPORT TRANSACTION CL138 +00042 * DTSIW001 WAGE TRANSACTION CL131 +00043 * CL*50 +00044 * PROCESSING: EFTBD140 +00045 * SORT THE TRANSACTIONS BY TRACE NUMBER AND RECORD TYPE. CL132 +00046 * THIS WILL GROUP ALL RECORDS FROM THE SAME QUARTERLY CL131 +00047 * REPORT TRANSACTION TOGETHER. WITHIN THE TRACE NUMBER, CL131 +00048 * THE RECORDS WILL BE IN THE FOLLOWING ORDER: REPORT CL131 +00049 * RECORD, PAYMENT RECORD, WAGE RECORDS. TRANSACTION FOR CL131 +00050 * PAYMENT OF A BALANCE DUE OCCURS SINGLY, AND HAVE NO CL131 +00051 * RELATED RECORDS. CL131 +00052 * ALL RECORDS WITH THE SAME TRACE NUMBER ARE PART OF THE CL131 +00053 * TRANSACTION (I.E., A COMPLETE QUARTERLY REPORT CONSISTS CL131 +00054 * OF THE TAX PORTION OF THE REPORT, THE PAYMENT AND THE CL131 +00055 * WAGES). CL131 +00056 * CL131 +00057 * TERMINATION: EFTBD140 +00058 * OUTPUT STATISTICAL RECORDS COUNT. CL*50 +00059 * EFTBD140 +00060 * RECORDS READ: EFTBD140 +00061 * MASTER: CL**3 +00062 * VSAM MPRF FILE CL188 +00063 * CL**3 +00064 * ALTERNATE INDEX: EFTBD140 +00065 * NONE. EFTBD140 +00066 * EFTBD140 +00067 * REFERENCE: EFTBD140 +00068 * NONE. EFTBD140 +00069 * EFTBD140 +00070 * RECORDS UPDATED: CL**3 +00071 * NONE CL249 +00072 * EFTBD140 +00073 * REPORT RECORDS WRITTEN: EFTBD140 +00074 * R907 ERROR REPORT RECORDS. CL188 +00075 * CL*50 +00076 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: CL241 +00077 * T027 RECORDS CL243 +00078 * CL131 +00079 * WAGE TRANSACTION COLLECTION RECORDS WRITTEN: CL131 +00080 * W001 RECORDS CL131 +00081 * EFTBD140 +00082 * MODULES CALLED: EFTBD140 +00083 * DTSBU001 DATE CONVERSION/EDIT. EFTBD140 +00084 * DTSBU004 QUARERLY SUMMARY REPORT REC. CL*47 +00085 * DTSBU910 VSAM MASTER FILES I/O. CL*74 +00086 * DTSBU927 VARIABLE LENGTH RECORDS BTC OUTPUT. CL*96 +00087 * DTSBU941 VARIABLE LENGTH RECORDS INPUT 1. CL134 +00088 * DTSBU947 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 2. CL133 +00089 * DTSBU983 BATCH WAGE TRANSACTION FILE INPUT/OUTPUT. CL176 +00090 * CL176 +00091 * VERMONT REFERENCE: EFTBD140 +00092 * NONE. EFTBD140 +00093 * EFTBD140 +00094 ***** EFTBD140 +00095 SKIP3 CL*13 +00096 ENVIRONMENT DIVISION. EFTBD140 +00097 CL*58 +00098 INPUT-OUTPUT SECTION. CL*58 +00099 CL*86 +00100 FILE-CONTROL. CL*86 +00101 SELECT WAGE-TRAN-FILE ASSIGN TO DTSFW001 CL*86 +00102 FILE STATUS IS WAGE-STATUS. CL*86 +00103 CL*58 +00104 DATA DIVISION. CL*86 +00105 CL*86 +00106 FILE SECTION. CL*86 +00107 CL*86 +00108 FD WAGE-TRAN-FILE CL*86 +00109 RECORDING MODE IS F CL*94 +00110 LABEL RECORDS ARE STANDARD CL*94 +00111 BLOCK CONTAINS 0 CHARACTERS. CL*86 +00112 SKIP1 CL*86 +00113 01 WAGE-TRAN-REC. CL*86 +00114 ++INCLUDE DTSIWSKL CL*86 +00115 CL*32 +00116 CL*32 +00117 WORKING-STORAGE SECTION. EFTBD140 +001175 77 PAN-VALET PICTURE X(24) VALUE '118EFTBD140 03/05/04'. EFTBD140 +00118 CL*40 +00119 01 WRK-AREA. EFTBD140 +00120 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +140. CL197 +00121 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD140'. CL197 +00122 05 WRK-ABEND-MSG PIC X(60). CL*83 +00123 CL*69 +00124 05 EFT-STATUS PIC X(02). CL*58 +00125 88 EFT-STATUS-OK-88 VALUE '00'. CL*58 +00126 88 EFT-STATUS-EOF-88 VALUE '10'. CL177 +00127 CL*32 +00128 05 WAGE-STATUS PIC X(02). CL*86 +00129 88 WAGE-STATUS-OK-88 VALUE '00'. CL*86 +00130 88 WAGE-STATUS-EOF-88 VALUE '10'. CL*86 +00131 CL*86 +00132 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL*90 +00133 CL*58 +00134 05 WRK-TOT-WAGE PIC S9(11)V99 VALUE +0. CL*70 +00135 05 WRK-EXCESS-WAGE PIC S9(09)V99 VALUE +0. CL*70 +00136 CL*91 +00137 05 WRK-MOPO-T002-IND PIC X(01). CL*91 +00138 88 WRK-MOPO-T002-YES-88 VALUE 'Y'. CL*91 +00139 88 WRK-MOPO-T002-NO-88 VALUE 'N'. CL*91 +00140 CL*93 +00141 05 WRK-MOPO-IND PIC X(01). CL*93 +00142 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL*93 +00143 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL*93 +00144 CL*93 +00145 05 ERR-UNEXPECTED-WAGE-IND PIC X(01). CL*65 +00146 88 ERR-UNEXPECTED-WAGE-YES-88 VALUE 'Y'. CL*65 +00147 88 ERR-UNEXPECTED-WAGE-NO-88 VALUE 'N'. CL*65 +00148 EFTBD140 +00149 05 ERR-T027-PASS-EDITS-IND PIC X(01). CL*65 +00150 88 ERR-T027-PASS-EDITS-YES-88 VALUE 'Y'. CL*65 +00151 88 ERR-T027-PASS-EDITS-NO-88 VALUE 'N'. CL*65 +00152 CL239 +00153 05 DISP-DATE PIC X(10) VALUE SPACES. CL*92 +00154 05 DISP-TIME PIC X(08) VALUE SPACES. CL*92 +00155 05 WRK-SYS-TIME PIC X(06) VALUE SPACES. CL*92 +00156 05 WRK-SYS-DATE PIC X(08) VALUE SPACES. CL*92 +00157 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. CL*92 +00158 05 WRK-CURR-YRQ PIC S9(05) COMP-3. CL154 +00159 CL154 +00160 05 WRK-L001-JUL-DATE PIC 9(7) VALUE ZERO. CL*79 +00161 05 FILLER REDEFINES WRK-L001-JUL-DATE. CL*79 +00162 10 WRK-JULIAN-YR-1ST-3 PIC 9(3). CL*79 +00163 10 WRK-JULIAN-YR-DAYS PIC 9(4). CL*79 +00164 CL150 +00165 05 WRK-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. CL*79 +00166 05 FILLER REDEFINES WRK-PSEUDO-BATCH-NO. CL*79 +00167 10 WRK-PSEUDO-YR-DAYS PIC 9(04). CL*79 +00168 10 WRK-PSEUDO-BATCH-SEQ PIC 9(01). CL*79 +00169 CL150 +00170 05 WRK-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. CL*79 +00171 05 WRK-SEQ-NO PIC 9(07) VALUE 0. CL*68 +00172 CL150 +00173 05 WRK-YRQ-AREA PIC 9(05). CL*78 +00174 05 FILLER REDEFINES WRK-YRQ-AREA. CL*78 +00175 10 WRK-YRQ-CCYY PIC 9(04). CL*78 +00176 10 WRK-YRQ-Q PIC 9(01). CL*78 +00177 CL*78 +00178 05 WRK-EMP-NO PIC 9(06) VALUE 0. CL138 +00179 05 WRK-CURR-PAY-TRACE-NO PIC 9(13) VALUE 0. CL*65 +00180 05 WRK-RPT-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00181 05 WRK-PAY-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00182 05 WRK-WAGE-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00183 05 WRK-T027-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00184 05 WRK-W001-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00185 05 WRK-R907-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00186 05 WRK-FAIL-EDITS-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 +00187 05 WRK-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. CL*92 +00188 05 WRK-L076-NAME PIC X(32) VALUE SPACES. CL116 +00189 CL*92 +00190 05 WRK-MSG-TEXT. CL112 +00191 10 WRK-MSG-LINE PIC X(32). CL116 +00192 10 FILLER PIC X(02) VALUE SPACES. CL112 +00193 10 FILLER PIC X(14) VALUE CL168 +00194 'FQTF-EMP-NO = '. CL168 +00195 * 10 WRK-ERR-PAY-AMT PIC 9(06)9.99. CL124 +00196 10 WRK-ERR-PAY-AMT PIC X(10). CL124 +00197 10 WRK-ERR-EMP-NO-X REDEFINES WRK-ERR-PAY-AMT. CL115 +00198 15 WRK-ERR-EMP-NO PIC X(06). CL112 +00199 15 FIL-EMP-NO PIC X(04). CL114 +00200 10 WRK-ERR-PAY-TRACE-NO-X REDEFINES WRK-ERR-PAY-AMT. CL115 +00201 15 WRK-ERR-PAY-TRACE-NO PIC X(05). CL114 +00202 15 FIL-PAY-TRACE-NO PIC X(05). CL115 +00203 10 WRK-ERR-PAY-DATE-X REDEFINES WRK-ERR-PAY-AMT. CL115 +00204 15 WRK-ERR-PAY-DATE PIC X(08). CL112 +00205 15 FIL-PAY-DATE PIC X(02). CL114 +00206 10 WRK-ERR-PAY-TIME-X REDEFINES WRK-ERR-PAY-AMT. CL115 +00207 15 WRK-ERR-PAY-TIME PIC X(06). CL112 +00208 15 FIL-PAY-TIME PIC X(04). CL114 +00209 CL166 +00210 05 MSG1-AREA. CL*67 +00211 10 MSG1-ID PIC X(03) VALUE '101'. CL*67 +00212 10 MSG1-TEXT. CL*67 +00213 15 FILLER PIC X(30) CL*67 +00214 VALUE 'TOTAL WAGES DO NOT = REPORTED'. CL*99 +00215 15 FILLER PIC X(30) CL*67 +00216 VALUE ' TOTAL WAGES OR NO WAGES RECS '. CL*99 +00217 15 FILLER PIC X(02) VALUE SPACES. CL*67 +00218 15 MSG1-TRACE-NO PIC 9(13). CL*67 +00219 CL169 +00220 05 MSG2-AREA. CL*67 +00221 10 MSG2-ID PIC X(03) VALUE '102'. CL*67 +00222 10 MSG2-TEXT. CL*67 +00223 15 FILLER PIC X(30) CL*67 +00224 VALUE 'DUPLICATE PAYMENT FOUND '. CL*82 +00225 15 FILLER PIC X(30) CL*67 +00226 VALUE ' '. CL*82 +00227 15 FILLER PIC X(02) VALUE SPACES. CL*67 +00228 15 MSG2-TRACE-NO PIC 9(13). CL*67 +00229 CL*67 +00230 05 MSG3-AREA. CL*67 +00231 10 MSG3-ID PIC X(03) VALUE '103'. CL*67 +00232 10 MSG3-TEXT. CL*67 +00233 15 FILLER PIC X(30) CL*67 +00234 VALUE 'PAYMENT FOUND WITHOUT REPORT '. CL*82 +00235 15 FILLER PIC X(30) CL*67 +00236 VALUE ' '. CL*82 +00237 15 FILLER PIC X(02) VALUE SPACES. CL*67 +00238 15 MSG3-TRACE-NO PIC 9(13). CL*67 +00239 CL*67 +00240 05 MSG4-AREA. CL*67 +00241 10 MSG4-ID PIC X(03) VALUE '104'. CL*67 +00242 10 MSG4-TEXT. CL*67 +00243 15 FILLER PIC X(30) CL*67 +00244 VALUE 'PAYMENT AMT ON PAYMENT RECORD '. CL*97 +00245 15 FILLER PIC X(30) CL*67 +00246 VALUE 'NOT = PAYMENT AMT ON REPORT '. CL*97 +00247 15 FILLER PIC X(02) VALUE SPACES. CL*67 +00248 15 MSG4-TRACE-NO PIC 9(13). CL*67 +00249 CL*67 +00250 05 MSG5-AREA. CL*67 +00251 10 MSG5-ID PIC X(03) VALUE '105'. CL*67 +00252 10 MSG5-TEXT. CL*67 +00253 15 FILLER PIC X(30) CL*67 +00254 VALUE 'WAGE RECORD FOUND WITHOUT REPO'. CL*82 +00255 15 FILLER PIC X(30) CL*67 +00256 VALUE 'RT '. CL*82 +00257 15 FILLER PIC X(02) VALUE SPACES. CL*67 +00258 15 MSG5-TRACE-NO PIC 9(13). CL*67 +00259 CL*67 +00260 05 MSG6-AREA. CL*67 +00261 10 MSG6-ID PIC X(03) VALUE '106'. CL*67 +00262 10 MSG6-TEXT. CL*67 +00263 15 FILLER PIC X(30) CL*67 +00264 VALUE 'WAGE RECORD FOUND, BUT WAGES A'. CL*82 +00265 15 FILLER PIC X(30) CL*67 +00266 VALUE 'RE SUBMITTED ON TAPE '. CL*82 +00267 15 FILLER PIC X(02) VALUE SPACES. CL*67 +00268 15 MSG6-TRACE-NO PIC 9(13). CL*67 +00269 CL*67 +00270 05 MSG7-AREA. CL*67 +00271 10 MSG7-ID PIC X(03) VALUE '107'. CL*67 +00272 10 MSG7-TEXT. CL*67 +00273 15 FILLER PIC X(30) CL*67 +00274 VALUE 'WAGE RECORD FOUND, BUT ZERO WA'. CL*82 +00275 15 FILLER PIC X(30) CL*67 +00276 VALUE 'GES REPORTED '. CL*82 +00277 15 FILLER PIC X(02) VALUE SPACES. CL*67 +00278 15 MSG7-TRACE-NO PIC 9(13). CL*67 +00279 CL*67 +00280 05 MSG8-AREA. CL*81 +00281 10 MSG8-ID PIC X(03) VALUE '108'. CL*81 +00282 10 MSG8-TEXT. CL*81 +00283 15 FILLER PIC X(30) CL*81 +00284 VALUE 'NO MATCHING PAYMENT FOR REPORT'. CL*82 +00285 15 FILLER PIC X(30) CL*81 +00286 VALUE ' '. CL*82 +00287 15 FILLER PIC X(02) VALUE SPACES. CL*81 +00288 15 MSG8-TRACE-NO PIC 9(13). CL*81 +00289 CL*93 +00290 05 MSG9-AREA. CL*93 +00291 10 MSG9-ID PIC X(03) VALUE '109'. CL*93 +00292 10 MSG9-TEXT. CL*93 +00293 15 FILLER PIC X(30) CL*93 +00294 VALUE 'FQTF REPORT NAME IS INVALID '. CL*93 +00295 15 FILLER PIC X(30) CL*93 +00296 VALUE ' '. CL*93 +00297 15 FILLER PIC X(02) VALUE SPACES. CL*93 +00298 15 MSG9-TRACE-NO PIC 9(13). CL*93 +00299 CL*81 +00300 CL166 +00301 05 WRK-ERROR-IND PIC X(01). CL152 +00302 88 WRK-ERROR-YES-88 VALUE 'Y'. CL152 +00303 88 WRK-ERROR-NO-88 VALUE 'N'. CL152 +00304 CL159 +00305 05 WRK-FIRST-READ-IND PIC X(01). CL159 +00306 88 WRK-FIRST-READ-YES-88 VALUE 'Y'. CL159 +00307 88 WRK-FIRST-READ-NO-88 VALUE 'N'. CL159 +00308 CL*76 +00309 05 WRK-MPRF-IND PIC X(01). EFTBD140 +00310 88 WRK-MPRF-YES-88 VALUE 'Y'. EFTBD140 +00311 88 WRK-MPRF-NO-88 VALUE 'N'. EFTBD140 +00312 CL143 +00313 05 WRK-FQTF-REC-WRITE-IND PIC X(01). CL143 +00314 88 WRK-FQTF-REC-WRITE-YES-88 VALUE 'Y'. CL143 +00315 88 WRK-FQTF-REC-WRITE-NO-88 VALUE 'N'. CL143 +00316 CL*16 +00317 01 WRK-PAYMENT-DATE PIC X(08). CL*85 +00318 01 WRK-PAYMENT-DATE-9 REDEFINES WRK-PAYMENT-DATE CL*85 +00319 PIC 9(08). CL*85 +00320 01 WRK-PAYMENT-CCYYMMDD REDEFINES WRK-PAYMENT-DATE. CL*85 +00321 10 WRK-DATE-CCYY PIC 9(04). CL*90 +00322 10 WRK-DATE-MM PIC 9(02). CL*90 +00323 10 WRK-DATE-DD PIC 9(02). CL*90 +00324 CL*84 +00325 01 WRK-PAYMENT-TIME PIC X(06). CL*85 +00326 01 WRK-PAYMENT-TIME-9 REDEFINES WRK-PAYMENT-TIME CL*85 +00327 PIC 9(06). CL*85 +00328 01 WRK-PAYMENT-HHMMSS REDEFINES WRK-PAYMENT-TIME. CL101 +00329 10 WRK-TIME-HH PIC 9(02). CL*90 +00330 10 WRK-TIME-MM PIC 9(02). CL*90 +00331 10 WRK-TIME-SS PIC 9(02). CL*90 +00332 CL*74 +00333 01 FQTF-REC. CL137 +00334 ++INCLUDE EFTIFQTF CL137 +00335 SKIP3 CL*58 +00336 01 FDPT-REC. CL137 +00337 ++INCLUDE EFTIFDPT CL137 +00338 SKIP3 CL137 +00339 01 FCQW-REC. CL183 +00340 ++INCLUDE EFTIFCQW CL183 +00341 SKIP3 CL137 +00342 01 T027-REC. CL219 +00343 ++INCLUDE DTSIT027 CL219 +00344 SKIP3 CL219 +00345 01 T002-REC. CL*91 +00346 ++INCLUDE DTSIT002 CL*91 +00347 SKIP3 CL*91 +00348 01 R907-REC. CL219 +00349 ++INCLUDE DTSIR907 CL219 +00350 SKIP3 CL219 +00351 01 L001-LINK-AREA. EFTBD140 +00352 ++INCLUDE DTSIL001 EFTBD140 +00353 EJECT EFTBD140 +00354 01 L003-LINK-AREA. CL*56 +00355 ++INCLUDE DTSIL003 CL*56 +00356 EJECT CL*24 +00357 01 L004-LINK-AREA. CL*56 +00358 ++INCLUDE DTSIL004 CL*56 +00359 EJECT CL*56 +00360 01 L005-COMM-AREA. CL*61 +00361 ++INCLUDE DTSIL005 CL*61 +00362 EJECT CL100 +00363 01 L516-LINK-AREA. EFTBD140 +00364 ++INCLUDE DTSIL516 EFTBD140 +00365 EJECT CL*92 +00366 01 L076-LINK-AREA. CL116 +00367 ++INCLUDE DTSIL076 CL116 +00368 EJECT CL*92 +00369 01 L910-LINK-AREA. CL*94 +00370 ++INCLUDE DTSIL910 CL*94 +00371 EJECT CL*94 +00372 01 MSKL-REC. CL*70 +00373 ++INCLUDE DTSIMSKL CL*70 +00374 EJECT CL*70 +00375 01 MPRF-REC. CL*70 +00376 ++INCLUDE DTSIMPRF CL*70 +00377 EJECT CL211 +00378 01 MQTR-REC. CL*70 +00379 ++INCLUDE DTSIMQTR CL*70 +00380 EJECT CL*70 +00381 01 MOPO-REC. CL*92 +00382 ++INCLUDE DTSIMOPO CL*92 +00383 EJECT CL*92 +00384 01 L927-LINK-AREA. CL212 +00385 ++INCLUDE DTSIL927 CL212 +00386 EJECT CL212 +00387 01 TSKL-REC. CL212 +00388 ++INCLUDE DTSITSKL CL212 +00389 EJECT CL212 +00390 01 L985-LINK-AREA. CL*48 +00391 ++INCLUDE DTSIL985 CL*48 +00392 CL*68 +00393 01 W001-REC. CL*68 +00394 * 05 W001-LENGTH PIC S9(04) COMP. CL*86 +00395 * 05 W001-DATA. CL*86 +00396 ++INCLUDE DTSIW001 CL*68 +00397 CL200 +00398 LINKAGE SECTION. CL200 +00399 01 EFT-REC-TYPE-LINK-AREA. CL200 +00400 ++INCLUDE EFTIL100 CL200 +00401 01 RSKL-REC. CL200 +00402 ++INCLUDE EFTIRSKL CL200 +00403 EJECT CL200 +00404 CL200 +00405 PROCEDURE DIVISION USING CL201 +00406 EFT-REC-TYPE-LINK-AREA CL201 +00407 RSKL-REC. CL211 +00408 CL201 +00409 IF EFT-L100-CMD-INIT-88 CL201 +00410 PERFORM I0000-INITIALIZE THRU I0000-EXIT CL201 +00411 ELSE CL201 +00412 IF EFT-L100-CMD-PROCESS-88 CL201 +00413 PERFORM P0000-PROCESS THRU P0000-EXIT CL201 +00414 ELSE CL201 +00415 IF EFT-L100-CMD-TERMINATE-88 CL*16 +00416 PERFORM T0000-TERMINATE THRU T0000-EXIT CL201 +00417 ELSE CL201 +00418 DISPLAY 'INVALID CALL FROM BD100 ' CL*69 +00419 PERFORM S999-ABEND THRU S999-EXIT. CL201 +00420 CL201 +00421 GOBACK. EFTBD140 +00422 EJECT EFTBD140 +00423 I0000-INITIALIZE. EFTBD140 +00424 MOVE WRK-MOD-NAME TO R907-MODULE-NAME CL*71 +00425 L985-MOD-NAME. CL*71 +00426 MOVE LENGTH OF R907-REC TO R907-LENGTH. CL*67 +00427 *** MOVE LENGTH OF W001-DATA TO W001-LENGTH. CL*86 +00428 MOVE LENGTH OF T027-REC TO T027-LENGTH. CL*67 +00429 MOVE LENGTH OF T002-REC TO T002-LENGTH. CL*91 +00430 CL*91 +00431 PERFORM I1000-SYS-DATE THRU I1000-EXIT. CL*74 +00432 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*86 +00433 PERFORM I3000-INIT-RECS THRU I3000-EXIT. CL*62 +00434 CL179 +00435 I0000-EXIT. EFTBD140 +00436 EXIT. EFTBD140 +00437 CL107 +00438 I1000-SYS-DATE. CL*72 +00439 SET L005-FROM-SYS TO TRUE. CL151 +00440 PERFORM S005-SYS-DATE THRU S005-EXIT. CL151 +00441 MOVE L005-DATE TO DISP-DATE. CL151 +00442 MOVE L005-TIME TO DISP-TIME. CL151 +00443 MOVE L005-SLASH-DATE TO WRK-SYS-DATE. CL151 +00444 MOVE L005-DISPLAY-TIME TO WRK-SYS-TIME. CL151 +00445 MOVE L005-SLASH-8-YR TO WRK-CURR-YR. CL151 +00446 CL151 +00447 MOVE L005-DATE TO L001-FED-8-DATE-9. CL151 +00448 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL151 +00449 MOVE L001-JUL-DATE TO WRK-L001-JUL-DATE. CL*79 +00450 MOVE WRK-JULIAN-YR-DAYS TO WRK-PSEUDO-YR-DAYS. CL*79 +00451 MOVE ZERO TO WRK-PSEUDO-BATCH-SEQ. CL*79 +00452 MOVE 1 TO WRK-PSEUDO-ITEM-NO. CL*79 +00453 CL*72 +00454 MOVE L005-DATE TO L004-DATE. CL154 +00455 SET L004-FROM-DATE TO TRUE. CL154 +00456 PERFORM S004-YRQ THRU S004-EXIT. CL154 +00457 MOVE L004-QTR-5-9 TO WRK-CURR-YRQ. CL154 +00458 CL154 +00459 DISPLAY ' '. CL*72 +00460 DISPLAY 'CURRENT DATE ' DISP-DATE CL*69 +00461 ' CURRENT-TIME ' DISP-TIME CL*69 +00462 ' CURRENT YEAR ' WRK-CURR-YR CL*70 +00463 ' STARTING BATCH ' WRK-PSEUDO-BATCH-NO CL*79 +00464 ' ITEM ' WRK-PSEUDO-ITEM-NO. CL*79 +00465 CL*69 +00466 I1000-EXIT. CL*72 +00467 EXIT. CL*72 +00468 CL**1 +00469 I2000-OPEN-FILES. CL*86 +00470 OPEN OUTPUT WAGE-TRAN-FILE. CL*86 +00471 IF NOT WAGE-STATUS-OK-88 CL*86 +00472 DISPLAY 'WAGE FILE OPEN ERROR: ' WAGE-STATUS CL*87 +00473 PERFORM S999-ABEND THRU S999-EXIT. CL*86 +00474 CL*86 +00475 CL*86 +00476 I2000-EXIT. CL*86 +00477 EXIT. CL*86 +00478 CL*58 +00479 I3000-INIT-RECS. CL*62 +00480 INITIALIZE FQTF-DATA-AREA CL*62 +00481 FDPT-DATA-AREA CL*62 +00482 FCQW-DATA-AREA. CL*62 +00483 CL*62 +00484 MOVE ZERO TO T027-EMP-NO CL*84 +00485 T027-SYS-DATE CL*84 +00486 T027-SYS-TIME CL*84 +00487 T027-PSEUDO-BATCH-NO CL*84 +00488 T027-PSEUDO-ITEM-NO CL*84 +00489 T027-YRQ CL*84 +00490 T027-TOT-WAGE CL*84 +00491 T027-EXCESS-WAGE CL*84 +00492 T027-TAX-WAGE CL*84 +00493 T027-REMIT-AMT CL*84 +00494 T027-TOTAL-EMPL-CNT CL*84 +00495 T027-1ST-MTH-EMPL-CNT CL*84 +00496 T027-2ND-MTH-EMPL-CNT CL*84 +00497 T027-3RD-MTH-EMPL-CNT CL*84 +00498 T027-RECEIVED-DATE CL*84 +00499 T027-DEPOSIT-DATE CL*84 +00500 T027-TRACE-NO. CL*84 +00501 CL*84 +00502 MOVE SPACES TO T027-ORIGIN CL*84 +00503 T027-TRN-TYPE CL*84 +00504 T027-NAME-CHECK CL*84 +00505 T027-RPT-TYPE CL*84 +00506 T027-WAIVE-BOTH-IND CL*84 +00507 T027-WAIVE-INT-IND CL*84 +00508 T027-WAIVE-LATE-PEN-IND CL*84 +00509 T027-RESPONSIBLE-ACTIVITY CL*84 +00510 T027-RESPONSIBLE-OP-ID CL*84 +00511 T027-PASSED-FULL-EDITS-IND. CL*84 +00512 CL*84 +00513 MOVE ZERO TO W001-BATCH-NO CL*84 +00514 W001-ITEM-NO CL*84 +00515 W001-SEQ-NO CL*84 +00516 W001-EMP-NO CL*84 +00517 W001-SSN CL*84 +00518 W001-SSN-ERR-ID CL*84 +00519 W001-NAME-ERR-ID CL*84 +00520 W001-YRQ CL*84 +00521 W001-WAGE-CHNG CL*84 +00522 W001-WAGE-ERR-ID CL*84 +00523 W001-CURR-WAGE CL*84 +00524 W001-TAX-WAGE CL*84 +00525 W001-PRIOR-WAGE CL*84 +00526 W001-RECEIVED-DATE CL*84 +00527 W001-RECEIVED-TIME. CL*84 +00528 CL*84 +00529 MOVE SPACES TO W001-NAME CL*84 +00530 W001-RESPONSIBLE-OP-ID CL*84 +00531 W001-SOURCE. CL*84 +00532 CL*84 +00533 I3000-EXIT. CL*62 +00534 EXIT. CL*62 +00535 CL*91 +00536 I4000-INIT-T002. CL*91 +00537 CL*93 +00538 SET WRK-MOPO-T002-NO-88 TO TRUE. CL*91 +00539 SET WRK-MOPO-FOUND-NO-88 TO TRUE. CL*93 +00540 CL*93 +00541 MOVE ZERO TO T002-EMP-NO CL*91 +00542 T002-SYS-DATE CL*91 +00543 T002-SYS-TIME. CL*91 +00544 CL*91 +00545 MOVE SPACES TO T002-ORIGIN CL*91 +00546 T002-DATA-AREA. CL*91 +00547 CL*91 +00548 I4000-EXIT. CL*91 +00549 EXIT. CL*91 +00550 CL*91 +00551 *************************************************************** CL*89 +00552 * SORT THE TRANSACTIONS BY TRACE NUMBER AND RECORD TYPE. * CL*89 +00553 * THIS WILL GROUP ALL RECORDS FROM THE SAME QUARTERLY * CL*89 +00554 * REPORT TRANSACTION TOGETHER. WITHIN THE TRACE NUMBER, * CL*89 +00555 * THE RECORDS WILL BE IN THE FOLLOWING ORDER: REPORT * CL*89 +00556 * RECORD, PAYMENT RECORD, WAGE RECORDS. TRANSACTION FOR * CL*89 +00557 * PAYMENT OF A BALANCE DUE OCCURS SINGLY, AND HAVE NO * CL*89 +00558 * RELATED RECORDS. * CL*89 +00559 *************************************************************** CL*89 +00560 EFTBD140 +00561 P0000-PROCESS. EFTBD140 +00562 EVALUATE TRUE CL*62 +00563 WHEN RSKL-TYPE-QTR-TAX-RPT-88 CL*62 +00564 PERFORM P1000-REPORT THRU P1000-EXIT CL*62 +00565 CL236 +00566 WHEN RSKL-TYPE-PAYMENT-88 CL*62 +00567 PERFORM P2000-PAYMENT THRU P2000-EXIT CL*62 +00568 CL*62 +00569 WHEN RSKL-TYPE-WAGE-IMP-88 CL*62 +00570 PERFORM P3000-WAGE THRU P3000-EXIT CL*62 +00571 CL*62 +00572 WHEN OTHER CL*62 +00573 DISPLAY 'INVALID RECORD TYPE ' RSKL-REC-TYPE CL*62 +00574 ' ' RSKL-SUB-TYPE CL*62 +00575 CL*62 +00576 END-EVALUATE. CL*62 +00577 CL*62 +00578 CL232 +00579 P0000-EXIT. EFTBD140 +00580 EXIT. EFTBD140 +00581 CL*72 +00582 *************************************************************** CL*88 +00583 * FOR EACH TAX FILE REPORT RECORD, A T027 TRANSACTION RECORD * CL*88 +00584 * WILL BE CREATED. IF THE PAYMENT AMOUNT NOT MATCHED THE TAX * CL*88 +00585 * FILE REPORT AMOUNT A R907 ERROR RECORD WILL BE WRITTE AND * CL*88 +00586 * PRESENTS ON THE R907 ERRORS REPORT. * CL*88 +00587 *************************************************************** CL*88 +00588 CL*88 +00589 P1000-REPORT. CL*62 +00590 ADD +1 TO WRK-RPT-REC-CNT. CL*69 +00591 IF FQTF-TRACE-NO > ZERO CL*62 +00592 PERFORM P1100-CHK-TOT-WAGE THRU P1100-EXIT CL*69 +00593 END-IF. CL*62 +00594 CL*62 +00595 PERFORM I3000-INIT-RECS THRU I3000-EXIT. CL*62 +00596 CL*62 +00597 MOVE ZERO TO WRK-TOT-WAGE CL*65 +00598 WRK-CURR-PAY-TRACE-NO. CL*65 +00599 CL*65 +00600 SET ERR-T027-PASS-EDITS-YES-88 TO TRUE. CL*65 +00601 SET ERR-UNEXPECTED-WAGE-NO-88 TO TRUE. CL*65 +00602 CL*65 +00603 MOVE RSKL-REC TO FQTF-REC. CL*63 +00604 CL*63 +00605 PERFORM P1200-EDIT-FQTF THRU P1200-EXIT. EFTBD140 +00606 PERFORM P1300-WRITE-T027 THRU P1300-EXIT. EFTBD140 +00607 PERFORM P1400-WRITE-T002 THRU P1400-EXIT. CL*90 +00608 CL*62 +00609 P1000-EXIT. CL*62 +00610 EXIT. CL*62 +00611 CL*63 +00612 P1100-CHK-TOT-WAGE. CL*63 +00613 CL*63 +00614 IF WRK-TOT-WAGE NOT = FQTF-TOTAL-WAGES AND CL110 +00615 FQTF-WAGE-RPT-IND = 'Y' CL110 +00616 MOVE MSG1-ID TO R907-MSG-ID CL*67 +00617 * MOVE FCQW-EMP-NO TO R907-EMP-NO CL101 +00618 MOVE FQTF-EMP-NO TO R907-EMP-NO CL101 +00619 * MOVE FCQW-EMPL-TRACE-NO TO MSG1-TRACE-NO CL*98 +00620 MOVE FQTF-TRACE-NO TO MSG1-TRACE-NO CL*98 +00621 MOVE MSG1-TEXT TO R907-MSG-TEXT CL*67 +00622 PERFORM S946-WRITE-R907 THRU S946-EXIT CL*63 +00623 ADD +1 TO WRK-R907-CNT CL*68 +00624 DISPLAY 'BD140 P1100 TOT WAGE <> REP WAGE OR NO WAGE RECS' CL100 +00625 ' FCQW-EMP-NO = ' FCQW-EMP-NO ' ' ' FQTF-EMP-NO = ' CL102 +00626 FQTF-EMP-NO CL*96 +00627 END-IF. CL*63 +00628 CL*63 +00629 P1100-EXIT. CL*63 +00630 EXIT. CL*63 +00631 CL*63 +00632 P1200-EDIT-FQTF. EFTBD140 +00633 PERFORM P1210-READ-MPRF THRU P1210-EXIT. EFTBD140 +00634 IF WRK-MPRF-NO-88 EFTBD140 +00635 GO TO P1200-EXIT EFTBD140 +00636 ELSE EFTBD140 +00637 PERFORM P1220-LIABILITY THRU P1220-EXIT EFTBD140 +00638 PERFORM P1230-READ-MQTR THRU P1230-EXIT EFTBD140 +00639 END-IF. EFTBD140 +00640 P1200-EXIT. EFTBD140 +00641 EXIT. EFTBD140 +00642 EFTBD140 +00643 P1210-READ-MPRF. EFTBD140 +00644 MOVE LOW-VALUE TO MSKL-KEY-AREA. EFTBD140 +00645 MOVE FQTF-EMP-NO TO MSKL-EMP-NO. EFTBD140 +00646 SET MSKL-PRF-88 TO TRUE. EFTBD140 +00647 PERFORM S910-READ THRU S910-EXIT. EFTBD140 +00648 IF L910-NO-REC-88 EFTBD140 +00649 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE CL*65 +00650 SET WRK-MPRF-NO-88 TO TRUE EFTBD140 +00651 DISPLAY 'BD140 P1210 NO MPRF ' FQTF-EMP-NO CL*77 +00652 GO TO P1210-EXIT EFTBD140 +00653 ELSE EFTBD140 +00654 SET WRK-MPRF-YES-88 TO TRUE EFTBD140 +00655 MOVE MSKL-REC TO MPRF-REC. EFTBD140 +00656 EFTBD140 +00657 IF NOT MPRF-CLASS-SUB-88 EFTBD140 +00658 DISPLAY 'BD140 P1210 NOT SUB ' FQTF-EMP-NO CL*77 +00659 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65 +00660 EFTBD140 +00661 IF MPRF-NOT-WRITTEN-OFF-88 EFTBD140 +00662 NEXT SENTENCE EFTBD140 +00663 ELSE EFTBD140 +00664 DISPLAY 'BD140 P1210 WRITE-OFF ' FQTF-EMP-NO CL*77 +00665 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65 +00666 EFTBD140 +00667 P1210-EXIT. EFTBD140 +00668 EXIT. EFTBD140 +00669 EFTBD140 +00670 P1220-LIABILITY. EFTBD140 +00671 MOVE FQTF-YRQ TO L516-YRQ. CL103 +00672 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. EFTBD140 +00673 IF L516-NOT-LIABLE-88 EFTBD140 +00674 DISPLAY 'BD140 P1220 NOT LIAB ' FQTF-EMP-NO CL*77 +00675 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65 +00676 EFTBD140 +00677 IF MPRF-CLASS-RATED-88 EFTBD140 +00678 IF L516-NO-RATE-88 EFTBD140 +00679 DISPLAY 'BD140 P1220 NO RATE ' FQTF-EMP-NO CL*77 +00680 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65 +00681 EFTBD140 +00682 P1220-EXIT. EFTBD140 +00683 EXIT. EFTBD140 +00684 EFTBD140 +00685 P1230-READ-MQTR. EFTBD140 +00686 MOVE LOW-VALUES TO MQTR-KEY-AREA. EFTBD140 +00687 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. EFTBD140 +00688 SET MQTR-QTR-88 TO TRUE. EFTBD140 +00689 MOVE FQTF-YRQ TO MQTR-YRQ. CL103 +00690 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA EFTBD140 +00691 PERFORM S910-READ THRU S910-EXIT. EFTBD140 +00692 IF L910-NO-REC-88 EFTBD140 +00693 NEXT SENTENCE EFTBD140 +00694 ELSE EFTBD140 +00695 MOVE MSKL-REC TO MQTR-REC EFTBD140 +00696 IF MQTR-CURR-RCVD-88 EFTBD140 +00697 DISPLAY 'BD140 P1230 RPT RCVD ' FQTF-EMP-NO CL*77 +00698 SET ERR-T027-PASS-EDITS-NO-88 TO TRUE. CL*65 +00699 EFTBD140 +00700 P1230-EXIT. EFTBD140 +00701 EXIT. EFTBD140 +00702 EFTBD140 +00703 P1300-WRITE-T027. EFTBD140 +00704 MOVE 0 TO WRK-SEQ-NO. CL*79 +00705 CL*79 +00706 MOVE FQTF-EMP-NO TO T027-EMP-NO. CL*74 +00707 MOVE 'WEBTXRPT' TO T027-ORIGIN. CL*63 +00708 MOVE L005-DATE TO T027-SYS-DATE. CL*63 +00709 MOVE L005-TIME TO T027-SYS-TIME. CL*63 +00710 SET T027-WEB-RPT-88 TO TRUE. CL*63 +00711 CL*63 +00712 IF WRK-PSEUDO-ITEM-NO < 999 CL*79 +00713 ADD 1 TO WRK-PSEUDO-ITEM-NO CL*79 +00714 ELSE CL*63 +00715 ADD 1 TO WRK-PSEUDO-BATCH-NO CL*79 +00716 MOVE 1 TO WRK-PSEUDO-ITEM-NO CL*83 +00717 END-IF. CL*83 +00718 CL*63 +00719 MOVE WRK-PSEUDO-BATCH-NO TO T027-PSEUDO-BATCH-NO. CL*79 +00720 MOVE WRK-PSEUDO-ITEM-NO TO T027-PSEUDO-ITEM-NO. CL*79 +00721 CL*63 +00722 MOVE MPRF-PRIMARY-NAME TO T027-NAME-CHECK. EFTBD140 +00723 SET T027-ORIG-88 TO TRUE. CL*63 +00724 MOVE FQTF-YRQ TO T027-YRQ. CL103 +00725 MOVE FQTF-TOTAL-WAGES TO T027-TOT-WAGE. CL*63 +00726 COMPUTE WRK-EXCESS-WAGE = CL*63 +00727 (FQTF-TOTAL-WAGES - FQTF-TOTAL-TAXABLE-WAGES). CL*63 +00728 MOVE WRK-EXCESS-WAGE TO T027-EXCESS-WAGE. CL*63 +00729 MOVE FQTF-TOTAL-TAXABLE-WAGES TO T027-TAX-WAGE. CL*63 +00730 MOVE FQTF-PAYMENT-AMOUNT TO T027-REMIT-AMT. CL*63 +00731 SET T027-WAIVE-BOTH-NO-88 TO TRUE. CL*63 +00732 SET T027-WAIVE-INT-NO-88 TO TRUE. CL*75 +00733 SET T027-WAIVE-LATE-PEN-NO-88 TO TRUE. CL*63 +00734 MOVE FQTF-WORKER-CNT-1ST-MON TO T027-1ST-MTH-EMPL-CNT. CL*63 +00735 MOVE FQTF-WORKER-CNT-2ND-MON TO T027-2ND-MTH-EMPL-CNT. CL*63 +00736 MOVE FQTF-WORKER-CNT-3RD-MON TO T027-3RD-MTH-EMPL-CNT. CL*63 +00737 COMPUTE T027-TOTAL-EMPL-CNT = CL*63 +00738 (FQTF-WORKER-CNT-1ST-MON + CL*63 +00739 FQTF-WORKER-CNT-2ND-MON + CL*63 +00740 FQTF-WORKER-CNT-3RD-MON). CL*63 +00741 MOVE FQTF-FILING-DATE TO T027-RECEIVED-DATE. CL*63 +00742 CL*63 +00743 MOVE T027-RECEIVED-DATE TO L001-FED-8-DATE-9. CL*63 +00744 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*63 +00745 SET L003-NOT-WORK-DAY TO TRUE. CL*63 +00746 PERFORM P1310-WORK-DAY-LOOP THRU P1310-EXIT EFTBD140 +00747 UNTIL L003-IS-WORK-DAY. CL*63 +00748 MOVE L001-FED-8-DATE-9 TO T027-DEPOSIT-DATE. CL*63 +00749 CL*63 +00750 MOVE FQTF-TRACE-NO TO T027-TRACE-NO. CL*76 +00751 CL*76 +00752 MOVE 'VOL' TO T027-RESPONSIBLE-ACTIVITY. CL*63 +00753 MOVE SPACES TO T027-RESPONSIBLE-OP-ID. CL*63 +00754 CL*63 +00755 *& CL*85 +00756 DISPLAY 'BD140 P1300 PASS EDITS ' CL*85 +00757 ERR-T027-PASS-EDITS-IND. CL*85 +00758 *& CL*85 +00759 IF ERR-T027-PASS-EDITS-NO-88 CL*65 +00760 SET T027-PASSED-FULL-EDITS-NO-88 TO TRUE EFTBD140 +00761 ELSE EFTBD140 +00762 SET T027-PASSED-FULL-EDITS-YES-88 TO TRUE. EFTBD140 +00763 EFTBD140 +00764 MOVE T027-REC TO TSKL-REC. CL*63 +00765 PERFORM S927-WRITE THRU S927-EXIT. CL*63 +00766 ADD 1 TO WRK-T027-CNT. CL*69 +00767 CL*63 +00768 P1300-EXIT. EFTBD140 +00769 EXIT. CL*63 +00770 CL*63 +00771 P1310-WORK-DAY-LOOP. EFTBD140 +00772 ADD +1 TO L001-JUL-ABS-DAY. EFTBD140 +00773 EFTBD140 +00774 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. EFTBD140 +00775 EFTBD140 +00776 MOVE L001-FED-8-DATE-9 TO L003-DATE. EFTBD140 +00777 EFTBD140 +00778 PERFORM S003-AGENCY-DAY THRU S003-EXIT. EFTBD140 +00779 EFTBD140 +00780 P1310-EXIT. EFTBD140 +00781 EXIT. EFTBD140 +00782 CL*90 +00783 P1400-WRITE-T002. CL*90 +00784 CL*91 +00785 PERFORM I4000-INIT-T002 THRU I4000-EXIT CL*91 +00786 PERFORM P1410-MOPO THRU P1410-EXIT CL*92 +00787 PERFORM P1420-CONT-NAME THRU P1420-EXIT CL*92 +00788 PERFORM P1430-CONT-PHONE THRU P1430-EXIT CL*92 +00789 CL*91 +00790 IF WRK-MOPO-T002-YES-88 CL*91 +00791 PERFORM P1440-MOPO-T002 THRU P1440-EXIT. CL*91 +00792 CL*90 +00793 P1400-EXIT. CL*90 +00794 EXIT. CL*90 +00795 CL*91 +00796 P1410-MOPO. CL*91 +00797 CL*91 +00798 MOVE LOW-VALUES TO MOPO-KEY-AREA. CL*91 +00799 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. CL*91 +00800 SET MOPO-OPO-88 TO TRUE. CL*91 +00801 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. CL*91 +00802 CL*91 +00803 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*91 +00804 IF L910-NO-REC-88 CL*91 +00805 NEXT SENTENCE CL*91 +00806 ELSE CL*91 +00807 PERFORM CL*91 +00808 UNTIL L910-NO-REC-88 CL*91 +00809 OR WRK-MOPO-FOUND-YES-88 CL*91 +00810 MOVE MSKL-REC TO MOPO-REC CL108 +00811 IF MOPO-TYPE-RPT-BSNS-88 CL112 +00812 MOVE MOPO-REC TO MSKL-REC CL*91 +00813 DISPLAY 'MOPO FOU ' MOPO-VOICE-1 CL108 +00814 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL108 +00815 ELSE CL*91 +00816 PERFORM S910-READ-NEXT THRU S910-EXIT CL*91 +00817 END-IF CL*91 +00818 END-PERFORM CL*91 +00819 END-IF. CL*91 +00820 CL*91 +00821 P1410-EXIT. CL*91 +00822 EXIT. CL*91 +00823 CL*91 +00824 P1420-CONT-NAME. CL*91 +00825 CL*91 +00826 IF FQTF-LAST-NAME = SPACES CL*92 +00827 SET WRK-MOPO-T002-NO-88 TO TRUE CL113 +00828 DISPLAY 'T002 NOT ADDED NO NAME ' FQTF-EMP-NO CL114 +00829 GO TO P1420-EXIT. CL*91 +00830 CL113 +00831 MOVE FQTF-FIRST-NAME TO L076-NAMEF CL116 +00832 MOVE FQTF-MIDDLE-INITIAL TO L076-NAMEI CL116 +00833 MOVE FQTF-LAST-NAME TO L076-NAMEL CL116 +00834 CL*91 +00835 PERFORM S076-NAME THRU S076-EXIT CL116 +00836 IF L076-NAME-INVALID CL116 +00837 SET WRK-MOPO-T002-NO-88 TO TRUE CL113 +00838 MOVE FQTF-EMP-NO TO R907-EMP-NO CL*93 +00839 MOVE FQTF-TRACE-NO TO MSG9-TRACE-NO CL*93 +00840 MOVE MSG9-TEXT TO R907-MSG-TEXT CL*93 +00841 PERFORM S946-WRITE-R907 THRU S946-EXIT CL*93 +00842 MOVE SPACES TO T002-CONTACT-NAME CL*91 +00843 GO TO P1420-EXIT. CL*91 +00844 CL*91 +00845 MOVE L076-NAM TO T002-CONTACT-NAME CL116 +00846 SET WRK-MOPO-T002-YES-88 TO TRUE. CL113 +00847 CL*91 +00848 P1420-EXIT. CL*91 +00849 EXIT. CL*91 +00850 CL*91 +00851 P1430-CONT-PHONE. CL*91 +00852 CL*91 +00853 IF FQTF-FILING-TEL-NO = SPACES CL*92 +00854 SET WRK-MOPO-T002-NO-88 TO TRUE CL113 +00855 DISPLAY 'T002 NOT ADDED NO TEL ' FQTF-EMP-NO CL115 +00856 GO TO P1430-EXIT. CL*91 +00857 CL*91 +00858 MOVE FQTF-FILING-TEL-NO TO T002-CONTACT-VOICE CL*92 +00859 SET WRK-MOPO-T002-YES-88 TO TRUE. CL*91 +00860 CL*91 +00861 P1430-EXIT. CL*91 +00862 EXIT. CL*91 +00863 CL*91 +00864 P1440-MOPO-T002. CL*91 +00865 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL*91 +00866 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL*91 +00867 MOVE L005-DATE TO T002-SYS-DATE. CL*91 +00868 MOVE L005-TIME TO T002-SYS-TIME. CL*91 +00869 CL*91 +00870 IF WRK-MOPO-FOUND-YES-88 CL*91 +00871 SET T002-UPD-CONTACT-88 TO TRUE CL*91 +00872 ELSE CL*91 +00873 SET T002-ADD-CONTACT-88 TO TRUE CL*91 +00874 END-IF. CL*91 +00875 CL*91 +00876 SET T002-CONTACT-RPT-BSNS-88 TO TRUE. CL112 +00877 CL*91 +00878 MOVE ZEROS TO T002-CONTACT-SSN CL113 +00879 MOVE SPACES TO T002-CONTACT-TITLE CL113 +00880 MOVE SPACES TO T002-CONTACT-FAX CL113 +00881 MOVE SPACES TO T002-CONTACT-EMAIL CL113 +00882 MOVE T002-REC TO TSKL-REC. CL*91 +00883 PERFORM S927-WRITE THRU S927-EXIT. CL*92 +00884 ADD +1 TO WRK-T002-CONTACT-CNT. CL*91 +00885 CL*91 +00886 P1440-EXIT. CL*91 +00887 EXIT. CL*91 +00888 CL*91 +00889 P2000-PAYMENT. CL*62 +00890 ADD +1 TO WRK-PAY-REC-CNT. CL*69 +00891 MOVE RSKL-REC TO FDPT-REC. CL*65 +00892 CL*65 +00893 IF WRK-CURR-PAY-TRACE-NO > ZERO CL*66 +00894 IF FDPT-EMP-NO = FQTF-EMP-NO CL*65 +00895 PERFORM P2100-DUPLICATE-ERR THRU P2100-EXIT CL*67 +00896 ELSE CL*65 +00897 PERFORM P2200-MISSING-RPT-ERR THRU P2200-EXIT CL*67 +00898 END-IF CL*65 +00899 ELSE CL*66 +00900 MOVE FDPT-EMP-NO TO WRK-CURR-PAY-TRACE-NO CL*69 +00901 END-IF. CL*63 +00902 CL*63 +00903 IF FDPT-PAYMENT-TRACE-NO NOT = FQTF-TRACE-NO CL*70 +00904 OR FDPT-EMP-NO NOT = FQTF-EMP-NO CL*69 +00905 PERFORM P2200-MISSING-RPT-ERR THRU P2200-EXIT CL*69 +00906 ELSE CL*69 +00907 IF FDPT-PAYMENT-AMOUNT NOT = FQTF-PAYMENT-AMOUNT CL*69 +00908 PERFORM P2300-PAYMENT-ERR THRU P2300-EXIT CL*69 +00909 END-IF CL*62 +00910 END-IF. CL*62 +00911 CL*62 +00912 P2000-EXIT. CL*62 +00913 EXIT. CL*62 +00914 CL*62 +00915 P2100-DUPLICATE-ERR. EFTBD140 +00916 EFTBD140 +00917 MOVE MSG2-ID TO R907-MSG-ID CL*67 +00918 MOVE FDPT-EMP-NO TO R907-EMP-NO CL*67 +00919 MOVE FDPT-PAYMENT-TRACE-NO TO MSG2-TRACE-NO CL*70 +00920 MOVE MSG2-TEXT TO R907-MSG-TEXT CL*67 +00921 PERFORM S946-WRITE-R907 THRU S946-EXIT. EFTBD140 +00922 DISPLAY 'BD140 P2100 DUP PMT ' FDPT-EMP-NO CL*77 +00923 ADD +1 TO WRK-R907-CNT. CL*68 +00924 EFTBD140 +00925 P2100-EXIT. EFTBD140 +00926 EXIT. EFTBD140 +00927 EFTBD140 +00928 P2200-MISSING-RPT-ERR. CL*70 +00929 MOVE MSG3-ID TO R907-MSG-ID CL*67 +00930 MOVE FDPT-EMP-NO TO R907-EMP-NO CL*67 +00931 MOVE FDPT-PAYMENT-TRACE-NO TO MSG3-TRACE-NO CL*70 +00932 MOVE MSG3-TEXT TO R907-MSG-TEXT CL*67 +00933 PERFORM S946-WRITE-R907 THRU S946-EXIT. EFTBD140 +00934 DISPLAY 'BD140 P2200 MISS RPT ' FDPT-EMP-NO CL*77 +00935 ADD +1 TO WRK-R907-CNT. CL*68 +00936 EFTBD140 +00937 P2200-EXIT. EFTBD140 +00938 EXIT. EFTBD140 +00939 EFTBD140 +00940 P2300-PAYMENT-ERR. EFTBD140 +00941 MOVE MSG4-ID TO R907-MSG-ID CL*67 +00942 MOVE FDPT-EMP-NO TO R907-EMP-NO CL*67 +00943 MOVE FDPT-PAYMENT-TRACE-NO TO MSG4-TRACE-NO CL*70 +00944 MOVE MSG4-TEXT TO R907-MSG-TEXT CL*67 +00945 PERFORM S946-WRITE-R907 THRU S946-EXIT. EFTBD140 +00946 DISPLAY 'BD140 P2300 PAY ERR ' FDPT-EMP-NO CL*77 +00947 ADD +1 TO WRK-R907-CNT. CL*68 +00948 EFTBD140 +00949 P2300-EXIT. EFTBD140 +00950 EXIT. EFTBD140 +00951 EFTBD140 +00952 P3000-WAGE. CL*63 +00953 ADD +1 TO WRK-WAGE-REC-CNT. CL*69 +00954 MOVE RSKL-REC TO FCQW-REC. CL*67 +00955 CL*63 +00956 ADD FCQW-EMPL-WAGES TO WRK-TOT-WAGE. CL*67 +00957 CL*63 +00958 PERFORM P3100-EDIT-CQW THRU P3100-EXIT. CL*79 +00959 CL*80 +00960 PERFORM P3200-WRITE-W001 THRU P3200-EXIT. CL*80 +00961 CL*80 +00962 P3000-EXIT. CL*63 +00963 EXIT. CL*63 +00964 CL*63 +00965 P3100-EDIT-CQW. CL*79 +00966 IF (FCQW-EMPL-TRACE-NO NOT = FQTF-TRACE-NO) CL104 +00967 OR (FCQW-EMP-NO NOT = FQTF-EMP-NO) CL104 +00968 PERFORM P3110-MISSING-REPORT-ERR THRU P3110-EXIT CL*80 +00969 END-IF. CL*80 +00970 CL*80 +00971 IF FQTF-WAGE-RPT-NO-88 CL*80 +00972 PERFORM P3120-UNEXPECTED-WAGE-ERR THRU P3120-EXIT CL*80 +00973 END-IF. CL*80 +00974 CL*80 +00975 IF FQTF-TOTAL-WAGES = ZERO CL*80 +00976 PERFORM P3130-ZERO-WAGE-ERR THRU P3130-EXIT CL*80 +00977 END-IF. CL*81 +00978 CL*80 +00979 IF FQTF-PAYMENT-AMOUNT = ZERO CL111 +00980 NEXT SENTENCE CL111 +00981 ELSE CL111 +00982 IF FDPT-PAYMENT-TRACE-NO = ZERO CL*80 +00983 PERFORM P3140-MISSING-PAYMENT THRU P3140-EXIT CL*80 +00984 END-IF. CL*81 +00985 CL*80 +00986 P3100-EXIT. CL*79 +00987 EXIT. CL*79 +00988 CL*79 +00989 P3110-MISSING-REPORT-ERR. CL*80 +00990 MOVE MSG5-ID TO R907-MSG-ID CL*67 +00991 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*67 +00992 MOVE FCQW-EMPL-TRACE-NO TO MSG5-TRACE-NO CL*70 +00993 MOVE MSG5-TEXT TO R907-MSG-TEXT CL*67 +00994 CL*67 +00995 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*67 +00996 DISPLAY 'BD140 P3110 MSG5 ' CL117 +00997 DISPLAY ' CQW ' FCQW-EMP-NO ' ' FCQW-EMPL-TRACE-NO CL118 +00998 DISPLAY ' QTF ' FQTF-EMP-NO ' ' FQTF-TRACE-NO CL117 +00999 ADD +1 TO WRK-R907-CNT. CL*68 +01000 CL*67 +01001 P3110-EXIT. CL*80 +01002 EXIT. EFTBD140 +01003 EFTBD140 +01004 P3120-UNEXPECTED-WAGE-ERR. CL*80 +01005 IF ERR-UNEXPECTED-WAGE-YES-88 CL*67 +01006 GO TO P3120-EXIT CL*80 +01007 ELSE CL*63 +01008 SET ERR-UNEXPECTED-WAGE-YES-88 TO TRUE. CL*67 +01009 CL*63 +01010 MOVE MSG6-ID TO R907-MSG-ID CL*67 +01011 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*67 +01012 MOVE FCQW-EMPL-TRACE-NO TO MSG6-TRACE-NO CL*70 +01013 MOVE MSG6-TEXT TO R907-MSG-TEXT CL*67 +01014 CL*67 +01015 DISPLAY 'BD140 P3120 UNEXPECT ' FCQW-EMP-NO CL*80 +01016 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*67 +01017 ADD +1 TO WRK-R907-CNT. CL*68 +01018 CL*67 +01019 P3120-EXIT. CL*80 +01020 EXIT. CL*63 +01021 CL*63 +01022 P3130-ZERO-WAGE-ERR. CL*80 +01023 MOVE MSG7-ID TO R907-MSG-ID CL*67 +01024 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*67 +01025 MOVE FCQW-EMPL-TRACE-NO TO MSG7-TRACE-NO CL*70 +01026 MOVE MSG7-TEXT TO R907-MSG-TEXT CL*67 +01027 CL*67 +01028 DISPLAY 'BD140 P3130 ZERO WAGE ' CL117 +01029 DISPLAY ' CQW ' FCQW-EMP-NO ' ' FCQW-EMPL-WAGES CL117 +01030 DISPLAY ' QTF ' FQTF-EMP-NO ' ' FQTF-TOTAL-WAGES CL117 +01031 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*67 +01032 ADD +1 TO WRK-R907-CNT. CL*68 +01033 CL*67 +01034 P3130-EXIT. CL*80 +01035 EXIT. EFTBD140 +01036 EFTBD140 +01037 P3140-MISSING-PAYMENT. CL*80 +01038 MOVE MSG8-ID TO R907-MSG-ID CL*80 +01039 MOVE FCQW-EMP-NO TO R907-EMP-NO CL*80 +01040 MOVE FCQW-EMPL-TRACE-NO TO MSG8-TRACE-NO CL*80 +01041 MOVE MSG8-TEXT TO R907-MSG-TEXT CL*80 +01042 CL*80 +01043 DISPLAY 'BD140 P3140 MISS PAY ' FCQW-EMP-NO CL*80 +01044 PERFORM S946-WRITE-R907 THRU S946-EXIT. CL*80 +01045 ADD +1 TO WRK-R907-CNT. CL*80 +01046 CL*80 +01047 P3140-EXIT. CL*80 +01048 EXIT. CL*80 +01049 CL*80 +01050 P3200-WRITE-W001. CL*80 +01051 MOVE WRK-PSEUDO-BATCH-NO TO W001-BATCH-NO. CL*79 +01052 MOVE WRK-PSEUDO-ITEM-NO TO W001-ITEM-NO. CL*79 +01053 ADD 1 TO WRK-SEQ-NO. CL*68 +01054 MOVE WRK-SEQ-NO TO W001-SEQ-NO. CL*68 +01055 MOVE FCQW-EMP-NO TO W001-EMP-NO. CL*68 +01056 MOVE FCQW-SSN TO W001-SSN. CL*68 +01057 SET W001-SSN-VALID-88 TO TRUE. CL*68 +01058 MOVE FCQW-FIRST-NAME TO W001-FIRST-NAME. CL*68 +01059 MOVE FCQW-MIDDLE-INITIAL TO W001-MID-INIT. CL*68 +01060 MOVE FCQW-LAST-NAME TO W001-LAST-NAME. CL*68 +01061 SET W001-NAME-VALID-88 TO TRUE. CL*68 +01062 MOVE FCQW-YEAR TO WRK-YRQ-CCYY. CL*78 +01063 MOVE FCQW-QTR TO WRK-YRQ-Q. CL*78 +01064 MOVE WRK-YRQ-AREA TO W001-YRQ. CL*78 +01065 MOVE FCQW-EMPL-WAGES TO W001-WAGE-CHNG. CL*68 +01066 SET W001-WAGE-VALID-88 TO TRUE. CL*68 +01067 MOVE ZERO TO W001-CURR-WAGE CL*68 +01068 W001-TAX-WAGE CL*68 +01069 W001-PRIOR-WAGE. CL*68 +01070 IF T027-RECEIVED-DATE = ZERO CL*84 +01071 MOVE L005-DATE TO W001-RECEIVED-DATE CL*84 +01072 ELSE CL*84 +01073 MOVE T027-RECEIVED-DATE TO W001-RECEIVED-DATE. CL*84 +01074 MOVE L005-TIME TO W001-RECEIVED-TIME. CL*68 +01075 MOVE SPACES TO W001-RESPONSIBLE-OP-ID. CL*68 +01076 CL*68 +01077 MOVE W001-REC TO WAGE-TRAN-REC. CL*86 +01078 WRITE WAGE-TRAN-REC. CL*86 +01079 IF NOT WAGE-STATUS-OK-88 CL*86 +01080 DISPLAY 'CANNOT WRITE WAGE: ' WAGE-STATUS. CL*87 +01081 *** PERFORM S985B-WRITE THRU S985B-EXIT. CL*86 +01082 ADD +1 TO WRK-W001-CNT. CL*68 +01083 CL*68 +01084 P3200-EXIT. CL*80 +01085 EXIT. CL*68 +01086 CL*68 +01087 T0000-TERMINATE. EFTBD140 +01088 *** PERFORM S985C-CLOSE THRU S985C-EXIT. CL*73 +01089 CLOSE WAGE-TRAN-FILE. CL*86 +01090 CL*59 +01091 DISPLAY ' '. CL221 +01092 DISPLAY ' '. CL221 +01093 CL*71 +01094 DISPLAY '*** EFTBD140 TERMINATION STATISTICS ***'. CL197 +01095 CL*71 +01096 DISPLAY ' '. CL237 +01097 DISPLAY 'REPORT TRANSACTION COUNT :' CL*69 +01098 WRK-RPT-REC-CNT. CL*69 +01099 CL223 +01100 DISPLAY ' '. CL*98 +01101 DISPLAY 'PAYMENT TRANSACTION COUNT :' CL*69 +01102 WRK-PAY-REC-CNT. CL*69 +01103 CL*98 +01104 DISPLAY ' '. CL*79 +01105 DISPLAY 'WAGE TRANSACTION COUNT :' CL*69 +01106 WRK-WAGE-REC-CNT. CL*69 +01107 CL*69 +01108 DISPLAY ' '. CL*79 +01109 DISPLAY 'T027 QUARTERLY TAX RPT OUTPUT TRAN (BTC FILE) :' CL106 +01110 WRK-T027-CNT. CL*69 +01111 CL*95 +01112 DISPLAY 'T002 CONTACT STATUS TRANS RECS CNT (BTC FILE) :' CL107 +01113 WRK-T002-CONTACT-CNT. CL*95 +01114 CL190 +01115 DISPLAY ' '. CL*79 +01116 DISPLAY 'W001 WAGES OUTPUT TRANS REC COUNT (BWTC FILE) :' CL106 +01117 WRK-W001-CNT. CL*69 +01118 CL*92 +01119 DISPLAY ' '. CL*95 +01120 DISPLAY 'R907 ERROR REPORT RECORD COUNT :' CL*92 +01121 WRK-R907-CNT. CL*92 +01122 CL*92 +01123 T0000-EXIT. EFTBD140 +01124 EXIT. EFTBD140 +01125 EJECT EFTBD140 +01126 CL*59 +01127 S001-FROM-FED-8. CL108 +01128 SET L001-FROM-FED-8 TO TRUE. CL108 +01129 GO TO S001-DATE. CL108 +01130 CL108 +01131 S001-FROM-ABS-DAY. CL108 +01132 SET L001-FROM-ABS-DAY TO TRUE. CL108 +01133 GO TO S001-DATE. CL108 +01134 CL108 +01135 S001-FROM-CAL-6. CL108 +01136 SET L001-FROM-CAL-6 TO TRUE. CL108 +01137 GO TO S001-DATE. CL108 +01138 CL108 +01139 S001-DATE. CL108 +01140 CALL 'DTSBU001' USING L001-LINK-AREA. CL108 +01141 S001-EXIT. CL108 +01142 EXIT. CL108 +01143 CL*56 +01144 S003-AGENCY-DAY. CL*56 +01145 SET L003-AGENCY-DAY TO TRUE. CL*56 +01146 GO TO S003-WORK-DAY. CL*56 +01147 CL*56 +01148 S003-WORK-DAY. CL*56 +01149 CALL 'DTSBU003' USING L003-LINK-AREA. CL*56 +01150 S003-EXIT. CL*56 +01151 EXIT. CL*56 +01152 CL*56 +01153 S004-FROM-3. CL*24 +01154 SET L004-FROM-3 TO TRUE. CL*24 +01155 GO TO S004-YRQ. CL*24 +01156 CL*24 +01157 S004-YRQ. CL*24 +01158 CALL 'DTSBU004' USING L004-LINK-AREA. CL*24 +01159 CL*24 +01160 S004-EXIT. CL*24 +01161 EXIT. CL*24 +01162 CL*24 +01163 S005-SYS-DATE. CL*61 +01164 CALL 'DTSBU005' USING L005-COMM-AREA. CL*61 +01165 CL*61 +01166 S005-EXIT. CL*61 +01167 EXIT. CL*61 +01168 CL*78 +01169 S516-LIABILITY-INFO. EFTBD140 +01170 CALL 'DTSBU516' USING L516-LINK-AREA EFTBD140 +01171 MPRF-REC. EFTBD140 +01172 S516-EXIT. EFTBD140 +01173 EXIT. EFTBD140 +01174 EFTBD140 +01175 S076-NAME. CL116 +01176 CALL 'DTSBU076' USING L076-LINK-AREA. CL116 +01177 CL*92 +01178 S076-EXIT. CL116 +01179 EXIT. CL*92 +01180 CL*92 +01181 S910-OPEN-READ. CL*70 +01182 SET L910-OPEN-READ-88 TO TRUE. CL*70 +01183 GO TO S910-MSTR-IO. CL*70 +01184 CL*70 +01185 S910-OPEN-UPDATE-NO-AIX. CL*70 +01186 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*70 +01187 GO TO S910-MSTR-IO. CL*70 +01188 CL*70 +01189 S910-READ. CL*70 +01190 SET L910-READ-88 TO TRUE. CL*70 +01191 GO TO S910-MSTR-IO. CL*70 +01192 CL*70 +01193 S910-START-BROWSE. CL*70 +01194 SET L910-START-BROWSE-88 TO TRUE. CL*70 +01195 GO TO S910-MSTR-IO. CL*70 +01196 CL*13 +01197 S910-READ-NEXT. CL*70 +01198 SET L910-READ-NEXT-88 TO TRUE. CL*70 +01199 GO TO S910-MSTR-IO. CL*70 +01200 CL*70 +01201 S910-COUNT. CL*70 +01202 SET L910-COUNT-88 TO TRUE. CL*70 +01203 GO TO S910-MSTR-IO. CL*70 +01204 CL*70 +01205 S910-WRITE. CL*70 +01206 SET L910-WRITE-88 TO TRUE. CL*70 +01207 GO TO S910-MSTR-IO. CL*70 +01208 CL*70 +01209 S910-REWRITE. CL*70 +01210 SET L910-REWRITE-88 TO TRUE. CL*70 +01211 GO TO S910-MSTR-IO. CL*70 +01212 CL*70 +01213 S910-CLOSE. CL*70 +01214 SET L910-CLOSE-88 TO TRUE. CL*70 +01215 GO TO S910-MSTR-IO. CL*70 +01216 CL*70 +01217 S910-MSTR-IO. CL*70 +01218 CALL 'DTSBU910' USING L910-LINK-AREA CL*70 +01219 MSKL-REC. CL*70 +01220 S910-EXIT. CL*70 +01221 EXIT. CL*70 +01222 CL212 +01223 S927-WRITE. CL212 +01224 SET L927-WRITE-88 TO TRUE. CL212 +01225 GO TO S927-BTC-O. CL212 +01226 CL212 +01227 S927-BTC-O. CL212 +01228 CALL 'DTSBU927' USING L927-LINK-AREA CL212 +01229 TSKL-REC. CL212 +01230 S927-EXIT. CL212 +01231 EXIT. CL212 +01232 CL215 +01233 CL*48 +01234 S985A-OPEN. CL*71 +01235 SET L985-OPEN-UPDATE-88 TO TRUE. CL*71 +01236 CALL 'DTSBU985' USING L985-LINK-AREA CL*71 +01237 W001-REC. CL*71 +01238 S985A-EXIT. CL*71 +01239 EXIT. CL*71 +01240 CL*71 +01241 S985B-WRITE. CL*71 +01242 SET L985-WRITE-88 TO TRUE. CL*48 +01243 CALL 'DTSBU985' USING L985-LINK-AREA CL*48 +01244 W001-REC. CL*68 +01245 S985B-EXIT. CL*71 +01246 EXIT. CL*48 +01247 CL*48 +01248 S985C-CLOSE. CL*71 +01249 SET L985-CLOSE-88 TO TRUE. CL*71 +01250 CALL 'DTSBU985' USING L985-LINK-AREA CL*71 +01251 W001-REC. CL*71 +01252 S985C-EXIT. CL*71 +01253 EXIT. CL*71 +01254 CL*71 +01255 S946-WRITE-R907. CL*41 +01256 CALL 'DTSBU946' USING R907-REC. CL*40 +01257 CL218 +01258 S946-EXIT. CL*49 +01259 EXIT. CL218 +01260 CL**9 +01261 S999-ABEND. EFTBD140 +01262 DISPLAY '*** EFTBD140 ABENDING : ' CL197 +01263 WRK-ABEND-MSG. CL*83 +01264 EFTBD140 +01265 CALL 'DTSBU999' USING WRK-ABEND-CD. EFTBD140 +01266 S999-EXIT. EFTBD140 +01267 EXIT. EFTBD140 diff --git a/Batch/GENT350.cob b/Batch/GENT350.cob new file mode 100644 index 0000000..5d70dd9 --- /dev/null +++ b/Batch/GENT350.cob @@ -0,0 +1,23 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. GENT350. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT LBL1OUT ASSIGN TO LBLOUT + ORGANIZATION IS SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + FD LBL1OUT + RECORDING MODE IS V. + 01 OUT-REC. + 05 WS-DATA PIC X(350) VALUE ZEROES. + 05 FILLER PIC X(3739) VALUE SPACES. + + WORKING-STORAGE SECTION. + PROCEDURE DIVISION. + OPEN OUTPUT LBL1OUT. + MOVE ALL "0" TO WS-DATA. + WRITE OUT-REC. + CLOSE LBL1OUT. + STOP RUN. \ No newline at end of file diff --git a/Batch/TDECVAL.cob b/Batch/TDECVAL.cob new file mode 100644 index 0000000..f28a41a --- /dev/null +++ b/Batch/TDECVAL.cob @@ -0,0 +1,613 @@ +00001 IDENTIFICATION DIVISION. 05/22/01 +00002 PROGRAM-ID. TDECVAL. TDECVAL +00003 LV001 +00004 ******************************************************************TDECVAL +00005 * *TDECVAL +00006 * FUNCTION: *TDECVAL +00007 * THE FUNCTION OF TDECVAL IS TO VALIDATE THE *TDECVAL +00008 * WAGE RECORD DATA THAT IS TRANSMITTED FROM THE TDEC COMPANY*TDECVAL +00009 * *TDECVAL +00010 * *TDECVAL +00011 ******************************************************************TDECVAL +00012 ******************************************************************TDECVAL +00013 * MODIFICATION HISTORY: *TDECVAL +00014 * *TDECVAL +00015 * 04-13-2001 MODIFIED TO INTERFACE WITH TAPE TRACKING SYSTEM *TDECVAL +00016 * THROUGH DESBD200. *TDECVAL +00017 * MODIFIED OUTPUT RECORD: FIRST DATA ELEMENT IS THE *TDECVAL +00018 * LOG NUMBER FOR THE TRAKING SYSTEM. *TDECVAL +00019 * *TDECVAL +00020 * REFERENCE RFP # AUTHOR OF CHANGE - GD *TDECVAL +00021 * *TDECVAL +00022 * 05-15-2001 MODIFIED TO OUTPUT A CLEAN TDEC DISK FILE. I.E., *TDECVAL +00023 * WITHOUT THE EXCEPTION RECORDS. *TDECVAL +00024 * REFERENCE RFP # AUTHOR OF CHANGE - RW *TDECVAL +00025 * *TDECVAL +00026 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *TDECVAL +00027 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *TDECVAL +00028 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *TDECVAL +00029 ******************************************************************TDECVAL +00030 TDECVAL +00031 ENVIRONMENT DIVISION. TDECVAL +00032 TDECVAL +00033 CONFIGURATION SECTION. TDECVAL +00034 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. TDECVAL +00035 TDECVAL +00036 INPUT-OUTPUT SECTION. TDECVAL +00037 FILE-CONTROL. TDECVAL +00038 SELECT TDECFILE ASSIGN TO TDECFILE. TDECVAL +00039 SELECT TDECOUT ASSIGN TO TDECOUT. TDECVAL +00040 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. TDECVAL +00041 SELECT EAFILE ASSIGN TO TXMASTER, TDECVAL +00042 ORGANIZATION IS INDEXED, TDECVAL +00043 ACCESS MODE IS DYNAMIC, TDECVAL +00044 RECORD KEY IS EMPL-ACCT-NO TDECVAL +00045 FILE STATUS IS FILE-STATUS-FILE. TDECVAL +00046 TDECVAL +00047 DATA DIVISION. TDECVAL +00048 TDECVAL +00049 FILE SECTION. TDECVAL +00050 FD EAFILE TDECVAL +00051 RECORD CONTAINS 3285 CHARACTERS TDECVAL +00052 DATA RECORD IS TX-MASTER. TDECVAL +00053 01 TXMASTER. TDECVAL +00054 ++INCLUDE TXMSR TDECVAL +00055 TDECVAL +00056 FD TDECFILE TDECVAL +00057 RECORDING MODE IS F TDECVAL +00058 ** RECORDING MODE IS S TDECVAL +00059 BLOCK CONTAINS 0 CHARACTERS TDECVAL +00060 LABEL RECORDS ARE STANDARD TDECVAL +00061 DATA RECORD IS TDECREC. TDECVAL +00062 01 TRANSACTION-RECORD PIC X(80). TDECVAL +00063 *01 TRANSACTION-RECORD1 PIC X(20). TDECVAL +00064 *01 TRANSACTION-RECORD2 PIC X(360). TDECVAL +00065 TDECVAL +00066 FD TDECOUT TDECVAL +00067 RECORDING MODE IS F TDECVAL +00068 BLOCK CONTAINS 0 CHARACTERS TDECVAL +00069 LABEL RECORDS ARE STANDARD TDECVAL +00070 DATA RECORD IS TDECOUT-REC. TDECVAL +00071 01 TDECOUT-REC PIC X(90). TDECVAL +00072 TDECVAL +00073 FD LISTOUT TDECVAL +00074 RECORD CONTAINS 133 CHARACTERS TDECVAL +00075 LABEL RECORDS ARE OMITTED TDECVAL +00076 DATA RECORD IS PRINT-REC. TDECVAL +00077 01 PRINT-REC PIC X(133). TDECVAL +00078 TDECVAL +00079 WORKING-STORAGE SECTION. TDECVAL +000795 77 PAN-VALET PICTURE X(24) VALUE '001TDECVAL 05/22/01'. TDECVAL +00080 TDECVAL +00081 01 WRK-AREA. TDECVAL +00082 05 ABEND-CD PIC X(05) VALUE 'TDVAL'. TDECVAL +00083 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. TDECVAL +00084 05 ABEND-MSG PIC X(60). TDECVAL +00085 05 WRK-MOD-NAME PIC X(08) VALUE 'TDECVAL '. TDECVAL +00086 05 WRK-LOG-NO PIC 9(10) VALUE 0. TDECVAL +00087 05 ERROR-SW PIC 9 VALUE 0. TDECVAL +00088 TDECVAL +00089 01 WS-QUARTER-YR-QTR PIC 9(05). TDECVAL +00090 01 FILLER REDEFINES WS-QUARTER-YR-QTR. TDECVAL +00091 05 WS-QUARTER-YEAR PIC 9(4). TDECVAL +00092 05 WS-QUARTER-QTR PIC 9(1). TDECVAL +00093 TDECVAL +00094 01 L004-LINK-AREA. TDECVAL +00095 ++INCLUDE DTSIL004 TDECVAL +00096 EJECT TDECVAL +00097 TDECVAL +00098 01 WS-WAGE-ACCOUNT PIC 9(06). TDECVAL +00099 TDECVAL +00100 01 WS-CURR-EMP PIC 9(06) VALUE ZERO. TDECVAL +00101 01 WS-EMP-TOT-CNT PIC S9(07) COMP-3 VALUE +0.TDECVAL +00102 01 WS-EMP-SUCCESS-CNT PIC S9(07) COMP-3 VALUE +0.TDECVAL +00103 TDECVAL +00104 01 L200-LINK-AREA. TDECVAL +00105 ++INCLUDE DESIL200 TDECVAL +00106 TDECVAL +00107 01 C202-MSG-TABLE. TDECVAL +00108 ++INCLUDE DTSIC202 TDECVAL +00109 TDECVAL +00110 01 ALPHA-SORT-NAME-FOUR PIC X(4). TDECVAL +00111 01 MAILING-NAME-FOUR PIC X(4). TDECVAL +00112 TDECVAL +00113 01 TDECOUT-WORK-AREA. TDECVAL +00114 ******************************************************************TDECVAL +00115 * TDEC-OUTPUT TRANSACTION RECORD AREA *TDECVAL +00116 ******************************************************************TDECVAL +00117 05 WRK-TRANSACTION-AREA. TDECVAL +00118 10 WRK-TRAN-LOG-NO PIC 9(10) VALUE 0. TDECVAL +00119 10 WRK-TRAN-AREA PIC X(80) VALUE SPACES. TDECVAL +00120 TDECVAL +00121 01 TRANSACTION-WORK-AREA. TDECVAL +00122 ******************************************************************TDECVAL +00123 * ESP TRANSACTION RECORD DESCRIPTIONS *TDECVAL +00124 ******************************************************************TDECVAL +00125 05 ESP-TRANSACTION-AREA. TDECVAL +00126 10 TRAN-SSN PIC 9(10). TDECVAL +00127 10 FILLER REDEFINES TRAN-SSN. TDECVAL +00128 15 TR-SSN PIC 9(9). TDECVAL +00129 15 TR-SSN-SEQ PIC 9(1). TDECVAL +00130 10 TRAN-ID PIC X(02). TDECVAL +00131 10 FILLER REDEFINES TRAN-ID. TDECVAL +00132 15 TRAN-ID-PFX PIC X(1). TDECVAL +00133 88 TRAN-ID-PFX-WAGE VALUE 'W'. TDECVAL +00134 15 FILLER PIC X(1). TDECVAL +00135 10 TRAN-OPER-ID PIC 9(8). TDECVAL +00136 10 FILLER REDEFINES TRAN-OPER-ID. TDECVAL +00137 15 BATCH-NUMBER PIC 9(03). TDECVAL +00138 15 FILLER REDEFINES BATCH-NUMBER. TDECVAL +00139 20 BATCH-NUMBER-NN PIC 9(02). TDECVAL +00140 20 FILLER PIC X(01). TDECVAL +00141 15 TRAN-LOCAL-OFFICE PIC 9(02). TDECVAL +00142 15 TRAN-OPERATOR-ID PIC 9(03). TDECVAL +00143 10 TRAN-DATE-ENTERED PIC 9(08). TDECVAL +00144 10 TRAN-TIME-ENTERED PIC 9(06). TDECVAL +00145 10 FILLER PIC 9(06). TDECVAL +00146 10 TRAN-NAME-CHECK PIC X(3). TDECVAL +00147 10 TRAN-QUARTER-YR-QTR PIC 9(5). TDECVAL +00148 10 TRAN-AFFI-CODE PIC 9(1). TDECVAL +00149 10 TRAN-QUARTER-EARNINGS PIC 9(7). TDECVAL +00150 10 TRAN-ACCOUNT PIC 9(6). TDECVAL +00151 10 TRAN-EMP-NAME PIC X(4). TDECVAL +00152 10 TRAN-FILLER PIC X(299). TDECVAL +00153 01 COUNTERS. TDECVAL +00154 03 FILE-STATUS-FILE PIC 99. TDECVAL +00155 03 EMP-QTR-TOT-EARNINGS PIC 9(7). TDECVAL +00156 03 RECS-IN PIC 9(5). TDECVAL +00157 03 RECS-OUT PIC 9(5). TDECVAL +00158 03 QTR-RECS-OUT PIC 9(5). TDECVAL +00159 03 PAGE-CTR PIC 9(5). TDECVAL +00160 03 ERROR-RECS PIC 9(5). TDECVAL +00161 TDECVAL +00162 03 ZERO-WAGE-CNT PIC 9(5). TDECVAL +00163 03 EXCEPTION-CNT PIC 9(5). TDECVAL +00164 03 WS-ZERO-WAGE-NO PIC 9(5). TDECVAL +00165 TDECVAL +00166 TDECVAL +00167 01 LINE-CTR PIC 9(5) VALUE 56. TDECVAL +00168 01 EOF PIC X. TDECVAL +00169 TDECVAL +00170 01 WS-TODAY PIC 9(06). TDECVAL +00171 01 WS-TODAY-REDEF REDEFINES WS-TODAY. TDECVAL +00172 05 WS-TODAY-YY PIC 9(02). TDECVAL +00173 05 WS-TODAY-MM PIC 9(02). TDECVAL +00174 05 WS-TODAY-DD PIC 9(02). TDECVAL +00175 TDECVAL +00176 01 SELECT-CARD. TDECVAL +00177 03 PGM-NAME PIC X(09) VALUE '**TDECVAL'. TDECVAL +00178 03 FIL PIC XX. TDECVAL +00179 03 SELECT-QUARTER PIC 9(5). TDECVAL +00180 03 FIL PIC X(73). TDECVAL +00181 01 HD1. TDECVAL +00182 03 FIL PIC X(5) VALUE SPACES. TDECVAL +00183 03 FIL PIC X(8) VALUE 'TDECVAL '. TDECVAL +00184 03 FIL PIC X(31) VALUE SPACES. TDECVAL +00185 03 FIL PIC X(42) VALUE TDECVAL +00186 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. TDECVAL +00187 03 FIL PIC X(35) VALUE SPACES. TDECVAL +00188 03 FIL PIC X(5) VALUE 'PAGE:'. TDECVAL +00189 03 PAGE-CTR-PRT PIC ZZ,ZZ9. TDECVAL +00190 01 HD2. TDECVAL +00191 03 FIL PIC X(49) VALUE SPACES. TDECVAL +00192 03 FIL PIC X(39) VALUE TDECVAL +00193 'DOES UI WAGE RECORD EDIT REPORT'. TDECVAL +00194 01 HD3. TDECVAL +00195 03 FIL PIC X(57) VALUE SPACES. TDECVAL +00196 03 FIL PIC X(9) VALUE 'RUN DATE:'. TDECVAL +00197 03 REPORTING-DATE-MM PIC X(2). TDECVAL +00198 03 FILLER PIC X VALUE '/'. TDECVAL +00199 03 REPORTING-DATE-DD PIC X(2). TDECVAL +00200 03 FILLER PIC X VALUE '/'. TDECVAL +00201 03 REPORTING-DATE-YY PIC X(2). TDECVAL +00202 TDECVAL +00203 01 HD4. TDECVAL +00204 03 FIL PIC X(5) VALUE SPACES. TDECVAL +00205 03 FIL PIC X(3) VALUE 'SSN'. TDECVAL +00206 03 FIL PIC X(7) VALUE SPACES. TDECVAL +00207 03 FIL PIC X(12) VALUE 'DATE ENTERED'. TDECVAL +00208 03 FIL PIC X(02) VALUE SPACES. TDECVAL +00209 03 FIL PIC X(13) VALUE 'EMPLOYEE NAME'. TDECVAL +00210 03 FIL PIC X(2) VALUE SPACES. TDECVAL +00211 03 FIL PIC X(7) VALUE 'QUARTER'. TDECVAL +00212 03 FIL PIC X(6) VALUE SPACES. TDECVAL +00213 03 FIL PIC X(8) VALUE 'EARNINGS'. TDECVAL +00214 03 FIL PIC X(6) VALUE SPACES. TDECVAL +00215 03 FIL PIC X(14) VALUE 'ACCOUNT NUMBER'. TDECVAL +00216 03 FIL PIC X(2) VALUE SPACES. TDECVAL +00217 03 FIL PIC X(13) VALUE 'EMPLOYER NAME'. TDECVAL +00218 03 FIL PIC X(04) VALUE SPACES. TDECVAL +00219 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'.TDECVAL +00220 01 DTL1. TDECVAL +00221 03 FIL PIC X(5) VALUE SPACES. TDECVAL +00222 03 SSN-PRT PIC X(9). TDECVAL +00223 03 FIL PIC X(04) VALUE SPACES. TDECVAL +00224 03 DATE-ENTERED-PRT PIC X(06). TDECVAL +00225 03 FIL PIC X(10) VALUE SPACES. TDECVAL +00226 03 EMPEE-NAME PIC X(3). TDECVAL +00227 03 FIL PIC X(08) VALUE SPACES. TDECVAL +00228 03 QTR-PRT PIC X(5). TDECVAL +00229 03 FIL PIC X(08) VALUE SPACES. TDECVAL +00230 03 EARNINGS-PRT PIC X(7). TDECVAL +00231 03 FIL PIC X(10) VALUE SPACES. TDECVAL +00232 03 ACCT-NUM-PRT PIC X(6). TDECVAL +00233 03 FIL PIC X(10) VALUE SPACES. TDECVAL +00234 03 EMPOR-PRT PIC X(6). TDECVAL +00235 03 FIL PIC X(07) VALUE SPACES. TDECVAL +00236 03 MESSAGE-AREA PIC X(30) VALUE SPACES. TDECVAL +00237 01 TOT1. TDECVAL +00238 03 FIL PIC X(2) VALUE SPACES. TDECVAL +00239 03 FIL PIC X(21) VALUE 'TOTAL WAGE RECS READ:'. TDECVAL +00240 03 WAGE-CNT-PRT PIC ZZZ,ZZ9. TDECVAL +00241 03 FIL PIC X(6) VALUE SPACES. TDECVAL +00242 03 FIL PIC X(24) VALUE 'TOTAL WAGE RECS WRITTEN:'.TDECVAL +00243 03 WAGE-OUT-PRT PIC ZZZ,ZZ9. TDECVAL +00244 03 FIL PIC X(6) VALUE SPACES. TDECVAL +00245 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. TDECVAL +00246 03 ERRORS-PRT PIC ZZ,ZZ9. TDECVAL +00247 03 FIL PIC X(6) VALUE SPACES. TDECVAL +00248 03 FIL PIC X(20) VALUE 'TOTAL ZERO WAGE REC:'. TDECVAL +00249 03 ZERO-WAGE-PRT PIC ZZ,ZZ9. TDECVAL +00250 03 BLANK-LINE PIC X(133) VALUE SPACES. TDECVAL +00251 TDECVAL +00252 LINKAGE SECTION. TDECVAL +00253 01 PARM-AREA. TDECVAL +00254 05 PARM-LENGTH PIC S9(04) COMP. TDECVAL +00255 05 PARM-LOG-NO PIC 9(06). TDECVAL +00256 05 FILLER PIC X(01). TDECVAL +00257 05 PARM-ZERO-WAGE-NO PIC 9(05). TDECVAL +00258 TDECVAL +00259 PROCEDURE DIVISION USING PARM-AREA. TDECVAL +00260 TDECVAL +00261 ** READY TRACE. TDECVAL +00262 ACCEPT SELECT-CARD. TDECVAL +00263 OPEN INPUT TDECFILE TDECVAL +00264 I-O EAFILE TDECVAL +00265 OUTPUT LISTOUT TDECOUT. TDECVAL +00266 TDECVAL +00267 ACCEPT WS-TODAY FROM DATE. TDECVAL +00268 MOVE WS-TODAY-YY TO REPORTING-DATE-YY. TDECVAL +00269 MOVE WS-TODAY-MM TO REPORTING-DATE-MM. TDECVAL +00270 MOVE WS-TODAY-DD TO REPORTING-DATE-DD. TDECVAL +00271 TDECVAL +00272 MOVE ZEROS TO COUNTERS. TDECVAL +00273 TDECVAL +00274 PERFORM INIT0100-EDIT-PARMS THRU INIT0100-EXIT. TDECVAL +00275 TDECVAL +00276 PERFORM 100-READ-WAGE THRU 100-RW-EXIT TDECVAL +00277 UNTIL TDECVAL +00278 EOF = 1. TDECVAL +00279 TDECVAL +00280 INIT0100-EDIT-PARMS. TDECVAL +00281 TDECVAL +00282 IF PARM-LOG-NO NOT NUMERIC TDECVAL +00283 MOVE 'PARM-LOG-NO IS NOT NUMERIC ' TO ABEND-MSG TDECVAL +00284 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. TDECVAL +00285 TDECVAL +00286 DISPLAY 'PARM-LOG-NO = ' PARM-LOG-NO. TDECVAL +00287 TDECVAL +00288 IF PARM-ZERO-WAGE-NO NOT NUMERIC TDECVAL +00289 MOVE 'PARM-ZERO-WAGE-NO IS NOT NUMERIC ' TO ABEND-MSG TDECVAL +00290 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. TDECVAL +00291 TDECVAL +00292 MOVE PARM-ZERO-WAGE-NO TO WS-ZERO-WAGE-NO. TDECVAL +00293 DISPLAY 'PARM-ZERO-WAGE-NO = ' WS-ZERO-WAGE-NO. TDECVAL +00294 TDECVAL +00295 TDECVAL +00296 SET L200-CMD-INIT-88 TO TRUE. TDECVAL +00297 MOVE PARM-LOG-NO TO L200-LOG-NO-SFX. TDECVAL +00298 MOVE WRK-MOD-NAME TO L200-PROG-NAME. TDECVAL +00299 CALL 'DESBD200' USING L200-LINK-AREA C202-MSG-TABLE. TDECVAL +00300 MOVE L200-LOG-NO TO WRK-LOG-NO. TDECVAL +00301 TDECVAL +00302 DISPLAY 'WRK-LOG-NO = ' WRK-LOG-NO. TDECVAL +00303 TDECVAL +00304 INIT0100-EXIT. TDECVAL +00305 EXIT. TDECVAL +00306 TDECVAL +00307 100-READ-WAGE. TDECVAL +00308 READ TDECFILE INTO ESP-TRANSACTION-AREA TDECVAL +00309 AT END TDECVAL +00310 MOVE 1 TO EOF TDECVAL +00311 TDECVAL +00312 IF WS-EMP-TOT-CNT > ZERO TDECVAL +00313 MOVE WS-CURR-EMP TO L200-EMP-NO TDECVAL +00314 MOVE WS-QUARTER-YR-QTR TO L200-REPORTING-DATE TDECVAL +00315 MOVE WS-EMP-TOT-CNT TO L200-TOT-CNT TDECVAL +00316 MOVE WS-EMP-SUCCESS-CNT TO L200-SUCCESS-CNT TDECVAL +00317 ELSE TDECVAL +00318 MOVE ZERO TO L200-EMP-NO TDECVAL +00319 L200-TOT-CNT TDECVAL +00320 L200-SUCCESS-CNT TDECVAL +00321 END-IF TDECVAL +00322 TDECVAL +00323 SET L200-CMD-TERMINATE-88 TO TRUE TDECVAL +00324 PERFORM SERV0200-UPD-LOG THRU SERV0200-EXIT. TDECVAL +00325 TDECVAL +00326 IF EOF = 1 TDECVAL +00327 GO TO 999-CLOSE-FILES. TDECVAL +00328 ** TDECVAL +00329 **TO BYPASS WAGE REPORTS PRINTED FROM THE NEW TAX M/F TDECVAL +00330 ** TDECVAL +00331 IF TRAN-QUARTER-YR-QTR > 19993 TDECVAL +00332 ** ADD 1 TO RECS-IN TDECVAL +00333 GO TO 100-READ-WAGE. TDECVAL +00334 TDECVAL +00335 ADD 1 TO RECS-IN. TDECVAL +00336 TDECVAL +00337 INSPECT TRAN-QUARTER-EARNINGS REPLACING TDECVAL +00338 LEADING ' ' BY ZERO. TDECVAL +00339 TDECVAL +00340 IF TRAN-QUARTER-EARNINGS = ZEROS TDECVAL +00341 IF WS-ZERO-WAGE-NO = EXCEPTION-CNT TDECVAL +00342 ADD 1 TO ZERO-WAGE-CNT TDECVAL +00343 GO TO 100-READ-WAGE TDECVAL +00344 ELSE TDECVAL +00345 MOVE 'GROSS-WAGE EQUAL ZEROS' TO MESSAGE-AREA TDECVAL +00346 * MOVE 1 TO ERROR-SW TDECVAL +00347 ADD 1 TO ZERO-WAGE-CNT TDECVAL +00348 ADD 1 TO EXCEPTION-CNT TDECVAL +00349 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00350 SET EMSG106-SELECTED-YES TO TRUE TDECVAL +00351 MOVE ZERO TO ERROR-SW TDECVAL +00352 GO TO 100-RW-EXIT. TDECVAL +00353 TDECVAL +00354 MOVE TRAN-ACCOUNT TO WS-WAGE-ACCOUNT. TDECVAL +00355 TDECVAL +00356 IF WS-WAGE-ACCOUNT NOT NUMERIC TDECVAL +00357 * NEXT SENTENCE TDECVAL +00358 MOVE ZEROS TO WS-WAGE-ACCOUNT TDECVAL +00359 ELSE TDECVAL +00360 IF WS-CURR-EMP = ZERO TDECVAL +00361 MOVE WS-WAGE-ACCOUNT TO WS-CURR-EMP TDECVAL +00362 MOVE +1 TO WS-EMP-TOT-CNT TDECVAL +00363 MOVE ZERO TO WS-EMP-SUCCESS-CNT TDECVAL +00364 ELSE TDECVAL +00365 IF WS-WAGE-ACCOUNT NOT = WS-CURR-EMP TDECVAL +00366 SET L200-CMD-EMP-COMPLETE-88 TO TRUE TDECVAL +00367 MOVE WS-CURR-EMP TO L200-EMP-NO TDECVAL +00368 MOVE WS-QUARTER-YR-QTR TO L200-REPORTING-DATE TDECVAL +00369 MOVE WS-EMP-TOT-CNT TO L200-TOT-CNT TDECVAL +00370 MOVE WS-EMP-SUCCESS-CNT TO L200-SUCCESS-CNT TDECVAL +00371 PERFORM SERV0200-UPD-LOG THRU SERV0200-EXIT TDECVAL +00372 MOVE +1 TO WS-EMP-TOT-CNT TDECVAL +00373 MOVE ZERO TO WS-EMP-SUCCESS-CNT TDECVAL +00374 MOVE WS-WAGE-ACCOUNT TO WS-CURR-EMP TDECVAL +00375 ELSE TDECVAL +00376 ADD +1 TO WS-EMP-TOT-CNT TDECVAL +00377 END-IF TDECVAL +00378 END-IF TDECVAL +00379 END-IF. TDECVAL +00380 TDECVAL +00381 PERFORM 110-VALIDATE-WAGE THRU 121-VW-EXIT. TDECVAL +00382 TDECVAL +00383 IF ERROR-SW = 1 TDECVAL +00384 MOVE ZERO TO ERROR-SW TDECVAL +00385 GO TO 100-RW-EXIT TDECVAL +00386 ELSE TDECVAL +00387 MOVE ZERO TO ERROR-SW. TDECVAL +00388 TDECVAL +00389 PERFORM 220-CREATE-W4-TRAN THRU 220-CW-EXIT. TDECVAL +00390 TDECVAL +00391 100-RW-EXIT. TDECVAL +00392 EXIT. TDECVAL +00393 TDECVAL +00394 110-VALIDATE-WAGE. TDECVAL +00395 TDECVAL +00396 MOVE SPACES TO MESSAGE-AREA. TDECVAL +00397 TDECVAL +00398 111-VALIDATE-SSN. TDECVAL +00399 IF TR-SSN NOT NUMERIC TDECVAL +00400 MOVE 1 TO ERROR-SW TDECVAL +00401 MOVE 'SSN NOT NUMERIC ' TO MESSAGE-AREA TDECVAL +00402 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00403 SET EMSG104-SELECTED-YES TO TRUE TDECVAL +00404 GO TO 121-VW-EXIT. TDECVAL +00405 TDECVAL +00406 112-VALIDATE-ID. TDECVAL +00407 IF TRAN-ID NOT = 'W4' TDECVAL +00408 MOVE 1 TO ERROR-SW TDECVAL +00409 MOVE 'TRAN-ID ERROR' TO MESSAGE-AREA TDECVAL +00410 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00411 SET EMSG112-SELECTED-YES TO TRUE. TDECVAL +00412 TDECVAL +00413 113-VALIDATE-DATE. TDECVAL +00414 IF TRAN-DATE-ENTERED NOT NUMERIC TDECVAL +00415 MOVE 1 TO ERROR-SW TDECVAL +00416 MOVE 'DATE ENTERED ERROR' TO MESSAGE-AREA TDECVAL +00417 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00418 SET EMSG113-SELECTED-YES TO TRUE. TDECVAL +00419 TDECVAL +00420 114-VALIDATE-TIME. TDECVAL +00421 IF TRAN-TIME-ENTERED NOT NUMERIC TDECVAL +00422 MOVE 1 TO ERROR-SW TDECVAL +00423 MOVE 'TIME-ENTERED ERROR' TO MESSAGE-AREA TDECVAL +00424 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00425 SET EMSG114-SELECTED-YES TO TRUE. TDECVAL +00426 TDECVAL +00427 115-VALIDATE-NAME. TDECVAL +00428 IF TRAN-NAME-CHECK EQUAL SPACES TDECVAL +00429 MOVE 1 TO ERROR-SW TDECVAL +00430 MOVE 'EMPLOYEE NAME IS SPACES' TO MESSAGE-AREA TDECVAL +00431 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00432 SET EMSG107-SELECTED-YES TO TRUE. TDECVAL +00433 TDECVAL +00434 116-VALIDATE-QUARTER1. TDECVAL +00435 IF TRAN-QUARTER-YR-QTR NOT NUMERIC TDECVAL +00436 MOVE 1 TO ERROR-SW TDECVAL +00437 MOVE 'QUARTER FIELD NOT VALID' TO MESSAGE-AREA TDECVAL +00438 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00439 SET EMSG101-SELECTED-YES TO TRUE TDECVAL +00440 GO TO 118-QUARTER-EARNINGS-CHECK. TDECVAL +00441 TDECVAL +00442 IF SELECT-QUARTER EQUAL 'ALL' TDECVAL +00443 GO TO 118-QUARTER-EARNINGS-CHECK. TDECVAL +00444 TDECVAL +00445 117-VALIDATE-QUARTER2. TDECVAL +00446 IF TRAN-QUARTER-YR-QTR NOT EQUAL SELECT-QUARTER TDECVAL +00447 MOVE 1 TO ERROR-SW TDECVAL +00448 MOVE 'QUARTER FIELD NOT VALID' TO MESSAGE-AREA TDECVAL +00449 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00450 SET EMSG101-SELECTED-YES TO TRUE. TDECVAL +00451 TDECVAL +00452 118-QUARTER-EARNINGS-CHECK. TDECVAL +00453 IF TRAN-QUARTER-EARNINGS NOT NUMERIC TDECVAL +00454 MOVE 1 TO ERROR-SW TDECVAL +00455 MOVE 'QUARTER EARNINGS NOT NUMERIC' TO MESSAGE-AREA TDECVAL +00456 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00457 SET EMSG105-SELECTED-YES TO TRUE TDECVAL +00458 GO TO 121-VW-EXIT. TDECVAL +00459 TDECVAL +00460 119-TRAN-ACCOUNT1. TDECVAL +00461 IF TRAN-ACCOUNT NOT NUMERIC TDECVAL +00462 MOVE 1 TO ERROR-SW TDECVAL +00463 MOVE 'ACCOUNT NUMBER NOT NUMERIC' TO MESSAGE-AREA TDECVAL +00464 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00465 SET EMSG108-SELECTED-YES TO TRUE TDECVAL +00466 * GO TO 120-TRAN-EMP-NAME. TDECVAL +00467 GO TO 121-VW-EXIT. TDECVAL +00468 IF TRAN-ACCOUNT EQUAL ZEROS TDECVAL +00469 MOVE 1 TO ERROR-SW TDECVAL +00470 MOVE 'ACCOUNT NUMBER EQUAL ZEROS' TO MESSAGE-AREA TDECVAL +00471 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00472 SET EMSG109-SELECTED-YES TO TRUE TDECVAL +00473 * GO TO 120-TRAN-EMP-NAME. TDECVAL +00474 GO TO 121-VW-EXIT. TDECVAL +00475 TDECVAL +00476 119-TRAN-ACCOUNT2. TDECVAL +00477 TDECVAL +00478 MOVE TRAN-ACCOUNT TO EMPL-ACCT-NO. TDECVAL +00479 TDECVAL +00480 READ EAFILE TDECVAL +00481 INVALID KEY TDECVAL +00482 DISPLAY 'ACCOUNT # INVALID KEY ' EMPL-ACCT-NO TDECVAL +00483 MOVE 'ACCOUNT NUMBER NOT ON M/F ' TO MESSAGE-AREA TDECVAL +00484 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00485 SET EMSG109-SELECTED-YES TO TRUE TDECVAL +00486 GO TO 121-VW-EXIT. TDECVAL +00487 *** GO TO 120-TRAN-EMP-NAME. TDECVAL +00488 *** DISPLAY 'FILE-STATUS *99*' FILE-STATUS-FILE. TDECVAL +00489 TDECVAL +00490 MOVE ALPHA-SORT-NAME TO ALPHA-SORT-NAME-FOUR. TDECVAL +00491 MOVE MAILING-NAME TO MAILING-NAME-FOUR. TDECVAL +00492 TDECVAL +00493 ** IF FILE-STATUS-FILE EQUAL 00 TDECVAL +00494 ** DISPLAY 'FILE-STATUS *OO*' FILE-STATUS-FILE TDECVAL +00495 ** DISPLAY 'TRAN-ACCOUNT *OO*' TRAN-ACCOUNT TDECVAL +00496 ** DISPLAY 'EMPL-ACCOUNT *OO*' EMPL-ACCT-NO. TDECVAL +00497 TDECVAL +00498 IF FILE-STATUS-FILE EQUAL 23 TDECVAL +00499 DISPLAY 'FILE-STATUS ****' FILE-STATUS-FILE TDECVAL +00500 DISPLAY 'TRAN-ACCOUNT ****' TRAN-ACCOUNT. TDECVAL +00501 TDECVAL +00502 120-TRAN-EMP-NAME. TDECVAL +00503 IF TRAN-EMP-NAME EQUAL SPACES TDECVAL +00504 ** MOVE 1 TO ERROR-SW TDECVAL +00505 MOVE 'EMPLOYER NAME EQUAL SPACES' TO MESSAGE-AREA TDECVAL +00506 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00507 SET EMSG110-SELECTED-YES TO TRUE. TDECVAL +00508 TDECVAL +00509 *** DISPLAY '2511 ALPHA-NAME' ALPHA-SORT-NAME-FOUR TRAN-EMP-NAME.TDECVAL +00510 IF (ALPHA-SORT-NAME-FOUR = TRAN-EMP-NAME) OR TDECVAL +00511 (MAILING-NAME-FOUR = TRAN-EMP-NAME) TDECVAL +00512 NEXT SENTENCE TDECVAL +00513 ELSE TDECVAL +00514 ** MOVE 1 TO ERROR-SW TDECVAL +00515 MOVE 'EMPLOYER NAME NOT ON M/F' TDECVAL +00516 TO MESSAGE-AREA TDECVAL +00517 MOVE TRAN-EMP-NAME TO EMPOR-PRT TDECVAL +00518 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVAL +00519 SET EMSG111-SELECTED-YES TO TRUE. TDECVAL +00520 TDECVAL +00521 121-VW-EXIT. TDECVAL +00522 EXIT. TDECVAL +00523 TDECVAL +00524 125-WAGE-REPORT. TDECVAL +00525 TDECVAL +00526 MOVE TR-SSN TO SSN-PRT. TDECVAL +00527 MOVE TRAN-DATE-ENTERED TO DATE-ENTERED-PRT. TDECVAL +00528 MOVE TRAN-NAME-CHECK TO EMPEE-NAME. TDECVAL +00529 MOVE TRAN-QUARTER-EARNINGS TO EARNINGS-PRT. TDECVAL +00530 MOVE TRAN-QUARTER-YR-QTR TO QTR-PRT. TDECVAL +00531 MOVE TRAN-ACCOUNT TO ACCT-NUM-PRT. TDECVAL +00532 MOVE TRAN-EMP-NAME TO EMPOR-PRT. TDECVAL +00533 IF LINE-CTR > 55 TDECVAL +00534 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. TDECVAL +00535 WRITE PRINT-REC FROM DTL1. TDECVAL +00536 IF TRAN-QUARTER-EARNINGS NOT = ZEROS TDECVAL +00537 ADD 1 TO ERROR-RECS. TDECVAL +00538 ADD 1 TO LINE-CTR. TDECVAL +00539 125-WR-EXIT. TDECVAL +00540 EXIT. TDECVAL +00541 TDECVAL +00542 130-WAGE-HEADER. TDECVAL +00543 ADD 1 TO PAGE-CTR. TDECVAL +00544 MOVE PAGE-CTR TO PAGE-CTR-PRT. TDECVAL +00545 WRITE PRINT-REC FROM HD1 AFTER TOP-OF-PAGE. TDECVAL +00546 WRITE PRINT-REC FROM HD2. TDECVAL +00547 WRITE PRINT-REC FROM HD3. TDECVAL +00548 WRITE PRINT-REC FROM HD4. TDECVAL +00549 MOVE 4 TO LINE-CTR. TDECVAL +00550 130-WH-EXIT. TDECVAL +00551 EXIT. TDECVAL +00552 TDECVAL +00553 220-CREATE-W4-TRAN. TDECVAL +00554 TDECVAL +00555 ADD +1 TO WS-EMP-SUCCESS-CNT. TDECVAL +00556 TDECVAL +00557 MOVE WRK-LOG-NO TO WRK-TRAN-LOG-NO. TDECVAL +00558 MOVE ESP-TRANSACTION-AREA TO WRK-TRAN-AREA. TDECVAL +00559 TDECVAL +00560 WRITE TDECOUT-REC FROM WRK-TRANSACTION-AREA. TDECVAL +00561 ADD 1 TO QTR-RECS-OUT. TDECVAL +00562 ADD TRAN-QUARTER-EARNINGS TO EMP-QTR-TOT-EARNINGS. TDECVAL +00563 TDECVAL +00564 220-CW-EXIT. TDECVAL +00565 EXIT. TDECVAL +00566 TDECVAL +00567 TDECVAL +00568 ******************************************************************TDECVAL +00569 * OBTAIN YYYYQ YEAR-QUARTER INFORMATION. *TDECVAL +00570 ******************************************************************TDECVAL +00571 S004-FROM-3. TDECVAL +00572 SET L004-FROM-3 TO TRUE. TDECVAL +00573 GO TO S004-YRQ. TDECVAL +00574 TDECVAL +00575 S004-YRQ. TDECVAL +00576 CALL 'DTSBU004' USING L004-LINK-AREA. TDECVAL +00577 TDECVAL +00578 S004-EXIT. TDECVAL +00579 EXIT. TDECVAL +00580 EJECT TDECVAL +00581 TDECVAL +00582 ******************************************************************TDECVAL +00583 * CALL DESBD200 TO UPDATE MSTF LOG FILE. *TDECVAL +00584 ******************************************************************TDECVAL +00585 SERV0200-UPD-LOG. TDECVAL +00586 TDECVAL +00587 MOVE WRK-LOG-NO TO L200-LOG-NO. TDECVAL +00588 MOVE WRK-MOD-NAME TO L200-PROG-NAME. TDECVAL +00589 TDECVAL +00590 CALL 'DESBD200' USING L200-LINK-AREA C202-MSG-TABLE. TDECVAL +00591 TDECVAL +00592 SERV0200-EXIT. TDECVAL +00593 EXIT. TDECVAL +00594 TDECVAL +00595 SERV9999-ABEND. TDECVAL +00596 DISPLAY '**** DTECVAL ABENDING ' ABEND-MSG. TDECVAL +00597 CALL ABEND-MOD USING ABEND-CD. TDECVAL +00598 SERV9999-EXIT. TDECVAL +00599 EXIT. TDECVAL +00600 TDECVAL +00601 999-CLOSE-FILES. TDECVAL +00602 MOVE RECS-IN TO WAGE-CNT-PRT. TDECVAL +00603 MOVE QTR-RECS-OUT TO WAGE-OUT-PRT. TDECVAL +00604 MOVE ERROR-RECS TO ERRORS-PRT. TDECVAL +00605 MOVE ZERO-WAGE-CNT TO ZERO-WAGE-PRT. TDECVAL +00606 IF LINE-CTR > 52 TDECVAL +00607 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. TDECVAL +00608 WRITE PRINT-REC FROM TOT1 AFTER 2. TDECVAL +00609 CLOSE TDECFILE LISTOUT EAFILE. TDECVAL +00610 CLOSE TDECOUT. TDECVAL +00611 STOP RUN. TDECVAL +00612 TDECVAL diff --git a/Batch/TDECVALX.cob b/Batch/TDECVALX.cob new file mode 100644 index 0000000..20735ce --- /dev/null +++ b/Batch/TDECVALX.cob @@ -0,0 +1,615 @@ +00001 IDENTIFICATION DIVISION. 05/22/01 +00002 PROGRAM-ID. TDECVAL1. TDECVALX +00003 LV001 +00004 ******************************************************************TDECVALX +00005 * *TDECVALX +00006 * FUNCTION: *TDECVALX +00007 * THE FUNCTION OF TDECVAL IS TO VALIDATE THE *TDECVALX +00008 * WAGE RECORD DATA THAT IS TRANSMITTED FROM THE TDEC COMPANY*TDECVALX +00009 * *TDECVALX +00010 ******************************************************************TDECVALX +00011 ******************************************************************TDECVALX +00012 * MODIFICATION HISTORY: *TDECVALX +00013 * *TDECVALX +00014 * 04-13-2001 MODIFIED TO INTERFACE WITH TAPE TRACKING SYSTEM *TDECVALX +00015 * THROUGH DESBD200. *TDECVALX +00016 * MODIFIED OUTPUT RECORD: FIRST DATA ELEMENT IS THE *TDECVALX +00017 * LOG NUMBER FOR THE TRAKING SYSTEM. *TDECVALX +00018 * *TDECVALX +00019 * REFERENCE RFP # AUTHOR OF CHANGE - GD *TDECVALX +00020 * *TDECVALX +00021 * 05-16-2001 MODIFIED TO OUTPUT A CLEAN TDEVOUT DISK FILE. I.E., *TDECVALX +00022 * WITHOUT THE EXCPTION RECORDS. *TDECVALX +00023 * REFERENCE RFP # AUTHOR OF CHANGE - RW *TDECVALX +00024 * *TDECVALX +00025 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *TDECVALX +00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *TDECVALX +00027 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *TDECVALX +00028 ******************************************************************TDECVALX +00029 TDECVALX +00030 ENVIRONMENT DIVISION. TDECVALX +00031 TDECVALX +00032 CONFIGURATION SECTION. TDECVALX +00033 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. TDECVALX +00034 TDECVALX +00035 INPUT-OUTPUT SECTION. TDECVALX +00036 FILE-CONTROL. TDECVALX +00037 SELECT TDECFILE ASSIGN TO TDECFILE. TDECVALX +00038 SELECT TDECOUT ASSIGN TO TDECOUT. TDECVALX +00039 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. TDECVALX +00040 TDECVALX +00041 DATA DIVISION. TDECVALX +00042 FILE SECTION. TDECVALX +00043 TDECVALX +00044 FD TDECFILE TDECVALX +00045 RECORDING MODE IS F TDECVALX +00046 BLOCK CONTAINS 0 CHARACTERS TDECVALX +00047 LABEL RECORDS ARE STANDARD TDECVALX +00048 DATA RECORD IS TDECREC. TDECVALX +00049 01 TRANSACTION-RECORD PIC X(80). TDECVALX +00050 TDECVALX +00051 FD TDECOUT TDECVALX +00052 RECORDING MODE IS F TDECVALX +00053 BLOCK CONTAINS 0 CHARACTERS TDECVALX +00054 LABEL RECORDS ARE STANDARD TDECVALX +00055 DATA RECORD IS TDECOUT-REC. TDECVALX +00056 01 TDECOUT-REC PIC X(90). TDECVALX +00057 TDECVALX +00058 FD LISTOUT TDECVALX +00059 RECORD CONTAINS 133 CHARACTERS TDECVALX +00060 LABEL RECORDS ARE OMITTED TDECVALX +00061 RECORDING MODE IS F TDECVALX +00062 DATA RECORD IS PRINT-REC. TDECVALX +00063 01 PRINT-REC PIC X(133). TDECVALX +00064 TDECVALX +00065 WORKING-STORAGE SECTION. TDECVALX +000655 77 PAN-VALET PICTURE X(24) VALUE '001TDECVALX 05/22/01'. TDECVALX +00066 TDECVALX +00067 01 WRK-AREA. TDECVALX +00068 05 ABEND-CD PIC X(05) VALUE 'TVAL1'. TDECVALX +00069 05 ABEND-MOD PIC X(08) VALUE 'DTSBU999'. TDECVALX +00070 05 ABEND-MSG PIC X(60). TDECVALX +00071 05 WRK-MOD-NAME PIC X(08) VALUE 'TDECVAL1'. TDECVALX +00072 05 WRK-LOG-NO PIC 9(10) VALUE 0. TDECVALX +00073 05 ERROR-SW PIC 9. TDECVALX +00074 TDECVALX +00075 01 WS-QUARTER-YR-QTR PIC 9(05). TDECVALX +00076 01 FILLER REDEFINES WS-QUARTER-YR-QTR. TDECVALX +00077 05 WS-QUARTER-YEAR PIC 9(4). TDECVALX +00078 05 WS-QUARTER-QTR PIC 9(1). TDECVALX +00079 TDECVALX +00080 01 L004-LINK-AREA. TDECVALX +00081 ++INCLUDE DTSIL004 TDECVALX +00082 EJECT TDECVALX +00083 TDECVALX +00084 01 WS-WAGE-ACCOUNT PIC 9(06). TDECVALX +00085 TDECVALX +00086 01 WS-CURR-EMP PIC 9(06) VALUE ZERO. TDECVALX +00087 01 WS-EMP-TOT-CNT PIC S9(07) COMP-3 VALUE +0. TDECVALX +00088 01 WS-EMP-SUCCESS-CNT PIC S9(07) COMP-3 VALUE +0. TDECVALX +00089 TDECVALX +00090 01 L200-LINK-AREA. TDECVALX +00091 ++INCLUDE DESIL200 TDECVALX +00092 TDECVALX +00093 01 C202-MSG-TABLE. TDECVALX +00094 ++INCLUDE DTSIC202 TDECVALX +00095 TDECVALX +00096 01 WS-ETA-EMP-NAME-FOUR PIC X(4). TDECVALX +00097 TDECVALX +00098 01 TDECOUT-WORK-AREA. TDECVALX +00099 ******************************************************************TDECVALX +00100 * TDEC-OUTPUT TRANSACTION RECORD AREA *TDECVALX +00101 ******************************************************************TDECVALX +00102 05 WRK-TRANSACTION-AREA. TDECVALX +00103 10 WRK-TRAN-LOG-NO PIC 9(10) VALUE 0. TDECVALX +00104 10 WRK-TRAN-AREA PIC X(80) VALUE SPACES. TDECVALX +00105 TDECVALX +00106 01 TRANSACTION-WORK-AREA. TDECVALX +00107 ******************************************************************TDECVALX +00108 * ESP TRANSACTION RECORD DESCRIPTIONS *TDECVALX +00109 ******************************************************************TDECVALX +00110 05 ESP-TRANSACTION-AREA. TDECVALX +00111 10 TRAN-SSN PIC 9(10). TDECVALX +00112 10 FILLER REDEFINES TRAN-SSN. TDECVALX +00113 15 TR-SSN PIC 9(9). TDECVALX +00114 15 TR-SSN-SEQ PIC 9(1). TDECVALX +00115 10 TRAN-ID PIC X(02). TDECVALX +00116 10 FILLER REDEFINES TRAN-ID. TDECVALX +00117 15 TRAN-ID-PFX PIC X(1). TDECVALX +00118 88 TRAN-ID-PFX-WAGE VALUE 'W'. TDECVALX +00119 15 FILLER PIC X(1). TDECVALX +00120 10 TRAN-OPER-ID PIC 9(8). TDECVALX +00121 10 FILLER REDEFINES TRAN-OPER-ID. TDECVALX +00122 15 BATCH-NUMBER PIC 9(03). TDECVALX +00123 15 FILLER REDEFINES BATCH-NUMBER. TDECVALX +00124 20 BATCH-NUMBER-NN PIC 9(02). TDECVALX +00125 20 FILLER PIC X(01). TDECVALX +00126 15 TRAN-LOCAL-OFFICE PIC 9(02). TDECVALX +00127 15 TRAN-OPERATOR-ID PIC 9(03). TDECVALX +00128 10 TRAN-DATE-ENTERED PIC 9(08). TDECVALX +00129 10 TRAN-TIME-ENTERED PIC 9(06). TDECVALX +00130 10 FILLER PIC 9(06). TDECVALX +00131 10 TRAN-NAME-CHECK PIC X(3). TDECVALX +00132 10 TRAN-QUARTER-YR-QTR PIC 9(5). TDECVALX +00133 10 TRAN-AFFI-CODE PIC 9(1). TDECVALX +00134 10 TRAN-QUARTER-EARNINGS PIC 9(7). TDECVALX +00135 10 TRAN-ACCOUNT PIC 9(6). TDECVALX +00136 10 TRAN-EMP-NAME PIC X(4). TDECVALX +00137 10 TRAN-FILLER PIC X(299). TDECVALX +00138 TDECVALX +00139 01 COUNTERS. TDECVALX +00140 03 EMP-QTR-TOT-EARNINGS PIC 9(7). TDECVALX +00141 03 RECS-IN PIC 9(5). TDECVALX +00142 03 RECS-OUT PIC 9(5). TDECVALX +00143 03 QTR-RECS-OUT PIC 9(5). TDECVALX +00144 03 PAGE-CTR PIC 9(5). TDECVALX +00145 03 ERROR-RECS PIC 9(5). TDECVALX +00146 03 WS-RUN-DATE. TDECVALX +00147 05 RUN-YR PIC 99. TDECVALX +00148 05 RUN-MO PIC 99. TDECVALX +00149 05 RUN-DA PIC 99. TDECVALX +00150 TDECVALX +00151 03 ZERO-WAGE-CNT PIC 9(5). TDECVALX +00152 03 EXCEPTION-CNT PIC 9(5). TDECVALX +00153 03 WS-ZERO-WAGE-NO PIC 9(5). TDECVALX +00154 TDECVALX +00155 TDECVALX +00156 01 LINE-CTR PIC 9(5) VALUE 56. TDECVALX +00157 01 EOF PIC X. TDECVALX +00158 TDECVALX +00159 01 SELECT-CARD. TDECVALX +00160 03 PGM-NAME PIC X(09) VALUE '**TDECVAL'. TDECVALX +00161 03 FIL PIC XX. TDECVALX +00162 03 SELECT-QUARTER PIC 9(5). TDECVALX +00163 03 FIL PIC X. TDECVALX +00164 03 SELECT-QUARTER1 PIC 9(5). TDECVALX +00165 03 FIL PIC X(73). TDECVALX +00166 TDECVALX +00167 01 HD1. TDECVALX +00168 03 FIL PIC X(5) VALUE SPACES. TDECVALX +00169 03 FIL PIC X(8) VALUE 'TDECVAL1'. TDECVALX +00170 03 FIL PIC X(31) VALUE SPACES. TDECVALX +00171 03 FIL PIC X(42) VALUE TDECVALX +00172 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. TDECVALX +00173 03 FIL PIC X(35) VALUE SPACES. TDECVALX +00174 03 FIL PIC X(5) VALUE 'PAGE:'. TDECVALX +00175 03 PAGE-CTR-PRT PIC ZZ,ZZ9. TDECVALX +00176 TDECVALX +00177 01 HD2. TDECVALX +00178 03 FIL PIC X(49) VALUE SPACES. TDECVALX +00179 03 FIL PIC X(39) VALUE TDECVALX +00180 'DOES UI WAGE RECORD EDIT REPORT'. TDECVALX +00181 TDECVALX +00182 01 HD3. TDECVALX +00183 03 FIL PIC X(55) VALUE SPACES. TDECVALX +00184 03 FIL PIC X(10) VALUE 'RUN DATE: '. TDECVALX +00185 03 RUN-DATE. TDECVALX +00186 05 RUN-MO1 PIC 99. TDECVALX +00187 05 FIL PIC X VALUE '/'. TDECVALX +00188 05 RUN-DA1 PIC 99. TDECVALX +00189 05 FIL PIC X VALUE '/'. TDECVALX +00190 05 RUN-CEN PIC 99. TDECVALX +00191 05 RUN-YR1 PIC 99. TDECVALX +00192 TDECVALX +00193 01 HD4. TDECVALX +00194 03 FIL PIC X(5) VALUE SPACES. TDECVALX +00195 03 FIL PIC X(3) VALUE 'SSN'. TDECVALX +00196 03 FIL PIC X(7) VALUE SPACES. TDECVALX +00197 03 FIL PIC X(12) VALUE 'DATE ENTERED'. TDECVALX +00198 03 FIL PIC X(02) VALUE SPACES. TDECVALX +00199 03 FIL PIC X(13) VALUE 'EMPLOYEE NAME'. TDECVALX +00200 03 FIL PIC X(2) VALUE SPACES. TDECVALX +00201 03 FIL PIC X(7) VALUE 'QUARTER'. TDECVALX +00202 03 FIL PIC X(6) VALUE SPACES. TDECVALX +00203 03 FIL PIC X(8) VALUE 'EARNINGS'. TDECVALX +00204 03 FIL PIC X(6) VALUE SPACES. TDECVALX +00205 03 FIL PIC X(14) VALUE 'ACCOUNT NUMBER'. TDECVALX +00206 03 FIL PIC X(2) VALUE SPACES. TDECVALX +00207 03 FIL PIC X(11) VALUE ' TDEC NAME'. TDECVALX +00208 03 FIL PIC X(05) VALUE SPACES. TDECVALX +00209 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'. TDECVALX +00210 TDECVALX +00211 01 DTL1. TDECVALX +00212 03 FIL PIC X(5) VALUE SPACES. TDECVALX +00213 03 SSN-PRT PIC X(9). TDECVALX +00214 03 FIL PIC X(04) VALUE SPACES. TDECVALX +00215 03 DATE-ENTERED-PRT PIC X(06). TDECVALX +00216 03 FIL PIC X(10) VALUE SPACES. TDECVALX +00217 03 EMPEE-NAME PIC X(3). TDECVALX +00218 03 FIL PIC X(08) VALUE SPACES. TDECVALX +00219 03 QTR-PRT PIC X(5). TDECVALX +00220 03 FIL PIC X(08) VALUE SPACES. TDECVALX +00221 03 EARNINGS-PRT PIC X(7). TDECVALX +00222 03 FIL PIC X(10) VALUE SPACES. TDECVALX +00223 03 ACCT-NUM-PRT PIC X(6). TDECVALX +00224 03 FIL PIC X(10) VALUE SPACES. TDECVALX +00225 03 EMPOR-PRT PIC X(6). TDECVALX +00226 03 FIL PIC X(06) VALUE SPACES. TDECVALX +00227 03 MESSAGE-AREA PIC X(30) VALUE SPACES. TDECVALX +00228 TDECVALX +00229 01 TOT1. TDECVALX +00230 03 FIL PIC X(2) VALUE SPACES. TDECVALX +00231 03 FIL PIC X(21) VALUE 'TOTAL WAGE RECS READ:'. TDECVALX +00232 03 WAGE-CNT-PRT PIC ZZZ,ZZ9. TDECVALX +00233 03 FIL PIC X(6) VALUE SPACES. TDECVALX +00234 03 FIL PIC X(24) VALUE 'TOTAL WAGE RECS WRITTEN:'.TDECVALX +00235 03 WAGE-OUT-PRT PIC ZZZ,ZZ9. TDECVALX +00236 03 FIL PIC X(6) VALUE SPACES. TDECVALX +00237 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. TDECVALX +00238 03 ERRORS-PRT PIC ZZ,ZZ9. TDECVALX +00239 03 FIL PIC X(6) VALUE SPACES. TDECVALX +00240 03 FIL PIC X(20) VALUE 'TOTAL ZERO WAGR REC:'. TDECVALX +00241 03 ZERO-WAGE-PRT PIC ZZ,ZZ9. TDECVALX +00242 TDECVALX +00243 01 BLANK-LINE PIC X(133) VALUE SPACES. TDECVALX +00244 TDECVALX +00245 01 EMPLOYER-STATUS-RECORD-DATA. TDECVALX +00246 ++INCLUDE ESPTAXAD TDECVALX +00247 ++INCLUDE ESPSCSWA TDECVALX +00248 ++INCLUDE WSDATES TDECVALX +00249 TDECVALX +00250 LINKAGE SECTION. TDECVALX +00251 01 PARM-AREA. TDECVALX +00252 05 PARM-LENGTH PIC S9(04) COMP. TDECVALX +00253 05 PARM-LOG-NO PIC 9(06). TDECVALX +00254 05 FILLER PIC X(01). TDECVALX +00255 05 PARM-ZERO-WAGE-NO PIC 9(05). TDECVALX +00256 TDECVALX +00257 PROCEDURE DIVISION USING PARM-AREA. TDECVALX +00258 TDECVALX +00259 ** READY TRACE. TDECVALX +00260 ACCEPT SELECT-CARD. TDECVALX +00261 ++INCLUDE CODEDATE TDECVALX +00262 MOVE WS-SYSTEM-DATE TO WS-RUN-DATE. TDECVALX +00263 MOVE RUN-DA TO RUN-DA1 TDECVALX +00264 MOVE RUN-MO TO RUN-MO1 TDECVALX +00265 MOVE 20 TO RUN-CEN TDECVALX +00266 MOVE RUN-YR TO RUN-YR1 TDECVALX +00267 TDECVALX +00268 OPEN INPUT TDECFILE TDECVALX +00269 OUTPUT LISTOUT TDECOUT. TDECVALX +00270 TDECVALX +00271 MOVE ZEROS TO COUNTERS. TDECVALX +00272 TDECVALX +00273 PERFORM INIT0100-EDIT-PARMS THRU INIT0100-EXIT. TDECVALX +00274 TDECVALX +00275 MOVE 'Y' TO CSV-TAX-FILE-FLAG. TDECVALX +00276 PERFORM 100-READ-WAGE THRU 100-RW-EXIT TDECVALX +00277 UNTIL TDECVALX +00278 EOF = 1. TDECVALX +00279 TDECVALX +00280 INIT0100-EDIT-PARMS. TDECVALX +00281 TDECVALX +00282 IF PARM-LOG-NO NOT NUMERIC TDECVALX +00283 MOVE 'PARM-LOG-NO IS NOT NUMERIC ' TO ABEND-MSG TDECVALX +00284 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. TDECVALX +00285 TDECVALX +00286 DISPLAY 'PARM-LOG-NO = ' PARM-LOG-NO. TDECVALX +00287 TDECVALX +00288 IF PARM-ZERO-WAGE-NO NOT NUMERIC TDECVALX +00289 MOVE 'PARM-ZERO-WAGE-NO IS NOT NUMERIC ' TO ABEND-MSG TDECVALX +00290 PERFORM SERV9999-ABEND THRU SERV9999-EXIT. TDECVALX +00291 TDECVALX +00292 MOVE PARM-ZERO-WAGE-NO TO WS-ZERO-WAGE-NO. TDECVALX +00293 DISPLAY 'PARM-ZERO-WAGE-NO = ' WS-ZERO-WAGE-NO. TDECVALX +00294 TDECVALX +00295 SET L200-CMD-INIT-88 TO TRUE. TDECVALX +00296 MOVE PARM-LOG-NO TO L200-LOG-NO-SFX. TDECVALX +00297 MOVE WRK-MOD-NAME TO L200-PROG-NAME. TDECVALX +00298 CALL 'DESBD200' USING L200-LINK-AREA C202-MSG-TABLE. TDECVALX +00299 MOVE L200-LOG-NO TO WRK-LOG-NO. TDECVALX +00300 TDECVALX +00301 DISPLAY 'WRK-LOG-NO = ' WRK-LOG-NO. TDECVALX +00302 TDECVALX +00303 INIT0100-EXIT. TDECVALX +00304 EXIT. TDECVALX +00305 TDECVALX +00306 100-READ-WAGE. TDECVALX +00307 READ TDECFILE INTO ESP-TRANSACTION-AREA TDECVALX +00308 AT END TDECVALX +00309 MOVE 1 TO EOF TDECVALX +00310 TDECVALX +00311 IF WS-EMP-TOT-CNT > ZERO TDECVALX +00312 MOVE WS-CURR-EMP TO L200-EMP-NO TDECVALX +00313 MOVE WS-QUARTER-YR-QTR TO L200-REPORTING-DATE TDECVALX +00314 MOVE WS-EMP-TOT-CNT TO L200-TOT-CNT TDECVALX +00315 MOVE WS-EMP-SUCCESS-CNT TO L200-SUCCESS-CNT TDECVALX +00316 ELSE TDECVALX +00317 MOVE ZERO TO L200-EMP-NO TDECVALX +00318 L200-TOT-CNT TDECVALX +00319 L200-SUCCESS-CNT TDECVALX +00320 END-IF TDECVALX +00321 TDECVALX +00322 SET L200-CMD-TERMINATE-88 TO TRUE TDECVALX +00323 PERFORM SERV0200-UPD-LOG THRU SERV0200-EXIT. TDECVALX +00324 TDECVALX +00325 IF EOF = 1 TDECVALX +00326 GO TO 999-CLOSE-FILES. TDECVALX +00327 TDECVALX +00328 **TO BYPASS WAGE REPORTS PRINTED FROM THE OLD TAX M/F TDECVALX +00329 TDECVALX +00330 IF TRAN-QUARTER-YR-QTR < 19994 TDECVALX +00331 ** ADD 1 TO RECS-IN TDECVALX +00332 GO TO 100-READ-WAGE. TDECVALX +00333 TDECVALX +00334 ADD 1 TO RECS-IN. TDECVALX +00335 TDECVALX +00336 INSPECT TRAN-QUARTER-EARNINGS REPLACING TDECVALX +00337 LEADING ' ' BY ZERO. TDECVALX +00338 TDECVALX +00339 IF TRAN-QUARTER-EARNINGS = ZEROS TDECVALX +00340 IF WS-ZERO-WAGE-NO = EXCEPTION-CNT TDECVALX +00341 ADD 1 TO ZERO-WAGE-CNT TDECVALX +00342 GO TO 100-READ-WAGE TDECVALX +00343 ELSE TDECVALX +00344 MOVE 'GROSS-WAGE EQUAL ZEROS' TO MESSAGE-AREA TDECVALX +00345 ADD 1 TO ZERO-WAGE-CNT TDECVALX +00346 ADD 1 TO EXCEPTION-CNT TDECVALX +00347 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00348 SET EMSG106-SELECTED-YES TO TRUE TDECVALX +00349 MOVE ZERO TO ERROR-SW TDECVALX +00350 GO TO 100-RW-EXIT. TDECVALX +00351 TDECVALX +00352 MOVE TRAN-ACCOUNT TO WS-WAGE-ACCOUNT. TDECVALX +00353 TDECVALX +00354 IF WS-WAGE-ACCOUNT NOT NUMERIC TDECVALX +00355 MOVE ZEROS TO WS-WAGE-ACCOUNT TDECVALX +00356 ELSE TDECVALX +00357 IF WS-CURR-EMP = ZERO TDECVALX +00358 MOVE WS-WAGE-ACCOUNT TO WS-CURR-EMP TDECVALX +00359 MOVE +1 TO WS-EMP-TOT-CNT TDECVALX +00360 MOVE ZERO TO WS-EMP-SUCCESS-CNT TDECVALX +00361 ELSE TDECVALX +00362 IF WS-WAGE-ACCOUNT NOT = WS-CURR-EMP TDECVALX +00363 SET L200-CMD-EMP-COMPLETE-88 TO TRUE TDECVALX +00364 MOVE WS-CURR-EMP TO L200-EMP-NO TDECVALX +00365 MOVE WS-QUARTER-YR-QTR TO L200-REPORTING-DATE TDECVALX +00366 MOVE WS-EMP-TOT-CNT TO L200-TOT-CNT TDECVALX +00367 MOVE WS-EMP-SUCCESS-CNT TO L200-SUCCESS-CNT TDECVALX +00368 PERFORM SERV0200-UPD-LOG THRU SERV0200-EXIT TDECVALX +00369 MOVE +1 TO WS-EMP-TOT-CNT TDECVALX +00370 MOVE ZERO TO WS-EMP-SUCCESS-CNT TDECVALX +00371 MOVE WS-WAGE-ACCOUNT TO WS-CURR-EMP TDECVALX +00372 ELSE TDECVALX +00373 ADD +1 TO WS-EMP-TOT-CNT TDECVALX +00374 END-IF TDECVALX +00375 END-IF TDECVALX +00376 END-IF. TDECVALX +00377 TDECVALX +00378 PERFORM 110-VALIDATE-WAGE THRU 121-VW-EXIT. TDECVALX +00379 TDECVALX +00380 IF ERROR-SW = 1 TDECVALX +00381 MOVE ZERO TO ERROR-SW TDECVALX +00382 GO TO 100-RW-EXIT TDECVALX +00383 ELSE TDECVALX +00384 MOVE ZERO TO ERROR-SW. TDECVALX +00385 TDECVALX +00386 PERFORM 220-CREATE-W4-TRAN THRU 220-CW-EXIT. TDECVALX +00387 TDECVALX +00388 100-RW-EXIT. TDECVALX +00389 EXIT. TDECVALX +00390 TDECVALX +00391 110-VALIDATE-WAGE. TDECVALX +00392 TDECVALX +00393 MOVE SPACES TO MESSAGE-AREA. TDECVALX +00394 TDECVALX +00395 111-VALIDATE-SSN. TDECVALX +00396 IF TR-SSN NOT NUMERIC TDECVALX +00397 OR (TR-SSN NOT GREATER THAN ZEROES) TDECVALX +00398 MOVE 'SSN NOT NUMERIC ' TO MESSAGE-AREA TDECVALX +00399 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00400 MOVE 1 TO ERROR-SW TDECVALX +00401 SET EMSG104-SELECTED-YES TO TRUE TDECVALX +00402 GO TO 121-VW-EXIT. TDECVALX +00403 TDECVALX +00404 112-VALIDATE-ID. TDECVALX +00405 IF TRAN-ID NOT = 'W4' TDECVALX +00406 MOVE 'TRAN-ID ERROR' TO MESSAGE-AREA TDECVALX +00407 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00408 MOVE 1 TO ERROR-SW TDECVALX +00409 SET EMSG112-SELECTED-YES TO TRUE. TDECVALX +00410 TDECVALX +00411 113-VALIDATE-DATE. TDECVALX +00412 IF TRAN-DATE-ENTERED NOT NUMERIC TDECVALX +00413 MOVE 'DATE ENTERED ERROR' TO MESSAGE-AREA TDECVALX +00414 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00415 MOVE 1 TO ERROR-SW TDECVALX +00416 SET EMSG113-SELECTED-YES TO TRUE. TDECVALX +00417 TDECVALX +00418 114-VALIDATE-TIME. TDECVALX +00419 IF TRAN-TIME-ENTERED NOT NUMERIC TDECVALX +00420 MOVE 'TIME-ENTERED ERROR' TO MESSAGE-AREA TDECVALX +00421 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00422 MOVE 1 TO ERROR-SW TDECVALX +00423 SET EMSG114-SELECTED-YES TO TRUE. TDECVALX +00424 TDECVALX +00425 115-VALIDATE-NAME. TDECVALX +00426 IF TRAN-NAME-CHECK EQUAL SPACES TDECVALX +00427 MOVE 'EMPLOYEE NAME IS SPACES' TO MESSAGE-AREA TDECVALX +00428 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00429 MOVE 1 TO ERROR-SW TDECVALX +00430 SET EMSG107-SELECTED-YES TO TRUE. TDECVALX +00431 TDECVALX +00432 116-VALIDATE-QUARTER1. TDECVALX +00433 IF TRAN-QUARTER-YR-QTR NOT NUMERIC TDECVALX +00434 MOVE 'QUARTER FIELD NOT VALID' TO MESSAGE-AREA TDECVALX +00435 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00436 MOVE 1 TO ERROR-SW TDECVALX +00437 SET EMSG101-SELECTED-YES TO TRUE TDECVALX +00438 GO TO 118-QUARTER-EARNINGS-CHECK. TDECVALX +00439 TDECVALX +00440 IF SELECT-QUARTER EQUAL 'ALL' TDECVALX +00441 GO TO 118-QUARTER-EARNINGS-CHECK. TDECVALX +00442 TDECVALX +00443 117-VALIDATE-QUARTER2. TDECVALX +00444 IF TRAN-QUARTER-YR-QTR EQUAL SELECT-QUARTER TDECVALX +00445 OR TDECVALX +00446 SELECT-QUARTER1 TDECVALX +00447 MOVE TRAN-QUARTER-YR-QTR TO WS-QUARTER-YR-QTR TDECVALX +00448 ELSE TDECVALX +00449 MOVE 'QUARTER FIELD NOT VALID' TO MESSAGE-AREA TDECVALX +00450 MOVE 1 TO ERROR-SW TDECVALX +00451 SET EMSG101-SELECTED-YES TO TRUE TDECVALX +00452 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. TDECVALX +00453 TDECVALX +00454 118-QUARTER-EARNINGS-CHECK. TDECVALX +00455 IF TRAN-QUARTER-EARNINGS NOT NUMERIC TDECVALX +00456 MOVE 'QUARTER EARNINGS NOT NUMERIC' TO MESSAGE-AREA TDECVALX +00457 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00458 MOVE 1 TO ERROR-SW TDECVALX +00459 SET EMSG105-SELECTED-YES TO TRUE TDECVALX +00460 GO TO 121-VW-EXIT. TDECVALX +00461 TDECVALX +00462 119-TRAN-ACCOUNT1. TDECVALX +00463 IF TRAN-ACCOUNT NOT NUMERIC TDECVALX +00464 MOVE 'ACCOUNT NUMBER NOT NUMERIC' TO MESSAGE-AREA TDECVALX +00465 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00466 MOVE 1 TO ERROR-SW TDECVALX +00467 SET EMSG108-SELECTED-YES TO TRUE TDECVALX +00468 * GO TO 120-TRAN-EMP-NAME. TDECVALX +00469 GO TO 121-VW-EXIT. TDECVALX +00470 TDECVALX +00471 IF TRAN-ACCOUNT EQUAL ZEROS TDECVALX +00472 MOVE 'ACCOUNT NUMBER EQUAL ZEROS' TO MESSAGE-AREA TDECVALX +00473 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00474 MOVE 1 TO ERROR-SW TDECVALX +00475 SET EMSG109-SELECTED-YES TO TRUE TDECVALX +00476 * GO TO 120-TRAN-EMP-NAME. TDECVALX +00477 GO TO 121-VW-EXIT. TDECVALX +00478 TDECVALX +00479 119-TRAN-ACCOUNT2. TDECVALX +00480 MOVE TRAN-ACCOUNT TO ETA-EMP-ACCT-NO. TDECVALX +00481 PERFORM SERV3000-ACCESS-TAX THRU SERV3000-EXIT. TDECVALX +00482 * IF NOT ETA-NO-RECORD-FOUND TDECVALX +00483 IF ETA-IO-COMPLETE TDECVALX +00484 GO TO 120-TRAN-EMP-NAME TDECVALX +00485 ELSE TDECVALX +00486 *** DISPLAY 'ACCOUNT # INVALID KEY ' EMPL-ACCT-NO TDECVALX +00487 MOVE 'ACCOUNT NUMBER NOT ON M/F ' TO MESSAGE-AREA TDECVALX +00488 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00489 MOVE 1 TO ERROR-SW TDECVALX +00490 SET EMSG109-SELECTED-YES TO TRUE TDECVALX +00491 GO TO 121-VW-EXIT. TDECVALX +00492 TDECVALX +00493 120-TRAN-EMP-NAME. TDECVALX +00494 MOVE ETA-EMP-NAME TO WS-ETA-EMP-NAME-FOUR. TDECVALX +00495 IF TRAN-EMP-NAME EQUAL SPACES TDECVALX +00496 MOVE 'EMPLOYER NAME EQUAL SPACES' TO MESSAGE-AREA TDECVALX +00497 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00498 MOVE 1 TO ERROR-SW TDECVALX +00499 SET EMSG110-SELECTED-YES TO TRUE TDECVALX +00500 GO TO 121-VW-EXIT. TDECVALX +00501 TDECVALX +00502 *** DISPLAY '2511 ALPHA-NAME' WS-ETA-EMP-NAME-FOUR TRAN-EMP-NAME.TDECVALX +00503 IF WS-ETA-EMP-NAME-FOUR = TRAN-EMP-NAME TDECVALX +00504 NEXT SENTENCE TDECVALX +00505 ELSE TDECVALX +00506 MOVE ETA-EMP-NAME TDECVALX +00507 TO MESSAGE-AREA TDECVALX +00508 *** MOVE '****' TO ASTR TDECVALX +00509 MOVE TRAN-EMP-NAME TO EMPOR-PRT TDECVALX +00510 MOVE 1 TO ERROR-SW TDECVALX +00511 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT TDECVALX +00512 SET EMSG111-SELECTED-YES TO TRUE. TDECVALX +00513 TDECVALX +00514 121-VW-EXIT. TDECVALX +00515 EXIT. TDECVALX +00516 TDECVALX +00517 125-WAGE-REPORT. TDECVALX +00518 TDECVALX +00519 MOVE TR-SSN TO SSN-PRT. TDECVALX +00520 MOVE TRAN-DATE-ENTERED TO DATE-ENTERED-PRT. TDECVALX +00521 MOVE TRAN-NAME-CHECK TO EMPEE-NAME. TDECVALX +00522 MOVE TRAN-QUARTER-EARNINGS TO EARNINGS-PRT. TDECVALX +00523 MOVE TRAN-QUARTER-YR-QTR TO QTR-PRT. TDECVALX +00524 MOVE TRAN-ACCOUNT TO ACCT-NUM-PRT. TDECVALX +00525 *** MOVE WS-ETA-EMP-NAME-FOUR TO EMPOR-PRT. TDECVALX +00526 IF LINE-CTR > 55 TDECVALX +00527 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. TDECVALX +00528 WRITE PRINT-REC FROM DTL1. TDECVALX +00529 IF TRAN-QUARTER-EARNINGS NOT = ZEROS TDECVALX +00530 ADD 1 TO ERROR-RECS. TDECVALX +00531 MOVE SPACES TO DTL1. TDECVALX +00532 ADD 1 TO LINE-CTR. TDECVALX +00533 TDECVALX +00534 125-WR-EXIT. TDECVALX +00535 EXIT. TDECVALX +00536 TDECVALX +00537 130-WAGE-HEADER. TDECVALX +00538 ADD 1 TO PAGE-CTR. TDECVALX +00539 MOVE PAGE-CTR TO PAGE-CTR-PRT. TDECVALX +00540 WRITE PRINT-REC FROM HD1 AFTER TOP-OF-PAGE. TDECVALX +00541 WRITE PRINT-REC FROM HD2. TDECVALX +00542 WRITE PRINT-REC FROM HD3. TDECVALX +00543 WRITE PRINT-REC FROM HD4. TDECVALX +00544 MOVE 4 TO LINE-CTR. TDECVALX +00545 TDECVALX +00546 130-WH-EXIT. TDECVALX +00547 EXIT. TDECVALX +00548 TDECVALX +00549 220-CREATE-W4-TRAN. TDECVALX +00550 TDECVALX +00551 ADD +1 TO WS-EMP-SUCCESS-CNT. TDECVALX +00552 TDECVALX +00553 MOVE WRK-LOG-NO TO WRK-TRAN-LOG-NO. TDECVALX +00554 MOVE ESP-TRANSACTION-AREA TO WRK-TRAN-AREA. TDECVALX +00555 TDECVALX +00556 WRITE TDECOUT-REC FROM WRK-TRANSACTION-AREA. TDECVALX +00557 ADD 1 TO QTR-RECS-OUT. TDECVALX +00558 ADD TRAN-QUARTER-EARNINGS TO EMP-QTR-TOT-EARNINGS. TDECVALX +00559 TDECVALX +00560 220-CW-EXIT. TDECVALX +00561 EXIT. TDECVALX +00562 TDECVALX +00563 ******************************************************************TDECVALX +00564 * OBTAIN YYYYQ YEAR-QUARTER INFORMATION. *TDECVALX +00565 ******************************************************************TDECVALX +00566 S004-FROM-3. TDECVALX +00567 SET L004-FROM-3 TO TRUE. TDECVALX +00568 GO TO S004-YRQ. TDECVALX +00569 TDECVALX +00570 S004-YRQ. TDECVALX +00571 CALL 'DTSBU004' USING L004-LINK-AREA. TDECVALX +00572 TDECVALX +00573 S004-EXIT. TDECVALX +00574 EXIT. TDECVALX +00575 EJECT TDECVALX +00576 TDECVALX +00577 ******************************************************************TDECVALX +00578 * CALL DESBD200 TO UPDATE MSTF LOG FILE. *TDECVALX +00579 ******************************************************************TDECVALX +00580 SERV0200-UPD-LOG. TDECVALX +00581 TDECVALX +00582 MOVE WRK-LOG-NO TO L200-LOG-NO. TDECVALX +00583 MOVE WRK-MOD-NAME TO L200-PROG-NAME. TDECVALX +00584 TDECVALX +00585 CALL 'DESBD200' USING L200-LINK-AREA C202-MSG-TABLE. TDECVALX +00586 TDECVALX +00587 SERV0200-EXIT. TDECVALX +00588 EXIT. TDECVALX +00589 TDECVALX +00590 SERV3000-ACCESS-TAX. TDECVALX +00591 MOVE CSV-TAX-FILE-FLAG TO ETA-TAX-FIRST-TIME-IND. TDECVALX +00592 CALL 'ESP925D' USING ETA-EMPLOYER-STATUS-DATA. TDECVALX +00593 MOVE ETA-TAX-FIRST-TIME-IND TO CSV-TAX-FILE-FLAG. TDECVALX +00594 SERV3000-EXIT. TDECVALX +00595 EXIT. TDECVALX +00596 TDECVALX +00597 SERV9999-ABEND. TDECVALX +00598 DISPLAY '**** TDECVAL1 ABENDING ' ABEND-MSG. TDECVALX +00599 CALL ABEND-MOD USING ABEND-CD. TDECVALX +00600 SERV9999-EXIT. TDECVALX +00601 EXIT. TDECVALX +00602 TDECVALX +00603 999-CLOSE-FILES. TDECVALX +00604 MOVE RECS-IN TO WAGE-CNT-PRT. TDECVALX +00605 MOVE QTR-RECS-OUT TO WAGE-OUT-PRT. TDECVALX +00606 MOVE ERROR-RECS TO ERRORS-PRT. TDECVALX +00607 MOVE ZERO-WAGE-CNT TO ZERO-WAGE-PRT. TDECVALX +00608 IF LINE-CTR > 52 TDECVALX +00609 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. TDECVALX +00610 WRITE PRINT-REC FROM TOT1 AFTER 2. TDECVALX +00611 CLOSE TDECFILE LISTOUT. TDECVALX +00612 CLOSE TDECOUT. TDECVALX +00613 STOP RUN. TDECVALX +00614 TDECVALX diff --git a/Batch/WGEDC090.cob b/Batch/WGEDC090.cob new file mode 100644 index 0000000..f32fa77 --- /dev/null +++ b/Batch/WGEDC090.cob @@ -0,0 +1,245 @@ +00001 IDENTIFICATION DIVISION. 08/11/11 +00002 PROGRAM-ID. WGEDC090. WGEDC090 +00003 LV017 +00004 ******************************************************************WGEDC090 +00005 * 90 BYTE RECORD FORMAT ONLY USE WAGEDC1 FOR 256 BYTE FORMAT * CL*11 +00006 * FUNCTION: *WGEDC090 +00007 * THE FUNCTION OF WAGEMDC1IS TO REFORMAT THE DC PAYROLL WGEDC090 +00008 * INTO THE DOCS SYSTEM W4 FORMAT. *WGEDC090 +00009 * WGEDC090 +00010 * 7/19/11 MODIFY PROGRAM TO INCLUDE YEARS 2011 2012 2013 ZL1 CL**3 +00011 * *WGEDC090 +00012 ******************************************************************WGEDC090 +00013 WGEDC090 +00014 ENVIRONMENT DIVISION. WGEDC090 +00015 CONFIGURATION SECTION. WGEDC090 +00016 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. WGEDC090 +00017 INPUT-OUTPUT SECTION. WGEDC090 +00018 FILE-CONTROL. WGEDC090 +00019 SELECT MAGFILE ASSIGN TO MAGFILE. WGEDC090 +00020 SELECT MAGFILEO ASSIGN TO MAGFILEO. WGEDC090 +00021 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. WGEDC090 +00022 DATA DIVISION. WGEDC090 +00023 FILE SECTION. WGEDC090 +00024 FD MAGFILE WGEDC090 +00025 RECORDING MODE IS F CL*11 +00026 DATA RECORD IS MAGREC. WGEDC090 +00027 01 MAGREC PIC X(090). CL*11 +00028 FD MAGFILEO WGEDC090 +00029 RECORDING MODE IS F WGEDC090 +00030 BLOCK CONTAINS 0 CHARACTERS WGEDC090 +00031 LABEL RECORDS ARE STANDARD WGEDC090 +00032 DATA RECORD IS MAGRECO. WGEDC090 +00033 01 MAGRECO PIC X(90). WGEDC090 +00034 FD LISTOUT WGEDC090 +00035 RECORD CONTAINS 133 CHARACTERS WGEDC090 +00036 LABEL RECORDS ARE OMITTED WGEDC090 +00037 RECORDING MODE IS F WGEDC090 +00038 DATA RECORD IS PRINT-REC. WGEDC090 +00039 01 PRINT-REC PIC X(133). WGEDC090 +00040 WORKING-STORAGE SECTION. WGEDC090 +000405 77 PAN-VALET PICTURE X(24) VALUE '017WGEDC090 08/11/11'. WGEDC090 +00041 01 WS-MAGRECO. WGEDC090 +00042 05 OUT-MONTH PIC X. WGEDC090 +00043 05 FIL PIC 9X(89). WGEDC090 +00044 01 MAGNETIC-WORK-AREA. WGEDC090 +00045 03 EXTRACT-QTR-YEAR. WGEDC090 +00046 05 EXTRACT-MONTH PIC X. WGEDC090 +00047 05 EXTRACT-YEAR PIC XX. WGEDC090 +00048 03 EXTRACT-EMPLOYER-ID PIC X(6). WGEDC090 +00049 03 EXTRACT-FIVE-ZEROS PIC 9(5). WGEDC090 +00050 03 EXTRACT-CONSTANT PIC XXX. WGEDC090 +00051 03 EXTRACT-SSN PIC 9(9). WGEDC090 +00052 03 EXTRACT-NAME-SYSTEM PIC X(5). WGEDC090 +00053 03 EXTRACT-WAGES PIC S9(7)V99. WGEDC090 +00054 03 EXTRACT-NAME PIC X(28). WGEDC090 +00055 03 EXTRACT-12 PIC X(22). CL**4 +00056 01 COUNTERS. WGEDC090 +00057 03 FIX-RECS-OUT PIC 9(9). WGEDC090 +00058 03 QTR-RECS-OUT PIC 9(9). WGEDC090 +00059 03 EMP-QTR-TOT-EARNINGS PIC 9(10)V99. WGEDC090 +00060 03 RECS-IN PIC 9(9). WGEDC090 +00061 03 RECS-OUT PIC 9(9). WGEDC090 +00062 03 PAGE-CTR PIC 9(5). WGEDC090 +00063 03 ERROR-RECS PIC 9(9). WGEDC090 +00064 03 ZEROS-WS PIC 9(9). WGEDC090 +00065 03 ERROR-SW PIC 9. WGEDC090 +00066 01 LINE-CTR PIC 9(5) VALUE 56. WGEDC090 +00067 01 EOF PIC X. WGEDC090 +00068 01 HD1. WGEDC090 +00069 03 FIL PIC X(5) VALUE SPACES. WGEDC090 +00070 03 FIL PIC X(8) VALUE 'DTSWGE01'. CL*13 +00071 03 FIL PIC X(31) VALUE SPACES. WGEDC090 +00072 03 FIL PIC X(42) VALUE WGEDC090 +00073 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. WGEDC090 +00074 03 FIL PIC X(35) VALUE SPACES. WGEDC090 +00075 03 FIL PIC X(5) VALUE 'PAGE:'. WGEDC090 +00076 03 PAGE-CTR-PRT PIC ZZ,ZZ9. WGEDC090 +00077 01 HD2. WGEDC090 +00078 03 FIL PIC X(49) VALUE SPACES. WGEDC090 +00079 03 FIL PIC X(39) VALUE WGEDC090 +00080 'DC-GOV WAGE RECORD EDIT REPORT'. CL*13 +00081 01 HD3. WGEDC090 +00082 03 FIL PIC X(57) VALUE SPACES. WGEDC090 +00083 03 FIL PIC X(9) VALUE 'RUN DATE:'. WGEDC090 +00084 03 RUN-DATE PIC X(8). WGEDC090 +00085 01 HD4. WGEDC090 +00086 03 FIL PIC X(5) VALUE SPACES. WGEDC090 +00087 03 FIL PIC X(3) VALUE 'SSN'. WGEDC090 +00088 03 FIL PIC X(7) VALUE SPACES. WGEDC090 +00089 03 FIL PIC X(12) VALUE 'DATE ENTERED'. WGEDC090 +00090 03 FIL PIC X(02) VALUE SPACES. WGEDC090 +00091 03 FIL PIC X(13) VALUE 'EMPLOYEE NAME'. WGEDC090 +00092 03 FIL PIC X(2) VALUE SPACES. WGEDC090 +00093 03 FIL PIC X(7) VALUE 'QUARTER'. WGEDC090 +00094 03 FIL PIC X(6) VALUE SPACES. WGEDC090 +00095 03 FIL PIC X(8) VALUE 'EARNINGS'. WGEDC090 +00096 03 FIL PIC X(6) VALUE SPACES. WGEDC090 +00097 03 FIL PIC X(14) VALUE 'ACCOUNT NUMBER'. WGEDC090 +00098 03 FIL PIC X(2) VALUE SPACES. WGEDC090 +00099 03 FIL PIC X(13) VALUE 'EMPLOYER NAME'. WGEDC090 +00100 03 FIL PIC X(10) VALUE SPACES. WGEDC090 +00101 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'. WGEDC090 +00102 01 DTL1. WGEDC090 +00103 03 FIL PIC X(5) VALUE SPACES. WGEDC090 +00104 03 SSN-PRT PIC X(9). WGEDC090 +00105 03 FIL PIC XX VALUE SPACES. WGEDC090 +00106 03 DATE-ENTERED-PRT PIC X(08). WGEDC090 +00107 03 FIL PIC X(10) VALUE SPACES. WGEDC090 +00108 03 EMPEE-NAME PIC X(3). WGEDC090 +00109 03 FIL PIC X(12) VALUE SPACES. WGEDC090 +00110 03 QTR-PRT. WGEDC090 +00111 05 QTR-PRT-QTR PIC X. WGEDC090 +00112 05 QTR-PRT-YR PIC 99. WGEDC090 +00113 03 FIL PIC X(9) VALUE SPACES. WGEDC090 +00114 03 EARNINGS-PRT PIC 9(9). WGEDC090 +00115 03 FIL PIC X(9) VALUE SPACES. WGEDC090 +00116 03 ACCT-NUM-PRT PIC X(6). WGEDC090 +00117 03 FIL PIC X(9) VALUE SPACES. WGEDC090 +00118 03 EMPOR-PRT PIC X(6). WGEDC090 +00119 03 FIL PIC X(08) VALUE SPACES. WGEDC090 +00120 03 MESSAGE-AREA PIC X(30) VALUE SPACES. WGEDC090 +00121 01 TOT1. WGEDC090 +00122 03 FIL PIC X(5) VALUE SPACES. WGEDC090 +00123 03 FIL PIC X(19) VALUE 'TOTAL WAGE RECORDS:'. WGEDC090 +00124 03 WAGE-CNT-PRT PIC ZZZ,ZZZ,ZZ9. WGEDC090 +00125 03 FIL PIC X(5) VALUE SPACES. WGEDC090 +00126 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. WGEDC090 +00127 03 ERRORS-PRT PIC ZZZ,ZZ9. WGEDC090 +00128 03 FIL PIC X(5) VALUE SPACES. WGEDC090 +00129 03 FIL PIC X(20) VALUE 'TOTAL WAGE EARNINGS:'. WGEDC090 +00130 03 TOT-EARNINGS-PRT PIC Z,ZZZ,ZZZ,999.99. WGEDC090 +00131 01 BLANK-LINE PIC X(133) VALUE SPACES. WGEDC090 +00132 PROCEDURE DIVISION. WGEDC090 +00133 OPEN INPUT MAGFILE. WGEDC090 +00134 OPEN OUTPUT LISTOUT MAGFILEO. WGEDC090 +00135 MOVE ZEROS TO COUNTERS. WGEDC090 +00136 PERFORM 100-READ-WAGE THRU 100-RW-EXIT WGEDC090 +00137 UNTIL EOF = 1. CL*13 +00138 WGEDC090 +00139 IF EOF = 1 WGEDC090 +00140 GO TO 999-CLOSE-FILES. WGEDC090 +00141 GOBACK. CL*13 +00142 100-READ-WAGE. WGEDC090 +00143 READ MAGFILE INTO MAGNETIC-WORK-AREA WGEDC090 +00144 AT END WGEDC090 +00145 MOVE 1 TO EOF CL*13 +00146 GO TO 100-RW-EXIT. WGEDC090 +00147 WGEDC090 +00148 IF EXTRACT-WAGES = ZEROS WGEDC090 +00149 DISPLAY '2272 ZEROS WAGES ' EXTRACT-SSN CL*17 +00150 GO TO 100-READ-WAGE. WGEDC090 +00151 WGEDC090 +00152 ADD 1 TO RECS-OUT. WGEDC090 +00153 MOVE MAGREC TO WS-MAGRECO. CL*14 +00154 PERFORM 110-VALIDATE-WAGE THRU 121-VW-EXIT. WGEDC090 +00155 IF ERROR-SW = 1 WGEDC090 +00156 MOVE ZERO TO ERROR-SW WGEDC090 +00157 GO TO 100-RW-EXIT. CL*14 +00158 CL*14 +00159 MOVE ZERO TO ERROR-SW. WGEDC090 +00160 WRITE MAGRECO FROM WS-MAGRECO. CL*15 +00161 ADD 1 TO FIX-RECS-OUT. CL*15 +00162 CL*15 +00163 100-RW-EXIT. WGEDC090 +00164 EXIT. WGEDC090 +00165 110-VALIDATE-WAGE. WGEDC090 +00166 MOVE SPACES TO MESSAGE-AREA. WGEDC090 +00167 111-VALIDATE-QUARTER-CODE. WGEDC090 +00168 WGEDC090 +00169 IF EXTRACT-MONTH EQUAL 'D' CL*14 +00170 MOVE 4 TO OUT-MONTH CL*16 +00171 ELSE CL*14 +00172 IF EXTRACT-MONTH EQUAL 'S' CL*14 +00173 MOVE 3 TO OUT-MONTH CL*16 +00174 ELSE CL*14 +00175 IF EXTRACT-MONTH EQUAL 'J' CL*14 +00176 MOVE 2 TO OUT-MONTH CL*16 +00177 ELSE CL*14 +00178 IF EXTRACT-MONTH EQUAL 'M' CL*14 +00179 MOVE 1 TO OUT-MONTH CL*14 +00180 ELSE CL*14 +00181 MOVE 'MONTH NE SJMD ' TO MESSAGE-AREA CL*14 +00182 MOVE 1 TO ERROR-SW CL*14 +00183 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*14 +00184 CL*14 +00185 112-VALIDATE-YEAR. WGEDC090 +00186 IF EXTRACT-YEAR NOT NUMERIC WGEDC090 +00187 MOVE 'MAG YEAR NOT NUMERIC ' TO MESSAGE-AREA WGEDC090 +00188 MOVE 1 TO ERROR-SW WGEDC090 +00189 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*13 +00190 114-VALIDATE-SSN. WGEDC090 +00191 IF EXTRACT-SSN NOT NUMERIC WGEDC090 +00192 MOVE 'SSN NOT NUMERIC ' TO MESSAGE-AREA WGEDC090 +00193 MOVE 1 TO ERROR-SW WGEDC090 +00194 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. WGEDC090 +00195 118-QUARTER-EARNINGS. WGEDC090 +00196 IF EXTRACT-WAGES NOT NUMERIC WGEDC090 +00197 MOVE 'QUARTER EARNINGS NOT NUMERIC' TO MESSAGE-AREA WGEDC090 +00198 MOVE 1 TO ERROR-SW WGEDC090 +00199 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. WGEDC090 +00200 119-EMPLOYEE-NAME. WGEDC090 +00201 IF EXTRACT-NAME = SPACES WGEDC090 +00202 MOVE 'EMPLOYEE-NAME EQUAL SPACES' TO MESSAGE-AREA WGEDC090 +00203 MOVE 1 TO ERROR-SW WGEDC090 +00204 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. WGEDC090 +00205 120-VALIDATE-EMPLOYER-ACCOUNT. WGEDC090 +00206 IF EXTRACT-EMPLOYER-ID = ZEROS CL*14 +00207 MOVE 'EMPLOYER ACCOUNT LESS THAN ZERO' TO MESSAGE-AREA WGEDC090 +00208 MOVE 1 TO ERROR-SW WGEDC090 +00209 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*13 +00210 121-VW-EXIT. WGEDC090 +00211 EXIT. WGEDC090 +00212 125-WAGE-REPORT. WGEDC090 +00213 ADD 1 TO ERROR-RECS. WGEDC090 +00214 MOVE EXTRACT-SSN TO SSN-PRT. WGEDC090 +00215 MOVE EXTRACT-NAME TO EMPEE-NAME. WGEDC090 +00216 MOVE EXTRACT-WAGES TO EARNINGS-PRT. WGEDC090 +00217 MOVE EXTRACT-MONTH TO QTR-PRT-QTR. WGEDC090 +00218 MOVE EXTRACT-YEAR TO QTR-PRT-YR. WGEDC090 +00219 MOVE EXTRACT-EMPLOYER-ID TO ACCT-NUM-PRT. WGEDC090 +00220 IF LINE-CTR > 55 WGEDC090 +00221 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. WGEDC090 +00222 WRITE PRINT-REC FROM DTL1. WGEDC090 +00223 ADD 1 TO LINE-CTR. WGEDC090 +00224 125-WR-EXIT. WGEDC090 +00225 EXIT. WGEDC090 +00226 130-WAGE-HEADER. WGEDC090 +00227 ADD 1 TO PAGE-CTR. WGEDC090 +00228 MOVE PAGE-CTR TO PAGE-CTR-PRT. WGEDC090 +00229 WRITE PRINT-REC FROM HD1 AFTER TOP-OF-PAGE. WGEDC090 +00230 WRITE PRINT-REC FROM HD2. WGEDC090 +00231 WRITE PRINT-REC FROM HD3. WGEDC090 +00232 WRITE PRINT-REC FROM HD4. WGEDC090 +00233 MOVE 4 TO LINE-CTR. WGEDC090 +00234 130-WH-EXIT. WGEDC090 +00235 EXIT. WGEDC090 +00236 999-CLOSE-FILES. WGEDC090 +00237 DISPLAY '3710 999-CLOSE ' WGEDC090 +00238 MOVE RECS-OUT TO WAGE-CNT-PRT. WGEDC090 +00239 MOVE EMP-QTR-TOT-EARNINGS TO TOT-EARNINGS-PRT. WGEDC090 +00240 MOVE ERROR-RECS TO ERRORS-PRT. WGEDC090 +00241 WRITE PRINT-REC FROM TOT1 AFTER 2. WGEDC090 +00242 CLOSE MAGFILE LISTOUT MAGFILEO. WGEDC090 +00243 STOP RUN. WGEDC090 +00244 EJECT WGEDC090 diff --git a/CICS/DTSCS18.cob b/CICS/DTSCS18.cob index edfd040..c489c0b 100644 --- a/CICS/DTSCS18.cob +++ b/CICS/DTSCS18.cob @@ -1305,11 +1305,14 @@ 01304 SKIP1 DTSCS18 01305 IF CURSOR-SET-GOTO DTSCS18 01306 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS18 +RCODE MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-GOTO-A 01307 ELSE DTSCS18 01308 IF CURSOR-SET-LINE-NUMBER DTSCS18 01309 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L DTSCS18 +RCODE MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-LINE-NUMBER-A 01310 ELSE DTSCS18 -01311 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS18 +01311 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS18 +RCODE MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A. 01312 SKIP1 DTSCS18 01313 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS18 01314 SKIP1 DTSCS18 diff --git a/CICS/DTSCS66.cob b/CICS/DTSCS66.cob index 792996b..d2808be 100644 --- a/CICS/DTSCS66.cob +++ b/CICS/DTSCS66.cob @@ -517,6 +517,15 @@ 00516 GO TO P1000-EXIT. DTSCS66 00517 DTSCS66 00518 *----------------------------------------------------- DTSCS66 +RCODE * TO FIX THE RAINCODE BEAHVIOR: MAP-LINE-NUMBER IS DTSCS66 +RCODE * TREATED AS A SIMPLE STRING FIELD DTSCS66 +RCODE *----------------------------------------------------- DTSCS66 +RCODE IF (MAP-LINE-NUMBER = LOW-VALUES OR SPACES) DTSCS66 +RCODE NEXT SENTENCE DTSCS66 +RCODE ELSE DTSCS66 +RCODE COMPUTE MAP-LINE-NUMBER-N = DTSCS66 +RCODE FUNCTION NUMVAL(MAP-LINE-NUMBER). DTSCS66 +RCODE *----------------------------------------------------- DTSCS66 00519 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS66 00520 * REQUESTED SCREEN TYPE DTSCS66 00521 *----------------------------------------------------- DTSCS66 diff --git a/CICS/DTSCS67.cob b/CICS/DTSCS67.cob index 2fa2e8b..00a56e2 100644 --- a/CICS/DTSCS67.cob +++ b/CICS/DTSCS67.cob @@ -534,6 +534,15 @@ 00533 SET REQ-JUMP TO TRUE DTSCS67 00534 GO TO P1000-EXIT. DTSCS67 00535 DTSCS67 +RCODE *----------------------------------------------------- DTSCS67 +RCODE * TO FIX THE RAINCODE BEAHVIOR: MAP-LINE-NUMBER IS DTSCS67 +RCODE * TREATED AS A SIMPLE STRING FIELD DTSCS67 +RCODE *----------------------------------------------------- DTSCS67 +RCODE IF (MAP-LINE-NUMBER = LOW-VALUES OR SPACES) DTSCS67 +RCODE NEXT SENTENCE DTSCS67 +RCODE ELSE DTSCS67 +RCODE COMPUTE MAP-LINE-NUMBER-N = DTSCS67 +RCODE FUNCTION NUMVAL(MAP-LINE-NUMBER). DTSCS67 00536 *----------------------------------------------------- DTSCS67 00537 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS67 00538 * REQUESTED SCREEN TYPE DTSCS67 diff --git a/CICS/DTSCU072.cob b/CICS/DTSCU072.cob index 3843be3..6ff4aab 100644 --- a/CICS/DTSCU072.cob +++ b/CICS/DTSCU072.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 05/15/17 +00001 IDENTIFICATION DIVISION. 09/12/25 00002 PROGRAM-ID. DTSCU072. DTSCU072 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV025 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV011 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU072 00005 DATE-COMPILED. DTSCU072 00006 SKIP3 DTSCU072 @@ -63,635 +63,655 @@ 00063 * 04/02/2002 RECOMPILED FOR NEW VERSION(R730) OF FINALIST. DTSCU072 00064 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSCU072 00065 * DTSCU072 -00066 * 99/99/9999 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU072 -00067 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU072 -00068 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU072 -00069 * DTSCU072 -00070 * DTSCU072 -00071 * DESCRIPTION: DTSCU072 +00066 * 05/15/2017 UNCOMMENTED CODE FOR CHECKING CASS CERTIFICATION CL**2 +00067 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 CL**2 +00068 * CL**2 +00069 * 99/99/9999 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU072 +00070 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU072 +00071 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU072 00072 * DTSCU072 -00073 * EDIT AN ADDRESS. DTSCU072 -00074 * DTSCU072 +00073 * DTSCU072 +00074 * DESCRIPTION: DTSCU072 00075 * DTSCU072 -00076 * SEE ISSUE STATEMENT 12, ISSUE STATEMENT 13, AND DTSCU072 -00077 * THE 'FINALIST' MANUAL. DTSCU072 +00076 * EDIT AN ADDRESS. DTSCU072 +00077 * DTSCU072 00078 * DTSCU072 -00079 * SEE THE COMMENTS IN THE CODE. DTSCU072 -00080 * DTSCU072 +00079 * SEE ISSUE STATEMENT 12, ISSUE STATEMENT 13, AND DTSCU072 +00080 * THE 'FINALIST' MANUAL. DTSCU072 00081 * DTSCU072 -00082 * 04/20/94 THE LOGIC PERMITTING A BLANK DELIVERY LINE DTSCU072 -00083 * (IF L072-NAME IS A VALID FIRM NAME) IS DTSCU072 -00084 * SUPPRESSED. DTSCU072 -00085 * DTSCU072 -00086 * STATUS UNIT WORKERS INDICATE THEY "NEVER" DTSCU072 -00087 * ENCOUNTER A BLANK DELIVERY LINE. DTSCU072 +00082 * SEE THE COMMENTS IN THE CODE. DTSCU072 +00083 * DTSCU072 +00084 * DTSCU072 +00085 * 04/20/94 THE LOGIC PERMITTING A BLANK DELIVERY LINE DTSCU072 +00086 * (IF L072-NAME IS A VALID FIRM NAME) IS DTSCU072 +00087 * SUPPRESSED. DTSCU072 00088 * DTSCU072 -00089 ***** DTSCU072 -00090 SKIP3 DTSCU072 -00091 ENVIRONMENT DIVISION. DTSCU072 -00092 SKIP3 DTSCU072 -00093 DATA DIVISION. DTSCU072 -00094 SKIP3 DTSCU072 -00095 WORKING-STORAGE SECTION. DTSCU072 -000955 77 PAN-VALET PICTURE X(24) VALUE '025DTSCU072 05/15/17'. DTSCU072 -00096 SKIP3 DTSCU072 -00097 01 WRK-AREA. DTSCU072 -00098 05 WRK-ABEND-CODE PIC X(04) VALUE 'U072'. DTSCU072 -00099 DTSCU072 -00100 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU072 -00101 SKIP3 DTSCU072 -00102 01 FC-FINALIST-RETURN-CODES. DTSCU072 -00103 05 FC-REASON-CODES. DTSCU072 -00104 10 FC-REASON-CODE1 PIC 9(01). DTSCU072 -00105 88 FC-ZIP-VERIF-88 VALUE 0 . DTSCU072 -00106 88 FC-ZIP-GUESSED-88 VALUE 4 . DTSCU072 -00107 88 FC-ZIP-FIXED-88 VALUE 5 6 7 . DTSCU072 -00108 88 FC-ZIP-RETURNED-88 VALUE 1 . DTSCU072 -00109 88 FC-ZIP-BYPASSED-88 VALUE 2 3 . DTSCU072 -00110 88 FC-ZIP-BAD-88 VALUE 9. DTSCU072 -00111 10 FC-REASON-CODE2 PIC 9(01). DTSCU072 -00112 88 FC-CITY-VERIF-88 VALUE 0 . DTSCU072 -00113 88 FC-CITY-VANITY-88 VALUE 7 . DTSCU072 -00114 88 FC-CITY-STANDARD-88 VALUE 2 3 . DTSCU072 -00115 88 FC-CITY-GUESSED-88 VALUE 6 . DTSCU072 -00116 88 FC-CITY-FIXED-88 VALUE 5 . DTSCU072 -00117 88 FC-CITY-RETURNED-88 VALUE 1 . DTSCU072 -00118 88 FC-CITY-BYPASSED-88 VALUE 4 . DTSCU072 -00119 88 FC-CITY-BAD-88 VALUE 9. DTSCU072 -00120 10 FC-REASON-CODE3-CARRIER-ROUTE PIC 9(01). DTSCU072 -00121 10 FC-REASON-CODE4-ZIP-PLUS-4 PIC 9(01). DTSCU072 -00122 10 FC-REASON-CODE5 PIC 9(01). DTSCU072 -00123 88 FC-STREET-VERIF-88 VALUE 0 . DTSCU072 -00124 88 FC-STREET-STANDARD-88 VALUE 1 . DTSCU072 -00125 88 FC-STREET-GUESSED-88 VALUE 2 3 4 6 . DTSCU072 -00126 88 FC-STREET-BAD-88 VALUE 9. DTSCU072 -00127 10 FC-REASON-CODE6 PIC 9(01). DTSCU072 -00128 88 FC-RANGE-VERIF-88 VALUE 0 . DTSCU072 -00129 88 FC-RANGE-GUESSED-88 VALUE 4 . DTSCU072 -00130 88 FC-RANGE-BAD-88 VALUE 1 2 3 9. DTSCU072 -00131 10 FC-REASON-CODE7 PIC 9(01). DTSCU072 -00132 88 FC-SUFDIR-VERIF-88 VALUE 0 . DTSCU072 -00133 88 FC-SUFDIR-MULTI-88 VALUE 4 . DTSCU072 -00134 88 FC-SUFDIR-FIXED-88 VALUE 1 2 3 . DTSCU072 -00135 88 FC-SUFDIR-BAD-88 VALUE 9. DTSCU072 -00136 05 FC-ADDRESS-INFO-CODES. DTSCU072 -00137 10 FC-INFO-CODE1 PIC 9(01). DTSCU072 -00138 10 FC-INFO-CODE2 PIC 9(01). DTSCU072 -00139 10 FC-INFO-CODE3 PIC 9(01). DTSCU072 -00140 10 FC-INFO-CODE4 PIC 9(01). DTSCU072 -00141 88 FC-BOTH-ADDR-BAD-88 VALUE 9. DTSCU072 -00142 10 FC-INFO-CODE5 PIC 9(01). DTSCU072 -00143 10 FC-INFO-CODE678 PIC 9(03). DTSCU072 -00144 SKIP3 DTSCU072 -00145 01 MSG-AREAS. DTSCU072 -00146 05 MSG-E081-AREA. DTSCU072 -00147 10 MSG-E081-MSG-ID PIC X(04) VALUE 'E081'.DTSCU072 -00148 10 MSG-E081-MSG-TXT. DTSCU072 -00149 15 FILLER PIC X(25) DTSCU072 -00150 VALUE 'FINALIST NOT AVAILABLE'. DTSCU072 -00151 15 MSG-E081-CAERRMOD PIC X(08). DTSCU072 -00152 15 FILLER PIC X(02) VALUE SPACES.DTSCU072 -00153 15 MSG-E081-CAERRSRC PIC X(08). DTSCU072 -00154 15 FILLER PIC X(02) VALUE SPACES.DTSCU072 -00155 15 MSG-E081-CAERRDSC PIC X(09). DTSCU072 -00156 15 FILLER PIC X(06) VALUE SPACES.DTSCU072 -00157 05 MSG-E082-AREA. DTSCU072 -00158 10 FILLER PIC X(21) VALUE 'E082FINALIST RESULT: '.DTSCU072 -00159 10 FILLER PIC X(43) DTSCU072 -00160 VALUE 'UNABLE TO DETERMINE ZIP PLUS FOUR'. DTSCU072 -00161 05 MSG-E083-AREA. DTSCU072 -00162 10 FILLER PIC X(21) VALUE 'E083FINALIST RESULT: '.DTSCU072 +00089 * STATUS UNIT WORKERS INDICATE THEY "NEVER" DTSCU072 +00090 * ENCOUNTER A BLANK DELIVERY LINE. DTSCU072 +00091 * DTSCU072 +00092 ***** DTSCU072 +00093 SKIP3 DTSCU072 +00094 ENVIRONMENT DIVISION. DTSCU072 +00095 SKIP3 DTSCU072 +00096 DATA DIVISION. DTSCU072 +00097 SKIP3 DTSCU072 +00098 WORKING-STORAGE SECTION. DTSCU072 +000985 77 PAN-VALET PICTURE X(24) VALUE '011DTSCU072 09/12/25'. DTSCU072 +00099 77 PAN-VALET PICTURE X(24) VALUE '023DTSCU072 05/15/02'. DTSCU072 +00100 SKIP3 DTSCU072 +00101 01 WRK-AREA. DTSCU072 +00102 05 WRK-ABEND-CODE PIC X(04) VALUE 'U072'. DTSCU072 +00103 DTSCU072 +00104 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU072 +00105 SKIP3 DTSCU072 +00106 01 FC-FINALIST-RETURN-CODES. DTSCU072 +00107 05 FC-REASON-CODES. DTSCU072 +00108 10 FC-REASON-CODE1 PIC 9(01). DTSCU072 +00109 88 FC-ZIP-VERIF-88 VALUE 0 . DTSCU072 +00110 88 FC-ZIP-GUESSED-88 VALUE 4 . DTSCU072 +00111 88 FC-ZIP-FIXED-88 VALUE 5 6 7 . DTSCU072 +00112 88 FC-ZIP-RETURNED-88 VALUE 1 . DTSCU072 +00113 88 FC-ZIP-BYPASSED-88 VALUE 2 3 . DTSCU072 +00114 88 FC-ZIP-BAD-88 VALUE 9. DTSCU072 +00115 10 FC-REASON-CODE2 PIC 9(01). DTSCU072 +00116 88 FC-CITY-VERIF-88 VALUE 0 . DTSCU072 +00117 88 FC-CITY-VANITY-88 VALUE 7 . DTSCU072 +00118 88 FC-CITY-STANDARD-88 VALUE 2 3 . DTSCU072 +00119 88 FC-CITY-GUESSED-88 VALUE 6 . DTSCU072 +00120 88 FC-CITY-FIXED-88 VALUE 5 . DTSCU072 +00121 88 FC-CITY-RETURNED-88 VALUE 1 . DTSCU072 +00122 88 FC-CITY-BYPASSED-88 VALUE 4 . DTSCU072 +00123 88 FC-CITY-BAD-88 VALUE 9. DTSCU072 +00124 10 FC-REASON-CODE3-CARRIER-ROUTE PIC 9(01). DTSCU072 +00125 10 FC-REASON-CODE4-ZIP-PLUS-4 PIC 9(01). DTSCU072 +00126 10 FC-REASON-CODE5 PIC 9(01). DTSCU072 +00127 88 FC-STREET-VERIF-88 VALUE 0 . DTSCU072 +00128 88 FC-STREET-STANDARD-88 VALUE 1 . DTSCU072 +00129 88 FC-STREET-GUESSED-88 VALUE 2 3 4 6 . DTSCU072 +00130 88 FC-STREET-BAD-88 VALUE 9. DTSCU072 +00131 10 FC-REASON-CODE6 PIC 9(01). DTSCU072 +00132 88 FC-RANGE-VERIF-88 VALUE 0 . DTSCU072 +00133 88 FC-RANGE-GUESSED-88 VALUE 4 . DTSCU072 +00134 88 FC-RANGE-BAD-88 VALUE 1 2 3 9. DTSCU072 +00135 10 FC-REASON-CODE7 PIC 9(01). DTSCU072 +00136 88 FC-SUFDIR-VERIF-88 VALUE 0 . DTSCU072 +00137 88 FC-SUFDIR-MULTI-88 VALUE 4 . DTSCU072 +00138 88 FC-SUFDIR-FIXED-88 VALUE 1 2 3 . DTSCU072 +00139 88 FC-SUFDIR-BAD-88 VALUE 9. DTSCU072 +00140 05 FC-ADDRESS-INFO-CODES. DTSCU072 +00141 10 FC-INFO-CODE1 PIC 9(01). DTSCU072 +00142 10 FC-INFO-CODE2 PIC 9(01). DTSCU072 +00143 10 FC-INFO-CODE3 PIC 9(01). DTSCU072 +00144 10 FC-INFO-CODE4 PIC 9(01). DTSCU072 +00145 88 FC-BOTH-ADDR-BAD-88 VALUE 9. DTSCU072 +00146 10 FC-INFO-CODE5 PIC 9(01). DTSCU072 +00147 10 FC-INFO-CODE678 PIC 9(03). DTSCU072 +00148 SKIP3 DTSCU072 +00149 01 MSG-AREAS. DTSCU072 +00150 05 MSG-E081-AREA. DTSCU072 +00151 10 MSG-E081-MSG-ID PIC X(04) VALUE 'E081'.DTSCU072 +00152 10 MSG-E081-MSG-TXT. DTSCU072 +00153 15 FILLER PIC X(25) DTSCU072 +00154 VALUE 'FINALIST NOT AVAILABLE'. DTSCU072 +00155 15 MSG-E081-CAERRMOD PIC X(08). DTSCU072 +00156 15 FILLER PIC X(02) VALUE SPACES.DTSCU072 +00157 15 MSG-E081-CAERRSRC PIC X(08). DTSCU072 +00158 15 FILLER PIC X(02) VALUE SPACES.DTSCU072 +00159 15 MSG-E081-CAERRDSC PIC X(09). DTSCU072 +00160 15 FILLER PIC X(06) VALUE SPACES.DTSCU072 +00161 05 MSG-E082-AREA. DTSCU072 +00162 10 FILLER PIC X(21) VALUE 'E082FINALIST RESULT: '.DTSCU072 00163 10 FILLER PIC X(43) DTSCU072 -00164 VALUE 'ZIP CODE FAILED'. DTSCU072 -00165 05 MSG-E084-AREA. DTSCU072 -00166 10 FILLER PIC X(21) VALUE 'E084FINALIST RESULT: '.DTSCU072 +00164 VALUE 'UNABLE TO DETERMINE ZIP PLUS FOUR'. DTSCU072 +00165 05 MSG-E083-AREA. DTSCU072 +00166 10 FILLER PIC X(21) VALUE 'E083FINALIST RESULT: '.DTSCU072 00167 10 FILLER PIC X(43) DTSCU072 -00168 VALUE 'CITY FAILED'. DTSCU072 -00169 05 MSG-E085-AREA. DTSCU072 -00170 10 FILLER PIC X(21) VALUE 'E085FINALIST RESULT: '.DTSCU072 +00168 VALUE 'ZIP CODE FAILED'. DTSCU072 +00169 05 MSG-E084-AREA. DTSCU072 +00170 10 FILLER PIC X(21) VALUE 'E084FINALIST RESULT: '.DTSCU072 00171 10 FILLER PIC X(43) DTSCU072 -00172 VALUE 'STREET ADDRESS FAILED'. DTSCU072 -00173 05 MSG-E086-AREA. DTSCU072 -00174 10 FILLER PIC X(21) VALUE 'E086FINALIST RESULT: '.DTSCU072 +00172 VALUE 'CITY FAILED'. DTSCU072 +00173 05 MSG-E085-AREA. DTSCU072 +00174 10 FILLER PIC X(21) VALUE 'E085FINALIST RESULT: '.DTSCU072 00175 10 FILLER PIC X(43) DTSCU072 -00176 VALUE 'ADDRESS FAILED'. DTSCU072 -00177 05 MSG-E087-AREA. DTSCU072 -00178 10 FILLER PIC X(21) VALUE 'E087FINALIST RESULT: '.DTSCU072 +00176 VALUE 'STREET ADDRESS FAILED'. DTSCU072 +00177 05 MSG-E086-AREA. DTSCU072 +00178 10 FILLER PIC X(21) VALUE 'E086FINALIST RESULT: '.DTSCU072 00179 10 FILLER PIC X(43) DTSCU072 -00180 VALUE 'ADDRESS LINE LONGER THAN 40 CHARACTERS'. DTSCU072 -00181 *****05 MSG-E08Y-AREA. DTSCU072 -00182 ***** 10 FILLER PIC X(04) VALUE 'E08Y'. DTSCU072 -00183 ***** 10 FILLER PIC X(60) DTSCU072 -00184 ***** VALUE 'ILLEGAL NAME FORMAT FOUND ON MASTER FILE'. DTSCU072 -00185 *****05 MSG-E08Z-AREA. DTSCU072 -00186 ***** 10 FILLER PIC X(04) VALUE 'E08ZFINALIST RESULT: '.DTSCU072 -00187 ***** 10 FILLER PIC X(43) DTSCU072 -00188 ***** VALUE 'NON-FIRM NAME FOUND ON MASTER FILE'. DTSCU072 -00189 EJECT DTSCU072 -00190 01 C072-LITERALS. DTSCU072 -00191 ++INCLUDE DTSIC072 DTSCU072 -00192 SKIP3 DTSCU072 -00193 ++INCLUDE LPFNCL01 DTSCU072 -00194 EJECT DTSCU072 -00195 01 CECD-LITERALS. DTSCU072 -00196 ++INCLUDE DTSICECD DTSCU072 -00197 EJECT DTSCU072 -00198 LINKAGE SECTION. DTSCU072 -00199 SKIP3 DTSCU072 -00200 01 DFHCOMMAREA. DTSCU072 -00201 ++INCLUDE DTSIL072 DTSCU072 -00202 EJECT DTSCU072 -00203 PROCEDURE DIVISION. DTSCU072 -00204 DTSCU072 -00205 *& NOTE: THE FOLLOWING LINE DISABLES CASS CERTIFICATION. DTSCU072 -00206 *& IT MUST BE REMOVED WHEN FINALIST IS AVAILABLE. DTSCU072 -00207 DTSCU072 -00208 *& SET L072-NO-CASS-EDITS-88 TO TRUE. DTSCU072 -00209 *& DTSCU072 -00210 PERFORM I1000-INITIALIZE THROUGH I1000-EXIT. DTSCU072 +00180 VALUE 'ADDRESS FAILED'. DTSCU072 +00181 05 MSG-E087-AREA. DTSCU072 +00182 10 FILLER PIC X(21) VALUE 'E087FINALIST RESULT: '.DTSCU072 +00183 10 FILLER PIC X(43) DTSCU072 +00184 VALUE 'ADDRESS LINE LONGER THAN 40 CHARACTERS'. DTSCU072 +00185 *****05 MSG-E08Y-AREA. DTSCU072 +00186 ***** 10 FILLER PIC X(04) VALUE 'E08Y'. DTSCU072 +00187 ***** 10 FILLER PIC X(60) DTSCU072 +00188 ***** VALUE 'ILLEGAL NAME FORMAT FOUND ON MASTER FILE'. DTSCU072 +00189 *****05 MSG-E08Z-AREA. DTSCU072 +00190 ***** 10 FILLER PIC X(04) VALUE 'E08ZFINALIST RESULT: '.DTSCU072 +00191 ***** 10 FILLER PIC X(43) DTSCU072 +00192 ***** VALUE 'NON-FIRM NAME FOUND ON MASTER FILE'. DTSCU072 +00193 EJECT DTSCU072 +00194 01 C072-LITERALS. DTSCU072 +00195 ++INCLUDE DTSIC072 DTSCU072 +00196 SKIP3 DTSCU072 +00197 ++INCLUDE LPFNCL01 DTSCU072 +00198 EJECT DTSCU072 +00199 01 CECD-LITERALS. DTSCU072 +00200 ++INCLUDE DTSICECD DTSCU072 +00201 EJECT DTSCU072 +00202 LINKAGE SECTION. DTSCU072 +00203 SKIP3 DTSCU072 +00204 01 DFHCOMMAREA. DTSCU072 +00205 ++INCLUDE DTSIL072 DTSCU072 +00206 EJECT DTSCU072 +00207 PROCEDURE DIVISION. DTSCU072 +00208 DTSCU072 +00209 *& NOTE: THE FOLLOWING LINE DISABLES CASS CERTIFICATION. DTSCU072 +00210 *& IT MUST BE REMOVED WHEN FINALIST IS AVAILABLE. DTSCU072 00211 DTSCU072 -00212 MOVE L072-ST TO C072-ST. DTSCU072 -00213 IF C072-DC-88 DTSCU072 -00214 PERFORM P2000-US-ADDRESS THRU P2000-EXIT DTSCU072 -00215 ELSE DTSCU072 -00216 IF C072-US-88 DTSCU072 -00217 PERFORM P2000-US-ADDRESS THRU P2000-EXIT DTSCU072 -00218 ELSE DTSCU072 -00219 IF C072-CANADA-88 DTSCU072 -00220 PERFORM P1000-CANADA-ADDRESS THRU P1000-EXIT DTSCU072 -00221 ELSE DTSCU072 -00222 IF C072-FOREIGN-88 DTSCU072 -00223 PERFORM P3000-FOREIGN-ADDRESS THRU P3000-EXIT DTSCU072 -00224 ELSE DTSCU072 -00225 SET L072-ST-NOT-VALID-88 TO TRUE DTSCU072 -00226 IF L072-ST = SPACE OR LOW-VALUE DTSCU072 -00227 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00228 ELSE DTSCU072 -00229 MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA. DTSCU072 -00230 DTSCU072 -00231 IF L072-MSG-ID NOT = SPACE DTSCU072 -00232 SET L072-ADDRESS-NOT-VALID-88 TO TRUE. DTSCU072 -00233 DTSCU072 -00234 IF L072-ADDRESS-NOT-VALID-88 DTSCU072 -00235 NEXT SENTENCE DTSCU072 -00236 ELSE DTSCU072 -00237 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCU072 -00238 OR L072-DELIV-LINE-2-NOT-VALID-88 DTSCU072 -00239 OR L072-CITY-NOT-VALID-88 DTSCU072 -00240 OR L072-ST-NOT-VALID-88 DTSCU072 -00241 OR L072-ZIP-NOT-VALID-88 DTSCU072 -00242 SET L072-ADDRESS-NOT-VALID-88 TO TRUE DTSCU072 -00243 ELSE DTSCU072 -00244 IF L072-DELIV-LINE-1-CHANGED-88 DTSCU072 -00245 OR L072-DELIV-LINE-2-CHANGED-88 DTSCU072 -00246 OR L072-CITY-CHANGED-88 DTSCU072 -00247 OR L072-ST-CHANGED-88 DTSCU072 -00248 OR L072-ZIP-CHANGED-88 DTSCU072 -00249 SET L072-ADDRESS-CHANGED-88 TO TRUE. DTSCU072 -00250 DTSCU072 -00251 DTSCU072 -00252 EXEC CICS DTSCU072 -00253 RETURN DTSCU072 -00254 END-EXEC. DTSCU072 +00212 SET L072-NO-CASS-EDITS-88 TO TRUE. CL**9 +00213 CL**9 +00214 PERFORM I1000-INITIALIZE THROUGH I1000-EXIT. DTSCU072 +00215 DTSCU072 +00216 MOVE L072-ST TO C072-ST. DTSCU072 +00217 IF C072-DC-88 DTSCU072 +00218 PERFORM P2000-US-ADDRESS THRU P2000-EXIT DTSCU072 +00219 ELSE DTSCU072 +00220 IF C072-US-88 DTSCU072 +00221 PERFORM P2000-US-ADDRESS THRU P2000-EXIT DTSCU072 +00222 ELSE DTSCU072 +00223 IF C072-CANADA-88 DTSCU072 +00224 PERFORM P1000-CANADA-ADDRESS THRU P1000-EXIT DTSCU072 +00225 ELSE DTSCU072 +00226 IF C072-FOREIGN-88 DTSCU072 +00227 PERFORM P3000-FOREIGN-ADDRESS THRU P3000-EXIT DTSCU072 +00228 ELSE DTSCU072 +00229 SET L072-ST-NOT-VALID-88 TO TRUE DTSCU072 +00230 IF L072-ST = SPACE OR LOW-VALUE DTSCU072 +00231 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 +00232 ELSE DTSCU072 +00233 MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA. DTSCU072 +00234 DTSCU072 +00235 IF L072-MSG-ID NOT = SPACE DTSCU072 +00236 SET L072-ADDRESS-NOT-VALID-88 TO TRUE. DTSCU072 +00237 DTSCU072 +00238 IF L072-ADDRESS-NOT-VALID-88 DTSCU072 +00239 NEXT SENTENCE DTSCU072 +00240 ELSE DTSCU072 +00241 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCU072 +00242 OR L072-DELIV-LINE-2-NOT-VALID-88 DTSCU072 +00243 OR L072-CITY-NOT-VALID-88 DTSCU072 +00244 OR L072-ST-NOT-VALID-88 DTSCU072 +00245 OR L072-ZIP-NOT-VALID-88 DTSCU072 +00246 SET L072-ADDRESS-NOT-VALID-88 TO TRUE DTSCU072 +00247 ELSE DTSCU072 +00248 IF L072-DELIV-LINE-1-CHANGED-88 DTSCU072 +00249 OR L072-DELIV-LINE-2-CHANGED-88 DTSCU072 +00250 OR L072-CITY-CHANGED-88 DTSCU072 +00251 OR L072-ST-CHANGED-88 DTSCU072 +00252 OR L072-ZIP-CHANGED-88 DTSCU072 +00253 SET L072-ADDRESS-CHANGED-88 TO TRUE. DTSCU072 +00254 DTSCU072 00255 DTSCU072 -00256 DTSCU072 -00257 DTSCU072 -00258 GOBACK. DTSCU072 -00259 EJECT DTSCU072 -00260 I1000-INITIALIZE. DTSCU072 -00261 IF L072-NO-CASS-EDITS-88 DTSCU072 -00262 NEXT SENTENCE DTSCU072 -00263 ELSE DTSCU072 -00264 SET L072-CASS-EDITS-88 TO TRUE. DTSCU072 -00265 DTSCU072 -00266 DTSCU072 -00267 SET L072-ADDRESS-UNCHANGED-88 TO TRUE. DTSCU072 -00268 DTSCU072 +00256 EXEC CICS DTSCU072 +00257 RETURN DTSCU072 +00258 END-EXEC. DTSCU072 +00259 DTSCU072 +00260 DTSCU072 +00261 DTSCU072 +00262 GOBACK. DTSCU072 +00263 EJECT DTSCU072 +00264 I1000-INITIALIZE. DTSCU072 +00265 IF L072-NO-CASS-EDITS-88 DTSCU072 +00266 NEXT SENTENCE DTSCU072 +00267 ELSE DTSCU072 +00268 SET L072-CASS-EDITS-88 TO TRUE. DTSCU072 00269 DTSCU072 -00270 SET L072-ATTN-LINE-UNCHANGED-88 TO TRUE. DTSCU072 -00271 DTSCU072 -00272 SET L072-DELIV-LINE-1-UNCHANGED-88 TO TRUE. DTSCU072 +00270 DTSCU072 +00271 SET L072-NO-CASS-EDITS-88 TO TRUE. CL*10 +00272 SET L072-ADDRESS-UNCHANGED-88 TO TRUE. DTSCU072 00273 DTSCU072 -00274 SET L072-DELIV-LINE-2-UNCHANGED-88 TO TRUE. DTSCU072 -00275 DTSCU072 -00276 SET L072-CITY-UNCHANGED-88 TO TRUE. DTSCU072 -00277 DTSCU072 -00278 SET L072-ST-UNCHANGED-88 TO TRUE. DTSCU072 -00279 DTSCU072 -00280 SET L072-ZIP-UNCHANGED-88 TO TRUE. DTSCU072 -00281 DTSCU072 +00274 DTSCU072 +00275 SET L072-ATTN-LINE-UNCHANGED-88 TO TRUE. DTSCU072 +00276 DTSCU072 +00277 SET L072-DELIV-LINE-1-UNCHANGED-88 TO TRUE. DTSCU072 +00278 DTSCU072 +00279 SET L072-DELIV-LINE-2-UNCHANGED-88 TO TRUE. DTSCU072 +00280 DTSCU072 +00281 SET L072-CITY-UNCHANGED-88 TO TRUE. DTSCU072 00282 DTSCU072 -00283 IF L072-ATTN-LINE = LOW-VALUES DTSCU072 -00284 MOVE SPACES TO L072-ATTN-LINE. DTSCU072 -00285 DTSCU072 -00286 IF L072-DELIV-LINE-1 = LOW-VALUES DTSCU072 -00287 MOVE SPACES TO L072-DELIV-LINE-1. DTSCU072 -00288 DTSCU072 -00289 IF L072-DELIV-LINE-2 = LOW-VALUES DTSCU072 -00290 MOVE SPACES TO L072-DELIV-LINE-2. DTSCU072 -00291 DTSCU072 -00292 IF L072-CITY = LOW-VALUES DTSCU072 -00293 MOVE SPACES TO L072-CITY. DTSCU072 -00294 DTSCU072 -00295 IF L072-ST = LOW-VALUES DTSCU072 -00296 MOVE SPACES TO L072-ST. DTSCU072 -00297 DTSCU072 -00298 IF L072-ZIP = LOW-VALUES DTSCU072 -00299 MOVE SPACES TO L072-ZIP. DTSCU072 -00300 DTSCU072 -00301 DTSCU072 -00302 MOVE SPACES TO L072-ADVANCED-BARCODE DTSCU072 -00303 L072-CASS-RETURN-CODES DTSCU072 -00304 L072-MSG-AREA. DTSCU072 +00283 SET L072-ST-UNCHANGED-88 TO TRUE. DTSCU072 +00284 DTSCU072 +00285 SET L072-ZIP-UNCHANGED-88 TO TRUE. DTSCU072 +00286 DTSCU072 +00287 DTSCU072 +00288 IF L072-ATTN-LINE = LOW-VALUES DTSCU072 +00289 MOVE SPACES TO L072-ATTN-LINE. DTSCU072 +00290 DTSCU072 +00291 IF L072-DELIV-LINE-1 = LOW-VALUES DTSCU072 +00292 MOVE SPACES TO L072-DELIV-LINE-1. DTSCU072 +00293 DTSCU072 +00294 IF L072-DELIV-LINE-2 = LOW-VALUES DTSCU072 +00295 MOVE SPACES TO L072-DELIV-LINE-2. DTSCU072 +00296 DTSCU072 +00297 IF L072-CITY = LOW-VALUES DTSCU072 +00298 MOVE SPACES TO L072-CITY. DTSCU072 +00299 DTSCU072 +00300 IF L072-ST = LOW-VALUES DTSCU072 +00301 MOVE SPACES TO L072-ST. DTSCU072 +00302 DTSCU072 +00303 IF L072-ZIP = LOW-VALUES DTSCU072 +00304 MOVE SPACES TO L072-ZIP. DTSCU072 00305 DTSCU072 00306 DTSCU072 -00307 MOVE L072-ST TO C072-ST. DTSCU072 -00308 I1000-EXIT. DTSCU072 -00309 EXIT. DTSCU072 -00310 EJECT DTSCU072 -00311 P1000-CANADA-ADDRESS. DTSCU072 -00312 SET L072-NO-CASS-EDITS-88 TO TRUE. DTSCU072 -00313 DTSCU072 -00314 DTSCU072 -00315 * IF (L072-ATTN-LINE NOT = SPACES) DTSCU072 -00316 * AND DTSCU072 -00317 * (L072-DELIV-LINE-1 NOT = SPACES) DTSCU072 -00318 * AND DTSCU072 -00319 * (L072-DELIV-LINE-2 NOT = SPACES) DTSCU072 -00320 * MOVE EMSG-CROSS-EDIT TO L072-MSG-AREA DTSCU072 -00321 * SET L072-ATTN-LINE-NOT-VALID-88 DTSCU072 -00322 * L072-DELIV-LINE-1-NOT-VALID-88 DTSCU072 -00323 * L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00324 * GO TO P1000-EXIT. DTSCU072 -00325 DTSCU072 -00326 IF (L072-DELIV-LINE-1 NOT = SPACES) DTSCU072 -00327 AND DTSCU072 -00328 (L072-DELIV-LINE-2 = SPACES) DTSCU072 -00329 MOVE L072-DELIV-LINE-1 TO L072-DELIV-LINE-2 DTSCU072 -00330 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 -00331 SET L072-DELIV-LINE-1-CHANGED-88 DTSCU072 -00332 L072-DELIV-LINE-2-CHANGED-88 TO TRUE. DTSCU072 -00333 DTSCU072 -00334 IF L072-DELIV-LINE-2 = SPACES DTSCU072 -00335 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00336 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00337 GO TO P1000-EXIT. DTSCU072 +00307 MOVE SPACES TO L072-ADVANCED-BARCODE DTSCU072 +00308 L072-CASS-RETURN-CODES DTSCU072 +00309 L072-MSG-AREA. DTSCU072 +00310 DTSCU072 +00311 DTSCU072 +00312 MOVE L072-ST TO C072-ST. DTSCU072 +00313 I1000-EXIT. DTSCU072 +00314 EXIT. DTSCU072 +00315 EJECT DTSCU072 +00316 P1000-CANADA-ADDRESS. DTSCU072 +00317 SET L072-NO-CASS-EDITS-88 TO TRUE. DTSCU072 +00318 DTSCU072 +00319 DTSCU072 +00320 * IF (L072-ATTN-LINE NOT = SPACES) DTSCU072 +00321 * AND DTSCU072 +00322 * (L072-DELIV-LINE-1 NOT = SPACES) DTSCU072 +00323 * AND DTSCU072 +00324 * (L072-DELIV-LINE-2 NOT = SPACES) DTSCU072 +00325 * MOVE EMSG-CROSS-EDIT TO L072-MSG-AREA DTSCU072 +00326 * SET L072-ATTN-LINE-NOT-VALID-88 DTSCU072 +00327 * L072-DELIV-LINE-1-NOT-VALID-88 DTSCU072 +00328 * L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 +00329 * GO TO P1000-EXIT. DTSCU072 +00330 DTSCU072 +00331 IF (L072-DELIV-LINE-1 NOT = SPACES) DTSCU072 +00332 AND DTSCU072 +00333 (L072-DELIV-LINE-2 = SPACES) DTSCU072 +00334 MOVE L072-DELIV-LINE-1 TO L072-DELIV-LINE-2 DTSCU072 +00335 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 +00336 SET L072-DELIV-LINE-1-CHANGED-88 DTSCU072 +00337 L072-DELIV-LINE-2-CHANGED-88 TO TRUE. DTSCU072 00338 DTSCU072 -00339 IF L072-CITY = SPACE DTSCU072 +00339 IF L072-DELIV-LINE-2 = SPACES DTSCU072 00340 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00341 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 +00341 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 00342 GO TO P1000-EXIT. DTSCU072 00343 DTSCU072 -00344 IF L072-ZIP = SPACES DTSCU072 +00344 IF L072-CITY = SPACE DTSCU072 00345 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00346 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 +00346 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 00347 GO TO P1000-EXIT. DTSCU072 00348 DTSCU072 -00349 IF L072-ZIP (1:1) NOT ALPHABETIC DTSCU072 -00350 OR L072-ZIP (2:1) NOT NUMERIC DTSCU072 -00351 OR L072-ZIP (3:1) NOT ALPHABETIC DTSCU072 -00352 OR L072-ZIP (4:1) NOT = SPACE DTSCU072 -00353 OR L072-ZIP (5:1) NOT NUMERIC DTSCU072 -00354 OR L072-ZIP (6:1) NOT ALPHABETIC DTSCU072 -00355 OR L072-ZIP (7:1) NOT NUMERIC DTSCU072 -00356 OR L072-ZIP (8:3) NOT = SPACE DTSCU072 -00357 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 -00358 MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA. DTSCU072 -00359 P1000-EXIT. DTSCU072 -00360 EXIT. DTSCU072 -00361 SKIP3 DTSCU072 -00362 P2000-US-ADDRESS. DTSCU072 -00363 IF L072-CASS-EDITS-88 DTSCU072 -00364 PERFORM P2100-CASS THRU P2100-EXIT DTSCU072 -00365 ELSE DTSCU072 -00366 PERFORM P2200-NO-CASS THRU P2200-EXIT. DTSCU072 -00367 P2000-EXIT. DTSCU072 -00368 EXIT. DTSCU072 -00369 EJECT DTSCU072 -00370 P2100-CASS. DTSCU072 -00371 MOVE SPACE TO FINAL-ORIGINAL-RETURN-AREA DTSCU072 -00372 FINAL-EXPANDED-RETURN-AREA. DTSCU072 -00373 MOVE HIGH-VALUE TO FINAL-FILLER. DTSCU072 -00374 DTSCU072 -00375 MOVE '0' TO FINAL-FUNCTION-CODE. DTSCU072 -00376 DTSCU072 -00377 *-------------------------------------------------------------- DTSCU072 -00378 * FINALIST ONLINE DOES NOT ACCEPT VALID CASS CONFIGURATIONS DTSCU072 -00379 * (CONFIGXXX). HOWEVER, THE FOLLOWING CODE SETS THE DTSCU072 -00380 * INDIVIDUAL TAILORING OPTIONS TO DUPLICATE (WHEN COMBINED DTSCU072 -00381 * WITH LATER USE OF FUNCTION CODE EQUAL TO 5) THE DTSCU072 -00382 * 'CNFIGAAR' CONFIGURATION. DTSCU072 +00349 * IF L072-ZIP = SPACES CL**7 +00350 * MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA CL**7 +00351 * SET L072-ZIP-NOT-VALID-88 TO TRUE CL**7 +00352 * GO TO P1000-EXIT. CL**7 +00353 DTSCU072 +00354 * IF L072-ZIP (1:1) NOT ALPHABETIC CL**6 +00355 * OR L072-ZIP (2:1) NOT NUMERIC CL**6 +00356 * OR L072-ZIP (3:1) NOT ALPHABETIC CL**6 +00357 * OR L072-ZIP (4:1) NOT = SPACE CL**6 +00358 * OR L072-ZIP (5:1) NOT NUMERIC CL**6 +00359 * OR L072-ZIP (6:1) NOT ALPHABETIC CL**6 +00360 * OR L072-ZIP (7:1) NOT NUMERIC CL**6 +00361 * OR L072-ZIP (8:3) NOT = SPACE CL**6 +00362 * SET L072-ZIP-NOT-VALID-88 TO TRUE CL**6 +00363 * MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA. CL**6 +00364 P1000-EXIT. DTSCU072 +00365 EXIT. DTSCU072 +00366 SKIP3 DTSCU072 +00367 P2000-US-ADDRESS. DTSCU072 +00368 * IF L072-CASS-EDITS-88 CL*10 +00369 * PERFORM P2100-CASS THRU P2100-EXIT CL*10 +00370 * ELSE CL*10 +00371 SET L072-NO-CASS-EDITS-88 TO TRUE. CL*10 +00372 PERFORM P2200-NO-CASS THRU P2200-EXIT. DTSCU072 +00373 P2000-EXIT. DTSCU072 +00374 EXIT. DTSCU072 +00375 EJECT DTSCU072 +00376 P2100-CASS. DTSCU072 +00377 MOVE SPACE TO FINAL-ORIGINAL-RETURN-AREA DTSCU072 +00378 FINAL-EXPANDED-RETURN-AREA. DTSCU072 +00379 MOVE HIGH-VALUE TO FINAL-FILLER. DTSCU072 +00380 DTSCU072 +00381 MOVE '0' TO FINAL-FUNCTION-CODE. DTSCU072 +00382 DTSCU072 00383 *-------------------------------------------------------------- DTSCU072 -00384 MOVE 'X ' TO FINAL-FUNCTION-OPTION. DTSCU072 -00385 MOVE 'Y' TO FINAL-UNIQUE-OPT. DTSCU072 -00386 MOVE 'Y' TO FINAL-STRTPHON-OPT. DTSCU072 -00387 MOVE 'Y' TO FINAL-FIRMCORR-OPT. DTSCU072 -00388 MOVE 'Y' TO FINAL-CITYPHON-OPT. DTSCU072 -00389 MOVE 'N' TO FINAL-WEIGHT-OPT. DTSCU072 -00390 MOVE 'Y' TO FINAL-ZIPCORR-OPT. DTSCU072 -00391 MOVE 'Y' TO FINAL-CITYCORR-OPT. DTSCU072 -00392 MOVE 'N' TO FINAL-STRCOSM-OPT. DTSCU072 -00393 MOVE 'Y' TO FINAL-FRMPRS-OPT. DTSCU072 -00394 MOVE 'Y' TO FINAL-UNITDES-OPT. DTSCU072 -00395 MOVE 'Y' TO FINAL-CTYLONG-OPT. DTSCU072 -00396 MOVE 'N' TO FINAL-ALSLBL-OPT. DTSCU072 -00397 MOVE 'LPFNMODC' TO CAMODNAM. DTSCU072 -00398 DTSCU072 -00399 PERFORM S1000-LINK-TO-FINALIST THROUGH S1000-EXIT. DTSCU072 -00400 DTSCU072 -00401 IF FINAL-RETURN-CODE1 = 'E' DTSCU072 -00402 PERFORM P2110-FINALIST-ABEND THROUGH P2110-EXIT DTSCU072 -00403 GO TO P2100-EXIT. DTSCU072 +00384 * FINALIST ONLINE DOES NOT ACCEPT VALID CASS CONFIGURATIONS DTSCU072 +00385 * (CONFIGXXX). HOWEVER, THE FOLLOWING CODE SETS THE DTSCU072 +00386 * INDIVIDUAL TAILORING OPTIONS TO DUPLICATE (WHEN COMBINED DTSCU072 +00387 * WITH LATER USE OF FUNCTION CODE EQUAL TO 5) THE DTSCU072 +00388 * 'CNFIGAAR' CONFIGURATION. DTSCU072 +00389 *-------------------------------------------------------------- DTSCU072 +00390 MOVE 'X ' TO FINAL-FUNCTION-OPTION. DTSCU072 +00391 MOVE 'Y' TO FINAL-UNIQUE-OPT. DTSCU072 +00392 MOVE 'Y' TO FINAL-STRTPHON-OPT. DTSCU072 +00393 MOVE 'Y' TO FINAL-FIRMCORR-OPT. DTSCU072 +00394 MOVE 'Y' TO FINAL-CITYPHON-OPT. DTSCU072 +00395 MOVE 'N' TO FINAL-WEIGHT-OPT. DTSCU072 +00396 MOVE 'Y' TO FINAL-ZIPCORR-OPT. DTSCU072 +00397 MOVE 'Y' TO FINAL-CITYCORR-OPT. DTSCU072 +00398 MOVE 'N' TO FINAL-STRCOSM-OPT. DTSCU072 +00399 MOVE 'Y' TO FINAL-FRMPRS-OPT. DTSCU072 +00400 MOVE 'Y' TO FINAL-UNITDES-OPT. DTSCU072 +00401 MOVE 'Y' TO FINAL-CTYLONG-OPT. DTSCU072 +00402 MOVE 'N' TO FINAL-ALSLBL-OPT. DTSCU072 +00403 MOVE 'LPFNMODC' TO CAMODNAM. DTSCU072 00404 DTSCU072 -00405 MOVE SPACES TO FINAL-INPUT-ADDR-AREA. DTSCU072 +00405 PERFORM S1000-LINK-TO-FINALIST THROUGH S1000-EXIT. DTSCU072 00406 DTSCU072 -00407 IF L072-DELIV-LINE-1 > SPACES DTSCU072 -00408 MOVE L072-DELIV-LINE-1 TO USER-INPUT-ADDRESS-1. DTSCU072 -00409 DTSCU072 -00410 * IF L072-DELIV-LINE = SPACE DTSCU072 -00411 * IF L072-MOPO-88 DTSCU072 -00412 * OR L072-FFID-88 DTSCU072 -00413 * SET L071-FROM-LAST-NAME-FIRST TO TRUE DTSCU072 -00414 * MOVE L072-NAME TO L071-NAM DTSCU072 -00415 * PERFORM S071-NAME-CONVERT THROUGH S071-EXIT DTSCU072 -00416 * IF L071-NAME-CONVERTED DTSCU072 -00417 * MOVE L071-NAM TO USER-INPUT-ADDRESS-2 DTSCU072 -00418 * ELSE DTSCU072 -00419 * SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE DTSCU072 -00420 * MOVE MSG-E08Y-AREA TO L072-MSG-AREA DTSCU072 -00421 * GO TO P2100-EXIT DTSCU072 -00422 * ELSE DTSCU072 -00423 * MOVE L072-NAME TO USER-INPUT-ADDRESS-2 DTSCU072 -00424 * ELSE DTSCU072 -00425 * MOVE L072-DELIV-LINE TO USER-INPUT-ADDRESS-2. DTSCU072 -00426 * IF L072-DELIV-LINE = SPACE DTSCU072 -00427 * SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE DTSCU072 -00428 * MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00429 * GO TO P2100-EXIT DTSCU072 +00407 IF FINAL-RETURN-CODE1 = 'E' DTSCU072 +00408 PERFORM P2110-FINALIST-ABEND THROUGH P2110-EXIT DTSCU072 +00409 GO TO P2100-EXIT. DTSCU072 +00410 DTSCU072 +00411 MOVE SPACES TO FINAL-INPUT-ADDR-AREA. DTSCU072 +00412 DTSCU072 +00413 IF L072-DELIV-LINE-1 > SPACES DTSCU072 +00414 MOVE L072-DELIV-LINE-1 TO USER-INPUT-ADDRESS-1. DTSCU072 +00415 DTSCU072 +00416 * IF L072-DELIV-LINE = SPACE DTSCU072 +00417 * IF L072-MOPO-88 DTSCU072 +00418 * OR L072-FFID-88 DTSCU072 +00419 * SET L071-FROM-LAST-NAME-FIRST TO TRUE DTSCU072 +00420 * MOVE L072-NAME TO L071-NAM DTSCU072 +00421 * PERFORM S071-NAME-CONVERT THROUGH S071-EXIT DTSCU072 +00422 * IF L071-NAME-CONVERTED DTSCU072 +00423 * MOVE L071-NAM TO USER-INPUT-ADDRESS-2 DTSCU072 +00424 * ELSE DTSCU072 +00425 * SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE DTSCU072 +00426 * MOVE MSG-E08Y-AREA TO L072-MSG-AREA DTSCU072 +00427 * GO TO P2100-EXIT DTSCU072 +00428 * ELSE DTSCU072 +00429 * MOVE L072-NAME TO USER-INPUT-ADDRESS-2 DTSCU072 00430 * ELSE DTSCU072 00431 * MOVE L072-DELIV-LINE TO USER-INPUT-ADDRESS-2. DTSCU072 -00432 * DTSCU072 -00433 * MOVE SPACES TO USER-INPUT-CSZ-AREA. DTSCU072 -00434 DTSCU072 -00435 MOVE L072-DELIV-LINE-2 TO USER-INPUT-ADDRESS-2. DTSCU072 -00436 DTSCU072 -00437 * STRING L072-CITY ' ' L072-ST DTSCU072 -00438 * DELIMITED BY ' ' DTSCU072 -00439 * INTO USER-INPUT-CITY-STATE. DTSCU072 +00432 * IF L072-DELIV-LINE = SPACE DTSCU072 +00433 * SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE DTSCU072 +00434 * MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 +00435 * GO TO P2100-EXIT DTSCU072 +00436 * ELSE DTSCU072 +00437 * MOVE L072-DELIV-LINE TO USER-INPUT-ADDRESS-2. DTSCU072 +00438 * DTSCU072 +00439 * MOVE SPACES TO USER-INPUT-CSZ-AREA. DTSCU072 00440 DTSCU072 -00441 MOVE L072-CITY TO USER-INPUT-CITY-STATE (1:25). DTSCU072 -00442 MOVE L072-ST TO USER-INPUT-CITY-STATE (28:2). DTSCU072 -00443 DTSCU072 -00444 MOVE L072-ZIP TO USER-INPUT-ZIP. DTSCU072 -00445 MOVE L072-ZIP (7:4) TO USER-INPUT-SEC-SEG. DTSCU072 +00441 MOVE L072-DELIV-LINE-2 TO USER-INPUT-ADDRESS-2. DTSCU072 +00442 DTSCU072 +00443 * STRING L072-CITY ' ' L072-ST DTSCU072 +00444 * DELIMITED BY ' ' DTSCU072 +00445 * INTO USER-INPUT-CITY-STATE. DTSCU072 00446 DTSCU072 -00447 MOVE '5' TO FINAL-FUNCTION-CODE. DTSCU072 -00448 PERFORM S1000-LINK-TO-FINALIST THROUGH S1000-EXIT. DTSCU072 -00449 IF FINAL-RETURN-CODE1 = 'E' DTSCU072 -00450 PERFORM P2110-FINALIST-ABEND THROUGH P2110-EXIT DTSCU072 -00451 GO TO P2100-EXIT. DTSCU072 +00447 MOVE L072-CITY TO USER-INPUT-CITY-STATE (1:25). DTSCU072 +00448 MOVE L072-ST TO USER-INPUT-CITY-STATE (28:2). DTSCU072 +00449 DTSCU072 +00450 MOVE L072-ZIP TO USER-INPUT-ZIP. DTSCU072 +00451 MOVE L072-ZIP (7:4) TO USER-INPUT-SEC-SEG. DTSCU072 00452 DTSCU072 -00453 PERFORM P2120-FINALIST-RESULTS THROUGH P2120-EXIT. DTSCU072 -00454 IF L072-MSG-ID = SPACE DTSCU072 -00455 PERFORM P2130-CHECK-FINALIST-CODES THROUGH P2130-EXIT. DTSCU072 -00456 * IF L072-DELIV-LINE-NOT-VALID-88 DTSCU072 -00457 *** WORKAROUND FOR FINALIST BUG: GENERAL DELIVERY W/ GARBAGE CITY DTSCU072 -00458 * IF L072-DELIV-LINE = 'GENERAL DELIVERY' DTSCU072 -00459 * SET L072-DELIV-LINE-UNCHANGED-88 TO TRUE DTSCU072 -00460 * MOVE MSG-E084-AREA TO L072-MSG-AREA DTSCU072 -00461 * SET L072-CITY-NOT-VALID-88 TO TRUE. DTSCU072 -00462 DTSCU072 -00463 IF L072-MSG-ID = SPACE DTSCU072 -00464 IF FINAL-OUTSEL-BAD = 'Y' DTSCU072 -00465 SET L072-ADDRESS-NOT-VALID-88 TO TRUE DTSCU072 -00466 MOVE MSG-E086-AREA TO L072-MSG-AREA. DTSCU072 -00467 DTSCU072 -00468 * MOVE '9' TO FINAL-FUNCTION-CODE. DTSCU072 -00469 * PERFORM S1000-LINK-TO-FINALIST THROUGH S1000-EXIT. DTSCU072 -00470 * IF FINAL-RETURN-CODE1 = 'E' DTSCU072 -00471 * PERFORM P2110-FINALIST-ABEND THROUGH P2110-EXIT. DTSCU072 -00472 DTSCU072 -00473 P2100-EXIT. DTSCU072 -00474 EXIT. DTSCU072 -00475 SKIP3 DTSCU072 -00476 P2110-FINALIST-ABEND. DTSCU072 -00477 SET L072-ADDRESS-NOT-VALID-88 TO TRUE. DTSCU072 +00453 MOVE '5' TO FINAL-FUNCTION-CODE. DTSCU072 +00454 PERFORM S1000-LINK-TO-FINALIST THROUGH S1000-EXIT. DTSCU072 +00455 IF FINAL-RETURN-CODE1 = 'E' DTSCU072 +00456 PERFORM P2110-FINALIST-ABEND THROUGH P2110-EXIT DTSCU072 +00457 GO TO P2100-EXIT. DTSCU072 +00458 DTSCU072 +00459 PERFORM P2120-FINALIST-RESULTS THROUGH P2120-EXIT. DTSCU072 +00460 IF L072-MSG-ID = SPACE DTSCU072 +00461 PERFORM P2130-CHECK-FINALIST-CODES THROUGH P2130-EXIT. DTSCU072 +00462 * IF L072-DELIV-LINE-NOT-VALID-88 DTSCU072 +00463 *** WORKAROUND FOR FINALIST BUG: GENERAL DELIVERY W/ GARBAGE CITY DTSCU072 +00464 * IF L072-DELIV-LINE = 'GENERAL DELIVERY' DTSCU072 +00465 * SET L072-DELIV-LINE-UNCHANGED-88 TO TRUE DTSCU072 +00466 * MOVE MSG-E084-AREA TO L072-MSG-AREA DTSCU072 +00467 * SET L072-CITY-NOT-VALID-88 TO TRUE. DTSCU072 +00468 DTSCU072 +00469 IF L072-MSG-ID = SPACE DTSCU072 +00470 IF FINAL-OUTSEL-BAD = 'Y' DTSCU072 +00471 SET L072-ADDRESS-NOT-VALID-88 TO TRUE DTSCU072 +00472 MOVE MSG-E086-AREA TO L072-MSG-AREA. DTSCU072 +00473 DTSCU072 +00474 * MOVE '9' TO FINAL-FUNCTION-CODE. DTSCU072 +00475 * PERFORM S1000-LINK-TO-FINALIST THROUGH S1000-EXIT. DTSCU072 +00476 * IF FINAL-RETURN-CODE1 = 'E' DTSCU072 +00477 * PERFORM P2110-FINALIST-ABEND THROUGH P2110-EXIT. DTSCU072 00478 DTSCU072 -00479 MOVE CAERRMOD TO MSG-E081-CAERRMOD. DTSCU072 -00480 MOVE CAERRSRC TO MSG-E081-CAERRSRC. DTSCU072 -00481 MOVE CAERRDSC TO MSG-E081-CAERRDSC. DTSCU072 -00482 DTSCU072 -00483 *****MOVE SPACES TO MSG-E081-CAERRMOD DTSCU072 -00484 ***** MSG-E081-CAERRSRC DTSCU072 -00485 ***** MSG-E081-CAERRDSC. DTSCU072 -00486 DTSCU072 -00487 MOVE MSG-E081-AREA TO L072-MSG-AREA. DTSCU072 -00488 P2110-EXIT. DTSCU072 -00489 EXIT. DTSCU072 -00490 EJECT DTSCU072 -00491 P2120-FINALIST-RESULTS. DTSCU072 -00492 IF FINAL-LABEL-LENGTH1 > 40 DTSCU072 -00493 MOVE MSG-E087-AREA TO L072-MSG-AREA DTSCU072 -00494 SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE DTSCU072 -00495 ELSE DTSCU072 -00496 IF L072-DELIV-LINE-1 > SPACES DTSCU072 -00497 IF FINAL-LABEL-LENGTH1 > 0 DTSCU072 -00498 MOVE EMSG-FIELD-NOT-ALLOWED TO L072-MSG-AREA DTSCU072 -00499 SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE DTSCU072 -00500 ELSE DTSCU072 -00501 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 -00502 ELSE DTSCU072 -00503 IF L072-DELIV-LINE-1 = SPACES DTSCU072 -00504 IF FINAL-LABEL-LENGTH1 > 0 DTSCU072 -00505 MOVE FINAL-LABEL-LINE1 TO L072-DELIV-LINE-1 DTSCU072 -00506 SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE DTSCU072 -00507 * SET L072-ATTN-DELIV-88 TO TRUE DTSCU072 -00508 ELSE DTSCU072 -00509 NEXT SENTENCE DTSCU072 -00510 ELSE DTSCU072 -00511 IF FINAL-LABEL-LENGTH1 > 0 DTSCU072 -00512 MOVE FINAL-LABEL-LINE1 TO L072-DELIV-LINE-1 DTSCU072 -00513 SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE DTSCU072 -00514 * SET L072-ATTN-DELIV-88 TO TRUE DTSCU072 -00515 ELSE DTSCU072 -00516 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 -00517 SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE. DTSCU072 -00518 * SET L072-ATTN-NONE-88 TO TRUE. DTSCU072 -00519 DTSCU072 -00520 IF FINAL-LABEL-LENGTH2 > 40 DTSCU072 -00521 MOVE MSG-E087-AREA TO L072-MSG-AREA DTSCU072 -00522 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00523 ELSE DTSCU072 -00524 * IF L072-DELIV-LINE = SPACE DTSCU072 -00525 * IF FINAL-MAIL-FIRM-NAME = SPACE DTSCU072 -00526 * SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE DTSCU072 -00527 * MOVE MSG-E08Z-AREA TO L072-MSG-AREA DTSCU072 -00528 * ELSE DTSCU072 -00529 * NEXT SENTENCE DTSCU072 -00530 * ELSE DTSCU072 -00531 IF FINAL-LABEL-LINE2 NOT = L072-DELIV-LINE-2 DTSCU072 -00532 MOVE FINAL-LABEL-LINE2 TO L072-DELIV-LINE-2 DTSCU072 -00533 SET L072-DELIV-LINE-2-CHANGED-88 TO TRUE. DTSCU072 -00534 DTSCU072 -00535 IF FINAL-FULL-CITY-NAME NOT = L072-CITY DTSCU072 -00536 MOVE FINAL-FULL-CITY-NAME TO L072-CITY DTSCU072 -00537 SET L072-CITY-CHANGED-88 TO TRUE. DTSCU072 -00538 DTSCU072 -00539 IF FINAL-STATE NOT = L072-ST DTSCU072 -00540 MOVE FINAL-STATE TO L072-ST DTSCU072 -00541 SET L072-ST-CHANGED-88 TO TRUE. DTSCU072 -00542 DTSCU072 -00543 IF FINAL-ZIP NOT = L072-ZIP (1:5) DTSCU072 -00544 MOVE FINAL-ZIP TO L072-ZIP (1:5) DTSCU072 -00545 SET L072-ZIP-CHANGED-88 TO TRUE. DTSCU072 -00546 DTSCU072 -00547 IF FINAL-SEC-SEG = SPACE DTSCU072 -00548 MOVE SPACE TO L072-ZIP (6:5) DTSCU072 -00549 ELSE DTSCU072 -00550 IF L072-ZIP (7:4) NOT = SPACE DTSCU072 -00551 AND FINAL-SEC-SEG NOT = L072-ZIP (7:4) DTSCU072 -00552 SET L072-ZIP-CHANGED-88 TO TRUE DTSCU072 -00553 END-IF DTSCU072 -00554 MOVE '-' TO L072-ZIP (6:1) DTSCU072 -00555 MOVE FINAL-SEC-SEG TO L072-ZIP (7:4). DTSCU072 -00556 DTSCU072 -00557 STRING FINAL-RETURN-CODE1 DELIMITED BY SIZE DTSCU072 -00558 '-' DELIMITED BY SIZE DTSCU072 -00559 FINAL-REASON-CODES (1:9) DELIMITED BY SIZE DTSCU072 -00560 '-' DELIMITED BY SIZE DTSCU072 -00561 FINAL-ADDRESS-INFO-CODES (1:6) DELIMITED BY SIZE DTSCU072 -00562 INTO L072-CASS-RETURN-CODES. DTSCU072 -00563 DTSCU072 -00564 MOVE FINAL-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE. DTSCU072 -00565 P2120-EXIT. DTSCU072 -00566 EXIT. DTSCU072 -00567 EJECT DTSCU072 -00568 P2130-CHECK-FINALIST-CODES. DTSCU072 -00569 MOVE FINAL-REASON-CODES TO FC-REASON-CODES. DTSCU072 -00570 MOVE FINAL-ADDRESS-INFO-CODES TO FC-ADDRESS-INFO-CODES. DTSCU072 -00571 DTSCU072 -00572 IF FC-STREET-BAD-88 DTSCU072 -00573 OR FC-RANGE-BAD-88 DTSCU072 -00574 OR FC-SUFDIR-BAD-88 DTSCU072 -00575 MOVE MSG-E085-AREA TO L072-MSG-AREA DTSCU072 -00576 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00577 GO TO P2130-EXIT. DTSCU072 -00578 DTSCU072 -00579 IF FC-CITY-BYPASSED-88 DTSCU072 -00580 OR FC-CITY-BAD-88 DTSCU072 -00581 MOVE MSG-E084-AREA TO L072-MSG-AREA DTSCU072 -00582 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 +00479 P2100-EXIT. DTSCU072 +00480 EXIT. DTSCU072 +00481 SKIP3 DTSCU072 +00482 P2110-FINALIST-ABEND. DTSCU072 +00483 SET L072-ADDRESS-NOT-VALID-88 TO TRUE. DTSCU072 +00484 DTSCU072 +00485 MOVE CAERRMOD TO MSG-E081-CAERRMOD. DTSCU072 +00486 MOVE CAERRSRC TO MSG-E081-CAERRSRC. DTSCU072 +00487 MOVE CAERRDSC TO MSG-E081-CAERRDSC. DTSCU072 +00488 DTSCU072 +00489 *****MOVE SPACES TO MSG-E081-CAERRMOD DTSCU072 +00490 ***** MSG-E081-CAERRSRC DTSCU072 +00491 ***** MSG-E081-CAERRDSC. DTSCU072 +00492 DTSCU072 +00493 MOVE MSG-E081-AREA TO L072-MSG-AREA. DTSCU072 +00494 P2110-EXIT. DTSCU072 +00495 EXIT. DTSCU072 +00496 EJECT DTSCU072 +00497 P2120-FINALIST-RESULTS. DTSCU072 +00498 IF FINAL-LABEL-LENGTH1 > 40 DTSCU072 +00499 MOVE MSG-E087-AREA TO L072-MSG-AREA DTSCU072 +00500 SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE DTSCU072 +00501 ELSE DTSCU072 +00502 IF L072-DELIV-LINE-1 > SPACES DTSCU072 +00503 IF FINAL-LABEL-LENGTH1 > 0 DTSCU072 +00504 MOVE EMSG-FIELD-NOT-ALLOWED TO L072-MSG-AREA DTSCU072 +00505 SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE DTSCU072 +00506 ELSE DTSCU072 +00507 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 +00508 ELSE DTSCU072 +00509 IF L072-DELIV-LINE-1 = SPACES DTSCU072 +00510 IF FINAL-LABEL-LENGTH1 > 0 DTSCU072 +00511 MOVE FINAL-LABEL-LINE1 TO L072-DELIV-LINE-1 DTSCU072 +00512 SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE DTSCU072 +00513 * SET L072-ATTN-DELIV-88 TO TRUE DTSCU072 +00514 ELSE DTSCU072 +00515 NEXT SENTENCE DTSCU072 +00516 ELSE DTSCU072 +00517 IF FINAL-LABEL-LENGTH1 > 0 DTSCU072 +00518 MOVE FINAL-LABEL-LINE1 TO L072-DELIV-LINE-1 DTSCU072 +00519 SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE DTSCU072 +00520 * SET L072-ATTN-DELIV-88 TO TRUE DTSCU072 +00521 ELSE DTSCU072 +00522 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 +00523 SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE. DTSCU072 +00524 * SET L072-ATTN-NONE-88 TO TRUE. DTSCU072 +00525 DTSCU072 +00526 IF FINAL-LABEL-LENGTH2 > 40 DTSCU072 +00527 MOVE MSG-E087-AREA TO L072-MSG-AREA DTSCU072 +00528 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 +00529 ELSE DTSCU072 +00530 * IF L072-DELIV-LINE = SPACE DTSCU072 +00531 * IF FINAL-MAIL-FIRM-NAME = SPACE DTSCU072 +00532 * SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE DTSCU072 +00533 * MOVE MSG-E08Z-AREA TO L072-MSG-AREA DTSCU072 +00534 * ELSE DTSCU072 +00535 * NEXT SENTENCE DTSCU072 +00536 * ELSE DTSCU072 +00537 IF FINAL-LABEL-LINE2 NOT = L072-DELIV-LINE-2 DTSCU072 +00538 MOVE FINAL-LABEL-LINE2 TO L072-DELIV-LINE-2 DTSCU072 +00539 SET L072-DELIV-LINE-2-CHANGED-88 TO TRUE. DTSCU072 +00540 DTSCU072 +00541 IF FINAL-FULL-CITY-NAME NOT = L072-CITY DTSCU072 +00542 MOVE FINAL-FULL-CITY-NAME TO L072-CITY DTSCU072 +00543 SET L072-CITY-CHANGED-88 TO TRUE. DTSCU072 +00544 DTSCU072 +00545 IF FINAL-STATE NOT = L072-ST DTSCU072 +00546 MOVE FINAL-STATE TO L072-ST DTSCU072 +00547 SET L072-ST-CHANGED-88 TO TRUE. DTSCU072 +00548 DTSCU072 +00549 IF FINAL-ZIP NOT = L072-ZIP (1:5) DTSCU072 +00550 MOVE FINAL-ZIP TO L072-ZIP (1:5) DTSCU072 +00551 SET L072-ZIP-CHANGED-88 TO TRUE. DTSCU072 +00552 DTSCU072 +00553 IF FINAL-SEC-SEG = SPACE DTSCU072 +00554 MOVE SPACE TO L072-ZIP (6:5) DTSCU072 +00555 ELSE DTSCU072 +00556 IF L072-ZIP (7:4) NOT = SPACE DTSCU072 +00557 AND FINAL-SEC-SEG NOT = L072-ZIP (7:4) DTSCU072 +00558 SET L072-ZIP-CHANGED-88 TO TRUE DTSCU072 +00559 END-IF DTSCU072 +00560 MOVE '-' TO L072-ZIP (6:1) DTSCU072 +00561 MOVE FINAL-SEC-SEG TO L072-ZIP (7:4). DTSCU072 +00562 DTSCU072 +00563 STRING FINAL-RETURN-CODE1 DELIMITED BY SIZE DTSCU072 +00564 '-' DELIMITED BY SIZE DTSCU072 +00565 FINAL-REASON-CODES (1:9) DELIMITED BY SIZE DTSCU072 +00566 '-' DELIMITED BY SIZE DTSCU072 +00567 FINAL-ADDRESS-INFO-CODES (1:6) DELIMITED BY SIZE DTSCU072 +00568 INTO L072-CASS-RETURN-CODES. DTSCU072 +00569 DTSCU072 +00570 MOVE FINAL-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE. DTSCU072 +00571 P2120-EXIT. DTSCU072 +00572 EXIT. DTSCU072 +00573 EJECT DTSCU072 +00574 P2130-CHECK-FINALIST-CODES. DTSCU072 +00575 MOVE FINAL-REASON-CODES TO FC-REASON-CODES. DTSCU072 +00576 MOVE FINAL-ADDRESS-INFO-CODES TO FC-ADDRESS-INFO-CODES. DTSCU072 +00577 DTSCU072 +00578 IF FC-STREET-BAD-88 DTSCU072 +00579 OR FC-RANGE-BAD-88 DTSCU072 +00580 OR FC-SUFDIR-BAD-88 DTSCU072 +00581 MOVE MSG-E085-AREA TO L072-MSG-AREA DTSCU072 +00582 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 00583 GO TO P2130-EXIT. DTSCU072 00584 DTSCU072 -00585 IF FC-ZIP-BYPASSED-88 DTSCU072 -00586 OR FC-ZIP-BAD-88 DTSCU072 -00587 MOVE MSG-E083-AREA TO L072-MSG-AREA DTSCU072 -00588 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 +00585 IF FC-CITY-BYPASSED-88 DTSCU072 +00586 OR FC-CITY-BAD-88 DTSCU072 +00587 MOVE MSG-E084-AREA TO L072-MSG-AREA DTSCU072 +00588 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 00589 GO TO P2130-EXIT. DTSCU072 00590 DTSCU072 -00591 IF FC-BOTH-ADDR-BAD-88 DTSCU072 -00592 MOVE MSG-E086-AREA TO L072-MSG-AREA DTSCU072 -00593 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00594 GO TO P2130-EXIT. DTSCU072 -00595 DTSCU072 -00596 IF FINAL-RETURN-CODE1 NOT = '0' DTSCU072 -00597 IF FC-SUFDIR-MULTI-88 DTSCU072 -00598 MOVE MSG-E085-AREA TO L072-MSG-AREA DTSCU072 -00599 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00600 GO TO P2130-EXIT DTSCU072 -00601 ELSE DTSCU072 -00602 MOVE MSG-E082-AREA TO L072-MSG-AREA DTSCU072 -00603 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 -00604 GO TO P2130-EXIT. DTSCU072 -00605 P2130-EXIT. DTSCU072 -00606 EXIT. DTSCU072 -00607 EJECT DTSCU072 -00608 P2200-NO-CASS. DTSCU072 -00609 IF (L072-DELIV-LINE-1 NOT = SPACES) DTSCU072 -00610 AND DTSCU072 -00611 (L072-DELIV-LINE-2 = SPACES) DTSCU072 -00612 MOVE L072-DELIV-LINE-1 TO L072-DELIV-LINE-2 DTSCU072 -00613 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 -00614 SET L072-DELIV-LINE-1-CHANGED-88 DTSCU072 -00615 L072-DELIV-LINE-2-CHANGED-88 TO TRUE. DTSCU072 -00616 DTSCU072 -00617 IF L072-DELIV-LINE-2 = SPACES DTSCU072 -00618 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00619 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00620 GO TO P2200-EXIT. DTSCU072 -00621 DTSCU072 -00622 IF L072-CITY = SPACE DTSCU072 -00623 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00624 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 -00625 GO TO P2200-EXIT. DTSCU072 -00626 DTSCU072 -00627 IF L072-ZIP = SPACES DTSCU072 -00628 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00629 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 -00630 GO TO P2200-EXIT. DTSCU072 -00631 DTSCU072 -00632 IF L072-ZIP (1:5) NOT NUMERIC DTSCU072 -00633 OR L072-ZIP (1:5) = '00000' CL*25 -00634 MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA DTSCU072 -00635 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 -00636 ELSE DTSCU072 -00637 IF L072-ZIP (6:5) NOT = SPACE CL*25 -00638 MOVE SPACE TO L072-ZIP (6:5) CL*25 -00639 SET L072-ZIP-CHANGED-88 TO TRUE. CL*25 -00640 P2200-EXIT. DTSCU072 -00641 EXIT. DTSCU072 -00642 EJECT DTSCU072 -00643 P3000-FOREIGN-ADDRESS. DTSCU072 -00644 SET L072-NO-CASS-EDITS-88 TO TRUE. DTSCU072 -00645 DTSCU072 -00646 IF L072-ZIP = ALL '*' DTSCU072 -00647 NEXT SENTENCE DTSCU072 -00648 ELSE DTSCU072 -00649 MOVE ALL '*' TO L072-ZIP DTSCU072 -00650 SET L072-ZIP-CHANGED-88 TO TRUE. DTSCU072 -00651 DTSCU072 -00652 IF L072-DELIV-LINE-1 = SPACES DTSCU072 -00653 SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE DTSCU072 -00654 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00655 GO TO P3000-EXIT. DTSCU072 -00656 DTSCU072 -00657 IF L072-DELIV-LINE-2 = SPACES DTSCU072 -00658 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 -00659 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00660 GO TO P3000-EXIT. DTSCU072 -00661 DTSCU072 -00662 IF L072-CITY = SPACES DTSCU072 -00663 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 -00664 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 -00665 GO TO P3000-EXIT. DTSCU072 -00666 P3000-EXIT. DTSCU072 -00667 EXIT. DTSCU072 -00668 EJECT DTSCU072 -00669 S1000-LINK-TO-FINALIST. DTSCU072 -00670 EXEC CICS DTSCU072 -00671 LINK DTSCU072 -00672 PROGRAM ('FINALOL') DTSCU072 -00673 COMMAREA (FINAL-CALL-AREA) DTSCU072 -00674 END-EXEC. DTSCU072 -00675 S1000-EXIT. DTSCU072 -00676 EXIT. DTSCU072 -00677 SKIP3 DTSCU072 -00678 ****************** S071-NAME-CONVERT NOT USED. DTSCU072 -00679 *S071-NAME-CONVERT. DTSCU072 -00680 * EXEC CICS DTSCU072 -00681 * LINK DTSCU072 -00682 * PROGRAM ('DTSCU071') DTSCU072 -00683 * COMMAREA (L071-COMM-AREA) DTSCU072 -00684 * END-EXEC. DTSCU072 -00685 *S071-EXIT. DTSCU072 -00686 * EXIT. DTSCU072 -00687 ****************** S899-ABEND NOT USED. DTSCU072 -00688 *S899-ABEND. DTSCU072 -00689 * SKIP1 DTSCU072 -00690 * EXEC CICS DTSCU072 -00691 * ABEND DTSCU072 -00692 * ABCODE (WRK-ABEND-CODE) DTSCU072 -00693 * END-EXEC. DTSCU072 -00694 * SKIP1 DTSCU072 -00695 *S899-EXIT. DTSCU072 -00696 * EXIT. DTSCU072 +00591 IF FC-ZIP-BYPASSED-88 DTSCU072 +00592 OR FC-ZIP-BAD-88 DTSCU072 +00593 MOVE MSG-E083-AREA TO L072-MSG-AREA DTSCU072 +00594 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 +00595 GO TO P2130-EXIT. DTSCU072 +00596 DTSCU072 +00597 IF FC-BOTH-ADDR-BAD-88 DTSCU072 +00598 MOVE MSG-E086-AREA TO L072-MSG-AREA DTSCU072 +00599 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 +00600 GO TO P2130-EXIT. DTSCU072 +00601 DTSCU072 +00602 IF FINAL-RETURN-CODE1 NOT = '0' DTSCU072 +00603 IF FC-SUFDIR-MULTI-88 DTSCU072 +00604 MOVE MSG-E085-AREA TO L072-MSG-AREA DTSCU072 +00605 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 +00606 GO TO P2130-EXIT DTSCU072 +00607 ELSE DTSCU072 +00608 MOVE MSG-E082-AREA TO L072-MSG-AREA DTSCU072 +00609 SET L072-ZIP-NOT-VALID-88 TO TRUE DTSCU072 +00610 GO TO P2130-EXIT. DTSCU072 +00611 P2130-EXIT. DTSCU072 +00612 EXIT. DTSCU072 +00613 EJECT DTSCU072 +00614 P2200-NO-CASS. DTSCU072 +00615 IF (L072-DELIV-LINE-1 NOT = SPACES) DTSCU072 +00616 AND DTSCU072 +00617 (L072-DELIV-LINE-2 = SPACES) DTSCU072 +00618 MOVE L072-DELIV-LINE-1 TO L072-DELIV-LINE-2 DTSCU072 +00619 MOVE SPACES TO L072-DELIV-LINE-1 DTSCU072 +00620 SET L072-DELIV-LINE-1-CHANGED-88 DTSCU072 +00621 L072-DELIV-LINE-2-CHANGED-88 TO TRUE. DTSCU072 +00622 DTSCU072 +00623 IF L072-DELIV-LINE-2 = SPACES DTSCU072 +00624 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 +00625 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 +00626 GO TO P2200-EXIT. DTSCU072 +00627 DTSCU072 +00628 IF L072-CITY = SPACE DTSCU072 +00629 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 +00630 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 +00631 GO TO P2200-EXIT. DTSCU072 +00632 DTSCU072 +00633 * IF L072-ZIP = SPACES CL**5 +00634 * MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA CL**5 +00635 * SET L072-ZIP-NOT-VALID-88 TO TRUE CL**5 +00636 * GO TO P2200-EXIT. CL**5 +00637 DTSCU072 +00638 IF L072-ZIP (1:5) NOT NUMERIC CL**3 +00639 * OR L072-ZIP (1:5) = '00000' CL**3 +00640 MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA CL**3 +00641 SET L072-ZIP-NOT-VALID-88 TO TRUE CL**3 +00642 GO TO P2200-EXIT. CL**4 +00643 CL**4 +00644 IF L072-ZIP (7:4) = SPACES CL**4 +00645 GO TO P2200-EXIT CL**4 +00646 ELSE CL**4 +00647 IF L072-ZIP (7:4) NOT NUMERIC CL**4 +00648 MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA CL**3 +00649 SET L072-ZIP-NOT-VALID-88 TO TRUE. CL**3 +00650 * MOVE SPACE TO L072-ZIP (6:5) CL**3 +00651 * SET L072-ZIP-CHANGED-88 TO TRUE. CL**3 +00652 * IF L072-ZIP (1:5) NOT NUMERIC CL**3 +00653 * OR L072-ZIP (1:5) = '00000' CL**3 +00654 * MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA CL**3 +00655 * SET L072-ZIP-NOT-VALID-88 TO TRUE CL**3 +00656 * ELSE CL**3 +00657 * IF L072-ZIP (6:5) NOT = SPACE CL**3 +00658 * MOVE SPACE TO L072-ZIP (6:5) CL**3 +00659 * SET L072-ZIP-CHANGED-88 TO TRUE. CL**3 +00660 P2200-EXIT. DTSCU072 +00661 EXIT. DTSCU072 +00662 EJECT DTSCU072 +00663 P3000-FOREIGN-ADDRESS. DTSCU072 +00664 SET L072-NO-CASS-EDITS-88 TO TRUE. DTSCU072 +00665 DTSCU072 +00666 IF L072-ZIP = ALL '*' DTSCU072 +00667 NEXT SENTENCE DTSCU072 +00668 ELSE DTSCU072 +00669 MOVE ALL '*' TO L072-ZIP DTSCU072 +00670 SET L072-ZIP-CHANGED-88 TO TRUE. DTSCU072 +00671 DTSCU072 +00672 IF L072-DELIV-LINE-1 = SPACES DTSCU072 +00673 SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE DTSCU072 +00674 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 +00675 GO TO P3000-EXIT. DTSCU072 +00676 DTSCU072 +00677 IF L072-DELIV-LINE-2 = SPACES DTSCU072 +00678 SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE DTSCU072 +00679 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 +00680 GO TO P3000-EXIT. DTSCU072 +00681 DTSCU072 +00682 IF L072-CITY = SPACES DTSCU072 +00683 SET L072-CITY-NOT-VALID-88 TO TRUE DTSCU072 +00684 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCU072 +00685 GO TO P3000-EXIT. DTSCU072 +00686 P3000-EXIT. DTSCU072 +00687 EXIT. DTSCU072 +00688 EJECT DTSCU072 +00689 S1000-LINK-TO-FINALIST. DTSCU072 +00690 EXEC CICS DTSCU072 +00691 LINK DTSCU072 +00692 PROGRAM ('FINALOL') DTSCU072 +00693 COMMAREA (FINAL-CALL-AREA) DTSCU072 +00694 END-EXEC. DTSCU072 +00695 S1000-EXIT. DTSCU072 +00696 EXIT. DTSCU072 +00697 SKIP3 DTSCU072 +00698 ****************** S071-NAME-CONVERT NOT USED. DTSCU072 +00699 *S071-NAME-CONVERT. DTSCU072 +00700 * EXEC CICS DTSCU072 +00701 * LINK DTSCU072 +00702 * PROGRAM ('DTSCU071') DTSCU072 +00703 * COMMAREA (L071-COMM-AREA) DTSCU072 +00704 * END-EXEC. DTSCU072 +00705 *S071-EXIT. DTSCU072 +00706 * EXIT. DTSCU072 +00707 ****************** S899-ABEND NOT USED. DTSCU072 +00708 *S899-ABEND. DTSCU072 +00709 * SKIP1 DTSCU072 +00710 * EXEC CICS DTSCU072 +00711 * ABEND DTSCU072 +00712 * ABCODE (WRK-ABEND-CODE) DTSCU072 +00713 * END-EXEC. DTSCU072 +00714 * SKIP1 DTSCU072 +00715 *S899-EXIT. DTSCU072 +00716 * EXIT. DTSCU072 diff --git a/CICSFiles.txt b/CICSFiles.txt index a6c1f97..a3fe8a9 100644 --- a/CICSFiles.txt +++ b/CICSFiles.txt @@ -1,4 +1,4 @@ -E:\Faizan_Folder\DUTAS_DEV_UPDATE\DUTAS\CICS\DTSCS26.cob +E:\Faizan_Folder\DUTAS_DEV_UPDATE\DUTAS\CICS\DTSCSL1.cob diff --git a/Copybook/CODEDATE.cpy b/Copybook/CODEDATE.cpy new file mode 100644 index 0000000..cb2c7e1 --- /dev/null +++ b/Copybook/CODEDATE.cpy @@ -0,0 +1,10 @@ +00001 04/29/04 +00002 *************************************************************** CODEDATE +00003 * COBOL 2 SYSTEM DATE, TIME, DAY AND DAY-OF-WEEK * LV001 +00004 *************************************************************** CODEDATE +00005 CODEDATE +00006 ACCEPT WS-SYSTEM-DATE FROM DATE. CODEDATE +00007 ACCEPT WS-SYSTEM-TIME FROM TIME. CODEDATE +00008 ACCEPT WS-SYSTEM-DAY FROM DAY. CODEDATE +00009 ACCEPT WS-SYSTEM-DOW FROM DAY-OF-WEEK. CODEDATE +00010 CODEDATE diff --git a/Copybook/DOESXLBL.cpy b/Copybook/DOESXLBL.cpy new file mode 100644 index 0000000..59c72cc --- /dev/null +++ b/Copybook/DOESXLBL.cpy @@ -0,0 +1,27 @@ +00001 ***** 01/31/03 +00002 * DOESXLBL +00003 * DOESXLBL XEROX LASER DEFINITIONS PRINTING LABELS LV001 +00004 * DOESXLBL +00005 * YY-YY-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DOESXLBL +00006 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DOESXLBL +00007 * REFERENCE RFP #**** PROGRAMMER: XXX DOESXLBL +00008 * DOESXLBL +00009 ***** DOESXLBL +00010 ******************************************************************DOESXLBL +00011 * XEROX LASER DEFINITION *DOESXLBL +00012 ******************************************************************DOESXLBL +00013 01 XEROX-CNTL-LINE1. DOESXLBL +00014 05 XEROX-DJDE PIC X(12) VALUE '$X9700$DJDE '. DOESXLBL +00015 05 XEROX-JDL PIC X(09) VALUE 'JDL=XMOM,'. DOESXLBL +00016 05 XEROX-JDE PIC X(11) VALUE 'JDE=X2PLBL,'. DOESXLBL +00017 05 XEROX-ASSIGN PIC X(13) VALUE 'ASSIGN=(1,1),'. DOESXLBL +00018 05 XEROX-BEGIN PIC X(18) VALUE DOESXLBL +00019 'BEGIN=(0.05,0.05),'. DOESXLBL +00020 05 XEROX-TOF PIC X(06) VALUE 'TOF=1,'. DOESXLBL +00021 05 XEROX-BOF PIC X(08) VALUE 'BOF=100,'. DOESXLBL +00022 05 XEROX-LINE-END PIC X(4) VALUE 'END;'. DOESXLBL +00023 01 XEROX-CNTL-LINE2. DOESXLBL +00024 05 FILLER PIC X. DOESXLBL +00025 05 XEROX-DJDE PIC X(12) VALUE '$X9700$DJDE '. DOESXLBL +00026 05 XEROX-LINE-END PIC X(4) VALUE 'END;'. DOESXLBL +00027 DOESXLBL diff --git a/Copybook/DTSES140.cpy b/Copybook/DTSES140.cpy new file mode 100644 index 0000000..32fec4c --- /dev/null +++ b/Copybook/DTSES140.cpy @@ -0,0 +1,45 @@ +00001 ***** 10/02/24 +00002 * DTSES140 +00003 * DTSES140 ESSP TAX REPORT EXTRACT RECORD LV005 +00004 * DTSES140 +00005 * EXCHANGES EMPLOYER TAX REPORTS BETWEEN MAINFRAME AND DTSES140 +00006 * SQL SERVER DATABASE. DTSES140 +00007 * DTSES140 +00008 * 05/04/2010 ADDED CHECK SCAN DATE, CHECK SEQUENCE NBR, DTSES140 +00009 * LEVEL-88 FOR REPORTS FROM IN-HOUSE CASHIERING, DTSES140 +00010 * INTEREST AND PENALTY WAIVER INDICATORS, DTSES140 +00011 * RESPONSIBLE OPID AND ACTIVITY. GD DTSES140 +00012 ***** DTSES140 +00013 DTSES140 +00014 15 X140-REC-TYPE PIC X(03) VALUE '140'. DTSES140 +00015 15 FILLER PIC X(01) VALUE ','. DTSES140 +00016 15 X140-EMP-NO PIC 9(06). DTSES140 +00017 15 FILLER PIC X(01) VALUE ','. DTSES140 +00018 15 X140-QUARTER PIC X(06). DTSES140 +00019 15 FILLER PIC X(01) VALUE ','. DTSES140 +00020 15 X140-REP-TYPE PIC X(08). CL**2 +00021 15 FILLER PIC X(01) VALUE ','. DTSES140 +00022 15 X140-REP-EMPLEE-CNT PIC X(08). CL**2 +00023 15 FILLER PIC X(01) VALUE ','. CL**2 +00024 15 X140-EXCESS-WAGE PIC ----------9.99. CL**5 +00025 15 FILLER PIC X(01) VALUE ','. DTSES140 +00026 15 X140-TAX-WAGE PIC ----------9.99. CL**4 +00027 15 FILLER PIC X(01) VALUE ','. DTSES140 +00028 15 X140-TOTAL-WAGE PIC ----------9.99. CL**4 +00029 15 FILLER PIC X(01) VALUE ','. CL**2 +00030 15 X140-SUBM PIC X(04). CL**2 +00031 15 FILLER PIC X(01) VALUE ','. CL**2 +00032 15 X140-RCVD-DATE PIC X(10). CL**2 +00033 15 FILLER PIC X(01) VALUE ','. CL**2 +00034 15 X140-WRKR-CNT-1ST-MNTH PIC 9(08). CL**2 +00035 15 FILLER PIC X(01) VALUE ','. DTSES140 +00036 15 X140-WRKR-CNT-2ND-MNTH PIC 9(08). CL**2 +00037 15 FILLER PIC X(01) VALUE ','. DTSES140 +00038 15 X140-WRKR-CNT-3RD-MNTH PIC 9(08). CL**2 +00039 15 FILLER PIC X(01) VALUE ','. DTSES140 +00040 15 X140-RPT-SUBM PIC X(04). CL**2 +00041 15 FILLER PIC X(01) VALUE ','. DTSES140 +00042 15 X140-REMITTANCE PIC 9(11).99. CL**2 +00043 15 FILLER PIC X(01) VALUE ','. CL**2 +00044 15 X140-RESP-OPID PIC X(06). CL**2 +00045 15 FILLER PIC X(363). CL**2 diff --git a/Copybook/DTSES144.cpy b/Copybook/DTSES144.cpy new file mode 100644 index 0000000..9cd74cc --- /dev/null +++ b/Copybook/DTSES144.cpy @@ -0,0 +1,41 @@ +00001 ***** 10/02/24 +00002 * DTSES144 +00003 * DTSIX144 EMPLOYEE WAGE EXTRACT RECORD LV001 +00004 * DTSES144 +00005 * IMPORTS EMPLOYEE WAGES AND NAME FROM EXTERNAL DTSES144 +00006 * APPLICATIONS. DTSES144 +00007 * DTSES144 +00008 * 02-23-2012 MODIFIED SOURCE CODES TO MATCH DTSIW001. GD DTSES144 +00009 * 06-11-2012 ADDED INTRANET REPORTS TO WAGE STATUS. GD DTSES144 +00010 * DTSES144 +00011 * DTSES144 +00012 ***** DTSES144 +00013 DTSES144 +00014 15 X144-REC-TYPE PIC X(03) VALUE '144'. DTSES144 +00015 15 FILLER PIC X(01) VALUE ','. DTSES144 +00016 15 X144-EMP-NO PIC 9(06). DTSES144 +00017 15 FILLER PIC X(01) VALUE ','. DTSES144 +00018 15 X144-QUARTER PIC X(06). DTSES144 +00019 15 FILLER PIC X(01) VALUE ','. DTSES144 +00020 15 X144-SSN PIC 9(09). DTSES144 +00021 15 FILLER PIC X(01) VALUE ','. DTSES144 +00022 15 X144-WAGE-STATUS PIC X(01). DTSES144 +00023 88 X144-ICESA-88 VALUE '1'. DTSES144 +00024 88 X144-PAPER-RPT-88 VALUE '2'. DTSES144 +00025 88 X144-WAGE-ONLY-DISK-88 VALUE '3'. DTSES144 +00026 88 X144-ANNUAL-RPT-88 VALUE '4'. DTSES144 +00027 88 X144-WEB-RPT-88 VALUE '5'. DTSES144 +00028 88 X144-AMEND-RPT-88 VALUE '6'. DTSES144 +00029 88 X144-BENEFITS-88 VALUE '7'. DTSES144 +00030 88 X144-INTRANET-RPT-88 VALUE '8'. DTSES144 +00031 88 X144-CLAIMNT-WAGE-88 VALUE '9'. DTSES144 +00032 88 X144-UNKNOWN-88 VALUE '0'. DTSES144 +00033 15 FILLER PIC X(01) VALUE ','. DTSES144 +00034 15 X144-EARNINGS PIC --------9.99. DTSES144 +00035 15 FILLER PIC X(01) VALUE ','. DTSES144 +00036 15 X144-LAST-NAME PIC X(20). DTSES144 +00037 15 FILLER PIC X(01) VALUE ','. DTSES144 +00038 15 X144-FIRST-NAME PIC X(15). DTSES144 +00039 15 FILLER PIC X(01) VALUE ','. DTSES144 +00040 15 X144-MID-INIT PIC X(01). DTSES144 +00041 15 FILLER PIC X(432). DTSES144 diff --git a/Copybook/DTSES147.cpy b/Copybook/DTSES147.cpy new file mode 100644 index 0000000..5dcfeb9 --- /dev/null +++ b/Copybook/DTSES147.cpy @@ -0,0 +1,43 @@ +00001 ***** 10/02/24 +00002 * DTSES147 +00003 * DTSIX147 EMPLOYEE AMENDED WAGES TO BE DELETED LV001 +00004 * DTSES147 +00005 * IMPORTS EMPLOYEE WAGES AND NAME FROM EXTERNAL DTSES147 +00006 * APPLICATIONS. DTSES147 +00007 * DTSES147 +00008 * 02-23-2012 MODIFIED SOURCE CODES TO MATCH DTSIW001. GD DTSES147 +00009 * 06-11-2012 ADDED INTRANET REPORTS TO WAGE STATUS. GD DTSES147 +00010 * 09-01-2015 COPIED FROM IX147, USED FOR AMENDED WAGES ZL1 DTSES147 +00011 * DTSES147 +00012 * DTSES147 +00013 ***** DTSES147 +00014 DTSES147 +00015 15 X147-REC-TYPE PIC X(03) VALUE '147'. DTSES147 +00016 15 FILLER PIC X(01) VALUE ','. DTSES147 +00017 15 X147-EMP-NO PIC 9(06). DTSES147 +00018 15 FILLER PIC X(01) VALUE ','. DTSES147 +00019 15 X147-QUARTER PIC X(06). DTSES147 +00020 15 FILLER PIC X(01) VALUE ','. DTSES147 +00021 15 X147-SSN PIC 9(09). DTSES147 +00022 15 FILLER PIC X(01) VALUE ','. DTSES147 +00023 15 X147-WAGE-STATUS PIC X(01). DTSES147 +00024 88 X147-ICESA-88 VALUE '1'. DTSES147 +00025 88 X147-PAPER-RPT-88 VALUE '2'. DTSES147 +00026 88 X147-WAGE-ONLY-DISK-88 VALUE '3'. DTSES147 +00027 88 X147-ANNUAL-RPT-88 VALUE '4'. DTSES147 +00028 88 X147-WEB-RPT-88 VALUE '5'. DTSES147 +00029 88 X147-AMEND-RPT-88 VALUE '6'. DTSES147 +00030 88 X147-BENEFITS-88 VALUE '7'. DTSES147 +00031 88 X147-INTRANET-RPT-88 VALUE '8'. DTSES147 +00032 88 X147-CLAIMNT-WAGE-88 VALUE '9'. DTSES147 +00033 88 X147-UNKNOWN-88 VALUE '0'. DTSES147 +00034 15 FILLER PIC X(01) VALUE ','. DTSES147 +00035 * 15 X147-EARNINGS PIC --------9.99. DTSES147 +00036 15 X147-EARNINGS PIC 9(11)V99. DTSES147 +00037 15 FILLER PIC X(01) VALUE ','. DTSES147 +00038 15 X147-LAST-NAME PIC X(20). DTSES147 +00039 15 FILLER PIC X(01) VALUE ','. DTSES147 +00040 15 X147-FIRST-NAME PIC X(15). DTSES147 +00041 15 FILLER PIC X(01) VALUE ','. DTSES147 +00042 15 X147-MID-INIT PIC X(01). DTSES147 +00043 15 FILLER PIC X(431). DTSES147 diff --git a/Copybook/DTSEX145.cpy b/Copybook/DTSEX145.cpy new file mode 100644 index 0000000..9100d9f --- /dev/null +++ b/Copybook/DTSEX145.cpy @@ -0,0 +1,41 @@ +00001 ***** 04/04/18 +00002 * DTSEX145 +00003 * DTSIX145 EMPLOYER PAYMENT EXTRACT RECORD LV007 +00004 * DTSEX145 +00005 * EXCHANGES EMPLOYER PAYMENT DATA BETWEEN MAINFRAME AND DTSEX145 +00006 * SQL SERVER DATABASE. DTSEX145 +00007 * DTSEX145 +00008 * 05/04/2010 ADDED CHECK SCAN DATE, CHECK SEQUENCE NBR, DTSEX145 +00009 * LEVEL-88 FOR PAYMENTS FROM IN-HOUSE CASHIERING, DTSEX145 +00010 * INTEREST AND PENALTY WAIVER INDICATORS, DTSEX145 +00011 * RESPONSIBLE OPID AND ACTIVITY. GD DTSEX145 +00012 * DTSEX145 +00013 * 11/17/2010 CHANGED LENGTH OF SOURCE TO ONE BYTE. ADDED DTSEX145 +00014 * X145-TO-WEB-88 FOR DATA SENT TO THE WEB DTSEX145 +00015 * DATABASE FROM THE MAINFRAME. GD DTSEX145 +00016 ***** DTSEX145 +00017 DTSEX145 +00018 15 E145-REC-TYPE PIC X(03) VALUE '145'. CL**3 +00019 15 FILLER PIC X(01) VALUE ','. DTSEX145 +00020 15 E145-EMP-NO PIC 9(06). CL**3 +00021 15 FILLER PIC X(01) VALUE ','. DTSEX145 +00022 15 E145-QTR PIC X(06). CL**3 +00023 15 FILLER PIC X(01) VALUE ','. DTSEX145 +00024 15 FILLER PIC X(06). CL**3 +00025 15 FILLER PIC X(01) VALUE ','. CL**3 +00026 15 FILLER PIC X(03). CL**5 +00027 15 FILLER PIC X(01) VALUE ','. CL**3 +00028 15 FILLER PIC X(02). CL**3 +00029 15 FILLER PIC X(01) VALUE ','. CL**3 +00030 15 FILLER PIC X(02). CL**3 +00031 15 FILLER PIC X(01) VALUE ','. CL**3 +00032 15 FILLER PIC X(02). CL**3 +00033 15 FILLER PIC X(01) VALUE ','. CL**3 +00034 15 E145-REMITTANCE PIC 9(11).99. CL**7 +00035 15 FILLER PIC X(01) VALUE ','. DTSEX145 +00036 15 E145-RECV-DATE PIC X(10). CL**3 +00037 15 FILLER PIC X(01) VALUE ','. CL**3 +00038 15 FILLER PIC X(10). CL**3 +00039 15 FILLER PIC X(01) VALUE ','. CL**3 +00040 15 E145-TRACE-NO PIC X(08). CL**3 +00041 15 FILLER PIC X(429). CL**5 diff --git a/Copybook/DTSHX145.cpy b/Copybook/DTSHX145.cpy new file mode 100644 index 0000000..5fc2658 --- /dev/null +++ b/Copybook/DTSHX145.cpy @@ -0,0 +1,41 @@ +00001 ***** 04/04/18 +00002 * DTSHX145 +00003 * DTSIX145 EMPLOYER PAYMENT EXTRACT RECORD LV008 +00004 * DTSHX145 +00005 * EXCHANGES EMPLOYER PAYMENT DATA BETWEEN MAINFRAME AND DTSHX145 +00006 * SQL SERVER DATABASE. DTSHX145 +00007 * DTSHX145 +00008 * 05/04/2010 ADDED CHECK SCAN DATE, CHECK SEQUENCE NBR, DTSHX145 +00009 * LEVEL-88 FOR PAYMENTS FROM IN-HOUSE CASHIERING, DTSHX145 +00010 * INTEREST AND PENALTY WAIVER INDICATORS, DTSHX145 +00011 * RESPONSIBLE OPID AND ACTIVITY. GD DTSHX145 +00012 * DTSHX145 +00013 * 11/17/2010 CHANGED LENGTH OF SOURCE TO ONE BYTE. ADDED DTSHX145 +00014 * X145-TO-WEB-88 FOR DATA SENT TO THE WEB DTSHX145 +00015 * DATABASE FROM THE MAINFRAME. GD DTSHX145 +00016 ***** DTSHX145 +00017 DTSHX145 +00018 15 H145-REC-TYPE PIC X(03) VALUE '145'. CL**7 +00019 15 FILLER PIC X(01) VALUE ','. DTSHX145 +00020 15 H145-EMP-NO PIC 9(06). CL**7 +00021 15 FILLER PIC X(01) VALUE ','. DTSHX145 +00022 15 H145-QTR PIC X(06). CL**7 +00023 15 FILLER PIC X(01) VALUE ','. DTSHX145 +00024 15 FILLER PIC X(06). CL**3 +00025 15 FILLER PIC X(01) VALUE ','. CL**3 +00026 15 FILLER PIC X(03). CL**5 +00027 15 FILLER PIC X(01) VALUE ','. CL**3 +00028 15 FILLER PIC X(02). CL**3 +00029 15 FILLER PIC X(01) VALUE ','. CL**3 +00030 15 FILLER PIC X(02). CL**3 +00031 15 FILLER PIC X(01) VALUE ','. CL**3 +00032 15 FILLER PIC X(02). CL**3 +00033 15 FILLER PIC X(01) VALUE ','. CL**3 +00034 15 H145-REMITTANCE PIC 9(11).99. CL**8 +00035 15 FILLER PIC X(01) VALUE ','. DTSHX145 +00036 15 H145-RECV-DATE PIC X(10). CL**7 +00037 15 FILLER PIC X(01) VALUE ','. CL**3 +00038 15 FILLER PIC X(10). CL**3 +00039 15 FILLER PIC X(01) VALUE ','. CL**3 +00040 15 H145-TRACE-NO PIC X(08). CL**7 +00041 15 FILLER PIC X(429). CL**5 diff --git a/Copybook/DTSIL941.TXT b/Copybook/DTSIL941.TXT new file mode 100644 index 0000000..5674433 --- /dev/null +++ b/Copybook/DTSIL941.TXT @@ -0,0 +1,28 @@ +00001 ***** 09/30/98 +00002 * DTSIL941 +00003 * DTSIL941 VARIABLE LENGTH RECORD FILE INPUT LINKAGE. LV002 +00004 * DTSIL941 +00005 * DTSIL941 AND (DTSIRSK1 OR DTSIRSK2 OR DTSIRSK3) DEFINE CL**2 +00006 * THE LINKAGE AREAS TO DTSCU941 (VARIABLE LENGTH RECORD CL**2 +00007 * FILE INPUT). DTSIL941 +00008 * DTSIL941 +00009 * CL**2 +00010 * 09/30/1998 REVIEWED AND MODIFIED FOR DC. EHH CL**2 +00011 * CL**2 +00012 ***** DTSIL941 +00013 CL**2 +00014 10 L941-TRACE-IND PIC X(01). DTSIL941 +00015 88 L941-TRACE-88 VALUE 'T'. DTSIL941 +00016 CL**2 +00017 10 L941-MOD-NAME PIC X(08). DTSIL941 +00018 CL**2 +00019 10 L941-CMND-CD PIC X(03). DTSIL941 +00020 88 L941-OPEN-READ-88 VALUE 'OPR'. DTSIL941 +00021 88 L941-READ-NEXT-88 VALUE 'RDN'. DTSIL941 +00022 88 L941-CLOSE-88 VALUE 'CL '. DTSIL941 +00023 CL**2 +00024 10 FILLER PIC X(51). DTSIL941 +00025 CL**2 +00026 10 L941-RESULT-IND PIC X(01). DTSIL941 +00027 88 L941-OK-88 VALUE '0'. DTSIL941 +00028 88 L941-NO-REC-88 VALUE '1'. DTSIL941 diff --git a/Copybook/DTSIW119.cpy b/Copybook/DTSIW119.cpy new file mode 100644 index 0000000..5a0e7e4 --- /dev/null +++ b/Copybook/DTSIW119.cpy @@ -0,0 +1,289 @@ +00001 *Modified: z. lalputan 01/29/20 +00002 *Date: 12 december 2019 DTSIW119 +00003 * LV007 +00004 SKIP2 DTSIW119 +00005 01 GENERIC-LETTER. DTSIW119 +00006 05 GEN-LINE-1 PIC X(133) VALUE SPACES. DTSIW119 +00007 05 GEN-LINE-2 PIC X(133) VALUE SPACES. DTSIW119 +00008 05 GEN-LINE-3. DTSIW119 +00009 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00010 10 FILLER PIC X(50) VALUE CL**2 +00011 'The District of Columbia Unemployment Insurance Ta'. CL**7 +00012 10 FILLER PIC X(40) CL**2 +00013 VALUE 'x Division has received and processed'. CL**2 +00014 05 GEN-LINE-4. CL**2 +00015 10 FILLER PIC X(02) VALUE SPACES. CL**2 +00016 10 FILLER PIC X(44) VALUE CL**2 +00017 'your request to close your employer account '. CL**2 +00018 10 gen-emp-no PIC 9(06). CL**5 +00019 10 filler PIC X(01) VALUE '.'. CL**2 +00020 10 FILLER PIC X(40) CL**2 +00021 VALUE ' This notice confirms that '. CL**6 +00022 05 GEN-LINE-5. CL**2 +00023 10 FILLER PIC X(02) VALUE SPACES. CL**2 +00024 10 FILLER PIC X(50) VALUE CL**2 +00025 'your account has been closed. Please note that th'. CL**2 +00026 10 FILLER PIC X(40) CL**2 +00027 VALUE 'e inactivation of this account also '. CL**2 +00028 05 GEN-LINE-6. CL**2 +00029 10 FILLER PIC X(02) VALUE SPACES. CL**2 +00030 10 FILLER PIC X(50) VALUE CL**2 +00031 'terminates all user access via the Employer Self S'. CL**4 +00032 10 FILLER PIC X(40) CL**2 +00033 VALUE 'ervice Portal (ESSP). Any balance due'. CL**4 +00034 05 GEN-LINE-7. CL**2 +00035 10 FILLER PIC X(02) VALUE SPACES. CL**2 +00036 10 FILLER PIC X(50) VALUE CL**2 +00037 'or missing wage reports must be submitted via regu'. CL**4 +00038 10 FILLER PIC X(40) CL**2 +00039 VALUE 'lar U.S. mail to DOES - UI Tax '. CL**4 +00040 05 GEN-LINE-8. CL**2 +00041 10 FILLER PIC X(02) VALUE SPACES. CL**2 +00042 10 FILLER PIC X(50) VALUE CL**2 +00043 'Division, P.O. Box 96664, Washingtion, DC 20019. '. CL**4 +00044 10 FILLER PIC X(40) CL**2 +00045 VALUE ' '. CL**2 +00046 05 gen-LINE-9 PIC X(133) VALUE SPACES. CL**2 +00047 05 gen-LINE-10 PIC X(133) VALUE SPACES. CL**2 +00048 05 GEN-LINE-11. CL**2 +00049 10 FILLER PIC X(02) VALUE SPACES. CL**2 +00050 10 FILLER PIC X(50) VALUE CL**2 +00051 'Reimbursable employers, please be advised that you'. CL**4 +00052 10 FILLER PIC X(40) CL**2 +00053 VALUE ' may be responsible for reimbursing '. CL**4 +00054 05 GEN-LINE-12. CL**3 +00055 10 FILLER PIC X(02) VALUE SPACES. CL**3 +00056 10 FILLER PIC X(50) VALUE CL**3 +00057 'the Unemployment Trust Fund for Unemployment Insur'. CL**6 +00058 10 FILLER PIC X(40) CL**3 +00059 VALUE 'ance Benefits paid to former employees'. CL**4 +00060 05 GEN-LINE-13. CL**3 +00061 10 FILLER PIC X(02) VALUE SPACES. CL**3 +00062 10 FILLER PIC X(50) VALUE CL**3 +00063 'up to five (5) quarters after your inactivation ef'. CL**4 +00064 10 FILLER PIC X(40) CL**3 +00065 VALUE 'fective date. For more information, '. CL**4 +00066 05 GEN-LINE-14. CL**3 +00067 10 FILLER PIC X(02) VALUE SPACES. CL**3 +00068 10 FILLER PIC X(50) VALUE CL**3 +00069 'please submit your inquires to UITax.Info@dc.gov. '. CL**4 +00070 10 FILLER PIC X(40) CL**3 +00071 VALUE ' '. CL**3 +00072 05 gen-LINE-15 pic x(90) value spaces. CL**3 +00073 05 gen-LINE-16 pic x(90) value spaces. CL**3 +00074 05 gen-LINE-17. CL**3 +00075 10 FILLER PIC X(02) VALUE SPACES. CL**3 +00076 10 FILLER PIC X(49) VALUE CL**3 +00077 'If you resume paying wages in the District of Col'. CL**3 +00078 10 FILLER PIC X(36) CL**3 +00079 VALUE 'umbia within three (3) years of the '. CL**3 +00080 05 gen-LINE-18. CL**3 +00081 10 FILLER PIC X(02) VALUE SPACES. CL**3 +00082 10 FILLER PIC X(49) VALUE CL**3 +00083 'last active quarter, please submit a written requ'. CL**3 +00084 10 FILLER PIC X(36) CL**3 +00085 VALUE 'est to reopen your account at '. CL**3 +00086 05 gen-LINE-19. CL**3 +00087 10 FILLER PIC X(02) VALUE SPACES. CL**3 +00088 10 FILLER PIC X(50) VALUE CL**3 +00089 'UITax.Info@dc.gov '. CL**3 +00090 SKIP2 DTSIW119 +00091 01 DEMAND-LETTER. DTSIW119 +00092 05 DML-LINE-1 PIC X(133) VALUE SPACES. DTSIW119 +00093 05 DML-LINE-2 PIC X(133) VALUE SPACES. DTSIW119 +00094 05 DML-LINE-3. DTSIW119 +00095 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00096 10 FILLER PIC X(50) VALUE DTSIW119 +00097 'The Unemployment Insurance Division requires that '. DTSIW119 +00098 10 FILLER PIC X(40) DTSIW119 +00099 VALUE 'an employer file a Contribution and '. DTSIW119 +00100 05 DML-LINE-4. DTSIW119 +00101 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00102 10 FILLER PIC X(50) VALUE DTSIW119 +00103 'Wage Report and submit payment upon termination of'. DTSIW119 +00104 10 FILLER PIC X(50) VALUE DTSIW119 +00105 ' your account. '. DTSIW119 +00106 05 DML-LINE-5 PIC X(133) VALUE SPACES. DTSIW119 +00107 05 DML-LINE-6. DTSIW119 +00108 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00109 10 FILLER PIC X(50) VALUE DTSIW119 +00110 'Please complete and return the enclosed Contributi'. DTSIW119 +00111 10 FILLER PIC X(40) DTSIW119 +00112 VALUE 'on and Wage Report with payment.'. DTSIW119 +00113 05 DML-LINE-7. DTSIW119 +00114 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00115 10 FILLER PIC X(50) VALUE DTSIW119 +00116 'If payment is not received WITHIN 30 DAYS, taxes a'. DTSIW119 +00117 10 FILLER PIC X(40) DTSIW119 +00118 VALUE 're subject to penalty and interest. '. DTSIW119 +00119 05 DML-LINE-9 PIC X(133) VALUE SPACES. DTSIW119 +00120 05 DML-LINE-10. DTSIW119 +00121 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00122 10 FILLER PIC X(40) DTSIW119 +00123 VALUE 'If you have any questions, please contac'. DTSIW119 +00124 10 FILLER PIC X(40) DTSIW119 +00125 VALUE 't me. '. DTSIW119 +00126 SKIP2 DTSIW119 +00127 01 EIGHT-QTR-NONES-LETTER. DTSIW119 +00128 05 EQN-LINE-1 PIC X(133) VALUE SPACES. DTSIW119 +00129 05 EQN-LINE-2 PIC X(133) VALUE SPACES. DTSIW119 +00130 05 EQN-LINE-3. DTSIW119 +00131 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00132 10 FILLER PIC X(50) VALUE DTSIW119 +00133 'In accordance with U.S. Department of Labor regula'. DTSIW119 +00134 10 FILLER PIC X(37) DTSIW119 +00135 VALUE 'tions, the District of Columbia '. DTSIW119 +00136 05 EQN-LINE-4. DTSIW119 +00137 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00138 10 FILLER PIC X(50) VALUE DTSIW119 +00139 'Unemployment Insurance Tax Division is required to'. DTSIW119 +00140 10 FILLER PIC X(40) DTSIW119 +00141 VALUE ' administratively inactivate your '. DTSIW119 +00142 05 EQN-LINE-41. DTSIW119 +00143 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00144 10 FILLER PIC X(50) VALUE DTSIW119 +00145 'employer account due to no-wage reports filed or n'. DTSIW119 +00146 10 FILLER PIC X(38) DTSIW119 +00147 VALUE 'o reports filed for the last (8) '. DTSIW119 +00148 05 EQN-LINE-42. DTSIW119 +00149 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00150 10 FILLER PIC X(50) VALUE DTSIW119 +00151 'consecutive calendar quarters. The last day of the'. DTSIW119 +00152 10 FILLER PIC X(36) DTSIW119 +00153 VALUE ' eight no-wage quarter determines '. DTSIW119 +00154 05 EQN-LINE-43. DTSIW119 +00155 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00156 10 FILLER PIC X(50) VALUE DTSIW119 +00157 'the account effective date of inactivation. '. DTSIW119 +00158 05 EQN-LINE-44. DTSIW119 +00159 10 FILLER PIC X(90) VALUE SPACES. DTSIW119 +00160 05 EQN-LINE-45. DTSIW119 +00161 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00162 10 FILLER PIC X(50) VALUE DTSIW119 +00163 'Your account has been administratively inactivated'. DTSIW119 +00164 10 FILLER PIC X(11) DTSIW119 +00165 VALUE ' effective '. DTSIW119 +00166 10 eqn-eff-date PIC X(10). DTSIW119 +00167 10 FILLER PIC X(10) DTSIW119 +00168 VALUE '. Please'. DTSIW119 +00169 05 EQN-LINE-46. DTSIW119 +00170 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00171 10 FILLER PIC X(50) VALUE DTSIW119 +00172 'note that the inactivation of this account also te'. DTSIW119 +00173 10 FILLER PIC X(36) DTSIW119 +00174 VALUE 'rminates all user access via the '. DTSIW119 +00175 05 EQN-LINE-47. DTSIW119 +00176 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00177 10 FILLER PIC X(50) VALUE DTSIW119 +00178 'Employer Self Service Portal (ESSP). Any balance d'. DTSIW119 +00179 10 FILLER PIC X(36) DTSIW119 +00180 VALUE 'ue or missing wage reports must be '. DTSIW119 +00181 05 EQN-LINE-48. DTSIW119 +00182 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00183 10 FILLER PIC X(50) VALUE DTSIW119 +00184 'submitted via regular U.S. mail to DOES - UI Tax '. DTSIW119 +00185 10 FILLER PIC X(36) DTSIW119 +00186 VALUE 'Division, P.O. Box 96664, '. DTSIW119 +00187 05 EQN-LINE-49. DTSIW119 +00188 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00189 10 FILLER PIC X(50) VALUE DTSIW119 +00190 'Washington, DC 20019. '. DTSIW119 +00191 10 FILLER PIC X(36) DTSIW119 +00192 VALUE ' '. DTSIW119 +00193 05 EQN-LINE-50 pic x(90) value spaces. DTSIW119 +00194 05 EQN-LINE-51. DTSIW119 +00195 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00196 10 FILLER PIC X(49) VALUE DTSIW119 +00197 'If you resume paying wages in the District of Col'. DTSIW119 +00198 10 FILLER PIC X(36) DTSIW119 +00199 VALUE 'umbia within three (3) years of the '. DTSIW119 +00200 05 EQN-LINE-52. DTSIW119 +00201 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00202 10 FILLER PIC X(49) VALUE DTSIW119 +00203 'last active quarter, please submit a written requ'. DTSIW119 +00204 10 FILLER PIC X(36) DTSIW119 +00205 VALUE 'est to reopen your account at '. DTSIW119 +00206 05 EQN-LINE-53. DTSIW119 +00207 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00208 10 FILLER PIC X(50) VALUE DTSIW119 +00209 'UITax.Info@dc.gov '. DTSIW119 +00210 * 05 EQN-LINE-5. DTSIW119 +00211 * 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00212 * 10 FILLER PIC X(50) VALUE DTSIW119 +00213 * 'uitax.info@dc.gov '. DTSIW119 +00214 05 EQN-LINE-11 PIC X(133) VALUE SPACES. DTSIW119 +00215 05 EQN-LINE-12. DTSIW119 +00216 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00217 10 FILLER PIC X(50) VALUE DTSIW119 +00218 ' '. DTSIW119 +00219 10 FILLER PIC X(36) DTSIW119 +00220 VALUE ' '. DTSIW119 +00221 05 EQN-LINE-14. DTSIW119 +00222 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00223 10 FILLER PIC X(50) value DTSIW119 +00224 ' '. DTSIW119 +00225 10 FILLER PIC X(36) value DTSIW119 +00226 ' '. DTSIW119 +00227 05 EQN-LINE-141. DTSIW119 +00228 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00229 10 FILLER PIC X(50) value DTSIW119 +00230 ' '. DTSIW119 +00231 SKIP2 DTSIW119 +00232 01 LETTER-FOOTING. DTSIW119 +00233 05 LTF-LINE-1 PIC X(133) VALUE SPACES. DTSIW119 +00234 05 LTF-LINE-2. DTSIW119 +00235 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00236 10 FILLER PIC X(40) DTSIW119 +00237 VALUE 'Sincerely, '. DTSIW119 +00238 05 LTF-LINE-6 PIC X(133) VALUE SPACES. DTSIW119 +00239 05 LTF-LINE-7. DTSIW119 +00240 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00241 10 filler PIC X(50) value DTSIW119 +00242 'Office of Unemployment Compensation - UI Tax Divis'. DTSIW119 +00243 10 FILLER PIC X(16) DTSIW119 +00244 VALUE 'ion '. DTSIW119 +00245 05 LTF-LINE-8. DTSIW119 +00246 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00247 10 FILLER PIC X(50) DTSIW119 +00248 value 'Department of Employment services'. DTSIW119 +00249 05 LTF-LINE-9. DTSIW119 +00250 10 FILLER PIC X(08) VALUE SPACES. DTSIW119 +00251 10 FILLER PIC X(16) DTSIW119 +00252 VALUE 'Telephone (202) '. DTSIW119 +00253 10 WS-OPR-VOICE-ONE PIC X(03). DTSIW119 +00254 10 FILLER PIC X(01) DTSIW119 +00255 VALUE '-'. DTSIW119 +00256 10 WS-OPR-VOICE-TWO PIC X(04). DTSIW119 +00257 DTSIW119 +00258 01 LETTER-FOOTIN2. DTSIW119 +00259 05 LF2-LINE-1 PIC X(133) VALUE SPACES. DTSIW119 +00260 05 LF2-LINE-2. DTSIW119 +00261 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00262 10 FILLER PIC X(40) DTSIW119 +00263 VALUE 'Sincerely, '. DTSIW119 +00264 05 LF2-LINE-6 PIC X(133) VALUE SPACES. DTSIW119 +00265 05 LF2-LINE-7. DTSIW119 +00266 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00267 * 10 WS-OPR-NAME-FOOTER2 PIC X(32). DTSIW119 +00268 10 FILLER PIC X(55) DTSIW119 +00269 value 'Office of Unemployment Compensation - Tax Division'.DTSIW119 +00270 05 LF2-LINE-8. DTSIW119 +00271 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00272 10 FILLER PIC X(50) DTSIW119 +00273 value 'Department of Employment Services '.DTSIW119 +00274 05 LF2-LINE-9. DTSIW119 +00275 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00276 10 FILLER PIC X(20) DTSIW119 +00277 VALUE 'UITax.Info@dc.gov'. DTSIW119 +00278 * 10 WS-OPR-VOICE-ONE2 PIC X(03). DTSIW119 +00279 * 10 FILLER PIC X(01) DTSIW119 +00280 * VALUE '-'. DTSIW119 +00281 * 10 WS-OPR-VOICE-TWO2 PIC X(04). DTSIW119 +00282 05 LF2-LINE-10. DTSIW119 +00283 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00284 10 FILLER PIC X(20) DTSIW119 +00285 VALUE 'Phone:(202)-698-7550'. DTSIW119 +00286 05 LF2-LINE-11. DTSIW119 +00287 10 FILLER PIC X(02) VALUE SPACES. DTSIW119 +00288 10 FILLER PIC X(20) DTSIW119 +00289 VALUE 'TTY:(202)-698-4817'. DTSIW119 diff --git a/Copybook/DTSIX102.cpy b/Copybook/DTSIX102.cpy index d878461..7e0c561 100644 --- a/Copybook/DTSIX102.cpy +++ b/Copybook/DTSIX102.cpy @@ -1,57 +1,57 @@ -00001 ***** 02/26/08 +00001 ***** 08/29/23 00002 * DTSIX102 -00003 * DTSIX102 EMPLOYER PROFILE EXTRACT RECORD LV001 +00003 * DTSIX102 EMPLOYER PROFILE RECORD LV003 00004 * DTSIX102 -00005 * EXCHANGES EMPLOYER PROFILE INFORMATION BETWEEN MAINFRAME AND DTSIX102 -00006 * SQL SERVER DATABASE. DTSIX102 -00007 * DTSIX102 -00008 * DTSIX102 -00009 ***** DTSIX102 -00010 DTSIX102 -00011 15 X102-REC-TYPE PIC X(03) VALUE '102'. DTSIX102 +00005 ***** DTSIX102 +00006 DTSIX102 +00007 15 X102-REC-TYPE PIC X(03) VALUE '102'. DTSIX102 +00008 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00009 15 X102-EMP-NO PIC 9(06). DTSIX102 +00010 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00011 15 X102-EMP-FEIN PIC 9(09). DTSIX102 00012 15 FILLER PIC X(01) VALUE ','. DTSIX102 -00013 15 X102-EMP-NO PIC 9(06). DTSIX102 -00014 15 FILLER PIC X(01) VALUE ','. DTSIX102 -00015 15 X102-EMP-FEIN PIC 9(09). DTSIX102 -00016 15 FILLER PIC X(01) VALUE ','. DTSIX102 -00017 15 X102-EMP-CLASS PIC X(01). DTSIX102 -00018 88 X102-CLASS-RATED-88 VALUE 'R'. DTSIX102 -00019 88 X102-CLASS-SELF-INS-88 VALUE 'S'. DTSIX102 -00020 15 FILLER PIC X(01) VALUE ','. DTSIX102 -00021 15 X102-EMP-STATUS PIC X(01). DTSIX102 -00022 88 X102-STATUS-ACTIVE-88 VALUE 'A'. DTSIX102 -00023 88 X102-STATUS-INACTIVE-88 VALUE 'I'. DTSIX102 -00024 88 X102-STATUS-NOT-SUB-88 VALUE 'N'. DTSIX102 -00025 88 X102-STATUS-UNKNOWN-88 VALUE 'U'. DTSIX102 -00026 15 FILLER PIC X(01) VALUE ','. DTSIX102 -00027 15 X102-SOURCE-CD PIC X(02). DTSIX102 -00028 88 X102-CONTRACT-CMPL-88 VALUE '00'. DTSIX102 -00029 88 X102-PHONE-CALL-88 VALUE '01'. DTSIX102 -00030 88 X102-WRITTEN-REQUEST-88 VALUE '02'. DTSIX102 -00031 88 X102-VOLUNTARY-88 VALUE '03'. DTSIX102 -00032 88 X102-UC30-OF-PRED-88 VALUE '04'. DTSIX102 -00033 88 X102-BENEFITS-88 VALUE '05'. DTSIX102 -00034 88 X102-940-CERTIFICATION-88 VALUE '06'. DTSIX102 -00035 88 X102-UNION-HALL-88 VALUE '07'. DTSIX102 -00036 88 X102-FIELD-REP-88 VALUE '08'. DTSIX102 -00037 88 X102-FOLLOW-UP-88 VALUE '09'. DTSIX102 -00038 88 X102-OTR-88 VALUE '10'. DTSIX102 -00039 88 X102-WORKERS-COMP-88 VALUE '11'. DTSIX102 -00040 88 X102-LIQUOR-LIC-88 VALUE '12'. DTSIX102 -00041 88 X102-FEIN-LIST-88 VALUE '13'. DTSIX102 -00042 88 X102-UC30-STAFF-88 VALUE '14'. DTSIX102 -00043 88 X102-UC30-SYS-88 VALUE '15'. DTSIX102 -00044 88 X102-UC30-88 VALUE '14', '15'. DTSIX102 -00045 88 X102-FISCAL-AGENT-88 VALUE '16'. DTSIX102 -00046 88 X102-WEB-REG-88 VALUE '17'. DTSIX102 -00047 88 X102-WEB-REG-PRED-88 VALUE '18'. DTSIX102 -00048 88 X102-WEB-REG-SUCC-88 VALUE '19'. DTSIX102 -00049 88 X102-WEB-88 VALUE DTSIX102 -00050 '17' THRU '19'. DTSIX102 -00051 88 X102-SOURCE-CD-VALID-88 VALUE DTSIX102 -00052 '00' THRU '19'. DTSIX102 -00053 15 FILLER PIC X(01) VALUE ','. DTSIX102 -00054 15 X102-ACTION-CD PIC X(01). DTSIX102 -00055 88 X102-ACTION-INSERT-88 VALUE 'I'. DTSIX102 -00056 88 X102-ACTION-UPDATE-88 VALUE 'U'. DTSIX102 -00057 88 X102-ACTION-DELETE-88 VALUE 'D'. DTSIX102 +00013 15 X102-EMP-CLASS PIC X(01). DTSIX102 +00014 88 X102-CLASS-RATED-88 VALUE 'R'. DTSIX102 +00015 88 X102-CLASS-SELF-INS-88 VALUE 'S'. DTSIX102 +00016 88 X102-CLASS-CD-VALID-88 VALUE 'R' 'S'. CL**2 +00017 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00018 15 X102-EMP-STATUS PIC X(01). DTSIX102 +00019 88 X102-STATUS-ACTIVE-88 VALUE 'A'. DTSIX102 +00020 88 X102-STATUS-INACTIVE-88 VALUE 'I'. DTSIX102 +00021 88 X102-STATUS-NOT-SUB-88 VALUE 'N'. DTSIX102 +00022 88 X102-STATUS-UNKNOWN-88 VALUE 'U'. DTSIX102 +00023 88 X102-STATUS-CD-VALID-88 VALUE 'A' 'I' CL**2 +00024 'N' 'U'. CL**2 +00025 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00026 15 X102-SOURCE-CD PIC X(02). DTSIX102 +00027 88 X102-CONTRACT-CMPL-88 VALUE '00'. DTSIX102 +00028 88 X102-PHONE-CALL-88 VALUE '01'. DTSIX102 +00029 88 X102-WRITTEN-REQUEST-88 VALUE '02'. DTSIX102 +00030 88 X102-VOLUNTARY-88 VALUE '03'. DTSIX102 +00031 88 X102-UC30-OF-PRED-88 VALUE '04'. DTSIX102 +00032 88 X102-BENEFITS-88 VALUE '05'. DTSIX102 +00033 88 X102-940-CERTIFICATION-88 VALUE '06'. DTSIX102 +00034 88 X102-UNION-HALL-88 VALUE '07'. DTSIX102 +00035 88 X102-FIELD-REP-88 VALUE '08'. DTSIX102 +00036 88 X102-FOLLOW-UP-88 VALUE '09'. DTSIX102 +00037 88 X102-OTR-88 VALUE '10'. DTSIX102 +00038 88 X102-WORKERS-COMP-88 VALUE '11'. DTSIX102 +00039 88 X102-LIQUOR-LIC-88 VALUE '12'. DTSIX102 +00040 88 X102-FEIN-LIST-88 VALUE '13'. DTSIX102 +00041 88 X102-UC30-STAFF-88 VALUE '14'. DTSIX102 +00042 88 X102-UC30-SYS-88 VALUE '15'. DTSIX102 +00043 88 X102-UC30-88 VALUE '14', '15'. DTSIX102 +00044 88 X102-FISCAL-AGENT-88 VALUE '16'. DTSIX102 +00045 88 X102-WEB-REG-88 VALUE '17'. DTSIX102 +00046 88 X102-WEB-REG-PRED-88 VALUE '18'. DTSIX102 +00047 88 X102-WEB-REG-SUCC-88 VALUE '19'. DTSIX102 +00048 88 X102-WEB-88 VALUE DTSIX102 +00049 '17' THRU '19'. DTSIX102 +00050 88 X102-SOURCE-CD-VALID-88 VALUE DTSIX102 +00051 '00' THRU '19'. DTSIX102 +00052 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00053 15 X102-ACTION-CD PIC X(01). DTSIX102 +00054 88 X102-ACTION-INSERT-88 VALUE 'I'. DTSIX102 +00055 88 X102-ACTION-UPDATE-88 VALUE 'U'. DTSIX102 +00056 88 X102-ACTION-DELETE-88 VALUE 'D'. DTSIX102 +00057 88 X102-ACTION-CD-VALID-88 VALUE 'I' 'U' 'D'. CL**2 diff --git a/Copybook/DTSIX305.cpy b/Copybook/DTSIX305.cpy index 8f52edc..00bb4e3 100644 --- a/Copybook/DTSIX305.cpy +++ b/Copybook/DTSIX305.cpy @@ -7,7 +7,7 @@ 00007 * DTSIX305 00008 * DTSIX305 00009 ***** DTSIX305 -00010 DTSIX305 +00010 ***** 01 X305. DTSIX305 00011 10 X305-BATCH-AGY PIC X(03). DTSIX305 00012 10 X305-BATCH-DATE-X PIC X(08). DTSIX305 00013 10 X305-BATCH-DATE-9 REDEFINES X305-BATCH-DATE-X DTSIX305 diff --git a/Copybook/DTSIY102.cpy b/Copybook/DTSIY102.cpy new file mode 100644 index 0000000..739b1f8 --- /dev/null +++ b/Copybook/DTSIY102.cpy @@ -0,0 +1,61 @@ +00001 ***** 02/26/08 +00002 * DTSIX102 +00003 * DTSIX102 EMPLOYER PROFILE EXTRACT RECORD LV001 +00004 * DTSIX102 +00005 * EXCHANGES EMPLOYER PROFILE INFORMATION BETWEEN MAINFRAME AND DTSIX102 +00006 * SQL SERVER DATABASE. DTSIX102 +00007 * DTSIX102 +00008 * DTSIX102 +00009 ***** DTSIX102 +00010 DTSIX102 +00011 15 X102-REC-TYPE PIC X(03) VALUE '102'. DTSIX102 +00012 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00013 15 X102-EMP-NO PIC 9(06). DTSIX102 +00014 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00015 15 X102-EMP-FEIN PIC 9(09). DTSIX102 +00016 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00017 15 X102-EMP-CLASS PIC X(01). DTSIX102 +00018 88 X102-CLASS-RATED-88 VALUE 'R'. DTSIX102 +00019 88 X102-CLASS-SELF-INS-88 VALUE 'S'. DTSIX102 +00020 88 X102-CLASS-CD-VALID-88 VALUE 'R', 'S'. DTSIX102 +00021 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00022 15 X102-EMP-STATUS PIC X(01). DTSIX102 +00023 88 X102-STATUS-ACTIVE-88 VALUE 'A'. DTSIX102 +00024 88 X102-STATUS-INACTIVE-88 VALUE 'I'. DTSIX102 +00025 88 X102-STATUS-NOT-SUB-88 VALUE 'N'. DTSIX102 +00026 88 X102-STATUS-UNKNOWN-88 VALUE 'U'. DTSIX102 +00027 88 X102-STATUS-CD-VALID-88 VALUE 'A' 'I' DTSIX102 +00028 'N', 'U'. DTSIX102 +00029 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00030 15 X102-SOURCE-CD PIC X(02). DTSIX102 +00031 88 X102-CONTRACT-CMPL-88 VALUE '00'. DTSIX102 +00032 88 X102-PHONE-CALL-88 VALUE '01'. DTSIX102 +00033 88 X102-WRITTEN-REQUEST-88 VALUE '02'. DTSIX102 +00034 88 X102-VOLUNTARY-88 VALUE '03'. DTSIX102 +00035 88 X102-UC30-OF-PRED-88 VALUE '04'. DTSIX102 +00036 88 X102-BENEFITS-88 VALUE '05'. DTSIX102 +00037 88 X102-940-CERTIFICATION-88 VALUE '06'. DTSIX102 +00038 88 X102-UNION-HALL-88 VALUE '07'. DTSIX102 +00039 88 X102-FIELD-REP-88 VALUE '08'. DTSIX102 +00040 88 X102-FOLLOW-UP-88 VALUE '09'. DTSIX102 +00041 88 X102-OTR-88 VALUE '10'. DTSIX102 +00042 88 X102-WORKERS-COMP-88 VALUE '11'. DTSIX102 +00043 88 X102-LIQUOR-LIC-88 VALUE '12'. DTSIX102 +00044 88 X102-FEIN-LIST-88 VALUE '13'. DTSIX102 +00045 88 X102-UC30-STAFF-88 VALUE '14'. DTSIX102 +00046 88 X102-UC30-SYS-88 VALUE '15'. DTSIX102 +00047 88 X102-UC30-88 VALUE '14', '15'. DTSIX102 +00048 88 X102-FISCAL-AGENT-88 VALUE '16'. DTSIX102 +00049 88 X102-WEB-REG-88 VALUE '17'. DTSIX102 +00050 88 X102-WEB-REG-PRED-88 VALUE '18'. DTSIX102 +00051 88 X102-WEB-REG-SUCC-88 VALUE '19'. DTSIX102 +00052 88 X102-WEB-88 VALUE DTSIX102 +00053 '17' THRU '19'. DTSIX102 +00054 88 X102-SOURCE-CD-VALID-88 VALUE DTSIX102 +00055 '00' THRU '19'. DTSIX102 +00056 15 FILLER PIC X(01) VALUE ','. DTSIX102 +00057 15 X102-ACTION-CD PIC X(01). DTSIX102 +00058 88 X102-ACTION-INSERT-88 VALUE 'I'. DTSIX102 +00059 88 X102-ACTION-UPDATE-88 VALUE 'U'. DTSIX102 +00060 88 X102-ACTION-DELETE-88 VALUE 'D'. DTSIX102 + 88 X102-ACTION-CD-VALID-88 VALUE 'I', 'U', 'D'. DTSIX102 diff --git a/Copybook/DTSNH104.cpy b/Copybook/DTSNH104.cpy new file mode 100644 index 0000000..6923728 --- /dev/null +++ b/Copybook/DTSNH104.cpy @@ -0,0 +1,132 @@ +00001 ***** 01/11/19 +00002 * DTSNH104 +00003 * DTSIX104 EMPLOYER DETERMINATION EXTRACT RECORD LV016 +00004 * DTSNH104 +00005 * EXCHANGES EMPLOYER DETERMINATION INFORMATION BETWEEN THE DTSNH104 +00006 * MAINFRAME AND SQL SERVER DATABASE. DTSNH104 +00007 * DTSNH104 +00008 * DTSNH104 +00009 ***** DTSNH104 +00010 DTSNH104 +00011 15 X104-REC-TYPE PIC X(03) VALUE '104'. DTSNH104 +00012 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00013 15 X104-EMP-NO PIC 9(06). DTSNH104 +00014 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00015 15 X104-STAFF-REVIEW-IND PIC X(01). DTSNH104 +00016 88 X104-STAFF-REVIEW-YES-88 VALUE 'Y'. CL**3 +00017 88 X104-STAFF-REVIEW-NO-88 VALUE 'N'. CL**3 +00018 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00019 15 X104-LIAB-CD PIC X(02). DTSNH104 +00020 88 X104-LIAB-NO-DETERM-88 VALUE ' '. DTSNH104 +00021 88 X104-LIAB-NOT-LIABLE-88 VALUE '00'. DTSNH104 +00022 88 X104-LIAB-RATED-REG-88 VALUE '01'. DTSNH104 +00023 88 X104-LIAB-RATED-NON-PROF-88 VALUE '02'. DTSNH104 +00024 88 X104-LIAB-RATED-DOMESTIC-88 VALUE '04'. DTSNH104 +00025 88 X104-LIAB-RATED-FOREIGN-88 VALUE '07'. DTSNH104 +00026 88 X104-LIAB-SELF-INS-CITY-88 VALUE '22'. DTSNH104 +00027 88 X104-LIAB-SELF-INS-COUNTY-88 VALUE '23'. DTSNH104 +00028 88 X104-LIAB-SELF-INS-STATE-88 VALUE '24'. DTSNH104 +00029 88 X104-LIAB-SELF-INS-CHURCH-88 VALUE '25'. DTSNH104 +00030 88 X104-LIAB-SELF-INS-NON-PROF-88 VALUE '26'. DTSNH104 +00031 88 X104-LIAB-RATED-88 VALUE DTSNH104 +00032 '01' '02' '04' '07'. DTSNH104 +00033 88 X104-LIAB-SELF-INS-88 VALUE DTSNH104 +00034 '22' '23' '24' '25' '26'. DTSNH104 +00035 88 X104-LIAB-VALID-88 VALUE DTSNH104 +00036 '00' '01' '02' '04' '07' '22' '23' '24' '25' '26'. DTSNH104 +00037 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00038 15 X104-ELIG-CD PIC X(02). DTSNH104 +00039 88 X104-ELIG-NO-DETERM-88 VALUE ' '. DTSNH104 +00040 88 X104-ELIG-RATED-88 VALUE '00'. DTSNH104 +00041 88 X104-ELIG-UCX-88 VALUE '01'. DTSNH104 +00042 88 X104-ELIG-UCFE-88 VALUE '02'. DTSNH104 +00043 88 X104-ELIG-INTERSTATE-88 VALUE '04'. DTSNH104 +00044 88 X104-ELIG-VOLUNTARY-QUIT-88 VALUE '05'. CL**8 +00045 88 X104-ELIG-MISCONDUCT-88 VALUE '06'. CL**8 +00046 88 X104-ELIG-EB-88 VALUE '07'. CL**8 +00047 88 X104-ELIG-SELF-INS-88 VALUE '08'. DTSNH104 +00048 88 X104-ELIG-TRA-88 VALUE '09'. CL**8 +00049 88 X104-ELIG-DC-GOV-88 VALUE '10'. DTSNH104 +00050 88 X104-ELIG-NOT-SUBJECT-88 VALUE '13'. DTSNH104 +00051 88 X104-ELIG-TEUC-88 VALUE '16'. CL**8 +00052 88 X104-ELIG-VALID-88 VALUE DTSNH104 +00053 ' ' '00' '01' '02' '04' '05' '06' '07' CL**8 +00054 '08' '09' '10' '13' '16'. CL**8 +00055 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00056 15 X104-NAICS-CD PIC 9(06). DTSNH104 +00057 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00058 15 X104-ORG-TYPE PIC X(03). DTSNH104 +00059 88 X104-ORG-SOLE-PROPRIETOR-88 VALUE 'S '. DTSNH104 +00060 88 X104-ORG-PARTNERSHIP-88 VALUE 'P '. DTSNH104 +00061 88 X104-ORG-LTD-LIAB-CO-88 VALUE 'LLC'. DTSNH104 +00062 88 X104-ORG-LTD-LIAB-PARTN-88 VALUE 'LLP'. DTSNH104 +00063 88 X104-ORG-CORPORATION-88 VALUE 'C '. DTSNH104 +00064 88 X104-ORG-J-JOINT-VENT-88 VALUE 'J '. CL**4 +00065 88 X104-ORG-S-CORPORATION-88 VALUE 'SC '. CL**4 +00066 88 X104-ORG-TRUST-BANK-88 VALUE 'TB '. CL**5 +00067 88 X104-ORG-RECEIVERSHIP-88 VALUE 'R '. CL**5 +00068 88 X104-ORG-TRUST-PENSION-88 VALUE 'TP '. CL*13 +00069 88 X104-ORG-ASSOCIATION-88 VALUE 'ASS'. CL**5 +00070 88 X104-ORG-HSEHLD-DMSTIC-88 VALUE 'H '. CL**5 +00071 88 X104-ORG-NON-PROFIT-88 VALUE 'NP '. DTSNH104 +00072 88 X104-ORG-OTH-NON-GOV-88 VALUE 'ONG'. DTSNH104 +00073 88 X104-ORG-UNINC-ASSOC-88 VALUE 'UNA'. CL*14 +00074 88 X104-ORG-FED-IND-TRIBE-88 VALUE 'FIT'. CL*14 +00075 88 X104-ORG-OTH-88 VALUE 'OTH'. CL*14 +00076 88 X104-ORG-STATE-88 VALUE 'ST'. DTSNH104 +00077 88 X104-ORG-COUNTY-88 VALUE 'CO '. DTSNH104 +00078 88 X104-ORG-CITY-88 VALUE 'CTY'. DTSNH104 +00079 88 X104-ORG-SCHOOL-DISTRICT-88 VALUE 'SCH'. DTSNH104 +00080 88 X104-ORG-FORGN-GOV-88 VALUE 'FG '. DTSNH104 +00081 88 X104-ORG-OTH-GOV-88 VALUE 'OG '. DTSNH104 +00082 88 X104-ORG-UNKNOWN-88 VALUE 'UNK'. CL*11 +00083 88 X104-ORG-TYPE-VALID-88 VALUE DTSNH104 +00084 'S ', 'P ', 'LLC', 'LLP', 'C ', 'SC ', DTSNH104 +00085 'H ', 'NP ', 'ONG', 'ST ', 'CO ', 'CTY', DTSNH104 +00086 'SCH', 'FG ', 'OG ', 'J ', 'TB ', 'R ', CL*13 +00087 'ASS', 'TP ', 'UNK', 'UNA', 'FIT', 'OTH'. CL*14 +00088 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00089 15 X104-INCORP-STATE PIC X(02). DTSNH104 +00090 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00091 15 X104-INCORP-DATE PIC X(10). DTSNH104 +00092 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00093 15 X104-HOUSEHOLD-FILING PIC X(01). DTSNH104 +00094 88 X104-HH-ANNUAL-88 VALUE 'A'. DTSNH104 +00095 88 X104-HH-QUARTERLY-88 VALUE 'Q'. DTSNH104 +00096 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00097 15 X104-FIRST-WAGE-DT PIC X(10). DTSNH104 +00098 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00099 15 X104-FIRST-500-QTR PIC X(06). DTSNH104 +00100 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00101 15 X104-ACQUIRE-IND PIC X(01). DTSNH104 +00102 88 X104-ACQUIRE-YES-88 VALUE 'Y'. CL**2 +00103 88 X104-ACQUIRE-NO-88 VALUE 'N'. CL**2 +00104 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00105 15 X104-MERGER-SPLIT-IND PIC X(01). DTSNH104 +00106 88 X104-MERGE-SPLIT-YES-88 VALUE 'Y'. CL**2 +00107 88 X104-MERGE-SPLIT-NO-88 VALUE 'N'. CL**2 +00108 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00109 15 X104-REORG-IND PIC X(01). DTSNH104 +00110 88 X104-REORG-YES-88 VALUE 'Y'. CL**2 +00111 88 X104-REORG-NO-88 VALUE 'N'. CL**2 +00112 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00113 15 X104-COMMON-OWN-IND PIC X(01). DTSNH104 +00114 88 X104-COMMON-OWN-YES-88 VALUE 'Y'. CL**2 +00115 88 X104-COMMON-OWN-NO-88 VALUE 'N'. CL**2 +00116 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00117 15 X104-SALE-TRANSFER-IND PIC X(01). DTSNH104 +00118 88 X104-SALE-TRANSFER-YES-88 VALUE 'Y'. CL**2 +00119 88 X104-SALE-TRANSFER-NO-88 VALUE 'N'. CL**2 +00120 15 FILLER PIC X(01) VALUE ','. DTSNH104 +00121 15 X104-NOT-LIAB-REASON PIC X(01). CL*16 +00122 88 X104-NOT-LIAB-NULL-88 VALUE '0'. DTSNH104 +00123 88 X104-NOT-LIAB-BUS-ACT-88 VALUE '1'. DTSNH104 +00124 88 X104-NOT-LIAB-NO-EMPL-88 VALUE '2'. DTSNH104 +00125 88 X104-NOT-LIAB-NO-WAGES-88 VALUE '3'. DTSNH104 +00126 88 X104-NOT-LIAB-LOCALIZE-88 VALUE '4'. DTSNH104 +00127 88 X104-NOT-LIAB-VALID-88 VALUES DTSNH104 +00128 '0' '1' '2' '3' '4'. DTSNH104 +00129 15 FILLER PIC X(01) VALUE ','. CL*12 +00130 15 X104-INACTIVE-DATE PIC X(10). CL*12 +00131 15 FILLER PIC X(01) VALUE ','. CL*15 +00132 15 X104-INACTIVE-CODE PIC X(02). CL*16 diff --git a/Copybook/DTSUX110.cpy b/Copybook/DTSUX110.cpy new file mode 100644 index 0000000..21a66fc --- /dev/null +++ b/Copybook/DTSUX110.cpy @@ -0,0 +1,43 @@ +00001 ***** 11/28/18 +00002 * DTSUX110 +00003 * DTSUX110 COPY OF EMPLOYER ADDRESS EXTRACT RECORD (X110) LV006 +00004 * DTSUX110 +00005 * THIS COPYBOOK IS USED TO UPDATE THE EMPLOYER ADDRESS INFO CL**4 +00006 * ON THE MAILING AND BUSINESS OPO ADDRESS NOT UPDATED CL**5 +00007 * DTSUX110 +00008 * ADDED FILLER AT END FOR REC LEN 512 09/23/14 ZL1 CL**4 +00009 ***** DTSUX110 +00010 DTSUX110 +00011 15 X110-REC-TYPE PIC X(03) VALUE '110'. DTSUX110 +00012 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00013 15 X110-EMP-NO PIC 9(06). DTSUX110 +00014 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00015 15 X110-ADDR-TYPE PIC X(02). DTSUX110 +00016 88 X110-ADDR-TYPE-MAIL-88 VALUE '01'. DTSUX110 +00017 88 X110-ADDR-TYPE-RECS-88 VALUE '02'. DTSUX110 +00018 88 X110-ADDR-TYPE-WORK-88 VALUE '03'. DTSUX110 +00019 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00020 15 X110-ATTENTION PIC X(40). DTSUX110 +00021 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00022 15 X110-STREET-1 PIC X(40). DTSUX110 +00023 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00024 15 X110-STREET-2 PIC X(40). DTSUX110 +00025 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00026 15 X110-CITY PIC X(25). DTSUX110 +00027 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00028 15 X110-STATE PIC X(02). DTSUX110 +00029 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00030 15 X110-ZIP PIC X(10). DTSUX110 +00031 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00032 15 X110-PHONE PIC X(15). DTSUX110 +00033 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00034 15 X110-FAX PIC X(15). DTSUX110 +00035 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00036 15 X110-EMAIL PIC X(40). DTSUX110 +00037 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00038 15 X110-WEB-SITE PIC X(40). DTSUX110 +00039 15 FILLER PIC X(01) VALUE ','. DTSUX110 +00040 15 X110-EMP-NAME PIC X(40). DTSUX110 +00041 15 FILLER PIC X(01) VALUE ','. CL**6 +00042 15 X110-QAS-FLAG PIC X(01). CL**6 +00043 15 FILLER PIC X(179). CL**6 diff --git a/Copybook/DTSWX120.cpy b/Copybook/DTSWX120.cpy new file mode 100644 index 0000000..e45c506 --- /dev/null +++ b/Copybook/DTSWX120.cpy @@ -0,0 +1,62 @@ +00001 ***** 03/25/15 +00002 * DTSWX120 +00003 * DTSWX120 EMPLOYER OWNER/PARNTER-OFFICER EXTRACT RECORD. LV005 +00004 * DTSWX120 +00005 * EXCHANGES OWNER/PARTNER/OFFICER DATA BETWEEN MAINFRAME AND DTSWX120 +00006 * SQL SERVER DATABASE. DTSWX120 +00007 * DTSWX120 +00008 * 11-10-14 ESSP IS PASSING COMMAS IN ADDRESS FIELDS, OUR CL**2 +00009 * DELIMITER IN BX205 IS A COMMA FIELDS ARE BEING CL**2 +00010 * CUTOFF, TO FIX PROBLEM DO NOT CALL BX205 FOR CL**2 +00011 * ADDRESSES. MODIFIED W120 RECORD TO PASS ONLY CL**4 +00012 * SIZE NEEDED FROM ESSP TO X120 ZL1 CL**4 +00013 ***** DTSWX120 +00014 DTSWX120 +00015 15 W120-REC-TYPE PIC X(03) VALUE '120'. CL**4 +00016 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00017 15 W120-EMP-NO PIC 9(06). CL**4 +00018 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00019 15 W120-TYPE-IND PIC X(02). CL**4 +00020 88 W120-TYPE-OPO-88 VALUE '00'. CL**4 +00021 88 W120-TYPE-RPT-BSNS-88 VALUE '03'. CL**4 +00022 88 W120-TYPE-RPT-TECH-88 VALUE '04'. CL**4 +00023 88 W120-TYPE-FR500-88 VALUE '05'. CL**4 +00024 88 W120-TYPE-CHARGE-88 VALUE '06'. CL**4 +00025 88 W120-TYPE-BENEFITS-88 VALUE '07'. CL**4 +00026 88 W120-TYPE-STATUS-88 VALUE '08'. CL**4 +00027 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00028 15 W120-OPO-ESSP-FNAME. CL**4 +00029 25 W120-OPO-FIRST-NAME PIC X(20). CL**4 +00030 25 W120-OPO-FIRST-FILLER PIC X(20). CL**4 +00031 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00032 15 W120-OPO-MID-INIT PIC X(01). CL**4 +00033 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00034 15 W120-OPO-ESSP-LNAME. CL**4 +00035 25 W120-OPO-LAST-NAME PIC X(20). CL**4 +00036 25 W120-OPO-LAST-FILLER PIC X(20). CL**4 +00037 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00038 15 W120-OPO-MEMBER-NAME PIC X(40). CL**4 +00039 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00040 15 W120-OPO-SSN PIC X(09). CL**4 +00041 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00042 15 W120-OPO-TITLE PIC X(40). CL**4 +00043 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00044 15 W120-OPO-ATTENTION PIC X(40). CL**4 +00045 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00046 15 W120-OPO-STREET-1 PIC X(40). CL**4 +00047 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00048 15 W120-OPO-STREET-2 PIC X(40). CL**4 +00049 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00050 15 W120-OPO-ESSP-CITY. CL**4 +00051 25 W120-OPO-CITY PIC X(20). CL**4 +00052 25 W120-OPO-CITY-FILLER PIC X(05). CL**4 +00053 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00054 15 W120-OPO-STATE PIC X(02). CL**4 +00055 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00056 15 W120-OPO-ZIP PIC X(10). CL**4 +00057 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00058 15 W120-OPO-PHONE PIC X(15). CL**4 +00059 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00060 15 W120-OPO-FAX PIC X(16). CL**5 +00061 15 FILLER PIC X(01) VALUE ','. DTSWX120 +00062 15 W120-OPO-EMAIL PIC X(40). CL**4 diff --git a/Copybook/ESPRPT04.cpy b/Copybook/ESPRPT04.cpy index e8dfbe2..7def7e4 100644 --- a/Copybook/ESPRPT04.cpy +++ b/Copybook/ESPRPT04.cpy @@ -1,6 +1,6 @@ -00001 ******************************************************************04/18/13 +00001 ******************************************************************01/25/24 00002 ** ESPRPT04 - EMPLOYER CHARGING REPORT RECORD **ESPRPT04 -00003 *** *** LV016 +00003 *** *** LV023 00004 *** ADDED 88 LEVEL FOR TEUCA 08/18/03 BEJ *** CL*12 00005 ****************************************************************** CL*12 00006 *CHANGED REC-TYPE TO PIC X FROM PIC 9 AK 04/15/04* CL*13 @@ -24,45 +24,49 @@ 00024 88 CHARGE-OP-WAIVER VALUE 8. CL**7 00025 88 CHARGE-OTHER VALUE 9. CL**7 00026 10 CHARGE-DATE PIC 9(8) VALUE ZERO. CL**2 -00027 10 CHARGE-SHAREABLE-IND PIC 9(1) VALUE ZERO. ESPRPT04 -00028 88 CHARGE-SHAREABLE-YES VALUE 1. ESPRPT04 +00027 10 CHARGE-SHAREABLE-IND PIC X(1) VALUE SPACES. CL*22 +00028 * 88 CHARGE-SHAREABLE-YES VALUE 1. CL*22 00029 10 CHARGE-PROG-NAME PIC X(6) VALUE SPACE. ESPRPT04 00030 10 CHARGE-PAY-TYPE-BEN PIC X(2) VALUE SPACE. ESPRPT04 00031 05 CHARGE-BWE-DATE PIC 9(8) VALUE ZERO. CL**2 00032 05 CHARGE-TRAN-ID PIC X(2) VALUE SPACE. ESPRPT04 00033 05 CHARGE-OPER-ID PIC X(8) VALUE SPACE. ESPRPT04 -00034 05 CHARGE-TOT-AMT PIC S9(8)V99 VALUE ZERO. ESPRPT04 -00035 05 CHARGE-CURR-AMT PIC S9(8)V99 VALUE ZERO. ESPRPT04 -00036 05 CHARGE-BYE-DATE PIC 9(8) VALUE ZERO. CL**2 -00037 05 CHARGE-SUPP-CODE PIC X(1) VALUE SPACE. ESPRPT04 -00038 88 CHARGE-SUPP-CODE-EB VALUE 'E'. ESPRPT04 -00039 88 CHARGE-SUPP-CODE-TEUC VALUE 'T'. CL*11 -00040 88 CHARGE-SUPP-CODE-TEUCA VALUE 'A'. CL*12 -00041 05 CHARGE-PAY-TYPE PIC X(1) VALUE SPACE. ESPRPT04 -00042 05 CHARGE-NAME PIC X(32) VALUE SPACE. ESPRPT04 -00043 05 CHARGE-FILLER CL**9 -00044 REDEFINES CL**9 -00045 CHARGE-NAME. CL**9 -00046 10 CHARGE-LAST-NAME PIC X(18). CL**6 -00047 10 CHARGE-NAME-SLASH PIC X. CL**6 -00048 10 CHARGE-FIRST-NAME PIC X(12). CL**6 -00049 10 CHARGE-MIDDLE-NAME PIC X. CL**6 -00050 05 CHARGE-EMPLOYER-TYPE PIC 9(2) VALUE ZERO. ESPRPT04 -00051 88 CHARGE-EMPLOYER-CONTRIBUTORY VALUE 00. CL*10 -00052 88 CHARGE-EMPLOYER-UCX VALUE 01. CL*10 -00053 88 CHARGE-EMPLOYER-UCFE VALUE 02. CL*10 -00054 88 CHARGE-EMPLOYER-ETA-PSE VALUE 03. CL*10 -00055 88 CHARGE-EMPLOYER-INTERSTATE VALUE 04. CL*10 -00056 88 CHARGE-EMPLOYER-VOL-QUIT VALUE 05. CL*10 -00057 88 CHARGE-EMPLOYER-MISCONDUCT VALUE 06. CL*10 -00058 88 CHARGE-EMPLOYER-EB VALUE 07. CL*10 -00059 88 CHARGE-EMPLOYER-SELF-INSURED VALUE 08. CL*10 -00060 88 CHARGE-EMPLOYER-TRA VALUE 09. CL*10 -00061 88 CHARGE-EMPLOYER-DC-GOVERNMENT VALUE 10. CL*10 -00062 88 CHARGE-EMPLOYER-UI-PSE VALUE 11. CL*10 -00063 88 CHARGE-EMPLOYER-FSC VALUE 12. CL*10 -00064 88 CHARGE-EMPLOYER-DUMMY VALUE 30. CL*10 -00065 05 CHARGE-REG-ADJ-CHECK PIC 9(02) VALUE ZEROS. ESPRPT04 -00066 05 CHARGE-PROG-X PIC X(02). CL*14 -00067 05 CHARGE-PROG REDEFINES CHARGE-PROG-X PIC 9(02). CL*14 -00068 05 CHARGE-FILLER-ONE PIC X(14) VALUE SPACE. CL**4 +00034 * 05 CHARGE-TOT-AMTZ PIC -9(7)V99 VALUE ZERO. CL*19 +00035 * 05 CHARGE-TOT-AMT REDEFINES CHARGE-TOT-AMTZ PIC S9(8)V99. CL*19 +00036 05 CHARGE-TOT-AMT PIC -9(7)V99. CL*19 +00037 * 05 CHARGE-CURR-AMTZ PIC -9(7)V99 VALUE ZERO. CL*19 +00038 * 05 CHARGE-CURR-AMT REDEFINES CHARGE-CURR-AMTZ PIC S9(8)V99. CL*19 +00039 05 CHARGE-CURR-AMT PIC -9(7)V99. CL*19 +00040 05 CHARGE-BYE-DATE PIC 9(8) VALUE ZERO. CL**2 +00041 05 CHARGE-SUPP-CODE PIC X(1) VALUE SPACE. ESPRPT04 +00042 88 CHARGE-SUPP-CODE-EB VALUE 'E'. ESPRPT04 +00043 88 CHARGE-SUPP-CODE-TEUC VALUE 'T'. CL*11 +00044 88 CHARGE-SUPP-CODE-TEUCA VALUE 'A'. CL*12 +00045 05 CHARGE-PAY-TYPE PIC X(1) VALUE SPACE. ESPRPT04 +00046 05 CHARGE-NAME PIC X(32) VALUE SPACE. ESPRPT04 +00047 05 CHARGE-FILLER CL**9 +00048 REDEFINES CL**9 +00049 CHARGE-NAME. CL**9 +00050 10 CHARGE-LAST-NAME PIC X(18). CL**6 +00051 10 CHARGE-NAME-SLASH PIC X. CL**6 +00052 10 CHARGE-FIRST-NAME PIC X(12). CL**6 +00053 10 CHARGE-MIDDLE-NAME PIC X. CL**6 +00054 05 CHARGE-EMPLOYER-TYPE PIC X(2) VALUE ZERO. CL*23 +00055 * 88 CHARGE-EMPLOYER-CONTRIBUTORY VALUE 00. CL*23 +00056 * 88 CHARGE-EMPLOYER-UCX VALUE 01. CL*23 +00057 * 88 CHARGE-EMPLOYER-UCFE VALUE 02. CL*23 +00058 * 88 CHARGE-EMPLOYER-ETA-PSE VALUE 03. CL*23 +00059 * 88 CHARGE-EMPLOYER-INTERSTATE VALUE 04. CL*23 +00060 * 88 CHARGE-EMPLOYER-VOL-QUIT VALUE 05. CL*23 +00061 * 88 CHARGE-EMPLOYER-MISCONDUCT VALUE 06. CL*23 +00062 * 88 CHARGE-EMPLOYER-EB VALUE 07. CL*23 +00063 * 88 CHARGE-EMPLOYER-SELF-INSURED VALUE 08. CL*23 +00064 * 88 CHARGE-EMPLOYER-TRA VALUE 09. CL*23 +00065 * 88 CHARGE-EMPLOYER-DC-GOVERNMENT VALUE 10. CL*23 +00066 * 88 CHARGE-EMPLOYER-UI-PSE VALUE 11. CL*23 +00067 * 88 CHARGE-EMPLOYER-FSC VALUE 12. CL*23 +00068 * 88 CHARGE-EMPLOYER-DUMMY VALUE 30. CL*23 +00069 05 CHARGE-REG-ADJ-CHECK PIC X(02) VALUE ZEROS. CL*23 +00070 05 CHARGE-PROG-X PIC X(02). CL*14 +00071 05 CHARGE-PROG REDEFINES CHARGE-PROG-X PIC 9(02). CL*14 +00072 05 CHARGE-FILLER-ONE PIC X(14) VALUE SPACE. CL**4 diff --git a/Copybook/ESPRPT04.cpy.decl.xml b/Copybook/ESPRPT04.cpy.decl.xml new file mode 100644 index 0000000..3dcb063 --- /dev/null +++ b/Copybook/ESPRPT04.cpy.decl.xml @@ -0,0 +1,426 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Copybook/WSDATES.cpy b/Copybook/WSDATES.cpy new file mode 100644 index 0000000..6461e5c --- /dev/null +++ b/Copybook/WSDATES.cpy @@ -0,0 +1,5 @@ +00001 01 WS-SYSTEM-DATE-TIME. 04/29/04 +00002 05 WS-SYSTEM-DATE PIC 9(06). WSDATES +00003 05 WS-SYSTEM-TIME PIC 9(08). LV001 +00004 05 WS-SYSTEM-DAY PIC 9(05). WSDATES +00005 05 WS-SYSTEM-DOW PIC 9(01). WSDATES diff --git a/JCL/CHGBD800.jcl b/JCL/CHGBD800.jcl index fb47d69..f3b5eb8 100644 --- a/JCL/CHGBD800.jcl +++ b/JCL/CHGBD800.jcl @@ -38,7 +38,7 @@ /* 00004399 //* 00004499 //********************************************************************* 00004549 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS 00004600 +//STEP0100 EXEC PGM=SORT, SORT REPORT RECORDS 00004600 // COND=(0,LT) 00004700 //SYSOUT DD SYSOUT=* 00004800 //SORTIN DD DSN=DOESTAX.PROD.CHG.BD220.RPT.QTR142,DISP=SHR 00005099 diff --git a/JCL/DTSACH01.jcl b/JCL/DTSACH01.jcl index e6049d7..fd8eee9 100644 --- a/JCL/DTSACH01.jcl +++ b/JCL/DTSACH01.jcl @@ -30,7 +30,7 @@ //LOADLIBS INCLUDE MEMBER=DTSIJLIB 00001599 //* 00001600 //********************************************************************* 00004549 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS 00004600 +//STEP0100 EXEC PGM=SORT, SORT REPORT RECORDS 00004600 // COND=(0,LT) 00004700 //SYSOUT DD SYSOUT=* 00004800 //*ORTIN DD DSN=DOESTAX.PROD.ARCHIVE.FY2009.&FYYEAR.,DISP=SHR 00005099 @@ -55,7 +55,7 @@ //SORTWK09 DD UNIT=SYSDA,SPACE=(CYL,(100,40),RLSE) 00011099 //SORTWK10 DD UNIT=SYSDA,SPACE=(CYL,(100,40),RLSE) 00011099 //********************************************************************* 00018000 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT EMPLOYER RECORDS 00004600 +//STEP0200 EXEC PGM=SORT, SORT EMPLOYER RECORDS 00004600 // COND=(0,LT) 00004700 //SYSOUT DD SYSOUT=* 00004800 //*ORTIN DD DSN=DOESTAX.DEVL.ARCHIVE.COLLDBT,DISP=SHR 00071099 diff --git a/JCL/DTSACHZ1.jcl b/JCL/DTSACHZ1.jcl index d4d0dae..1ace89d 100644 --- a/JCL/DTSACHZ1.jcl +++ b/JCL/DTSACHZ1.jcl @@ -29,7 +29,7 @@ //LOADLIBS INCLUDE MEMBER=DTSIXLIB 00001599 //* 00001600 //********************************************************************* 00004549 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS 00004600 +//STEP0100 EXEC PGM=SORT, SORT REPORT RECORDS 00004600 // COND=(0,LT) 00004700 //SYSOUT DD SYSOUT=* 00004800 //*ORTIN DD DSN=DOESTAX.PROD.ARCHIVE.FY2009.&FYYEAR.,DISP=SHR 00005099 @@ -55,7 +55,7 @@ //SORTWK09 DD UNIT=SYSDA,SPACE=(CYL,(100,40),RLSE) 00011099 //SORTWK10 DD UNIT=SYSDA,SPACE=(CYL,(100,40),RLSE) 00011099 //********************************************************************* 00018000 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT EMPLOYER RECORDS 00004600 +//STEP0200 EXEC PGM=SORT, SORT EMPLOYER RECORDS 00004600 // COND=(0,LT) 00004700 //SYSOUT DD SYSOUT=* 00004800 //SORTIN DD DSN=DOESTAX.PROD.ARCHIVE.EMPL,DISP=SHR 00005099 diff --git a/JCL/DTSBX305.jcl b/JCL/DTSBX305.jcl index 5ae86fb..bd01af7 100644 --- a/JCL/DTSBX305.jcl +++ b/JCL/DTSBX305.jcl @@ -68,7 +68,7 @@ //* LATEST UPDATES ARE SORTED TO THE BOTTOM OF FILE 00001700 //* 00001700 //******************************************************************** -//STEP0075 EXEC PGM=SORT,PARM='VLTEST=0' SORT FTP RECORDS +//STEP0075 EXEC PGM=SORT SORT FTP RECORDS //SYSOUT DD SYSOUT=* //SORTIN DD DSN=DOESTAX.PROD.FTP.REFUND.X305IMP,DISP=SHR //SORTOUT DD DSN=DOESTAX.PROD.FTP.REFUND.X305IMP,DISP=SHR diff --git a/JCL/DTSBX460.jcl b/JCL/DTSBX460.jcl index b3a43eb..503f6ec 100644 --- a/JCL/DTSBX460.jcl +++ b/JCL/DTSBX460.jcl @@ -47,7 +47,7 @@ // SPACE=(CYL,(40,10),RLSE), 00038000 // DCB=(RECFM=FB,LRECL=333,BLKSIZE=3330) 00001700 //* 00001700 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', 00015000 +//STEP0200 EXEC PGM=SORT, 00015000 // COND=(0,NE) 00015000 //SYSOUT DD SYSOUT=(*) 00017000 //SYSPRINT DD SYSOUT=(*) 00018000 @@ -69,7 +69,7 @@ /* 00046000 //* THIS SORT STEP ALSO ELIMINATES DUPLICATES 00047000 //* 00047000 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', 00015000 +//STEP0300 EXEC PGM=SORT, 00015000 // COND=(0,NE) 00015000 //SYSOUT DD SYSOUT=(*) 00017000 //SYSPRINT DD SYSOUT=(*) 00018000 diff --git a/JCL/DTSBX552.jcl b/JCL/DTSBX552.jcl index 591cc04..d06b26f 100644 --- a/JCL/DTSBX552.jcl +++ b/JCL/DTSBX552.jcl @@ -17,7 +17,7 @@ // DD DSN=UI.&UINODE..DOCS.LOADLIB,DISP=SHR 00061000 // DD DSN=SYS1.SORTLIB,DISP=SHR 00070000 //* 00080000 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00090007 +//STEP0100 EXEC PGM=SORT, SORT TRANSACTIONS 00090007 // COND=(0,LT) 00100007 //SYSOUT DD SYSOUT=* 00110007 //* 00120007 @@ -35,7 +35,7 @@ //*SYSIN DD DSN=DOESTAX.&LVLNODE..PARMLIB(DTSSX552),DISP=SHR //SYSIN DD DSN=DOESTAX.CONV.USER.PARMLIB(DTSSX552),DISP=SHR 00213007 //* 00214007 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00216009 +//STEP0200 EXEC PGM=SORT, SORT TRANSACTIONS 00216009 // COND=(0,LT) 00217009 //SYSOUT DD SYSOUT=* 00218009 //* 00219009 @@ -53,7 +53,7 @@ //SYSIN DD DSN=DOESTAX.CONV.USER.PARMLIB(DTSSX552),DISP=SHR 00350009 //* 00360009 //* 00370041 -//STEP0150 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00380041 +//STEP0150 EXEC PGM=SORT, SORT TRANSACTIONS 00380041 // COND=(0,LT) 00390041 //SYSOUT DD SYSOUT=* 00400041 //* 00410041 diff --git a/JCL/DTSBX553.jcl b/JCL/DTSBX553.jcl index 28325f9..35478b8 100644 --- a/JCL/DTSBX553.jcl +++ b/JCL/DTSBX553.jcl @@ -17,7 +17,7 @@ // DD DSN=UI.&UINODE..DOCS.LOADLIB,DISP=SHR 00061000 // DD DSN=SYS1.SORTLIB,DISP=SHR 00070000 //* 00080000 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00090000 +//STEP0100 EXEC PGM=SORT, SORT TRANSACTIONS 00090000 // COND=(0,LT) 00100000 //SYSOUT DD SYSOUT=* 00110000 //* 00120000 @@ -34,7 +34,7 @@ //SYSIN DD DSN=DOESTAX.CONV.USER.PARMLIB(DTSSX553),DISP=SHR 00213003 //* 00214000 //* 00215001 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00216002 +//STEP0200 EXEC PGM=SORT, SORT TRANSACTIONS 00216002 // COND=(0,LT) 00217002 //SYSOUT DD SYSOUT=* 00218002 //* 00219002 @@ -51,7 +51,7 @@ //SYSIN DD DSN=DOESTAX.CONV.USER.PARMLIB(DTSSX553),DISP=SHR 00350003 //* 00360000 //* 00370005 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00380005 +//STEP0300 EXEC PGM=SORT, SORT TRANSACTIONS 00380005 // COND=(0,LT) 00390005 //SYSOUT DD SYSOUT=* 00400005 //* 00410005 diff --git a/JCL/DTSBX626.jcl b/JCL/DTSBX626.jcl index 96860af..45e11cb 100644 --- a/JCL/DTSBX626.jcl +++ b/JCL/DTSBX626.jcl @@ -31,7 +31,7 @@ //* THIS JOB MAY BE RERUN. 00001700 //* IT REBUILDS THE OUTPUT FILE EACH TIME IT RUNS. 00001700 //** 00001700 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS +//STEP0100 EXEC PGM=SORT, SORT TRANSACTIONS // COND=(0,LT) //SYSOUT DD SYSOUT=* //* @@ -50,7 +50,7 @@ //* //SYSIN DD DSN=DOESTAX.CONV.USER.PARMLIB(DTSSX626),DISP=SHR //* -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS +//STEP0200 EXEC PGM=SORT, SORT TRANSACTIONS // COND=(0,LT) //SYSOUT DD SYSOUT=* //* @@ -69,7 +69,7 @@ //* //SYSIN DD DSN=DOESTAX.CONV.USER.PARMLIB(DTSSX626),DISP=SHR //* -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS +//STEP0300 EXEC PGM=SORT, SORT TRANSACTIONS // COND=(0,LT) //SYSOUT DD SYSOUT=* //* @@ -87,7 +87,7 @@ //* //SYSIN DD DSN=DOESTAX.CONV.USER.PARMLIB(DTSSS626),DISP=SHR //* -//STEP0350 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS +//STEP0350 EXEC PGM=SORT, SORT TRANSACTIONS // COND=(0,LT) //SYSOUT DD SYSOUT=* //* diff --git a/JCL/DTSBX629.jcl b/JCL/DTSBX629.jcl index 95221c8..49fe78c 100644 --- a/JCL/DTSBX629.jcl +++ b/JCL/DTSBX629.jcl @@ -18,7 +18,7 @@ //* DD DSN=UI.&UINODE..DOCS.LOADLIB,DISP=SHR 00061019 // DD DSN=SYS1.SORTLIB,DISP=SHR 00070000 //* 00080000 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00090000 +//STEP0100 EXEC PGM=SORT, SORT TRANSACTIONS 00090000 // COND=(0,LT) 00100000 //SYSOUT DD SYSOUT=* 00110000 //* 00120000 @@ -41,7 +41,7 @@ END 00213402 //* 00213502 //* 00214000 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT TRANSACTIONS 00216000 +//STEP0200 EXEC PGM=SORT, SORT TRANSACTIONS 00216000 // COND=(0,LT) 00217000 //SYSOUT DD SYSOUT=* 00218000 //* 00219000 diff --git a/JCL/DTSBXPFL.jcl b/JCL/DTSBXPFL.jcl index ea3c28a..773b6cb 100644 --- a/JCL/DTSBXPFL.jcl +++ b/JCL/DTSBXPFL.jcl @@ -24,7 +24,7 @@ //** //* NO BACKUP NEEDED BEFORE THIS REPORT //** -//STEP0010 EXEC PGM=SORT,PARM='VLTEST=0' SORT REPORT RECORDS +//STEP0010 EXEC PGM=SORT SORT REPORT RECORDS //SYSOUT DD SYSOUT=(*) //SYSPRINT DD SYSOUT=(*) //SORTIN DD DSN=ECNTSUP.DOESTAX.PROD.FTP.BE459,DISP=SHR diff --git a/JCL/DTSBZ387.jcl b/JCL/DTSBZ387.jcl index 49b1e59..b017bfd 100644 --- a/JCL/DTSBZ387.jcl +++ b/JCL/DTSBZ387.jcl @@ -28,7 +28,7 @@ // DCB=(SYS3.MODEL,RECFM=VB,LRECL=4093,BLKSIZE=8192) /* //********************************************************************* 00120000 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS 00130000 +//STEP0200 EXEC PGM=SORT, SORT REPORT RECORDS 00130000 // COND=(0,LT) 00140000 //SYSOUT DD SYSOUT=* 00150000 //SORTIN DD DSN=DOESTAX.PROD.BE325.RPT(+1),DISP=SHR 325 RPTS 00150199 diff --git a/JCL/DTSCHGA1.jcl b/JCL/DTSCHGA1.jcl index 06b95ae..76dc642 100644 --- a/JCL/DTSCHGA1.jcl +++ b/JCL/DTSCHGA1.jcl @@ -92,7 +92,7 @@ ANN, , ,YNNNNN,000000 00190099 //RPC100R3 DD SYSOUT=O 01491099 //** 01520099 //**** SORT REPORT RECORDS (901/907) 01800000 -//STEP0150 EXEC PGM=SORT,PARM='VLTEST=0', 01810000 +//STEP0150 EXEC PGM=SORT, 01810000 // COND=(0,LT), 01820000 // REGION=0M 01830000 //SYSOUT DD SYSOUT=* 01840000 diff --git a/JCL/DTSCHGE1.jcl b/JCL/DTSCHGE1.jcl index 32141d4..dd4a856 100644 --- a/JCL/DTSCHGE1.jcl +++ b/JCL/DTSCHGE1.jcl @@ -90,7 +90,7 @@ EMP,010105,101508,YNNNNN,143904 00200000 // DEST=&LDEST. 01491200 //** 01520000 //**** SORT REPORT RECORDS (901/907) 01800000 -//STEP0150 EXEC PGM=SORT,PARM='VLTEST=0', 01810000 +//STEP0150 EXEC PGM=SORT, 01810000 // COND=(0,LT), 01820000 // REGION=0M 01830000 //SYSOUT DD SYSOUT=* 01840000 diff --git a/JCL/DTSCHGRT.jcl b/JCL/DTSCHGRT.jcl index c32614c..6ad9b80 100644 --- a/JCL/DTSCHGRT.jcl +++ b/JCL/DTSCHGRT.jcl @@ -91,7 +91,7 @@ QTR, , ,YYYYYY,000000 00200099 //RPC100R3 DD SYSOUT=0 01491099 //** 01520099 //**** SORT REPORT RECORDS (901/907) 01800000 -//STEP0150 EXEC PGM=SORT,PARM='VLTEST=0', 01810000 +//STEP0150 EXEC PGM=SORT, 01810000 // COND=(0,LT), 01820000 // REGION=0M 01830000 //SYSOUT DD SYSOUT=* 01840000 diff --git a/JCL/DTSGACHD.jcl b/JCL/DTSGACHD.jcl index a566fb0..a7342c8 100644 --- a/JCL/DTSGACHD.jcl +++ b/JCL/DTSGACHD.jcl @@ -29,7 +29,16 @@ //* BATCH EXECUTION OF FTP UNDER TLS TO REMOTE HOST WF FTPS //*----------------------------------------------------- //STEPWF EXEC PGM=FTP, -// PARM='-r TLS safetrans.wellsfargo.com' +//* PARM='-r TLS safetrans.wellsfargo.com' +// PARM='-Sftp=TRUE 10.57.110.160' +//ENVVAR DD * + CLIENT=sftp + SFTP_AUTH=3 +/* +//*SFTPAUTH DD DISP=SHR,DSN=DOESTAX.CONV.USER.PARMLIB(DTSPPF24) +//SFTPAUTH DD * + machine 10.57.110.160 user dutasrc pass Today728rc! +/* //*ETRC DD DISP=SHR,DSN=DOESTAX.CONV.PARMLIB(DTSPPFIN) //NETRC DD DISP=SHR,DSN=DOESTAX.CONV.USER.PARMLIB(DTSPPF24) //SYSFTPD DD DISP=SHR,DSN=SYS2.TCPIP.ODC3.PARMLIB(FTCWFPAT) diff --git a/JCL/DTSPDAY7.jcl b/JCL/DTSPDAY7.jcl index 016e1a9..6a106c0 100644 --- a/JCL/DTSPDAY7.jcl +++ b/JCL/DTSPDAY7.jcl @@ -40,7 +40,7 @@ 614 /* //* SORT REPORT RECORDS -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', +//STEP0200 EXEC PGM=SORT, // COND=(0,LT) //SYSOUT DD SYSOUT=* //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+1),DISP=SHR diff --git a/JCL/DTSPMON1.jcl b/JCL/DTSPMON1.jcl index bd42b87..a44ef5c 100644 --- a/JCL/DTSPMON1.jcl +++ b/JCL/DTSPMON1.jcl @@ -92,7 +92,7 @@ 332, ,Y /* //********************************************************************* -//STEP0400 EXEC PGM=SORT, SORT REPORT RECORDS +//STEP0400 EXEC PGM=SORT, SORT REPORT RECORDS // COND=(0,LT) //SYSOUT DD SYSOUT=* //SORTIN DD DSN=DOESTAX.PROD.PER.RPT(+1),DISP=SHR diff --git a/JCL/DTSRQ310.jcl b/JCL/DTSRQ310.jcl index a3bf5f1..1e39028 100644 --- a/JCL/DTSRQ310.jcl +++ b/JCL/DTSRQ310.jcl @@ -23,7 +23,7 @@ // SPACE=(CYL,(75,15),RLSE), // DCB=(RECFM=FB,LRECL=17,BLKSIZE=30600) /* -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT ITM RECORDS +//STEP0200 EXEC PGM=SORT, SORT ITM RECORDS // COND=(0,LT) //SYSOUT DD SYSOUT=* //SORTIN DD DSN=DOESTAX.&LVLNODE..WITM.FILE, diff --git a/JCL/DTSRQ328.jcl b/JCL/DTSRQ328.jcl index df7ca74..11ecda9 100644 --- a/JCL/DTSRQ328.jcl +++ b/JCL/DTSRQ328.jcl @@ -18,7 +18,7 @@ //* 00001700 //STEP0100 EXEC DTSUX328 // -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS +//STEP0200 EXEC PGM=SORT, SORT REPORT RECORDS // COND=(0,LT) //SYSOUT DD SYSOUT=* //SORTIN DD DSN=DOESTAX.&LVLNODE..BE327.RPT(+0),DISP=SHR 325 RPTS diff --git a/JCL/DTSRQ352.jcl b/JCL/DTSRQ352.jcl index d14ba41..be09c6c 100644 --- a/JCL/DTSRQ352.jcl +++ b/JCL/DTSRQ352.jcl @@ -52,7 +52,7 @@ //STEP0100.RPT991R1 DD HOLD=YES //DOESLBLP.DOESLBL1 DD DUMMY LABELS 00631000 //* -//STEP0400 EXEC PGM=SORT,PARM='VLTEST=0',COND=(0,NE) 00015000 +//STEP0400 EXEC PGM=SORT, COND=(0,NE) 00015000 //SYSOUT DD SYSOUT=(*) 00017000 //SYSPRINT DD SYSOUT=(*) 00018000 //* 00019000 diff --git a/JCL/DTSRQ500.jcl b/JCL/DTSRQ500.jcl index 9bb82e5..e30dc4a 100644 --- a/JCL/DTSRQ500.jcl +++ b/JCL/DTSRQ500.jcl @@ -63,7 +63,7 @@ ANN, , ,YYYYY,000000 00302445 //**** RUN THE EXTRACT 00310000 //STEP0300 EXEC DTSUX500 00320080 //**** SORT REPORT RECORDS 00350000 -//STEP0400 EXEC PGM=SORT,PARM='VLTEST=0', 00360016 +//STEP0400 EXEC PGM=SORT, 00360016 // COND=(0,LT) 00370000 //SYSOUT DD SYSOUT=* 00380000 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+1),DISP=SHR 00390062 diff --git a/JCL/DTSRQ517.jcl b/JCL/DTSRQ517.jcl index 6359b74..0b990b6 100644 --- a/JCL/DTSRQ517.jcl +++ b/JCL/DTSRQ517.jcl @@ -51,7 +51,7 @@ //**** SORT REPORT RECORDS 00041600 //STEP0200 EXEC DTSUX517 00004304 //**** SORT REPORT RECORDS 00041600 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', 00041700 +//STEP0300 EXEC PGM=SORT, 00041700 // COND=(0,LT) 00041800 //SYSOUT DD SYSOUT=* 00041900 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+2),DISP=SHR 00042000 diff --git a/JCL/DTSRQ518.jcl b/JCL/DTSRQ518.jcl index a55904f..856f53a 100644 --- a/JCL/DTSRQ518.jcl +++ b/JCL/DTSRQ518.jcl @@ -54,7 +54,7 @@ //**** 00006385 //STEP0200 EXEC DTSUX518 00007075 //**** SORT REPORT RECORDS 00041600 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', 00041700 +//STEP0300 EXEC PGM=SORT, 00041700 // COND=(0,LT) 00041800 //SYSOUT DD SYSOUT=* 00041900 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+1),DISP=SHR 00042000 diff --git a/JCL/DTSRQ590.jcl b/JCL/DTSRQ590.jcl index 43751d0..11ebc7d 100644 --- a/JCL/DTSRQ590.jcl +++ b/JCL/DTSRQ590.jcl @@ -26,7 +26,7 @@ //*TEP0100 EXEC DTSUTVSM, //* BKUPGEN='(+1)' //**** ELIMINATE DUPS FROM SAME FA 00310099 -//STEP0150 EXEC PGM=SORT,PARM='VLTEST=0', 00310099 +//STEP0150 EXEC PGM=SORT, 00310099 // COND=(0,LT) 00320099 //SYSOUT DD SYSOUT=* 00330000 //SORTIN DD DSN=DOESTAX.&LDATAIN..UC30.FISCAGNT.&QTR, @@ -45,7 +45,7 @@ //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(15,15),RLSE) 00470099 //**** 00480099 //**** SORT FA-UC30/RATE(S) DATA 00310099 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', 00310099 +//STEP0200 EXEC PGM=SORT, 00310099 // COND=(0,LT) 00320099 //SYSOUT DD SYSOUT=* 00330000 //SORTIN DD DSN=&&FANODUP,DISP=(OLD,PASS,DELETE) diff --git a/JCL/DTSRQ591.jcl b/JCL/DTSRQ591.jcl index 5265460..9b02f41 100644 --- a/JCL/DTSRQ591.jcl +++ b/JCL/DTSRQ591.jcl @@ -22,7 +22,7 @@ //*TEP0100 EXEC DTSUTVSM, //* BKUPGEN='(+1)' //** -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', /* SORT FA-CHG RECORDS 00310099 +//STEP0200 EXEC PGM=SORT, /* SORT FA-CHG RECORDS 00310099 // COND=(0,LT) /* ALREADY LOADED IN GDG 00320099 //SYSOUT DD SYSOUT=* 00330000 //SORTIN DD DSN=DOESTAX.CONV.CHRG.FISCAGNT.&YRQTR.,DISP=SHR @@ -55,7 +55,7 @@ //DTSFREF DD DSN=DOESTAX.&LVLNODE..VSAM.REF,DISP=SHR, // AMP=('BUFNI=5,BUFND=10') //** -//STEP0400 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS 00002400 +//STEP0400 EXEC PGM=SORT, SORT REPORT RECORDS 00002400 // COND=(0,LT) 00002500 //SYSOUT DD SYSOUT=* 00002600 //SORTIN DD DSN=DOESTAX.&LVLNODE..CHGBR591.FA.&QTR591.,DISP=SHR 00003006 diff --git a/JCL/DTSRQ704.jcl b/JCL/DTSRQ704.jcl index 64eecd2..3e4fc85 100644 --- a/JCL/DTSRQ704.jcl +++ b/JCL/DTSRQ704.jcl @@ -63,7 +63,7 @@ INFILE (FILEIN) /* //*** SORT REPORT RECORDS -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', +//STEP0200 EXEC PGM=SORT, // COND=(0,LT), // REGION=0M //SYSOUT DD SYSOUT=* diff --git a/JCL/DTSRT300.jcl b/JCL/DTSRT300.jcl index 9430973..9afdd4b 100644 --- a/JCL/DTSRT300.jcl +++ b/JCL/DTSRT300.jcl @@ -18,7 +18,7 @@ //LOADLIBS INCLUDE MEMBER=DTSIJLIB 00001599 //* 00001600 //********************************************************************* 00004549 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS 00004600 +//STEP0100 EXEC PGM=SORT, SORT REPORT RECORDS 00004600 // COND=(0,LT) 00004700 //SYSOUT DD SYSOUT=* 00004800 //SORTIN DD DSN=DOESTAX.PROD.CHG.BD220.RPT.&QTRLY.,DISP=SHR 00005099 @@ -32,7 +32,7 @@ //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(50,10),RLSE) 00008099 //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(50,10),RLSE) 00008099 //********************************************************************* 00018000 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT EMPLOYER RECORDS 00004600 +//STEP0200 EXEC PGM=SORT, SORT EMPLOYER RECORDS 00004600 // COND=(0,LT) 00004700 //SYSOUT DD SYSOUT=* 00004800 //SORTIN DD DSN=DOESTAX.PROD.CHG.EMPL,DISP=SHR 00005099 diff --git a/JCL/DTSRX591.jcl b/JCL/DTSRX591.jcl index 4b1be97..abb74ce 100644 --- a/JCL/DTSRX591.jcl +++ b/JCL/DTSRX591.jcl @@ -18,7 +18,7 @@ //PROCLIB JCLLIB ORDER=DOESTAX.&LVLNODE..PROCLIB 00001600 //LOADLIBS INCLUDE MEMBER=DTSIJLIB 00001600 //** 00001700 -//STEP0400 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS 00002400 +//STEP0400 EXEC PGM=SORT, SORT REPORT RECORDS 00002400 // COND=(0,LT) 00002500 //SYSOUT DD SYSOUT=* 00002600 //SORTIN DD DSN=DOESTAX.&LVLNODE..CHGBR591.FA.&QTR591.,DISP=SHR 00003006 diff --git a/JCL/DTSRZ518.jcl b/JCL/DTSRZ518.jcl index ca19115..aff26b7 100644 --- a/JCL/DTSRZ518.jcl +++ b/JCL/DTSRZ518.jcl @@ -52,7 +52,7 @@ ANN, , ,YYYYY,000000 00005900 //**** 00006100 //STEP0200 EXEC DTSUX518 00007000 //**** SORT REPORT RECORDS 00041600 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', 00041700 +//STEP0300 EXEC PGM=SORT, 00041700 // COND=(0,LT) 00041800 //SYSOUT DD SYSOUT=* 00041900 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+1),DISP=SHR 00042000 diff --git a/JCL/DTSTP590.jcl b/JCL/DTSTP590.jcl index 269df27..d8c37f4 100644 --- a/JCL/DTSTP590.jcl +++ b/JCL/DTSTP590.jcl @@ -15,7 +15,7 @@ //PROCLIB JCLLIB ORDER=DOESTAX.&LVLNODE..PROCLIB 00001812 //LOADLIBS INCLUDE MEMBER=DTSIJLIB 00001912 //**** 00002010 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', /* SRT RPT RECORDS 00002410 +//STEP0100 EXEC PGM=SORT, /* SRT RPT RECORDS 00002410 // COND=(0,LT) 00002500 //SYSOUT DD SYSOUT=* 00002600 //SORTIN DD DSN=DOESTAX.&LVLNODE..UC30.BR590.&QTR., 00004010 diff --git a/JCL/DTSVOSQ.jcl b/JCL/DTSVOSQ.jcl index 9eedf00..2663d52 100644 --- a/JCL/DTSVOSQ.jcl +++ b/JCL/DTSVOSQ.jcl @@ -14,7 +14,7 @@ //* THE SORTED NWHIRE FILE MUST PICK UP ALL THE GENERATIONS OF //* REPORT AND CSESATA. 00014000 //*** 00014000 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT NEW HIRE DATA 00015001 +//STEP0100 EXEC PGM=SORT, SORT NEW HIRE DATA 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -63,7 +63,7 @@ // DCB=(RECFM=FB,LRECL=135,BLKSIZE=31050) //* 00070000 //*** 00014000 -//STEP0120 EXEC PGM=SORT,PARM='VLTEST=0', SORT WORKER 00015001 +//STEP0120 EXEC PGM=SORT, SORT WORKER 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -86,7 +86,7 @@ SORT FIELDS=(1,15,CH,A) 00048006 /* 00060000 //***** 00070000 -//STEP0130 EXEC PGM=SORT,PARM='VLTEST=0', SORT EMPLOYER 00015001 +//STEP0130 EXEC PGM=SORT, SORT EMPLOYER 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -108,7 +108,7 @@ //SYSIN DD * 00047000 SORT FIELDS=(1,15,CH,A) 00048006 /* 00060000 -//STEP0140 EXEC PGM=SORT,PARM='VLTEST=0', SORT HIRE TRANSACTIONS 00015001 +//STEP0140 EXEC PGM=SORT, SORT HIRE TRANSACTIONS 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -182,7 +182,7 @@ // DCB=(RECFM=FB,LRECL=290,BLKSIZE=29000) //* //** 00001700 -//STEP0210 EXEC PGM=SORT,PARM='VLTEST=0', SORT EMPLOYERS +//STEP0210 EXEC PGM=SORT, SORT EMPLOYERS // COND=(5,LT), // REGION=0K //SYSOUT DD SYSOUT=* @@ -220,7 +220,7 @@ // AMP=('BUFNI=5,BUFND=10') //*** //** 00001700 -//STEP0230 EXEC PGM=SORT,PARM='VLTEST=0', SORT TAX EMPLOYERS +//STEP0230 EXEC PGM=SORT, SORT TAX EMPLOYERS // COND=(5,LT), // REGION=0K //SYSOUT DD SYSOUT=* @@ -304,7 +304,7 @@ //SYSIN DD DSN=DOESTAX.&LVLNODE..APPL.PARMLIB(DTSRONE),DISP=SHR //*** //* -//STEP0400 EXEC PGM=SORT,PARM='VLTEST=0', SORT ADDRESSES +//STEP0400 EXEC PGM=SORT, SORT ADDRESSES // COND=(5,LT), // REGION=0K //SYSOUT DD SYSOUT=* diff --git a/JCL/DTSVOSW.jcl b/JCL/DTSVOSW.jcl index d148cfa..6508437 100644 --- a/JCL/DTSVOSW.jcl +++ b/JCL/DTSVOSW.jcl @@ -14,7 +14,7 @@ //* //* 00014000 //*** 00014000 -//STEP0100 EXEC PGM=SORT,PARM='VLTEST=0', SORT NEW HIRE DATA 00015001 +//STEP0100 EXEC PGM=SORT, SORT NEW HIRE DATA 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -61,7 +61,7 @@ // DCB=(RECFM=FB,LRECL=135,BLKSIZE=31050) //* 00070000 //*** 00014000 -//STEP0120 EXEC PGM=SORT,PARM='VLTEST=0', SORT WORKER 00015001 +//STEP0120 EXEC PGM=SORT, SORT WORKER 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -84,7 +84,7 @@ SORT FIELDS=(1,15,CH,A) 00048006 /* 00060000 //***** 00070000 -//STEP0130 EXEC PGM=SORT,PARM='VLTEST=0', SORT EMPLOYER 00015001 +//STEP0130 EXEC PGM=SORT, SORT EMPLOYER 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -106,7 +106,7 @@ //SYSIN DD * 00047000 SORT FIELDS=(1,15,CH,A) 00048006 /* 00060000 -//STEP0140 EXEC PGM=SORT,PARM='VLTEST=0', SORT HIRE TRANSACTIONS 00015001 +//STEP0140 EXEC PGM=SORT, SORT HIRE TRANSACTIONS 00015001 // COND=(0,LT) //SYSOUT DD SYSOUT=* 00017000 //* 00019000 @@ -163,7 +163,7 @@ // SPACE=(29000,(1000,1000),RLSE), // DCB=(RECFM=FB,LRECL=290,BLKSIZE=29000) //* -//STEP0160 EXEC PGM=SORT,PARM='VLTEST=0', SORT EMPLOYERS +//STEP0160 EXEC PGM=SORT, SORT EMPLOYERS // COND=(5,LT), // REGION=0K //SYSOUT DD SYSOUT=* @@ -200,7 +200,7 @@ // AMP=('BUFNI=5,BUFND=10') //*** //** 00001700 -//STEP0230 EXEC PGM=SORT,PARM='VLTEST=0', SORT TAX EMPLOYERS +//STEP0230 EXEC PGM=SORT, SORT TAX EMPLOYERS // COND=(5,LT), // REGION=0K //SYSOUT DD SYSOUT=* @@ -277,7 +277,7 @@ //SYSIN DD DSN=DOESTAX.&LVLNODE..APPL.PARMLIB(DTSRONE),DISP=SHR //*** //* -//STEP0400 EXEC PGM=SORT,PARM='VLTEST=0', SORT ADDRESSES +//STEP0400 EXEC PGM=SORT, SORT ADDRESSES // COND=(5,LT), // REGION=0K //SYSOUT DD SYSOUT=* diff --git a/JCL/DTSZQ517.jcl b/JCL/DTSZQ517.jcl index ae1e604..2aec956 100644 --- a/JCL/DTSZQ517.jcl +++ b/JCL/DTSZQ517.jcl @@ -37,7 +37,7 @@ //LOADLIBS INCLUDE MEMBER=DTSIJLIB 00003764 //**** BACKUP BEFORE THIS RUN 00003800 //**** (NOT NEEDED IF RUN RIGHT AFTER A DAILY) 00003931 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', 00041700 +//STEP0300 EXEC PGM=SORT, 00041700 // COND=(0,LT) 00041800 //SYSOUT DD SYSOUT=* 00041900 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT.G2873V00,DISP=SHR 00042000 diff --git a/JCL/DTSZQ518.jcl b/JCL/DTSZQ518.jcl index 6f69470..1e86aab 100644 --- a/JCL/DTSZQ518.jcl +++ b/JCL/DTSZQ518.jcl @@ -47,7 +47,7 @@ //**** RUN THE EXTRACT 00005160 //STEP0200 EXEC DTSUX518 00006050 //**** SORT REPORT RECORDS 00041600 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', 00041700 +//STEP0300 EXEC PGM=SORT, 00041700 // COND=(0,LT) 00041800 //SYSOUT DD SYSOUT=* 00041900 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+1),DISP=SHR 00042000 diff --git a/JCL/DTSZZ503.jcl b/JCL/DTSZZ503.jcl index c6be3fb..810b542 100644 --- a/JCL/DTSZZ503.jcl +++ b/JCL/DTSZZ503.jcl @@ -41,7 +41,7 @@ //STEP0200 EXEC DTSUX503 00004947 //STEP0100.DTSFBTCO DD DUMMY 00005061 //**** SORT REPORT RECORDS 00041639 -//STEP0300 EXEC PGM=SORT,PARM='VLTEST=0', 00041739 +//STEP0300 EXEC PGM=SORT, 00041739 // COND=(0,LT) 00041839 //SYSOUT DD SYSOUT=* 00041939 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+1),DISP=SHR 00042042 diff --git a/JCL/DTSZZ506.jcl b/JCL/DTSZZ506.jcl index 890b109..f9e67a2 100644 --- a/JCL/DTSZZ506.jcl +++ b/JCL/DTSZZ506.jcl @@ -57,7 +57,7 @@ ANN, , ,YYYYYY,000000 00302479 //**** RUN THE EXTRACT 00310000 //STEP0300 EXEC DTSUX506 00320029 //**** SORT REPORT RECORDS 00350000 -//STEP0400 EXEC PGM=SORT,PARM='VLTEST=0', 00360016 +//STEP0400 EXEC PGM=SORT, 00360016 // COND=(0,LT) 00370000 //SYSOUT DD SYSOUT=* 00380000 //SORTIN DD DSN=DOESTAX.&LVLNODE..PER.RPT(+1),DISP=SHR 00390062 diff --git a/JCL/RUNRQ551.jcl b/JCL/RUNRQ551.jcl index f502970..898161d 100644 --- a/JCL/RUNRQ551.jcl +++ b/JCL/RUNRQ551.jcl @@ -86,7 +86,7 @@ //CBDATA DD DSN=DOES.CICS.FIN730.CBDATA.EX100102,DISP=SHR //CBCTYST DD DSN=DOES.CICS.FIN730.CBCTYST.EX100102,DISP=SHR //* 00080002 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', SORT REPORT RECORDS +//STEP0200 EXEC PGM=SORT, SORT REPORT RECORDS // COND=(05,LT), // REGION=0K //SYSOUT DD SYSOUT=* diff --git a/JCL/RUNRQACH.jcl b/JCL/RUNRQACH.jcl index 2fa4ece..9f4b597 100644 --- a/JCL/RUNRQACH.jcl +++ b/JCL/RUNRQACH.jcl @@ -17,7 +17,7 @@ //* 00001900 //LOADLIBS INCLUDE MEMBER=DTSIJLIB 00002000 //* 00003000 -//STEP0105 EXEC PGM=SORT,PARM='VLTEST=0', SORT PAYMENT RECORDS 00004618 +//STEP0105 EXEC PGM=SORT, SORT PAYMENT RECORDS 00004618 // COND=(0,LT) 00004718 //SYSOUT DD SYSOUT=* 00004818 //SORTIN DD DSN=DOESTAX.&CPYNODE..&WACHNEW, 00004923 @@ -30,7 +30,7 @@ //* 00005722 //SYSIN DD DSN=DOESTAX.&LVLNODE..APPL.PARMLIB(EFTSREC2),DISP=SHR 00006018 //********************************************************************* 00006118 -//STEP0110 EXEC PGM=SORT,PARM='VLTEST=0', SORT EFTACH RECORDS 00006215 +//STEP0110 EXEC PGM=SORT, SORT EFTACH RECORDS 00006215 // COND=(0,LT) 00006315 //SYSOUT DD SYSOUT=* 00006415 //* 00006522 diff --git a/JCL/RUNRZ590.jcl b/JCL/RUNRZ590.jcl index 5bba0fe..d7d1d63 100644 --- a/JCL/RUNRZ590.jcl +++ b/JCL/RUNRZ590.jcl @@ -24,7 +24,7 @@ //**** BKP BEFORE MSTR UPDT 00001700 //* (NOT NEEDED IF RUN IMMEDIATELY 00001700 //* *AFTER* A DAILY) 00001700 -//STEP0150 EXEC PGM=SORT,PARM='VLTEST=0', 00310099 +//STEP0150 EXEC PGM=SORT, 00310099 // COND=(0,LT) 00320099 //SYSOUT DD SYSOUT=* 00330000 //*ORTIN DD DSN=DOESTAX.&LDATAIN..UC30.FISCAGNT.&QTR..G0001V00, @@ -47,7 +47,7 @@ //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(15,15),RLSE) 00470099 //**** 00480099 //**** SORT FA-UC30/RATE(S) DATA 00310099 -//STEP0200 EXEC PGM=SORT,PARM='VLTEST=0', 00310099 +//STEP0200 EXEC PGM=SORT, 00310099 // COND=(0,LT) 00320099 //SYSOUT DD SYSOUT=* 00330000 //SORTIN DD DSN=&&FANODUP,DISP=(OLD,PASS,DELETE) diff --git a/JCL/TESTSEC.jcl b/JCL/TESTSEC.jcl new file mode 100644 index 0000000..bb82091 --- /dev/null +++ b/JCL/TESTSEC.jcl @@ -0,0 +1,41 @@ +//SECPDEC JOB (UI,4300,03410,P),'DECRYPT/PAYMTS-TDEC',REGION=4000K, +// USER=#DOADTS, +// CLASS=A,MSGCLASS=X,NOTIFY=ECNTNH1 +//* +//******************************************************************** +//* SecureZIP Decrypt processing in PGP format * +//* * +//* This JCL Procedure invokes the SecureZIP code to decrypt data * +//* stored in a PGP-format archive. It is not necessary to specify * +//* who will decrypt the data as the software automatically searches * +//* for a matching recipient, which should always be OCTO. * +//* * +//* All of the parameters necessary to make the process work against * +//* a PGP-format archive are stored in the Defaults Module, or in * +//* the SYSIN file. * +//* * +//******************************************************************** +//* * +//* Parameters: * +//* * +//* KEYHLQ - The dataset prefix for the PGP-format Keyrings * +//* * +//******************************************************************** +//* +//DECRYPT EXEC PGM=PKZIPC +//*STEPLIB DD DISP=SHR,DSN=SYSO.SECZIP.PROD.LOAD +//* +//PUBRING DD DISP=SHR,DSN=SYS3.SECZIP.KEYS.V2.PUBRING +//SECRING DD DISP=SHR,DSN=SYS3.SECZIP.KEYS.V2.SECRING +//* +//SYSIN DD DISP=SHR,DSN=SYS3.SECZIP.PARMS.DECRYPT.TXT +//SYSERR DD SYSOUT=* +//SYSOUT DD SYSOUT=* +//SYSPRINT DD SYSOUT=* +//SYSTSPRT DD SYSOUT=* +//DATAIN DD DSN=DOESTAX.CONV.TDEC.DOES.CRYPT.CHKS,DISP=SHR +//DATAOUT DD DSN=DOESTAX.CONV.TDEC.DOES.DAILY.CHKS(+1), +// DISP=(,CATLG,DELETE), +// UNIT=SYSDA,SPACE=(CYL,(9,1),RLSE), +// DCB=(SYS3.MODEL,RECFM=FB,LRECL=512,BLKSIZE=5120) +//* \ No newline at end of file diff --git a/JCL/TestCopy.jcl b/JCL/TestCopy.jcl new file mode 100644 index 0000000..30433de --- /dev/null +++ b/JCL/TestCopy.jcl @@ -0,0 +1,13 @@ +//DTSBXTST JOB (UI,4300,3400,T),TESTMSTB, +// CLASS=S,MSGCLASS=X,REGION=0M +//STEP0120 EXEC PGM=IDCAMS +//SYSOUT DD SYSOUT=* +//INDD01 DD DSN=DOESTAX.PROD.VSAM.MSTB,DISP=SHR, +// AMP=('BUFNI=5,BUFND=30') +//OUTDD01 DD DSN=DOESTAX.PROD.BACKUP.MSTB(+1), +// DISP=(NEW,CATLG,DELETE), +// UNIT=CART, +// LABEL=(2,SL,,,EXPDT=99000), +// DCB=(RECFM=VB,LRECL=4096,BLKSIZE=32760) +//SYSIN DD * + REPRO INFILE(INDD01) OUTFILE(OUTDD01) diff --git a/JCL/VLTEST.jcl b/JCL/VLTEST.jcl new file mode 100644 index 0000000..ca54497 --- /dev/null +++ b/JCL/VLTEST.jcl @@ -0,0 +1,20 @@ +//ECNT800Z JOB (UI,4300,3400,T),'CHGBD100',CLASS=A,MSGCLASS=X, +// NOTIFY=ECNTZL1,REGION=0M +//**** +//STEP0100 EXEC PGM=SORT, SORT REPORT RECORDS +// COND=(4,LT) +//SYSOUT DD SYSOUT=(*) +//SYSPRINT DD SYSOUT=(*) +//SORTIN DD DSN=DOESTAX.PROD.SRTDAILY.RPT(+0),DISP=SHR +//**** +//SORTOUT DD DSN=&&SRTOUT, +// DISP=(,PASS,DELETE), +// UNIT=SYSDA, +// SPACE=(8192,(1000,1000),RLSE), +// DCB=(RECFM=VB,LRECL=4093,BLKSIZE=0) +//SYSIN DD DSN=DOESTAX.PROD.APPL.PARMLIB(DTSSRREC),DISP=SHR +//**** +//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(20,20),RLSE) +//SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(20,20),RLSE) +//SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(20,20),RLSE) +//SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,(20,20),RLSE) \ No newline at end of file diff --git a/Maps/DTSML1.bms b/Maps/DTSML1.bms index 6130649..bfa5e92 100644 --- a/Maps/DTSML1.bms +++ b/Maps/DTSML1.bms @@ -1,285 +1,270 @@ -* DATA SET DTSML1 AT LEVEL 014 AS OF 09/22/06 -* DATA SET DTSML1 AT LEVEL 003 AS OF 09/21/06 00001 -* DATA SET DTSML1 AT LEVEL 012 AS OF 07/19/99 00002 -DTSML1 DFHMDI SIZE=(24,80), X00003 - LINE=01, X00004 - COLUMN=01 00005 -FL10101 DFHMDF POS=(01,01), X00006 - ATTRB=(ASKIP,FSET), X00007 - LENGTH=002, X00008 - INITIAL='L1' 00009 - DFHMDF POS=(01,20), X00010 - ATTRB=(ASKIP), X00011 - LENGTH=020, X00012 - INITIAL=' LMI INQUIRY/UPDATE ' 00013 -FL10162 DFHMDF POS=(01,62), X00014 - ATTRB=(ASKIP), X00015 - LENGTH=008 00016 -FL10172 DFHMDF POS=(01,72), X00017 - ATTRB=(ASKIP), X00018 - LENGTH=008 00019 -FL10272 DFHMDF POS=(02,72), X00020 - ATTRB=(ASKIP), X00021 - LENGTH=008 00022 - DFHMDF POS=(03,05), X00023 - ATTRB=(ASKIP), X00024 - LENGTH=007, X00025 - INITIAL='EMP NO:' 00026 -FL10313 DFHMDF POS=(03,13), X00027 - ATTRB=(ASKIP), X00028 - LENGTH=003 00029 -FL10317 DFHMDF POS=(03,17), X00030 - ATTRB=(ASKIP), X00031 - LENGTH=003 00032 - DFHMDF POS=(03,21), X00033 - ATTRB=(ASKIP), X00034 - LENGTH=001 00035 -FL10324 DFHMDF POS=(03,24), X00036 - ATTRB=(ASKIP), X00037 - LENGTH=040 00038 -FL10372 DFHMDF POS=(03,72), X00039 - ATTRB=(ASKIP), X00040 - LENGTH=002 00041 - DFHMDF POS=(03,75), X00042 - ATTRB=(ASKIP), X00043 - LENGTH=002, X00044 - INITIAL='OF' 00045 -FL10378 DFHMDF POS=(03,78), X00046 - ATTRB=(ASKIP), X00047 - LENGTH=002 00048 - DFHMDF POS=(05,16), X00049 - ATTRB=(ASKIP), X00050 - LENGTH=004, X00051 - INITIAL='QTR:' 00052 -FL10521 DFHMDF POS=(05,21), X00053 - ATTRB=(ASKIP), X00054 - LENGTH=002 00055 -FL10524 DFHMDF POS=(05,24), X00056 - ATTRB=(ASKIP), X00057 - LENGTH=001 00058 - DFHMDF POS=(05,26), X00059 - ATTRB=(ASKIP), X00060 - LENGTH=001 00061 - DFHMDF POS=(07,04), X00062 - ATTRB=(ASKIP), X00063 - LENGTH=016, X00064 - INITIAL='MONTH 1 EMP CNT:' 00065 -FL10721 DFHMDF POS=(07,21), X00066 - ATTRB=(ASKIP), X00067 - LENGTH=009 00068 - DFHMDF POS=(07,31), X00069 - ATTRB=(ASKIP), X00070 - LENGTH=001 00071 - DFHMDF POS=(07,42), X00072 - ATTRB=(ASKIP), X00073 - LENGTH=009, X00074 - INITIAL='TOT WAGE:' 00075 -FL10752 DFHMDF POS=(07,52), X00076 - ATTRB=(ASKIP), X00077 - LENGTH=014 00078 - DFHMDF POS=(08,04), X00079 - ATTRB=(ASKIP), X00080 - LENGTH=016, X00081 - INITIAL='MONTH 2 EMP CNT:' 00082 -FL10821 DFHMDF POS=(08,21), X00083 - ATTRB=(ASKIP), X00084 - LENGTH=009 00085 - DFHMDF POS=(08,31), X00086 - ATTRB=(ASKIP), X00087 - LENGTH=001 00088 - DFHMDF POS=(08,42), X00089 - ATTRB=(ASKIP), X00090 - LENGTH=009, X00091 - INITIAL='TAX WAGE:' 00092 -FL10852 DFHMDF POS=(08,52), X00093 - ATTRB=(ASKIP), X00094 - LENGTH=014 00095 - DFHMDF POS=(09,04), X00096 - ATTRB=(ASKIP), X00097 - LENGTH=016, X00098 - INITIAL='MONTH 3 EMP CNT:' 00099 -FL10921 DFHMDF POS=(09,21), X00100 - ATTRB=(ASKIP), X00101 - LENGTH=009 00102 - DFHMDF POS=(09,31), X00103 - ATTRB=(ASKIP), X00104 - LENGTH=001 00105 - DFHMDF POS=(09,42), X00106 - ATTRB=(ASKIP), X00107 - LENGTH=009, X00108 - INITIAL='WGE CHNG:' 00109 -FL10952 DFHMDF POS=(09,52), X00110 - ATTRB=(ASKIP), X00111 - LENGTH=008 00112 - DFHMDF POS=(10,42), X00113 - ATTRB=(ASKIP), X00114 - LENGTH=009, X00115 - INITIAL='RPT TYPE:' 00116 -FL11052 DFHMDF POS=(10,52), X00117 - ATTRB=(ASKIP), X00118 - LENGTH=010 00119 - DFHMDF POS=(11,42), X00120 - ATTRB=(ASKIP), X00121 - LENGTH=009, X00122 - INITIAL='CNT CHNG:' 00123 -FL11152 DFHMDF POS=(11,52), X00124 - ATTRB=(ASKIP), X00125 - LENGTH=008 00126 - DFHMDF POS=(13,08), X00127 - ATTRB=(ASKIP), X00128 - LENGTH=007, X00129 - INITIAL='SIC CD:' 00130 -FL11310 DFHMDF POS=(13,16), X00131 - ATTRB=(ASKIP), X00132 - LENGTH=004 00133 - DFHMDF POS=(13,21), X00134 - ATTRB=(ASKIP), X00135 - LENGTH=001 00136 -FL11320 DFHMDF POS=(13,25), X00137 - ATTRB=(ASKIP), X00138 - LENGTH=020 00139 - DFHMDF POS=(13,49), X00140 - ATTRB=(ASKIP), X00141 - LENGTH=008, X00142 - INITIAL='OLD SIC:' 00143 -FL11355 DFHMDF POS=(13,58), X00144 - ATTRB=(ASKIP), X00145 - LENGTH=004 00146 - DFHMDF POS=(13,65), X00147 - ATTRB=(ASKIP), X00148 - LENGTH=005, X00149 - INITIAL='CHNG:' 00150 -FL11371 DFHMDF POS=(13,71), X00151 - ATTRB=(ASKIP), X00152 - LENGTH=008 00153 - DFHMDF POS=(15,04), X00154 - ATTRB=(ASKIP), X00155 - LENGTH=011, X00156 - INITIAL='SIC AUX CD:' 00157 -FL11516 DFHMDF POS=(15,16), X00158 - ATTRB=(ASKIP), X00159 - LENGTH=001 00160 - DFHMDF POS=(15,18), X00161 - ATTRB=(ASKIP), X00162 - LENGTH=001 00163 -FL11525 DFHMDF POS=(15,25), X00164 - ATTRB=(ASKIP), X00165 - LENGTH=010 00166 - DFHMDF POS=(17,06), X00167 - ATTRB=(ASKIP), X00168 - LENGTH=009, X00169 - INITIAL='NAICS CD:' 00170 -FL11716 DFHMDF POS=(17,16), X00171 - ATTRB=(ASKIP), X00172 - LENGTH=006 00173 - DFHMDF POS=(17,23), X00174 - ATTRB=(ASKIP), X00175 - LENGTH=001 00176 -FL11725 DFHMDF POS=(17,25), X00177 - ATTRB=(ASKIP), X00178 - LENGTH=020 00179 - DFHMDF POS=(17,47), X00180 - ATTRB=(ASKIP), X00181 - LENGTH=010, X00182 - INITIAL='OLD NAICS:' 00183 -FL11758 DFHMDF POS=(17,58), X00184 - ATTRB=(ASKIP), X00185 - LENGTH=006 00186 - DFHMDF POS=(17,65), X00187 - ATTRB=(ASKIP), X00188 - LENGTH=005, X00189 - INITIAL='CHNG:' 00190 -FL11771 DFHMDF POS=(17,71), X00191 - ATTRB=(ASKIP), X00192 - LENGTH=008 00193 - DFHMDF POS=(18,05), X00194 - ATTRB=(ASKIP), X00195 - LENGTH=010, X00196 - INITIAL='ALT NAICS:' 00197 -FL11816 DFHMDF POS=(18,16), X00198 - ATTRB=(ASKIP), X00199 - LENGTH=006 00200 - DFHMDF POS=(18,23), X00201 - ATTRB=(ASKIP), X00202 - LENGTH=001 00203 -FL11825 DFHMDF POS=(18,25), X00204 - ATTRB=(ASKIP), X00205 - LENGTH=020 00206 - DFHMDF POS=(19,08), X00207 - ATTRB=(ASKIP), X00208 - LENGTH=007, X00209 - INITIAL='OWN CD:' 00210 -FL11910 DFHMDF POS=(19,16), X00211 - ATTRB=(ASKIP), X00212 - LENGTH=002 00213 - DFHMDF POS=(19,19), X00214 - ATTRB=(ASKIP), X00215 - LENGTH=001 00216 -FL11920 DFHMDF POS=(19,25), X00217 - ATTRB=(ASKIP), X00218 - LENGTH=010 00219 - DFHMDF POS=(19,49), X00220 - ATTRB=(ASKIP), X00221 - LENGTH=008, X00222 - INITIAL='OLD OWN:' 00223 -FL11955 DFHMDF POS=(19,58), X00224 - ATTRB=(ASKIP), X00225 - LENGTH=002 00226 - DFHMDF POS=(19,65), X00227 - ATTRB=(ASKIP), X00228 - LENGTH=005, X00229 - INITIAL='CHNG:' 00230 -FL11971 DFHMDF POS=(19,71), X00231 - ATTRB=(ASKIP), X00232 - LENGTH=008 00233 - DFHMDF POS=(21,05), X00234 - ATTRB=(ASKIP), X00235 - LENGTH=010, X00236 - INITIAL='MULTI IND:' 00237 -FL12110 DFHMDF POS=(21,16), X00238 - ATTRB=(ASKIP), X00239 - LENGTH=001 00240 - DFHMDF POS=(21,18), X00241 - ATTRB=(ASKIP), X00242 - LENGTH=001 00243 -FL12120 DFHMDF POS=(21,25), X00244 - ATTRB=(ASKIP), X00245 - LENGTH=010 00246 - DFHMDF POS=(21,49), X00247 - ATTRB=(ASKIP), X00248 - LENGTH=008, X00249 - INITIAL='WARD CD:' 00250 -FL12155 DFHMDF POS=(21,58), X00251 +* DATA SET DTSML1 AT LEVEL 012 AS OF 07/19/99 +DTSML1 DFHMDI SIZE=(24,80), X00001**3 + LINE=01, X00002 + COLUMN=01 00003 +FL10101 DFHMDF POS=(01,01), X00004**4 + ATTRB=(ASKIP,FSET), X00005 + LENGTH=002, X00006 + INITIAL='L1' 00007**7 + DFHMDF POS=(01,20), X00008 + ATTRB=(ASKIP), X00009 + LENGTH=020, X00010 + INITIAL=' LMI INQUIRY/UPDATE ' 00011**8 +FL10162 DFHMDF POS=(01,62), X00012**4 + ATTRB=(ASKIP), X00013 + LENGTH=008 00014 +FL10172 DFHMDF POS=(01,72), X00015**4 + ATTRB=(ASKIP), X00016 + LENGTH=008 00017 +FL10272 DFHMDF POS=(02,72), X00018**4 + ATTRB=(ASKIP), X00019 + LENGTH=008 00020 + DFHMDF POS=(03,05), X00021 + ATTRB=(ASKIP), X00022 + LENGTH=007, X00023 + INITIAL='EMP NO:' 00024 +FL10313 DFHMDF POS=(03,13), X00025**4 + ATTRB=(ASKIP), X00026 + LENGTH=003 00027 +FL10317 DFHMDF POS=(03,17), X00028**4 + ATTRB=(ASKIP), X00029 + LENGTH=003 00030 + DFHMDF POS=(03,21), X00031 + ATTRB=(ASKIP), X00032 + LENGTH=001 00033 +FL10324 DFHMDF POS=(03,24), X00034**4 + ATTRB=(ASKIP), X00035 + LENGTH=040 00036 +FL10372 DFHMDF POS=(03,72), X00037**4 + ATTRB=(ASKIP), X00038 + LENGTH=002 00039 + DFHMDF POS=(03,75), X00040 + ATTRB=(ASKIP), X00041 + LENGTH=002, X00042 + INITIAL='OF' 00043 +FL10378 DFHMDF POS=(03,78), X00044**4 + ATTRB=(ASKIP), X00045 + LENGTH=002 00046 + DFHMDF POS=(05,16), X00047 + ATTRB=(ASKIP), X00048 + LENGTH=004, X00049 + INITIAL='QTR:' 00050 +FL10521 DFHMDF POS=(05,21), X00051**4 + ATTRB=(ASKIP), X00052 + LENGTH=002 00053 +FL10524 DFHMDF POS=(05,24), X00054**4 + ATTRB=(ASKIP), X00055 + LENGTH=001 00056 + DFHMDF POS=(05,26), X00057 + ATTRB=(ASKIP), X00058 + LENGTH=001 00059 + DFHMDF POS=(07,04), X00060 + ATTRB=(ASKIP), X00061 + LENGTH=016, X00062 + INITIAL='MONTH 1 EMP CNT:' 00063 +FL10721 DFHMDF POS=(07,21), X00064**4 + ATTRB=(ASKIP), X00065 + LENGTH=009 00066*12 + DFHMDF POS=(07,31), X00067*12 + ATTRB=(ASKIP), X00068 + LENGTH=001 00069 + DFHMDF POS=(07,42), X00070 + ATTRB=(ASKIP), X00071 + LENGTH=009, X00072 + INITIAL='TOT WAGE:' 00073 +FL10752 DFHMDF POS=(07,52), X00074**4 + ATTRB=(ASKIP), X00075 + LENGTH=014 00076 + DFHMDF POS=(08,04), X00077 + ATTRB=(ASKIP), X00078 + LENGTH=016, X00079 + INITIAL='MONTH 2 EMP CNT:' 00080 +FL10821 DFHMDF POS=(08,21), X00081**4 + ATTRB=(ASKIP), X00082 + LENGTH=009 00083*12 + DFHMDF POS=(08,31), X00084*12 + ATTRB=(ASKIP), X00085 + LENGTH=001 00086 + DFHMDF POS=(08,42), X00087 + ATTRB=(ASKIP), X00088 + LENGTH=009, X00089 + INITIAL='TAX WAGE:' 00090 +FL10852 DFHMDF POS=(08,52), X00091**4 + ATTRB=(ASKIP), X00092 + LENGTH=014 00093 + DFHMDF POS=(09,04), X00094 + ATTRB=(ASKIP), X00095 + LENGTH=016, X00096 + INITIAL='MONTH 3 EMP CNT:' 00097 +FL10921 DFHMDF POS=(09,21), X00098**4 + ATTRB=(ASKIP), X00099 + LENGTH=009 00100*12 + DFHMDF POS=(09,31), X00101*12 + ATTRB=(ASKIP), X00102 + LENGTH=001 00103 + DFHMDF POS=(09,42), X00104 + ATTRB=(ASKIP), X00105 + LENGTH=009, X00106 + INITIAL='WGE CHNG:' 00107 +FL10952 DFHMDF POS=(09,52), X00108**4 + ATTRB=(ASKIP), X00109 + LENGTH=008 00110 + DFHMDF POS=(10,42), X00111 + ATTRB=(ASKIP), X00112 + LENGTH=009, X00113 + INITIAL='RPT TYPE:' 00114 +FL11052 DFHMDF POS=(10,52), X00115**4 + ATTRB=(ASKIP), X00116 + LENGTH=010 00117 + DFHMDF POS=(11,42), X00118 + ATTRB=(ASKIP), X00119 + LENGTH=009, X00120 + INITIAL='CNT CHNG:' 00121 +FL11152 DFHMDF POS=(11,52), X00122**4 + ATTRB=(ASKIP), X00123 + LENGTH=008 00124 + DFHMDF POS=(13,08), X00125**5 + ATTRB=(ASKIP), X00126 + LENGTH=007, X00127 + INITIAL='SIC CD:' 00128 +FL11310 DFHMDF POS=(13,16), X00129**6 + ATTRB=(ASKIP), X00130 + LENGTH=004 00131**5 + DFHMDF POS=(13,21), X00132**5 + ATTRB=(ASKIP), X00133 + LENGTH=001 00134 +FL11320 DFHMDF POS=(13,25), X00135**6 + ATTRB=(ASKIP), X00136 + LENGTH=020 00137 + DFHMDF POS=(13,49), X00138**5 + ATTRB=(ASKIP), X00139 + LENGTH=008, X00140 + INITIAL='OLD SIC:' 00141 +FL11355 DFHMDF POS=(13,58), X00142**6 + ATTRB=(ASKIP), X00143 + LENGTH=004 00144**5 + DFHMDF POS=(13,65), X00145**5 + ATTRB=(ASKIP), X00146 + LENGTH=005, X00147 + INITIAL='CHNG:' 00148 +FL11371 DFHMDF POS=(13,71), X00149**6 + ATTRB=(ASKIP), X00150 + LENGTH=008 00151 + DFHMDF POS=(15,04), X00152*10 + ATTRB=(ASKIP), X00153**5 + LENGTH=011, X00154*10 + INITIAL='SIC AUX CD:' 00155*10 +FL11516 DFHMDF POS=(15,16), X00156*10 + ATTRB=(ASKIP), X00157**5 + LENGTH=001 00158**5 + DFHMDF POS=(15,18), X00159*10 + ATTRB=(ASKIP), X00160**5 + LENGTH=001 00161**5 +FL11525 DFHMDF POS=(15,25), X00162*10 + ATTRB=(ASKIP), X00163**5 + LENGTH=010 00164**5 + DFHMDF POS=(17,06), X00165*10 + ATTRB=(ASKIP), X00166*10 + LENGTH=009, X00167*10 + INITIAL='NAICS CD:' 00168*10 +FL11716 DFHMDF POS=(17,16), X00169*10 + ATTRB=(ASKIP), X00170*11 + LENGTH=006 00171*10 + DFHMDF POS=(17,23), X00172*10 + ATTRB=(ASKIP), X00173*10 + LENGTH=001 00174*10 +FL11725 DFHMDF POS=(17,25), X00175*10 + ATTRB=(ASKIP), X00176*10 + LENGTH=020 00177*10 + DFHMDF POS=(17,47), X00178*10 + ATTRB=(ASKIP), X00179*10 + LENGTH=010, X00180*10 + INITIAL='OLD NAICS:' 00181*10 +FL11758 DFHMDF POS=(17,58), X00182*10 + ATTRB=(ASKIP), X00183*10 + LENGTH=006 00184*10 + DFHMDF POS=(17,65), X00185*10 + ATTRB=(ASKIP), X00186*10 + LENGTH=005, X00187*10 + INITIAL='CHNG:' 00188*10 +FL11771 DFHMDF POS=(17,71), X00189*10 + ATTRB=(ASKIP), X00190*10 + LENGTH=008 00191*10 + DFHMDF POS=(19,08), X00192**5 + ATTRB=(ASKIP), X00193**5 + LENGTH=007, X00194**5 + INITIAL='OWN CD:' 00195**5 +FL11910 DFHMDF POS=(19,16), X00196**6 + ATTRB=(ASKIP), X00197**5 + LENGTH=002 00198**5 + DFHMDF POS=(19,19), X00199**5 + ATTRB=(ASKIP), X00200**5 + LENGTH=001 00201**5 +FL11920 DFHMDF POS=(19,25), X00202**6 + ATTRB=(ASKIP), X00203**5 + LENGTH=010 00204**5 + DFHMDF POS=(19,49), X00205**5 + ATTRB=(ASKIP), X00206**5 + LENGTH=008, X00207**5 + INITIAL='OLD OWN:' 00208**5 +FL11955 DFHMDF POS=(19,58), X00209**6 + ATTRB=(ASKIP), X00210**5 + LENGTH=002 00211**5 + DFHMDF POS=(19,65), X00212**5 + ATTRB=(ASKIP), X00213**5 + LENGTH=005, X00214**5 + INITIAL='CHNG:' 00215**5 +FL11971 DFHMDF POS=(19,71), X00216**6 + ATTRB=(ASKIP), X00217**5 + LENGTH=008 00218**5 + DFHMDF POS=(21,05), X00219**6 + ATTRB=(ASKIP), X00220**5 + LENGTH=010, X00221**6 + INITIAL='MULTI IND:' 00222**6 +FL12110 DFHMDF POS=(21,16), X00223**6 + ATTRB=(ASKIP), X00224**5 + LENGTH=001 00225**6 + DFHMDF POS=(21,18), X00226**6 + ATTRB=(ASKIP), X00227**5 + LENGTH=001 00228**5 +FL12120 DFHMDF POS=(21,25), X00229**6 + ATTRB=(ASKIP), X00230**5 + LENGTH=010 00231**5 + DFHMDF POS=(21,49), X00232**6 + ATTRB=(ASKIP), X00233**5 + LENGTH=008, X00234**5 + INITIAL='WARD CD:' 00235**6 +FL12155 DFHMDF POS=(21,58), X00236**6 + ATTRB=(ASKIP), X00237**5 + LENGTH=002 00238**9 +FL12312 DFHMDF POS=(23,12), X00239**4 + ATTRB=(ASKIP), X00240 + LENGTH=008 00241 +FL12322 DFHMDF POS=(23,22), X00242**4 + ATTRB=(ASKIP), X00243 + LENGTH=007 00244 +FL12331 DFHMDF POS=(23,31), X00245**4 + ATTRB=(ASKIP), X00246 + LENGTH=007 00247 +FL12340 DFHMDF POS=(23,40), X00248**4 + ATTRB=(ASKIP), X00249 + LENGTH=007 00250 +FL12350 DFHMDF POS=(23,50), X00251**4 ATTRB=(ASKIP), X00252 - LENGTH=002 00253 -FL12312 DFHMDF POS=(23,12), X00254 + LENGTH=007 00253 +FL12401 DFHMDF POS=(24,01), X00254**4 ATTRB=(ASKIP), X00255 LENGTH=008 00256 -FL12322 DFHMDF POS=(23,22), X00257 +FL12410 DFHMDF POS=(24,10), X00257**4 ATTRB=(ASKIP), X00258 - LENGTH=007 00259 -FL12331 DFHMDF POS=(23,31), X00260 + LENGTH=058 00259 + DFHMDF POS=(24,69), X00260 ATTRB=(ASKIP), X00261 - LENGTH=007 00262 -FL12340 DFHMDF POS=(23,40), X00263 - ATTRB=(ASKIP), X00264 - LENGTH=007 00265 -FL12350 DFHMDF POS=(23,50), X00266 - ATTRB=(ASKIP), X00267 - LENGTH=007 00268 -FL12401 DFHMDF POS=(24,01), X00269 - ATTRB=(ASKIP), X00270 - LENGTH=008 00271 -FL12410 DFHMDF POS=(24,10), X00272 - ATTRB=(ASKIP), X00273 - LENGTH=058 00274 - DFHMDF POS=(24,69), X00275 - ATTRB=(ASKIP), X00276 - LENGTH=006, X00277 - INITIAL='GO TO:' 00278 -FL12476 DFHMDF POS=(24,76), X00279 - ATTRB=(ASKIP), X00280 - LENGTH=002 00281 - DFHMDF POS=(24,79), X00282 - ATTRB=(ASKIP), X00283 - LENGTH=001 00284 + LENGTH=006, X00262 + INITIAL='GO TO:' 00263 +FL12476 DFHMDF POS=(24,76), X00264**4 + ATTRB=(ASKIP), X00265 + LENGTH=002 00266 + DFHMDF POS=(24,79), X00267 + ATTRB=(ASKIP), X00268 + LENGTH=001 00269 diff --git a/Maps/DTSMSET.cpy b/Maps/DTSMSET.cpy index 4746674..6848e3f 100644 --- a/Maps/DTSMSET.cpy +++ b/Maps/DTSMSET.cpy @@ -29677,16 +29677,6 @@ 02 FILLER REDEFINES FL11771F. 04 FL11771A PIC X. 02 FL11771I PIC X(8). - 02 FL11816L PIC S9(4) COMP-5. - 02 FL11816F PIC X(1). - 02 FILLER REDEFINES FL11816F. - 04 FL11816A PIC X. - 02 FL11816I PIC X(6). - 02 FL11825L PIC S9(4) COMP-5. - 02 FL11825F PIC X(1). - 02 FILLER REDEFINES FL11825F. - 04 FL11825A PIC X. - 02 FL11825I PIC X(20). 02 FL11910L PIC S9(4) COMP-5. 02 FL11910F PIC X(1). 02 FILLER REDEFINES FL11910F. @@ -29823,10 +29813,6 @@ 02 FILLER PIC X(3). 02 FL11771O PIC X(8). 02 FILLER PIC X(3). - 02 FL11816O PIC X(6). - 02 FILLER PIC X(3). - 02 FL11825O PIC X(20). - 02 FILLER PIC X(3). 02 FL11910O PIC X(2). 02 FILLER PIC X(3). 02 FL11920O PIC X(10). diff --git a/Maps/DTSMSET.xml b/Maps/DTSMSET.xml index 5b42414..a394548 100644 --- a/Maps/DTSMSET.xml +++ b/Maps/DTSMSET.xml @@ -85284,51 +85284,6 @@ Intensity="NORM" /> - - - - - - - - - - - -