00001 IDENTIFICATION DIVISION. 11/16/00 00002 PROGRAM-ID. DTSCS77. DTSCS77 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV049 00004 DATE-WRITTEN. MAY 1994. DTSCS77 00005 DATE-COMPILED. DTSCS77 00006 SKIP3 DTSCS77 00007 ***** DTSCS77 00008 * DTSCS77 00009 * FUNCTION: CORRESPONDENCE QUEUE INITIATION DTSCS77 00010 * SCREEN PROCESSOR. DTSCS77 00011 * DTSCS77 00012 * DTSCS77 00013 * MODIFICATION LOG: DTSCS77 00014 * DTSCS77 00015 * 10/02/98 INITIAL DEVELOPMENT. COPIED FROM MACCS77 DTSCS77 00016 * WORK ORDER: PROGRAMMER: ZL1. DTSCS77 00017 * DTSCS77 00018 * 06/22/1999 FOPR-EMAIL-ADDRESS AND FFID-EMAIL-ADDRESS TO DTSCS77 00019 * CORRESPONDENCE QUEUE RECORD - PER DC DTSCS77 00020 * SPECIFICATIONS. DTSCS77 00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCS77 00022 * DTSCS77 00023 * 09/14/1999 PER A REQUEST FROM KAMI PEEL, CHANGED THE DTSCS77 00024 * CORRESPONDENCE QUEUE RECORD FIELD SEPARATOR DTSCS77 00025 * CHARACTER FROM '^' TO '*'. ATTEMPT TO DTSCS77 00026 * COMPENSATE FOR BUGS IN EXTRA! 6.4. DTSCS77 00027 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCS77 00028 * DTSCS77 00029 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS77 00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS77 00031 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS77 00032 * DTSCS77 00033 * DTSCS77 00034 * DESCRIPTION: DTSCS77 00035 * DTSCS77 00036 * DTSCS77 00037 * CLEAR: DTSCS77 00038 * DTSCS77 00039 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS77 00040 * DTSCS77 00041 * DTSCS77 00042 * JUMP: DTSCS77 00043 * DTSCS77 00044 * NONE. DTSCS77 00045 * DTSCS77 00046 * DTSCS77 00047 * INQUIRY: DTSCS77 00048 * DTSCS77 00049 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS77 00050 * DTSCS77 00051 * JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO.DTSCS77 00052 * DTSCS77 00053 * ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS77 00054 * DTSCS77 00055 * STANDARD LCCM-EMP-NO. DTSCS77 00056 * DTSCS77 00057 * DTSCS77 00058 * UPDATE: DTSCS77 00059 * DTSCS77 00060 * ADD DTSCS77 00061 * DTSCS77 00062 * DOES NOT UPDATE THE MASTER FILE. RATHER, WRITES ONE DTSCS77 00063 * CORRESPONDENCE RECORD TO THE VSAM KSDS WORK FILE. DTSCS77 00064 * DTSCS77 00065 * OPERATION SHOULD BE SIMILAR TO 'ADD' FUNCTION ON DTSCS77 00066 * OTHER SCREENS (F09, CONFIRM OR CANCEL). DTSCS77 00067 * DTSCS77 00068 * DTSCS77 00069 * RECORDS READ: DTSCS77 00070 * DTSCS77 00071 * MASTER: DTSCS77 00072 * DTSCS77 00073 * MPRF DTSCS77 00074 * MLIN DTSCS77 00075 * MDPC DTSCS77 00076 * MOPO DTSCS77 00077 * DTSCS77 00078 * DTSCS77 00079 * ALTERNATE INDEX: DTSCS77 00080 * DTSCS77 00081 * NONE. DTSCS77 00082 * DTSCS77 00083 * DTSCS77 00084 * REFERENCE: DTSCS77 00085 * DTSCS77 00086 * NONE. DTSCS77 00087 * DTSCS77 00088 * DTSCS77 00089 * ACCOUNTING TRANSACTION COLLECTION: DTSCS77 00090 * DTSCS77 00091 * NONE. DTSCS77 00092 * DTSCS77 00093 * DTSCS77 00094 * RECORDS UPDATED: DTSCS77 00095 * DTSCS77 00096 * MASTER: DTSCS77 00097 * DTSCS77 00098 * MEVL (WRITE) DTSCS77 00099 * MTCK (WRITE) DTSCS77 00100 * DTSCS77 00101 * DTSCS77 00102 * REFERENCE: DTSCS77 00103 * DTSCS77 00104 * NONE. DTSCS77 00105 * DTSCS77 00106 * DTSCS77 00107 * ACCOUNTING TRANSACTION COLLECTION: DTSCS77 00108 * DTSCS77 00109 * NONE. DTSCS77 00110 * DTSCS77 00111 * DTSCS77 00112 * VSAM KSDS WORK FILE RECORDS WRITTEN: DTSCS77 00113 * DTSCS77 00114 * DTSIVCOR CORRESPONDENCE QUEUE RECORD. DTSCS77 00115 * DTSCS77 00116 * DTSCS77 00117 * TEMPORARY STORAGE USAGE: DTSCS77 00118 * DTSCS77 00119 * NONE. DTSCS77 00120 * DTSCS77 00121 * DTSCS77 00122 * MODULES LINKED TO: DTSCS77 00123 * DTSCS77 00124 * DTSCU001 DATE EDIT/CONVERSION. DTSCS77 00125 * DTSCU013 COUNT FROM SCREEN (INTEGER) FORMAT/EDIT. DTSCS77 00126 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS77 00127 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS77 00128 * DTSCU018 CERT NO FROM SCREEN FORMAT/EDIT. DTSCS77 00129 * DTSCU061 FIELD ZIP / FIELD REP ID. DTSCS77 00130 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS77 00131 * DTSCU071 NAME EDIT/CONVERSION. DTSCS77 00132 * DTSCU075 COOPERATING AGENCY ADDRESS LOOKUP. DTSCS77 00133 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS77 00134 * DTSCU111 ADDRESS LOOKUP. DTSCS77 00135 * MACCU112 FORMAT ADDRESS FOR MAILING. DTSCS77 00136 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS77 00137 * DTSCU827 VSAM KSDS WORK FILE INPUT/OUTPUT. DTSCS77 00138 * DTSCS77 00139 * DTSCS77 00140 * VERMONT REFERENCE: DTSCS77 00141 * DTSCS77 00142 * NONE. DTSCS77 00143 * DTSCS77 00144 ***** DTSCS77 00145 SKIP3 DTSCS77 00146 ENVIRONMENT DIVISION. DTSCS77 00147 SKIP3 DTSCS77 00148 DATA DIVISION. DTSCS77 00149 SKIP3 DTSCS77 00150 WORKING-STORAGE SECTION. DTSCS77 001505 77 PAN-VALET PICTURE X(24) VALUE '049DTSCS77 11/16/00'. DTSCS77 00151 SKIP3 DTSCS77 00152 01 SW-AREA. DTSCS77 00153 05 WRK-ABEND-CD PIC X(04) VALUE 'S77 '. DTSCS77 00154 SKIP1 DTSCS77 00155 05 WRK-SCR-ID. DTSCS77 00156 10 WRK-SCR-ID-N PIC 9(02) VALUE 77. DTSCS77 00157 SKIP1 DTSCS77 00158 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS77 00159 SKIP1 DTSCS77 00160 05 WRK-TEXT-MAX PIC S9(04) COMP VALUE +6. DTSCS77 00161 SKIP3 DTSCS77 00162 05 SCR-ACCESS-IND PIC X(01). DTSCS77 00163 88 SCR-ACCESS-INQ VALUE '1'. DTSCS77 00164 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS77 00165 SKIP1 DTSCS77 00166 05 CURSOR-SET-IND PIC X(01). DTSCS77 00167 88 CURSOR-SET-YES VALUE 'Y'. DTSCS77 00168 88 CURSOR-SET-NO VALUE 'N'. DTSCS77 00169 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS77 00170 SKIP1 DTSCS77 00171 05 REQ-IND PIC X(01). DTSCS77 00172 88 REQ-ERROR VALUE 'O'. DTSCS77 00173 88 REQ-JUMP VALUE 'J'. DTSCS77 00174 88 REQ-INQUIRE VALUE 'I'. DTSCS77 00175 88 REQ-CLEAR VALUE 'C'. DTSCS77 00176 88 REQ-EDIT VALUE 'E'. DTSCS77 00177 88 REQ-UPDATE VALUE 'U'. DTSCS77 00178 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS77 00179 SKIP1 DTSCS77 00180 05 RESP-IND PIC X(01). DTSCS77 00181 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS77 00182 88 RESP-SEND-MAP VALUE 'M'. DTSCS77 00183 88 RESP-JUMP VALUE 'J'. DTSCS77 00184 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS77 00185 SKIP1 DTSCS77 00186 05 WRK-MSG-AREA PIC X(64). DTSCS77 00187 SKIP1 DTSCS77 00188 05 WRK-ATB-AN PIC X(01). DTSCS77 00189 05 WRK-ATB-NUM PIC X(01). DTSCS77 00190 SKIP3 DTSCS77 00191 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS77 00192 SKIP3 DTSCS77 00193 05 WRK-CERT-NO PIC 9(08). DTSCS77 00194 DTSCS77 00195 05 WRK-EDIT-CERT-NO REDEFINES WRK-CERT-NO. DTSCS77 00196 10 WRK-EDIT-CERT-NO1 PIC 9(4). DTSCS77 00197 10 WRK-EDIT-CERT-NO2 PIC 9(4). DTSCS77 00198 SKIP1 DTSCS77 00199 05 WRK-MPRF-IND PIC X(01). DTSCS77 00200 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS77 00201 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS77 00202 SKIP3 DTSCS77 00203 05 WRK-DISPLAY PIC 9(11). DTSCS77 00204 SKIP1 DTSCS77 00205 05 FILLER REDEFINES WRK-DISPLAY. DTSCS77 00206 10 FILLER PIC X(05). DTSCS77 00207 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS77 00208 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS77 00209 SKIP1 DTSCS77 00210 05 FILLER REDEFINES WRK-DISPLAY. DTSCS77 00211 10 FILLER PIC X(05). DTSCS77 00212 10 WRK-DISPLAY-YR PIC X(02). DTSCS77 00213 10 WRK-DISPLAY-MO PIC X(02). DTSCS77 00214 10 WRK-DISPLAY-DA PIC X(02). DTSCS77 00215 SKIP1 DTSCS77 00216 05 FILLER REDEFINES WRK-DISPLAY. DTSCS77 00217 10 FILLER PIC X(08). DTSCS77 00218 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS77 00219 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS77 00220 SKIP1 DTSCS77 00221 05 FILLER REDEFINES WRK-DISPLAY. DTSCS77 00222 10 FILLER PIC X(08). DTSCS77 00223 10 WRK-DISPLAY-ADDR-ID-NO PIC X(03). DTSCS77 00224 SKIP1 DTSCS77 00225 05 FILLER REDEFINES WRK-DISPLAY. DTSCS77 00226 10 FILLER PIC X(02). DTSCS77 00227 10 WRK-DISPLAY-SSN-1 PIC X(03). DTSCS77 00228 10 WRK-DISPLAY-SSN-2 PIC X(02). DTSCS77 00229 10 WRK-DISPLAY-SSN-3 PIC X(04). DTSCS77 00230 SKIP3 DTSCS77 00231 05 FILLER REDEFINES WRK-DISPLAY. DTSCS77 00232 10 FILLER PIC X(05). DTSCS77 00233 10 WRK-DISPLAY-CERT-NO1 PIC X(02). DTSCS77 00234 10 WRK-DISPLAY-CERT-NO2 PIC X(04). DTSCS77 00235 SKIP3 DTSCS77 00236 05 WRK-TEXT-SUB PIC S9(04) COMP. DTSCS77 00237 SKIP1 DTSCS77 00238 05 WRK-REC-CNT PIC S9(04) COMP. DTSCS77 00239 SKIP1 DTSCS77 00240 05 MAILING-ADDR-IND PIC X(01). DTSCS77 00241 88 MAILING-ADDR-YES-88 VALUE 'Y'. DTSCS77 00242 88 MAILING-ADDR-NO-88 VALUE 'N'. DTSCS77 00243 SKIP3 DTSCS77 00244 05 WP-CONSTRUCTION-AREA. DTSCS77 00245 10 COR-SEP-CHAR PIC X(01) VALUE '*'. DTSCS77 00246 10 COR-MAX PIC S9(04) COMP VALUE +1580. DTSCS77 00247 10 WRK-MAX PIC S9(04) COMP VALUE +50. DTSCS77 00248 10 COR-CNT PIC S9(04) COMP. DTSCS77 00249 10 WRK-FIRST PIC S9(04) COMP. DTSCS77 00250 10 WRK-LAST PIC S9(04) COMP. DTSCS77 00251 10 WRK-SUB PIC S9(04) COMP. DTSCS77 00252 10 COR-FIRST PIC S9(04) COMP. DTSCS77 00253 10 COR-LAST PIC S9(04) COMP. DTSCS77 00254 10 COR-LENGTH PIC S9(04) COMP. DTSCS77 00255 10 WRK-AREA. DTSCS77 00256 15 WRK-CHAR OCCURS 50 TIMES DTSCS77 00257 INDEXED BY WRK-IDX DTSCS77 00258 PIC X(01). DTSCS77 00259 *****EJECT DTSCS77 00260 *01 MSG-LITERALS. DTSCS77 00261 *****05 MSG-E771-AREA. DTSCS77 00262 ***** 10 FILLER PIC X(04) VALUE 'E771'. DTSCS77 00263 ***** 10 FILLER PIC X(30) DTSCS77 00264 ***** VALUE ' '. DTSCS77 00265 ***** 10 FILLER PIC X(30) DTSCS77 00266 ***** VALUE ' '. DTSCS77 00267 EJECT DTSCS77 00268 01 L001-COMM-AREA. DTSCS77 00269 ++INCLUDE DTSIL001 DTSCS77 00270 EJECT DTSCS77 00271 01 L013-COMM-AREA. DTSCS77 00272 ++INCLUDE DTSIL013 DTSCS77 00273 EJECT DTSCS77 00274 01 L015-COMM-AREA. DTSCS77 00275 ++INCLUDE DTSIL015 DTSCS77 00276 EJECT DTSCS77 00277 01 L018-COMM-AREA. DTSCS77 00278 ++INCLUDE DTSIL018 DTSCS77 00279 EJECT DTSCS77 00280 01 L028-COMM-AREA. DTSCS77 00281 ++INCLUDE DTSIL028 DTSCS77 00282 EJECT DTSCS77 00283 01 L061-COMM-AREA. DTSCS77 00284 ++INCLUDE DTSIL061 DTSCS77 00285 EJECT DTSCS77 00286 01 L062-COMM-AREA. DTSCS77 00287 ++INCLUDE DTSIL062 DTSCS77 00288 EJECT DTSCS77 00289 01 L071-COMM-AREA. DTSCS77 00290 ++INCLUDE DTSIL071 DTSCS77 00291 EJECT DTSCS77 00292 01 L075-COMM-AREA. DTSCS77 00293 ++INCLUDE DTSIL075 DTSCS77 00294 EJECT DTSCS77 00295 01 L082-COMM-AREA. DTSCS77 00296 ++INCLUDE DTSIL082 DTSCS77 00297 EJECT DTSCS77 00298 01 L111-COMM-AREA. DTSCS77 00299 ++INCLUDE DTSIL111 DTSCS77 00300 EJECT DTSCS77 00301 01 L112-COMM-AREA. DTSCS77 00302 ++INCLUDE DTSIL112 DTSCS77 00303 EJECT DTSCS77 00304 01 L221-COMM-AREA. DTSCS77 00305 ++INCLUDE DTSIL221 DTSCS77 00306 EJECT DTSCS77 00307 01 L805-COMM-AREA. DTSCS77 00308 ++INCLUDE DTSIL805 DTSCS77 00309 EJECT DTSCS77 00310 01 L810-COMM-AREA. DTSCS77 00311 05 L810-CONTROL-BLOCK. DTSCS77 00312 ++INCLUDE DTSIL810 DTSCS77 00313 EJECT DTSCS77 00314 05 MSKL-REC. DTSCS77 00315 ++INCLUDE DTSIMSKL DTSCS77 00316 EJECT DTSCS77 00317 01 MPRF-REC. DTSCS77 00318 ++INCLUDE DTSIMPRF DTSCS77 00319 EJECT DTSCS77 00320 01 MLIN-REC. DTSCS77 00321 ++INCLUDE DTSIMLIN DTSCS77 00322 EJECT DTSCS77 00323 01 MDPC-REC. DTSCS77 00324 ++INCLUDE DTSIMDPC DTSCS77 00325 EJECT DTSCS77 00326 01 MOPO-REC. DTSCS77 00327 ++INCLUDE DTSIMOPO DTSCS77 00328 EJECT DTSCS77 00329 01 MEVL-REC. DTSCS77 00330 ++INCLUDE DTSIMEVL DTSCS77 00331 EJECT DTSCS77 00332 01 MTCK-REC. DTSCS77 00333 ++INCLUDE DTSIMTCK DTSCS77 00334 EJECT DTSCS77 00335 01 L827-COMM-AREA. DTSCS77 00336 05 L827-CONTROL-BLOCK. DTSCS77 00337 ++INCLUDE DTSIL827 DTSCS77 00338 EJECT DTSCS77 00339 05 VSKL-REC. DTSCS77 00340 ++INCLUDE DTSIVSKL DTSCS77 00341 EJECT DTSCS77 00342 01 VCOR-REC. DTSCS77 00343 ++INCLUDE DTSIVCOR DTSCS77 00344 EJECT DTSCS77 00345 01 L851-COMM-AREA. DTSCS77 00346 ++INCLUDE DTSIL851 DTSCS77 00347 SKIP3 DTSCS77 00348 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS77 00349 ++INCLUDE DTSIS77 DTSCS77 00350 EJECT DTSCS77 00351 01 CATB-LITERALS. DTSCS77 00352 ++INCLUDE DTSICATB DTSCS77 00353 SKIP3 DTSCS77 00354 01 CFKD-LITERALS. DTSCS77 00355 ++INCLUDE DTSICFKD DTSCS77 00356 SKIP3 DTSCS77 00357 01 CECD-LITERALS. DTSCS77 00358 ++INCLUDE DTSICECD DTSCS77 00359 SKIP3 DTSCS77 00360 01 CPCD-LITERALS. DTSCS77 00361 ++INCLUDE DTSICPCD DTSCS77 00362 EJECT DTSCS77 00363 LINKAGE SECTION. DTSCS77 00364 SKIP3 DTSCS77 00365 01 DFHCOMMAREA. DTSCS77 00366 ++INCLUDE DTSILCCM DTSCS77 00367 EJECT DTSCS77 00368 ******************************************************************DTSCS77 00369 * *DTSCS77 00370 ******************************************************************DTSCS77 00371 SKIP1 DTSCS77 00372 PROCEDURE DIVISION. DTSCS77 00373 SKIP2 DTSCS77 00374 MOVE +0 TO WRK-EMP-NO. DTSCS77 00375 SET WRK-MPRF-NO-88 TO TRUE. DTSCS77 00376 SKIP1 DTSCS77 00377 MOVE LOW-VALUES TO MAP-AREA. DTSCS77 00378 SKIP1 DTSCS77 00379 SET CURSOR-SET-NO TO TRUE. DTSCS77 00380 SKIP1 DTSCS77 00381 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS77 00382 TO SCR-ACCESS-IND. DTSCS77 00383 SKIP3 DTSCS77 00384 MOVE SPACE TO REQ-IND. DTSCS77 00385 SKIP1 DTSCS77 00386 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS77 00387 SKIP1 DTSCS77 00388 *----------------------------------------------------- DTSCS77 00389 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS77 00390 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS77 00391 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS77 00392 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS77 00393 * DTSCS77 00394 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS77 00395 * PROCESSED. DTSCS77 00396 * DTSCS77 00397 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS77 00398 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS77 00399 * WORK STATION OPERATOR. DTSCS77 00400 *----------------------------------------------------- DTSCS77 00401 SKIP1 DTSCS77 00402 MOVE SPACE TO RESP-IND. DTSCS77 00403 SKIP1 DTSCS77 00404 IF REQ-ERROR DTSCS77 00405 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS77 00406 ELSE DTSCS77 00407 IF REQ-JUMP DTSCS77 00408 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS77 00409 ELSE DTSCS77 00410 IF REQ-CLEAR DTSCS77 00411 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS77 00412 ELSE DTSCS77 00413 IF REQ-CURSOR-TO-GOTO DTSCS77 00414 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS77 00415 ELSE DTSCS77 00416 IF REQ-INQUIRE DTSCS77 00417 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS77 00418 ELSE DTSCS77 00419 IF REQ-EDIT DTSCS77 00420 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS77 00421 ELSE DTSCS77 00422 IF REQ-UPDATE DTSCS77 00423 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS77 00424 ELSE DTSCS77 00425 GO TO S899-ABEND. DTSCS77 00426 SKIP3 DTSCS77 00427 *----------------------------------------------------- DTSCS77 00428 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS77 00429 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS77 00430 *----------------------------------------------------- DTSCS77 00431 SKIP1 DTSCS77 00432 IF RESP-SEND-MAP DTSCS77 00433 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS77 00434 SET LCCM-END-TASK-88 TO TRUE DTSCS77 00435 ELSE DTSCS77 00436 IF RESP-SEND-MSGONLY DTSCS77 00437 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS77 00438 SET LCCM-END-TASK-88 TO TRUE DTSCS77 00439 ELSE DTSCS77 00440 IF RESP-JUMP DTSCS77 00441 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 00442 ELSE DTSCS77 00443 IF RESP-CURSOR-TO-GOTO DTSCS77 00444 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS77 00445 SET LCCM-END-TASK-88 TO TRUE DTSCS77 00446 ELSE DTSCS77 00447 GO TO S899-ABEND. DTSCS77 00448 SKIP3 DTSCS77 00449 MAINLINE-EXIT. DTSCS77 00450 SKIP1 DTSCS77 00451 EXEC CICS DTSCS77 00452 RETURN DTSCS77 00453 END-EXEC. DTSCS77 00454 SKIP2 DTSCS77 00455 GOBACK. DTSCS77 00456 EJECT DTSCS77 00457 /*****************************************************************DTSCS77 00458 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS77 00459 ******************************************************************DTSCS77 00460 P1000-ANALYZE-REQUEST. DTSCS77 00461 SKIP1 DTSCS77 00462 *----------------------------------------------------- DTSCS77 00463 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS77 00464 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS77 00465 * REPLACED WITH ENTER) DTSCS77 00466 *----------------------------------------------------- DTSCS77 00467 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS77 00468 SET LCCM-ENTER-88 TO TRUE DTSCS77 00469 SET REQ-INQUIRE TO TRUE DTSCS77 00470 IF LCCM-EMP-NO > ZERO DTSCS77 00471 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS77 00472 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS77 00473 END-IF DTSCS77 00474 GO TO P1000-EXIT. DTSCS77 00475 SKIP3 DTSCS77 00476 *----------------------------------------------------- DTSCS77 00477 * MAP IS RECEIVED DTSCS77 00478 *----------------------------------------------------- DTSCS77 00479 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS77 00480 SKIP3 DTSCS77 00481 *----------------------------------------------------- DTSCS77 00482 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS77 00483 * WORK STATION DTSCS77 00484 *----------------------------------------------------- DTSCS77 00485 IF LCCM-CLEAR-88 DTSCS77 00486 SET REQ-CLEAR TO TRUE DTSCS77 00487 GO TO P1000-EXIT. DTSCS77 00488 SKIP3 DTSCS77 00489 *----------------------------------------------------- DTSCS77 00490 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS77 00491 *----------------------------------------------------- DTSCS77 00492 IF LCCM-SCR-UPDATE-LOCKED DTSCS77 00493 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS77 00494 GO TO P1000-EXIT. DTSCS77 00495 SKIP3 DTSCS77 00496 *----------------------------------------------------- DTSCS77 00497 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS77 00498 *----------------------------------------------------- DTSCS77 00499 IF LCCM-PA2-88 DTSCS77 00500 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS77 00501 GO TO P1000-EXIT. DTSCS77 00502 SKIP3 DTSCS77 00503 *----------------------------------------------------- DTSCS77 00504 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS77 00505 *----------------------------------------------------- DTSCS77 00506 IF LCCM-PA-88 DTSCS77 00507 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS77 00508 SET REQ-ERROR TO TRUE DTSCS77 00509 GO TO P1000-EXIT. DTSCS77 00510 SKIP3 DTSCS77 00511 *----------------------------------------------------- DTSCS77 00512 * IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS77 00513 * CLEAR SCREEN. DTSCS77 00514 *----------------------------------------------------- DTSCS77 00515 IF LCCM-F12-88 DTSCS77 00516 MOVE LOW-VALUES TO MAP-AREA DTSCS77 00517 SET REQ-CLEAR TO TRUE DTSCS77 00518 GO TO P1000-EXIT. DTSCS77 00519 SKIP3 DTSCS77 00520 *----------------------------------------------------- DTSCS77 00521 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS77 00522 *----------------------------------------------------- DTSCS77 00523 IF LCCM-F03-88 DTSCS77 00524 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS77 00525 SET REQ-JUMP TO TRUE DTSCS77 00526 GO TO P1000-EXIT. DTSCS77 00527 SKIP3 DTSCS77 00528 *----------------------------------------------------- DTSCS77 00529 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS77 00530 *----------------------------------------------------- DTSCS77 00531 IF LCCM-F04-88 DTSCS77 00532 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS77 00533 SET REQ-JUMP TO TRUE DTSCS77 00534 GO TO P1000-EXIT. DTSCS77 00535 SKIP3 DTSCS77 00536 *----------------------------------------------------- DTSCS77 00537 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS77 00538 * CORRESPONDENCE SCREEN DTSCS77 00539 *----------------------------------------------------- DTSCS77 00540 IF LCCM-F14-88 DTSCS77 00541 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS77 00542 SET REQ-JUMP TO TRUE DTSCS77 00543 GO TO P1000-EXIT. DTSCS77 00544 SKIP3 DTSCS77 00545 *----------------------------------------------------- DTSCS77 00546 * IF JUMP KEY PRESSED, JUMP TO THE REQUESTED SCREEN DTSCS77 00547 *----------------------------------------------------- DTSCS77 00548 * IF LCCM-F21-88 DTSCS77 00549 * MOVE '73' TO LCCM-REQ-SCR-ID DTSCS77 00550 * SET REQ-JUMP TO TRUE DTSCS77 00551 * GO TO P1000-EXIT. DTSCS77 00552 * SKIP1 DTSCS77 00553 * IF LCCM-F22-88 DTSCS77 00554 * MOVE '74' TO LCCM-REQ-SCR-ID DTSCS77 00555 * SET REQ-JUMP TO TRUE DTSCS77 00556 * GO TO P1000-EXIT. DTSCS77 00557 * SKIP3 DTSCS77 00558 *----------------------------------------------------- DTSCS77 00559 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS77 00560 * REQUESTED SCREEN TYPE DTSCS77 00561 *----------------------------------------------------- DTSCS77 00562 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS77 00563 NEXT SENTENCE DTSCS77 00564 ELSE DTSCS77 00565 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS77 00566 SET REQ-JUMP TO TRUE DTSCS77 00567 GO TO P1000-EXIT. DTSCS77 00568 SKIP3 DTSCS77 00569 *----------------------------------------------------- DTSCS77 00570 * IF REQUEST TO UPDATE THE DATA (MOD) DTSCS77 00571 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS77 00572 *----------------------------------------------------- DTSCS77 00573 IF LCCM-F09-88 DTSCS77 00574 IF SCR-ACCESS-UPDATE DTSCS77 00575 SET REQ-EDIT TO TRUE DTSCS77 00576 GO TO P1000-EXIT DTSCS77 00577 ELSE DTSCS77 00578 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS77 00579 SET REQ-ERROR TO TRUE DTSCS77 00580 GO TO P1000-EXIT. DTSCS77 00581 SKIP3 DTSCS77 00582 *----------------------------------------------------- DTSCS77 00583 * IF INQUIRY TYPE KEY PRESSED (ENTER) INDICATE DTSCS77 00584 * INQUIRY REQUEST. DTSCS77 00585 *----------------------------------------------------- DTSCS77 00586 IF LCCM-ENTER-88 DTSCS77 00587 SET REQ-INQUIRE TO TRUE DTSCS77 00588 GO TO P1000-EXIT. DTSCS77 00589 SKIP3 DTSCS77 00590 *----------------------------------------------------- DTSCS77 00591 * ANY OTHER KEY IS INVALID DTSCS77 00592 *----------------------------------------------------- DTSCS77 00593 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS77 00594 SET REQ-ERROR TO TRUE. DTSCS77 00595 P1000-EXIT. DTSCS77 00596 EXIT. DTSCS77 00597 SKIP3 DTSCS77 00598 ******************************************************************DTSCS77 00599 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS77 00600 ******************************************************************DTSCS77 00601 SKIP1 DTSCS77 00602 P1100-UPDATE-LOCKED. DTSCS77 00603 *----------------------------------------------------- DTSCS77 00604 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS77 00605 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS77 00606 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS77 00607 *----------------------------------------------------- DTSCS77 00608 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS77 00609 SET REQ-UPDATE TO TRUE DTSCS77 00610 ELSE DTSCS77 00611 SET REQ-ERROR TO TRUE DTSCS77 00612 IF LCCM-SCR-ADD-LOCKED DTSCS77 00613 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS77 00614 ELSE DTSCS77 00615 GO TO S899-ABEND. DTSCS77 00616 P1100-EXIT. DTSCS77 00617 EXIT. DTSCS77 00618 /*****************************************************************DTSCS77 00619 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS77 00620 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS77 00621 ******************************************************************DTSCS77 00622 SKIP1 DTSCS77 00623 P2000-REQUEST-ERROR. DTSCS77 00624 IF LCCM-MSG DTSCS77 00625 SET RESP-SEND-MSGONLY TO TRUE DTSCS77 00626 ELSE DTSCS77 00627 GO TO S899-ABEND. DTSCS77 00628 P2000-EXIT. DTSCS77 00629 EXIT. DTSCS77 00630 /*****************************************************************DTSCS77 00631 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS77 00632 ******************************************************************DTSCS77 00633 SKIP1 DTSCS77 00634 P3000-REQUEST-JUMP. DTSCS77 00635 *----------------------------------------------------- DTSCS77 00636 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS77 00637 * BY USER DTSCS77 00638 *----------------------------------------------------- DTSCS77 00639 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS77 00640 SKIP3 DTSCS77 00641 *----------------------------------------------------- DTSCS77 00642 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS77 00643 *----------------------------------------------------- DTSCS77 00644 IF LCCM-MSG DTSCS77 00645 SET RESP-SEND-MSGONLY TO TRUE DTSCS77 00646 SET CURSOR-SET-GOTO TO TRUE DTSCS77 00647 GO TO P3000-EXIT. DTSCS77 00648 SKIP3 DTSCS77 00649 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS77 00650 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS77 00651 IF L018-VALID DTSCS77 00652 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS77 00653 SKIP3 DTSCS77 00654 *----------------------------------------------------- DTSCS77 00655 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS77 00656 *----------------------------------------------------- DTSCS77 00657 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS77 00658 LCCM-SCR-HOLD-AREA. DTSCS77 00659 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS77 00660 SET RESP-JUMP TO TRUE. DTSCS77 00661 P3000-EXIT. DTSCS77 00662 EXIT. DTSCS77 00663 /*****************************************************************DTSCS77 00664 * CLEAR KEY WAS PRESSED *DTSCS77 00665 ******************************************************************DTSCS77 00666 SKIP1 DTSCS77 00667 P4000-REQUEST-CLEAR. DTSCS77 00668 SET LCCM-SCR-CLEAR TO TRUE. DTSCS77 00669 SKIP1 DTSCS77 00670 IF SCR-ACCESS-UPDATE DTSCS77 00671 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS77 00672 ELSE DTSCS77 00673 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS77 00674 SKIP3 DTSCS77 00675 *----------------------------------------------------- DTSCS77 00676 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS77 00677 * FIELDS FROM EARLIER REQUESTS DTSCS77 00678 *----------------------------------------------------- DTSCS77 00679 IF LCCM-EMP-NO > ZERO DTSCS77 00680 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS77 00681 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS77 00682 SKIP1 DTSCS77 00683 MOVE ZERO TO LCCM-EMP-NO. DTSCS77 00684 SKIP1 DTSCS77 00685 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS77 00686 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS77 00687 SKIP1 DTSCS77 00688 SET RESP-SEND-MAP TO TRUE. DTSCS77 00689 P4000-EXIT. DTSCS77 00690 EXIT. DTSCS77 00691 /*****************************************************************DTSCS77 00692 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS77 00693 ******************************************************************DTSCS77 00694 SKIP1 DTSCS77 00695 P5000-CURSOR-TO-GOTO. DTSCS77 00696 SET CURSOR-SET-GOTO TO TRUE. DTSCS77 00697 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS77 00698 P5000-EXIT. DTSCS77 00699 EXIT. DTSCS77 00700 /*****************************************************************DTSCS77 00701 * INQUIRY WAS REQUESTED *DTSCS77 00702 ******************************************************************DTSCS77 00703 SKIP1 DTSCS77 00704 P6000-REQUEST-INQUIRE. DTSCS77 00705 MOVE LOW-VALUES TO MAP-FLD-REP-ID DTSCS77 00706 MAP-MAILING-LINE-1 DTSCS77 00707 MAP-MAILING-LINE-2 DTSCS77 00708 MAP-MAILING-LINE-3 DTSCS77 00709 MAP-MAILING-LINE-4 DTSCS77 00710 MAP-MAILING-LINE-5. DTSCS77 00711 SKIP1 DTSCS77 00712 SET LCCM-SCR-CLEAR TO TRUE. DTSCS77 00713 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS77 00714 SKIP1 DTSCS77 00715 SET RESP-SEND-MAP TO TRUE. DTSCS77 00716 SKIP1 DTSCS77 00717 IF SCR-ACCESS-UPDATE DTSCS77 00718 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS77 00719 ELSE DTSCS77 00720 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS77 00721 SKIP1 DTSCS77 00722 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS77 00723 IF LCCM-MSG DTSCS77 00724 GO TO P6000-EXIT. DTSCS77 00725 SKIP1 DTSCS77 00726 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS77 00727 IF LCCM-MSG DTSCS77 00728 GO TO P6000-EXIT. DTSCS77 00729 SKIP1 DTSCS77 00730 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS77 00731 SKIP1 DTSCS77 00732 SKIP1 DTSCS77 00733 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS77 00734 SKIP1 DTSCS77 00735 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS77 00736 P6000-EXIT. DTSCS77 00737 EXIT. DTSCS77 00738 /*****************************************************************DTSCS77 00739 * *DTSCS77 00740 ******************************************************************DTSCS77 00741 SKIP1 DTSCS77 00742 P6900-CONSTRUCT-SCREEN. DTSCS77 00743 PERFORM S4000-MAILING-ADDR THRU S4000-EXIT. DTSCS77 00744 SKIP1 DTSCS77 00745 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSCS77 00746 MOVE WRK-EMP-NO TO L061-EMP-NO. DTSCS77 00747 PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT. DTSCS77 00748 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID. DTSCS77 00749 SKIP1 DTSCS77 00750 MOVE LCCM-RESP-OP-ID TO MAP-CORR-OP-ID. DTSCS77 00751 SKIP1 DTSCS77 00752 MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID. DTSCS77 00753 P6900-EXIT. DTSCS77 00754 EXIT. DTSCS77 00755 /*****************************************************************DTSCS77 00756 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED. *DTSCS77 00757 ******************************************************************DTSCS77 00758 SKIP1 DTSCS77 00759 P7000-REQUEST-EDIT. DTSCS77 00760 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS77 00761 SKIP1 DTSCS77 00762 IF LCCM-F09-88 DTSCS77 00763 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS77 00764 ELSE DTSCS77 00765 GO TO S899-ABEND. DTSCS77 00766 SKIP3 DTSCS77 00767 *------------------------------------------------------ DTSCS77 00768 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS77 00769 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS77 00770 * REMAIN IN 'INQUIRE' STATUS. DTSCS77 00771 *------------------------------------------------------ DTSCS77 00772 SKIP1 DTSCS77 00773 IF LCCM-MSG DTSCS77 00774 NEXT SENTENCE DTSCS77 00775 ELSE DTSCS77 00776 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS77 00777 IF LCCM-F09-88 DTSCS77 00778 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS77 00779 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID. DTSCS77 00780 SKIP1 DTSCS77 00781 SET RESP-SEND-MAP TO TRUE. DTSCS77 00782 P7000-EXIT. DTSCS77 00783 EXIT. DTSCS77 00784 /*****************************************************************DTSCS77 00785 * ADD FUNCTION WAS REQUESTED *DTSCS77 00786 ******************************************************************DTSCS77 00787 SKIP1 DTSCS77 00788 P7100-EDIT-ADD. DTSCS77 00789 *----------------------------------------------------- DTSCS77 00790 * ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE DTSCS77 00791 *----------------------------------------------------- DTSCS77 00792 *****IF NOT LCCM-SCR-CLEAR DTSCS77 00793 ***** MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS77 00794 ***** GO TO P7100-EXIT. DTSCS77 00795 SKIP3 DTSCS77 00796 *----------------------------------------------------- DTSCS77 00797 * MAP-EMP-NO IS REQUIRED DTSCS77 00798 *----------------------------------------------------- DTSCS77 00799 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS77 00800 IF LCCM-MSG DTSCS77 00801 GO TO P7100-EXIT. DTSCS77 00802 SKIP1 DTSCS77 00803 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS77 00804 P7100-EXIT. DTSCS77 00805 EXIT. DTSCS77 00806 /*****************************************************************DTSCS77 00807 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS77 00808 ******************************************************************DTSCS77 00809 SKIP1 DTSCS77 00810 P8000-REQUEST-UPDATE. DTSCS77 00811 IF LCCM-SCR-ADD-LOCKED DTSCS77 00812 PERFORM P8100-ADD THRU P8100-EXIT DTSCS77 00813 ELSE DTSCS77 00814 GO TO S899-ABEND. DTSCS77 00815 SKIP1 DTSCS77 00816 SET RESP-SEND-MAP TO TRUE. DTSCS77 00817 P8000-EXIT. DTSCS77 00818 EXIT. DTSCS77 00819 /*****************************************************************DTSCS77 00820 * *DTSCS77 00821 ******************************************************************DTSCS77 00822 SKIP1 DTSCS77 00823 P8100-ADD. DTSCS77 00824 SET LCCM-SCR-CLEAR TO TRUE. DTSCS77 00825 SKIP1 DTSCS77 00826 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS77 00827 SKIP2 DTSCS77 00828 IF LCCM-F12-88 DTSCS77 00829 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS77 00830 GO TO P8100-EXIT. DTSCS77 00831 SKIP2 DTSCS77 00832 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS77 00833 SKIP1 DTSCS77 00834 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS77 00835 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS77 00836 IF LCCM-MSG DTSCS77 00837 GO TO P8100-EXIT. DTSCS77 00838 SKIP1 DTSCS77 00839 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS77 00840 SKIP2 DTSCS77 00841 PERFORM P8200-ADD-VCOR THRU P8200-EXIT. DTSCS77 00842 SKIP1 DTSCS77 00843 PERFORM P8300-ADD-MEVL THRU P8300-EXIT. DTSCS77 00844 SKIP1 DTSCS77 00845 PERFORM P8400-ADD-MTCK THRU P8400-EXIT. DTSCS77 00846 SKIP2 DTSCS77 00847 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS77 00848 SKIP2 DTSCS77 00849 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS77 00850 SKIP2 DTSCS77 00851 MOVE LOW-VALUES TO MAP-FLD-REP-ID DTSCS77 00852 MAP-MAILING-LINE-1 DTSCS77 00853 MAP-MAILING-LINE-2 DTSCS77 00854 MAP-MAILING-LINE-3 DTSCS77 00855 MAP-MAILING-LINE-4 DTSCS77 00856 MAP-MAILING-LINE-5. DTSCS77 00857 SKIP1 DTSCS77 00858 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS77 00859 P8100-EXIT. DTSCS77 00860 EXIT. DTSCS77 00861 SKIP3 DTSCS77 00862 P8200-ADD-VCOR. DTSCS77 00863 MOVE LOW-VALUES TO VCOR-REC. DTSCS77 00864 SET VCOR-COR-88 TO TRUE. DTSCS77 00865 MOVE MAP-QUEUE-OP-ID TO VCOR-QUEUE-ID. DTSCS77 00866 MOVE LCCM-TASK-START-ABSTIME TO VCOR-ESTB-ABSTIME. DTSCS77 00867 SKIP1 DTSCS77 00868 MOVE +0 TO COR-CNT. DTSCS77 00869 SKIP1 DTSCS77 00870 MOVE MAP-TEMPLATE-ID TO WRK-AREA. DTSCS77 00871 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00872 SKIP1 DTSCS77 00873 MOVE MAP-QUEUE-OP-ID TO WRK-AREA. DTSCS77 00874 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00875 SKIP1 DTSCS77 00876 MOVE SPACES TO WRK-AREA. DTSCS77 00877 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS77 00878 MOVE WRK-DISPLAY-EMP-NO-1 TO WRK-AREA (1:3). DTSCS77 00879 MOVE WRK-DISPLAY-EMP-NO-2 TO WRK-AREA (5:3). DTSCS77 00880 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00881 SKIP1 DTSCS77 00882 MOVE MPRF-PRIMARY-NAME TO WRK-AREA. DTSCS77 00883 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00884 SKIP1 DTSCS77 00885 MOVE MAP-CORR-OP-ID TO WRK-AREA. DTSCS77 00886 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00887 SKIP1 DTSCS77 00888 MOVE MAP-CORR-OP-ID TO L082-OP-ID. DTSCS77 00889 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS77 00890 IF (L082-VALID-OP) AND (L082-EXTERNAL-88) DTSCS77 00891 PERFORM P8210-CORR-OP THRU P8210-EXIT DTSCS77 00892 ELSE DTSCS77 00893 MOVE SPACES TO WRK-AREA DTSCS77 00894 PERFORM P8290-WRKTOCOR THRU P8290-EXIT DTSCS77 00895 5 TIMES. DTSCS77 00896 SKIP1 DTSCS77 00897 * MOVE MAP-LIEN-CERT-AREA TO L028-S-NO-AREA. DTSCS77 00898 * PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT. DTSCS77 00899 * MOVE L028-NO TO WRK-AREA. DTSCS77 00900 MOVE SPACES TO WRK-AREA. DTSCS77 00901 MOVE MAP-CERT-NUM1 TO WRK-AREA (1:2). DTSCS77 00902 MOVE MAP-CERT-NUM2 TO WRK-AREA (4:4). DTSCS77 00903 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00904 SKIP1 DTSCS77 00905 MOVE MAP-COPY-CNT TO WRK-AREA. DTSCS77 00906 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00907 SKIP1 DTSCS77 00908 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS77 00909 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS77 00910 MOVE L001-SLASH-DATE TO WRK-AREA. DTSCS77 00911 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00912 SKIP1 DTSCS77 00913 MOVE MAP-CORR-DATE-AREA TO L015-S-DATE-AREA. DTSCS77 00914 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS77 00915 MOVE L015-DATE TO L001-FED-8-DATE-9. DTSCS77 00916 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS77 00917 MOVE L001-SLASH-DATE TO WRK-AREA. DTSCS77 00918 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00919 SKIP1 DTSCS77 00920 MOVE MAP-ADDR-TYPE TO WRK-AREA. DTSCS77 00921 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00922 SKIP1 DTSCS77 00923 MOVE MAP-ADDR-ID-NO TO WRK-AREA. DTSCS77 00924 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00925 SKIP1 DTSCS77 00926 MOVE MAP-MAILING-LINE-1 TO WRK-AREA. DTSCS77 00927 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00928 SKIP1 DTSCS77 00929 MOVE MAP-MAILING-LINE-2 TO WRK-AREA. DTSCS77 00930 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00931 SKIP1 DTSCS77 00932 MOVE MAP-MAILING-LINE-3 TO WRK-AREA. DTSCS77 00933 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00934 SKIP1 DTSCS77 00935 MOVE MAP-MAILING-LINE-4 TO WRK-AREA. DTSCS77 00936 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00937 SKIP1 DTSCS77 00938 MOVE MAP-MAILING-LINE-5 TO WRK-AREA. DTSCS77 00939 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00940 SKIP1 DTSCS77 00941 IF MAP-ADDR-OPO-88 DTSCS77 00942 PERFORM P8220-OPO THRU P8220-EXIT DTSCS77 00943 ELSE DTSCS77 00944 MOVE SPACES TO WRK-AREA DTSCS77 00945 PERFORM P8290-WRKTOCOR THRU P8290-EXIT DTSCS77 00946 3 TIMES. DTSCS77 00947 SKIP1 DTSCS77 00948 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID. DTSCS77 00949 PERFORM S062-FLD-REP-DSCR THRU S062-EXIT. DTSCS77 00950 IF (MAP-FLD-REP-NONE-88) DTSCS77 00951 OR DTSCS77 00952 (L062-NOT-VALID) DTSCS77 00953 MOVE SPACES TO WRK-AREA DTSCS77 00954 PERFORM P8290-WRKTOCOR THRU P8290-EXIT DTSCS77 00955 15 TIMES DTSCS77 00956 ELSE DTSCS77 00957 PERFORM P8230-FLD-REP THRU P8230-EXIT. DTSCS77 00958 SKIP1 DTSCS77 00959 IF MAP-CORR-STATE = SPACES OR LOW-VALUES DTSCS77 00960 MOVE SPACES TO WRK-AREA DTSCS77 00961 PERFORM P8290-WRKTOCOR THRU P8290-EXIT DTSCS77 00962 5 TIMES DTSCS77 00963 ELSE DTSCS77 00964 MOVE MAP-CORR-STATE TO L075-LOOKUP-STATE DTSCS77 00965 SET L075-LOOKUP-ADDR-88 TO TRUE DTSCS77 00966 PERFORM S075-LOOKUP-COOP-STATE THRU S075-EXIT DTSCS77 00967 IF L075-ADDR-FOUND-88 DTSCS77 00968 PERFORM P8240-CORR-STATE THRU P8240-EXIT DTSCS77 00969 ELSE DTSCS77 00970 MOVE SPACES TO WRK-AREA DTSCS77 00971 PERFORM P8290-WRKTOCOR THRU P8290-EXIT DTSCS77 00972 5 TIMES. DTSCS77 00973 SKIP2 DTSCS77 00974 MOVE VCOR-REC TO VSKL-REC. DTSCS77 00975 PERFORM S827-WRITE THRU S827-EXIT. DTSCS77 00976 P8200-EXIT. DTSCS77 00977 EXIT. DTSCS77 00978 SKIP3 DTSCS77 00979 P8210-CORR-OP. DTSCS77 00980 MOVE L082-NAME TO L071-NAM. DTSCS77 00981 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS77 00982 PERFORM S071-NAME-CONVERSION THRU S071-EXIT. DTSCS77 00983 MOVE L071-NAM TO WRK-AREA. DTSCS77 00984 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00985 SKIP1 DTSCS77 00986 MOVE L082-TITLE TO WRK-AREA. DTSCS77 00987 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00988 SKIP1 DTSCS77 00989 MOVE L082-UNIT-NAME TO WRK-AREA. DTSCS77 00990 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 00991 SKIP1 DTSCS77 00992 MOVE SPACES TO WRK-AREA. DTSCS77 00993 STRING '(' DELIMITED BY SIZE DTSCS77 00994 L082-VOICE-1-AREA-CD DELIMITED BY SIZE DTSCS77 00995 ') ' DELIMITED BY SIZE DTSCS77 00996 L082-VOICE-1-PREFIX DELIMITED BY SIZE DTSCS77 00997 '-' DELIMITED BY SIZE DTSCS77 00998 L082-VOICE-1-SUFFIX DELIMITED BY SIZE DTSCS77 00999 '-' DELIMITED BY SIZE DTSCS77 01000 L082-VOICE-1-EXT DELIMITED BY SIZE DTSCS77 01001 INTO WRK-AREA. DTSCS77 01002 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01003 SKIP1 DTSCS77 01004 MOVE L082-EMAIL-ADDRESS TO WRK-AREA. DTSCS77 01005 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01006 P8210-EXIT. DTSCS77 01007 EXIT. DTSCS77 01008 SKIP3 DTSCS77 01009 P8220-OPO. DTSCS77 01010 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCS77 01011 MOVE WRK-EMP-NO TO MOPO-EMP-NO. DTSCS77 01012 SET MOPO-OPO-88 TO TRUE. DTSCS77 01013 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS77 01014 PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS77 01015 MOVE L013-CNT TO MOPO-ID-NO. DTSCS77 01016 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCS77 01017 PERFORM S810-READ THRU S810-EXIT. DTSCS77 01018 IF L810-NO-REC-88 DTSCS77 01019 MOVE SPACES TO WRK-AREA DTSCS77 01020 PERFORM P8290-WRKTOCOR THRU P8290-EXIT DTSCS77 01021 3 TIMES DTSCS77 01022 GO TO P8220-EXIT. DTSCS77 01023 SKIP1 DTSCS77 01024 MOVE MSKL-REC TO MOPO-REC. DTSCS77 01025 SKIP1 DTSCS77 01026 MOVE MOPO-TITLE TO WRK-AREA. DTSCS77 01027 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01028 SKIP1 DTSCS77 01029 MOVE MOPO-NAME TO L071-NAM. DTSCS77 01030 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS77 01031 PERFORM S071-NAME-CONVERSION THRU S071-EXIT. DTSCS77 01032 MOVE L071-NAM TO WRK-AREA. DTSCS77 01033 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01034 SKIP1 DTSCS77 01035 MOVE SPACES TO WRK-AREA. DTSCS77 01036 IF MOPO-SSN = +0 DTSCS77 01037 NEXT SENTENCE DTSCS77 01038 ELSE DTSCS77 01039 MOVE MOPO-SSN TO WRK-DISPLAY DTSCS77 01040 STRING WRK-DISPLAY-SSN-1 DELIMITED BY SIZE DTSCS77 01041 '-' DELIMITED BY SIZE DTSCS77 01042 WRK-DISPLAY-SSN-3 DELIMITED BY SIZE DTSCS77 01043 '-' DELIMITED BY SIZE DTSCS77 01044 WRK-DISPLAY-SSN-2 DELIMITED BY SIZE DTSCS77 01045 INTO DTSCS77 01046 WRK-AREA. DTSCS77 01047 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01048 P8220-EXIT. DTSCS77 01049 EXIT. DTSCS77 01050 SKIP3 DTSCS77 01051 P8230-FLD-REP. DTSCS77 01052 MOVE L062-FLD-REP-ID TO WRK-AREA. DTSCS77 01053 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01054 SKIP1 DTSCS77 01055 MOVE L062-NAME TO L071-NAM. DTSCS77 01056 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS77 01057 PERFORM S071-NAME-CONVERSION THRU S071-EXIT. DTSCS77 01058 MOVE L071-NAM TO WRK-AREA. DTSCS77 01059 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01060 SKIP1 DTSCS77 01061 SET L112-FID-MAILING-ADDR-88 TO TRUE. DTSCS77 01062 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS77 01063 MOVE SPACES TO L112-PRIMARY-NAME. DTSCS77 01064 MOVE L062-NAME TO L112-NAME. DTSCS77 01065 MOVE SPACES TO L112-TITLE. DTSCS77 01066 SKIP1 DTSCS77 01067 MOVE L062-MAIL-ADDR TO L112-ADDRESS. DTSCS77 01068 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS77 01069 SKIP1 DTSCS77 01070 PERFORM P8231-MOVE-ADDR THRU P8231-EXIT DTSCS77 01071 VARYING L112-MAILING-IDX FROM 1 BY 1 DTSCS77 01072 UNTIL L112-MAILING-IDX > +5. DTSCS77 01073 SKIP1 DTSCS77 01074 SET L112-FID-PHYSICAL-ADDR-88 TO TRUE. DTSCS77 01075 MOVE L062-PHYSICAL-ADDR TO L112-ADDRESS. DTSCS77 01076 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS77 01077 SKIP1 DTSCS77 01078 PERFORM P8231-MOVE-ADDR THRU P8231-EXIT DTSCS77 01079 VARYING L112-MAILING-IDX FROM 1 BY 1 DTSCS77 01080 UNTIL L112-MAILING-IDX > +5. DTSCS77 01081 SKIP1 DTSCS77 01082 MOVE SPACES TO WRK-AREA. DTSCS77 01083 STRING '(' DELIMITED BY SIZE DTSCS77 01084 L062-VOICE-1-AREA-CD DELIMITED BY SIZE DTSCS77 01085 ') ' DELIMITED BY SIZE DTSCS77 01086 L062-VOICE-1-PREFIX DELIMITED BY SIZE DTSCS77 01087 '-' DELIMITED BY SIZE DTSCS77 01088 L062-VOICE-1-SUFFIX DELIMITED BY SIZE DTSCS77 01089 '-' DELIMITED BY SIZE DTSCS77 01090 L062-VOICE-1-EXT DELIMITED BY SIZE DTSCS77 01091 INTO DTSCS77 01092 WRK-AREA. DTSCS77 01093 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01094 SKIP1 DTSCS77 01095 MOVE SPACES TO WRK-AREA. DTSCS77 01096 STRING '(' DELIMITED BY SIZE DTSCS77 01097 L062-FAX-AREA-CD DELIMITED BY SIZE DTSCS77 01098 ') ' DELIMITED BY SIZE DTSCS77 01099 L062-FAX-PREFIX DELIMITED BY SIZE DTSCS77 01100 '-' DELIMITED BY SIZE DTSCS77 01101 L062-FAX-SUFFIX DELIMITED BY SIZE DTSCS77 01102 '-' DELIMITED BY SIZE DTSCS77 01103 L062-FAX-EXT DELIMITED BY SIZE DTSCS77 01104 INTO DTSCS77 01105 WRK-AREA. DTSCS77 01106 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01107 SKIP1 DTSCS77 01108 MOVE L062-EMAIL-ADDRESS TO WRK-AREA. DTSCS77 01109 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01110 P8230-EXIT. DTSCS77 01111 EXIT. DTSCS77 01112 SKIP3 DTSCS77 01113 P8231-MOVE-ADDR. DTSCS77 01114 MOVE L112-MAILING-LINE (L112-MAILING-IDX) TO WRK-AREA. DTSCS77 01115 PERFORM P8290-WRKTOCOR THRU P8290-EXIT. DTSCS77 01116 P8231-EXIT. DTSCS77 01117 EXIT. DTSCS77 01118 SKIP3 DTSCS77 01119 P8240-CORR-STATE. DTSCS77 01120 SET L112-TAA-ADDR-88 TO TRUE. DTSCS77 01121 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS77 01122 MOVE SPACE TO L112-PRIMARY-NAME DTSCS77 01123 L112-TITLE. DTSCS77 01124 MOVE L075-NAME TO L112-NAME. DTSCS77 01125 SKIP1 DTSCS77 01126 MOVE L075-ADDRESS TO L112-ADDRESS. DTSCS77 01127 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS77 01128 SKIP1 DTSCS77 01129 PERFORM P8231-MOVE-ADDR THRU P8231-EXIT DTSCS77 01130 VARYING L112-MAILING-IDX FROM 1 BY 1 DTSCS77 01131 UNTIL L112-MAILING-IDX > +5. DTSCS77 01132 P8240-EXIT. DTSCS77 01133 EXIT. DTSCS77 01134 SKIP3 DTSCS77 01135 P8290-WRKTOCOR. DTSCS77 01136 INSPECT WRK-AREA DTSCS77 01137 CONVERTING COR-SEP-CHAR TO SPACE. DTSCS77 01138 SKIP1 DTSCS77 01139 MOVE +0 TO WRK-FIRST DTSCS77 01140 WRK-LAST. DTSCS77 01141 PERFORM P8291-WRK-CHAR-SCAN THRU P8291-EXIT DTSCS77 01142 VARYING WRK-SUB FROM 1 BY 1 DTSCS77 01143 UNTIL WRK-SUB > WRK-MAX. DTSCS77 01144 IF WRK-FIRST = +0 DTSCS77 01145 NEXT SENTENCE DTSCS77 01146 ELSE DTSCS77 01147 PERFORM P8292-MOVE-WRK THRU P8292-EXIT. DTSCS77 01148 IF COR-CNT < COR-MAX DTSCS77 01149 ADD +1 TO COR-CNT DTSCS77 01150 MOVE COR-SEP-CHAR TO VCOR-DATA (COR-CNT:1). DTSCS77 01151 P8290-EXIT. DTSCS77 01152 EXIT. DTSCS77 01153 SKIP3 DTSCS77 01154 P8291-WRK-CHAR-SCAN. DTSCS77 01155 IF WRK-CHAR (WRK-SUB) = SPACES OR LOW-VALUES DTSCS77 01156 GO TO P8291-EXIT. DTSCS77 01157 SKIP1 DTSCS77 01158 IF WRK-FIRST = +0 DTSCS77 01159 MOVE WRK-SUB TO WRK-FIRST. DTSCS77 01160 MOVE WRK-SUB TO WRK-LAST. DTSCS77 01161 P8291-EXIT. DTSCS77 01162 EXIT. DTSCS77 01163 SKIP3 DTSCS77 01164 P8292-MOVE-WRK. DTSCS77 01165 COMPUTE COR-FIRST = COR-CNT + 1. DTSCS77 01166 SKIP1 DTSCS77 01167 IF COR-FIRST > COR-MAX DTSCS77 01168 GO TO P8292-EXIT. DTSCS77 01169 SKIP1 DTSCS77 01170 COMPUTE COR-LENGTH = WRK-LAST - WRK-FIRST + 1. DTSCS77 01171 SKIP1 DTSCS77 01172 COMPUTE COR-LAST = COR-CNT + COR-LENGTH. DTSCS77 01173 SKIP1 DTSCS77 01174 IF COR-LAST > COR-MAX DTSCS77 01175 COMPUTE COR-LENGTH = COR-MAX - COR-CNT. DTSCS77 01176 SKIP1 DTSCS77 01177 MOVE WRK-AREA (WRK-FIRST:COR-LENGTH) DTSCS77 01178 TO VCOR-DATA (COR-FIRST:COR-LENGTH). DTSCS77 01179 SKIP1 DTSCS77 01180 COMPUTE COR-CNT = COR-CNT + COR-LENGTH. DTSCS77 01181 P8292-EXIT. DTSCS77 01182 EXIT. DTSCS77 01183 EJECT DTSCS77 01184 P8300-ADD-MEVL. DTSCS77 01185 MOVE LOW-VALUES TO MEVL-REC. DTSCS77 01186 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS77 01187 SET MEVL-EVL-88 TO TRUE. DTSCS77 01188 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS77 01189 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS77 01190 SKIP1 DTSCS77 01191 MOVE +0 TO MEVL-PURGE-DATE. DTSCS77 01192 SKIP1 DTSCS77 01193 MOVE SPACES TO MEVL-TEXT. DTSCS77 01194 STRING 'CORRESPONDENCE: ' DELIMITED BY SIZE DTSCS77 01195 MAP-TEMPLATE-ID DELIMITED BY SIZE DTSCS77 01196 INTO DTSCS77 01197 MEVL-TEXT. DTSCS77 01198 SKIP1 DTSCS77 01199 MOVE MAP-CORR-OP-ID TO MEVL-SOURCE. DTSCS77 01200 SKIP1 DTSCS77 01201 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS77 01202 SKIP1 DTSCS77 01203 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS77 01204 MEVL-CHNG-DATE. DTSCS77 01205 SKIP1 DTSCS77 01206 MOVE MEVL-REC TO MSKL-REC. DTSCS77 01207 PERFORM S810-WRITE THRU S810-EXIT. DTSCS77 01208 P8300-EXIT. DTSCS77 01209 EXIT. DTSCS77 01210 EJECT DTSCS77 01211 P8400-ADD-MTCK. DTSCS77 01212 MOVE MAP-TRIGGER-DATE-AREA TO L015-S-DATE-AREA. DTSCS77 01213 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS77 01214 IF L015-VALID DTSCS77 01215 NEXT SENTENCE DTSCS77 01216 ELSE DTSCS77 01217 GO TO P8400-EXIT. DTSCS77 01218 SKIP1 DTSCS77 01219 MOVE LOW-VALUES TO MTCK-REC. DTSCS77 01220 SKIP1 DTSCS77 01221 MOVE WRK-EMP-NO TO MTCK-EMP-NO. DTSCS77 01222 SET MTCK-TCK-88 TO TRUE. DTSCS77 01223 MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS77 01224 SKIP1 DTSCS77 01225 MOVE +0 TO MTCK-PURGE-DATE. DTSCS77 01226 SKIP1 DTSCS77 01227 SET MTCK-TYPE-MANUAL-88 TO TRUE. DTSCS77 01228 MOVE L015-DATE TO MTCK-TRIGGER-DATE. DTSCS77 01229 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. DTSCS77 01230 MOVE MAP-CORR-OP-ID TO MTCK-SOURCE-OP-ID DTSCS77 01231 MTCK-DEST-OP-ID. DTSCS77 01232 SKIP1 DTSCS77 01233 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSCS77 01234 MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSCS77 01235 MTCK-CHNG-DATE. DTSCS77 01236 SKIP1 DTSCS77 01237 MOVE +0 TO MTCK-TEXT-CNT. DTSCS77 01238 PERFORM P8410-TEXT THRU P8410-EXIT DTSCS77 01239 VARYING WRK-TEXT-SUB FROM 1 BY 1 DTSCS77 01240 UNTIL WRK-TEXT-SUB > WRK-TEXT-MAX. DTSCS77 01241 SKIP1 DTSCS77 01242 MOVE MTCK-REC TO MSKL-REC. DTSCS77 01243 PERFORM S810-WRITE THRU S810-EXIT. DTSCS77 01244 P8400-EXIT. DTSCS77 01245 EXIT. DTSCS77 01246 SKIP3 DTSCS77 01247 P8410-TEXT. DTSCS77 01248 INSPECT MAP-TEXT (WRK-TEXT-SUB) DTSCS77 01249 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01250 SKIP1 DTSCS77 01251 MOVE MAP-TEXT (WRK-TEXT-SUB) DTSCS77 01252 TO MTCK-TEXT (WRK-TEXT-SUB). DTSCS77 01253 IF MAP-TEXT (WRK-TEXT-SUB) = SPACES DTSCS77 01254 NEXT SENTENCE DTSCS77 01255 ELSE DTSCS77 01256 MOVE WRK-TEXT-SUB TO MTCK-TEXT-CNT. DTSCS77 01257 P8410-EXIT. DTSCS77 01258 EXIT. DTSCS77 01259 EJECT DTSCS77 01260 P8810-LOCK-EMPLOYER. DTSCS77 01261 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS77 01262 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS77 01263 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS77 01264 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS77 01265 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS77 01266 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS77 01267 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS77 01268 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS77 01269 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS77 01270 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS77 01271 P8810-EXIT. DTSCS77 01272 EXIT. DTSCS77 01273 EJECT DTSCS77 01274 /*****************************************************************DTSCS77 01275 * LINKS TO UTILITY MODULES DTSCS77 01276 ******************************************************************DTSCS77 01277 SKIP1 DTSCS77 01278 S001-FROM-FED-8. DTSCS77 01279 SET L001-FROM-FED-8 TO TRUE. DTSCS77 01280 GO TO S001-DATE. DTSCS77 01281 SKIP1 DTSCS77 01282 S001-DATE. DTSCS77 01283 EXEC CICS LINK DTSCS77 01284 PROGRAM('DTSCU001') DTSCS77 01285 COMMAREA(L001-COMM-AREA) DTSCS77 01286 END-EXEC. DTSCS77 01287 S001-EXIT. DTSCS77 01288 EXIT. DTSCS77 01289 SKIP3 DTSCS77 01290 S013-ADDR-NUM. DTSCS77 01291 MOVE +1 TO L013-MIN-CNT. DTSCS77 01292 MOVE +999 TO L013-MAX-CNT. DTSCS77 01293 GO TO S013-COUNT-FROM-SCREEN. DTSCS77 01294 SKIP1 DTSCS77 01295 S013-COPY-CNT. DTSCS77 01296 MOVE +1 TO L013-MIN-CNT. DTSCS77 01297 MOVE +99 TO L013-MAX-CNT. DTSCS77 01298 GO TO S013-COUNT-FROM-SCREEN. DTSCS77 01299 SKIP1 DTSCS77 01300 S013-COUNT-FROM-SCREEN. DTSCS77 01301 EXEC CICS LINK DTSCS77 01302 PROGRAM('DTSCU013') DTSCS77 01303 COMMAREA(L013-COMM-AREA) DTSCS77 01304 END-EXEC. DTSCS77 01305 S013-EXIT. DTSCS77 01306 EXIT. DTSCS77 01307 SKIP3 DTSCS77 01308 S015-DATE-FROM-SCREEN. DTSCS77 01309 EXEC CICS LINK DTSCS77 01310 PROGRAM('DTSCU015') DTSCS77 01311 COMMAREA(L015-COMM-AREA) DTSCS77 01312 END-EXEC. DTSCS77 01313 S015-EXIT. DTSCS77 01314 EXIT. DTSCS77 01315 SKIP3 DTSCS77 01316 S018-EMP-NO-FROM-SCREEN. DTSCS77 01317 EXEC CICS LINK DTSCS77 01318 PROGRAM('DTSCU018') DTSCS77 01319 COMMAREA(L018-COMM-AREA) DTSCS77 01320 END-EXEC. DTSCS77 01321 S018-EXIT. DTSCS77 01322 EXIT. DTSCS77 01323 SKIP3 DTSCS77 01324 S028-CERT-NO-FROM-SCREEN. DTSCS77 01325 EXEC CICS LINK DTSCS77 01326 PROGRAM('DTSCU028') DTSCS77 01327 COMMAREA(L028-COMM-AREA) DTSCS77 01328 END-EXEC. DTSCS77 01329 S028-EXIT. DTSCS77 01330 EXIT. DTSCS77 01331 SKIP3 DTSCS77 01332 S061-FLD-REP-LOOKUP. DTSCS77 01333 EXEC CICS LINK DTSCS77 01334 PROGRAM('DTSCU061') DTSCS77 01335 COMMAREA(L061-COMM-AREA) DTSCS77 01336 END-EXEC. DTSCS77 01337 SKIP1 DTSCS77 01338 IF L061-FILE-CLOSED DTSCS77 01339 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01340 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01341 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01342 GO TO MAINLINE-EXIT. DTSCS77 01343 S061-EXIT. DTSCS77 01344 EXIT. DTSCS77 01345 SKIP3 DTSCS77 01346 S062-FLD-REP-DSCR. DTSCS77 01347 EXEC CICS LINK DTSCS77 01348 PROGRAM('DTSCU062') DTSCS77 01349 COMMAREA(L062-COMM-AREA) DTSCS77 01350 END-EXEC. DTSCS77 01351 SKIP1 DTSCS77 01352 IF L062-FILE-CLOSED DTSCS77 01353 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01354 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01355 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01356 GO TO MAINLINE-EXIT. DTSCS77 01357 S062-EXIT. DTSCS77 01358 EXIT. DTSCS77 01359 SKIP3 DTSCS77 01360 S071-NAME-CONVERSION. DTSCS77 01361 EXEC CICS LINK DTSCS77 01362 PROGRAM('DTSCU071') DTSCS77 01363 COMMAREA(L071-COMM-AREA) DTSCS77 01364 END-EXEC. DTSCS77 01365 S071-EXIT. DTSCS77 01366 EXIT. DTSCS77 01367 SKIP3 DTSCS77 01368 S075-LOOKUP-COOP-STATE. DTSCS77 01369 EXEC CICS LINK DTSCS77 01370 PROGRAM('DTSCU075') DTSCS77 01371 COMMAREA(L075-COMM-AREA) DTSCS77 01372 END-EXEC. DTSCS77 01373 SKIP1 DTSCS77 01374 IF L075-FILE-CLOSED-88 DTSCS77 01375 MOVE L075-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01376 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01377 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01378 GO TO MAINLINE-EXIT. DTSCS77 01379 S075-EXIT. DTSCS77 01380 EXIT. DTSCS77 01381 SKIP3 DTSCS77 01382 S082-OP-ID-LOOKUP. DTSCS77 01383 EXEC CICS LINK DTSCS77 01384 PROGRAM('DTSCU082') DTSCS77 01385 COMMAREA(L082-COMM-AREA) DTSCS77 01386 END-EXEC. DTSCS77 01387 SKIP1 DTSCS77 01388 IF L082-FILE-CLOSED DTSCS77 01389 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01390 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01391 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01392 GO TO MAINLINE-EXIT. DTSCS77 01393 S082-EXIT. DTSCS77 01394 EXIT. DTSCS77 01395 SKIP3 DTSCS77 01396 S111-ADDR-LOOKUP. DTSCS77 01397 EXEC CICS LINK DTSCS77 01398 PROGRAM('DTSCU111') DTSCS77 01399 COMMAREA(L111-COMM-AREA) DTSCS77 01400 END-EXEC. DTSCS77 01401 SKIP1 DTSCS77 01402 IF L111-FILE-CLOSED-88 DTSCS77 01403 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01404 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01405 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01406 GO TO MAINLINE-EXIT. DTSCS77 01407 S111-EXIT. DTSCS77 01408 EXIT. DTSCS77 01409 SKIP3 DTSCS77 01410 S112-ADDR-FORMAT. DTSCS77 01411 EXEC CICS LINK DTSCS77 01412 PROGRAM('DTSCU112') DTSCS77 01413 COMMAREA(L112-COMM-AREA) DTSCS77 01414 END-EXEC. DTSCS77 01415 S112-EXIT. DTSCS77 01416 EXIT. DTSCS77 01417 SKIP3 DTSCS77 01418 S221-EMP-LOCK. DTSCS77 01419 SET L221-START-UPDATE TO TRUE. DTSCS77 01420 GO TO S221-EMP-LOCK-UNLOCK. DTSCS77 01421 SKIP1 DTSCS77 01422 S221-EMP-UNLOCK. DTSCS77 01423 SET L221-END-UPDATE TO TRUE. DTSCS77 01424 GO TO S221-EMP-LOCK-UNLOCK. DTSCS77 01425 SKIP1 DTSCS77 01426 S221-EMP-LOCK-UNLOCK. DTSCS77 01427 EXEC CICS LINK DTSCS77 01428 PROGRAM('DTSCU221') DTSCS77 01429 COMMAREA(L221-COMM-AREA) DTSCS77 01430 END-EXEC. DTSCS77 01431 SKIP1 DTSCS77 01432 IF L221-FILE-CLOSED DTSCS77 01433 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01434 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01435 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01436 GO TO MAINLINE-EXIT. DTSCS77 01437 SKIP1 DTSCS77 01438 IF L221-NOT-OK DTSCS77 01439 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS77 01440 S221-EXIT. DTSCS77 01441 EXIT. DTSCS77 01442 SKIP3 DTSCS77 01443 S803-REQ-SCR-ID-EDIT. DTSCS77 01444 EXEC CICS LINK DTSCS77 01445 PROGRAM ('DTSCU803') DTSCS77 01446 COMMAREA (DFHCOMMAREA) DTSCS77 01447 END-EXEC. DTSCS77 01448 S803-EXIT. DTSCS77 01449 EXIT. DTSCS77 01450 SKIP3 DTSCS77 01451 S804-INVALID-KEY. DTSCS77 01452 EXEC CICS LINK DTSCS77 01453 PROGRAM ('DTSCU804') DTSCS77 01454 COMMAREA (DFHCOMMAREA) DTSCS77 01455 END-EXEC. DTSCS77 01456 S804-EXIT. DTSCS77 01457 EXIT. DTSCS77 01458 SKIP3 DTSCS77 01459 S805-MSG-AREA. DTSCS77 01460 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS77 01461 SKIP1 DTSCS77 01462 EXEC CICS LINK DTSCS77 01463 PROGRAM ('DTSCU805') DTSCS77 01464 COMMAREA (L805-COMM-AREA) DTSCS77 01465 END-EXEC. DTSCS77 01466 SKIP1 DTSCS77 01467 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS77 01468 S805-EXIT. DTSCS77 01469 EXIT. DTSCS77 01470 EJECT DTSCS77 01471 S810-READ. DTSCS77 01472 SET L810-READ-88 TO TRUE. DTSCS77 01473 GO TO S810-IO. DTSCS77 01474 SKIP1 DTSCS77 01475 S810-START-BROWSE. DTSCS77 01476 SET L810-START-BROWSE-88 TO TRUE. DTSCS77 01477 GO TO S810-IO. DTSCS77 01478 SKIP1 DTSCS77 01479 S810-READ-NEXT. DTSCS77 01480 SET L810-READ-NEXT-88 TO TRUE. DTSCS77 01481 GO TO S810-IO. DTSCS77 01482 SKIP1 DTSCS77 01483 S810-READ-PREV. DTSCS77 01484 SET L810-READ-PREV-88 TO TRUE. DTSCS77 01485 GO TO S810-IO. DTSCS77 01486 SKIP1 DTSCS77 01487 S810-END-BROWSE. DTSCS77 01488 SET L810-END-BROWSE-88 TO TRUE. DTSCS77 01489 GO TO S810-IO. DTSCS77 01490 SKIP1 DTSCS77 01491 S810-COUNT. DTSCS77 01492 SET L810-COUNT-88 TO TRUE. DTSCS77 01493 GO TO S810-IO. DTSCS77 01494 SKIP1 DTSCS77 01495 S810-REWRITE. DTSCS77 01496 SET L810-REWRITE-88 TO TRUE. DTSCS77 01497 GO TO S810-IO. DTSCS77 01498 SKIP1 DTSCS77 01499 S810-WRITE. DTSCS77 01500 SET L810-WRITE-88 TO TRUE. DTSCS77 01501 GO TO S810-IO. DTSCS77 01502 SKIP1 DTSCS77 01503 S810-DELETE. DTSCS77 01504 SET L810-DELETE-88 TO TRUE. DTSCS77 01505 GO TO S810-IO. DTSCS77 01506 SKIP1 DTSCS77 01507 S810-IO. DTSCS77 01508 SKIP1 DTSCS77 01509 EXEC CICS LINK DTSCS77 01510 PROGRAM ('DTSCU810') DTSCS77 01511 COMMAREA (L810-COMM-AREA) DTSCS77 01512 END-EXEC. DTSCS77 01513 SKIP1 DTSCS77 01514 IF L810-FILE-CLOSED-88 DTSCS77 01515 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01516 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01517 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01518 GO TO MAINLINE-EXIT. DTSCS77 01519 S810-EXIT. DTSCS77 01520 EXIT. DTSCS77 01521 EJECT DTSCS77 01522 S827-WRITE. DTSCS77 01523 SET L827-WRITE-88 TO TRUE. DTSCS77 01524 GO TO S827-IO. DTSCS77 01525 SKIP1 DTSCS77 01526 S827-IO. DTSCS77 01527 SKIP1 DTSCS77 01528 EXEC CICS LINK DTSCS77 01529 PROGRAM ('DTSCU827') DTSCS77 01530 COMMAREA (L827-COMM-AREA) DTSCS77 01531 END-EXEC. DTSCS77 01532 SKIP1 DTSCS77 01533 IF L827-FILE-CLOSED-88 DTSCS77 01534 MOVE L827-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01535 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS77 01536 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS77 01537 GO TO MAINLINE-EXIT. DTSCS77 01538 S827-EXIT. DTSCS77 01539 EXIT. DTSCS77 01540 EJECT DTSCS77 01541 S851-SCREEN-PROCESSING. DTSCS77 01542 EXEC CICS LINK DTSCS77 01543 PROGRAM ('DTSCU851') DTSCS77 01544 COMMAREA (L851-COMM-AREA) DTSCS77 01545 END-EXEC. DTSCS77 01546 S851-EXIT. DTSCS77 01547 EXIT. DTSCS77 01548 SKIP3 DTSCS77 01549 S899-ABEND. DTSCS77 01550 EXEC CICS ABEND DTSCS77 01551 ABCODE(WRK-ABEND-CD) DTSCS77 01552 END-EXEC. DTSCS77 01553 S899-EXIT. DTSCS77 01554 EXIT. DTSCS77 01555 /*****************************************************************DTSCS77 01556 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS77 01557 ******************************************************************DTSCS77 01558 SKIP1 DTSCS77 01559 S1000-SCREEN-EDITS. DTSCS77 01560 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS77 01561 IF LCCM-MSG DTSCS77 01562 GO TO S1000-EXIT. DTSCS77 01563 SKIP1 DTSCS77 01564 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS77 01565 SKIP1 DTSCS77 01566 PERFORM S1200-TEMPLATE-ID THRU S1200-EXIT. DTSCS77 01567 PERFORM S1300-ADDR-TYPE THRU S1300-EXIT. DTSCS77 01568 PERFORM S1400-ADDR-ID-NO THRU S1400-EXIT. DTSCS77 01569 PERFORM S1500-CORR-OP-ID THRU S1500-EXIT. DTSCS77 01570 PERFORM S1600-FLD-REP-ID THRU S1600-EXIT. DTSCS77 01571 PERFORM S1650-LIEN-CERT THRU S1650-EXIT. DTSCS77 01572 PERFORM S1700-COPY-CNT THRU S1700-EXIT. DTSCS77 01573 PERFORM S1800-CORR-DATE THRU S1800-EXIT. DTSCS77 01574 PERFORM S2100-CORR-STATE THRU S2100-EXIT. DTSCS77 01575 PERFORM S1900-TRIGGER-DATE THRU S1900-EXIT. DTSCS77 01576 PERFORM S2200-QUEUE-OP-ID THRU S2200-EXIT. DTSCS77 01577 SKIP1 DTSCS77 01578 PERFORM S4000-MAILING-ADDR THRU S4000-EXIT. DTSCS77 01579 S1000-EXIT. EXIT. DTSCS77 01580 EJECT DTSCS77 01581 S1100-EDIT-KEY. DTSCS77 01582 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS77 01583 S1100-EXIT. EXIT. DTSCS77 01584 /*****************************************************************DTSCS77 01585 * DTSCS77 01586 ******************************************************************DTSCS77 01587 S1101-EMP-NO. DTSCS77 01588 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS77 01589 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS77 01590 SKIP1 DTSCS77 01591 IF L018-NO-ENTRY DTSCS77 01592 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS77 01593 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS77 01594 GO TO S1101-EXIT. DTSCS77 01595 SKIP1 DTSCS77 01596 IF L018-NOT-VALID DTSCS77 01597 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01598 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS77 01599 GO TO S1101-EXIT. DTSCS77 01600 SKIP1 DTSCS77 01601 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS77 01602 S1101-EXIT. EXIT. DTSCS77 01603 SKIP3 DTSCS77 01604 S1110-READ-MPRF. DTSCS77 01605 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS77 01606 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS77 01607 SET MPRF-PRF-88 TO TRUE. DTSCS77 01608 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS77 01609 PERFORM S810-READ THRU S810-EXIT. DTSCS77 01610 IF L810-NO-REC-88 DTSCS77 01611 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS77 01612 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS77 01613 ELSE DTSCS77 01614 MOVE MSKL-REC TO MPRF-REC DTSCS77 01615 SET WRK-MPRF-YES-88 TO TRUE. DTSCS77 01616 S1110-EXIT. DTSCS77 01617 EXIT. DTSCS77 01618 SKIP3 DTSCS77 01619 S1199-ERROR. DTSCS77 01620 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS77 01621 MAP-EMP-NO-2-A. DTSCS77 01622 IF LCCM-NO-MSG DTSCS77 01623 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01624 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS77 01625 SET CURSOR-SET-YES TO TRUE. DTSCS77 01626 S1199-EXIT. EXIT. DTSCS77 01627 /*****************************************************************DTSCS77 01628 * DTSCS77 01629 ******************************************************************DTSCS77 01630 S1200-TEMPLATE-ID. DTSCS77 01631 INSPECT MAP-TEMPLATE-ID DTSCS77 01632 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01633 SKIP1 DTSCS77 01634 IF MAP-TEMPLATE-ID = SPACES DTSCS77 01635 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS77 01636 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS77 01637 S1200-EXIT. EXIT. DTSCS77 01638 SKIP3 DTSCS77 01639 S1201-ERROR. DTSCS77 01640 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TEMPLATE-ID-A. DTSCS77 01641 IF LCCM-NO-MSG DTSCS77 01642 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01643 MOVE CATB-CURSOR TO MAP-TEMPLATE-ID-L DTSCS77 01644 SET CURSOR-SET-YES TO TRUE. DTSCS77 01645 S1201-EXIT. EXIT. DTSCS77 01646 /*****************************************************************DTSCS77 01647 * DTSCS77 01648 ******************************************************************DTSCS77 01649 S1300-ADDR-TYPE. DTSCS77 01650 IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS77 01651 SET MAP-ADDR-TAX-88 TO TRUE DTSCS77 01652 ELSE DTSCS77 01653 IF MAP-ADDR-VALID-88 DTSCS77 01654 NEXT SENTENCE DTSCS77 01655 ELSE DTSCS77 01656 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01657 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS77 01658 S1300-EXIT. EXIT. DTSCS77 01659 SKIP3 DTSCS77 01660 S1301-ERROR. DTSCS77 01661 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS77 01662 IF LCCM-NO-MSG DTSCS77 01663 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01664 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS77 01665 SET CURSOR-SET-YES TO TRUE. DTSCS77 01666 S1301-EXIT. EXIT. DTSCS77 01667 /*****************************************************************DTSCS77 01668 * DTSCS77 01669 ******************************************************************DTSCS77 01670 S1400-ADDR-ID-NO. DTSCS77 01671 INSPECT MAP-ADDR-ID-NO DTSCS77 01672 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01673 SKIP1 DTSCS77 01674 IF MAP-ADDR-TAD-88 DTSCS77 01675 PERFORM S1410-ADDR-TAD THRU S1410-EXIT DTSCS77 01676 GO TO S1400-EXIT. DTSCS77 01677 SKIP1 DTSCS77 01678 IF MAP-ADDR-ID-NO = SPACES DTSCS77 01679 IF MAP-ADDR-NONE-88 DTSCS77 01680 GO TO S1400-EXIT DTSCS77 01681 ELSE DTSCS77 01682 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS77 01683 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS77 01684 GO TO S1400-EXIT. DTSCS77 01685 SKIP1 DTSCS77 01686 IF MAP-ADDR-NONE-88 DTSCS77 01687 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS77 01688 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS77 01689 GO TO S1400-EXIT. DTSCS77 01690 SKIP1 DTSCS77 01691 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS77 01692 MOVE +1 TO L013-MIN-CNT DTSCS77 01693 MOVE +999 TO L013-MAX-CNT. DTSCS77 01694 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS77 01695 SKIP1 DTSCS77 01696 IF L013-VALID DTSCS77 01697 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS77 01698 IF MAP-ADDR-TAA-OPO-88 DTSCS77 01699 PERFORM S1420-ADDR-TAA-OPO THRU S1420-EXIT DTSCS77 01700 ELSE DTSCS77 01701 IF MAP-ADDR-LIN-88 DTSCS77 01702 PERFORM S1430-ADDR-LIN THRU S1430-EXIT DTSCS77 01703 ELSE DTSCS77 01704 IF MAP-ADDR-DPC-88 DTSCS77 01705 PERFORM S1440-ADDR-DPC THRU S1440-EXIT DTSCS77 01706 ELSE DTSCS77 01707 NEXT SENTENCE DTSCS77 01708 ELSE DTSCS77 01709 IF L013-NO-ENTRY DTSCS77 01710 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS77 01711 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS77 01712 ELSE DTSCS77 01713 IF L013-INVALID-NEGATIVE DTSCS77 01714 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS77 01715 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS77 01716 ELSE DTSCS77 01717 IF L013-EXCEEDS-MIN-MAX DTSCS77 01718 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS77 01719 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS77 01720 ELSE DTSCS77 01721 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01722 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS77 01723 S1400-EXIT. EXIT. DTSCS77 01724 SKIP3 DTSCS77 01725 S1401-ERROR. DTSCS77 01726 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A. DTSCS77 01727 IF LCCM-NO-MSG DTSCS77 01728 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01729 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS77 01730 SET CURSOR-SET-YES TO TRUE. DTSCS77 01731 S1401-EXIT. EXIT. DTSCS77 01732 SKIP3 DTSCS77 01733 S1410-ADDR-TAD. DTSCS77 01734 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS77 01735 IF MAP-ADDR-TAX-88 DTSCS77 01736 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS77 01737 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS77 01738 ELSE DTSCS77 01739 IF MAP-ADDR-PHY-88 DTSCS77 01740 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS77 01741 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS77 01742 ELSE DTSCS77 01743 GO TO S899-ABEND. DTSCS77 01744 SKIP1 DTSCS77 01745 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS77 01746 SKIP1 DTSCS77 01747 IF L111-ADDR-NOT-FOUND-88 DTSCS77 01748 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS77 01749 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS77 01750 S1410-EXIT. DTSCS77 01751 EXIT. DTSCS77 01752 SKIP3 DTSCS77 01753 S1420-ADDR-TAA-OPO. DTSCS77 01754 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS77 01755 IF MAP-ADDR-TAX-ALT-88 DTSCS77 01756 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS77 01757 ELSE DTSCS77 01758 IF MAP-ADDR-OPO-88 DTSCS77 01759 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS77 01760 ELSE DTSCS77 01761 GO TO S899-ABEND. DTSCS77 01762 SKIP1 DTSCS77 01763 IF L013-CNT = +0 DTSCS77 01764 MOVE 1 TO L111-ID-NO DTSCS77 01765 ELSE DTSCS77 01766 MOVE L013-CNT TO L111-ID-NO. DTSCS77 01767 SKIP1 DTSCS77 01768 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS77 01769 SKIP1 DTSCS77 01770 IF L111-ADDR-NOT-FOUND-88 DTSCS77 01771 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS77 01772 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS77 01773 S1420-EXIT. DTSCS77 01774 EXIT. DTSCS77 01775 SKIP3 DTSCS77 01776 S1430-ADDR-LIN. DTSCS77 01777 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS77 01778 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS77 01779 SET MSKL-LIN-88 TO TRUE. DTSCS77 01780 PERFORM S810-COUNT THRU S810-EXIT. DTSCS77 01781 IF L013-CNT > L810-RECORD-CNT DTSCS77 01782 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS77 01783 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS77 01784 S1430-EXIT. DTSCS77 01785 EXIT. DTSCS77 01786 SKIP3 DTSCS77 01787 S1440-ADDR-DPC. DTSCS77 01788 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS77 01789 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS77 01790 SET MSKL-DPC-88 TO TRUE. DTSCS77 01791 PERFORM S810-COUNT THRU S810-EXIT. DTSCS77 01792 IF L013-CNT > L810-RECORD-CNT DTSCS77 01793 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS77 01794 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS77 01795 S1440-EXIT. DTSCS77 01796 EXIT. DTSCS77 01797 /*****************************************************************DTSCS77 01798 * DTSCS77 01799 ******************************************************************DTSCS77 01800 S1500-CORR-OP-ID. DTSCS77 01801 INSPECT MAP-CORR-OP-ID DTSCS77 01802 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01803 SKIP1 DTSCS77 01804 IF MAP-CORR-OP-ID = SPACES DTSCS77 01805 MOVE LCCM-RESP-OP-ID TO MAP-CORR-OP-ID. DTSCS77 01806 SKIP1 DTSCS77 01807 IF MAP-CORR-OP-ID = LCCM-OP-ID DTSCS77 01808 MOVE MAP-CORR-OP-ID TO LCCM-RESP-OP-ID DTSCS77 01809 GO TO S1500-EXIT. DTSCS77 01810 SKIP1 DTSCS77 01811 MOVE MAP-CORR-OP-ID TO L082-OP-ID. DTSCS77 01812 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS77 01813 IF (L082-VALID-OP) AND (L082-EXTERNAL-88) DTSCS77 01814 MOVE MAP-CORR-OP-ID TO LCCM-RESP-OP-ID DTSCS77 01815 ELSE DTSCS77 01816 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01817 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS77 01818 S1500-EXIT. EXIT. DTSCS77 01819 SKIP3 DTSCS77 01820 S1501-ERROR. DTSCS77 01821 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CORR-OP-ID-A. DTSCS77 01822 IF LCCM-NO-MSG DTSCS77 01823 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01824 MOVE CATB-CURSOR TO MAP-CORR-OP-ID-L DTSCS77 01825 SET CURSOR-SET-YES TO TRUE. DTSCS77 01826 S1501-EXIT. EXIT. DTSCS77 01827 /*****************************************************************DTSCS77 01828 * DTSCS77 01829 ******************************************************************DTSCS77 01830 S1600-FLD-REP-ID. DTSCS77 01831 INSPECT MAP-FLD-REP-ID DTSCS77 01832 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01833 SKIP1 DTSCS77 01834 IF MAP-FLD-REP-ID = SPACES DTSCS77 01835 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST DTSCS77 01836 MOVE WRK-EMP-NO TO L061-EMP-NO DTSCS77 01837 PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT DTSCS77 01838 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS77 01839 GO TO S1600-EXIT. DTSCS77 01840 SKIP1 DTSCS77 01841 IF MAP-FLD-REP-NONE-88 DTSCS77 01842 GO TO S1600-EXIT. DTSCS77 01843 SKIP1 DTSCS77 01844 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID. DTSCS77 01845 PERFORM S062-FLD-REP-DSCR THRU S062-EXIT. DTSCS77 01846 IF L062-NOT-VALID DTSCS77 01847 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01848 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS77 01849 GO TO S1600-EXIT. DTSCS77 01850 S1600-EXIT. EXIT. DTSCS77 01851 SKIP3 DTSCS77 01852 S1601-ERROR. DTSCS77 01853 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-REP-ID-A. DTSCS77 01854 IF LCCM-NO-MSG DTSCS77 01855 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01856 MOVE CATB-CURSOR TO MAP-FLD-REP-ID-L DTSCS77 01857 SET CURSOR-SET-YES TO TRUE. DTSCS77 01858 S1601-EXIT. EXIT. DTSCS77 01859 /*****************************************************************DTSCS77 01860 * DTSCS77 01861 ******************************************************************DTSCS77 01862 S1650-LIEN-CERT. DTSCS77 01863 INSPECT MAP-CERT-NUM1 DTSCS77 01864 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01865 SKIP1 DTSCS77 01866 INSPECT MAP-CERT-NUM2 DTSCS77 01867 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01868 SKIP1 DTSCS77 01869 IF MAP-CERT-NUM1 = SPACES AND MAP-CERT-NUM2 = SPACES DTSCS77 01870 GO TO S1650-EXIT. DTSCS77 01871 SKIP1 DTSCS77 01872 MOVE MAP-LIEN-CERT-AREA TO L028-S-NO-AREA. DTSCS77 01873 DTSCS77 01874 PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT. DTSCS77 01875 SKIP1 DTSCS77 01876 IF L028-VALID DTSCS77 01877 NEXT SENTENCE DTSCS77 01878 ELSE DTSCS77 01879 IF L028-NO-ENTRY DTSCS77 01880 NEXT SENTENCE DTSCS77 01881 ELSE DTSCS77 01882 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01883 PERFORM S1651-ERROR THRU S1651-EXIT. DTSCS77 01884 DTSCS77 01885 MOVE L028-NO TO WRK-CERT-NO. DTSCS77 01886 DTSCS77 01887 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS77 01888 DTSCS77 01889 IF L001-FED-8-MO > 09 DTSCS77 01890 ADD 1 TO L001-FED-8-YR. DTSCS77 01891 DTSCS77 01892 IF WRK-EDIT-CERT-NO1 > L001-FED-8-YR DTSCS77 01893 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01894 PERFORM S1651-ERROR THRU S1651-EXIT. DTSCS77 01895 DTSCS77 01896 S1650-EXIT. EXIT. DTSCS77 01897 SKIP3 DTSCS77 01898 S1651-ERROR. DTSCS77 01899 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CERT-NUM1-A DTSCS77 01900 MAP-CERT-NUM2-A. DTSCS77 01901 IF LCCM-NO-MSG DTSCS77 01902 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01903 MOVE CATB-CURSOR TO MAP-CERT-NUM1-L DTSCS77 01904 SET CURSOR-SET-YES TO TRUE. DTSCS77 01905 S1651-EXIT. EXIT. DTSCS77 01906 /*****************************************************************DTSCS77 01907 * DTSCS77 01908 ******************************************************************DTSCS77 01909 S1700-COPY-CNT. DTSCS77 01910 INSPECT MAP-COPY-CNT DTSCS77 01911 CONVERTING LOW-VALUES TO SPACES. DTSCS77 01912 SKIP1 DTSCS77 01913 IF MAP-COPY-CNT = SPACES DTSCS77 01914 MOVE 1 TO MAP-COPY-CNT-Z DTSCS77 01915 GO TO S1700-EXIT. DTSCS77 01916 SKIP1 DTSCS77 01917 MOVE MAP-COPY-CNT-AREA TO L013-S-CNT-AREA. DTSCS77 01918 MOVE +1 TO L013-MIN-CNT. DTSCS77 01919 MOVE +99 TO L013-MAX-CNT. DTSCS77 01920 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS77 01921 SKIP1 DTSCS77 01922 IF L013-VALID DTSCS77 01923 MOVE L013-CNT TO MAP-COPY-CNT-Z DTSCS77 01924 ELSE DTSCS77 01925 IF L013-NO-ENTRY DTSCS77 01926 NEXT SENTENCE DTSCS77 01927 ELSE DTSCS77 01928 IF L013-INVALID-NEGATIVE DTSCS77 01929 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS77 01930 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS77 01931 ELSE DTSCS77 01932 IF L013-EXCEEDS-MIN-MAX DTSCS77 01933 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS77 01934 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS77 01935 ELSE DTSCS77 01936 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01937 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS77 01938 S1700-EXIT. EXIT. DTSCS77 01939 SKIP3 DTSCS77 01940 S1701-ERROR. DTSCS77 01941 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPY-CNT-A. DTSCS77 01942 IF LCCM-NO-MSG DTSCS77 01943 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01944 MOVE CATB-CURSOR TO MAP-COPY-CNT-L DTSCS77 01945 SET CURSOR-SET-YES TO TRUE. DTSCS77 01946 S1701-EXIT. EXIT. DTSCS77 01947 /*****************************************************************DTSCS77 01948 * DTSCS77 01949 ******************************************************************DTSCS77 01950 S1800-CORR-DATE. DTSCS77 01951 MOVE MAP-CORR-DATE-AREA TO L015-S-DATE-AREA. DTSCS77 01952 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS77 01953 SKIP1 DTSCS77 01954 IF L015-NO-ENTRY DTSCS77 01955 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS77 01956 MOVE WRK-DISPLAY-MO TO MAP-CORR-MO DTSCS77 01957 MOVE WRK-DISPLAY-DA TO MAP-CORR-DA DTSCS77 01958 MOVE WRK-DISPLAY-YR TO MAP-CORR-YR DTSCS77 01959 ELSE DTSCS77 01960 IF L015-NOT-VALID DTSCS77 01961 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01962 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS77 01963 ELSE DTSCS77 01964 IF L015-DATE < LCCM-CURR-RUN-DATE DTSCS77 01965 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS77 01966 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS77 01967 S1800-EXIT. EXIT. DTSCS77 01968 SKIP3 DTSCS77 01969 S1801-ERROR. DTSCS77 01970 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CORR-MO-A DTSCS77 01971 MAP-CORR-DA-A DTSCS77 01972 MAP-CORR-YR-A. DTSCS77 01973 IF LCCM-NO-MSG DTSCS77 01974 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 01975 MOVE CATB-CURSOR TO MAP-CORR-MO-L DTSCS77 01976 SET CURSOR-SET-YES TO TRUE. DTSCS77 01977 S1801-EXIT. EXIT. DTSCS77 01978 /*****************************************************************DTSCS77 01979 * DTSCS77 01980 ******************************************************************DTSCS77 01981 S1900-TRIGGER-DATE. DTSCS77 01982 MOVE MAP-TRIGGER-DATE-AREA TO L015-S-DATE-AREA. DTSCS77 01983 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS77 01984 SKIP1 DTSCS77 01985 IF L015-NO-ENTRY DTSCS77 01986 NEXT SENTENCE DTSCS77 01987 ELSE DTSCS77 01988 IF L015-NOT-VALID DTSCS77 01989 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 01990 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS77 01991 ELSE DTSCS77 01992 IF L015-DATE < LCCM-CURR-RUN-DATE DTSCS77 01993 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS77 01994 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS77 01995 S1900-EXIT. EXIT. DTSCS77 01996 SKIP3 DTSCS77 01997 S1901-ERROR. DTSCS77 01998 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TRIGGER-MO-A DTSCS77 01999 MAP-TRIGGER-DA-A DTSCS77 02000 MAP-TRIGGER-YR-A. DTSCS77 02001 IF LCCM-NO-MSG DTSCS77 02002 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 02003 MOVE CATB-CURSOR TO MAP-TRIGGER-MO-L DTSCS77 02004 SET CURSOR-SET-YES TO TRUE. DTSCS77 02005 S1901-EXIT. EXIT. DTSCS77 02006 /*****************************************************************DTSCS77 02007 * DTSCS77 02008 ******************************************************************DTSCS77 02009 S2100-CORR-STATE. DTSCS77 02010 IF MAP-CORR-STATE = SPACE OR LOW-VALUE DTSCS77 02011 GO TO S2100-EXIT. DTSCS77 02012 MOVE MAP-CORR-STATE TO L075-LOOKUP-STATE. DTSCS77 02013 SET L075-LOOKUP-ADDR-88 TO TRUE. DTSCS77 02014 PERFORM S075-LOOKUP-COOP-STATE THRU S075-EXIT. DTSCS77 02015 IF L075-ADDR-FOUND-88 DTSCS77 02016 NEXT SENTENCE DTSCS77 02017 ELSE DTSCS77 02018 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 02019 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS77 02020 S2100-EXIT. EXIT. DTSCS77 02021 SKIP3 DTSCS77 02022 S2101-ERROR. DTSCS77 02023 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CORR-STATE-A. DTSCS77 02024 IF LCCM-NO-MSG DTSCS77 02025 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 02026 MOVE CATB-CURSOR TO MAP-CORR-STATE-L DTSCS77 02027 SET CURSOR-SET-YES TO TRUE. DTSCS77 02028 S2101-EXIT. EXIT. DTSCS77 02029 /*****************************************************************DTSCS77 02030 * DTSCS77 02031 ******************************************************************DTSCS77 02032 S2200-QUEUE-OP-ID. DTSCS77 02033 INSPECT MAP-QUEUE-OP-ID DTSCS77 02034 CONVERTING LOW-VALUES TO SPACES. DTSCS77 02035 SKIP1 DTSCS77 02036 IF MAP-QUEUE-OP-ID = SPACES DTSCS77 02037 MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID. DTSCS77 02038 SKIP1 DTSCS77 02039 IF MAP-QUEUE-OP-ID = LCCM-CORR-QUEUE-OP-ID DTSCS77 02040 GO TO S2200-EXIT. DTSCS77 02041 SKIP1 DTSCS77 02042 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID. DTSCS77 02043 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS77 02044 IF L082-VALID-OP DTSCS77 02045 MOVE MAP-QUEUE-OP-ID TO LCCM-CORR-QUEUE-OP-ID DTSCS77 02046 ELSE DTSCS77 02047 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS77 02048 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS77 02049 S2200-EXIT. EXIT. DTSCS77 02050 SKIP3 DTSCS77 02051 S2201-ERROR. DTSCS77 02052 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-QUEUE-OP-ID-A. DTSCS77 02053 IF LCCM-NO-MSG DTSCS77 02054 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS77 02055 MOVE CATB-CURSOR TO MAP-QUEUE-OP-ID-L DTSCS77 02056 SET CURSOR-SET-YES TO TRUE. DTSCS77 02057 S2201-EXIT. EXIT. DTSCS77 02058 EJECT DTSCS77 02059 S4000-MAILING-ADDR. DTSCS77 02060 MOVE LOW-VALUES TO MAP-MAILING-LINE-1 DTSCS77 02061 MAP-MAILING-LINE-2 DTSCS77 02062 MAP-MAILING-LINE-3 DTSCS77 02063 MAP-MAILING-LINE-4 DTSCS77 02064 MAP-MAILING-LINE-5. DTSCS77 02065 SKIP1 DTSCS77 02066 IF MAP-ADDR-NONE-88 DTSCS77 02067 GO TO S4000-EXIT. DTSCS77 02068 SKIP1 DTSCS77 02069 IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES) DTSCS77 02070 OR DTSCS77 02071 (MAP-ADDR-VALID-88) DTSCS77 02072 NEXT SENTENCE DTSCS77 02073 ELSE DTSCS77 02074 GO TO S4000-EXIT. DTSCS77 02075 SKIP1 DTSCS77 02076 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS77 02077 PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS77 02078 SKIP1 DTSCS77 02079 IF L013-NO-ENTRY DTSCS77 02080 IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES) DTSCS77 02081 OR DTSCS77 02082 (MAP-ADDR-TAD-88) DTSCS77 02083 NEXT SENTENCE DTSCS77 02084 ELSE DTSCS77 02085 GO TO S4000-EXIT DTSCS77 02086 ELSE DTSCS77 02087 IF L013-VALID DTSCS77 02088 NEXT SENTENCE DTSCS77 02089 ELSE DTSCS77 02090 GO TO S4000-EXIT. DTSCS77 02091 SKIP1 DTSCS77 02092 IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES) DTSCS77 02093 OR DTSCS77 02094 (MAP-ADDR-TAD-88) DTSCS77 02095 PERFORM S4100-TAD-ADDR THRU S4100-EXIT DTSCS77 02096 ELSE DTSCS77 02097 IF MAP-ADDR-TAA-OPO-88 DTSCS77 02098 PERFORM S4200-TAA-OPO-ADDR THRU S4200-EXIT DTSCS77 02099 ELSE DTSCS77 02100 IF MAP-ADDR-LIN-88 DTSCS77 02101 PERFORM S4300-LIN-ADDR THRU S4300-EXIT DTSCS77 02102 ELSE DTSCS77 02103 IF MAP-ADDR-DPC-88 DTSCS77 02104 PERFORM S4400-DPC-ADDR THRU S4400-EXIT. DTSCS77 02105 S4000-EXIT. DTSCS77 02106 EXIT. DTSCS77 02107 SKIP3 DTSCS77 02108 S4100-TAD-ADDR. DTSCS77 02109 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS77 02110 IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES) DTSCS77 02111 OR DTSCS77 02112 (MAP-ADDR-TAX-88) DTSCS77 02113 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS77 02114 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS77 02115 ELSE DTSCS77 02116 IF MAP-ADDR-PHY-88 DTSCS77 02117 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS77 02118 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS77 02119 ELSE DTSCS77 02120 GO TO S899-ABEND. DTSCS77 02121 SKIP1 DTSCS77 02122 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS77 02123 IF L111-ADDR-NOT-FOUND-88 DTSCS77 02124 GO TO S4100-EXIT. DTSCS77 02125 SKIP1 DTSCS77 02126 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS77 02127 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS77 02128 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS77 02129 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS77 02130 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS77 02131 SKIP1 DTSCS77 02132 MOVE L112-MAILING-LINE-1 TO MAP-MAILING-LINE-1. DTSCS77 02133 MOVE L112-MAILING-LINE-2 TO MAP-MAILING-LINE-2. DTSCS77 02134 MOVE L112-MAILING-LINE-3 TO MAP-MAILING-LINE-3. DTSCS77 02135 MOVE L112-MAILING-LINE-4 TO MAP-MAILING-LINE-4. DTSCS77 02136 MOVE L112-MAILING-LINE-5 TO MAP-MAILING-LINE-5. DTSCS77 02137 S4100-EXIT. DTSCS77 02138 EXIT. DTSCS77 02139 SKIP3 DTSCS77 02140 S4200-TAA-OPO-ADDR. DTSCS77 02141 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS77 02142 IF MAP-ADDR-TAX-ALT-88 DTSCS77 02143 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS77 02144 ELSE DTSCS77 02145 IF MAP-ADDR-OPO-88 DTSCS77 02146 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS77 02147 ELSE DTSCS77 02148 GO TO S899-ABEND. DTSCS77 02149 SKIP1 DTSCS77 02150 IF L013-CNT = +0 DTSCS77 02151 MOVE 1 TO L111-ID-NO DTSCS77 02152 ELSE DTSCS77 02153 MOVE L013-CNT TO L111-ID-NO. DTSCS77 02154 SKIP1 DTSCS77 02155 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS77 02156 IF L111-ADDR-NOT-FOUND-88 DTSCS77 02157 GO TO S4200-EXIT. DTSCS77 02158 SKIP1 DTSCS77 02159 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS77 02160 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS77 02161 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS77 02162 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS77 02163 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS77 02164 SKIP1 DTSCS77 02165 MOVE L112-MAILING-LINE-1 TO MAP-MAILING-LINE-1. DTSCS77 02166 MOVE L112-MAILING-LINE-2 TO MAP-MAILING-LINE-2. DTSCS77 02167 MOVE L112-MAILING-LINE-3 TO MAP-MAILING-LINE-3. DTSCS77 02168 MOVE L112-MAILING-LINE-4 TO MAP-MAILING-LINE-4. DTSCS77 02169 MOVE L112-MAILING-LINE-5 TO MAP-MAILING-LINE-5. DTSCS77 02170 S4200-EXIT. DTSCS77 02171 EXIT. DTSCS77 02172 SKIP3 DTSCS77 02173 S4300-LIN-ADDR. DTSCS77 02174 MOVE LOW-VALUES TO MLIN-KEY-AREA. DTSCS77 02175 MOVE WRK-EMP-NO TO MLIN-EMP-NO. DTSCS77 02176 SET MLIN-LIN-88 TO TRUE. DTSCS77 02177 MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA. DTSCS77 02178 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS77 02179 MOVE +0 TO WRK-REC-CNT. DTSCS77 02180 PERFORM S4310-SCAN-MLIN THRU S4310-EXIT DTSCS77 02181 UNTIL L810-NO-REC-88. DTSCS77 02182 S4300-EXIT. DTSCS77 02183 EXIT. DTSCS77 02184 SKIP3 DTSCS77 02185 S4310-SCAN-MLIN. DTSCS77 02186 ADD +1 TO WRK-REC-CNT. DTSCS77 02187 IF WRK-REC-CNT = L013-CNT DTSCS77 02188 MOVE MSKL-REC TO MLIN-REC DTSCS77 02189 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS77 02190 SET L810-NO-REC-88 TO TRUE DTSCS77 02191 MOVE MLIN-ADDRESS-LINE-1 TO MAP-MAILING-LINE-1 DTSCS77 02192 MOVE MLIN-ADDRESS-LINE-2 TO MAP-MAILING-LINE-2 DTSCS77 02193 MOVE MLIN-ADDRESS-LINE-3 TO MAP-MAILING-LINE-3 DTSCS77 02194 MOVE MLIN-ADDRESS-LINE-4 TO MAP-MAILING-LINE-4 DTSCS77 02195 MOVE MLIN-ADDRESS-LINE-5 TO MAP-MAILING-LINE-5 DTSCS77 02196 MOVE MLIN-CERTIFICATE-NO TO WRK-DISPLAY DTSCS77 02197 MOVE WRK-DISPLAY-CERT-NO1 TO MAP-CERT-NUM1 DTSCS77 02198 MOVE WRK-DISPLAY-CERT-NO2 TO MAP-CERT-NUM2 DTSCS77 02199 * IF MLIN-CERTIFICATE-NO = ZERO DTSCS77 02200 * MOVE SPACES TO MAP-LIEN-CERT DTSCS77 02201 * END-IF DTSCS77 02202 GO TO S4310-EXIT. DTSCS77 02203 SKIP1 DTSCS77 02204 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS77 02205 S4310-EXIT. DTSCS77 02206 EXIT. DTSCS77 02207 SKIP3 DTSCS77 02208 S4400-DPC-ADDR. DTSCS77 02209 MOVE LOW-VALUES TO MDPC-KEY-AREA. DTSCS77 02210 MOVE WRK-EMP-NO TO MDPC-EMP-NO. DTSCS77 02211 SET MDPC-DPC-88 TO TRUE. DTSCS77 02212 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA. DTSCS77 02213 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS77 02214 MOVE +0 TO WRK-REC-CNT. DTSCS77 02215 PERFORM S4410-SCAN-MDPC THRU S4410-EXIT DTSCS77 02216 UNTIL L810-NO-REC-88. DTSCS77 02217 S4400-EXIT. DTSCS77 02218 EXIT. DTSCS77 02219 SKIP3 DTSCS77 02220 S4410-SCAN-MDPC. DTSCS77 02221 ADD +1 TO WRK-REC-CNT. DTSCS77 02222 IF WRK-REC-CNT = L013-CNT DTSCS77 02223 MOVE MSKL-REC TO MDPC-REC DTSCS77 02224 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS77 02225 SET L810-NO-REC-88 TO TRUE DTSCS77 02226 MOVE MDPC-MAILING-LINE-1 DTSCS77 02227 TO MAP-MAILING-LINE-1 DTSCS77 02228 MOVE MDPC-MAILING-LINE-2 DTSCS77 02229 TO MAP-MAILING-LINE-2 DTSCS77 02230 MOVE MDPC-MAILING-LINE-3 DTSCS77 02231 TO MAP-MAILING-LINE-3 DTSCS77 02232 MOVE MDPC-MAILING-LINE-4 DTSCS77 02233 TO MAP-MAILING-LINE-4 DTSCS77 02234 MOVE MDPC-MAILING-LINE-5 DTSCS77 02235 TO MAP-MAILING-LINE-5 DTSCS77 02236 GO TO S4410-EXIT. DTSCS77 02237 SKIP1 DTSCS77 02238 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS77 02239 S4410-EXIT. DTSCS77 02240 EXIT. DTSCS77 02241 /*****************************************************************DTSCS77 02242 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS77 02243 ******************************************************************DTSCS77 02244 S5100-SET-LOCK-ATTRB. DTSCS77 02245 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS77 02246 WRK-ATB-NUM. DTSCS77 02247 SKIP1 DTSCS77 02248 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS77 02249 SKIP1 DTSCS77 02250 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS77 02251 MAP-EMP-NO-2-A DTSCS77 02252 MAP-GOTO-A. DTSCS77 02253 S5100-EXIT. DTSCS77 02254 EXIT. DTSCS77 02255 SKIP3 DTSCS77 02256 ******************************************************************DTSCS77 02257 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS77 02258 ******************************************************************DTSCS77 02259 S5200-SET-UPDATE-ATTRB. DTSCS77 02260 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS77 02261 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS77 02262 SKIP1 DTSCS77 02263 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS77 02264 S5200-EXIT. DTSCS77 02265 EXIT. DTSCS77 02266 SKIP3 DTSCS77 02267 ******************************************************************DTSCS77 02268 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS77 02269 ******************************************************************DTSCS77 02270 S5300-SET-INQ-ATTRB. DTSCS77 02271 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS77 02272 WRK-ATB-NUM. DTSCS77 02273 SKIP1 DTSCS77 02274 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS77 02275 SKIP1 DTSCS77 02276 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS77 02277 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-ADDR-ID-NO-A. DTSCS77 02278 S5300-EXIT. DTSCS77 02279 EXIT. DTSCS77 02280 SKIP3 DTSCS77 02281 S5900-SET-ATTRB. DTSCS77 02282 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS77 02283 MAP-EMP-NO-2-A. DTSCS77 02284 SKIP1 DTSCS77 02285 MOVE WRK-ATB-AN TO MAP-TEMPLATE-ID-A. DTSCS77 02286 SKIP1 DTSCS77 02287 MOVE WRK-ATB-AN TO MAP-ADDR-TYPE-A. DTSCS77 02288 SKIP1 DTSCS77 02289 MOVE WRK-ATB-NUM TO MAP-ADDR-ID-NO-A. DTSCS77 02290 SKIP1 DTSCS77 02291 MOVE WRK-ATB-AN TO MAP-CORR-OP-ID-A. DTSCS77 02292 SKIP1 DTSCS77 02293 MOVE WRK-ATB-AN TO MAP-FLD-REP-ID-A. DTSCS77 02294 SKIP1 DTSCS77 02295 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS77 02296 MAP-MAILING-LINE-1-A DTSCS77 02297 MAP-MAILING-LINE-2-A DTSCS77 02298 MAP-MAILING-LINE-3-A DTSCS77 02299 MAP-MAILING-LINE-4-A DTSCS77 02300 MAP-MAILING-LINE-5-A. DTSCS77 02301 SKIP1 DTSCS77 02302 MOVE WRK-ATB-NUM TO MAP-COPY-CNT-A. DTSCS77 02303 SKIP1 DTSCS77 02304 MOVE WRK-ATB-NUM TO MAP-CERT-NUM1-A DTSCS77 02305 MAP-CERT-NUM2-A. DTSCS77 02306 SKIP1 DTSCS77 02307 MOVE WRK-ATB-NUM TO MAP-CORR-MO-A DTSCS77 02308 MAP-CORR-DA-A DTSCS77 02309 MAP-CORR-YR-A. DTSCS77 02310 SKIP1 DTSCS77 02311 MOVE WRK-ATB-AN TO MAP-CORR-STATE-A. DTSCS77 02312 SKIP1 DTSCS77 02313 MOVE WRK-ATB-NUM TO MAP-TRIGGER-MO-A DTSCS77 02314 MAP-TRIGGER-DA-A DTSCS77 02315 MAP-TRIGGER-YR-A. DTSCS77 02316 SKIP1 DTSCS77 02317 PERFORM S5910-TEXT-LINE THRU S5910-EXIT DTSCS77 02318 VARYING MAP-TEXT-IDX FROM 1 BY 1 DTSCS77 02319 UNTIL MAP-TEXT-IDX > WRK-TEXT-MAX. DTSCS77 02320 SKIP1 DTSCS77 02321 MOVE WRK-ATB-AN TO MAP-QUEUE-OP-ID-A. DTSCS77 02322 SKIP1 DTSCS77 02323 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS77 02324 S5900-EXIT. DTSCS77 02325 EXIT. DTSCS77 02326 SKIP3 DTSCS77 02327 S5910-TEXT-LINE. DTSCS77 02328 MOVE WRK-ATB-AN TO MAP-TEXT-A (MAP-TEXT-IDX). DTSCS77 02329 S5910-EXIT. DTSCS77 02330 EXIT. DTSCS77 02331 /*****************************************************************DTSCS77 02332 * MAP ROUTINES *DTSCS77 02333 ******************************************************************DTSCS77 02334 S9100-RECEIVE. DTSCS77 02335 SET L851-RECEIVE-88 TO TRUE. DTSCS77 02336 SKIP1 DTSCS77 02337 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS77 02338 SKIP1 DTSCS77 02339 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS77 02340 SKIP1 DTSCS77 02341 MOVE L851-AID TO LCCM-AID. DTSCS77 02342 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS77 02343 S9100-EXIT. DTSCS77 02344 EXIT. DTSCS77 02345 SKIP3 DTSCS77 02346 S9200-SEND-DATAONLY. DTSCS77 02347 MOVE LOW-VALUES TO MAP-AREA. DTSCS77 02348 SKIP1 DTSCS77 02349 IF LCCM-NO-MSG DTSCS77 02350 NEXT SENTENCE DTSCS77 02351 ELSE DTSCS77 02352 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS77 02353 SKIP1 DTSCS77 02354 IF CURSOR-SET-GOTO DTSCS77 02355 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS77 02356 ELSE DTSCS77 02357 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS77 02358 SKIP1 DTSCS77 02359 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS77 02360 SKIP1 DTSCS77 02361 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS77 02362 SKIP1 DTSCS77 02363 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS77 02364 S9200-EXIT. DTSCS77 02365 EXIT. DTSCS77 02366 SKIP3 DTSCS77 02367 S9300-SEND-MAP. DTSCS77 02368 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS77 02369 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS77 02370 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS77 02371 SKIP1 DTSCS77 02372 IF SCR-ACCESS-UPDATE DTSCS77 02373 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS77 02374 ELSE DTSCS77 02375 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS77 02376 SKIP1 DTSCS77 02377 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS77 02378 SKIP1 DTSCS77 02379 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS77 02380 SKIP1 DTSCS77 02381 IF CURSOR-SET-NO DTSCS77 02382 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS77 02383 SKIP1 DTSCS77 02384 SET L851-SEND-88 TO TRUE. DTSCS77 02385 SKIP1 DTSCS77 02386 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS77 02387 SKIP1 DTSCS77 02388 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS77 02389 S9300-EXIT. DTSCS77 02390 EXIT. DTSCS77 02391 SKIP3 DTSCS77 02392 S9310-UPDATE-FKEYS. DTSCS77 02393 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS77 02394 SKIP1 DTSCS77 02395 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS77 02396 SKIP1 DTSCS77 02397 IF LCCM-SCR-CLEAR DTSCS77 02398 NEXT SENTENCE DTSCS77 02399 ELSE DTSCS77 02400 IF LCCM-SCR-INQUIRE DTSCS77 02401 NEXT SENTENCE DTSCS77 02402 ELSE DTSCS77 02403 IF LCCM-SCR-UPDATE-LOCKED DTSCS77 02404 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS77 02405 ELSE DTSCS77 02406 NEXT SENTENCE. DTSCS77 02407 S9310-EXIT. DTSCS77 02408 EXIT. DTSCS77 02409 SKIP3 DTSCS77 02410 S9320-INQUIRY-FKEYS. DTSCS77 02411 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS77 02412 SKIP1 DTSCS77 02413 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS77 02414 S9320-EXIT. DTSCS77 02415 EXIT. DTSCS77 02416 SKIP3 DTSCS77 02417 *S9321-JUMP-KEYS. DTSCS77 02418 * MOVE 'F21=EVENT LOG' TO MAP-KEY-EVL. DTSCS77 02419 * MOVE 'F22=TICKLER' TO MAP-KEY-TCK. DTSCS77 02420 *S9321-EXIT. DTSCS77 02421 EXIT. DTSCS77 02422 SKIP3 DTSCS77 02423 S9330-DSCR-FIELDS. DTSCS77 02424 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS77 02425 IF WRK-MPRF-YES-88 DTSCS77 02426 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS77 02427 SKIP1 DTSCS77 02428 IF MAP-CORR-OP-ID = LOW-VALUES OR SPACES DTSCS77 02429 MOVE LOW-VALUES TO MAP-CORR-OP-ID-DESC DTSCS77 02430 ELSE DTSCS77 02431 IF MAP-CORR-OP-ID = LCCM-OP-ID DTSCS77 02432 MOVE LCCM-OP-NAME TO MAP-CORR-OP-ID-DESC DTSCS77 02433 ELSE DTSCS77 02434 MOVE MAP-CORR-OP-ID TO L082-OP-ID DTSCS77 02435 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS77 02436 MOVE L082-NAME TO MAP-CORR-OP-ID-DESC. DTSCS77 02437 SKIP1 DTSCS77 02438 IF MAP-FLD-REP-ID = SPACES OR LOW-VALUES DTSCS77 02439 MOVE LOW-VALUES TO MAP-FLD-REP-ID-DESC DTSCS77 02440 ELSE DTSCS77 02441 IF MAP-FLD-REP-NONE-88 DTSCS77 02442 MOVE LOW-VALUES TO MAP-FLD-REP-ID-DESC DTSCS77 02443 ELSE DTSCS77 02444 MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID DTSCS77 02445 PERFORM S062-FLD-REP-DSCR THRU S062-EXIT DTSCS77 02446 MOVE L062-NAME TO MAP-FLD-REP-ID-DESC. DTSCS77 02447 SKIP1 DTSCS77 02448 IF MAP-QUEUE-OP-ID = LOW-VALUES OR SPACES DTSCS77 02449 MOVE LOW-VALUES TO MAP-QUEUE-OP-ID-DESC DTSCS77 02450 ELSE DTSCS77 02451 IF MAP-QUEUE-OP-ID = LCCM-OP-ID DTSCS77 02452 MOVE LCCM-OP-NAME TO MAP-QUEUE-OP-ID-DESC DTSCS77 02453 ELSE DTSCS77 02454 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID DTSCS77 02455 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS77 02456 MOVE L082-NAME TO MAP-QUEUE-OP-ID-DESC. DTSCS77 02457 S9330-EXIT. DTSCS77 02458 EXIT. DTSCS77 02459 SKIP3 DTSCS77 02460 S9900-PREPARE-SEND. DTSCS77 02461 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS77 02462 LCCM-SCR-ID. DTSCS77 02463 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS77 02464 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS77 02465 S9900-EXIT. DTSCS77 02466 EXIT. DTSCS77