00001 IDENTIFICATION DIVISION. 10/07/98 00002 PROGRAM-ID. DTSCS99. DTSCS99 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004 00004 DATE-WRITTEN. SEPTEMBER 1998. CL**2 00005 DATE-COMPILED. DTSCS99 00006 DTSCS99 00007 ***** DTSCS99 00008 * DTSCS99 00009 * FUNCTION: EMPLOYER ON-LINE UPDATE LOCK INQUIRY/UPDATE DTSCS99 00010 * SCREEN PROCESSOR. DTSCS99 00011 * DTSCS99 00012 * DTSCS99 00013 * MODIFICATION LOG: DTSCS99 00014 * DTSCS99 00015 * 09/28/1998 INITIAL DEVELOPMENT. CL**2 00016 * WORK ORDER: PROGRAMMER: GD CL**2 00017 * DTSCS99 00018 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00020 * WORK ORDER: PROGRAMMER: XXX CL**2 00021 * DTSCS99 00022 * DTSCS99 00023 * DESCRIPTION: DTSCS99 00024 * DTSCS99 00025 * CLEAR: DTSCS99 00026 * DTSCS99 00027 * DATA FIELDS DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS99 00028 * DTSCS99 00029 * DTSCS99 00030 * INQUIRY: DTSCS99 00031 * DTSCS99 00032 * CONTROL FIELDS(S): MAP-EMP-NO. DTSCS99 00033 * DTSCS99 00034 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS99 00035 * DTSCS99 00036 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS99 00037 * DTSCS99 00038 * STANDARD LCCM-EMP-NO MAINTENANCE LOGIC. DTSCS99 00039 * DTSCS99 00040 * DTSCS99 00041 * UPDATE: DTSCS99 00042 * DTSCS99 00043 * MOD DTSCS99 00044 * DTSCS99 00045 * DTSCS99 00046 * RECORDS READ: DTSCS99 00047 * DTSCS99 00048 * MASTER: DTSCS99 00049 * DTSCS99 00050 * MPRF. DTSCS99 00051 * DTSCS99 00052 * DTSCS99 00053 * ALTERNATE INDEX: DTSCS99 00054 * DTSCS99 00055 * NONE. DTSCS99 00056 * DTSCS99 00057 * DTSCS99 00058 * REFERENCE: DTSCS99 00059 * DTSCS99 00060 * NONE. DTSCS99 00061 * DTSCS99 00062 * DTSCS99 00063 * ACCOUNTING TRANSACTION COLLECTION: DTSCS99 00064 * DTSCS99 00065 * NONE. DTSCS99 00066 * DTSCS99 00067 * DTSCS99 00068 * RECORDS UPDATED: DTSCS99 00069 * DTSCS99 00070 * MASTER: DTSCS99 00071 * DTSCS99 00072 * MPRF (MOD). DTSCS99 00073 * OBVIOUSLY, THIS MODULE BYPASSES THE EMPLOYER ON-LINE DTSCS99 00074 * UPDATE LOCKING PROCEDURES (THIS IS THE MODULE THAT DTSCS99 00075 * ALLOWS THE SYSTEM USERS TO MAINTAIN THE EMPLOYER DTSCS99 00076 * ON-LINE UPDATE LOCK). DTSCS99 00077 * DTSCS99 00078 * THE ONLY MPRF FIELDS MODIFIED ARE MPRF-UPDATE-START- DTSCS99 00079 * ABSTIME AND MPRF-UPDATE-END-ABSTIME. DTSCS99 00080 * DTSCS99 00081 * IF MPRF IS MODIFIED, THEN WRITE A DTSIR905 RECORD CL**2 00082 * REFLECTING THE EVENT. DTSCS99 00083 * DTSCS99 00084 * DTSCS99 00085 * REFERENCE: DTSCS99 00086 * DTSCS99 00087 * NONE. DTSCS99 00088 * DTSCS99 00089 * DTSCS99 00090 * ACCOUNTING TRANSACTION COLLECTION: DTSCS99 00091 * DTSCS99 00092 * NONE. DTSCS99 00093 * DTSCS99 00094 * DTSCS99 00095 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS99 00096 * DTSCS99 00097 * DTSIR905 ON-LINE RECOVERY/RESTART (905R1) REPORT RECORD. CL**2 00098 * DTSCS99 00099 * DTSCS99 00100 * MODULES LINKED TO: DTSCS99 00101 * DTSCS99 00102 * DTSCU001 DATE EDIT/CONVERSION. CL**2 00103 * DTSCU018 EMP-NO FROM SCREEN FORMAT/EDIT. CL**2 00104 * DTSCU810 MASTER I/O. CL**2 00105 * DTSCU825 ON-LINE EVENT FILE O. CL**2 00106 * DTSCS99 00107 * DTSCS99 00108 ***** DTSCS99 00109 SKIP3 DTSCS99 00110 ENVIRONMENT DIVISION. DTSCS99 00111 SKIP3 DTSCS99 00112 DATA DIVISION. DTSCS99 00113 SKIP3 DTSCS99 00114 WORKING-STORAGE SECTION. DTSCS99 001145 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS99 10/07/98'. DTSCS99 00115 SKIP3 DTSCS99 00116 01 WRK-AREA. DTSCS99 00117 05 WRK-ABEND-CD PIC X(04) VALUE 'S99 '. DTSCS99 00118 SKIP1 DTSCS99 00119 05 WRK-SCR-ID. DTSCS99 00120 10 WRK-SCR-ID-9 PIC 9(02) VALUE 99. DTSCS99 00121 SKIP1 DTSCS99 00122 05 WRK-F03-SCR-ID PIC X(02) VALUE '90'. DTSCS99 00123 SKIP3 DTSCS99 00124 05 SCR-ACCESS-IND PIC X(01). DTSCS99 00125 88 SCR-ACCESS-INQ VALUE '1'. DTSCS99 00126 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS99 00127 SKIP1 DTSCS99 00128 05 CURSOR-SET-IND PIC X(01). DTSCS99 00129 88 CURSOR-SET-YES VALUE 'Y'. DTSCS99 00130 88 CURSOR-SET-NO VALUE 'N'. DTSCS99 00131 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS99 00132 SKIP1 DTSCS99 00133 05 REQ-IND PIC X(01). DTSCS99 00134 88 REQ-ERROR VALUE 'O'. DTSCS99 00135 88 REQ-JUMP VALUE 'J'. DTSCS99 00136 88 REQ-INQUIRE VALUE 'I'. DTSCS99 00137 88 REQ-CLEAR VALUE 'C'. DTSCS99 00138 88 REQ-EDIT VALUE 'E'. DTSCS99 00139 88 REQ-UPDATE VALUE 'U'. DTSCS99 00140 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS99 00141 SKIP1 DTSCS99 00142 05 RESP-IND PIC X(01). DTSCS99 00143 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS99 00144 88 RESP-SEND-MAP VALUE 'M'. DTSCS99 00145 88 RESP-JUMP VALUE 'J'. DTSCS99 00146 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS99 00147 SKIP1 DTSCS99 00148 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS99 00149 SKIP1 DTSCS99 00150 05 WRK-MPRF-IND PIC X(01). DTSCS99 00151 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS99 00152 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS99 00153 SKIP1 DTSCS99 00154 05 WRK-NEW-KEY-IND PIC X(01). DTSCS99 00155 SKIP1 DTSCS99 00156 05 WRK-MSG-AREA PIC X(64). DTSCS99 00157 SKIP1 DTSCS99 00158 05 WRK-ATB-AN PIC X(01). DTSCS99 00159 05 WRK-ATB-NUM PIC X(01). DTSCS99 00160 SKIP3 DTSCS99 00161 05 WRK-DISPLAY PIC 9(09). DTSCS99 00162 SKIP1 DTSCS99 00163 05 FILLER REDEFINES WRK-DISPLAY. DTSCS99 00164 10 FILLER PIC X(03). DTSCS99 00165 10 WRK-DISPLAY-YR PIC X(02). DTSCS99 00166 10 WRK-DISPLAY-MO PIC X(02). DTSCS99 00167 10 WRK-DISPLAY-DA PIC X(02). DTSCS99 00168 SKIP1 DTSCS99 00169 05 FILLER REDEFINES WRK-DISPLAY. DTSCS99 00170 10 FILLER PIC X(03). DTSCS99 00171 10 WRK-DISPLAY-HR PIC X(02). DTSCS99 00172 10 WRK-DISPLAY-MIN PIC X(02). DTSCS99 00173 10 WRK-DISPLAY-SEC PIC X(02). DTSCS99 00174 EJECT DTSCS99 00175 01 L018-COMM-AREA. DTSCS99 00176 ++INCLUDE DTSIL018 CL**2 00177 EJECT DTSCS99 00178 01 L805-COMM-AREA. DTSCS99 00179 ++INCLUDE DTSIL805 CL**2 00180 EJECT DTSCS99 00181 01 L810-COMM-AREA. DTSCS99 00182 05 L810-CONTROL-BLOCK. DTSCS99 00183 ++INCLUDE DTSIL810 CL**2 00184 EJECT DTSCS99 00185 05 MSKL-REC. DTSCS99 00186 ++INCLUDE DTSIMSKL CL**2 00187 EJECT DTSCS99 00188 01 MPRF-REC. DTSCS99 00189 ++INCLUDE DTSIMPRF CL**2 00190 EJECT DTSCS99 00191 01 L825-COMM-AREA. DTSCS99 00192 05 L825-CONTROL-BLOCK. DTSCS99 00193 ++INCLUDE DTSIL825 CL**2 00194 EJECT DTSCS99 00195 05 RSKL-REC. DTSCS99 00196 ++INCLUDE DTSIRSK1 CL**2 00197 EJECT DTSCS99 00198 01 R905-REC. DTSCS99 00199 ++INCLUDE DTSIR905 CL**2 00200 EJECT DTSCS99 00201 * MAP DEFINITION DTSCS99 00202 01 L851-COMM-AREA. DTSCS99 00203 ++INCLUDE DTSIL851 CL**2 00204 SKIP3 DTSCS99 00205 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS99 00206 ++INCLUDE DTSIS99 CL**2 00207 EJECT DTSCS99 00208 01 CATB-LITERALS. DTSCS99 00209 ++INCLUDE DTSICATB CL**2 00210 SKIP3 DTSCS99 00211 01 CFKD-LITERALS. DTSCS99 00212 ++INCLUDE DTSICFKD CL**2 00213 SKIP3 DTSCS99 00214 01 CECD-LITERALS. DTSCS99 00215 ++INCLUDE DTSICECD CL**2 00216 SKIP3 DTSCS99 00217 01 CPCD-LITERALS. DTSCS99 00218 ++INCLUDE DTSICPCD CL**2 00219 EJECT DTSCS99 00220 LINKAGE SECTION. DTSCS99 00221 SKIP3 DTSCS99 00222 01 DFHCOMMAREA. DTSCS99 00223 ++INCLUDE DTSILCCM CL**2 00224 EJECT DTSCS99 00225 ******************************************************************DTSCS99 00226 * *DTSCS99 00227 ******************************************************************DTSCS99 00228 SKIP1 DTSCS99 00229 PROCEDURE DIVISION. DTSCS99 00230 SKIP2 DTSCS99 00231 MOVE +0 TO WRK-EMP-NO. DTSCS99 00232 SKIP1 DTSCS99 00233 SET WRK-MPRF-NO-88 TO TRUE. DTSCS99 00234 SKIP1 DTSCS99 00235 MOVE LOW-VALUES TO MAP-AREA. DTSCS99 00236 SKIP1 DTSCS99 00237 SET CURSOR-SET-NO TO TRUE. DTSCS99 00238 SKIP1 DTSCS99 00239 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS99 00240 TO SCR-ACCESS-IND. DTSCS99 00241 SKIP3 DTSCS99 00242 MOVE SPACE TO REQ-IND. DTSCS99 00243 SKIP1 DTSCS99 00244 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS99 00245 SKIP1 DTSCS99 00246 *----------------------------------------------------- DTSCS99 00247 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS99 00248 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS99 00249 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS99 00250 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS99 00251 * DTSCS99 00252 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS99 00253 * PROCESSED. DTSCS99 00254 * DTSCS99 00255 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS99 00256 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS99 00257 * WORK STATION OPERATOR. DTSCS99 00258 *----------------------------------------------------- DTSCS99 00259 SKIP1 DTSCS99 00260 MOVE SPACE TO RESP-IND. DTSCS99 00261 SKIP1 DTSCS99 00262 IF REQ-ERROR DTSCS99 00263 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS99 00264 ELSE DTSCS99 00265 IF REQ-JUMP DTSCS99 00266 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS99 00267 ELSE DTSCS99 00268 IF REQ-CLEAR DTSCS99 00269 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS99 00270 ELSE DTSCS99 00271 IF REQ-CURSOR-TO-GOTO DTSCS99 00272 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS99 00273 ELSE DTSCS99 00274 IF REQ-INQUIRE DTSCS99 00275 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS99 00276 ELSE DTSCS99 00277 IF REQ-EDIT DTSCS99 00278 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS99 00279 ELSE DTSCS99 00280 IF REQ-UPDATE DTSCS99 00281 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS99 00282 ELSE DTSCS99 00283 GO TO S899-ABEND. DTSCS99 00284 SKIP3 DTSCS99 00285 *----------------------------------------------------- DTSCS99 00286 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS99 00287 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS99 00288 *----------------------------------------------------- DTSCS99 00289 SKIP1 DTSCS99 00290 IF RESP-SEND-MAP DTSCS99 00291 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS99 00292 SET LCCM-END-TASK-88 TO TRUE DTSCS99 00293 ELSE DTSCS99 00294 IF RESP-SEND-MSGONLY DTSCS99 00295 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS99 00296 SET LCCM-END-TASK-88 TO TRUE DTSCS99 00297 ELSE DTSCS99 00298 IF RESP-JUMP DTSCS99 00299 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS99 00300 ELSE DTSCS99 00301 IF RESP-CURSOR-TO-GOTO DTSCS99 00302 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS99 00303 SET LCCM-END-TASK-88 TO TRUE DTSCS99 00304 ELSE DTSCS99 00305 GO TO S899-ABEND. DTSCS99 00306 SKIP3 DTSCS99 00307 MAINLINE-EXIT. DTSCS99 00308 SKIP1 DTSCS99 00309 EXEC CICS DTSCS99 00310 RETURN DTSCS99 00311 END-EXEC. DTSCS99 00312 SKIP2 DTSCS99 00313 GOBACK. DTSCS99 00314 /*****************************************************************DTSCS99 00315 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS99 00316 ******************************************************************DTSCS99 00317 P1000-ANALYZE-REQUEST. DTSCS99 00318 SKIP1 DTSCS99 00319 *----------------------------------------------------- DTSCS99 00320 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS99 00321 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS99 00322 * REPLACED WITH ENTER) DTSCS99 00323 *----------------------------------------------------- DTSCS99 00324 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS99 00325 SET LCCM-ENTER-88 TO TRUE DTSCS99 00326 SET REQ-INQUIRE TO TRUE DTSCS99 00327 IF LCCM-EMP-NO > ZERO DTSCS99 00328 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS99 00329 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS99 00330 END-IF DTSCS99 00331 GO TO P1000-EXIT. DTSCS99 00332 SKIP3 DTSCS99 00333 *----------------------------------------------------- DTSCS99 00334 * MAP IS RECEIVED DTSCS99 00335 *----------------------------------------------------- DTSCS99 00336 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS99 00337 SKIP3 DTSCS99 00338 *----------------------------------------------------- DTSCS99 00339 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS99 00340 * WORK STATION DTSCS99 00341 *----------------------------------------------------- DTSCS99 00342 IF LCCM-CLEAR-88 DTSCS99 00343 SET REQ-CLEAR TO TRUE DTSCS99 00344 GO TO P1000-EXIT. DTSCS99 00345 SKIP3 DTSCS99 00346 *----------------------------------------------------- DTSCS99 00347 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS99 00348 *----------------------------------------------------- DTSCS99 00349 IF LCCM-SCR-UPDATE-LOCKED DTSCS99 00350 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS99 00351 GO TO P1000-EXIT. DTSCS99 00352 SKIP3 DTSCS99 00353 *----------------------------------------------------- DTSCS99 00354 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS99 00355 *----------------------------------------------------- DTSCS99 00356 IF LCCM-PA2-88 DTSCS99 00357 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS99 00358 GO TO P1000-EXIT. DTSCS99 00359 SKIP3 DTSCS99 00360 *----------------------------------------------------- DTSCS99 00361 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS99 00362 *----------------------------------------------------- DTSCS99 00363 IF LCCM-PA-88 DTSCS99 00364 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS99 00365 SET REQ-ERROR TO TRUE DTSCS99 00366 GO TO P1000-EXIT. DTSCS99 00367 SKIP3 DTSCS99 00368 *----------------------------------------------------- CL**2 00369 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A CL**2 00370 * REQUEST TO CLEAR THE SCREEN CL**2 00371 *----------------------------------------------------- CL**2 00372 IF LCCM-F12-88 CL**2 00373 MOVE LOW-VALUE TO MAP-AREA CL**2 00374 SET REQ-CLEAR TO TRUE CL**2 00375 GO TO P1000-EXIT. CL**2 00376 SKIP3 CL**2 00377 *----------------------------------------------------- DTSCS99 00378 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS99 00379 *----------------------------------------------------- DTSCS99 00380 IF LCCM-F03-88 DTSCS99 00381 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS99 00382 SET REQ-JUMP TO TRUE DTSCS99 00383 GO TO P1000-EXIT. DTSCS99 00384 SKIP3 DTSCS99 00385 *----------------------------------------------------- DTSCS99 00386 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS99 00387 *----------------------------------------------------- DTSCS99 00388 IF LCCM-F04-88 DTSCS99 00389 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS99 00390 SET REQ-JUMP TO TRUE DTSCS99 00391 GO TO P1000-EXIT. DTSCS99 00392 SKIP3 DTSCS99 00393 *----------------------------------------------------- DTSCS99 00394 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS99 00395 * CORRESPONDENCE SCREEN DTSCS99 00396 *----------------------------------------------------- DTSCS99 00397 IF LCCM-F14-88 DTSCS99 00398 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS99 00399 SET REQ-JUMP TO TRUE DTSCS99 00400 GO TO P1000-EXIT. DTSCS99 00401 SKIP3 DTSCS99 00402 *----------------------------------------------------- DTSCS99 00403 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS99 00404 * REQUESTED SCREEN TYPE DTSCS99 00405 *----------------------------------------------------- DTSCS99 00406 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS99 00407 NEXT SENTENCE DTSCS99 00408 ELSE DTSCS99 00409 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS99 00410 SET REQ-JUMP TO TRUE DTSCS99 00411 GO TO P1000-EXIT. DTSCS99 00412 SKIP3 DTSCS99 00413 *----------------------------------------------------- DTSCS99 00414 * IF REQUEST TO UPDATE THE DATA (MOD) DTSCS99 00415 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS99 00416 *----------------------------------------------------- DTSCS99 00417 IF LCCM-F10-88 DTSCS99 00418 IF SCR-ACCESS-UPDATE DTSCS99 00419 SET REQ-EDIT TO TRUE DTSCS99 00420 GO TO P1000-EXIT DTSCS99 00421 ELSE DTSCS99 00422 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS99 00423 SET REQ-ERROR TO TRUE DTSCS99 00424 GO TO P1000-EXIT. DTSCS99 00425 SKIP3 DTSCS99 00426 *----------------------------------------------------- DTSCS99 00427 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS99 00428 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS99 00429 *----------------------------------------------------- DTSCS99 00430 IF LCCM-ENTER-88 DTSCS99 00431 SET REQ-INQUIRE TO TRUE DTSCS99 00432 GO TO P1000-EXIT. DTSCS99 00433 SKIP3 DTSCS99 00434 *----------------------------------------------------- DTSCS99 00435 * ANY OTHER KEY IS INVALID DTSCS99 00436 *----------------------------------------------------- DTSCS99 00437 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS99 00438 SET REQ-ERROR TO TRUE. DTSCS99 00439 P1000-EXIT. DTSCS99 00440 EXIT. DTSCS99 00441 SKIP3 DTSCS99 00442 ******************************************************************DTSCS99 00443 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS99 00444 ******************************************************************DTSCS99 00445 SKIP1 DTSCS99 00446 P1100-UPDATE-LOCKED. DTSCS99 00447 *----------------------------------------------------- DTSCS99 00448 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS99 00449 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS99 00450 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS99 00451 *----------------------------------------------------- DTSCS99 00452 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS99 00453 SET REQ-UPDATE TO TRUE DTSCS99 00454 ELSE DTSCS99 00455 SET REQ-ERROR TO TRUE DTSCS99 00456 IF LCCM-SCR-MOD-LOCKED DTSCS99 00457 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS99 00458 ELSE DTSCS99 00459 GO TO S899-ABEND. DTSCS99 00460 P1100-EXIT. DTSCS99 00461 EXIT. DTSCS99 00462 /*****************************************************************DTSCS99 00463 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS99 00464 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS99 00465 ******************************************************************DTSCS99 00466 SKIP1 DTSCS99 00467 P2000-REQUEST-ERROR. DTSCS99 00468 IF LCCM-MSG DTSCS99 00469 SET RESP-SEND-MSGONLY TO TRUE DTSCS99 00470 ELSE DTSCS99 00471 GO TO S899-ABEND. DTSCS99 00472 P2000-EXIT. DTSCS99 00473 EXIT. DTSCS99 00474 /*****************************************************************DTSCS99 00475 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS99 00476 ******************************************************************DTSCS99 00477 SKIP1 DTSCS99 00478 P3000-REQUEST-JUMP. DTSCS99 00479 *----------------------------------------------------- DTSCS99 00480 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS99 00481 * BY USER DTSCS99 00482 *----------------------------------------------------- DTSCS99 00483 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS99 00484 SKIP3 DTSCS99 00485 *----------------------------------------------------- DTSCS99 00486 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS99 00487 *----------------------------------------------------- DTSCS99 00488 IF LCCM-MSG DTSCS99 00489 SET RESP-SEND-MSGONLY TO TRUE DTSCS99 00490 SET CURSOR-SET-GOTO TO TRUE DTSCS99 00491 GO TO P3000-EXIT. DTSCS99 00492 SKIP3 DTSCS99 00493 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS99 00494 PERFORM S018-EMP-NO THRU S018-EXIT. DTSCS99 00495 IF L018-VALID DTSCS99 00496 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS99 00497 SKIP3 DTSCS99 00498 *----------------------------------------------------- DTSCS99 00499 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS99 00500 *----------------------------------------------------- DTSCS99 00501 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS99 00502 LCCM-SCR-HOLD-AREA. DTSCS99 00503 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS99 00504 SET RESP-JUMP TO TRUE. DTSCS99 00505 P3000-EXIT. DTSCS99 00506 EXIT. DTSCS99 00507 /*****************************************************************DTSCS99 00508 * CLEAR KEY WAS PRESSED *DTSCS99 00509 ******************************************************************DTSCS99 00510 SKIP1 DTSCS99 00511 P4000-REQUEST-CLEAR. DTSCS99 00512 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS99 00513 SKIP3 DTSCS99 00514 *----------------------------------------------------- DTSCS99 00515 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS99 00516 * FIELDS FROM EARLIER REQUESTS DTSCS99 00517 *----------------------------------------------------- DTSCS99 00518 IF LCCM-EMP-NO > ZERO DTSCS99 00519 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS99 00520 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS99 00521 MOVE ZERO TO LCCM-EMP-NO. DTSCS99 00522 SKIP1 DTSCS99 00523 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS99 00524 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS99 00525 SET LCCM-SCR-CLEAR TO TRUE. DTSCS99 00526 SET RESP-SEND-MAP TO TRUE. DTSCS99 00527 P4000-EXIT. DTSCS99 00528 EXIT. DTSCS99 00529 /*****************************************************************DTSCS99 00530 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS99 00531 ******************************************************************DTSCS99 00532 SKIP1 DTSCS99 00533 P5000-CURSOR-TO-GOTO. DTSCS99 00534 SET CURSOR-SET-GOTO TO TRUE. DTSCS99 00535 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS99 00536 P5000-EXIT. DTSCS99 00537 EXIT. DTSCS99 00538 /*****************************************************************DTSCS99 00539 * INQUIRY WAS REQUESTED *DTSCS99 00540 ******************************************************************DTSCS99 00541 SKIP1 DTSCS99 00542 P6000-REQUEST-INQUIRE. DTSCS99 00543 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS99 00544 MOVE LOW-VALUES TO MAP-AREA. DTSCS99 00545 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS99 00546 SKIP1 DTSCS99 00547 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS99 00548 SKIP1 DTSCS99 00549 SET LCCM-SCR-CLEAR TO TRUE. DTSCS99 00550 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS99 00551 SKIP1 DTSCS99 00552 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS99 00553 SKIP1 DTSCS99 00554 IF LCCM-MSG DTSCS99 00555 NEXT SENTENCE DTSCS99 00556 ELSE DTSCS99 00557 IF LCCM-ENTER-88 DTSCS99 00558 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS99 00559 ELSE DTSCS99 00560 GO TO S899-ABEND. DTSCS99 00561 SKIP1 DTSCS99 00562 SET RESP-SEND-MAP TO TRUE. DTSCS99 00563 P6000-EXIT. DTSCS99 00564 EXIT. DTSCS99 00565 EJECT DTSCS99 00566 P6100-NO-PAGE. DTSCS99 00567 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS99 00568 SKIP1 DTSCS99 00569 IF LCCM-MSG DTSCS99 00570 GO TO P6100-EXIT. DTSCS99 00571 SKIP1 DTSCS99 00572 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS99 00573 P6100-EXIT. DTSCS99 00574 EXIT. DTSCS99 00575 /*****************************************************************DTSCS99 00576 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS99 00577 ******************************************************************DTSCS99 00578 SKIP1 DTSCS99 00579 P6900-CONSTRUCT-SCREEN. DTSCS99 00580 IF SCR-ACCESS-UPDATE DTSCS99 00581 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS99 00582 SKIP3 DTSCS99 00583 IF MPRF-UPDATE-ACTIVE-88 DTSCS99 00584 MOVE 'Y' TO MAP-UPDATE-IND DTSCS99 00585 ELSE DTSCS99 00586 MOVE 'N' TO MAP-UPDATE-IND. DTSCS99 00587 SKIP1 DTSCS99 00588 MOVE MPRF-UPDATE-TASK-ID TO MAP-UPDATE-TASK-ID. DTSCS99 00589 MOVE MPRF-UPDATE-OP-ID TO MAP-UPDATE-OP-ID. DTSCS99 00590 MOVE MPRF-UPDATE-TERMID TO MAP-UPDATE-TERMID. DTSCS99 00591 MOVE MPRF-UPDATE-NETNAME TO MAP-UPDATE-NETNAME. CL**2 00592 MOVE MPRF-UPDATE-SCR-ID TO MAP-UPDATE-SCR-ID. DTSCS99 00593 MOVE MPRF-UPDATE-FUNCTION TO MAP-UPDATE-FUNCTION. DTSCS99 00594 SKIP1 DTSCS99 00595 MOVE MPRF-UPDATE-START-DATE TO WRK-DISPLAY. DTSCS99 00596 MOVE ' / / ' TO MAP-UPDATE-START-DATE. DTSCS99 00597 MOVE WRK-DISPLAY-MO TO MAP-UPDATE-START-DATE (1:2). DTSCS99 00598 MOVE WRK-DISPLAY-DA TO MAP-UPDATE-START-DATE (4:2). DTSCS99 00599 MOVE WRK-DISPLAY-YR TO MAP-UPDATE-START-DATE (7:2). DTSCS99 00600 SKIP1 DTSCS99 00601 MOVE MPRF-UPDATE-START-TIME TO WRK-DISPLAY. DTSCS99 00602 MOVE ' : : ' TO MAP-UPDATE-START-TIME. DTSCS99 00603 MOVE WRK-DISPLAY-HR TO MAP-UPDATE-START-TIME (1:2). DTSCS99 00604 MOVE WRK-DISPLAY-MIN TO MAP-UPDATE-START-TIME (4:2). DTSCS99 00605 MOVE WRK-DISPLAY-SEC TO MAP-UPDATE-START-TIME (7:2). DTSCS99 00606 SKIP3 DTSCS99 00607 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS99 00608 SKIP1 DTSCS99 00609 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS99 00610 P6900-EXIT. DTSCS99 00611 EXIT. DTSCS99 00612 /*****************************************************************DTSCS99 00613 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS99 00614 ******************************************************************DTSCS99 00615 SKIP1 DTSCS99 00616 P7000-REQUEST-EDIT. DTSCS99 00617 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS99 00618 SKIP1 DTSCS99 00619 IF LCCM-F10-88 DTSCS99 00620 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS99 00621 ELSE DTSCS99 00622 GO TO S899-ABEND. DTSCS99 00623 SKIP3 DTSCS99 00624 *------------------------------------------------------ DTSCS99 00625 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS99 00626 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS99 00627 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS99 00628 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS99 00629 *------------------------------------------------------ DTSCS99 00630 SKIP1 DTSCS99 00631 IF LCCM-MSG DTSCS99 00632 NEXT SENTENCE DTSCS99 00633 ELSE DTSCS99 00634 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS99 00635 IF LCCM-F10-88 DTSCS99 00636 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS99 00637 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID. DTSCS99 00638 SKIP1 DTSCS99 00639 SET RESP-SEND-MAP TO TRUE. DTSCS99 00640 P7000-EXIT. DTSCS99 00641 EXIT. DTSCS99 00642 /*****************************************************************DTSCS99 00643 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS99 00644 ******************************************************************DTSCS99 00645 SKIP1 DTSCS99 00646 P7200-EDIT-MOD. DTSCS99 00647 *----------------------------------------------------- DTSCS99 00648 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS99 00649 * INQUIRED DTSCS99 00650 *----------------------------------------------------- DTSCS99 00651 IF NOT LCCM-SCR-INQUIRE DTSCS99 00652 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS99 00653 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS99 00654 GO TO P7200-EXIT. DTSCS99 00655 SKIP3 DTSCS99 00656 *----------------------------------------------------- DTSCS99 00657 * MAP-OP-ID MAY NOT BE CHANGED DURING THE MOD DTSCS99 00658 *----------------------------------------------------- DTSCS99 00659 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS99 00660 IF LCCM-MSG DTSCS99 00661 GO TO P7200-EXIT. DTSCS99 00662 SKIP1 DTSCS99 00663 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS99 00664 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS99 00665 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99 00666 GO TO P7200-EXIT. DTSCS99 00667 SKIP1 DTSCS99 00668 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS99 00669 P7200-EXIT. DTSCS99 00670 EXIT. DTSCS99 00671 /*****************************************************************DTSCS99 00672 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS99 00673 ******************************************************************DTSCS99 00674 SKIP1 DTSCS99 00675 P8000-REQUEST-UPDATE. DTSCS99 00676 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS99 00677 SKIP1 DTSCS99 00678 IF LCCM-SCR-MOD-LOCKED DTSCS99 00679 PERFORM P8200-MOD THRU P8200-EXIT DTSCS99 00680 ELSE DTSCS99 00681 GO TO S899-ABEND. DTSCS99 00682 SKIP1 DTSCS99 00683 SET RESP-SEND-MAP TO TRUE. DTSCS99 00684 P8000-EXIT. DTSCS99 00685 EXIT. DTSCS99 00686 /*****************************************************************DTSCS99 00687 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS99 00688 ******************************************************************DTSCS99 00689 SKIP1 DTSCS99 00690 P8200-MOD. DTSCS99 00691 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS99 00692 SKIP1 DTSCS99 00693 IF LCCM-F12-88 DTSCS99 00694 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS99 00695 GO TO P8200-EXIT. DTSCS99 00696 SKIP1 DTSCS99 00697 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS99 00698 SKIP1 DTSCS99 00699 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS99 00700 IF LCCM-MSG DTSCS99 00701 GO TO P8200-EXIT. DTSCS99 00702 SKIP1 DTSCS99 00703 PERFORM P8900-UPDATE THRU P8900-EXIT. DTSCS99 00704 SKIP1 DTSCS99 00705 MOVE MPRF-REC TO MSKL-REC. DTSCS99 00706 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS99 00707 SKIP1 DTSCS99 00708 *-------------------------------------------------------- DTSCS99 00709 * REFRESH THE SCREEN. DTSCS99 00710 *-------------------------------------------------------- DTSCS99 00711 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS99 00712 SKIP3 DTSCS99 00713 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS99 00714 SKIP1 DTSCS99 00715 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS99 00716 P8200-EXIT. DTSCS99 00717 EXIT. DTSCS99 00718 EJECT DTSCS99 00719 P8900-UPDATE. DTSCS99 00720 IF MPRF-UPDATE-ACTIVE-88 DTSCS99 00721 IF MAP-UPDATE-IND = 'Y' DTSCS99 00722 GO TO P8900-EXIT DTSCS99 00723 ELSE DTSCS99 00724 NEXT SENTENCE DTSCS99 00725 ELSE DTSCS99 00726 IF MAP-UPDATE-IND = 'N' DTSCS99 00727 GO TO P8900-EXIT DTSCS99 00728 ELSE DTSCS99 00729 NEXT SENTENCE. DTSCS99 00730 SKIP1 DTSCS99 00731 IF MAP-UPDATE-IND = 'Y' DTSCS99 00732 SET MPRF-UPDATE-ACTIVE-88 TO TRUE DTSCS99 00733 ELSE DTSCS99 00734 MOVE LCCM-TASK-START-ABSTIME TO MPRF-UPDATE-END-ABSTIME. DTSCS99 00735 SKIP1 DTSCS99 00736 MOVE LCCM-TASK-ID TO MPRF-UPDATE-TASK-ID. DTSCS99 00737 MOVE LCCM-OP-ID TO MPRF-UPDATE-OP-ID. DTSCS99 00738 MOVE LCCM-CICS-TERM-ID TO MPRF-UPDATE-TERMID. DTSCS99 00739 MOVE LCCM-TASK-NETNAME TO MPRF-UPDATE-NETNAME. CL**2 00740 MOVE LCCM-TASK-START-DATE TO MPRF-UPDATE-START-DATE. DTSCS99 00741 MOVE LCCM-TASK-START-TIME TO MPRF-UPDATE-START-TIME. DTSCS99 00742 MOVE WRK-SCR-ID TO MPRF-UPDATE-SCR-ID. DTSCS99 00743 SET MPRF-UPDATE-MODIFY-88 TO TRUE. DTSCS99 00744 SKIP1 DTSCS99 00745 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS99 00746 SKIP3 DTSCS99 00747 PERFORM P8910-CREATE-R905 THRU P8910-EXIT. DTSCS99 00748 P8900-EXIT. DTSCS99 00749 EXIT. DTSCS99 00750 SKIP3 DTSCS99 00751 P8910-CREATE-R905. DTSCS99 00752 MOVE WRK-EMP-NO TO R905-EMP-NO. DTSCS99 00753 MOVE LCCM-TASK-START-DATE TO R905-SYS-DATE. DTSCS99 00754 MOVE LCCM-TASK-START-TIME TO R905-SYS-TIME. DTSCS99 00755 MOVE LCCM-OP-ID TO R905-OP-ID. DTSCS99 00756 MOVE MAP-UPDATE-IND TO R905-UPDATE-IND. DTSCS99 00757 MOVE MPRF-UPDATE-TASK-ID TO R905-UPDATE-TASK-ID. DTSCS99 00758 MOVE MPRF-UPDATE-OP-ID TO R905-UPDATE-OP-ID. CL**4 00759 MOVE MPRF-UPDATE-TERMID TO R905-UPDATE-TERMID. DTSCS99 00760 MOVE MPRF-UPDATE-NETNAME TO R905-UPDATE-NETNAME. CL**2 00761 MOVE MPRF-UPDATE-START-DATE TO R905-UPDATE-START-DATE. DTSCS99 00762 MOVE MPRF-UPDATE-START-TIME TO R905-UPDATE-START-TIME. DTSCS99 00763 MOVE MPRF-UPDATE-SCR-ID TO R905-UPDATE-SCR-ID. DTSCS99 00764 MOVE MPRF-UPDATE-FUNCTION TO R905-UPDATE-FUNCTION. DTSCS99 00765 CL**4 00766 MOVE LOW-VALUES TO R905-PADDING-FOR-SYNCSORT. CL**4 00767 CL**4 00768 MOVE LENGTH OF R905-REC TO R905-LENGTH. CL**4 00769 CL**4 00770 MOVE R905-REC TO RSKL-REC. DTSCS99 00771 CL**4 00772 PERFORM S825-WRITE THRU S825-EXIT. CL**4 00773 P8910-EXIT. DTSCS99 00774 EXIT. DTSCS99 00775 /*****************************************************************DTSCS99 00776 * LINKS TO UTILITY MODULES DTSCS99 00777 ******************************************************************DTSCS99 00778 SKIP1 DTSCS99 00779 S018-EMP-NO. DTSCS99 00780 EXEC CICS LINK DTSCS99 00781 PROGRAM('DTSCU018') CL**2 00782 COMMAREA(L018-COMM-AREA) DTSCS99 00783 END-EXEC. DTSCS99 00784 S018-EXIT. DTSCS99 00785 EXIT. DTSCS99 00786 SKIP3 DTSCS99 00787 S803-REQ-SCR-ID-EDIT. DTSCS99 00788 EXEC CICS LINK DTSCS99 00789 PROGRAM ('DTSCU803') CL**2 00790 COMMAREA (DFHCOMMAREA) DTSCS99 00791 END-EXEC. DTSCS99 00792 S803-EXIT. DTSCS99 00793 EXIT. DTSCS99 00794 SKIP3 DTSCS99 00795 S804-INVALID-KEY. DTSCS99 00796 EXEC CICS LINK DTSCS99 00797 PROGRAM ('DTSCU804') CL**2 00798 COMMAREA (DFHCOMMAREA) DTSCS99 00799 END-EXEC. DTSCS99 00800 S804-EXIT. DTSCS99 00801 EXIT. DTSCS99 00802 SKIP3 DTSCS99 00803 S805-MSG-AREA. DTSCS99 00804 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS99 00805 SKIP1 DTSCS99 00806 EXEC CICS LINK DTSCS99 00807 PROGRAM ('DTSCU805') CL**2 00808 COMMAREA (L805-COMM-AREA) DTSCS99 00809 END-EXEC. DTSCS99 00810 SKIP1 DTSCS99 00811 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS99 00812 S805-EXIT. DTSCS99 00813 EXIT. DTSCS99 00814 EJECT DTSCS99 00815 S810-READ. DTSCS99 00816 SET L810-READ-88 TO TRUE. DTSCS99 00817 GO TO S810-IO. DTSCS99 00818 SKIP1 DTSCS99 00819 S810-START-BROWSE. DTSCS99 00820 SET L810-START-BROWSE-88 TO TRUE. DTSCS99 00821 GO TO S810-IO. DTSCS99 00822 SKIP1 DTSCS99 00823 S810-READ-NEXT. DTSCS99 00824 SET L810-READ-NEXT-88 TO TRUE. DTSCS99 00825 GO TO S810-IO. DTSCS99 00826 SKIP1 DTSCS99 00827 S810-READ-PREV. DTSCS99 00828 SET L810-READ-PREV-88 TO TRUE. DTSCS99 00829 GO TO S810-IO. DTSCS99 00830 SKIP1 DTSCS99 00831 S810-END-BROWSE. DTSCS99 00832 SET L810-END-BROWSE-88 TO TRUE. DTSCS99 00833 GO TO S810-IO. DTSCS99 00834 SKIP1 DTSCS99 00835 S810-REWRITE. DTSCS99 00836 SET L810-REWRITE-88 TO TRUE. DTSCS99 00837 GO TO S810-IO. DTSCS99 00838 SKIP1 DTSCS99 00839 S810-WRITE. DTSCS99 00840 SET L810-WRITE-88 TO TRUE. DTSCS99 00841 GO TO S810-IO. DTSCS99 00842 SKIP1 DTSCS99 00843 S810-DELETE. DTSCS99 00844 SET L810-DELETE-88 TO TRUE. DTSCS99 00845 GO TO S810-IO. DTSCS99 00846 SKIP1 DTSCS99 00847 S810-IO. DTSCS99 00848 SKIP1 DTSCS99 00849 EXEC CICS LINK DTSCS99 00850 PROGRAM ('DTSCU810') CL**2 00851 COMMAREA (L810-COMM-AREA) DTSCS99 00852 END-EXEC. DTSCS99 00853 SKIP1 DTSCS99 00854 IF L810-FILE-CLOSED-88 DTSCS99 00855 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS99 00856 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS99 00857 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS99 00858 GO TO MAINLINE-EXIT. DTSCS99 00859 S810-EXIT. DTSCS99 00860 EXIT. DTSCS99 00861 EJECT DTSCS99 00862 S825-WRITE. DTSCS99 00863 SET L825-WRITE-88 TO TRUE. DTSCS99 00864 GO TO S825-O. DTSCS99 00865 SKIP1 DTSCS99 00866 S825-O. DTSCS99 00867 SKIP1 DTSCS99 00868 EXEC CICS LINK DTSCS99 00869 PROGRAM ('DTSCU825') CL**2 00870 COMMAREA (L825-COMM-AREA) DTSCS99 00871 END-EXEC. DTSCS99 00872 SKIP1 DTSCS99 00873 IF L825-FILE-CLOSED-88 DTSCS99 00874 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS99 00875 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS99 00876 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS99 00877 GO TO MAINLINE-EXIT. DTSCS99 00878 S825-EXIT. DTSCS99 00879 EXIT. DTSCS99 00880 EJECT DTSCS99 00881 S851-SCREEN-PROCESSING. DTSCS99 00882 EXEC CICS LINK DTSCS99 00883 PROGRAM ('DTSCU851') CL**2 00884 COMMAREA (L851-COMM-AREA) DTSCS99 00885 END-EXEC. DTSCS99 00886 S851-EXIT. DTSCS99 00887 EXIT. DTSCS99 00888 SKIP3 DTSCS99 00889 S899-ABEND. DTSCS99 00890 EXEC CICS ABEND DTSCS99 00891 ABCODE(WRK-ABEND-CD) DTSCS99 00892 END-EXEC. DTSCS99 00893 S899-EXIT. DTSCS99 00894 EXIT. DTSCS99 00895 /*****************************************************************DTSCS99 00896 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS99 00897 ******************************************************************DTSCS99 00898 SKIP1 DTSCS99 00899 S1000-SCREEN-EDITS. DTSCS99 00900 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS99 00901 SKIP1 DTSCS99 00902 IF LCCM-MSG DTSCS99 00903 GO TO S1000-EXIT. DTSCS99 00904 SKIP1 DTSCS99 00905 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS99 00906 SKIP1 DTSCS99 00907 IF LCCM-MSG DTSCS99 00908 GO TO S1000-EXIT. DTSCS99 00909 SKIP1 DTSCS99 00910 PERFORM S1200-UPDATE-IND THRU S1200-EXIT. DTSCS99 00911 S1000-EXIT. DTSCS99 00912 EXIT. DTSCS99 00913 SKIP3 DTSCS99 00914 S1001-EDIT-KEY. DTSCS99 00915 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS99 00916 S1001-EXIT. DTSCS99 00917 EXIT. DTSCS99 00918 EJECT DTSCS99 00919 S1100-EMP-NO. DTSCS99 00920 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS99 00921 PERFORM S018-EMP-NO THRU S018-EXIT. DTSCS99 00922 IF L018-NO-ENTRY DTSCS99 00923 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS99 00924 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99 00925 ELSE DTSCS99 00926 IF L018-NOT-VALID DTSCS99 00927 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS99 00928 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99 00929 ELSE DTSCS99 00930 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS99 00931 S1100-EXIT. DTSCS99 00932 EXIT. DTSCS99 00933 SKIP3 DTSCS99 00934 S1190-READ-MPRF. DTSCS99 00935 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS99 00936 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS99 00937 SET MPRF-PRF-88 TO TRUE. DTSCS99 00938 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS99 00939 PERFORM S810-READ THRU S810-EXIT. DTSCS99 00940 IF L810-NO-REC-88 DTSCS99 00941 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS99 00942 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS99 00943 ELSE DTSCS99 00944 SET WRK-MPRF-YES-88 TO TRUE DTSCS99 00945 MOVE MSKL-REC TO MPRF-REC. DTSCS99 00946 S1190-EXIT. DTSCS99 00947 EXIT. DTSCS99 00948 SKIP3 DTSCS99 00949 S1199-ERROR. DTSCS99 00950 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS99 00951 MAP-EMP-NO-2-A. DTSCS99 00952 IF LCCM-NO-MSG DTSCS99 00953 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS99 00954 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS99 00955 SET CURSOR-SET-YES TO TRUE. DTSCS99 00956 S1199-EXIT. DTSCS99 00957 EXIT. DTSCS99 00958 EJECT DTSCS99 00959 S1200-UPDATE-IND. DTSCS99 00960 IF MAP-UPDATE-IND = SPACES OR LOW-VALUES DTSCS99 00961 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS99 00962 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS99 00963 ELSE DTSCS99 00964 IF MAP-UPDATE-IND = 'N' OR 'Y' DTSCS99 00965 NEXT SENTENCE DTSCS99 00966 ELSE DTSCS99 00967 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS99 00968 PERFORM S1299-ERROR THRU S1299-EXIT. DTSCS99 00969 S1200-EXIT. DTSCS99 00970 EXIT. DTSCS99 00971 SKIP3 DTSCS99 00972 S1299-ERROR. DTSCS99 00973 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-UPDATE-IND-A. DTSCS99 00974 IF LCCM-NO-MSG DTSCS99 00975 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS99 00976 MOVE CATB-CURSOR TO MAP-UPDATE-IND-L DTSCS99 00977 SET CURSOR-SET-YES TO TRUE. DTSCS99 00978 S1299-EXIT. DTSCS99 00979 EXIT. DTSCS99 00980 /*****************************************************************DTSCS99 00981 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS99 00982 ******************************************************************DTSCS99 00983 S5100-SET-LOCK-ATTRB. DTSCS99 00984 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS99 00985 WRK-ATB-NUM. DTSCS99 00986 SKIP1 DTSCS99 00987 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS99 00988 SKIP1 DTSCS99 00989 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS99 00990 MAP-EMP-NO-2-A DTSCS99 00991 MAP-GOTO-A. DTSCS99 00992 S5100-EXIT. DTSCS99 00993 EXIT. DTSCS99 00994 SKIP3 DTSCS99 00995 ******************************************************************DTSCS99 00996 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS99 00997 ******************************************************************DTSCS99 00998 S5200-SET-UPDATE-ATTRB. DTSCS99 00999 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS99 01000 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS99 01001 SKIP1 DTSCS99 01002 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS99 01003 S5200-EXIT. DTSCS99 01004 EXIT. DTSCS99 01005 SKIP3 DTSCS99 01006 ******************************************************************DTSCS99 01007 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS99 01008 ******************************************************************DTSCS99 01009 S5300-SET-INQ-ATTRB. DTSCS99 01010 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS99 01011 WRK-ATB-NUM. DTSCS99 01012 SKIP1 DTSCS99 01013 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS99 01014 S5300-EXIT. DTSCS99 01015 EXIT. DTSCS99 01016 SKIP3 DTSCS99 01017 S5900-SET-ATTRB. DTSCS99 01018 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS99 01019 MAP-EMP-NO-2-A. DTSCS99 01020 SKIP1 DTSCS99 01021 SKIP1 DTSCS99 01022 MOVE WRK-ATB-AN TO MAP-UPDATE-IND-A. DTSCS99 01023 SKIP1 DTSCS99 01024 MOVE CATB-ASKIP-BRT-MDTON DTSCS99 01025 TO MAP-PRIMARY-NAME-A CL**2 01026 MAP-UPDATE-TASK-ID-A DTSCS99 01027 MAP-UPDATE-OP-ID-A DTSCS99 01028 MAP-UPDATE-TERMID-A DTSCS99 01029 MAP-UPDATE-NETNAME-A CL**2 01030 MAP-UPDATE-SCR-ID-A DTSCS99 01031 MAP-UPDATE-FUNCTION-A DTSCS99 01032 MAP-UPDATE-START-DATE-A DTSCS99 01033 MAP-UPDATE-START-TIME-A. DTSCS99 01034 SKIP1 DTSCS99 01035 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS99 01036 S5900-EXIT. DTSCS99 01037 EXIT. DTSCS99 01038 /*****************************************************************DTSCS99 01039 * MAP ROUTINES *DTSCS99 01040 ******************************************************************DTSCS99 01041 S9100-RECEIVE. DTSCS99 01042 SET L851-RECEIVE-88 TO TRUE. DTSCS99 01043 SKIP1 DTSCS99 01044 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS99 01045 SKIP1 DTSCS99 01046 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS99 01047 SKIP1 DTSCS99 01048 MOVE L851-AID TO LCCM-AID. DTSCS99 01049 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS99 01050 S9100-EXIT. DTSCS99 01051 EXIT. DTSCS99 01052 SKIP3 DTSCS99 01053 S9200-SEND-DATAONLY. DTSCS99 01054 MOVE LOW-VALUES TO MAP-AREA. DTSCS99 01055 SKIP1 DTSCS99 01056 IF LCCM-NO-MSG DTSCS99 01057 NEXT SENTENCE DTSCS99 01058 ELSE DTSCS99 01059 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS99 01060 SKIP1 DTSCS99 01061 IF CURSOR-SET-GOTO DTSCS99 01062 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS99 01063 ELSE DTSCS99 01064 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS99 01065 SKIP1 DTSCS99 01066 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS99 01067 SKIP1 DTSCS99 01068 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS99 01069 SKIP1 DTSCS99 01070 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS99 01071 S9200-EXIT. DTSCS99 01072 EXIT. DTSCS99 01073 SKIP3 DTSCS99 01074 S9300-SEND-MAP. DTSCS99 01075 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS99 01076 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS99 01077 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS99 01078 SKIP1 DTSCS99 01079 IF SCR-ACCESS-UPDATE DTSCS99 01080 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS99 01081 ELSE DTSCS99 01082 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS99 01083 SKIP1 DTSCS99 01084 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS99 01085 SKIP1 DTSCS99 01086 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS99 01087 SKIP1 DTSCS99 01088 IF CURSOR-SET-NO DTSCS99 01089 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS99 01090 SKIP1 DTSCS99 01091 SET L851-SEND-88 TO TRUE. DTSCS99 01092 SKIP1 DTSCS99 01093 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS99 01094 SKIP1 DTSCS99 01095 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS99 01096 S9300-EXIT. DTSCS99 01097 EXIT. DTSCS99 01098 SKIP3 DTSCS99 01099 S9310-UPDATE-FKEYS. DTSCS99 01100 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS99 01101 SKIP1 DTSCS99 01102 IF LCCM-SCR-CLEAR DTSCS99 01103 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS99 01104 ELSE DTSCS99 01105 IF LCCM-SCR-UPDATE-LOCKED DTSCS99 01106 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS99 01107 ELSE DTSCS99 01108 NEXT SENTENCE. DTSCS99 01109 S9310-EXIT. DTSCS99 01110 EXIT. DTSCS99 01111 SKIP3 DTSCS99 01112 S9320-INQUIRY-FKEYS. DTSCS99 01113 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS99 01114 S9320-EXIT. DTSCS99 01115 EXIT. DTSCS99 01116 SKIP3 DTSCS99 01117 S9330-DSCR-FIELDS. DTSCS99 01118 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. CL**3 01119 IF WRK-MPRF-YES-88 DTSCS99 01120 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. CL**2 01121 S9330-EXIT. DTSCS99 01122 EXIT. DTSCS99 01123 SKIP3 DTSCS99 01124 S9900-PREPARE-SEND. DTSCS99 01125 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS99 01126 LCCM-SCR-ID. DTSCS99 01127 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS99 01128 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS99 01129 S9900-EXIT. DTSCS99 01130 EXIT. DTSCS99