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