00001 IDENTIFICATION DIVISION. 05/05/25 00002 PROGRAM-ID. DTSCS7D. DTSCS7D 00003 AUTHOR. NORTHROP GRUMMEN. LV003 00004 DATE-WRITTEN. JANUARY 2003. DTSCS7D 00005 DATE-COMPILED. DTSCS7D 00006 DTSCS7D 00007 ***** DTSCS7D 00008 * DTSCS7D 00009 * FUNCTION: EMPLOYER WAGE REQUEST SCREEN PROCESSOR. DTSCS7D 00010 * DTSCS7D 00011 * DTSCS7D 00012 * MODIFICATION LOG: DTSCS7D 00013 * DTSCS7D 00014 * 01/02/03 INITIAL DEVELOPMENT. COPIED FROM DTSCS76. DTSCS7D 00015 * PROGRAMMER: SCM DTSCS7D 00016 * DTSCS7D 00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS7D 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS7D 00019 * REFERENCE RFP: #*** PROGRAMMER: XXX DTSCS7D 00020 * DTSCS7D 00021 * DTSCS7D 00022 * DESCRIPTION: DTSCS7D 00023 * DTSCS7D 00024 * DTSCS7D 00025 * CLEAR: DTSCS7D 00026 * DTSCS7D 00027 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS7D 00028 * DTSCS7D 00029 * DTSCS7D 00030 * JUMP: DTSCS7D 00031 * DTSCS7D 00032 * NONE. DTSCS7D 00033 * DTSCS7D 00034 * DTSCS7D 00035 * INQUIRY: DTSCS7D 00036 * DTSCS7D 00037 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS7D 00038 * DTSCS7D 00039 * JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS7D 00040 * DTSCS7D 00041 * ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS7D 00042 * DTSCS7D 00043 * STANDARD LCCM-EMP-NO. DTSCS7D 00044 * DTSCS7D 00045 * DTSCS7D 00046 * UPDATE: DTSCS7D 00047 * DTSCS7D 00048 * ADD DTSCS7D 00049 * DTSCS7D 00050 * DOES NOT UPDATE THE MASTER FILE. WRITES DTSIR751 DTSCS7D 00051 * RECORD TO THE ON-LINE ACTIVITY FILE. OPTIONALLY DTSCS7D 00052 * WRITES A DTSIR901 LABEL RECORD TO OLA FILE. DTSCS7D 00053 * DTSCS7D 00054 * RECORDS READ: DTSCS7D 00055 * DTSCS7D 00056 * MASTER: DTSCS7D 00057 * DTSCS7D 00058 * MPRF DTSCS7D 00059 * MSOL DTSCS7D 00060 * MRTE DTSCS7D 00061 * MRPT DTSCS7D 00062 * DTSCS7D 00063 * ALTERNATE INDEX: DTSCS7D 00064 * DTSCS7D 00065 * NONE. DTSCS7D 00066 * DTSCS7D 00067 * REFERENCE: DTSCS7D 00068 * DTSCS7D 00069 * NONE. DTSCS7D 00070 * DTSCS7D 00071 * DTSCS7D 00072 * ACCOUNTING TRANSACTION COLLECTION: DTSCS7D 00073 * DTSCS7D 00074 * NONE. DTSCS7D 00075 * DTSCS7D 00076 * DTSCS7D 00077 * RECORDS UPDATED: DTSCS7D 00078 * DTSCS7D 00079 * MASTER: DTSCS7D 00080 * DTSCS7D 00081 * NONE. DTSCS7D 00082 * DTSCS7D 00083 * DTSCS7D 00084 * REFERENCE: DTSCS7D 00085 * DTSCS7D 00086 * NONE. DTSCS7D 00087 * DTSCS7D 00088 * DTSCS7D 00089 * ACCOUNTING TRANSACTION COLLECTION: DTSCS7D 00090 * DTSCS7D 00091 * NONE. DTSCS7D 00092 * DTSCS7D 00093 * DTSCS7D 00094 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS7D 00095 * DTSCS7D 00096 * WRITE A DTSIR751 RECORD. DTSCS7D 00097 * DTSCS7D 00098 * TEMPORARY STORAGE USAGE: DTSCS7D 00099 * DTSCS7D 00100 * NONE. DTSCS7D 00101 * DTSCS7D 00102 * DTSCS7D 00103 * MODULES LINKED TO: DTSCS7D 00104 * DTSCS7D 00105 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS7D 00106 * DTSCU016 QUARTER/YEAR FROM SCREEN FORMAT/EDIT. DTSCS7D 00107 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS7D 00108 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS7D 00109 * DTSCU111 ADDRESS LOOKUP. DTSCS7D 00110 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS7D 00111 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS7D 00112 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCS7D 00113 * DTSCS7D 00114 ***** DTSCS7D 00115 DTSCS7D 00116 ENVIRONMENT DIVISION. DTSCS7D 00117 DTSCS7D 00118 DATA DIVISION. DTSCS7D 00119 DTSCS7D 00120 WORKING-STORAGE SECTION. DTSCS7D 001205 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS7D 05/05/25'. DTSCS7D 00121 77 PAN-VALET PICTURE X(24) VALUE '008DTSCS7D 05/05/25'. DTSCS7D 00122 DTSCS7D 00123 01 SW-AREA. DTSCS7D 00124 05 WRK-ABEND-CD PIC X(04) VALUE 'S7D '. DTSCS7D 00125 DTSCS7D 00126 05 WRK-SCR-ID. DTSCS7D 00127 10 WRK-SCR-ID-A PIC X(02) VALUE '7D'. DTSCS7D 00128 DTSCS7D 00129 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS7D 00130 DTSCS7D 00131 05 WRK-FINL-IND-OK PIC X(01). DTSCS7D 00132 DTSCS7D 00133 05 SCR-ACCESS-IND PIC X(01). DTSCS7D 00134 88 SCR-ACCESS-INQ VALUE '1'. DTSCS7D 00135 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS7D 00136 DTSCS7D 00137 05 CURSOR-SET-IND PIC X(01). DTSCS7D 00138 88 CURSOR-SET-YES VALUE 'Y'. DTSCS7D 00139 88 CURSOR-SET-NO VALUE 'N'. DTSCS7D 00140 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS7D 00141 DTSCS7D 00142 05 REQ-IND PIC X(01). DTSCS7D 00143 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS7D 00144 88 REQ-ERROR VALUE 'O'. DTSCS7D 00145 88 REQ-JUMP VALUE 'J'. DTSCS7D 00146 88 REQ-UPDATE VALUE 'U'. DTSCS7D 00147 88 REQ-INQUIRE VALUE 'I'. DTSCS7D 00148 88 REQ-CLEAR VALUE 'C'. DTSCS7D 00149 88 REQ-EDIT VALUE 'E'. DTSCS7D 00150 DTSCS7D 00151 05 RESP-IND PIC X(01). DTSCS7D 00152 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS7D 00153 88 RESP-SEND-MAP VALUE 'M'. DTSCS7D 00154 88 RESP-JUMP VALUE 'J'. DTSCS7D 00155 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS7D 00156 DTSCS7D 00157 05 WRK-MSG-AREA PIC X(64). DTSCS7D 00158 DTSCS7D 00159 05 WRK-ATB-AN PIC X(01). DTSCS7D 00160 DTSCS7D 00161 05 WRK-ATB-NUM PIC X(01). DTSCS7D 00162 DTSCS7D 00163 05 WRK-NO-DEFAULT PIC X(01). DTSCS7D 00164 DTSCS7D 00165 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS7D 00166 DTSCS7D 00167 05 WRK-MPRF-IND PIC X(01). DTSCS7D 00168 88 WRK-MPRF-NONE-88 VALUE ' '. DTSCS7D 00169 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS7D 00170 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS7D 00171 DTSCS7D 00172 05 WRK-MAILING-ADDRESS-AREA. DTSCS7D 00173 10 WRK-MAILING-ADDRESS. DTSCS7D 00174 15 FILLER OCCURS 5 PIC X(40). DTSCS7D 00175 10 WRK-ZIP PIC X(10). DTSCS7D 00176 10 WRK-ADVANCED-BARCODE PIC X(14). DTSCS7D 00177 DTSCS7D 00178 05 WRK-TELEPHONE-AREA. DTSCS7D 00179 10 FILLER PIC X(01) VALUE '('. DTSCS7D 00180 10 WRK-VOICE-AREA-CD PIC X(03). DTSCS7D 00181 10 FILLER PIC X(02) VALUE ')'. DTSCS7D 00182 10 WRK-VOICE-PREFIX PIC X(03). DTSCS7D 00183 10 FILLER PIC X(01) VALUE '-'. DTSCS7D 00184 10 WRK-VOICE-SUFFIX PIC X(04). DTSCS7D 00185 DTSCS7D 00186 05 WRK-DISPLAY PIC 9(11). DTSCS7D 00187 DTSCS7D 00188 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7D 00189 10 FILLER PIC X(05). DTSCS7D 00190 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS7D 00191 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS7D 00192 DTSCS7D 00193 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7D 00194 10 FILLER PIC X(05). DTSCS7D 00195 10 WRK-DISPLAY-YR PIC X(02). DTSCS7D 00196 10 WRK-DISPLAY-MO PIC X(02). DTSCS7D 00197 10 WRK-DISPLAY-DA PIC X(02). DTSCS7D 00198 DTSCS7D 00199 05 FILLER REDEFINES WRK-DISPLAY. DTSCS7D 00200 10 FILLER PIC X(06). DTSCS7D 00201 10 WRK-DISPLAY-YRQ PIC X(05). DTSCS7D 00202 10 FILLER REDEFINES WRK-DISPLAY-YRQ. DTSCS7D 00203 15 FILLER PIC XX. DTSCS7D 00204 15 WRK-DISPLAY-YRQ-Y PIC 99. DTSCS7D 00205 15 WRK-DISPLAY-YRQ-Q PIC 9. DTSCS7D 00206 DTSCS7D 00207 EJECT DTSCS7D 00208 01 MSG-LITERALS. DTSCS7D 00209 05 MSG-E7D1-AREA. DTSCS7D 00210 10 FILLER PIC X(04) VALUE 'E7D1'. DTSCS7D 00211 10 FILLER PIC X(30) DTSCS7D 00212 VALUE 'SSN MUST BE ENTERED '. DTSCS7D 00213 10 FILLER PIC X(30) DTSCS7D 00214 VALUE ' '. DTSCS7D 00215 DTSCS7D 00216 05 MSG-E7D2-AREA. DTSCS7D 00217 10 FILLER PIC X(04) VALUE 'E7D2'. DTSCS7D 00218 10 FILLER PIC X(30) DTSCS7D 00219 VALUE 'SSN NOT IN CLAIMANT FILE; RE-E'. DTSCS7D 00220 10 FILLER PIC X(30) DTSCS7D 00221 VALUE 'NTER. '. DTSCS7D 00222 DTSCS7D 00223 05 MSG-E7D3-AREA. DTSCS7D 00224 10 FILLER PIC X(04) VALUE 'E7D3'. DTSCS7D 00225 10 FILLER PIC X(52) VALUE DTSCS7D 00226 'EITHER EMPLOYER NUMBER OR NAME & ADDRESS IS REQUIRED'. DTSCS7D 00227 DTSCS7D 00228 05 MSG-E7D4-AREA. DTSCS7D 00229 10 FILLER PIC X(04) VALUE 'E7D4'. DTSCS7D 00230 10 FILLER PIC X(47) VALUE DTSCS7D 00231 'ENTER EITHER EMPLOYER NUMBER OR NAME & ADDRESS,'. DTSCS7D 00232 10 FILLER PIC X(08) DTSCS7D 00233 VALUE 'NOT BOTH'. DTSCS7D 00234 DTSCS7D 00235 05 MSG-E7D5-AREA. DTSCS7D 00236 10 FILLER PIC X(04) VALUE 'E7D5'. DTSCS7D 00237 10 FILLER PIC X(47) VALUE DTSCS7D 00238 'INCOMPLETE/INVALID ADDRESS ENTERED FOR EMPLOYER'. DTSCS7D 00239 DTSCS7D 00240 05 MSG-E7D6-AREA. DTSCS7D 00241 10 FILLER PIC X(04) VALUE 'E7D6'. DTSCS7D 00242 10 FILLER PIC X(33) VALUE DTSCS7D 00243 'INVALID ENTRY. MUST BE (Y, N, L)'. DTSCS7D 00244 DTSCS7D 00245 05 MSG-E7D7-AREA. DTSCS7D 00246 10 FILLER PIC X(04) VALUE 'E7D7'. DTSCS7D 00247 10 FILLER PIC X(40) VALUE DTSCS7D 00248 'EMPLOYER ADDRESS COULD NOT BE CONFIRMED'. DTSCS7D 00249 DTSCS7D 00250 05 MSG-E7D8-AREA. DTSCS7D 00251 10 FILLER PIC X(04) VALUE 'E7D8'. DTSCS7D 00252 10 FILLER PIC X(32) VALUE DTSCS7D 00253 'EMPLOYER DOES NOT EXIST IN DUTAS'. DTSCS7D 00254 DTSCS7D 00255 05 MSG-E7D9-AREA. DTSCS7D 00256 10 FILLER PIC X(04) VALUE 'E7D9'. DTSCS7D 00257 10 FILLER PIC X(37) VALUE DTSCS7D 00258 'DO NOT ENTER EMPLOYER OR QTR(S) WHEN'. DTSCS7D 00259 10 FILLER PIC X(14) DTSCS7D 00260 VALUE 'MAIL LABEL = L'. DTSCS7D 00261 DTSCS7D 00262 05 MSG-E7D10-AREA. DTSCS7D 00263 10 FILLER PIC X(05) VALUE 'E7D10'. DTSCS7D 00264 10 FILLER PIC X(51) VALUE DTSCS7D 00265 'EITHER EMPLOYER NUMBER OR EMPLOYER NAME IS REQUIRED'. DTSCS7D 00266 DTSCS7D 00267 *01 ESP072D-COMM-AREA. CL**3 00268 *++INCLUDE ESPLINKC CL**3 00269 * EJECT CL**3 00270 01 L001-COMM-AREA. DTSCS7D 00271 ++INCLUDE DTSIL001 DTSCS7D 00272 EJECT DTSCS7D 00273 01 L004-COMM-AREA. DTSCS7D 00274 ++INCLUDE DTSIL004 DTSCS7D 00275 EJECT DTSCS7D 00276 01 L006-COMM-AREA. DTSCS7D 00277 ++INCLUDE DTSIL006 DTSCS7D 00278 EJECT DTSCS7D 00279 01 L013-COMM-AREA. DTSCS7D 00280 ++INCLUDE DTSIL013 DTSCS7D 00281 EJECT DTSCS7D 00282 01 L015-COMM-AREA. DTSCS7D 00283 ++INCLUDE DTSIL015 DTSCS7D 00284 EJECT DTSCS7D 00285 01 L016-COMM-AREA. DTSCS7D 00286 ++INCLUDE DTSIL016 DTSCS7D 00287 EJECT DTSCS7D 00288 01 L018-COMM-AREA. DTSCS7D 00289 ++INCLUDE DTSIL018 DTSCS7D 00290 EJECT DTSCS7D 00291 01 L020-COMM-AREA. DTSCS7D 00292 ++INCLUDE DTSIL020 DTSCS7D 00293 EJECT DTSCS7D 00294 01 L072-COMM-AREA. DTSCS7D 00295 ++INCLUDE DTSIL072 DTSCS7D 00296 EJECT DTSCS7D 00297 01 L081-COMM-AREA. DTSCS7D 00298 ++INCLUDE DTSIL081 DTSCS7D 00299 EJECT DTSCS7D 00300 01 L082-COMM-AREA. DTSCS7D 00301 ++INCLUDE DTSIL082 DTSCS7D 00302 EJECT DTSCS7D 00303 01 L112-COMM-AREA. DTSCS7D 00304 ++INCLUDE DTSIL112 DTSCS7D 00305 EJECT DTSCS7D 00306 01 L381-COMM-AREA. DTSCS7D 00307 ++INCLUDE DTSIL381 DTSCS7D 00308 EJECT DTSCS7D 00309 01 L410-COMM-AREA. DTSCS7D 00310 ++INCLUDE DTSIL410 DTSCS7D 00311 EJECT DTSCS7D 00312 01 L805-COMM-AREA. DTSCS7D 00313 ++INCLUDE DTSIL805 DTSCS7D 00314 EJECT DTSCS7D 00315 01 L810-COMM-AREA. DTSCS7D 00316 05 L810-CONTROL-BLOCK. DTSCS7D 00317 ++INCLUDE DTSIL810 DTSCS7D 00318 EJECT DTSCS7D 00319 05 MSKL-REC. DTSCS7D 00320 ++INCLUDE DTSIMSKL DTSCS7D 00321 EJECT DTSCS7D 00322 01 MPRF-REC. DTSCS7D 00323 ++INCLUDE DTSIMPRF DTSCS7D 00324 EJECT DTSCS7D 00325 01 MTAD-REC. DTSCS7D 00326 ++INCLUDE DTSIMTAD DTSCS7D 00327 EJECT DTSCS7D 00328 01 L851-COMM-AREA. DTSCS7D 00329 ++INCLUDE DTSIL851 DTSCS7D 00330 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS7D 00331 EJECT DTSCS7D 00332 ++INCLUDE DTSIS7D DTSCS7D 00333 EJECT DTSCS7D 00334 01 L825-COMM-AREA. DTSCS7D 00335 05 L825-CONTROL-BLOCK. DTSCS7D 00336 ++INCLUDE DTSIL825 DTSCS7D 00337 EJECT DTSCS7D 00338 05 RSKL-REC. DTSCS7D 00339 ++INCLUDE DTSIRSK1 DTSCS7D 00340 EJECT DTSCS7D 00341 01 R751-REC. DTSCS7D 00342 ++INCLUDE DTSIR751 DTSCS7D 00343 EJECT DTSCS7D 00344 01 R901-REC. DTSCS7D 00345 ++INCLUDE DTSIR901 DTSCS7D 00346 EJECT DTSCS7D 00347 01 CATB-LITERALS. DTSCS7D 00348 ++INCLUDE DTSICATB DTSCS7D 00349 DTSCS7D 00350 01 CFKD-LITERALS. DTSCS7D 00351 ++INCLUDE DTSICFKD DTSCS7D 00352 DTSCS7D 00353 01 CECD-LITERALS. DTSCS7D 00354 ++INCLUDE DTSICECD DTSCS7D 00355 DTSCS7D 00356 01 CPCD-LITERALS. DTSCS7D 00357 ++INCLUDE DTSICPCD DTSCS7D 00358 DTSCS7D 00359 LINKAGE SECTION. DTSCS7D 00360 DTSCS7D 00361 01 DFHCOMMAREA. DTSCS7D 00362 ++INCLUDE DTSILCCM DTSCS7D 00363 EJECT DTSCS7D 00364 PROCEDURE DIVISION. DTSCS7D 00365 DTSCS7D 00366 MOVE +0 TO WRK-EMP-NO. DTSCS7D 00367 DTSCS7D 00368 SET WRK-MPRF-NONE-88 TO TRUE. DTSCS7D 00369 DTSCS7D 00370 MOVE LOW-VALUES TO MAP-AREA. DTSCS7D 00371 DTSCS7D 00372 SET CURSOR-SET-NO TO TRUE. DTSCS7D 00373 DTSCS7D 00374 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS7D 00375 VARYING LCCM-NONUM-IDX FROM +1 BY +1 DTSCS7D 00376 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCS7D 00377 DTSCS7D 00378 MOVE SPACE TO REQ-IND. DTSCS7D 00379 DTSCS7D 00380 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS7D 00381 DTSCS7D 00382 *----------------------------------------------------- DTSCS7D 00383 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS7D 00384 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS7D 00385 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS7D 00386 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS7D 00387 * DTSCS7D 00388 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS7D 00389 * PROCESSED. DTSCS7D 00390 * DTSCS7D 00391 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS7D 00392 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS7D 00393 * WORK STATION OPERATOR. DTSCS7D 00394 *----------------------------------------------------- DTSCS7D 00395 DTSCS7D 00396 MOVE SPACE TO RESP-IND. DTSCS7D 00397 DTSCS7D 00398 IF REQ-ERROR DTSCS7D 00399 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS7D 00400 ELSE DTSCS7D 00401 IF REQ-JUMP DTSCS7D 00402 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS7D 00403 ELSE DTSCS7D 00404 IF REQ-CLEAR DTSCS7D 00405 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS7D 00406 ELSE DTSCS7D 00407 IF REQ-CURSOR-TO-GOTO DTSCS7D 00408 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS7D 00409 ELSE DTSCS7D 00410 IF REQ-INQUIRE DTSCS7D 00411 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS7D 00412 ELSE DTSCS7D 00413 IF REQ-EDIT DTSCS7D 00414 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS7D 00415 ELSE DTSCS7D 00416 IF REQ-UPDATE DTSCS7D 00417 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS7D 00418 ELSE DTSCS7D 00419 GO TO S899-ABEND. DTSCS7D 00420 DTSCS7D 00421 *----------------------------------------------------- DTSCS7D 00422 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS7D 00423 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS7D 00424 *----------------------------------------------------- DTSCS7D 00425 DTSCS7D 00426 IF RESP-SEND-MAP DTSCS7D 00427 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS7D 00428 SET LCCM-END-TASK-88 TO TRUE DTSCS7D 00429 ELSE DTSCS7D 00430 IF RESP-SEND-MSGONLY DTSCS7D 00431 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS7D 00432 SET LCCM-END-TASK-88 TO TRUE DTSCS7D 00433 ELSE DTSCS7D 00434 IF RESP-JUMP DTSCS7D 00435 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D 00436 ELSE DTSCS7D 00437 IF RESP-CURSOR-TO-GOTO DTSCS7D 00438 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS7D 00439 SET LCCM-END-TASK-88 TO TRUE DTSCS7D 00440 ELSE DTSCS7D 00441 GO TO S899-ABEND. DTSCS7D 00442 DTSCS7D 00443 MAINLINE-EXIT. DTSCS7D 00444 DTSCS7D 00445 EXEC CICS DTSCS7D 00446 RETURN DTSCS7D 00447 END-EXEC. DTSCS7D 00448 DTSCS7D 00449 GOBACK. DTSCS7D 00450 EJECT DTSCS7D 00451 P0100-ACCESS-SEARCH. DTSCS7D 00452 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID-A DTSCS7D 00453 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS7D 00454 TO SCR-ACCESS-IND. DTSCS7D 00455 P0100-EXIT. DTSCS7D 00456 EXIT. DTSCS7D 00457 DTSCS7D 00458 ******************************************************************DTSCS7D 00459 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS7D 00460 ******************************************************************DTSCS7D 00461 DTSCS7D 00462 P1000-ANALYZE-REQUEST. DTSCS7D 00463 DTSCS7D 00464 *----------------------------------------------------- DTSCS7D 00465 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS7D 00466 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS7D 00467 * REPLACED WITH ENTER) DTSCS7D 00468 *----------------------------------------------------- DTSCS7D 00469 DTSCS7D 00470 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS7D 00471 SET LCCM-ENTER-88 TO TRUE DTSCS7D 00472 SET REQ-INQUIRE TO TRUE DTSCS7D 00473 IF LCCM-EMP-NO > ZERO DTSCS7D 00474 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7D 00475 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS7D 00476 END-IF DTSCS7D 00477 GO TO P1000-EXIT. DTSCS7D 00478 DTSCS7D 00479 *----------------------------------------------------- DTSCS7D 00480 * RECEIVE THE MAP DTSCS7D 00481 *----------------------------------------------------- DTSCS7D 00482 DTSCS7D 00483 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS7D 00484 DTSCS7D 00485 *----------------------------------------------------- DTSCS7D 00486 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS7D 00487 * WORK STATION DTSCS7D 00488 *----------------------------------------------------- DTSCS7D 00489 DTSCS7D 00490 IF LCCM-CLEAR-88 DTSCS7D 00491 SET REQ-CLEAR TO TRUE DTSCS7D 00492 GO TO P1000-EXIT. DTSCS7D 00493 DTSCS7D 00494 *----------------------------------------------------- DTSCS7D 00495 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS7D 00496 *----------------------------------------------------- DTSCS7D 00497 DTSCS7D 00498 IF LCCM-SCR-UPDATE-LOCKED DTSCS7D 00499 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS7D 00500 GO TO P1000-EXIT. DTSCS7D 00501 DTSCS7D 00502 *----------------------------------------------------- DTSCS7D 00503 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS7D 00504 *----------------------------------------------------- DTSCS7D 00505 DTSCS7D 00506 IF LCCM-PA2-88 DTSCS7D 00507 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS7D 00508 GO TO P1000-EXIT. DTSCS7D 00509 DTSCS7D 00510 *----------------------------------------------------- DTSCS7D 00511 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS7D 00512 *----------------------------------------------------- DTSCS7D 00513 DTSCS7D 00514 IF LCCM-PA-88 DTSCS7D 00515 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS7D 00516 SET REQ-ERROR TO TRUE DTSCS7D 00517 GO TO P1000-EXIT. DTSCS7D 00518 DTSCS7D 00519 *----------------------------------------------------- DTSCS7D 00520 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS7D 00521 * CLEAR SCREEN DTSCS7D 00522 *----------------------------------------------------- DTSCS7D 00523 DTSCS7D 00524 IF LCCM-F12-88 DTSCS7D 00525 MOVE LOW-VALUES TO MAP-AREA DTSCS7D 00526 SET REQ-CLEAR TO TRUE DTSCS7D 00527 GO TO P1000-EXIT. DTSCS7D 00528 DTSCS7D 00529 *----------------------------------------------------- DTSCS7D 00530 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS7D 00531 *----------------------------------------------------- DTSCS7D 00532 DTSCS7D 00533 IF LCCM-F03-88 DTSCS7D 00534 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7D 00535 SET REQ-JUMP TO TRUE DTSCS7D 00536 GO TO P1000-EXIT. DTSCS7D 00537 DTSCS7D 00538 *----------------------------------------------------- DTSCS7D 00539 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS7D 00540 *----------------------------------------------------- DTSCS7D 00541 DTSCS7D 00542 IF LCCM-F04-88 DTSCS7D 00543 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7D 00544 SET REQ-JUMP TO TRUE DTSCS7D 00545 GO TO P1000-EXIT. DTSCS7D 00546 DTSCS7D 00547 *----------------------------------------------------- DTSCS7D 00548 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS7D 00549 * CORRESPONDENCE SCREEN DTSCS7D 00550 *----------------------------------------------------- DTSCS7D 00551 DTSCS7D 00552 IF LCCM-F14-88 DTSCS7D 00553 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS7D 00554 SET REQ-JUMP TO TRUE DTSCS7D 00555 GO TO P1000-EXIT. DTSCS7D 00556 DTSCS7D 00557 *----------------------------------------------------- DTSCS7D 00558 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS7D 00559 * REQUESTED SCREEN TYPE DTSCS7D 00560 *----------------------------------------------------- DTSCS7D 00561 DTSCS7D 00562 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS7D 00563 NEXT SENTENCE DTSCS7D 00564 ELSE DTSCS7D 00565 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS7D 00566 SET REQ-JUMP TO TRUE DTSCS7D 00567 GO TO P1000-EXIT. DTSCS7D 00568 DTSCS7D 00569 *----------------------------------------------------- DTSCS7D 00570 * IF REQUEST TO UPDATE THE DATA (ADD) DTSCS7D 00571 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS7D 00572 *----------------------------------------------------- DTSCS7D 00573 DTSCS7D 00574 IF LCCM-F09-88 DTSCS7D 00575 IF SCR-ACCESS-UPDATE DTSCS7D 00576 SET REQ-EDIT TO TRUE DTSCS7D 00577 GO TO P1000-EXIT DTSCS7D 00578 ELSE DTSCS7D 00579 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS7D 00580 SET REQ-ERROR TO TRUE DTSCS7D 00581 GO TO P1000-EXIT. DTSCS7D 00582 DTSCS7D 00583 *----------------------------------------------------- DTSCS7D 00584 * IF INQUIRY KEY IS PRESSED (ENTER), INDICATE DTSCS7D 00585 * INQUIRY REQUESTED. DTSCS7D 00586 *----------------------------------------------------- DTSCS7D 00587 DTSCS7D 00588 IF LCCM-ENTER-88 DTSCS7D 00589 SET REQ-INQUIRE TO TRUE DTSCS7D 00590 GO TO P1000-EXIT. DTSCS7D 00591 DTSCS7D 00592 *----------------------------------------------------- DTSCS7D 00593 * ANY OTHER KEY IS INVALID DTSCS7D 00594 *----------------------------------------------------- DTSCS7D 00595 DTSCS7D 00596 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS7D 00597 DTSCS7D 00598 SET REQ-ERROR TO TRUE. DTSCS7D 00599 P1000-EXIT. DTSCS7D 00600 EXIT. DTSCS7D 00601 DTSCS7D 00602 ******************************************************************DTSCS7D 00603 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS7D 00604 ******************************************************************DTSCS7D 00605 DTSCS7D 00606 P1100-UPDATE-LOCKED. DTSCS7D 00607 DTSCS7D 00608 *----------------------------------------------------- DTSCS7D 00609 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS7D 00610 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER OR F9 DTSCS7D 00611 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS7D 00612 *----------------------------------------------------- DTSCS7D 00613 DTSCS7D 00614 IF LCCM-ENTER-88 OR LCCM-F12-88 OR LCCM-F09-88 DTSCS7D 00615 SET REQ-UPDATE TO TRUE DTSCS7D 00616 IF LCCM-F09-88 DTSCS7D 00617 SET LCCM-ENTER-88 TO TRUE DTSCS7D 00618 END-IF DTSCS7D 00619 ELSE DTSCS7D 00620 SET REQ-ERROR TO TRUE DTSCS7D 00621 IF LCCM-SCR-ADD-LOCKED DTSCS7D 00622 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS7D 00623 ELSE DTSCS7D 00624 GO TO S899-ABEND. DTSCS7D 00625 P1100-EXIT. DTSCS7D 00626 EXIT. DTSCS7D 00627 ******************************************************************DTSCS7D 00628 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS7D 00629 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS7D 00630 ******************************************************************DTSCS7D 00631 DTSCS7D 00632 P2000-REQUEST-ERROR. DTSCS7D 00633 IF LCCM-MSG DTSCS7D 00634 SET RESP-SEND-MSGONLY TO TRUE DTSCS7D 00635 ELSE DTSCS7D 00636 GO TO S899-ABEND. DTSCS7D 00637 P2000-EXIT. DTSCS7D 00638 EXIT. DTSCS7D 00639 ******************************************************************DTSCS7D 00640 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS7D 00641 ******************************************************************DTSCS7D 00642 DTSCS7D 00643 P3000-REQUEST-JUMP. DTSCS7D 00644 DTSCS7D 00645 *----------------------------------------------------- DTSCS7D 00646 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS7D 00647 * BY USER DTSCS7D 00648 *----------------------------------------------------- DTSCS7D 00649 DTSCS7D 00650 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS7D 00651 DTSCS7D 00652 *----------------------------------------------------- DTSCS7D 00653 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS7D 00654 *----------------------------------------------------- DTSCS7D 00655 DTSCS7D 00656 IF LCCM-MSG DTSCS7D 00657 SET RESP-SEND-MSGONLY TO TRUE DTSCS7D 00658 SET CURSOR-SET-GOTO TO TRUE DTSCS7D 00659 GO TO P3000-EXIT. DTSCS7D 00660 DTSCS7D 00661 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS7D 00662 DTSCS7D 00663 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS7D 00664 DTSCS7D 00665 IF L018-VALID DTSCS7D 00666 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS7D 00667 DTSCS7D 00668 *----------------------------------------------------- DTSCS7D 00669 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS7D 00670 *----------------------------------------------------- DTSCS7D 00671 DTSCS7D 00672 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS7D 00673 LCCM-SCR-HOLD-AREA. DTSCS7D 00674 DTSCS7D 00675 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS7D 00676 DTSCS7D 00677 SET RESP-JUMP TO TRUE. DTSCS7D 00678 P3000-EXIT. DTSCS7D 00679 EXIT. DTSCS7D 00680 ******************************************************************DTSCS7D 00681 * CLEAR KEY WAS PRESSED *DTSCS7D 00682 ******************************************************************DTSCS7D 00683 DTSCS7D 00684 P4000-REQUEST-CLEAR. DTSCS7D 00685 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7D 00686 DTSCS7D 00687 IF SCR-ACCESS-UPDATE DTSCS7D 00688 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS7D 00689 ELSE DTSCS7D 00690 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS7D 00691 DTSCS7D 00692 *----------------------------------------------------- DTSCS7D 00693 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS7D 00694 * FIELDS FROM EARLIER REQUESTS DTSCS7D 00695 *----------------------------------------------------- DTSCS7D 00696 DTSCS7D 00697 IF LCCM-EMP-NO > ZERO DTSCS7D 00698 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7D 00699 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS7D 00700 DTSCS7D 00701 MOVE ZERO TO LCCM-EMP-NO. DTSCS7D 00702 DTSCS7D 00703 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS7D 00704 DTSCS7D 00705 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7D 00706 DTSCS7D 00707 SET RESP-SEND-MAP TO TRUE. DTSCS7D 00708 P4000-EXIT. DTSCS7D 00709 EXIT. DTSCS7D 00710 DTSCS7D 00711 ******************************************************************DTSCS7D 00712 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS7D 00713 ******************************************************************DTSCS7D 00714 DTSCS7D 00715 P5000-CURSOR-TO-GOTO. DTSCS7D 00716 SET CURSOR-SET-GOTO TO TRUE. DTSCS7D 00717 DTSCS7D 00718 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS7D 00719 P5000-EXIT. DTSCS7D 00720 EXIT. DTSCS7D 00721 DTSCS7D 00722 ******************************************************************DTSCS7D 00723 * INQUIRY WAS REQUESTED *DTSCS7D 00724 ******************************************************************DTSCS7D 00725 DTSCS7D 00726 P6000-REQUEST-INQUIRE. DTSCS7D 00727 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7D 00728 DTSCS7D 00729 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS7D 00730 DTSCS7D 00731 SET RESP-SEND-MAP TO TRUE. DTSCS7D 00732 DTSCS7D 00733 IF SCR-ACCESS-UPDATE DTSCS7D 00734 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS7D 00735 ELSE DTSCS7D 00736 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS7D 00737 DTSCS7D 00738 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS7D 00739 P6000-EXIT. DTSCS7D 00740 EXIT. DTSCS7D 00741 DTSCS7D 00742 ******************************************************************DTSCS7D 00743 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED. *DTSCS7D 00744 ******************************************************************DTSCS7D 00745 DTSCS7D 00746 P7000-REQUEST-EDIT. DTSCS7D 00747 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS7D 00748 DTSCS7D 00749 IF LCCM-F09-88 DTSCS7D 00750 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS7D 00751 ELSE DTSCS7D 00752 GO TO S899-ABEND. DTSCS7D 00753 DTSCS7D 00754 *------------------------------------------------------ DTSCS7D 00755 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS7D 00756 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST DTSCS7D 00757 * REMAIN IN 'CLEAR' STATUS. DTSCS7D 00758 *------------------------------------------------------ DTSCS7D 00759 DTSCS7D 00760 IF LCCM-MSG DTSCS7D 00761 NEXT SENTENCE DTSCS7D 00762 ELSE DTSCS7D 00763 PERFORM S8100-SET-LOCK-ATTRB THRU S8100-EXIT DTSCS7D 00764 IF LCCM-F09-88 DTSCS7D 00765 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS7D 00766 MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID. DTSCS7D 00767 DTSCS7D 00768 SET RESP-SEND-MAP TO TRUE. DTSCS7D 00769 DTSCS7D 00770 P7000-EXIT. DTSCS7D 00771 EXIT. DTSCS7D 00772 ******************************************************************DTSCS7D 00773 * ADD FUNCTION WAS REQUESTED *DTSCS7D 00774 ******************************************************************DTSCS7D 00775 DTSCS7D 00776 P7100-EDIT-ADD. DTSCS7D 00777 *----------------------------------------------------- DTSCS7D 00778 * ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE DTSCS7D 00779 * MAP-EMP-NO IS REQUIRED UNLESS MAP EMPLOYER NAME AND DTSCS7D 00780 * ADDRESS ARE ENTERED. IF BOTH ARE ENTERED, DISPLAY DTSCS7D 00781 * ERROR MESSAGE. DTSCS7D 00782 *----------------------------------------------------- DTSCS7D 00783 DTSCS7D 00784 IF MAP-EMP-NO-1 GREATER SPACES DTSCS7D 00785 OR MAP-EMP-NO-2 GREATER SPACES DTSCS7D 00786 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS7D 00787 DTSCS7D 00788 IF LCCM-MSG DTSCS7D 00789 GO TO P7100-EXIT. DTSCS7D 00790 DTSCS7D 00791 MOVE MAP-FINL-IND-OK TO WRK-FINL-IND-OK. DTSCS7D 00792 DTSCS7D 00793 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS7D 00794 IF LCCM-MSG DTSCS7D 00795 GO TO P7100-EXIT. DTSCS7D 00796 DTSCS7D 00797 IF MAP-MAIL-LABEL EQUAL 'L' DTSCS7D 00798 MOVE L081-CLAIMANT-NAME TO MAP-DE-NAME DTSCS7D 00799 MOVE SPACES TO MAP-DE-ADDR1 DTSCS7D 00800 MOVE SPACES TO MAP-DE-ADDR2 DTSCS7D 00801 MOVE SPACES TO MAP-DE-CITY DTSCS7D 00802 MOVE SPACES TO MAP-DE-STATE DTSCS7D 00803 MOVE SPACES TO MAP-DE-ZIP DTSCS7D 00804 MOVE SPACES TO MAP-DE-ATTN. DTSCS7D 00805 DTSCS7D 00806 P7100-EXIT. DTSCS7D 00807 EXIT. DTSCS7D 00808 ******************************************************************DTSCS7D 00809 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS7D 00810 ******************************************************************DTSCS7D 00811 DTSCS7D 00812 P8000-REQUEST-UPDATE. DTSCS7D 00813 IF LCCM-SCR-ADD-LOCKED DTSCS7D 00814 PERFORM P8100-ADD THRU P8100-EXIT DTSCS7D 00815 ELSE DTSCS7D 00816 GO TO S899-ABEND. DTSCS7D 00817 DTSCS7D 00818 SET RESP-SEND-MAP TO TRUE. DTSCS7D 00819 P8000-EXIT. DTSCS7D 00820 EXIT. DTSCS7D 00821 DTSCS7D 00822 P8100-ADD. DTSCS7D 00823 SET LCCM-SCR-CLEAR TO TRUE. DTSCS7D 00824 DTSCS7D 00825 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS7D 00826 DTSCS7D 00827 IF LCCM-F12-88 DTSCS7D 00828 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS7D 00829 GO TO P8100-EXIT. DTSCS7D 00830 DTSCS7D 00831 IF MAP-EMP-NO-1 NOT GREATER SPACES DTSCS7D 00832 AND MAP-EMP-NO-2 NOT GREATER SPACES DTSCS7D 00833 OR MAP-MAIL-LABEL EQUAL 'L' DTSCS7D 00834 GO TO P8100-ADD-1. DTSCS7D 00835 DTSCS7D 00836 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS7D 00837 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS7D 00838 MOVE ALL '?' TO WRK-MAILING-ADDRESS-AREA. DTSCS7D 00839 DTSCS7D 00840 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME, DTSCS7D 00841 L112-NAME. DTSCS7D 00842 MOVE MTAD-ADDRESS TO L112-ADDRESS. DTSCS7D 00843 DTSCS7D 00844 GO TO P8100-ADD-2. DTSCS7D 00845 DTSCS7D 00846 P8100-ADD-1. DTSCS7D 00847 MOVE MAP-DE-NAME TO L112-PRIMARY-NAME, DTSCS7D 00848 L112-NAME. DTSCS7D 00849 MOVE MAP-DE-ADDR1 TO L112-DELIV-LINE-1. DTSCS7D 00850 MOVE MAP-DE-ADDR2 TO L112-DELIV-LINE-2. DTSCS7D 00851 MOVE MAP-DE-CITY TO L112-CITY. DTSCS7D 00852 MOVE MAP-DE-STATE TO L112-ST. DTSCS7D 00853 MOVE MAP-DE-ZIP TO L112-ZIP. DTSCS7D 00854 MOVE MAP-DE-ATTN TO L112-ATTN-LINE. DTSCS7D 00855 MOVE SPACES TO L112-ADVANCED-BARCODE. DTSCS7D 00856 DTSCS7D 00857 P8100-ADD-2. DTSCS7D 00858 SET L112-TAD-ADDR-88 TO TRUE. DTSCS7D 00859 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSCS7D 00860 DTSCS7D 00861 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS7D 00862 DTSCS7D 00863 MOVE L112-MAILING-ADDRESS TO WRK-MAILING-ADDRESS. DTSCS7D 00864 MOVE L112-ZIP TO WRK-ZIP. DTSCS7D 00865 MOVE L112-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE. DTSCS7D 00866 DTSCS7D 00867 IF MAP-MAIL-LABEL EQUAL 'L' OR 'Y' DTSCS7D 00868 PERFORM P8910-R901-RECORD THRU P8910-EXIT. DTSCS7D 00869 DTSCS7D 00870 IF MAP-MAIL-LABEL NOT EQUAL 'L' DTSCS7D 00871 PERFORM P8980-R751-RECORD THRU P8980-EXIT. DTSCS7D 00872 DTSCS7D 00873 MOVE LOW-VALUES TO MAP-AREA. DTSCS7D 00874 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS7D 00875 IF LCCM-EMP-NO GREATER ZEROS DTSCS7D 00876 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS7D 00877 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS7D 00878 DTSCS7D 00879 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS7D 00880 MOVE ZEROS TO LCCM-EMP-NO. DTSCS7D 00881 DTSCS7D 00882 IF MAP-MAIL-LABEL NOT GREATER SPACES DTSCS7D 00883 AND WRK-NO-DEFAULT NOT EQUAL 'Y' DTSCS7D 00884 MOVE 'Y' TO MAP-MAIL-LABEL. DTSCS7D 00885 P8100-EXIT. DTSCS7D 00886 EXIT. DTSCS7D 00887 DTSCS7D 00888 ***** DTSCS7D 00889 * MACIR901 LABEL REPORT RECORD. DTSCS7D 00890 ***** DTSCS7D 00891 P8910-R901-RECORD. DTSCS7D 00892 SET R901-ON-REQUEST-88 TO TRUE. DTSCS7D 00893 DTSCS7D 00894 MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS7D 00895 DTSCS7D 00896 MOVE +01 TO R901-LABEL-CNT. DTSCS7D 00897 DTSCS7D 00898 MOVE LCCM-RESP-OP-ID TO R901-GRP1-OP-ID. DTSCS7D 00899 DTSCS7D 00900 MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS7D 00901 R901-EMP-NO. DTSCS7D 00902 DTSCS7D 00903 MOVE WRK-MAILING-ADDRESS TO R901-FMT-ADDR. DTSCS7D 00904 DTSCS7D 00905 MOVE WRK-ZIP TO R901-ZIP. DTSCS7D 00906 DTSCS7D 00907 MOVE WRK-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE. DTSCS7D 00908 DTSCS7D 00909 MOVE LENGTH OF R901-REC TO R901-LENGTH. DTSCS7D 00910 DTSCS7D 00911 MOVE R901-REC TO RSKL-REC. DTSCS7D 00912 DTSCS7D 00913 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D 00914 P8910-EXIT. DTSCS7D 00915 EXIT. DTSCS7D 00916 DTSCS7D 00917 ***** DTSCS7D 00918 * MACIR901 ELF LABEL REPORT RECORD. DTSCS7D 00919 ***** DTSCS7D 00920 DTSCS7D 00921 P8980-R751-RECORD. DTSCS7D 00922 MOVE WRK-EMP-NO TO R751-EMP-NO. DTSCS7D 00923 IF WRK-EMP-NO GREATER ZEROS DTSCS7D 00924 MOVE MPRF-PRIMARY-NAME TO R751-EMP-PRIMARY-NAME DTSCS7D 00925 ELSE DTSCS7D 00926 MOVE MAP-DE-NAME TO R751-EMP-PRIMARY-NAME. DTSCS7D 00927 DTSCS7D 00928 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS7D 00929 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS7D 00930 MOVE L020-SSN TO R751-SSN. DTSCS7D 00931 DTSCS7D 00932 MOVE MAP-CLAIMANT-NAME TO R751-CLAIMANT-NAME. DTSCS7D 00933 MOVE LCCM-OP-NAME TO R751-OP-NAME. DTSCS7D 00934 MOVE LCCM-CURR-MAIL-DATE TO R751-MAIL-DATE. DTSCS7D 00935 MOVE LENGTH OF R751-REC TO R751-LENGTH. DTSCS7D 00936 DTSCS7D 00937 IF MAP-WR-YRQ1-YR GREATER SPACES DTSCS7D 00938 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA DTSCS7D 00939 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D 00940 MOVE L016-YRQ TO R751-YRQ DTSCS7D 00941 MOVE R751-REC TO RSKL-REC DTSCS7D 00942 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D 00943 DTSCS7D 00944 IF MAP-WR-YRQ2-YR GREATER SPACES DTSCS7D 00945 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS7D 00946 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D 00947 MOVE L016-YRQ TO R751-YRQ DTSCS7D 00948 MOVE R751-REC TO RSKL-REC DTSCS7D 00949 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D 00950 DTSCS7D 00951 IF MAP-WR-YRQ3-YR GREATER SPACES DTSCS7D 00952 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS7D 00953 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D 00954 MOVE L016-YRQ TO R751-YRQ DTSCS7D 00955 MOVE R751-REC TO RSKL-REC DTSCS7D 00956 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D 00957 DTSCS7D 00958 IF MAP-WR-YRQ4-YR GREATER SPACES DTSCS7D 00959 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS7D 00960 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D 00961 MOVE L016-YRQ TO R751-YRQ DTSCS7D 00962 MOVE R751-REC TO RSKL-REC DTSCS7D 00963 PERFORM S825-WRITE THRU S825-EXIT. DTSCS7D 00964 DTSCS7D 00965 P8980-EXIT. DTSCS7D 00966 EXIT. DTSCS7D 00967 DTSCS7D 00968 ******************************************************************DTSCS7D 00969 * LINKS TO UTILITY MODULES DTSCS7D 00970 ******************************************************************DTSCS7D 00971 DTSCS7D 00972 S001-FROM-FED-8. DTSCS7D 00973 SET L001-FROM-FED-8 TO TRUE. DTSCS7D 00974 GO TO S001-LINK. DTSCS7D 00975 DTSCS7D 00976 S001-FROM-ABS-DAY. DTSCS7D 00977 SET L001-FROM-ABS-DAY TO TRUE. DTSCS7D 00978 GO TO S001-LINK. DTSCS7D 00979 DTSCS7D 00980 S001-LINK. DTSCS7D 00981 EXEC CICS LINK DTSCS7D 00982 PROGRAM ('DTSCU001') DTSCS7D 00983 COMMAREA (L001-COMM-AREA) DTSCS7D 00984 END-EXEC. DTSCS7D 00985 S001-EXIT. DTSCS7D 00986 EXIT. DTSCS7D 00987 DTSCS7D 00988 S004-FROM-5. DTSCS7D 00989 SET L004-FROM-5 TO TRUE. DTSCS7D 00990 GO TO S004-LINK. DTSCS7D 00991 DTSCS7D 00992 S004-FROM-DATE. DTSCS7D 00993 SET L004-FROM-DATE TO TRUE. DTSCS7D 00994 GO TO S004-LINK. DTSCS7D 00995 DTSCS7D 00996 S004-FROM-ABS. DTSCS7D 00997 SET L004-FROM-ABS TO TRUE. DTSCS7D 00998 GO TO S004-LINK. DTSCS7D 00999 DTSCS7D 01000 S004-LINK. DTSCS7D 01001 EXEC CICS LINK DTSCS7D 01002 PROGRAM ('DTSCU004') DTSCS7D 01003 COMMAREA (L004-COMM-AREA) DTSCS7D 01004 END-EXEC. DTSCS7D 01005 S004-EXIT. DTSCS7D 01006 EXIT. DTSCS7D 01007 DTSCS7D 01008 S006-LINK. DTSCS7D 01009 EXEC CICS LINK DTSCS7D 01010 PROGRAM ('DTSCU006') DTSCS7D 01011 COMMAREA (L006-COMM-AREA) DTSCS7D 01012 END-EXEC. DTSCS7D 01013 S006-EXIT. DTSCS7D 01014 EXIT. DTSCS7D 01015 DTSCS7D 01016 S016-YRQ-FROM-SCREEN. DTSCS7D 01017 EXEC CICS LINK DTSCS7D 01018 PROGRAM('DTSCU016') DTSCS7D 01019 COMMAREA(L016-COMM-AREA) DTSCS7D 01020 END-EXEC. DTSCS7D 01021 S016-EXIT. DTSCS7D 01022 EXIT. DTSCS7D 01023 DTSCS7D 01024 S018-EMP-NO-FROM-SCREEN. DTSCS7D 01025 EXEC CICS LINK DTSCS7D 01026 PROGRAM('DTSCU018') DTSCS7D 01027 COMMAREA(L018-COMM-AREA) DTSCS7D 01028 END-EXEC. DTSCS7D 01029 S018-EXIT. DTSCS7D 01030 EXIT. DTSCS7D 01031 DTSCS7D 01032 S020-SCREEN-SSN. DTSCS7D 01033 EXEC CICS LINK DTSCS7D 01034 PROGRAM ('DTSCU020') DTSCS7D 01035 COMMAREA (L020-COMM-AREA) DTSCS7D 01036 END-EXEC. DTSCS7D 01037 S020-EXIT. DTSCS7D 01038 EXIT. DTSCS7D 01039 DTSCS7D 01040 S072-EDIT-ADDRESS. DTSCS7D 01041 EXEC CICS LINK DTSCS7D 01042 PROGRAM ('DTSCU072') DTSCS7D 01043 COMMAREA (L072-COMM-AREA) DTSCS7D 01044 END-EXEC. DTSCS7D 01045 S072-EXIT. DTSCS7D 01046 EXIT. DTSCS7D 01047 DTSCS7D 01048 S081-CLAIMANT-NAME-LOOKUP. DTSCS7D 01049 EXEC CICS LINK DTSCS7D 01050 PROGRAM('DTSCU081') DTSCS7D 01051 COMMAREA(L081-COMM-AREA) DTSCS7D 01052 END-EXEC. DTSCS7D 01053 DTSCS7D 01054 IF L081-FILE-CLOSED DTSCS7D 01055 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01056 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7D 01057 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D 01058 GO TO MAINLINE-EXIT. DTSCS7D 01059 S081-EXIT. DTSCS7D 01060 EXIT. DTSCS7D 01061 DTSCS7D 01062 *S081A-CONVERT-CLAIMANT-NAME. DTSCS7D 01063 * DTSCS7D 01064 * EXEC CICS LINK DTSCS7D 01065 * PROGRAM('ESP072D') DTSCS7D 01066 * COMMAREA(ESP072D-COMM-AREA) DTSCS7D 01067 * LENGTH(COM-LEN) DTSCS7D 01068 * END-EXEC. DTSCS7D 01069 DTSCS7D 01070 *S081A-EXIT. DTSCS7D 01071 EXIT. DTSCS7D 01072 DTSCS7D 01073 S112-ADDR-FORMAT. DTSCS7D 01074 EXEC CICS LINK DTSCS7D 01075 PROGRAM('DTSCU112') DTSCS7D 01076 COMMAREA(L112-COMM-AREA) DTSCS7D 01077 END-EXEC. DTSCS7D 01078 S112-EXIT. DTSCS7D 01079 EXIT. DTSCS7D 01080 DTSCS7D 01081 S803-REQ-SCR-ID-EDIT. DTSCS7D 01082 EXEC CICS LINK DTSCS7D 01083 PROGRAM ('DTSCU803') DTSCS7D 01084 COMMAREA (DFHCOMMAREA) DTSCS7D 01085 END-EXEC. DTSCS7D 01086 S803-EXIT. DTSCS7D 01087 EXIT. DTSCS7D 01088 DTSCS7D 01089 S804-INVALID-KEY. DTSCS7D 01090 EXEC CICS LINK DTSCS7D 01091 PROGRAM ('DTSCU804') DTSCS7D 01092 COMMAREA (DFHCOMMAREA) DTSCS7D 01093 END-EXEC. DTSCS7D 01094 S804-EXIT. DTSCS7D 01095 EXIT. DTSCS7D 01096 DTSCS7D 01097 S805-MSG-AREA. DTSCS7D 01098 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS7D 01099 DTSCS7D 01100 EXEC CICS LINK DTSCS7D 01101 PROGRAM ('DTSCU805') DTSCS7D 01102 COMMAREA (L805-COMM-AREA) DTSCS7D 01103 END-EXEC. DTSCS7D 01104 DTSCS7D 01105 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS7D 01106 S805-EXIT. DTSCS7D 01107 EXIT. DTSCS7D 01108 DTSCS7D 01109 S810-READ. DTSCS7D 01110 SET L810-READ-88 TO TRUE. DTSCS7D 01111 GO TO S810-IO. DTSCS7D 01112 DTSCS7D 01113 S810-START-BROWSE. DTSCS7D 01114 SET L810-START-BROWSE-88 TO TRUE. DTSCS7D 01115 GO TO S810-IO. DTSCS7D 01116 DTSCS7D 01117 S810-READ-NEXT. DTSCS7D 01118 SET L810-READ-NEXT-88 TO TRUE. DTSCS7D 01119 GO TO S810-IO. DTSCS7D 01120 DTSCS7D 01121 S810-READ-PREV. DTSCS7D 01122 SET L810-READ-PREV-88 TO TRUE. DTSCS7D 01123 GO TO S810-IO. DTSCS7D 01124 DTSCS7D 01125 S810-END-BROWSE. DTSCS7D 01126 SET L810-END-BROWSE-88 TO TRUE. DTSCS7D 01127 GO TO S810-IO. DTSCS7D 01128 DTSCS7D 01129 S810-COUNT. DTSCS7D 01130 SET L810-COUNT-88 TO TRUE. DTSCS7D 01131 GO TO S810-IO. DTSCS7D 01132 DTSCS7D 01133 S810-IO. DTSCS7D 01134 EXEC CICS LINK DTSCS7D 01135 PROGRAM ('DTSCU810') DTSCS7D 01136 COMMAREA (L810-COMM-AREA) DTSCS7D 01137 END-EXEC. DTSCS7D 01138 DTSCS7D 01139 IF L810-FILE-CLOSED-88 DTSCS7D 01140 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01141 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7D 01142 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D 01143 GO TO MAINLINE-EXIT. DTSCS7D 01144 S810-EXIT. DTSCS7D 01145 EXIT. DTSCS7D 01146 DTSCS7D 01147 S825-WRITE. DTSCS7D 01148 SET L825-WRITE-88 TO TRUE. DTSCS7D 01149 GO TO S825-O. DTSCS7D 01150 DTSCS7D 01151 S825-O. DTSCS7D 01152 DTSCS7D 01153 EXEC CICS LINK DTSCS7D 01154 PROGRAM ('DTSCU825') DTSCS7D 01155 COMMAREA (L825-COMM-AREA) DTSCS7D 01156 END-EXEC. DTSCS7D 01157 DTSCS7D 01158 IF L825-FILE-CLOSED-88 DTSCS7D 01159 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01160 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS7D 01161 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS7D 01162 GO TO MAINLINE-EXIT. DTSCS7D 01163 S825-EXIT. DTSCS7D 01164 EXIT. DTSCS7D 01165 DTSCS7D 01166 S851-SCREEN-PROCESSING. DTSCS7D 01167 EXEC CICS LINK DTSCS7D 01168 PROGRAM ('DTSCU851') DTSCS7D 01169 COMMAREA (L851-COMM-AREA) DTSCS7D 01170 END-EXEC. DTSCS7D 01171 S851-EXIT. DTSCS7D 01172 EXIT. DTSCS7D 01173 DTSCS7D 01174 S899-ABEND. DTSCS7D 01175 EXEC CICS ABEND DTSCS7D 01176 ABCODE(WRK-ABEND-CD) DTSCS7D 01177 END-EXEC. DTSCS7D 01178 S899-EXIT. DTSCS7D 01179 EXIT. DTSCS7D 01180 DTSCS7D 01181 ******************************************************************DTSCS7D 01182 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS7D 01183 ******************************************************************DTSCS7D 01184 DTSCS7D 01185 S1000-SCREEN-EDITS. DTSCS7D 01186 PERFORM S2600-WAGE-REQUEST THRU S2600-EXIT. DTSCS7D 01187 DTSCS7D 01188 IF LCCM-MSG DTSCS7D 01189 GO TO S1000-EXIT. DTSCS7D 01190 DTSCS7D 01191 IF MAP-SSN-1 NOT GREATER SPACES DTSCS7D 01192 MOVE MSG-E7D1-AREA TO WRK-MSG-AREA DTSCS7D 01193 PERFORM S1195-ERROR THRU S1195-EXIT DTSCS7D 01194 GO TO S1000-EXIT. DTSCS7D 01195 DTSCS7D 01196 IF MAP-MAIL-LABEL NOT EQUAL 'Y' AND 'N' AND 'L' DTSCS7D 01197 MOVE 'Y' TO WRK-NO-DEFAULT DTSCS7D 01198 MOVE MSG-E7D6-AREA TO WRK-MSG-AREA DTSCS7D 01199 PERFORM S1197-ERROR THRU S1197-EXIT DTSCS7D 01200 GO TO S1000-EXIT. DTSCS7D 01201 DTSCS7D 01202 S1000-SE-1. DTSCS7D 01203 IF MAP-MAIL-LABEL EQUAL 'L' DTSCS7D 01204 IF MAP-EMP-NO-1 GREATER SPACES DTSCS7D 01205 OR MAP-EMP-NO-2 GREATER SPACES DTSCS7D 01206 OR MAP-DE-NAME GREATER SPACES DTSCS7D 01207 AND MAP-DE-NAME NOT EQUAL L081-CLAIMANT-NAME DTSCS7D 01208 OR MAP-DE-ADDR1 GREATER SPACES DTSCS7D 01209 AND MAP-DE-ADDR1 NOT EQUAL L081-CLAIMANT-STREET DTSCS7D 01210 OR MAP-DE-ADDR2 GREATER SPACES DTSCS7D 01211 OR MAP-DE-CITY GREATER SPACES DTSCS7D 01212 AND MAP-DE-CITY NOT EQUAL L081-CLAIMANT-CITY DTSCS7D 01213 OR MAP-DE-STATE GREATER SPACES DTSCS7D 01214 AND MAP-DE-STATE NOT EQUAL L081-CLAIMANT-STATE DTSCS7D 01215 OR MAP-DE-ZIP GREATER SPACES DTSCS7D 01216 AND MAP-DE-ZIP NOT EQUAL L081-CLAIMANT-ZIP (1:5) DTSCS7D 01217 OR MAP-DE-ATTN GREATER SPACES DTSCS7D 01218 OR MAP-WR-YRQ1-YR GREATER SPACES DTSCS7D 01219 OR MAP-WR-YRQ1-Q GREATER SPACES DTSCS7D 01220 OR MAP-WR-YRQ2-YR GREATER SPACES DTSCS7D 01221 OR MAP-WR-YRQ2-Q GREATER SPACES DTSCS7D 01222 OR MAP-WR-YRQ3-YR GREATER SPACES DTSCS7D 01223 OR MAP-WR-YRQ3-Q GREATER SPACES DTSCS7D 01224 OR MAP-WR-YRQ4-YR GREATER SPACES DTSCS7D 01225 OR MAP-WR-YRQ4-Q GREATER SPACES DTSCS7D 01226 MOVE MSG-E7D9-AREA TO WRK-MSG-AREA DTSCS7D 01227 PERFORM S1194-ERROR THRU S1194-EXIT DTSCS7D 01228 GO TO S1000-EXIT DTSCS7D 01229 ELSE DTSCS7D 01230 GO TO S1000-EXIT. DTSCS7D 01231 DTSCS7D 01232 IF MAP-EMP-NO-1 NOT GREATER SPACES DTSCS7D 01233 AND MAP-EMP-NO-2 NOT GREATER SPACES DTSCS7D 01234 AND MAP-DE-NAME NOT GREATER SPACES DTSCS7D 01235 AND MAP-DE-ADDR1 NOT GREATER SPACES DTSCS7D 01236 AND MAP-DE-ADDR2 NOT GREATER SPACES DTSCS7D 01237 AND MAP-DE-CITY NOT GREATER SPACES DTSCS7D 01238 AND MAP-DE-STATE NOT GREATER SPACES DTSCS7D 01239 AND MAP-DE-ZIP NOT GREATER SPACES DTSCS7D 01240 AND MAP-DE-ATTN NOT GREATER SPACES DTSCS7D 01241 MOVE MSG-E7D3-AREA TO WRK-MSG-AREA DTSCS7D 01242 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D 01243 GO TO S1000-EXIT. DTSCS7D 01244 DTSCS7D 01245 IF (MAP-EMP-NO-1 GREATER SPACES DTSCS7D 01246 OR MAP-EMP-NO-2 GREATER SPACES) DTSCS7D 01247 AND (MAP-DE-NAME GREATER SPACES DTSCS7D 01248 OR MAP-DE-ADDR1 GREATER SPACES DTSCS7D 01249 OR MAP-DE-ADDR1 GREATER SPACES DTSCS7D 01250 OR MAP-DE-CITY GREATER SPACES DTSCS7D 01251 OR MAP-DE-STATE GREATER SPACES DTSCS7D 01252 OR MAP-DE-ZIP GREATER SPACES DTSCS7D 01253 OR MAP-DE-ATTN GREATER SPACES) DTSCS7D 01254 MOVE MSG-E7D4-AREA TO WRK-MSG-AREA DTSCS7D 01255 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D 01256 GO TO S1000-EXIT. DTSCS7D 01257 DTSCS7D 01258 IF MAP-EMP-NO-1 GREATER SPACES DTSCS7D 01259 OR MAP-EMP-NO-2 GREATER SPACES DTSCS7D 01260 PERFORM S1110-READ-MPRF THRU S1110-EXIT DTSCS7D 01261 IF WRK-MPRF-NO-88 DTSCS7D 01262 MOVE MSG-E7D8-AREA TO WRK-MSG-AREA DTSCS7D 01263 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D 01264 GO TO S1000-EXIT DTSCS7D 01265 ELSE DTSCS7D 01266 MOVE WRK-EMP-NO TO LCCM-EMP-NO DTSCS7D 01267 GO TO S1000-EXIT. DTSCS7D 01268 DTSCS7D 01269 IF MAP-MAIL-LABEL EQUAL 'N' DTSCS7D 01270 IF MAP-DE-NAME GREATER SPACES DTSCS7D 01271 GO TO S1000-EXIT DTSCS7D 01272 ELSE DTSCS7D 01273 MOVE MSG-E7D10-AREA TO WRK-MSG-AREA DTSCS7D 01274 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D 01275 GO TO S1000-EXIT. DTSCS7D 01276 DTSCS7D 01277 IF MAP-DE-NAME NOT GREATER SPACES DTSCS7D 01278 OR MAP-DE-ADDR1 NOT GREATER SPACES DTSCS7D 01279 OR MAP-DE-CITY NOT GREATER SPACES DTSCS7D 01280 OR MAP-DE-STATE NOT GREATER SPACES DTSCS7D 01281 OR MAP-DE-STATE NOT ALPHABETIC DTSCS7D 01282 OR MAP-DE-ZIP NOT GREATER SPACES DTSCS7D 01283 MOVE MSG-E7D5-AREA TO WRK-MSG-AREA DTSCS7D 01284 PERFORM S1198-ERROR THRU S1198-EXIT DTSCS7D 01285 GO TO S1000-EXIT. DTSCS7D 01286 DTSCS7D 01287 PERFORM S1200-FORMAT-FINALIST THRU S1200-EXIT. DTSCS7D 01288 DTSCS7D 01289 IF L072-ADDRESS-VALID-88 DTSCS7D 01290 MOVE 'ADDRESS MADE STANDARD BY FINALIST' TO DTSCS7D 01291 MAP-FINL-LITERAL. DTSCS7D 01292 DTSCS7D 01293 IF L072-ADDRESS-VALID-88 DTSCS7D 01294 OR WRK-FINL-IND-OK EQUAL 'Y' DTSCS7D 01295 MOVE L072-ATTN-LINE TO MAP-DE-ATTN DTSCS7D 01296 MOVE L072-DELIV-LINE-1 TO MAP-DE-ADDR1 DTSCS7D 01297 MOVE L072-DELIV-LINE-2 TO MAP-DE-ADDR2 DTSCS7D 01298 MOVE L072-CITY TO MAP-DE-CITY DTSCS7D 01299 MOVE L072-ST TO MAP-DE-STATE DTSCS7D 01300 MOVE L072-ZIP (1:5) TO MAP-DE-ZIP DTSCS7D 01301 MOVE L072-ZIP (7:4) TO MAP-ZIP-W4 DTSCS7D 01302 ELSE DTSCS7D 01303 MOVE MSG-E7D7-AREA TO WRK-MSG-AREA DTSCS7D 01304 PERFORM S1196-ERROR THRU S1196-EXIT. DTSCS7D 01305 DTSCS7D 01306 S1000-EXIT. DTSCS7D 01307 EXIT. DTSCS7D 01308 DTSCS7D 01309 S1100-EDIT-KEY. DTSCS7D 01310 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS7D 01311 S1100-EXIT. DTSCS7D 01312 EXIT. DTSCS7D 01313 DTSCS7D 01314 S1101-EMP-NO. DTSCS7D 01315 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS7D 01316 DTSCS7D 01317 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS7D 01318 DTSCS7D 01319 IF L018-NO-ENTRY DTSCS7D 01320 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D 01321 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D 01322 GO TO S1101-EXIT. DTSCS7D 01323 DTSCS7D 01324 IF L018-NOT-VALID DTSCS7D 01325 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D 01326 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS7D 01327 GO TO S1101-EXIT. DTSCS7D 01328 DTSCS7D 01329 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS7D 01330 S1101-EXIT. DTSCS7D 01331 EXIT. DTSCS7D 01332 DTSCS7D 01333 S1110-READ-MPRF. DTSCS7D 01334 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS7D 01335 DTSCS7D 01336 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS7D 01337 DTSCS7D 01338 SET MPRF-PRF-88 TO TRUE. DTSCS7D 01339 DTSCS7D 01340 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS7D 01341 DTSCS7D 01342 PERFORM S810-READ THRU S810-EXIT. DTSCS7D 01343 DTSCS7D 01344 IF L810-NO-REC-88 DTSCS7D 01345 SET WRK-MPRF-NO-88 TO TRUE DTSCS7D 01346 ELSE DTSCS7D 01347 MOVE MSKL-REC TO MPRF-REC DTSCS7D 01348 SET WRK-MPRF-YES-88 TO TRUE DTSCS7D 01349 PERFORM S1120-READ-MTAD THRU S1120-EXIT. DTSCS7D 01350 S1110-EXIT. DTSCS7D 01351 EXIT. DTSCS7D 01352 DTSCS7D 01353 S1120-READ-MTAD. DTSCS7D 01354 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS7D 01355 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS7D 01356 SET MTAD-TAD-88 TO TRUE. DTSCS7D 01357 MOVE +001 TO MTAD-ID-NO. DTSCS7D 01358 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS7D 01359 DTSCS7D 01360 PERFORM S810-READ THRU S810-EXIT. DTSCS7D 01361 IF L810-NO-REC-88 DTSCS7D 01362 GO TO S899-ABEND. DTSCS7D 01363 DTSCS7D 01364 MOVE MSKL-REC TO MTAD-REC. DTSCS7D 01365 S1120-EXIT. EXIT. DTSCS7D 01366 DTSCS7D 01367 S1194-ERROR. DTSCS7D 01368 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-LABEL-A. DTSCS7D 01369 DTSCS7D 01370 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS7D 01371 MOVE CATB-CURSOR TO MAP-MAIL-LABEL-L. DTSCS7D 01372 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01373 S1194-EXIT. DTSCS7D 01374 EXIT. DTSCS7D 01375 DTSCS7D 01376 S1195-ERROR. DTSCS7D 01377 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A, DTSCS7D 01378 MAP-SSN-2-A, DTSCS7D 01379 MAP-SSN-3-A. DTSCS7D 01380 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS7D 01381 MOVE CATB-CURSOR TO MAP-SSN-1-L. DTSCS7D 01382 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01383 S1195-EXIT. DTSCS7D 01384 EXIT. DTSCS7D 01385 DTSCS7D 01386 S1196-ERROR. DTSCS7D 01387 MOVE DTSCS7D 01388 'FINALIST COULD NOT CONFIRM ADDRESS, ACCEPT? (Y OR N)' TO DTSCS7D 01389 MAP-FINL-LITERAL. DTSCS7D 01390 DTSCS7D 01391 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS7D 01392 MOVE CATB-CURSOR TO MAP-FINL-IND-OK-L. DTSCS7D 01393 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FINL-LITERAL-A. DTSCS7D 01394 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FINL-IND-OK-A. DTSCS7D 01395 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01396 S1196-EXIT. DTSCS7D 01397 EXIT. DTSCS7D 01398 DTSCS7D 01399 S1197-ERROR. DTSCS7D 01400 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-LABEL-A. DTSCS7D 01401 DTSCS7D 01402 IF LCCM-NO-MSG DTSCS7D 01403 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01404 MOVE CATB-CURSOR TO MAP-MAIL-LABEL-L DTSCS7D 01405 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01406 S1197-EXIT. DTSCS7D 01407 EXIT. DTSCS7D 01408 DTSCS7D 01409 S1198-ERROR. DTSCS7D 01410 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DE-NAME-A DTSCS7D 01411 MAP-DE-ADDR1-A DTSCS7D 01412 MAP-DE-ADDR2-A DTSCS7D 01413 MAP-DE-CITY-A DTSCS7D 01414 MAP-DE-STATE-A DTSCS7D 01415 MAP-DE-ZIP-A, DTSCS7D 01416 MAP-DE-ATTN-A. DTSCS7D 01417 IF LCCM-NO-MSG DTSCS7D 01418 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01419 MOVE CATB-CURSOR TO MAP-DE-NAME-L DTSCS7D 01420 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01421 S1198-EXIT. DTSCS7D 01422 EXIT. DTSCS7D 01423 DTSCS7D 01424 S1199-ERROR. DTSCS7D 01425 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS7D 01426 MAP-EMP-NO-2-A. DTSCS7D 01427 DTSCS7D 01428 IF LCCM-NO-MSG DTSCS7D 01429 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01430 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS7D 01431 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01432 S1199-EXIT. DTSCS7D 01433 EXIT. DTSCS7D 01434 DTSCS7D 01435 S1200-FORMAT-FINALIST. DTSCS7D 01436 SET L072-MTAD-88 TO TRUE. DTSCS7D 01437 MOVE SPACE TO L072-ADDRESS. DTSCS7D 01438 MOVE MAP-DE-NAME TO L072-NAME. DTSCS7D 01439 MOVE MAP-DE-ATTN TO L072-ATTN-LINE. DTSCS7D 01440 MOVE MAP-DE-ADDR1 TO L072-DELIV-LINE-1. DTSCS7D 01441 MOVE MAP-DE-ADDR2 TO L072-DELIV-LINE-2. DTSCS7D 01442 MOVE MAP-DE-CITY TO L072-CITY. DTSCS7D 01443 MOVE MAP-DE-STATE TO L072-ST. DTSCS7D 01444 MOVE MAP-DE-ZIP TO L072-ZIP. DTSCS7D 01445 DTSCS7D 01446 PERFORM S072-EDIT-ADDRESS THRU S072-EXIT. DTSCS7D 01447 DTSCS7D 01448 S1200-EXIT. DTSCS7D 01449 EXIT. DTSCS7D 01450 DTSCS7D 01451 S1301-ERROR. DTSCS7D 01452 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-LABEL-A. DTSCS7D 01453 DTSCS7D 01454 IF LCCM-NO-MSG DTSCS7D 01455 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01456 MOVE CATB-CURSOR TO MAP-MAIL-LABEL-L DTSCS7D 01457 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01458 S1301-EXIT. DTSCS7D 01459 EXIT. DTSCS7D 01460 DTSCS7D 01461 S2600-WAGE-REQUEST. DTSCS7D 01462 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS7D 01463 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS7D 01464 IF L020-NO-ENTRY DTSCS7D 01465 GO TO S2600-EXIT DTSCS7D 01466 ELSE DTSCS7D 01467 IF L020-NOT-VALID DTSCS7D 01468 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D 01469 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS7D 01470 GO TO S2600-EXIT. DTSCS7D 01471 DTSCS7D 01472 MOVE L020-SSN TO L081-CLAIMANT-SSN. DTSCS7D 01473 PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT. DTSCS7D 01474 IF L081-NAME-FOUND DTSCS7D 01475 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME DTSCS7D 01476 ELSE DTSCS7D 01477 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS7D 01478 MOVE MSG-E7D2-AREA TO WRK-MSG-AREA DTSCS7D 01479 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS7D 01480 GO TO S2600-EXIT. DTSCS7D 01481 DTSCS7D 01482 MOVE LCCM-CURR-RUN-DATE TO L004-DATE. DTSCS7D 01483 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSCS7D 01484 ADD +4 TO L004-ABS-QTR. DTSCS7D 01485 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS7D 01486 DTSCS7D 01487 IF MAP-MAIL-LABEL EQUAL 'L' DTSCS7D 01488 GO TO S2600-EXIT. DTSCS7D 01489 DTSCS7D 01490 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA. DTSCS7D 01491 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS7D 01492 IF L016-NO-ENTRY DTSCS7D 01493 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D 01494 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS7D 01495 GO TO S2600-EXIT DTSCS7D 01496 ELSE DTSCS7D 01497 IF L016-NOT-VALID DTSCS7D 01498 OR L016-YRQ > L004-QTR-5-9 DTSCS7D 01499 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D 01500 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS7D 01501 GO TO S2600-EXIT. DTSCS7D 01502 DTSCS7D 01503 IF MAP-WR-YRQ2-YR NOT GREATER SPACES DTSCS7D 01504 AND MAP-WR-YRQ2-Q NOT GREATER SPACES DTSCS7D 01505 GO TO S2600-CHECK-YRQ3. DTSCS7D 01506 DTSCS7D 01507 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS7D 01508 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D 01509 IF L016-NO-ENTRY DTSCS7D 01510 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D 01511 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS7D 01512 GO TO S2600-EXIT DTSCS7D 01513 ELSE DTSCS7D 01514 IF L016-NOT-VALID DTSCS7D 01515 OR L016-YRQ > L004-QTR-5-9 DTSCS7D 01516 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D 01517 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS7D 01518 GO TO S2600-EXIT. DTSCS7D 01519 DTSCS7D 01520 S2600-CHECK-YRQ3. DTSCS7D 01521 IF MAP-WR-YRQ3-YR NOT GREATER SPACES DTSCS7D 01522 AND MAP-WR-YRQ3-Q NOT GREATER SPACES DTSCS7D 01523 GO TO S2600-CHECK-YRQ4. DTSCS7D 01524 DTSCS7D 01525 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS7D 01526 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D 01527 IF L016-NO-ENTRY DTSCS7D 01528 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D 01529 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS7D 01530 GO TO S2600-EXIT DTSCS7D 01531 ELSE DTSCS7D 01532 IF L016-NOT-VALID DTSCS7D 01533 OR L016-YRQ > L004-QTR-5-9 DTSCS7D 01534 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D 01535 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS7D 01536 GO TO S2600-EXIT. DTSCS7D 01537 DTSCS7D 01538 S2600-CHECK-YRQ4. DTSCS7D 01539 IF MAP-WR-YRQ4-YR NOT GREATER SPACES DTSCS7D 01540 AND MAP-WR-YRQ4-Q NOT GREATER SPACES DTSCS7D 01541 GO TO S2600-EXIT. DTSCS7D 01542 DTSCS7D 01543 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS7D 01544 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS7D 01545 IF L016-NO-ENTRY DTSCS7D 01546 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS7D 01547 PERFORM S2605-ERROR THRU S2605-EXIT DTSCS7D 01548 GO TO S2600-EXIT DTSCS7D 01549 ELSE DTSCS7D 01550 IF L016-NOT-VALID DTSCS7D 01551 OR L016-YRQ > L004-QTR-5-9 DTSCS7D 01552 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS7D 01553 PERFORM S2605-ERROR THRU S2605-EXIT DTSCS7D 01554 GO TO S2600-EXIT. DTSCS7D 01555 S2600-EXIT. DTSCS7D 01556 EXIT. DTSCS7D 01557 DTSCS7D 01558 S2601-ERROR. DTSCS7D 01559 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A DTSCS7D 01560 MAP-SSN-2-A DTSCS7D 01561 MAP-SSN-3-A. DTSCS7D 01562 IF LCCM-NO-MSG DTSCS7D 01563 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01564 MOVE CATB-CURSOR TO MAP-SSN-1-L DTSCS7D 01565 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01566 S2601-EXIT. EXIT. DTSCS7D 01567 DTSCS7D 01568 S2602-ERROR. DTSCS7D 01569 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ1-YR-A DTSCS7D 01570 MAP-WR-YRQ1-Q-A. DTSCS7D 01571 IF LCCM-NO-MSG DTSCS7D 01572 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01573 MOVE CATB-CURSOR TO MAP-WR-YRQ1-YR-L DTSCS7D 01574 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01575 S2602-EXIT. DTSCS7D 01576 EXIT. DTSCS7D 01577 S2603-ERROR. DTSCS7D 01578 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ2-YR-A DTSCS7D 01579 MAP-WR-YRQ2-Q-A. DTSCS7D 01580 IF LCCM-NO-MSG DTSCS7D 01581 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01582 MOVE CATB-CURSOR TO MAP-WR-YRQ2-YR-L DTSCS7D 01583 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01584 S2603-EXIT. DTSCS7D 01585 EXIT. DTSCS7D 01586 S2604-ERROR. DTSCS7D 01587 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ3-YR-A DTSCS7D 01588 MAP-WR-YRQ3-Q-A. DTSCS7D 01589 IF LCCM-NO-MSG DTSCS7D 01590 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01591 MOVE CATB-CURSOR TO MAP-WR-YRQ3-YR-L DTSCS7D 01592 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01593 S2604-EXIT. DTSCS7D 01594 EXIT. DTSCS7D 01595 S2605-ERROR. DTSCS7D 01596 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ4-YR-A DTSCS7D 01597 MAP-WR-YRQ4-Q-A. DTSCS7D 01598 IF LCCM-NO-MSG DTSCS7D 01599 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS7D 01600 MOVE CATB-CURSOR TO MAP-WR-YRQ4-YR-L DTSCS7D 01601 SET CURSOR-SET-YES TO TRUE. DTSCS7D 01602 S2605-EXIT. DTSCS7D 01603 EXIT. DTSCS7D 01604 EJECT DTSCS7D 01605 DTSCS7D 01606 S8100-SET-LOCK-ATTRB. DTSCS7D 01607 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS7D 01608 WRK-ATB-NUM. DTSCS7D 01609 DTSCS7D 01610 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS7D 01611 DTSCS7D 01612 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS7D 01613 MAP-EMP-NO-2-A DTSCS7D 01614 MAP-GOTO-A. DTSCS7D 01615 S8100-EXIT. DTSCS7D 01616 EXIT. DTSCS7D 01617 DTSCS7D 01618 ******************************************************************DTSCS7D 01619 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS7D 01620 ******************************************************************DTSCS7D 01621 S8200-SET-UPDATE-ATTRB. DTSCS7D 01622 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS7D 01623 DTSCS7D 01624 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS7D 01625 DTSCS7D 01626 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS7D 01627 S8200-EXIT. DTSCS7D 01628 EXIT. DTSCS7D 01629 DTSCS7D 01630 ******************************************************************DTSCS7D 01631 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS7D 01632 ******************************************************************DTSCS7D 01633 S8300-SET-INQ-ATTRB. DTSCS7D 01634 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS7D 01635 WRK-ATB-NUM. DTSCS7D 01636 DTSCS7D 01637 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS7D 01638 S8300-EXIT. DTSCS7D 01639 EXIT. DTSCS7D 01640 DTSCS7D 01641 S8900-SET-ATTRB. DTSCS7D 01642 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS7D 01643 MAP-EMP-NO-2-A. DTSCS7D 01644 DTSCS7D 01645 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A, DTSCS7D 01646 MAP-TELEPHONE-A, DTSCS7D 01647 MAP-CLAIMANT-NAME-A DTSCS7D 01648 MAP-FINL-LITERAL-A. DTSCS7D 01649 DTSCS7D 01650 MOVE WRK-ATB-NUM TO MAP-SSN-1-A DTSCS7D 01651 MAP-SSN-2-A DTSCS7D 01652 MAP-SSN-3-A DTSCS7D 01653 MAP-WR-YRQ1-YR-A DTSCS7D 01654 MAP-WR-YRQ1-Q-A DTSCS7D 01655 MAP-WR-YRQ2-YR-A DTSCS7D 01656 MAP-WR-YRQ2-Q-A DTSCS7D 01657 MAP-WR-YRQ3-YR-A DTSCS7D 01658 MAP-WR-YRQ3-Q-A DTSCS7D 01659 MAP-WR-YRQ4-YR-A DTSCS7D 01660 MAP-WR-YRQ4-Q-A. DTSCS7D 01661 DTSCS7D 01662 MOVE WRK-ATB-AN TO MAP-DE-NAME-A DTSCS7D 01663 MAP-DE-ADDR1-A DTSCS7D 01664 MAP-DE-ADDR2-A DTSCS7D 01665 MAP-DE-CITY-A DTSCS7D 01666 MAP-DE-STATE-A DTSCS7D 01667 MAP-DE-ZIP-A DTSCS7D 01668 MAP-DE-ATTN-A DTSCS7D 01669 MAP-MAIL-LABEL-A DTSCS7D 01670 MAP-FINL-IND-OK-A. DTSCS7D 01671 DTSCS7D 01672 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS7D 01673 S8900-EXIT. DTSCS7D 01674 EXIT. DTSCS7D 01675 DTSCS7D 01676 ******************************************************************DTSCS7D 01677 * MAP ROUTINES *DTSCS7D 01678 ******************************************************************DTSCS7D 01679 S9100-RECEIVE. DTSCS7D 01680 SET L851-RECEIVE-88 TO TRUE. DTSCS7D 01681 DTSCS7D 01682 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS7D 01683 DTSCS7D 01684 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7D 01685 DTSCS7D 01686 MOVE L851-AID TO LCCM-AID. DTSCS7D 01687 DTSCS7D 01688 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS7D 01689 S9100-EXIT. DTSCS7D 01690 EXIT. DTSCS7D 01691 DTSCS7D 01692 S9200-SEND-DATAONLY. DTSCS7D 01693 MOVE LOW-VALUES TO MAP-AREA. DTSCS7D 01694 DTSCS7D 01695 IF LCCM-NO-MSG DTSCS7D 01696 NEXT SENTENCE DTSCS7D 01697 ELSE DTSCS7D 01698 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS7D 01699 DTSCS7D 01700 IF CURSOR-SET-GOTO DTSCS7D 01701 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS7D 01702 ELSE DTSCS7D 01703 MOVE CATB-CURSOR TO MAP-SSN-1-L. DTSCS7D 01704 DTSCS7D 01705 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS7D 01706 DTSCS7D 01707 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS7D 01708 DTSCS7D 01709 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7D 01710 S9200-EXIT. DTSCS7D 01711 EXIT. DTSCS7D 01712 DTSCS7D 01713 S9300-SEND-MAP. DTSCS7D 01714 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS7D 01715 DTSCS7D 01716 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS7D 01717 DTSCS7D 01718 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS7D 01719 DTSCS7D 01720 IF SCR-ACCESS-UPDATE DTSCS7D 01721 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS7D 01722 ELSE DTSCS7D 01723 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS7D 01724 DTSCS7D 01725 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS7D 01726 DTSCS7D 01727 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS7D 01728 DTSCS7D 01729 IF CURSOR-SET-NO DTSCS7D 01730 MOVE CATB-CURSOR TO MAP-SSN-1-L. DTSCS7D 01731 DTSCS7D 01732 SET L851-SEND-88 TO TRUE. DTSCS7D 01733 DTSCS7D 01734 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS7D 01735 DTSCS7D 01736 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS7D 01737 S9300-EXIT. DTSCS7D 01738 EXIT. DTSCS7D 01739 DTSCS7D 01740 S9310-UPDATE-FKEYS. DTSCS7D 01741 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS7D 01742 DTSCS7D 01743 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS7D 01744 DTSCS7D 01745 IF LCCM-SCR-CLEAR DTSCS7D 01746 NEXT SENTENCE DTSCS7D 01747 ELSE DTSCS7D 01748 IF LCCM-SCR-INQUIRE DTSCS7D 01749 NEXT SENTENCE DTSCS7D 01750 ELSE DTSCS7D 01751 IF LCCM-SCR-UPDATE-LOCKED DTSCS7D 01752 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS7D 01753 ELSE DTSCS7D 01754 NEXT SENTENCE. DTSCS7D 01755 S9310-EXIT. DTSCS7D 01756 EXIT. DTSCS7D 01757 DTSCS7D 01758 S9320-INQUIRY-FKEYS. DTSCS7D 01759 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS7D 01760 DTSCS7D 01761 S9320-EXIT. DTSCS7D 01762 EXIT. DTSCS7D 01763 DTSCS7D 01764 S9330-DSCR-FIELDS. DTSCS7D 01765 MOVE LOW-VALUES TO MAP-PRIMARY-NAME, DTSCS7D 01766 MAP-CLAIMANT-NAME, DTSCS7D 01767 MAP-TELEPHONE. DTSCS7D 01768 DTSCS7D 01769 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME CL**2 01770 DTSCS7D 01771 IF WRK-MPRF-YES-88 DTSCS7D 01772 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS7D 01773 MOVE MTAD-VOICE-1-AREA-CD TO WRK-VOICE-AREA-CD DTSCS7D 01774 MOVE MTAD-VOICE-1-PREFIX TO WRK-VOICE-PREFIX DTSCS7D 01775 MOVE MTAD-VOICE-1-SUFFIX TO WRK-VOICE-SUFFIX DTSCS7D 01776 MOVE WRK-TELEPHONE-AREA TO MAP-TELEPHONE DTSCS7D 01777 ELSE DTSCS7D 01778 IF WRK-MPRF-NO-88 DTSCS7D 01779 MOVE '*** NOT FOUND ***' TO MAP-PRIMARY-NAME. DTSCS7D 01780 S9330-EXIT. DTSCS7D 01781 EXIT. DTSCS7D 01782 DTSCS7D 01783 S9900-PREPARE-SEND. DTSCS7D 01784 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS7D 01785 LCCM-SCR-ID. DTSCS7D 01786 DTSCS7D 01787 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS7D 01788 DTSCS7D 01789 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS7D 01790 DTSCS7D 01791 IF MAP-MAIL-LABEL NOT GREATER SPACES DTSCS7D 01792 AND WRK-NO-DEFAULT NOT EQUAL 'Y' DTSCS7D 01793 MOVE 'Y' TO MAP-MAIL-LABEL. DTSCS7D 01794 S9900-EXIT. DTSCS7D 01795 EXIT. DTSCS7D