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