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