00001 IDENTIFICATION DIVISION. 02/10/12 00002 PROGRAM-ID. DTSCSED. DTSCSED 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV010 00004 DATE-WRITTEN. MAY 1994. DTSCSED 00005 DATE-COMPILED. DTSCSED 00006 SKIP3 DTSCSED 00007 ***** DTSCSED 00008 * DTSCSED 00009 * FUNCTION: TEXT EDIT SCREEN PROCESSOR. DTSCSED 00010 * DTSCSED 00011 * DTSCSED 00012 * MODIFICATION LOG: DTSCSED 00013 * DTSCSED 00014 * 11/25/98 initial development. copied from maccsed DTSCSED 00015 * WORK ORDER: PROGRAMMER: zl1 DTSCSED 00016 * DTSCSED 00017 * DTSCSED 00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSED 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSED 00020 * WORK ORDER: PROGRAMMER: XXX DTSCSED 00021 * DTSCSED 00022 * DTSCSED 00023 * DESCRIPTION: DTSCSED 00024 * DTSCSED 00025 * CLEAR: DTSCSED 00026 * DTSCSED 00027 * REDISPLAY PAGE OF INFORMATION. DTSCSED 00028 * DTSCSED 00029 * DTSCSED 00030 * JUMP: DTSCSED 00031 * DTSCSED 00032 * F03 COPY TS QUEUE '1' TO TS QUEUE LSED-QUEUE-NAME DTSCSED 00033 * AND JUMP TO LSED-HOLD-SCR-ID. DTSCSED 00034 * DTSCSED 00035 * F04 NOT VALID. DTSCSED 00036 * DTSCSED 00037 * GO TO DOES NOT EXIST ON THIS SCREEN. DTSCSED 00038 * DTSCSED 00039 * DTSCSED 00040 * INQUIRY: DTSCSED 00041 * DTSCSED 00042 * CONTROL FIELD(S): NONE. DTSCSED 00043 * DTSCSED 00044 * JUMP IN: TEXT TO BE EDITED IS IN TS Q LSED-QUEUE-NAME. DTSCSED 00045 * DTSCSED 00046 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCSED 00047 * DTSCSED 00048 * PAGE INITIALLY DISPLAYED: FIRST. DTSCSED 00049 * DTSCSED 00050 * DTSCSED 00051 * JUMP OUT: DTSCSED 00052 * DTSCSED 00053 * DTSCSED 00054 * UPDATE: DTSCSED 00055 * DTSCSED 00056 * LINE EDIT COMMANDS: DTSCSED 00057 * DTSCSED 00058 * A AFTER INSERT TEXT FROM BUFFER AFTER THIS LINE. DTSCSED 00059 * B BEFORE INSERT TEXT FROM BUFFER BEFORE THIS LINE. DTSCSED 00060 * CNN COPY CLEAR THE BUFFER AND COPY NN LINES OF TEXT TO DTSCSED 00061 * THE BUFFER - DEFAULT NN VALUE IS 1. DTSCSED 00062 * DNN DELETE DELETE NN LINES OF TEXT DTSCSED 00063 * - DEFAULT NN VALUE IS 1. DTSCSED 00064 * INN INSERT INSERT NN BLANK LINES DTSCSED 00065 * - DEFAULT NN VALUE IS 1. DTSCSED 00066 * KNN KOPY APPEND NN LINES OF TEXT TO THE BUFFER DTSCSED 00067 * - DEFAULT NN VALUE IS 1. DTSCSED 00068 * RNN REPEAT REPEAT LINE NN TIMES DTSCSED 00069 * - DEFAULT NN VALUE IS 1. DTSCSED 00070 * / TOP MAKE THIS THE FIRST LINE ON THE SCREEN. DTSCSED 00071 * DTSCSED 00072 * DTSCSED 00073 * RECORDS READ: DTSCSED 00074 * DTSCSED 00075 * MASTER: DTSCSED 00076 * DTSCSED 00077 * NONE. DTSCSED 00078 * DTSCSED 00079 * DTSCSED 00080 * ALTERNATE INDEX: DTSCSED 00081 * DTSCSED 00082 * NONE. DTSCSED 00083 * DTSCSED 00084 * DTSCSED 00085 * REFERENCE: DTSCSED 00086 * DTSCSED 00087 * NONE. DTSCSED 00088 * DTSCSED 00089 * DTSCSED 00090 * ACCOUNTING TRANSACTION COLLECTION: DTSCSED 00091 * DTSCSED 00092 * NONE. DTSCSED 00093 * DTSCSED 00094 * DTSCSED 00095 * RECORDS UPDATED: DTSCSED 00096 * DTSCSED 00097 * MASTER: DTSCSED 00098 * DTSCSED 00099 * NONE. DTSCSED 00100 * DTSCSED 00101 * DTSCSED 00102 * REFERENCE: DTSCSED 00103 * DTSCSED 00104 * NONE. DTSCSED 00105 * DTSCSED 00106 * DTSCSED 00107 * ACCOUNTING TRANSACTION COLLECTION: DTSCSED 00108 * DTSCSED 00109 * NONE. DTSCSED 00110 * DTSCSED 00111 * DTSCSED 00112 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCSED 00113 * DTSCSED 00114 * NONE. DTSCSED 00115 * DTSCSED 00116 * DTSCSED 00117 * TEMPORARY STORAGE USAGE: DTSCSED 00118 * DTSCSED 00119 * LSED-QUEUE-NAME DTSCSED 00120 * DTSCSED 00121 * TEXT PASSED TO DTSCSED. DTSCSED 00122 * TEXT RETURNED FROM DTSCSED. DTSCSED 00123 * DTSCSED 00124 * 2 DTSCSED 00125 * DTSCSED 00126 * TEXT LINE STORAGE DURING EDITING. DTSCSED 00127 * DTSCSED 00128 * 3 DTSCSED 00129 * DTSCSED 00130 * COPY BUFFER. DTSCSED 00131 * DTSCSED 00132 * DTSCSED 00133 * MODULES LINKED TO: DTSCSED 00134 * DTSCSED 00135 * DTSCU829 TEMPORARY STORAGE INPUT/OUTPUT. DTSCSED 00136 * DTSCSED 00137 ***** DTSCSED 00138 ENVIRONMENT DIVISION. DTSCSED 00139 DTSCSED 00140 DATA DIVISION. DTSCSED 00141 DTSCSED 00142 WORKING-STORAGE SECTION. DTSCSED 001425 77 PAN-VALET PICTURE X(24) VALUE '010DTSCSED 02/10/12'. DTSCSED 00143 DTSCSED 00144 01 WRK-AREA. DTSCSED 00145 05 WRK-ABEND-CD PIC X(04) VALUE 'SED '. DTSCSED 00146 DTSCSED 00147 05 WRK-SCR-ID. DTSCSED 00148 10 WRK-SCR-ID-X PIC X(02) VALUE 'ED'. DTSCSED 00149 DTSCSED 00150 05 WRK-LIT-L pic x(01) value 'L'. DTSCSED 00151 DTSCSED 00152 05 WRK-LIT-U pic x(01) value 'U'. DTSCSED 00153 DTSCSED 00154 *****05 SCR-ACCESS-IND PIC X(01). DTSCSED 00155 ***** 88 SCR-ACCESS-INQ VALUE '1'. DTSCSED 00156 ***** 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCSED 00157 DTSCSED 00158 05 CURSOR-SET-IND PIC X(01). DTSCSED 00159 88 CURSOR-SET-YES VALUE 'Y'. DTSCSED 00160 88 CURSOR-SET-NO VALUE 'N'. DTSCSED 00161 DTSCSED 00162 05 REQ-IND PIC X(01). DTSCSED 00163 88 REQ-ERROR VALUE 'O'. DTSCSED 00164 88 REQ-JUMP VALUE 'J'. DTSCSED 00165 88 REQ-UPDATE VALUE 'U'. DTSCSED 00166 88 REQ-INQUIRE VALUE 'I'. DTSCSED 00167 88 REQ-CLEAR VALUE 'C'. DTSCSED 00168 88 REQ-EDIT VALUE 'E'. DTSCSED 00169 DTSCSED 00170 05 RESP-IND PIC X(01). DTSCSED 00171 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCSED 00172 88 RESP-SEND-MAP VALUE 'M'. DTSCSED 00173 88 RESP-JUMP VALUE 'J'. DTSCSED 00174 DTSCSED 00175 05 WRK-MSG-AREA PIC X(64). DTSCSED 00176 DTSCSED 00177 05 WRK-ATB-AN-BRT PIC X(01). DTSCSED 00178 05 WRK-ATB-AN-NORM PIC X(01). DTSCSED 00179 05 WRK-ATB-NUM PIC X(01). DTSCSED 00180 DTSCSED 00181 05 INQUIRY-CONTROL-AREA. DTSCSED 00182 ***** 10 LAST-REC-NUM PIC S9(08) COMP. DTSCSED 00183 ***** 10 WS-REC-NUM PIC S9(08) COMP. DTSCSED 00184 ***** DTSCSED 00185 ***** 10 LAST-REC-KEY-AREA PIC X(16). DTSCSED 00186 ***** 10 SCR-REC-KEY-AREA PIC X(96). DTSCSED 00187 DTSCSED 00188 10 WS-REC-FOUND-IND PIC X(01). DTSCSED 00189 DTSCSED 00190 10 HOLD-CMND PIC X(01). DTSCSED 00191 DTSCSED 00192 10 WRK-OCC PIC S9(04) COMP. DTSCSED 00193 DTSCSED 00194 10 WRK-OCC2 PIC S9(04) COMP. DTSCSED 00195 DTSCSED 00196 10 TBL-OCC PIC S9(04) COMP. DTSCSED 00197 DTSCSED 00198 10 SCR-OCC PIC S9(04) COMP. DTSCSED 00199 DTSCSED 00200 10 BUF-OCC PIC S9(04) COMP. DTSCSED 00201 DTSCSED 00202 10 CMD-OCC PIC S9(04) COMP. DTSCSED 00203 DTSCSED 00204 10 SHIFT-OCC-FROM PIC S9(04) COMP. DTSCSED 00205 DTSCSED 00206 10 SHIFT-OCC-TO PIC S9(04) COMP. DTSCSED 00207 DTSCSED 00208 10 WRK-CMND-LINE-CTR PIC S9(04) COMP. DTSCSED 00209 DTSCSED 00210 10 WRK-NEXT-OCC PIC S9(04) COMP. DTSCSED 00211 DTSCSED 00212 10 WRK-CURR-LINE PIC S9(04) COMP. DTSCSED 00213 DTSCSED 00214 10 WRK-LAST-LINE PIC S9(04) COMP. DTSCSED 00215 DTSCSED 00216 10 WRK-NON-BLANK-LINE PIC S9(04) COMP. DTSCSED 00217 DTSCSED 00218 10 WRK-LINES-CNT PIC S9(04) COMP. DTSCSED 00219 DTSCSED 00220 10 WRK-BUFFER-ITEM PIC S9(04) COMP. DTSCSED 00221 DTSCSED 00222 10 WRK-BUFFER-CTR PIC S9(04) COMP. DTSCSED 00223 DTSCSED 00224 10 WRK-TABLE-MAX-LINES PIC S9(04) COMP. DTSCSED 00225 DTSCSED 00226 10 TEST-TABLE-MAX-LINES PIC S9(04) COMP. DTSCSED 00227 DTSCSED 00228 10 TEST-BUFFER-ITEM PIC S9(04) COMP. DTSCSED 00229 DTSCSED 00230 10 TEST-BUFFER-ITEM-ADDED PIC S9(04) COMP. DTSCSED 00231 DTSCSED 00232 10 WRK-AFTER-BEFORE-CTR PIC S9(04) COMP. DTSCSED 00233 DTSCSED 00234 10 LIT-TABLE-MAX-LINES PIC S9(04) COMP VALUE +800. DTSCSED 00235 DTSCSED 00236 10 LIT-LINES-PER-PAGE PIC S9(04) COMP VALUE +18. DTSCSED 00237 DTSCSED 00238 10 LIT-Q-MAX-LINES PIC S9(04) COMP VALUE +16. DTSCSED 00239 DTSCSED 00240 10 LIT-CMND-AREA PIC X(04) VALUE QUOTES. DTSCSED 00241 DTSCSED 00242 DTSCSED 00243 10 WRK-EDIT-CMND-ERROR-IND PIC X(01). DTSCSED 00244 88 WRK-EDIT-CMND-ERROR-YES VALUE 'Y'. DTSCSED 00245 88 WRK-EDIT-CMND-ERROR-NO VALUE 'N'. DTSCSED 00246 DTSCSED 00247 10 WRK-EDIT-CMND-IND PIC X(01). DTSCSED 00248 88 WRK-EDIT-CMND-FOUND-YES VALUE 'Y'. DTSCSED 00249 88 WRK-EDIT-CMND-FOUND-NO VALUE 'N'. DTSCSED 00250 DTSCSED 00251 10 WRK-CMND PIC X. DTSCSED 00252 88 WRK-COPY-YES VALUE 'C' 'c'. DTSCSED 00253 88 WRK-KOPY-YES VALUE 'K' 'k'. DTSCSED 00254 88 WRK-AFTER-YES VALUE 'A' 'a'. DTSCSED 00255 88 WRK-BEFORE-YES VALUE 'B' 'b'. DTSCSED 00256 88 WRK-DELETE-YES VALUE 'D' 'd'. DTSCSED 00257 88 WRK-INSERT-YES VALUE 'I' 'i'. DTSCSED 00258 88 WRK-REPEAT-YES VALUE 'R' 'r'. DTSCSED 00259 88 WRK-CURRENT-LINE-YES VALUE '/' '\'. DTSCSED 00260 88 WRK-CMND-VALID VALUE 'C' 'K' 'A' 'B' 'D' 'I' 'R' DTSCSED 00261 '/' '\' 'c' 'k' 'a' 'b' 'd' 'i' 'r'.DTSCSED 00262 DTSCSED 00263 10 WRK-CMND-TABLE. DTSCSED 00264 15 WRK-CMND-TBL OCCURS 18 TIMES. DTSCSED 00265 20 WRK-TBL-CMND PIC X. DTSCSED 00266 20 WRK-TBL-LINE-CTR PIC S9(04) COMP. DTSCSED 00267 20 WRK-TBL-LINE PIC S9(04) COMP. DTSCSED 00268 EJECT DTSCSED 00269 01 WRK-EDIT-MODULE-INFO. DTSCSED 00270 ++INCLUDE DTSILSED DTSCSED 00271 EJECT DTSCSED 00272 * SCREEN SPECIFIC ERROR MESSAGES DTSCSED 00273 * DTSCSED 00274 01 MSG-LITERALS. DTSCSED 00275 DTSCSED 00276 05 MSG-EED1-AREA. DTSCSED 00277 10 FILLER PIC X(04) VALUE 'EED1'. DTSCSED 00278 10 FILLER PIC X(30) DTSCSED 00279 VALUE 'INVALID SYNTAX. Valid command'. DTSCSED 00280 10 FILLER PIC X(30) DTSCSED 00281 VALUE ' syntax => Xnnn '. DTSCSED 00282 DTSCSED 00283 05 MSG-EED2-AREA. DTSCSED 00284 10 FILLER PIC X(04) VALUE 'EED2'. DTSCSED 00285 10 FILLER PIC X(30) DTSCSED 00286 VALUE 'INVALID COMMAND. USE Rnn A B '. DTSCSED 00287 10 FILLER PIC X(30) DTSCSED 00288 VALUE 'Cnn Knn Dnn Inn. '. DTSCSED 00289 DTSCSED 00290 05 MSG-EED3-AREA. DTSCSED 00291 10 FILLER PIC X(04) VALUE 'EED3'. DTSCSED 00292 10 FILLER PIC X(30) DTSCSED 00293 VALUE 'SOME COMMANDS NOT PROCESSED. E'. DTSCSED 00294 10 FILLER PIC X(30) DTSCSED 00295 VALUE 'DITOR MAX LINES REACHED. '. DTSCSED 00296 DTSCSED 00297 05 MSG-EED4-AREA. DTSCSED 00298 10 FILLER PIC X(04) VALUE 'EED4'. DTSCSED 00299 10 FILLER PIC X(30) DTSCSED 00300 VALUE 'PROCESSING OF COMMANDS WOULD R'. DTSCSED 00301 10 FILLER PIC X(30) DTSCSED 00302 VALUE 'ESULT IN LOSS OF DATA. '. DTSCSED 00303 EJECT DTSCSED 00304 01 L805-COMM-AREA. DTSCSED 00305 ++INCLUDE DTSIL805 DTSCSED 00306 EJECT DTSCSED 00307 01 L829-COMM-AREA. DTSCSED 00308 05 L829-CONTROL-BLOCK. DTSCSED 00309 ++INCLUDE DTSIL829 DTSCSED 00310 DTSCSED 00311 05 L829-REC. DTSCSED 00312 ++INCLUDE DTSIXEDS DTSCSED 00313 EJECT DTSCSED 00314 01 L851-COMM-AREA. DTSCSED 00315 ++INCLUDE DTSIL851 DTSCSED 00316 DTSCSED 00317 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCSED 00318 ++INCLUDE DTSISED DTSCSED 00319 EJECT DTSCSED 00320 01 CATB-LITERALS. DTSCSED 00321 ++INCLUDE DTSICATB DTSCSED 00322 DTSCSED 00323 01 CFKD-LITERALS. DTSCSED 00324 ++INCLUDE DTSICFKD DTSCSED 00325 DTSCSED 00326 01 CECD-LITERALS. DTSCSED 00327 ++INCLUDE DTSICECD DTSCSED 00328 DTSCSED 00329 01 CPCD-LITERALS. DTSCSED 00330 ++INCLUDE DTSICPCD DTSCSED 00331 EJECT DTSCSED 00332 01 WRK-LINE-STORAGE. DTSCSED 00333 05 WRK-TEXT-LINE OCCURS 800 TIMES PIC X(72). DTSCSED 00334 EJECT DTSCSED 00335 LINKAGE SECTION. DTSCSED 00336 DTSCSED 00337 01 DFHCOMMAREA. DTSCSED 00338 ++INCLUDE DTSILCCM DTSCSED 00339 EJECT DTSCSED 00340 ******************************************************************DTSCSED 00341 * *DTSCSED 00342 ******************************************************************DTSCSED 00343 DTSCSED 00344 PROCEDURE DIVISION. DTSCSED 00345 DTSCSED 00346 * EVERY TIME THS MODULE IS ENTERED THERE SHOULD BE INFORMATION DTSCSED 00347 * IN LCCM-SCRED-HOLD-AREA WHICH IS THEN USED TO READ THE STORAGE DTSCSED 00348 * QUEUE TO LOAD ALL LINES OF TEXT INTO WORKING STORAGE. DTSCSED 00349 DTSCSED 00350 MOVE LCCM-SCRED-HOLD-AREA TO WRK-EDIT-MODULE-INFO DTSCSED 00351 DTSCSED 00352 MOVE XEDS-LENGTH TO L829-REC-LENGTH. DTSCSED 00353 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCSED 00354 MOVE LSED-QUEUE-NAME TO L829-QUEUE-NAME. DTSCSED 00355 DTSCSED 00356 * COMPUTE L829-COMM-AREA-LENGTH DTSCSED 00357 * = L829-CONTROL-BLOCK-LENGTH + L829-REC-LENGTH. DTSCSED 00358 DTSCSED 00359 PERFORM P8000-LOAD-TABLE-FROM-Q THRU P8000-EXIT. DTSCSED 00360 DTSCSED 00361 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCSED 00362 DTSCSED 00363 MOVE LOW-VALUES TO MAP-AREA. DTSCSED 00364 DTSCSED 00365 SET CURSOR-SET-NO TO TRUE. DTSCSED 00366 DTSCSED 00367 MOVE SPACE TO REQ-IND. DTSCSED 00368 DTSCSED 00369 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCSED 00370 DTSCSED 00371 *----------------------------------------------------- DTSCSED 00372 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCSED 00373 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCSED 00374 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCSED 00375 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCSED 00376 * DTSCSED 00377 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCSED 00378 * PROCESSED. DTSCSED 00379 * DTSCSED 00380 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCSED 00381 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCSED 00382 * WORK STATION OPERATOR. DTSCSED 00383 *----------------------------------------------------- DTSCSED 00384 DTSCSED 00385 MOVE SPACE TO RESP-IND. DTSCSED 00386 DTSCSED 00387 IF REQ-ERROR DTSCSED 00388 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCSED 00389 ELSE DTSCSED 00390 IF REQ-JUMP DTSCSED 00391 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCSED 00392 ELSE DTSCSED 00393 IF REQ-CLEAR DTSCSED 00394 SET LCCM-ENTER-88 TO TRUE DTSCSED 00395 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSED 00396 ELSE DTSCSED 00397 IF REQ-INQUIRE DTSCSED 00398 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSED 00399 ELSE DTSCSED 00400 IF REQ-UPDATE DTSCSED 00401 PERFORM P7000-REQUEST-UPDATE THRU P7000-EXIT DTSCSED 00402 IF LCCM-NO-MSG DTSCSED 00403 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSED 00404 END-IF DTSCSED 00405 ELSE DTSCSED 00406 GO TO S899-ABEND. DTSCSED 00407 DTSCSED 00408 *----------------------------------------------------- DTSCSED 00409 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCSED 00410 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCSED 00411 *----------------------------------------------------- DTSCSED 00412 IF RESP-SEND-MAP DTSCSED 00413 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCSED 00414 SET LCCM-END-TASK-88 TO TRUE DTSCSED 00415 ELSE DTSCSED 00416 IF RESP-SEND-MSGONLY DTSCSED 00417 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSED 00418 SET LCCM-END-TASK-88 TO TRUE DTSCSED 00419 ELSE DTSCSED 00420 IF RESP-JUMP DTSCSED 00421 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSED 00422 ELSE DTSCSED 00423 GO TO S899-ABEND. DTSCSED 00424 DTSCSED 00425 DTSCSED 00426 MOVE XEDS-LENGTH TO L829-REC-LENGTH. DTSCSED 00427 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCSED 00428 MOVE LSED-QUEUE-NAME TO L829-QUEUE-NAME. DTSCSED 00429 DTSCSED 00430 * COMPUTE L829-COMM-AREA-LENGTH DTSCSED 00431 * = L829-CONTROL-BLOCK-LENGTH + L829-REC-LENGTH. DTSCSED 00432 DTSCSED 00433 PERFORM P8100-LOAD-Q-FROM-TABLE THRU P8100-EXIT. DTSCSED 00434 DTSCSED 00435 MOVE WRK-EDIT-MODULE-INFO TO LCCM-SCRED-HOLD-AREA. DTSCSED 00436 MAINLINE-EXIT. DTSCSED 00437 DTSCSED 00438 EXEC CICS DTSCSED 00439 RETURN DTSCSED 00440 END-EXEC. DTSCSED 00441 DTSCSED 00442 GOBACK. DTSCSED 00443 EJECT DTSCSED 00444 /*****************************************************************DTSCSED 00445 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCSED 00446 ******************************************************************DTSCSED 00447 P1000-ANALYZE-REQUEST. DTSCSED 00448 DTSCSED 00449 *----------------------------------------------------- DTSCSED 00450 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCSED 00451 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCSED 00452 * REPLACED WITH ENTER) DTSCSED 00453 * THE PAGE BEING VIEWED AT THE TIME THE EDIT REQUEST INVOKED DTSCSED 00454 * WILL BE DISPLAYED. DTSCSED 00455 *----------------------------------------------------- DTSCSED 00456 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCSED 00457 PERFORM P8910-INIT-BUFFER THRU P8910-EXIT DTSCSED 00458 PERFORM P8200-DELETE-BUFFER THRU P8200-EXIT DTSCSED 00459 SET LCCM-ENTER-88 TO TRUE DTSCSED 00460 SET REQ-INQUIRE TO TRUE DTSCSED 00461 MOVE +0 TO LSED-CURR-LINE DTSCSED 00462 LSED-BUFFER-ITEM DTSCSED 00463 PERFORM SUCTRAN-OFF THRU SUCTRAN-EXIT DTSCSED 00464 GO TO P1000-EXIT. DTSCSED 00465 DTSCSED 00466 *----------------------------------------------------- DTSCSED 00467 * MAP IS RECEIVED DTSCSED 00468 *----------------------------------------------------- DTSCSED 00469 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCSED 00470 DTSCSED 00471 *----------------------------------------------------- DTSCSED 00472 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCSED 00473 * WORK STATION DTSCSED 00474 *----------------------------------------------------- DTSCSED 00475 IF LCCM-CLEAR-88 DTSCSED 00476 SET REQ-CLEAR TO TRUE DTSCSED 00477 GO TO P1000-EXIT. DTSCSED 00478 DTSCSED 00479 *----------------------------------------------------- DTSCSED 00480 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCSED 00481 *----------------------------------------------------- DTSCSED 00482 IF LCCM-PA-88 DTSCSED 00483 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSED 00484 SET REQ-ERROR TO TRUE DTSCSED 00485 GO TO P1000-EXIT. DTSCSED 00486 DTSCSED 00487 *----------------------------------------------------- DTSCSED 00488 * TREAT F12 AS A CLEAR DTSCSED 00489 *----------------------------------------------------- DTSCSED 00490 IF LCCM-F12-88 DTSCSED 00491 MOVE LOW-VALUES TO MAP-AREA DTSCSED 00492 SET REQ-CLEAR TO TRUE DTSCSED 00493 GO TO P1000-EXIT. DTSCSED 00494 DTSCSED 00495 DTSCSED 00496 *----------------------------------------------------- DTSCSED 00497 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCSED 00498 *----------------------------------------------------- DTSCSED 00499 IF LCCM-F03-88 DTSCSED 00500 SET REQ-JUMP TO TRUE DTSCSED 00501 GO TO P1000-EXIT. DTSCSED 00502 DTSCSED 00503 *----------------------------------------------------- DTSCSED 00504 * IF CANCEL KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCSED 00505 *----------------------------------------------------- DTSCSED 00506 *****IF LCCM-F12-88 DTSCSED 00507 ***** SET REQ-JUMP TO TRUE DTSCSED 00508 ***** GO TO P1000-EXIT. DTSCSED 00509 DTSCSED 00510 *----------------------------------------------------- DTSCSED 00511 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCSED 00512 * OR F8), INDICATE INQUIRY REQUEST DTSCSED 00513 *----------------------------------------------------- DTSCSED 00514 IF LCCM-INQUIRY-88 DTSCSED 00515 SET REQ-UPDATE TO TRUE DTSCSED 00516 GO TO P1000-EXIT. DTSCSED 00517 DTSCSED 00518 *----------------------------------------------------- DTSCSED 00519 * ANY OTHER KEY IS INVALID DTSCSED 00520 *----------------------------------------------------- DTSCSED 00521 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCSED 00522 SET REQ-ERROR TO TRUE. DTSCSED 00523 P1000-EXIT. DTSCSED 00524 EXIT. DTSCSED 00525 DTSCSED 00526 /*****************************************************************DTSCSED 00527 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCSED 00528 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCSED 00529 ******************************************************************DTSCSED 00530 DTSCSED 00531 P2000-REQUEST-ERROR. DTSCSED 00532 IF LCCM-MSG DTSCSED 00533 SET RESP-SEND-MSGONLY TO TRUE DTSCSED 00534 ELSE DTSCSED 00535 GO TO S899-ABEND. DTSCSED 00536 P2000-EXIT. DTSCSED 00537 EXIT. DTSCSED 00538 /*****************************************************************DTSCSED 00539 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCSED 00540 ******************************************************************DTSCSED 00541 DTSCSED 00542 P3000-REQUEST-JUMP. DTSCSED 00543 *----------------------------------------------------- DTSCSED 00544 * MAKE ANY REQUESTED UPDATES DTSCSED 00545 *----------------------------------------------------- DTSCSED 00546 PERFORM P7000-REQUEST-UPDATE THRU P7000-EXIT. DTSCSED 00547 DTSCSED 00548 IF LCCM-NO-MSG DTSCSED 00549 NEXT SENTENCE DTSCSED 00550 ELSE DTSCSED 00551 GO TO P3000-EXIT. DTSCSED 00552 DTSCSED 00553 *----------------------------------------------------- DTSCSED 00554 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCSED 00555 *----------------------------------------------------- DTSCSED 00556 MOVE LSED-HOLD-SCR-ID TO LCCM-REQ-SCR-ID. DTSCSED 00557 DTSCSED 00558 SET LSED-OK-88 TO TRUE. DTSCSED 00559 DTSCSED 00560 PERFORM P8910-INIT-BUFFER THRU P8910-EXIT. DTSCSED 00561 DTSCSED 00562 PERFORM P8200-DELETE-BUFFER THRU P8200-EXIT. DTSCSED 00563 DTSCSED 00564 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCSED 00565 DTSCSED 00566 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCSED 00567 DTSCSED 00568 SET RESP-JUMP TO TRUE. DTSCSED 00569 DTSCSED 00570 PERFORM SUCTRAN-ON THRU SUCTRAN-EXIT. DTSCSED 00571 P3000-EXIT. DTSCSED 00572 EXIT. DTSCSED 00573 /*****************************************************************DTSCSED 00574 * CLEAR KEY WAS PRESSED *DTSCSED 00575 ******************************************************************DTSCSED 00576 DTSCSED 00577 *P4000-REQUEST-CLEAR. DTSCSED 00578 ***** DTSCSED 00579 ***** DTSCSED 00580 *****MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSED 00581 ***** DTSCSED 00582 *****SET LCCM-SCR-CLEAR TO TRUE. DTSCSED 00583 ***** DTSCSED 00584 *****PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCSED 00585 ***** DTSCSED 00586 *****SET RESP-SEND-MAP TO TRUE. DTSCSED 00587 *P4000-EXIT. DTSCSED 00588 *****EXIT. DTSCSED 00589 /*****************************************************************DTSCSED 00590 * INQUIRY WAS REQUESTED *DTSCSED 00591 ******************************************************************DTSCSED 00592 DTSCSED 00593 P6000-REQUEST-INQUIRE. DTSCSED 00594 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSED 00595 DTSCSED 00596 SET RESP-SEND-MAP TO TRUE. DTSCSED 00597 DTSCSED 00598 MOVE SPACES TO MAP-TEXT-AREA. DTSCSED 00599 DTSCSED 00600 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCSED 00601 DTSCSED 00602 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCSED 00603 IF LCCM-MSG DTSCSED 00604 GO TO P6000-EXIT. DTSCSED 00605 DTSCSED 00606 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCSED 00607 DTSCSED 00608 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSED 00609 DTSCSED 00610 P6000-EXIT. DTSCSED 00611 EXIT. DTSCSED 00612 EJECT DTSCSED 00613 P6100-LOCATE-REC. DTSCSED 00614 *------------------------------------------------------------ DTSCSED 00615 * DTSCSED 00616 *------------------------------------------------------------ DTSCSED 00617 IF LSED-CURR-LINE = 0 DTSCSED 00618 MOVE +1 TO LSED-CURR-LINE DTSCSED 00619 GO TO P6100-EXIT. DTSCSED 00620 DTSCSED 00621 IF LCCM-ENTER-88 DTSCSED 00622 GO TO P6100-EXIT. DTSCSED 00623 DTSCSED 00624 IF LCCM-F05-88 DTSCSED 00625 MOVE +1 TO LSED-CURR-LINE DTSCSED 00626 GO TO P6100-EXIT. DTSCSED 00627 DTSCSED 00628 IF LCCM-F06-88 DTSCSED 00629 MOVE WRK-TABLE-MAX-LINES TO LSED-CURR-LINE DTSCSED 00630 SUBTRACT LIT-LINES-PER-PAGE FROM LSED-CURR-LINE DTSCSED 00631 ADD 1 TO LSED-CURR-LINE DTSCSED 00632 IF LSED-CURR-LINE < +1 DTSCSED 00633 MOVE +1 TO LSED-CURR-LINE DTSCSED 00634 END-IF DTSCSED 00635 GO TO P6100-EXIT. DTSCSED 00636 DTSCSED 00637 IF LCCM-F07-88 DTSCSED 00638 IF LSED-CURR-LINE > LIT-LINES-PER-PAGE DTSCSED 00639 SUBTRACT LIT-LINES-PER-PAGE FROM LSED-CURR-LINE DTSCSED 00640 ELSE DTSCSED 00641 MOVE +1 TO LSED-CURR-LINE DTSCSED 00642 END-IF DTSCSED 00643 GO TO P6100-EXIT. DTSCSED 00644 DTSCSED 00645 IF LCCM-F08-88 DTSCSED 00646 ADD LIT-LINES-PER-PAGE TO LSED-CURR-LINE DTSCSED 00647 IF LSED-CURR-LINE > WRK-TABLE-MAX-LINES DTSCSED 00648 IF WRK-TABLE-MAX-LINES > +2 DTSCSED 00649 SUBTRACT 1 FROM WRK-TABLE-MAX-LINES DTSCSED 00650 GIVING LSED-CURR-LINE DTSCSED 00651 ELSE DTSCSED 00652 MOVE +1 TO LSED-CURR-LINE DTSCSED 00653 END-IF DTSCSED 00654 END-IF DTSCSED 00655 GO TO P6100-EXIT. DTSCSED 00656 DTSCSED 00657 GO TO S899-ABEND. DTSCSED 00658 P6100-EXIT. DTSCSED 00659 EXIT. DTSCSED 00660 DTSCSED 00661 /*****************************************************************DTSCSED 00662 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCSED 00663 ******************************************************************DTSCSED 00664 DTSCSED 00665 P6900-CONSTRUCT-SCREEN. DTSCSED 00666 PERFORM P6910-CLEAR-CMND-AREA THRU P6910-EXIT. DTSCSED 00667 DTSCSED 00668 MOVE LSED-CURR-LINE TO WRK-LAST-LINE. DTSCSED 00669 DTSCSED 00670 PERFORM DTSCSED 00671 VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00672 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00673 OR WRK-LAST-LINE > WRK-TABLE-MAX-LINES DTSCSED 00674 MOVE WRK-TEXT-LINE(WRK-LAST-LINE) TO MAP-TEXT(SCR-OCC) DTSCSED 00675 ADD +1 TO WRK-LAST-LINE DTSCSED 00676 END-PERFORM. DTSCSED 00677 DTSCSED 00678 IF LSED-CURR-LINE + LIT-LINES-PER-PAGE DTSCSED 00679 > LIT-TABLE-MAX-LINES DTSCSED 00680 PERFORM DTSCSED 00681 VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00682 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00683 IF (LSED-CURR-LINE + SCR-OCC - 1) DTSCSED 00684 > LIT-TABLE-MAX-LINES DTSCSED 00685 MOVE CATB-ASKIP-DRK-MDTOFF DTSCSED 00686 TO MAP-TEXT-A(SCR-OCC) DTSCSED 00687 MAP-LINE-ED-A(SCR-OCC) DTSCSED 00688 END-IF DTSCSED 00689 END-PERFORM. DTSCSED 00690 DTSCSED 00691 IF LSED-CURR-LINE = 1 DTSCSED 00692 MOVE ' TOP' TO MAP-TOP-POS DTSCSED 00693 ELSE DTSCSED 00694 MOVE LSED-CURR-LINE TO MAP-TOP-POS-N. DTSCSED 00695 DTSCSED 00696 IF (LSED-CURR-LINE + LIT-LINES-PER-PAGE - 1) DTSCSED 00697 LESS THAN WRK-TABLE-MAX-LINES DTSCSED 00698 MOVE SPACES TO MAP-BOT-POS DTSCSED 00699 ELSE DTSCSED 00700 MOVE ' BOT' TO MAP-BOT-POS. DTSCSED 00701 P6900-EXIT. DTSCSED 00702 EXIT. DTSCSED 00703 DTSCSED 00704 P6910-CLEAR-CMND-AREA. DTSCSED 00705 PERFORM DTSCSED 00706 VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00707 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00708 MOVE LIT-CMND-AREA TO MAP-LINE-ED(SCR-OCC) DTSCSED 00709 END-PERFORM. DTSCSED 00710 P6910-EXIT. EXIT. DTSCSED 00711 DTSCSED 00712 /*****************************************************************DTSCSED 00713 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCSED 00714 ******************************************************************DTSCSED 00715 * DTSCSED 00716 P7000-REQUEST-UPDATE. DTSCSED 00717 SET RESP-SEND-MAP TO TRUE. DTSCSED 00718 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCSED 00719 DTSCSED 00720 PERFORM S1300-SCREEN-TO-TABLE THRU S1300-EXIT. DTSCSED 00721 DTSCSED 00722 MOVE WRK-TABLE-MAX-LINES TO TEST-TABLE-MAX-LINES. DTSCSED 00723 MOVE LSED-BUFFER-ITEM TO TEST-BUFFER-ITEM. DTSCSED 00724 MOVE +0 TO TEST-BUFFER-ITEM-ADDED. DTSCSED 00725 MOVE +0 TO WRK-AFTER-BEFORE-CTR. DTSCSED 00726 DTSCSED 00727 MOVE SPACES TO WRK-CMND-TABLE. DTSCSED 00728 DTSCSED 00729 PERFORM S1200-EDIT-CMND THRU S1200-EXIT DTSCSED 00730 VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00731 UNTIL (SCR-OCC > LIT-LINES-PER-PAGE) DTSCSED 00732 OR ((LSED-CURR-LINE + SCR-OCC - 1) > LIT-TABLE-MAX-LINES).DTSCSED 00733 DTSCSED 00734 IF LCCM-MSG DTSCSED 00735 GO TO P7000-EXIT. DTSCSED 00736 DTSCSED 00737 COMPUTE TEST-TABLE-MAX-LINES DTSCSED 00738 = TEST-TABLE-MAX-LINES DTSCSED 00739 + ( WRK-AFTER-BEFORE-CTR DTSCSED 00740 * ( TEST-BUFFER-ITEM + TEST-BUFFER-ITEM-ADDED) DTSCSED 00741 ). DTSCSED 00742 DTSCSED 00743 IF TEST-TABLE-MAX-LINES > LIT-TABLE-MAX-LINES DTSCSED 00744 MOVE MSG-EED4-AREA TO WRK-MSG-AREA DTSCSED 00745 PERFORM P7010-CMND-ERROR THRU P7010-EXIT DTSCSED 00746 VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00747 UNTIL (SCR-OCC > LIT-LINES-PER-PAGE) DTSCSED 00748 OR DTSCSED 00749 ((LSED-CURR-LINE + SCR-OCC - 1) > LIT-TABLE-MAX-LINES) DTSCSED 00750 END-IF. DTSCSED 00751 DTSCSED 00752 IF LCCM-MSG DTSCSED 00753 GO TO P7000-EXIT DTSCSED 00754 END-IF. DTSCSED 00755 DTSCSED 00756 **** RANKING I FELT THAT IF THEY ENTERED MANY COMMANDS ON THE DTSCSED 00757 **** SCREEN THEN THIS IS THE ORDER I WOULD DO THEM DTSCSED 00758 DTSCSED 00759 PERFORM P7100-COPY THRU P7100-EXIT. DTSCSED 00760 DTSCSED 00761 PERFORM P7200-KOPY THRU P7200-EXIT. DTSCSED 00762 DTSCSED 00763 PERFORM P7300-AFTER THRU P7300-EXIT. DTSCSED 00764 DTSCSED 00765 PERFORM P7400-BEFORE THRU P7400-EXIT. DTSCSED 00766 DTSCSED 00767 PERFORM P7500-INSERT THRU P7500-EXIT. DTSCSED 00768 DTSCSED 00769 PERFORM P7600-REPEAT THRU P7600-EXIT. DTSCSED 00770 DTSCSED 00771 PERFORM P7700-DELETE THRU P7700-EXIT. DTSCSED 00772 DTSCSED 00773 PERFORM P7800-CURRENT-LINE THRU P7800-EXIT. DTSCSED 00774 P7000-EXIT. DTSCSED 00775 EXIT. DTSCSED 00776 DTSCSED 00777 P7010-CMND-ERROR. DTSCSED 00778 IF WRK-TBL-CMND (SCR-OCC) = SPACES DTSCSED 00779 NEXT SENTENCE DTSCSED 00780 ELSE DTSCSED 00781 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCSED 00782 P7010-EXIT. DTSCSED 00783 EXIT. DTSCSED 00784 DTSCSED 00785 P7100-COPY. DTSCSED 00786 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00787 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00788 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00789 DTSCSED 00790 IF WRK-COPY-YES DTSCSED 00791 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00792 PERFORM P8910-INIT-BUFFER THRU P8910-EXIT DTSCSED 00793 PERFORM P8200-DELETE-BUFFER THRU P8200-EXIT DTSCSED 00794 PERFORM P8910-INIT-BUFFER THRU P8910-EXIT DTSCSED 00795 PERFORM P7110-COPY-TO-BUFFER THRU P7110-EXIT DTSCSED 00796 VARYING BUF-OCC FROM 1 BY 1 DTSCSED 00797 UNTIL BUF-OCC > WRK-CMND-LINE-CTR DTSCSED 00798 END-IF DTSCSED 00799 DTSCSED 00800 END-PERFORM. DTSCSED 00801 P7100-EXIT. DTSCSED 00802 EXIT. DTSCSED 00803 DTSCSED 00804 * SET THE BUFFER ITEM UP DTSCSED 00805 * MOVE THE TEXT LINE FROM THE TABLE TO THE BUFFER AREA DTSCSED 00806 * WRITE IT AND POINT TO THE NEXT LINE DTSCSED 00807 P7110-COPY-TO-BUFFER. DTSCSED 00808 IF WRK-CURR-LINE > WRK-TABLE-MAX-LINES DTSCSED 00809 NEXT SENTENCE DTSCSED 00810 ELSE DTSCSED 00811 ADD +1 TO LSED-BUFFER-ITEM DTSCSED 00812 MOVE WRK-TEXT-LINE (WRK-CURR-LINE) TO XEDS-LINE(1) DTSCSED 00813 PERFORM P8300-TO-BUFFER THRU P8300-EXIT DTSCSED 00814 ADD +1 TO WRK-CURR-LINE. DTSCSED 00815 P7110-EXIT. DTSCSED 00816 EXIT. DTSCSED 00817 DTSCSED 00818 P7200-KOPY. DTSCSED 00819 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00820 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00821 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00822 DTSCSED 00823 IF WRK-KOPY-YES DTSCSED 00824 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00825 PERFORM P8910-INIT-BUFFER THRU P8910-EXIT DTSCSED 00826 PERFORM P7110-COPY-TO-BUFFER THRU P7110-EXIT DTSCSED 00827 VARYING BUF-OCC FROM 1 BY 1 DTSCSED 00828 UNTIL BUF-OCC > WRK-CMND-LINE-CTR DTSCSED 00829 END-IF DTSCSED 00830 END-PERFORM. DTSCSED 00831 P7200-EXIT. DTSCSED 00832 EXIT. DTSCSED 00833 DTSCSED 00834 P7300-AFTER. DTSCSED 00835 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00836 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00837 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00838 IF WRK-AFTER-YES DTSCSED 00839 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00840 IF LSED-BUFFER-ITEM > +0 DTSCSED 00841 MOVE LSED-BUFFER-ITEM TO WRK-CMND-LINE-CTR DTSCSED 00842 PERFORM P7310-INSERT THRU P7310-EXIT DTSCSED 00843 END-IF DTSCSED 00844 END-IF DTSCSED 00845 END-PERFORM. DTSCSED 00846 P7300-EXIT. DTSCSED 00847 EXIT. DTSCSED 00848 DTSCSED 00849 P7310-INSERT. DTSCSED 00850 PERFORM P8600-MAKE-ROOM THRU P8600-EXIT. DTSCSED 00851 DTSCSED 00852 MOVE +1 TO WRK-BUFFER-ITEM. DTSCSED 00853 DTSCSED 00854 PERFORM P8910-INIT-BUFFER THRU P8910-EXIT. DTSCSED 00855 DTSCSED 00856 PERFORM P8400-READ-BUFFER THRU P8400-EXIT. DTSCSED 00857 DTSCSED 00858 MOVE WRK-CURR-LINE TO WRK-OCC. DTSCSED 00859 DTSCSED 00860 ADD +1 TO WRK-OCC. DTSCSED 00861 DTSCSED 00862 PERFORM DTSCSED 00863 UNTIL (WRK-BUFFER-ITEM > LSED-BUFFER-ITEM) DTSCSED 00864 OR (NOT L829-OK-88) DTSCSED 00865 MOVE XEDS-LINE(1) TO WRK-TEXT-LINE(WRK-OCC) DTSCSED 00866 ADD 1 TO WRK-OCC DTSCSED 00867 ADD 1 TO WRK-BUFFER-ITEM DTSCSED 00868 PERFORM P8400-READ-BUFFER THRU P8400-EXIT DTSCSED 00869 END-PERFORM. DTSCSED 00870 P7310-EXIT. DTSCSED 00871 EXIT. DTSCSED 00872 DTSCSED 00873 P7400-BEFORE. DTSCSED 00874 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00875 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00876 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00877 DTSCSED 00878 IF WRK-BEFORE-YES DTSCSED 00879 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00880 IF LSED-BUFFER-ITEM > +0 DTSCSED 00881 SUBTRACT 1 FROM WRK-CURR-LINE DTSCSED 00882 MOVE LSED-BUFFER-ITEM TO WRK-CMND-LINE-CTR DTSCSED 00883 PERFORM P7310-INSERT THRU P7310-EXIT DTSCSED 00884 END-IF DTSCSED 00885 END-IF DTSCSED 00886 DTSCSED 00887 END-PERFORM. DTSCSED 00888 P7400-EXIT. DTSCSED 00889 EXIT. DTSCSED 00890 DTSCSED 00891 P7500-INSERT. DTSCSED 00892 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00893 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00894 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00895 DTSCSED 00896 IF WRK-INSERT-YES DTSCSED 00897 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00898 PERFORM P7510-INSERT THRU P7510-EXIT DTSCSED 00899 END-IF DTSCSED 00900 DTSCSED 00901 END-PERFORM. DTSCSED 00902 P7500-EXIT. DTSCSED 00903 EXIT. DTSCSED 00904 DTSCSED 00905 P7510-INSERT. DTSCSED 00906 PERFORM P8600-MAKE-ROOM THRU P8600-EXIT. DTSCSED 00907 COMPUTE WRK-NEXT-OCC = WRK-CURR-LINE + 1 DTSCSED 00908 PERFORM WRK-CMND-LINE-CTR TIMES DTSCSED 00909 MOVE SPACES DTSCSED 00910 TO WRK-TEXT-LINE(WRK-NEXT-OCC) DTSCSED 00911 ADD 1 TO WRK-NEXT-OCC DTSCSED 00912 END-PERFORM. DTSCSED 00913 P7510-EXIT. DTSCSED 00914 EXIT. DTSCSED 00915 DTSCSED 00916 P7600-REPEAT. DTSCSED 00917 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00918 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00919 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00920 DTSCSED 00921 IF WRK-REPEAT-YES DTSCSED 00922 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00923 PERFORM P7610-INSERT THRU P7610-EXIT DTSCSED 00924 END-IF DTSCSED 00925 DTSCSED 00926 END-PERFORM. DTSCSED 00927 P7600-EXIT. DTSCSED 00928 EXIT. DTSCSED 00929 DTSCSED 00930 P7610-INSERT. DTSCSED 00931 PERFORM P8600-MAKE-ROOM THRU P8600-EXIT DTSCSED 00932 DTSCSED 00933 COMPUTE WRK-NEXT-OCC = WRK-CURR-LINE + 1 DTSCSED 00934 PERFORM WRK-CMND-LINE-CTR TIMES DTSCSED 00935 MOVE WRK-TEXT-LINE(WRK-CURR-LINE) DTSCSED 00936 TO WRK-TEXT-LINE(WRK-NEXT-OCC) DTSCSED 00937 ADD 1 TO WRK-NEXT-OCC DTSCSED 00938 END-PERFORM. DTSCSED 00939 P7610-EXIT. DTSCSED 00940 EXIT. DTSCSED 00941 DTSCSED 00942 P7700-DELETE. DTSCSED 00943 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00944 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00945 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00946 DTSCSED 00947 IF WRK-DELETE-YES DTSCSED 00948 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00949 PERFORM P7710-DELETE THRU P7710-EXIT DTSCSED 00950 END-IF DTSCSED 00951 DTSCSED 00952 END-PERFORM. DTSCSED 00953 P7700-EXIT. DTSCSED 00954 EXIT. DTSCSED 00955 DTSCSED 00956 P7710-DELETE. DTSCSED 00957 DTSCSED 00958 MOVE WRK-CURR-LINE TO SHIFT-OCC-TO DTSCSED 00959 ADD WRK-CMND-LINE-CTR TO WRK-CURR-LINE GIVING SHIFT-OCC-FROM DTSCSED 00960 IF SHIFT-OCC-FROM > WRK-TABLE-MAX-LINES DTSCSED 00961 OR SHIFT-OCC-FROM > LIT-TABLE-MAX-LINES DTSCSED 00962 PERFORM VARYING WRK-OCC FROM WRK-CURR-LINE BY 1 DTSCSED 00963 UNTIL WRK-OCC > WRK-TABLE-MAX-LINES DTSCSED 00964 MOVE SPACES TO WRK-TEXT-LINE(WRK-OCC) DTSCSED 00965 END-PERFORM DTSCSED 00966 SUBTRACT 1 FROM WRK-CURR-LINE GIVING WRK-TABLE-MAX-LINES DTSCSED 00967 GO TO P7710-EXIT. DTSCSED 00968 DTSCSED 00969 PERFORM WITH TEST BEFORE DTSCSED 00970 UNTIL SHIFT-OCC-FROM > WRK-TABLE-MAX-LINES DTSCSED 00971 MOVE WRK-TEXT-LINE(SHIFT-OCC-FROM) DTSCSED 00972 TO WRK-TEXT-LINE(SHIFT-OCC-TO) DTSCSED 00973 MOVE SPACES TO WRK-TEXT-LINE(SHIFT-OCC-FROM) DTSCSED 00974 ADD 1 TO SHIFT-OCC-FROM DTSCSED 00975 ADD 1 TO SHIFT-OCC-TO DTSCSED 00976 END-PERFORM. DTSCSED 00977 DTSCSED 00978 SUBTRACT WRK-CMND-LINE-CTR FROM WRK-TABLE-MAX-LINES. DTSCSED 00979 COMPUTE WRK-CMND-LINE-CTR = WRK-CMND-LINE-CTR * -1. DTSCSED 00980 PERFORM P8610-ADJUST-CMNDS THRU P8610-EXIT. DTSCSED 00981 P7710-EXIT. DTSCSED 00982 EXIT. DTSCSED 00983 P7800-CURRENT-LINE. DTSCSED 00984 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 00985 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 00986 PERFORM S1400-GET-CMND THRU S1400-EXIT DTSCSED 00987 DTSCSED 00988 IF WRK-CURRENT-LINE-YES DTSCSED 00989 MOVE SPACES TO WRK-TBL-CMND(SCR-OCC) DTSCSED 00990 MOVE WRK-CURR-LINE TO LSED-CURR-LINE DTSCSED 00991 END-IF DTSCSED 00992 DTSCSED 00993 END-PERFORM. DTSCSED 00994 P7800-EXIT. DTSCSED 00995 EXIT. DTSCSED 00996 DTSCSED 00997 P8000-LOAD-TABLE-FROM-Q. DTSCSED 00998 MOVE +1 TO L829-ITEM-NO. DTSCSED 00999 MOVE +0 TO WRK-NON-BLANK-LINE. DTSCSED 01000 MOVE +0 TO WRK-TABLE-MAX-LINES. DTSCSED 01001 SET L829-READ-ITEM-88 TO TRUE. DTSCSED 01002 DTSCSED 01003 PERFORM S829-TS-IO THRU S829-EXIT. DTSCSED 01004 DTSCSED 01005 PERFORM UNTIL (NOT L829-OK-88) DTSCSED 01006 OR (WRK-TABLE-MAX-LINES NOT < LIT-TABLE-MAX-LINES) DTSCSED 01007 DTSCSED 01008 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCSED 01009 UNTIL (WRK-OCC > LIT-Q-MAX-LINES) DTSCSED 01010 OR (WRK-TABLE-MAX-LINES NOT < LIT-TABLE-MAX-LINES) DTSCSED 01011 DTSCSED 01012 ADD +1 TO WRK-TABLE-MAX-LINES DTSCSED 01013 MOVE XEDS-LINE(WRK-OCC) DTSCSED 01014 TO WRK-TEXT-LINE(WRK-TABLE-MAX-LINES) DTSCSED 01015 DTSCSED 01016 IF WRK-TEXT-LINE(WRK-TABLE-MAX-LINES) DTSCSED 01017 = SPACES OR LOW-VALUES DTSCSED 01018 CONTINUE DTSCSED 01019 ELSE DTSCSED 01020 MOVE WRK-TABLE-MAX-LINES TO WRK-NON-BLANK-LINE DTSCSED 01021 END-IF DTSCSED 01022 DTSCSED 01023 END-PERFORM DTSCSED 01024 DTSCSED 01025 ADD +1 TO L829-ITEM-NO DTSCSED 01026 PERFORM S829-TS-IO THRU S829-EXIT DTSCSED 01027 END-PERFORM. DTSCSED 01028 DTSCSED 01029 MOVE WRK-NON-BLANK-LINE TO WRK-TABLE-MAX-LINES. DTSCSED 01030 DTSCSED 01031 P8000-EXIT. DTSCSED 01032 EXIT. DTSCSED 01033 DTSCSED 01034 P8100-LOAD-Q-FROM-TABLE. DTSCSED 01035 IF WRK-TABLE-MAX-LINES = +0 DTSCSED 01036 GO TO P8100-EXIT. DTSCSED 01037 DTSCSED 01038 MOVE +0 TO WRK-CURR-LINE. DTSCSED 01039 DTSCSED 01040 MOVE +0 TO WRK-NON-BLANK-LINE. DTSCSED 01041 DTSCSED 01042 SET L829-WRITE-88 TO TRUE. DTSCSED 01043 DTSCSED 01044 PERFORM UNTIL (WRK-CURR-LINE = WRK-TABLE-MAX-LINES) DTSCSED 01045 OR (WRK-CURR-LINE > WRK-TABLE-MAX-LINES) DTSCSED 01046 DTSCSED 01047 MOVE SPACES TO XEDS-DATA DTSCSED 01048 DTSCSED 01049 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCSED 01050 UNTIL (WRK-OCC > LIT-Q-MAX-LINES) DTSCSED 01051 OR (WRK-CURR-LINE = WRK-TABLE-MAX-LINES) DTSCSED 01052 OR (WRK-CURR-LINE > WRK-TABLE-MAX-LINES) DTSCSED 01053 DTSCSED 01054 ADD +1 TO WRK-CURR-LINE DTSCSED 01055 MOVE WRK-TEXT-LINE(WRK-CURR-LINE) DTSCSED 01056 TO XEDS-LINE(WRK-OCC) DTSCSED 01057 IF WRK-TEXT-LINE(WRK-CURR-LINE) NOT = SPACES DTSCSED 01058 MOVE WRK-OCC TO XEDS-LINE-CNT DTSCSED 01059 MOVE WRK-CURR-LINE TO WRK-NON-BLANK-LINE DTSCSED 01060 END-IF DTSCSED 01061 DTSCSED 01062 END-PERFORM DTSCSED 01063 DTSCSED 01064 IF WRK-CURR-LINE < WRK-TABLE-MAX-LINES DTSCSED 01065 MOVE LIT-Q-MAX-LINES TO XEDS-LINE-CNT DTSCSED 01066 END-IF DTSCSED 01067 ADD +1 TO L829-ITEM-NO DTSCSED 01068 PERFORM S829-TS-IO THRU S829-EXIT DTSCSED 01069 END-PERFORM. DTSCSED 01070 DTSCSED 01071 MOVE WRK-NON-BLANK-LINE TO WRK-TABLE-MAX-LINES. DTSCSED 01072 P8100-EXIT. DTSCSED 01073 EXIT. DTSCSED 01074 * DELETE THE BUFFER QUEUE DTSCSED 01075 P8200-DELETE-BUFFER. DTSCSED 01076 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCSED 01077 PERFORM S829-TS-IO THRU S829-EXIT. DTSCSED 01078 MOVE +0 TO LSED-BUFFER-ITEM. DTSCSED 01079 P8200-EXIT. DTSCSED 01080 EXIT. DTSCSED 01081 DTSCSED 01082 P8300-TO-BUFFER. DTSCSED 01083 SET L829-WRITE-88 TO TRUE. DTSCSED 01084 MOVE LSED-BUFFER-ITEM TO L829-ITEM-NO. DTSCSED 01085 PERFORM S829-TS-IO THRU S829-EXIT. DTSCSED 01086 P8300-EXIT. DTSCSED 01087 EXIT. DTSCSED 01088 DTSCSED 01089 DTSCSED 01090 P8400-READ-BUFFER. DTSCSED 01091 SET L829-READ-ITEM-88 TO TRUE. DTSCSED 01092 MOVE WRK-BUFFER-ITEM TO L829-ITEM-NO. DTSCSED 01093 PERFORM S829-TS-IO THRU S829-EXIT. DTSCSED 01094 P8400-EXIT. DTSCSED 01095 EXIT. DTSCSED 01096 DTSCSED 01097 P8600-MAKE-ROOM. DTSCSED 01098 DTSCSED 01099 *****IF WRK-CURR-LINE > WRK-TABLE-MAX-LINES DTSCSED 01100 ********ADD WRK-CMND-LINE-CTR TO WRK-TABLE-MAX-LINES DTSCSED 01101 ********GO TO P8600-EXIT DTSCSED 01102 *****END-IF. DTSCSED 01103 DTSCSED 01104 ***** DTSCSED 01105 * 09/07/1999 BUG FIX. ABOVE SENTENCE COMMENTED OUT DTSCSED 01106 * AND FOLLOWING SENTENCE INSERTED. EHH DTSCSED 01107 ***** DTSCSED 01108 DTSCSED 01109 IF WRK-CURR-LINE > WRK-TABLE-MAX-LINES DTSCSED 01110 PERFORM DTSCSED 01111 UNTIL (WRK-TABLE-MAX-LINES >= WRK-CURR-LINE) DTSCSED 01112 OR DTSCSED 01113 (WRK-TABLE-MAX-LINES >= LIT-TABLE-MAX-LINES) DTSCSED 01114 ADD +1 TO WRK-TABLE-MAX-LINES DTSCSED 01115 MOVE SPACE DTSCSED 01116 TO WRK-TEXT-LINE (WRK-TABLE-MAX-LINES) DTSCSED 01117 END-PERFORM. DTSCSED 01118 DTSCSED 01119 DTSCSED 01120 DTSCSED 01121 MOVE WRK-TABLE-MAX-LINES TO SHIFT-OCC-FROM DTSCSED 01122 ADD WRK-CMND-LINE-CTR TO WRK-TABLE-MAX-LINES DTSCSED 01123 DTSCSED 01124 IF WRK-TABLE-MAX-LINES > LIT-TABLE-MAX-LINES DTSCSED 01125 MOVE LIT-TABLE-MAX-LINES TO WRK-TABLE-MAX-LINES DTSCSED 01126 COMPUTE WRK-CMND-LINE-CTR = WRK-TABLE-MAX-LINES DTSCSED 01127 - SHIFT-OCC-FROM DTSCSED 01128 END-IF DTSCSED 01129 DTSCSED 01130 MOVE WRK-TABLE-MAX-LINES TO SHIFT-OCC-TO DTSCSED 01131 DTSCSED 01132 PERFORM WITH TEST BEFORE DTSCSED 01133 UNTIL SHIFT-OCC-FROM = WRK-CURR-LINE DTSCSED 01134 MOVE WRK-TEXT-LINE(SHIFT-OCC-FROM) DTSCSED 01135 TO WRK-TEXT-LINE(SHIFT-OCC-TO) DTSCSED 01136 MOVE SPACES TO WRK-TEXT-LINE(SHIFT-OCC-FROM) DTSCSED 01137 SUBTRACT 1 FROM SHIFT-OCC-TO DTSCSED 01138 SUBTRACT 1 FROM SHIFT-OCC-FROM DTSCSED 01139 END-PERFORM. DTSCSED 01140 DTSCSED 01141 PERFORM P8610-ADJUST-CMNDS THRU P8610-EXIT. DTSCSED 01142 P8600-EXIT. DTSCSED 01143 EXIT. DTSCSED 01144 DTSCSED 01145 P8610-ADJUST-CMNDS. DTSCSED 01146 ADD 1 TO SCR-OCC GIVING WRK-OCC2 DTSCSED 01147 PERFORM WITH TEST BEFORE DTSCSED 01148 VARYING WRK-OCC DTSCSED 01149 FROM WRK-OCC2 DTSCSED 01150 BY 1 DTSCSED 01151 UNTIL WRK-OCC = LIT-LINES-PER-PAGE DTSCSED 01152 OR WRK-OCC > LIT-LINES-PER-PAGE DTSCSED 01153 IF WRK-TBL-CMND (WRK-OCC) NOT = SPACE DTSCSED 01154 ADD WRK-CMND-LINE-CTR TO WRK-TBL-LINE(WRK-OCC) DTSCSED 01155 **** I DO NOT THINK THE FOLLOWING IF WILL EVER BE EXECUTED DTSCSED 01156 ***** BECAUSE OF TRAPPING ADDED IN S1220 AND P7100 DTSCSED 01157 IF WRK-TBL-LINE(WRK-OCC) DTSCSED 01158 > LIT-TABLE-MAX-LINES DTSCSED 01159 MOVE MSG-EED3-AREA TO LCCM-MSG-AREA DTSCSED 01160 MOVE SPACES TO WRK-CMND-TBL(WRK-OCC) DTSCSED 01161 END-IF DTSCSED 01162 END-IF DTSCSED 01163 END-PERFORM. DTSCSED 01164 P8610-EXIT. DTSCSED 01165 EXIT. DTSCSED 01166 DTSCSED 01167 P8910-INIT-BUFFER. DTSCSED 01168 MOVE 76 TO L829-REC-LENGTH. DTSCSED 01169 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCSED 01170 MOVE LSED-QUEUE-NAME TO L829-QUEUE-NAME. DTSCSED 01171 MOVE '2' TO L829-QUEUE-NAME-SUFFIX. DTSCSED 01172 DTSCSED 01173 * COMPUTE L829-COMM-AREA-LENGTH DTSCSED 01174 * = L829-CONTROL-BLOCK-LENGTH + L829-REC-LENGTH. DTSCSED 01175 P8910-EXIT. DTSCSED 01176 EXIT. DTSCSED 01177 DTSCSED 01178 *S829-READ-ITEM. DTSCSED 01179 *****MOVE LSED-CURR-PAGE TO L829-ITEM-NO DTSCSED 01180 *****SET L829-READ-ITEM-88 TO TRUE. DTSCSED 01181 *****GO TO S829-TS-IO. DTSCSED 01182 DTSCSED 01183 S804-INVALID-KEY. DTSCSED 01184 EXEC CICS LINK DTSCSED 01185 PROGRAM ('DTSCU804') DTSCSED 01186 COMMAREA (DFHCOMMAREA) DTSCSED 01187 END-EXEC. DTSCSED 01188 S804-EXIT. DTSCSED 01189 EXIT. DTSCSED 01190 DTSCSED 01191 S805-MSG-AREA. DTSCSED 01192 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCSED 01193 DTSCSED 01194 EXEC CICS LINK DTSCSED 01195 PROGRAM ('DTSCU805') DTSCSED 01196 COMMAREA (L805-COMM-AREA) DTSCSED 01197 END-EXEC. DTSCSED 01198 DTSCSED 01199 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCSED 01200 S805-EXIT. DTSCSED 01201 EXIT. DTSCSED 01202 EJECT DTSCSED 01203 *S829-READ-ITEM. DTSCSED 01204 *****SET L829-READ-ITEM-88 TO TRUE. DTSCSED 01205 *****GO TO S829-TS-IO. DTSCSED 01206 ***** DTSCSED 01207 *S829-WRITE-QUEUE. DTSCSED 01208 *****SET L829-WRITE-88 TO TRUE. DTSCSED 01209 *****GO TO S829-TS-IO. DTSCSED 01210 DTSCSED 01211 *-----------------------------------------------------------------DTSCSED 01212 * CLEAN UP AND INITIALIZE TS QUEUE AREA. DTSCSED 01213 *-----------------------------------------------------------------DTSCSED 01214 S829-DELETE-QUEUE. DTSCSED 01215 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCSED 01216 GO TO S829-TS-IO. DTSCSED 01217 DTSCSED 01218 S829-TS-IO. DTSCSED 01219 EXEC CICS DTSCSED 01220 LINK DTSCSED 01221 PROGRAM ('DTSCU829') DTSCSED 01222 COMMAREA (L829-COMM-AREA) DTSCSED 01223 END-EXEC. DTSCSED 01224 S829-EXIT. DTSCSED 01225 EXIT. DTSCSED 01226 S851-SCREEN-PROCESSING. DTSCSED 01227 EXEC CICS LINK DTSCSED 01228 PROGRAM ('DTSCU851') DTSCSED 01229 COMMAREA (L851-COMM-AREA) DTSCSED 01230 END-EXEC. DTSCSED 01231 S851-EXIT. DTSCSED 01232 EXIT. DTSCSED 01233 DTSCSED 01234 S899-ABEND. DTSCSED 01235 EXEC CICS ABEND DTSCSED 01236 ABCODE(WRK-ABEND-CD) DTSCSED 01237 END-EXEC. DTSCSED 01238 S899-EXIT. DTSCSED 01239 EXIT. DTSCSED 01240 DTSCSED 01241 SUCTRAN-OFF. DTSCSED 01242 EXEC CICS DTSCSED 01243 LINK DTSCSED 01244 PROGRAM ('UCTRAN41') DTSCSED 01245 COMMAREA (WRK-LIT-L) DTSCSED 01246 END-EXEC. DTSCSED 01247 DTSCSED 01248 GO TO SUCTRAN-EXIT. DTSCSED 01249 DTSCSED 01250 SUCTRAN-ON. DTSCSED 01251 EXEC CICS DTSCSED 01252 LINK DTSCSED 01253 PROGRAM ('UCTRAN41') DTSCSED 01254 COMMAREA (WRK-LIT-U) DTSCSED 01255 END-EXEC. DTSCSED 01256 DTSCSED 01257 GO TO SUCTRAN-EXIT. DTSCSED 01258 DTSCSED 01259 SUCTRAN-EXIT. DTSCSED 01260 EXIT. DTSCSED 01261 /*****************************************************************DTSCSED 01262 * EDIT THE INFORMATION ON THE SCREEN. *DTSCSED 01263 ******************************************************************DTSCSED 01264 S1200-EDIT-CMND. DTSCSED 01265 MOVE SPACES TO WRK-CMND-TBL(SCR-OCC). DTSCSED 01266 MOVE SPACE TO WRK-CMND. DTSCSED 01267 MOVE +0 TO WRK-CMND-LINE-CTR. DTSCSED 01268 DTSCSED 01269 IF LIT-CMND-AREA = MAP-LINE-ED(SCR-OCC) DTSCSED 01270 GO TO S1200-EXIT. DTSCSED 01271 DTSCSED 01272 SET WRK-EDIT-CMND-FOUND-NO TO TRUE. DTSCSED 01273 SET WRK-EDIT-CMND-ERROR-NO TO TRUE. DTSCSED 01274 MOVE +0 TO WRK-CMND-LINE-CTR. DTSCSED 01275 DTSCSED 01276 PERFORM S1205-EDIT THRU S1205-EXIT DTSCSED 01277 VARYING CMD-OCC FROM 1 BY 1 DTSCSED 01278 UNTIL CMD-OCC > 4 DTSCSED 01279 OR WRK-EDIT-CMND-ERROR-YES. DTSCSED 01280 DTSCSED 01281 IF WRK-EDIT-CMND-FOUND-YES DTSCSED 01282 MOVE HOLD-CMND TO WRK-CMND DTSCSED 01283 WRK-TBL-CMND(SCR-OCC) DTSCSED 01284 COMPUTE WRK-TBL-LINE(SCR-OCC) DTSCSED 01285 = LSED-CURR-LINE + SCR-OCC - 1 DTSCSED 01286 IF WRK-CMND-LINE-CTR = +0 DTSCSED 01287 MOVE +1 TO WRK-CMND-LINE-CTR DTSCSED 01288 END-IF DTSCSED 01289 MOVE WRK-CMND-LINE-CTR TO WRK-TBL-LINE-CTR(SCR-OCC) DTSCSED 01290 PERFORM S1220-CHECK-MAX THRU S1220-EXIT DTSCSED 01291 ELSE DTSCSED 01292 MOVE SPACE TO WRK-CMND DTSCSED 01293 END-IF. DTSCSED 01294 DTSCSED 01295 S1200-EXIT. DTSCSED 01296 EXIT. DTSCSED 01297 DTSCSED 01298 S1201-ERROR. DTSCSED 01299 SET WRK-EDIT-CMND-ERROR-YES TO TRUE. DTSCSED 01300 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-LINE-ED-A(SCR-OCC). DTSCSED 01301 IF LCCM-NO-MSG DTSCSED 01302 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSED 01303 MOVE CATB-CURSOR TO MAP-LINE-ED-L(SCR-OCC) DTSCSED 01304 SET CURSOR-SET-YES TO TRUE. DTSCSED 01305 S1201-EXIT. DTSCSED 01306 EXIT. DTSCSED 01307 DTSCSED 01308 * LOOK AT EACH BYTE OF THE LINE COMMAND DTSCSED 01309 S1205-EDIT. DTSCSED 01310 DTSCSED 01311 IF MAP-LINE-CMND (SCR-OCC, CMD-OCC) NUMERIC DTSCSED 01312 IF WRK-EDIT-CMND-FOUND-YES DTSCSED 01313 COMPUTE WRK-CMND-LINE-CTR DTSCSED 01314 = WRK-CMND-LINE-CTR * 10 DTSCSED 01315 + MAP-LINE-CMND-N (SCR-OCC, CMD-OCC) DTSCSED 01316 ELSE DTSCSED 01317 MOVE MSG-EED1-AREA TO WRK-MSG-AREA DTSCSED 01318 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSED 01319 ELSE DTSCSED 01320 MOVE MAP-LINE-CMND (SCR-OCC, CMD-OCC) TO WRK-CMND DTSCSED 01321 IF WRK-EDIT-CMND-FOUND-NO DTSCSED 01322 AND WRK-CMND-VALID DTSCSED 01323 SET WRK-EDIT-CMND-FOUND-YES TO TRUE DTSCSED 01324 MOVE WRK-CMND TO HOLD-CMND DTSCSED 01325 ELSE DTSCSED 01326 IF WRK-CMND = QUOTE OR ' ' OR LOW-VALUES DTSCSED 01327 CONTINUE DTSCSED 01328 ELSE DTSCSED 01329 MOVE MSG-EED2-AREA TO WRK-MSG-AREA DTSCSED 01330 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCSED 01331 S1205-EXIT. DTSCSED 01332 EXIT. DTSCSED 01333 DTSCSED 01334 S1220-CHECK-MAX. DTSCSED 01335 IF WRK-COPY-YES DTSCSED 01336 MOVE WRK-CMND-LINE-CTR TO TEST-BUFFER-ITEM DTSCSED 01337 ELSE DTSCSED 01338 IF WRK-KOPY-YES DTSCSED 01339 ADD WRK-CMND-LINE-CTR TO TEST-BUFFER-ITEM-ADDED DTSCSED 01340 ELSE DTSCSED 01341 IF WRK-AFTER-YES OR WRK-BEFORE-YES DTSCSED 01342 ADD 1 TO WRK-AFTER-BEFORE-CTR DTSCSED 01343 ELSE DTSCSED 01344 IF WRK-INSERT-YES OR WRK-REPEAT-YES DTSCSED 01345 ADD WRK-CMND-LINE-CTR TO TEST-TABLE-MAX-LINES DTSCSED 01346 END-IF. DTSCSED 01347 DTSCSED 01348 S1220-EXIT. DTSCSED 01349 EXIT. DTSCSED 01350 ******************************************************************DTSCSED 01351 * THE TEXT MAY HAVE BEEN MODIFIED SO MOVE IT REGARDLESS *DTSCSED 01352 ******************************************************************DTSCSED 01353 S1300-SCREEN-TO-TABLE. DTSCSED 01354 IF LSED-CURR-LINE = +0 DTSCSED 01355 MOVE 1 TO TBL-OCC DTSCSED 01356 ELSE DTSCSED 01357 MOVE LSED-CURR-LINE TO TBL-OCC DTSCSED 01358 END-IF. DTSCSED 01359 DTSCSED 01360 PERFORM VARYING SCR-OCC FROM 1 BY 1 DTSCSED 01361 UNTIL (SCR-OCC > LIT-LINES-PER-PAGE) DTSCSED 01362 OR ((LSED-CURR-LINE + SCR-OCC - 1) > LIT-TABLE-MAX-LINES) DTSCSED 01363 INSPECT MAP-TEXT(SCR-OCC) DTSCSED 01364 CONVERTING LOW-VALUES TO SPACES DTSCSED 01365 MOVE MAP-TEXT(SCR-OCC) TO WRK-TEXT-LINE(TBL-OCC) DTSCSED 01366 IF WRK-TEXT-LINE(TBL-OCC) NOT = SPACES DTSCSED 01367 IF TBL-OCC > WRK-TABLE-MAX-LINES DTSCSED 01368 MOVE TBL-OCC TO WRK-TABLE-MAX-LINES DTSCSED 01369 END-IF DTSCSED 01370 END-IF DTSCSED 01371 ADD 1 TO TBL-OCC DTSCSED 01372 END-PERFORM. DTSCSED 01373 S1300-EXIT. DTSCSED 01374 EXIT. DTSCSED 01375 S1400-GET-CMND. DTSCSED 01376 MOVE WRK-TBL-CMND(SCR-OCC) TO WRK-CMND. DTSCSED 01377 MOVE WRK-TBL-LINE(SCR-OCC) TO WRK-CURR-LINE. DTSCSED 01378 MOVE WRK-TBL-LINE-CTR(SCR-OCC) TO WRK-CMND-LINE-CTR. DTSCSED 01379 S1400-EXIT. EXIT. DTSCSED 01380 ******************************************************************DTSCSED 01381 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCSED 01382 ******************************************************************DTSCSED 01383 S5200-SET-UPDATE-ATTRB. DTSCSED 01384 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN-BRT. DTSCSED 01385 MOVE CATB-UNPROT-NORM-AN-MDTON TO WRK-ATB-AN-NORM. DTSCSED 01386 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCSED 01387 DTSCSED 01388 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSED 01389 DTSCSED 01390 S5200-EXIT. DTSCSED 01391 EXIT. DTSCSED 01392 DTSCSED 01393 S5900-SET-ATTRB. DTSCSED 01394 MOVE CATB-ASKIP-BRT-MDTON TO MAP-TOP-POS-A DTSCSED 01395 MAP-BOT-POS-A DTSCSED 01396 PERFORM VARYING SCR-OCC DTSCSED 01397 FROM 1 BY 1 DTSCSED 01398 UNTIL SCR-OCC > LIT-LINES-PER-PAGE DTSCSED 01399 MOVE WRK-ATB-AN-NORM DTSCSED 01400 TO MAP-TEXT-A (SCR-OCC) DTSCSED 01401 MOVE WRK-ATB-AN-BRT DTSCSED 01402 TO MAP-LINE-ED-A (SCR-OCC) DTSCSED 01403 END-PERFORM. DTSCSED 01404 S5900-EXIT. DTSCSED 01405 EXIT. DTSCSED 01406 EJECT DTSCSED 01407 /*****************************************************************DTSCSED 01408 * MAP ROUTINES *DTSCSED 01409 ******************************************************************DTSCSED 01410 S9100-RECEIVE. DTSCSED 01411 SET L851-RECEIVE-88 TO TRUE. DTSCSED 01412 DTSCSED 01413 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCSED 01414 DTSCSED 01415 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSED 01416 DTSCSED 01417 MOVE L851-AID TO LCCM-AID. DTSCSED 01418 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCSED 01419 S9100-EXIT. DTSCSED 01420 EXIT. DTSCSED 01421 DTSCSED 01422 S9200-SEND-DATAONLY. DTSCSED 01423 MOVE LOW-VALUES TO MAP-AREA. DTSCSED 01424 DTSCSED 01425 IF LCCM-NO-MSG DTSCSED 01426 NEXT SENTENCE DTSCSED 01427 ELSE DTSCSED 01428 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSED 01429 DTSCSED 01430 MOVE CATB-CURSOR TO MAP-TEXT-L(1) DTSCSED 01431 DTSCSED 01432 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCSED 01433 DTSCSED 01434 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSED 01435 DTSCSED 01436 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSED 01437 S9200-EXIT. DTSCSED 01438 EXIT. DTSCSED 01439 DTSCSED 01440 S9300-SEND-MAP. DTSCSED 01441 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCSED 01442 MOVE SPACES TO MAP-SYS-TIME. DTSCSED 01443 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCSED 01444 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCSED 01445 MOVE LSED-TITLE TO MAP-TITLE-LINE-NAME. DTSCSED 01446 DTSCSED 01447 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT. DTSCSED 01448 DTSCSED 01449 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSED 01450 DTSCSED 01451 IF CURSOR-SET-NO DTSCSED 01452 MOVE CATB-CURSOR TO MAP-TEXT-L(1). DTSCSED 01453 DTSCSED 01454 SET L851-SEND-88 TO TRUE. DTSCSED 01455 DTSCSED 01456 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSED 01457 DTSCSED 01458 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSED 01459 S9300-EXIT. DTSCSED 01460 EXIT. DTSCSED 01461 DTSCSED 01462 S9310-UPDATE-FKEYS. DTSCSED 01463 MOVE 'F3=END EDIT' TO MAP-KEY-SAVE. DTSCSED 01464 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSED 01465 DTSCSED 01466 DTSCSED 01467 S9310-EXIT. DTSCSED 01468 EXIT. DTSCSED 01469 DTSCSED 01470 S9320-INQUIRY-FKEYS. DTSCSED 01471 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCSED 01472 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCSED 01473 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCSED 01474 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCSED 01475 DTSCSED 01476 DTSCSED 01477 S9320-EXIT. DTSCSED 01478 EXIT. DTSCSED 01479 DTSCSED 01480 * DTSCSED 01481 DTSCSED 01482 S9900-PREPARE-SEND. DTSCSED 01483 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCSED 01484 LCCM-SCR-ID. DTSCSED 01485 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCSED 01486 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCSED 01487 S9900-EXIT. DTSCSED 01488 EXIT. DTSCSED