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