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