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