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