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