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