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