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