00001 IDENTIFICATION DIVISION. 05/18/99 00002 PROGRAM-ID. DTSCS43. DTSCS43 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008 00004 DATE-WRITTEN. JUNE 1994. DTSCS43 00005 DATE-COMPILED. DTSCS43 00006 SKIP3 DTSCS43 00007 ***** DTSCS43 00008 * DTSCS43 00009 * FUNCTION: APPEAL INQUIRY/UPDATE DTSCS43 00010 * SCREEN PROCESSOR. DTSCS43 00011 * DTSCS43 00012 * DTSCS43 00013 * MODIFICATION LOG: DTSCS43 00014 * DTSCS43 00015 * 01/28/99 INITIAL DEVELOPMENT. COPIED FROM MACCS43 CL**2 00016 * REFERENCE RFP: PROGRAMMER: ZL1 CL**2 00017 * DTSCS43 00018 * 05/18/1999 PICKUP MODIFICATIONS. ENTRY OF AND DISPLAY OF CL**7 00019 * 'PU' IN COVERED YR/Q. CL**7 00020 * REFERENCE: PICKUP DIR PROGRAMMER: EHH CL**7 00021 * CL**7 00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**7 00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**7 00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**7 00025 * DTSCS43 00026 * DTSCS43 00027 * DESCRIPTION: DTSCS43 00028 * DTSCS43 00029 * CLEAR: DTSCS43 00030 * DTSCS43 00031 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS43 00032 * DTSCS43 00033 * DTSCS43 00034 * JUMP: DTSCS43 00035 * DTSCS43 00036 * F19 QUARTER INQUIRY (31). DTSCS43 00037 * F20 COLLECTIONS INQUIRY (41). DTSCS43 00038 * DTSCS43 00039 * DTSCS43 00040 * INQUIRY: DTSCS43 00041 * DTSCS43 00042 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS43 00043 * DTSCS43 00044 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR43-HOLD-AREA EMP-NO DTSCS43 00045 * DISPLAY RECORD INDICATED BY DTSCS43 00046 * LCCM-SCR43-HOLD-AREA DTSCS43 00047 * ELSE DTSCS43 00048 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS43 00049 * WITH LCCM-EMP-NO. DTSCS43 00050 * DTSCS43 00051 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS43 00052 * DTSCS43 00053 * DISPLAY SEQUENCE: ASCENDING ON MAPL-ESTB-ABSTIME. DTSCS43 00054 * DTSCS43 00055 * PAGE INITIALLY DISPLAYED: LAST. DTSCS43 00056 * DTSCS43 00057 * DTSCS43 00058 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS43 00059 * DTSCS43 00060 * STORE INFORMATION REPRESENTING PAGE DTSCS43 00061 * CURRENTLY DISPLAYED IN LCCM-SCR43-HOLD-AREA. DTSCS43 00062 * DTSCS43 00063 * DTSCS43 00064 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS43 00065 * DTSCS43 00066 * DTSCS43 00067 * UPDATE: DTSCS43 00068 * DTSCS43 00069 * ADD DTSCS43 00070 * MOD DTSCS43 00071 * DEL DTSCS43 00072 * DTSCS43 00073 * DTSCS43 00074 * RECORDS READ: DTSCS43 00075 * DTSCS43 00076 * MASTER: DTSCS43 00077 * DTSCS43 00078 * MPRF DTSCS43 00079 * MAPL DTSCS43 00080 * DTSCS43 00081 * DTSCS43 00082 * ALTERNATE INDEX: DTSCS43 00083 * DTSCS43 00084 * NONE. DTSCS43 00085 * DTSCS43 00086 * DTSCS43 00087 * REFERENCE: DTSCS43 00088 * DTSCS43 00089 * NONE. DTSCS43 00090 * DTSCS43 00091 * DTSCS43 00092 * ACCOUNTING TRANSACTION COLLECTION: DTSCS43 00093 * DTSCS43 00094 * NONE. DTSCS43 00095 * DTSCS43 00096 * DTSCS43 00097 * RECORDS UPDATED: DTSCS43 00098 * DTSCS43 00099 * MASTER: DTSCS43 00100 * DTSCS43 00101 * MPRF (REWRITE) MAINTAIN MPRF-MAPL-IND. DTSCS43 00102 * DTSCS43 00103 * MAPL (WRITE, REWRITE, DELETE) DTSCS43 00104 * DTSCS43 00105 * MTCK (WRITE) DTSCS43 00106 * IF APPEAL TYPE IS EQUAL TO 'A' (AUDIT) AND DTSCS43 00107 * APPEAL STATUS IS CHANGED FROM "OPEN" TO "CLOSED", DTSCS43 00108 * THEN WRITE A TYPE 'MAN' TICKLER WITH DESTINATION DTSCS43 00109 * EQUAL TO 'FLDDSK' AND TRIGGER DATE EQUAL TO CURRENT DTSCS43 00110 * RUN DATE. DTSCS43 00111 * DTSCS43 00112 * DTSCS43 00113 * REFERENCE: DTSCS43 00114 * DTSCS43 00115 * NONE. DTSCS43 00116 * DTSCS43 00117 * DTSCS43 00118 * ACCOUNTING TRANSACTION COLLECTION: DTSCS43 00119 * DTSCS43 00120 * NONE. DTSCS43 00121 * DTSCS43 00122 * DTSCS43 00123 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS43 00124 * DTSCS43 00125 * NONE. DTSCS43 00126 * DTSCS43 00127 * DTSCS43 00128 * TEMPORARY STORAGE USAGE: DTSCS43 00129 * DTSCS43 00130 * NONE DTSCS43 00131 * DTSCS43 00132 * DTSCS43 00133 * MODULES LINKED TO: DTSCS43 00134 * DTSCS43 00135 * DTSCU001 DATE EDIT/CONVERSION. CL**2 00136 * DTSCU004 QUARTER EDIT/CONVERSION. CL**2 00137 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. CL**2 00138 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. CL**7 00139 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. CL**2 00140 * DTSCU034 COLLECTIONS CODES EDIT/DESCRIPTION. CL**2 00141 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. CL**2 00142 * DTSCU331 WRITE MAINTENANCE LIST REPORT RECORD. CL**2 00143 * DTSCU810 MASTER FILE INPUT/OUTPUT. CL**2 00144 * DTSCS43 00145 * DTSCS43 00146 * VERMONT REFERENCE: DTSCS43 00147 * DTSCS43 00148 * TXC260C (SIMILAR IN STRUCTURE; NOT IN CONTENT). DTSCS43 00149 * DTSCS43 00150 * . I CALL FOR USING DTSCU331, BUT CAN'T FIND ANY DATA CL**2 00151 * ELEMENTS TO REPORT VIA DTSCU331. CL**2 00152 * DTSCS43 00153 * . ONE MPRF DATA ELEMENT (MPRF-APL-IND) MUST BE UPDATED. DTSCS43 00154 * DTSCS43 00155 * . THE FILE/DECISION DATE EDITS AND COVERED YR/Q EDITS DTSCS43 00156 * ARE SPECIFIED IN THE DATA ELEMENT DEFINITIONS. DON'T DTSCS43 00157 * TRY TO EDIT YR/Q AGAINST MSOL OR MQTR RECORDS. DTSCS43 00158 * DTSCS43 00159 * . NOTE THE ONE TICKLER RECORD WRITTEN. DTSCS43 00160 * DTSCS43 00161 * DTSCS43 00162 * TURNAROUND NOTES TO JEFF: DTSCS43 00163 * DTSCS43 00164 * . THE LOGIC FOR F14, F19, AND F20 WAS MISSING. INSERTED. DTSCS43 00165 * DTSCS43 00166 * . P6100. THE IF L810-NO-REC-88 FOLLOWING THE PERFORM DTSCS43 00167 * P6190 IS MISSING A GO TO. THIS IS A BUG THAT I DTSCS43 00168 * DISCOVERED A COUPLE OF MONTHS AGO AND HAD INFORMED DTSCS43 00169 * YOU OF. I DON'T UNDERSTAND WHY IT HAS REAPPEARED. DTSCS43 00170 * DTSCS43 00171 * . I DON'T UNDERSTAND WHY THE VARYING CLAUSE IN THE IN LINE DTSCS43 00172 * PERFORMS IS SPREAD ACROSS THREE LINES. DTSCS43 00173 * DTSCS43 00174 * . P7100. MOVED THE IF LCCM-MSG AT BOTTOM OF PARAGRAPH DTSCS43 00175 * (WHERE IT IS INEFFECTIVE) UP (TO FOLLOW S1110-READ-MPRF). DTSCS43 00176 * INSERTED MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS43 00177 * DTSCS43 00178 * . P8120. FIXED THE MOVE MAPL-REC BUG. DTSCS43 00179 * DTSCS43 00180 * . P8700. A BUG EXISTS IN THE COMPLEX IF STATEMENT THAT DTSCS43 00181 * PROCESSES STATUS-CD CHANGES. ADDED "OR ALL-NINES-DATE". DTSCS43 00182 * DTSCS43 00183 * . S1200. REMOVE "TYPE" VALUES FROM MAP-AREA AND USE DTSCS43 00184 * A CALL TO DTSCU034. CL**2 00185 * DTSCS43 00186 * . S1700. REMOVE THE REDUNDANT IF L029-YRQ = +0 STATEMENT. CL**7 00187 * DTSCS43 00188 ***** DTSCS43 00189 DTSCS43 00190 ENVIRONMENT DIVISION. DTSCS43 00191 DTSCS43 00192 DATA DIVISION. DTSCS43 00193 DTSCS43 00194 WORKING-STORAGE SECTION. DTSCS43 001945 77 PAN-VALET PICTURE X(24) VALUE '008DTSCS43 05/18/99'. DTSCS43 00195 DTSCS43 00196 01 WRK-AREA. DTSCS43 00197 05 WRK-ABEND-CD PIC X(04) VALUE 'S43 '. DTSCS43 00198 DTSCS43 00199 05 WRK-SCR-ID. DTSCS43 00200 10 WRK-SCR-ID-N PIC 9(02) VALUE 43. DTSCS43 00201 DTSCS43 00202 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS43 00203 DTSCS43 00204 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS43 00205 VALUE +999999999.DTSCS43 00206 DTSCS43 00207 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCS43 00208 VALUE +99999. DTSCS43 00209 DTSCS43 00210 05 SCR-ACCESS-IND PIC X(01). DTSCS43 00211 88 SCR-ACCESS-INQ VALUE '1'. DTSCS43 00212 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS43 00213 DTSCS43 00214 05 CURSOR-SET-IND PIC X(01). DTSCS43 00215 88 CURSOR-SET-YES VALUE 'Y'. DTSCS43 00216 88 CURSOR-SET-NO VALUE 'N'. DTSCS43 00217 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS43 00218 DTSCS43 00219 05 REQ-IND PIC X(01). DTSCS43 00220 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS43 00221 88 REQ-ERROR VALUE 'O'. DTSCS43 00222 88 REQ-JUMP VALUE 'J'. DTSCS43 00223 88 REQ-UPDATE VALUE 'U'. DTSCS43 00224 88 REQ-INQUIRE VALUE 'I'. DTSCS43 00225 88 REQ-CLEAR VALUE 'C'. DTSCS43 00226 88 REQ-EDIT VALUE 'E'. DTSCS43 00227 DTSCS43 00228 05 RESP-IND PIC X(01). DTSCS43 00229 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS43 00230 88 RESP-SEND-MAP VALUE 'M'. DTSCS43 00231 88 RESP-JUMP VALUE 'J'. DTSCS43 00232 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS43 00233 DTSCS43 00234 05 WRK-MSG-AREA PIC X(64). DTSCS43 00235 DTSCS43 00236 05 WRK-ATB-AN PIC X(01). DTSCS43 00237 05 WRK-ATB-NUM PIC X(01). DTSCS43 00238 DTSCS43 00239 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS43 00240 DTSCS43 00241 05 WRK-LAST-YRQ PIC S9(05) COMP-3. DTSCS43 00242 DTSCS43 00243 05 WRK-FILE-DATE OCCURS 4 TIMES PIC S9(09) COMP-3. CL**4 00244 DTSCS43 00245 05 WRK-MPRF-IND PIC X(01). DTSCS43 00246 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS43 00247 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS43 00248 DTSCS43 00249 05 WRK-MAPL-IND PIC X(01). DTSCS43 00250 88 WRK-MAPL-YES-88 VALUE 'Y'. DTSCS43 00251 88 WRK-MAPL-NO-88 VALUE 'N'. DTSCS43 00252 DTSCS43 00253 05 WRK-DISPLAY PIC 9(11). DTSCS43 00254 DTSCS43 00255 05 FILLER REDEFINES WRK-DISPLAY. DTSCS43 00256 10 FILLER PIC X(05). DTSCS43 00257 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS43 00258 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS43 00259 DTSCS43 00260 05 FILLER REDEFINES WRK-DISPLAY. DTSCS43 00261 10 FILLER PIC X(08). DTSCS43 00262 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS43 00263 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS43 00264 DTSCS43 00265 05 FILLER REDEFINES WRK-DISPLAY. DTSCS43 00266 10 FILLER PIC 9(05). DTSCS43 00267 10 WRK-DISPLAY-YR PIC 9(02). DTSCS43 00268 10 WRK-DISPLAY-MO PIC 9(02). DTSCS43 00269 10 WRK-DISPLAY-DA PIC 9(02). DTSCS43 00270 10 WRK-DISPLAY-CAL-YR REDEFINES WRK-DISPLAY-DA DTSCS43 00271 PIC 9(02). DTSCS43 00272 DTSCS43 00273 05 INQUIRY-CONTROL-AREA. DTSCS43 00274 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS43 00275 10 WS-REC-NUM PIC S9(08) COMP. DTSCS43 00276 DTSCS43 00277 10 LAST-REC-KEY-AREA PIC X(16). DTSCS43 00278 10 SCR-REC-KEY-AREA PIC X(16). DTSCS43 00279 DTSCS43 00280 10 WS-REC-FOUND-IND PIC X(01). DTSCS43 00281 DTSCS43 00282 05 WRK-OCC PIC S9(04) COMP. DTSCS43 00283 EJECT DTSCS43 00284 01 MSG-LITERALS. DTSCS43 00285 05 MSG-E431-AREA. DTSCS43 00286 10 FILLER PIC X(04) VALUE 'E431'. DTSCS43 00287 10 FILLER PIC X(60) VALUE DTSCS43 00288 'YR/Q ENTRIES MAY NOT BE SKIPPED MUST BE ASCENDING '.DTSCS43 00289 EJECT DTSCS43 00290 01 L001-COMM-AREA. DTSCS43 00291 ++INCLUDE DTSIL001 CL**2 00292 EJECT DTSCS43 00293 01 L004-COMM-AREA. DTSCS43 00294 ++INCLUDE DTSIL004 CL**2 00295 EJECT DTSCS43 00296 01 L015-COMM-AREA. DTSCS43 00297 ++INCLUDE DTSIL015 CL**2 00298 EJECT DTSCS43 00299 01 L018-COMM-AREA. DTSCS43 00300 ++INCLUDE DTSIL018 CL**2 00301 EJECT DTSCS43 00302 01 L029-COMM-AREA. CL**7 00303 ++INCLUDE DTSIL029 CL**7 00304 EJECT CL**7 00305 01 L034-COMM-AREA. DTSCS43 00306 ++INCLUDE DTSIL034 CL**2 00307 EJECT DTSCS43 00308 01 L221-COMM-AREA. DTSCS43 00309 ++INCLUDE DTSIL221 CL**2 00310 EJECT DTSCS43 00311 01 L331-COMM-AREA. DTSCS43 00312 ++INCLUDE DTSIL331 CL**2 00313 EJECT DTSCS43 00314 01 L805-COMM-AREA. DTSCS43 00315 ++INCLUDE DTSIL805 CL**2 00316 EJECT DTSCS43 00317 01 L810-COMM-AREA. DTSCS43 00318 05 L810-CONTROL-BLOCK. DTSCS43 00319 ++INCLUDE DTSIL810 CL**2 00320 EJECT DTSCS43 00321 05 MSKL-REC. DTSCS43 00322 ++INCLUDE DTSIMSKL CL**2 00323 EJECT DTSCS43 00324 * DTSCS43 00325 01 MPRF-REC. DTSCS43 00326 ++INCLUDE DTSIMPRF CL**2 00327 EJECT DTSCS43 00328 01 MAPL-REC. DTSCS43 00329 ++INCLUDE DTSIMAPL CL**2 00330 EJECT DTSCS43 00331 01 MTCK-REC. DTSCS43 00332 ++INCLUDE DTSIMTCK CL**2 00333 EJECT DTSCS43 00334 01 L851-COMM-AREA. DTSCS43 00335 ++INCLUDE DTSIL851 CL**2 00336 DTSCS43 00337 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS43 00338 ++INCLUDE DTSIS43 CL**2 00339 EJECT DTSCS43 00340 01 CATB-LITERALS. DTSCS43 00341 ++INCLUDE DTSICATB CL**2 00342 DTSCS43 00343 01 CFKD-LITERALS. DTSCS43 00344 ++INCLUDE DTSICFKD CL**2 00345 DTSCS43 00346 01 CECD-LITERALS. DTSCS43 00347 ++INCLUDE DTSICECD CL**2 00348 DTSCS43 00349 01 CPCD-LITERALS. DTSCS43 00350 ++INCLUDE DTSICPCD CL**2 00351 DTSCS43 00352 01 MMAX-LITERALS. DTSCS43 00353 ++INCLUDE DTSIMMAX CL**2 00354 DTSCS43 00355 LINKAGE SECTION. DTSCS43 00356 DTSCS43 00357 01 DFHCOMMAREA. DTSCS43 00358 ++INCLUDE DTSILCCM CL**2 00359 EJECT DTSCS43 00360 ******************************************************************DTSCS43 00361 * *DTSCS43 00362 ******************************************************************DTSCS43 00363 DTSCS43 00364 PROCEDURE DIVISION. DTSCS43 00365 DTSCS43 00366 MOVE +0 TO WRK-EMP-NO. DTSCS43 00367 SET WRK-MPRF-NO-88 TO TRUE. DTSCS43 00368 DTSCS43 00369 MOVE LOW-VALUES TO MAP-AREA. DTSCS43 00370 DTSCS43 00371 SET CURSOR-SET-NO TO TRUE. DTSCS43 00372 DTSCS43 00373 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS43 00374 TO SCR-ACCESS-IND. DTSCS43 00375 DTSCS43 00376 MOVE SPACE TO REQ-IND. DTSCS43 00377 DTSCS43 00378 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS43 00379 DTSCS43 00380 *----------------------------------------------------- DTSCS43 00381 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS43 00382 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS43 00383 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS43 00384 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS43 00385 * DTSCS43 00386 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS43 00387 * PROCESSED. DTSCS43 00388 * DTSCS43 00389 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS43 00390 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS43 00391 * WORK STATION OPERATOR. DTSCS43 00392 *----------------------------------------------------- DTSCS43 00393 DTSCS43 00394 MOVE SPACE TO RESP-IND. DTSCS43 00395 DTSCS43 00396 IF REQ-ERROR DTSCS43 00397 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS43 00398 ELSE DTSCS43 00399 IF REQ-JUMP DTSCS43 00400 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS43 00401 ELSE DTSCS43 00402 IF REQ-CLEAR DTSCS43 00403 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS43 00404 ELSE DTSCS43 00405 IF REQ-CURSOR-TO-GOTO DTSCS43 00406 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS43 00407 ELSE DTSCS43 00408 IF REQ-INQUIRE DTSCS43 00409 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS43 00410 ELSE DTSCS43 00411 IF REQ-EDIT DTSCS43 00412 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS43 00413 ELSE DTSCS43 00414 IF REQ-UPDATE DTSCS43 00415 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS43 00416 ELSE DTSCS43 00417 GO TO S899-ABEND. DTSCS43 00418 DTSCS43 00419 *----------------------------------------------------- DTSCS43 00420 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS43 00421 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS43 00422 *----------------------------------------------------- DTSCS43 00423 DTSCS43 00424 IF RESP-SEND-MAP DTSCS43 00425 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS43 00426 SET LCCM-END-TASK-88 TO TRUE DTSCS43 00427 ELSE DTSCS43 00428 IF RESP-SEND-MSGONLY DTSCS43 00429 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS43 00430 SET LCCM-END-TASK-88 TO TRUE DTSCS43 00431 ELSE DTSCS43 00432 IF RESP-JUMP DTSCS43 00433 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS43 00434 ELSE DTSCS43 00435 IF RESP-CURSOR-TO-GOTO DTSCS43 00436 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS43 00437 SET LCCM-END-TASK-88 TO TRUE DTSCS43 00438 ELSE DTSCS43 00439 GO TO S899-ABEND. DTSCS43 00440 DTSCS43 00441 MAINLINE-EXIT. DTSCS43 00442 DTSCS43 00443 EXEC CICS DTSCS43 00444 RETURN DTSCS43 00445 END-EXEC. DTSCS43 00446 DTSCS43 00447 GOBACK. DTSCS43 00448 EJECT DTSCS43 00449 /*****************************************************************DTSCS43 00450 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS43 00451 ******************************************************************DTSCS43 00452 P1000-ANALYZE-REQUEST. DTSCS43 00453 DTSCS43 00454 *----------------------------------------------------- DTSCS43 00455 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS43 00456 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS43 00457 * REPLACED WITH ENTER) DTSCS43 00458 *----------------------------------------------------- DTSCS43 00459 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS43 00460 SET LCCM-ENTER-88 TO TRUE DTSCS43 00461 IF LCCM-EMP-NO > ZERO DTSCS43 00462 SET REQ-INQUIRE TO TRUE DTSCS43 00463 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS43 00464 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS43 00465 ELSE DTSCS43 00466 SET REQ-INQUIRE TO TRUE DTSCS43 00467 END-IF DTSCS43 00468 GO TO P1000-EXIT. DTSCS43 00469 DTSCS43 00470 *----------------------------------------------------- DTSCS43 00471 * MAP IS RECEIVED DTSCS43 00472 *----------------------------------------------------- DTSCS43 00473 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS43 00474 DTSCS43 00475 *----------------------------------------------------- DTSCS43 00476 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS43 00477 * WORK STATION DTSCS43 00478 *----------------------------------------------------- DTSCS43 00479 IF LCCM-CLEAR-88 DTSCS43 00480 SET REQ-CLEAR TO TRUE DTSCS43 00481 GO TO P1000-EXIT. DTSCS43 00482 DTSCS43 00483 *----------------------------------------------------- DTSCS43 00484 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS43 00485 *----------------------------------------------------- DTSCS43 00486 IF LCCM-SCR-UPDATE-LOCKED DTSCS43 00487 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS43 00488 GO TO P1000-EXIT. DTSCS43 00489 DTSCS43 00490 *----------------------------------------------------- DTSCS43 00491 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS43 00492 *----------------------------------------------------- DTSCS43 00493 IF LCCM-PA2-88 DTSCS43 00494 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS43 00495 GO TO P1000-EXIT. DTSCS43 00496 DTSCS43 00497 *----------------------------------------------------- DTSCS43 00498 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS43 00499 *----------------------------------------------------- DTSCS43 00500 IF LCCM-PA-88 DTSCS43 00501 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS43 00502 SET REQ-ERROR TO TRUE DTSCS43 00503 GO TO P1000-EXIT. DTSCS43 00504 DTSCS43 00505 *----------------------------------------------------- CL**2 00506 * IF F12 IS PRESS AND UPDATE NOT IN PROGRESS THEN CL**2 00507 * CLEAR SCREEN CL**2 00508 *----------------------------------------------------- CL**2 00509 IF LCCM-F12-88 CL**2 00510 MOVE LOW-VALUES TO MAP-AREA CL**2 00511 SET REQ-CLEAR TO TRUE CL**2 00512 GO TO P1000-EXIT. CL**2 00513 CL**2 00514 *----------------------------------------------------- DTSCS43 00515 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS43 00516 *----------------------------------------------------- DTSCS43 00517 IF LCCM-F03-88 DTSCS43 00518 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS43 00519 SET REQ-JUMP TO TRUE DTSCS43 00520 GO TO P1000-EXIT. DTSCS43 00521 DTSCS43 00522 *----------------------------------------------------- DTSCS43 00523 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS43 00524 *----------------------------------------------------- DTSCS43 00525 IF LCCM-F04-88 DTSCS43 00526 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS43 00527 SET REQ-JUMP TO TRUE DTSCS43 00528 GO TO P1000-EXIT. DTSCS43 00529 DTSCS43 00530 *----------------------------------------------------- DTSCS43 00531 * IF CORRESPNDENCE SCREEN KEY PRESSED, THEN JUMP TO DTSCS43 00532 * CORRESPONDENCE SCREEN. DTSCS43 00533 *----------------------------------------------------- DTSCS43 00534 IF LCCM-F14-88 CL**6 00535 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID CL**6 00536 SET REQ-JUMP TO TRUE CL**6 00537 GO TO P1000-EXIT. CL**6 00538 CL**6 00539 *----------------------------------------------------- DTSCS43 00540 * IF A DIFFERENT SCREEN TYPE IS REQUESTED VIA FUNCTION DTSCS43 00541 * KEY, THEN JUMP TO THE REQUESTED SCREEN TYPE. DTSCS43 00542 *----------------------------------------------------- DTSCS43 00543 * IF LCCM-F19-88 CL**2 00544 * MOVE '31' TO LCCM-REQ-SCR-ID CL**2 00545 * SET REQ-JUMP TO TRUE CL**2 00546 * GO TO P1000-EXIT. CL**2 00547 * CL**2 00548 * IF LCCM-F20-88 CL**2 00549 * MOVE '41' TO LCCM-REQ-SCR-ID CL**2 00550 * SET REQ-JUMP TO TRUE CL**2 00551 * GO TO P1000-EXIT. CL**2 00552 * CL**2 00553 *----------------------------------------------------- DTSCS43 00554 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS43 00555 * REQUESTED SCREEN TYPE DTSCS43 00556 *----------------------------------------------------- DTSCS43 00557 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS43 00558 NEXT SENTENCE DTSCS43 00559 ELSE DTSCS43 00560 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS43 00561 SET REQ-JUMP TO TRUE DTSCS43 00562 GO TO P1000-EXIT. DTSCS43 00563 DTSCS43 00564 *----------------------------------------------------- DTSCS43 00565 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS43 00566 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS43 00567 *----------------------------------------------------- DTSCS43 00568 IF LCCM-F09-88 DTSCS43 00569 OR LCCM-F10-88 DTSCS43 00570 OR LCCM-F23-88 DTSCS43 00571 IF SCR-ACCESS-UPDATE DTSCS43 00572 SET REQ-EDIT TO TRUE DTSCS43 00573 GO TO P1000-EXIT DTSCS43 00574 ELSE DTSCS43 00575 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS43 00576 SET REQ-ERROR TO TRUE DTSCS43 00577 GO TO P1000-EXIT. DTSCS43 00578 DTSCS43 00579 *----------------------------------------------------- DTSCS43 00580 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS43 00581 * OR F8), INDICATE INQUIRY REQUEST DTSCS43 00582 *----------------------------------------------------- DTSCS43 00583 IF LCCM-INQUIRY-88 DTSCS43 00584 SET REQ-INQUIRE TO TRUE DTSCS43 00585 GO TO P1000-EXIT. DTSCS43 00586 DTSCS43 00587 *----------------------------------------------------- DTSCS43 00588 * ANY OTHER KEY IS INVALID DTSCS43 00589 *----------------------------------------------------- DTSCS43 00590 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS43 00591 SET REQ-ERROR TO TRUE. DTSCS43 00592 P1000-EXIT. DTSCS43 00593 EXIT. DTSCS43 00594 DTSCS43 00595 ******************************************************************DTSCS43 00596 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS43 00597 ******************************************************************DTSCS43 00598 DTSCS43 00599 P1100-UPDATE-LOCKED. DTSCS43 00600 *----------------------------------------------------- DTSCS43 00601 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS43 00602 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS43 00603 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS43 00604 *----------------------------------------------------- DTSCS43 00605 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS43 00606 SET REQ-UPDATE TO TRUE DTSCS43 00607 ELSE DTSCS43 00608 SET REQ-ERROR TO TRUE DTSCS43 00609 IF LCCM-SCR-ADD-LOCKED DTSCS43 00610 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS43 00611 ELSE DTSCS43 00612 IF LCCM-SCR-MOD-LOCKED DTSCS43 00613 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS43 00614 ELSE DTSCS43 00615 IF LCCM-SCR-DEL-LOCKED DTSCS43 00616 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS43 00617 ELSE DTSCS43 00618 GO TO S899-ABEND. DTSCS43 00619 P1100-EXIT. DTSCS43 00620 EXIT. DTSCS43 00621 /*****************************************************************DTSCS43 00622 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS43 00623 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS43 00624 ******************************************************************DTSCS43 00625 DTSCS43 00626 P2000-REQUEST-ERROR. DTSCS43 00627 IF LCCM-MSG DTSCS43 00628 SET RESP-SEND-MSGONLY TO TRUE DTSCS43 00629 ELSE DTSCS43 00630 GO TO S899-ABEND. DTSCS43 00631 P2000-EXIT. DTSCS43 00632 EXIT. DTSCS43 00633 /*****************************************************************DTSCS43 00634 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS43 00635 ******************************************************************DTSCS43 00636 DTSCS43 00637 P3000-REQUEST-JUMP. DTSCS43 00638 *----------------------------------------------------- DTSCS43 00639 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS43 00640 * BY USER DTSCS43 00641 *----------------------------------------------------- DTSCS43 00642 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS43 00643 DTSCS43 00644 *----------------------------------------------------- DTSCS43 00645 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS43 00646 *----------------------------------------------------- DTSCS43 00647 IF LCCM-MSG DTSCS43 00648 SET RESP-SEND-MSGONLY TO TRUE DTSCS43 00649 SET CURSOR-SET-GOTO TO TRUE DTSCS43 00650 GO TO P3000-EXIT. DTSCS43 00651 SKIP3 DTSCS43 00652 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS43 00653 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS43 00654 IF L018-VALID DTSCS43 00655 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS43 00656 DTSCS43 00657 *----------------------------------------------------- DTSCS43 00658 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS43 00659 *----------------------------------------------------- DTSCS43 00660 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS43 00661 LCCM-SCR-HOLD-AREA. DTSCS43 00662 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS43 00663 SET RESP-JUMP TO TRUE. DTSCS43 00664 P3000-EXIT. DTSCS43 00665 EXIT. DTSCS43 00666 /*****************************************************************DTSCS43 00667 * CLEAR KEY WAS PRESSED *DTSCS43 00668 ******************************************************************DTSCS43 00669 DTSCS43 00670 P4000-REQUEST-CLEAR. DTSCS43 00671 DTSCS43 00672 *----------------------------------------------------- DTSCS43 00673 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS43 00674 * FIELDS FROM EARLIER REQUESTS DTSCS43 00675 *----------------------------------------------------- DTSCS43 00676 IF LCCM-EMP-NO > ZERO DTSCS43 00677 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS43 00678 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS43 00679 DTSCS43 00680 MOVE ZERO TO LCCM-EMP-NO. DTSCS43 00681 DTSCS43 00682 MOVE LOW-VALUES TO LCCM-SCR43-HOLD-AREA. DTSCS43 00683 DTSCS43 00684 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS43 00685 DTSCS43 00686 SET LCCM-SCR-CLEAR TO TRUE. DTSCS43 00687 DTSCS43 00688 IF SCR-ACCESS-UPDATE DTSCS43 00689 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS43 00690 ELSE DTSCS43 00691 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS43 00692 DTSCS43 00693 SET RESP-SEND-MAP TO TRUE. DTSCS43 00694 P4000-EXIT. DTSCS43 00695 EXIT. DTSCS43 00696 /*****************************************************************DTSCS43 00697 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS43 00698 ******************************************************************DTSCS43 00699 DTSCS43 00700 P5000-CURSOR-TO-GOTO. DTSCS43 00701 SET CURSOR-SET-GOTO TO TRUE. DTSCS43 00702 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS43 00703 P5000-EXIT. DTSCS43 00704 EXIT. DTSCS43 00705 /*****************************************************************DTSCS43 00706 * INQUIRY WAS REQUESTED *DTSCS43 00707 ******************************************************************DTSCS43 00708 DTSCS43 00709 P6000-REQUEST-INQUIRE. DTSCS43 00710 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS43 00711 MOVE LOW-VALUES TO MAP-AREA. DTSCS43 00712 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS43 00713 DTSCS43 00714 SET LCCM-SCR-CLEAR TO TRUE. DTSCS43 00715 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS43 00716 DTSCS43 00717 SET RESP-SEND-MAP TO TRUE. DTSCS43 00718 DTSCS43 00719 IF SCR-ACCESS-UPDATE DTSCS43 00720 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS43 00721 ELSE DTSCS43 00722 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS43 00723 DTSCS43 00724 MOVE LCCM-SCR43-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS43 00725 MOVE LOW-VALUES TO LCCM-SCR43-HOLD-AREA. DTSCS43 00726 DTSCS43 00727 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS43 00728 IF LCCM-MSG DTSCS43 00729 GO TO P6000-EXIT. DTSCS43 00730 DTSCS43 00731 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS43 00732 IF LCCM-MSG DTSCS43 00733 GO TO P6000-EXIT. DTSCS43 00734 DTSCS43 00735 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS43 00736 DTSCS43 00737 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS43 00738 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS43 00739 SET MSKL-APL-88 TO TRUE. DTSCS43 00740 PERFORM S810-COUNT THRU S810-EXIT. DTSCS43 00741 DTSCS43 00742 IF L810-RECORD-CNT = +0 DTSCS43 00743 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS43 00744 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 00745 GO TO P6000-EXIT. DTSCS43 00746 DTSCS43 00747 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS43 00748 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS43 00749 DTSCS43 00750 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS43 00751 IF LCCM-MSG DTSCS43 00752 GO TO P6000-EXIT. DTSCS43 00753 DTSCS43 00754 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS43 00755 DTSCS43 00756 MOVE MAPL-KEY-AREA TO LCCM-SCR43-HOLD-AREA. DTSCS43 00757 DTSCS43 00758 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS43 00759 P6000-EXIT. DTSCS43 00760 EXIT. DTSCS43 00761 EJECT DTSCS43 00762 P6100-LOCATE-REC. DTSCS43 00763 *------------------------------------------------------------ DTSCS43 00764 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS43 00765 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS43 00766 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS43 00767 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS43 00768 * RECORD WITH THE GREATEST MAPL-ESTB-ABSTIME DTSCS43 00769 *------------------------------------------------------------ DTSCS43 00770 DTSCS43 00771 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS43 00772 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS43 00773 GO TO P6100-EXIT. DTSCS43 00774 DTSCS43 00775 MOVE SCR-REC-KEY-AREA TO MAPL-KEY-AREA. DTSCS43 00776 DTSCS43 00777 IF WRK-EMP-NO = MAPL-EMP-NO DTSCS43 00778 NEXT SENTENCE DTSCS43 00779 ELSE DTSCS43 00780 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS43 00781 GO TO P6100-EXIT. DTSCS43 00782 DTSCS43 00783 IF LCCM-F05-88 DTSCS43 00784 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS43 00785 GO TO P6100-EXIT. DTSCS43 00786 DTSCS43 00787 IF LCCM-F06-88 DTSCS43 00788 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS43 00789 GO TO P6100-EXIT. DTSCS43 00790 DTSCS43 00791 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS43 00792 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS43 00793 SET MSKL-APL-88 TO TRUE. DTSCS43 00794 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS43 00795 IF L810-NO-REC-88 DTSCS43 00796 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS43 00797 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 00798 GO TO P6100-EXIT. DTSCS43 00799 DTSCS43 00800 MOVE +0 TO WS-REC-NUM. DTSCS43 00801 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS43 00802 PERFORM P6190-BROWSE-MAPL THRU P6190-EXIT DTSCS43 00803 UNTIL (L810-NO-REC-88) DTSCS43 00804 OR DTSCS43 00805 (WS-REC-FOUND-IND = 'Y'). DTSCS43 00806 DTSCS43 00807 IF L810-NO-REC-88 DTSCS43 00808 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS43 00809 GO TO P6100-EXIT. DTSCS43 00810 DTSCS43 00811 IF LCCM-ENTER-88 DTSCS43 00812 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS43 00813 GO TO P6100-EXIT. DTSCS43 00814 DTSCS43 00815 IF LCCM-F07-88 DTSCS43 00816 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS43 00817 GO TO P6100-EXIT. DTSCS43 00818 DTSCS43 00819 IF LCCM-F08-88 DTSCS43 00820 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS43 00821 GO TO P6100-EXIT. DTSCS43 00822 DTSCS43 00823 GO TO S899-ABEND. DTSCS43 00824 P6100-EXIT. DTSCS43 00825 EXIT. DTSCS43 00826 DTSCS43 00827 P6110-FIRST-REC. DTSCS43 00828 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS43 00829 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS43 00830 SET MSKL-APL-88 TO TRUE. DTSCS43 00831 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS43 00832 IF L810-NO-REC-88 DTSCS43 00833 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS43 00834 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 00835 GO TO P6110-EXIT. DTSCS43 00836 DTSCS43 00837 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS43 00838 DTSCS43 00839 MOVE MSKL-REC TO MAPL-REC. DTSCS43 00840 DTSCS43 00841 MOVE +1 TO WS-REC-NUM. DTSCS43 00842 P6110-EXIT. DTSCS43 00843 EXIT. DTSCS43 00844 DTSCS43 00845 P6120-PREV-REC. DTSCS43 00846 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS43 00847 IF L810-NO-REC-88 DTSCS43 00848 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS43 00849 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 00850 GO TO P6120-EXIT. DTSCS43 00851 DTSCS43 00852 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS43 00853 IF L810-NO-REC-88 DTSCS43 00854 GO TO P6120-EXIT. DTSCS43 00855 DTSCS43 00856 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS43 00857 DTSCS43 00858 SUBTRACT 1 FROM WS-REC-NUM. DTSCS43 00859 DTSCS43 00860 MOVE MSKL-REC TO MAPL-REC. DTSCS43 00861 P6120-EXIT. DTSCS43 00862 EXIT. DTSCS43 00863 DTSCS43 00864 P6130-NEXT-REC. DTSCS43 00865 IF MAPL-KEY-AREA > SCR-REC-KEY-AREA DTSCS43 00866 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS43 00867 GO TO P6130-EXIT. DTSCS43 00868 DTSCS43 00869 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS43 00870 DTSCS43 00871 IF L810-NO-REC-88 DTSCS43 00872 GO TO P6130-EXIT. DTSCS43 00873 DTSCS43 00874 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS43 00875 DTSCS43 00876 ADD +1 TO WS-REC-NUM. DTSCS43 00877 DTSCS43 00878 MOVE MSKL-REC TO MAPL-REC. DTSCS43 00879 P6130-EXIT. DTSCS43 00880 EXIT. DTSCS43 00881 DTSCS43 00882 P6140-LAST-REC. DTSCS43 00883 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS43 00884 PERFORM S810-READ THRU S810-EXIT. DTSCS43 00885 IF L810-NO-REC-88 DTSCS43 00886 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS43 00887 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 00888 GO TO P6140-EXIT. DTSCS43 00889 DTSCS43 00890 MOVE MSKL-REC TO MAPL-REC. DTSCS43 00891 DTSCS43 00892 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS43 00893 P6140-EXIT. DTSCS43 00894 EXIT. DTSCS43 00895 DTSCS43 00896 P6190-BROWSE-MAPL. DTSCS43 00897 MOVE MSKL-REC TO MAPL-REC. DTSCS43 00898 ADD +1 TO WS-REC-NUM. DTSCS43 00899 IF MAPL-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS43 00900 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS43 00901 ELSE DTSCS43 00902 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS43 00903 P6190-EXIT. DTSCS43 00904 EXIT. DTSCS43 00905 /*****************************************************************DTSCS43 00906 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS43 00907 ******************************************************************DTSCS43 00908 DTSCS43 00909 P6900-CONSTRUCT-SCREEN. DTSCS43 00910 PERFORM P6910-FROM-MAPL THRU P6910-EXIT. DTSCS43 00911 DTSCS43 00912 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS43 00913 P6900-EXIT. DTSCS43 00914 EXIT. DTSCS43 00915 DTSCS43 00916 P6910-FROM-MAPL. DTSCS43 00917 MOVE MAPL-STATUS-CD TO MAP-STATUS-CD. DTSCS43 00918 DTSCS43 00919 MOVE MAPL-STATUS-DATE TO L001-FED-8-DATE-9. DTSCS43 00920 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS43 00921 MOVE L001-SLASH-DATE TO MAP-STATUS-DATE. DTSCS43 00922 DTSCS43 00923 MOVE MAPL-STATUS-OP-ID TO MAP-STATUS-OP-ID. DTSCS43 00924 DTSCS43 00925 MOVE MAPL-OPEN-DATE TO WRK-DISPLAY. DTSCS43 00926 MOVE WRK-DISPLAY-MO TO MAP-OPEN-DATE-MO. DTSCS43 00927 MOVE WRK-DISPLAY-DA TO MAP-OPEN-DATE-DA. DTSCS43 00928 MOVE WRK-DISPLAY-YR TO MAP-OPEN-DATE-YR. DTSCS43 00929 DTSCS43 00930 IF MAPL-CLOSE-DATE > +0 DTSCS43 00931 MOVE MAPL-CLOSE-DATE TO WRK-DISPLAY DTSCS43 00932 MOVE WRK-DISPLAY-MO TO MAP-CLOSE-DATE-MO DTSCS43 00933 MOVE WRK-DISPLAY-DA TO MAP-CLOSE-DATE-DA DTSCS43 00934 MOVE WRK-DISPLAY-YR TO MAP-CLOSE-DATE-YR DTSCS43 00935 END-IF. DTSCS43 00936 DTSCS43 00937 MOVE MAPL-TYPE TO MAP-TYPE DTSCS43 00938 DTSCS43 00939 PERFORM DTSCS43 00940 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 00941 UNTIL WRK-OCC > MMAX-APL-LVL-MAX DTSCS43 00942 IF MAPL-FILE-DATE(WRK-OCC) > +0 DTSCS43 00943 MOVE MAPL-FILE-DATE(WRK-OCC) TO WRK-DISPLAY DTSCS43 00944 MOVE WRK-DISPLAY-MO TO MAP-FILE-DATE-MO(WRK-OCC) DTSCS43 00945 MOVE WRK-DISPLAY-DA TO MAP-FILE-DATE-DA(WRK-OCC) DTSCS43 00946 MOVE WRK-DISPLAY-YR TO MAP-FILE-DATE-YR(WRK-OCC) DTSCS43 00947 END-IF DTSCS43 00948 IF MAPL-DECSN-DATE(WRK-OCC) > +0 DTSCS43 00949 MOVE MAPL-DECSN-DATE(WRK-OCC) TO WRK-DISPLAY DTSCS43 00950 MOVE WRK-DISPLAY-MO TO MAP-DECSN-DATE-MO(WRK-OCC) DTSCS43 00951 MOVE WRK-DISPLAY-DA TO MAP-DECSN-DATE-DA(WRK-OCC) DTSCS43 00952 MOVE WRK-DISPLAY-YR TO MAP-DECSN-DATE-YR(WRK-OCC) DTSCS43 00953 END-IF DTSCS43 00954 END-PERFORM. DTSCS43 00955 DTSCS43 00956 PERFORM DTSCS43 00957 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 00958 UNTIL WRK-OCC > MAPL-COVERED-CNT DTSCS43 00959 MOVE MAPL-COVERED-YRQ(WRK-OCC) TO WRK-DISPLAY DTSCS43 00960 MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR(WRK-OCC) DTSCS43 00961 MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q (WRK-OCC) DTSCS43 00962 IF MAPL-COVERED-YRQ (WRK-OCC) = LCCM-PICKUP-YRQ CL**8 00963 MOVE 'PU' TO MAP-COVERED-YRQ-YR (WRK-OCC) CL**8 00964 MOVE ' ' TO MAP-COVERED-YRQ-Q (WRK-OCC) CL**8 00965 END-IF CL**8 00966 END-PERFORM DTSCS43 00967 DTSCS43 00968 PERFORM DTSCS43 00969 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 00970 UNTIL WRK-OCC > MAPL-TEXT-CNT DTSCS43 00971 MOVE MAPL-TEXT (WRK-OCC) TO MAP-TEXT(WRK-OCC) DTSCS43 00972 END-PERFORM. DTSCS43 00973 DTSCS43 00974 P6910-EXIT. DTSCS43 00975 EXIT. DTSCS43 00976 DTSCS43 00977 P6990-PAGE-NUMBER. DTSCS43 00978 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS43 00979 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS43 00980 DTSCS43 00981 IF WS-REC-NUM = +1 DTSCS43 00982 IF LAST-REC-NUM = +1 DTSCS43 00983 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS43 00984 ELSE DTSCS43 00985 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS43 00986 ELSE DTSCS43 00987 IF WS-REC-NUM = LAST-REC-NUM DTSCS43 00988 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS43 00989 P6990-EXIT. DTSCS43 00990 EXIT. DTSCS43 00991 /*****************************************************************DTSCS43 00992 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS43 00993 ******************************************************************DTSCS43 00994 DTSCS43 00995 P7000-REQUEST-EDIT. DTSCS43 00996 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS43 00997 DTSCS43 00998 IF LCCM-F09-88 DTSCS43 00999 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS43 01000 ELSE DTSCS43 01001 IF LCCM-F10-88 DTSCS43 01002 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS43 01003 ELSE DTSCS43 01004 IF LCCM-F23-88 DTSCS43 01005 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS43 01006 ELSE DTSCS43 01007 GO TO S899-ABEND. DTSCS43 01008 DTSCS43 01009 *------------------------------------------------------ DTSCS43 01010 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS43 01011 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS43 01012 * REMAIN IN 'INQUIRE' STATUS. DTSCS43 01013 *------------------------------------------------------ DTSCS43 01014 DTSCS43 01015 IF LCCM-MSG DTSCS43 01016 NEXT SENTENCE DTSCS43 01017 ELSE DTSCS43 01018 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS43 01019 IF LCCM-F09-88 DTSCS43 01020 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS43 01021 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS43 01022 ELSE DTSCS43 01023 IF LCCM-F10-88 DTSCS43 01024 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS43 01025 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS43 01026 ELSE DTSCS43 01027 IF LCCM-F23-88 DTSCS43 01028 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS43 01029 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS43 01030 DTSCS43 01031 SET RESP-SEND-MAP TO TRUE. DTSCS43 01032 P7000-EXIT. DTSCS43 01033 EXIT. DTSCS43 01034 /*****************************************************************DTSCS43 01035 * ADD FUNCTION WAS REQUESTED *DTSCS43 01036 ******************************************************************DTSCS43 01037 DTSCS43 01038 P7100-EDIT-ADD. DTSCS43 01039 *----------------------------------------------------- DTSCS43 01040 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS43 01041 *----------------------------------------------------- DTSCS43 01042 IF NOT LCCM-SCR-CLEAR DTSCS43 01043 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS43 01044 GO TO P7100-EXIT. DTSCS43 01045 DTSCS43 01046 *----------------------------------------------------- DTSCS43 01047 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS43 01048 *----------------------------------------------------- DTSCS43 01049 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS43 01050 IF LCCM-MSG DTSCS43 01051 GO TO P7100-EXIT. DTSCS43 01052 DTSCS43 01053 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS43 01054 DTSCS43 01055 IF LCCM-MSG DTSCS43 01056 GO TO P7100-EXIT. DTSCS43 01057 DTSCS43 01058 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS43 01059 DTSCS43 01060 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS43 01061 P7100-EXIT. DTSCS43 01062 EXIT. DTSCS43 01063 /*****************************************************************DTSCS43 01064 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS43 01065 ******************************************************************DTSCS43 01066 DTSCS43 01067 P7200-EDIT-MOD. DTSCS43 01068 *----------------------------------------------------- DTSCS43 01069 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS43 01070 * INQUIRED DTSCS43 01071 *----------------------------------------------------- DTSCS43 01072 IF NOT LCCM-SCR-INQUIRE DTSCS43 01073 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS43 01074 GO TO P7200-EXIT. DTSCS43 01075 DTSCS43 01076 *----------------------------------------------------- DTSCS43 01077 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS43 01078 *----------------------------------------------------- DTSCS43 01079 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS43 01080 IF LCCM-MSG DTSCS43 01081 GO TO P7200-EXIT. DTSCS43 01082 DTSCS43 01083 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS43 01084 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS43 01085 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 01086 GO TO P7200-EXIT. DTSCS43 01087 DTSCS43 01088 DTSCS43 01089 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS43 01090 P7200-EXIT. DTSCS43 01091 EXIT. DTSCS43 01092 /*****************************************************************DTSCS43 01093 * DELETE FUNCTION WAS REQUESTED *DTSCS43 01094 ******************************************************************DTSCS43 01095 DTSCS43 01096 P7300-EDIT-DEL. DTSCS43 01097 *----------------------------------------------------- DTSCS43 01098 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS43 01099 * INQUIRED DTSCS43 01100 *----------------------------------------------------- DTSCS43 01101 IF NOT LCCM-SCR-INQUIRE DTSCS43 01102 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS43 01103 GO TO P7300-EXIT. DTSCS43 01104 DTSCS43 01105 *----------------------------------------------------- DTSCS43 01106 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL DTSCS43 01107 *----------------------------------------------------- DTSCS43 01108 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS43 01109 IF LCCM-MSG DTSCS43 01110 GO TO P7300-EXIT. DTSCS43 01111 DTSCS43 01112 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS43 01113 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS43 01114 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 01115 GO TO P7300-EXIT. DTSCS43 01116 DTSCS43 01117 P7300-EXIT. DTSCS43 01118 EXIT. DTSCS43 01119 /*****************************************************************DTSCS43 01120 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS43 01121 ******************************************************************DTSCS43 01122 DTSCS43 01123 P8000-REQUEST-UPDATE. DTSCS43 01124 DTSCS43 01125 IF LCCM-SCR-ADD-LOCKED DTSCS43 01126 PERFORM P8100-ADD THRU P8100-EXIT DTSCS43 01127 ELSE DTSCS43 01128 IF LCCM-SCR-MOD-LOCKED DTSCS43 01129 PERFORM P8200-MOD THRU P8200-EXIT DTSCS43 01130 ELSE DTSCS43 01131 IF LCCM-SCR-DEL-LOCKED DTSCS43 01132 PERFORM P8300-DEL THRU P8300-EXIT DTSCS43 01133 ELSE DTSCS43 01134 GO TO S899-ABEND. DTSCS43 01135 DTSCS43 01136 SET RESP-SEND-MAP TO TRUE. DTSCS43 01137 P8000-EXIT. DTSCS43 01138 EXIT. DTSCS43 01139 /*****************************************************************DTSCS43 01140 * *DTSCS43 01141 ******************************************************************DTSCS43 01142 DTSCS43 01143 P8100-ADD. DTSCS43 01144 SET LCCM-SCR-CLEAR TO TRUE. DTSCS43 01145 DTSCS43 01146 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS43 01147 DTSCS43 01148 IF LCCM-F12-88 DTSCS43 01149 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS43 01150 GO TO P8100-EXIT. DTSCS43 01151 DTSCS43 01152 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS43 01153 DTSCS43 01154 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS43 01155 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS43 01156 IF LCCM-MSG DTSCS43 01157 GO TO P8100-EXIT. DTSCS43 01158 DTSCS43 01159 PERFORM P8110-CONSTRUCT-MAPL THRU P8110-EXIT. DTSCS43 01160 DTSCS43 01161 PERFORM P8120-UPDATE-MPRF THRU P8120-EXIT. DTSCS43 01162 DTSCS43 01163 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS43 01164 DTSCS43 01165 MOVE MAPL-KEY-AREA TO LCCM-SCR43-HOLD-AREA. DTSCS43 01166 DTSCS43 01167 SET LCCM-ENTER-88 TO TRUE. DTSCS43 01168 DTSCS43 01169 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS43 01170 DTSCS43 01171 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS43 01172 DTSCS43 01173 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS43 01174 P8100-EXIT. DTSCS43 01175 EXIT. DTSCS43 01176 DTSCS43 01177 P8110-CONSTRUCT-MAPL. DTSCS43 01178 MOVE LOW-VALUES TO MAPL-REC. DTSCS43 01179 DTSCS43 01180 MOVE WRK-EMP-NO TO MAPL-EMP-NO. DTSCS43 01181 DTSCS43 01182 SET MAPL-APL-88 TO TRUE. DTSCS43 01183 DTSCS43 01184 MOVE LCCM-TASK-START-ABSTIME TO MAPL-ESTB-ABSTIME. DTSCS43 01185 DTSCS43 01186 MOVE +0 TO MAPL-PURGE-DATE. DTSCS43 01187 DTSCS43 01188 SET MAPL-NOT-CONVERTED-88 TO TRUE. DTSCS43 01189 DTSCS43 01190 MOVE +0 TO MAPL-OPEN-DATE DTSCS43 01191 DTSCS43 01192 MOVE ALL-NINES-DATE TO MAPL-CLOSE-DATE. DTSCS43 01193 DTSCS43 01194 PERFORM P8700-COMMON-MOVES THRU P8700-EXIT. DTSCS43 01195 DTSCS43 01196 MOVE LCCM-CURR-RUN-DATE TO MAPL-ESTB-DATE. DTSCS43 01197 MOVE LCCM-CURR-RUN-DATE TO MAPL-CHNG-DATE. DTSCS43 01198 DTSCS43 01199 MOVE MAPL-REC TO MSKL-REC. DTSCS43 01200 PERFORM S810-WRITE THRU S810-EXIT. DTSCS43 01201 P8110-EXIT. DTSCS43 01202 EXIT. DTSCS43 01203 /*****************************************************************DTSCS43 01204 * DTSCS43 01205 ******************************************************************DTSCS43 01206 P8120-UPDATE-MPRF. DTSCS43 01207 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS43 01208 DTSCS43 01209 IF MPRF-NO-MAPL-88 DTSCS43 01210 SET MPRF-MAPL-EXISTS-88 TO TRUE DTSCS43 01211 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS43 01212 MOVE MPRF-REC TO MSKL-REC DTSCS43 01213 PERFORM S810-REWRITE THRU S810-EXIT DTSCS43 01214 END-IF. DTSCS43 01215 P8120-EXIT. DTSCS43 01216 EXIT. DTSCS43 01217 /*****************************************************************DTSCS43 01218 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS43 01219 ******************************************************************DTSCS43 01220 DTSCS43 01221 P8200-MOD. DTSCS43 01222 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS43 01223 DTSCS43 01224 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS43 01225 DTSCS43 01226 IF LCCM-F12-88 DTSCS43 01227 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS43 01228 GO TO P8200-EXIT. DTSCS43 01229 DTSCS43 01230 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS43 01231 DTSCS43 01232 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS43 01233 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS43 01234 IF LCCM-MSG DTSCS43 01235 GO TO P8200-EXIT. DTSCS43 01236 DTSCS43 01237 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS43 01238 DTSCS43 01239 PERFORM P8210-CONSTRUCT-MAPL THRU P8210-EXIT. DTSCS43 01240 DTSCS43 01241 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS43 01242 DTSCS43 01243 SET LCCM-ENTER-88 TO TRUE. DTSCS43 01244 DTSCS43 01245 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS43 01246 DTSCS43 01247 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS43 01248 DTSCS43 01249 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS43 01250 P8200-EXIT. DTSCS43 01251 EXIT. DTSCS43 01252 EJECT DTSCS43 01253 P8210-CONSTRUCT-MAPL. DTSCS43 01254 MOVE LCCM-SCR43-HOLD-AREA TO MSKL-KEY-AREA. DTSCS43 01255 PERFORM S810-READ THRU S810-EXIT. DTSCS43 01256 IF L810-NO-REC-88 DTSCS43 01257 GO TO S899-ABEND. DTSCS43 01258 DTSCS43 01259 MOVE MSKL-REC TO MAPL-REC. DTSCS43 01260 DTSCS43 01261 PERFORM P8700-COMMON-MOVES THRU P8700-EXIT. DTSCS43 01262 DTSCS43 01263 MOVE LCCM-CURR-RUN-DATE TO MAPL-CHNG-DATE. DTSCS43 01264 DTSCS43 01265 MOVE MAPL-REC TO MSKL-REC. DTSCS43 01266 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS43 01267 P8210-EXIT. DTSCS43 01268 EXIT. DTSCS43 01269 /*****************************************************************DTSCS43 01270 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS43 01271 ******************************************************************DTSCS43 01272 DTSCS43 01273 P8300-DEL. DTSCS43 01274 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS43 01275 DTSCS43 01276 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS43 01277 DTSCS43 01278 IF LCCM-F12-88 DTSCS43 01279 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS43 01280 GO TO P8300-EXIT. DTSCS43 01281 DTSCS43 01282 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS43 01283 DTSCS43 01284 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS43 01285 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS43 01286 IF LCCM-MSG DTSCS43 01287 GO TO P8300-EXIT. DTSCS43 01288 DTSCS43 01289 MOVE LCCM-SCR43-HOLD-AREA TO MSKL-KEY-AREA. DTSCS43 01290 PERFORM S810-READ THRU S810-EXIT. DTSCS43 01291 IF L810-NO-REC-88 DTSCS43 01292 GO TO S899-ABEND. DTSCS43 01293 DTSCS43 01294 MOVE MSKL-REC TO MAPL-REC. DTSCS43 01295 DTSCS43 01296 PERFORM S810-DELETE THRU S810-EXIT. DTSCS43 01297 DTSCS43 01298 PERFORM P8320-CHECK-MPRF THRU P8320-EXIT. DTSCS43 01299 DTSCS43 01300 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS43 01301 DTSCS43 01302 MOVE LOW-VALUES TO MAP-AREA. DTSCS43 01303 DTSCS43 01304 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS43 01305 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS43 01306 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS43 01307 DTSCS43 01308 SET LCCM-SCR-CLEAR TO TRUE. DTSCS43 01309 DTSCS43 01310 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS43 01311 DTSCS43 01312 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS43 01313 DTSCS43 01314 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS43 01315 P8300-EXIT. DTSCS43 01316 EXIT. DTSCS43 01317 DTSCS43 01318 P8320-CHECK-MPRF. DTSCS43 01319 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS43 01320 DTSCS43 01321 MOVE MPRF-MAPL-IND TO WRK-MAPL-IND. DTSCS43 01322 DTSCS43 01323 MOVE LOW-VALUES TO MAPL-KEY-AREA. DTSCS43 01324 MOVE WRK-EMP-NO TO MAPL-EMP-NO. DTSCS43 01325 SET MAPL-APL-88 TO TRUE. DTSCS43 01326 MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA. DTSCS43 01327 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS43 01328 IF L810-OK-88 DTSCS43 01329 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS43 01330 SET MPRF-MAPL-EXISTS-88 TO TRUE DTSCS43 01331 ELSE DTSCS43 01332 SET MPRF-NO-MAPL-88 TO TRUE. DTSCS43 01333 DTSCS43 01334 IF WRK-MAPL-IND = MPRF-MAPL-IND DTSCS43 01335 NEXT SENTENCE DTSCS43 01336 ELSE DTSCS43 01337 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS43 01338 MOVE MPRF-REC TO MSKL-REC DTSCS43 01339 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS43 01340 P8320-EXIT. DTSCS43 01341 EXIT. DTSCS43 01342 EJECT DTSCS43 01343 EJECT DTSCS43 01344 P8700-COMMON-MOVES. DTSCS43 01345 MOVE MAP-OPEN-DATE-AREA TO L015-S-DATE-AREA. DTSCS43 01346 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS43 01347 MOVE L015-DATE TO MAPL-OPEN-DATE. DTSCS43 01348 DTSCS43 01349 MOVE MAP-CLOSE-DATE-AREA TO L015-S-DATE-AREA. DTSCS43 01350 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS43 01351 DTSCS43 01352 IF L015-DATE NOT = MAPL-CLOSE-DATE DTSCS43 01353 IF L015-DATE = +0 DTSCS43 01354 SET MAPL-STATUS-OPEN-88 TO TRUE DTSCS43 01355 MOVE LCCM-CURR-RUN-DATE TO MAPL-STATUS-DATE DTSCS43 01356 MOVE LCCM-OP-ID TO MAPL-STATUS-OP-ID DTSCS43 01357 ELSE DTSCS43 01358 IF MAPL-CLOSE-DATE = +0 OR ALL-NINES-DATE DTSCS43 01359 SET MAPL-STATUS-CLOSED-88 TO TRUE DTSCS43 01360 MOVE LCCM-CURR-RUN-DATE TO MAPL-STATUS-DATE DTSCS43 01361 MOVE LCCM-OP-ID TO MAPL-STATUS-OP-ID DTSCS43 01362 PERFORM P8710-TICKLER THRU P8710-EXIT DTSCS43 01363 END-IF DTSCS43 01364 END-IF DTSCS43 01365 MOVE L015-DATE TO MAPL-CLOSE-DATE DTSCS43 01366 END-IF. DTSCS43 01367 DTSCS43 01368 MOVE MAP-TYPE TO MAPL-TYPE. DTSCS43 01369 DTSCS43 01370 PERFORM DTSCS43 01371 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 01372 UNTIL WRK-OCC > MMAX-APL-LVL-MAX DTSCS43 01373 MOVE MAP-FILE-DATES(WRK-OCC) DTSCS43 01374 TO L015-S-DATE-AREA DTSCS43 01375 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT DTSCS43 01376 MOVE L015-DATE DTSCS43 01377 TO MAPL-FILE-DATE(WRK-OCC) DTSCS43 01378 DTSCS43 01379 IF MAPL-OPEN-DATE = +0 DTSCS43 01380 MOVE L015-DATE TO MAPL-OPEN-DATE DTSCS43 01381 END-IF DTSCS43 01382 DTSCS43 01383 MOVE MAP-DECSN-DATES(WRK-OCC) DTSCS43 01384 TO L015-S-DATE-AREA DTSCS43 01385 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT DTSCS43 01386 MOVE L015-DATE DTSCS43 01387 TO MAPL-DECSN-DATE(WRK-OCC) DTSCS43 01388 END-PERFORM. DTSCS43 01389 DTSCS43 01390 MOVE +0 TO MAPL-COVERED-CNT. DTSCS43 01391 DTSCS43 01392 PERFORM DTSCS43 01393 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 01394 UNTIL WRK-OCC > MMAX-APL-COV-MAX DTSCS43 01395 MOVE MAP-COVERED-YRQ-AREA(WRK-OCC) DTSCS43 01396 TO L029-S-YRQ-AREA CL**7 01397 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT CL**7 01398 MOVE L029-YRQ TO MAPL-COVERED-YRQ(WRK-OCC) CL**7 01399 IF L029-VALID CL**7 01400 MOVE WRK-OCC TO MAPL-COVERED-CNT DTSCS43 01401 END-IF DTSCS43 01402 END-PERFORM. DTSCS43 01403 DTSCS43 01404 MOVE +0 TO MAPL-TEXT-CNT. DTSCS43 01405 PERFORM DTSCS43 01406 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 01407 UNTIL WRK-OCC > MMAX-APL-TEXT-MAX DTSCS43 01408 MOVE MAP-TEXT(WRK-OCC) DTSCS43 01409 TO MAPL-TEXT(WRK-OCC) DTSCS43 01410 IF MAP-TEXT(WRK-OCC) NOT = SPACES DTSCS43 01411 MOVE WRK-OCC TO MAPL-TEXT-CNT DTSCS43 01412 END-IF DTSCS43 01413 END-PERFORM. DTSCS43 01414 DTSCS43 01415 P8700-EXIT. DTSCS43 01416 EXIT. DTSCS43 01417 P8710-TICKLER. DTSCS43 01418 IF NOT MAPL-AUDIT-88 DTSCS43 01419 GO TO P8710-EXIT DTSCS43 01420 END-IF. DTSCS43 01421 DTSCS43 01422 MOVE LOW-VALUES TO MTCK-REC. DTSCS43 01423 MOVE WRK-EMP-NO TO MTCK-EMP-NO. DTSCS43 01424 SET MTCK-TCK-88 TO TRUE. DTSCS43 01425 MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS43 01426 DTSCS43 01427 MOVE +0 TO MTCK-PURGE-DATE. DTSCS43 01428 SET MTCK-TYPE-MANUAL-88 TO TRUE. DTSCS43 01429 MOVE LCCM-CURR-RUN-DATE TO MTCK-TRIGGER-DATE. DTSCS43 01430 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. DTSCS43 01431 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSCS43 01432 DTSCS43 01433 MOVE LCCM-OP-ID TO MTCK-SOURCE-OP-ID. DTSCS43 01434 MOVE 'FLDDSK' TO MTCK-DEST-OP-ID. DTSCS43 01435 MOVE SPACES TO MTCK-ALTERNATE-ID. DTSCS43 01436 MOVE LCCM-CURR-RUN-DATE DTSCS43 01437 TO MTCK-ESTB-DATE DTSCS43 01438 MTCK-CHNG-DATE. DTSCS43 01439 MOVE +1 TO MTCK-TEXT-CNT. DTSCS43 01440 MOVE 'AUDIT APPEAL CLOSED' TO MTCK-TEXT-AREA. DTSCS43 01441 DTSCS43 01442 MOVE MTCK-REC TO MSKL-REC. DTSCS43 01443 PERFORM S810-WRITE THRU S810-EXIT. DTSCS43 01444 P8710-EXIT. DTSCS43 01445 EXIT. DTSCS43 01446 DTSCS43 01447 *P8720-MAINTENANCE-LIST. DTSCS43 01448 *****SET L331-LIST-TYPE DTSCS43 01449 ***** DTSCS43 01450 *****MOVE TO L331-FIELD-NAME. DTSCS43 01451 *****MOVE TO L331-FIELD-KEY. DTSCS43 01452 *****MOVE TO L331-FROM-VALUE. DTSCS43 01453 *****MOVE TO L331-TO-VALUE. DTSCS43 01454 *****PERFORM S331-MAINTENANCE-LIST THRU S331-EXIT. DTSCS43 01455 *P8720-EXIT. DTSCS43 01456 *****EXIT. DTSCS43 01457 DTSCS43 01458 P8810-LOCK-EMPLOYER. DTSCS43 01459 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS43 01460 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS43 01461 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS43 01462 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS43 01463 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS43 01464 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. CL**2 01465 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS43 01466 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS43 01467 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS43 01468 DTSCS43 01469 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS43 01470 P8810-EXIT. DTSCS43 01471 EXIT. DTSCS43 01472 EJECT DTSCS43 01473 DTSCS43 01474 /*****************************************************************DTSCS43 01475 * LINKS TO UTILITY MODULES DTSCS43 01476 ******************************************************************DTSCS43 01477 DTSCS43 01478 S001-FROM-FED-8. DTSCS43 01479 SET L001-FROM-FED-8 TO TRUE. DTSCS43 01480 GO TO S001-DATE. DTSCS43 01481 DTSCS43 01482 *S001-FROM-ABS-DATE. DTSCS43 01483 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS43 01484 *****GO TO S001-DATE. DTSCS43 01485 DTSCS43 01486 S001-DATE. DTSCS43 01487 EXEC CICS LINK DTSCS43 01488 PROGRAM('DTSCU001') CL**2 01489 COMMAREA(L001-COMM-AREA) DTSCS43 01490 END-EXEC. DTSCS43 01491 S001-EXIT. DTSCS43 01492 EXIT. DTSCS43 01493 DTSCS43 01494 S015-DATE-FROM-SCREEN. DTSCS43 01495 EXEC CICS LINK DTSCS43 01496 PROGRAM('DTSCU015') CL**2 01497 COMMAREA(L015-COMM-AREA) DTSCS43 01498 END-EXEC. DTSCS43 01499 S015-EXIT. DTSCS43 01500 EXIT. DTSCS43 01501 DTSCS43 01502 S018-EMP-NO-FROM-SCREEN. DTSCS43 01503 EXEC CICS LINK DTSCS43 01504 PROGRAM('DTSCU018') CL**2 01505 COMMAREA(L018-COMM-AREA) DTSCS43 01506 END-EXEC. DTSCS43 01507 S018-EXIT. DTSCS43 01508 EXIT. DTSCS43 01509 CL**5 01510 S029-YRQ-FROM-SCREEN. CL**7 01511 EXEC CICS LINK CL**7 01512 PROGRAM('DTSCU029') CL**7 01513 COMMAREA(L029-COMM-AREA) CL**7 01514 END-EXEC. CL**7 01515 S029-EXIT. CL**7 01516 EXIT. CL**7 01517 CL**7 01518 S034-MAPL-STATUS-CD. CL**5 01519 SET L034-MAPL-STATUS-CD TO TRUE. CL**5 01520 GO TO S034-LINK. CL**5 01521 CL**5 01522 DTSCS43 01523 S034-MAPL-TYPE. CL**5 01524 SET L034-MAPL-TYPE TO TRUE. DTSCS43 01525 GO TO S034-LINK. DTSCS43 01526 DTSCS43 01527 S034-LINK. DTSCS43 01528 EXEC CICS LINK DTSCS43 01529 PROGRAM ('DTSCU034') CL**2 01530 COMMAREA (L034-COMM-AREA) DTSCS43 01531 END-EXEC. DTSCS43 01532 S034-EXIT. DTSCS43 01533 EXIT. DTSCS43 01534 DTSCS43 01535 S221-EMP-LOCK. DTSCS43 01536 SET L221-START-UPDATE TO TRUE. DTSCS43 01537 GO TO S221-EMP-LOCK-UNLOCK. DTSCS43 01538 DTSCS43 01539 S221-EMP-UNLOCK. DTSCS43 01540 SET L221-END-UPDATE TO TRUE. DTSCS43 01541 GO TO S221-EMP-LOCK-UNLOCK. DTSCS43 01542 DTSCS43 01543 S221-EMP-LOCK-UNLOCK. DTSCS43 01544 EXEC CICS LINK DTSCS43 01545 PROGRAM('DTSCU221') CL**2 01546 COMMAREA(L221-COMM-AREA) DTSCS43 01547 END-EXEC. DTSCS43 01548 DTSCS43 01549 IF L221-FILE-CLOSED DTSCS43 01550 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01551 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS43 01552 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS43 01553 GO TO MAINLINE-EXIT. DTSCS43 01554 DTSCS43 01555 IF L221-NOT-OK DTSCS43 01556 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS43 01557 S221-EXIT. DTSCS43 01558 EXIT. DTSCS43 01559 DTSCS43 01560 *S331-MAINTENANCE-LIST. DTSCS43 01561 *****MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS43 01562 *****MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS43 01563 *****MOVE LCCM-TASK-START-DATE TO L331-UPDATE-DATE. DTSCS43 01564 *****MOVE LCCM-TASK-START-TIME TO L331-UPDATE-TIME. DTSCS43 01565 *****MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS43 01566 ***** DTSCS43 01567 *****EXEC CICS LINK DTSCS43 01568 ***** PROGRAM('MACCU331') DTSCS43 01569 ***** COMMAREA(L331-COMM-AREA) DTSCS43 01570 ***** LENGTH(L331-LENGTH) DTSCS43 01571 *****END-EXEC. DTSCS43 01572 ***** DTSCS43 01573 *****IF L331-FILE-CLOSED DTSCS43 01574 ***** MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01575 ***** SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS43 01576 ***** SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS43 01577 ***** GO TO MAINLINE-EXIT. DTSCS43 01578 *S331-EXIT. DTSCS43 01579 *****EXIT. DTSCS43 01580 DTSCS43 01581 S803-REQ-SCR-ID-EDIT. DTSCS43 01582 EXEC CICS LINK DTSCS43 01583 PROGRAM ('DTSCU803') CL**2 01584 COMMAREA (DFHCOMMAREA) DTSCS43 01585 END-EXEC. DTSCS43 01586 S803-EXIT. DTSCS43 01587 EXIT. DTSCS43 01588 DTSCS43 01589 S804-INVALID-KEY. DTSCS43 01590 EXEC CICS LINK DTSCS43 01591 PROGRAM ('DTSCU804') CL**2 01592 COMMAREA (DFHCOMMAREA) DTSCS43 01593 END-EXEC. DTSCS43 01594 S804-EXIT. DTSCS43 01595 EXIT. DTSCS43 01596 DTSCS43 01597 S805-MSG-AREA. DTSCS43 01598 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS43 01599 DTSCS43 01600 EXEC CICS LINK DTSCS43 01601 PROGRAM ('DTSCU805') CL**2 01602 COMMAREA (L805-COMM-AREA) DTSCS43 01603 END-EXEC. DTSCS43 01604 DTSCS43 01605 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS43 01606 S805-EXIT. DTSCS43 01607 EXIT. DTSCS43 01608 EJECT DTSCS43 01609 S810-READ. DTSCS43 01610 SET L810-READ-88 TO TRUE. DTSCS43 01611 GO TO S810-IO. DTSCS43 01612 DTSCS43 01613 S810-START-BROWSE. DTSCS43 01614 SET L810-START-BROWSE-88 TO TRUE. DTSCS43 01615 GO TO S810-IO. DTSCS43 01616 DTSCS43 01617 S810-READ-NEXT. DTSCS43 01618 SET L810-READ-NEXT-88 TO TRUE. DTSCS43 01619 GO TO S810-IO. DTSCS43 01620 DTSCS43 01621 S810-READ-PREV. DTSCS43 01622 SET L810-READ-PREV-88 TO TRUE. DTSCS43 01623 GO TO S810-IO. DTSCS43 01624 DTSCS43 01625 S810-END-BROWSE. DTSCS43 01626 SET L810-END-BROWSE-88 TO TRUE. DTSCS43 01627 GO TO S810-IO. DTSCS43 01628 DTSCS43 01629 S810-COUNT. DTSCS43 01630 SET L810-COUNT-88 TO TRUE. DTSCS43 01631 GO TO S810-IO. DTSCS43 01632 DTSCS43 01633 S810-REWRITE. DTSCS43 01634 SET L810-REWRITE-88 TO TRUE. DTSCS43 01635 GO TO S810-IO. DTSCS43 01636 DTSCS43 01637 S810-WRITE. DTSCS43 01638 SET L810-WRITE-88 TO TRUE. DTSCS43 01639 GO TO S810-IO. DTSCS43 01640 DTSCS43 01641 S810-DELETE. DTSCS43 01642 SET L810-DELETE-88 TO TRUE. DTSCS43 01643 GO TO S810-IO. DTSCS43 01644 DTSCS43 01645 S810-IO. DTSCS43 01646 DTSCS43 01647 EXEC CICS LINK DTSCS43 01648 PROGRAM ('DTSCU810') CL**2 01649 COMMAREA (L810-COMM-AREA) DTSCS43 01650 END-EXEC. DTSCS43 01651 DTSCS43 01652 IF L810-FILE-CLOSED-88 DTSCS43 01653 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01654 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS43 01655 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS43 01656 GO TO MAINLINE-EXIT. DTSCS43 01657 S810-EXIT. DTSCS43 01658 EXIT. DTSCS43 01659 EJECT DTSCS43 01660 S851-SCREEN-PROCESSING. DTSCS43 01661 EXEC CICS LINK DTSCS43 01662 PROGRAM ('DTSCU851') CL**2 01663 COMMAREA (L851-COMM-AREA) DTSCS43 01664 END-EXEC. DTSCS43 01665 S851-EXIT. DTSCS43 01666 EXIT. DTSCS43 01667 DTSCS43 01668 S899-ABEND. DTSCS43 01669 EXEC CICS ABEND DTSCS43 01670 ABCODE(WRK-ABEND-CD) DTSCS43 01671 END-EXEC. DTSCS43 01672 S899-EXIT. DTSCS43 01673 EXIT. DTSCS43 01674 /*****************************************************************DTSCS43 01675 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS43 01676 ******************************************************************DTSCS43 01677 DTSCS43 01678 S1000-SCREEN-EDITS. DTSCS43 01679 PERFORM S1200-TYPE THRU S1200-EXIT. DTSCS43 01680 PERFORM S1300-OPEN-DATE THRU S1300-EXIT. DTSCS43 01681 PERFORM S1400-CLOSE-DATE THRU S1400-EXIT. DTSCS43 01682 CL**4 01683 PERFORM S1500-FILE-DATES THRU S1500-EXIT DTSCS43 01684 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 01685 UNTIL WRK-OCC > MMAX-APL-LVL-MAX. DTSCS43 01686 DTSCS43 01687 PERFORM S1600-DECSN-DATES THRU S1600-EXIT DTSCS43 01688 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 01689 UNTIL WRK-OCC > MMAX-APL-LVL-MAX. DTSCS43 01690 DTSCS43 01691 MOVE +0 TO WRK-LAST-YRQ. DTSCS43 01692 PERFORM S1700-COVERED-YRQS THRU S1700-EXIT DTSCS43 01693 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 01694 UNTIL WRK-OCC > MMAX-APL-COV-MAX. DTSCS43 01695 DTSCS43 01696 PERFORM S1800-TEXT THRU S1800-EXIT DTSCS43 01697 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 01698 UNTIL WRK-OCC > MMAX-APL-TEXT-MAX. DTSCS43 01699 DTSCS43 01700 IF LCCM-MSG DTSCS43 01701 GO TO S1000-EXIT. DTSCS43 01702 DTSCS43 01703 PERFORM S2000-MISC-EDITS THRU S2000-EXIT. DTSCS43 01704 CL**4 01705 S1000-EXIT. EXIT. DTSCS43 01706 EJECT DTSCS43 01707 S1100-EDIT-KEY. DTSCS43 01708 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS43 01709 S1100-EXIT. EXIT. DTSCS43 01710 /*****************************************************************DTSCS43 01711 * DTSCS43 01712 ******************************************************************DTSCS43 01713 S1101-EMP-NO. DTSCS43 01714 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS43 01715 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS43 01716 DTSCS43 01717 IF L018-NO-ENTRY DTSCS43 01718 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS43 01719 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 01720 GO TO S1101-EXIT. DTSCS43 01721 DTSCS43 01722 IF L018-NOT-VALID DTSCS43 01723 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01724 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 01725 GO TO S1101-EXIT. DTSCS43 01726 DTSCS43 01727 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS43 01728 S1101-EXIT. EXIT. DTSCS43 01729 DTSCS43 01730 S1110-READ-MPRF. DTSCS43 01731 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS43 01732 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS43 01733 SET MPRF-PRF-88 TO TRUE. DTSCS43 01734 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS43 01735 PERFORM S810-READ THRU S810-EXIT. DTSCS43 01736 IF L810-NO-REC-88 DTSCS43 01737 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS43 01738 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS43 01739 ELSE DTSCS43 01740 MOVE MSKL-REC TO MPRF-REC DTSCS43 01741 SET WRK-MPRF-YES-88 TO TRUE. DTSCS43 01742 S1110-EXIT. DTSCS43 01743 EXIT. DTSCS43 01744 DTSCS43 01745 S1199-ERROR. DTSCS43 01746 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS43 01747 MAP-EMP-NO-2-A. DTSCS43 01748 IF LCCM-NO-MSG DTSCS43 01749 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01750 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS43 01751 SET CURSOR-SET-YES TO TRUE. DTSCS43 01752 S1199-EXIT. EXIT. DTSCS43 01753 DTSCS43 01754 /*****************************************************************DTSCS43 01755 * DTSCS43 01756 ******************************************************************DTSCS43 01757 S1200-TYPE. DTSCS43 01758 IF MAP-TYPE = LOW-VALUES OR SPACES DTSCS43 01759 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS43 01760 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS43 01761 ELSE DTSCS43 01762 MOVE MAP-TYPE TO L034-CD DTSCS43 01763 PERFORM S034-MAPL-TYPE THRU S034-EXIT DTSCS43 01764 IF L034-NOT-VALID DTSCS43 01765 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01766 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS43 01767 S1200-EXIT. DTSCS43 01768 EXIT. DTSCS43 01769 DTSCS43 01770 S1201-ERROR. DTSCS43 01771 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TYPE-A DTSCS43 01772 IF LCCM-NO-MSG DTSCS43 01773 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01774 MOVE CATB-CURSOR TO MAP-TYPE-L DTSCS43 01775 SET CURSOR-SET-YES TO TRUE. DTSCS43 01776 S1201-EXIT. EXIT. DTSCS43 01777 DTSCS43 01778 /*****************************************************************DTSCS43 01779 * DTSCS43 01780 ******************************************************************DTSCS43 01781 S1300-OPEN-DATE. DTSCS43 01782 MOVE +0 TO MAPL-OPEN-DATE. DTSCS43 01783 DTSCS43 01784 MOVE MAP-OPEN-DATE-AREA TO L015-S-DATE-AREA. DTSCS43 01785 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS43 01786 DTSCS43 01787 IF L015-NO-ENTRY DTSCS43 01788 MOVE +0 TO MAPL-OPEN-DATE DTSCS43 01789 ELSE DTSCS43 01790 IF L015-NOT-VALID DTSCS43 01791 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01792 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS43 01793 ELSE DTSCS43 01794 MOVE L015-DATE TO MAPL-OPEN-DATE. DTSCS43 01795 S1300-EXIT. DTSCS43 01796 EXIT. DTSCS43 01797 DTSCS43 01798 S1301-ERROR. DTSCS43 01799 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-OPEN-DATE-MO-A DTSCS43 01800 MAP-OPEN-DATE-DA-A DTSCS43 01801 MAP-OPEN-DATE-YR-A. DTSCS43 01802 IF LCCM-NO-MSG DTSCS43 01803 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01804 MOVE CATB-CURSOR TO MAP-OPEN-DATE-MO-L DTSCS43 01805 SET CURSOR-SET-YES TO TRUE. DTSCS43 01806 S1301-EXIT. EXIT. DTSCS43 01807 DTSCS43 01808 /*****************************************************************DTSCS43 01809 * DTSCS43 01810 ******************************************************************DTSCS43 01811 S1400-CLOSE-DATE. DTSCS43 01812 MOVE ALL-NINES-DATE TO MAPL-CLOSE-DATE. DTSCS43 01813 DTSCS43 01814 MOVE MAP-CLOSE-DATE-AREA TO L015-S-DATE-AREA. DTSCS43 01815 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS43 01816 DTSCS43 01817 IF L015-NO-ENTRY DTSCS43 01818 MOVE 'O' TO MAP-STATUS-CD DTSCS43 01819 ELSE DTSCS43 01820 IF L015-NOT-VALID DTSCS43 01821 OR L015-DATE < MAPL-OPEN-DATE DTSCS43 01822 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01823 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS43 01824 ELSE DTSCS43 01825 MOVE 'C' TO MAP-STATUS-CD DTSCS43 01826 MOVE L015-DATE TO MAPL-CLOSE-DATE. DTSCS43 01827 S1400-EXIT. DTSCS43 01828 EXIT. DTSCS43 01829 DTSCS43 01830 S1401-ERROR. DTSCS43 01831 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CLOSE-DATE-MO-A DTSCS43 01832 MAP-CLOSE-DATE-DA-A DTSCS43 01833 MAP-CLOSE-DATE-YR-A. DTSCS43 01834 IF LCCM-NO-MSG DTSCS43 01835 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01836 MOVE CATB-CURSOR TO MAP-CLOSE-DATE-MO-L DTSCS43 01837 SET CURSOR-SET-YES TO TRUE. DTSCS43 01838 S1401-EXIT. EXIT. DTSCS43 01839 DTSCS43 01840 /*****************************************************************DTSCS43 01841 * DTSCS43 01842 ******************************************************************DTSCS43 01843 S1500-FILE-DATES. DTSCS43 01844 MOVE +0 TO WRK-FILE-DATE(WRK-OCC). DTSCS43 01845 DTSCS43 01846 MOVE MAP-FILE-DATES(WRK-OCC) TO L015-S-DATE-AREA. DTSCS43 01847 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS43 01848 DTSCS43 01849 IF L015-NO-ENTRY DTSCS43 01850 CONTINUE DTSCS43 01851 ELSE DTSCS43 01852 IF L015-NOT-VALID DTSCS43 01853 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01854 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS43 01855 ELSE DTSCS43 01856 IF L015-DATE < MAPL-OPEN-DATE DTSCS43 01857 OR L015-DATE > MAPL-CLOSE-DATE DTSCS43 01858 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01859 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS43 01860 ELSE DTSCS43 01861 MOVE L015-DATE TO WRK-FILE-DATE(WRK-OCC). DTSCS43 01862 S1500-EXIT. DTSCS43 01863 EXIT. DTSCS43 01864 DTSCS43 01865 S1501-ERROR. DTSCS43 01866 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS43 01867 TO MAP-FILE-DATE-MO-A(WRK-OCC) DTSCS43 01868 MAP-FILE-DATE-DA-A(WRK-OCC) DTSCS43 01869 MAP-FILE-DATE-YR-A(WRK-OCC). DTSCS43 01870 IF LCCM-NO-MSG DTSCS43 01871 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01872 MOVE CATB-CURSOR TO MAP-FILE-DATE-MO-L(WRK-OCC) DTSCS43 01873 SET CURSOR-SET-YES TO TRUE. DTSCS43 01874 S1501-EXIT. EXIT. DTSCS43 01875 DTSCS43 01876 /*****************************************************************DTSCS43 01877 * DTSCS43 01878 ******************************************************************DTSCS43 01879 S1600-DECSN-DATES. DTSCS43 01880 MOVE MAP-DECSN-DATES(WRK-OCC) TO L015-S-DATE-AREA. DTSCS43 01881 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS43 01882 DTSCS43 01883 IF L015-NO-ENTRY DTSCS43 01884 CONTINUE DTSCS43 01885 ELSE DTSCS43 01886 IF L015-NOT-VALID DTSCS43 01887 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01888 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS43 01889 ELSE DTSCS43 01890 IF L015-DATE < MAPL-OPEN-DATE DTSCS43 01891 OR L015-DATE > MAPL-CLOSE-DATE DTSCS43 01892 OR WRK-FILE-DATE (WRK-OCC) = +0 DTSCS43 01893 OR L015-DATE < WRK-FILE-DATE (WRK-OCC) DTSCS43 01894 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01895 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS43 01896 S1600-EXIT. DTSCS43 01897 EXIT. DTSCS43 01898 DTSCS43 01899 S1601-ERROR. DTSCS43 01900 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS43 01901 TO MAP-DECSN-DATE-MO-A(WRK-OCC) DTSCS43 01902 MAP-DECSN-DATE-DA-A(WRK-OCC) DTSCS43 01903 MAP-DECSN-DATE-YR-A(WRK-OCC). DTSCS43 01904 IF LCCM-NO-MSG DTSCS43 01905 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01906 MOVE CATB-CURSOR TO MAP-DECSN-DATE-MO-L(WRK-OCC) DTSCS43 01907 SET CURSOR-SET-YES TO TRUE. DTSCS43 01908 S1601-EXIT. EXIT. DTSCS43 01909 DTSCS43 01910 /*****************************************************************DTSCS43 01911 * DTSCS43 01912 ******************************************************************DTSCS43 01913 S1700-COVERED-YRQS. DTSCS43 01914 MOVE MAP-COVERED-YRQ-AREA(WRK-OCC) TO L029-S-YRQ-AREA. CL**7 01915 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. CL**7 01916 DTSCS43 01917 IF L029-NO-ENTRY CL**7 01918 MOVE ALL-NINES-YRQ TO WRK-LAST-YRQ DTSCS43 01919 ELSE DTSCS43 01920 IF L029-NOT-VALID CL**7 01921 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS43 01922 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS43 01923 ELSE DTSCS43 01924 IF L029-YRQ NOT > WRK-LAST-YRQ CL**7 01925 MOVE MSG-E431-AREA TO WRK-MSG-AREA DTSCS43 01926 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS43 01927 ELSE DTSCS43 01928 MOVE L029-YRQ TO WRK-LAST-YRQ. CL**7 01929 S1700-EXIT. DTSCS43 01930 EXIT. DTSCS43 01931 DTSCS43 01932 S1701-ERROR. DTSCS43 01933 MOVE CATB-UNPROT-NORM-AN-MDTON CL**7 01934 TO MAP-COVERED-YRQ-YR-A(WRK-OCC) CL**7 01935 MAP-COVERED-YRQ-Q-A(WRK-OCC). CL**7 01936 IF LCCM-NO-MSG DTSCS43 01937 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS43 01938 MOVE CATB-CURSOR TO MAP-COVERED-YRQ-YR-L(WRK-OCC) DTSCS43 01939 SET CURSOR-SET-YES TO TRUE. DTSCS43 01940 S1701-EXIT. EXIT. DTSCS43 01941 DTSCS43 01942 /*****************************************************************DTSCS43 01943 * DTSCS43 01944 ******************************************************************DTSCS43 01945 S1800-TEXT. DTSCS43 01946 INSPECT MAP-TEXT(WRK-OCC) CONVERTING LOW-VALUES TO SPACES. DTSCS43 01947 S1800-EXIT. DTSCS43 01948 EXIT. DTSCS43 01949 /*****************************************************************DTSCS43 01950 * DTSCS43 01951 ******************************************************************DTSCS43 01952 S2000-MISC-EDITS. DTSCS43 01953 IF WRK-FILE-DATE(1) = +0 DTSCS43 01954 AND WRK-FILE-DATE(2) = +0 DTSCS43 01955 AND WRK-FILE-DATE(3) = +0 DTSCS43 01956 AND WRK-FILE-DATE(4) = +0 DTSCS43 01957 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS43 01958 MOVE 1 TO WRK-OCC DTSCS43 01959 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS43 01960 END-IF. DTSCS43 01961 S2000-EXIT. DTSCS43 01962 EXIT. DTSCS43 01963 /*****************************************************************DTSCS43 01964 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS43 01965 ******************************************************************DTSCS43 01966 S5100-SET-LOCK-ATTRB. DTSCS43 01967 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS43 01968 WRK-ATB-NUM. DTSCS43 01969 DTSCS43 01970 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS43 01971 DTSCS43 01972 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS43 01973 MAP-EMP-NO-2-A DTSCS43 01974 MAP-GOTO-A. DTSCS43 01975 S5100-EXIT. DTSCS43 01976 EXIT. DTSCS43 01977 DTSCS43 01978 ******************************************************************DTSCS43 01979 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS43 01980 ******************************************************************DTSCS43 01981 S5200-SET-UPDATE-ATTRB. DTSCS43 01982 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS43 01983 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS43 01984 DTSCS43 01985 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS43 01986 DTSCS43 01987 S5200-EXIT. DTSCS43 01988 EXIT. DTSCS43 01989 DTSCS43 01990 ******************************************************************DTSCS43 01991 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS43 01992 ******************************************************************DTSCS43 01993 S5300-SET-INQ-ATTRB. DTSCS43 01994 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS43 01995 WRK-ATB-NUM. DTSCS43 01996 DTSCS43 01997 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS43 01998 S5300-EXIT. DTSCS43 01999 EXIT. DTSCS43 02000 DTSCS43 02001 S5900-SET-ATTRB. DTSCS43 02002 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS43 02003 MAP-EMP-NO-2-A. DTSCS43 02004 MOVE WRK-ATB-AN TO DTSCS43 02005 MAP-TYPE-A. DTSCS43 02006 DTSCS43 02007 MOVE WRK-ATB-NUM TO DTSCS43 02008 MAP-OPEN-DATE-MO-A DTSCS43 02009 MAP-OPEN-DATE-DA-A DTSCS43 02010 MAP-OPEN-DATE-YR-A DTSCS43 02011 MAP-CLOSE-DATE-MO-A DTSCS43 02012 MAP-CLOSE-DATE-DA-A DTSCS43 02013 MAP-CLOSE-DATE-YR-A. DTSCS43 02014 DTSCS43 02015 PERFORM DTSCS43 02016 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 02017 UNTIL WRK-OCC > MMAX-APL-LVL-MAX DTSCS43 02018 MOVE WRK-ATB-NUM TO DTSCS43 02019 MAP-FILE-DATE-MO-A(WRK-OCC) DTSCS43 02020 MAP-FILE-DATE-DA-A(WRK-OCC) DTSCS43 02021 MAP-FILE-DATE-YR-A(WRK-OCC) DTSCS43 02022 MAP-DECSN-DATE-MO-A (WRK-OCC) DTSCS43 02023 MAP-DECSN-DATE-DA-A (WRK-OCC) DTSCS43 02024 MAP-DECSN-DATE-YR-A (WRK-OCC) DTSCS43 02025 END-PERFORM. DTSCS43 02026 DTSCS43 02027 PERFORM DTSCS43 02028 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 02029 UNTIL WRK-OCC > MMAX-APL-COV-MAX DTSCS43 02030 MOVE WRK-ATB-AN TO CL**7 02031 MAP-COVERED-YRQ-YR-A(WRK-OCC) DTSCS43 02032 MAP-COVERED-YRQ-Q-A(WRK-OCC) DTSCS43 02033 END-PERFORM. DTSCS43 02034 DTSCS43 02035 PERFORM DTSCS43 02036 VARYING WRK-OCC FROM 1 BY 1 DTSCS43 02037 UNTIL WRK-OCC > MMAX-APL-TEXT-MAX DTSCS43 02038 MOVE WRK-ATB-AN TO DTSCS43 02039 MAP-TEXT-A(WRK-OCC) DTSCS43 02040 END-PERFORM. DTSCS43 02041 DTSCS43 02042 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS43 02043 MAP-PRIMARY-NAME-A CL**2 02044 MAP-CURR-PAGE-A DTSCS43 02045 MAP-LAST-PAGE-A DTSCS43 02046 MAP-STATUS-CD-A DTSCS43 02047 MAP-STATUS-DATE-A DTSCS43 02048 MAP-STATUS-OP-ID-A. DTSCS43 02049 DTSCS43 02050 MOVE CATB-ASKIP-NORM-MDTON TO DTSCS43 02051 MAP-TYPE-DSCR-A. DTSCS43 02052 DTSCS43 02053 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS43 02054 S5900-EXIT. DTSCS43 02055 EXIT. DTSCS43 02056 EJECT DTSCS43 02057 /*****************************************************************DTSCS43 02058 * MAP ROUTINES *DTSCS43 02059 ******************************************************************DTSCS43 02060 S9100-RECEIVE. DTSCS43 02061 SET L851-RECEIVE-88 TO TRUE. DTSCS43 02062 DTSCS43 02063 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS43 02064 DTSCS43 02065 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS43 02066 DTSCS43 02067 MOVE L851-AID TO LCCM-AID. DTSCS43 02068 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS43 02069 S9100-EXIT. DTSCS43 02070 EXIT. DTSCS43 02071 DTSCS43 02072 S9200-SEND-DATAONLY. DTSCS43 02073 MOVE LOW-VALUES TO MAP-AREA. DTSCS43 02074 DTSCS43 02075 IF LCCM-NO-MSG DTSCS43 02076 NEXT SENTENCE DTSCS43 02077 ELSE DTSCS43 02078 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS43 02079 DTSCS43 02080 IF CURSOR-SET-GOTO DTSCS43 02081 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS43 02082 ELSE DTSCS43 02083 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS43 02084 DTSCS43 02085 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS43 02086 DTSCS43 02087 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS43 02088 DTSCS43 02089 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS43 02090 S9200-EXIT. DTSCS43 02091 EXIT. DTSCS43 02092 DTSCS43 02093 S9300-SEND-MAP. DTSCS43 02094 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS43 02095 MOVE SPACES TO MAP-SYS-TIME. DTSCS43 02096 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS43 02097 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS43 02098 DTSCS43 02099 IF SCR-ACCESS-UPDATE DTSCS43 02100 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS43 02101 ELSE DTSCS43 02102 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS43 02103 DTSCS43 02104 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS43 02105 DTSCS43 02106 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS43 02107 DTSCS43 02108 IF CURSOR-SET-NO DTSCS43 02109 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS43 02110 DTSCS43 02111 SET L851-SEND-88 TO TRUE. DTSCS43 02112 DTSCS43 02113 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS43 02114 DTSCS43 02115 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS43 02116 S9300-EXIT. DTSCS43 02117 EXIT. DTSCS43 02118 DTSCS43 02119 S9310-UPDATE-FKEYS. DTSCS43 02120 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS43 02121 DTSCS43 02122 DTSCS43 02123 IF LCCM-SCR-CLEAR DTSCS43 02124 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS43 02125 ELSE DTSCS43 02126 IF LCCM-SCR-INQUIRE DTSCS43 02127 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS43 02128 MOVE CFKD-DEL TO MAP-KEY-DEL CL**2 02129 ELSE DTSCS43 02130 IF LCCM-SCR-UPDATE-LOCKED DTSCS43 02131 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS43 02132 MAP-KEY-LAST DTSCS43 02133 MAP-KEY-BACK DTSCS43 02134 MAP-KEY-FWRD. DTSCS43 02135 S9310-EXIT. DTSCS43 02136 EXIT. DTSCS43 02137 DTSCS43 02138 S9320-INQUIRY-FKEYS. DTSCS43 02139 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS43 02140 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS43 02141 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS43 02142 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS43 02143 DTSCS43 02144 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS43 02145 MAP-KEY-DEL DTSCS43 02146 MAP-KEY-ADD. DTSCS43 02147 DTSCS43 02148 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. CL**2 02149 S9320-EXIT. DTSCS43 02150 EXIT. DTSCS43 02151 DTSCS43 02152 *S9321-JUMP-KEYS. CL**2 02153 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. CL**2 02154 * MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. CL**2 02155 *S9321-EXIT. CL**2 02156 * EXIT. CL**2 02157 * DTSCS43 02158 S9330-DSCR-FIELDS. DTSCS43 02159 IF WRK-MPRF-YES-88 DTSCS43 02160 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME CL**2 02161 END-IF. DTSCS43 02162 IF MAP-TYPE = LOW-VALUES OR SPACES DTSCS43 02163 MOVE SPACES TO MAP-TYPE-DSCR DTSCS43 02164 ELSE DTSCS43 02165 MOVE MAP-TYPE TO L034-CD DTSCS43 02166 PERFORM S034-MAPL-TYPE THRU S034-EXIT DTSCS43 02167 MOVE L034-SHORT-DSCR TO MAP-TYPE-DSCR. DTSCS43 02168 DTSCS43 02169 IF MAP-STATUS-CD = LOW-VALUES OR SPACES CL**5 02170 MOVE SPACES TO MAP-STATUS-DSCR CL**5 02171 ELSE CL**5 02172 MOVE MAP-STATUS-CD TO L034-CD CL**5 02173 PERFORM S034-MAPL-STATUS-CD THRU S034-EXIT CL**5 02174 MOVE L034-SHORT-DSCR TO MAP-STATUS-DSCR. CL**5 02175 CL**5 02176 S9330-EXIT. EXIT. DTSCS43 02177 DTSCS43 02178 S9900-PREPARE-SEND. DTSCS43 02179 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS43 02180 LCCM-SCR-ID. DTSCS43 02181 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS43 02182 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS43 02183 S9900-EXIT. DTSCS43 02184 EXIT. DTSCS43