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