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