1190 lines
93 KiB
COBOL
1190 lines
93 KiB
COBOL
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
|