Files
DUTAS/CICS/DTSCSED.cob
2025-07-21 11:20:11 -04:00

1490 lines
116 KiB
COBOL

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