giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
156717a8043cb10f023dd849325921cb8dc6f997
DUTAS/CICS/DTSCS34.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2065 lines
161 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink