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

2013 lines
157 KiB
COBOL
Raw Permalink Blame History

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