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