00001 IDENTIFICATION DIVISION. 12/29/16 00002 PROGRAM-ID. DTSCS37. DTSCS37 00003 AUTHOR. TRW. LV024 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 * 11/10/2016 PAYMENT SCREEN UPDATE FOR MULTIPLE EMPLOYERS CL*10 00018 * FOR SAME PAYMENT ID CL*10 00019 * REFERENCE: PROGRAMMER:N GUPTA CL*10 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 '024DTSCS37 12/29/16'. 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 000000 MOVE +0 TO PAGE-LINE-CNT. 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. CL**8 01016 PERFORM CL*18 01017 UNTIL L821-NO-REC-88 CL*18 01018 MOVE ISKL-REC TO ITRT-REC CL*18 01019 * PERFORM UNTIL ITRT-TRACE-NO NOT= WRK-TRACE-NO CL*18 01020 IF ITRT-TRACE-NO = WRK-TRACE-NO CL*11 01021 SET WRK-SELECT-NO-88 TO TRUE CL*18 01022 PERFORM P7110-FIND-MPAY THRU P7110-EXIT CL*14 01023 IF WRK-SELECT-YES-88 CL*18 01024 PERFORM P7900-FIND-MREV THRU P7900-EXIT CL*11 01025 END-IF CL*18 01026 PERFORM S821-READ-NEXT THRU S821-EXIT CL**5 01027 ELSE CL*18 01028 SET L821-NO-REC-88 TO TRUE CL*18 01029 END-IF CL*18 01030 * MOVE ISKL-REC TO ITRT-REC CL*18 01031 END-PERFORM. CL*18 01032 PERFORM S821-END-BROWSE THRU S821-EXIT CL**4 01033 * CL**8 01034 * ELSE CL*11 01035 * GO TO P7100-EXIT. CL*11 01036 DTSCS37 01037 IF PAGE-LINE-CNT > +0 DTSCS37 01038 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS37 01039 DTSCS37 01040 P7100-EXIT. DTSCS37 01041 EXIT. DTSCS37 01042 SKIP3 DTSCS37 01043 P7110-FIND-MPAY. DTSCS37 01044 MOVE LOW-VALUE TO MPAY-REC. DTSCS37 01045 MOVE LOW-VALUE TO MSKL-REC. CL*15 01046 MOVE ITRT-EMP-NO TO MPAY-EMP-NO. DTSCS37 01047 SET MPAY-PAY-88 TO TRUE. DTSCS37 01048 MOVE ITRT-BATCH-NO TO MPAY-BATCH-NO. DTSCS37 01049 MOVE ITRT-ITEM-NO TO MPAY-ITEM-NO. DTSCS37 01050 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 01051 PERFORM S810-READ THRU S810-EXIT. DTSCS37 01052 IF L810-OK-88 DTSCS37 01053 MOVE MSKL-REC TO MPAY-REC DTSCS37 01054 PERFORM P7211-CHECK-TYPE THRU P7211-EXIT CL*19 01055 IF WRK-SELECT-YES-88 CL*19 01056 PERFORM P7212-CHECK-DATES THRU P7212-EXIT CL*19 01057 IF WRK-SELECT-YES-88 CL*19 01058 PERFORM P7800-MPAY-TO-PAGE-LINE THRU P7800-EXIT. CL*19 01059 DTSCS37 01060 P7110-EXIT. DTSCS37 01061 EXIT. DTSCS37 01062 SKIP3 DTSCS37 01063 SKIP3 DTSCS37 01064 P7200-EMP-NO-SEARCH. DTSCS37 01065 MOVE LOW-VALUES TO ITRE-KEY-AREA. DTSCS37 01066 SET ITRE-TRE-88 TO TRUE. DTSCS37 01067 MOVE WRK-EMP-NO TO ITRE-EMP-NO. DTSCS37 01068 MOVE ZERO TO ITRE-RCVD-DATE-XOR DTSCS37 01069 ITRE-TRACE-NO DTSCS37 01070 ITRE-BATCH-NO DTSCS37 01071 ITRE-ITEM-NO. DTSCS37 01072 MOVE ITRE-KEY-AREA TO ISKL-KEY-AREA. DTSCS37 01073 DTSCS37 01074 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS37 01075 DTSCS37 01076 IF L810-NO-REC-88 DTSCS37 01077 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 01078 GO TO P7200-EXIT DTSCS37 01079 ELSE DTSCS37 01080 PERFORM DTSCS37 01081 UNTIL L821-NO-REC-88 DTSCS37 01082 MOVE ISKL-REC TO ITRE-REC DTSCS37 01083 IF ITRE-EMP-NO = WRK-EMP-NO DTSCS37 01084 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 01085 PERFORM P7210-FIND-MPAY THRU P7210-EXIT DTSCS37 01086 IF WRK-SELECT-YES-88 DTSCS37 01087 PERFORM P7900-FIND-MREV THRU P7900-EXIT DTSCS37 01088 END-IF DTSCS37 01089 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS37 01090 ELSE DTSCS37 01091 SET L821-NO-REC-88 TO TRUE DTSCS37 01092 END-IF DTSCS37 01093 END-PERFORM. DTSCS37 01094 DTSCS37 01095 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 01096 DTSCS37 01097 IF PAGE-LINE-CNT > +0 DTSCS37 01098 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS37 01099 DTSCS37 01100 P7200-EXIT. DTSCS37 01101 EXIT. DTSCS37 01102 DTSCS37 01103 P7210-FIND-MPAY. DTSCS37 01104 MOVE LOW-VALUE TO MPAY-REC. DTSCS37 01105 MOVE LOW-VALUE TO MSKL-REC. CL*15 01106 MOVE ITRE-EMP-NO TO MPAY-EMP-NO. DTSCS37 01107 SET MPAY-PAY-88 TO TRUE. DTSCS37 01108 MOVE ITRE-BATCH-NO TO MPAY-BATCH-NO. DTSCS37 01109 MOVE ITRE-ITEM-NO TO MPAY-ITEM-NO. DTSCS37 01110 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 01111 PERFORM S810-READ THRU S810-EXIT. DTSCS37 01112 IF L810-OK-88 DTSCS37 01113 MOVE MSKL-REC TO MPAY-REC DTSCS37 01114 PERFORM P7211-CHECK-TYPE THRU P7211-EXIT DTSCS37 01115 IF WRK-SELECT-YES-88 DTSCS37 01116 PERFORM P7212-CHECK-DATES THRU P7212-EXIT DTSCS37 01117 IF WRK-SELECT-YES-88 DTSCS37 01118 PERFORM P7800-MPAY-TO-PAGE-LINE THRU P7800-EXIT. DTSCS37 01119 DTSCS37 01120 P7210-EXIT. DTSCS37 01121 EXIT. DTSCS37 01122 SKIP3 DTSCS37 01123 P7211-CHECK-TYPE. DTSCS37 01124 IF MPAY-PAYMENT-88 DTSCS37 01125 OR MPAY-REF-REV-88 DTSCS37 01126 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 01127 ELSE DTSCS37 01128 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 01129 END-IF. DTSCS37 01130 DTSCS37 01131 P7211-EXIT. DTSCS37 01132 EXIT. DTSCS37 01133 SKIP3 DTSCS37 01134 P7212-CHECK-DATES. DTSCS37 01135 IF WRK-DATE1 NOT = ZERO DTSCS37 01136 IF WRK-DATE2 = ZERO DTSCS37 01137 IF MPAY-RECEIVED-DATE = WRK-DATE1 DTSCS37 01138 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 01139 ELSE DTSCS37 01140 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 01141 END-IF DTSCS37 01142 ELSE DTSCS37 01143 IF MPAY-RECEIVED-DATE >= WRK-DATE1 DTSCS37 01144 AND MPAY-RECEIVED-DATE <= WRK-DATE2 DTSCS37 01145 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 01146 ELSE DTSCS37 01147 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 01148 END-IF DTSCS37 01149 END-IF DTSCS37 01150 ELSE DTSCS37 01151 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 01152 END-IF. DTSCS37 01153 DTSCS37 01154 P7212-EXIT. DTSCS37 01155 EXIT. DTSCS37 01156 SKIP3 DTSCS37 01157 P7800-MPAY-TO-PAGE-LINE. DTSCS37 01158 IF PAGE-LINE-CNT < LINES-PER-PAGE DTSCS37 01159 NEXT SENTENCE DTSCS37 01160 ELSE DTSCS37 01161 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS37 01162 MOVE +0 TO PAGE-LINE-CNT. DTSCS37 01163 DTSCS37 01164 ADD +1 TO PAGE-LINE-CNT. DTSCS37 01165 DTSCS37 01166 MOVE MPAY-EMP-NO TO PAGE-EMP-NO (PAGE-LINE-CNT). DTSCS37 01167 MOVE MPAY-PAY-TYPE TO PAGE-PAY-TYPE (PAGE-LINE-CNT). DTSCS37 01168 MOVE MPAY-BATCH-NO TO PAGE-BATCH-NO (PAGE-LINE-CNT). DTSCS37 01169 MOVE MPAY-ITEM-NO TO PAGE-ITEM-NO (PAGE-LINE-CNT). DTSCS37 01170 MOVE MPAY-TRACE-NO TO PAGE-TRACE-NO (PAGE-LINE-CNT). DTSCS37 01171 MOVE MPAY-REMIT-AMT DTSCS37 01172 TO PAGE-AMT (PAGE-LINE-CNT). DTSCS37 01173 MOVE MPAY-RECEIVED-DATE DTSCS37 01174 TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT). DTSCS37 01175 MOVE MPAY-ESTB-DATE DTSCS37 01176 TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT). DTSCS37 01177 DTSCS37 01178 P7800-EXIT. DTSCS37 01179 EXIT. DTSCS37 01180 DTSCS37 01181 P7900-FIND-MREV. DTSCS37 01182 MOVE LOW-VALUE TO MREV-REC. DTSCS37 01183 MOVE LOW-VALUE TO MSKL-REC. CL*15 01184 MOVE MPAY-EMP-NO TO MREV-EMP-NO. DTSCS37 01185 SET MREV-REV-88 TO TRUE. DTSCS37 01186 MOVE MPAY-BATCH-NO TO MREV-PA-BATCH-NO. DTSCS37 01187 MOVE MPAY-ITEM-NO TO MREV-PA-ITEM-NO. DTSCS37 01188 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 01189 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS37 01190 DTSCS37 01191 PERFORM DTSCS37 01192 UNTIL L810-NO-REC-88 CL*21 01193 MOVE MSKL-REC TO MREV-REC DTSCS37 01194 IF MREV-PA-DOC-NO = MPAY-DOC-NO CL*24 01195 PERFORM P7910-MREV-TO-PAGE-LINE THRU P7910-EXIT DTSCS37 01196 END-IF CL*24 01197 PERFORM S810-READ-NEXT THRU S810-EXIT CL*24 01198 END-PERFORM. DTSCS37 01199 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS37 01200 DTSCS37 01201 P7900-EXIT. DTSCS37 01202 EXIT. DTSCS37 01203 SKIP3 DTSCS37 01204 P7910-MREV-TO-PAGE-LINE. DTSCS37 01205 IF PAGE-LINE-CNT < LINES-PER-PAGE DTSCS37 01206 NEXT SENTENCE DTSCS37 01207 ELSE DTSCS37 01208 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS37 01209 MOVE +0 TO PAGE-LINE-CNT. DTSCS37 01210 DTSCS37 01211 ADD +1 TO PAGE-LINE-CNT. DTSCS37 01212 DTSCS37 01213 MOVE MREV-EMP-NO TO PAGE-EMP-NO (PAGE-LINE-CNT). DTSCS37 01214 MOVE MREV-FATE TO PAGE-PAY-TYPE (PAGE-LINE-CNT). DTSCS37 01215 MOVE MREV-PU-RF-PR-BATCH-NO DTSCS37 01216 TO PAGE-BATCH-NO (PAGE-LINE-CNT). DTSCS37 01217 MOVE MREV-PU-RF-PR-ITEM-NO DTSCS37 01218 TO PAGE-ITEM-NO (PAGE-LINE-CNT). DTSCS37 01219 MOVE ZERO TO PAGE-TRACE-NO (PAGE-LINE-CNT). DTSCS37 01220 COMPUTE PAGE-AMT (PAGE-LINE-CNT) = DTSCS37 01221 (MREV-AMT * -1). DTSCS37 01222 *& MOVE MPAY-RECEIVED-DATE DTSCS37 01223 *& TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT). DTSCS37 01224 MOVE MREV-ESTB-DATE DTSCS37 01225 TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT). DTSCS37 01226 DTSCS37 01227 P7910-EXIT. DTSCS37 01228 EXIT. DTSCS37 01229 DTSCS37 01230 P8100-STORE-PAGE-AREA. DTSCS37 01231 IF ITEM-CNT < ITEM-MAX-LCCM DTSCS37 01232 ADD +1 TO ITEM-CNT DTSCS37 01233 MOVE PAGE-AREA TO LCCM-SCR-HOLD-PAGE-AREA (ITEM-CNT) DTSCS37 01234 GO TO P8100-EXIT. DTSCS37 01235 DTSCS37 01236 IF ITEM-CNT < ITEM-MAX DTSCS37 01237 ADD +1 TO ITEM-CNT DTSCS37 01238 MOVE PAGE-AREA TO L829-REC DTSCS37 01239 PERFORM S829-WRITE THRU S829-EXIT. DTSCS37 01240 P8100-EXIT. DTSCS37 01241 EXIT. DTSCS37 01242 SKIP3 DTSCS37 01243 P8200-RETREIVE-PAGE-AREA. DTSCS37 01244 IF ITEM-SUB > ITEM-MAX-LCCM DTSCS37 01245 COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM DTSCS37 01246 PERFORM S829-READ-ITEM THRU S829-EXIT DTSCS37 01247 IF L829-NO-REC-88 DTSCS37 01248 GO TO S899-ABEND DTSCS37 01249 ELSE DTSCS37 01250 MOVE L829-REC TO PAGE-AREA DTSCS37 01251 ELSE DTSCS37 01252 MOVE LCCM-SCR-HOLD-PAGE-AREA (ITEM-SUB) TO PAGE-AREA. DTSCS37 01253 P8200-EXIT. DTSCS37 01254 EXIT. DTSCS37 01255 /*****************************************************************DTSCS37 01256 * LINKS TO UTILITY MODULES DTSCS37 01257 ******************************************************************DTSCS37 01258 SKIP1 DTSCS37 01259 S001-FROM-FED-8. DTSCS37 01260 SET L001-FROM-FED-8 TO TRUE. DTSCS37 01261 GO TO S001-DATE. DTSCS37 01262 SKIP1 DTSCS37 01263 *S001-FROM-ABS-DATE. DTSCS37 01264 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS37 01265 *****GO TO S001-DATE. DTSCS37 01266 *****SKIP1 DTSCS37 01267 S001-DATE. DTSCS37 01268 EXEC CICS LINK DTSCS37 01269 PROGRAM('DTSCU001') DTSCS37 01270 COMMAREA(L001-COMM-AREA) DTSCS37 01271 END-EXEC. DTSCS37 01272 S001-EXIT. DTSCS37 01273 EXIT. DTSCS37 01274 SKIP3 DTSCS37 01275 S004-FROM-5. DTSCS37 01276 SET L004-FROM-5 TO TRUE. DTSCS37 01277 GO TO S004-QTR. DTSCS37 01278 SKIP1 DTSCS37 01279 S004-FROM-ABS. DTSCS37 01280 SET L004-FROM-ABS TO TRUE. DTSCS37 01281 GO TO S004-QTR. DTSCS37 01282 SKIP1 DTSCS37 01283 S004-QTR. DTSCS37 01284 EXEC CICS LINK DTSCS37 01285 PROGRAM('DTSCU004') DTSCS37 01286 COMMAREA(L004-COMM-AREA) DTSCS37 01287 END-EXEC. DTSCS37 01288 S004-EXIT. DTSCS37 01289 EXIT. DTSCS37 01290 SKIP3 DTSCS37 01291 S015-DATE-FROM-SCREEN. DTSCS37 01292 EXEC CICS LINK DTSCS37 01293 PROGRAM('DTSCU015') DTSCS37 01294 COMMAREA(L015-COMM-AREA) DTSCS37 01295 END-EXEC. DTSCS37 01296 S015-EXIT. DTSCS37 01297 EXIT. DTSCS37 01298 SKIP3 DTSCS37 01299 S018-EMP-NO-FROM-SCREEN. DTSCS37 01300 EXEC CICS LINK DTSCS37 01301 PROGRAM('DTSCU018') DTSCS37 01302 COMMAREA(L018-COMM-AREA) DTSCS37 01303 END-EXEC. DTSCS37 01304 S018-EXIT. DTSCS37 01305 EXIT. DTSCS37 01306 SKIP3 DTSCS37 01307 S803-REQ-SCR-ID-EDIT. DTSCS37 01308 EXEC CICS LINK DTSCS37 01309 PROGRAM ('DTSCU803') DTSCS37 01310 COMMAREA (DFHCOMMAREA) DTSCS37 01311 END-EXEC. DTSCS37 01312 S803-EXIT. DTSCS37 01313 EXIT. DTSCS37 01314 SKIP3 DTSCS37 01315 S804-INVALID-KEY. DTSCS37 01316 EXEC CICS LINK DTSCS37 01317 PROGRAM ('DTSCU804') DTSCS37 01318 COMMAREA (DFHCOMMAREA) DTSCS37 01319 END-EXEC. DTSCS37 01320 S804-EXIT. DTSCS37 01321 EXIT. DTSCS37 01322 SKIP3 DTSCS37 01323 S805-MSG-AREA. DTSCS37 01324 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS37 01325 SKIP1 DTSCS37 01326 EXEC CICS LINK DTSCS37 01327 PROGRAM ('DTSCU805') DTSCS37 01328 COMMAREA (L805-COMM-AREA) DTSCS37 01329 END-EXEC. DTSCS37 01330 SKIP1 DTSCS37 01331 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS37 01332 S805-EXIT. DTSCS37 01333 EXIT. DTSCS37 01334 EJECT DTSCS37 01335 S810-READ. DTSCS37 01336 SET L810-READ-88 TO TRUE. DTSCS37 01337 GO TO S810-IO. DTSCS37 01338 SKIP1 DTSCS37 01339 S810-START-BROWSE. DTSCS37 01340 SET L810-START-BROWSE-88 TO TRUE. DTSCS37 01341 GO TO S810-IO. DTSCS37 01342 SKIP1 DTSCS37 01343 S810-READ-NEXT. DTSCS37 01344 SET L810-READ-NEXT-88 TO TRUE. DTSCS37 01345 GO TO S810-IO. DTSCS37 01346 SKIP1 DTSCS37 01347 S810-READ-PREV. DTSCS37 01348 SET L810-READ-PREV-88 TO TRUE. DTSCS37 01349 GO TO S810-IO. DTSCS37 01350 SKIP1 DTSCS37 01351 S810-END-BROWSE. DTSCS37 01352 SET L810-END-BROWSE-88 TO TRUE. DTSCS37 01353 GO TO S810-IO. DTSCS37 01354 SKIP1 DTSCS37 01355 S810-COUNT. DTSCS37 01356 SET L810-COUNT-88 TO TRUE. DTSCS37 01357 GO TO S810-IO. DTSCS37 01358 SKIP1 DTSCS37 01359 *S810-REWRITE. DTSCS37 01360 *****SET L810-REWRITE-88 TO TRUE. DTSCS37 01361 *****GO TO S810-IO. DTSCS37 01362 *****SKIP1 DTSCS37 01363 *S810-WRITE. DTSCS37 01364 *****SET L810-WRITE-88 TO TRUE. DTSCS37 01365 *****GO TO S810-IO. DTSCS37 01366 *****SKIP1 DTSCS37 01367 *S810-DELETE. DTSCS37 01368 *****SET L810-DELETE-88 TO TRUE. DTSCS37 01369 *****GO TO S810-IO. DTSCS37 01370 SKIP1 DTSCS37 01371 S810-IO. DTSCS37 01372 SKIP1 DTSCS37 01373 EXEC CICS LINK DTSCS37 01374 PROGRAM ('DTSCU810') DTSCS37 01375 COMMAREA (L810-COMM-AREA) DTSCS37 01376 END-EXEC. DTSCS37 01377 SKIP1 DTSCS37 01378 IF L810-FILE-CLOSED-88 DTSCS37 01379 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS37 01380 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS37 01381 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS37 01382 GO TO MAINLINE-EXIT. DTSCS37 01383 S810-EXIT. DTSCS37 01384 EXIT. DTSCS37 01385 EJECT DTSCS37 01386 S821-START-BROWSE. DTSCS37 01387 SET L821-START-BROWSE-88 TO TRUE. DTSCS37 01388 GO TO S821-AIX-IO. DTSCS37 01389 SKIP1 DTSCS37 01390 S821-READ-NEXT. DTSCS37 01391 SET L821-READ-NEXT-88 TO TRUE. DTSCS37 01392 GO TO S821-AIX-IO. DTSCS37 01393 SKIP1 DTSCS37 01394 S821-READ-PREV. DTSCS37 01395 SET L821-READ-PREV-88 TO TRUE. DTSCS37 01396 GO TO S821-AIX-IO. DTSCS37 01397 SKIP1 DTSCS37 01398 S821-END-BROWSE. DTSCS37 01399 SET L821-END-BROWSE-88 TO TRUE. DTSCS37 01400 GO TO S821-AIX-IO. DTSCS37 01401 SKIP1 DTSCS37 01402 SKIP1 DTSCS37 01403 S821-AIX-IO. DTSCS37 01404 SKIP1 DTSCS37 01405 EXEC CICS LINK DTSCS37 01406 PROGRAM ('DTSCU821') DTSCS37 01407 COMMAREA (L821-COMM-AREA) DTSCS37 01408 END-EXEC. DTSCS37 01409 SKIP1 DTSCS37 01410 IF L821-FILE-CLOSED-88 DTSCS37 01411 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS37 01412 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS37 01413 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS37 01414 GO TO MAINLINE-EXIT. DTSCS37 01415 S821-EXIT. DTSCS37 01416 EXIT. DTSCS37 01417 EJECT DTSCS37 01418 S829-READ-ITEM. DTSCS37 01419 SET L829-READ-ITEM-88 TO TRUE. DTSCS37 01420 GO TO S829-IO. DTSCS37 01421 DTSCS37 01422 S829-WRITE. DTSCS37 01423 SET L829-WRITE-88 TO TRUE. DTSCS37 01424 GO TO S829-IO. DTSCS37 01425 DTSCS37 01426 S829-DELETE-QUEUE. DTSCS37 01427 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS37 01428 GO TO S829-IO. DTSCS37 01429 DTSCS37 01430 S829-IO. DTSCS37 01431 * COMPUTE L829-COMM-AREA-LENGTH DTSCS37 01432 * = L829-CONTROL-BLOCK-LENGTH + ITEM-LENGTH. DTSCS37 01433 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS37 01434 MOVE 'S' TO L829-QUEUE-NAME-SUFFIX. DTSCS37 01435 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCS37 01436 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS37 01437 DTSCS37 01438 EXEC CICS DTSCS37 01439 LINK DTSCS37 01440 PROGRAM ('DTSCU829') DTSCS37 01441 COMMAREA (L829-COMM-AREA) DTSCS37 01442 END-EXEC. DTSCS37 01443 S829-EXIT. DTSCS37 01444 EXIT. DTSCS37 01445 EJECT DTSCS37 01446 S851-SCREEN-PROCESSING. DTSCS37 01447 EXEC CICS LINK DTSCS37 01448 PROGRAM ('DTSCU851') DTSCS37 01449 COMMAREA (L851-COMM-AREA) DTSCS37 01450 END-EXEC. DTSCS37 01451 S851-EXIT. DTSCS37 01452 EXIT. DTSCS37 01453 SKIP3 DTSCS37 01454 S899-ABEND. DTSCS37 01455 EXEC CICS ABEND DTSCS37 01456 ABCODE(WRK-ABEND-CD) DTSCS37 01457 END-EXEC. DTSCS37 01458 S899-EXIT. DTSCS37 01459 EXIT. DTSCS37 01460 EJECT DTSCS37 01461 S1100-EDIT-KEY. DTSCS37 01462 PERFORM S1101-TRACE-NO THRU S1101-EXIT. DTSCS37 01463 PERFORM S1102-EMP-NO THRU S1102-EXIT. DTSCS37 01464 PERFORM S1103-DATE1 THRU S1103-EXIT. DTSCS37 01465 PERFORM S1104-DATE2 THRU S1104-EXIT. DTSCS37 01466 DTSCS37 01467 IF WRK-TRACE-NO = ZERO DTSCS37 01468 AND WRK-EMP-NO = ZERO DTSCS37 01469 MOVE MSG-E371-AREA TO WRK-MSG-AREA DTSCS37 01470 PERFORM S1101A-ERROR THRU S1101A-EXIT. DTSCS37 01471 S1100-EXIT. EXIT. DTSCS37 01472 /*****************************************************************DTSCS37 01473 * DTSCS37 01474 ******************************************************************DTSCS37 01475 S1101-TRACE-NO. DTSCS37 01476 SET WRK-TRACE-NO-NULL-88 TO TRUE. DTSCS37 01477 MOVE ZERO TO WRK-TRACE-NO-OUT. DTSCS37 01478 MOVE +14 TO OUT-SUB. DTSCS37 01479 DTSCS37 01480 INSPECT MAP-SRCH-TRACE-NO DTSCS37 01481 CONVERTING LOW-VALUE TO SPACE. DTSCS37 01482 IF MAP-SRCH-TRACE-NO = SPACES DTSCS37 01483 GO TO S1101-EXIT DTSCS37 01484 ELSE DTSCS37 01485 MOVE MAP-SRCH-TRACE-NO TO WRK-TRACE-NO-IN. DTSCS37 01486 DTSCS37 01487 PERFORM DTSCS37 01488 VARYING IN-SUB FROM +13 BY -1 DTSCS37 01489 UNTIL IN-SUB < +1 DTSCS37 01490 IF WRK-TRACE-NO-IN (IN-SUB : 1) NUMERIC DTSCS37 01491 SUBTRACT +1 FROM OUT-SUB DTSCS37 01492 MOVE WRK-TRACE-NO-IN (IN-SUB : 1) TO DTSCS37 01493 WRK-TRACE-NO-OUT (OUT-SUB : 1) DTSCS37 01494 ELSE DTSCS37 01495 IF OUT-SUB < +14 DTSCS37 01496 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 01497 PERFORM S1101A-ERROR THRU S1101A-EXIT DTSCS37 01498 GO TO S1101-EXIT DTSCS37 01499 END-IF DTSCS37 01500 END-IF DTSCS37 01501 END-PERFORM. DTSCS37 01502 DTSCS37 01503 IF WRK-TRACE-NO > ZERO DTSCS37 01504 SET WRK-TRACE-NO-ENTERED-88 TO TRUE. DTSCS37 01505 DTSCS37 01506 S1101-EXIT. EXIT. DTSCS37 01507 SKIP3 DTSCS37 01508 S1101A-ERROR. DTSCS37 01509 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-TRACE-NO-A. DTSCS37 01510 DTSCS37 01511 IF LCCM-NO-MSG DTSCS37 01512 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 01513 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L DTSCS37 01514 SET CURSOR-SET-YES TO TRUE. DTSCS37 01515 S1101A-EXIT. EXIT. DTSCS37 01516 DTSCS37 01517 S1102-EMP-NO. DTSCS37 01518 MOVE ZERO TO WRK-EMP-NO. DTSCS37 01519 DTSCS37 01520 MOVE MAP-SEARCH-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS37 01521 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS37 01522 DTSCS37 01523 IF L018-NO-ENTRY DTSCS37 01524 IF WRK-TRACE-NO-NULL-88 DTSCS37 01525 MOVE MSG-E371-AREA TO WRK-MSG-AREA DTSCS37 01526 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 01527 GO TO S1102-EXIT DTSCS37 01528 ELSE DTSCS37 01529 GO TO S1102-EXIT DTSCS37 01530 END-IF DTSCS37 01531 ELSE DTSCS37 01532 IF WRK-TRACE-NO-ENTERED-88 DTSCS37 01533 MOVE MSG-E374-AREA TO WRK-MSG-AREA DTSCS37 01534 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 01535 GO TO S1102-EXIT DTSCS37 01536 END-IF DTSCS37 01537 END-IF. DTSCS37 01538 DTSCS37 01539 IF L018-NOT-VALID DTSCS37 01540 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 01541 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 01542 GO TO S1102-EXIT DTSCS37 01543 ELSE DTSCS37 01544 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS37 01545 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS37 01546 DTSCS37 01547 S1102-EXIT. EXIT. DTSCS37 01548 SKIP3 DTSCS37 01549 DTSCS37 01550 S1102A-ERROR. DTSCS37 01551 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-EMP-NO-1-A DTSCS37 01552 MAP-SRCH-EMP-NO-2-A. DTSCS37 01553 IF LCCM-NO-MSG DTSCS37 01554 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 01555 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L DTSCS37 01556 SET CURSOR-SET-YES TO TRUE. DTSCS37 01557 S1102A-EXIT. EXIT. DTSCS37 01558 DTSCS37 01559 S1103-DATE1. DTSCS37 01560 MOVE ZERO TO WRK-DATE1. DTSCS37 01561 DTSCS37 01562 MOVE MAP-SEARCH-DATE1-AREA TO L015-S-DATE-AREA. DTSCS37 01563 DTSCS37 01564 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS37 01565 IF L015-NO-ENTRY DTSCS37 01566 GO TO S1103-EXIT DTSCS37 01567 ELSE DTSCS37 01568 IF WRK-EMP-NO = ZERO DTSCS37 01569 MOVE MSG-E373-AREA TO WRK-MSG-AREA DTSCS37 01570 PERFORM S1103A-ERROR THRU S1103A-EXIT DTSCS37 01571 GO TO S1103-EXIT DTSCS37 01572 ELSE DTSCS37 01573 IF L015-NOT-VALID DTSCS37 01574 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 01575 PERFORM S1103A-ERROR THRU S1103A-EXIT DTSCS37 01576 GO TO S1103-EXIT DTSCS37 01577 ELSE DTSCS37 01578 MOVE L015-DATE TO WRK-DATE1 DTSCS37 01579 END-IF DTSCS37 01580 END-IF DTSCS37 01581 END-IF. DTSCS37 01582 DTSCS37 01583 S1103-EXIT. EXIT. DTSCS37 01584 SKIP3 DTSCS37 01585 S1103A-ERROR. DTSCS37 01586 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-DATE1-MO-A. DTSCS37 01587 DTSCS37 01588 IF LCCM-NO-MSG DTSCS37 01589 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 01590 MOVE CATB-CURSOR TO MAP-SRCH-DATE1-MO-L DTSCS37 01591 SET CURSOR-SET-YES TO TRUE. DTSCS37 01592 S1103A-EXIT. EXIT. DTSCS37 01593 DTSCS37 01594 S1104-DATE2. DTSCS37 01595 MOVE ZERO TO WRK-DATE2. DTSCS37 01596 DTSCS37 01597 MOVE MAP-SEARCH-DATE2-AREA TO L015-S-DATE-AREA. DTSCS37 01598 DTSCS37 01599 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS37 01600 IF L015-NO-ENTRY DTSCS37 01601 GO TO S1104-EXIT DTSCS37 01602 ELSE DTSCS37 01603 IF WRK-EMP-NO = ZERO DTSCS37 01604 MOVE MSG-E373-AREA TO WRK-MSG-AREA DTSCS37 01605 PERFORM S1104A-ERROR THRU S1104A-EXIT DTSCS37 01606 GO TO S1104-EXIT DTSCS37 01607 ELSE DTSCS37 01608 IF L015-NOT-VALID DTSCS37 01609 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 01610 PERFORM S1104A-ERROR THRU S1104A-EXIT DTSCS37 01611 GO TO S1104-EXIT DTSCS37 01612 ELSE DTSCS37 01613 MOVE L015-DATE TO WRK-DATE2 DTSCS37 01614 END-IF DTSCS37 01615 END-IF DTSCS37 01616 END-IF. DTSCS37 01617 DTSCS37 01618 S1104-EXIT. EXIT. DTSCS37 01619 SKIP3 DTSCS37 01620 S1104A-ERROR. DTSCS37 01621 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-DATE2-MO-A. DTSCS37 01622 DTSCS37 01623 IF LCCM-NO-MSG DTSCS37 01624 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 01625 MOVE CATB-CURSOR TO MAP-SRCH-DATE2-MO-L DTSCS37 01626 SET CURSOR-SET-YES TO TRUE. DTSCS37 01627 S1104A-EXIT. EXIT. DTSCS37 01628 DTSCS37 01629 S1110-READ-MPRF. DTSCS37 01630 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS37 01631 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*15 01632 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS37 01633 SET MPRF-PRF-88 TO TRUE. DTSCS37 01634 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 01635 PERFORM S810-READ THRU S810-EXIT. DTSCS37 01636 IF L810-NO-REC-88 DTSCS37 01637 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS37 01638 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 01639 ELSE DTSCS37 01640 MOVE MSKL-REC TO MPRF-REC DTSCS37 01641 SET WRK-MPRF-YES-88 TO TRUE DTSCS37 01642 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS37 01643 S1110-EXIT. DTSCS37 01644 EXIT. DTSCS37 01645 /*****************************************************************DTSCS37 01646 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS37 01647 ******************************************************************DTSCS37 01648 S5300-SET-INQ-ATTRB. DTSCS37 01649 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS37 01650 WRK-ATB-NUM. DTSCS37 01651 DTSCS37 01652 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS37 01653 S5300-EXIT. DTSCS37 01654 EXIT. DTSCS37 01655 SKIP3 DTSCS37 01656 S5900-SET-ATTRB. DTSCS37 01657 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SRCH-TRACE-NO-A DTSCS37 01658 MAP-SRCH-TRACE-NO-A DTSCS37 01659 MAP-SRCH-EMP-NO-1-A DTSCS37 01660 MAP-SRCH-EMP-NO-2-A DTSCS37 01661 MAP-SRCH-DATE1-MO-A DTSCS37 01662 MAP-SRCH-DATE1-DA-A DTSCS37 01663 MAP-SRCH-DATE1-YR-A DTSCS37 01664 MAP-SRCH-DATE2-MO-A DTSCS37 01665 MAP-SRCH-DATE2-DA-A DTSCS37 01666 MAP-SRCH-DATE2-YR-A. DTSCS37 01667 DTSCS37 01668 DTSCS37 01669 PERFORM DTSCS37 01670 VARYING LINE-OCC FROM 1 BY 1 DTSCS37 01671 UNTIL LINE-OCC > LINES-PER-PAGE DTSCS37 01672 MOVE CATB-ASKIP-BRT-MDTOFF DTSCS37 01673 TO MAP-LINE-A (LINE-OCC) DTSCS37 01674 END-PERFORM. DTSCS37 01675 DTSCS37 01676 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS37 01677 S5900-EXIT. DTSCS37 01678 EXIT. DTSCS37 01679 /*****************************************************************DTSCS37 01680 * MAP ROUTINES *DTSCS37 01681 ******************************************************************DTSCS37 01682 S9100-RECEIVE. DTSCS37 01683 SET L851-RECEIVE-88 TO TRUE. DTSCS37 01684 SKIP1 DTSCS37 01685 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS37 01686 SKIP1 DTSCS37 01687 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 01688 SKIP1 DTSCS37 01689 MOVE L851-AID TO LCCM-AID. DTSCS37 01690 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS37 01691 S9100-EXIT. DTSCS37 01692 EXIT. DTSCS37 01693 SKIP3 DTSCS37 01694 S9200-SEND-DATAONLY. DTSCS37 01695 MOVE LOW-VALUES TO MAP-AREA. DTSCS37 01696 SKIP1 DTSCS37 01697 IF LCCM-NO-MSG DTSCS37 01698 NEXT SENTENCE DTSCS37 01699 ELSE DTSCS37 01700 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS37 01701 SKIP1 DTSCS37 01702 IF CURSOR-SET-GOTO DTSCS37 01703 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS37 01704 ELSE DTSCS37 01705 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L. DTSCS37 01706 SKIP1 DTSCS37 01707 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS37 01708 SKIP1 DTSCS37 01709 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS37 01710 SKIP1 DTSCS37 01711 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 01712 S9200-EXIT. DTSCS37 01713 EXIT. DTSCS37 01714 SKIP3 DTSCS37 01715 S9300-SEND-MAP. DTSCS37 01716 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS37 01717 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS37 01718 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS37 01719 SKIP1 DTSCS37 01720 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS37 01721 SKIP1 DTSCS37 01722 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS37 01723 SKIP1 DTSCS37 01724 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS37 01725 SKIP1 DTSCS37 01726 IF CURSOR-SET-NO DTSCS37 01727 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L. DTSCS37 01728 SKIP1 DTSCS37 01729 SET L851-SEND-88 TO TRUE. DTSCS37 01730 SKIP1 DTSCS37 01731 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS37 01732 SKIP1 DTSCS37 01733 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 01734 S9300-EXIT. DTSCS37 01735 EXIT. DTSCS37 01736 SKIP3 DTSCS37 01737 S9320-INQUIRY-FKEYS. DTSCS37 01738 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS37 01739 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS37 01740 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS37 01741 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS37 01742 MOVE CFKD-NEW-SEARCH TO MAP-KEY-RESET. DTSCS37 01743 SKIP1 DTSCS37 01744 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS37 01745 S9320-EXIT. DTSCS37 01746 EXIT. DTSCS37 01747 SKIP3 DTSCS37 01748 *S9321-JUMP-KEYS. DTSCS37 01749 * MOVE 'F9=QTR' TO MAP-KEY-QTR-INQ. DTSCS37 01750 * MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ. DTSCS37 01751 * MOVE 'F12=ADJ' TO MAP-KEY-ADJ-INQ. DTSCS37 01752 *S9321-EXIT. DTSCS37 01753 * EXIT. DTSCS37 01754 SKIP3 DTSCS37 01755 S9330-DSCR-FIELDS. DTSCS37 01756 * IF WRK-MPRF-YES-88 DTSCS37 01757 * MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS37 01758 * ELSE DTSCS37 01759 * MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS37 01760 S9330-EXIT. DTSCS37 01761 EXIT. DTSCS37 01762 SKIP3 DTSCS37 01763 S9900-PREPARE-SEND. DTSCS37 01764 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS37 01765 LCCM-SCR-ID. DTSCS37 01766 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS37 01767 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS37 01768 S9900-EXIT. DTSCS37 01769 EXIT. DTSCS37