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