00001 IDENTIFICATION DIVISION. 07/18/00 00002 PROGRAM-ID. DTSCS53. DTSCS53 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV026 00004 DATE-WRITTEN. MAY 1994. DTSCS53 00005 DATE-COMPILED. DTSCS53 00006 SKIP3 DTSCS53 00007 ***** DTSCS53 00008 * DTSCS53 00009 * FUNCTION: FUTA CERTIFICATION/RECERTIFICATION PRINT DTSCS53 00010 * SCREEN PROCESSOR. DTSCS53 00011 * DTSCS53 00012 * DTSCS53 00013 * MODIFICATION LOG: DTSCS53 00014 * DTSCS53 00015 * 05/01/1999 INITIAL DEVELOPMENT. COPIED FROM MACCS53 DTSCS53 00016 * WORK ORDER: PROGRAMMER: ZL1 DTSCS53 00017 * DTSCS53 00018 * 05/20/1999 PICKUP MODIFICATIONS. DTSCS53 00019 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS53 00020 * DTSCS53 00021 * 04/19/2000 REMOVED AGENCY FACTS INFORMATION. LETTER WILL DTSCS53 00022 * PRINT ON AGENCY LETTER HEAD PAPER. DTSCS53 00023 * REFERENCE: E0001 PROGRAMMER: ZL1 DTSCS53 00024 * DTSCS53 00025 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS53 00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS53 00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS53 00028 * DTSCS53 00029 * DTSCS53 00030 * DESCRIPTION: DTSCS53 00031 * DTSCS53 00032 * DTSCS53 00033 * CLEAR: DTSCS53 00034 * DTSCS53 00035 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS53 00036 * DTSCS53 00037 * DTSCS53 00038 * JUMP: DTSCS53 00039 * DTSCS53 00040 * F17 REGISTRATION INQUIRY (11). DTSCS53 00041 * F18 REGISTRATION SEARCHES (12). DTSCS53 00042 * F19 QUARTER INQUIRY (31). DTSCS53 00043 * DTSCS53 00044 * DTSCS53 00045 * INQUIRY: DTSCS53 00046 * DTSCS53 00047 * CONTROL FIELDS: MAP-EMP-NO DTSCS53 00048 * DTSCS53 00049 * DTSCS53 00050 * JUMP IN: DISPLAY INFORMATION ASSOCIATED WITH LCCM-EMP-NO DTSCS53 00051 * (AND DEFAULT YEAR). DTSCS53 00052 * DTSCS53 00053 * JUMP OUT: NO SPECIAL PROCESSING. DTSCS53 00054 * DTSCS53 00055 * ENTER: DISPLAY MAP-EMP-NO. DTSCS53 00056 * DTSCS53 00057 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS53 00058 * DTSCS53 00059 * DTSCS53 00060 * UPDATE: DTSCS53 00061 * DTSCS53 00062 * NONE. DTSCS53 00063 * DTSCS53 00064 * DTSCS53 00065 * PRINT: DTSCS53 00066 * DTSCS53 00067 * 'PRINT' SHOULD BE MADE TO WORK MUCH LIKE A MOD ON AN DTSCS53 00068 * UPDATE SCREEN (SUCCESSFUL INQUIRY; F9 (OR ENTER); PRINT DTSCS53 00069 * OR CANCEL PRINT). DTSCS53 00070 * DTSCS53 00071 * ON THIS SCREEN, LCCM-OP-SCR-UPDATE IMPLIES PRINT AUTHORITY.DTSCS53 00072 * DTSCS53 00073 * USE TS Q 'P' TO COMMUNICATE PRINT LINES TO MACCU357. DTSCS53 00074 * DTSCS53 00075 * SEE 711R1 (FUTA CERTIFICATION) IN \RAP\RPTS FOR DESCRIPTIONDTSCS53 00076 * AND LAYOUT OF PRINT. DTSCS53 00077 * DTSCS53 00078 * DTSCS53 00079 * RECORDS READ: DTSCS53 00080 * DTSCS53 00081 * MASTER: DTSCS53 00082 * DTSCS53 00083 * MPRF DTSCS53 00084 * MSOS DTSCS53 00085 * MQTR DTSCS53 00086 * MDST DTSCS53 00087 * DTSCS53 00088 * DTSCS53 00089 * ALTERNATE INDEX: DTSCS53 00090 * DTSCS53 00091 * IEIN DTSCS53 00092 * DTSCS53 00093 * DTSCS53 00094 * REFERENCE: DTSCS53 00095 * DTSCS53 00096 * NONE. DTSCS53 00097 * DTSCS53 00098 * DTSCS53 00099 * ACCOUNTING TRANSACTION COLLECTION: DTSCS53 00100 * DTSCS53 00101 * NONE. DTSCS53 00102 * DTSCS53 00103 * DTSCS53 00104 * RECORDS UPDATED: DTSCS53 00105 * DTSCS53 00106 * MASTER: DTSCS53 00107 * DTSCS53 00108 * NONE. DTSCS53 00109 * DTSCS53 00110 * DTSCS53 00111 * REFERENCE: DTSCS53 00112 * DTSCS53 00113 * NONE. DTSCS53 00114 * DTSCS53 00115 * DTSCS53 00116 * ACCOUNTING TRANSACTION COLLECTION: DTSCS53 00117 * DTSCS53 00118 * NONE. DTSCS53 00119 * DTSCS53 00120 * DTSCS53 00121 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS53 00122 * DTSCS53 00123 * NONE. DTSCS53 00124 * DTSCS53 00125 * DTSCS53 00126 * TEMPORARY STORAGE USAGE: DTSCS53 00127 * DTSCS53 00128 * P COMMUNICATE PRINT LINES TO DTSCU357. DTSCS53 00129 * DTSCS53 00130 * DTSCS53 00131 * MODULES LINKED TO: DTSCS53 00132 * DTSCS53 00133 * DTSCU001 DATE EDIT/CONVERSION. DTSCS53 00134 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS53 00135 * DTSCU007 YEAR EDIT/CONVERSION. DTSCS53 00136 * DTSCU013 COUNT (INTENGER) FROM SCREEN FORMAT/EDIT. DTSCS53 00137 * DTSCU056 RATE DISPLAY. DTSCS53 00138 * DTSCU111 ADDR LOOKUP. DTSCS53 00139 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS53 00140 * DTSCU119 AGENCY FACTS. DTSCS53 00141 * DTSCU357 ON-LINE PRINTING. DTSCS53 00142 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS53 00143 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCS53 00144 * DTSCU829 TEMPORARY STORAGE PROCESSING. DTSCS53 00145 * DTSCS53 00146 * DTSCS53 00147 * NOTES FOR JEFF: DTSCS53 00148 * DTSCS53 00149 * . THE GENERAL IDEA IS THE SAME AS VERMONT. THERE ARE A DTSCS53 00150 * COUPLE OF DEPARTURES: DTSCS53 00151 * DTSCS53 00152 * . ABILITY TO "COMBINE" INFORMATION FROM SEVERAL EMPLOYERS DTSCS53 00153 * EACH OF WHOM HAS THE SAME MPRF-FEIN. THIS IS THE MOST DTSCS53 00154 * SIGNIFICANT ENHANCEMENT TO VERMONT. IF MAP-COMBINE IS DTSCS53 00155 * EQUAL TO 'Y', THEN TAXABLE WAGES AND PAID AMOUNTS ARE DTSCS53 00156 * "COMBINED" FROM ALL EMPLOYERS WITH MPRF-FEIN EQUAL TO DTSCS53 00157 * MAP-FEIN (THE OTHER DATA ELEMENTS (PRIMARY NAME, DTSCS53 00158 * ADDRESS, RATE) COME FROM MAP-EMP-NO). DTSCS53 00159 * DTSCS53 00160 * . GREATER ADDRESS FLEXIBILITY. MAP-ADDR-TYPE AND DTSCS53 00161 * MAP-ADDR-ID. SIMILAR TO THE ADDRESS FLEXIBILITY ON DTSCS53 00162 * SCREEN 76. DTSCS53 00163 * DTSCS53 00164 * . FOUR LINES OF FREE FORM TEXT ON THE DOCUMENT. JUST DTSCS53 00165 * PRINT AND THROW AWAY. DTSCS53 00166 * DTSCS53 00167 * DTSCS53 00168 * . IN MONTANA, THE PROCESS OF FINDING "UI CONTRIBUTIONS PAID" DTSCS53 00169 * WILL BE SIMPLER THAN IN VERMONT. DTSCS53 00170 * DTSCS53 00171 * I HAVE ADDED A (REDUNDANT) DATA ELEMENT, MDST-RECEIVED-DATE,DTSCS53 00172 * TO THE MDST RECORDS. THUS, YOU DON'T HAVE TO LOOK AT THE DTSCS53 00173 * MPAY RECORDS. ASSUMING WRK-YRQ IS THE QUARTER BEING DTSCS53 00174 * PROCESSED: DTSCS53 00175 * DTSCS53 00176 * MOVE +0 TO WRK-UI-PAID-PRIOR DTSCS53 00177 * WRK-UI-PAID-THRU DTSCS53 00178 * WRK-UI-PAID-AFTER. DTSCS53 00179 * DTSCS53 00180 * MOVE LOW-VALUES TO MDST-KEY-AREA. DTSCS53 00181 * MOVE WRK-EMP-NO TO MDST-EMP-NO. DTSCS53 00182 * SET MDST-DST-88 TO TRUE. DTSCS53 00183 * MOVE WRK-YRQ TO MDST-YRQ. DTSCS53 00184 * MOVE MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSCS53 00185 * PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS53 00186 * PERFORM P****-SCAN-MDST THRU P****-EXIT DTSCS53 00187 * UNTIL L810-NO-REC-88. DTSCS53 00188 * DTSCS53 00189 * P****-SCAN-MDST. DTSCS53 00190 * MOVE MSKL-REC TO MDST-REC. DTSCS53 00191 * DTSCS53 00192 * IF MDST-YRQ > WRK-YRQ DTSCS53 00193 * PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS53 00194 * SET L810-NO-REC-88 TO TRUE DTSCS53 00195 * GO TO P****-EXIT. DTSCS53 00196 * DTSCS53 00197 * PERFORM DTSCS53 00198 * VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSCS53 00199 * UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSCS53 00200 * IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSCS53 00201 * IF MAP-FORM-IND = '2' OR '3' DTSCS53 00202 * IF MDST-RECEIVED-DATE > WRK-0415-DATE DTSCS53 00203 * ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 00204 * TO WRK-UI-PAID-AFTER DTSCS53 00205 * ELSE DTSCS53 00206 * ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 00207 * TO WRK-UI-PAID-PRIOR DTSCS53 00208 * END-IF DTSCS53 00209 * ELSE DTSCS53 00210 * IF MDST-RECEIVED-DATE < WRK-0201-DATE DTSCS53 00211 * ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 00212 * TO WRK-UI-PAID-PRIOR DTSCS53 00213 * ELSE DTSCS53 00214 * IF MDST-RECEIVED-DATE > WRK-0210-DATE DTSCS53 00215 * ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 00216 * TO WRK-UI-PAID-AFTER DTSCS53 00217 * ELSE DTSCS53 00218 * ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 00219 * TO WRK-UI-PAID-THRU DTSCS53 00220 * END-IF DTSCS53 00221 * END-IF DTSCS53 00222 * END-IF DTSCS53 00223 * END-PERFORM. DTSCS53 00224 * DTSCS53 00225 * PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS53 00226 * P****-EXIT. EXIT. DTSCS53 00227 * DTSCS53 00228 * DTSCS53 00229 * . OF COURSE, YOU CAN TAKE THE ON-LINE PRINTING (AND TEMPORARY DTSCS53 00230 * STORAGE PROCESSING OUT OF MACCS61, MACCS62, OR MACCS21). DTSCS53 00231 * DTSCS53 00232 * DTSCS53 00233 * . PLEASE CALL THE "ACENCY FACTS" MODULE (MACCU119) WITH DTSCS53 00234 * L119-REQ-CAPS-88 AND L119-REQ-NO-UNIT-88 FOR THE THREE DTSCS53 00235 * LINES AT THE TOP OF THE PAGE (STATE OF MONTANA, ETC). DTSCS53 00236 * L119-AGY-NAMEB1, L119-AGY-NAMEB2, L119-UI-DIV-CHIEF-NAME. DTSCS53 00237 * DTSCS53 00238 * MACCS61 USED AS BASE DTSCS53 00239 ***** DTSCS53 00240 DTSCS53 00241 ENVIRONMENT DIVISION. DTSCS53 00242 DTSCS53 00243 DATA DIVISION. DTSCS53 00244 DTSCS53 00245 WORKING-STORAGE SECTION. DTSCS53 002455 77 PAN-VALET PICTURE X(24) VALUE '026DTSCS53 07/18/00'. DTSCS53 00246 DTSCS53 00247 01 WRK-AREA. DTSCS53 00248 05 WRK-ABEND-CD PIC X(04) VALUE 'S53 '. DTSCS53 00249 DTSCS53 00250 05 WRK-SCR-ID. DTSCS53 00251 10 WRK-SCR-ID-N PIC 9(02) VALUE 53. DTSCS53 00252 DTSCS53 00253 05 WRK-F03-SCR-ID PIC X(02) VALUE '50'. DTSCS53 00254 DTSCS53 00255 05 WRK-AMT-LINE-MAX PIC S9(04) COMP VALUE +5. DTSCS53 00256 DTSCS53 00257 05 WRK-TEXT-LINE-MAX PIC S9(04) COMP VALUE +4. DTSCS53 00258 DTSCS53 00259 DTSCS53 00260 05 SCR-ACCESS-IND PIC X(01). DTSCS53 00261 88 SCR-ACCESS-INQ VALUE '1'. DTSCS53 00262 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS53 00263 DTSCS53 00264 05 CURSOR-SET-IND PIC X(01). DTSCS53 00265 88 CURSOR-SET-YES VALUE 'Y'. DTSCS53 00266 88 CURSOR-SET-NO VALUE 'N'. DTSCS53 00267 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS53 00268 DTSCS53 00269 05 REQ-IND PIC X(01). DTSCS53 00270 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS53 00271 88 REQ-ERROR VALUE 'O'. DTSCS53 00272 88 REQ-JUMP VALUE 'J'. DTSCS53 00273 88 REQ-UPDATE VALUE 'U'. DTSCS53 00274 88 REQ-INQUIRE VALUE 'I'. DTSCS53 00275 88 REQ-CLEAR VALUE 'C'. DTSCS53 00276 88 REQ-EDIT VALUE 'E'. DTSCS53 00277 DTSCS53 00278 05 RESP-IND PIC X(01). DTSCS53 00279 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS53 00280 88 RESP-SEND-MAP VALUE 'M'. DTSCS53 00281 88 RESP-JUMP VALUE 'J'. DTSCS53 00282 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS53 00283 DTSCS53 00284 05 WRK-MSG-AREA PIC X(64). DTSCS53 00285 DTSCS53 00286 05 WRK-ATB-AN PIC X(01). DTSCS53 00287 05 WRK-ATB-NUM PIC X(01). DTSCS53 00288 DTSCS53 00289 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS53 00290 DTSCS53 00291 05 WRK-CTR PIC S9(04) COMP. DTSCS53 00292 DTSCS53 00293 05 WRK-MPRF-IND PIC X(01). DTSCS53 00294 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS53 00295 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS53 00296 DTSCS53 00297 05 WRK-PREVENTION-ERROR PIC X(01). DTSCS53 00298 88 WRK-NO-KILLER-ERROR VALUE 'Y'. DTSCS53 00299 88 WRK-KILLER-ERROR VALUE 'N'. DTSCS53 00300 DTSCS53 00301 05 WRK-DISPLAY PIC 9(11). DTSCS53 00302 DTSCS53 00303 05 FILLER REDEFINES WRK-DISPLAY. DTSCS53 00304 10 FILLER PIC X(05). DTSCS53 00305 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS53 00306 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS53 00307 DTSCS53 00308 05 FILLER REDEFINES WRK-DISPLAY. DTSCS53 00309 10 FILLER PIC X(08). DTSCS53 00310 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS53 00311 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS53 00312 10 WRK-YRQ-Q REDEFINES WRK-DISPLAY-QTR-Q PIC 9(01). DTSCS53 00313 DTSCS53 00314 05 FILLER REDEFINES WRK-DISPLAY. DTSCS53 00315 10 FILLER PIC 9(05). DTSCS53 00316 10 WRK-DISPLAY-YR PIC 9(02). DTSCS53 00317 10 WRK-DISPLAY-MO PIC 9(02). DTSCS53 00318 10 WRK-DISPLAY-DA PIC 9(02). DTSCS53 00319 DTSCS53 00320 05 WRK-YRQ PIC S9(05) COMP-3. DTSCS53 00321 DTSCS53 00322 05 WRK-YRQ-END PIC S9(05) COMP-3. DTSCS53 00323 DTSCS53 00324 05 WRK-TABLE OCCURS 5 TIMES. DTSCS53 00325 10 WRK-UI-PAID-PRIOR PIC S9(11)V9(02) COMP-3. DTSCS53 00326 10 WRK-UI-PAID-THRU PIC S9(11)V9(02) COMP-3. DTSCS53 00327 10 WRK-UI-PAID-AFTER PIC S9(11)V9(02) COMP-3. DTSCS53 00328 10 WRK-TAXABLE-WAGES PIC S9(11)V9(02) COMP-3. DTSCS53 00329 10 WRK-UI-RATE PIC S9V9(04) COMP-3. DTSCS53 00330 88 WRK-NO-UI-RATE-88 VALUE -9.9999. DTSCS53 00331 10 WRK-LIABLE-IND PIC X(01). DTSCS53 00332 88 WRK-LIABLE-88 VALUE 'Y'. DTSCS53 00333 88 WRK-NOT-LIABLE-88 VALUE 'N'. DTSCS53 00334 DTSCS53 00335 05 WRK-RPT-RECEIVED-INDS. DTSCS53 00336 10 WRK-RPT-RECEIVED-IND OCCURS 4 TIMES DTSCS53 00337 PIC X(01). DTSCS53 00338 DTSCS53 00339 05 WRK-FEIN PIC S9(09) COMP-3. DTSCS53 00340 DTSCS53 00341 05 WRK-0201-DATE PIC S9(09) COMP-3. DTSCS53 00342 DTSCS53 00343 05 WRK-0210-DATE PIC S9(09) COMP-3. DTSCS53 00344 DTSCS53 00345 05 WRK-0415-DATE PIC S9(09) COMP-3. DTSCS53 00346 DTSCS53 00347 05 WRK-CURR-YRQ PIC 9(5). DTSCS53 00348 05 FILLER REDEFINES WRK-CURR-YRQ. DTSCS53 00349 10 FILLER PIC X(2). DTSCS53 00350 10 WRK-CURR-YRQ-YR PIC 99. DTSCS53 00351 10 WRK-CURR-YRQ-Q PIC 9. DTSCS53 00352 DTSCS53 00353 EJECT DTSCS53 00354 ***** DTSCS53 00355 * DTSCS53 00356 ***** DTSCS53 00357 DTSCS53 00358 01 MSG-LITERALS. DTSCS53 00359 DTSCS53 00360 05 MSG-E531-AREA. DTSCS53 00361 10 FILLER PIC X(04) VALUE 'E531'. DTSCS53 00362 10 FILLER PIC X(30) DTSCS53 00363 VALUE 'PRINT FAILED '. DTSCS53 00364 10 FILLER PIC X(30) DTSCS53 00365 VALUE ' '. DTSCS53 00366 DTSCS53 00367 05 MSG-P532-AREA. DTSCS53 00368 10 FILLER PIC X(04) VALUE 'P532'. DTSCS53 00369 10 FILLER PIC X(30) DTSCS53 00370 VALUE 'NOT LIABLE DURING THE YEAR REQ'. DTSCS53 00371 10 FILLER PIC X(30) DTSCS53 00372 VALUE 'UESTED '. DTSCS53 00373 DTSCS53 00374 DTSCS53 00375 05 MSG-E533-AREA. DTSCS53 00376 10 FILLER PIC X(04) VALUE 'E533'. DTSCS53 00377 10 FILLER PIC X(30) DTSCS53 00378 VALUE 'INFORMATION HAS BEEN ARCHIVED '. DTSCS53 00379 10 FILLER PIC X(30) DTSCS53 00380 VALUE ' SYSTEM CAN NOT CERTIFY '. DTSCS53 00381 EJECT DTSCS53 00382 01 LINES-OF-REPORT-711. DTSCS53 00383 05 LINE01. DTSCS53 00384 10 FILLER PIC X(31) VALUE SPACES. DTSCS53 00385 10 LINE01-AGY-NAMEB1 PIC X(40). DTSCS53 00386 10 FILLER PIC X(07) VALUE SPACES. DTSCS53 00387 DTSCS53 00388 05 LINE02. DTSCS53 00389 10 FILLER PIC X(28) VALUE SPACES. DTSCS53 00390 10 LINE02-AGY-NAMEB2 PIC X(40). DTSCS53 00391 10 FILLER PIC X(10) VALUE SPACES. DTSCS53 00392 DTSCS53 00393 05 LINE03. DTSCS53 00394 10 FILLER PIC X(17) VALUE SPACES. DTSCS53 00395 10 LINE03-PROGRAM-NAME PIC X(50). DTSCS53 00396 10 FILLER PIC X(11) VALUE SPACES. DTSCS53 00397 DTSCS53 00398 05 LINE05. DTSCS53 00399 10 FILLER PIC X(40) VALUE SPACES. DTSCS53 00400 10 FILLER PIC X(18) VALUE DTSCS53 00401 'FUTA CERTIFICATION'. DTSCS53 00402 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00403 DTSCS53 00404 05 LINE08. DTSCS53 00405 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00406 10 FILLER PIC X(05) VALUE 'FORM '. DTSCS53 00407 10 LINE08-FORM-ID PIC X(04). DTSCS53 00408 10 FILLER PIC X(35) VALUE SPACES. DTSCS53 00409 10 FILLER PIC X(19) VALUE DTSCS53 00410 'FEDERAL ID NUMBER:'. DTSCS53 00411 10 LINE08-FEIN-X PIC X(10). DTSCS53 00412 10 LINE08-FEIN REDEFINES LINE08-FEIN-X DTSCS53 00413 PIC 99B9999999. DTSCS53 00414 10 FILLER PIC X(05) VALUE SPACES. DTSCS53 00415 DTSCS53 00416 05 LINE09. DTSCS53 00417 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00418 10 FILLER PIC X(58) VALUE DTSCS53 00419 'DEPARTMENT OF THE TREASURY'. DTSCS53 00420 DTSCS53 00421 05 LINE10. DTSCS53 00422 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00423 10 FILLER PIC X(24) VALUE DTSCS53 00424 'INTERNAL REVENUE SERVICE'. DTSCS53 00425 10 FILLER PIC X(15) VALUE SPACES. DTSCS53 00426 10 FILLER PIC X(24) VALUE DTSCS53 00427 'STATE REPORTING NUMBER: '. DTSCS53 00428 10 LINE10-EMP-NO PIC 999B999. DTSCS53 00429 10 FILLER PIC X(08) VALUE SPACES. DTSCS53 00430 DTSCS53 00431 05 LINE14. DTSCS53 00432 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00433 10 FILLER PIC X(58) VALUE ' EMPLOYER ENTITY:'.DTSCS53 00434 DTSCS53 00435 05 LINE15. DTSCS53 00436 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00437 10 LINE15-MAIL-1 PIC X(40). DTSCS53 00438 10 FILLER PIC X(15) VALUE SPACES. DTSCS53 00439 10 FILLER PIC X(14) VALUE 'STATE: DC '. DTSCS53 00440 10 FILLER PIC X(09) VALUE SPACES. DTSCS53 00441 DTSCS53 00442 05 LINE16. DTSCS53 00443 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00444 10 LINE16-MAIL-2 PIC X(40). DTSCS53 00445 10 FILLER PIC X(38) VALUE SPACES. DTSCS53 00446 DTSCS53 00447 05 LINE17. DTSCS53 00448 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00449 10 LINE17-MAIL-3 PIC X(40). DTSCS53 00450 10 FILLER PIC X(16) VALUE SPACES. DTSCS53 00451 10 FILLER PIC X(06) VALUE 'YEAR: '. DTSCS53 00452 10 LINE17-YEAR PIC 9(04). DTSCS53 00453 10 FILLER PIC X(12) VALUE SPACES. DTSCS53 00454 DTSCS53 00455 05 LINE18. DTSCS53 00456 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00457 10 LINE18-MAIL-4 PIC X(40). DTSCS53 00458 10 FILLER PIC X(38) VALUE SPACES. DTSCS53 00459 DTSCS53 00460 05 LINE19. DTSCS53 00461 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00462 10 LINE19-MAIL-5 PIC X(40). DTSCS53 00463 10 FILLER PIC X(07) VALUE SPACES. DTSCS53 00464 10 FILLER PIC X(15) VALUE 'DATE PREPARED: '. DTSCS53 00465 10 LINE19-PREPARED PIC X(10). DTSCS53 00466 10 FILLER PIC X(06) VALUE SPACES. DTSCS53 00467 DTSCS53 00468 05 LINE23. DTSCS53 00469 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00470 10 FILLER PIC X(26) VALUE SPACES. DTSCS53 00471 10 FILLER PIC X(13) VALUE 'STATE EXPER '. DTSCS53 00472 10 FILLER PIC X(39) VALUE DTSCS53 00473 '--------CONTRIBUTIONS PAID-------------'. DTSCS53 00474 DTSCS53 00475 05 LINE24. DTSCS53 00476 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00477 10 FILLER PIC X(24) VALUE SPACES. DTSCS53 00478 10 FILLER PIC X(14) VALUE 'TAXABLE IENCE'. DTSCS53 00479 10 FILLER PIC X(09) VALUE SPACES. DTSCS53 00480 10 LINE24-PRIOR PIC X(05). DTSCS53 00481 10 FILLER PIC X(08) VALUE SPACES. DTSCS53 00482 10 LINE24-THRU PIC X(05). DTSCS53 00483 10 FILLER PIC X(08) VALUE SPACES. DTSCS53 00484 10 LINE24-AFTER PIC X(05). DTSCS53 00485 DTSCS53 00486 05 LINE25. DTSCS53 00487 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00488 10 FILLER PIC X(26) VALUE SPACES. DTSCS53 00489 10 FILLER PIC X(12) VALUE 'WAGES RATE'. DTSCS53 00490 10 FILLER PIC X(06) VALUE SPACES. DTSCS53 00491 10 LINE25-PRIOR PIC X(08). DTSCS53 00492 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00493 10 LINE25-THRU PIC X(10). DTSCS53 00494 10 FILLER PIC X(08) VALUE SPACES. DTSCS53 00495 10 LINE25-AFTER PIC X(05). DTSCS53 00496 DTSCS53 00497 05 LINE26-NOT-LIABLE. DTSCS53 00498 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00499 10 FILLER PIC X(46) VALUE DTSCS53 00500 'EMPLOYER NOT SUBJECT TO DC UI TAX DURING '. DTSCS53 00501 10 LINE26-YEAR PIC 9(4). DTSCS53 00502 10 FILLER PIC X(28) VALUE SPACES. DTSCS53 00503 DTSCS53 00504 05 LINE26. DTSCS53 00505 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00506 10 FILLER PIC X(16) VALUE ' 1/1 THRU 3/31'. DTSCS53 00507 10 LINE26-F PIC ZZZZ,ZZZ,ZZ9.99. DTSCS53 00508 10 LINE26-9 PIC X(07). DTSCS53 00509 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00510 10 LINE26-H PIC ZZ,ZZZ,ZZ9.99. DTSCS53 00511 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00512 10 LINE26-I-X PIC X(12). DTSCS53 00513 10 LINE26-I REDEFINES DTSCS53 00514 LINE26-I-X PIC ZZZZZ,ZZ9.99. DTSCS53 00515 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00516 10 LINE26-J PIC ZZZZZ,ZZ9.99. DTSCS53 00517 DTSCS53 00518 05 LINE27. DTSCS53 00519 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00520 10 FILLER PIC X(16) VALUE ' 4/1 THRU 6/30'. DTSCS53 00521 10 LINE27-F PIC ZZZZ,ZZZ,ZZ9.99. DTSCS53 00522 10 LINE27-9 PIC X(07). DTSCS53 00523 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00524 10 LINE27-H PIC ZZ,ZZZ,ZZ9.99. DTSCS53 00525 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00526 10 LINE27-I-X PIC X(12). DTSCS53 00527 10 LINE27-I REDEFINES DTSCS53 00528 LINE27-I-X PIC ZZZZZ,ZZ9.99. DTSCS53 00529 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00530 10 LINE27-J PIC ZZZZZ,ZZ9.99. DTSCS53 00531 DTSCS53 00532 05 LINE28. DTSCS53 00533 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00534 10 FILLER PIC X(16) VALUE ' 7/1 THRU 9/30'. DTSCS53 00535 10 LINE28-F PIC ZZZZ,ZZZ,ZZ9.99. DTSCS53 00536 10 LINE28-9 PIC X(07). DTSCS53 00537 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00538 10 LINE28-H PIC ZZ,ZZZ,ZZ9.99. DTSCS53 00539 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00540 10 LINE28-I-X PIC X(12). DTSCS53 00541 10 LINE28-I REDEFINES DTSCS53 00542 LINE28-I-X PIC ZZZZZ,ZZ9.99. DTSCS53 00543 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00544 10 LINE28-J PIC ZZZZZ,ZZ9.99. DTSCS53 00545 DTSCS53 00546 05 LINE29. DTSCS53 00547 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00548 10 FILLER PIC X(16) VALUE '10/1 THRU 12/31 '. DTSCS53 00549 10 LINE29-F PIC ZZZZ,ZZZ,ZZ9.99. DTSCS53 00550 10 LINE29-9 PIC X(07). DTSCS53 00551 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00552 10 LINE29-H PIC ZZ,ZZZ,ZZ9.99. DTSCS53 00553 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00554 10 LINE29-I-X PIC X(12). DTSCS53 00555 10 LINE29-I REDEFINES DTSCS53 00556 LINE29-I-X PIC ZZZZZ,ZZ9.99. DTSCS53 00557 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00558 10 LINE29-J PIC ZZZZZ,ZZ9.99. DTSCS53 00559 DTSCS53 00560 05 LINE30. DTSCS53 00561 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00562 10 FILLER PIC X(16) VALUE ' TOTALS '. DTSCS53 00563 10 LINE30-F PIC ZZZZ,ZZZ,ZZ9.99. DTSCS53 00564 10 LINE30-9 PIC X(07). DTSCS53 00565 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00566 10 LINE30-H PIC ZZ,ZZZ,ZZ9.99. DTSCS53 00567 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00568 10 LINE30-I-X PIC X(12). DTSCS53 00569 10 LINE30-I REDEFINES DTSCS53 00570 LINE30-I-X PIC ZZZZZ,ZZ9.99. DTSCS53 00571 10 FILLER PIC X(01) VALUE ' '. DTSCS53 00572 10 LINE30-J PIC ZZZZZ,ZZ9.99. DTSCS53 00573 DTSCS53 00574 05 LINE33. DTSCS53 00575 10 LINE33-REMARKS-LIT DTSCS53 00576 PIC X(08). DTSCS53 00577 10 FILLER PIC X(70) VALUE SPACES. DTSCS53 00578 DTSCS53 00579 05 LINE35. DTSCS53 00580 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00581 10 LINE35-TEXT PIC X(72). DTSCS53 00582 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00583 DTSCS53 00584 05 LINE36. DTSCS53 00585 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00586 10 LINE36-TEXT PIC X(72). DTSCS53 00587 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00588 DTSCS53 00589 05 LINE37. DTSCS53 00590 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00591 10 LINE37-TEXT PIC X(72). DTSCS53 00592 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00593 DTSCS53 00594 05 LINE38. DTSCS53 00595 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00596 10 LINE38-TEXT PIC X(72). DTSCS53 00597 10 FILLER PIC X(03) VALUE SPACES. DTSCS53 00598 DTSCS53 00599 05 LINE41. DTSCS53 00600 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00601 10 FILLER PIC X(58) VALUE DTSCS53 00602 ' TO THE DIRECTOR OF THE INTERNAL REVENUE SERVICE CENTER'.DTSCS53 00603 DTSCS53 00604 05 LINE43. DTSCS53 00605 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00606 10 FILLER PIC X(07) VALUE SPACES. DTSCS53 00607 10 FILLER PIC X(33) VALUE DTSCS53 00608 'I HEREBY CERTIFY THAT THE RECORDS'. DTSCS53 00609 10 FILLER PIC X(33) VALUE DTSCS53 00610 ' OF THIS OFFICE AGREE WITH'. DTSCS53 00611 10 FILLER PIC X(05) VALUE SPACES. DTSCS53 00612 DTSCS53 00613 05 LINE44. DTSCS53 00614 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00615 10 FILLER PIC X(58) VALUE DTSCS53 00616 ' THE ENTRIES SHOWN ABOVE.'. DTSCS53 00617 DTSCS53 00618 05 LINE47. DTSCS53 00619 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00620 10 FILLER PIC X(58) VALUE DTSCS53 00621 ' CERTIFIED BY:'. DTSCS53 00622 DTSCS53 00623 05 LINE60. DTSCS53 00624 10 FILLER PIC X(20) VALUE SPACES. DTSCS53 00625 10 FILLER PIC X(31) VALUE SPACES. DTSCS53 00626 10 LINE60-TEXT PIC X(25). DTSCS53 00627 10 FILLER PIC X(22) VALUE SPACES. DTSCS53 00628 EJECT DTSCS53 00629 01 L001-COMM-AREA. DTSCS53 00630 ++INCLUDE DTSIL001 DTSCS53 00631 EJECT DTSCS53 00632 01 L004-COMM-AREA. DTSCS53 00633 ++INCLUDE DTSIL004 DTSCS53 00634 EJECT DTSCS53 00635 01 L007-COMM-AREA. DTSCS53 00636 ++INCLUDE DTSIL007 DTSCS53 00637 EJECT DTSCS53 00638 01 L013-COMM-AREA. DTSCS53 00639 ++INCLUDE DTSIL013 DTSCS53 00640 EJECT DTSCS53 00641 01 L018-COMM-AREA. DTSCS53 00642 ++INCLUDE DTSIL018 DTSCS53 00643 EJECT DTSCS53 00644 01 L056-COMM-AREA. DTSCS53 00645 ++INCLUDE DTSIL056 DTSCS53 00646 EJECT DTSCS53 00647 01 L111-COMM-AREA. DTSCS53 00648 ++INCLUDE DTSIL111 DTSCS53 00649 EJECT DTSCS53 00650 01 L112-COMM-AREA. DTSCS53 00651 ++INCLUDE DTSIL112 DTSCS53 00652 EJECT DTSCS53 00653 01 L119-COMM-AREA. DTSCS53 00654 ++INCLUDE DTSIL119 DTSCS53 00655 EJECT DTSCS53 00656 01 L357-COMM-AREA. DTSCS53 00657 ++INCLUDE DTSIL357 DTSCS53 00658 EJECT DTSCS53 00659 01 L381-COMM-AREA. DTSCS53 00660 ++INCLUDE DTSIL381 DTSCS53 00661 EJECT DTSCS53 00662 01 L805-COMM-AREA. DTSCS53 00663 ++INCLUDE DTSIL805 DTSCS53 00664 EJECT DTSCS53 00665 01 L810-COMM-AREA. DTSCS53 00666 05 L810-CONTROL-BLOCK. DTSCS53 00667 ++INCLUDE DTSIL810 DTSCS53 00668 EJECT DTSCS53 00669 05 MSKL-REC. DTSCS53 00670 ++INCLUDE DTSIMSKL DTSCS53 00671 EJECT DTSCS53 00672 01 MPRF-REC. DTSCS53 00673 ++INCLUDE DTSIMPRF DTSCS53 00674 EJECT DTSCS53 00675 01 MSOL-REC. DTSCS53 00676 ++INCLUDE DTSIMSOL DTSCS53 00677 EJECT DTSCS53 00678 01 MQTR-REC. DTSCS53 00679 ++INCLUDE DTSIMQTR DTSCS53 00680 EJECT DTSCS53 00681 01 MDST-REC. DTSCS53 00682 ++INCLUDE DTSIMDST DTSCS53 00683 EJECT DTSCS53 00684 01 L821-COMM-AREA. DTSCS53 00685 05 L821-CONTROL-BLOCK. DTSCS53 00686 ++INCLUDE DTSIL821 DTSCS53 00687 EJECT DTSCS53 00688 05 ISKL-REC. DTSCS53 00689 ++INCLUDE DTSIISKL DTSCS53 00690 SKIP3 DTSCS53 00691 05 IEIN-REC REDEFINES ISKL-REC. DTSCS53 00692 ++INCLUDE DTSIIEIN DTSCS53 00693 EJECT DTSCS53 00694 01 L829-COMM-AREA. DTSCS53 00695 05 L829-CONTROL-BLOCK. DTSCS53 00696 ++INCLUDE DTSIL829 DTSCS53 00697 DTSCS53 00698 05 L829-REC. DTSCS53 00699 ++INCLUDE DTSIXPTS DTSCS53 00700 EJECT DTSCS53 00701 DTSCS53 00702 01 L851-COMM-AREA. DTSCS53 00703 ++INCLUDE DTSIL851 DTSCS53 00704 DTSCS53 00705 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS53 00706 ++INCLUDE DTSIS53 DTSCS53 00707 EJECT DTSCS53 00708 01 CATB-LITERALS. DTSCS53 00709 ++INCLUDE DTSICATB DTSCS53 00710 DTSCS53 00711 01 CFKD-LITERALS. DTSCS53 00712 ++INCLUDE DTSICFKD DTSCS53 00713 DTSCS53 00714 01 CECD-LITERALS. DTSCS53 00715 ++INCLUDE DTSICECD DTSCS53 00716 DTSCS53 00717 01 CPCD-LITERALS. DTSCS53 00718 ++INCLUDE DTSICPCD DTSCS53 00719 EJECT DTSCS53 00720 LINKAGE SECTION. DTSCS53 00721 DTSCS53 00722 01 DFHCOMMAREA. DTSCS53 00723 ++INCLUDE DTSILCCM DTSCS53 00724 EJECT DTSCS53 00725 ******************************************************************DTSCS53 00726 * *DTSCS53 00727 ******************************************************************DTSCS53 00728 DTSCS53 00729 PROCEDURE DIVISION. DTSCS53 00730 DTSCS53 00731 MOVE +0 TO WRK-EMP-NO DTSCS53 00732 WRK-FEIN. DTSCS53 00733 DTSCS53 00734 SET WRK-MPRF-NO-88 TO TRUE. DTSCS53 00735 DTSCS53 00736 MOVE LOW-VALUES TO MAP-AREA. DTSCS53 00737 DTSCS53 00738 SET CURSOR-SET-NO TO TRUE. DTSCS53 00739 DTSCS53 00740 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS53 00741 TO SCR-ACCESS-IND. DTSCS53 00742 DTSCS53 00743 MOVE SPACE TO REQ-IND. DTSCS53 00744 DTSCS53 00745 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS53 00746 DTSCS53 00747 *----------------------------------------------------- DTSCS53 00748 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS53 00749 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS53 00750 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS53 00751 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS53 00752 * DTSCS53 00753 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS53 00754 * PROCESSED. DTSCS53 00755 * DTSCS53 00756 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS53 00757 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS53 00758 * WORK STATION OPERATOR. DTSCS53 00759 *----------------------------------------------------- DTSCS53 00760 DTSCS53 00761 MOVE SPACE TO RESP-IND. DTSCS53 00762 DTSCS53 00763 IF REQ-ERROR DTSCS53 00764 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS53 00765 ELSE DTSCS53 00766 IF REQ-JUMP DTSCS53 00767 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS53 00768 ELSE DTSCS53 00769 IF REQ-CLEAR DTSCS53 00770 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS53 00771 ELSE DTSCS53 00772 IF REQ-CURSOR-TO-GOTO DTSCS53 00773 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS53 00774 ELSE DTSCS53 00775 IF REQ-EDIT DTSCS53 00776 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS53 00777 ELSE DTSCS53 00778 IF REQ-UPDATE DTSCS53 00779 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS53 00780 ELSE DTSCS53 00781 GO TO S899-ABEND. DTSCS53 00782 DTSCS53 00783 *----------------------------------------------------- DTSCS53 00784 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS53 00785 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS53 00786 *----------------------------------------------------- DTSCS53 00787 DTSCS53 00788 IF RESP-SEND-MAP DTSCS53 00789 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS53 00790 SET LCCM-END-TASK-88 TO TRUE DTSCS53 00791 ELSE DTSCS53 00792 IF RESP-SEND-MSGONLY DTSCS53 00793 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS53 00794 SET LCCM-END-TASK-88 TO TRUE DTSCS53 00795 ELSE DTSCS53 00796 IF RESP-JUMP DTSCS53 00797 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS53 00798 ELSE DTSCS53 00799 IF RESP-CURSOR-TO-GOTO DTSCS53 00800 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS53 00801 SET LCCM-END-TASK-88 TO TRUE DTSCS53 00802 ELSE DTSCS53 00803 GO TO S899-ABEND. DTSCS53 00804 DTSCS53 00805 MAINLINE-EXIT. DTSCS53 00806 DTSCS53 00807 EXEC CICS DTSCS53 00808 RETURN DTSCS53 00809 END-EXEC. DTSCS53 00810 DTSCS53 00811 GOBACK. DTSCS53 00812 EJECT DTSCS53 00813 /*****************************************************************DTSCS53 00814 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS53 00815 ******************************************************************DTSCS53 00816 P1000-ANALYZE-REQUEST. DTSCS53 00817 DTSCS53 00818 *----------------------------------------------------- DTSCS53 00819 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS53 00820 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS53 00821 * REPLACED WITH ENTER) DTSCS53 00822 *----------------------------------------------------- DTSCS53 00823 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS53 00824 PERFORM S1210-DEFAULT-YEAR THRU S1210-EXIT DTSCS53 00825 SET LCCM-ENTER-88 TO TRUE DTSCS53 00826 SET REQ-EDIT TO TRUE DTSCS53 00827 IF LCCM-EMP-NO > ZERO DTSCS53 00828 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS53 00829 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS53 00830 END-IF DTSCS53 00831 GO TO P1000-EXIT. DTSCS53 00832 DTSCS53 00833 *----------------------------------------------------- DTSCS53 00834 * MAP IS RECEIVED DTSCS53 00835 *----------------------------------------------------- DTSCS53 00836 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS53 00837 DTSCS53 00838 *----------------------------------------------------- DTSCS53 00839 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS53 00840 * WORK STATION DTSCS53 00841 *----------------------------------------------------- DTSCS53 00842 IF LCCM-CLEAR-88 DTSCS53 00843 SET REQ-CLEAR TO TRUE DTSCS53 00844 GO TO P1000-EXIT. DTSCS53 00845 DTSCS53 00846 *----------------------------------------------------- DTSCS53 00847 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS53 00848 *----------------------------------------------------- DTSCS53 00849 IF LCCM-SCR-PRT-LOCKED DTSCS53 00850 PERFORM P1100-PRT-LOCKED THRU P1100-EXIT DTSCS53 00851 GO TO P1000-EXIT. DTSCS53 00852 DTSCS53 00853 *----------------------------------------------------- DTSCS53 00854 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS53 00855 *----------------------------------------------------- DTSCS53 00856 IF LCCM-PA2-88 DTSCS53 00857 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS53 00858 GO TO P1000-EXIT. DTSCS53 00859 DTSCS53 00860 *----------------------------------------------------- DTSCS53 00861 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS53 00862 *----------------------------------------------------- DTSCS53 00863 IF LCCM-PA-88 DTSCS53 00864 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS53 00865 SET REQ-ERROR TO TRUE DTSCS53 00866 GO TO P1000-EXIT. DTSCS53 00867 DTSCS53 00868 *----------------------------------------------------- DTSCS53 00869 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS53 00870 * CLEAR SCREEN DTSCS53 00871 *----------------------------------------------------- DTSCS53 00872 IF LCCM-F12-88 DTSCS53 00873 MOVE LOW-VALUES TO MAP-AREA DTSCS53 00874 SET REQ-CLEAR TO TRUE DTSCS53 00875 GO TO P1000-EXIT. DTSCS53 00876 DTSCS53 00877 *----------------------------------------------------- DTSCS53 00878 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS53 00879 *----------------------------------------------------- DTSCS53 00880 IF LCCM-F03-88 DTSCS53 00881 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS53 00882 SET REQ-JUMP TO TRUE DTSCS53 00883 GO TO P1000-EXIT. DTSCS53 00884 DTSCS53 00885 *----------------------------------------------------- DTSCS53 00886 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS53 00887 *----------------------------------------------------- DTSCS53 00888 IF LCCM-F04-88 DTSCS53 00889 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS53 00890 SET REQ-JUMP TO TRUE DTSCS53 00891 GO TO P1000-EXIT. DTSCS53 00892 DTSCS53 00893 *--------------------------------------------------------- DTSCS53 00894 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS53 00895 * CORRESPONDENCE SCREEN. DTSCS53 00896 *--------------------------------------------------------- DTSCS53 00897 DTSCS53 00898 IF LCCM-F14-88 DTSCS53 00899 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS53 00900 SET REQ-JUMP TO TRUE DTSCS53 00901 GO TO P1000-EXIT. DTSCS53 00902 DTSCS53 00903 *--------------------------------------------------------- DTSCS53 00904 * IF REGISTRATION INQUIRY SCREEN KEY PRESSED, DTSCS53 00905 * THEN JUMP TO REGISTRATION INQUIRY SCREEN. DTSCS53 00906 *--------------------------------------------------------- DTSCS53 00907 DTSCS53 00908 * IF LCCM-F17-88 DTSCS53 00909 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS53 00910 * SET REQ-JUMP TO TRUE DTSCS53 00911 * GO TO P1000-EXIT. DTSCS53 00912 * DTSCS53 00913 * IF LCCM-F18-88 DTSCS53 00914 * MOVE '12' TO LCCM-REQ-SCR-ID DTSCS53 00915 * SET REQ-JUMP TO TRUE DTSCS53 00916 * GO TO P1000-EXIT. DTSCS53 00917 * DTSCS53 00918 * IF LCCM-F19-88 DTSCS53 00919 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS53 00920 * SET REQ-JUMP TO TRUE DTSCS53 00921 * GO TO P1000-EXIT. DTSCS53 00922 * DTSCS53 00923 *----------------------------------------------------- DTSCS53 00924 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS53 00925 * REQUESTED SCREEN TYPE DTSCS53 00926 *----------------------------------------------------- DTSCS53 00927 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS53 00928 NEXT SENTENCE DTSCS53 00929 ELSE DTSCS53 00930 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS53 00931 SET REQ-JUMP TO TRUE DTSCS53 00932 GO TO P1000-EXIT. DTSCS53 00933 DTSCS53 00934 *----------------------------------------------------- DTSCS53 00935 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS53 00936 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS53 00937 *----------------------------------------------------- DTSCS53 00938 IF LCCM-F09-88 DTSCS53 00939 AND SCR-ACCESS-UPDATE DTSCS53 00940 SET REQ-EDIT TO TRUE DTSCS53 00941 GO TO P1000-EXIT DTSCS53 00942 ELSE DTSCS53 00943 IF LCCM-ENTER-88 DTSCS53 00944 SET REQ-EDIT TO TRUE DTSCS53 00945 GO TO P1000-EXIT. DTSCS53 00946 DTSCS53 00947 *----------------------------------------------------- DTSCS53 00948 * ANY OTHER KEY IS INVALID DTSCS53 00949 *----------------------------------------------------- DTSCS53 00950 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS53 00951 SET REQ-ERROR TO TRUE. DTSCS53 00952 P1000-EXIT. DTSCS53 00953 EXIT. DTSCS53 00954 DTSCS53 00955 ******************************************************************DTSCS53 00956 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS53 00957 ******************************************************************DTSCS53 00958 DTSCS53 00959 P1100-PRT-LOCKED. DTSCS53 00960 *----------------------------------------------------- DTSCS53 00961 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS53 00962 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS53 00963 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS53 00964 *----------------------------------------------------- DTSCS53 00965 IF LCCM-ENTER-88 OR LCCM-F09-88 OR LCCM-F12-88 DTSCS53 00966 SET REQ-UPDATE TO TRUE DTSCS53 00967 ELSE DTSCS53 00968 SET REQ-ERROR TO TRUE DTSCS53 00969 IF LCCM-SCR-PRT-LOCKED DTSCS53 00970 MOVE PMSG-ALT-PRT-CONFIRM TO LCCM-MSG-ID DTSCS53 00971 ELSE DTSCS53 00972 GO TO S899-ABEND. DTSCS53 00973 P1100-EXIT. DTSCS53 00974 EXIT. DTSCS53 00975 /*****************************************************************DTSCS53 00976 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS53 00977 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS53 00978 ******************************************************************DTSCS53 00979 DTSCS53 00980 P2000-REQUEST-ERROR. DTSCS53 00981 IF LCCM-MSG DTSCS53 00982 SET RESP-SEND-MSGONLY TO TRUE DTSCS53 00983 ELSE DTSCS53 00984 GO TO S899-ABEND. DTSCS53 00985 P2000-EXIT. DTSCS53 00986 EXIT. DTSCS53 00987 /*****************************************************************DTSCS53 00988 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS53 00989 ******************************************************************DTSCS53 00990 DTSCS53 00991 P3000-REQUEST-JUMP. DTSCS53 00992 *----------------------------------------------------- DTSCS53 00993 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS53 00994 * BY USER DTSCS53 00995 *----------------------------------------------------- DTSCS53 00996 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS53 00997 DTSCS53 00998 *----------------------------------------------------- DTSCS53 00999 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS53 01000 *----------------------------------------------------- DTSCS53 01001 IF LCCM-MSG DTSCS53 01002 SET RESP-SEND-MSGONLY TO TRUE DTSCS53 01003 SET CURSOR-SET-GOTO TO TRUE DTSCS53 01004 GO TO P3000-EXIT. DTSCS53 01005 SKIP3 DTSCS53 01006 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS53 01007 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS53 01008 IF L018-VALID DTSCS53 01009 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS53 01010 DTSCS53 01011 *----------------------------------------------------- DTSCS53 01012 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS53 01013 *----------------------------------------------------- DTSCS53 01014 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS53 01015 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS53 01016 SET RESP-JUMP TO TRUE. DTSCS53 01017 P3000-EXIT. DTSCS53 01018 EXIT. DTSCS53 01019 /*****************************************************************DTSCS53 01020 * CLEAR KEY WAS PRESSED *DTSCS53 01021 ******************************************************************DTSCS53 01022 DTSCS53 01023 P4000-REQUEST-CLEAR. DTSCS53 01024 DTSCS53 01025 *----------------------------------------------------- DTSCS53 01026 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS53 01027 * FIELDS FROM EARLIER REQUESTS DTSCS53 01028 *----------------------------------------------------- DTSCS53 01029 IF LCCM-EMP-NO > ZERO DTSCS53 01030 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS53 01031 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS53 01032 DTSCS53 01033 MOVE ZERO TO LCCM-EMP-NO. DTSCS53 01034 DTSCS53 01035 PERFORM S1210-DEFAULT-YEAR THRU S1210-EXIT DTSCS53 01036 DTSCS53 01037 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS53 01038 DTSCS53 01039 SET LCCM-SCR-CLEAR TO TRUE. DTSCS53 01040 DTSCS53 01041 IF SCR-ACCESS-UPDATE DTSCS53 01042 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS53 01043 ELSE DTSCS53 01044 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS53 01045 DTSCS53 01046 SET RESP-SEND-MAP TO TRUE. DTSCS53 01047 P4000-EXIT. DTSCS53 01048 EXIT. DTSCS53 01049 /*****************************************************************DTSCS53 01050 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS53 01051 ******************************************************************DTSCS53 01052 DTSCS53 01053 P5000-CURSOR-TO-GOTO. DTSCS53 01054 SET CURSOR-SET-GOTO TO TRUE. DTSCS53 01055 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS53 01056 P5000-EXIT. DTSCS53 01057 EXIT. DTSCS53 01058 /*****************************************************************DTSCS53 01059 * FUNCTION KEY TO PRINT THE RECORD WAS PRESSED DTSCS53 01060 * OR FUNCTION KEY ENTER WAS PRESSED TO VIEW THE DATA DTSCS53 01061 ******************************************************************DTSCS53 01062 DTSCS53 01063 P7000-REQUEST-EDIT. DTSCS53 01064 PERFORM P7100-INITIALIZE-MAP-AREA THRU P7100-EXIT. DTSCS53 01065 DTSCS53 01066 IF SCR-ACCESS-INQ DTSCS53 01067 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS53 01068 ELSE DTSCS53 01069 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS53 01070 DTSCS53 01071 IF LCCM-F09-88 DTSCS53 01072 OR LCCM-ENTER-88 DTSCS53 01073 NEXT SENTENCE DTSCS53 01074 ELSE DTSCS53 01075 GO TO S899-ABEND. DTSCS53 01076 DTSCS53 01077 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS53 01078 DTSCS53 01079 IF LCCM-MSG DTSCS53 01080 NEXT SENTENCE DTSCS53 01081 ELSE DTSCS53 01082 MOVE WRK-EMP-NO TO LCCM-EMP-NO DTSCS53 01083 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS53 01084 DTSCS53 01085 IF LCCM-ERROR-MSG DTSCS53 01086 NEXT SENTENCE DTSCS53 01087 ELSE DTSCS53 01088 IF LCCM-F09-88 DTSCS53 01089 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS53 01090 SET LCCM-SCR-PRT-LOCKED TO TRUE DTSCS53 01091 MOVE PMSG-ALT-PRT-CONFIRM TO LCCM-MSG-AREA. DTSCS53 01092 DTSCS53 01093 SET RESP-SEND-MAP TO TRUE. DTSCS53 01094 P7000-EXIT. DTSCS53 01095 EXIT. DTSCS53 01096 SKIP3 DTSCS53 01097 P7100-INITIALIZE-MAP-AREA. DTSCS53 01098 MOVE LOW-VALUES TO MAP-PRIMARY-NAME DTSCS53 01099 MAP-FORM-IND-MSG DTSCS53 01100 MAP-FEIN-X DTSCS53 01101 MAP-FEIN-MSG DTSCS53 01102 MAP-ATTN-LINE DTSCS53 01103 MAP-DELIV-LINE1 DTSCS53 01104 MAP-DELIV-LINE2 DTSCS53 01105 MAP-CITY DTSCS53 01106 MAP-STATE DTSCS53 01107 MAP-ZIP DTSCS53 01108 MAP-HDG-LN1-PRIOR DTSCS53 01109 MAP-HDG-LN1-THRU DTSCS53 01110 MAP-HDG-LN1-AFTER DTSCS53 01111 MAP-HDG-LN2-PRIOR DTSCS53 01112 MAP-HDG-LN2-THRU DTSCS53 01113 MAP-HDG-LN2-AFTER. DTSCS53 01114 DTSCS53 01115 PERFORM DTSCS53 01116 VARYING WRK-CTR FROM 1 BY 1 DTSCS53 01117 UNTIL WRK-CTR > WRK-AMT-LINE-MAX DTSCS53 01118 MOVE LOW-VALUES TO MAP-LINE (WRK-CTR) DTSCS53 01119 END-PERFORM. DTSCS53 01120 P7100-EXIT. DTSCS53 01121 EXIT. DTSCS53 01122 /*****************************************************************DTSCS53 01123 * THE PRINT FUNCTION WAS CONFIRMED OR CANCELED DTSCS53 01124 ******************************************************************DTSCS53 01125 DTSCS53 01126 P8000-REQUEST-UPDATE. DTSCS53 01127 DTSCS53 01128 IF LCCM-SCR-PRT-LOCKED DTSCS53 01129 PERFORM P8100-PRT THRU P8100-EXIT DTSCS53 01130 ELSE DTSCS53 01131 GO TO S899-ABEND. DTSCS53 01132 DTSCS53 01133 SET RESP-SEND-MAP TO TRUE. DTSCS53 01134 P8000-EXIT. DTSCS53 01135 EXIT. DTSCS53 01136 /*****************************************************************DTSCS53 01137 * *DTSCS53 01138 ******************************************************************DTSCS53 01139 DTSCS53 01140 P8100-PRT. DTSCS53 01141 SET LCCM-SCR-CLEAR TO TRUE. DTSCS53 01142 DTSCS53 01143 IF LCCM-F12-88 DTSCS53 01144 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS53 01145 MOVE PMSG-PRINT-CANCELED TO LCCM-MSG-ID DTSCS53 01146 GO TO P8100-EXIT. DTSCS53 01147 DTSCS53 01148 DTSCS53 01149 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS53 01150 DTSCS53 01151 PERFORM P8110-THE-MOVES THRU P8110-EXIT. DTSCS53 01152 DTSCS53 01153 PERFORM P8120-PRINT THRU P8120-EXIT. DTSCS53 01154 DTSCS53 01155 PERFORM S357-LINK-PRINT THRU S357-EXIT. DTSCS53 01156 DTSCS53 01157 IF L357-FAILED-88 DTSCS53 01158 MOVE MSG-E531-AREA TO WRK-MSG-AREA DTSCS53 01159 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS53 01160 GO TO P8100-EXIT. DTSCS53 01161 DTSCS53 01162 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS53 01163 MOVE MAP-YEAR TO L007-YR-2-X. DTSCS53 01164 DTSCS53 01165 MOVE LOW-VALUES TO MAP-AREA. DTSCS53 01166 DTSCS53 01167 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS53 01168 MOVE L007-YR-2-X TO MAP-YEAR. DTSCS53 01169 DTSCS53 01170 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS53 01171 DTSCS53 01172 IF LCCM-ENTER-88 DTSCS53 01173 MOVE LINE35-TEXT TO MAP-MSG-LINE (1) DTSCS53 01174 MOVE LINE36-TEXT TO MAP-MSG-LINE (2) DTSCS53 01175 MOVE LINE37-TEXT TO MAP-MSG-LINE (3) DTSCS53 01176 MOVE LINE38-TEXT TO MAP-MSG-LINE (4). DTSCS53 01177 DTSCS53 01178 MOVE PMSG-PRINT-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS53 01179 P8100-EXIT. DTSCS53 01180 EXIT. DTSCS53 01181 ****** DTSCS53 01182 * BEFORE THE ACTUAL PRINTING HAPPENS I FELT THAT IT WOULD BE MORE DTSCS53 01183 * STRAIGHTFORWARD TO RETREIVE ALL OF THE INFORMATION NEEDED FOR DTSCS53 01184 * PRINTING. DTSCS53 01185 ****** DTSCS53 01186 P8110-THE-MOVES. DTSCS53 01187 PERFORM S119-AGENCY-FACTS THRU S119-EXIT. DTSCS53 01188 DTSCS53 01189 MOVE SPACES TO LINE01-AGY-NAMEB1. DTSCS53 01190 MOVE SPACES TO LINE02-AGY-NAMEB2. DTSCS53 01191 MOVE SPACES TO LINE03-PROGRAM-NAME. DTSCS53 01192 DTSCS53 01193 EVALUATE MAP-FORM-IND DTSCS53 01194 WHEN '2' DTSCS53 01195 MOVE '1041' TO LINE08-FORM-ID DTSCS53 01196 WHEN '3' DTSCS53 01197 MOVE '1040' TO LINE08-FORM-ID DTSCS53 01198 WHEN OTHER DTSCS53 01199 MOVE ' 940' TO LINE08-FORM-ID DTSCS53 01200 END-EVALUATE. DTSCS53 01201 DTSCS53 01202 IF WRK-FEIN = +0 DTSCS53 01203 MOVE SPACES TO LINE08-FEIN-X DTSCS53 01204 ELSE DTSCS53 01205 MOVE WRK-FEIN TO LINE08-FEIN. DTSCS53 01206 DTSCS53 01207 MOVE WRK-EMP-NO TO LINE10-EMP-NO DTSCS53 01208 DTSCS53 01209 IF MAP-ADDR-TAD-88 DTSCS53 01210 PERFORM S1430-ADDR-TAD THRU S1430-EXIT DTSCS53 01211 ELSE DTSCS53 01212 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA DTSCS53 01213 MOVE +1 TO L013-MIN-CNT DTSCS53 01214 MOVE +999 TO L013-MAX-CNT DTSCS53 01215 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT DTSCS53 01216 PERFORM S1440-ADDR-TAA-OPO THRU S1440-EXIT. DTSCS53 01217 DTSCS53 01218 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS53 01219 DTSCS53 01220 MOVE L112-MAILING-LINE-1 TO LINE15-MAIL-1. DTSCS53 01221 MOVE L112-MAILING-LINE-2 TO LINE16-MAIL-2. DTSCS53 01222 MOVE L112-MAILING-LINE-3 TO LINE17-MAIL-3. DTSCS53 01223 MOVE L112-MAILING-LINE-4 TO LINE18-MAIL-4. DTSCS53 01224 MOVE L112-MAILING-LINE-5 TO LINE19-MAIL-5. DTSCS53 01225 DTSCS53 01226 MOVE MAP-YEAR TO L007-YR-2-X. DTSCS53 01227 PERFORM S007-FROM-YR2 THRU S007-EXIT. DTSCS53 01228 MOVE L007-YR-4-9 TO LINE17-YEAR. DTSCS53 01229 DTSCS53 01230 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS53 01231 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS53 01232 MOVE L001-SLASH-8-DATE TO LINE19-PREPARED. DTSCS53 01233 DTSCS53 01234 MOVE L007-START-YRQ TO WRK-YRQ. DTSCS53 01235 MOVE L007-END-YRQ TO WRK-YRQ-END. DTSCS53 01236 DTSCS53 01237 PERFORM S1211-DETERMINE-UI-PAID-HDGS THRU S1211-EXIT. DTSCS53 01238 DTSCS53 01239 IF MAP-FORM-IND = '2' OR '3' DTSCS53 01240 MOVE '04/15' TO LINE24-PRIOR DTSCS53 01241 MOVE 'OR PRIOR' TO LINE25-PRIOR DTSCS53 01242 MOVE SPACES TO LINE24-THRU DTSCS53 01243 LINE25-THRU DTSCS53 01244 MOVE 'AFTER' TO LINE24-AFTER DTSCS53 01245 MOVE '04/15' TO LINE25-AFTER DTSCS53 01246 ELSE DTSCS53 01247 MOVE 'PRIOR' TO LINE24-PRIOR DTSCS53 01248 MOVE 'TO 02/01' TO LINE25-PRIOR DTSCS53 01249 MOVE '02/01' TO LINE24-THRU DTSCS53 01250 MOVE 'THRU 02/10' TO LINE25-THRU DTSCS53 01251 MOVE 'AFTER' TO LINE24-AFTER DTSCS53 01252 MOVE '02/10' TO LINE25-AFTER. DTSCS53 01253 DTSCS53 01254 SET WRK-NO-KILLER-ERROR TO TRUE. DTSCS53 01255 DTSCS53 01256 MOVE LOW-VALUES TO MAP-FEIN-MSG. DTSCS53 01257 DTSCS53 01258 PERFORM S3500-MISC-EDITS THRU S3500-EXIT. DTSCS53 01259 DTSCS53 01260 MOVE WRK-UI-RATE(1) TO L056-RATE. DTSCS53 01261 PERFORM S056-DISP1-RIGHT THRU S056-EXIT. DTSCS53 01262 MOVE WRK-TAXABLE-WAGES(1) TO LINE26-F. DTSCS53 01263 MOVE L056-DISP-RATE TO LINE26-9. DTSCS53 01264 MOVE WRK-UI-PAID-PRIOR(1) TO LINE26-H. DTSCS53 01265 MOVE WRK-UI-PAID-THRU (1) TO LINE26-I. DTSCS53 01266 MOVE WRK-UI-PAID-AFTER(1) TO LINE26-J. DTSCS53 01267 DTSCS53 01268 MOVE WRK-UI-RATE(2) TO L056-RATE. DTSCS53 01269 PERFORM S056-DISP1-RIGHT THRU S056-EXIT. DTSCS53 01270 MOVE WRK-TAXABLE-WAGES(2) TO LINE27-F. DTSCS53 01271 MOVE L056-DISP-RATE TO LINE27-9. DTSCS53 01272 MOVE WRK-UI-PAID-PRIOR(2) TO LINE27-H. DTSCS53 01273 MOVE WRK-UI-PAID-THRU (2) TO LINE27-I. DTSCS53 01274 MOVE WRK-UI-PAID-AFTER(2) TO LINE27-J. DTSCS53 01275 DTSCS53 01276 MOVE WRK-UI-RATE(3) TO L056-RATE. DTSCS53 01277 PERFORM S056-DISP1-RIGHT THRU S056-EXIT. DTSCS53 01278 MOVE WRK-TAXABLE-WAGES(3) TO LINE28-F. DTSCS53 01279 MOVE L056-DISP-RATE TO LINE28-9. DTSCS53 01280 MOVE WRK-UI-PAID-PRIOR(3) TO LINE28-H. DTSCS53 01281 MOVE WRK-UI-PAID-THRU (3) TO LINE28-I. DTSCS53 01282 MOVE WRK-UI-PAID-AFTER(3) TO LINE28-J. DTSCS53 01283 DTSCS53 01284 MOVE WRK-UI-RATE(4) TO L056-RATE. DTSCS53 01285 PERFORM S056-DISP1-RIGHT THRU S056-EXIT. DTSCS53 01286 MOVE WRK-TAXABLE-WAGES(4) TO LINE29-F. DTSCS53 01287 MOVE L056-DISP-RATE TO LINE29-9. DTSCS53 01288 MOVE WRK-UI-PAID-PRIOR(4) TO LINE29-H. DTSCS53 01289 MOVE WRK-UI-PAID-THRU (4) TO LINE29-I. DTSCS53 01290 MOVE WRK-UI-PAID-AFTER(4) TO LINE29-J. DTSCS53 01291 DTSCS53 01292 MOVE WRK-UI-RATE(5) TO L056-RATE. DTSCS53 01293 PERFORM S056-DISP1-RIGHT THRU S056-EXIT. DTSCS53 01294 MOVE WRK-TAXABLE-WAGES(5) TO LINE30-F. DTSCS53 01295 MOVE L056-DISP-RATE TO LINE30-9. DTSCS53 01296 MOVE WRK-UI-PAID-PRIOR(5) TO LINE30-H. DTSCS53 01297 MOVE WRK-UI-PAID-THRU (5) TO LINE30-I. DTSCS53 01298 MOVE WRK-UI-PAID-AFTER(5) TO LINE30-J. DTSCS53 01299 DTSCS53 01300 **** ONLY DISPLAY CENTER COLUMN IF FORM-IND = 1 (FORM 940). DTSCS53 01301 IF MAP-FORM-IND = '2' OR '3' DTSCS53 01302 MOVE SPACES TO LINE26-I-X DTSCS53 01303 LINE27-I-X DTSCS53 01304 LINE28-I-X DTSCS53 01305 LINE29-I-X DTSCS53 01306 LINE30-I-X. DTSCS53 01307 DTSCS53 01308 IF MAP-MSG-LINE (1) = SPACES DTSCS53 01309 AND MAP-MSG-LINE (2) = SPACES DTSCS53 01310 AND MAP-MSG-LINE (3) = SPACES DTSCS53 01311 AND MAP-MSG-LINE (4) = SPACES DTSCS53 01312 MOVE SPACES TO LINE33-REMARKS-LIT DTSCS53 01313 ELSE DTSCS53 01314 MOVE 'REMARKS:' TO LINE33-REMARKS-LIT. DTSCS53 01315 DTSCS53 01316 MOVE MAP-MSG-LINE(1) TO LINE35-TEXT. DTSCS53 01317 MOVE MAP-MSG-LINE(2) TO LINE36-TEXT. DTSCS53 01318 MOVE MAP-MSG-LINE(3) TO LINE37-TEXT. DTSCS53 01319 MOVE MAP-MSG-LINE(4) TO LINE38-TEXT. DTSCS53 01320 DTSCS53 01321 P8110-EXIT. EXIT. DTSCS53 01322 DTSCS53 01323 DTSCS53 01324 P8120-PRINT. DTSCS53 01325 DTSCS53 01326 PERFORM P8121-INIT-PRINT THRU P8121-EXIT. DTSCS53 01327 DTSCS53 01328 PERFORM P8122-REPORT THRU P8122-EXIT DTSCS53 01329 VARYING WRK-CTR FROM 1 BY 1 DTSCS53 01330 UNTIL WRK-CTR > MAP-COPIES-N. DTSCS53 01331 DTSCS53 01332 P8120-EXIT. DTSCS53 01333 EXIT. DTSCS53 01334 DTSCS53 01335 DTSCS53 01336 *-----------------------------------------------------------------DTSCS53 01337 * CLEAN UP AND INITIALIZE TS QUEUE AREA. DTSCS53 01338 *-----------------------------------------------------------------DTSCS53 01339 P8121-INIT-PRINT. DTSCS53 01340 MOVE 0 TO L829-ITEM-NO. DTSCS53 01341 DTSCS53 01342 MOVE LENGTH OF L829-REC TO L829-REC-LENGTH. DTSCS53 01343 DTSCS53 01344 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS53 01345 DTSCS53 01346 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS53 01347 DTSCS53 01348 MOVE 'P' TO L829-QUEUE-NAME-SUFFIX. DTSCS53 01349 DTSCS53 01350 * COMPUTE L829-COMM-AREA-LENGTH DTSCS53 01351 * = L829-CONTROL-BLOCK-LENGTH + L829-REC-LENGTH. DTSCS53 01352 DTSCS53 01353 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS53 01354 DTSCS53 01355 MOVE LCCM-PRINTER-ID TO L357-PRINTER-ID. DTSCS53 01356 DTSCS53 01357 MOVE L829-QUEUE-NAME TO L357-QUEUE-NAME. DTSCS53 01358 P8121-EXIT. DTSCS53 01359 EXIT. DTSCS53 01360 /*****************************************************************DTSCS53 01361 * BUILD REPORT DTSCS53 01362 ******************************************************************DTSCS53 01363 P8122-REPORT. DTSCS53 01364 DTSCS53 01365 SET XPTS-FF-88 TO TRUE. DTSCS53 01366 MOVE SPACES TO XPTS-DATA. DTSCS53 01367 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01368 DTSCS53 01369 SET XPTS-DS-88 TO TRUE. DTSCS53 01370 MOVE SPACES TO XPTS-DATA. DTSCS53 01371 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01372 DTSCS53 01373 SET XPTS-TS-88 TO TRUE. DTSCS53 01374 MOVE SPACES TO XPTS-DATA. DTSCS53 01375 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01376 DTSCS53 01377 SET XPTS-TS-88 TO TRUE. DTSCS53 01378 MOVE SPACES TO XPTS-DATA. DTSCS53 01379 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01380 DTSCS53 01381 SET XPTS-TS-88 TO TRUE. DTSCS53 01382 MOVE SPACES TO XPTS-DATA. DTSCS53 01383 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01384 DTSCS53 01385 SET XPTS-SS-88 TO TRUE. DTSCS53 01386 MOVE LINE05 TO XPTS-DATA. DTSCS53 01387 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01388 DTSCS53 01389 SET XPTS-TS-88 TO TRUE. DTSCS53 01390 MOVE LINE08 TO XPTS-DATA. DTSCS53 01391 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01392 DTSCS53 01393 SET XPTS-SS-88 TO TRUE. DTSCS53 01394 MOVE LINE09 TO XPTS-DATA. DTSCS53 01395 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01396 DTSCS53 01397 SET XPTS-SS-88 TO TRUE. DTSCS53 01398 MOVE LINE10 TO XPTS-DATA. DTSCS53 01399 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01400 DTSCS53 01401 SET XPTS-TS-88 TO TRUE. DTSCS53 01402 MOVE SPACES TO XPTS-DATA. DTSCS53 01403 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01404 DTSCS53 01405 SET XPTS-SS-88 TO TRUE. DTSCS53 01406 MOVE LINE14 TO XPTS-DATA. DTSCS53 01407 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01408 DTSCS53 01409 SET XPTS-SS-88 TO TRUE. DTSCS53 01410 MOVE LINE15 TO XPTS-DATA. DTSCS53 01411 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01412 DTSCS53 01413 SET XPTS-SS-88 TO TRUE. DTSCS53 01414 MOVE LINE16 TO XPTS-DATA. DTSCS53 01415 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01416 DTSCS53 01417 SET XPTS-SS-88 TO TRUE. DTSCS53 01418 MOVE LINE17 TO XPTS-DATA. DTSCS53 01419 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01420 DTSCS53 01421 SET XPTS-SS-88 TO TRUE. DTSCS53 01422 MOVE LINE18 TO XPTS-DATA. DTSCS53 01423 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01424 DTSCS53 01425 SET XPTS-SS-88 TO TRUE. DTSCS53 01426 MOVE LINE19 TO XPTS-DATA. DTSCS53 01427 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01428 DTSCS53 01429 SET XPTS-TS-88 TO TRUE. DTSCS53 01430 MOVE SPACES TO XPTS-DATA. DTSCS53 01431 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01432 DTSCS53 01433 SET XPTS-SS-88 TO TRUE. DTSCS53 01434 MOVE LINE23 TO XPTS-DATA. DTSCS53 01435 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01436 DTSCS53 01437 SET XPTS-SS-88 TO TRUE. DTSCS53 01438 MOVE LINE24 TO XPTS-DATA. DTSCS53 01439 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01440 DTSCS53 01441 SET XPTS-SS-88 TO TRUE. DTSCS53 01442 MOVE LINE25 TO XPTS-DATA. DTSCS53 01443 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01444 DTSCS53 01445 SET XPTS-SS-88 TO TRUE. DTSCS53 01446 MOVE SPACES TO XPTS-DATA. DTSCS53 01447 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01448 DTSCS53 01449 IF WRK-NOT-LIABLE-88 (1) DTSCS53 01450 AND WRK-NOT-LIABLE-88 (2) DTSCS53 01451 AND WRK-NOT-LIABLE-88 (3) DTSCS53 01452 AND WRK-NOT-LIABLE-88 (4) DTSCS53 01453 SET XPTS-TS-88 TO TRUE DTSCS53 01454 MOVE L007-YR-4-9 TO LINE26-YEAR DTSCS53 01455 MOVE LINE26-NOT-LIABLE TO XPTS-DATA DTSCS53 01456 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS53 01457 SET XPTS-DS-88 TO TRUE DTSCS53 01458 MOVE SPACES TO XPTS-DATA DTSCS53 01459 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS53 01460 DTSCS53 01461 ELSE DTSCS53 01462 SET XPTS-SS-88 TO TRUE DTSCS53 01463 MOVE LINE26 TO XPTS-DATA DTSCS53 01464 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS53 01465 DTSCS53 01466 SET XPTS-SS-88 TO TRUE DTSCS53 01467 MOVE LINE27 TO XPTS-DATA DTSCS53 01468 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS53 01469 DTSCS53 01470 SET XPTS-SS-88 TO TRUE DTSCS53 01471 MOVE LINE28 TO XPTS-DATA DTSCS53 01472 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS53 01473 DTSCS53 01474 SET XPTS-SS-88 TO TRUE DTSCS53 01475 MOVE LINE29 TO XPTS-DATA DTSCS53 01476 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS53 01477 DTSCS53 01478 SET XPTS-SS-88 TO TRUE DTSCS53 01479 MOVE LINE30 TO XPTS-DATA DTSCS53 01480 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS53 01481 END-IF. DTSCS53 01482 DTSCS53 01483 SET XPTS-TS-88 TO TRUE. DTSCS53 01484 MOVE LINE33 TO XPTS-DATA. DTSCS53 01485 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01486 DTSCS53 01487 SET XPTS-DS-88 TO TRUE. DTSCS53 01488 MOVE LINE35 TO XPTS-DATA. DTSCS53 01489 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01490 DTSCS53 01491 SET XPTS-SS-88 TO TRUE. DTSCS53 01492 MOVE LINE36 TO XPTS-DATA. DTSCS53 01493 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01494 DTSCS53 01495 SET XPTS-SS-88 TO TRUE. DTSCS53 01496 MOVE LINE37 TO XPTS-DATA. DTSCS53 01497 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01498 DTSCS53 01499 SET XPTS-SS-88 TO TRUE. DTSCS53 01500 MOVE LINE38 TO XPTS-DATA. DTSCS53 01501 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01502 DTSCS53 01503 SET XPTS-TS-88 TO TRUE. DTSCS53 01504 MOVE LINE41 TO XPTS-DATA. DTSCS53 01505 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01506 DTSCS53 01507 SET XPTS-DS-88 TO TRUE. DTSCS53 01508 MOVE LINE43 TO XPTS-DATA. DTSCS53 01509 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01510 DTSCS53 01511 SET XPTS-SS-88 TO TRUE. DTSCS53 01512 MOVE LINE44 TO XPTS-DATA. DTSCS53 01513 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01514 DTSCS53 01515 SET XPTS-TS-88 TO TRUE. DTSCS53 01516 MOVE LINE47 TO XPTS-DATA. DTSCS53 01517 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01518 DTSCS53 01519 SET XPTS-DS-88 TO TRUE. DTSCS53 01520 MOVE SPACES TO XPTS-DATA. DTSCS53 01521 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01522 DTSCS53 01523 IF WRK-CTR = 1 DTSCS53 01524 MOVE ' (IRS COPY) ' TO LINE60-TEXT DTSCS53 01525 ELSE DTSCS53 01526 IF WRK-CTR = 2 DTSCS53 01527 MOVE ' (EMPLOYER COPY) ' TO LINE60-TEXT DTSCS53 01528 ELSE DTSCS53 01529 MOVE ' (FILE COPY) ' TO LINE60-TEXT. DTSCS53 01530 DTSCS53 01531 SET XPTS-TS-88 TO TRUE. DTSCS53 01532 MOVE LINE60 TO XPTS-DATA. DTSCS53 01533 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS53 01534 DTSCS53 01535 P8122-EXIT. EXIT. DTSCS53 01536 DTSCS53 01537 /*****************************************************************DTSCS53 01538 * LINKS TO UTILITY MODULES DTSCS53 01539 ******************************************************************DTSCS53 01540 DTSCS53 01541 S001-FROM-FED-8. DTSCS53 01542 SET L001-FROM-FED-8 TO TRUE. DTSCS53 01543 GO TO S001-DATE. DTSCS53 01544 DTSCS53 01545 *S001-FROM-ABS-DATE. DTSCS53 01546 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS53 01547 *****GO TO S001-DATE. DTSCS53 01548 DTSCS53 01549 S001-DATE. DTSCS53 01550 EXEC CICS LINK DTSCS53 01551 PROGRAM('DTSCU001') DTSCS53 01552 COMMAREA(L001-COMM-AREA) DTSCS53 01553 END-EXEC. DTSCS53 01554 S001-EXIT. DTSCS53 01555 EXIT. DTSCS53 01556 DTSCS53 01557 S004-FROM-5. DTSCS53 01558 SET L004-FROM-5 TO TRUE. DTSCS53 01559 GO TO S004-YRQ. DTSCS53 01560 DTSCS53 01561 S004-FROM-ABS. DTSCS53 01562 SET L004-FROM-ABS TO TRUE. DTSCS53 01563 GO TO S004-YRQ. DTSCS53 01564 DTSCS53 01565 *S004-FROM-DATE. DTSCS53 01566 *****SET L004-FROM-DATE TO TRUE. DTSCS53 01567 *****GO TO S004-YRQ. DTSCS53 01568 DTSCS53 01569 S004-YRQ. DTSCS53 01570 EXEC CICS LINK DTSCS53 01571 PROGRAM('DTSCU004') DTSCS53 01572 COMMAREA(L004-COMM-AREA) DTSCS53 01573 END-EXEC. DTSCS53 01574 S004-EXIT. DTSCS53 01575 EXIT. DTSCS53 01576 DTSCS53 01577 S007-FROM-YR2. DTSCS53 01578 SET L007-FROM-YR-2 TO TRUE. DTSCS53 01579 GO TO S007-LINK. DTSCS53 01580 DTSCS53 01581 S007-FROM-YR4. DTSCS53 01582 SET L007-FROM-YR-4 TO TRUE. DTSCS53 01583 GO TO S007-LINK. DTSCS53 01584 DTSCS53 01585 S007-LINK. DTSCS53 01586 EXEC CICS LINK DTSCS53 01587 PROGRAM ('DTSCU007') DTSCS53 01588 COMMAREA (L007-COMM-AREA) DTSCS53 01589 END-EXEC. DTSCS53 01590 S007-EXIT. DTSCS53 01591 EXIT. DTSCS53 01592 DTSCS53 01593 S013-COUNT-FROM-SCREEN. DTSCS53 01594 EXEC CICS LINK DTSCS53 01595 PROGRAM ('DTSCU013') DTSCS53 01596 COMMAREA (L013-COMM-AREA) DTSCS53 01597 END-EXEC. DTSCS53 01598 S013-EXIT. DTSCS53 01599 EXIT. DTSCS53 01600 DTSCS53 01601 S018-EMP-NO-FROM-SCREEN. DTSCS53 01602 EXEC CICS LINK DTSCS53 01603 PROGRAM ('DTSCU018') DTSCS53 01604 COMMAREA (L018-COMM-AREA) DTSCS53 01605 END-EXEC. DTSCS53 01606 S018-EXIT. DTSCS53 01607 EXIT. DTSCS53 01608 DTSCS53 01609 *S056-DISP1-LEFT. DTSCS53 01610 *****SET L056-DISP1-LEFT-88 TO TRUE. DTSCS53 01611 *****GO TO S056-LINK. DTSCS53 01612 DTSCS53 01613 S056-DISP1-RIGHT. DTSCS53 01614 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS53 01615 GO TO S056-LINK. DTSCS53 01616 DTSCS53 01617 S056-LINK. DTSCS53 01618 EXEC CICS LINK DTSCS53 01619 PROGRAM ('DTSCU056') DTSCS53 01620 COMMAREA (L056-COMM-AREA) DTSCS53 01621 END-EXEC. DTSCS53 01622 S056-EXIT. DTSCS53 01623 EXIT. DTSCS53 01624 DTSCS53 01625 S111-ADDR-LOOKUP. DTSCS53 01626 EXEC CICS LINK DTSCS53 01627 PROGRAM ('DTSCU111') DTSCS53 01628 COMMAREA (L111-COMM-AREA) DTSCS53 01629 END-EXEC. DTSCS53 01630 DTSCS53 01631 IF L111-FILE-CLOSED-88 DTSCS53 01632 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS53 01633 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS53 01634 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS53 01635 GO TO MAINLINE-EXIT. DTSCS53 01636 DTSCS53 01637 S111-EXIT. DTSCS53 01638 EXIT. DTSCS53 01639 DTSCS53 01640 S112-ADDR-FORMAT. DTSCS53 01641 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS53 01642 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS53 01643 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS53 01644 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS53 01645 DTSCS53 01646 EXEC CICS LINK DTSCS53 01647 PROGRAM('DTSCU112') DTSCS53 01648 COMMAREA(L112-COMM-AREA) DTSCS53 01649 END-EXEC. DTSCS53 01650 S112-EXIT. DTSCS53 01651 EXIT. DTSCS53 01652 DTSCS53 01653 S119-AGENCY-FACTS. DTSCS53 01654 SET L119-REQ-CAPS-88 TO TRUE. DTSCS53 01655 SET L119-REQ-NO-UNIT-88 TO TRUE. DTSCS53 01656 EXEC CICS DTSCS53 01657 LINK DTSCS53 01658 PROGRAM ('DTSCU119') DTSCS53 01659 COMMAREA (L119-COMM-AREA) DTSCS53 01660 END-EXEC. DTSCS53 01661 S119-EXIT. DTSCS53 01662 EXIT. DTSCS53 01663 DTSCS53 01664 S357-LINK-PRINT. DTSCS53 01665 SET L357-EJECT-PAGE-88 TO TRUE. DTSCS53 01666 DTSCS53 01667 EXEC CICS LINK DTSCS53 01668 PROGRAM ('DTSCU357') DTSCS53 01669 COMMAREA (L357-COMM-AREA) DTSCS53 01670 END-EXEC. DTSCS53 01671 S357-EXIT. DTSCS53 01672 EXIT. DTSCS53 01673 DTSCS53 01674 S381-LOOKUP-LIABILITY. DTSCS53 01675 EXEC CICS LINK DTSCS53 01676 PROGRAM ('DTSCU381') DTSCS53 01677 COMMAREA (L381-COMM-AREA) DTSCS53 01678 END-EXEC. DTSCS53 01679 DTSCS53 01680 IF L381-FILE-CLOSED-88 DTSCS53 01681 MOVE L381-MSG-AREA TO LCCM-MSG-AREA DTSCS53 01682 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS53 01683 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS53 01684 GO TO MAINLINE-EXIT. DTSCS53 01685 S381-EXIT. DTSCS53 01686 EXIT. DTSCS53 01687 DTSCS53 01688 S803-REQ-SCR-ID-EDIT. DTSCS53 01689 EXEC CICS LINK DTSCS53 01690 PROGRAM ('DTSCU803') DTSCS53 01691 COMMAREA (DFHCOMMAREA) DTSCS53 01692 END-EXEC. DTSCS53 01693 S803-EXIT. DTSCS53 01694 EXIT. DTSCS53 01695 DTSCS53 01696 S804-INVALID-KEY. DTSCS53 01697 EXEC CICS LINK DTSCS53 01698 PROGRAM ('DTSCU804') DTSCS53 01699 COMMAREA (DFHCOMMAREA) DTSCS53 01700 END-EXEC. DTSCS53 01701 S804-EXIT. DTSCS53 01702 EXIT. DTSCS53 01703 DTSCS53 01704 S805-MSG-AREA. DTSCS53 01705 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS53 01706 DTSCS53 01707 EXEC CICS LINK DTSCS53 01708 PROGRAM ('DTSCU805') DTSCS53 01709 COMMAREA (L805-COMM-AREA) DTSCS53 01710 END-EXEC. DTSCS53 01711 DTSCS53 01712 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS53 01713 S805-EXIT. DTSCS53 01714 EXIT. DTSCS53 01715 EJECT DTSCS53 01716 DTSCS53 01717 S810-READ. DTSCS53 01718 SET L810-READ-88 TO TRUE. DTSCS53 01719 GO TO S810-IO. DTSCS53 01720 DTSCS53 01721 S810-START-BROWSE. DTSCS53 01722 SET L810-START-BROWSE-88 TO TRUE. DTSCS53 01723 GO TO S810-IO. DTSCS53 01724 DTSCS53 01725 S810-READ-NEXT. DTSCS53 01726 SET L810-READ-NEXT-88 TO TRUE. DTSCS53 01727 GO TO S810-IO. DTSCS53 01728 DTSCS53 01729 *S810-READ-PREV. DTSCS53 01730 *****SET L810-READ-PREV-88 TO TRUE. DTSCS53 01731 *****GO TO S810-IO. DTSCS53 01732 DTSCS53 01733 S810-END-BROWSE. DTSCS53 01734 SET L810-END-BROWSE-88 TO TRUE. DTSCS53 01735 GO TO S810-IO. DTSCS53 01736 DTSCS53 01737 *S810-COUNT. DTSCS53 01738 *****SET L810-COUNT-88 TO TRUE. DTSCS53 01739 *****GO TO S810-IO. DTSCS53 01740 DTSCS53 01741 *S810-REWRITE. DTSCS53 01742 *****SET L810-REWRITE-88 TO TRUE. DTSCS53 01743 *****GO TO S810-IO. DTSCS53 01744 DTSCS53 01745 *S810-WRITE. DTSCS53 01746 *****SET L810-WRITE-88 TO TRUE. DTSCS53 01747 *****GO TO S810-IO. DTSCS53 01748 DTSCS53 01749 *S810-READ-UPDATE. DTSCS53 01750 *****SET L810-READ-UPDATE-88 TO TRUE. DTSCS53 01751 *****GO TO S810-IO. DTSCS53 01752 DTSCS53 01753 *S810-REWRITE-UPDATE. DTSCS53 01754 *****SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS53 01755 *****GO TO S810-IO. DTSCS53 01756 DTSCS53 01757 *S810-DELETE. DTSCS53 01758 *****SET L810-DELETE-88 TO TRUE. DTSCS53 01759 *****GO TO S810-IO. DTSCS53 01760 DTSCS53 01761 S810-IO. DTSCS53 01762 DTSCS53 01763 EXEC CICS LINK DTSCS53 01764 PROGRAM ('DTSCU810') DTSCS53 01765 COMMAREA (L810-COMM-AREA) DTSCS53 01766 END-EXEC. DTSCS53 01767 DTSCS53 01768 IF L810-FILE-CLOSED-88 DTSCS53 01769 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS53 01770 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS53 01771 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS53 01772 GO TO MAINLINE-EXIT. DTSCS53 01773 S810-EXIT. DTSCS53 01774 EXIT. DTSCS53 01775 EJECT DTSCS53 01776 S821-START-BROWSE-IEIN. DTSCS53 01777 MOVE LOW-VALUES TO IEIN-KEY-AREA. DTSCS53 01778 SET IEIN-EIN-88 TO TRUE. DTSCS53 01779 MOVE WRK-FEIN TO IEIN-FEIN. DTSCS53 01780 SET L821-START-BROWSE-88 TO TRUE. DTSCS53 01781 GO TO S821-IO. DTSCS53 01782 DTSCS53 01783 S821-READ-NEXT-IEIN. DTSCS53 01784 SET L821-READ-NEXT-88 TO TRUE. DTSCS53 01785 GO TO S821-IO. DTSCS53 01786 DTSCS53 01787 S821-END-BROWSE. DTSCS53 01788 SET L821-END-BROWSE-88 TO TRUE. DTSCS53 01789 GO TO S821-IO. DTSCS53 01790 DTSCS53 01791 S821-IO. DTSCS53 01792 EXEC CICS LINK DTSCS53 01793 PROGRAM ('DTSCU821') DTSCS53 01794 COMMAREA (L821-COMM-AREA) DTSCS53 01795 END-EXEC. DTSCS53 01796 DTSCS53 01797 IF L821-FILE-CLOSED-88 DTSCS53 01798 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS53 01799 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS53 01800 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS53 01801 GO TO MAINLINE-EXIT. DTSCS53 01802 DTSCS53 01803 S821-EXIT. DTSCS53 01804 EXIT. DTSCS53 01805 EJECT DTSCS53 01806 S829-DELETE-QUEUE. DTSCS53 01807 DTSCS53 01808 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS53 01809 GO TO S829-TS-IO. DTSCS53 01810 DTSCS53 01811 S829-WRITE-ITEM. DTSCS53 01812 SET L829-WRITE-88 TO TRUE. DTSCS53 01813 GO TO S829-TS-IO. DTSCS53 01814 DTSCS53 01815 S829-TS-IO. DTSCS53 01816 EXEC CICS DTSCS53 01817 LINK DTSCS53 01818 PROGRAM ('DTSCU829') DTSCS53 01819 COMMAREA (L829-COMM-AREA) DTSCS53 01820 END-EXEC. DTSCS53 01821 S829-EXIT. DTSCS53 01822 EXIT. DTSCS53 01823 EJECT DTSCS53 01824 S851-SCREEN-PROCESSING. DTSCS53 01825 EXEC CICS LINK DTSCS53 01826 PROGRAM ('DTSCU851') DTSCS53 01827 COMMAREA (L851-COMM-AREA) DTSCS53 01828 END-EXEC. DTSCS53 01829 S851-EXIT. DTSCS53 01830 EXIT. DTSCS53 01831 DTSCS53 01832 S899-ABEND. DTSCS53 01833 EXEC CICS ABEND DTSCS53 01834 ABCODE(WRK-ABEND-CD) DTSCS53 01835 END-EXEC. DTSCS53 01836 DTSCS53 01837 GOBACK. DTSCS53 01838 S899-EXIT. DTSCS53 01839 EXIT. DTSCS53 01840 /*****************************************************************DTSCS53 01841 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS53 01842 ******************************************************************DTSCS53 01843 DTSCS53 01844 S1000-SCREEN-EDITS. DTSCS53 01845 SET WRK-NO-KILLER-ERROR TO TRUE. DTSCS53 01846 DTSCS53 01847 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS53 01848 DTSCS53 01849 IF LCCM-MSG DTSCS53 01850 GO TO S1000-EXIT. DTSCS53 01851 DTSCS53 01852 PERFORM S1200-YEAR THRU S1200-EXIT. DTSCS53 01853 PERFORM S1220-FORM-IND THRU S1220-EXIT. DTSCS53 01854 PERFORM S1300-ADDR-TYPE THRU S1300-EXIT. DTSCS53 01855 PERFORM S1400-ADDR-ID-NO THRU S1400-EXIT. DTSCS53 01856 PERFORM S1500-COMBINE THRU S1500-EXIT. DTSCS53 01857 PERFORM S1600-MSGS THRU S1600-EXIT. DTSCS53 01858 PERFORM S1700-COPIES THRU S1700-EXIT. DTSCS53 01859 PERFORM S1800-PRINTER-ID THRU S1800-EXIT. DTSCS53 01860 PERFORM S3500-MISC-EDITS THRU S3500-EXIT. DTSCS53 01861 DTSCS53 01862 S1000-EXIT. EXIT. DTSCS53 01863 EJECT DTSCS53 01864 DTSCS53 01865 S1100-EDIT-KEY. DTSCS53 01866 MOVE +0 TO WRK-FEIN DTSCS53 01867 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS53 01868 S1100-EXIT. EXIT. DTSCS53 01869 /*****************************************************************DTSCS53 01870 * DTSCS53 01871 ******************************************************************DTSCS53 01872 S1101-EMP-NO. DTSCS53 01873 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS53 01874 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS53 01875 DTSCS53 01876 IF L018-NO-ENTRY DTSCS53 01877 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS53 01878 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS53 01879 GO TO S1101-EXIT. DTSCS53 01880 DTSCS53 01881 IF L018-NOT-VALID DTSCS53 01882 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS53 01883 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS53 01884 GO TO S1101-EXIT. DTSCS53 01885 DTSCS53 01886 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS53 01887 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS53 01888 S1101-EXIT. EXIT. DTSCS53 01889 DTSCS53 01890 S1110-READ-MPRF. DTSCS53 01891 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS53 01892 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS53 01893 SET MPRF-PRF-88 TO TRUE. DTSCS53 01894 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS53 01895 DTSCS53 01896 PERFORM S810-READ THRU S810-EXIT. DTSCS53 01897 DTSCS53 01898 IF L810-NO-REC-88 DTSCS53 01899 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS53 01900 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS53 01901 ELSE DTSCS53 01902 MOVE MSKL-REC TO MPRF-REC DTSCS53 01903 MOVE MPRF-FEIN TO WRK-FEIN DTSCS53 01904 SET WRK-MPRF-YES-88 TO TRUE. DTSCS53 01905 S1110-EXIT. DTSCS53 01906 EXIT. DTSCS53 01907 DTSCS53 01908 S1199-ERROR. DTSCS53 01909 SET WRK-KILLER-ERROR TO TRUE. DTSCS53 01910 DTSCS53 01911 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS53 01912 MAP-EMP-NO-2-A. DTSCS53 01913 IF LCCM-NO-MSG DTSCS53 01914 SET CURSOR-SET-YES TO TRUE DTSCS53 01915 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 01916 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS53 01917 S1199-EXIT. EXIT. DTSCS53 01918 /*****************************************************************DTSCS53 01919 * *DTSCS53 01920 ******************************************************************DTSCS53 01921 S1200-YEAR. DTSCS53 01922 IF MAP-YEAR = LOW-VALUES OR SPACES DTSCS53 01923 PERFORM S1210-DEFAULT-YEAR THRU S1210-EXIT DTSCS53 01924 ELSE DTSCS53 01925 MOVE MAP-YEAR TO L007-YR-2-X DTSCS53 01926 PERFORM S007-FROM-YR2 THRU S007-EXIT DTSCS53 01927 IF (L007-NOT-VALID-YR) DTSCS53 01928 OR DTSCS53 01929 (L007-END-YRQ <= LCCM-PICKUP-YRQ) DTSCS53 01930 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS53 01931 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS53 01932 ELSE DTSCS53 01933 PERFORM S1211-DETERMINE-UI-PAID-HDGS THRU S1211-EXIT DTSCS53 01934 MOVE L007-START-YRQ TO WRK-YRQ DTSCS53 01935 MOVE L007-END-YRQ TO WRK-YRQ-END. DTSCS53 01936 S1200-EXIT. EXIT. DTSCS53 01937 DTSCS53 01938 S1201-ERROR. DTSCS53 01939 SET WRK-KILLER-ERROR TO TRUE. DTSCS53 01940 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YEAR-A. DTSCS53 01941 IF LCCM-NO-MSG DTSCS53 01942 SET CURSOR-SET-YES TO TRUE DTSCS53 01943 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 01944 MOVE CATB-CURSOR TO MAP-YEAR-L. DTSCS53 01945 S1201-EXIT. EXIT. DTSCS53 01946 DTSCS53 01947 S1210-DEFAULT-YEAR. DTSCS53 01948 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS53 01949 SUBTRACT 2 FROM L001-FED-8-YR GIVING L007-YR-4-9. DTSCS53 01950 PERFORM S007-FROM-YR4 THRU S007-EXIT. DTSCS53 01951 MOVE L007-YR-2-X TO MAP-YEAR. DTSCS53 01952 PERFORM S1211-DETERMINE-UI-PAID-HDGS THRU S1211-EXIT. DTSCS53 01953 MOVE L007-START-YRQ TO WRK-YRQ. DTSCS53 01954 MOVE L007-END-YRQ TO WRK-YRQ-END. DTSCS53 01955 S1210-EXIT. EXIT. DTSCS53 01956 DTSCS53 01957 S1211-DETERMINE-UI-PAID-HDGS. DTSCS53 01958 MOVE L007-YR-4-9 TO L001-FED-8-YR. DTSCS53 01959 ADD +1 TO L001-FED-8-YR. DTSCS53 01960 IF MAP-FORM-IND = '2' OR '3' DTSCS53 01961 *** "PRIOR" DTSCS53 01962 MOVE 04 TO L001-FED-8-MO DTSCS53 01963 MOVE 15 TO L001-FED-8-DA DTSCS53 01964 MOVE L001-FED-8-DATE-9 TO WRK-0415-DATE DTSCS53 01965 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS53 01966 MOVE L001-SLASH-DATE TO MAP-HDG-LN1-PRIOR DTSCS53 01967 MOVE 'OR PRIOR' TO MAP-HDG-LN2-PRIOR DTSCS53 01968 *** "THRU" (DON'T DISPLAY CENTER COLUMN) DTSCS53 01969 MOVE SPACES TO MAP-HDG-LN1-THRU DTSCS53 01970 MAP-HDG-LN2-THRU DTSCS53 01971 MOVE SPACES TO MAP-UI-PAID-THRU-X (1) DTSCS53 01972 MAP-UI-PAID-THRU-X (2) DTSCS53 01973 MAP-UI-PAID-THRU-X (3) DTSCS53 01974 MAP-UI-PAID-THRU-X (4) DTSCS53 01975 MAP-UI-PAID-THRU-X (5) DTSCS53 01976 *** "AFTER" DTSCS53 01977 MOVE WRK-0415-DATE TO L001-FED-8-DATE-9 DTSCS53 01978 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS53 01979 MOVE ' AFTER' TO MAP-HDG-LN1-AFTER DTSCS53 01980 MOVE L001-SLASH-DATE TO MAP-HDG-LN2-AFTER DTSCS53 01981 ELSE DTSCS53 01982 *** "PRIOR" DTSCS53 01983 MOVE 02 TO L001-FED-8-MO DTSCS53 01984 MOVE 01 TO L001-FED-8-DA DTSCS53 01985 MOVE L001-FED-8-DATE-9 TO WRK-0201-DATE DTSCS53 01986 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS53 01987 MOVE 'PRIOR TO' TO MAP-HDG-LN1-PRIOR DTSCS53 01988 MOVE L001-SLASH-DATE TO MAP-HDG-LN2-PRIOR DTSCS53 01989 *** "THRU" DTSCS53 01990 MOVE L001-SLASH-DATE TO MAP-HDG-LN1-THRU DTSCS53 01991 MOVE 10 TO L001-FED-8-DA DTSCS53 01992 MOVE L001-FED-8-DATE-9 TO WRK-0210-DATE DTSCS53 01993 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS53 01994 MOVE 'THRU ' TO MAP-HDG-LN2-THRU-1 DTSCS53 01995 MOVE L001-SLASH-DATE TO MAP-HDG-LN2-THRU-2 DTSCS53 01996 *** "AFTER" DTSCS53 01997 MOVE ' AFTER' TO MAP-HDG-LN1-AFTER DTSCS53 01998 MOVE L001-SLASH-DATE TO MAP-HDG-LN2-AFTER. DTSCS53 01999 DTSCS53 02000 *****MOVE 02 TO L001-FED-8-MO. DTSCS53 02001 *****MOVE 01 TO L001-FED-8-DA. DTSCS53 02002 *****MOVE L001-FED-8-DATE-9 TO WRK-0201-DATE. DTSCS53 02003 *****MOVE 10 TO L001-FED-8-DA. DTSCS53 02004 *****MOVE L001-FED-8-DATE-9 TO WRK-0210-DATE. DTSCS53 02005 *****MOVE WRK-0201-DATE TO L001-FED-8-DATE-9. DTSCS53 02006 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS53 02007 *****MOVE L001-SLASH-DATE TO MAP-HDG-LN1-THRU DTSCS53 02008 ***** MAP-HDG-LN2-PRIOR DTSCS53 02009 *****MOVE WRK-0210-DATE TO L001-FED-8-DATE-9. DTSCS53 02010 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS53 02011 *****MOVE L001-SLASH-DATE TO MAP-HDG-LN2-THRU DTSCS53 02012 ***** MAP-HDG-LN2-AFTER. DTSCS53 02013 S1211-EXIT. EXIT. DTSCS53 02014 DTSCS53 02015 /*****************************************************************DTSCS53 02016 * *DTSCS53 02017 ******************************************************************DTSCS53 02018 S1220-FORM-IND. DTSCS53 02019 IF MAP-FORM-IND = '1' OR SPACES OR LOW-VALUES DTSCS53 02020 MOVE '1' TO MAP-FORM-IND DTSCS53 02021 MOVE 'FORM 940 ' TO MAP-FORM-IND-MSG DTSCS53 02022 ELSE DTSCS53 02023 IF MAP-FORM-IND = '2' DTSCS53 02024 MOVE 'FORM 1041 ' TO MAP-FORM-IND-MSG DTSCS53 02025 ELSE DTSCS53 02026 IF MAP-FORM-IND = '3' DTSCS53 02027 MOVE 'FORM 1040 ' TO MAP-FORM-IND-MSG DTSCS53 02028 ELSE DTSCS53 02029 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS53 02030 PERFORM S1221-ERROR THRU S1221-EXIT. DTSCS53 02031 S1220-EXIT. EXIT. DTSCS53 02032 DTSCS53 02033 S1221-ERROR. DTSCS53 02034 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FORM-IND-A. DTSCS53 02035 IF LCCM-NO-MSG DTSCS53 02036 SET CURSOR-SET-YES TO TRUE DTSCS53 02037 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 02038 MOVE CATB-CURSOR TO MAP-FORM-IND-L. DTSCS53 02039 S1221-EXIT. EXIT. DTSCS53 02040 DTSCS53 02041 ******************************************************************DTSCS53 02042 * *DTSCS53 02043 ******************************************************************DTSCS53 02044 S1300-ADDR-TYPE. DTSCS53 02045 IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS53 02046 SET MAP-ADDR-TAX-88 TO TRUE DTSCS53 02047 ELSE DTSCS53 02048 IF MAP-ADDR-VALID-88 DTSCS53 02049 NEXT SENTENCE DTSCS53 02050 ELSE DTSCS53 02051 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS53 02052 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS53 02053 S1300-EXIT. EXIT. DTSCS53 02054 DTSCS53 02055 S1301-ERROR. DTSCS53 02056 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS53 02057 IF LCCM-NO-MSG DTSCS53 02058 SET CURSOR-SET-YES TO TRUE DTSCS53 02059 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 02060 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L. DTSCS53 02061 S1301-EXIT. EXIT. DTSCS53 02062 DTSCS53 02063 /*****************************************************************DTSCS53 02064 * *DTSCS53 02065 ******************************************************************DTSCS53 02066 S1400-ADDR-ID-NO. DTSCS53 02067 INSPECT MAP-ADDR-ID-NO DTSCS53 02068 CONVERTING LOW-VALUES TO SPACES. DTSCS53 02069 DTSCS53 02070 IF MAP-ADDR-TAD-88 DTSCS53 02071 PERFORM S1430-ADDR-TAD THRU S1430-EXIT DTSCS53 02072 GO TO S1400-EXIT. DTSCS53 02073 DTSCS53 02074 IF MAP-ADDR-ID-NO = SPACES DTSCS53 02075 MOVE 1 TO MAP-ADDR-ID-NO-Z DTSCS53 02076 L013-CNT. DTSCS53 02077 DTSCS53 02078 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS53 02079 MOVE +1 TO L013-MIN-CNT DTSCS53 02080 MOVE +999 TO L013-MAX-CNT. DTSCS53 02081 DTSCS53 02082 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS53 02083 DTSCS53 02084 IF L013-VALID DTSCS53 02085 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS53 02086 IF MAP-ADDR-TAA-OPO-88 DTSCS53 02087 PERFORM S1440-ADDR-TAA-OPO THRU S1440-EXIT DTSCS53 02088 ELSE DTSCS53 02089 NEXT SENTENCE DTSCS53 02090 ELSE DTSCS53 02091 IF L013-NO-ENTRY DTSCS53 02092 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS53 02093 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS53 02094 ELSE DTSCS53 02095 IF L013-INVALID-NEGATIVE DTSCS53 02096 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS53 02097 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS53 02098 ELSE DTSCS53 02099 IF L013-EXCEEDS-MIN-MAX DTSCS53 02100 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS53 02101 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS53 02102 ELSE DTSCS53 02103 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS53 02104 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS53 02105 S1400-EXIT. EXIT. DTSCS53 02106 DTSCS53 02107 S1401-ERROR. DTSCS53 02108 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A. DTSCS53 02109 IF LCCM-NO-MSG DTSCS53 02110 SET CURSOR-SET-YES TO TRUE DTSCS53 02111 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 02112 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L. DTSCS53 02113 S1401-EXIT. EXIT. DTSCS53 02114 DTSCS53 02115 DTSCS53 02116 S1430-ADDR-TAD. DTSCS53 02117 DTSCS53 02118 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS53 02119 DTSCS53 02120 IF MAP-ADDR-TAX-88 DTSCS53 02121 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS53 02122 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS53 02123 ELSE DTSCS53 02124 IF MAP-ADDR-PHY-88 DTSCS53 02125 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS53 02126 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS53 02127 ELSE DTSCS53 02128 GO TO S899-ABEND. DTSCS53 02129 DTSCS53 02130 EXEC CICS ASKTIME END-EXEC. DTSCS53 02131 PERFORM S1450-ADDR-LOOKUP THRU S1450-EXIT. DTSCS53 02132 S1430-EXIT. DTSCS53 02133 EXIT. DTSCS53 02134 DTSCS53 02135 S1440-ADDR-TAA-OPO. DTSCS53 02136 DTSCS53 02137 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS53 02138 DTSCS53 02139 IF MAP-ADDR-TAX-ALT-88 DTSCS53 02140 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS53 02141 ELSE DTSCS53 02142 IF MAP-ADDR-OPO-88 DTSCS53 02143 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS53 02144 ELSE DTSCS53 02145 GO TO S899-ABEND. DTSCS53 02146 DTSCS53 02147 IF L013-CNT = 0 DTSCS53 02148 MOVE 1 TO L111-ID-NO DTSCS53 02149 ELSE DTSCS53 02150 MOVE L013-CNT TO L111-ID-NO. DTSCS53 02151 DTSCS53 02152 PERFORM S1450-ADDR-LOOKUP THRU S1450-EXIT. DTSCS53 02153 S1440-EXIT. DTSCS53 02154 EXIT. DTSCS53 02155 S1450-ADDR-LOOKUP. DTSCS53 02156 /*****************************************************************DTSCS53 02157 * *DTSCS53 02158 ******************************************************************DTSCS53 02159 DTSCS53 02160 EXEC CICS ASKTIME END-EXEC. DTSCS53 02161 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS53 02162 EXEC CICS ASKTIME END-EXEC. DTSCS53 02163 DTSCS53 02164 IF L111-ADDR-NOT-FOUND-88 DTSCS53 02165 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS53 02166 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS53 02167 GO TO S1450-EXIT. DTSCS53 02168 DTSCS53 02169 EXEC CICS ASKTIME END-EXEC. DTSCS53 02170 MOVE L111-ATTN-LINE TO MAP-ATTN-LINE. DTSCS53 02171 MOVE L111-DELIV-LINE-1 TO MAP-DELIV-LINE1. DTSCS53 02172 MOVE L111-DELIV-LINE-2 TO MAP-DELIV-LINE2. DTSCS53 02173 MOVE L111-CITY TO MAP-CITY. DTSCS53 02174 MOVE L111-ST TO MAP-STATE. DTSCS53 02175 MOVE L111-ZIP TO MAP-ZIP. DTSCS53 02176 EXEC CICS ASKTIME END-EXEC. DTSCS53 02177 S1450-EXIT. DTSCS53 02178 EXIT. DTSCS53 02179 /*****************************************************************DTSCS53 02180 * *DTSCS53 02181 ******************************************************************DTSCS53 02182 S1500-COMBINE. DTSCS53 02183 INSPECT MAP-COMBINE-IND DTSCS53 02184 CONVERTING LOW-VALUES TO SPACES. DTSCS53 02185 IF NOT MAP-COMBINE-VALID DTSCS53 02186 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS53 02187 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS53 02188 S1500-EXIT. EXIT. DTSCS53 02189 DTSCS53 02190 S1501-ERROR. DTSCS53 02191 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-COMBINE-IND-A. DTSCS53 02192 IF LCCM-NO-MSG DTSCS53 02193 SET CURSOR-SET-YES TO TRUE DTSCS53 02194 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 02195 MOVE CATB-CURSOR TO MAP-COMBINE-IND-L. DTSCS53 02196 S1501-EXIT. EXIT. DTSCS53 02197 DTSCS53 02198 /*****************************************************************DTSCS53 02199 * *DTSCS53 02200 ******************************************************************DTSCS53 02201 S1600-MSGS. DTSCS53 02202 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS53 02203 UNTIL WRK-CTR > WRK-TEXT-LINE-MAX DTSCS53 02204 INSPECT MAP-MSG-LINE(WRK-CTR) DTSCS53 02205 CONVERTING LOW-VALUES TO SPACES DTSCS53 02206 END-PERFORM. DTSCS53 02207 S1600-EXIT. EXIT. DTSCS53 02208 DTSCS53 02209 /*****************************************************************DTSCS53 02210 * *DTSCS53 02211 ******************************************************************DTSCS53 02212 S1700-COPIES. DTSCS53 02213 IF MAP-COPIES = LOW-VALUES OR SPACES DTSCS53 02214 MOVE '3' TO MAP-COPIES DTSCS53 02215 ELSE DTSCS53 02216 IF NOT MAP-COPIES-VALID DTSCS53 02217 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS53 02218 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS53 02219 S1700-EXIT. EXIT. DTSCS53 02220 DTSCS53 02221 S1701-ERROR. DTSCS53 02222 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPIES-A. DTSCS53 02223 IF LCCM-NO-MSG DTSCS53 02224 SET CURSOR-SET-YES TO TRUE DTSCS53 02225 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 02226 MOVE CATB-CURSOR TO MAP-COPIES-L. DTSCS53 02227 S1701-EXIT. EXIT. DTSCS53 02228 DTSCS53 02229 /*****************************************************************DTSCS53 02230 * *DTSCS53 02231 ******************************************************************DTSCS53 02232 S1800-PRINTER-ID. DTSCS53 02233 IF MAP-PRINTER-ID = LOW-VALUES OR SPACES DTSCS53 02234 MOVE LCCM-PRINTER-ID TO MAP-PRINTER-ID DTSCS53 02235 ELSE DTSCS53 02236 MOVE MAP-PRINTER-ID TO LCCM-PRINTER-ID. DTSCS53 02237 S1800-EXIT. EXIT. DTSCS53 02238 DTSCS53 02239 S1801-ERROR. DTSCS53 02240 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRINTER-ID-A. DTSCS53 02241 IF LCCM-NO-MSG DTSCS53 02242 SET CURSOR-SET-YES TO TRUE DTSCS53 02243 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS53 02244 MOVE CATB-CURSOR TO MAP-PRINTER-ID-L. DTSCS53 02245 S1801-EXIT. EXIT. DTSCS53 02246 DTSCS53 02247 /*****************************************************************DTSCS53 02248 * DTSCS53 02249 ******************************************************************DTSCS53 02250 S3500-MISC-EDITS. DTSCS53 02251 PERFORM S4001-INIT-TABLE THRU S4001-EXIT. DTSCS53 02252 DTSCS53 02253 IF WRK-KILLER-ERROR DTSCS53 02254 GO TO S3500-EXIT. DTSCS53 02255 DTSCS53 02256 IF MAP-COMBINE-YES-88 DTSCS53 02257 AND WRK-FEIN > +0 DTSCS53 02258 PERFORM S821-START-BROWSE-IEIN THRU S821-EXIT DTSCS53 02259 PERFORM UNTIL L821-NO-REC-88 DTSCS53 02260 PERFORM S3501-CHECK-ADDL-EMP THRU S3501-EXIT DTSCS53 02261 PERFORM S3520-MPRF-EDITS THRU S3520-EXIT DTSCS53 02262 PERFORM S4010-MQTR-INFO THRU S4010-EXIT DTSCS53 02263 PERFORM S4020-MDST-INFO THRU S4020-EXIT DTSCS53 02264 PERFORM S821-READ-NEXT-IEIN THRU S821-EXIT DTSCS53 02265 IF L821-OK-88 DTSCS53 02266 AND IEIN-FEIN NOT = WRK-FEIN DTSCS53 02267 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS53 02268 SET L821-NO-REC-88 TO TRUE DTSCS53 02269 END-IF DTSCS53 02270 END-PERFORM DTSCS53 02271 ELSE DTSCS53 02272 MOVE WRK-EMP-NO TO IEIN-EMP-NO DTSCS53 02273 PERFORM S3520-MPRF-EDITS THRU S3520-EXIT DTSCS53 02274 PERFORM S4010-MQTR-INFO THRU S4010-EXIT DTSCS53 02275 PERFORM S4020-MDST-INFO THRU S4020-EXIT DTSCS53 02276 IF WRK-FEIN > +0 DTSCS53 02277 PERFORM S821-START-BROWSE-IEIN THRU S821-EXIT DTSCS53 02278 PERFORM S3510-SCAN-IEIN THRU S3510-EXIT DTSCS53 02279 END-IF DTSCS53 02280 END-IF. DTSCS53 02281 DTSCS53 02282 IF MAP-FEIN-MSG-ADDL-88 DTSCS53 02283 IF MAP-COMBINE-IND = SPACE DTSCS53 02284 SET MAP-COMBINE-NO-88 TO TRUE. DTSCS53 02285 DTSCS53 02286 PERFORM S4030-RESULTS-TO-SCREEN THRU S4030-EXIT. DTSCS53 02287 S3500-EXIT. DTSCS53 02288 EXIT. DTSCS53 02289 DTSCS53 02290 /*****************************************************************DTSCS53 02291 * DTSCS53 02292 ******************************************************************DTSCS53 02293 S3501-CHECK-ADDL-EMP. DTSCS53 02294 IF IEIN-EMP-NO NOT = WRK-EMP-NO DTSCS53 02295 SET MAP-FEIN-MSG-ADDL-88 TO TRUE. DTSCS53 02296 S3501-EXIT. EXIT. DTSCS53 02297 SKIP3 DTSCS53 02298 S3510-SCAN-IEIN. DTSCS53 02299 IF IEIN-FEIN = WRK-FEIN DTSCS53 02300 NEXT SENTENCE DTSCS53 02301 ELSE DTSCS53 02302 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS53 02303 SET L821-NO-REC-88 TO TRUE DTSCS53 02304 GO TO S3510-EXIT. DTSCS53 02305 DTSCS53 02306 IF IEIN-EMP-NO = WRK-EMP-NO DTSCS53 02307 NEXT SENTENCE DTSCS53 02308 ELSE DTSCS53 02309 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS53 02310 SET L821-NO-REC-88 TO TRUE DTSCS53 02311 SET MAP-FEIN-MSG-ADDL-88 TO TRUE DTSCS53 02312 GO TO S3510-EXIT. DTSCS53 02313 DTSCS53 02314 PERFORM S821-READ-NEXT-IEIN THRU S821-EXIT. DTSCS53 02315 S3510-EXIT. DTSCS53 02316 EXIT. DTSCS53 02317 SKIP3 DTSCS53 02318 S3520-MPRF-EDITS. DTSCS53 02319 IF IEIN-EMP-NO = WRK-EMP-NO DTSCS53 02320 NEXT SENTENCE DTSCS53 02321 ELSE DTSCS53 02322 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS53 02323 MOVE IEIN-EMP-NO TO MSKL-EMP-NO DTSCS53 02324 SET MSKL-PRF-88 TO TRUE DTSCS53 02325 PERFORM S810-READ THRU S810-EXIT DTSCS53 02326 IF L810-OK-88 DTSCS53 02327 MOVE MSKL-REC TO MPRF-REC DTSCS53 02328 ELSE DTSCS53 02329 GO TO S3520-EXIT. DTSCS53 02330 DTSCS53 02331 IF MPRF-LAST-ARCHIVED-YRQ = +0 DTSCS53 02332 NEXT SENTENCE DTSCS53 02333 ELSE DTSCS53 02334 IF MPRF-LAST-ARCHIVED-YRQ < WRK-YRQ DTSCS53 02335 NEXT SENTENCE DTSCS53 02336 ELSE DTSCS53 02337 MOVE MSG-E533-AREA TO WRK-MSG-AREA DTSCS53 02338 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS53 02339 DTSCS53 02340 MOVE WRK-YRQ TO L004-QTR-5-9. DTSCS53 02341 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS53 02342 DTSCS53 02343 PERFORM S3521-LIAB-RATE-LOOP THRU S3521-EXIT DTSCS53 02344 UNTIL L004-QTR-5-9 > WRK-YRQ-END. DTSCS53 02345 DTSCS53 02346 IF IEIN-EMP-NO = WRK-EMP-NO DTSCS53 02347 NEXT SENTENCE DTSCS53 02348 ELSE DTSCS53 02349 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS53 02350 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS53 02351 SET MSKL-PRF-88 TO TRUE DTSCS53 02352 PERFORM S810-READ THRU S810-EXIT DTSCS53 02353 IF L810-OK-88 DTSCS53 02354 MOVE MSKL-REC TO MPRF-REC DTSCS53 02355 ELSE DTSCS53 02356 GO TO S899-ABEND. DTSCS53 02357 S3520-EXIT. DTSCS53 02358 EXIT. DTSCS53 02359 SKIP3 DTSCS53 02360 S3521-LIAB-RATE-LOOP. DTSCS53 02361 MOVE MPRF-EMP-NO TO L381-EMP-NO. DTSCS53 02362 MOVE L004-QTR-5-9 TO L381-YRQ. DTSCS53 02363 MOVE MPRF-EMP-CLASS TO L381-EMP-CLASS. DTSCS53 02364 DTSCS53 02365 PERFORM S381-LOOKUP-LIABILITY THRU S381-EXIT. DTSCS53 02366 DTSCS53 02367 MOVE L004-QTR-5-Q TO WRK-CTR. DTSCS53 02368 DTSCS53 02369 IF L381-LIABLE-88 DTSCS53 02370 SET WRK-LIABLE-88 (WRK-CTR) TO TRUE. DTSCS53 02371 DTSCS53 02372 IF MPRF-EMP-NO = WRK-EMP-NO DTSCS53 02373 IF L381-UI-RATE-OK-88 DTSCS53 02374 MOVE L381-UI-RATE TO WRK-UI-RATE (WRK-CTR) DTSCS53 02375 ELSE DTSCS53 02376 NEXT SENTENCE DTSCS53 02377 ELSE DTSCS53 02378 IF WRK-NO-UI-RATE-88 (WRK-CTR) DTSCS53 02379 IF L381-UI-RATE-OK-88 DTSCS53 02380 MOVE L381-UI-RATE TO WRK-UI-RATE (WRK-CTR) DTSCS53 02381 ELSE DTSCS53 02382 NEXT SENTENCE. DTSCS53 02383 DTSCS53 02384 ADD +1 TO L004-ABS-QTR. DTSCS53 02385 DTSCS53 02386 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS53 02387 S3521-EXIT. DTSCS53 02388 EXIT. DTSCS53 02389 /*****************************************************************DTSCS53 02390 * DTSCS53 02391 ******************************************************************DTSCS53 02392 S4001-INIT-TABLE. DTSCS53 02393 PERFORM DTSCS53 02394 VARYING WRK-CTR FROM 1 BY 1 DTSCS53 02395 UNTIL WRK-CTR > WRK-AMT-LINE-MAX DTSCS53 02396 MOVE SPACES TO MAP-LINE (WRK-CTR) DTSCS53 02397 MOVE +0 TO WRK-UI-PAID-PRIOR (WRK-CTR) DTSCS53 02398 WRK-UI-PAID-THRU (WRK-CTR) DTSCS53 02399 WRK-UI-PAID-AFTER (WRK-CTR) DTSCS53 02400 WRK-TAXABLE-WAGES (WRK-CTR) DTSCS53 02401 SET WRK-NO-UI-RATE-88 (WRK-CTR) TO TRUE DTSCS53 02402 SET WRK-NOT-LIABLE-88 (WRK-CTR) TO TRUE DTSCS53 02403 PERFORM S4700-GET-YRQ THRU S4700-EXIT DTSCS53 02404 MOVE ' / ' TO MAP-YRQ (WRK-CTR) DTSCS53 02405 MOVE WRK-CURR-YRQ-YR TO MAP-YRQ-YR (WRK-CTR) DTSCS53 02406 MOVE WRK-CURR-YRQ-Q TO MAP-YRQ-Q (WRK-CTR) DTSCS53 02407 END-PERFORM. DTSCS53 02408 S4001-EXIT. DTSCS53 02409 EXIT. DTSCS53 02410 /*****************************************************************DTSCS53 02411 * DTSCS53 02412 ******************************************************************DTSCS53 02413 S4010-MQTR-INFO. DTSCS53 02414 MOVE 'NNNN' TO WRK-RPT-RECEIVED-INDS. DTSCS53 02415 DTSCS53 02416 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS53 02417 MOVE IEIN-EMP-NO TO MQTR-EMP-NO. DTSCS53 02418 SET MQTR-QTR-88 TO TRUE. DTSCS53 02419 MOVE WRK-YRQ TO MQTR-YRQ. DTSCS53 02420 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS53 02421 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS53 02422 PERFORM S4011-LOOP THRU S4011-EXIT DTSCS53 02423 UNTIL L810-NO-REC-88. DTSCS53 02424 S4010-EXIT. EXIT. DTSCS53 02425 DTSCS53 02426 /*****************************************************************DTSCS53 02427 * DTSCS53 02428 ******************************************************************DTSCS53 02429 S4011-LOOP. DTSCS53 02430 MOVE MSKL-REC TO MQTR-REC. DTSCS53 02431 DTSCS53 02432 IF MQTR-YRQ > WRK-YRQ-END DTSCS53 02433 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS53 02434 SET L810-NO-REC-88 TO TRUE DTSCS53 02435 GO TO S4011-EXIT. DTSCS53 02436 DTSCS53 02437 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS53 02438 DTSCS53 02439 MOVE L004-QTR-5-Q TO WRK-CTR DTSCS53 02440 DTSCS53 02441 IF MQTR-CURR-RCVD-88 DTSCS53 02442 ADD MQTR-TAX-WAGE TO WRK-TAXABLE-WAGES (WRK-CTR) DTSCS53 02443 MOVE 'Y' TO WRK-RPT-RECEIVED-IND (WRK-CTR). DTSCS53 02444 DTSCS53 02445 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS53 02446 S4011-EXIT. EXIT. DTSCS53 02447 /*****************************************************************DTSCS53 02448 * DTSCS53 02449 ******************************************************************DTSCS53 02450 S4020-MDST-INFO. DTSCS53 02451 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSCS53 02452 MOVE IEIN-EMP-NO TO MDST-EMP-NO. DTSCS53 02453 SET MDST-DST-88 TO TRUE. DTSCS53 02454 MOVE WRK-YRQ TO MDST-YRQ. DTSCS53 02455 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSCS53 02456 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS53 02457 PERFORM S4022-SCAN-MDST THRU S4022-EXIT DTSCS53 02458 UNTIL L810-NO-REC-88. DTSCS53 02459 S4020-EXIT. EXIT. DTSCS53 02460 /*****************************************************************DTSCS53 02461 * DTSCS53 02462 ******************************************************************DTSCS53 02463 S4022-SCAN-MDST. DTSCS53 02464 MOVE MSKL-REC TO MDST-REC. DTSCS53 02465 DTSCS53 02466 IF MDST-YRQ > WRK-YRQ-END DTSCS53 02467 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS53 02468 SET L810-NO-REC-88 TO TRUE DTSCS53 02469 GO TO S4022-EXIT. DTSCS53 02470 DTSCS53 02471 MOVE MDST-YRQ TO L004-QTR-5-9. DTSCS53 02472 DTSCS53 02473 MOVE L004-QTR-5-Q TO WRK-CTR. DTSCS53 02474 DTSCS53 02475 IF WRK-RPT-RECEIVED-IND (WRK-CTR) = 'Y' DTSCS53 02476 PERFORM DTSCS53 02477 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSCS53 02478 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSCS53 02479 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSCS53 02480 IF MAP-FORM-IND = '2' OR '3' DTSCS53 02481 IF MDST-RECEIVED-DATE > WRK-0415-DATE DTSCS53 02482 ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 02483 TO WRK-UI-PAID-AFTER(WRK-CTR) DTSCS53 02484 ELSE DTSCS53 02485 ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 02486 TO WRK-UI-PAID-PRIOR(WRK-CTR) DTSCS53 02487 END-IF DTSCS53 02488 ELSE DTSCS53 02489 IF MDST-RECEIVED-DATE < WRK-0201-DATE DTSCS53 02490 ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 02491 TO WRK-UI-PAID-PRIOR(WRK-CTR) DTSCS53 02492 ELSE DTSCS53 02493 IF MDST-RECEIVED-DATE > WRK-0210-DATE DTSCS53 02494 ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 02495 TO WRK-UI-PAID-AFTER(WRK-CTR) DTSCS53 02496 ELSE DTSCS53 02497 ADD MDST-AMT (MDST-ACCT-IDX) DTSCS53 02498 TO WRK-UI-PAID-THRU(WRK-CTR) DTSCS53 02499 END-IF DTSCS53 02500 END-IF DTSCS53 02501 END-IF DTSCS53 02502 END-IF DTSCS53 02503 END-PERFORM. DTSCS53 02504 DTSCS53 02505 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS53 02506 S4022-EXIT. EXIT. DTSCS53 02507 DTSCS53 02508 /*****************************************************************DTSCS53 02509 * DTSCS53 02510 ******************************************************************DTSCS53 02511 S4030-RESULTS-TO-SCREEN. DTSCS53 02512 PERFORM VARYING WRK-CTR FROM 1 BY 1 DTSCS53 02513 UNTIL WRK-CTR > 4 DTSCS53 02514 IF WRK-NOT-LIABLE-88 (WRK-CTR) DTSCS53 02515 MOVE ' NOT SUBJECT' TO MAP-TAX-WAGES-X (WRK-CTR) DTSCS53 02516 ELSE DTSCS53 02517 MOVE WRK-UI-PAID-PRIOR (WRK-CTR) DTSCS53 02518 TO MAP-UI-PAID-PRIOR (WRK-CTR) DTSCS53 02519 ADD WRK-UI-PAID-PRIOR (WRK-CTR) DTSCS53 02520 TO WRK-UI-PAID-PRIOR (5) DTSCS53 02521 MOVE WRK-UI-PAID-THRU (WRK-CTR) DTSCS53 02522 TO MAP-UI-PAID-THRU (WRK-CTR) DTSCS53 02523 ADD WRK-UI-PAID-THRU (WRK-CTR) DTSCS53 02524 TO WRK-UI-PAID-THRU (5) DTSCS53 02525 MOVE WRK-UI-PAID-AFTER (WRK-CTR) DTSCS53 02526 TO MAP-UI-PAID-AFTER (WRK-CTR) DTSCS53 02527 ADD WRK-UI-PAID-AFTER (WRK-CTR) DTSCS53 02528 TO WRK-UI-PAID-AFTER (5) DTSCS53 02529 MOVE WRK-TAXABLE-WAGES (WRK-CTR) DTSCS53 02530 TO MAP-TAX-WAGES (WRK-CTR) DTSCS53 02531 ADD WRK-TAXABLE-WAGES (WRK-CTR) DTSCS53 02532 TO WRK-TAXABLE-WAGES (5) DTSCS53 02533 MOVE WRK-UI-RATE (WRK-CTR) DTSCS53 02534 TO L056-RATE DTSCS53 02535 PERFORM S056-DISP1-RIGHT THRU S056-EXIT DTSCS53 02536 MOVE L056-DISP-RATE DTSCS53 02537 TO MAP-UI-RATE (WRK-CTR) DTSCS53 02538 END-IF DTSCS53 02539 END-PERFORM. DTSCS53 02540 DTSCS53 02541 MOVE 'TOTAL' TO MAP-YRQ (5). DTSCS53 02542 MOVE WRK-UI-PAID-PRIOR (5) DTSCS53 02543 TO MAP-UI-PAID-PRIOR (5) DTSCS53 02544 MOVE WRK-UI-PAID-THRU (5) DTSCS53 02545 TO MAP-UI-PAID-THRU (5) DTSCS53 02546 MOVE WRK-UI-PAID-AFTER (5) DTSCS53 02547 TO MAP-UI-PAID-AFTER (5) DTSCS53 02548 MOVE WRK-TAXABLE-WAGES (5) DTSCS53 02549 TO MAP-TAX-WAGES (5). DTSCS53 02550 DTSCS53 02551 *** DISPLAY SPACES IN CENTER COLUMN FOR FORM-IND 2 AND 3. DTSCS53 02552 IF MAP-FORM-IND = '2' OR '3' DTSCS53 02553 MOVE SPACES TO MAP-UI-PAID-THRU-X (1) DTSCS53 02554 MAP-UI-PAID-THRU-X (2) DTSCS53 02555 MAP-UI-PAID-THRU-X (3) DTSCS53 02556 MAP-UI-PAID-THRU-X (4) DTSCS53 02557 MAP-UI-PAID-THRU-X (5). DTSCS53 02558 DTSCS53 02559 IF WRK-NOT-LIABLE-88 (1) DTSCS53 02560 AND WRK-NOT-LIABLE-88 (2) DTSCS53 02561 AND WRK-NOT-LIABLE-88 (3) DTSCS53 02562 AND WRK-NOT-LIABLE-88 (4) DTSCS53 02563 MOVE MSG-P532-AREA TO WRK-MSG-AREA DTSCS53 02564 IF LCCM-NO-MSG DTSCS53 02565 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS53 02566 S4030-EXIT. EXIT. DTSCS53 02567 DTSCS53 02568 S4700-GET-YRQ. DTSCS53 02569 MOVE WRK-YRQ TO L004-QTR-5-9. DTSCS53 02570 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS53 02571 COMPUTE L004-ABS-QTR = L004-ABS-QTR + WRK-CTR - 1. DTSCS53 02572 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS53 02573 MOVE L004-QTR-5-9 TO WRK-CURR-YRQ. DTSCS53 02574 S4700-EXIT. EXIT. DTSCS53 02575 /*****************************************************************DTSCS53 02576 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS53 02577 ******************************************************************DTSCS53 02578 S5100-SET-LOCK-ATTRB. DTSCS53 02579 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS53 02580 WRK-ATB-NUM. DTSCS53 02581 DTSCS53 02582 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS53 02583 DTSCS53 02584 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS53 02585 MAP-EMP-NO-2-A DTSCS53 02586 MAP-YEAR-A DTSCS53 02587 MAP-FORM-IND-A DTSCS53 02588 MAP-COMBINE-IND-A DTSCS53 02589 MAP-GOTO-A. DTSCS53 02590 S5100-EXIT. DTSCS53 02591 EXIT. DTSCS53 02592 DTSCS53 02593 ******************************************************************DTSCS53 02594 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS53 02595 ******************************************************************DTSCS53 02596 S5200-SET-UPDATE-ATTRB. DTSCS53 02597 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS53 02598 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS53 02599 DTSCS53 02600 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS53 02601 DTSCS53 02602 S5200-EXIT. DTSCS53 02603 EXIT. DTSCS53 02604 DTSCS53 02605 ******************************************************************DTSCS53 02606 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS53 02607 ******************************************************************DTSCS53 02608 S5300-SET-INQ-ATTRB. DTSCS53 02609 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS53 02610 WRK-ATB-NUM. DTSCS53 02611 DTSCS53 02612 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS53 02613 S5300-EXIT. DTSCS53 02614 EXIT. DTSCS53 02615 DTSCS53 02616 S5900-SET-ATTRB. DTSCS53 02617 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS53 02618 MAP-EMP-NO-2-A DTSCS53 02619 MAP-YEAR-A DTSCS53 02620 MAP-FORM-IND-A. DTSCS53 02621 MOVE CATB-UNPROT-BRT-AN-MDTON TO DTSCS53 02622 MAP-COMBINE-IND-A. DTSCS53 02623 DTSCS53 02624 MOVE WRK-ATB-NUM TO DTSCS53 02625 MAP-ADDR-ID-NO-A DTSCS53 02626 MAP-COPIES-A. DTSCS53 02627 DTSCS53 02628 MOVE WRK-ATB-AN TO DTSCS53 02629 MAP-ADDR-TYPE-A DTSCS53 02630 MAP-PRINTER-ID-A. DTSCS53 02631 DTSCS53 02632 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS53 02633 MAP-PRIMARY-NAME-A DTSCS53 02634 MAP-FORM-IND-MSG-A DTSCS53 02635 MAP-FEIN-A DTSCS53 02636 MAP-FEIN-MSG-A DTSCS53 02637 MAP-ATTN-LINE-A DTSCS53 02638 MAP-DELIV-LINE1-A DTSCS53 02639 MAP-DELIV-LINE2-A DTSCS53 02640 MAP-CITY-A DTSCS53 02641 MAP-STATE-A DTSCS53 02642 MAP-ZIP-A. DTSCS53 02643 DTSCS53 02644 PERFORM DTSCS53 02645 VARYING WRK-CTR FROM 1 BY 1 DTSCS53 02646 UNTIL WRK-CTR > WRK-AMT-LINE-MAX DTSCS53 02647 MOVE CATB-ASKIP-BRT-MDTON DTSCS53 02648 TO MAP-LINE-A (WRK-CTR) DTSCS53 02649 END-PERFORM. DTSCS53 02650 DTSCS53 02651 PERFORM DTSCS53 02652 VARYING WRK-CTR FROM 1 BY 1 DTSCS53 02653 UNTIL WRK-CTR > WRK-TEXT-LINE-MAX DTSCS53 02654 MOVE WRK-ATB-AN DTSCS53 02655 TO MAP-MSG-LINE-A (WRK-CTR) DTSCS53 02656 END-PERFORM. DTSCS53 02657 DTSCS53 02658 MOVE CATB-ASKIP-NORM-MDTON DTSCS53 02659 TO MAP-HDG-LN1-PRIOR-A DTSCS53 02660 MAP-HDG-LN2-PRIOR-A DTSCS53 02661 MAP-HDG-LN1-THRU-A DTSCS53 02662 MAP-HDG-LN2-THRU-A DTSCS53 02663 MAP-HDG-LN1-AFTER-A DTSCS53 02664 MAP-HDG-LN2-AFTER-A. DTSCS53 02665 DTSCS53 02666 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS53 02667 S5900-EXIT. DTSCS53 02668 EXIT. DTSCS53 02669 EJECT DTSCS53 02670 /*****************************************************************DTSCS53 02671 * MAP ROUTINES *DTSCS53 02672 ******************************************************************DTSCS53 02673 S9100-RECEIVE. DTSCS53 02674 SET L851-RECEIVE-88 TO TRUE. DTSCS53 02675 DTSCS53 02676 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS53 02677 DTSCS53 02678 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS53 02679 DTSCS53 02680 MOVE L851-AID TO LCCM-AID. DTSCS53 02681 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS53 02682 S9100-EXIT. DTSCS53 02683 EXIT. DTSCS53 02684 DTSCS53 02685 S9200-SEND-DATAONLY. DTSCS53 02686 MOVE LOW-VALUES TO MAP-AREA. DTSCS53 02687 DTSCS53 02688 IF LCCM-NO-MSG DTSCS53 02689 NEXT SENTENCE DTSCS53 02690 ELSE DTSCS53 02691 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS53 02692 DTSCS53 02693 IF CURSOR-SET-GOTO DTSCS53 02694 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS53 02695 ELSE DTSCS53 02696 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS53 02697 DTSCS53 02698 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS53 02699 DTSCS53 02700 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS53 02701 DTSCS53 02702 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS53 02703 S9200-EXIT. DTSCS53 02704 EXIT. DTSCS53 02705 DTSCS53 02706 S9300-SEND-MAP. DTSCS53 02707 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS53 02708 MOVE SPACES TO MAP-SYS-TIME. DTSCS53 02709 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS53 02710 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS53 02711 DTSCS53 02712 IF SCR-ACCESS-UPDATE DTSCS53 02713 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT. DTSCS53 02714 DTSCS53 02715 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS53 02716 DTSCS53 02717 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS53 02718 DTSCS53 02719 IF CURSOR-SET-NO DTSCS53 02720 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS53 02721 DTSCS53 02722 SET L851-SEND-88 TO TRUE. DTSCS53 02723 DTSCS53 02724 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS53 02725 DTSCS53 02726 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS53 02727 S9300-EXIT. DTSCS53 02728 EXIT. DTSCS53 02729 DTSCS53 02730 S9310-UPDATE-FKEYS. DTSCS53 02731 * PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS53 02732 DTSCS53 02733 IF LCCM-SCR-PRT-LOCKED DTSCS53 02734 NEXT SENTENCE DTSCS53 02735 ELSE DTSCS53 02736 IF SCR-ACCESS-UPDATE DTSCS53 02737 MOVE 'F9=PRINT' TO MAP-KEY-PRINT. DTSCS53 02738 S9310-EXIT. DTSCS53 02739 EXIT. DTSCS53 02740 DTSCS53 02741 *S9320-INQUIRY-FKEYS. DTSCS53 02742 * DTSCS53 02743 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS53 02744 *S9320-EXIT. DTSCS53 02745 * EXIT. DTSCS53 02746 * DTSCS53 02747 *S9321-JUMP-KEYS. DTSCS53 02748 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS53 02749 * MOVE CFKD-REG-SEARCH TO MAP-KEY-REG-SEARCH. DTSCS53 02750 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS53 02751 *S9321-EXIT. DTSCS53 02752 * EXIT. DTSCS53 02753 * DTSCS53 02754 S9330-DSCR-FIELDS. DTSCS53 02755 IF LCCM-F12-88 DTSCS53 02756 GO TO S9330-EXIT. DTSCS53 02757 DTSCS53 02758 IF WRK-MPRF-YES-88 DTSCS53 02759 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS53 02760 IF WRK-FEIN > +0 DTSCS53 02761 MOVE MPRF-FEIN TO MAP-FEIN DTSCS53 02762 ELSE DTSCS53 02763 MOVE LOW-VALUES TO MAP-FEIN-X DTSCS53 02764 ELSE DTSCS53 02765 MOVE LOW-VALUES TO MAP-PRIMARY-NAME DTSCS53 02766 MAP-FEIN-X. DTSCS53 02767 S9330-EXIT. EXIT. DTSCS53 02768 DTSCS53 02769 S9900-PREPARE-SEND. DTSCS53 02770 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS53 02771 LCCM-SCR-ID. DTSCS53 02772 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS53 02773 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS53 02774 S9900-EXIT. DTSCS53 02775 EXIT. DTSCS53