1660 lines
130 KiB
COBOL
1660 lines
130 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/02/03
|
|
00002 PROGRAM-ID. DTSCS75. DTSCS75
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009
|
|
00004 DATE-WRITTEN. MAY 1994. DTSCS75
|
|
00005 DATE-COMPILED. DTSCS75
|
|
00006 SKIP3 DTSCS75
|
|
00007 ***** DTSCS75
|
|
00008 * DTSCS75
|
|
00009 * FUNCTION: TICKLER BY DESTINATION SEARCH DTSCS75
|
|
00010 * SCREEN PROCESSOR. DTSCS75
|
|
00011 * DTSCS75
|
|
00012 * DTSCS75
|
|
00013 * MODIFICATION LOG: DTSCS75
|
|
00014 * DTSCS75
|
|
00015 * 09/28/98 INITIAL DEVELOPMENT. COPIED FROM MACCS75. DTSCS75
|
|
00016 * WORK ORDER: PROGRAMMER: ZL1. DTSCS75
|
|
00017 * DTSCS75
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS75
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS75
|
|
00020 * WORK ORDER: PROGRAMMER: XXX DTSCS75
|
|
00021 * DTSCS75
|
|
00022 * DTSCS75
|
|
00023 * DESCRIPTION: DTSCS75
|
|
00024 * DTSCS75
|
|
00025 * DTSCS75
|
|
00026 * CLEAR: DTSCS75
|
|
00027 * DTSCS75
|
|
00028 * FIELD DISPLAYED :NONE. UPROTECT MAP-SRCH-DEST, DTSCS75
|
|
00029 * MAP-SRCH-ACK-IND, MAP-SRCH-TRIG-START-DATE, AND DTSCS75
|
|
00030 * MAP-SRCH-TRIG-END-DATE. DTSCS75
|
|
00031 * DTSCS75
|
|
00032 * DTSCS75
|
|
00033 * INQUIRY: DTSCS75
|
|
00034 * DTSCS75
|
|
00035 * CONTROL FIELD(S): MAP-SRCH-DEST, MAP-SRCH-ACK-IND, DTSCS75
|
|
00036 * MAP-SRCH-TRIG-START-DATE, AND DTSCS75
|
|
00037 * MAP-SRCH-TRIG-END-DATE. DTSCS75
|
|
00038 * DTSCS75
|
|
00039 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR75-HOLD-AREA EMP-NO DTSCS75
|
|
00040 * START A SEARCH AT THE AIX INDEX RECORD WHOSE DTSCS75
|
|
00041 * KEY IS IN LCCM-SCR75-HOLD-AREA DTSCS75
|
|
00042 * ELSE DTSCS75
|
|
00043 * CLEAR. DTSCS75
|
|
00044 * DTSCS75
|
|
00045 * ENTER: REDISPLAY SAME STUFF. DTSCS75
|
|
00046 * DTSCS75
|
|
00047 * F07, F08: DO NOT BOTHER TO 'WRAP' PAGING. DTSCS75
|
|
00048 * DTSCS75
|
|
00049 * JUMP OUT: IF A LINE NO IS BEING SELECTED: DTSCS75
|
|
00050 * DTSCS75
|
|
00051 * UPDATE LCCM-EMP-NO DTSCS75
|
|
00052 * DTSCS75
|
|
00053 * STORE AIX RECORD REPRESENTING LINE NO DTSCS75
|
|
00054 * SELECTED IN LCCM-SCR75-HOLD-AREA DTSCS75
|
|
00055 * DTSCS75
|
|
00056 * STORE MAP-SRCH-ACK-IND, MAP-SRCH-TRIG DTSCS75
|
|
00057 * -START-ATE, AND MAP-SRCH-TRIG-END-DATE DTSCS75
|
|
00058 * IN LCCM-SCR-75-HOLD-AREA (MAP-SRCH-DEST DTSCS75
|
|
00059 * IS IN THE AIX RECORD) DTSCS75
|
|
00060 * DTSCS75
|
|
00061 * IF (JUMP TO SCREEN '74 REQUESTED) DTSCS75
|
|
00062 * CONSTRUCT LCCM-SCR74-HOLD-AREA. DTSCS75
|
|
00063 * DTSCS75
|
|
00064 * PROTECT THE 'CONTROL' FIELDS DURING A SEARCH - DTSCS75
|
|
00065 * LEAVING THE USER SPECIFIED SEARCH CRITERIA DISPLAYED. DTSCS75
|
|
00066 * THE USER MUST PRESS THE CLEAR KEY BEFORE RESTARTING DTSCS75
|
|
00067 * A SEARCH. DTSCS75
|
|
00068 * DTSCS75
|
|
00069 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCS75
|
|
00070 * LCCM-SCR-HOLD-AREA TO HOLD THE FROM 1 TO 12 AIX DTSCS75
|
|
00071 * RECORDS FROM WHICH THE 1 TO 12 LINES OF THE DISPLAY DTSCS75
|
|
00072 * WERE CONSTRUCTED. WHEN THE USER SELECTS A 'LINE NO', DTSCS75
|
|
00073 * THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA IS USED DTSCS75
|
|
00074 * TO DETERMINE WHICH EMPLOYER WAS SELECTED. DTSCS75
|
|
00075 * DTSCS75
|
|
00076 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCS75
|
|
00077 * THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA TO DTSCS75
|
|
00078 * CONTROL PAGING. DTSCS75
|
|
00079 * DTSCS75
|
|
00080 * DTSCS75
|
|
00081 * UPDATE: DTSCS75
|
|
00082 * DTSCS75
|
|
00083 * NONE. DTSCS75
|
|
00084 * DTSCS75
|
|
00085 * DTSCS75
|
|
00086 * RECORDS READ: DTSCS75
|
|
00087 * DTSCS75
|
|
00088 * MASTER: DTSCS75
|
|
00089 * DTSCS75
|
|
00090 * MPRF DTSCS75
|
|
00091 * MTCK DTSCS75
|
|
00092 * DTSCS75
|
|
00093 * DTSCS75
|
|
00094 * ALTERNATE INDEX: DTSCS75
|
|
00095 * DTSCS75
|
|
00096 * ITDS DTSCS75
|
|
00097 * DTSCS75
|
|
00098 * DTSCS75
|
|
00099 * REFERENCE: DTSCS75
|
|
00100 * DTSCS75
|
|
00101 * NONE. DTSCS75
|
|
00102 * DTSCS75
|
|
00103 * DTSCS75
|
|
00104 * ACCOUNTING TRANSACTION COLLECTION: DTSCS75
|
|
00105 * DTSCS75
|
|
00106 * NONE. DTSCS75
|
|
00107 * DTSCS75
|
|
00108 * DTSCS75
|
|
00109 * RECORDS UPDATED: DTSCS75
|
|
00110 * DTSCS75
|
|
00111 * MASTER: DTSCS75
|
|
00112 * DTSCS75
|
|
00113 * NONE. DTSCS75
|
|
00114 * DTSCS75
|
|
00115 * DTSCS75
|
|
00116 * REFERENCE: DTSCS75
|
|
00117 * DTSCS75
|
|
00118 * NONE. DTSCS75
|
|
00119 * DTSCS75
|
|
00120 * DTSCS75
|
|
00121 * ACCOUNTING TRANSACTION COLLECTION: DTSCS75
|
|
00122 * DTSCS75
|
|
00123 * NONE. DTSCS75
|
|
00124 * DTSCS75
|
|
00125 * DTSCS75
|
|
00126 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS75
|
|
00127 * DTSCS75
|
|
00128 * NONE. DTSCS75
|
|
00129 * DTSCS75
|
|
00130 * DTSCS75
|
|
00131 * TEMPORARY STORAGE USAGE: DTSCS75
|
|
00132 * DTSCS75
|
|
00133 * NONE. DTSCS75
|
|
00134 * DTSCS75
|
|
00135 * DTSCS75
|
|
00136 * MODULES LINKED TO: DTSCS75
|
|
00137 * DTSCS75
|
|
00138 * DTSCU001 DATE EDIT/CONVERSION. DTSCS75
|
|
00139 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS75
|
|
00140 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS75
|
|
00141 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCS75
|
|
00142 * DTSCS75
|
|
00143 * DTSCS75
|
|
00144 * VERMONT REFERENCE: DTSCS75
|
|
00145 * DTSCS75
|
|
00146 * TXC620C DTSCS75
|
|
00147 * DTSCS75
|
|
00148 * DTSCS75
|
|
00149 * NOTES TO JEFF: DTSCS75
|
|
00150 * DTSCS75
|
|
00151 * . THIS SCREEN SHOULD BE VERY MUCH LIKE TXC620C. OBVIOUSLY, DTSCS75
|
|
00152 * DTSCS67 IS ALSO A POSSIBLE MODEL. DTSCS75
|
|
00153 * DTSCS75
|
|
00154 * . PROBABLY THE ONLY DEPARTURE FROM VERMONT IS THAT IF A DTSCS75
|
|
00155 * LINE NUMBER IS SPECIFIED IN SELECT LINE NO AND THE DTSCS75
|
|
00156 * ENTER KEY IS PRESSED, THEN JUMP TO SCREEN 74. THIS DTSCS75
|
|
00157 * IS THE SAME KIND OF CHANGE WE MADE FOR MONTANA ON DTSCS75
|
|
00158 * SCREEN 12, 66, AND 67. DTSCS75
|
|
00159 * DTSCS75
|
|
00160 * DTSCS75
|
|
00161 ***** DTSCS75
|
|
00162 DTSCS75
|
|
00163 ENVIRONMENT DIVISION. DTSCS75
|
|
00164 DTSCS75
|
|
00165 DATA DIVISION. DTSCS75
|
|
00166 DTSCS75
|
|
00167 WORKING-STORAGE SECTION. DTSCS75
|
|
001675 77 PAN-VALET PICTURE X(24) VALUE '009DTSCS75 07/02/03'. DTSCS75
|
|
00168 DTSCS75
|
|
00169 01 WRK-TS-AREA. DTSCS75
|
|
00170 05 WRK-TS-SCREEN-75-IND PIC X(02). DTSCS75
|
|
00171 88 WRK-TS-SCREEN-75-YES VALUE '75'. DTSCS75
|
|
00172 05 WRK-TS-KEY-AREA PIC X(796). DTSCS75
|
|
00173 05 FILLER REDEFINES WRK-TS-KEY-AREA. DTSCS75
|
|
00174 10 WRK-TS-KEY OCCURS 12 TIMES. DTSCS75
|
|
00175 15 FILLER PIC X(64). DTSCS75
|
|
00176 05 WRK-SCR-FIRST-ADDL PIC X(04). DTSCS75
|
|
00177 05 WRK-ADDL-CTR REDEFINES WRK-SCR-FIRST-ADDL PIC S9(04). DTSCS75
|
|
00178 DTSCS75
|
|
00179 01 WRK-AREA. DTSCS75
|
|
00180 05 WRK-ABEND-CD PIC X(04) VALUE 'S75 '. DTSCS75
|
|
00181 DTSCS75
|
|
00182 05 WRK-SCR-ID. DTSCS75
|
|
00183 10 WRK-SCR-ID-N PIC 9(02) VALUE 75. DTSCS75
|
|
00184 DTSCS75
|
|
00185 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS75
|
|
00186 DTSCS75
|
|
00187 05 SCR-ACCESS-IND PIC X(01). DTSCS75
|
|
00188 88 SCR-ACCESS-INQ VALUE '1'. DTSCS75
|
|
00189 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS75
|
|
00190 DTSCS75
|
|
00191 05 CURSOR-SET-IND PIC X(01). DTSCS75
|
|
00192 88 CURSOR-SET-YES VALUE 'Y'. DTSCS75
|
|
00193 88 CURSOR-SET-NO VALUE 'N'. DTSCS75
|
|
00194 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS75
|
|
00195 DTSCS75
|
|
00196 05 REQ-IND PIC X(01). DTSCS75
|
|
00197 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS75
|
|
00198 88 REQ-ERROR VALUE 'O'. DTSCS75
|
|
00199 88 REQ-JUMP VALUE 'J'. DTSCS75
|
|
00200 88 REQ-UPDATE VALUE 'U'. DTSCS75
|
|
00201 88 REQ-INQUIRE VALUE 'I'. DTSCS75
|
|
00202 88 REQ-CLEAR VALUE 'C'. DTSCS75
|
|
00203 88 REQ-EDIT VALUE 'E'. DTSCS75
|
|
00204 DTSCS75
|
|
00205 05 RESP-IND PIC X(01). DTSCS75
|
|
00206 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS75
|
|
00207 88 RESP-SEND-MAP VALUE 'M'. DTSCS75
|
|
00208 88 RESP-JUMP VALUE 'J'. DTSCS75
|
|
00209 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS75
|
|
00210 DTSCS75
|
|
00211 05 WRK-MSG-AREA PIC X(64). DTSCS75
|
|
00212 DTSCS75
|
|
00213 05 WRK-ATB-AN PIC X(01). DTSCS75
|
|
00214 05 WRK-ATB-NUM PIC X(01). DTSCS75
|
|
00215 DTSCS75
|
|
00216 05 WRK-DEST-OP-ID PIC X(08). DTSCS75
|
|
00217 DTSCS75
|
|
00218 05 INQUIRY-CONTROL-AREA. DTSCS75
|
|
00219 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS75
|
|
00220 10 WS-REC-NUM PIC S9(08) COMP. DTSCS75
|
|
00221 DTSCS75
|
|
00222 10 SCR-REC-KEY-AREA PIC X(96). DTSCS75
|
|
00223 10 WRK-SCR-KEY-AREA. DTSCS75
|
|
00224 15 WRK-SCR-TDS-KEY PIC X(64). DTSCS75
|
|
00225 15 WRK-TRIGGER-DATE-FROM PIC S9(08) COMP-3. DTSCS75
|
|
00226 15 WRK-TRIGGER-DATE-TO PIC S9(08) COMP-3. DTSCS75
|
|
00227 15 WRK-ACKNOWLEDGED-IND PIC X(01). DTSCS75
|
|
00228 DTSCS75
|
|
00229 05 WRK-TS-FOUND-IND PIC X(01). DTSCS75
|
|
00230 88 WRK-TS-FOUND-YES VALUE 'Y'. DTSCS75
|
|
00231 88 WRK-TS-FOUND-NO VALUE 'N'. DTSCS75
|
|
00232 DTSCS75
|
|
00233 05 WRK-CTR PIC S9(04) COMP. DTSCS75
|
|
00234 DTSCS75
|
|
00235 05 WRK-CTR2 PIC S9(04) COMP. DTSCS75
|
|
00236 DTSCS75
|
|
00237 05 WRK-SUB PIC S9(04) COMP. DTSCS75
|
|
00238 DTSCS75
|
|
00239 05 WRK-REALLY-WANT-IND PIC X(01). DTSCS75
|
|
00240 88 WRK-REALLY-WANT-IT VALUE 'Y'. DTSCS75
|
|
00241 88 WRK-REALLY-DO-NOT-WANT-IT VALUE 'N'. DTSCS75
|
|
00242 DTSCS75
|
|
00243 05 WRK-DISPLAY PIC 9(11). DTSCS75
|
|
00244 DTSCS75
|
|
00245 05 FILLER REDEFINES WRK-DISPLAY. DTSCS75
|
|
00246 10 FILLER PIC X(05). DTSCS75
|
|
00247 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS75
|
|
00248 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS75
|
|
00249 DTSCS75
|
|
00250 05 FILLER REDEFINES WRK-DISPLAY. DTSCS75
|
|
00251 10 FILLER PIC X(05). DTSCS75
|
|
00252 10 WRK-DISPLAY-DATE. DTSCS75
|
|
00253 15 WRK-DISPLAY-YR PIC X(02). DTSCS75
|
|
00254 15 WRK-DISPLAY-MO PIC X(02). DTSCS75
|
|
00255 15 WRK-DISPLAY-DA PIC X(02). DTSCS75
|
|
00256 DTSCS75
|
|
00257 01 MSG-LITERALS. DTSCS75
|
|
00258 05 MSG-E751-AREA. DTSCS75
|
|
00259 10 FILLER PIC X(04) VALUE 'E751'. DTSCS75
|
|
00260 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS75
|
|
00261 10 MSG-E751-MSG PIC X(50) VALUE DTSCS75
|
|
00262 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS75
|
|
00263 EJECT DTSCS75
|
|
00264 01 L001-COMM-AREA. DTSCS75
|
|
00265 ++INCLUDE DTSIL001 DTSCS75
|
|
00266 EJECT DTSCS75
|
|
00267 01 L015-COMM-AREA. DTSCS75
|
|
00268 ++INCLUDE DTSIL015 DTSCS75
|
|
00269 EJECT DTSCS75
|
|
00270 01 L805-COMM-AREA. DTSCS75
|
|
00271 ++INCLUDE DTSIL805 DTSCS75
|
|
00272 EJECT DTSCS75
|
|
00273 01 L810-COMM-AREA. DTSCS75
|
|
00274 05 L810-CONTROL-BLOCK. DTSCS75
|
|
00275 ++INCLUDE DTSIL810 DTSCS75
|
|
00276 EJECT DTSCS75
|
|
00277 05 MSKL-REC. DTSCS75
|
|
00278 ++INCLUDE DTSIMSKL DTSCS75
|
|
00279 EJECT DTSCS75
|
|
00280 01 MPRF-REC. DTSCS75
|
|
00281 ++INCLUDE DTSIMPRF DTSCS75
|
|
00282 EJECT DTSCS75
|
|
00283 01 MTCK-REC. DTSCS75
|
|
00284 ++INCLUDE DTSIMTCK DTSCS75
|
|
00285 EJECT DTSCS75
|
|
00286 01 L821-COMM-AREA. DTSCS75
|
|
00287 05 L821-CONTROL-BLOCK. DTSCS75
|
|
00288 ++INCLUDE DTSIL821 DTSCS75
|
|
00289 DTSCS75
|
|
00290 05 ISKL-REC. DTSCS75
|
|
00291 ++INCLUDE DTSIISKL DTSCS75
|
|
00292 05 FILLER REDEFINES ISKL-REC. DTSCS75
|
|
00293 ++INCLUDE DTSIITDS DTSCS75
|
|
00294 DTSCS75
|
|
00295 01 L851-COMM-AREA. DTSCS75
|
|
00296 ++INCLUDE DTSIL851 DTSCS75
|
|
00297 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS75
|
|
00298 ++INCLUDE DTSIS75 DTSCS75
|
|
00299 EJECT DTSCS75
|
|
00300 01 CATB-LITERALS. DTSCS75
|
|
00301 ++INCLUDE DTSICATB DTSCS75
|
|
00302 DTSCS75
|
|
00303 01 CFKD-LITERALS. DTSCS75
|
|
00304 ++INCLUDE DTSICFKD DTSCS75
|
|
00305 DTSCS75
|
|
00306 01 CECD-LITERALS. DTSCS75
|
|
00307 ++INCLUDE DTSICECD DTSCS75
|
|
00308 DTSCS75
|
|
00309 01 CPCD-LITERALS. DTSCS75
|
|
00310 ++INCLUDE DTSICPCD DTSCS75
|
|
00311 EJECT DTSCS75
|
|
00312 LINKAGE SECTION. DTSCS75
|
|
00313 DTSCS75
|
|
00314 01 DFHCOMMAREA. DTSCS75
|
|
00315 ++INCLUDE DTSILCCM DTSCS75
|
|
00316 EJECT DTSCS75
|
|
00317 ******************************************************************DTSCS75
|
|
00318 * *DTSCS75
|
|
00319 ******************************************************************DTSCS75
|
|
00320 DTSCS75
|
|
00321 PROCEDURE DIVISION. DTSCS75
|
|
00322 DTSCS75
|
|
00323 MOVE LOW-VALUES TO MAP-AREA. DTSCS75
|
|
00324 SET CURSOR-SET-NO TO TRUE. DTSCS75
|
|
00325 DTSCS75
|
|
00326 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS75
|
|
00327 TO SCR-ACCESS-IND. DTSCS75
|
|
00328 DTSCS75
|
|
00329 MOVE +0 TO WRK-CTR DTSCS75
|
|
00330 WRK-CTR2 DTSCS75
|
|
00331 WRK-SUB. DTSCS75
|
|
00332 DTSCS75
|
|
00333 *----------------------------------------------------- DTSCS75
|
|
00334 * DETERMINE IF THERE IS INFORMATION HELD FROM THE PREVIOUS DTSCS75
|
|
00335 * TASK AND SET THE APPROPRIATE INDICATORS/COUNTERS DTSCS75
|
|
00336 *----------------------------------------------------- DTSCS75
|
|
00337 MOVE LCCM-SCR-HOLD-AREA TO WRK-TS-AREA. DTSCS75
|
|
00338 MOVE LCCM-SCR75-HOLD-AREA TO WRK-SCR-KEY-AREA. DTSCS75
|
|
00339 DTSCS75
|
|
00340 IF WRK-TS-SCREEN-75-YES DTSCS75
|
|
00341 SET WRK-TS-FOUND-YES TO TRUE DTSCS75
|
|
00342 ELSE DTSCS75
|
|
00343 MOVE +0 TO WRK-ADDL-CTR DTSCS75
|
|
00344 SET WRK-TS-FOUND-NO TO TRUE. DTSCS75
|
|
00345 DTSCS75
|
|
00346 MOVE SPACE TO REQ-IND. DTSCS75
|
|
00347 DTSCS75
|
|
00348 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS75
|
|
00349 DTSCS75
|
|
00350 *----------------------------------------------------- DTSCS75
|
|
00351 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS75
|
|
00352 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS75
|
|
00353 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS75
|
|
00354 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS75
|
|
00355 * DTSCS75
|
|
00356 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS75
|
|
00357 * PROCESSED. DTSCS75
|
|
00358 * DTSCS75
|
|
00359 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS75
|
|
00360 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS75
|
|
00361 * WORK STATION OPERATOR. DTSCS75
|
|
00362 *----------------------------------------------------- DTSCS75
|
|
00363 DTSCS75
|
|
00364 MOVE SPACE TO RESP-IND. DTSCS75
|
|
00365 DTSCS75
|
|
00366 IF REQ-ERROR DTSCS75
|
|
00367 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS75
|
|
00368 ELSE DTSCS75
|
|
00369 IF REQ-JUMP DTSCS75
|
|
00370 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS75
|
|
00371 ELSE DTSCS75
|
|
00372 IF REQ-CLEAR DTSCS75
|
|
00373 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS75
|
|
00374 ELSE DTSCS75
|
|
00375 IF REQ-CURSOR-TO-GOTO DTSCS75
|
|
00376 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS75
|
|
00377 ELSE DTSCS75
|
|
00378 IF REQ-INQUIRE DTSCS75
|
|
00379 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS75
|
|
00380 ELSE DTSCS75
|
|
00381 GO TO S899-ABEND. DTSCS75
|
|
00382 DTSCS75
|
|
00383 *----------------------------------------------------- DTSCS75
|
|
00384 * SAVE THE SCREEN INFORMATION THAT HAS BEEN BUILT DTSCS75
|
|
00385 * FOR LATER IF THE USER RETURNS TO THIS SCREEN DTSCS75
|
|
00386 *----------------------------------------------------- DTSCS75
|
|
00387 MOVE WRK-SCR-KEY-AREA TO LCCM-SCR75-HOLD-AREA. DTSCS75
|
|
00388 DTSCS75
|
|
00389 *----------------------------------------------------- DTSCS75
|
|
00390 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS75
|
|
00391 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS75
|
|
00392 *----------------------------------------------------- DTSCS75
|
|
00393 IF RESP-SEND-MAP DTSCS75
|
|
00394 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS75
|
|
00395 SET LCCM-END-TASK-88 TO TRUE DTSCS75
|
|
00396 ELSE DTSCS75
|
|
00397 IF RESP-SEND-MSGONLY DTSCS75
|
|
00398 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS75
|
|
00399 SET LCCM-END-TASK-88 TO TRUE DTSCS75
|
|
00400 ELSE DTSCS75
|
|
00401 IF RESP-JUMP DTSCS75
|
|
00402 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS75
|
|
00403 ELSE DTSCS75
|
|
00404 IF RESP-CURSOR-TO-GOTO DTSCS75
|
|
00405 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS75
|
|
00406 SET LCCM-END-TASK-88 TO TRUE DTSCS75
|
|
00407 ELSE DTSCS75
|
|
00408 GO TO S899-ABEND. DTSCS75
|
|
00409 DTSCS75
|
|
00410 MAINLINE-EXIT. DTSCS75
|
|
00411 DTSCS75
|
|
00412 EXEC CICS DTSCS75
|
|
00413 RETURN DTSCS75
|
|
00414 END-EXEC. DTSCS75
|
|
00415 DTSCS75
|
|
00416 GOBACK. DTSCS75
|
|
00417 EJECT DTSCS75
|
|
00418 /*****************************************************************DTSCS75
|
|
00419 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS75
|
|
00420 ******************************************************************DTSCS75
|
|
00421 P1000-ANALYZE-REQUEST. DTSCS75
|
|
00422 *----------------------------------------------------- DTSCS75
|
|
00423 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS75
|
|
00424 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS75
|
|
00425 * REPLACED WITH ENTER) DTSCS75
|
|
00426 *----------------------------------------------------- DTSCS75
|
|
00427 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS75
|
|
00428 SET LCCM-ENTER-88 TO TRUE DTSCS75
|
|
00429 PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT DTSCS75
|
|
00430 * THE FOLLOWING LINE WILL START THE SEARCH BASED ON THE KEY FIELDSDTSCS75
|
|
00431 * FROM A PREVIOUS SEARCH DTSCS75
|
|
00432 ******* SET REQ-INQUIRE TO TRUE DTSCS75
|
|
00433 GO TO P1000-EXIT. DTSCS75
|
|
00434 DTSCS75
|
|
00435 *----------------------------------------------------- DTSCS75
|
|
00436 * MAP IS RECEIVED DTSCS75
|
|
00437 *----------------------------------------------------- DTSCS75
|
|
00438 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS75
|
|
00439 DTSCS75
|
|
00440 *----------------------------------------------------- DTSCS75
|
|
00441 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS75
|
|
00442 * WORK STATION DTSCS75
|
|
00443 *----------------------------------------------------- DTSCS75
|
|
00444 IF LCCM-CLEAR-88 DTSCS75
|
|
00445 SET REQ-CLEAR TO TRUE DTSCS75
|
|
00446 GO TO P1000-EXIT. DTSCS75
|
|
00447 DTSCS75
|
|
00448 *----------------------------------------------------- DTSCS75
|
|
00449 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS75
|
|
00450 *----------------------------------------------------- DTSCS75
|
|
00451 IF LCCM-PA2-88 DTSCS75
|
|
00452 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS75
|
|
00453 GO TO P1000-EXIT. DTSCS75
|
|
00454 DTSCS75
|
|
00455 *----------------------------------------------------- DTSCS75
|
|
00456 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS75
|
|
00457 *----------------------------------------------------- DTSCS75
|
|
00458 IF LCCM-PA-88 DTSCS75
|
|
00459 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS75
|
|
00460 SET REQ-ERROR TO TRUE DTSCS75
|
|
00461 GO TO P1000-EXIT. DTSCS75
|
|
00462 DTSCS75
|
|
00463 *----------------------------------------------------- DTSCS75
|
|
00464 * IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS75
|
|
00465 * CLEAR SCREEN DTSCS75
|
|
00466 *----------------------------------------------------- DTSCS75
|
|
00467 IF LCCM-F12-88 DTSCS75
|
|
00468 MOVE LOW-VALUES TO MAP-AREA DTSCS75
|
|
00469 SET REQ-CLEAR TO TRUE DTSCS75
|
|
00470 GO TO P1000-EXIT. DTSCS75
|
|
00471 DTSCS75
|
|
00472 *----------------------------------------------------- DTSCS75
|
|
00473 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS75
|
|
00474 *----------------------------------------------------- DTSCS75
|
|
00475 IF LCCM-F03-88 DTSCS75
|
|
00476 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS75
|
|
00477 SET REQ-JUMP TO TRUE DTSCS75
|
|
00478 GO TO P1000-EXIT. DTSCS75
|
|
00479 DTSCS75
|
|
00480 *----------------------------------------------------- DTSCS75
|
|
00481 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS75
|
|
00482 *----------------------------------------------------- DTSCS75
|
|
00483 IF LCCM-F04-88 DTSCS75
|
|
00484 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS75
|
|
00485 SET REQ-JUMP TO TRUE DTSCS75
|
|
00486 GO TO P1000-EXIT. DTSCS75
|
|
00487 DTSCS75
|
|
00488 *--------------------------------------------------------- DTSCS75
|
|
00489 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS75
|
|
00490 * CORRESPONDENCE SCREEN. DTSCS75
|
|
00491 *--------------------------------------------------------- DTSCS75
|
|
00492 DTSCS75
|
|
00493 IF LCCM-F14-88 DTSCS75
|
|
00494 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS75
|
|
00495 SET REQ-JUMP TO TRUE DTSCS75
|
|
00496 GO TO P1000-EXIT. DTSCS75
|
|
00497 DTSCS75
|
|
00498 *----------------------------------------------------- DTSCS75
|
|
00499 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS75
|
|
00500 * REQUESTED SCREEN TYPE DTSCS75
|
|
00501 *----------------------------------------------------- DTSCS75
|
|
00502 * IF LCCM-F17-88 DTSCS75
|
|
00503 * OR LCCM-F19-88 DTSCS75
|
|
00504 * OR LCCM-F20-88 DTSCS75
|
|
00505 * OR LCCM-F21-88 DTSCS75
|
|
00506 * SET REQ-JUMP TO TRUE DTSCS75
|
|
00507 * GO TO P1000-EXIT DTSCS75
|
|
00508 * ELSE DTSCS75
|
|
00509 IF (MAP-SCREEN-ID = LOW-VALUES OR SPACES) DTSCS75
|
|
00510 AND (MAP-LINE-NUMBER = LOW-VALUES OR SPACES) DTSCS75
|
|
00511 NEXT SENTENCE DTSCS75
|
|
00512 ELSE DTSCS75
|
|
00513 SET REQ-JUMP TO TRUE DTSCS75
|
|
00514 GO TO P1000-EXIT. DTSCS75
|
|
00515 DTSCS75
|
|
00516 *----------------------------------------------------- DTSCS75
|
|
00517 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS75
|
|
00518 * REQUESTED SCREEN TYPE DTSCS75
|
|
00519 *----------------------------------------------------- DTSCS75
|
|
00520 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS75
|
|
00521 NEXT SENTENCE DTSCS75
|
|
00522 ELSE DTSCS75
|
|
00523 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS75
|
|
00524 SET REQ-JUMP TO TRUE DTSCS75
|
|
00525 GO TO P1000-EXIT. DTSCS75
|
|
00526 DTSCS75
|
|
00527 *----------------------------------------------------- DTSCS75
|
|
00528 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS75
|
|
00529 * OR F8), INDICATE INQUIRY REQUEST DTSCS75
|
|
00530 *----------------------------------------------------- DTSCS75
|
|
00531 IF LCCM-F07-88 DTSCS75
|
|
00532 OR LCCM-F08-88 DTSCS75
|
|
00533 OR LCCM-ENTER-88 DTSCS75
|
|
00534 SET REQ-INQUIRE TO TRUE DTSCS75
|
|
00535 GO TO P1000-EXIT. DTSCS75
|
|
00536 DTSCS75
|
|
00537 *----------------------------------------------------- DTSCS75
|
|
00538 * ANY OTHER KEY IS INVALID DTSCS75
|
|
00539 *----------------------------------------------------- DTSCS75
|
|
00540 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS75
|
|
00541 SET REQ-ERROR TO TRUE. DTSCS75
|
|
00542 P1000-EXIT. DTSCS75
|
|
00543 EXIT. DTSCS75
|
|
00544 DTSCS75
|
|
00545 ******************************************************************DTSCS75
|
|
00546 * DTSCS75
|
|
00547 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR75-HOLD-AREA EMP-NO DTSCS75
|
|
00548 * DTSCS75
|
|
00549 * START A SEARCH AT THE ITDS RECORD WHOSE DTSCS75
|
|
00550 * KEY IS IN LCCM-SCR75-HOLD-AREA DTSCS75
|
|
00551 * ELSE DTSCS75
|
|
00552 * CLEAR (BUT LEAVE THE REQUESTED KEY FIELDS) DTSCS75
|
|
00553 ******************************************************************DTSCS75
|
|
00554 DTSCS75
|
|
00555 P1200-CHECK-HOLD-AREA. DTSCS75
|
|
00556 MOVE +0 TO WRK-ADDL-CTR DTSCS75
|
|
00557 DTSCS75
|
|
00558 MOVE WRK-SCR-TDS-KEY TO ITDS-KEY-AREA DTSCS75
|
|
00559 IF ITDS-TDS-88 DTSCS75
|
|
00560 * LINE MOVED TO ONLY SHOW CRITERIA IF JUMP-EMP = LCCM-EMP DTSCS75
|
|
00561 ******* PERFORM P1201-REQUEST-FIELDS THRU P1201-EXIT DTSCS75
|
|
00562 IF ITDS-EMP-NO = LCCM-EMP-NO DTSCS75
|
|
00563 SET WRK-TS-FOUND-YES TO TRUE DTSCS75
|
|
00564 ELSE DTSCS75
|
|
00565 SET WRK-TS-FOUND-NO TO TRUE DTSCS75
|
|
00566 ELSE DTSCS75
|
|
00567 SET WRK-TS-FOUND-NO TO TRUE. DTSCS75
|
|
00568 DTSCS75
|
|
00569 IF WRK-TS-FOUND-YES DTSCS75
|
|
00570 * CRITERIA ONLY SHOWED IF JUMP EMP-NO = LCCM-EMP-NO DTSCS75
|
|
00571 SET REQ-INQUIRE TO TRUE DTSCS75
|
|
00572 PERFORM P1201-REQUEST-FIELDS THRU P1201-EXIT DTSCS75
|
|
00573 SET WRK-TS-SCREEN-75-YES TO TRUE DTSCS75
|
|
00574 MOVE WRK-SCR-TDS-KEY TO WRK-TS-KEY(1) DTSCS75
|
|
00575 MOVE +1 TO WRK-ADDL-CTR DTSCS75
|
|
00576 ELSE DTSCS75
|
|
00577 * IF NO PREVIOUS SEARCH CRITERIA OR DID NOT MATCH SEND CLEAR SCREEDTSCS75
|
|
00578 SET REQ-CLEAR TO TRUE DTSCS75
|
|
00579 MOVE +0 TO WRK-ADDL-CTR DTSCS75
|
|
00580 END-IF. DTSCS75
|
|
00581 P1200-EXIT. DTSCS75
|
|
00582 EXIT. DTSCS75
|
|
00583 DTSCS75
|
|
00584 P1201-REQUEST-FIELDS. DTSCS75
|
|
00585 IF WRK-TRIGGER-DATE-FROM > 0 DTSCS75
|
|
00586 MOVE WRK-TRIGGER-DATE-FROM TO WRK-DISPLAY DTSCS75
|
|
00587 MOVE WRK-DISPLAY-MO TO MAP-TRIGGER-DATE-FROM-MO DTSCS75
|
|
00588 MOVE WRK-DISPLAY-DA TO MAP-TRIGGER-DATE-FROM-DA DTSCS75
|
|
00589 MOVE WRK-DISPLAY-YR TO MAP-TRIGGER-DATE-FROM-YR DTSCS75
|
|
00590 END-IF DTSCS75
|
|
00591 IF WRK-TRIGGER-DATE-TO < 99999999 DTSCS75
|
|
00592 MOVE WRK-TRIGGER-DATE-TO TO WRK-DISPLAY DTSCS75
|
|
00593 MOVE WRK-DISPLAY-MO TO MAP-TRIGGER-DATE-TO-MO DTSCS75
|
|
00594 MOVE WRK-DISPLAY-DA TO MAP-TRIGGER-DATE-TO-DA DTSCS75
|
|
00595 MOVE WRK-DISPLAY-YR TO MAP-TRIGGER-DATE-TO-YR DTSCS75
|
|
00596 END-IF DTSCS75
|
|
00597 MOVE WRK-ACKNOWLEDGED-IND TO MAP-ACKNOWLEDGED-IND. DTSCS75
|
|
00598 MOVE ITDS-DEST-OP-ID TO MAP-DEST-OP-ID. DTSCS75
|
|
00599 P1201-EXIT. DTSCS75
|
|
00600 EXIT. DTSCS75
|
|
00601 /*****************************************************************DTSCS75
|
|
00602 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS75
|
|
00603 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS75
|
|
00604 ******************************************************************DTSCS75
|
|
00605 DTSCS75
|
|
00606 P2000-REQUEST-ERROR. DTSCS75
|
|
00607 IF LCCM-MSG DTSCS75
|
|
00608 SET RESP-SEND-MSGONLY TO TRUE DTSCS75
|
|
00609 ELSE DTSCS75
|
|
00610 GO TO S899-ABEND. DTSCS75
|
|
00611 P2000-EXIT. DTSCS75
|
|
00612 EXIT. DTSCS75
|
|
00613 /*****************************************************************DTSCS75
|
|
00614 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS75
|
|
00615 ******************************************************************DTSCS75
|
|
00616 DTSCS75
|
|
00617 P3000-REQUEST-JUMP. DTSCS75
|
|
00618 PERFORM P3001-SELECTION-LINE-EDIT THRU P3001-EXIT DTSCS75
|
|
00619 DTSCS75
|
|
00620 IF NOT LCCM-MSG DTSCS75
|
|
00621 PERFORM P3500-BUILD-TS-AREAS THRU P3500-EXIT. DTSCS75
|
|
00622 DTSCS75
|
|
00623 *----------------------------------------------------- DTSCS75
|
|
00624 * IF ERROR DETECTED AND DATA ON SCREEN THEN SAVE IT DTSCS75
|
|
00625 *----------------------------------------------------- DTSCS75
|
|
00626 DTSCS75
|
|
00627 IF LCCM-MSG DTSCS75
|
|
00628 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS75
|
|
00629 SET RESP-SEND-MAP TO TRUE DTSCS75
|
|
00630 GO TO P3000-EXIT. DTSCS75
|
|
00631 DTSCS75
|
|
00632 *----------------------------------------------------- DTSCS75
|
|
00633 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS75
|
|
00634 *----------------------------------------------------- DTSCS75
|
|
00635 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS75
|
|
00636 LCCM-SCR-HOLD-AREA. DTSCS75
|
|
00637 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS75
|
|
00638 SET RESP-JUMP TO TRUE. DTSCS75
|
|
00639 P3000-EXIT. DTSCS75
|
|
00640 EXIT. DTSCS75
|
|
00641 DTSCS75
|
|
00642 ******************************************************************DTSCS75
|
|
00643 * IF A JUMP-KEY WAS PRESSED OK DTSCS75
|
|
00644 * IF A SCREEN ID ENTERED (NOT GOTO) THEN LINE NUMBER REQUIRED DTSCS75
|
|
00645 * IF A LINE NUMBER WAS ENTERED IT MUST EXIST ON THE SCREEN DTSCS75
|
|
00646 ******************************************************************DTSCS75
|
|
00647 P3001-SELECTION-LINE-EDIT. DTSCS75
|
|
00648 *****IF MAP-GOTO EQUAL SPACES CODE COMMENTED OUT ON 08/24/94. DTSCS75
|
|
00649 ****************OR LOW-VALUES USER REPORTED ABEND IN SCREEN 12.DTSCS75
|
|
00650 ****************OR WRK-SCR-ID EHH. DTSCS75
|
|
00651 IF MAP-LINE-NUMBER EQUAL LOW-VALUES OR SPACES DTSCS75
|
|
00652 IF MAP-SCREEN-ID EQUAL LOW-VALUES OR SPACES DTSCS75
|
|
00653 NEXT SENTENCE DTSCS75
|
|
00654 ELSE DTSCS75
|
|
00655 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS75
|
|
00656 PERFORM S1901-MAP-LINE-ERROR THRU S1901-EXIT DTSCS75
|
|
00657 ELSE DTSCS75
|
|
00658 IF WRK-TS-FOUND-YES DTSCS75
|
|
00659 IF (NOT MAP-LINE-NUMBER-VALID) DTSCS75
|
|
00660 OR (MAP-LINE-NUMBER-N > WRK-ADDL-CTR) DTSCS75
|
|
00661 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS75
|
|
00662 PERFORM S1901-MAP-LINE-ERROR THRU S1901-EXIT. DTSCS75
|
|
00663 P3001-EXIT. DTSCS75
|
|
00664 EXIT. DTSCS75
|
|
00665 DTSCS75
|
|
00666 P3500-BUILD-TS-AREAS. DTSCS75
|
|
00667 IF WRK-TS-FOUND-YES DTSCS75
|
|
00668 IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES DTSCS75
|
|
00669 NEXT SENTENCE DTSCS75
|
|
00670 ELSE DTSCS75
|
|
00671 MOVE WRK-TS-KEY(MAP-LINE-NUMBER-N) TO ITDS-KEY-AREA DTSCS75
|
|
00672 MOVE ITDS-KEY-AREA TO WRK-SCR-TDS-KEY DTSCS75
|
|
00673 PERFORM P3501-FIND-EMP-NO THRU P3501-EXIT. DTSCS75
|
|
00674 DTSCS75
|
|
00675 PERFORM P3502-REQ-SCR-ID THRU P3502-EXIT. DTSCS75
|
|
00676 PERFORM P3510-BUILD-JUMP-AREA THRU P3510-EXIT. DTSCS75
|
|
00677 DTSCS75
|
|
00678 *----------------------------------------------------- DTSCS75
|
|
00679 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS75
|
|
00680 * BY USER DTSCS75
|
|
00681 *----------------------------------------------------- DTSCS75
|
|
00682 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCS75
|
|
00683 *----------------------------------------------------- DTSCS75
|
|
00684 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS75
|
|
00685 *----------------------------------------------------- DTSCS75
|
|
00686 IF LCCM-MSG DTSCS75
|
|
00687 SET CURSOR-SET-YES TO TRUE DTSCS75
|
|
00688 IF MAP-GOTO EQUAL SPACES DTSCS75
|
|
00689 OR LOW-VALUES DTSCS75
|
|
00690 OR WRK-SCR-ID DTSCS75
|
|
00691 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SCREEN-ID-A DTSCS75
|
|
00692 MOVE CATB-CURSOR TO MAP-SCREEN-ID-L DTSCS75
|
|
00693 ELSE DTSCS75
|
|
00694 MOVE CATB-CURSOR TO MAP-GOTO-L. DTSCS75
|
|
00695 P3500-EXIT. EXIT. DTSCS75
|
|
00696 DTSCS75
|
|
00697 /*****************************************************************DTSCS75
|
|
00698 * EMPLOYER NUMBER IS AT A DIFFERENT DISPLACEMENT FOR EACH TYPE DTSCS75
|
|
00699 ******************************************************************DTSCS75
|
|
00700 P3501-FIND-EMP-NO. DTSCS75
|
|
00701 MOVE ITDS-EMP-NO TO LCCM-EMP-NO. DTSCS75
|
|
00702 P3501-EXIT. DTSCS75
|
|
00703 EXIT. DTSCS75
|
|
00704 DTSCS75
|
|
00705 /*****************************************************************DTSCS75
|
|
00706 * DETERMINE WHICH SCREEN WILL BE JUMPED TO BASED ON DTSCS75
|
|
00707 * FUNCTION KEY DTSCS75
|
|
00708 * SELECTED SCREEN DTSCS75
|
|
00709 * GOTO OPTION (OVERRIDES FUNCTION OR SELECTED) DTSCS75
|
|
00710 ******************************************************************DTSCS75
|
|
00711 P3502-REQ-SCR-ID. DTSCS75
|
|
00712 MOVE LOW-VALUES TO LCCM-REQ-SCR-ID. DTSCS75
|
|
00713 DTSCS75
|
|
00714 IF LCCM-F03-88 DTSCS75
|
|
00715 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS75
|
|
00716 ELSE DTSCS75
|
|
00717 IF LCCM-F04-88 DTSCS75
|
|
00718 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS75
|
|
00719 ELSE DTSCS75
|
|
00720 IF LCCM-F14-88 DTSCS75
|
|
00721 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS75
|
|
00722 ELSE DTSCS75
|
|
00723 * IF LCCM-F17-88 DTSCS75
|
|
00724 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS75
|
|
00725 * ELSE DTSCS75
|
|
00726 * IF LCCM-F19-88 DTSCS75
|
|
00727 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS75
|
|
00728 * ELSE DTSCS75
|
|
00729 * IF LCCM-F20-88 DTSCS75
|
|
00730 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS75
|
|
00731 * ELSE DTSCS75
|
|
00732 * IF LCCM-F21-88 DTSCS75
|
|
00733 * MOVE '74' TO LCCM-REQ-SCR-ID DTSCS75
|
|
00734 * ELSE DTSCS75
|
|
00735 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS75
|
|
00736 IF MAP-SCREEN-ID = SPACES OR LOW-VALUES DTSCS75
|
|
00737 IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES DTSCS75
|
|
00738 NEXT SENTENCE DTSCS75
|
|
00739 ELSE DTSCS75
|
|
00740 IF WRK-TS-FOUND-YES DTSCS75
|
|
00741 MOVE '74' TO LCCM-REQ-SCR-ID DTSCS75
|
|
00742 ELSE DTSCS75
|
|
00743 NEXT SENTENCE DTSCS75
|
|
00744 ELSE DTSCS75
|
|
00745 MOVE MAP-SCREEN-ID TO LCCM-REQ-SCR-ID DTSCS75
|
|
00746 ELSE DTSCS75
|
|
00747 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID. DTSCS75
|
|
00748 DTSCS75
|
|
00749 IF LCCM-REQ-SCR-ID = LOW-VALUES OR SPACES OR WRK-SCR-ID DTSCS75
|
|
00750 MOVE EMSG-INVALID-TRANS-ID TO WRK-MSG-AREA DTSCS75
|
|
00751 PERFORM S2001-SELECT-SCREEN-ERROR THRU S2001-EXIT. DTSCS75
|
|
00752 P3502-EXIT. DTSCS75
|
|
00753 EXIT. DTSCS75
|
|
00754 DTSCS75
|
|
00755 /*****************************************************************DTSCS75
|
|
00756 * SELECTED LINE SELECTED TYPE AND SELECTED JUMP WILL BUILD THE DTSCS75
|
|
00757 * SPECIFIC 'KEY' FOR THE CORRECT DISPLAY PAGE WHEN JUMP HAPPENS DTSCS75
|
|
00758 ******************************************************************DTSCS75
|
|
00759 P3510-BUILD-JUMP-AREA. DTSCS75
|
|
00760 IF WRK-TS-FOUND-YES DTSCS75
|
|
00761 IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES DTSCS75
|
|
00762 NEXT SENTENCE DTSCS75
|
|
00763 ELSE DTSCS75
|
|
00764 IF (LCCM-REQ-SCR-ID = '74') DTSCS75
|
|
00765 PERFORM P3574-TS-FOR-74 THRU P3574-EXIT. DTSCS75
|
|
00766 P3510-EXIT. DTSCS75
|
|
00767 EXIT. DTSCS75
|
|
00768 DTSCS75
|
|
00769 P3574-TS-FOR-74. DTSCS75
|
|
00770 MOVE LOW-VALUES TO LCCM-SCR74-HOLD-AREA. DTSCS75
|
|
00771 MOVE LOW-VALUES TO MTCK-KEY-AREA. DTSCS75
|
|
00772 SET MTCK-TCK-88 TO TRUE. DTSCS75
|
|
00773 MOVE ITDS-ESTB-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS75
|
|
00774 MOVE ITDS-EMP-NO TO MTCK-EMP-NO. DTSCS75
|
|
00775 MOVE MTCK-KEY-AREA TO LCCM-SCR74-HOLD-AREA. DTSCS75
|
|
00776 DTSCS75
|
|
00777 P3574-EXIT. EXIT. DTSCS75
|
|
00778 DTSCS75
|
|
00779 /*****************************************************************DTSCS75
|
|
00780 * CLEAR KEY WAS PRESSED *DTSCS75
|
|
00781 ******************************************************************DTSCS75
|
|
00782 DTSCS75
|
|
00783 P4000-REQUEST-CLEAR. DTSCS75
|
|
00784 PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT DTSCS75
|
|
00785 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS75
|
|
00786 DTSCS75
|
|
00787 MOVE CATB-CURSOR TO MAP-DEST-OP-ID-L. DTSCS75
|
|
00788 DTSCS75
|
|
00789 SET CURSOR-SET-YES TO TRUE. DTSCS75
|
|
00790 MOVE 'N' TO WRK-TS-FOUND-IND. DTSCS75
|
|
00791 *----------------------------------------------------- DTSCS75
|
|
00792 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS75
|
|
00793 * FIELDS FROM EARLIER REQUESTS DTSCS75
|
|
00794 *----------------------------------------------------- DTSCS75
|
|
00795 DTSCS75
|
|
00796 *****MOVE ZERO TO LCCM-EMP-NO. DTSCS75
|
|
00797 DTSCS75
|
|
00798 MOVE LOW-VALUES TO WRK-SCR-KEY-AREA DTSCS75
|
|
00799 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS75
|
|
00800 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS75
|
|
00801 DTSCS75
|
|
00802 SET LCCM-SCR-CLEAR TO TRUE. DTSCS75
|
|
00803 DTSCS75
|
|
00804 SET RESP-SEND-MAP TO TRUE. DTSCS75
|
|
00805 P4000-EXIT. DTSCS75
|
|
00806 EXIT. DTSCS75
|
|
00807 /*****************************************************************DTSCS75
|
|
00808 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS75
|
|
00809 ******************************************************************DTSCS75
|
|
00810 DTSCS75
|
|
00811 P5000-CURSOR-TO-GOTO. DTSCS75
|
|
00812 SET CURSOR-SET-GOTO TO TRUE. DTSCS75
|
|
00813 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS75
|
|
00814 P5000-EXIT. DTSCS75
|
|
00815 EXIT. DTSCS75
|
|
00816 /*****************************************************************DTSCS75
|
|
00817 * INQUIRY WAS REQUESTED *DTSCS75
|
|
00818 ******************************************************************DTSCS75
|
|
00819 DTSCS75
|
|
00820 P6000-REQUEST-INQUIRE. DTSCS75
|
|
00821 SET RESP-SEND-MAP TO TRUE DTSCS75
|
|
00822 MOVE SPACES TO MAP-TABLE DTSCS75
|
|
00823 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS75
|
|
00824 IF WRK-TS-FOUND-NO DTSCS75
|
|
00825 SET LCCM-ENTER-88 TO TRUE. DTSCS75
|
|
00826 DTSCS75
|
|
00827 IF LCCM-SCR-CLEAR DTSCS75
|
|
00828 OR WRK-ADDL-CTR = 0 DTSCS75
|
|
00829 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS75
|
|
00830 DTSCS75
|
|
00831 MOVE 'I' TO LCCM-SCR-STATUS. DTSCS75
|
|
00832 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS75
|
|
00833 IF LCCM-MSG DTSCS75
|
|
00834 GO TO P6000-EXIT. DTSCS75
|
|
00835 DTSCS75
|
|
00836 IF LCCM-F08-88 DTSCS75
|
|
00837 MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA DTSCS75
|
|
00838 ELSE DTSCS75
|
|
00839 MOVE WRK-TS-KEY(1) TO ITDS-KEY-AREA DTSCS75
|
|
00840 MOVE WRK-TS-KEY(1) TO WRK-SCR-TDS-KEY DTSCS75
|
|
00841 END-IF. DTSCS75
|
|
00842 DTSCS75
|
|
00843 MOVE ITDS-DEST-OP-ID TO WRK-DEST-OP-ID DTSCS75
|
|
00844 MOVE +0 TO WRK-ADDL-CTR DTSCS75
|
|
00845 WRK-CTR DTSCS75
|
|
00846 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS75
|
|
00847 IF L821-NO-REC-88 DTSCS75
|
|
00848 MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID DTSCS75
|
|
00849 MOVE LOW-VALUES TO WRK-SCR-KEY-AREA. DTSCS75
|
|
00850 DTSCS75
|
|
00851 *-NOTE ----------------------------------------------- DTSCS75
|
|
00852 * AT THIS POINT EITHER THE KEY IS OK TO PROCESS OR IN ERROR DTSCS75
|
|
00853 *----------------------------------------------------- DTSCS75
|
|
00854 DTSCS75
|
|
00855 IF LCCM-MSG DTSCS75
|
|
00856 GO TO P6000-EXIT DTSCS75
|
|
00857 ELSE DTSCS75
|
|
00858 IF LCCM-ENTER-88 DTSCS75
|
|
00859 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS75
|
|
00860 ELSE DTSCS75
|
|
00861 IF LCCM-F07-88 DTSCS75
|
|
00862 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS75
|
|
00863 ELSE DTSCS75
|
|
00864 IF LCCM-F08-88 DTSCS75
|
|
00865 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS75
|
|
00866 ELSE DTSCS75
|
|
00867 GO TO S899-ABEND. DTSCS75
|
|
00868 DTSCS75
|
|
00869 IF L821-OK-88 DTSCS75
|
|
00870 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS75
|
|
00871 END-IF. DTSCS75
|
|
00872 DTSCS75
|
|
00873 IF WRK-CTR > 0 DTSCS75
|
|
00874 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L DTSCS75
|
|
00875 SET CURSOR-SET-YES TO TRUE DTSCS75
|
|
00876 SET WRK-TS-SCREEN-75-YES TO TRUE DTSCS75
|
|
00877 MOVE WRK-TS-AREA TO LCCM-SCR-HOLD-AREA DTSCS75
|
|
00878 SET WRK-TS-FOUND-YES TO TRUE DTSCS75
|
|
00879 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A DTSCS75
|
|
00880 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS75
|
|
00881 TO MAP-LINE-NUMBER-A DTSCS75
|
|
00882 ELSE DTSCS75
|
|
00883 SET WRK-TS-FOUND-NO TO TRUE DTSCS75
|
|
00884 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS75
|
|
00885 MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID. DTSCS75
|
|
00886 P6000-EXIT. DTSCS75
|
|
00887 EXIT. DTSCS75
|
|
00888 DTSCS75
|
|
00889 /*****************************************************************DTSCS75
|
|
00890 * ENTER KEY WAS PRESSED *DTSCS75
|
|
00891 ******************************************************************DTSCS75
|
|
00892 P6100-NO-PAGE. DTSCS75
|
|
00893 DTSCS75
|
|
00894 MOVE ITDS-KEY-AREA TO WRK-SCR-TDS-KEY DTSCS75
|
|
00895 MOVE ITDS-KEY-AREA TO WRK-TS-KEY(1) DTSCS75
|
|
00896 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS75
|
|
00897 VARYING WRK-SUB FROM 1 BY 1 DTSCS75
|
|
00898 UNTIL WRK-SUB > 12 DTSCS75
|
|
00899 OR L821-NO-REC-88. DTSCS75
|
|
00900 P6100-EXIT. DTSCS75
|
|
00901 EXIT. DTSCS75
|
|
00902 /*****************************************************************DTSCS75
|
|
00903 * //// *DTSCS75
|
|
00904 ******************************************************************DTSCS75
|
|
00905 P6200-PAGE-BACK. DTSCS75
|
|
00906 PERFORM S821-READ-PREV THRU S821-EXIT DTSCS75
|
|
00907 PERFORM S821-READ-PREV THRU S821-EXIT DTSCS75
|
|
00908 IF L821-NO-REC-88 DTSCS75
|
|
00909 MOVE WRK-TS-KEY(1) TO ITDS-KEY-AREA DTSCS75
|
|
00910 MOVE ITDS-KEY-AREA TO WRK-SCR-TDS-KEY DTSCS75
|
|
00911 MOVE 1 TO WRK-SUB DTSCS75
|
|
00912 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS75
|
|
00913 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS75
|
|
00914 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS75
|
|
00915 MOVE 2 TO WRK-SUB DTSCS75
|
|
00916 SET L821-NO-REC-88 TO TRUE DTSCS75
|
|
00917 ELSE DTSCS75
|
|
00918 MOVE ITDS-KEY-AREA TO WRK-SCR-TDS-KEY DTSCS75
|
|
00919 MOVE ITDS-KEY-AREA TO WRK-TS-KEY(1) DTSCS75
|
|
00920 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS75
|
|
00921 VARYING WRK-SUB FROM 1 BY 1 DTSCS75
|
|
00922 UNTIL WRK-SUB > 12 DTSCS75
|
|
00923 OR L821-NO-REC-88. DTSCS75
|
|
00924 DTSCS75
|
|
00925 IF L821-NO-REC-88 DTSCS75
|
|
00926 AND WRK-ADDL-CTR < 12 DTSCS75
|
|
00927 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS75
|
|
00928 IF WRK-ADDL-CTR = 0 DTSCS75
|
|
00929 MOVE WRK-TS-KEY(1) TO ITDS-KEY-AREA DTSCS75
|
|
00930 ELSE DTSCS75
|
|
00931 MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA DTSCS75
|
|
00932 END-IF DTSCS75
|
|
00933 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS75
|
|
00934 IF L821-OK-88 DTSCS75
|
|
00935 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS75
|
|
00936 SET LCCM-F08-88 TO TRUE DTSCS75
|
|
00937 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS75
|
|
00938 VARYING WRK-SUB FROM WRK-SUB BY 1 DTSCS75
|
|
00939 UNTIL WRK-SUB > 12 DTSCS75
|
|
00940 OR L821-NO-REC-88. DTSCS75
|
|
00941 P6200-EXIT. DTSCS75
|
|
00942 EXIT. DTSCS75
|
|
00943 DTSCS75
|
|
00944 /*****************************************************************DTSCS75
|
|
00945 * *DTSCS75
|
|
00946 ******************************************************************DTSCS75
|
|
00947 P6300-PAGE-NEXT. DTSCS75
|
|
00948 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS75
|
|
00949 IF L821-NO-REC-88 DTSCS75
|
|
00950 MOVE WRK-TS-KEY(1) TO ITDS-KEY-AREA DTSCS75
|
|
00951 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS75
|
|
00952 IF L821-NO-REC-88 DTSCS75
|
|
00953 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCS75
|
|
00954 ELSE DTSCS75
|
|
00955 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS75
|
|
00956 MOVE ISKL-KEY-AREA TO WRK-SCR-TDS-KEY DTSCS75
|
|
00957 MOVE ISKL-KEY-AREA TO WRK-TS-KEY(1) DTSCS75
|
|
00958 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS75
|
|
00959 VARYING WRK-SUB FROM 1 BY 1 DTSCS75
|
|
00960 UNTIL WRK-SUB > 12 DTSCS75
|
|
00961 OR L821-NO-REC-88 DTSCS75
|
|
00962 ELSE DTSCS75
|
|
00963 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS75
|
|
00964 VARYING WRK-SUB FROM 1 BY 1 DTSCS75
|
|
00965 UNTIL WRK-SUB > 12 DTSCS75
|
|
00966 OR L821-NO-REC-88. DTSCS75
|
|
00967 * THIS CORRECTS A PROBLEM WITH THE LAST PAGE BEING BLANK DTSCS75
|
|
00968 * ON A PGDN - PROBLEM IS I NEED TO READ THRU X # OF RECORDS DTSCS75
|
|
00969 * LOOKING FOR THE NEXT ONE THAT MEETS THE CRITERIA DTSCS75
|
|
00970 * SO IF I DIDN'T FIND ANY I WANT TO REBUILD THE SCREEN AS IT WAS DTSCS75
|
|
00971 IF WRK-ADDL-CTR = 0 DTSCS75
|
|
00972 MOVE WRK-TS-KEY(1) TO ISKL-KEY-AREA DTSCS75
|
|
00973 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS75
|
|
00974 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCS75
|
|
00975 IF L821-NO-REC-88 DTSCS75
|
|
00976 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCS75
|
|
00977 ELSE DTSCS75
|
|
00978 MOVE ISKL-KEY-AREA TO WRK-SCR-TDS-KEY DTSCS75
|
|
00979 MOVE ISKL-KEY-AREA TO WRK-TS-KEY(1) DTSCS75
|
|
00980 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS75
|
|
00981 VARYING WRK-SUB FROM 1 BY 1 DTSCS75
|
|
00982 UNTIL WRK-SUB > 12 DTSCS75
|
|
00983 OR L821-NO-REC-88. DTSCS75
|
|
00984 P6300-EXIT. DTSCS75
|
|
00985 EXIT. DTSCS75
|
|
00986 /*****************************************************************DTSCS75
|
|
00987 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS75
|
|
00988 ******************************************************************DTSCS75
|
|
00989 P6900-CONSTRUCT-SCREEN. DTSCS75
|
|
00990 DTSCS75
|
|
00991 SET WRK-REALLY-WANT-IT TO TRUE DTSCS75
|
|
00992 PERFORM P6910-DO-WE-WANT-IT THRU P6910-EXIT DTSCS75
|
|
00993 IF WRK-REALLY-DO-NOT-WANT-IT DTSCS75
|
|
00994 SUBTRACT 1 FROM WRK-SUB DTSCS75
|
|
00995 IF LCCM-F07-88 DTSCS75
|
|
00996 PERFORM S821-READ-PREV THRU S821-EXIT DTSCS75
|
|
00997 ELSE DTSCS75
|
|
00998 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS75
|
|
00999 END-IF DTSCS75
|
|
01000 GO TO P6900-EXIT DTSCS75
|
|
01001 END-IF DTSCS75
|
|
01002 DTSCS75
|
|
01003 ADD 1 TO WRK-ADDL-CTR DTSCS75
|
|
01004 IF LCCM-F07-88 DTSCS75
|
|
01005 PERFORM P6920-PUSH-STACK THRU P6920-EXIT DTSCS75
|
|
01006 VARYING WRK-CTR FROM WRK-SUB BY -1 DTSCS75
|
|
01007 UNTIL WRK-CTR < 2. DTSCS75
|
|
01008 DTSCS75
|
|
01009 IF LCCM-F07-88 DTSCS75
|
|
01010 COMPUTE WRK-CTR = 1 DTSCS75
|
|
01011 ELSE DTSCS75
|
|
01012 COMPUTE WRK-CTR = WRK-SUB. DTSCS75
|
|
01013 DTSCS75
|
|
01014 MOVE SPACES TO MAP-LINE-DATA(WRK-CTR) DTSCS75
|
|
01015 MOVE ITDS-KEY-AREA TO WRK-TS-KEY(WRK-CTR) DTSCS75
|
|
01016 PERFORM P6930-READ-FORMAT-TCK THRU P6930-EXIT. DTSCS75
|
|
01017 DTSCS75
|
|
01018 DTSCS75
|
|
01019 MOVE WRK-CTR TO MAP-LINE-NO(WRK-CTR). DTSCS75
|
|
01020 DTSCS75
|
|
01021 IF L821-NO-REC-88 DTSCS75
|
|
01022 GO TO P6900-EXIT. DTSCS75
|
|
01023 DTSCS75
|
|
01024 IF LCCM-F07-88 DTSCS75
|
|
01025 MOVE ITDS-KEY-AREA TO WRK-TS-KEY(1) DTSCS75
|
|
01026 PERFORM S821-READ-PREV THRU S821-EXIT DTSCS75
|
|
01027 ELSE DTSCS75
|
|
01028 MOVE ITDS-KEY-AREA TO WRK-TS-KEY(WRK-ADDL-CTR)DTSCS75
|
|
01029 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCS75
|
|
01030 P6900-EXIT. EXIT. DTSCS75
|
|
01031 DTSCS75
|
|
01032 P6910-DO-WE-WANT-IT. DTSCS75
|
|
01033 IF ITDS-TRIGGER-DATE < WRK-TRIGGER-DATE-FROM DTSCS75
|
|
01034 OR ITDS-TRIGGER-DATE > WRK-TRIGGER-DATE-TO DTSCS75
|
|
01035 SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE DTSCS75
|
|
01036 GO TO P6910-EXIT. DTSCS75
|
|
01037 DTSCS75
|
|
01038 IF MAP-ACKNOWLEDGED-IND = LOW-VALUES OR SPACES DTSCS75
|
|
01039 GO TO P6910-EXIT DTSCS75
|
|
01040 ELSE DTSCS75
|
|
01041 IF MAP-ACKNOWLEDGED-IND = 'Y' DTSCS75
|
|
01042 AND ITDS-ACKNOWLEDGED-DATE > +0 DTSCS75
|
|
01043 GO TO P6910-EXIT DTSCS75
|
|
01044 ELSE DTSCS75
|
|
01045 IF MAP-ACKNOWLEDGED-IND = 'N' DTSCS75
|
|
01046 AND ITDS-ACKNOWLEDGED-DATE = +0 DTSCS75
|
|
01047 GO TO P6910-EXIT DTSCS75
|
|
01048 ELSE DTSCS75
|
|
01049 SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE DTSCS75
|
|
01050 GO TO P6910-EXIT DTSCS75
|
|
01051 END-IF. DTSCS75
|
|
01052 DTSCS75
|
|
01053 DTSCS75
|
|
01054 SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE. DTSCS75
|
|
01055 P6910-EXIT. DTSCS75
|
|
01056 EXIT. DTSCS75
|
|
01057 P6920-PUSH-STACK. DTSCS75
|
|
01058 COMPUTE WRK-CTR2 = WRK-CTR - 1 DTSCS75
|
|
01059 MOVE MAP-LINE-DATA(WRK-CTR2) TO MAP-LINE-DATA(WRK-CTR) DTSCS75
|
|
01060 MOVE WRK-TS-KEY(WRK-CTR2) TO WRK-TS-KEY(WRK-CTR) DTSCS75
|
|
01061 MOVE WRK-CTR TO MAP-LINE-NO(WRK-CTR). DTSCS75
|
|
01062 P6920-EXIT. EXIT. DTSCS75
|
|
01063 DTSCS75
|
|
01064 P6930-READ-FORMAT-TCK. DTSCS75
|
|
01065 PERFORM P6935-READ-MTCK THRU P6935-EXIT. DTSCS75
|
|
01066 DTSCS75
|
|
01067 PERFORM P6936-READ-MPRF THRU P6936-EXIT. DTSCS75
|
|
01068 DTSCS75
|
|
01069 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME(WRK-CTR) DTSCS75
|
|
01070 DTSCS75
|
|
01071 IF ITDS-ACKNOWLEDGED-DATE > 0 DTSCS75
|
|
01072 MOVE ITDS-ACKNOWLEDGED-DATE TO L001-FED-8-DATE-9 DTSCS75
|
|
01073 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS75
|
|
01074 MOVE L001-SLASH-DATE TO MAP-ACKNOWLEDGE-DATE(WRK-CTR) DTSCS75
|
|
01075 END-IF. DTSCS75
|
|
01076 DTSCS75
|
|
01077 MOVE MTCK-TYPE TO MAP-TYPE(WRK-CTR) DTSCS75
|
|
01078 MOVE MTCK-SOURCE-OP-ID TO MAP-SOURCE(WRK-CTR) DTSCS75
|
|
01079 MOVE MTCK-EMP-NO TO MAP-EMP-NO(WRK-CTR). DTSCS75
|
|
01080 DTSCS75
|
|
01081 MOVE MTCK-TRIGGER-DATE TO L001-FED-8-DATE-9. DTSCS75
|
|
01082 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS75
|
|
01083 MOVE L001-SLASH-DATE TO MAP-TRIGGER-DATE(WRK-CTR). DTSCS75
|
|
01084 DTSCS75
|
|
01085 P6930-EXIT. EXIT. DTSCS75
|
|
01086 DTSCS75
|
|
01087 P6935-READ-MTCK. DTSCS75
|
|
01088 MOVE LOW-VALUES TO MTCK-KEY-AREA. DTSCS75
|
|
01089 MOVE ITDS-EMP-NO TO MTCK-EMP-NO. DTSCS75
|
|
01090 MOVE ITDS-ESTB-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS75
|
|
01091 SET MTCK-TCK-88 TO TRUE. DTSCS75
|
|
01092 DTSCS75
|
|
01093 MOVE MTCK-KEY-AREA TO MSKL-KEY-AREA. DTSCS75
|
|
01094 DTSCS75
|
|
01095 PERFORM S810-READ THRU S810-EXIT. DTSCS75
|
|
01096 DTSCS75
|
|
01097 IF L810-NO-REC-88 DTSCS75
|
|
01098 MOVE MTCK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS75
|
|
01099 MOVE MSG-E751-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01100 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS75
|
|
01101 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS75
|
|
01102 GO TO MAINLINE-EXIT. DTSCS75
|
|
01103 DTSCS75
|
|
01104 MOVE MSKL-REC TO MTCK-REC. DTSCS75
|
|
01105 P6935-EXIT. EXIT. DTSCS75
|
|
01106 DTSCS75
|
|
01107 P6936-READ-MPRF. DTSCS75
|
|
01108 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS75
|
|
01109 MOVE ITDS-EMP-NO TO MPRF-EMP-NO. DTSCS75
|
|
01110 SET MPRF-PRF-88 TO TRUE. DTSCS75
|
|
01111 DTSCS75
|
|
01112 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS75
|
|
01113 DTSCS75
|
|
01114 PERFORM S810-READ THRU S810-EXIT. DTSCS75
|
|
01115 DTSCS75
|
|
01116 IF L810-NO-REC-88 DTSCS75
|
|
01117 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS75
|
|
01118 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS75
|
|
01119 ELSE DTSCS75
|
|
01120 MOVE MSKL-REC TO MPRF-REC. DTSCS75
|
|
01121 P6936-EXIT. EXIT. DTSCS75
|
|
01122 DTSCS75
|
|
01123 /*****************************************************************DTSCS75
|
|
01124 * LINKS TO UTILITY MODULES DTSCS75
|
|
01125 ******************************************************************DTSCS75
|
|
01126 DTSCS75
|
|
01127 S001-FROM-FED-8. DTSCS75
|
|
01128 SET L001-FROM-FED-8 TO TRUE. DTSCS75
|
|
01129 GO TO S001-DATE. DTSCS75
|
|
01130 DTSCS75
|
|
01131 DTSCS75
|
|
01132 S001-DATE. DTSCS75
|
|
01133 EXEC CICS LINK DTSCS75
|
|
01134 PROGRAM('DTSCU001') DTSCS75
|
|
01135 COMMAREA(L001-COMM-AREA) DTSCS75
|
|
01136 END-EXEC. DTSCS75
|
|
01137 S001-EXIT. DTSCS75
|
|
01138 EXIT. DTSCS75
|
|
01139 DTSCS75
|
|
01140 DTSCS75
|
|
01141 S015-DATE-FROM-SCREEN. DTSCS75
|
|
01142 EXEC CICS LINK DTSCS75
|
|
01143 PROGRAM('DTSCU015') DTSCS75
|
|
01144 COMMAREA(L015-COMM-AREA) DTSCS75
|
|
01145 END-EXEC. DTSCS75
|
|
01146 S015-EXIT. DTSCS75
|
|
01147 EXIT. DTSCS75
|
|
01148 DTSCS75
|
|
01149 S803-REQ-SCR-ID-EDIT. DTSCS75
|
|
01150 EXEC CICS LINK DTSCS75
|
|
01151 PROGRAM ('DTSCU803') DTSCS75
|
|
01152 COMMAREA (DFHCOMMAREA) DTSCS75
|
|
01153 END-EXEC. DTSCS75
|
|
01154 S803-EXIT. DTSCS75
|
|
01155 EXIT. DTSCS75
|
|
01156 DTSCS75
|
|
01157 S804-INVALID-KEY. DTSCS75
|
|
01158 EXEC CICS LINK DTSCS75
|
|
01159 PROGRAM ('DTSCU804') DTSCS75
|
|
01160 COMMAREA (DFHCOMMAREA) DTSCS75
|
|
01161 END-EXEC. DTSCS75
|
|
01162 S804-EXIT. DTSCS75
|
|
01163 EXIT. DTSCS75
|
|
01164 DTSCS75
|
|
01165 S805-MSG-AREA. DTSCS75
|
|
01166 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS75
|
|
01167 DTSCS75
|
|
01168 EXEC CICS LINK DTSCS75
|
|
01169 PROGRAM ('DTSCU805') DTSCS75
|
|
01170 COMMAREA (L805-COMM-AREA) DTSCS75
|
|
01171 END-EXEC. DTSCS75
|
|
01172 DTSCS75
|
|
01173 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS75
|
|
01174 S805-EXIT. DTSCS75
|
|
01175 EXIT. DTSCS75
|
|
01176 EJECT DTSCS75
|
|
01177 S810-READ. DTSCS75
|
|
01178 SET L810-READ-88 TO TRUE. DTSCS75
|
|
01179 GO TO S810-IO. DTSCS75
|
|
01180 DTSCS75
|
|
01181 S810-START-BROWSE. DTSCS75
|
|
01182 SET L810-START-BROWSE-88 TO TRUE. DTSCS75
|
|
01183 GO TO S810-IO. DTSCS75
|
|
01184 DTSCS75
|
|
01185 S810-READ-NEXT. DTSCS75
|
|
01186 SET L810-READ-NEXT-88 TO TRUE. DTSCS75
|
|
01187 GO TO S810-IO. DTSCS75
|
|
01188 DTSCS75
|
|
01189 S810-READ-PREV. DTSCS75
|
|
01190 SET L810-READ-PREV-88 TO TRUE. DTSCS75
|
|
01191 GO TO S810-IO. DTSCS75
|
|
01192 DTSCS75
|
|
01193 S810-END-BROWSE. DTSCS75
|
|
01194 SET L810-END-BROWSE-88 TO TRUE. DTSCS75
|
|
01195 GO TO S810-IO. DTSCS75
|
|
01196 DTSCS75
|
|
01197 S810-COUNT. DTSCS75
|
|
01198 SET L810-COUNT-88 TO TRUE. DTSCS75
|
|
01199 GO TO S810-IO. DTSCS75
|
|
01200 DTSCS75
|
|
01201 S810-REWRITE. DTSCS75
|
|
01202 SET L810-REWRITE-88 TO TRUE. DTSCS75
|
|
01203 GO TO S810-IO. DTSCS75
|
|
01204 DTSCS75
|
|
01205 S810-WRITE. DTSCS75
|
|
01206 SET L810-WRITE-88 TO TRUE. DTSCS75
|
|
01207 GO TO S810-IO. DTSCS75
|
|
01208 DTSCS75
|
|
01209 S810-DELETE. DTSCS75
|
|
01210 SET L810-DELETE-88 TO TRUE. DTSCS75
|
|
01211 GO TO S810-IO. DTSCS75
|
|
01212 DTSCS75
|
|
01213 S810-IO. DTSCS75
|
|
01214 DTSCS75
|
|
01215 EXEC CICS LINK DTSCS75
|
|
01216 PROGRAM ('DTSCU810') DTSCS75
|
|
01217 COMMAREA (L810-COMM-AREA) DTSCS75
|
|
01218 END-EXEC. DTSCS75
|
|
01219 DTSCS75
|
|
01220 IF L810-FILE-CLOSED-88 DTSCS75
|
|
01221 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01222 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS75
|
|
01223 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS75
|
|
01224 GO TO MAINLINE-EXIT. DTSCS75
|
|
01225 S810-EXIT. DTSCS75
|
|
01226 EXIT. DTSCS75
|
|
01227 EJECT DTSCS75
|
|
01228 S821-START-BROWSE. DTSCS75
|
|
01229 SET L821-START-BROWSE-88 TO TRUE. DTSCS75
|
|
01230 GO TO S821-MASTER-IO. DTSCS75
|
|
01231 S821-END-BROWSE. DTSCS75
|
|
01232 SET L821-END-BROWSE-88 TO TRUE. DTSCS75
|
|
01233 GO TO S821-MASTER-IO. DTSCS75
|
|
01234 S821-READ-PREV. DTSCS75
|
|
01235 SET L821-READ-PREV-88 TO TRUE. DTSCS75
|
|
01236 GO TO S821-MASTER-IO. DTSCS75
|
|
01237 S821-READ-NEXT. DTSCS75
|
|
01238 SET L821-READ-NEXT-88 TO TRUE. DTSCS75
|
|
01239 GO TO S821-MASTER-IO. DTSCS75
|
|
01240 S821-MASTER-IO. DTSCS75
|
|
01241 EXEC CICS LINK DTSCS75
|
|
01242 PROGRAM ('DTSCU821') DTSCS75
|
|
01243 COMMAREA (L821-COMM-AREA) DTSCS75
|
|
01244 END-EXEC. DTSCS75
|
|
01245 IF L821-FILE-CLOSED-88 DTSCS75
|
|
01246 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01247 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS75
|
|
01248 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS75
|
|
01249 GO TO MAINLINE-EXIT DTSCS75
|
|
01250 ELSE DTSCS75
|
|
01251 PERFORM S821A-SIMULATE-NO-REC THRU S821A-EXIT. DTSCS75
|
|
01252 S821-EXIT. EXIT. DTSCS75
|
|
01253 DTSCS75
|
|
01254 S821A-SIMULATE-NO-REC. DTSCS75
|
|
01255 IF NOT L821-OK-88 DTSCS75
|
|
01256 GO TO S821A-EXIT. DTSCS75
|
|
01257 DTSCS75
|
|
01258 IF (ITDS-TDS-88) DTSCS75
|
|
01259 AND ITDS-DEST-OP-ID NOT = WRK-DEST-OP-ID DTSCS75
|
|
01260 SET L821-END-BROWSE-88 TO TRUE DTSCS75
|
|
01261 EXEC CICS LINK DTSCS75
|
|
01262 PROGRAM ('DTSCU821') DTSCS75
|
|
01263 COMMAREA (L821-COMM-AREA) DTSCS75
|
|
01264 END-EXEC DTSCS75
|
|
01265 IF WRK-ADDL-CTR > 0 DTSCS75
|
|
01266 MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA DTSCS75
|
|
01267 END-IF DTSCS75
|
|
01268 SET L821-NO-REC-88 TO TRUE DTSCS75
|
|
01269 GO TO S821A-EXIT. DTSCS75
|
|
01270 * I BELIEVE THAT WE CAN SET A BREAK ON RANGE OF DATES DTSCS75
|
|
01271 IF ITDS-TRIGGER-DATE < WRK-TRIGGER-DATE-FROM DTSCS75
|
|
01272 SET L821-END-BROWSE-88 TO TRUE DTSCS75
|
|
01273 EXEC CICS LINK DTSCS75
|
|
01274 PROGRAM ('DTSCU821') DTSCS75
|
|
01275 COMMAREA (L821-COMM-AREA) DTSCS75
|
|
01276 END-EXEC DTSCS75
|
|
01277 IF WRK-ADDL-CTR > 0 DTSCS75
|
|
01278 MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA DTSCS75
|
|
01279 END-IF DTSCS75
|
|
01280 SET L821-NO-REC-88 TO TRUE DTSCS75
|
|
01281 GO TO S821A-EXIT. DTSCS75
|
|
01282 DTSCS75
|
|
01283 IF ITDS-TRIGGER-DATE > WRK-TRIGGER-DATE-TO DTSCS75
|
|
01284 AND (NOT LCCM-F07-88) DTSCS75
|
|
01285 SET L821-END-BROWSE-88 TO TRUE DTSCS75
|
|
01286 EXEC CICS LINK DTSCS75
|
|
01287 PROGRAM ('DTSCU821') DTSCS75
|
|
01288 COMMAREA (L821-COMM-AREA) DTSCS75
|
|
01289 END-EXEC DTSCS75
|
|
01290 IF WRK-ADDL-CTR > 0 DTSCS75
|
|
01291 MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA DTSCS75
|
|
01292 END-IF DTSCS75
|
|
01293 SET L821-NO-REC-88 TO TRUE DTSCS75
|
|
01294 GO TO S821A-EXIT. DTSCS75
|
|
01295 S821A-EXIT. EXIT. DTSCS75
|
|
01296 DTSCS75
|
|
01297 DTSCS75
|
|
01298 S891-WRITE-TS. DTSCS75
|
|
01299 MOVE WRK-TS-AREA TO LCCM-SCR-HOLD-AREA. DTSCS75
|
|
01300 S891-EXIT. EXIT. DTSCS75
|
|
01301 DTSCS75
|
|
01302 S851-SCREEN-PROCESSING. DTSCS75
|
|
01303 EXEC CICS LINK DTSCS75
|
|
01304 PROGRAM ('DTSCU851') DTSCS75
|
|
01305 COMMAREA (L851-COMM-AREA) DTSCS75
|
|
01306 END-EXEC. DTSCS75
|
|
01307 S851-EXIT. DTSCS75
|
|
01308 EXIT. DTSCS75
|
|
01309 DTSCS75
|
|
01310 S899-ABEND. DTSCS75
|
|
01311 EXEC CICS ABEND DTSCS75
|
|
01312 ABCODE(WRK-ABEND-CD) DTSCS75
|
|
01313 END-EXEC. DTSCS75
|
|
01314 S899-EXIT. DTSCS75
|
|
01315 EXIT. DTSCS75
|
|
01316 /*****************************************************************DTSCS75
|
|
01317 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS75
|
|
01318 ******************************************************************DTSCS75
|
|
01319 DTSCS75
|
|
01320 S1000-SCREEN-EDITS. DTSCS75
|
|
01321 DTSCS75
|
|
01322 MOVE +0 TO WRK-CTR DTSCS75
|
|
01323 PERFORM S1100-DEST-OP-ID THRU S1100-EXIT. DTSCS75
|
|
01324 PERFORM S1200-ACKNOWLEDGED-IND THRU S1200-EXIT. DTSCS75
|
|
01325 PERFORM S1300-TRIGGER-DATE-RANGE THRU S1300-EXIT. DTSCS75
|
|
01326 DTSCS75
|
|
01327 S1000-EXIT. EXIT. DTSCS75
|
|
01328 EJECT DTSCS75
|
|
01329 /**************************************************************** DTSCS75
|
|
01330 * EDIT DEST-OP-ID REQUIRED DTSCS75
|
|
01331 * WASN'T SURE WE WANTED RESTRICTIONS INCLUDE OR COMMENT OUT DTSCS75
|
|
01332 ***************************************************************** DTSCS75
|
|
01333 S1100-DEST-OP-ID. DTSCS75
|
|
01334 IF MAP-DEST-OP-ID = LOW-VALUES OR SPACES DTSCS75
|
|
01335 ***********MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS75
|
|
01336 ***********PERFORM S1101-ERROR THRU S1101-EXIT DTSCS75
|
|
01337 ***********GO TO S1100-EXIT. DTSCS75
|
|
01338 DTSCS75
|
|
01339 MOVE LCCM-OP-ID TO MAP-DEST-OP-ID. DTSCS75
|
|
01340 DTSCS75
|
|
01341 MOVE LOW-VALUES TO ITDS-KEY-AREA DTSCS75
|
|
01342 SET ITDS-TDS-88 TO TRUE DTSCS75
|
|
01343 MOVE MAP-DEST-OP-ID TO ITDS-DEST-OP-ID DTSCS75
|
|
01344 WRK-DEST-OP-ID DTSCS75
|
|
01345 MOVE ZEROS TO ITDS-TRIGGER-DATE DTSCS75
|
|
01346 ITDS-ESTB-ABSTIME DTSCS75
|
|
01347 ITDS-TYPE DTSCS75
|
|
01348 ITDS-ACKNOWLEDGED-DATE DTSCS75
|
|
01349 ITDS-EMP-NO DTSCS75
|
|
01350 MOVE ITDS-KEY-AREA TO WRK-TS-KEY(1). DTSCS75
|
|
01351 S1100-EXIT. EXIT. DTSCS75
|
|
01352 DTSCS75
|
|
01353 S1101-ERROR. DTSCS75
|
|
01354 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DEST-OP-ID-A DTSCS75
|
|
01355 SET CURSOR-SET-YES TO TRUE. DTSCS75
|
|
01356 IF LCCM-NO-MSG DTSCS75
|
|
01357 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01358 MOVE CATB-CURSOR TO MAP-DEST-OP-ID-L. DTSCS75
|
|
01359 S1101-EXIT. EXIT. DTSCS75
|
|
01360 DTSCS75
|
|
01361 DTSCS75
|
|
01362 /**************************************************************** DTSCS75
|
|
01363 * ACTIVE ASSIGNMENTS INCLUDED IN SEARCH DTSCS75
|
|
01364 ***************************************************************** DTSCS75
|
|
01365 S1200-ACKNOWLEDGED-IND. DTSCS75
|
|
01366 MOVE SPACES TO WRK-ACKNOWLEDGED-IND DTSCS75
|
|
01367 IF MAP-ACKNOWLEDGED-IND = LOW-VALUES OR SPACES DTSCS75
|
|
01368 MOVE 'N' TO WRK-ACKNOWLEDGED-IND DTSCS75
|
|
01369 MOVE 'N' TO MAP-ACKNOWLEDGED-IND DTSCS75
|
|
01370 ELSE DTSCS75
|
|
01371 IF MAP-ACKNOWLEDGED-VALID DTSCS75
|
|
01372 MOVE MAP-ACKNOWLEDGED-IND TO WRK-ACKNOWLEDGED-IND DTSCS75
|
|
01373 ELSE DTSCS75
|
|
01374 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS75
|
|
01375 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS75
|
|
01376 S1200-EXIT. EXIT. DTSCS75
|
|
01377 DTSCS75
|
|
01378 S1201-ERROR. DTSCS75
|
|
01379 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACKNOWLEDGED-IND-A DTSCS75
|
|
01380 SET CURSOR-SET-YES TO TRUE. DTSCS75
|
|
01381 IF LCCM-NO-MSG DTSCS75
|
|
01382 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01383 MOVE CATB-CURSOR TO MAP-ACKNOWLEDGED-IND-L. DTSCS75
|
|
01384 S1201-EXIT. EXIT. DTSCS75
|
|
01385 /**************************************************************** DTSCS75
|
|
01386 * A PARTICULAR RANGE OF DATES INCLUDED IN SEARCH DTSCS75
|
|
01387 ***************************************************************** DTSCS75
|
|
01388 S1300-TRIGGER-DATE-RANGE. DTSCS75
|
|
01389 MOVE +0 TO WRK-TRIGGER-DATE-FROM DTSCS75
|
|
01390 MOVE +99999999 TO WRK-TRIGGER-DATE-TO DTSCS75
|
|
01391 DTSCS75
|
|
01392 MOVE MAP-TRIGGER-DATE-FROM-AREA TO L015-S-DATE-AREA. DTSCS75
|
|
01393 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS75
|
|
01394 DTSCS75
|
|
01395 IF L015-NO-ENTRY DTSCS75
|
|
01396 MOVE +0 TO WRK-TRIGGER-DATE-FROM DTSCS75
|
|
01397 ELSE DTSCS75
|
|
01398 IF L015-NOT-VALID DTSCS75
|
|
01399 MOVE +0 TO WRK-TRIGGER-DATE-FROM DTSCS75
|
|
01400 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS75
|
|
01401 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS75
|
|
01402 ELSE DTSCS75
|
|
01403 MOVE L015-DATE TO WRK-TRIGGER-DATE-FROM DTSCS75
|
|
01404 END-IF. DTSCS75
|
|
01405 DTSCS75
|
|
01406 MOVE MAP-TRIGGER-DATE-TO-AREA TO L015-S-DATE-AREA. DTSCS75
|
|
01407 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS75
|
|
01408 DTSCS75
|
|
01409 IF L015-NO-ENTRY DTSCS75
|
|
01410 MOVE +99999999 TO WRK-TRIGGER-DATE-TO DTSCS75
|
|
01411 ELSE DTSCS75
|
|
01412 IF L015-NOT-VALID DTSCS75
|
|
01413 MOVE +99999999 TO WRK-TRIGGER-DATE-TO DTSCS75
|
|
01414 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS75
|
|
01415 PERFORM S1302-ERROR THRU S1302-EXIT DTSCS75
|
|
01416 ELSE DTSCS75
|
|
01417 MOVE L015-DATE TO WRK-TRIGGER-DATE-TO DTSCS75
|
|
01418 END-IF. DTSCS75
|
|
01419 DTSCS75
|
|
01420 IF WRK-TRIGGER-DATE-TO < WRK-TRIGGER-DATE-FROM DTSCS75
|
|
01421 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS75
|
|
01422 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS75
|
|
01423 PERFORM S1302-ERROR THRU S1302-EXIT DTSCS75
|
|
01424 END-IF. DTSCS75
|
|
01425 MOVE WRK-TRIGGER-DATE-FROM TO ITDS-TRIGGER-DATE. DTSCS75
|
|
01426 MOVE ITDS-KEY-AREA TO WRK-TS-KEY(1). DTSCS75
|
|
01427 S1300-EXIT. EXIT. DTSCS75
|
|
01428 DTSCS75
|
|
01429 S1301-ERROR. DTSCS75
|
|
01430 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS75
|
|
01431 TO MAP-TRIGGER-DATE-FROM-YR-A DTSCS75
|
|
01432 MAP-TRIGGER-DATE-FROM-MO-A DTSCS75
|
|
01433 MAP-TRIGGER-DATE-FROM-DA-A DTSCS75
|
|
01434 SET CURSOR-SET-YES TO TRUE. DTSCS75
|
|
01435 IF LCCM-NO-MSG DTSCS75
|
|
01436 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01437 MOVE CATB-CURSOR TO MAP-TRIGGER-DATE-FROM-MO-L. DTSCS75
|
|
01438 S1301-EXIT. EXIT. DTSCS75
|
|
01439 DTSCS75
|
|
01440 S1302-ERROR. DTSCS75
|
|
01441 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TRIGGER-DATE-TO-YR-A DTSCS75
|
|
01442 MAP-TRIGGER-DATE-TO-MO-A DTSCS75
|
|
01443 MAP-TRIGGER-DATE-TO-DA-A DTSCS75
|
|
01444 SET CURSOR-SET-YES TO TRUE. DTSCS75
|
|
01445 IF LCCM-NO-MSG DTSCS75
|
|
01446 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01447 MOVE CATB-CURSOR TO MAP-TRIGGER-DATE-TO-MO-L.DTSCS75
|
|
01448 S1302-EXIT. EXIT. DTSCS75
|
|
01449 DTSCS75
|
|
01450 /**************************************************************** DTSCS75
|
|
01451 * SCREEN SELECT AND LINE NUMBER ERROR ROUTINES DTSCS75
|
|
01452 ***************************************************************** DTSCS75
|
|
01453 S1901-MAP-LINE-ERROR. DTSCS75
|
|
01454 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LINE-NUMBER-A DTSCS75
|
|
01455 SET CURSOR-SET-YES TO TRUE. DTSCS75
|
|
01456 IF LCCM-NO-MSG DTSCS75
|
|
01457 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01458 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L. DTSCS75
|
|
01459 S1901-EXIT. EXIT. DTSCS75
|
|
01460 DTSCS75
|
|
01461 S2001-SELECT-SCREEN-ERROR. DTSCS75
|
|
01462 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SCREEN-ID-A DTSCS75
|
|
01463 SET CURSOR-SET-YES TO TRUE. DTSCS75
|
|
01464 IF LCCM-NO-MSG DTSCS75
|
|
01465 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS75
|
|
01466 MOVE CATB-CURSOR TO MAP-SCREEN-ID-L. DTSCS75
|
|
01467 S2001-EXIT. EXIT. DTSCS75
|
|
01468 ******************************************************************DTSCS75
|
|
01469 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS75
|
|
01470 ******************************************************************DTSCS75
|
|
01471 S5300-SET-INQ-ATTRB. DTSCS75
|
|
01472 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS75
|
|
01473 WRK-ATB-NUM. DTSCS75
|
|
01474 DTSCS75
|
|
01475 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS75
|
|
01476 S5300-EXIT. DTSCS75
|
|
01477 EXIT. DTSCS75
|
|
01478 DTSCS75
|
|
01479 S5900-SET-ATTRB. DTSCS75
|
|
01480 MOVE LOW-VALUES TO MAP-DEST-OP-ID-A DTSCS75
|
|
01481 MAP-ACKNOWLEDGED-IND-A DTSCS75
|
|
01482 MAP-TRIGGER-DATE-FROM-YR-ADTSCS75
|
|
01483 MAP-TRIGGER-DATE-FROM-MO-ADTSCS75
|
|
01484 MAP-TRIGGER-DATE-FROM-DA-ADTSCS75
|
|
01485 MAP-TRIGGER-DATE-TO-YR-A DTSCS75
|
|
01486 MAP-TRIGGER-DATE-TO-MO-A DTSCS75
|
|
01487 MAP-TRIGGER-DATE-TO-DA-A DTSCS75
|
|
01488 PERFORM S5910-TABLE THRU S5910-EXIT DTSCS75
|
|
01489 VARYING WRK-CTR FROM 1 BY 1 DTSCS75
|
|
01490 UNTIL WRK-CTR > 12. DTSCS75
|
|
01491 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS75
|
|
01492 S5900-EXIT. EXIT. DTSCS75
|
|
01493 DTSCS75
|
|
01494 S5910-TABLE. DTSCS75
|
|
01495 MOVE CATB-ASKIP-BRT-MDTON TO MAP-LINE-A(WRK-CTR). DTSCS75
|
|
01496 S5910-EXIT. EXIT. DTSCS75
|
|
01497 /*************************************************************** DTSCS75
|
|
01498 * THESE ATTRIBUTES ARE BUILT PRIOR TO THE SEND BASED ON THE DTSCS75
|
|
01499 * SEARCH RESULTS AND SCREEN STATUS DTSCS75
|
|
01500 **************************************************************** DTSCS75
|
|
01501 S5920-ATTRIBUTES. DTSCS75
|
|
01502 IF WRK-TS-FOUND-YES DTSCS75
|
|
01503 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A DTSCS75
|
|
01504 ELSE DTSCS75
|
|
01505 IF WRK-TS-FOUND-NO DTSCS75
|
|
01506 MOVE CATB-ASKIP-NORM-MDTON TO MAP-SCREEN-ID-A. DTSCS75
|
|
01507 DTSCS75
|
|
01508 IF WRK-TS-FOUND-YES DTSCS75
|
|
01509 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-LINE-NUMBER-A DTSCS75
|
|
01510 ELSE DTSCS75
|
|
01511 IF WRK-TS-FOUND-NO DTSCS75
|
|
01512 MOVE CATB-ASKIP-NORM-MDTON TO MAP-LINE-NUMBER-A. DTSCS75
|
|
01513 DTSCS75
|
|
01514 IF WRK-TS-FOUND-NO AND MAP-DEST-OP-ID-A = LOW-VALUES DTSCS75
|
|
01515 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-DEST-OP-ID-A DTSCS75
|
|
01516 ELSE DTSCS75
|
|
01517 IF WRK-TS-FOUND-YES DTSCS75
|
|
01518 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DEST-OP-ID-A. DTSCS75
|
|
01519 DTSCS75
|
|
01520 IF WRK-TS-FOUND-NO AND MAP-ACKNOWLEDGED-IND-A = LOW-VALUES DTSCS75
|
|
01521 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-ACKNOWLEDGED-IND-A DTSCS75
|
|
01522 ELSE DTSCS75
|
|
01523 IF WRK-TS-FOUND-YES DTSCS75
|
|
01524 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ACKNOWLEDGED-IND-A. DTSCS75
|
|
01525 DTSCS75
|
|
01526 IF WRK-TS-FOUND-NO DTSCS75
|
|
01527 AND MAP-TRIGGER-DATE-FROM-MO-A = LOW-VALUES DTSCS75
|
|
01528 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS75
|
|
01529 TO MAP-TRIGGER-DATE-FROM-MO-A DTSCS75
|
|
01530 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS75
|
|
01531 TO MAP-TRIGGER-DATE-FROM-DA-A DTSCS75
|
|
01532 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS75
|
|
01533 TO MAP-TRIGGER-DATE-FROM-YR-A DTSCS75
|
|
01534 ELSE DTSCS75
|
|
01535 IF WRK-TS-FOUND-YES DTSCS75
|
|
01536 MOVE CATB-ASKIP-NORM-MDTON DTSCS75
|
|
01537 TO MAP-TRIGGER-DATE-FROM-MO-A DTSCS75
|
|
01538 MOVE CATB-ASKIP-NORM-MDTON DTSCS75
|
|
01539 TO MAP-TRIGGER-DATE-FROM-DA-A DTSCS75
|
|
01540 MOVE CATB-ASKIP-NORM-MDTON TO MAP-TRIGGER-DATE-FROM-YR-A. DTSCS75
|
|
01541 DTSCS75
|
|
01542 IF WRK-TS-FOUND-NO DTSCS75
|
|
01543 AND MAP-TRIGGER-DATE-TO-MO-A = LOW-VALUES DTSCS75
|
|
01544 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS75
|
|
01545 TO MAP-TRIGGER-DATE-TO-MO-A DTSCS75
|
|
01546 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS75
|
|
01547 TO MAP-TRIGGER-DATE-TO-DA-A DTSCS75
|
|
01548 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCS75
|
|
01549 TO MAP-TRIGGER-DATE-TO-YR-A DTSCS75
|
|
01550 ELSE DTSCS75
|
|
01551 IF WRK-TS-FOUND-YES DTSCS75
|
|
01552 MOVE CATB-ASKIP-NORM-MDTON DTSCS75
|
|
01553 TO MAP-TRIGGER-DATE-TO-MO-A DTSCS75
|
|
01554 MOVE CATB-ASKIP-NORM-MDTON DTSCS75
|
|
01555 TO MAP-TRIGGER-DATE-TO-DA-A DTSCS75
|
|
01556 MOVE CATB-ASKIP-NORM-MDTON DTSCS75
|
|
01557 TO MAP-TRIGGER-DATE-TO-YR-A. DTSCS75
|
|
01558 DTSCS75
|
|
01559 S5920-EXIT. EXIT. DTSCS75
|
|
01560 EJECT DTSCS75
|
|
01561 /*****************************************************************DTSCS75
|
|
01562 * MAP ROUTINES *DTSCS75
|
|
01563 ******************************************************************DTSCS75
|
|
01564 S9100-RECEIVE. DTSCS75
|
|
01565 SET L851-RECEIVE-88 TO TRUE. DTSCS75
|
|
01566 DTSCS75
|
|
01567 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS75
|
|
01568 DTSCS75
|
|
01569 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS75
|
|
01570 DTSCS75
|
|
01571 MOVE L851-AID TO LCCM-AID. DTSCS75
|
|
01572 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS75
|
|
01573 S9100-EXIT. DTSCS75
|
|
01574 EXIT. DTSCS75
|
|
01575 DTSCS75
|
|
01576 S9200-SEND-DATAONLY. DTSCS75
|
|
01577 MOVE LOW-VALUES TO MAP-AREA. DTSCS75
|
|
01578 DTSCS75
|
|
01579 IF LCCM-NO-MSG DTSCS75
|
|
01580 NEXT SENTENCE DTSCS75
|
|
01581 ELSE DTSCS75
|
|
01582 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS75
|
|
01583 DTSCS75
|
|
01584 IF CURSOR-SET-GOTO DTSCS75
|
|
01585 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS75
|
|
01586 ELSE DTSCS75
|
|
01587 IF CURSOR-SET-NO DTSCS75
|
|
01588 MOVE CATB-CURSOR TO MAP-DEST-OP-ID-L. DTSCS75
|
|
01589 DTSCS75
|
|
01590 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS75
|
|
01591 DTSCS75
|
|
01592 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS75
|
|
01593 DTSCS75
|
|
01594 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS75
|
|
01595 S9200-EXIT. DTSCS75
|
|
01596 EXIT. DTSCS75
|
|
01597 DTSCS75
|
|
01598 S9300-SEND-MAP. DTSCS75
|
|
01599 PERFORM S5920-ATTRIBUTES THRU S5920-EXIT. DTSCS75
|
|
01600 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS75
|
|
01601 MOVE SPACES TO MAP-SYS-TIME. DTSCS75
|
|
01602 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS75
|
|
01603 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS75
|
|
01604 DTSCS75
|
|
01605 IF SCR-ACCESS-UPDATE DTSCS75
|
|
01606 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS75
|
|
01607 ELSE DTSCS75
|
|
01608 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS75
|
|
01609 DTSCS75
|
|
01610 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS75
|
|
01611 DTSCS75
|
|
01612 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS75
|
|
01613 DTSCS75
|
|
01614 IF CURSOR-SET-NO DTSCS75
|
|
01615 MOVE CATB-CURSOR TO MAP-DEST-OP-ID-L. DTSCS75
|
|
01616 DTSCS75
|
|
01617 SET L851-SEND-88 TO TRUE. DTSCS75
|
|
01618 DTSCS75
|
|
01619 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS75
|
|
01620 DTSCS75
|
|
01621 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS75
|
|
01622 S9300-EXIT. DTSCS75
|
|
01623 EXIT. DTSCS75
|
|
01624 DTSCS75
|
|
01625 S9310-UPDATE-FKEYS. DTSCS75
|
|
01626 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS75
|
|
01627 DTSCS75
|
|
01628 S9310-EXIT. DTSCS75
|
|
01629 EXIT. DTSCS75
|
|
01630 DTSCS75
|
|
01631 S9320-INQUIRY-FKEYS. DTSCS75
|
|
01632 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS75
|
|
01633 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS75
|
|
01634 MOVE CFKD-NEW-SEARCH TO MAP-KEY-TICK-INQ. DTSCS75
|
|
01635 DTSCS75
|
|
01636 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS75
|
|
01637 S9320-EXIT. DTSCS75
|
|
01638 EXIT. DTSCS75
|
|
01639 DTSCS75
|
|
01640 *S9321-JUMP-KEYS. DTSCS75
|
|
01641 *****MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS75
|
|
01642 *****MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS75
|
|
01643 *****MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS75
|
|
01644 *****MOVE CFKD-TICK-INQ TO MAP-KEY-TICK-INQ. DTSCS75
|
|
01645 *S9321-EXIT. DTSCS75
|
|
01646 *****EXIT. DTSCS75
|
|
01647 DTSCS75
|
|
01648 S9330-DSCR-FIELDS. DTSCS75
|
|
01649 S9330-EXIT. EXIT. DTSCS75
|
|
01650 DTSCS75
|
|
01651 DTSCS75
|
|
01652 S9900-PREPARE-SEND. DTSCS75
|
|
01653 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS75
|
|
01654 LCCM-SCR-ID. DTSCS75
|
|
01655 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS75
|
|
01656 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS75
|
|
01657 S9900-EXIT. DTSCS75
|
|
01658 EXIT. DTSCS75
|