00001 IDENTIFICATION DIVISION. 04/05/04 00002 PROGRAM-ID. DTSCS14. DTSCS14 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009 00004 DATE-WRITTEN. APRIL 1994. DTSCS14 00005 DATE-COMPILED. DTSCS14 00006 SKIP3 DTSCS14 00007 ***** DTSCS14 00008 * DTSCS14 00009 * FUNCTION: OWNER/PARTNER/OFFICER NAME INQUIRY DTSCS14 00010 * SCREEN PROCESSOR. DTSCS14 00011 * DTSCS14 00012 * DTSCS14 00013 * MODIFICATION LOG: DTSCS14 00014 * DTSCS14 00015 * 10/14/1998 INITIAL DEVELOPMENT. COPIED FROM MCCCS14. DTSCS14 00016 * WORK ORDER: PROGRAMMER: ZL1.DTSCS14 00017 * DTSCS14 00018 * 02/04/2004 MODIFIED TO USE NEW VERSION OF MOPO RECORD, DTSCS14 00019 * INCLUDING MOPO-TYPE. CALL DTSCU035 TO DTSCS14 00020 * MOVE OPO TYPE LITTERAL TO TITLE AREA ON DTSCS14 00021 * SCREEN. DTSCS14 00022 * WORK ORDER: PROGRAMMER: GD DTSCS14 00023 * DTSCS14 00024 * DTSCS14 00025 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS14 00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS14 00027 * WORK ORDER: PROGRAMMER: XXX DTSCS14 00028 * DTSCS14 00029 * DTSCS14 00030 * DESCRIPTION: DTSCS14 00031 * DTSCS14 00032 * DTSCS14 00033 * CLEAR: DTSCS14 00034 * DTSCS14 00035 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS14 00036 * DTSCS14 00037 * DTSCS14 00038 * JUMP: DTSCS14 00039 * DTSCS14 00040 * F17 REGISTRATION INQUIRY (11) DTSCS14 00041 * F21 OWNER/PARTNER/OFFICER INQUIRY/UPDATE (15) DTSCS14 00042 * DTSCS14 00043 * DTSCS14 00044 * INQUIRY: DTSCS14 00045 * DTSCS14 00046 * CONTROL FIELD(S): MAP-EMP-NO DTSCS14 00047 * DTSCS14 00048 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR14-HOLD-AREA EMP-NO DTSCS14 00049 * DISPLAY THE PAGE OF INFORMATION INDICATED DTSCS14 00050 * BY LCCM-SCR14-HOLD-AREA DTSCS14 00051 * ELSE DTSCS14 00052 * DISPLAY FIRST PAGE OF INFORMATION ASSOCIATED DTSCS14 00053 * WITH LCCM-EMP-NO. DTSCS14 00054 * DTSCS14 00055 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS14 00056 * DTSCS14 00057 * DISPLAY SEQUENCE: ASCENDING ON MOPO-ID-NO. DTSCS14 00058 * DTSCS14 00059 * PAGE INITIALLY DISPLAYED: FIRST DTSCS14 00060 * DTSCS14 00061 * DTSCS14 00062 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS14 00063 * DTSCS14 00064 * STORE INFORMATION REPRESENTING PAGE CURRENTLY DTSCS14 00065 * DISPLAYED IN LCCM-SCR14-HOLD-AREA. DTSCS14 00066 * DTSCS14 00067 * IF A LINE NO IS BEING SELECTED: DTSCS14 00068 * IF (JUMP TO SCREEN '15' REQUESTED) DTSCS14 00069 * CONSTRUCT LCCM-SCR15-HOLD-AREA. DTSCS14 00070 * DTSCS14 00071 * DTSCS14 00072 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS14 00073 * DTSCS14 00074 * DTSCS14 00075 * DURING A DISPLAY OF THE RESULTS OF AN INQUIRY, USE DTSCS14 00076 * LCCM-SCR-HOLD-AREA TO HOLD THE RECORD KEYS OF THE DTSCS14 00077 * FROM 1 TO 16 MOPO RECORDS FROM WHICH THE LINES DTSCS14 00078 * OF THE DISPLAY WERE CONSTRUCTED. DTSCS14 00079 * DTSCS14 00080 * DTSCS14 00081 * WHEN THE USER SELECTS A 'LINE NO', THE INFORMATION DTSCS14 00082 * STORED IN LCCM-SCR-HOLD-AREA IS USED TO DETERMINE WHICH DTSCS14 00083 * MOPO RECORD WAS SELECTED. DTSCS14 00084 * DTSCS14 00085 * DTSCS14 00086 * UPDATE: DTSCS14 00087 * DTSCS14 00088 * NONE. DTSCS14 00089 * DTSCS14 00090 * DTSCS14 00091 * RECORDS READ: DTSCS14 00092 * DTSCS14 00093 * MASTER: DTSCS14 00094 * DTSCS14 00095 * MPRF DTSCS14 00096 * MOPO DTSCS14 00097 * DTSCS14 00098 * DTSCS14 00099 * ALTERNATE INDEX: DTSCS14 00100 * DTSCS14 00101 * NONE. DTSCS14 00102 * DTSCS14 00103 * DTSCS14 00104 * REFERENCE: DTSCS14 00105 * DTSCS14 00106 * NONE. DTSCS14 00107 * DTSCS14 00108 * DTSCS14 00109 * ACCOUNTING TRANSACTION COLLECTION: DTSCS14 00110 * DTSCS14 00111 * NONE. DTSCS14 00112 * DTSCS14 00113 * DTSCS14 00114 * RECORDS UPDATED: DTSCS14 00115 * DTSCS14 00116 * MASTER: DTSCS14 00117 * DTSCS14 00118 * NONE. DTSCS14 00119 * DTSCS14 00120 * DTSCS14 00121 * REFERENCE: DTSCS14 00122 * DTSCS14 00123 * NONE. DTSCS14 00124 * DTSCS14 00125 * DTSCS14 00126 * ACCOUNTING TRANSACTION COLLECTION: DTSCS14 00127 * DTSCS14 00128 * NONE. DTSCS14 00129 * DTSCS14 00130 * DTSCS14 00131 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS14 00132 * DTSCS14 00133 * NONE. DTSCS14 00134 * DTSCS14 00135 * DTSCS14 00136 * TEMPORARY STORAGE USAGE: DTSCS14 00137 * DTSCS14 00138 * S OVERFLOW FROM LCCM-SCR-HOLD-AREA. DTSCS14 00139 * DTSCS14 00140 * DTSCS14 00141 * MODULES LINKED TO: DTSCS14 00142 * DTSCS14 00143 * DTSCU013 COUNT FROM SCREEN FORMAT/EDIT. DTSCS14 00144 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS14 00145 * DTSCS14 00146 * DTSCS14 00147 * VERMONT REFERENCE: DTSCS14 00148 * DTSCS14 00149 * NONE. DTSCS14 00150 * DTSCS14 00151 ***** DTSCS14 00152 SKIP3 DTSCS14 00153 ENVIRONMENT DIVISION. DTSCS14 00154 SKIP3 DTSCS14 00155 DATA DIVISION. DTSCS14 00156 SKIP3 DTSCS14 00157 WORKING-STORAGE SECTION. DTSCS14 001575 77 PAN-VALET PICTURE X(24) VALUE '009DTSCS14 04/05/04'. DTSCS14 00158 SKIP3 DTSCS14 00159 01 WRK-AREA. DTSCS14 00160 05 WRK-ABEND-CD PIC X(04) VALUE 'S14 '. DTSCS14 00161 SKIP1 DTSCS14 00162 05 WRK-SCR-ID. DTSCS14 00163 10 WRK-SCR-ID-N PIC 9(02) VALUE 14. DTSCS14 00164 SKIP1 DTSCS14 00165 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS14 00166 DTSCS14 00167 05 LINES-PER-PAGE PIC S9(04) COMP VALUE +16. DTSCS14 00168 SKIP3 DTSCS14 00169 05 SCR-ACCESS-IND PIC X(01). DTSCS14 00170 88 SCR-ACCESS-INQ VALUE '1'. DTSCS14 00171 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS14 00172 SKIP1 DTSCS14 00173 05 CURSOR-SET-IND PIC X(01). DTSCS14 00174 88 CURSOR-SET-YES VALUE 'Y'. DTSCS14 00175 88 CURSOR-SET-NO VALUE 'N'. DTSCS14 00176 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS14 00177 88 CURSOR-SET-LINE-NUMBER VALUE 'L'. DTSCS14 00178 SKIP1 DTSCS14 00179 05 REQ-IND PIC X(01). DTSCS14 00180 88 REQ-ERROR VALUE 'O'. DTSCS14 00181 88 REQ-JUMP VALUE 'J'. DTSCS14 00182 88 REQ-INQUIRE VALUE 'I'. DTSCS14 00183 88 REQ-CLEAR VALUE 'C'. DTSCS14 00184 *********88 REQ-EDIT VALUE 'E'. DTSCS14 00185 *********88 REQ-UPDATE VALUE 'U'. DTSCS14 00186 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS14 00187 SKIP1 DTSCS14 00188 05 RESP-IND PIC X(01). DTSCS14 00189 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS14 00190 88 RESP-SEND-MAP VALUE 'M'. DTSCS14 00191 88 RESP-JUMP VALUE 'J'. DTSCS14 00192 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS14 00193 SKIP1 DTSCS14 00194 05 WRK-MSG-AREA PIC X(64). DTSCS14 00195 SKIP1 DTSCS14 00196 05 WRK-ATB-AN PIC X(01). DTSCS14 00197 05 WRK-ATB-NUM PIC X(01). DTSCS14 00198 SKIP3 DTSCS14 00199 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS14 00200 SKIP3 DTSCS14 00201 05 WRK-DISPLAY PIC 9(11). DTSCS14 00202 SKIP1 DTSCS14 00203 05 FILLER REDEFINES WRK-DISPLAY. DTSCS14 00204 10 FILLER PIC X(05). DTSCS14 00205 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS14 00206 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS14 00207 SKIP3 DTSCS14 00208 05 LINE-OCC PIC S9(04) COMP. DTSCS14 00209 SKIP3 DTSCS14 00210 05 SCR-HOLD-AREA. DTSCS14 00211 10 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS14 00212 10 SCR-HOLD-CURR-PAGE-NUM PIC S9(04) COMP. DTSCS14 00213 SKIP3 DTSCS14 00214 05 INQUIRY-CONTROL-AREA. DTSCS14 00215 10 LAST-REC-NUM PIC S9(04) COMP. DTSCS14 00216 DTSCS14 00217 10 LAST-REC-KEY-AREA PIC X(16). DTSCS14 00218 DTSCS14 00219 10 WS-REC-NUM PIC S9(04) COMP. DTSCS14 00220 DTSCS14 00221 10 START-REC-NUM PIC S9(04) COMP. DTSCS14 00222 DTSCS14 00223 10 LAST-PAGE-NUM PIC S9(04) COMP. DTSCS14 00224 DTSCS14 00225 10 CURR-PAGE-NUM PIC S9(04) COMP. DTSCS14 00226 DTSCS14 00227 05 WRK-OPO-TITLE-AREA. DTSCS14 00228 10 WRK-OPO-STAR PIC X(02) VALUE '* '. DTSCS14 00229 10 WRK-OPO-TITLE PIC X(13). DTSCS14 00230 *****EJECT DTSCS14 00231 *01 MSG-LITERALS. DTSCS14 00232 *****05 MSG-E141-AREA. DTSCS14 00233 ***** 10 FILLER PIC X(04) VALUE 'E141'. DTSCS14 00234 ***** 10 FILLER PIC X(30) DTSCS14 00235 ***** VALUE ' '. DTSCS14 00236 ***** 10 FILLER PIC X(30) DTSCS14 00237 ***** VALUE ' '. DTSCS14 00238 *****EJECT DTSCS14 00239 *01 L001-COMM-AREA. DTSCS14 00240 *****COPY MACIL001. DTSCS14 00241 EJECT DTSCS14 00242 01 L013-COMM-AREA. DTSCS14 00243 ++INCLUDE DTSIL013 DTSCS14 00244 EJECT DTSCS14 00245 01 L018-COMM-AREA. DTSCS14 00246 ++INCLUDE DTSIL018 DTSCS14 00247 EJECT DTSCS14 00248 01 L035-COMM-AREA. DTSCS14 00249 ++INCLUDE DTSIL035 DTSCS14 00250 EJECT DTSCS14 00251 01 L805-COMM-AREA. DTSCS14 00252 ++INCLUDE DTSIL805 DTSCS14 00253 EJECT DTSCS14 00254 01 L810-COMM-AREA. DTSCS14 00255 05 L810-CONTROL-BLOCK. DTSCS14 00256 ++INCLUDE DTSIL810 DTSCS14 00257 EJECT DTSCS14 00258 05 MSKL-REC. DTSCS14 00259 ++INCLUDE DTSIMSKL DTSCS14 00260 EJECT DTSCS14 00261 01 MPRF-REC. DTSCS14 00262 ++INCLUDE DTSIMPRF DTSCS14 00263 EJECT DTSCS14 00264 01 MOPO-REC. DTSCS14 00265 ++INCLUDE DTSIMOPO DTSCS14 00266 EJECT DTSCS14 00267 01 L851-COMM-AREA. DTSCS14 00268 ++INCLUDE DTSIL851 DTSCS14 00269 SKIP3 DTSCS14 00270 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS14 00271 ++INCLUDE DTSIS14 DTSCS14 00272 EJECT DTSCS14 00273 01 CATB-LITERALS. DTSCS14 00274 ++INCLUDE DTSICATB DTSCS14 00275 SKIP3 DTSCS14 00276 01 CFKD-LITERALS. DTSCS14 00277 ++INCLUDE DTSICFKD DTSCS14 00278 SKIP3 DTSCS14 00279 01 CECD-LITERALS. DTSCS14 00280 ++INCLUDE DTSICECD DTSCS14 00281 SKIP3 DTSCS14 00282 01 CPCD-LITERALS. DTSCS14 00283 ++INCLUDE DTSICPCD DTSCS14 00284 EJECT DTSCS14 00285 LINKAGE SECTION. DTSCS14 00286 SKIP3 DTSCS14 00287 01 DFHCOMMAREA. DTSCS14 00288 ++INCLUDE DTSILCCM DTSCS14 00289 SKIP3 DTSCS14 00290 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS14 00291 20 LCCM-SCR-HOLD-LINE-CNT PIC S9(04) COMP. DTSCS14 00292 20 LCCM-SCR-HOLD-LINE-KEY-AREA DTSCS14 00293 OCCURS 16 TIMES DTSCS14 00294 PIC X(16). DTSCS14 00295 EJECT DTSCS14 00296 ******************************************************************DTSCS14 00297 * *DTSCS14 00298 ******************************************************************DTSCS14 00299 SKIP1 DTSCS14 00300 PROCEDURE DIVISION. DTSCS14 00301 SKIP2 DTSCS14 00302 MOVE +0 TO WRK-EMP-NO. DTSCS14 00303 SKIP1 DTSCS14 00304 MOVE LOW-VALUES TO MAP-AREA. DTSCS14 00305 SKIP1 DTSCS14 00306 SET CURSOR-SET-NO TO TRUE. DTSCS14 00307 SKIP1 DTSCS14 00308 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS14 00309 TO SCR-ACCESS-IND. DTSCS14 00310 SKIP3 DTSCS14 00311 MOVE SPACE TO REQ-IND. DTSCS14 00312 SKIP1 DTSCS14 00313 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS14 00314 SKIP1 DTSCS14 00315 *----------------------------------------------------- DTSCS14 00316 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS14 00317 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS14 00318 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS14 00319 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS14 00320 * DTSCS14 00321 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS14 00322 * PROCESSED. DTSCS14 00323 * DTSCS14 00324 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS14 00325 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS14 00326 * WORK STATION OPERATOR. DTSCS14 00327 *----------------------------------------------------- DTSCS14 00328 SKIP1 DTSCS14 00329 MOVE SPACE TO RESP-IND. DTSCS14 00330 SKIP1 DTSCS14 00331 IF REQ-ERROR DTSCS14 00332 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS14 00333 ELSE DTSCS14 00334 IF REQ-JUMP DTSCS14 00335 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS14 00336 ELSE DTSCS14 00337 IF REQ-CLEAR DTSCS14 00338 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS14 00339 ELSE DTSCS14 00340 IF REQ-CURSOR-TO-GOTO DTSCS14 00341 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS14 00342 ELSE DTSCS14 00343 IF REQ-INQUIRE DTSCS14 00344 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS14 00345 ELSE DTSCS14 00346 *****IF REQ-EDIT DTSCS14 00347 ***** PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS14 00348 *****ELSE DTSCS14 00349 *****IF REQ-UPDATE DTSCS14 00350 ***** PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS14 00351 *****ELSE DTSCS14 00352 GO TO S899-ABEND. DTSCS14 00353 SKIP3 DTSCS14 00354 *----------------------------------------------------- DTSCS14 00355 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS14 00356 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS14 00357 *----------------------------------------------------- DTSCS14 00358 SKIP1 DTSCS14 00359 IF RESP-SEND-MAP DTSCS14 00360 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS14 00361 SET LCCM-END-TASK-88 TO TRUE DTSCS14 00362 ELSE DTSCS14 00363 IF RESP-SEND-MSGONLY DTSCS14 00364 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS14 00365 SET LCCM-END-TASK-88 TO TRUE DTSCS14 00366 ELSE DTSCS14 00367 IF RESP-JUMP DTSCS14 00368 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS14 00369 ELSE DTSCS14 00370 IF RESP-CURSOR-TO-GOTO DTSCS14 00371 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS14 00372 SET LCCM-END-TASK-88 TO TRUE DTSCS14 00373 ELSE DTSCS14 00374 GO TO S899-ABEND. DTSCS14 00375 SKIP3 DTSCS14 00376 MAINLINE-EXIT. DTSCS14 00377 SKIP1 DTSCS14 00378 EXEC CICS DTSCS14 00379 RETURN DTSCS14 00380 END-EXEC. DTSCS14 00381 SKIP2 DTSCS14 00382 GOBACK. DTSCS14 00383 EJECT DTSCS14 00384 /*****************************************************************DTSCS14 00385 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS14 00386 ******************************************************************DTSCS14 00387 P1000-ANALYZE-REQUEST. DTSCS14 00388 SKIP1 DTSCS14 00389 *----------------------------------------------------- DTSCS14 00390 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS14 00391 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS14 00392 * REPLACED WITH ENTER) DTSCS14 00393 *----------------------------------------------------- DTSCS14 00394 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS14 00395 SET LCCM-ENTER-88 TO TRUE DTSCS14 00396 SET REQ-INQUIRE TO TRUE DTSCS14 00397 IF LCCM-EMP-NO > ZERO DTSCS14 00398 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS14 00399 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS14 00400 END-IF DTSCS14 00401 GO TO P1000-EXIT. DTSCS14 00402 SKIP3 DTSCS14 00403 *----------------------------------------------------- DTSCS14 00404 * MAP IS RECEIVED DTSCS14 00405 *----------------------------------------------------- DTSCS14 00406 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS14 00407 SKIP3 DTSCS14 00408 *----------------------------------------------------- DTSCS14 00409 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS14 00410 * WORK STATION DTSCS14 00411 *----------------------------------------------------- DTSCS14 00412 IF LCCM-CLEAR-88 DTSCS14 00413 SET REQ-CLEAR TO TRUE DTSCS14 00414 GO TO P1000-EXIT. DTSCS14 00415 SKIP3 DTSCS14 00416 *----------------------------------------------------- DTSCS14 00417 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS14 00418 *----------------------------------------------------- DTSCS14 00419 *****IF LCCM-SCR-UPDATE-LOCKED DTSCS14 00420 ***** PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS14 00421 ***** GO TO P1000-EXIT. DTSCS14 00422 *****SKIP3 DTSCS14 00423 *----------------------------------------------------- DTSCS14 00424 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS14 00425 *----------------------------------------------------- DTSCS14 00426 IF LCCM-PA2-88 DTSCS14 00427 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS14 00428 GO TO P1000-EXIT. DTSCS14 00429 SKIP3 DTSCS14 00430 *----------------------------------------------------- DTSCS14 00431 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS14 00432 *----------------------------------------------------- DTSCS14 00433 IF LCCM-PA-88 DTSCS14 00434 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS14 00435 SET REQ-ERROR TO TRUE DTSCS14 00436 GO TO P1000-EXIT. DTSCS14 00437 SKIP3 DTSCS14 00438 *----------------------------------------------------- DTSCS14 00439 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS14 00440 * CLEAR SCREEN DTSCS14 00441 *----------------------------------------------------- DTSCS14 00442 IF LCCM-F12-88 DTSCS14 00443 MOVE LOW-VALUES TO MAP-AREA DTSCS14 00444 SET REQ-CLEAR TO TRUE DTSCS14 00445 GO TO P1000-EXIT. DTSCS14 00446 SKIP3 DTSCS14 00447 *----------------------------------------------------- DTSCS14 00448 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS14 00449 *----------------------------------------------------- DTSCS14 00450 IF LCCM-F03-88 DTSCS14 00451 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS14 00452 SET REQ-JUMP TO TRUE DTSCS14 00453 GO TO P1000-EXIT. DTSCS14 00454 SKIP3 DTSCS14 00455 *----------------------------------------------------- DTSCS14 00456 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS14 00457 *----------------------------------------------------- DTSCS14 00458 IF LCCM-F04-88 DTSCS14 00459 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS14 00460 SET REQ-JUMP TO TRUE DTSCS14 00461 GO TO P1000-EXIT. DTSCS14 00462 SKIP3 DTSCS14 00463 *----------------------------------------------------- DTSCS14 00464 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS14 00465 * CORRESPONDENCE SCREEN DTSCS14 00466 *----------------------------------------------------- DTSCS14 00467 IF LCCM-F14-88 DTSCS14 00468 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS14 00469 SET REQ-JUMP TO TRUE DTSCS14 00470 GO TO P1000-EXIT. DTSCS14 00471 SKIP3 DTSCS14 00472 * IF LCCM-F17-88 DTSCS14 00473 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS14 00474 * SET REQ-JUMP TO TRUE DTSCS14 00475 * GO TO P1000-EXIT. DTSCS14 00476 * DTSCS14 00477 * IF LCCM-F21-88 DTSCS14 00478 * MOVE '15' TO LCCM-REQ-SCR-ID DTSCS14 00479 * SET REQ-JUMP TO TRUE DTSCS14 00480 * GO TO P1000-EXIT. DTSCS14 00481 * SKIP3 DTSCS14 00482 *----------------------------------------------------- DTSCS14 00483 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS14 00484 * REQUESTED SCREEN TYPE DTSCS14 00485 *----------------------------------------------------- DTSCS14 00486 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS14 00487 NEXT SENTENCE DTSCS14 00488 ELSE DTSCS14 00489 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS14 00490 SET REQ-JUMP TO TRUE DTSCS14 00491 GO TO P1000-EXIT. DTSCS14 00492 SKIP3 DTSCS14 00493 *----------------------------------------------------- DTSCS14 00494 * IF REQUEST TO UPDATE THE DATA (MOD) DTSCS14 00495 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS14 00496 *----------------------------------------------------- DTSCS14 00497 *****IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F11-88 DTSCS14 00498 ***** IF SCR-ACCESS-UPDATE DTSCS14 00499 ***** SET REQ-EDIT TO TRUE DTSCS14 00500 ***** GO TO P1000-EXIT DTSCS14 00501 ***** ELSE DTSCS14 00502 ***** PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS14 00503 ***** SET REQ-ERROR TO TRUE DTSCS14 00504 ***** GO TO P1000-EXIT. DTSCS14 00505 *****SKIP3 DTSCS14 00506 *----------------------------------------------------- DTSCS14 00507 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS14 00508 * F8), INDICATE INQUIRY REQUEST DTSCS14 00509 *----------------------------------------------------- DTSCS14 00510 IF LCCM-INQUIRY-88 DTSCS14 00511 IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES DTSCS14 00512 SET REQ-INQUIRE TO TRUE DTSCS14 00513 GO TO P1000-EXIT DTSCS14 00514 ELSE DTSCS14 00515 MOVE '15' TO LCCM-REQ-SCR-ID DTSCS14 00516 SET REQ-JUMP TO TRUE DTSCS14 00517 GO TO P1000-EXIT. DTSCS14 00518 SKIP3 DTSCS14 00519 *----------------------------------------------------- DTSCS14 00520 * ANY OTHER KEY IS INVALID DTSCS14 00521 *----------------------------------------------------- DTSCS14 00522 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS14 00523 SET REQ-ERROR TO TRUE. DTSCS14 00524 P1000-EXIT. DTSCS14 00525 EXIT. DTSCS14 00526 SKIP3 DTSCS14 00527 ******************************************************************DTSCS14 00528 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS14 00529 ******************************************************************DTSCS14 00530 SKIP1 DTSCS14 00531 *P1100-UPDATE-LOCKED. DTSCS14 00532 *----------------------------------------------------- DTSCS14 00533 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS14 00534 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS14 00535 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS14 00536 *----------------------------------------------------- DTSCS14 00537 *****IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS14 00538 ***** SET REQ-UPDATE TO TRUE DTSCS14 00539 *****ELSE DTSCS14 00540 ***** SET REQ-ERROR TO TRUE DTSCS14 00541 ***** IF LCCM-SCR-ADD-LOCKED DTSCS14 00542 ***** MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS14 00543 ***** ELSE DTSCS14 00544 ***** IF LCCM-SCR-MOD-LOCKED DTSCS14 00545 ***** MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS14 00546 ***** ELSE DTSCS14 00547 ***** IF LCCM-SCR-DEL-LOCKED DTSCS14 00548 ***** MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS14 00549 ***** ELSE DTSCS14 00550 ***** GO TO S899-ABEND. DTSCS14 00551 *P1100-EXIT. DTSCS14 00552 *****EXIT. DTSCS14 00553 /*****************************************************************DTSCS14 00554 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS14 00555 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS14 00556 ******************************************************************DTSCS14 00557 SKIP1 DTSCS14 00558 P2000-REQUEST-ERROR. DTSCS14 00559 IF LCCM-MSG DTSCS14 00560 SET RESP-SEND-MSGONLY TO TRUE DTSCS14 00561 ELSE DTSCS14 00562 GO TO S899-ABEND. DTSCS14 00563 P2000-EXIT. DTSCS14 00564 EXIT. DTSCS14 00565 /*****************************************************************DTSCS14 00566 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS14 00567 ******************************************************************DTSCS14 00568 SKIP1 DTSCS14 00569 P3000-REQUEST-JUMP. DTSCS14 00570 *----------------------------------------------------- DTSCS14 00571 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS14 00572 * BY USER DTSCS14 00573 *----------------------------------------------------- DTSCS14 00574 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS14 00575 SKIP3 DTSCS14 00576 *----------------------------------------------------- DTSCS14 00577 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS14 00578 *----------------------------------------------------- DTSCS14 00579 IF LCCM-MSG DTSCS14 00580 SET RESP-SEND-MSGONLY TO TRUE DTSCS14 00581 SET CURSOR-SET-GOTO TO TRUE DTSCS14 00582 GO TO P3000-EXIT. DTSCS14 00583 SKIP3 DTSCS14 00584 IF LCCM-REQ-SCR-ID = '15' DTSCS14 00585 MOVE MAP-LINE-NUMBER-AREA TO L013-S-CNT-AREA DTSCS14 00586 PERFORM S013-LINE-NUMBER THRU S013-EXIT DTSCS14 00587 IF L013-NO-ENTRY DTSCS14 00588 PERFORM P3200-MAP-EMP-NO THRU P3200-EXIT DTSCS14 00589 ELSE DTSCS14 00590 IF L013-NOT-VALID DTSCS14 00591 MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA DTSCS14 00592 ELSE DTSCS14 00593 PERFORM P3100-LINE-NUMBER THRU P3100-EXIT DTSCS14 00594 ELSE DTSCS14 00595 PERFORM P3200-MAP-EMP-NO THRU P3200-EXIT. DTSCS14 00596 DTSCS14 00597 IF LCCM-MSG DTSCS14 00598 SET CURSOR-SET-LINE-NUMBER TO TRUE DTSCS14 00599 SET RESP-SEND-MSGONLY TO TRUE DTSCS14 00600 GO TO P3000-EXIT. DTSCS14 00601 SKIP3 DTSCS14 00602 *----------------------------------------------------- DTSCS14 00603 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS14 00604 *----------------------------------------------------- DTSCS14 00605 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS14 00606 LCCM-SCR-HOLD-AREA. DTSCS14 00607 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS14 00608 SET RESP-JUMP TO TRUE. DTSCS14 00609 P3000-EXIT. DTSCS14 00610 EXIT. DTSCS14 00611 SKIP3 DTSCS14 00612 P3100-LINE-NUMBER. DTSCS14 00613 MOVE LCCM-SCR14-HOLD-AREA TO SCR-HOLD-AREA. DTSCS14 00614 IF (SCR-HOLD-CURR-PAGE-NUM = +0) DTSCS14 00615 OR DTSCS14 00616 (L013-CNT < +1) DTSCS14 00617 OR DTSCS14 00618 (L013-CNT > LCCM-SCR-HOLD-LINE-CNT) DTSCS14 00619 MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA DTSCS14 00620 ELSE DTSCS14 00621 MOVE LCCM-SCR-HOLD-LINE-KEY-AREA (L013-CNT) DTSCS14 00622 TO LCCM-SCR15-HOLD-AREA. DTSCS14 00623 P3100-EXIT. DTSCS14 00624 EXIT. DTSCS14 00625 SKIP3 DTSCS14 00626 P3200-MAP-EMP-NO. DTSCS14 00627 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS14 00628 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS14 00629 IF L018-VALID DTSCS14 00630 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS14 00631 P3200-EXIT. DTSCS14 00632 EXIT. DTSCS14 00633 /*****************************************************************DTSCS14 00634 * CLEAR KEY WAS PRESSED *DTSCS14 00635 ******************************************************************DTSCS14 00636 SKIP1 DTSCS14 00637 P4000-REQUEST-CLEAR. DTSCS14 00638 SET LCCM-SCR-CLEAR TO TRUE. DTSCS14 00639 SKIP1 DTSCS14 00640 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS14 00641 SKIP3 DTSCS14 00642 *----------------------------------------------------- DTSCS14 00643 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS14 00644 * FIELDS FROM EARLIER REQUESTS DTSCS14 00645 *----------------------------------------------------- DTSCS14 00646 IF LCCM-EMP-NO > ZERO DTSCS14 00647 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS14 00648 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS14 00649 SKIP1 DTSCS14 00650 MOVE ZERO TO LCCM-EMP-NO. DTSCS14 00651 SKIP1 DTSCS14 00652 MOVE LOW-VALUES TO LCCM-SCR14-HOLD-AREA DTSCS14 00653 LCCM-SCR-HOLD-AREA. DTSCS14 00654 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS14 00655 SKIP1 DTSCS14 00656 SET RESP-SEND-MAP TO TRUE. DTSCS14 00657 P4000-EXIT. DTSCS14 00658 EXIT. DTSCS14 00659 /*****************************************************************DTSCS14 00660 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS14 00661 ******************************************************************DTSCS14 00662 SKIP1 DTSCS14 00663 P5000-CURSOR-TO-GOTO. DTSCS14 00664 SET CURSOR-SET-GOTO TO TRUE. DTSCS14 00665 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS14 00666 P5000-EXIT. DTSCS14 00667 EXIT. DTSCS14 00668 /*****************************************************************DTSCS14 00669 * INQUIRY WAS REQUESTED *DTSCS14 00670 ******************************************************************DTSCS14 00671 SKIP1 DTSCS14 00672 P6000-REQUEST-INQUIRE. DTSCS14 00673 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS14 00674 MOVE LOW-VALUES TO MAP-AREA. DTSCS14 00675 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS14 00676 SKIP1 DTSCS14 00677 SET LCCM-SCR-CLEAR TO TRUE. DTSCS14 00678 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS14 00679 SKIP1 DTSCS14 00680 SET RESP-SEND-MAP TO TRUE. DTSCS14 00681 SKIP1 DTSCS14 00682 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS14 00683 SKIP1 DTSCS14 00684 MOVE LCCM-SCR14-HOLD-AREA TO SCR-HOLD-AREA. DTSCS14 00685 MOVE LOW-VALUES TO LCCM-SCR14-HOLD-AREA DTSCS14 00686 LCCM-SCR-HOLD-AREA. DTSCS14 00687 SKIP1 DTSCS14 00688 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS14 00689 IF LCCM-MSG DTSCS14 00690 GO TO P6000-EXIT. DTSCS14 00691 SKIP1 DTSCS14 00692 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS14 00693 IF LCCM-MSG DTSCS14 00694 GO TO P6000-EXIT. DTSCS14 00695 SKIP1 DTSCS14 00696 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS14 00697 SKIP1 DTSCS14 00698 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS14 00699 SKIP1 DTSCS14 00700 PERFORM P6200-LOCATE-PAGE THRU P6200-EXIT. DTSCS14 00701 IF LCCM-MSG DTSCS14 00702 GO TO P6000-EXIT. DTSCS14 00703 SKIP1 DTSCS14 00704 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS14 00705 SKIP1 DTSCS14 00706 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCS14 00707 MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM. DTSCS14 00708 MOVE SCR-HOLD-AREA TO LCCM-SCR14-HOLD-AREA. DTSCS14 00709 SKIP1 DTSCS14 00710 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS14 00711 SKIP1 DTSCS14 00712 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-LINE-NUMBER-A. DTSCS14 00713 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L. DTSCS14 00714 SET CURSOR-SET-YES TO TRUE. DTSCS14 00715 P6000-EXIT. DTSCS14 00716 EXIT. DTSCS14 00717 EJECT DTSCS14 00718 P6200-LOCATE-PAGE. DTSCS14 00719 MOVE LOW-VALUES TO MSKL-REC. DTSCS14 00720 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS14 00721 SET MSKL-OPO-88 TO TRUE. DTSCS14 00722 PERFORM S810-COUNT THRU S810-EXIT. DTSCS14 00723 DTSCS14 00724 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS14 00725 DTSCS14 00726 IF LAST-REC-NUM = +0 DTSCS14 00727 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS14 00728 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS14 00729 MOVE +0 TO LAST-PAGE-NUM DTSCS14 00730 CURR-PAGE-NUM DTSCS14 00731 GO TO P6200-EXIT. DTSCS14 00732 DTSCS14 00733 COMPUTE LAST-PAGE-NUM DTSCS14 00734 = ((LAST-REC-NUM - 1) / LINES-PER-PAGE) + 1. DTSCS14 00735 DTSCS14 00736 IF SCR-HOLD-AREA = LOW-VALUES DTSCS14 00737 MOVE +1 TO CURR-PAGE-NUM DTSCS14 00738 GO TO P6200-EXIT. DTSCS14 00739 DTSCS14 00740 IF SCR-HOLD-EMP-NO = WRK-EMP-NO DTSCS14 00741 NEXT SENTENCE DTSCS14 00742 ELSE DTSCS14 00743 MOVE +1 TO CURR-PAGE-NUM DTSCS14 00744 GO TO P6200-EXIT. DTSCS14 00745 DTSCS14 00746 IF LCCM-ENTER-88 DTSCS14 00747 MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM DTSCS14 00748 ELSE DTSCS14 00749 IF LCCM-F05-88 DTSCS14 00750 MOVE +1 TO CURR-PAGE-NUM DTSCS14 00751 ELSE DTSCS14 00752 IF LCCM-F06-88 DTSCS14 00753 MOVE LAST-PAGE-NUM TO CURR-PAGE-NUM DTSCS14 00754 ELSE DTSCS14 00755 IF LCCM-F07-88 DTSCS14 00756 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1 DTSCS14 00757 ELSE DTSCS14 00758 IF LCCM-F08-88 DTSCS14 00759 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1 DTSCS14 00760 ELSE DTSCS14 00761 GO TO S899-ABEND. DTSCS14 00762 DTSCS14 00763 IF CURR-PAGE-NUM < +1 DTSCS14 00764 MOVE +1 TO CURR-PAGE-NUM DTSCS14 00765 ELSE DTSCS14 00766 IF CURR-PAGE-NUM > LAST-PAGE-NUM DTSCS14 00767 MOVE LAST-PAGE-NUM TO CURR-PAGE-NUM. DTSCS14 00768 P6200-EXIT. DTSCS14 00769 EXIT. DTSCS14 00770 /*****************************************************************DTSCS14 00771 * *DTSCS14 00772 ******************************************************************DTSCS14 00773 SKIP1 DTSCS14 00774 P6900-CONSTRUCT-SCREEN. DTSCS14 00775 MOVE +0 TO LINE-OCC DTSCS14 00776 LCCM-SCR-HOLD-LINE-CNT. DTSCS14 00777 DTSCS14 00778 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCS14 00779 MOVE WRK-EMP-NO TO MOPO-EMP-NO. DTSCS14 00780 SET MOPO-OPO-88 TO TRUE. DTSCS14 00781 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCS14 00782 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS14 00783 IF L810-NO-REC-88 DTSCS14 00784 GO TO P6900-EXIT. DTSCS14 00785 DTSCS14 00786 MOVE +1 TO WS-REC-NUM. DTSCS14 00787 DTSCS14 00788 COMPUTE START-REC-NUM DTSCS14 00789 = ((CURR-PAGE-NUM - 1) * LINES-PER-PAGE) + 1. DTSCS14 00790 DTSCS14 00791 PERFORM P6910-NEXT-MOPO THRU P6910-EXIT DTSCS14 00792 UNTIL (L810-NO-REC-88) DTSCS14 00793 OR DTSCS14 00794 (WS-REC-NUM NOT < START-REC-NUM). DTSCS14 00795 DTSCS14 00796 PERFORM P6920-BUILD-LINE THRU P6920-EXIT DTSCS14 00797 UNTIL (LINE-OCC NOT < LINES-PER-PAGE) DTSCS14 00798 OR DTSCS14 00799 (L810-NO-REC-88). DTSCS14 00800 DTSCS14 00801 IF L810-NO-REC-88 DTSCS14 00802 NEXT SENTENCE DTSCS14 00803 ELSE DTSCS14 00804 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS14 00805 DTSCS14 00806 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS14 00807 P6900-EXIT. DTSCS14 00808 EXIT. DTSCS14 00809 SKIP3 DTSCS14 00810 P6910-NEXT-MOPO. DTSCS14 00811 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS14 00812 DTSCS14 00813 IF L810-NO-REC-88 DTSCS14 00814 NEXT SENTENCE DTSCS14 00815 ELSE DTSCS14 00816 ADD +1 TO WS-REC-NUM. DTSCS14 00817 P6910-EXIT. DTSCS14 00818 EXIT. DTSCS14 00819 SKIP3 DTSCS14 00820 P6920-BUILD-LINE. DTSCS14 00821 MOVE MSKL-REC TO MOPO-REC. DTSCS14 00822 DTSCS14 00823 ADD +1 TO LINE-OCC DTSCS14 00824 LCCM-SCR-HOLD-LINE-CNT. DTSCS14 00825 DTSCS14 00826 MOVE MOPO-KEY-AREA DTSCS14 00827 TO LCCM-SCR-HOLD-LINE-KEY-AREA (LCCM-SCR-HOLD-LINE-CNT). DTSCS14 00828 DTSCS14 00829 MOVE LINE-OCC TO MAP-LINE-NO (LINE-OCC). DTSCS14 00830 DTSCS14 00831 MOVE MOPO-NAME TO MAP-NAME (LINE-OCC). DTSCS14 00832 DTSCS14 00833 IF MOPO-TYPE-OPO-88 DTSCS14 00834 MOVE MOPO-TITLE TO MAP-TITLE (LINE-OCC) DTSCS14 00835 ELSE DTSCS14 00836 MOVE MOPO-TYPE-IND TO L035-CD DTSCS14 00837 PERFORM S035-SCREEN-OPO-TYPE THRU S035-EXIT DTSCS14 00838 IF L035-VALID DTSCS14 00839 MOVE L035-SHORT-DSCR TO WRK-OPO-TITLE DTSCS14 00840 MOVE WRK-OPO-TITLE-AREA TO MAP-TITLE (LINE-OCC) DTSCS14 00841 END-IF DTSCS14 00842 END-IF. DTSCS14 00843 DTSCS14 00844 IF MOPO-SSN = +0 DTSCS14 00845 NEXT SENTENCE DTSCS14 00846 ELSE DTSCS14 00847 MOVE MOPO-SSN TO MAP-SSN (LINE-OCC). DTSCS14 00848 DTSCS14 00849 MOVE MOPO-CITY TO MAP-CITY (LINE-OCC). DTSCS14 00850 DTSCS14 00851 MOVE MOPO-ST TO MAP-ST (LINE-OCC). DTSCS14 00852 DTSCS14 00853 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS14 00854 P6920-EXIT. DTSCS14 00855 EXIT. DTSCS14 00856 EJECT DTSCS14 00857 P6990-PAGE-NUMBER. DTSCS14 00858 MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCS14 00859 MOVE LAST-PAGE-NUM TO MAP-LAST-PAGE. DTSCS14 00860 DTSCS14 00861 IF CURR-PAGE-NUM = +1 DTSCS14 00862 IF LAST-PAGE-NUM = +1 DTSCS14 00863 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS14 00864 ELSE DTSCS14 00865 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS14 00866 ELSE DTSCS14 00867 IF CURR-PAGE-NUM = LAST-PAGE-NUM DTSCS14 00868 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS14 00869 P6990-EXIT. DTSCS14 00870 EXIT. DTSCS14 00871 /*****************************************************************DTSCS14 00872 * LINKS TO UTILITY MODULES DTSCS14 00873 ******************************************************************DTSCS14 00874 SKIP1 DTSCS14 00875 *S001-FROM-FED-8. DTSCS14 00876 *****SET L001-FROM-FED-8 TO TRUE. DTSCS14 00877 *****GO TO S001-DATE. DTSCS14 00878 *****SKIP1 DTSCS14 00879 *S001-FROM-ABS-DATE. DTSCS14 00880 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS14 00881 *****GO TO S001-DATE. DTSCS14 00882 *****SKIP1 DTSCS14 00883 *S001-DATE. DTSCS14 00884 *****EXEC CICS LINK DTSCS14 00885 ***** PROGRAM('MACCU001') DTSCS14 00886 ***** COMMAREA(L001-COMM-AREA) DTSCS14 00887 ***** LENGTH(L001-LENGTH) DTSCS14 00888 *****END-EXEC. DTSCS14 00889 *S001-EXIT. DTSCS14 00890 *****EXIT. DTSCS14 00891 SKIP3 DTSCS14 00892 S013-LINE-NUMBER. DTSCS14 00893 MOVE +1 TO L013-MIN-CNT. DTSCS14 00894 MOVE LINES-PER-PAGE TO L013-MAX-CNT. DTSCS14 00895 GO TO S013-COUNT-FROM-SCREEN. DTSCS14 00896 SKIP1 DTSCS14 00897 S013-COUNT-FROM-SCREEN. DTSCS14 00898 EXEC CICS LINK DTSCS14 00899 PROGRAM('DTSCU013') DTSCS14 00900 COMMAREA(L013-COMM-AREA) DTSCS14 00901 END-EXEC. DTSCS14 00902 S013-EXIT. DTSCS14 00903 EXIT. DTSCS14 00904 SKIP3 DTSCS14 00905 S018-EMP-NO-FROM-SCREEN. DTSCS14 00906 EXEC CICS LINK DTSCS14 00907 PROGRAM('DTSCU018') DTSCS14 00908 COMMAREA(L018-COMM-AREA) DTSCS14 00909 END-EXEC. DTSCS14 00910 S018-EXIT. DTSCS14 00911 EXIT. DTSCS14 00912 SKIP3 DTSCS14 00913 S035-SCREEN-OPO-TYPE. DTSCS14 00914 SET L035-MOPO-TYPE TO TRUE. DTSCS14 00915 DTSCS14 00916 EXEC CICS LINK DTSCS14 00917 PROGRAM ('DTSCU035') DTSCS14 00918 COMMAREA (L035-COMM-AREA) DTSCS14 00919 END-EXEC. DTSCS14 00920 S035-EXIT. DTSCS14 00921 EXIT. DTSCS14 00922 DTSCS14 00923 S803-REQ-SCR-ID-EDIT. DTSCS14 00924 EXEC CICS LINK DTSCS14 00925 PROGRAM ('DTSCU803') DTSCS14 00926 COMMAREA (DFHCOMMAREA) DTSCS14 00927 END-EXEC. DTSCS14 00928 S803-EXIT. DTSCS14 00929 EXIT. DTSCS14 00930 SKIP3 DTSCS14 00931 S804-INVALID-KEY. DTSCS14 00932 EXEC CICS LINK DTSCS14 00933 PROGRAM ('DTSCU804') DTSCS14 00934 COMMAREA (DFHCOMMAREA) DTSCS14 00935 END-EXEC. DTSCS14 00936 S804-EXIT. DTSCS14 00937 EXIT. DTSCS14 00938 SKIP3 DTSCS14 00939 S805-MSG-AREA. DTSCS14 00940 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS14 00941 SKIP1 DTSCS14 00942 EXEC CICS LINK DTSCS14 00943 PROGRAM ('DTSCU805') DTSCS14 00944 COMMAREA (L805-COMM-AREA) DTSCS14 00945 END-EXEC. DTSCS14 00946 SKIP1 DTSCS14 00947 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS14 00948 S805-EXIT. DTSCS14 00949 EXIT. DTSCS14 00950 EJECT DTSCS14 00951 S810-READ. DTSCS14 00952 SET L810-READ-88 TO TRUE. DTSCS14 00953 GO TO S810-IO. DTSCS14 00954 SKIP1 DTSCS14 00955 S810-START-BROWSE. DTSCS14 00956 SET L810-START-BROWSE-88 TO TRUE. DTSCS14 00957 GO TO S810-IO. DTSCS14 00958 SKIP1 DTSCS14 00959 S810-READ-NEXT. DTSCS14 00960 SET L810-READ-NEXT-88 TO TRUE. DTSCS14 00961 GO TO S810-IO. DTSCS14 00962 SKIP1 DTSCS14 00963 *S810-READ-PREV. DTSCS14 00964 *****SET L810-READ-PREV-88 TO TRUE. DTSCS14 00965 *****GO TO S810-IO. DTSCS14 00966 *****SKIP1 DTSCS14 00967 S810-END-BROWSE. DTSCS14 00968 SET L810-END-BROWSE-88 TO TRUE. DTSCS14 00969 GO TO S810-IO. DTSCS14 00970 SKIP1 DTSCS14 00971 S810-COUNT. DTSCS14 00972 SET L810-COUNT-88 TO TRUE. DTSCS14 00973 GO TO S810-IO. DTSCS14 00974 SKIP1 DTSCS14 00975 *S810-REWRITE. DTSCS14 00976 *****SET L810-REWRITE-88 TO TRUE. DTSCS14 00977 *****GO TO S810-IO. DTSCS14 00978 *****SKIP1 DTSCS14 00979 *S810-WRITE. DTSCS14 00980 *****SET L810-WRITE-88 TO TRUE. DTSCS14 00981 *****GO TO S810-IO. DTSCS14 00982 *****SKIP1 DTSCS14 00983 *S810-DELETE. DTSCS14 00984 *****SET L810-DELETE-88 TO TRUE. DTSCS14 00985 *****GO TO S810-IO. DTSCS14 00986 SKIP1 DTSCS14 00987 S810-IO. DTSCS14 00988 SKIP1 DTSCS14 00989 EXEC CICS LINK DTSCS14 00990 PROGRAM ('DTSCU810') DTSCS14 00991 COMMAREA (L810-COMM-AREA) DTSCS14 00992 END-EXEC. DTSCS14 00993 SKIP1 DTSCS14 00994 IF L810-FILE-CLOSED-88 DTSCS14 00995 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS14 00996 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS14 00997 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS14 00998 GO TO MAINLINE-EXIT. DTSCS14 00999 S810-EXIT. DTSCS14 01000 EXIT. DTSCS14 01001 EJECT DTSCS14 01002 S851-SCREEN-PROCESSING. DTSCS14 01003 EXEC CICS LINK DTSCS14 01004 PROGRAM ('DTSCU851') DTSCS14 01005 COMMAREA (L851-COMM-AREA) DTSCS14 01006 END-EXEC. DTSCS14 01007 S851-EXIT. DTSCS14 01008 EXIT. DTSCS14 01009 SKIP3 DTSCS14 01010 S899-ABEND. DTSCS14 01011 EXEC CICS ABEND DTSCS14 01012 ABCODE(WRK-ABEND-CD) DTSCS14 01013 END-EXEC. DTSCS14 01014 S899-EXIT. DTSCS14 01015 EXIT. DTSCS14 01016 EJECT DTSCS14 01017 S1100-EDIT-KEY. DTSCS14 01018 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS14 01019 S1100-EXIT. EXIT. DTSCS14 01020 /*****************************************************************DTSCS14 01021 * DTSCS14 01022 ******************************************************************DTSCS14 01023 S1101-EMP-NO. DTSCS14 01024 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS14 01025 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS14 01026 SKIP1 DTSCS14 01027 IF L018-NO-ENTRY DTSCS14 01028 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS14 01029 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS14 01030 GO TO S1101-EXIT. DTSCS14 01031 SKIP1 DTSCS14 01032 IF L018-NOT-VALID DTSCS14 01033 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS14 01034 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS14 01035 GO TO S1101-EXIT. DTSCS14 01036 SKIP1 DTSCS14 01037 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS14 01038 S1101-EXIT. EXIT. DTSCS14 01039 SKIP3 DTSCS14 01040 S1110-READ-MPRF. DTSCS14 01041 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS14 01042 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS14 01043 SET MPRF-PRF-88 TO TRUE. DTSCS14 01044 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS14 01045 PERFORM S810-READ THRU S810-EXIT. DTSCS14 01046 IF L810-NO-REC-88 DTSCS14 01047 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS14 01048 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS14 01049 ELSE DTSCS14 01050 MOVE MSKL-REC TO MPRF-REC. DTSCS14 01051 S1110-EXIT. DTSCS14 01052 EXIT. DTSCS14 01053 SKIP3 DTSCS14 01054 S1199-ERROR. DTSCS14 01055 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS14 01056 MAP-EMP-NO-2-A. DTSCS14 01057 IF LCCM-NO-MSG DTSCS14 01058 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS14 01059 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS14 01060 SET CURSOR-SET-YES TO TRUE. DTSCS14 01061 S1199-EXIT. EXIT. DTSCS14 01062 SKIP3 DTSCS14 01063 *S1299-ERROR. DTSCS14 01064 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LINE-NUMBER-A. DTSCS14 01065 *****IF LCCM-NO-MSG DTSCS14 01066 ***** MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS14 01067 ***** MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L DTSCS14 01068 ***** SET CURSOR-SET-YES TO TRUE. DTSCS14 01069 *S1299-EXIT. EXIT. DTSCS14 01070 /*****************************************************************DTSCS14 01071 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS14 01072 ******************************************************************DTSCS14 01073 S5300-SET-INQ-ATTRB. DTSCS14 01074 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS14 01075 WRK-ATB-NUM. DTSCS14 01076 SKIP1 DTSCS14 01077 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS14 01078 S5300-EXIT. DTSCS14 01079 EXIT. DTSCS14 01080 SKIP3 DTSCS14 01081 S5900-SET-ATTRB. DTSCS14 01082 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS14 01083 MAP-EMP-NO-2-A. DTSCS14 01084 SKIP1 DTSCS14 01085 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-PRIMARY-NAME-A. DTSCS14 01086 SKIP1 DTSCS14 01087 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-CURR-PAGE-A DTSCS14 01088 MAP-LAST-PAGE-A. DTSCS14 01089 DTSCS14 01090 PERFORM DTSCS14 01091 VARYING LINE-OCC FROM 1 BY 1 DTSCS14 01092 UNTIL LINE-OCC > LINES-PER-PAGE DTSCS14 01093 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-LINE-A (LINE-OCC) DTSCS14 01094 END-PERFORM. DTSCS14 01095 DTSCS14 01096 MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-LINE-NUMBER-A. DTSCS14 01097 SKIP1 DTSCS14 01098 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS14 01099 S5900-EXIT. DTSCS14 01100 EXIT. DTSCS14 01101 /*****************************************************************DTSCS14 01102 * MAP ROUTINES *DTSCS14 01103 ******************************************************************DTSCS14 01104 S9100-RECEIVE. DTSCS14 01105 SET L851-RECEIVE-88 TO TRUE. DTSCS14 01106 SKIP1 DTSCS14 01107 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS14 01108 SKIP1 DTSCS14 01109 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS14 01110 SKIP1 DTSCS14 01111 MOVE L851-AID TO LCCM-AID. DTSCS14 01112 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS14 01113 S9100-EXIT. DTSCS14 01114 EXIT. DTSCS14 01115 SKIP3 DTSCS14 01116 S9200-SEND-DATAONLY. DTSCS14 01117 MOVE LOW-VALUES TO MAP-AREA. DTSCS14 01118 SKIP1 DTSCS14 01119 IF LCCM-NO-MSG DTSCS14 01120 NEXT SENTENCE DTSCS14 01121 ELSE DTSCS14 01122 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS14 01123 SKIP1 DTSCS14 01124 IF CURSOR-SET-GOTO DTSCS14 01125 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS14 01126 ELSE DTSCS14 01127 IF CURSOR-SET-LINE-NUMBER DTSCS14 01128 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L DTSCS14 01129 ELSE DTSCS14 01130 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS14 01131 SKIP1 DTSCS14 01132 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS14 01133 SKIP1 DTSCS14 01134 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS14 01135 SKIP1 DTSCS14 01136 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS14 01137 S9200-EXIT. DTSCS14 01138 EXIT. DTSCS14 01139 SKIP3 DTSCS14 01140 S9300-SEND-MAP. DTSCS14 01141 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS14 01142 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS14 01143 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS14 01144 SKIP1 DTSCS14 01145 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS14 01146 SKIP1 DTSCS14 01147 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS14 01148 SKIP1 DTSCS14 01149 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS14 01150 SKIP1 DTSCS14 01151 IF CURSOR-SET-NO DTSCS14 01152 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS14 01153 SKIP1 DTSCS14 01154 SET L851-SEND-88 TO TRUE. DTSCS14 01155 SKIP1 DTSCS14 01156 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS14 01157 SKIP1 DTSCS14 01158 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS14 01159 S9300-EXIT. DTSCS14 01160 EXIT. DTSCS14 01161 SKIP3 DTSCS14 01162 S9320-INQUIRY-FKEYS. DTSCS14 01163 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS14 01164 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS14 01165 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS14 01166 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS14 01167 SKIP1 DTSCS14 01168 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS14 01169 S9320-EXIT. DTSCS14 01170 EXIT. DTSCS14 01171 SKIP3 DTSCS14 01172 *S9321-JUMP-KEYS. DTSCS14 01173 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS14 01174 * MOVE 'F21=OPO' TO MAP-KEY-OPO-UPDATE. DTSCS14 01175 *S9321-EXIT. DTSCS14 01176 * EXIT. DTSCS14 01177 SKIP3 DTSCS14 01178 S9330-DSCR-FIELDS. DTSCS14 01179 S9330-EXIT. DTSCS14 01180 EXIT. DTSCS14 01181 SKIP3 DTSCS14 01182 S9900-PREPARE-SEND. DTSCS14 01183 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS14 01184 LCCM-SCR-ID. DTSCS14 01185 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS14 01186 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS14 01187 S9900-EXIT. DTSCS14 01188 EXIT. DTSCS14