00001 IDENTIFICATION DIVISION. 05/07/25 00002 PROGRAM-ID. DTSCS76. DTSCS76 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV001 00004 DATE-WRITTEN. MAY 1994. DTSCS76 00005 DATE-COMPILED. DTSCS76 00006 DTSCS76 00007 ***** DTSCS76 00008 * DTSCS76 00009 * FUNCTION: MISCELLANEOUS BATCH/ONLINE REQUEST DTSCS76 00010 * SCREEN PROCESSOR. DTSCS76 00011 * DTSCS76 00012 * DTSCS76 00013 * MODIFICATION LOG: DTSCS76 00014 * DTSCS76 00015 * 10/04/98 INITIAL DEVELOPMENT. COPIED FROM MACCS76. DTSCS76 00016 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS76 00017 * DTSCS76 00018 * 11/01/02 MODIFIED SCREEN TO ALLOW FOR EMPLOYER WAGE REQUEST.DTSCS76 00019 * IR751 RECORD IS GENERATED. THE USER SPECIFIES AN DTSCS76 00020 * SSN AND THE QUARTER(S) OF THE WAGE REQUEST. DTSCS76 00021 * THIS MODIFICATION EDITS THE WAGE REQUEST DTSCS76 00022 * SCREEN DATA AND WRITES THE DTSIR751 REPORT RECORD. DTSCS76 00023 * DTSBR751 PRINTS THE WAGE REQUEST. DTSCS76 00024 * DTSCS76 00025 * 09/04/05 MODIFIED SCREEN TO ALLOW FOR PRINTING STATEMENT OF DTSCS76 00026 * ACCOUNTS OVERNIGHT. THE USER SPECIFIES AN DTSCS76 00027 * THE QUARTER(S) OF THE ACCOUNT TO PRINT. DTSCS76 00028 * THIS MODIFICATION EDITS THE PRINT REQUEST DTSCS76 00029 * SCREEN DATA AND WRITES THE T011 TRANSACTION RECORDDTSCS76 00030 * DTSBD327 READS THE T011 AND BIULDS A IR414 RECORD. DTSCS76 00031 * DTSCS76 00032 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS76 00033 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS76 00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS76 00035 * REFERENCE RFP: #*** PROGRAMMER: XXX DTSCS76 00036 * DTSCS76 00037 * DTSCS76 00038 * DESCRIPTION: DTSCS76 00039 * DTSCS76 00040 * DTSCS76 00041 * CLEAR: DTSCS76 00042 * DTSCS76 00043 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS76 00044 * DTSCS76 00045 * DTSCS76 00046 * JUMP: DTSCS76 00047 * DTSCS76 00048 * NONE. DTSCS76 00049 * DTSCS76 00050 * DTSCS76 00051 * INQUIRY: DTSCS76 00052 * DTSCS76 00053 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS76 00054 * DTSCS76 00055 * JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS76 00056 * DTSCS76 00057 * ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS76 00058 * DTSCS76 00059 * STANDARD LCCM-EMP-NO. DTSCS76 00060 * DTSCS76 00061 * DTSCS76 00062 * UPDATE: DTSCS76 00063 * DTSCS76 00064 * ADD DTSCS76 00065 * DTSCS76 00066 * DOES NOT UPDATE THE MASTER FILE. RATHER, WRITES ONE DTSCS76 00067 * OR MORE RECORDS TO THE ON-LINE ACTIVITY FILE. DTSCS76 00068 * DTSCS76 00069 * OPERATION SHOULD BE SIMILAR TO 'ADD' FUNCTION ON DTSCS76 00070 * OTHER SCREENS (F09, CONFIRM OR CANCEL). DTSCS76 00071 * DTSCS76 00072 * ELECTRONIC FILER(MELF) REMOVED ZL1. DTSCS76 00073 * RECORDS READ: DTSCS76 00074 * DTSCS76 00075 * MASTER: DTSCS76 00076 * DTSCS76 00077 * MPRF DTSCS76 00078 * MSOL DTSCS76 00079 * MRTE DTSCS76 00080 * MQTR DTSCS76 00081 * MRPT DTSCS76 00082 * DTSCS76 00083 * DTSCS76 00084 * DTSCS76 00085 * ALTERNATE INDEX: DTSCS76 00086 * DTSCS76 00087 * NONE. DTSCS76 00088 * DTSCS76 00089 * DTSCS76 00090 * REFERENCE: DTSCS76 00091 * DTSCS76 00092 * NONE. DTSCS76 00093 * DTSCS76 00094 * DTSCS76 00095 * ACCOUNTING TRANSACTION COLLECTION: DTSCS76 00096 * DTSCS76 00097 * NONE. DTSCS76 00098 * DTSCS76 00099 * DTSCS76 00100 * RECORDS UPDATED: DTSCS76 00101 * DTSCS76 00102 * MASTER: DTSCS76 00103 * DTSCS76 00104 * NONE. DTSCS76 00105 * DTSCS76 00106 * DTSCS76 00107 * REFERENCE: DTSCS76 00108 * DTSCS76 00109 * NONE. DTSCS76 00110 * DTSCS76 00111 * DTSCS76 00112 * ACCOUNTING TRANSACTION COLLECTION: DTSCS76 00113 * DTSCS76 00114 * NONE. DTSCS76 00115 * DTSCS76 00116 * DTSCS76 00117 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS76 00118 * DTSCS76 00119 * IF MAP-LABEL-CNT NOT = 0 DTSCS76 00120 * DTSCS76 00121 * WRITE A MACIR901 RECORD (R901-ON-REQUEST-88). DTSCS76 00122 * DTSCS76 00123 * DTSCS76 00124 * IF MAP-ELF-LABEL-IND = 'Y' AND MAP-ELF-LABEL-CNT NOT = 0 DTSCS76 00125 * DTSCS76 00126 * WRITE A MACIR901 RECORD (R901-ON-REQUEST-88). DTSCS76 00127 * DTSCS76 00128 * NOTE: USERS MUST BE ABLE TO REQUEST MAILING LABELS AND DTSCS76 00129 * ELECTRONIC FILER (ELF) MAILING LABELS FOR A GIVEN DTSCS76 00130 * EMPLOYER. WRITE TWO MACIR901 RECORDS IN SUCH CASES. DTSCS76 00131 * DTSCS76 00132 * DTSCS76 00133 * IF MAP-START-RPT-YRQ NOT = SPACES OR LOW-VALUES DTSCS76 00134 * DTSCS76 00135 * WRITE A MACIT036 RECORD WITH T036-TRN-CD = '02' DTSCS76 00136 * AND T036-FORCE-PRINT-IND EQUAL TO MAP-FORCE-PRINT DTSCS76 00137 * -IND. THE T036-WAIVE-* FIELDS SHOULD BE ZEROS. DTSCS76 00138 * T036-ADDR-TYPE AND T036-ADDR-NO SHOULD BE TAKEN DTSCS76 00139 * FROM MAP-ADDR-TYPE AND MAP-ADDR-NO. DTSCS76 00140 * DTSCS76 00141 * THE EDITS IN HERE SHOULD BE SIMILAR TO VERMONT. DTSCS76 00142 * MAY USE IN INFAMOUS DTSCU381 TO VERIFY LIABILITY DTSCS76 00143 * AND THE EXISTENCE OF A RATE. IF MAP-FORCE-IND DTSCS76 00144 * IS EQUAL TO 'N', WILL NEED TO READ THE MQTR DTSCS76 00145 * RECORDS AND IF MQTR RECORD EXISTS AND MQTR-CURR DTSCS76 00146 * RCVD-88, DISPLAY E763. DTSCS76 00147 * DTSCS76 00148 * DTSCS76 00149 * IF MAP-5E-START-RPT-YRQ NOT = SPACES OR LOW-VALUES DTSCS76 00150 * DTSCS76 00151 * WRITE A MACIT036 RECORD WITH T036-TRN-CD = '02' DTSCS76 00152 * AND T036-FORCE-PRINT-IND EQUAL TO MAP-5E-FORCE-PRINT DTSCS76 00153 * -IND. THE T036-WAIVE-* FIELDS SHOULD BE ZEROS. DTSCS76 00154 * T036-ADDR-TYPE AND T036-ADDR-NO SHOULD BE TAKEN DTSCS76 00155 * FROM MAP-ADDR-TYPE AND MAP-ADDR-NO. DTSCS76 00156 * DTSCS76 00157 * USE THE SAME EDITS AS FOR THE REGULAR UI-5'S ABOVE. DTSCS76 00158 * VERIFY LIABILITY AND THE EXISTENCE OF A RATE. IF DTSCS76 00159 * MAP-5E-FORCE-IND IS EQUAL TO 'N', WILL NEED TO READ DTSCS76 00160 * THE MQTR RECORDS AND IF MQTR RECORD EXISTS AND MQTR- DTSCS76 00161 * CURR-RCVD-88, DISPLAY E769. DTSCS76 00162 * DTSCS76 00163 * NOTE: USERS MUST BE ABLE TO REQUEST BOTH UI-5(S) AND DTSCS76 00164 * UI-5E(S) AS LONG AS THE QUARTER RANGES DO NOT OVER- DTSCS76 00165 * LAP. WRITE TWO T036 RECORDS IN SUCH CASES, SETTING DTSCS76 00166 * T036-UI-5E-REQ APPROPRIATELY. DTSCS76 00167 * DTSCS76 00168 * DTSCS76 00169 * IF MAP-NOTICE-OF-COVERAGE-CNT NOT = 0 DTSCS76 00170 * DTSCS76 00171 * WRITE MAP-NOTICE-OF-COVERAGE-CNT MACIR111 RECORDS. DTSCS76 00172 * DTSCS76 00173 * DTSCS76 00174 * IF MAP-NOTICE-OF-SUBJECT-IND = 'Y' DTSCS76 00175 * DTSCS76 00176 * WRITE A MACIR112 RECORD FOR THE LAST MSOL RECORD DTSCS76 00177 * ASSOCIATED WITH THE EMPLOYER. SEE MACBD311 FOR DTSCS76 00178 * SAMPLE MACIR112 GENERATING CODE. DTSCS76 00179 * DTSCS76 00180 * DTSCS76 00181 * IF MAP-REQUEST-FOR-FEIN-IND = 'Y' DTSCS76 00182 * DTSCS76 00183 * WRITE A MACIR903 RECORD. DTSCS76 00184 * DTSCS76 00185 * DTSCS76 00186 * IF MAP-AR-AUDIT-TRAIL-IND = 'Y' DTSCS76 00187 * DTSCS76 00188 * SCAN MQTR RECORDS. FOR EACH MQTR RECORD: DTSCS76 00189 * DTSCS76 00190 * IF THE MQTR RECORD HAS ONE OR MORE DTSCS76 00191 * MQTR-BALANCE-AMT (N) OCCURRENCE GREATER THAN DTSCS76 00192 * ZERO DTSCS76 00193 * DTSCS76 00194 * SCAN THE MRPT RECORDS ASSOCIATED WITH THE DTSCS76 00195 * QUARTER (THOSE MRPT RECORDS WITH MRPT-YRQ DTSCS76 00196 * EQUAL TO MQTR-YRQ) AND FOR EACH SUCH MRPT DTSCS76 00197 * RECORD ENCOUNTERED WRITE AN R432 RECORD. DTSCS76 00198 * DTSCS76 00199 * DTSCS76 00200 * IF MAP-COMBINE-IND = 'Y' DTSCS76 00201 * DTSCS76 00202 * WRITE A DTSIR733 RECORD. DTSCS76 00203 * DTSCS76 00204 * DTSCS76 00205 * TEMPORARY STORAGE USAGE: DTSCS76 00206 * DTSCS76 00207 * NONE. DTSCS76 00208 * DTSCS76 00209 * DTSCS76 00210 * MODULES LINKED TO: DTSCS76 00211 * DTSCS76 00212 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS76 00213 * DTSCU013 COUNT FROM SCREEN (INTEGER) FORMAT/EDIT. DTSCS76 00214 * DTSCU016 QUARTER/YEAR FROM SCREEN FORMAT/EDIT. DTSCS76 00215 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS76 00216 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS76 00217 * DTSCU111 ADDRESS LOOKUP. DTSCS76 00218 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS76 00219 * DTSCU381 FIND LIABILITY AND RATE FOR A QUARTER. DTSCS76 00220 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS76 00221 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCS76 00222 * DTSCS76 00223 ***** DTSCS76 00224 DTSCS76 00225 ENVIRONMENT DIVISION. DTSCS76 00226 DTSCS76 00227 DATA DIVISION. DTSCS76 00228 DTSCS76 00229 WORKING-STORAGE SECTION. DTSCS76 002295 77 PAN-VALET PICTURE X(24) VALUE '001DTSCS76 05/07/25'. DTSCS76 00230 77 PAN-VALET PICTURE X(24) VALUE '056DTSCS76 09/14/05'. DTSCS76 00231 DTSCS76 00232 01 SW-AREA. DTSCS76 00233 05 WRK-ABEND-CD PIC X(04) VALUE 'S76 '. DTSCS76 00234 DTSCS76 00235 05 WRK-SCR-ID. DTSCS76 00236 10 WRK-SCR-ID-N PIC 9(02) VALUE 76. DTSCS76 00237 DTSCS76 00238 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS76 00239 DTSCS76 00240 05 SCR-ACCESS-IND PIC X(01). DTSCS76 00241 88 SCR-ACCESS-INQ VALUE '1'. DTSCS76 00242 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS76 00243 DTSCS76 00244 05 CURSOR-SET-IND PIC X(01). DTSCS76 00245 88 CURSOR-SET-YES VALUE 'Y'. DTSCS76 00246 88 CURSOR-SET-NO VALUE 'N'. DTSCS76 00247 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS76 00248 DTSCS76 00249 05 REQ-IND PIC X(01). DTSCS76 00250 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS76 00251 88 REQ-ERROR VALUE 'O'. DTSCS76 00252 88 REQ-JUMP VALUE 'J'. DTSCS76 00253 88 REQ-UPDATE VALUE 'U'. DTSCS76 00254 88 REQ-INQUIRE VALUE 'I'. DTSCS76 00255 88 REQ-CLEAR VALUE 'C'. DTSCS76 00256 88 REQ-EDIT VALUE 'E'. DTSCS76 00257 DTSCS76 00258 05 RESP-IND PIC X(01). DTSCS76 00259 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS76 00260 88 RESP-SEND-MAP VALUE 'M'. DTSCS76 00261 88 RESP-JUMP VALUE 'J'. DTSCS76 00262 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS76 00263 DTSCS76 00264 05 WRK-MSG-AREA PIC X(64). DTSCS76 00265 DTSCS76 00266 05 WRK-ATB-AN PIC X(01). DTSCS76 00267 DTSCS76 00268 05 WRK-ATB-NUM PIC X(01). DTSCS76 00269 DTSCS76 00270 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS76 00271 DTSCS76 00272 *****05 WRK-5E-REQ-IND PIC X(01). DTSCS76 00273 *********88 WRK-5E-REQ-YES-88 VALUE 'Y'. DTSCS76 00274 *********88 WRK-5E-REQ-NO-88 VALUE 'N'. DTSCS76 00275 DTSCS76 00276 05 WRK-FROM-YRQ PIC S9(05) COMP-3. DTSCS76 00277 05 WRK-TO-YRQ PIC S9(05) COMP-3. DTSCS76 00278 DTSCS76 00279 05 WRK-STMT-FROM-YRQ PIC S9(05) COMP-3. DTSCS76 00280 05 WRK-STMT-TO-YRQ PIC S9(05) COMP-3. DTSCS76 00281 DTSCS76 00282 DTSCS76 00283 DTSCS76 00284 05 WRK-R751-IND PIC X(01). DTSCS76 00285 88 WRK-R751-YES-88 VALUE 'Y'. DTSCS76 00286 88 WRK-R751-NO-88 VALUE 'N'. DTSCS76 00287 DTSCS76 00288 05 WRK-WAIVE-EXT-DATE PIC S9(09) COMP-3. DTSCS76 00289 DTSCS76 00290 *****05 WRK-5E-WAIVE-EXT-DATE PIC S9(09) COMP-3. DTSCS76 00291 DTSCS76 00292 05 WRK-MPRF-IND PIC X(01). DTSCS76 00293 88 WRK-MPRF-NONE-88 VALUE ' '. DTSCS76 00294 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS76 00295 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS76 00296 DTSCS76 00297 05 WRK-ANN-LIABLE-IND PIC X(01). DTSCS76 00298 88 WRK-ANN-LIABLE-YES-88 VALUE 'Y'. DTSCS76 00299 88 WRK-ANN-LIABLE-NO-88 VALUE 'N'. DTSCS76 00300 DTSCS76 00301 05 WRK-ANN-FILER-IND PIC X(01). DTSCS76 00302 88 WRK-ANN-FILER-YES-88 VALUE 'Y'. DTSCS76 00303 88 WRK-ANN-FILER-NO-88 VALUE 'N'. DTSCS76 00304 DTSCS76 00305 *****05 WRK-MELF-IND PIC X(01). DTSCS76 00306 *********88 WRK-MELF-NONE-88 VALUE ' '. DTSCS76 00307 *********88 WRK-MELF-YES-88 VALUE 'Y'. DTSCS76 00308 *********88 WRK-MELF-NO-88 VALUE 'N'. DTSCS76 00309 DTSCS76 00310 05 WRK-MAILING-ADDRESS-AREA. DTSCS76 00311 10 WRK-MAILING-ADDRESS. DTSCS76 00312 15 FILLER OCCURS 5 PIC X(40). DTSCS76 00313 10 WRK-ZIP PIC X(10). DTSCS76 00314 *********10 WRK-DELIV-POINT PIC X(02). DTSCS76 00315 *********10 WRK-CHECK-DIGIT PIC X(01). DTSCS76 00316 10 WRK-ADVANCED-BARCODE PIC X(14). DTSCS76 00317 DTSCS76 00318 *****05 WRK-ELF-ADDRESS-AREA. DTSCS76 00319 *********10 WRK-ELF-ADDRESS. DTSCS76 00320 *************15 FILLER OCCURS 5 PIC X(40). DTSCS76 00321 *********10 WRK-ELF-ZIP PIC X(10). DTSCS76 00322 *********10 WRK-ELF-DELIV-POINT PIC X(02). DTSCS76 00323 *********10 WRK-ELF-CHECK-DIGIT PIC X(01). DTSCS76 00324 DTSCS76 00325 DTSCS76 00326 DTSCS76 00327 05 WRK-DISPLAY PIC 9(11). DTSCS76 00328 DTSCS76 00329 05 FILLER REDEFINES WRK-DISPLAY. DTSCS76 00330 10 FILLER PIC X(05). DTSCS76 00331 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS76 00332 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS76 00333 DTSCS76 00334 05 FILLER REDEFINES WRK-DISPLAY. DTSCS76 00335 10 FILLER PIC X(05). DTSCS76 00336 10 WRK-DISPLAY-YR PIC X(02). DTSCS76 00337 10 WRK-DISPLAY-MO PIC X(02). DTSCS76 00338 10 WRK-DISPLAY-DA PIC X(02). DTSCS76 00339 DTSCS76 00340 05 FILLER REDEFINES WRK-DISPLAY. DTSCS76 00341 10 FILLER PIC X(06). DTSCS76 00342 10 WRK-DISPLAY-YRQ PIC X(05). DTSCS76 00343 10 FILLER REDEFINES WRK-DISPLAY-YRQ. DTSCS76 00344 15 FILLER PIC XX. DTSCS76 00345 15 WRK-DISPLAY-YRQ-Y PIC 99. DTSCS76 00346 15 WRK-DISPLAY-YRQ-Q PIC 9. DTSCS76 00347 DTSCS76 00348 DTSCS76 00349 05 WRK-RATE-CTR PIC S9(04) COMP. DTSCS76 00350 DTSCS76 00351 *****05 WRK-OCC PIC S9(04) COMP. DTSCS76 00352 DTSCS76 00353 05 BALANCE-DUE-IND PIC X(01). DTSCS76 00354 EJECT DTSCS76 00355 01 MSG-LITERALS. DTSCS76 00356 05 MSG-E761-AREA. DTSCS76 00357 10 FILLER PIC X(04) VALUE 'E761'. DTSCS76 00358 10 FILLER PIC X(13) DTSCS76 00359 VALUE 'THE RATE FOR '. DTSCS76 00360 10 MSG-E761-SLASH-QTR PIC X(04). DTSCS76 00361 10 FILLER PIC X(15) DTSCS76 00362 VALUE ' IS NOT ON FILE'. DTSCS76 00363 DTSCS76 00364 05 MSG-E762-AREA. DTSCS76 00365 10 FILLER PIC X(04) VALUE 'E762'. DTSCS76 00366 10 FILLER PIC X(30) DTSCS76 00367 VALUE 'NO BALANCE DUE '. DTSCS76 00368 10 FILLER PIC X(30) DTSCS76 00369 VALUE ' '. DTSCS76 00370 DTSCS76 00371 05 MSG-E763-AREA. DTSCS76 00372 10 FILLER PIC X(04) VALUE 'E763'. DTSCS76 00373 10 FILLER PIC X(30) DTSCS76 00374 VALUE 'EMPLOYER REPORT IS ON FILE. FO'. DTSCS76 00375 10 FILLER PIC X(30) DTSCS76 00376 VALUE 'RCE PRINT? '. DTSCS76 00377 DTSCS76 00378 05 MSG-E764-AREA. DTSCS76 00379 10 FILLER PIC X(04) VALUE 'E764'. DTSCS76 00380 10 FILLER PIC X(30) DTSCS76 00381 VALUE 'NOTHING TO DO '. DTSCS76 00382 10 FILLER PIC X(30) DTSCS76 00383 VALUE ' '. DTSCS76 00384 DTSCS76 00385 05 MSG-E765-AREA. DTSCS76 00386 10 FILLER PIC X(04) VALUE 'E765'. DTSCS76 00387 10 FILLER PIC X(30) DTSCS76 00388 VALUE 'EMPLOYER IS NOT SUBJECT '. DTSCS76 00389 10 FILLER PIC X(30) DTSCS76 00390 VALUE ' '. DTSCS76 00391 DTSCS76 00392 05 MSG-E766-AREA. DTSCS76 00393 10 FILLER PIC X(04) VALUE 'E766'. DTSCS76 00394 10 FILLER PIC X(26) DTSCS76 00395 VALUE 'EMPLOYER IS NOT LIABLE IN '. DTSCS76 00396 10 MSG-E766-SLASH-QTR PIC X(04). DTSCS76 00397 DTSCS76 00398 *****05 MSG-E767-AREA. DTSCS76 00399 *********10 FILLER PIC X(04) VALUE 'E767'. DTSCS76 00400 *********10 FILLER PIC X(30) DTSCS76 00401 ***************VALUE 'EMPLOYER IS NOT ACTIVE '. DTSCS76 00402 *********10 FILLER PIC X(30) DTSCS76 00403 ***************VALUE ' '. DTSCS76 00404 DTSCS76 00405 05 MSG-E768-AREA. DTSCS76 00406 10 FILLER PIC X(04) VALUE 'E768'. DTSCS76 00407 10 FILLER PIC X(30) DTSCS76 00408 VALUE 'EMPLOYER IS CHARGING ONLY '. DTSCS76 00409 10 FILLER PIC X(30) DTSCS76 00410 VALUE ' '. DTSCS76 00411 DTSCS76 00412 *****05 MSG-E769-AREA. DTSCS76 00413 *********10 FILLER PIC X(04) VALUE 'E769'. DTSCS76 00414 *********10 FILLER PIC X(30) DTSCS76 00415 ***************VALUE 'REPORT EXISTS. FORCE PRINT? C'. DTSCS76 00416 *********10 FILLER PIC X(30) DTSCS76 00417 ***************VALUE 'ONSIDER UI-5 OR UI-5G. '. DTSCS76 00418 DTSCS76 00419 *****05 MSG-E76A-AREA. DTSCS76 00420 *********10 FILLER PIC X(04) VALUE 'E76A'. DTSCS76 00421 *********10 FILLER PIC X(30) DTSCS76 00422 ***************VALUE 'EMPLOYER IS NOT AN ELECTRONIC '. DTSCS76 00423 *********10 FILLER PIC X(30) DTSCS76 00424 ***************VALUE 'FILER. '. DTSCS76 00425 DTSCS76 00426 *****05 MSG-E76B-AREA. DTSCS76 00427 *********10 FILLER PIC X(04) VALUE 'E76B'. DTSCS76 00428 *********10 FILLER PIC X(30) DTSCS76 00429 ***************VALUE 'EMPLOYER IS NOT AN ELECTRONIC '. DTSCS76 00430 *********10 FILLER PIC X(30) DTSCS76 00431 ***************VALUE 'FILER FOR TAX REPORTS. '. DTSCS76 00432 DTSCS76 00433 *****05 MSG-E76C-AREA. DTSCS76 00434 *********10 FILLER PIC X(04) VALUE 'E76C'. DTSCS76 00435 *********10 FILLER PIC X(30) DTSCS76 00436 ***************VALUE 'ELF? MUST = Y FOR NUMBER OF LA'. DTSCS76 00437 *********10 FILLER PIC X(30) DTSCS76 00438 ***************VALUE 'BELS TO BE ENTERED. '. DTSCS76 00439 DTSCS76 00440 *****05 MSG-E76D-AREA. DTSCS76 00441 *********10 FILLER PIC X(04) VALUE 'E76D'. DTSCS76 00442 *********10 FILLER PIC X(30) DTSCS76 00443 ***************VALUE 'UI-5E QUARTER RANGE OVERLAPS U'. DTSCS76 00444 *********10 FILLER PIC X(30) DTSCS76 00445 ***************VALUE 'I-5 QUARTER RANGE. '. DTSCS76 00446 DTSCS76 00447 *****05 MSG-E76E-AREA. DTSCS76 00448 *********10 FILLER PIC X(04) VALUE 'E76E'. DTSCS76 00449 *********10 FILLER PIC X(30) DTSCS76 00450 ***************VALUE 'ELF ADDRESS NOT DELIVERABLE. '. DTSCS76 00451 *********10 FILLER PIC X(30) DTSCS76 00452 ***************VALUE ' '. DTSCS76 00453 DTSCS76 00454 05 MSG-E76F-AREA. DTSCS76 00455 10 FILLER PIC X(04) VALUE 'E76F'. DTSCS76 00456 10 FILLER PIC X(30) DTSCS76 00457 VALUE 'ANNUAL UC30H REQUESTED. QUARTE'. DTSCS76 00458 10 FILLER PIC X(30) DTSCS76 00459 VALUE 'R RANGE MUST BE 1 THROUGH 4. '. DTSCS76 00460 DTSCS76 00461 05 MSG-E76G-AREA. DTSCS76 00462 10 FILLER PIC X(04) VALUE 'E76F'. DTSCS76 00463 10 FILLER PIC X(30) DTSCS76 00464 VALUE 'SSN NOT IN CLAIMANT FILE; RE-E'. DTSCS76 00465 10 FILLER PIC X(30) DTSCS76 00466 VALUE 'NTER. '. DTSCS76 00467 DTSCS76 00468 05 MSG-E76H-AREA. DTSCS76 00469 10 FILLER PIC X(04) VALUE 'E76H'. DTSCS76 00470 10 FILLER PIC X(30) DTSCS76 00471 VALUE 'MASS MAILING HAS NOT OCCURED F'. DTSCS76 00472 10 FILLER PIC X(30) DTSCS76 00473 VALUE 'OR QUARTER. FORCE PRINT? '. DTSCS76 00474 DTSCS76 00475 EJECT DTSCS76 00476 01 L001-COMM-AREA. DTSCS76 00477 ++INCLUDE DTSIL001 DTSCS76 00478 EJECT DTSCS76 00479 01 L004-COMM-AREA. DTSCS76 00480 ++INCLUDE DTSIL004 DTSCS76 00481 EJECT DTSCS76 00482 01 L006-COMM-AREA. DTSCS76 00483 ++INCLUDE DTSIL006 DTSCS76 00484 EJECT DTSCS76 00485 01 L013-COMM-AREA. DTSCS76 00486 ++INCLUDE DTSIL013 DTSCS76 00487 EJECT DTSCS76 00488 01 L015-COMM-AREA. DTSCS76 00489 ++INCLUDE DTSIL015 DTSCS76 00490 EJECT DTSCS76 00491 01 L016-COMM-AREA. DTSCS76 00492 ++INCLUDE DTSIL016 DTSCS76 00493 EJECT DTSCS76 00494 01 L018-COMM-AREA. DTSCS76 00495 ++INCLUDE DTSIL018 DTSCS76 00496 EJECT DTSCS76 00497 01 L020-COMM-AREA. DTSCS76 00498 ++INCLUDE DTSIL020 DTSCS76 00499 EJECT DTSCS76 00500 01 L081-COMM-AREA. DTSCS76 00501 ++INCLUDE DTSIL081 DTSCS76 00502 EJECT DTSCS76 00503 01 L082-COMM-AREA. DTSCS76 00504 ++INCLUDE DTSIL082 DTSCS76 00505 EJECT DTSCS76 00506 01 L111-COMM-AREA. DTSCS76 00507 ++INCLUDE DTSIL111 DTSCS76 00508 EJECT DTSCS76 00509 01 L112-COMM-AREA. DTSCS76 00510 ++INCLUDE DTSIL112 DTSCS76 00511 EJECT DTSCS76 00512 01 L381-COMM-AREA. DTSCS76 00513 ++INCLUDE DTSIL381 DTSCS76 00514 EJECT DTSCS76 00515 01 L410-COMM-AREA. DTSCS76 00516 ++INCLUDE DTSIL410 DTSCS76 00517 EJECT DTSCS76 00518 01 L415-COMM-AREA. DTSCS76 00519 ++INCLUDE DTSIL415 DTSCS76 00520 EJECT DTSCS76 00521 01 L805-COMM-AREA. DTSCS76 00522 ++INCLUDE DTSIL805 DTSCS76 00523 EJECT DTSCS76 00524 01 L810-COMM-AREA. DTSCS76 00525 05 L810-CONTROL-BLOCK. DTSCS76 00526 ++INCLUDE DTSIL810 DTSCS76 00527 EJECT DTSCS76 00528 05 MSKL-REC. DTSCS76 00529 ++INCLUDE DTSIMSKL DTSCS76 00530 EJECT DTSCS76 00531 01 MPRF-REC. DTSCS76 00532 ++INCLUDE DTSIMPRF DTSCS76 00533 EJECT DTSCS76 00534 01 MRTE-REC. DTSCS76 00535 ++INCLUDE DTSIMRTE DTSCS76 00536 EJECT DTSCS76 00537 01 MSOL-REC. DTSCS76 00538 ++INCLUDE DTSIMSOL DTSCS76 00539 EJECT DTSCS76 00540 01 MQTR-REC. DTSCS76 00541 ++INCLUDE DTSIMQTR DTSCS76 00542 EJECT DTSCS76 00543 01 MRPT-REC. DTSCS76 00544 ++INCLUDE DTSIMRPT DTSCS76 00545 EJECT DTSCS76 00546 01 MOPO-REC. DTSCS76 00547 ++INCLUDE DTSIMOPO DTSCS76 00548 EJECT DTSCS76 00549 01 MTAA-REC. DTSCS76 00550 ++INCLUDE DTSIMTAA DTSCS76 00551 EJECT DTSCS76 00552 *01 MELF-REC. DTSCS76 00553 ***INCLUDE DTSIMELF DTSCS76 00554 EJECT DTSCS76 00555 01 L851-COMM-AREA. DTSCS76 00556 ++INCLUDE DTSIL851 DTSCS76 00557 DTSCS76 00558 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS76 00559 ++INCLUDE DTSIS76 DTSCS76 00560 EJECT DTSCS76 00561 01 L825-COMM-AREA. DTSCS76 00562 05 L825-CONTROL-BLOCK. DTSCS76 00563 ++INCLUDE DTSIL825 DTSCS76 00564 DTSCS76 00565 05 RSKL-REC. DTSCS76 00566 ++INCLUDE DTSIRSK1 DTSCS76 00567 EJECT DTSCS76 00568 *01 R111-REC. DTSCS76 00569 ***INCLUDE DTSIR111 DTSCS76 00570 EJECT DTSCS76 00571 01 R112-REC. DTSCS76 00572 ++INCLUDE DTSIR112 DTSCS76 00573 EJECT DTSCS76 00574 01 R432-REC. DTSCS76 00575 ++INCLUDE DTSIR432 DTSCS76 00576 EJECT DTSCS76 00577 01 R733-REC. DTSCS76 00578 ++INCLUDE DTSIR733 DTSCS76 00579 EJECT DTSCS76 00580 01 R751-REC. DTSCS76 00581 ++INCLUDE DTSIR751 DTSCS76 00582 EJECT DTSCS76 00583 01 R901-REC. DTSCS76 00584 ++INCLUDE DTSIR901 DTSCS76 00585 EJECT DTSCS76 00586 01 R903-REC. DTSCS76 00587 ++INCLUDE DTSIR903 DTSCS76 00588 EJECT DTSCS76 00589 01 T011-REC. DTSCS76 00590 ++INCLUDE DTSIT011 DTSCS76 00591 EJECT DTSCS76 00592 01 T031-REC. DTSCS76 00593 ++INCLUDE DTSIT031 DTSCS76 00594 EJECT DTSCS76 00595 01 T036-REC. DTSCS76 00596 ++INCLUDE DTSIT036 DTSCS76 00597 EJECT DTSCS76 00598 01 CATB-LITERALS. DTSCS76 00599 ++INCLUDE DTSICATB DTSCS76 00600 DTSCS76 00601 DTSCS76 00602 DTSCS76 00603 01 CFKD-LITERALS. DTSCS76 00604 ++INCLUDE DTSICFKD DTSCS76 00605 DTSCS76 00606 DTSCS76 00607 DTSCS76 00608 01 CECD-LITERALS. DTSCS76 00609 ++INCLUDE DTSICECD DTSCS76 00610 DTSCS76 00611 DTSCS76 00612 DTSCS76 00613 01 CPCD-LITERALS. DTSCS76 00614 ++INCLUDE DTSICPCD DTSCS76 00615 EJECT DTSCS76 00616 LINKAGE SECTION. DTSCS76 00617 DTSCS76 00618 01 DFHCOMMAREA. DTSCS76 00619 ++INCLUDE DTSILCCM DTSCS76 00620 EJECT DTSCS76 00621 PROCEDURE DIVISION. DTSCS76 00622 DTSCS76 00623 MOVE +0 TO WRK-EMP-NO. DTSCS76 00624 DTSCS76 00625 SET WRK-MPRF-NONE-88 TO TRUE. DTSCS76 00626 *** SET WRK-R751-NO-88 TO TRUE. DTSCS76 00627 DTSCS76 00628 MOVE LOW-VALUES TO MAP-AREA. DTSCS76 00629 DTSCS76 00630 SET CURSOR-SET-NO TO TRUE. DTSCS76 00631 DTSCS76 00632 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS76 00633 TO SCR-ACCESS-IND. DTSCS76 00634 DTSCS76 00635 DTSCS76 00636 MOVE SPACE TO REQ-IND. DTSCS76 00637 DTSCS76 00638 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS76 00639 DTSCS76 00640 DTSCS76 00641 *----------------------------------------------------- DTSCS76 00642 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS76 00643 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS76 00644 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS76 00645 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS76 00646 * DTSCS76 00647 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS76 00648 * PROCESSED. DTSCS76 00649 * DTSCS76 00650 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS76 00651 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS76 00652 * WORK STATION OPERATOR. DTSCS76 00653 *----------------------------------------------------- DTSCS76 00654 DTSCS76 00655 MOVE SPACE TO RESP-IND. DTSCS76 00656 DTSCS76 00657 IF REQ-ERROR DTSCS76 00658 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS76 00659 ELSE DTSCS76 00660 IF REQ-JUMP DTSCS76 00661 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS76 00662 ELSE DTSCS76 00663 IF REQ-CLEAR DTSCS76 00664 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS76 00665 ELSE DTSCS76 00666 IF REQ-CURSOR-TO-GOTO DTSCS76 00667 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS76 00668 ELSE DTSCS76 00669 IF REQ-INQUIRE DTSCS76 00670 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS76 00671 ELSE DTSCS76 00672 IF REQ-EDIT DTSCS76 00673 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS76 00674 ELSE DTSCS76 00675 IF REQ-UPDATE DTSCS76 00676 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS76 00677 ELSE DTSCS76 00678 GO TO S899-ABEND. DTSCS76 00679 DTSCS76 00680 DTSCS76 00681 *----------------------------------------------------- DTSCS76 00682 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS76 00683 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS76 00684 *----------------------------------------------------- DTSCS76 00685 DTSCS76 00686 IF RESP-SEND-MAP DTSCS76 00687 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS76 00688 SET LCCM-END-TASK-88 TO TRUE DTSCS76 00689 ELSE DTSCS76 00690 IF RESP-SEND-MSGONLY DTSCS76 00691 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS76 00692 SET LCCM-END-TASK-88 TO TRUE DTSCS76 00693 ELSE DTSCS76 00694 IF RESP-JUMP DTSCS76 00695 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76 00696 ELSE DTSCS76 00697 IF RESP-CURSOR-TO-GOTO DTSCS76 00698 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS76 00699 SET LCCM-END-TASK-88 TO TRUE DTSCS76 00700 ELSE DTSCS76 00701 GO TO S899-ABEND. DTSCS76 00702 DTSCS76 00703 MAINLINE-EXIT. DTSCS76 00704 DTSCS76 00705 EXEC CICS DTSCS76 00706 RETURN DTSCS76 00707 END-EXEC. DTSCS76 00708 DTSCS76 00709 GOBACK. DTSCS76 00710 EJECT DTSCS76 00711 /*****************************************************************DTSCS76 00712 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS76 00713 ******************************************************************DTSCS76 00714 DTSCS76 00715 P1000-ANALYZE-REQUEST. DTSCS76 00716 DTSCS76 00717 DTSCS76 00718 *----------------------------------------------------- DTSCS76 00719 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS76 00720 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS76 00721 * REPLACED WITH ENTER) DTSCS76 00722 *----------------------------------------------------- DTSCS76 00723 DTSCS76 00724 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS76 00725 SET LCCM-ENTER-88 TO TRUE DTSCS76 00726 SET REQ-INQUIRE TO TRUE DTSCS76 00727 IF LCCM-EMP-NO > ZERO DTSCS76 00728 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS76 00729 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS76 00730 END-IF DTSCS76 00731 GO TO P1000-EXIT. DTSCS76 00732 DTSCS76 00733 DTSCS76 00734 *----------------------------------------------------- DTSCS76 00735 * RECEIVE THE MAP DTSCS76 00736 *----------------------------------------------------- DTSCS76 00737 DTSCS76 00738 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS76 00739 DTSCS76 00740 DTSCS76 00741 *----------------------------------------------------- DTSCS76 00742 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS76 00743 * WORK STATION DTSCS76 00744 *----------------------------------------------------- DTSCS76 00745 DTSCS76 00746 IF LCCM-CLEAR-88 DTSCS76 00747 SET REQ-CLEAR TO TRUE DTSCS76 00748 GO TO P1000-EXIT. DTSCS76 00749 DTSCS76 00750 DTSCS76 00751 *----------------------------------------------------- DTSCS76 00752 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS76 00753 *----------------------------------------------------- DTSCS76 00754 DTSCS76 00755 IF LCCM-SCR-UPDATE-LOCKED DTSCS76 00756 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS76 00757 GO TO P1000-EXIT. DTSCS76 00758 DTSCS76 00759 DTSCS76 00760 *----------------------------------------------------- DTSCS76 00761 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS76 00762 *----------------------------------------------------- DTSCS76 00763 DTSCS76 00764 IF LCCM-PA2-88 DTSCS76 00765 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS76 00766 GO TO P1000-EXIT. DTSCS76 00767 DTSCS76 00768 DTSCS76 00769 *----------------------------------------------------- DTSCS76 00770 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS76 00771 *----------------------------------------------------- DTSCS76 00772 DTSCS76 00773 IF LCCM-PA-88 DTSCS76 00774 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS76 00775 SET REQ-ERROR TO TRUE DTSCS76 00776 GO TO P1000-EXIT. DTSCS76 00777 DTSCS76 00778 DTSCS76 00779 *----------------------------------------------------- DTSCS76 00780 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS76 00781 * CLEAR SCREEN DTSCS76 00782 *----------------------------------------------------- DTSCS76 00783 DTSCS76 00784 IF LCCM-F12-88 DTSCS76 00785 MOVE LOW-VALUES TO MAP-AREA DTSCS76 00786 SET REQ-CLEAR TO TRUE DTSCS76 00787 GO TO P1000-EXIT. DTSCS76 00788 DTSCS76 00789 DTSCS76 00790 *----------------------------------------------------- DTSCS76 00791 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS76 00792 *----------------------------------------------------- DTSCS76 00793 DTSCS76 00794 IF LCCM-F03-88 DTSCS76 00795 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS76 00796 SET REQ-JUMP TO TRUE DTSCS76 00797 GO TO P1000-EXIT. DTSCS76 00798 DTSCS76 00799 DTSCS76 00800 *----------------------------------------------------- DTSCS76 00801 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS76 00802 *----------------------------------------------------- DTSCS76 00803 DTSCS76 00804 IF LCCM-F04-88 DTSCS76 00805 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS76 00806 SET REQ-JUMP TO TRUE DTSCS76 00807 GO TO P1000-EXIT. DTSCS76 00808 DTSCS76 00809 DTSCS76 00810 *----------------------------------------------------- DTSCS76 00811 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS76 00812 * CORRESPONDENCE SCREEN DTSCS76 00813 *----------------------------------------------------- DTSCS76 00814 DTSCS76 00815 IF LCCM-F14-88 DTSCS76 00816 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS76 00817 SET REQ-JUMP TO TRUE DTSCS76 00818 GO TO P1000-EXIT. DTSCS76 00819 DTSCS76 00820 DTSCS76 00821 *----------------------------------------------------- DTSCS76 00822 * IF JUMP KEY PRESSED, JUMP TO THE REQUESTED SCREEN DTSCS76 00823 *----------------------------------------------------- DTSCS76 00824 DTSCS76 00825 *****IF LCCM-F17-88 DTSCS76 00826 ********MOVE '11' TO LCCM-REQ-SCR-ID DTSCS76 00827 ********SET REQ-JUMP TO TRUE DTSCS76 00828 ********GO TO P1000-EXIT. DTSCS76 00829 DTSCS76 00830 *****IF LCCM-F18-88 DTSCS76 00831 ********MOVE '12' TO LCCM-REQ-SCR-ID DTSCS76 00832 ********SET REQ-JUMP TO TRUE DTSCS76 00833 ********GO TO P1000-EXIT. DTSCS76 00834 DTSCS76 00835 *****IF LCCM-F19-88 DTSCS76 00836 ********MOVE '31' TO LCCM-REQ-SCR-ID DTSCS76 00837 ********SET REQ-JUMP TO TRUE DTSCS76 00838 ********GO TO P1000-EXIT. DTSCS76 00839 DTSCS76 00840 *****IF LCCM-F20-88 DTSCS76 00841 ********MOVE '41' TO LCCM-REQ-SCR-ID DTSCS76 00842 ********SET REQ-JUMP TO TRUE DTSCS76 00843 ********GO TO P1000-EXIT. DTSCS76 00844 DTSCS76 00845 DTSCS76 00846 *----------------------------------------------------- DTSCS76 00847 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS76 00848 * REQUESTED SCREEN TYPE DTSCS76 00849 *----------------------------------------------------- DTSCS76 00850 DTSCS76 00851 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS76 00852 NEXT SENTENCE DTSCS76 00853 ELSE DTSCS76 00854 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS76 00855 SET REQ-JUMP TO TRUE DTSCS76 00856 GO TO P1000-EXIT. DTSCS76 00857 DTSCS76 00858 DTSCS76 00859 *----------------------------------------------------- DTSCS76 00860 * IF REQUEST TO UPDATE THE DATA (ADD) DTSCS76 00861 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS76 00862 *----------------------------------------------------- DTSCS76 00863 DTSCS76 00864 IF LCCM-F09-88 DTSCS76 00865 IF SCR-ACCESS-UPDATE DTSCS76 00866 SET REQ-EDIT TO TRUE DTSCS76 00867 GO TO P1000-EXIT DTSCS76 00868 ELSE DTSCS76 00869 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS76 00870 SET REQ-ERROR TO TRUE DTSCS76 00871 GO TO P1000-EXIT. DTSCS76 00872 DTSCS76 00873 DTSCS76 00874 *----------------------------------------------------- DTSCS76 00875 * IF INQUIRY KEY IS PRESSED (ENTER), INDICATE DTSCS76 00876 * INQUIRY REQUESTED. DTSCS76 00877 *----------------------------------------------------- DTSCS76 00878 DTSCS76 00879 IF LCCM-ENTER-88 DTSCS76 00880 SET REQ-INQUIRE TO TRUE DTSCS76 00881 GO TO P1000-EXIT. DTSCS76 00882 DTSCS76 00883 DTSCS76 00884 *----------------------------------------------------- DTSCS76 00885 * ANY OTHER KEY IS INVALID DTSCS76 00886 *----------------------------------------------------- DTSCS76 00887 DTSCS76 00888 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS76 00889 DTSCS76 00890 SET REQ-ERROR TO TRUE. DTSCS76 00891 P1000-EXIT. DTSCS76 00892 EXIT. DTSCS76 00893 DTSCS76 00894 DTSCS76 00895 DTSCS76 00896 ******************************************************************DTSCS76 00897 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS76 00898 ******************************************************************DTSCS76 00899 DTSCS76 00900 P1100-UPDATE-LOCKED. DTSCS76 00901 DTSCS76 00902 *----------------------------------------------------- DTSCS76 00903 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS76 00904 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER OR F9 DTSCS76 00905 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS76 00906 *----------------------------------------------------- DTSCS76 00907 DTSCS76 00908 IF LCCM-ENTER-88 OR LCCM-F12-88 OR LCCM-F09-88 DTSCS76 00909 SET REQ-UPDATE TO TRUE DTSCS76 00910 IF LCCM-F09-88 DTSCS76 00911 SET LCCM-ENTER-88 TO TRUE DTSCS76 00912 END-IF DTSCS76 00913 ELSE DTSCS76 00914 SET REQ-ERROR TO TRUE DTSCS76 00915 IF LCCM-SCR-ADD-LOCKED DTSCS76 00916 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS76 00917 ELSE DTSCS76 00918 GO TO S899-ABEND. DTSCS76 00919 P1100-EXIT. DTSCS76 00920 EXIT. DTSCS76 00921 /*****************************************************************DTSCS76 00922 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS76 00923 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS76 00924 ******************************************************************DTSCS76 00925 DTSCS76 00926 P2000-REQUEST-ERROR. DTSCS76 00927 IF LCCM-MSG DTSCS76 00928 SET RESP-SEND-MSGONLY TO TRUE DTSCS76 00929 ELSE DTSCS76 00930 GO TO S899-ABEND. DTSCS76 00931 P2000-EXIT. DTSCS76 00932 EXIT. DTSCS76 00933 /*****************************************************************DTSCS76 00934 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS76 00935 ******************************************************************DTSCS76 00936 DTSCS76 00937 P3000-REQUEST-JUMP. DTSCS76 00938 DTSCS76 00939 *----------------------------------------------------- DTSCS76 00940 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS76 00941 * BY USER DTSCS76 00942 *----------------------------------------------------- DTSCS76 00943 DTSCS76 00944 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS76 00945 DTSCS76 00946 DTSCS76 00947 *----------------------------------------------------- DTSCS76 00948 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS76 00949 *----------------------------------------------------- DTSCS76 00950 DTSCS76 00951 IF LCCM-MSG DTSCS76 00952 SET RESP-SEND-MSGONLY TO TRUE DTSCS76 00953 SET CURSOR-SET-GOTO TO TRUE DTSCS76 00954 GO TO P3000-EXIT. DTSCS76 00955 DTSCS76 00956 DTSCS76 00957 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS76 00958 DTSCS76 00959 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS76 00960 DTSCS76 00961 IF L018-VALID DTSCS76 00962 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS76 00963 DTSCS76 00964 DTSCS76 00965 *----------------------------------------------------- DTSCS76 00966 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS76 00967 *----------------------------------------------------- DTSCS76 00968 DTSCS76 00969 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS76 00970 LCCM-SCR-HOLD-AREA. DTSCS76 00971 DTSCS76 00972 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS76 00973 DTSCS76 00974 SET RESP-JUMP TO TRUE. DTSCS76 00975 P3000-EXIT. DTSCS76 00976 EXIT. DTSCS76 00977 /*****************************************************************DTSCS76 00978 * CLEAR KEY WAS PRESSED *DTSCS76 00979 ******************************************************************DTSCS76 00980 DTSCS76 00981 P4000-REQUEST-CLEAR. DTSCS76 00982 SET LCCM-SCR-CLEAR TO TRUE. DTSCS76 00983 DTSCS76 00984 IF SCR-ACCESS-UPDATE DTSCS76 00985 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS76 00986 ELSE DTSCS76 00987 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS76 00988 DTSCS76 00989 DTSCS76 00990 *----------------------------------------------------- DTSCS76 00991 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS76 00992 * FIELDS FROM EARLIER REQUESTS DTSCS76 00993 *----------------------------------------------------- DTSCS76 00994 DTSCS76 00995 IF LCCM-EMP-NO > ZERO DTSCS76 00996 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS76 00997 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS76 00998 DTSCS76 00999 MOVE ZERO TO LCCM-EMP-NO. DTSCS76 01000 DTSCS76 01001 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS76 01002 DTSCS76 01003 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS76 01004 DTSCS76 01005 SET RESP-SEND-MAP TO TRUE. DTSCS76 01006 P4000-EXIT. DTSCS76 01007 EXIT. DTSCS76 01008 /*****************************************************************DTSCS76 01009 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS76 01010 ******************************************************************DTSCS76 01011 DTSCS76 01012 P5000-CURSOR-TO-GOTO. DTSCS76 01013 SET CURSOR-SET-GOTO TO TRUE. DTSCS76 01014 DTSCS76 01015 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS76 01016 P5000-EXIT. DTSCS76 01017 EXIT. DTSCS76 01018 /*****************************************************************DTSCS76 01019 * INQUIRY WAS REQUESTED *DTSCS76 01020 ******************************************************************DTSCS76 01021 DTSCS76 01022 P6000-REQUEST-INQUIRE. DTSCS76 01023 SET LCCM-SCR-CLEAR TO TRUE. DTSCS76 01024 DTSCS76 01025 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS76 01026 DTSCS76 01027 SET RESP-SEND-MAP TO TRUE. DTSCS76 01028 DTSCS76 01029 IF SCR-ACCESS-UPDATE DTSCS76 01030 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS76 01031 ELSE DTSCS76 01032 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS76 01033 DTSCS76 01034 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS76 01035 DTSCS76 01036 IF LCCM-MSG DTSCS76 01037 GO TO P6000-EXIT. DTSCS76 01038 DTSCS76 01039 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS76 01040 DTSCS76 01041 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS76 01042 DTSCS76 01043 MOVE LCCM-RESP-OP-ID TO MAP-RESPONSIBLE-OP-ID. DTSCS76 01044 DTSCS76 01045 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS76 01046 P6000-EXIT. DTSCS76 01047 EXIT. DTSCS76 01048 /*****************************************************************DTSCS76 01049 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED. *DTSCS76 01050 ******************************************************************DTSCS76 01051 DTSCS76 01052 P7000-REQUEST-EDIT. DTSCS76 01053 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS76 01054 DTSCS76 01055 IF LCCM-F09-88 DTSCS76 01056 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS76 01057 ELSE DTSCS76 01058 GO TO S899-ABEND. DTSCS76 01059 DTSCS76 01060 DTSCS76 01061 *------------------------------------------------------ DTSCS76 01062 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS76 01063 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST DTSCS76 01064 * REMAIN IN 'CLEAR' STATUS. DTSCS76 01065 *------------------------------------------------------ DTSCS76 01066 DTSCS76 01067 IF LCCM-MSG DTSCS76 01068 NEXT SENTENCE DTSCS76 01069 ELSE DTSCS76 01070 PERFORM S8100-SET-LOCK-ATTRB THRU S8100-EXIT DTSCS76 01071 IF LCCM-F09-88 DTSCS76 01072 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS76 01073 MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID. DTSCS76 01074 DTSCS76 01075 SET RESP-SEND-MAP TO TRUE. DTSCS76 01076 DTSCS76 01077 IF MAP-CLAIMANT-NAME GREATER SPACES DTSCS76 01078 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CLAIMANT-NAME-A. DTSCS76 01079 P7000-EXIT. DTSCS76 01080 EXIT. DTSCS76 01081 /*****************************************************************DTSCS76 01082 * ADD FUNCTION WAS REQUESTED *DTSCS76 01083 ******************************************************************DTSCS76 01084 DTSCS76 01085 P7100-EDIT-ADD. DTSCS76 01086 *----------------------------------------------------- DTSCS76 01087 * ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE DTSCS76 01088 *----------------------------------------------------- DTSCS76 01089 DTSCS76 01090 *****IF NOT LCCM-SCR-CLEAR DTSCS76 01091 ********MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS76 01092 ********GO TO P7100-EXIT. DTSCS76 01093 DTSCS76 01094 DTSCS76 01095 *----------------------------------------------------- DTSCS76 01096 * MAP-EMP-NO IS REQUIRED DTSCS76 01097 *----------------------------------------------------- DTSCS76 01098 DTSCS76 01099 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS76 01100 DTSCS76 01101 IF LCCM-MSG DTSCS76 01102 GO TO P7100-EXIT. DTSCS76 01103 DTSCS76 01104 DTSCS76 01105 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS76 01106 P7100-EXIT. DTSCS76 01107 EXIT. DTSCS76 01108 /*****************************************************************DTSCS76 01109 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS76 01110 ******************************************************************DTSCS76 01111 DTSCS76 01112 P8000-REQUEST-UPDATE. DTSCS76 01113 IF LCCM-SCR-ADD-LOCKED DTSCS76 01114 PERFORM P8100-ADD THRU P8100-EXIT DTSCS76 01115 ELSE DTSCS76 01116 GO TO S899-ABEND. DTSCS76 01117 DTSCS76 01118 SET RESP-SEND-MAP TO TRUE. DTSCS76 01119 P8000-EXIT. DTSCS76 01120 EXIT. DTSCS76 01121 /*****************************************************************DTSCS76 01122 * *DTSCS76 01123 ******************************************************************DTSCS76 01124 DTSCS76 01125 P8100-ADD. DTSCS76 01126 SET LCCM-SCR-CLEAR TO TRUE. DTSCS76 01127 DTSCS76 01128 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS76 01129 DTSCS76 01130 IF LCCM-F12-88 DTSCS76 01131 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS76 01132 GO TO P8100-EXIT. DTSCS76 01133 DTSCS76 01134 DTSCS76 01135 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS76 01136 DTSCS76 01137 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS76 01138 DTSCS76 01139 *****PERFORM S1200-READ-MELF THRU S1200-EXIT. DTSCS76 01140 DTSCS76 01141 MOVE ALL '?' TO WRK-MAILING-ADDRESS-AREA. DTSCS76 01142 DTSCS76 01143 IF WRK-MPRF-YES-88 DTSCS76 01144 PERFORM P8110-FORMAT-ADDR THRU P8110-EXIT DTSCS76 01145 IF LCCM-MSG DTSCS76 01146 GO TO P8100-EXIT. DTSCS76 01147 DTSCS76 01148 DTSCS76 01149 MOVE MAP-MAILING-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76 01150 DTSCS76 01151 PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76 01152 DTSCS76 01153 IF L013-CNT NOT = 0 DTSCS76 01154 PERFORM P8910-R901-RECORD THRU P8910-EXIT. DTSCS76 01155 DTSCS76 01156 DTSCS76 01157 *****MOVE ALL '?' TO WRK-ELF-ADDRESS-AREA. DTSCS76 01158 *****IF WRK-MELF-YES-88 DTSCS76 01159 *********PERFORM P8210-FORMAT-ELF-ADDR THRU P8210-EXIT DTSCS76 01160 *********IF LCCM-MSG DTSCS76 01161 *************GO TO P8100-EXIT. DTSCS76 01162 DTSCS76 01163 *****MOVE MAP-ELF-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76 01164 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76 01165 DTSCS76 01166 *****IF L013-CNT NOT = 0 DTSCS76 01167 *********PERFORM P8915-ELF-R901-RECORD THRU P8915-EXIT DTSCS76 01168 *****END-IF. DTSCS76 01169 DTSCS76 01170 DTSCS76 01171 MOVE MAP-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 01172 DTSCS76 01173 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 01174 DTSCS76 01175 IF L016-NO-ENTRY DTSCS76 01176 NEXT SENTENCE DTSCS76 01177 ELSE DTSCS76 01178 PERFORM P8920-T036-RECORD THRU P8920-EXIT. DTSCS76 01179 DTSCS76 01180 DTSCS76 01181 *****MOVE MAP-5E-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 01182 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 01183 *****IF L016-NO-ENTRY DTSCS76 01184 *********NEXT SENTENCE DTSCS76 01185 *****ELSE DTSCS76 01186 *********PERFORM P8925-5E-T036-RECORD THRU P8925-EXIT DTSCS76 01187 *****END-IF. DTSCS76 01188 DTSCS76 01189 *****MOVE MAP-NOTICE-OF-COVERAGE-AREA TO L013-S-CNT-AREA. DTSCS76 01190 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76 01191 *****IF L013-CNT > +0 DTSCS76 01192 ********PERFORM P8930-R111-RECORDS THRU P8930-EXIT DTSCS76 01193 ************L013-CNT TIMES. DTSCS76 01194 DTSCS76 01195 DTSCS76 01196 IF MAP-NOTICE-OF-SUBJECT-YES DTSCS76 01197 PERFORM P8940-R112-RECORD THRU P8940-EXIT. DTSCS76 01198 DTSCS76 01199 DTSCS76 01200 IF MAP-REQUEST-FOR-FEIN-YES DTSCS76 01201 PERFORM P8950-R903-RECORD THRU P8950-EXIT. DTSCS76 01202 DTSCS76 01203 DTSCS76 01204 IF MAP-AR-AUDIT-TRAIL-YES DTSCS76 01205 PERFORM P8960-R432-RECORD THRU P8960-EXIT. DTSCS76 01206 DTSCS76 01207 DTSCS76 01208 MOVE MAP-STMT-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 01209 DTSCS76 01210 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 01211 DTSCS76 01212 IF L016-NO-ENTRY DTSCS76 01213 NEXT SENTENCE DTSCS76 01214 ELSE DTSCS76 01215 PERFORM P8970-T011-RECORD THRU P8970-EXIT. DTSCS76 01216 DTSCS76 01217 IF MAP-SSN-1 GREATER SPACES DTSCS76 01218 *** MOVE +1 TO L013-CNT DTSCS76 01219 ** SET WRK-R751-YES-88 TO TRUE DTSCS76 01220 ** PERFORM P8910-R901-RECORD THRU P8910-EXIT DTSCS76 01221 *** SET WRK-R751-NO-88 TO TRUE DTSCS76 01222 PERFORM P8980-R751-RECORD THRU P8980-EXIT. DTSCS76 01223 DTSCS76 01224 DTSCS76 01225 IF LCCM-ENTER-88 DTSCS76 01226 MOVE LOW-VALUES TO MAP-AREA DTSCS76 01227 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS76 01228 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS76 01229 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS76 01230 ELSE DTSCS76 01231 MOVE LOW-VALUES TO MAP-EMP-NO-1 DTSCS76 01232 MAP-EMP-NO-2 DTSCS76 01233 MAP-PRIMARY-NAME. DTSCS76 01234 DTSCS76 01235 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS76 01236 P8100-EXIT. DTSCS76 01237 EXIT. DTSCS76 01238 DTSCS76 01239 DTSCS76 01240 DTSCS76 01241 P8110-FORMAT-ADDR. DTSCS76 01242 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS76 01243 DTSCS76 01244 IF MAP-ADDR-TAD-88 DTSCS76 01245 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS76 01246 ELSE DTSCS76 01247 IF MAP-ADDR-TAX-ALT-88 DTSCS76 01248 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS76 01249 ELSE DTSCS76 01250 IF MAP-ADDR-OPO-88 DTSCS76 01251 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS76 01252 ELSE DTSCS76 01253 GO TO P8110-EXIT. DTSCS76 01254 DTSCS76 01255 IF MAP-ADDR-TAX-88 DTSCS76 01256 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS76 01257 ELSE DTSCS76 01258 IF MAP-ADDR-PHY-88 DTSCS76 01259 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS76 01260 ELSE DTSCS76 01261 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA DTSCS76 01262 PERFORM S013-ADDR-NUM THRU S013-EXIT DTSCS76 01263 IF L013-VALID DTSCS76 01264 MOVE L013-CNT TO L111-ID-NO DTSCS76 01265 ELSE DTSCS76 01266 GO TO P8110-EXIT. DTSCS76 01267 DTSCS76 01268 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS76 01269 DTSCS76 01270 IF L111-ADDR-NOT-FOUND-88 DTSCS76 01271 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS76 01272 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76 01273 GO TO P8110-EXIT. DTSCS76 01274 DTSCS76 01275 DTSCS76 01276 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS76 01277 DTSCS76 01278 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS76 01279 DTSCS76 01280 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS76 01281 DTSCS76 01282 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS76 01283 DTSCS76 01284 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS76 01285 DTSCS76 01286 DTSCS76 01287 MOVE L112-MAILING-ADDRESS TO WRK-MAILING-ADDRESS. DTSCS76 01288 DTSCS76 01289 MOVE L112-ZIP TO WRK-ZIP. DTSCS76 01290 DTSCS76 01291 *****MOVE L112-DELIV-POINT TO WRK-DELIV-POINT. DTSCS76 01292 DTSCS76 01293 *****MOVE L112-CHECK-DIGIT TO WRK-CHECK-DIGIT. DTSCS76 01294 DTSCS76 01295 MOVE L112-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE. DTSCS76 01296 P8110-EXIT. DTSCS76 01297 EXIT. DTSCS76 01298 DTSCS76 01299 DTSCS76 01300 DTSCS76 01301 *P8210-FORMAT-ELF-ADDR. DTSCS76 01302 **** SET L112-TAD-ADDR-88 TO TRUE. DTSCS76 01303 *****SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS76 01304 *****MOVE MPRF-BUSINESS-NAME TO L112-BUSINESS-NAME. DTSCS76 01305 *****MOVE MELF-MAIL-DELIV-IND TO L112-MAIL-DELIV-IND. DTSCS76 01306 *****MOVE SPACES TO L112-NAME DTSCS76 01307 ********************L112-TITLE. DTSCS76 01308 *****MOVE MELF-ADDRESS TO L112-ADDRESS. DTSCS76 01309 DTSCS76 01310 *****PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS76 01311 DTSCS76 01312 *****MOVE L112-MAILING-ADDRESS TO WRK-ELF-ADDRESS. DTSCS76 01313 *****MOVE L112-ZIP TO WRK-ELF-ZIP. DTSCS76 01314 *****MOVE L112-DELIV-POINT TO WRK-ELF-DELIV-POINT. DTSCS76 01315 *****MOVE L112-CHECK-DIGIT TO WRK-ELF-CHECK-DIGIT. DTSCS76 01316 *P8210-EXIT. EXIT. DTSCS76 01317 DTSCS76 01318 DTSCS76 01319 DTSCS76 01320 ***** DTSCS76 01321 * MACIR901 LABEL REPORT RECORD. DTSCS76 01322 ***** DTSCS76 01323 DTSCS76 01324 P8910-R901-RECORD. DTSCS76 01325 SET R901-ON-REQUEST-88 TO TRUE. DTSCS76 01326 DTSCS76 01327 MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS76 01328 DTSCS76 01329 MOVE L013-CNT TO R901-LABEL-CNT. DTSCS76 01330 DTSCS76 01331 *****SET R901-MAILING-LABEL TO TRUE. DTSCS76 01332 DTSCS76 01333 *** IF WRK-R751-NO-88 DTSCS76 01334 MOVE MAP-RESPONSIBLE-OP-ID TO R901-GRP1-OP-ID DTSCS76 01335 ** ELSE DTSCS76 01336 *** MOVE 'RPT751R1' TO R901-GRP1-OP-ID. DTSCS76 01337 DTSCS76 01338 MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS76 01339 R901-EMP-NO. DTSCS76 01340 DTSCS76 01341 MOVE WRK-MAILING-ADDRESS TO R901-FMT-ADDR. DTSCS76 01342 DTSCS76 01343 MOVE WRK-ZIP TO R901-ZIP. DTSCS76 01344 DTSCS76 01345 *****MOVE WRK-DELIV-POINT TO R901-DELIV-POINT. DTSCS76 01346 DTSCS76 01347 *****MOVE WRK-CHECK-DIGIT TO R901-CHECK-DIGIT. DTSCS76 01348 DTSCS76 01349 MOVE WRK-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE. DTSCS76 01350 DTSCS76 01351 DTSCS76 01352 MOVE LENGTH OF R901-REC TO R901-LENGTH. DTSCS76 01353 DTSCS76 01354 MOVE R901-REC TO RSKL-REC. DTSCS76 01355 DTSCS76 01356 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01357 P8910-EXIT. DTSCS76 01358 EXIT. DTSCS76 01359 DTSCS76 01360 DTSCS76 01361 ***** DTSCS76 01362 * MACIR901 ELF LABEL REPORT RECORD. DTSCS76 01363 ***** DTSCS76 01364 DTSCS76 01365 *P8915-ELF-R901-RECORD. DTSCS76 01366 *****SET R901-ON-REQUEST-88 TO TRUE. DTSCS76 01367 DTSCS76 01368 *****MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS76 01369 DTSCS76 01370 *****MOVE L013-CNT TO R901-LABEL-CNT. DTSCS76 01371 *****MOVE MAP-RESPONSIBLE-OP-ID TO R901-GRP1-OP-ID. DTSCS76 01372 DTSCS76 01373 *****SET R901-ELF-LABEL TO TRUE. DTSCS76 01374 DTSCS76 01375 *****MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS76 01376 ****************************************R901-EMP-NO. DTSCS76 01377 DTSCS76 01378 *****MOVE WRK-ELF-ADDRESS TO R901-FMT-ADDR. DTSCS76 01379 *****MOVE WRK-ELF-ZIP TO R901-ZIP. DTSCS76 01380 *****MOVE WRK-ELF-DELIV-POINT TO R901-DELIV-POINT. DTSCS76 01381 *****MOVE WRK-ELF-CHECK-DIGIT TO R901-CHECK-DIGIT. DTSCS76 01382 DTSCS76 01383 *****MOVE R901-REC TO RSKL-REC. DTSCS76 01384 *****PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01385 *P8915-EXIT. DTSCS76 01386 *****EXIT. DTSCS76 01387 DTSCS76 01388 DTSCS76 01389 DTSCS76 01390 ***** DTSCS76 01391 * CREATE UC-30 TRANSACTION RECORD. DTSCS76 01392 ***** DTSCS76 01393 DTSCS76 01394 P8920-T036-RECORD. DTSCS76 01395 MOVE WRK-EMP-NO TO T036-EMP-NO. DTSCS76 01396 DTSCS76 01397 MOVE LCCM-OP-ID TO T036-OP-ID. DTSCS76 01398 DTSCS76 01399 MOVE WRK-SCR-ID TO T036-SCR-ID. DTSCS76 01400 DTSCS76 01401 MOVE LCCM-TASK-START-DATE TO T036-SYS-DATE. DTSCS76 01402 DTSCS76 01403 MOVE LCCM-TASK-START-TIME TO T036-SYS-TIME. DTSCS76 01404 DTSCS76 01405 SET T036-REQUEST TO TRUE. DTSCS76 01406 DTSCS76 01407 MOVE MAP-RESPONSIBLE-OP-ID TO T036-RESP-OP-ID. DTSCS76 01408 DTSCS76 01409 MOVE MAP-FORCE-PRINT TO T036-FORCE-PRINT-IND. DTSCS76 01410 DTSCS76 01411 MOVE L016-YRQ TO T036-START-YRQ. DTSCS76 01412 DTSCS76 01413 MOVE MAP-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 01414 DTSCS76 01415 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 01416 DTSCS76 01417 IF L016-VALID DTSCS76 01418 MOVE L016-YRQ TO T036-END-YRQ DTSCS76 01419 ELSE DTSCS76 01420 MOVE T036-START-YRQ TO T036-END-YRQ. DTSCS76 01421 DTSCS76 01422 MOVE +0 TO T036-WAIVER-START-YRQ DTSCS76 01423 T036-WAIVER-END-YRQ DTSCS76 01424 T036-WAIVER-EXT-DATE. DTSCS76 01425 DTSCS76 01426 MOVE MAP-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76 01427 DTSCS76 01428 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76 01429 DTSCS76 01430 IF L015-VALID DTSCS76 01431 MOVE WRK-EMP-NO TO T031-EMP-NO DTSCS76 01432 MOVE LCCM-OP-ID TO T031-ORIGIN DTSCS76 01433 MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE DTSCS76 01434 MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME DTSCS76 01435 SET T031-AUTO-PROCESS TO TRUE DTSCS76 01436 MOVE T036-START-YRQ TO T031-START-YRQ DTSCS76 01437 MOVE T036-END-YRQ TO T031-END-YRQ DTSCS76 01438 MOVE T031-START-YRQ TO T031-WAIVER-START-YRQ DTSCS76 01439 MOVE T031-END-YRQ TO T031-WAIVER-END-YRQ DTSCS76 01440 MOVE L015-DATE TO T031-WAIVER-EXT-DATE DTSCS76 01441 SET T031-TRANSFER-NO-88 TO TRUE DTSCS76 01442 MOVE +0 TO T031-TRANSFER-TO-EMP-NO DTSCS76 01443 MOVE LENGTH OF T031-REC TO T031-LENGTH DTSCS76 01444 MOVE T031-REC TO RSKL-REC DTSCS76 01445 PERFORM S825-WRITE THRU S825-EXIT DTSCS76 01446 MOVE T036-START-YRQ TO T036-WAIVER-START-YRQ DTSCS76 01447 MOVE T036-END-YRQ TO T036-WAIVER-END-YRQ DTSCS76 01448 MOVE L015-DATE TO T036-WAIVER-EXT-DATE. DTSCS76 01449 DTSCS76 01450 DTSCS76 01451 MOVE MAP-ADDR-TYPE TO T036-ADDR-TYPE. DTSCS76 01452 DTSCS76 01453 *****MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76 01454 DTSCS76 01455 *****PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS76 01456 DTSCS76 01457 *****MOVE L013-CNT TO T036-ADDR-NO. DTSCS76 01458 DTSCS76 01459 *****SET T036-5E-REQ-NO-88 TO TRUE. DTSCS76 01460 DTSCS76 01461 MOVE +0 TO T036-ADDR-ESTB-ABSTIME. DTSCS76 01462 DTSCS76 01463 IF MAP-ADDR-OPO-88 OR MAP-ADDR-TAX-ALT-88 DTSCS76 01464 NEXT SENTENCE DTSCS76 01465 ELSE DTSCS76 01466 MOVE LENGTH OF T036-REC TO T036-LENGTH DTSCS76 01467 MOVE T036-REC TO RSKL-REC DTSCS76 01468 PERFORM S825-WRITE THRU S825-EXIT DTSCS76 01469 GO TO P8920-EXIT. DTSCS76 01470 DTSCS76 01471 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76 01472 DTSCS76 01473 PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS76 01474 DTSCS76 01475 IF L013-VALID DTSCS76 01476 NEXT SENTENCE DTSCS76 01477 ELSE DTSCS76 01478 GO TO P8920-EXIT. DTSCS76 01479 DTSCS76 01480 IF MAP-ADDR-OPO-88 DTSCS76 01481 PERFORM P8921-OPO-ESTB-ABSTIME THRU P8921-EXIT DTSCS76 01482 ELSE DTSCS76 01483 PERFORM P8922-TAA-ESTB-ABSTIME THRU P8922-EXIT. DTSCS76 01484 DTSCS76 01485 DTSCS76 01486 MOVE LENGTH OF T036-REC TO T036-LENGTH. DTSCS76 01487 DTSCS76 01488 MOVE T036-REC TO RSKL-REC. DTSCS76 01489 DTSCS76 01490 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01491 P8920-EXIT. DTSCS76 01492 EXIT. DTSCS76 01493 DTSCS76 01494 DTSCS76 01495 DTSCS76 01496 P8921-OPO-ESTB-ABSTIME. DTSCS76 01497 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCS76 01498 DTSCS76 01499 MOVE WRK-EMP-NO TO MOPO-EMP-NO. DTSCS76 01500 DTSCS76 01501 SET MOPO-OPO-88 TO TRUE. DTSCS76 01502 DTSCS76 01503 MOVE L013-CNT TO MOPO-ID-NO. DTSCS76 01504 DTSCS76 01505 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 01506 DTSCS76 01507 PERFORM S810-READ THRU S810-EXIT. DTSCS76 01508 DTSCS76 01509 IF L810-OK-88 DTSCS76 01510 MOVE MSKL-REC TO MOPO-REC DTSCS76 01511 MOVE MOPO-ESTB-ABSTIME TO T036-ADDR-ESTB-ABSTIME. DTSCS76 01512 P8921-EXIT. DTSCS76 01513 EXIT. DTSCS76 01514 DTSCS76 01515 DTSCS76 01516 DTSCS76 01517 P8922-TAA-ESTB-ABSTIME. DTSCS76 01518 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSCS76 01519 DTSCS76 01520 MOVE WRK-EMP-NO TO MTAA-EMP-NO. DTSCS76 01521 DTSCS76 01522 SET MTAA-TAA-88 TO TRUE. DTSCS76 01523 DTSCS76 01524 MOVE L013-CNT TO MTAA-ID-NO. DTSCS76 01525 DTSCS76 01526 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 01527 DTSCS76 01528 PERFORM S810-READ THRU S810-EXIT. DTSCS76 01529 DTSCS76 01530 IF L810-OK-88 DTSCS76 01531 MOVE MSKL-REC TO MTAA-REC DTSCS76 01532 MOVE MTAA-ESTB-ABSTIME TO T036-ADDR-ESTB-ABSTIME. DTSCS76 01533 P8922-EXIT. DTSCS76 01534 EXIT. DTSCS76 01535 DTSCS76 01536 DTSCS76 01537 DTSCS76 01538 ***** DTSCS76 01539 * CREATE UI-5E TRANSACTION RECORD. DTSCS76 01540 ***** DTSCS76 01541 DTSCS76 01542 *P8925-5E-T036-RECORD. DTSCS76 01543 *****MOVE WRK-EMP-NO TO T036-EMP-NO. DTSCS76 01544 *****MOVE LCCM-OP-ID TO T036-OP-ID. DTSCS76 01545 *****MOVE WRK-SCR-ID TO T036-SCR-ID. DTSCS76 01546 *****MOVE LCCM-TASK-START-DATE TO T036-SYS-DATE. DTSCS76 01547 *****MOVE LCCM-TASK-START-TIME TO T036-SYS-TIME. DTSCS76 01548 DTSCS76 01549 *****SET T036-REQUEST TO TRUE. DTSCS76 01550 DTSCS76 01551 *****MOVE MAP-RESPONSIBLE-OP-ID TO T036-RESP-OP-ID. DTSCS76 01552 *****MOVE MAP-5E-FORCE-PRINT TO T036-FORCE-PRINT-IND DTSCS76 01553 DTSCS76 01554 *****MOVE L016-YRQ TO T036-START-YRQ. DTSCS76 01555 DTSCS76 01556 *****MOVE MAP-5E-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 01557 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 01558 DTSCS76 01559 *****IF L016-VALID DTSCS76 01560 ********MOVE L016-YRQ TO T036-END-YRQ DTSCS76 01561 *****ELSE DTSCS76 01562 ********MOVE T036-START-YRQ TO T036-END-YRQ DTSCS76 01563 *****END-IF. DTSCS76 01564 DTSCS76 01565 *****MOVE +0 TO T036-WAIVE-START-YRQ DTSCS76 01566 ****************************************T036-WAIVE-END-YRQ DTSCS76 01567 ****************************************T036-WAIVE-EXT-DATE. DTSCS76 01568 DTSCS76 01569 *****MOVE MAP-5E-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76 01570 *****PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76 01571 *****IF L015-VALID DTSCS76 01572 *********MOVE WRK-EMP-NO TO T031-EMP-NO DTSCS76 01573 *********MOVE LCCM-OP-ID TO T031-ORIGIN DTSCS76 01574 *********MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE DTSCS76 01575 *********MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME DTSCS76 01576 *********SET T031-AUTO-PROCESS TO TRUE DTSCS76 01577 *********MOVE T036-START-YRQ TO T031-START-YRQ DTSCS76 01578 *********MOVE T036-END-YRQ TO T031-END-YRQ DTSCS76 01579 *********MOVE T031-START-YRQ TO T031-WAIVE-START-YRQ DTSCS76 01580 *********MOVE T031-END-YRQ TO T031-WAIVE-END-YRQ DTSCS76 01581 *********MOVE L015-DATE TO T031-WAIVE-EXT-DATE DTSCS76 01582 *********SET T031-TRANSFER-NO-88 TO TRUE DTSCS76 01583 *********MOVE +0 TO T031-TRANSFER-TO-EMP-NO DTSCS76 01584 *********MOVE T031-REC TO RSKL-REC DTSCS76 01585 *********PERFORM S825-WRITE THRU S825-EXIT DTSCS76 01586 *********MOVE T036-START-YRQ TO T036-WAIVE-START-YRQ DTSCS76 01587 *********MOVE T036-END-YRQ TO T036-WAIVE-END-YRQ DTSCS76 01588 *********MOVE L015-DATE TO T036-WAIVE-EXT-DATE. DTSCS76 01589 DTSCS76 01590 *****MOVE MAP-ADDR-TYPE TO T036-ADDR-TYPE. DTSCS76 01591 DTSCS76 01592 *****MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76 01593 DTSCS76 01594 *****PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS76 01595 DTSCS76 01596 *****MOVE L013-CNT TO T036-ADDR-NO. DTSCS76 01597 DTSCS76 01598 *****SET T036-5E-REQ-YES-88 TO TRUE. DTSCS76 01599 DTSCS76 01600 *****MOVE T036-REC TO RSKL-REC. DTSCS76 01601 *****PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01602 *P8925-EXIT. DTSCS76 01603 *****EXIT. DTSCS76 01604 DTSCS76 01605 DTSCS76 01606 DTSCS76 01607 ***** DTSCS76 01608 * MACIR111 EMPLOYER REGISTRATION NOTIFICATION OF DTSCS76 01609 * COVERAGE REPORT RECORD. DTSCS76 01610 ***** DTSCS76 01611 DTSCS76 01612 *P8930-R111-RECORDS. DTSCS76 01613 *****MOVE MAP-RESPONSIBLE-OP-ID TO R111-OP-ID. DTSCS76 01614 *****MOVE WRK-EMP-NO TO R111-EMP-NO. DTSCS76 01615 DTSCS76 01616 *****MOVE WRK-MAILING-ADDRESS TO R111-FMT-ADDR. DTSCS76 01617 *****MOVE WRK-ZIP TO R111-ZIP. DTSCS76 01618 *****MOVE WRK-DELIV-POINT TO R111-DELIV-POINT. DTSCS76 01619 *****MOVE WRK-CHECK-DIGIT TO R111-CHECK-DIGIT. DTSCS76 01620 DTSCS76 01621 *****MOVE R111-REC TO RSKL-REC. DTSCS76 01622 *****PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01623 *P8930-EXIT. DTSCS76 01624 *****EXIT. DTSCS76 01625 DTSCS76 01626 DTSCS76 01627 DTSCS76 01628 ***** DTSCS76 01629 * MACIR112 EMPLOYER REGISTRATION NOTICE OF SUBJECTIVITY DTSCS76 01630 * (UI-47) REPORT RECORD. DTSCS76 01631 ***** DTSCS76 01632 DTSCS76 01633 P8940-R112-RECORD. DTSCS76 01634 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSCS76 01635 DTSCS76 01636 MOVE WRK-EMP-NO TO MSOL-EMP-NO. DTSCS76 01637 DTSCS76 01638 SET MSOL-SOL-88 TO TRUE. DTSCS76 01639 DTSCS76 01640 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 01641 DTSCS76 01642 PERFORM S810-COUNT THRU S810-EXIT. DTSCS76 01643 DTSCS76 01644 IF L810-RECORD-CNT = 0 DTSCS76 01645 GO TO P8940-EXIT. DTSCS76 01646 DTSCS76 01647 DTSCS76 01648 PERFORM S810-READ THRU S810-EXIT. DTSCS76 01649 DTSCS76 01650 MOVE MSKL-REC TO MSOL-REC. DTSCS76 01651 DTSCS76 01652 DTSCS76 01653 INITIALIZE R112-DATA-AREA. DTSCS76 01654 DTSCS76 01655 DTSCS76 01656 MOVE MAP-RESPONSIBLE-OP-ID TO R112-OP-ID. DTSCS76 01657 DTSCS76 01658 MOVE WRK-EMP-NO TO R112-EMP-NO. DTSCS76 01659 DTSCS76 01660 MOVE LCCM-CURR-RUN-DATE TO R112-RUN-DATE. DTSCS76 01661 DTSCS76 01662 MOVE WRK-MAILING-ADDRESS TO R112-FMT-ADDR. DTSCS76 01663 DTSCS76 01664 MOVE WRK-ZIP TO R112-ZIP. DTSCS76 01665 DTSCS76 01666 *****MOVE WRK-DELIV-POINT TO R112-DELIV-POINT. DTSCS76 01667 DTSCS76 01668 *****MOVE WRK-CHECK-DIGIT TO R112-CHECK-DIGIT. DTSCS76 01669 DTSCS76 01670 MOVE WRK-ADVANCED-BARCODE TO R112-ADVANCED-BARCODE. DTSCS76 01671 DTSCS76 01672 MOVE MSOL-FIRST-LIAB-YRQ TO R112-FIRST-LIAB-YRQ. DTSCS76 01673 DTSCS76 01674 MOVE MSOL-LAST-LIAB-YRQ TO R112-LAST-LIAB-YRQ. DTSCS76 01675 DTSCS76 01676 MOVE MPRF-EMP-CLASS TO R112-EMP-CLASS. DTSCS76 01677 DTSCS76 01678 *****MOVE MPRF-SIC-DIVISION TO R112-SIC-DIVISION. DTSCS76 01679 DTSCS76 01680 IF MPRF-CLASS-RATED-88 DTSCS76 01681 MOVE LCCM-LAST-RATE-END-YRQ TO R112-LAST-RATE-END-YRQ. DTSCS76 01682 DTSCS76 01683 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS76 01684 DTSCS76 01685 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS76 01686 DTSCS76 01687 SET MSKL-RTE-88 TO TRUE. DTSCS76 01688 DTSCS76 01689 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76 01690 DTSCS76 01691 MOVE +0 TO WRK-RATE-CTR. DTSCS76 01692 DTSCS76 01693 PERFORM P8941-RATE-AREA THRU P8941-EXIT DTSCS76 01694 UNTIL L810-NO-REC-88. DTSCS76 01695 DTSCS76 01696 MOVE WRK-RATE-CTR TO R112-RATE-CNT. DTSCS76 01697 DTSCS76 01698 MOVE LENGTH OF R112-REC TO R112-LENGTH. DTSCS76 01699 DTSCS76 01700 MOVE R112-REC TO RSKL-REC. DTSCS76 01701 DTSCS76 01702 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01703 P8940-EXIT. DTSCS76 01704 EXIT. DTSCS76 01705 DTSCS76 01706 DTSCS76 01707 DTSCS76 01708 P8941-RATE-AREA. DTSCS76 01709 ADD +1 TO WRK-RATE-CTR. DTSCS76 01710 DTSCS76 01711 IF WRK-RATE-CTR > +6 DTSCS76 01712 MOVE R112-RATE-AREA (2) TO R112-RATE-AREA (1) DTSCS76 01713 MOVE R112-RATE-AREA (3) TO R112-RATE-AREA (2) DTSCS76 01714 MOVE R112-RATE-AREA (4) TO R112-RATE-AREA (3) DTSCS76 01715 MOVE R112-RATE-AREA (5) TO R112-RATE-AREA (4) DTSCS76 01716 MOVE R112-RATE-AREA (6) TO R112-RATE-AREA (5) DTSCS76 01717 MOVE +6 TO WRK-RATE-CTR. DTSCS76 01718 DTSCS76 01719 DTSCS76 01720 MOVE MSKL-REC TO MRTE-REC. DTSCS76 01721 DTSCS76 01722 DTSCS76 01723 MOVE MRTE-EFF-YRQ TO R112-RATE-EFF-YRQ (WRK-RATE-CTR). DTSCS76 01724 DTSCS76 01725 MOVE MRTE-END-YRQ TO R112-RATE-END-YRQ (WRK-RATE-CTR). DTSCS76 01726 DTSCS76 01727 *****MOVE MRTE-UI-RATE-TYPE TO R112-UI-RATE-TYPE (WRK-RATE-CTR). DTSCS76 01728 DTSCS76 01729 MOVE MRTE-UI-RATE TO R112-UI-RATE (WRK-RATE-CTR). DTSCS76 01730 DTSCS76 01731 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS76 01732 P8941-EXIT. DTSCS76 01733 EXIT. DTSCS76 01734 DTSCS76 01735 DTSCS76 01736 DTSCS76 01737 ***** DTSCS76 01738 * MACIR903 REQUEST FOR FEDERAL ID (UI-15) REPORT RECORDS. DTSCS76 01739 ***** DTSCS76 01740 DTSCS76 01741 P8950-R903-RECORD. DTSCS76 01742 MOVE MAP-RESPONSIBLE-OP-ID TO R903-OP-ID. DTSCS76 01743 DTSCS76 01744 MOVE WRK-EMP-NO TO R903-EMP-NO. DTSCS76 01745 DTSCS76 01746 MOVE LCCM-CURR-MAIL-DATE TO R903-MAIL-DATE. DTSCS76 01747 DTSCS76 01748 MOVE WRK-MAILING-ADDRESS TO R903-FMT-ADDR. DTSCS76 01749 DTSCS76 01750 MOVE WRK-ZIP TO R903-ZIP. DTSCS76 01751 DTSCS76 01752 *****MOVE WRK-DELIV-POINT TO R903-DELIV-POINT. DTSCS76 01753 DTSCS76 01754 *****MOVE WRK-CHECK-DIGIT TO R903-CHECK-DIGIT. DTSCS76 01755 DTSCS76 01756 MOVE WRK-ADVANCED-BARCODE TO R903-ADVANCED-BARCODE. DTSCS76 01757 DTSCS76 01758 MOVE LENGTH OF R903-REC TO R903-LENGTH. DTSCS76 01759 DTSCS76 01760 MOVE R903-REC TO RSKL-REC. DTSCS76 01761 DTSCS76 01762 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01763 P8950-EXIT. DTSCS76 01764 EXIT. DTSCS76 01765 DTSCS76 01766 DTSCS76 01767 DTSCS76 01768 P8960-R432-RECORD. DTSCS76 01769 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS76 01770 DTSCS76 01771 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS76 01772 DTSCS76 01773 SET MQTR-QTR-88 TO TRUE. DTSCS76 01774 DTSCS76 01775 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 01776 DTSCS76 01777 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76 01778 DTSCS76 01779 PERFORM P8961-PROCESS-EACH-MQTR THRU P8961-EXIT DTSCS76 01780 UNTIL L810-NO-REC-88. DTSCS76 01781 P8960-EXIT. DTSCS76 01782 EXIT. DTSCS76 01783 DTSCS76 01784 DTSCS76 01785 DTSCS76 01786 P8961-PROCESS-EACH-MQTR. DTSCS76 01787 MOVE MSKL-REC TO MQTR-REC. DTSCS76 01788 DTSCS76 01789 MOVE 'N' TO BALANCE-DUE-IND. DTSCS76 01790 DTSCS76 01791 PERFORM DTSCS76 01792 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS76 01793 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS76 01794 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSCS76 01795 MOVE 'Y' TO BALANCE-DUE-IND DTSCS76 01796 END-IF DTSCS76 01797 END-PERFORM. DTSCS76 01798 DTSCS76 01799 IF BALANCE-DUE-IND = 'N' DTSCS76 01800 NEXT SENTENCE DTSCS76 01801 ELSE DTSCS76 01802 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76 01803 PERFORM P8965-READ-MRPT THRU P8965-EXIT DTSCS76 01804 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSCS76 01805 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS76 01806 IF L810-NO-REC-88 DTSCS76 01807 GO TO P8961-EXIT. DTSCS76 01808 DTSCS76 01809 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS76 01810 P8961-EXIT. DTSCS76 01811 EXIT. DTSCS76 01812 DTSCS76 01813 DTSCS76 01814 DTSCS76 01815 P8965-READ-MRPT. DTSCS76 01816 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSCS76 01817 DTSCS76 01818 MOVE MQTR-EMP-NO TO MRPT-EMP-NO. DTSCS76 01819 DTSCS76 01820 SET MRPT-RPT-88 TO TRUE. DTSCS76 01821 DTSCS76 01822 MOVE MQTR-YRQ TO MRPT-YRQ. DTSCS76 01823 DTSCS76 01824 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 01825 DTSCS76 01826 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76 01827 DTSCS76 01828 PERFORM DTSCS76 01829 UNTIL L810-NO-REC-88 DTSCS76 01830 MOVE MSKL-REC TO MRPT-REC DTSCS76 01831 IF MRPT-YRQ NOT = MQTR-YRQ DTSCS76 01832 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76 01833 SET L810-NO-REC-88 TO TRUE DTSCS76 01834 ELSE DTSCS76 01835 PERFORM P8966-R432 THRU P8966-EXIT DTSCS76 01836 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS76 01837 END-IF DTSCS76 01838 END-PERFORM. DTSCS76 01839 P8965-EXIT. DTSCS76 01840 EXIT. DTSCS76 01841 DTSCS76 01842 DTSCS76 01843 DTSCS76 01844 ***** DTSCS76 01845 * MACIR432 ACCOUNTS RECEIVABLE AUDIT TRAIL REPORT RECORD. DTSCS76 01846 ***** DTSCS76 01847 DTSCS76 01848 P8966-R432. DTSCS76 01849 MOVE MRPT-BATCH-NO TO R432-BATCH-NO. DTSCS76 01850 DTSCS76 01851 MOVE MRPT-ITEM-NO TO R432-ITEM-NO. DTSCS76 01852 DTSCS76 01853 MOVE MRPT-EMP-NO TO R432-EMP-NO. DTSCS76 01854 DTSCS76 01855 MOVE MRPT-YRQ TO R432-YRQ. DTSCS76 01856 DTSCS76 01857 MOVE MRPT-RPT-TYPE TO R432-RPT-TYPE. DTSCS76 01858 DTSCS76 01859 MOVE LENGTH OF R432-REC TO R432-LENGTH. DTSCS76 01860 DTSCS76 01861 MOVE R432-REC TO RSKL-REC. DTSCS76 01862 DTSCS76 01863 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01864 P8966-EXIT. DTSCS76 01865 EXIT. DTSCS76 01866 DTSCS76 01867 DTSCS76 01868 P8970-T011-RECORD. DTSCS76 01869 MOVE WRK-EMP-NO TO T011-EMP-NO. DTSCS76 01870 DTSCS76 01871 MOVE LCCM-OP-ID TO T011-OP-ID DTSCS76 01872 T011-RESP-OP-ID. DTSCS76 01873 DTSCS76 01874 MOVE WRK-SCR-ID TO T011-SCR-ID. DTSCS76 01875 DTSCS76 01876 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE. DTSCS76 01877 DTSCS76 01878 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME. DTSCS76 01879 DTSCS76 01880 SET T011-STMT-OF-ACCT TO TRUE. DTSCS76 01881 DTSCS76 01882 MOVE L016-YRQ TO T011-START-YRQ. DTSCS76 01883 DTSCS76 01884 MOVE MAP-STMT-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 01885 DTSCS76 01886 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 01887 DTSCS76 01888 IF L016-VALID DTSCS76 01889 MOVE L016-YRQ TO T011-END-YRQ DTSCS76 01890 ELSE DTSCS76 01891 MOVE T011-START-YRQ TO T011-END-YRQ. DTSCS76 01892 DTSCS76 01893 MOVE LENGTH OF T011-REC TO T011-LENGTH DTSCS76 01894 MOVE +0 TO T011-ESTB-ABSTIME. DTSCS76 01895 MOVE LCCM-TASK-START-ABSTIME TO T011-ESTB-ABSTIME. DTSCS76 01896 MOVE T011-REC TO RSKL-REC DTSCS76 01897 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01898 DTSCS76 01899 DTSCS76 01900 P8970-EXIT. DTSCS76 01901 EXIT. DTSCS76 01902 DTSCS76 01903 DTSCS76 01904 DTSCS76 01905 P8980-R751-RECORD. DTSCS76 01906 MOVE WRK-EMP-NO TO R751-EMP-NO. DTSCS76 01907 MOVE MPRF-PRIMARY-NAME TO R751-EMP-PRIMARY-NAME. DTSCS76 01908 DTSCS76 01909 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS76 01910 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS76 01911 MOVE L020-SSN TO R751-SSN. DTSCS76 01912 DTSCS76 01913 MOVE MAP-CLAIMANT-NAME TO R751-CLAIMANT-NAME. DTSCS76 01914 DTSCS76 01915 MOVE LCCM-CURR-MAIL-DATE TO R751-MAIL-DATE. DTSCS76 01916 DTSCS76 01917 MOVE LENGTH OF R751-REC TO R751-LENGTH. DTSCS76 01918 DTSCS76 01919 IF MAP-WR-YRQ1-YR GREATER SPACES DTSCS76 01920 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA DTSCS76 01921 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 01922 MOVE L016-YRQ TO R751-YRQ DTSCS76 01923 MOVE R751-REC TO RSKL-REC DTSCS76 01924 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01925 DTSCS76 01926 IF MAP-WR-YRQ2-YR GREATER SPACES DTSCS76 01927 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS76 01928 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 01929 MOVE L016-YRQ TO R751-YRQ DTSCS76 01930 MOVE R751-REC TO RSKL-REC DTSCS76 01931 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01932 DTSCS76 01933 IF MAP-WR-YRQ3-YR GREATER SPACES DTSCS76 01934 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS76 01935 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 01936 MOVE L016-YRQ TO R751-YRQ DTSCS76 01937 MOVE R751-REC TO RSKL-REC DTSCS76 01938 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01939 DTSCS76 01940 IF MAP-WR-YRQ4-YR GREATER SPACES DTSCS76 01941 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS76 01942 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 01943 MOVE L016-YRQ TO R751-YRQ DTSCS76 01944 MOVE R751-REC TO RSKL-REC DTSCS76 01945 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76 01946 DTSCS76 01947 P8980-EXIT. DTSCS76 01948 EXIT. DTSCS76 01949 /*****************************************************************DTSCS76 01950 * LINKS TO UTILITY MODULES DTSCS76 01951 ******************************************************************DTSCS76 01952 DTSCS76 01953 S001-FROM-FED-8. DTSCS76 01954 SET L001-FROM-FED-8 TO TRUE. DTSCS76 01955 GO TO S001-LINK. DTSCS76 01956 DTSCS76 01957 S001-FROM-ABS-DAY. DTSCS76 01958 SET L001-FROM-ABS-DAY TO TRUE. DTSCS76 01959 GO TO S001-LINK. DTSCS76 01960 DTSCS76 01961 S001-LINK. DTSCS76 01962 EXEC CICS LINK DTSCS76 01963 PROGRAM ('DTSCU001') DTSCS76 01964 COMMAREA (L001-COMM-AREA) DTSCS76 01965 END-EXEC. DTSCS76 01966 S001-EXIT. DTSCS76 01967 EXIT. DTSCS76 01968 DTSCS76 01969 DTSCS76 01970 DTSCS76 01971 S004-FROM-5. DTSCS76 01972 SET L004-FROM-5 TO TRUE. DTSCS76 01973 GO TO S004-LINK. DTSCS76 01974 DTSCS76 01975 S004-FROM-DATE. DTSCS76 01976 SET L004-FROM-DATE TO TRUE. DTSCS76 01977 GO TO S004-LINK. DTSCS76 01978 DTSCS76 01979 S004-FROM-ABS. DTSCS76 01980 SET L004-FROM-ABS TO TRUE. DTSCS76 01981 GO TO S004-LINK. DTSCS76 01982 DTSCS76 01983 S004-LINK. DTSCS76 01984 EXEC CICS LINK DTSCS76 01985 PROGRAM ('DTSCU004') DTSCS76 01986 COMMAREA (L004-COMM-AREA) DTSCS76 01987 END-EXEC. DTSCS76 01988 S004-EXIT. DTSCS76 01989 EXIT. DTSCS76 01990 DTSCS76 01991 DTSCS76 01992 DTSCS76 01993 S006-LINK. DTSCS76 01994 EXEC CICS LINK DTSCS76 01995 PROGRAM ('DTSCU006') DTSCS76 01996 COMMAREA (L006-COMM-AREA) DTSCS76 01997 END-EXEC. DTSCS76 01998 S006-EXIT. DTSCS76 01999 EXIT. DTSCS76 02000 DTSCS76 02001 DTSCS76 02002 DTSCS76 02003 S013-ADDR-NUM. DTSCS76 02004 MOVE +1 TO L013-MIN-CNT. DTSCS76 02005 MOVE +999 TO L013-MAX-CNT. DTSCS76 02006 GO TO S013-COUNT-FROM-SCREEN. DTSCS76 02007 DTSCS76 02008 S013-COPY-CNT. DTSCS76 02009 MOVE +1 TO L013-MIN-CNT. DTSCS76 02010 MOVE +99 TO L013-MAX-CNT. DTSCS76 02011 GO TO S013-COUNT-FROM-SCREEN. DTSCS76 02012 DTSCS76 02013 S013-COUNT-FROM-SCREEN. DTSCS76 02014 EXEC CICS LINK DTSCS76 02015 PROGRAM('DTSCU013') DTSCS76 02016 COMMAREA(L013-COMM-AREA) DTSCS76 02017 END-EXEC. DTSCS76 02018 S013-EXIT. DTSCS76 02019 EXIT. DTSCS76 02020 DTSCS76 02021 DTSCS76 02022 DTSCS76 02023 S015-DATE-FROM-SCREEN. DTSCS76 02024 EXEC CICS LINK DTSCS76 02025 PROGRAM('DTSCU015') DTSCS76 02026 COMMAREA(L015-COMM-AREA) DTSCS76 02027 END-EXEC. DTSCS76 02028 S015-EXIT. DTSCS76 02029 EXIT. DTSCS76 02030 DTSCS76 02031 DTSCS76 02032 DTSCS76 02033 S016-YRQ-FROM-SCREEN. DTSCS76 02034 EXEC CICS LINK DTSCS76 02035 PROGRAM('DTSCU016') DTSCS76 02036 COMMAREA(L016-COMM-AREA) DTSCS76 02037 END-EXEC. DTSCS76 02038 S016-EXIT. DTSCS76 02039 EXIT. DTSCS76 02040 DTSCS76 02041 DTSCS76 02042 DTSCS76 02043 S018-EMP-NO-FROM-SCREEN. DTSCS76 02044 EXEC CICS LINK DTSCS76 02045 PROGRAM('DTSCU018') DTSCS76 02046 COMMAREA(L018-COMM-AREA) DTSCS76 02047 END-EXEC. DTSCS76 02048 S018-EXIT. DTSCS76 02049 EXIT. DTSCS76 02050 DTSCS76 02051 DTSCS76 02052 S020-SCREEN-SSN. DTSCS76 02053 EXEC CICS LINK DTSCS76 02054 PROGRAM ('DTSCU020') DTSCS76 02055 COMMAREA (L020-COMM-AREA) DTSCS76 02056 END-EXEC. DTSCS76 02057 S020-EXIT. DTSCS76 02058 EXIT. DTSCS76 02059 DTSCS76 02060 DTSCS76 02061 S081-CLAIMANT-NAME-LOOKUP. DTSCS76 02062 EXEC CICS LINK DTSCS76 02063 PROGRAM('DTSCU081') DTSCS76 02064 COMMAREA(L081-COMM-AREA) DTSCS76 02065 END-EXEC. DTSCS76 02066 DTSCS76 02067 IF L081-FILE-CLOSED DTSCS76 02068 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02069 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76 02070 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76 02071 GO TO MAINLINE-EXIT. DTSCS76 02072 S081-EXIT. DTSCS76 02073 EXIT. DTSCS76 02074 SKIP3 DTSCS76 02075 DTSCS76 02076 S082-OP-ID-LOOKUP. DTSCS76 02077 EXEC CICS LINK DTSCS76 02078 PROGRAM('DTSCU082') DTSCS76 02079 COMMAREA(L082-COMM-AREA) DTSCS76 02080 END-EXEC. DTSCS76 02081 DTSCS76 02082 IF L082-FILE-CLOSED DTSCS76 02083 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02084 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76 02085 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76 02086 GO TO MAINLINE-EXIT. DTSCS76 02087 S082-EXIT. DTSCS76 02088 EXIT. DTSCS76 02089 DTSCS76 02090 DTSCS76 02091 DTSCS76 02092 S111-ADDR-LOOKUP. DTSCS76 02093 EXEC CICS LINK DTSCS76 02094 PROGRAM('DTSCU111') DTSCS76 02095 COMMAREA(L111-COMM-AREA) DTSCS76 02096 END-EXEC. DTSCS76 02097 DTSCS76 02098 IF L111-FILE-CLOSED-88 DTSCS76 02099 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02100 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76 02101 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76 02102 GO TO MAINLINE-EXIT. DTSCS76 02103 S111-EXIT. DTSCS76 02104 EXIT. DTSCS76 02105 DTSCS76 02106 DTSCS76 02107 DTSCS76 02108 S112-ADDR-FORMAT. DTSCS76 02109 EXEC CICS LINK DTSCS76 02110 PROGRAM('DTSCU112') DTSCS76 02111 COMMAREA(L112-COMM-AREA) DTSCS76 02112 END-EXEC. DTSCS76 02113 S112-EXIT. DTSCS76 02114 EXIT. DTSCS76 02115 DTSCS76 02116 DTSCS76 02117 DTSCS76 02118 S381-DETERM-LIABILITY. DTSCS76 02119 EXEC CICS LINK DTSCS76 02120 PROGRAM ('DTSCU381') DTSCS76 02121 COMMAREA (L381-COMM-AREA) DTSCS76 02122 END-EXEC. DTSCS76 02123 DTSCS76 02124 IF L381-FILE-CLOSED-88 DTSCS76 02125 MOVE L381-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02126 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76 02127 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76 02128 GO TO MAINLINE-EXIT. DTSCS76 02129 DTSCS76 02130 S381-EXIT. DTSCS76 02131 EXIT. DTSCS76 02132 DTSCS76 02133 S410-FILING-SCHEDULE. DTSCS76 02134 DTSCS76 02135 EXEC CICS LINK DTSCS76 02136 PROGRAM('DTSCU410') DTSCS76 02137 COMMAREA(L410-COMM-AREA) DTSCS76 02138 END-EXEC. DTSCS76 02139 DTSCS76 02140 S410-EXIT. DTSCS76 02141 EXIT. DTSCS76 02142 DTSCS76 02143 S415-HOUSEHOLD-DATES. DTSCS76 02144 DTSCS76 02145 EXEC CICS LINK DTSCS76 02146 PROGRAM('DTSCU415') DTSCS76 02147 COMMAREA(L415-COMM-AREA) DTSCS76 02148 END-EXEC. DTSCS76 02149 DTSCS76 02150 S415-EXIT. DTSCS76 02151 EXIT. DTSCS76 02152 DTSCS76 02153 S803-REQ-SCR-ID-EDIT. DTSCS76 02154 EXEC CICS LINK DTSCS76 02155 PROGRAM ('DTSCU803') DTSCS76 02156 COMMAREA (DFHCOMMAREA) DTSCS76 02157 END-EXEC. DTSCS76 02158 S803-EXIT. DTSCS76 02159 EXIT. DTSCS76 02160 DTSCS76 02161 DTSCS76 02162 DTSCS76 02163 S804-INVALID-KEY. DTSCS76 02164 EXEC CICS LINK DTSCS76 02165 PROGRAM ('DTSCU804') DTSCS76 02166 COMMAREA (DFHCOMMAREA) DTSCS76 02167 END-EXEC. DTSCS76 02168 S804-EXIT. DTSCS76 02169 EXIT. DTSCS76 02170 DTSCS76 02171 DTSCS76 02172 DTSCS76 02173 S805-MSG-AREA. DTSCS76 02174 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS76 02175 DTSCS76 02176 EXEC CICS LINK DTSCS76 02177 PROGRAM ('DTSCU805') DTSCS76 02178 COMMAREA (L805-COMM-AREA) DTSCS76 02179 END-EXEC. DTSCS76 02180 DTSCS76 02181 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS76 02182 S805-EXIT. DTSCS76 02183 EXIT. DTSCS76 02184 DTSCS76 02185 DTSCS76 02186 DTSCS76 02187 S810-READ. DTSCS76 02188 SET L810-READ-88 TO TRUE. DTSCS76 02189 GO TO S810-IO. DTSCS76 02190 DTSCS76 02191 S810-START-BROWSE. DTSCS76 02192 SET L810-START-BROWSE-88 TO TRUE. DTSCS76 02193 GO TO S810-IO. DTSCS76 02194 DTSCS76 02195 S810-READ-NEXT. DTSCS76 02196 SET L810-READ-NEXT-88 TO TRUE. DTSCS76 02197 GO TO S810-IO. DTSCS76 02198 DTSCS76 02199 S810-READ-PREV. DTSCS76 02200 SET L810-READ-PREV-88 TO TRUE. DTSCS76 02201 GO TO S810-IO. DTSCS76 02202 DTSCS76 02203 S810-END-BROWSE. DTSCS76 02204 SET L810-END-BROWSE-88 TO TRUE. DTSCS76 02205 GO TO S810-IO. DTSCS76 02206 DTSCS76 02207 S810-COUNT. DTSCS76 02208 SET L810-COUNT-88 TO TRUE. DTSCS76 02209 GO TO S810-IO. DTSCS76 02210 DTSCS76 02211 *S810-REWRITE. DTSCS76 02212 *****SET L810-REWRITE-88 TO TRUE. DTSCS76 02213 *****GO TO S810-IO. DTSCS76 02214 ***** DTSCS76 02215 *S810-WRITE. DTSCS76 02216 *****SET L810-WRITE-88 TO TRUE. DTSCS76 02217 *****GO TO S810-IO. DTSCS76 02218 ***** DTSCS76 02219 *S810-DELETE. DTSCS76 02220 *****SET L810-DELETE-88 TO TRUE. DTSCS76 02221 *****GO TO S810-IO. DTSCS76 02222 DTSCS76 02223 S810-IO. DTSCS76 02224 DTSCS76 02225 EXEC CICS LINK DTSCS76 02226 PROGRAM ('DTSCU810') DTSCS76 02227 COMMAREA (L810-COMM-AREA) DTSCS76 02228 END-EXEC. DTSCS76 02229 DTSCS76 02230 IF L810-FILE-CLOSED-88 DTSCS76 02231 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02232 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76 02233 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76 02234 GO TO MAINLINE-EXIT. DTSCS76 02235 DTSCS76 02236 S810-EXIT. DTSCS76 02237 EXIT. DTSCS76 02238 DTSCS76 02239 DTSCS76 02240 DTSCS76 02241 S825-WRITE. DTSCS76 02242 SET L825-WRITE-88 TO TRUE. DTSCS76 02243 GO TO S825-O. DTSCS76 02244 DTSCS76 02245 S825-O. DTSCS76 02246 DTSCS76 02247 EXEC CICS LINK DTSCS76 02248 PROGRAM ('DTSCU825') DTSCS76 02249 COMMAREA (L825-COMM-AREA) DTSCS76 02250 END-EXEC. DTSCS76 02251 DTSCS76 02252 IF L825-FILE-CLOSED-88 DTSCS76 02253 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02254 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76 02255 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76 02256 GO TO MAINLINE-EXIT. DTSCS76 02257 S825-EXIT. DTSCS76 02258 EXIT. DTSCS76 02259 DTSCS76 02260 DTSCS76 02261 DTSCS76 02262 S851-SCREEN-PROCESSING. DTSCS76 02263 EXEC CICS LINK DTSCS76 02264 PROGRAM ('DTSCU851') DTSCS76 02265 COMMAREA (L851-COMM-AREA) DTSCS76 02266 END-EXEC. DTSCS76 02267 S851-EXIT. DTSCS76 02268 EXIT. DTSCS76 02269 DTSCS76 02270 DTSCS76 02271 DTSCS76 02272 S899-ABEND. DTSCS76 02273 EXEC CICS ABEND DTSCS76 02274 ABCODE(WRK-ABEND-CD) DTSCS76 02275 END-EXEC. DTSCS76 02276 S899-EXIT. DTSCS76 02277 EXIT. DTSCS76 02278 /*****************************************************************DTSCS76 02279 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS76 02280 ******************************************************************DTSCS76 02281 DTSCS76 02282 S1000-SCREEN-EDITS. DTSCS76 02283 *****SET WRK-5E-REQ-NO-88 TO TRUE. DTSCS76 02284 DTSCS76 02285 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS76 02286 DTSCS76 02287 IF LCCM-MSG DTSCS76 02288 GO TO S1000-EXIT. DTSCS76 02289 DTSCS76 02290 DTSCS76 02291 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS76 02292 DTSCS76 02293 DTSCS76 02294 PERFORM S1300-MAILING-LABELS THRU S1300-EXIT. DTSCS76 02295 DTSCS76 02296 *****PERFORM S1350-ELF-IND THRU S1350-EXIT. DTSCS76 02297 DTSCS76 02298 *****PERFORM S1375-ELF-LABELS THRU S1375-EXIT. DTSCS76 02299 DTSCS76 02300 PERFORM S1400-FROM-TO-YRQ THRU S1400-EXIT. DTSCS76 02301 DTSCS76 02302 PERFORM S1500-FORCE-PRINT THRU S1500-EXIT. DTSCS76 02303 DTSCS76 02304 PERFORM S1550-WAIVE-EXT-DATE THRU S1550-EXIT. DTSCS76 02305 DTSCS76 02306 *****PERFORM S1600-OL-FROM-TO-YRQ THRU S1600-EXIT. DTSCS76 02307 DTSCS76 02308 *****PERFORM S1700-OL-FORCE-PRINT THRU S1700-EXIT. DTSCS76 02309 DTSCS76 02310 *****PERFORM S1750-OL-PRINTER-ID THRU S1750-EXIT. DTSCS76 02311 DTSCS76 02312 *****PERFORM S1800-NOTICE-OF-COVERAGE THRU S1800-EXIT. DTSCS76 02313 DTSCS76 02314 PERFORM S1900-NOTICE-OF-SUBJECT THRU S1900-EXIT. DTSCS76 02315 DTSCS76 02316 PERFORM S2000-REQUEST-FOR-FEIN THRU S2000-EXIT. DTSCS76 02317 DTSCS76 02318 PERFORM S2100-ADDR-TYPE THRU S2100-EXIT. DTSCS76 02319 DTSCS76 02320 PERFORM S2200-ADDR-NBR THRU S2200-EXIT. DTSCS76 02321 DTSCS76 02322 PERFORM S2300-AR-AUDIT-TRAIL THRU S2300-EXIT. DTSCS76 02323 DTSCS76 02324 PERFORM S2400-STMT-FROM-TO-YRQ THRU S2400-EXIT. DTSCS76 02325 DTSCS76 02326 PERFORM S2500-RESPONSIBLE-OP-ID THRU S2500-EXIT. DTSCS76 02327 DTSCS76 02328 PERFORM S2600-WAGE-REQUEST THRU S2600-EXIT. DTSCS76 02329 DTSCS76 02330 IF LCCM-MSG DTSCS76 02331 GO TO S1000-EXIT. DTSCS76 02332 DTSCS76 02333 DTSCS76 02334 IF WRK-FROM-YRQ > +0 DTSCS76 02335 PERFORM S3000-RPTS-EDITS THRU S3000-EXIT. DTSCS76 02336 DTSCS76 02337 IF LCCM-MSG DTSCS76 02338 GO TO S1000-EXIT. DTSCS76 02339 DTSCS76 02340 DTSCS76 02341 IF WRK-WAIVE-EXT-DATE > +0 DTSCS76 02342 PERFORM S4000-WAIVE-EDITS THRU S4000-EXIT. DTSCS76 02343 DTSCS76 02344 IF LCCM-MSG DTSCS76 02345 GO TO S1000-EXIT. DTSCS76 02346 DTSCS76 02347 DTSCS76 02348 *****IF WRK-OL-FROM-YRQ > +0 DTSCS76 02349 *********SET WRK-OL-REQ-YES-88 TO TRUE DTSCS76 02350 *********PERFORM S3000-RPTS-EDITS THRU S3000-EXIT. DTSCS76 02351 DTSCS76 02352 *****IF LCCM-MSG DTSCS76 02353 *********GO TO S1000-EXIT. DTSCS76 02354 DTSCS76 02355 *****IF WRK-5E-WAIVE-EXT-DATE > +0 DTSCS76 02356 *********PERFORM S4500-5E-WAIVE-EDITS THRU S4500-EXIT. DTSCS76 02357 DTSCS76 02358 *****IF LCCM-MSG DTSCS76 02359 *********GO TO S1000-EXIT. DTSCS76 02360 DTSCS76 02361 DTSCS76 02362 IF MAP-MAILING-LABELS = SPACES DTSCS76 02363 ********AND MAP-ELF-IND-NO DTSCS76 02364 ********AND MAP-ELF-LABELS = SPACES DTSCS76 02365 AND WRK-FROM-YRQ = 0 DTSCS76 02366 AND WRK-TO-YRQ = 0 DTSCS76 02367 ********AND WRK-OL-FROM-YRQ = 0 DTSCS76 02368 ********AND WRK-OL-TO-YRQ = 0 DTSCS76 02369 ********AND MAP-NOTICE-OF-COVERAGE = SPACES DTSCS76 02370 AND MAP-NOTICE-OF-SUBJECT-NO DTSCS76 02371 AND MAP-REQUEST-FOR-FEIN-NO DTSCS76 02372 AND MAP-AR-AUDIT-TRAIL-NO DTSCS76 02373 AND WRK-STMT-FROM-YRQ = 0 DTSCS76 02374 AND WRK-STMT-TO-YRQ = 0 DTSCS76 02375 AND MAP-SSN-1 NOT GREATER SPACES DTSCS76 02376 MOVE MSG-E764-AREA TO LCCM-MSG-AREA. DTSCS76 02377 DTSCS76 02378 S1000-EXIT. DTSCS76 02379 EXIT. DTSCS76 02380 EJECT DTSCS76 02381 S1100-EDIT-KEY. DTSCS76 02382 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS76 02383 S1100-EXIT. DTSCS76 02384 EXIT. DTSCS76 02385 /*****************************************************************DTSCS76 02386 * DTSCS76 02387 ******************************************************************DTSCS76 02388 S1101-EMP-NO. DTSCS76 02389 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS76 02390 DTSCS76 02391 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS76 02392 DTSCS76 02393 IF L018-NO-ENTRY DTSCS76 02394 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76 02395 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS76 02396 GO TO S1101-EXIT. DTSCS76 02397 DTSCS76 02398 IF L018-NOT-VALID DTSCS76 02399 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02400 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS76 02401 GO TO S1101-EXIT. DTSCS76 02402 DTSCS76 02403 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS76 02404 S1101-EXIT. DTSCS76 02405 EXIT. DTSCS76 02406 DTSCS76 02407 DTSCS76 02408 DTSCS76 02409 S1110-READ-MPRF. DTSCS76 02410 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS76 02411 DTSCS76 02412 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS76 02413 DTSCS76 02414 SET MPRF-PRF-88 TO TRUE. DTSCS76 02415 DTSCS76 02416 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 02417 DTSCS76 02418 PERFORM S810-READ THRU S810-EXIT. DTSCS76 02419 DTSCS76 02420 IF L810-NO-REC-88 DTSCS76 02421 SET WRK-MPRF-NO-88 TO TRUE DTSCS76 02422 ELSE DTSCS76 02423 MOVE MSKL-REC TO MPRF-REC DTSCS76 02424 SET WRK-MPRF-YES-88 TO TRUE. DTSCS76 02425 S1110-EXIT. DTSCS76 02426 EXIT. DTSCS76 02427 DTSCS76 02428 DTSCS76 02429 DTSCS76 02430 S1199-ERROR. DTSCS76 02431 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS76 02432 MAP-EMP-NO-2-A. DTSCS76 02433 DTSCS76 02434 IF LCCM-NO-MSG DTSCS76 02435 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02436 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS76 02437 SET CURSOR-SET-YES TO TRUE. DTSCS76 02438 S1199-EXIT. DTSCS76 02439 EXIT. DTSCS76 02440 /*****************************************************************DTSCS76 02441 * DTSCS76 02442 ******************************************************************DTSCS76 02443 *S1200-READ-MELF. DTSCS76 02444 *****MOVE LOW-VALUES TO MELF-KEY-AREA. DTSCS76 02445 *****MOVE WRK-EMP-NO TO MELF-EMP-NO. DTSCS76 02446 *****SET MELF-ELF-88 TO TRUE. DTSCS76 02447 *****MOVE MELF-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 02448 DTSCS76 02449 *****PERFORM S810-READ THRU S810-EXIT. DTSCS76 02450 *****IF L810-NO-REC-88 DTSCS76 02451 *********SET WRK-MELF-NO-88 TO TRUE DTSCS76 02452 *****ELSE DTSCS76 02453 *********SET WRK-MELF-YES-88 TO TRUE DTSCS76 02454 *********MOVE MSKL-REC TO MELF-REC. DTSCS76 02455 *S1200-EXIT. EXIT. DTSCS76 02456 /*****************************************************************DTSCS76 02457 * DTSCS76 02458 ******************************************************************DTSCS76 02459 S1300-MAILING-LABELS. DTSCS76 02460 MOVE MAP-MAILING-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76 02461 DTSCS76 02462 PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76 02463 DTSCS76 02464 IF L013-VALID DTSCS76 02465 IF WRK-MPRF-NO-88 DTSCS76 02466 AND L013-CNT > 0 DTSCS76 02467 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02468 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS76 02469 ELSE DTSCS76 02470 MOVE L013-CNT TO MAP-MAILING-LABELS-N DTSCS76 02471 ELSE DTSCS76 02472 IF L013-NO-ENTRY DTSCS76 02473 MOVE SPACES TO MAP-MAILING-LABELS DTSCS76 02474 ELSE DTSCS76 02475 IF L013-INVALID-NEGATIVE DTSCS76 02476 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76 02477 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS76 02478 ELSE DTSCS76 02479 IF L013-EXCEEDS-MIN-MAX DTSCS76 02480 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76 02481 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS76 02482 ELSE DTSCS76 02483 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02484 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS76 02485 S1300-EXIT. DTSCS76 02486 EXIT. DTSCS76 02487 DTSCS76 02488 DTSCS76 02489 DTSCS76 02490 S1301-ERROR. DTSCS76 02491 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAILING-LABELS-A. DTSCS76 02492 DTSCS76 02493 IF LCCM-NO-MSG DTSCS76 02494 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02495 MOVE CATB-CURSOR TO MAP-MAILING-LABELS-L DTSCS76 02496 SET CURSOR-SET-YES TO TRUE. DTSCS76 02497 S1301-EXIT. DTSCS76 02498 EXIT. DTSCS76 02499 /*****************************************************************DTSCS76 02500 * DTSCS76 02501 ******************************************************************DTSCS76 02502 *S1350-ELF-IND. DTSCS76 02503 *****IF MAP-ELF-IND = LOW-VALUES OR SPACES DTSCS76 02504 *********MOVE 'N' TO MAP-ELF-IND DTSCS76 02505 *****ELSE DTSCS76 02506 *********IF NOT MAP-ELF-IND-VALID DTSCS76 02507 ************MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02508 ************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76 02509 *********ELSE DTSCS76 02510 ************IF MAP-ELF-IND-YES DTSCS76 02511 ***************IF WRK-MPRF-NO-88 DTSCS76 02512 ******************MOVE EMSG-FIELD-NOT-ALLOWED STMT WRK-MSG-AREA DTSCS76 02513 ******************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76 02514 ***************ELSE DTSCS76 02515 ******************IF WRK-MELF-NO-88 DTSCS76 02516 *********************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76 02517 *********************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76 02518 ******************ELSE DTSCS76 02519 *********************IF MELF-MAIL-NOT-DELIV-88 DTSCS76 02520 *********************MOVE MSG-E76E-AREA TO WRK-MSG-AREA DTSCS76 02521 *********************PERFORM S1351-ERROR THRU S1351-EXIT. DTSCS76 02522 *S1350-EXIT. EXIT. DTSCS76 02523 DTSCS76 02524 *S1351-ERROR. DTSCS76 02525 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-IND-A. DTSCS76 02526 *****IF LCCM-NO-MSG DTSCS76 02527 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02528 ********MOVE CATB-CURSOR TO MAP-ELF-IND-L DTSCS76 02529 ********SET CURSOR-SET-YES TO TRUE. DTSCS76 02530 *S1351-EXIT. EXIT. DTSCS76 02531 DTSCS76 02532 *S1375-ELF-LABELS. DTSCS76 02533 *****MOVE MAP-ELF-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76 02534 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76 02535 DTSCS76 02536 *****IF L013-VALID DTSCS76 02537 *********IF L013-CNT > 0 DTSCS76 02538 ************IF WRK-MPRF-NO-88 DTSCS76 02539 ***************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02540 ***************PERFORM S1376-ERROR THRU S1376-EXIT DTSCS76 02541 ************ELSE DTSCS76 02542 ***************IF NOT MAP-ELF-IND-YES DTSCS76 02543 ******************MOVE MSG-E76C-AREA TO WRK-MSG-AREA DTSCS76 02544 ******************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76 02545 ***************ELSE DTSCS76 02546 ******************MOVE L013-CNT TO MAP-ELF-LABELS-N DTSCS76 02547 *********ELSE DTSCS76 02548 ************MOVE L013-CNT TO MAP-ELF-LABELS-N DTSCS76 02549 *****ELSE DTSCS76 02550 *****IF L013-NO-ENTRY DTSCS76 02551 ********MOVE SPACES TO MAP-ELF-LABELS DTSCS76 02552 *****ELSE DTSCS76 02553 *****IF L013-INVALID-NEGATIVE DTSCS76 02554 ********MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76 02555 ********PERFORM S1376-ERROR THRU S1376-EXIT DTSCS76 02556 *****ELSE DTSCS76 02557 *****IF L013-EXCEEDS-MIN-MAX DTSCS76 02558 *********MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76 02559 *********PERFORM S1376-ERROR THRU S1376-EXIT DTSCS76 02560 *****ELSE DTSCS76 02561 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02562 *********PERFORM S1376-ERROR THRU S1376-EXIT. DTSCS76 02563 *S1375-EXIT. EXIT. DTSCS76 02564 DTSCS76 02565 *S1376-ERROR. DTSCS76 02566 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ELF-LABELS-A. DTSCS76 02567 *****IF LCCM-NO-MSG DTSCS76 02568 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02569 ********MOVE CATB-CURSOR TO MAP-ELF-LABELS-L DTSCS76 02570 ********SET CURSOR-SET-YES TO TRUE. DTSCS76 02571 *S1376-EXIT. EXIT. DTSCS76 02572 /*****************************************************************DTSCS76 02573 * DTSCS76 02574 ******************************************************************DTSCS76 02575 S1400-FROM-TO-YRQ. DTSCS76 02576 MOVE +0 TO WRK-FROM-YRQ DTSCS76 02577 WRK-TO-YRQ. DTSCS76 02578 DTSCS76 02579 DTSCS76 02580 MOVE MAP-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 02581 DTSCS76 02582 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 02583 DTSCS76 02584 IF L016-NO-ENTRY DTSCS76 02585 NEXT SENTENCE DTSCS76 02586 ELSE DTSCS76 02587 IF L016-NOT-VALID DTSCS76 02588 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02589 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 02590 ELSE DTSCS76 02591 IF WRK-MPRF-NO-88 DTSCS76 02592 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02593 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 02594 ELSE DTSCS76 02595 MOVE L016-YRQ TO WRK-FROM-YRQ. DTSCS76 02596 DTSCS76 02597 DTSCS76 02598 MOVE MAP-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 02599 DTSCS76 02600 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 02601 DTSCS76 02602 IF L016-NO-ENTRY DTSCS76 02603 MOVE WRK-FROM-YRQ TO WRK-TO-YRQ DTSCS76 02604 ELSE DTSCS76 02605 IF L016-NOT-VALID DTSCS76 02606 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02607 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76 02608 GO TO S1400-EXIT DTSCS76 02609 ELSE DTSCS76 02610 IF WRK-MPRF-NO-88 DTSCS76 02611 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02612 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76 02613 GO TO S1400-EXIT DTSCS76 02614 ELSE DTSCS76 02615 MOVE L016-YRQ TO WRK-TO-YRQ. DTSCS76 02616 DTSCS76 02617 DTSCS76 02618 IF WRK-TO-YRQ < WRK-FROM-YRQ DTSCS76 02619 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 02620 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 02621 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76 02622 GO TO S1400-EXIT. DTSCS76 02623 DTSCS76 02624 DTSCS76 02625 IF WRK-FROM-YRQ = +0 DTSCS76 02626 IF WRK-TO-YRQ > +0 DTSCS76 02627 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 02628 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 02629 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76 02630 GO TO S1400-EXIT. DTSCS76 02631 S1400-EXIT. DTSCS76 02632 EXIT. DTSCS76 02633 DTSCS76 02634 DTSCS76 02635 DTSCS76 02636 S1401-ERROR. DTSCS76 02637 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FROM-YRQ-YR-A. DTSCS76 02638 DTSCS76 02639 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FROM-YRQ-Q-A. DTSCS76 02640 DTSCS76 02641 IF LCCM-NO-MSG DTSCS76 02642 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02643 MOVE CATB-CURSOR TO MAP-FROM-YRQ-YR-L DTSCS76 02644 SET CURSOR-SET-YES TO TRUE. DTSCS76 02645 S1401-EXIT. DTSCS76 02646 EXIT. DTSCS76 02647 DTSCS76 02648 S1402-ERROR. DTSCS76 02649 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TO-YRQ-YR-A. DTSCS76 02650 DTSCS76 02651 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TO-YRQ-Q-A. DTSCS76 02652 DTSCS76 02653 IF LCCM-NO-MSG DTSCS76 02654 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02655 MOVE CATB-CURSOR TO MAP-TO-YRQ-YR-L DTSCS76 02656 SET CURSOR-SET-YES TO TRUE. DTSCS76 02657 S1402-EXIT. DTSCS76 02658 EXIT. DTSCS76 02659 /*****************************************************************DTSCS76 02660 * DTSCS76 02661 ******************************************************************DTSCS76 02662 S1500-FORCE-PRINT. DTSCS76 02663 IF MAP-FORCE-PRINT = LOW-VALUES OR SPACES DTSCS76 02664 MOVE 'N' TO MAP-FORCE-PRINT DTSCS76 02665 ELSE DTSCS76 02666 IF NOT MAP-FORCE-PRINT-VALID DTSCS76 02667 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02668 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS76 02669 ELSE DTSCS76 02670 IF WRK-MPRF-NO-88 DTSCS76 02671 AND MAP-FORCE-PRINT-YES DTSCS76 02672 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02673 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS76 02674 S1500-EXIT. DTSCS76 02675 EXIT. DTSCS76 02676 DTSCS76 02677 DTSCS76 02678 DTSCS76 02679 S1501-ERROR. DTSCS76 02680 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FORCE-PRINT-A. DTSCS76 02681 DTSCS76 02682 IF LCCM-NO-MSG DTSCS76 02683 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02684 MOVE CATB-CURSOR TO MAP-FORCE-PRINT-L DTSCS76 02685 SET CURSOR-SET-YES TO TRUE. DTSCS76 02686 S1501-EXIT. DTSCS76 02687 EXIT. DTSCS76 02688 /*****************************************************************DTSCS76 02689 * DTSCS76 02690 ******************************************************************DTSCS76 02691 S1550-WAIVE-EXT-DATE. DTSCS76 02692 MOVE +0 TO WRK-WAIVE-EXT-DATE. DTSCS76 02693 DTSCS76 02694 DTSCS76 02695 MOVE MAP-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76 02696 DTSCS76 02697 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76 02698 DTSCS76 02699 IF L015-NO-ENTRY DTSCS76 02700 NEXT SENTENCE DTSCS76 02701 ELSE DTSCS76 02702 IF L015-NOT-VALID DTSCS76 02703 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02704 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76 02705 ELSE DTSCS76 02706 IF WRK-MPRF-NO-88 DTSCS76 02707 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02708 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76 02709 ELSE DTSCS76 02710 MOVE L015-DATE TO WRK-WAIVE-EXT-DATE. DTSCS76 02711 S1550-EXIT. DTSCS76 02712 EXIT. DTSCS76 02713 DTSCS76 02714 DTSCS76 02715 DTSCS76 02716 S1551-ERROR. DTSCS76 02717 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS76 02718 TO MAP-WAIVE-EXT-MO-A DTSCS76 02719 MAP-WAIVE-EXT-DA-A DTSCS76 02720 MAP-WAIVE-EXT-YR-A. DTSCS76 02721 DTSCS76 02722 IF LCCM-NO-MSG DTSCS76 02723 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02724 MOVE CATB-CURSOR TO MAP-WAIVE-EXT-MO-L DTSCS76 02725 SET CURSOR-SET-YES TO TRUE. DTSCS76 02726 S1551-EXIT. DTSCS76 02727 EXIT. DTSCS76 02728 /*****************************************************************DTSCS76 02729 * DTSCS76 02730 ******************************************************************DTSCS76 02731 *S1600-OL-FROM-TO-YRQ. DTSCS76 02732 *****MOVE +0 TO WRK-OL-FROM-YRQ DTSCS76 02733 ****************WRK-OL-TO-YRQ. DTSCS76 02734 DTSCS76 02735 *****MOVE MAP-OL-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 02736 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 02737 *****IF L016-NO-ENTRY DTSCS76 02738 ********NEXT SENTENCE DTSCS76 02739 *****ELSE DTSCS76 02740 *****IF L016-NOT-VALID DTSCS76 02741 ********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02742 ********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 02743 *****ELSE DTSCS76 02744 ********IF WRK-MPRF-NO-88 DTSCS76 02745 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02746 ***********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 02747 ********ELSE DTSCS76 02748 ************IF WRK-MELF-NO-88 DTSCS76 02749 ***************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76 02750 ***************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 02751 ************ELSE DTSCS76 02752 ***************IF MELF-TAX-RPT-NO-88 DTSCS76 02753 ******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76 02754 ******************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 02755 ***************ELSE DTSCS76 02756 ******************MOVE L016-YRQ TO WRK-OL-FROM-YRQ. DTSCS76 02757 DTSCS76 02758 *****MOVE MAP-OL-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 02759 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 02760 *****IF L016-NO-ENTRY DTSCS76 02761 ********MOVE WRK-OL-FROM-YRQ TO WRK-OL-TO-YRQ DTSCS76 02762 *****ELSE DTSCS76 02763 *****IF L016-NOT-VALID DTSCS76 02764 ********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02765 ********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 02766 ********GO TO S1600-EXIT DTSCS76 02767 *****ELSE DTSCS76 02768 ********IF WRK-MPRF-NO-88 DTSCS76 02769 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02770 ***********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 02771 ***********GO TO S1600-EXIT DTSCS76 02772 ********ELSE DTSCS76 02773 ************IF WRK-MELF-NO-88 DTSCS76 02774 ***************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76 02775 ***************PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 02776 ***************GO TO S1600-EXIT DTSCS76 02777 ************ELSE DTSCS76 02778 ***************IF MELF-TAX-RPT-NO-88 DTSCS76 02779 ******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76 02780 ******************PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 02781 ******************GO TO S1600-EXIT DTSCS76 02782 ***************ELSE DTSCS76 02783 ******************MOVE L016-YRQ TO WRK-OL-TO-YRQ. DTSCS76 02784 DTSCS76 02785 *****IF WRK-OL-TO-YRQ < WRK-OL-FROM-YRQ DTSCS76 02786 ********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 02787 ********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 02788 ********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 02789 ********GO TO S1600-EXIT. DTSCS76 02790 DTSCS76 02791 *****IF WRK-5E-FROM-YRQ = +0 DTSCS76 02792 *********IF WRK-5E-TO-YRQ > +0 DTSCS76 02793 *************MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 02794 *************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 02795 *************PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 02796 *************GO TO S1600-EXIT. DTSCS76 02797 DTSCS76 02798 *****IF (WRK-FROM-YRQ = +0) AND (WRK-TO-YRQ = +0) DTSCS76 02799 *********GO TO S1600-EXIT DTSCS76 02800 *****ELSE DTSCS76 02801 *********IF (WRK-TO-YRQ < WRK-5E-FROM-YRQ) DTSCS76 02802 ************************OR DTSCS76 02803 ************(WRK-5E-TO-YRQ < WRK-FROM-YRQ) DTSCS76 02804 *************GO TO S1600-EXIT DTSCS76 02805 *********ELSE DTSCS76 02806 *************MOVE MSG-E76D-AREA TO WRK-MSG-AREA DTSCS76 02807 *************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 02808 *************PERFORM S1602-ERROR THRU S1602-EXIT. DTSCS76 02809 *S1600-EXIT. EXIT. DTSCS76 02810 DTSCS76 02811 *S1601-ERROR. DTSCS76 02812 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-FROM-YRQ-YR-A. DTSCS76 02813 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-FROM-YRQ-Q-A. DTSCS76 02814 *****IF LCCM-NO-MSG DTSCS76 02815 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02816 ********MOVE CATB-CURSOR TO MAP-5E-FROM-YRQ-YR-L DTSCS76 02817 ********SET CURSOR-SET-YES TO TRUE. DTSCS76 02818 *S1601-EXIT. EXIT. DTSCS76 02819 DTSCS76 02820 *S1602-ERROR. DTSCS76 02821 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-TO-YRQ-YR-A. DTSCS76 02822 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-TO-YRQ-Q-A. DTSCS76 02823 *****IF LCCM-NO-MSG DTSCS76 02824 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02825 ********MOVE CATB-CURSOR TO MAP-5E-TO-YRQ-YR-L DTSCS76 02826 ********SET CURSOR-SET-YES TO TRUE. DTSCS76 02827 *S1602-EXIT. EXIT. DTSCS76 02828 /*****************************************************************DTSCS76 02829 * DTSCS76 02830 ******************************************************************DTSCS76 02831 *S1700-5E-FORCE-PRINT. DTSCS76 02832 *****IF MAP-5E-FORCE-PRINT = LOW-VALUES OR SPACES DTSCS76 02833 ********MOVE 'N' TO MAP-5E-FORCE-PRINT DTSCS76 02834 *****ELSE DTSCS76 02835 *****IF NOT MAP-5E-FORCE-PRINT-VALID DTSCS76 02836 ********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02837 ********PERFORM S1701-ERROR THRU S1701-EXIT DTSCS76 02838 *****ELSE DTSCS76 02839 ********IF MAP-5E-FORCE-PRINT-YES DTSCS76 02840 ***********IF WRK-MPRF-NO-88 DTSCS76 02841 **************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02842 **************PERFORM S1701-ERROR THRU S1701-EXIT DTSCS76 02843 ***********ELSE DTSCS76 02844 **************IF WRK-MELF-NO-88 DTSCS76 02845 *****************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76 02846 *****************PERFORM S1701-ERROR THRU S1701-EXIT DTSCS76 02847 **************ELSE DTSCS76 02848 *****************IF MELF-TAX-RPT-NO-88 DTSCS76 02849 ******************* MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76 02850 ********************PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS76 02851 *S1700-EXIT. EXIT. DTSCS76 02852 DTSCS76 02853 *S1701-ERROR. DTSCS76 02854 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-5E-FORCE-PRINT-A. DTSCS76 02855 *****IF LCCM-NO-MSG DTSCS76 02856 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02857 ********MOVE CATB-CURSOR TO MAP-5E-FORCE-PRINT-L DTSCS76 02858 ********SET CURSOR-SET-YES TO TRUE. DTSCS76 02859 *S1701-EXIT. EXIT. DTSCS76 02860 /*****************************************************************DTSCS76 02861 * DTSCS76 02862 ******************************************************************DTSCS76 02863 *S1750-5E-WAIVE-EXT-DATE. DTSCS76 02864 *****MOVE +0 TO WRK-5E-WAIVE-EXT-DATE. DTSCS76 02865 DTSCS76 02866 *****MOVE MAP-5E-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76 02867 *****PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76 02868 *****IF L015-NO-ENTRY DTSCS76 02869 *********NEXT SENTENCE DTSCS76 02870 *****ELSE DTSCS76 02871 *****IF L015-NOT-VALID DTSCS76 02872 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02873 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 02874 *****ELSE DTSCS76 02875 *********IF WRK-MPRF-NO-88 DTSCS76 02876 *************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02877 *************PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 02878 *********ELSE DTSCS76 02879 *************IF WRK-MELF-NO-88 DTSCS76 02880 ****************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76 02881 ****************PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 02882 *************ELSE DTSCS76 02883 ****************IF MELF-TAX-RPT-NO-88 DTSCS76 02884 *******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76 02885 *******************PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 02886 ****************ELSE DTSCS76 02887 *******************MOVE L015-DATE TO WRK-5E-WAIVE-EXT-DATE. DTSCS76 02888 *S1750-EXIT. DTSCS76 02889 *****EXIT. DTSCS76 02890 DTSCS76 02891 *S1751-ERROR. DTSCS76 02892 *****MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS76 02893 *******TO MAP-5E-WAIVE-EXT-MO-A DTSCS76 02894 **********MAP-5E-WAIVE-EXT-DA-A DTSCS76 02895 **********MAP-5E-WAIVE-EXT-YR-A. DTSCS76 02896 DTSCS76 02897 *****IF LCCM-NO-MSG DTSCS76 02898 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02899 *********MOVE CATB-CURSOR TO MAP-5E-WAIVE-EXT-MO-L DTSCS76 02900 *********SET CURSOR-SET-YES TO TRUE. DTSCS76 02901 *S1751-EXIT. DTSCS76 02902 *****EXIT. DTSCS76 02903 /*****************************************************************DTSCS76 02904 * DTSCS76 02905 ******************************************************************DTSCS76 02906 *S1800-NOTICE-OF-COVERAGE. DTSCS76 02907 *****MOVE MAP-NOTICE-OF-COVERAGE-AREA TO L013-S-CNT-AREA. DTSCS76 02908 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76 02909 DTSCS76 02910 *****IF L013-VALID DTSCS76 02911 ********IF WRK-MPRF-NO-88 DTSCS76 02912 ********AND L013-CNT > 0 DTSCS76 02913 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02914 ***********PERFORM S1801-ERROR THRU S1801-EXIT DTSCS76 02915 ********ELSE DTSCS76 02916 ***********MOVE L013-CNT TO MAP-NOTICE-OF-COVERAGE-N DTSCS76 02917 ***********PERFORM S1810-ACTIVE-EDIT THRU S1810-EXIT DTSCS76 02918 *****ELSE DTSCS76 02919 *****IF L013-NO-ENTRY DTSCS76 02920 ********MOVE SPACES TO MAP-NOTICE-OF-COVERAGE DTSCS76 02921 *****ELSE DTSCS76 02922 *****IF L013-INVALID-NEGATIVE DTSCS76 02923 ********MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76 02924 ********PERFORM S1801-ERROR THRU S1801-EXIT DTSCS76 02925 *****ELSE DTSCS76 02926 *****IF L013-EXCEEDS-MIN-MAX DTSCS76 02927 *********MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76 02928 *********PERFORM S1801-ERROR THRU S1801-EXIT DTSCS76 02929 *****ELSE DTSCS76 02930 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02931 *********PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS76 02932 *S1800-EXIT. EXIT. DTSCS76 02933 DTSCS76 02934 *S1801-ERROR. DTSCS76 02935 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-NOTICE-OF-COVERAGE-A. DTSCS76 02936 *****IF LCCM-NO-MSG DTSCS76 02937 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02938 ********MOVE CATB-CURSOR TO MAP-NOTICE-OF-COVERAGE-L DTSCS76 02939 ********SET CURSOR-SET-YES TO TRUE. DTSCS76 02940 *S1801-EXIT. EXIT. DTSCS76 02941 DTSCS76 02942 *S1810-ACTIVE-EDIT. DTSCS76 02943 *****IF (WRK-MPRF-NO-88) DTSCS76 02944 *************OR DTSCS76 02945 ********(L013-CNT = +0) DTSCS76 02946 *********GO TO S1810-EXIT. DTSCS76 02947 DTSCS76 02948 *****IF MPRF-STATUS-ACT-88 DTSCS76 02949 *********NEXT SENTENCE DTSCS76 02950 *****ELSE DTSCS76 02951 *********MOVE MSG-E767-AREA TO WRK-MSG-AREA DTSCS76 02952 *********PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS76 02953 *S1810-EXIT. DTSCS76 02954 *****EXIT. DTSCS76 02955 /*****************************************************************DTSCS76 02956 * DTSCS76 02957 ******************************************************************DTSCS76 02958 S1900-NOTICE-OF-SUBJECT. DTSCS76 02959 IF MAP-NOTICE-OF-SUBJECT = LOW-VALUES OR SPACES DTSCS76 02960 MOVE 'N' TO MAP-NOTICE-OF-SUBJECT DTSCS76 02961 ELSE DTSCS76 02962 IF NOT MAP-NOTICE-OF-SUBJECT-VALID DTSCS76 02963 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 02964 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS76 02965 ELSE DTSCS76 02966 IF WRK-MPRF-NO-88 DTSCS76 02967 AND MAP-NOTICE-OF-SUBJECT-YES DTSCS76 02968 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 02969 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS76 02970 ELSE DTSCS76 02971 PERFORM S1910-SUBJECT-EDIT THRU S1910-EXIT. DTSCS76 02972 S1900-EXIT. DTSCS76 02973 EXIT. DTSCS76 02974 DTSCS76 02975 DTSCS76 02976 DTSCS76 02977 S1901-ERROR. DTSCS76 02978 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS76 02979 TO MAP-NOTICE-OF-SUBJECT-A. DTSCS76 02980 DTSCS76 02981 IF LCCM-NO-MSG DTSCS76 02982 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 02983 MOVE CATB-CURSOR TO MAP-NOTICE-OF-SUBJECT-L DTSCS76 02984 SET CURSOR-SET-YES TO TRUE. DTSCS76 02985 S1901-EXIT. DTSCS76 02986 EXIT. DTSCS76 02987 DTSCS76 02988 DTSCS76 02989 S1910-SUBJECT-EDIT. DTSCS76 02990 IF (WRK-MPRF-NO-88) DTSCS76 02991 OR DTSCS76 02992 (MAP-NOTICE-OF-SUBJECT-NO) DTSCS76 02993 GO TO S1910-EXIT. DTSCS76 02994 DTSCS76 02995 IF MPRF-STATUS-SUB-88 DTSCS76 02996 NEXT SENTENCE DTSCS76 02997 ELSE DTSCS76 02998 MOVE MSG-E765-AREA TO WRK-MSG-AREA DTSCS76 02999 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS76 03000 S1910-EXIT. DTSCS76 03001 EXIT. DTSCS76 03002 /*****************************************************************DTSCS76 03003 * DTSCS76 03004 ******************************************************************DTSCS76 03005 S2000-REQUEST-FOR-FEIN. DTSCS76 03006 IF MAP-REQUEST-FOR-FEIN = LOW-VALUES OR SPACES DTSCS76 03007 MOVE 'N' TO MAP-REQUEST-FOR-FEIN DTSCS76 03008 ELSE DTSCS76 03009 IF NOT MAP-REQUEST-FOR-FEIN-VALID DTSCS76 03010 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03011 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS76 03012 ELSE DTSCS76 03013 IF WRK-MPRF-NO-88 DTSCS76 03014 IF MAP-REQUEST-FOR-FEIN-YES DTSCS76 03015 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 03016 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS76 03017 ELSE DTSCS76 03018 NEXT SENTENCE DTSCS76 03019 ELSE DTSCS76 03020 IF MAP-REQUEST-FOR-FEIN-YES DTSCS76 03021 IF MPRF-CLASS-CHG-ONLY-88 DTSCS76 03022 MOVE MSG-E768-AREA TO WRK-MSG-AREA DTSCS76 03023 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS76 03024 S2000-EXIT. DTSCS76 03025 EXIT. DTSCS76 03026 DTSCS76 03027 DTSCS76 03028 DTSCS76 03029 S2001-ERROR. DTSCS76 03030 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REQUEST-FOR-FEIN-A. DTSCS76 03031 DTSCS76 03032 IF LCCM-NO-MSG DTSCS76 03033 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03034 MOVE CATB-CURSOR TO MAP-REQUEST-FOR-FEIN-L DTSCS76 03035 SET CURSOR-SET-YES TO TRUE. DTSCS76 03036 S2001-EXIT. DTSCS76 03037 EXIT. DTSCS76 03038 /*****************************************************************DTSCS76 03039 * DTSCS76 03040 ******************************************************************DTSCS76 03041 S2100-ADDR-TYPE. DTSCS76 03042 IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS76 03043 SET MAP-ADDR-TAX-88 TO TRUE DTSCS76 03044 ELSE DTSCS76 03045 IF MAP-ADDR-VALID-88 DTSCS76 03046 NEXT SENTENCE DTSCS76 03047 ELSE DTSCS76 03048 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03049 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS76 03050 S2100-EXIT. DTSCS76 03051 EXIT. DTSCS76 03052 DTSCS76 03053 DTSCS76 03054 DTSCS76 03055 S2101-ERROR. DTSCS76 03056 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A DTSCS76 03057 DTSCS76 03058 IF LCCM-NO-MSG DTSCS76 03059 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03060 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS76 03061 SET CURSOR-SET-YES TO TRUE. DTSCS76 03062 S2101-EXIT. DTSCS76 03063 EXIT. DTSCS76 03064 /*****************************************************************DTSCS76 03065 * DTSCS76 03066 ******************************************************************DTSCS76 03067 S2200-ADDR-NBR. DTSCS76 03068 INSPECT MAP-ADDR-ID-NO DTSCS76 03069 CONVERTING LOW-VALUES TO SPACES. DTSCS76 03070 DTSCS76 03071 DTSCS76 03072 IF MAP-ADDR-ID-NO = SPACES DTSCS76 03073 IF MAP-ADDR-TAD-88 DTSCS76 03074 IF WRK-MPRF-NO-88 DTSCS76 03075 GO TO S2200-EXIT DTSCS76 03076 ELSE DTSCS76 03077 PERFORM S2210-ADDR-LOOKUP THRU S2210-EXIT DTSCS76 03078 GO TO S2200-EXIT DTSCS76 03079 ELSE DTSCS76 03080 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76 03081 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76 03082 GO TO S2200-EXIT. DTSCS76 03083 DTSCS76 03084 DTSCS76 03085 IF MAP-ADDR-TAD-88 DTSCS76 03086 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 03087 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76 03088 GO TO S2200-EXIT. DTSCS76 03089 DTSCS76 03090 DTSCS76 03091 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76 03092 DTSCS76 03093 MOVE +1 TO L013-MIN-CNT DTSCS76 03094 DTSCS76 03095 MOVE +999 TO L013-MAX-CNT. DTSCS76 03096 DTSCS76 03097 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS76 03098 DTSCS76 03099 IF L013-VALID DTSCS76 03100 MOVE L013-CNT TO MAP-ADDR-ID-NO-N DTSCS76 03101 IF MAP-ADDR-TAA-OPO-88 DTSCS76 03102 PERFORM S2220-ADDR-TAA-OPO THRU S2220-EXIT DTSCS76 03103 ELSE DTSCS76 03104 NEXT SENTENCE DTSCS76 03105 ELSE DTSCS76 03106 IF L013-NO-ENTRY DTSCS76 03107 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76 03108 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76 03109 ELSE DTSCS76 03110 IF L013-INVALID-NEGATIVE DTSCS76 03111 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76 03112 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76 03113 ELSE DTSCS76 03114 IF L013-EXCEEDS-MIN-MAX DTSCS76 03115 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76 03116 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76 03117 ELSE DTSCS76 03118 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03119 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS76 03120 S2200-EXIT. DTSCS76 03121 EXIT. DTSCS76 03122 DTSCS76 03123 DTSCS76 03124 DTSCS76 03125 S2201-ERROR. DTSCS76 03126 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A. DTSCS76 03127 DTSCS76 03128 IF LCCM-NO-MSG DTSCS76 03129 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03130 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS76 03131 SET CURSOR-SET-YES TO TRUE. DTSCS76 03132 S2201-EXIT. DTSCS76 03133 EXIT. DTSCS76 03134 DTSCS76 03135 DTSCS76 03136 DTSCS76 03137 S2210-ADDR-LOOKUP. DTSCS76 03138 IF WRK-MPRF-NO-88 DTSCS76 03139 GO TO S2210-EXIT. DTSCS76 03140 DTSCS76 03141 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS76 03142 DTSCS76 03143 IF MAP-ADDR-TAX-88 DTSCS76 03144 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS76 03145 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS76 03146 ELSE DTSCS76 03147 IF MAP-ADDR-PHY-88 DTSCS76 03148 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS76 03149 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS76 03150 ELSE DTSCS76 03151 GO TO S899-ABEND. DTSCS76 03152 DTSCS76 03153 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS76 03154 DTSCS76 03155 IF L111-ADDR-NOT-FOUND-88 DTSCS76 03156 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS76 03157 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS76 03158 S2210-EXIT. DTSCS76 03159 EXIT. DTSCS76 03160 DTSCS76 03161 DTSCS76 03162 DTSCS76 03163 S2220-ADDR-TAA-OPO. DTSCS76 03164 IF WRK-MPRF-NO-88 DTSCS76 03165 GO TO S2210-EXIT. DTSCS76 03166 DTSCS76 03167 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS76 03168 DTSCS76 03169 IF MAP-ADDR-TAX-ALT-88 DTSCS76 03170 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS76 03171 ELSE DTSCS76 03172 IF MAP-ADDR-OPO-88 DTSCS76 03173 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS76 03174 ELSE DTSCS76 03175 GO TO S899-ABEND. DTSCS76 03176 DTSCS76 03177 IF L013-CNT = +0 DTSCS76 03178 MOVE 1 TO L111-ID-NO DTSCS76 03179 ELSE DTSCS76 03180 MOVE L013-CNT TO L111-ID-NO. DTSCS76 03181 DTSCS76 03182 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS76 03183 DTSCS76 03184 IF L111-ADDR-NOT-FOUND-88 DTSCS76 03185 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS76 03186 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS76 03187 S2220-EXIT. DTSCS76 03188 EXIT. DTSCS76 03189 /*****************************************************************DTSCS76 03190 * DTSCS76 03191 ******************************************************************DTSCS76 03192 S2300-AR-AUDIT-TRAIL. DTSCS76 03193 IF MAP-AR-AUDIT-TRAIL = LOW-VALUES OR SPACES DTSCS76 03194 MOVE 'N' TO MAP-AR-AUDIT-TRAIL DTSCS76 03195 ELSE DTSCS76 03196 IF NOT MAP-AR-AUDIT-TRAIL-VALID DTSCS76 03197 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03198 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS76 03199 ELSE DTSCS76 03200 IF WRK-MPRF-NO-88 DTSCS76 03201 AND MAP-AR-AUDIT-TRAIL-YES DTSCS76 03202 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 03203 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS76 03204 ELSE DTSCS76 03205 IF MAP-AR-AUDIT-TRAIL-YES DTSCS76 03206 AND MPRF-TOT-BALANCE-AMT NOT > +0 DTSCS76 03207 MOVE MSG-E762-AREA TO WRK-MSG-AREA DTSCS76 03208 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS76 03209 S2300-EXIT. DTSCS76 03210 EXIT. DTSCS76 03211 DTSCS76 03212 DTSCS76 03213 DTSCS76 03214 S2301-ERROR. DTSCS76 03215 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AR-AUDIT-TRAIL-A. DTSCS76 03216 DTSCS76 03217 IF LCCM-NO-MSG DTSCS76 03218 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03219 MOVE CATB-CURSOR TO MAP-AR-AUDIT-TRAIL-L DTSCS76 03220 SET CURSOR-SET-YES TO TRUE. DTSCS76 03221 S2301-EXIT. DTSCS76 03222 EXIT. DTSCS76 03223 /*****************************************************************DTSCS76 03224 * DTSCS76 03225 ******************************************************************DTSCS76 03226 /*****************************************************************DTSCS76 03227 * DTSCS76 03228 ******************************************************************DTSCS76 03229 S2400-STMT-FROM-TO-YRQ. DTSCS76 03230 MOVE +0 TO WRK-STMT-FROM-YRQ DTSCS76 03231 WRK-STMT-TO-YRQ. DTSCS76 03232 DTSCS76 03233 DTSCS76 03234 MOVE MAP-STMT-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 03235 DTSCS76 03236 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 03237 DTSCS76 03238 IF L016-NO-ENTRY DTSCS76 03239 NEXT SENTENCE DTSCS76 03240 ELSE DTSCS76 03241 IF L016-NOT-VALID DTSCS76 03242 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03243 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76 03244 ELSE DTSCS76 03245 IF WRK-MPRF-NO-88 DTSCS76 03246 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 03247 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76 03248 ELSE DTSCS76 03249 MOVE L016-YRQ TO WRK-STMT-FROM-YRQ. DTSCS76 03250 DTSCS76 03251 DTSCS76 03252 MOVE MAP-STMT-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76 03253 DTSCS76 03254 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76 03255 DTSCS76 03256 IF L016-NO-ENTRY DTSCS76 03257 MOVE WRK-STMT-FROM-YRQ TO WRK-STMT-TO-YRQ DTSCS76 03258 ELSE DTSCS76 03259 IF L016-NOT-VALID DTSCS76 03260 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03261 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76 03262 GO TO S2400-EXIT DTSCS76 03263 ELSE DTSCS76 03264 IF WRK-MPRF-NO-88 DTSCS76 03265 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76 03266 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76 03267 GO TO S2400-EXIT DTSCS76 03268 ELSE DTSCS76 03269 MOVE L016-YRQ TO WRK-STMT-TO-YRQ. DTSCS76 03270 DTSCS76 03271 DTSCS76 03272 IF WRK-STMT-TO-YRQ > +0 DTSCS76 03273 IF WRK-STMT-FROM-YRQ > WRK-STMT-TO-YRQ DTSCS76 03274 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03275 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76 03276 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76 03277 GO TO S2400-EXIT. DTSCS76 03278 DTSCS76 03279 DTSCS76 03280 IF WRK-STMT-FROM-YRQ = +0 DTSCS76 03281 IF WRK-STMT-TO-YRQ > +0 DTSCS76 03282 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03283 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76 03284 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76 03285 GO TO S2400-EXIT. DTSCS76 03286 S2400-EXIT. DTSCS76 03287 EXIT. DTSCS76 03288 DTSCS76 03289 DTSCS76 03290 DTSCS76 03291 S2401-ERROR. DTSCS76 03292 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-FROM-YRQ-YR-A. DTSCS76 03293 DTSCS76 03294 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-FROM-YRQ-Q-A. DTSCS76 03295 DTSCS76 03296 IF LCCM-NO-MSG DTSCS76 03297 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03298 MOVE CATB-CURSOR TO MAP-STMT-FROM-YRQ-YR-L DTSCS76 03299 SET CURSOR-SET-YES TO TRUE. DTSCS76 03300 S2401-EXIT. DTSCS76 03301 EXIT. DTSCS76 03302 DTSCS76 03303 S2402-ERROR. DTSCS76 03304 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-TO-YRQ-YR-A. DTSCS76 03305 DTSCS76 03306 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-TO-YRQ-Q-A. DTSCS76 03307 DTSCS76 03308 IF LCCM-NO-MSG DTSCS76 03309 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03310 MOVE CATB-CURSOR TO MAP-STMT-TO-YRQ-YR-L DTSCS76 03311 SET CURSOR-SET-YES TO TRUE. DTSCS76 03312 S2402-EXIT. DTSCS76 03313 EXIT. DTSCS76 03314 /*****************************************************************DTSCS76 03315 * DTSCS76 03316 ******************************************************************DTSCS76 03317 S2500-RESPONSIBLE-OP-ID. DTSCS76 03318 IF MAP-RESPONSIBLE-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS76 03319 MOVE LCCM-RESP-OP-ID TO MAP-RESPONSIBLE-OP-ID. DTSCS76 03320 DTSCS76 03321 IF MAP-RESPONSIBLE-OP-ID = LCCM-OP-ID DTSCS76 03322 MOVE MAP-RESPONSIBLE-OP-ID TO LCCM-RESP-OP-ID DTSCS76 03323 GO TO S2500-EXIT. DTSCS76 03324 DTSCS76 03325 MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID. DTSCS76 03326 DTSCS76 03327 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS76 03328 DTSCS76 03329 IF (L082-VALID-OP) DTSCS76 03330 AND DTSCS76 03331 (L082-EXTERNAL-88) DTSCS76 03332 MOVE MAP-RESPONSIBLE-OP-ID TO LCCM-RESP-OP-ID DTSCS76 03333 ELSE DTSCS76 03334 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03335 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS76 03336 S2500-EXIT. DTSCS76 03337 EXIT. DTSCS76 03338 DTSCS76 03339 DTSCS76 03340 DTSCS76 03341 S2501-ERROR. DTSCS76 03342 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESPONSIBLE-OP-ID-A. DTSCS76 03343 DTSCS76 03344 IF LCCM-NO-MSG DTSCS76 03345 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03346 MOVE CATB-CURSOR TO MAP-RESPONSIBLE-OP-ID-L DTSCS76 03347 SET CURSOR-SET-YES TO TRUE. DTSCS76 03348 S2501-EXIT. DTSCS76 03349 EXIT. DTSCS76 03350 S2600-WAGE-REQUEST. DTSCS76 03351 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS76 03352 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS76 03353 IF L020-NO-ENTRY DTSCS76 03354 GO TO S2600-EXIT DTSCS76 03355 ELSE DTSCS76 03356 IF L020-NOT-VALID DTSCS76 03357 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03358 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS76 03359 GO TO S2600-EXIT. DTSCS76 03360 DTSCS76 03361 MOVE L020-SSN TO L081-CLAIMANT-SSN. DTSCS76 03362 PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT. DTSCS76 03363 IF L081-NAME-FOUND DTSCS76 03364 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME DTSCS76 03365 ELSE DTSCS76 03366 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS76 03367 MOVE MSG-E76G-AREA TO WRK-MSG-AREA DTSCS76 03368 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS76 03369 GO TO S2600-EXIT. DTSCS76 03370 DTSCS76 03371 MOVE LCCM-CURR-RUN-DATE TO L004-DATE. DTSCS76 03372 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSCS76 03373 ADD +4 TO L004-ABS-QTR. DTSCS76 03374 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS76 03375 DTSCS76 03376 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA DTSCS76 03377 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 03378 IF L016-NO-ENTRY DTSCS76 03379 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76 03380 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS76 03381 GO TO S2600-EXIT DTSCS76 03382 ELSE DTSCS76 03383 IF L016-NOT-VALID DTSCS76 03384 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03385 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS76 03386 GO TO S2600-EXIT. DTSCS76 03387 DTSCS76 03388 IF L016-YRQ > L004-QTR-5-9 DTSCS76 03389 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03390 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS76 03391 GO TO S2600-EXIT. DTSCS76 03392 DTSCS76 03393 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS76 03394 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 03395 IF L016-NO-ENTRY DTSCS76 03396 NEXT SENTENCE DTSCS76 03397 ELSE DTSCS76 03398 IF L016-NOT-VALID DTSCS76 03399 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03400 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS76 03401 GO TO S2600-EXIT. DTSCS76 03402 DTSCS76 03403 IF L016-YRQ > L004-QTR-5-9 DTSCS76 03404 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03405 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS76 03406 GO TO S2600-EXIT. DTSCS76 03407 DTSCS76 03408 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS76 03409 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 03410 IF L016-NO-ENTRY DTSCS76 03411 NEXT SENTENCE DTSCS76 03412 ELSE DTSCS76 03413 IF L016-NOT-VALID DTSCS76 03414 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03415 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS76 03416 GO TO S2600-EXIT. DTSCS76 03417 DTSCS76 03418 IF L016-YRQ > L004-QTR-5-9 DTSCS76 03419 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03420 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS76 03421 GO TO S2600-EXIT. DTSCS76 03422 DTSCS76 03423 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS76 03424 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76 03425 IF L016-NO-ENTRY DTSCS76 03426 NEXT SENTENCE DTSCS76 03427 ELSE DTSCS76 03428 IF L016-NOT-VALID DTSCS76 03429 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03430 PERFORM S2605-ERROR THRU S2605-EXIT DTSCS76 03431 GO TO S2600-EXIT. DTSCS76 03432 DTSCS76 03433 IF L016-YRQ > L004-QTR-5-9 DTSCS76 03434 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03435 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS76 03436 GO TO S2600-EXIT. DTSCS76 03437 DTSCS76 03438 S2600-EXIT. EXIT. DTSCS76 03439 DTSCS76 03440 S2601-ERROR. DTSCS76 03441 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A DTSCS76 03442 MAP-SSN-2-A DTSCS76 03443 MAP-SSN-3-A. DTSCS76 03444 IF LCCM-NO-MSG DTSCS76 03445 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03446 MOVE CATB-CURSOR TO MAP-SSN-1-L DTSCS76 03447 SET CURSOR-SET-YES TO TRUE. DTSCS76 03448 S2601-EXIT. EXIT. DTSCS76 03449 DTSCS76 03450 S2602-ERROR. DTSCS76 03451 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ1-YR-A DTSCS76 03452 MAP-WR-YRQ1-Q-A. DTSCS76 03453 IF LCCM-NO-MSG DTSCS76 03454 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03455 MOVE CATB-CURSOR TO MAP-WR-YRQ1-YR-L DTSCS76 03456 SET CURSOR-SET-YES TO TRUE. DTSCS76 03457 S2602-EXIT. DTSCS76 03458 EXIT. DTSCS76 03459 S2603-ERROR. DTSCS76 03460 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ2-YR-A DTSCS76 03461 MAP-WR-YRQ2-Q-A. DTSCS76 03462 IF LCCM-NO-MSG DTSCS76 03463 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03464 MOVE CATB-CURSOR TO MAP-WR-YRQ2-YR-L DTSCS76 03465 SET CURSOR-SET-YES TO TRUE. DTSCS76 03466 S2603-EXIT. DTSCS76 03467 EXIT. DTSCS76 03468 S2604-ERROR. DTSCS76 03469 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ3-YR-A DTSCS76 03470 MAP-WR-YRQ3-Q-A. DTSCS76 03471 IF LCCM-NO-MSG DTSCS76 03472 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03473 MOVE CATB-CURSOR TO MAP-WR-YRQ3-YR-L DTSCS76 03474 SET CURSOR-SET-YES TO TRUE. DTSCS76 03475 S2604-EXIT. DTSCS76 03476 EXIT. DTSCS76 03477 S2605-ERROR. DTSCS76 03478 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ4-YR-A DTSCS76 03479 MAP-WR-YRQ4-Q-A. DTSCS76 03480 IF LCCM-NO-MSG DTSCS76 03481 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76 03482 MOVE CATB-CURSOR TO MAP-WR-YRQ4-YR-L DTSCS76 03483 SET CURSOR-SET-YES TO TRUE. DTSCS76 03484 S2605-EXIT. DTSCS76 03485 EXIT. DTSCS76 03486 EJECT DTSCS76 03487 S3000-RPTS-EDITS. DTSCS76 03488 IF WRK-MPRF-NO-88 DTSCS76 03489 GO TO S3000-EXIT. DTSCS76 03490 DTSCS76 03491 IF MPRF-STATUS-SUB-88 DTSCS76 03492 NEXT SENTENCE DTSCS76 03493 ELSE DTSCS76 03494 MOVE MSG-E765-AREA TO WRK-MSG-AREA DTSCS76 03495 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS76 03496 DTSCS76 03497 MOVE WRK-FROM-YRQ TO L004-QTR-5-9. DTSCS76 03498 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS76 03499 DTSCS76 03500 SET WRK-ANN-LIABLE-NO-88 TO TRUE. DTSCS76 03501 SET WRK-ANN-FILER-NO-88 TO TRUE. DTSCS76 03502 DTSCS76 03503 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS76 03504 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSCS76 03505 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS76 03506 MOVE WRK-FROM-YRQ TO L410-YRQ DTSCS76 03507 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS76 03508 IF L410-ANN-SCHED-88 DTSCS76 03509 SET WRK-ANN-FILER-YES-88 TO TRUE. DTSCS76 03510 DTSCS76 03511 PERFORM S3100-CHECK-LIAB-AND-RATE THRU S3100-EXIT DTSCS76 03512 UNTIL (LCCM-MSG) DTSCS76 03513 OR DTSCS76 03514 (L004-QTR-5-9 > WRK-TO-YRQ) DTSCS76 03515 OR DTSCS76 03516 (L004-INVALID-QTR). DTSCS76 03517 DTSCS76 03518 IF WRK-ANN-FILER-YES-88 DTSCS76 03519 IF WRK-ANN-LIABLE-NO-88 DTSCS76 03520 MOVE WRK-FROM-YRQ TO L004-QTR-5-9 DTSCS76 03521 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS76 03522 MOVE L004-SLASH-QTR TO MSG-E766-SLASH-QTR DTSCS76 03523 MOVE MSG-E766-AREA TO WRK-MSG-AREA DTSCS76 03524 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS76 03525 DTSCS76 03526 IF LCCM-MSG DTSCS76 03527 GO TO S3000-EXIT. DTSCS76 03528 DTSCS76 03529 IF MAP-FORCE-PRINT-YES DTSCS76 03530 GO TO S3000-EXIT. DTSCS76 03531 DTSCS76 03532 DTSCS76 03533 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS76 03534 DTSCS76 03535 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS76 03536 DTSCS76 03537 SET MQTR-QTR-88 TO TRUE. DTSCS76 03538 DTSCS76 03539 MOVE WRK-FROM-YRQ TO MQTR-YRQ. DTSCS76 03540 DTSCS76 03541 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS76 03542 DTSCS76 03543 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76 03544 DTSCS76 03545 PERFORM S3200-CHECK-FOR-RPT THRU S3200-EXIT DTSCS76 03546 UNTIL L810-NO-REC-88. DTSCS76 03547 DTSCS76 03548 IF WRK-ANN-FILER-YES-88 DTSCS76 03549 PERFORM S3300-ANNUAL-REPORT THRU S3300-EXIT DTSCS76 03550 IF LCCM-MSG DTSCS76 03551 GO TO S3000-EXIT. DTSCS76 03552 DTSCS76 03553 PERFORM S3400-MASS-MAILING THRU S3400-EXIT. DTSCS76 03554 DTSCS76 03555 S3000-EXIT. DTSCS76 03556 EXIT. DTSCS76 03557 DTSCS76 03558 DTSCS76 03559 DTSCS76 03560 S3100-CHECK-LIAB-AND-RATE. DTSCS76 03561 MOVE WRK-EMP-NO TO L381-EMP-NO. DTSCS76 03562 DTSCS76 03563 MOVE L004-QTR-5-9 TO L381-YRQ. DTSCS76 03564 DTSCS76 03565 MOVE MPRF-EMP-CLASS TO L381-EMP-CLASS. DTSCS76 03566 DTSCS76 03567 PERFORM S381-DETERM-LIABILITY THRU S381-EXIT. DTSCS76 03568 DTSCS76 03569 IF WRK-ANN-FILER-YES-88 DTSCS76 03570 IF L381-LIABLE-88 DTSCS76 03571 SET WRK-ANN-LIABLE-YES-88 TO TRUE DTSCS76 03572 END-IF DTSCS76 03573 ELSE DTSCS76 03574 IF L381-NOT-LIABLE-88 DTSCS76 03575 MOVE L004-SLASH-QTR TO MSG-E766-SLASH-QTR DTSCS76 03576 MOVE MSG-E766-AREA TO WRK-MSG-AREA DTSCS76 03577 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 03578 GO TO S3100-EXIT. DTSCS76 03579 DTSCS76 03580 IF L381-CLASS-SELF-INS-88 DTSCS76 03581 NEXT SENTENCE DTSCS76 03582 ELSE DTSCS76 03583 IF L381-UI-RATE-NOT-FOUND-88 DTSCS76 03584 MOVE L004-SLASH-QTR TO MSG-E761-SLASH-QTR DTSCS76 03585 MOVE MSG-E761-AREA TO WRK-MSG-AREA DTSCS76 03586 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 03587 GO TO S3100-EXIT. DTSCS76 03588 DTSCS76 03589 ADD +1 TO L004-ABS-QTR. DTSCS76 03590 DTSCS76 03591 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS76 03592 S3100-EXIT. DTSCS76 03593 EXIT. DTSCS76 03594 DTSCS76 03595 DTSCS76 03596 DTSCS76 03597 S3200-CHECK-FOR-RPT. DTSCS76 03598 MOVE MSKL-REC TO MQTR-REC. DTSCS76 03599 DTSCS76 03600 IF MQTR-YRQ > WRK-TO-YRQ DTSCS76 03601 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76 03602 SET L810-NO-REC-88 TO TRUE DTSCS76 03603 GO TO S3200-EXIT. DTSCS76 03604 DTSCS76 03605 IF MQTR-CURR-RCVD-88 DTSCS76 03606 MOVE MSG-E763-AREA TO WRK-MSG-AREA DTSCS76 03607 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS76 03608 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76 03609 SET L810-NO-REC-88 TO TRUE DTSCS76 03610 GO TO S3200-EXIT. DTSCS76 03611 DTSCS76 03612 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS76 03613 S3200-EXIT. DTSCS76 03614 EXIT. DTSCS76 03615 EJECT DTSCS76 03616 S3300-ANNUAL-REPORT. DTSCS76 03617 DTSCS76 03618 MOVE WRK-FROM-YRQ TO L004-QTR-5-9. DTSCS76 03619 IF L004-QTR-5-Q = 1 DTSCS76 03620 NEXT SENTENCE DTSCS76 03621 ELSE DTSCS76 03622 MOVE MSG-E76F-AREA TO WRK-MSG-AREA DTSCS76 03623 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS76 03624 DTSCS76 03625 MOVE WRK-TO-YRQ TO L004-QTR-5-9. DTSCS76 03626 IF L004-QTR-5-Q = 4 DTSCS76 03627 NEXT SENTENCE DTSCS76 03628 ELSE DTSCS76 03629 MOVE MSG-E76F-AREA TO WRK-MSG-AREA DTSCS76 03630 PERFORM S1402-ERROR THRU S1402-EXIT. DTSCS76 03631 S3300-EXIT. DTSCS76 03632 EXIT. DTSCS76 03633 DTSCS76 03634 S3400-MASS-MAILING. DTSCS76 03635 IF WRK-ANN-FILER-YES-88 DTSCS76 03636 MOVE WRK-FROM-YRQ TO L004-QTR-5-9 DTSCS76 03637 MOVE L004-QTR-5-YR TO L415-YR DTSCS76 03638 SET L415-MODE-INPUT-YEAR-88 TO TRUE DTSCS76 03639 PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT DTSCS76 03640 IF L415-NOT-FOUND-88 DTSCS76 03641 MOVE MSG-E76H-AREA TO WRK-MSG-AREA DTSCS76 03642 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 03643 END-IF DTSCS76 03644 ELSE DTSCS76 03645 IF WRK-FROM-YRQ > LCCM-LAST-UC30-MASS-MAIL-YRQ DTSCS76 03646 MOVE MSG-E76H-AREA TO WRK-MSG-AREA DTSCS76 03647 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 03648 END-IF DTSCS76 03649 END-IF. DTSCS76 03650 DTSCS76 03651 S3400-EXIT. DTSCS76 03652 EXIT. DTSCS76 03653 EJECT DTSCS76 03654 S4000-WAIVE-EDITS. DTSCS76 03655 IF WRK-FROM-YRQ = +0 DTSCS76 03656 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03657 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76 03658 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76 03659 GO TO S4000-EXIT. DTSCS76 03660 DTSCS76 03661 DTSCS76 03662 IF WRK-TO-YRQ > LCCM-LAST-UC30-MASS-MAIL-YRQ DTSCS76 03663 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03664 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76 03665 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76 03666 GO TO S4000-EXIT. DTSCS76 03667 DTSCS76 03668 DTSCS76 03669 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS76 03670 DTSCS76 03671 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS76 03672 DTSCS76 03673 ADD +45 TO L001-JUL-ABS-DAY. DTSCS76 03674 DTSCS76 03675 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSCS76 03676 DTSCS76 03677 IF (WRK-WAIVE-EXT-DATE < LCCM-CURR-MAIL-DATE) DTSCS76 03678 OR DTSCS76 03679 (WRK-WAIVE-EXT-DATE > L001-FED-8-DATE-9) DTSCS76 03680 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03681 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76 03682 GO TO S4000-EXIT. DTSCS76 03683 DTSCS76 03684 DTSCS76 03685 MOVE WRK-TO-YRQ TO L004-QTR-5-9. DTSCS76 03686 DTSCS76 03687 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS76 03688 DTSCS76 03689 IF L004-QTR-DEFAULT-DUE-DATE NOT < WRK-WAIVE-EXT-DATE DTSCS76 03690 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03691 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76 03692 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76 03693 GO TO S4000-EXIT. DTSCS76 03694 S4000-EXIT. DTSCS76 03695 EXIT. DTSCS76 03696 EJECT DTSCS76 03697 *S4500-5E-WAIVE-EDITS. DTSCS76 03698 *****IF WRK-5E-FROM-YRQ = +0 DTSCS76 03699 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03700 *********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76 03701 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 03702 *********GO TO S4500-EXIT. DTSCS76 03703 DTSCS76 03704 *****IF WRK-5E-TO-YRQ > LCCM-LAST-UI5-MASS-MAIL-YRQ DTSCS76 03705 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03706 *********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 03707 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 03708 *********GO TO S4500-EXIT. DTSCS76 03709 DTSCS76 03710 *****MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS76 03711 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS76 03712 *****ADD +45 TO L001-JUL-ABS-DAY. DTSCS76 03713 *****PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSCS76 03714 DTSCS76 03715 *****IF (WRK-5E-WAIVE-EXT-DATE < LCCM-CURR-MAIL-DATE) DTSCS76 03716 *************OR DTSCS76 03717 ********(WRK-5E-WAIVE-EXT-DATE > L001-FED-8-DATE-9) DTSCS76 03718 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76 03719 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 03720 *********GO TO S4500-EXIT. DTSCS76 03721 DTSCS76 03722 *****MOVE WRK-5E-TO-YRQ TO L004-QTR-5-9. DTSCS76 03723 *****PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS76 03724 DTSCS76 03725 *****IF L004-QTR-DEFAULT-DUE-DATE NOT < WRK-5E-WAIVE-EXT-DATE DTSCS76 03726 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76 03727 *********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76 03728 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76 03729 *********GO TO S4500-EXIT. DTSCS76 03730 *S4500-EXIT. DTSCS76 03731 *****EXIT. DTSCS76 03732 /*****************************************************************DTSCS76 03733 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS76 03734 ******************************************************************DTSCS76 03735 S8100-SET-LOCK-ATTRB. DTSCS76 03736 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS76 03737 WRK-ATB-NUM. DTSCS76 03738 DTSCS76 03739 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS76 03740 DTSCS76 03741 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS76 03742 MAP-EMP-NO-2-A DTSCS76 03743 MAP-GOTO-A. DTSCS76 03744 S8100-EXIT. DTSCS76 03745 EXIT. DTSCS76 03746 DTSCS76 03747 DTSCS76 03748 DTSCS76 03749 ******************************************************************DTSCS76 03750 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS76 03751 ******************************************************************DTSCS76 03752 S8200-SET-UPDATE-ATTRB. DTSCS76 03753 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS76 03754 DTSCS76 03755 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS76 03756 DTSCS76 03757 DTSCS76 03758 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS76 03759 S8200-EXIT. DTSCS76 03760 EXIT. DTSCS76 03761 DTSCS76 03762 DTSCS76 03763 DTSCS76 03764 ******************************************************************DTSCS76 03765 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS76 03766 ******************************************************************DTSCS76 03767 S8300-SET-INQ-ATTRB. DTSCS76 03768 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS76 03769 WRK-ATB-NUM. DTSCS76 03770 DTSCS76 03771 DTSCS76 03772 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS76 03773 S8300-EXIT. DTSCS76 03774 EXIT. DTSCS76 03775 DTSCS76 03776 DTSCS76 03777 DTSCS76 03778 S8900-SET-ATTRB. DTSCS76 03779 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS76 03780 MAP-EMP-NO-2-A. DTSCS76 03781 DTSCS76 03782 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A. DTSCS76 03783 DTSCS76 03784 MOVE WRK-ATB-NUM TO MAP-MAILING-LABELS-A DTSCS76 03785 *************************MAP-ELF-LABELS-A DTSCS76 03786 MAP-FROM-YRQ-YR-A DTSCS76 03787 MAP-FROM-YRQ-Q-A DTSCS76 03788 MAP-TO-YRQ-YR-A DTSCS76 03789 MAP-TO-YRQ-Q-A DTSCS76 03790 MAP-WAIVE-EXT-MO-A DTSCS76 03791 MAP-WAIVE-EXT-DA-A DTSCS76 03792 MAP-WAIVE-EXT-YR-A DTSCS76 03793 MAP-STMT-FROM-YRQ-YR-A DTSCS76 03794 MAP-STMT-FROM-YRQ-Q-A DTSCS76 03795 MAP-STMT-TO-YRQ-YR-A DTSCS76 03796 MAP-STMT-TO-YRQ-Q-A DTSCS76 03797 *************************MAP-5E-WAIVE-EXT-MO-A DTSCS76 03798 *************************MAP-5E-WAIVE-EXT-DA-A DTSCS76 03799 *************************MAP-5E-WAIVE-EXT-YR-A DTSCS76 03800 MAP-SSN-1-A DTSCS76 03801 MAP-SSN-2-A DTSCS76 03802 MAP-SSN-3-A DTSCS76 03803 MAP-WR-YRQ1-YR-A DTSCS76 03804 MAP-WR-YRQ1-Q-A DTSCS76 03805 MAP-WR-YRQ2-YR-A DTSCS76 03806 MAP-WR-YRQ2-Q-A DTSCS76 03807 MAP-WR-YRQ3-YR-A DTSCS76 03808 MAP-WR-YRQ3-Q-A DTSCS76 03809 MAP-WR-YRQ4-YR-A DTSCS76 03810 MAP-WR-YRQ4-Q-A DTSCS76 03811 MAP-ADDR-ID-NO-A. DTSCS76 03812 *************************MAP-NOTICE-OF-COVERAGE-A. DTSCS76 03813 DTSCS76 03814 *****MOVE WRK-ATB-AN TO MAP-ELF-IND-A DTSCS76 03815 ************************MAP-5E-FORCE-PRINT-A. DTSCS76 03816 DTSCS76 03817 MOVE WRK-ATB-AN TO MAP-FORCE-PRINT-A DTSCS76 03818 MAP-NOTICE-OF-SUBJECT-A DTSCS76 03819 MAP-REQUEST-FOR-FEIN-A DTSCS76 03820 MAP-ADDR-TYPE-A DTSCS76 03821 MAP-AR-AUDIT-TRAIL-A DTSCS76 03822 MAP-RESPONSIBLE-OP-ID-A. DTSCS76 03823 DTSCS76 03824 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS76 03825 S8900-EXIT. DTSCS76 03826 EXIT. DTSCS76 03827 /*****************************************************************DTSCS76 03828 * MAP ROUTINES *DTSCS76 03829 ******************************************************************DTSCS76 03830 S9100-RECEIVE. DTSCS76 03831 SET L851-RECEIVE-88 TO TRUE. DTSCS76 03832 DTSCS76 03833 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS76 03834 DTSCS76 03835 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS76 03836 DTSCS76 03837 MOVE L851-AID TO LCCM-AID. DTSCS76 03838 DTSCS76 03839 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS76 03840 S9100-EXIT. DTSCS76 03841 EXIT. DTSCS76 03842 DTSCS76 03843 DTSCS76 03844 DTSCS76 03845 S9200-SEND-DATAONLY. DTSCS76 03846 MOVE LOW-VALUES TO MAP-AREA. DTSCS76 03847 DTSCS76 03848 IF LCCM-NO-MSG DTSCS76 03849 NEXT SENTENCE DTSCS76 03850 ELSE DTSCS76 03851 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS76 03852 DTSCS76 03853 IF CURSOR-SET-GOTO DTSCS76 03854 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS76 03855 ELSE DTSCS76 03856 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS76 03857 DTSCS76 03858 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS76 03859 DTSCS76 03860 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS76 03861 DTSCS76 03862 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS76 03863 S9200-EXIT. DTSCS76 03864 EXIT. DTSCS76 03865 DTSCS76 03866 DTSCS76 03867 DTSCS76 03868 S9300-SEND-MAP. DTSCS76 03869 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS76 03870 DTSCS76 03871 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS76 03872 DTSCS76 03873 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS76 03874 DTSCS76 03875 IF SCR-ACCESS-UPDATE DTSCS76 03876 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS76 03877 ELSE DTSCS76 03878 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS76 03879 DTSCS76 03880 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS76 03881 DTSCS76 03882 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS76 03883 DTSCS76 03884 IF CURSOR-SET-NO DTSCS76 03885 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS76 03886 DTSCS76 03887 SET L851-SEND-88 TO TRUE. DTSCS76 03888 DTSCS76 03889 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS76 03890 DTSCS76 03891 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS76 03892 S9300-EXIT. DTSCS76 03893 EXIT. DTSCS76 03894 DTSCS76 03895 DTSCS76 03896 DTSCS76 03897 S9310-UPDATE-FKEYS. DTSCS76 03898 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS76 03899 DTSCS76 03900 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS76 03901 DTSCS76 03902 IF LCCM-SCR-CLEAR DTSCS76 03903 NEXT SENTENCE DTSCS76 03904 ELSE DTSCS76 03905 IF LCCM-SCR-INQUIRE DTSCS76 03906 NEXT SENTENCE DTSCS76 03907 ELSE DTSCS76 03908 IF LCCM-SCR-UPDATE-LOCKED DTSCS76 03909 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS76 03910 ELSE DTSCS76 03911 NEXT SENTENCE. DTSCS76 03912 S9310-EXIT. DTSCS76 03913 EXIT. DTSCS76 03914 DTSCS76 03915 DTSCS76 03916 DTSCS76 03917 S9320-INQUIRY-FKEYS. DTSCS76 03918 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS76 03919 DTSCS76 03920 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS76 03921 S9320-EXIT. DTSCS76 03922 EXIT. DTSCS76 03923 DTSCS76 03924 DTSCS76 03925 DTSCS76 03926 *S9321-JUMP-KEYS. DTSCS76 03927 *****MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS76 03928 *****MOVE CFKD-REG-SEARCH TO MAP-KEY-SEARCH. DTSCS76 03929 *****MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS76 03930 *****MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS76 03931 *S9321-EXIT. DTSCS76 03932 *****EXIT. DTSCS76 03933 DTSCS76 03934 DTSCS76 03935 DTSCS76 03936 S9330-DSCR-FIELDS. DTSCS76 03937 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS76 03938 DTSCS76 03939 IF WRK-MPRF-YES-88 DTSCS76 03940 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS76 03941 ELSE DTSCS76 03942 IF WRK-MPRF-NO-88 DTSCS76 03943 MOVE 'MAY BE ARCHIVED' TO MAP-PRIMARY-NAME. DTSCS76 03944 DTSCS76 03945 IF MAP-RESPONSIBLE-OP-ID = LOW-VALUES OR SPACES DTSCS76 03946 MOVE LOW-VALUES TO MAP-RESPONSIBLE-OP-ID-DSCR DTSCS76 03947 ELSE DTSCS76 03948 IF MAP-RESPONSIBLE-OP-ID = LCCM-OP-ID DTSCS76 03949 MOVE LCCM-OP-NAME TO MAP-RESPONSIBLE-OP-ID-DSCR DTSCS76 03950 ELSE DTSCS76 03951 MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID DTSCS76 03952 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS76 03953 MOVE L082-NAME TO MAP-RESPONSIBLE-OP-ID-DSCR. DTSCS76 03954 S9330-EXIT. DTSCS76 03955 EXIT. DTSCS76 03956 DTSCS76 03957 DTSCS76 03958 DTSCS76 03959 S9900-PREPARE-SEND. DTSCS76 03960 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS76 03961 LCCM-SCR-ID. DTSCS76 03962 DTSCS76 03963 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS76 03964 DTSCS76 03965 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS76 03966 S9900-EXIT. DTSCS76 03967 EXIT. DTSCS76