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