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