giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
42a3da46ab1a7bd4c48cb25d4d4073a83ce34294
DUTAS/CICS/DTSCS43.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2186 lines
171 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink