2673 lines
209 KiB
COBOL
2673 lines
209 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/28/14
|
|
00002 PROGRAM-ID. DTSCS41. DTSCS41
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV038
|
|
00004 DATE-WRITTEN. JUNE 1994. DTSCS41
|
|
00005 DATE-COMPILED. DTSCS41
|
|
00006 SKIP3 DTSCS41
|
|
00007 ***** DTSCS41
|
|
00008 * DTSCS41
|
|
00009 * FUNCTION: COLLECTIONS INQUIRY SCREEN PROCESSOR. DTSCS41
|
|
00010 * DTSCS41
|
|
00011 * DTSCS41
|
|
00012 * MODIFICATION LOG: DTSCS41
|
|
00013 * DTSCS41
|
|
00014 * 01/26/99 INITIAL DEVELOPMENT. COPIED FROM MACCS41 DTSCS41
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1 DTSCS41
|
|
00016 * DTSCS41
|
|
00017 * 05/18/1999 PICKUP MODIFICATIONS. DTSCS41
|
|
00018 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS41
|
|
00019 * DTSCS41
|
|
00020 * 09/16/2001 MODIFIED PROGRAM TO DISPLAY DATA FOR ANNUAL DTSCS41
|
|
00021 * FILERS. TOTAL FOR ANNUAL FILERS WILL BE DISPLAYEDDTSCS41
|
|
00022 * IN A SINGEL COLUMN. DTSCS41
|
|
00023 * REFERENCE: PICKUP DIR PROGRAMMER: ZL1 DTSCS41
|
|
00024 * DTSCS41
|
|
00025 * 05/26/2005 CORRECTED PROBLEM WITH TOTALS FOR ANNUAL DTSCS41
|
|
00026 * FILERS. DTSCS41
|
|
00027 * REFERENCE: PROGRAMMER: GD DTSCS41
|
|
00028 * DTSCS41
|
|
00029 * 02/20/2006 MODIFIED INTEREST CALCULATION - UI TAX DTSCS41
|
|
00030 * BALANCE ONLY INCLUDED. P7311, P7315. DTSCS41
|
|
00031 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: GD DTSCS41
|
|
00032 * DTSCS41
|
|
00033 * 04/20/2006 CORRECTED PROBLEM WITH PAGE-COL-CNT. P7310 DTSCS41
|
|
00034 * (INITIALIZE FOR ANNUAL REPORTS) INCREMENTED DTSCS41
|
|
00035 * THIS FIELD INSTEAD OF SETTING IT TO ONE. DTSCS41
|
|
00036 * THIS PRODUCED A SUBSCRIPT OUT OF BOUNDS ERROR. DTSCS41
|
|
00037 * REFERENCE: PROD PROBLEM PROGRAMMER: GD DTSCS41
|
|
00038 * DTSCS41
|
|
00039 * 02/12/2008 MODIFIED INTEREST CALCULATION TO INCLUDE DTSCS41
|
|
00040 * SUR TAX. P7311, P7315. DTSCS41
|
|
00041 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: ZL1 DTSCS41
|
|
00042 * DTSCS41
|
|
00043 * 07/07/2014 MODIFIED P7100 NOT TO COUNT INACTIVE WIDTHDRAWN DTSCS41
|
|
00044 * SPAN OF LIABILITY IN NBR OF SPANS COUNT. DTSCS41
|
|
00045 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: ZL1 DTSCS41
|
|
00046 * DTSCS41
|
|
00047 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS41
|
|
00048 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS41
|
|
00049 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS41
|
|
00050 * DTSCS41
|
|
00051 * DTSCS41
|
|
00052 * DESCRIPTION: DTSCS41
|
|
00053 * DTSCS41
|
|
00054 * CLEAR: DTSCS41
|
|
00055 * DTSCS41
|
|
00056 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS41
|
|
00057 * DTSCS41
|
|
00058 * DTSCS41
|
|
00059 * JUMP: DTSCS41
|
|
00060 * DTSCS41
|
|
00061 * F09 NOTE PAD INQUIRY/UPDATE (71). DTSCS41
|
|
00062 * F17 REGISTRATION INQUIRY (11). DTSCS41
|
|
00063 * F18 REGISTRATION SEARCHES (12). DTSCS41
|
|
00064 * F19 QUARTER INQUIRY (31). DTSCS41
|
|
00065 * DTSCS41
|
|
00066 * DTSCS41
|
|
00067 * INQUIRY: DTSCS41
|
|
00068 * DTSCS41
|
|
00069 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS41
|
|
00070 * DTSCS41
|
|
00071 * DTSCS41
|
|
00072 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR41-HOLD-AREA EMP-NO DTSCS41
|
|
00073 * DISPLAY PAGE INDICATED BY DTSCS41
|
|
00074 * LCCM-SCR41-HOLD-AREA DTSCS41
|
|
00075 * ELSE DTSCS41
|
|
00076 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS41
|
|
00077 * WITH LCCM-EMP-NO. DTSCS41
|
|
00078 * DTSCS41
|
|
00079 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS41
|
|
00080 * DTSCS41
|
|
00081 * DISPLAY SEQUENCE: ASCENDING ON MQTR-YRQ DTSCS41
|
|
00082 * (SEE SCREEN DESCRIPTION DTSCS41
|
|
00083 * FOR DETAILS). DTSCS41
|
|
00084 * DTSCS41
|
|
00085 * PAGE INITIALLY DISPLAYED: LAST. DTSCS41
|
|
00086 * DTSCS41
|
|
00087 * DTSCS41
|
|
00088 * TRY FOR SOME EFFICIENCY. DTSCS41
|
|
00089 * DTSCS41
|
|
00090 * . CONSTRUCT EMPLOYER LEVEL INFORMATION AND QUARTER DTSCS41
|
|
00091 * INFORMATION FOR EACH PAGE IN LCCM-SCR-HOLD-AREA DTSCS41
|
|
00092 * AND/OR IN TS. DTSCS41
|
|
00093 * DTSCS41
|
|
00094 * . SCAN MQTR RECORDS ONCE (RATHER THAN TWICE: ONCE DTSCS41
|
|
00095 * WHILE BUILDING EMPLOYER LEVEL INFORMATION; AND DTSCS41
|
|
00096 * ONCE WHILE BUILDING QUARTER LEVEL INFORMATION). DTSCS41
|
|
00097 * DTSCS41
|
|
00098 * . UNTIL EMP-NO CHANGES, COMP-DATE CHANGES, OR THE DTSCS41
|
|
00099 * TS INFOMATION IS OUT OF DATE, DISPLAY SCREENS FROM DTSCS41
|
|
00100 * INFORMATION STORED IN LCCM-SCR-HOLD-AREA AND OR TS. DTSCS41
|
|
00101 * DTSCS41
|
|
00102 * DTSCS41
|
|
00103 * JUMP OUT: STORE INFORMATION REPRESENTING PAGE DTSCS41
|
|
00104 * CURRENTLY DISPLAYED IN LCCM-SCR41-HOLD-AREA. DTSCS41
|
|
00105 * DTSCS41
|
|
00106 * DELETE TEMPORARY STORAGE QUEUE 'S'. DTSCS41
|
|
00107 * DTSCS41
|
|
00108 * DTSCS41
|
|
00109 * LCCM-MISC-CONTROL-AREA MAINTENANCE: DTSCS41
|
|
00110 * DTSCS41
|
|
00111 * LCCM-EMP-NO DTSCS41
|
|
00112 * DTSCS41
|
|
00113 * LCCM-COMP-DATE DTSCS41
|
|
00114 * DTSCS41
|
|
00115 * DTSCS41
|
|
00116 * UPDATE: DTSCS41
|
|
00117 * DTSCS41
|
|
00118 * NONE. DTSCS41
|
|
00119 * DTSCS41
|
|
00120 * DTSCS41
|
|
00121 * RECORDS READ: DTSCS41
|
|
00122 * DTSCS41
|
|
00123 * MASTER: DTSCS41
|
|
00124 * DTSCS41
|
|
00125 * MPRF DTSCS41
|
|
00126 * MQTR DTSCS41
|
|
00127 * MAPL DTSCS41
|
|
00128 * MLIN DTSCS41
|
|
00129 * MDPC DTSCS41
|
|
00130 * MCOL DTSCS41
|
|
00131 * MSOL DTSCS41
|
|
00132 * MNTE DTSCS41
|
|
00133 * DTSCS41
|
|
00134 * DTSCS41
|
|
00135 * ALTERNATE INDEX: DTSCS41
|
|
00136 * DTSCS41
|
|
00137 * NONE. DTSCS41
|
|
00138 * DTSCS41
|
|
00139 * DTSCS41
|
|
00140 * REFERENCE: DTSCS41
|
|
00141 * DTSCS41
|
|
00142 * NONE. DTSCS41
|
|
00143 * DTSCS41
|
|
00144 * DTSCS41
|
|
00145 * ACCOUNTING TRANSACTION COLLECTION: DTSCS41
|
|
00146 * DTSCS41
|
|
00147 * NONE. DTSCS41
|
|
00148 * DTSCS41
|
|
00149 * DTSCS41
|
|
00150 * RECORDS UPDATED: DTSCS41
|
|
00151 * DTSCS41
|
|
00152 * MASTER: DTSCS41
|
|
00153 * DTSCS41
|
|
00154 * NONE. DTSCS41
|
|
00155 * DTSCS41
|
|
00156 * DTSCS41
|
|
00157 * REFERENCE: DTSCS41
|
|
00158 * DTSCS41
|
|
00159 * NONE. DTSCS41
|
|
00160 * DTSCS41
|
|
00161 * DTSCS41
|
|
00162 * ACCOUNTING TRANSACTION COLLECTION: DTSCS41
|
|
00163 * DTSCS41
|
|
00164 * NONE. DTSCS41
|
|
00165 * DTSCS41
|
|
00166 * DTSCS41
|
|
00167 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS41
|
|
00168 * DTSCS41
|
|
00169 * NONE. DTSCS41
|
|
00170 * DTSCS41
|
|
00171 * DTSCS41
|
|
00172 * TEMPORARY STORAGE USAGE: DTSCS41
|
|
00173 * DTSCS41
|
|
00174 * S IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL. DTSCS41
|
|
00175 * DTSCS41
|
|
00176 * DTSCS41
|
|
00177 * MODULES LINKED TO: DTSCS41
|
|
00178 * DTSCS41
|
|
00179 * DTSCU001 DATE EDIT/CONVERSION. DTSCS41
|
|
00180 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS41
|
|
00181 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS41
|
|
00182 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS41
|
|
00183 * DTSCU033 CURRENT REPORT TYPE/PURSUED REPORT DTSCS41
|
|
00184 * INDICATOR DESCRIPTION. DTSCS41
|
|
00185 * DTSCU056 RATE DISPLAY. DTSCS41
|
|
00186 * DTSCU061 FIELD ZIP / FIELD REP ID. DTSCS41
|
|
00187 * DTSCU101 INTEREST AND PENALTY CHARGE/ABATEMENT DTSCS41
|
|
00188 * CALCULATION. DTSCS41
|
|
00189 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS41
|
|
00190 * DTSCU829 TEMPORARY STORAGE INPUT/OUTPUT. DTSCS41
|
|
00191 * DTSCS41
|
|
00192 * DTSCS41
|
|
00193 * VERMONT REFERENCE: DTSCS41
|
|
00194 * DTSCS41
|
|
00195 * NONE. DTSCS41
|
|
00196 * DTSCS41
|
|
00197 * DTSCS41
|
|
00198 * NOTES TO JEFF: DTSCS41
|
|
00199 * DTSCS41
|
|
00200 * . MACCS41 HAS SOME SIMILARITIES TO MACCS31 (EMPLOYER LEVEL DTSCS41
|
|
00201 * INFORMATION AT TOP OF SCREEN; STORE EMPLOYER LEVEL DTSCS41
|
|
00202 * INFORMATION IN LCCM-SCR-HOLD-AREA). DTSCS41
|
|
00203 * DTSCS41
|
|
00204 * . MACCS41 HAS SOME SIMILARITIES TO MACCS33 (QUARTERS DTSCS41
|
|
00205 * DISPLAYED AS COLUMNS). DTSCS41
|
|
00206 * DTSCS41
|
|
00207 * . PLEASE USE THE MACCS33/34/35/36 MODEL FOR CONSTRUCTION, DTSCS41
|
|
00208 * STORAGE, AND DISPLAY OF PAGES. DTSCS41
|
|
00209 * DTSCS41
|
|
00210 * . NOTE THE QUARTERS TO BE DISPLAYED. DISPLAY ONLY THOSE DTSCS41
|
|
00211 * MQTR RECORDS WITH MQTR-RPT-IS-PURSUED-88 OR SUM OF DTSCS41
|
|
00212 * MQTR-CHARGED-AMT OCCURRENCES IS GREATER THAN ZERO. DTSCS41
|
|
00213 * DTSCS41
|
|
00214 * . EVEN IF NO QUARTERS ARE DISPLAYED, GO AHEAD AND CONSTRUCT DTSCS41
|
|
00215 * AND DISPLAY THE EMPLOYER LEVEL INFORMATION. DTSCS41
|
|
00216 * DTSCS41
|
|
00217 * . NOTE THAT THE LAST COLUMN DISPLAYED ON THE LAST PAGE IS A DTSCS41
|
|
00218 * "TOTAL" COLUMN. SEE SCR41.DSC. IF ONLY ONE QUARTER IS DTSCS41
|
|
00219 * DISPLAYED, THEN DO NOT DISPLAY A "TOTAL" COLUMN. DTSCS41
|
|
00220 * DTSCS41
|
|
00221 * . "TOT ABATE" IS SOMETHING NEW. SUM UP ALL MQTR-ABATE-AMT DTSCS41
|
|
00222 * (FOR ALL QUARTERS, NOT JUST DISPLAYED QUARTERS) AND ADD DTSCS41
|
|
00223 * IN L101-INT-ABATE-CHNG AND L101-PEN-ABATE-CHNG FROM DTSCS41
|
|
00224 * CALLS TO MACCU101. DTSCS41
|
|
00225 * DTSCS41
|
|
00226 * . NOTE THAT THE "*** TX" LINES ARE THE SUM OF DTSCS41
|
|
00227 * MQTR-ACCT-TAX-88 OCCURRENCES AND THE "*** P+J" DTSCS41
|
|
00228 * LINES ARE THE SUM OF MQTR-ACCT-PEN-88 PLUS DTSCS41
|
|
00229 * MQTR-ACCT-JEP-88. DTSCS41
|
|
00230 * DTSCS41
|
|
00231 * . THE "PI AB" LINE IS VERY SIMPLE. DTSCS41
|
|
00232 * DTSCS41
|
|
00233 * IF MQTR-ABATE-PEN-START-DATE = +0 DTSCS41
|
|
00234 * IF MQTR-ABATE-INT-START-DATE = +0 DTSCS41
|
|
00235 * MOVE ' / ' TO DTSCS41
|
|
00236 * ELSE DTSCS41
|
|
00237 * MOVE ' /I' TO DTSCS41
|
|
00238 * ELSE DTSCS41
|
|
00239 * IF MQTR-ABATE-INT-START-DATE = +0 DTSCS41
|
|
00240 * MOVE 'P/ ' TO DTSCS41
|
|
00241 * ELSE DTSCS41
|
|
00242 * MOVE 'P/I' TO . DTSCS41
|
|
00243 * DTSCS41
|
|
00244 * . CALL MACBU033 FOR THE VALUE DISPLAYED IN "REPORT". DTSCS41
|
|
00245 * DTSCS41
|
|
00246 * . TRY FOR SOME EFFICIENCY IN ASSEMBLING THE "A/L/D" DTSCS41
|
|
00247 * DISPLAY. SEE MACCS31 FOR A START. ALSO, CONSIDER DTSCS41
|
|
00248 * SCANNING THE MAPL, MLIN, MDPC ONCE, PUTTING INFOMATION DTSCS41
|
|
00249 * ABOUT THE COVERED QUARTERS INTO A TABLE. YOU MAY DTSCS41
|
|
00250 * ASSUME L004-ABS-QTR VALUES WILL BE FROM 1 TO 400. DTSCS41
|
|
00251 * IS OK TO USE L004-ABS-QTR AS A SUBSCRIPT INTO A TABLE DTSCS41
|
|
00252 * OF A/L/D VALUES FOR EACH QUARTERS. DTSCS41
|
|
00253 * DTSCS41
|
|
00254 ***** DTSCS41
|
|
00255 ENVIRONMENT DIVISION. DTSCS41
|
|
00256 DTSCS41
|
|
00257 DATA DIVISION. DTSCS41
|
|
00258 DTSCS41
|
|
00259 WORKING-STORAGE SECTION. DTSCS41
|
|
002595 77 PAN-VALET PICTURE X(24) VALUE '038DTSCS41 07/28/14'. DTSCS41
|
|
00260 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS41 07/07/14'. DTSCS41
|
|
00261 77 PAN-VALET PICTURE X(24) VALUE '036DTSCS41 05/19/08'. DTSCS41
|
|
00262 DTSCS41
|
|
00263 01 WRK-AREA. DTSCS41
|
|
00264 05 WRK-ABEND-CD PIC X(04) VALUE 'S41 '. DTSCS41
|
|
00265 DTSCS41
|
|
00266 05 WRK-SCR-ID. DTSCS41
|
|
00267 10 WRK-SCR-ID-N PIC 9(02) VALUE 41. DTSCS41
|
|
00268 DTSCS41
|
|
00269 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS41
|
|
00270 DTSCS41
|
|
00271 05 HOLD-KEY-AREA PIC X(16). DTSCS41
|
|
00272 DTSCS41
|
|
00273 05 WRK-CURR-ANN-YR PIC 9(05) VALUE ZEROS. DTSCS41
|
|
00274 05 WRK-ANN-DISPLAY PIC X(08). DTSCS41
|
|
00275 05 FILLER REDEFINES WRK-ANN-DISPLAY. DTSCS41
|
|
00276 10 WRK-ANN-DISPLAY-TEXT PIC X(04). DTSCS41
|
|
00277 10 WRK-ANN-DISPLAY-YR PIC X(04). DTSCS41
|
|
00278 DTSCS41
|
|
00279 05 COLS-PER-PAGE PIC S9(04) COMP VALUE +5. DTSCS41
|
|
00280 DTSCS41
|
|
00281 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS41
|
|
00282 VALUE +999999999.DTSCS41
|
|
00283 DTSCS41
|
|
00284 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCS41
|
|
00285 VALUE +99999. DTSCS41
|
|
00286 DTSCS41
|
|
00287 05 SCR-ACCESS-IND PIC X(01). DTSCS41
|
|
00288 88 SCR-ACCESS-INQ VALUE '1'. DTSCS41
|
|
00289 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS41
|
|
00290 DTSCS41
|
|
00291 05 CURSOR-SET-IND PIC X(01). DTSCS41
|
|
00292 88 CURSOR-SET-YES VALUE 'Y'. DTSCS41
|
|
00293 88 CURSOR-SET-NO VALUE 'N'. DTSCS41
|
|
00294 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS41
|
|
00295 DTSCS41
|
|
00296 05 REQ-IND PIC X(01). DTSCS41
|
|
00297 88 REQ-ERROR VALUE 'O'. DTSCS41
|
|
00298 88 REQ-JUMP VALUE 'J'. DTSCS41
|
|
00299 88 REQ-INQUIRE VALUE 'I'. DTSCS41
|
|
00300 88 REQ-CLEAR VALUE 'C'. DTSCS41
|
|
00301 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS41
|
|
00302 DTSCS41
|
|
00303 05 RESP-IND PIC X(01). DTSCS41
|
|
00304 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS41
|
|
00305 88 RESP-SEND-MAP VALUE 'M'. DTSCS41
|
|
00306 88 RESP-JUMP VALUE 'J'. DTSCS41
|
|
00307 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS41
|
|
00308 DTSCS41
|
|
00309 05 WRK-MSG-AREA PIC X(64). DTSCS41
|
|
00310 DTSCS41
|
|
00311 05 WRK-ATB-AN PIC X(01). DTSCS41
|
|
00312 05 WRK-ATB-NUM PIC X(01). DTSCS41
|
|
00313 DTSCS41
|
|
00314 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS41
|
|
00315 DTSCS41
|
|
00316 05 WRK-MPRF-IND PIC X(01). DTSCS41
|
|
00317 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS41
|
|
00318 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS41
|
|
00319 DTSCS41
|
|
00320 05 WRK-BALANCE-IND PIC X(01). DTSCS41
|
|
00321 DTSCS41
|
|
00322 05 WRK-NORMAL-IND PIC X(01). DTSCS41
|
|
00323 88 NORMAL-INFO-THIS-REC-YES VALUE 'Y'. DTSCS41
|
|
00324 88 NORMAL-INFO-THIS-REC-NO VALUE 'N'. DTSCS41
|
|
00325 DTSCS41
|
|
00326 05 WRK-YRQ PIC S9(05) COMP-3. DTSCS41
|
|
00327 DTSCS41
|
|
00328 05 WRK-DISPLAY PIC 9(11). DTSCS41
|
|
00329 DTSCS41
|
|
00330 05 FILLER REDEFINES WRK-DISPLAY. DTSCS41
|
|
00331 10 FILLER PIC X(05). DTSCS41
|
|
00332 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS41
|
|
00333 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS41
|
|
00334 DTSCS41
|
|
00335 05 FILLER REDEFINES WRK-DISPLAY. DTSCS41
|
|
00336 10 FILLER PIC X(05). DTSCS41
|
|
00337 10 WRK-DISPLAY-YR PIC X(02). DTSCS41
|
|
00338 10 WRK-DISPLAY-MO PIC X(02). DTSCS41
|
|
00339 10 WRK-DISPLAY-DA PIC X(02). DTSCS41
|
|
00340 DTSCS41
|
|
00341 05 COL-OCC PIC S9(04) COMP. DTSCS41
|
|
00342 DTSCS41
|
|
00343 05 WRK-ALD-TBL. DTSCS41
|
|
00344 10 WRK-ALD-TBL-OCC OCCURS 400 TIMES. DTSCS41
|
|
00345 15 WRK-APL-IND PIC X(01). DTSCS41
|
|
00346 15 WRK-LIN-IND PIC X(01). DTSCS41
|
|
00347 15 WRK-DPC-IND PIC X(01). DTSCS41
|
|
00348 DTSCS41
|
|
00349 05 SCR-HOLD-AREA. DTSCS41
|
|
00350 10 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS41
|
|
00351 10 SCR-HOLD-CURR-PAGE-NUM PIC S9(04) COMP. DTSCS41
|
|
00352 DTSCS41
|
|
00353 05 INQUIRY-CONTROL-AREA. DTSCS41
|
|
00354 10 ITEM-LENGTH PIC S9(04) COMP VALUE +497. DTSCS41
|
|
00355 DTSCS41
|
|
00356 10 ITEM-MAX PIC S9(05) COMP VALUE +32760. DTSCS41
|
|
00357 DTSCS41
|
|
00358 10 ITEM-MAX-LCCM PIC S9(04) COMP VALUE +3. DTSCS41
|
|
00359 DTSCS41
|
|
00360 10 CURR-PAGE-NUM PIC S9(04) COMP. DTSCS41
|
|
00361 DTSCS41
|
|
00362 10 ITEM-SUB PIC S9(04) COMP. DTSCS41
|
|
00363 DTSCS41
|
|
00364 10 ITEM-CNT PIC S9(04) COMP. DTSCS41
|
|
00365 DTSCS41
|
|
00366 DTSCS41
|
|
00367 ***** DTSCS41
|
|
00368 * DTSCS41
|
|
00369 * IF THE LENGTH OF PAGE-AREA IS MODIFIED, THEN MAKE DTSCS41
|
|
00370 * CORRESPONDING MODIFICATIONS TO ITEM-LENGTH, L829-REC, DTSCS41
|
|
00371 * AND LCCM-SCR-HOLD-PAGE-AREA. DTSCS41
|
|
00372 * DTSCS41
|
|
00373 ***** DTSCS41
|
|
00374 DTSCS41
|
|
00375 05 PAGE-AREA PIC X(497). DTSCS41
|
|
00376 DTSCS41
|
|
00377 05 FILLER REDEFINES PAGE-AREA. DTSCS41
|
|
00378 10 PAGE-COL-CNT PIC S9(04) COMP. DTSCS41
|
|
00379 DTSCS41
|
|
00380 10 PAGE-COL OCCURS 5 TIMES. DTSCS41
|
|
00381 15 PAGE-YRQ PIC S9(05) COMP-3.DTSCS41
|
|
00382 15 PAGE-RPT-TYPE PIC X(01). DTSCS41
|
|
00383 88 PAGE-RPT-NONE-88 VALUE 'N' 'L' 'D'. DTSCS41
|
|
00384 88 PAGE-RPT-TOTAL-88 VALUE HIGH-VALUE. DTSCS41
|
|
00385 15 PAGE-TOT-WAGE PIC S9(11)V9(02) COMP-3.DTSCS41
|
|
00386 15 PAGE-TAX-WAGE PIC S9(11)V9(02) COMP-3.DTSCS41
|
|
00387 15 PAGE-UI-RATE PIC S9(01)V9(04) COMP-3.DTSCS41
|
|
00388 15 PAGE-TAX-CHARGED PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00389 15 PAGE-INT-CHARGED PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00390 15 PAGE-PEN-CHARGED PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00391 15 PAGE-TAX-PAID PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00392 15 PAGE-INT-PAID PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00393 15 PAGE-PEN-PAID PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00394 15 PAGE-TAX-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00395 15 PAGE-INT-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00396 15 PAGE-PEN-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00397 15 PAGE-TOT-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00398 15 PAGE-ALD PIC X(05). DTSCS41
|
|
00399 15 FILLER REDEFINES PAGE-ALD. DTSCS41
|
|
00400 20 PAGE-APL-IND PIC X(01). DTSCS41
|
|
00401 20 FILLER PIC X(01). DTSCS41
|
|
00402 20 PAGE-LIN-IND PIC X(01). DTSCS41
|
|
00403 20 FILLER PIC X(01). DTSCS41
|
|
00404 20 PAGE-DPC-IND PIC X(01). DTSCS41
|
|
00405 15 PAGE-PEN-INT-WAIVE-IND PIC X(03). DTSCS41
|
|
00406 15 PAGE-REPORT PIC X(10). DTSCS41
|
|
00407 SKIP3 DTSCS41
|
|
00408 05 TOTAL-COL-AREA. DTSCS41
|
|
00409 10 TOTAL-COL-TOT-WAGE PIC S9(11)V9(02) COMP-3.DTSCS41
|
|
00410 10 TOTAL-COL-TAX-WAGE PIC S9(11)V9(02) COMP-3.DTSCS41
|
|
00411 10 TOTAL-COL-TAX-CHARGED PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00412 10 TOTAL-COL-INT-CHARGED PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00413 10 TOTAL-COL-PEN-CHARGED PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00414 10 TOTAL-COL-TAX-PAID PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00415 10 TOTAL-COL-INT-PAID PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00416 10 TOTAL-COL-PEN-PAID PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00417 10 TOTAL-COL-TAX-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00418 10 TOTAL-COL-INT-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00419 10 TOTAL-COL-PEN-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00420 10 TOTAL-COL-TOT-BALANCE PIC S9(09)V9(02) COMP-3.DTSCS41
|
|
00421 10 TOTAL-COL-ALD. DTSCS41
|
|
00422 15 TOTAL-COL-APL-IND PIC X(01). DTSCS41
|
|
00423 15 FILLER PIC X(01). DTSCS41
|
|
00424 15 TOTAL-COL-LIN-IND PIC X(01). DTSCS41
|
|
00425 15 FILLER PIC X(01). DTSCS41
|
|
00426 15 TOTAL-COL-DPC-IND PIC X(01). DTSCS41
|
|
00427 DTSCS41
|
|
00428 05 WRK-ANN-MQTR-AREA. DTSCS41
|
|
00429 10 WRK-MQTR-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSCS41
|
|
00430 10 WRK-MQTR-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSCS41
|
|
00431 10 WRK-MQTR-TAX-CHG PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00432 10 WRK-MQTR-INT-CHG PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00433 10 WRK-MQTR-PEN-CHG PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00434 10 WRK-MQTR-TAX-PAID PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00435 10 WRK-MQTR-INT-PAID PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00436 10 WRK-MQTR-PEN-PAID PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00437 10 WRK-MQTR-TAX-BAL PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00438 10 WRK-MQTR-INT-BAL PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00439 10 WRK-MQTR-PEN-BAL PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00440 10 WRK-MQTR-TOT-BAL PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00441 10 WRK-PAGE-TOT-WAGE. DTSCS41
|
|
00442 15 WRK-PAGE-TOT-DOLS PIC S9(11) COMP-3. DTSCS41
|
|
00443 15 WRK-PAGE-TOT-CENT PIC S9(02) COMP-3. DTSCS41
|
|
00444 *****EJECT DTSCS41
|
|
00445 *01 MSG-LITERALS. DTSCS41
|
|
00446 *****05 MSG-E411-AREA. DTSCS41
|
|
00447 ***** 10 FILLER PIC X(04) VALUE 'E411'. DTSCS41
|
|
00448 ***** 10 FILLER PIC X(30) DTSCS41
|
|
00449 ***** VALUE ' '. DTSCS41
|
|
00450 ***** 10 FILLER PIC X(30) DTSCS41
|
|
00451 ***** VALUE ' '. DTSCS41
|
|
00452 EJECT DTSCS41
|
|
00453 01 L001-COMM-AREA. DTSCS41
|
|
00454 ++INCLUDE DTSIL001 DTSCS41
|
|
00455 EJECT DTSCS41
|
|
00456 01 L004-COMM-AREA. DTSCS41
|
|
00457 ++INCLUDE DTSIL004 DTSCS41
|
|
00458 EJECT DTSCS41
|
|
00459 01 L015-COMM-AREA. DTSCS41
|
|
00460 ++INCLUDE DTSIL015 DTSCS41
|
|
00461 EJECT DTSCS41
|
|
00462 01 L018-COMM-AREA. DTSCS41
|
|
00463 ++INCLUDE DTSIL018 DTSCS41
|
|
00464 EJECT DTSCS41
|
|
00465 01 L033-COMM-AREA. DTSCS41
|
|
00466 ++INCLUDE DTSIL033 DTSCS41
|
|
00467 EJECT DTSCS41
|
|
00468 01 L056-COMM-AREA. DTSCS41
|
|
00469 ++INCLUDE DTSIL056 DTSCS41
|
|
00470 EJECT DTSCS41
|
|
00471 01 L061-COMM-AREA. DTSCS41
|
|
00472 ++INCLUDE DTSIL061 DTSCS41
|
|
00473 EJECT DTSCS41
|
|
00474 01 L101-COMM-AREA. DTSCS41
|
|
00475 ++INCLUDE DTSIL101 DTSCS41
|
|
00476 EJECT DTSCS41
|
|
00477 01 L109-COMM-AREA. DTSCS41
|
|
00478 ++INCLUDE DTSIL109 DTSCS41
|
|
00479 EJECT DTSCS41
|
|
00480 01 L805-COMM-AREA. DTSCS41
|
|
00481 ++INCLUDE DTSIL805 DTSCS41
|
|
00482 EJECT DTSCS41
|
|
00483 01 L810-COMM-AREA. DTSCS41
|
|
00484 05 L810-CONTROL-BLOCK. DTSCS41
|
|
00485 ++INCLUDE DTSIL810 DTSCS41
|
|
00486 EJECT DTSCS41
|
|
00487 05 MSKL-REC. DTSCS41
|
|
00488 ++INCLUDE DTSIMSKL DTSCS41
|
|
00489 EJECT DTSCS41
|
|
00490 01 MPRF-REC. DTSCS41
|
|
00491 ++INCLUDE DTSIMPRF DTSCS41
|
|
00492 EJECT DTSCS41
|
|
00493 01 MQTR-REC. DTSCS41
|
|
00494 ++INCLUDE DTSIMQTR DTSCS41
|
|
00495 EJECT DTSCS41
|
|
00496 01 MAPL-REC. DTSCS41
|
|
00497 ++INCLUDE DTSIMAPL DTSCS41
|
|
00498 EJECT DTSCS41
|
|
00499 01 MLIN-REC. DTSCS41
|
|
00500 ++INCLUDE DTSIMLIN DTSCS41
|
|
00501 EJECT DTSCS41
|
|
00502 01 MDPC-REC. DTSCS41
|
|
00503 ++INCLUDE DTSIMDPC DTSCS41
|
|
00504 EJECT DTSCS41
|
|
00505 01 MCOL-REC. DTSCS41
|
|
00506 ++INCLUDE DTSIMCOL DTSCS41
|
|
00507 EJECT DTSCS41
|
|
00508 01 MTAD-REC. DTSCS41
|
|
00509 ++INCLUDE DTSIMTAD DTSCS41
|
|
00510 EJECT DTSCS41
|
|
00511 01 MSOL-REC. DTSCS41
|
|
00512 ++INCLUDE DTSIMSOL DTSCS41
|
|
00513 EJECT DTSCS41
|
|
00514 01 L829-COMM-AREA. DTSCS41
|
|
00515 05 L829-CONTROL-BLOCK. DTSCS41
|
|
00516 ++INCLUDE DTSIL829 DTSCS41
|
|
00517 DTSCS41
|
|
00518 05 L829-REC PIC X(497). DTSCS41
|
|
00519 EJECT DTSCS41
|
|
00520 01 L851-COMM-AREA. DTSCS41
|
|
00521 ++INCLUDE DTSIL851 DTSCS41
|
|
00522 DTSCS41
|
|
00523 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS41
|
|
00524 ++INCLUDE DTSIS41 DTSCS41
|
|
00525 EJECT DTSCS41
|
|
00526 01 CATB-LITERALS. DTSCS41
|
|
00527 ++INCLUDE DTSICATB DTSCS41
|
|
00528 DTSCS41
|
|
00529 01 CFKD-LITERALS. DTSCS41
|
|
00530 ++INCLUDE DTSICFKD DTSCS41
|
|
00531 DTSCS41
|
|
00532 01 CECD-LITERALS. DTSCS41
|
|
00533 ++INCLUDE DTSICECD DTSCS41
|
|
00534 DTSCS41
|
|
00535 01 CPCD-LITERALS. DTSCS41
|
|
00536 ++INCLUDE DTSICPCD DTSCS41
|
|
00537 EJECT DTSCS41
|
|
00538 LINKAGE SECTION. DTSCS41
|
|
00539 DTSCS41
|
|
00540 01 DFHCOMMAREA. DTSCS41
|
|
00541 ++INCLUDE DTSILCCM DTSCS41
|
|
00542 DTSCS41
|
|
00543 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS41
|
|
00544 20 LCCM-SCR-CONTROL-AREA. DTSCS41
|
|
00545 25 LCCM-SE-NO PIC S9(07) COMP-3.DTSCS41
|
|
00546 25 LCCM-SCR-COMP-DATE PIC S9(09) COMP-3.DTSCS41
|
|
00547 25 LCCM-S-ABSTIME PIC S9(15) COMP-3.DTSCS41
|
|
00548 25 LCCM-SCR-LAST-PAGE-NUM PIC S9(04) COMP. DTSCS41
|
|
00549 DTSCS41
|
|
00550 20 LCCM-SCR-EMPLOYER-AREA. DTSCS41
|
|
00551 25 LCCM-SE-NOTE PIC X(01). DTSCS41
|
|
00552 25 LCCM-SE-FLD-REP-ID PIC X(02). DTSCS41
|
|
00553 25 LCCM-SE-CLASS PIC X(01). DTSCS41
|
|
00554 25 LCCM-SE-RECENT-SOL. DTSCS41
|
|
00555 30 LCCM-SE-RECENT-FROM-YRQ PIC X(04). DTSCS41
|
|
00556 30 LCCM-SE-RECENT-COLON PIC X(01). DTSCS41
|
|
00557 30 LCCM-SE-RECENT-TO-YRQ PIC X(04). DTSCS41
|
|
00558 25 LCCM-SE-NBR-SPANS PIC S9(04) COMP. DTSCS41
|
|
00559 25 LCCM-SE-VOICE-1. DTSCS41
|
|
00560 30 LCCM-SE-VOICE-1-AREA PIC X(03). DTSCS41
|
|
00561 30 LCCM-SE-VOICE-1-PREFIX PIC X(03). DTSCS41
|
|
00562 30 LCCM-SE-VOICE-1-SUFFIX PIC X(04). DTSCS41
|
|
00563 25 LCCM-SE-WRITE-OFF-IND PIC X(01). DTSCS41
|
|
00564 25 LCCM-SE-STATUS PIC X(01). DTSCS41
|
|
00565 25 LCCM-SE-WAIVE-AMT DTSCS41
|
|
00566 PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00567 25 LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
00568 PIC S9(09)V9(02) COMP-3. DTSCS41
|
|
00569 25 LCCM-SE-SUBPOENA-CD PIC X(01). DTSCS41
|
|
00570 25 LCCM-SE-SUBPOENA-DATE PIC X(08). DTSCS41
|
|
00571 25 LCCM-SE-BNK-OPEN-IND PIC X(01). DTSCS41
|
|
00572 25 LCCM-SE-INT-PER-MONTH DTSCS41
|
|
00573 PIC S9(05)V9(02) COMP-3. DTSCS41
|
|
00574 25 LCCM-SE-PURSUED-RPT-CNT PIC S9(03) COMP-3. DTSCS41
|
|
00575 DTSCS41
|
|
00576 20 LCCM-SCR-PAGE-AREA OCCURS 3 TIMES DTSCS41
|
|
00577 PIC X(497). DTSCS41
|
|
00578 EJECT DTSCS41
|
|
00579 ******************************************************************DTSCS41
|
|
00580 * *DTSCS41
|
|
00581 ******************************************************************DTSCS41
|
|
00582 DTSCS41
|
|
00583 PROCEDURE DIVISION. DTSCS41
|
|
00584 DTSCS41
|
|
00585 MOVE +0 TO WRK-EMP-NO DTSCS41
|
|
00586 WRK-YRQ. DTSCS41
|
|
00587 DTSCS41
|
|
00588 SET WRK-MPRF-NO-88 TO TRUE. DTSCS41
|
|
00589 DTSCS41
|
|
00590 MOVE LOW-VALUES TO MAP-AREA. DTSCS41
|
|
00591 DTSCS41
|
|
00592 SET CURSOR-SET-NO TO TRUE. DTSCS41
|
|
00593 DTSCS41
|
|
00594 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS41
|
|
00595 TO SCR-ACCESS-IND. DTSCS41
|
|
00596 DTSCS41
|
|
00597 MOVE SPACE TO REQ-IND. DTSCS41
|
|
00598 DTSCS41
|
|
00599 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS41
|
|
00600 DTSCS41
|
|
00601 *----------------------------------------------------- DTSCS41
|
|
00602 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS41
|
|
00603 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS41
|
|
00604 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS41
|
|
00605 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS41
|
|
00606 * DTSCS41
|
|
00607 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS41
|
|
00608 * PROCESSED. DTSCS41
|
|
00609 * DTSCS41
|
|
00610 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS41
|
|
00611 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS41
|
|
00612 * WORK STATION OPERATOR. DTSCS41
|
|
00613 *----------------------------------------------------- DTSCS41
|
|
00614 DTSCS41
|
|
00615 MOVE SPACE TO RESP-IND. DTSCS41
|
|
00616 DTSCS41
|
|
00617 IF REQ-ERROR DTSCS41
|
|
00618 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS41
|
|
00619 ELSE DTSCS41
|
|
00620 IF REQ-JUMP DTSCS41
|
|
00621 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS41
|
|
00622 ELSE DTSCS41
|
|
00623 IF REQ-CLEAR DTSCS41
|
|
00624 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS41
|
|
00625 ELSE DTSCS41
|
|
00626 IF REQ-CURSOR-TO-GOTO DTSCS41
|
|
00627 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS41
|
|
00628 ELSE DTSCS41
|
|
00629 IF REQ-INQUIRE DTSCS41
|
|
00630 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS41
|
|
00631 ELSE DTSCS41
|
|
00632 GO TO S899-ABEND. DTSCS41
|
|
00633 DTSCS41
|
|
00634 *----------------------------------------------------- DTSCS41
|
|
00635 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS41
|
|
00636 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS41
|
|
00637 *----------------------------------------------------- DTSCS41
|
|
00638 DTSCS41
|
|
00639 IF RESP-SEND-MAP DTSCS41
|
|
00640 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS41
|
|
00641 SET LCCM-END-TASK-88 TO TRUE DTSCS41
|
|
00642 ELSE DTSCS41
|
|
00643 IF RESP-SEND-MSGONLY DTSCS41
|
|
00644 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS41
|
|
00645 SET LCCM-END-TASK-88 TO TRUE DTSCS41
|
|
00646 ELSE DTSCS41
|
|
00647 IF RESP-JUMP DTSCS41
|
|
00648 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS41
|
|
00649 ELSE DTSCS41
|
|
00650 IF RESP-CURSOR-TO-GOTO DTSCS41
|
|
00651 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS41
|
|
00652 SET LCCM-END-TASK-88 TO TRUE DTSCS41
|
|
00653 ELSE DTSCS41
|
|
00654 GO TO S899-ABEND. DTSCS41
|
|
00655 DTSCS41
|
|
00656 MAINLINE-EXIT. DTSCS41
|
|
00657 DTSCS41
|
|
00658 EXEC CICS DTSCS41
|
|
00659 RETURN DTSCS41
|
|
00660 END-EXEC. DTSCS41
|
|
00661 DTSCS41
|
|
00662 * GOBACK. DTSCS41
|
|
00663 EJECT DTSCS41
|
|
00664 /*****************************************************************DTSCS41
|
|
00665 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS41
|
|
00666 ******************************************************************DTSCS41
|
|
00667 P1000-ANALYZE-REQUEST. DTSCS41
|
|
00668 DTSCS41
|
|
00669 *----------------------------------------------------- DTSCS41
|
|
00670 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS41
|
|
00671 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS41
|
|
00672 * REPLACED WITH ENTER) DTSCS41
|
|
00673 *----------------------------------------------------- DTSCS41
|
|
00674 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS41
|
|
00675 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS41
|
|
00676 SET LCCM-ENTER-88 TO TRUE DTSCS41
|
|
00677 IF LCCM-EMP-NO = +0 DTSCS41
|
|
00678 MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA DTSCS41
|
|
00679 SET REQ-CLEAR TO TRUE DTSCS41
|
|
00680 GO TO P1000-EXIT DTSCS41
|
|
00681 ELSE DTSCS41
|
|
00682 SET REQ-INQUIRE TO TRUE DTSCS41
|
|
00683 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS41
|
|
00684 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS41
|
|
00685 GO TO P1000-EXIT. DTSCS41
|
|
00686 DTSCS41
|
|
00687 *----------------------------------------------------- DTSCS41
|
|
00688 * MAP IS RECEIVED DTSCS41
|
|
00689 *----------------------------------------------------- DTSCS41
|
|
00690 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS41
|
|
00691 DTSCS41
|
|
00692 *----------------------------------------------------- DTSCS41
|
|
00693 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS41
|
|
00694 * WORK STATION DTSCS41
|
|
00695 *----------------------------------------------------- DTSCS41
|
|
00696 IF LCCM-CLEAR-88 DTSCS41
|
|
00697 SET REQ-CLEAR TO TRUE DTSCS41
|
|
00698 GO TO P1000-EXIT. DTSCS41
|
|
00699 DTSCS41
|
|
00700 *----------------------------------------------------- DTSCS41
|
|
00701 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS41
|
|
00702 *----------------------------------------------------- DTSCS41
|
|
00703 IF LCCM-PA2-88 DTSCS41
|
|
00704 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS41
|
|
00705 GO TO P1000-EXIT. DTSCS41
|
|
00706 DTSCS41
|
|
00707 *----------------------------------------------------- DTSCS41
|
|
00708 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS41
|
|
00709 *----------------------------------------------------- DTSCS41
|
|
00710 IF LCCM-PA-88 DTSCS41
|
|
00711 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS41
|
|
00712 SET REQ-ERROR TO TRUE DTSCS41
|
|
00713 GO TO P1000-EXIT. DTSCS41
|
|
00714 *----------------------------------------------------- DTSCS41
|
|
00715 * IF F12 KEY IS PRESS CLEAR SCREEN DTSCS41
|
|
00716 *----------------------------------------------------- DTSCS41
|
|
00717 IF LCCM-F12-88 DTSCS41
|
|
00718 MOVE LOW-VALUES TO MAP-AREA DTSCS41
|
|
00719 SET REQ-CLEAR TO TRUE DTSCS41
|
|
00720 GO TO P1000-EXIT. DTSCS41
|
|
00721 DTSCS41
|
|
00722 DTSCS41
|
|
00723 *----------------------------------------------------- DTSCS41
|
|
00724 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS41
|
|
00725 *----------------------------------------------------- DTSCS41
|
|
00726 IF LCCM-F03-88 DTSCS41
|
|
00727 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS41
|
|
00728 SET REQ-JUMP TO TRUE DTSCS41
|
|
00729 GO TO P1000-EXIT. DTSCS41
|
|
00730 DTSCS41
|
|
00731 *----------------------------------------------------- DTSCS41
|
|
00732 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS41
|
|
00733 *----------------------------------------------------- DTSCS41
|
|
00734 IF LCCM-F04-88 DTSCS41
|
|
00735 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS41
|
|
00736 SET REQ-JUMP TO TRUE DTSCS41
|
|
00737 GO TO P1000-EXIT. DTSCS41
|
|
00738 DTSCS41
|
|
00739 *----------------------------------------------------- DTSCS41
|
|
00740 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS41
|
|
00741 * CORRESPONDENCE SCREEN DTSCS41
|
|
00742 *----------------------------------------------------- DTSCS41
|
|
00743 DTSCS41
|
|
00744 IF LCCM-F14-88 DTSCS41
|
|
00745 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS41
|
|
00746 SET REQ-JUMP TO TRUE DTSCS41
|
|
00747 GO TO P1000-EXIT. DTSCS41
|
|
00748 DTSCS41
|
|
00749 * IF LCCM-F09-88 DTSCS41
|
|
00750 * MOVE '71' TO LCCM-REQ-SCR-ID DTSCS41
|
|
00751 * SET REQ-JUMP TO TRUE DTSCS41
|
|
00752 * GO TO P1000-EXIT. DTSCS41
|
|
00753 * DTSCS41
|
|
00754 * IF LCCM-F17-88 DTSCS41
|
|
00755 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS41
|
|
00756 * SET REQ-JUMP TO TRUE DTSCS41
|
|
00757 * GO TO P1000-EXIT. DTSCS41
|
|
00758 * DTSCS41
|
|
00759 * IF LCCM-F18-88 DTSCS41
|
|
00760 * MOVE '12' TO LCCM-REQ-SCR-ID DTSCS41
|
|
00761 * SET REQ-JUMP TO TRUE DTSCS41
|
|
00762 * GO TO P1000-EXIT. DTSCS41
|
|
00763 * DTSCS41
|
|
00764 * IF LCCM-F19-88 DTSCS41
|
|
00765 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS41
|
|
00766 * SET REQ-JUMP TO TRUE DTSCS41
|
|
00767 * GO TO P1000-EXIT. DTSCS41
|
|
00768 DTSCS41
|
|
00769 *----------------------------------------------------- DTSCS41
|
|
00770 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS41
|
|
00771 * REQUESTED SCREEN TYPE DTSCS41
|
|
00772 *----------------------------------------------------- DTSCS41
|
|
00773 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS41
|
|
00774 NEXT SENTENCE DTSCS41
|
|
00775 ELSE DTSCS41
|
|
00776 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS41
|
|
00777 SET REQ-JUMP TO TRUE DTSCS41
|
|
00778 GO TO P1000-EXIT. DTSCS41
|
|
00779 DTSCS41
|
|
00780 *----------------------------------------------------- DTSCS41
|
|
00781 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS41
|
|
00782 * F8), INDICATE INQUIRY REQUEST DTSCS41
|
|
00783 *----------------------------------------------------- DTSCS41
|
|
00784 IF LCCM-INQUIRY-88 DTSCS41
|
|
00785 SET REQ-INQUIRE TO TRUE DTSCS41
|
|
00786 GO TO P1000-EXIT. DTSCS41
|
|
00787 DTSCS41
|
|
00788 *----------------------------------------------------- DTSCS41
|
|
00789 * ANY OTHER KEY IS INVALID DTSCS41
|
|
00790 *----------------------------------------------------- DTSCS41
|
|
00791 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS41
|
|
00792 SET REQ-ERROR TO TRUE. DTSCS41
|
|
00793 P1000-EXIT. DTSCS41
|
|
00794 EXIT. DTSCS41
|
|
00795 DTSCS41
|
|
00796 /*****************************************************************DTSCS41
|
|
00797 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS41
|
|
00798 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS41
|
|
00799 ******************************************************************DTSCS41
|
|
00800 DTSCS41
|
|
00801 P2000-REQUEST-ERROR. DTSCS41
|
|
00802 IF LCCM-MSG DTSCS41
|
|
00803 SET RESP-SEND-MSGONLY TO TRUE DTSCS41
|
|
00804 ELSE DTSCS41
|
|
00805 GO TO S899-ABEND. DTSCS41
|
|
00806 P2000-EXIT. DTSCS41
|
|
00807 EXIT. DTSCS41
|
|
00808 DTSCS41
|
|
00809 /*****************************************************************DTSCS41
|
|
00810 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS41
|
|
00811 ******************************************************************DTSCS41
|
|
00812 DTSCS41
|
|
00813 P3000-REQUEST-JUMP. DTSCS41
|
|
00814 *----------------------------------------------------- DTSCS41
|
|
00815 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS41
|
|
00816 * BY USER DTSCS41
|
|
00817 *----------------------------------------------------- DTSCS41
|
|
00818 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS41
|
|
00819 DTSCS41
|
|
00820 *----------------------------------------------------- DTSCS41
|
|
00821 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS41
|
|
00822 *----------------------------------------------------- DTSCS41
|
|
00823 IF LCCM-MSG DTSCS41
|
|
00824 SET RESP-SEND-MSGONLY TO TRUE DTSCS41
|
|
00825 SET CURSOR-SET-GOTO TO TRUE DTSCS41
|
|
00826 GO TO P3000-EXIT. DTSCS41
|
|
00827 SKIP3 DTSCS41
|
|
00828 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS41
|
|
00829 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS41
|
|
00830 IF L018-VALID DTSCS41
|
|
00831 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS41
|
|
00832 DTSCS41
|
|
00833 *----------------------------------------------------- DTSCS41
|
|
00834 * IF PAGES OF INFORMATION ARE IN TS, THEN BEFORE DTSCS41
|
|
00835 * JUMPING OUT OF THIS MODULE, DELETE THE TS QUEUE. DTSCS41
|
|
00836 *----------------------------------------------------- DTSCS41
|
|
00837 DTSCS41
|
|
00838 IF LCCM-SCR-CONTROL-AREA = LOW-VALUES DTSCS41
|
|
00839 NEXT SENTENCE DTSCS41
|
|
00840 ELSE DTSCS41
|
|
00841 IF LCCM-SCR-LAST-PAGE-NUM > ITEM-MAX-LCCM DTSCS41
|
|
00842 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS41
|
|
00843 DTSCS41
|
|
00844 *----------------------------------------------------- DTSCS41
|
|
00845 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS41
|
|
00846 *----------------------------------------------------- DTSCS41
|
|
00847 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS41
|
|
00848 LCCM-SCR-HOLD-AREA. DTSCS41
|
|
00849 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS41
|
|
00850 SET RESP-JUMP TO TRUE. DTSCS41
|
|
00851 P3000-EXIT. DTSCS41
|
|
00852 EXIT. DTSCS41
|
|
00853 /*****************************************************************DTSCS41
|
|
00854 * CLEAR KEY WAS PRESSED *DTSCS41
|
|
00855 ******************************************************************DTSCS41
|
|
00856 DTSCS41
|
|
00857 P4000-REQUEST-CLEAR. DTSCS41
|
|
00858 *----------------------------------------------------- DTSCS41
|
|
00859 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS41
|
|
00860 * FIELDS FROM EARLIER REQUESTS DTSCS41
|
|
00861 *----------------------------------------------------- DTSCS41
|
|
00862 IF LCCM-EMP-NO > ZERO DTSCS41
|
|
00863 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS41
|
|
00864 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS41
|
|
00865 DTSCS41
|
|
00866 MOVE ZERO TO LCCM-EMP-NO. DTSCS41
|
|
00867 DTSCS41
|
|
00868 IF LCCM-COMP-DATE > +0 DTSCS41
|
|
00869 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS41
|
|
00870 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO DTSCS41
|
|
00871 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA DTSCS41
|
|
00872 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR. DTSCS41
|
|
00873 DTSCS41
|
|
00874 MOVE LOW-VALUES TO LCCM-SCR41-HOLD-AREA. DTSCS41
|
|
00875 DTSCS41
|
|
00876 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS41
|
|
00877 DTSCS41
|
|
00878 SET LCCM-SCR-CLEAR TO TRUE. DTSCS41
|
|
00879 DTSCS41
|
|
00880 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS41
|
|
00881 DTSCS41
|
|
00882 SET RESP-SEND-MAP TO TRUE. DTSCS41
|
|
00883 P4000-EXIT. DTSCS41
|
|
00884 EXIT. DTSCS41
|
|
00885 /*****************************************************************DTSCS41
|
|
00886 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS41
|
|
00887 ******************************************************************DTSCS41
|
|
00888 DTSCS41
|
|
00889 P5000-CURSOR-TO-GOTO. DTSCS41
|
|
00890 SET CURSOR-SET-GOTO TO TRUE. DTSCS41
|
|
00891 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS41
|
|
00892 P5000-EXIT. DTSCS41
|
|
00893 EXIT. DTSCS41
|
|
00894 /*****************************************************************DTSCS41
|
|
00895 * INQUIRY WAS REQUESTED *DTSCS41
|
|
00896 ******************************************************************DTSCS41
|
|
00897 DTSCS41
|
|
00898 P6000-REQUEST-INQUIRE. DTSCS41
|
|
00899 *------------------------------------------------------------ DTSCS41
|
|
00900 * CLEAR MAP-AREA WHILE PRESERVING MAP-EMP-NO-AREA AND DTSCS41
|
|
00901 * MAP-COMP-DATE-AREA. DTSCS41
|
|
00902 *------------------------------------------------------------ DTSCS41
|
|
00903 DTSCS41
|
|
00904 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS41
|
|
00905 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS41
|
|
00906 DTSCS41
|
|
00907 MOVE LOW-VALUES TO MAP-AREA. DTSCS41
|
|
00908 DTSCS41
|
|
00909 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS41
|
|
00910 MOVE L015-S-DATE-AREA TO MAP-COMP-DATE-AREA. DTSCS41
|
|
00911 DTSCS41
|
|
00912 DTSCS41
|
|
00913 SET LCCM-SCR-CLEAR TO TRUE. DTSCS41
|
|
00914 DTSCS41
|
|
00915 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS41
|
|
00916 DTSCS41
|
|
00917 SET RESP-SEND-MAP TO TRUE. DTSCS41
|
|
00918 DTSCS41
|
|
00919 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS41
|
|
00920 DTSCS41
|
|
00921 DTSCS41
|
|
00922 *------------------------------------------------------------ DTSCS41
|
|
00923 * IF LAST ACTION WAS A SCREEN 41 DISPLAY, THEN LCCM-SCR41- DTSCS41
|
|
00924 * LCCM-SCR-HOLD-AREA CONTAINS EMP NO, AND PAGE NUMBER LAST DTSCS41
|
|
00925 * DISPLAYED. DTSCS41
|
|
00926 *------------------------------------------------------------ DTSCS41
|
|
00927 DTSCS41
|
|
00928 MOVE LCCM-SCR41-HOLD-AREA TO SCR-HOLD-AREA. DTSCS41
|
|
00929 DTSCS41
|
|
00930 MOVE LOW-VALUES TO LCCM-SCR41-HOLD-AREA. DTSCS41
|
|
00931 DTSCS41
|
|
00932 *------------------------------------------------------------ DTSCS41
|
|
00933 * EDIT MAP-EMP-NO-AREA AND MAP-COMP-DATE-AREA FOR VALIDITY. DTSCS41
|
|
00934 *------------------------------------------------------------ DTSCS41
|
|
00935 DTSCS41
|
|
00936 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS41
|
|
00937 IF LCCM-MSG DTSCS41
|
|
00938 NEXT SENTENCE DTSCS41
|
|
00939 ELSE DTSCS41
|
|
00940 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS41
|
|
00941 DTSCS41
|
|
00942 PERFORM S1200-COMP-DATE THRU S1200-EXIT. DTSCS41
|
|
00943 DTSCS41
|
|
00944 IF LCCM-MSG DTSCS41
|
|
00945 GO TO P6000-EXIT. DTSCS41
|
|
00946 *------------------------------------------------------------ DTSCS41
|
|
00947 * THIS MODULE CONSTRUCTS PAGES OF INFORMATION INTO DTSCS41
|
|
00948 * LCCM-SCR-HOLD-AREA (WITH ANY OVERFLOW STORED IN TS) DTSCS41
|
|
00949 * AND RETAINS THIS INFORMATION BETWEEN TASKS. DTSCS41
|
|
00950 * DTSCS41
|
|
00951 * IF LCCM-SCR-HOLD-AREA CONTAINS INFORMATION FOR THE EMP-NO DTSCS41
|
|
00952 * SPECIFIED ON THE SCREEN AND THE EMPLOYER'S DTSCS41
|
|
00953 * RECORDS HAVE NOT BEEN UPDATED SINCE THE LCCM-SCR-HOLD-AREA DTSCS41
|
|
00954 * WAS CONSTRUCTED, THEN THE INFORMATION IN LCCM-SCR-HOLD-AREA DTSCS41
|
|
00955 * MAY BE USED FOR PAGING AND DISPLAY - IT IS NOT NECESSARY DTSCS41
|
|
00956 * TO REBUILD LCCM-SCR-HOLD-AREA. DTSCS41
|
|
00957 *------------------------------------------------------------ DTSCS41
|
|
00958 DTSCS41
|
|
00959 IF (LCCM-SCR-CONTROL-AREA = LOW-VALUES) DTSCS41
|
|
00960 OR DTSCS41
|
|
00961 (WRK-EMP-NO NOT = LCCM-SE-NO) DTSCS41
|
|
00962 OR DTSCS41
|
|
00963 (LCCM-COMP-DATE NOT = LCCM-SCR-COMP-DATE) DTSCS41
|
|
00964 OR DTSCS41
|
|
00965 (LCCM-S-ABSTIME NOT = MPRF-UPDATE-END-ABSTIME) DTSCS41
|
|
00966 PERFORM P7000-CONSTRUCT-PAGES THRU P7000-EXIT. DTSCS41
|
|
00967 DTSCS41
|
|
00968 DTSCS41
|
|
00969 PERFORM P6800-EMP-LEVEL-TO-MAP THRU P6800-EXIT. DTSCS41
|
|
00970 *------------------------------------------------------------ DTSCS41
|
|
00971 * IF NO INFORMATION IS AVAILABLE FOR DISPLAY, THEN YOU DTSCS41
|
|
00972 * ARE DONE. DTSCS41
|
|
00973 *------------------------------------------------------------ DTSCS41
|
|
00974 DTSCS41
|
|
00975 IF LCCM-SCR-LAST-PAGE-NUM = +0 DTSCS41
|
|
00976 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS41
|
|
00977 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS41
|
|
00978 GO TO P6000-EXIT. DTSCS41
|
|
00979 DTSCS41
|
|
00980 *------------------------------------------------------------ DTSCS41
|
|
00981 * DETERMINE WHICH PAGE TO DISPLAY. DTSCS41
|
|
00982 *------------------------------------------------------------ DTSCS41
|
|
00983 DTSCS41
|
|
00984 PERFORM P6200-LOCATE-PAGE THRU P6200-EXIT. DTSCS41
|
|
00985 IF LCCM-MSG DTSCS41
|
|
00986 GO TO P6000-EXIT. DTSCS41
|
|
00987 DTSCS41
|
|
00988 DTSCS41
|
|
00989 *------------------------------------------------------------ DTSCS41
|
|
00990 * PLACE INFORMATION INTO MAP-AREA. DTSCS41
|
|
00991 *------------------------------------------------------------ DTSCS41
|
|
00992 DTSCS41
|
|
00993 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS41
|
|
00994 DTSCS41
|
|
00995 DTSCS41
|
|
00996 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCS41
|
|
00997 DTSCS41
|
|
00998 MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM. DTSCS41
|
|
00999 DTSCS41
|
|
01000 MOVE SCR-HOLD-AREA TO LCCM-SCR41-HOLD-AREA. DTSCS41
|
|
01001 DTSCS41
|
|
01002 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS41
|
|
01003 P6000-EXIT. DTSCS41
|
|
01004 EXIT. DTSCS41
|
|
01005 EJECT DTSCS41
|
|
01006 P6200-LOCATE-PAGE. DTSCS41
|
|
01007 IF (SCR-HOLD-EMP-NO NOT NUMERIC) DTSCS41
|
|
01008 OR (SCR-HOLD-EMP-NO NOT = WRK-EMP-NO) DTSCS41
|
|
01009 MOVE +1 TO CURR-PAGE-NUM DTSCS41
|
|
01010 GO TO P6200-EXIT. DTSCS41
|
|
01011 DTSCS41
|
|
01012 IF LCCM-ENTER-88 DTSCS41
|
|
01013 MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM DTSCS41
|
|
01014 ELSE DTSCS41
|
|
01015 IF LCCM-F05-88 DTSCS41
|
|
01016 MOVE +1 TO CURR-PAGE-NUM DTSCS41
|
|
01017 ELSE DTSCS41
|
|
01018 IF LCCM-F06-88 DTSCS41
|
|
01019 MOVE LCCM-SCR-LAST-PAGE-NUM TO CURR-PAGE-NUM DTSCS41
|
|
01020 ELSE DTSCS41
|
|
01021 IF LCCM-F07-88 DTSCS41
|
|
01022 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1 DTSCS41
|
|
01023 ELSE DTSCS41
|
|
01024 IF LCCM-F08-88 DTSCS41
|
|
01025 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1 DTSCS41
|
|
01026 ELSE DTSCS41
|
|
01027 GO TO S899-ABEND. DTSCS41
|
|
01028 DTSCS41
|
|
01029 IF CURR-PAGE-NUM < +1 DTSCS41
|
|
01030 MOVE +1 TO CURR-PAGE-NUM DTSCS41
|
|
01031 ELSE DTSCS41
|
|
01032 IF CURR-PAGE-NUM > LCCM-SCR-LAST-PAGE-NUM DTSCS41
|
|
01033 MOVE LCCM-SCR-LAST-PAGE-NUM TO CURR-PAGE-NUM. DTSCS41
|
|
01034 P6200-EXIT. DTSCS41
|
|
01035 EXIT. DTSCS41
|
|
01036 /*****************************************************************DTSCS41
|
|
01037 * *DTSCS41
|
|
01038 ******************************************************************DTSCS41
|
|
01039 DTSCS41
|
|
01040 P6800-EMP-LEVEL-TO-MAP. DTSCS41
|
|
01041 MOVE LCCM-SE-NOTE TO MAP-NOTE. DTSCS41
|
|
01042 MOVE LCCM-SE-FLD-REP-ID TO MAP-FLD-REP-ID. DTSCS41
|
|
01043 MOVE LCCM-SE-CLASS TO MAP-EMP-CLASS. DTSCS41
|
|
01044 MOVE LCCM-SE-RECENT-SOL TO MAP-RECENT-SOL. DTSCS41
|
|
01045 MOVE LCCM-SE-NBR-SPANS TO MAP-SOL-CNT. DTSCS41
|
|
01046 MOVE LCCM-SE-VOICE-1-AREA TO MAP-VOICE-1-AREA. DTSCS41
|
|
01047 MOVE LCCM-SE-VOICE-1-PREFIX TO MAP-VOICE-1-PREFIX. DTSCS41
|
|
01048 MOVE LCCM-SE-VOICE-1-SUFFIX TO MAP-VOICE-1-SUFFIX. DTSCS41
|
|
01049 MOVE LCCM-SE-WRITE-OFF-IND TO MAP-WRITE-OFF-IND. DTSCS41
|
|
01050 MOVE LCCM-SE-STATUS TO MAP-EMP-STATUS. DTSCS41
|
|
01051 MOVE LCCM-SE-WAIVE-AMT TO MAP-TOT-WAIVE-AMT-PROJ-9. DTSCS41
|
|
01052 IF LCCM-SE-WRITE-OFF-IND = 'Y' DTSCS41
|
|
01053 MOVE 'WRITTEN OFF' TO MAP-TOT-DUE-AMT DTSCS41
|
|
01054 ELSE DTSCS41
|
|
01055 MOVE LCCM-SE-TOT-DUE-AMT TO MAP-TOT-DUE-AMT-9. DTSCS41
|
|
01056 MOVE LCCM-SE-SUBPOENA-CD TO MAP-SUBPOENA-CD. DTSCS41
|
|
01057 MOVE LCCM-SE-SUBPOENA-DATE TO MAP-SUBPOENA-DATE. DTSCS41
|
|
01058 MOVE LCCM-SE-BNK-OPEN-IND TO MAP-BNK-OPEN-IND. DTSCS41
|
|
01059 MOVE LCCM-SE-INT-PER-MONTH TO MAP-INT-PER-MONTH-AMT-9 DTSCS41
|
|
01060 MOVE LCCM-SE-PURSUED-RPT-CNT TO MAP-PURSUED-RPT-CNT-9. DTSCS41
|
|
01061 P6800-EXIT. DTSCS41
|
|
01062 EXIT. DTSCS41
|
|
01063 DTSCS41
|
|
01064 DTSCS41
|
|
01065 DTSCS41
|
|
01066 P6900-CONSTRUCT-SCREEN. DTSCS41
|
|
01067 *-------------------------------------------------------------- DTSCS41
|
|
01068 * PAGES OF INFORMATION HAVE BEEN ASSEMBLED AND PLACED INTO DTSCS41
|
|
01069 * LCCM-SCR-HOLD-AREA AND A PAGE (CURR-PAGE-NUM) HAS BEEN DTSCS41
|
|
01070 * SELECTED FOR DISPLAY. THUS, ALL THAT IS LEFT IS TO RETRIEVE DTSCS41
|
|
01071 * THE SELECTED PAGE OF INFORMATION FROM LCCM-SCR-HOLD-AREA DTSCS41
|
|
01072 * (OR THE TS OVERFLOW) INTO PAGE-AREA AND MOVE DATA ELEMENTS DTSCS41
|
|
01073 * FROM PAGE-AREA TO MAP-AREA. DTSCS41
|
|
01074 *-------------------------------------------------------------- DTSCS41
|
|
01075 DTSCS41
|
|
01076 MOVE CURR-PAGE-NUM TO ITEM-SUB. DTSCS41
|
|
01077 DTSCS41
|
|
01078 PERFORM P8200-RETREIVE-PAGE-AREA THRU P8200-EXIT. DTSCS41
|
|
01079 DTSCS41
|
|
01080 PERFORM P6910-PAGE-AREA-TO-MAP THRU P6910-EXIT DTSCS41
|
|
01081 VARYING COL-OCC FROM 1 BY 1 DTSCS41
|
|
01082 UNTIL COL-OCC > PAGE-COL-CNT. DTSCS41
|
|
01083 DTSCS41
|
|
01084 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS41
|
|
01085 P6900-EXIT. DTSCS41
|
|
01086 EXIT. DTSCS41
|
|
01087 EJECT DTSCS41
|
|
01088 P6910-PAGE-AREA-TO-MAP. DTSCS41
|
|
01089 IF PAGE-YRQ (COL-OCC) = ALL-NINES-YRQ DTSCS41
|
|
01090 MOVE 'TOTAL' TO MAP-YRQ-DISPLAY (COL-OCC) DTSCS41
|
|
01091 ELSE DTSCS41
|
|
01092 IF PAGE-YRQ (COL-OCC) = LCCM-PICKUP-YRQ DTSCS41
|
|
01093 MOVE ' PKUP' TO MAP-YRQ-DISPLAY (COL-OCC) DTSCS41
|
|
01094 ELSE DTSCS41
|
|
01095 MOVE PAGE-YRQ (COL-OCC) TO L004-QTR-5-9 DTSCS41
|
|
01096 IF L004-QTR-5-Q = 0 DTSCS41
|
|
01097 MOVE L004-QTR-5-YR TO WRK-ANN-DISPLAY-YR DTSCS41
|
|
01098 MOVE 'ANN ' TO WRK-ANN-DISPLAY-TEXT DTSCS41
|
|
01099 MOVE WRK-ANN-DISPLAY TO MAP-YRQ-DISPLAY (COL-OCC) DTSCS41
|
|
01100 ELSE DTSCS41
|
|
01101 PERFORM P6911-SLASH-YRQ THRU P6911-EXIT DTSCS41
|
|
01102 MOVE L004-SLASH-QTR TO MAP-YRQ-DISPLAY (COL-OCC). DTSCS41
|
|
01103 DTSCS41
|
|
01104 MOVE PAGE-UI-RATE (COL-OCC) TO L056-RATE. DTSCS41
|
|
01105 PERFORM S056-DISP1-RIGHT THRU S056-EXIT. DTSCS41
|
|
01106 MOVE L056-DISP-RATE TO MAP-UI-RATE (COL-OCC). DTSCS41
|
|
01107 DTSCS41
|
|
01108 IF PAGE-RPT-NONE-88 (COL-OCC) DTSCS41
|
|
01109 PERFORM P6913-DISPLAY-BLANK-IF-0 THRU P6913-EXIT DTSCS41
|
|
01110 ELSE DTSCS41
|
|
01111 PERFORM P6914-DISPLAY-0-IF-0 THRU P6914-EXIT. DTSCS41
|
|
01112 DTSCS41
|
|
01113 MOVE PAGE-ALD (COL-OCC) DTSCS41
|
|
01114 TO MAP-ALD (COL-OCC). DTSCS41
|
|
01115 DTSCS41
|
|
01116 MOVE PAGE-PEN-INT-WAIVE-IND (COL-OCC) DTSCS41
|
|
01117 TO MAP-PEN-INT-WAIVE-IND (COL-OCC). DTSCS41
|
|
01118 DTSCS41
|
|
01119 MOVE PAGE-REPORT (COL-OCC) DTSCS41
|
|
01120 TO MAP-REPORT (COL-OCC). DTSCS41
|
|
01121 P6910-EXIT. DTSCS41
|
|
01122 EXIT. DTSCS41
|
|
01123 DTSCS41
|
|
01124 DTSCS41
|
|
01125 DTSCS41
|
|
01126 P6911-SLASH-YRQ. DTSCS41
|
|
01127 IF L004-QTR-5-9 = +0 DTSCS41
|
|
01128 MOVE SPACES TO L004-SLASH-QTR DTSCS41
|
|
01129 ELSE DTSCS41
|
|
01130 MOVE L004-QTR-5-YR TO L004-SLASH-YR DTSCS41
|
|
01131 MOVE '/' TO L004-SLASH-LIT DTSCS41
|
|
01132 MOVE L004-QTR-5-Q TO L004-SLASH-Q. DTSCS41
|
|
01133 P6911-EXIT. DTSCS41
|
|
01134 EXIT. DTSCS41
|
|
01135 DTSCS41
|
|
01136 DTSCS41
|
|
01137 *P6912-SLASH-DATE. DTSCS41
|
|
01138 *****IF L001-FED-8-DATE-9 = +0 DTSCS41
|
|
01139 ***** MOVE SPACES TO L001-SLASH-DATE DTSCS41
|
|
01140 *****ELSE DTSCS41
|
|
01141 ***** MOVE ' / / ' TO L001-SLASH-DATE DTSCS41
|
|
01142 ***** MOVE L001-FED-8-MO TO L001-SLASH-MO DTSCS41
|
|
01143 ***** MOVE L001-FED-8-DA TO L001-SLASH-DA DTSCS41
|
|
01144 ***** MOVE L001-FED-8-YR TO L001-SLASH-YR. DTSCS41
|
|
01145 *P6912-EXIT. DTSCS41
|
|
01146 *****EXIT. DTSCS41
|
|
01147 EJECT DTSCS41
|
|
01148 P6913-DISPLAY-BLANK-IF-0. DTSCS41
|
|
01149 IF PAGE-TOT-WAGE (COL-OCC) = +0 DTSCS41
|
|
01150 MOVE LOW-VALUE TO MAP-TOT-WAGE (COL-OCC) DTSCS41
|
|
01151 ELSE DTSCS41
|
|
01152 MOVE PAGE-TOT-WAGE (COL-OCC) TO WRK-PAGE-TOT-WAGE. DTSCS41
|
|
01153 MOVE WRK-PAGE-TOT-DOLS TO MAP-TOT-WAGE (COL-OCC). DTSCS41
|
|
01154 DTSCS41
|
|
01155 * COMPUTE MAP-TOT-WAGE-9 (COL-OCC) = PAGE-TOT-WAGE(COL-OCC)DTSCS41
|
|
01156 * ON SIZE ERROR DTSCS41
|
|
01157 * MOVE ' OVERFLOW' TO MAP-TOT-WAGE (COL-OCC). DTSCS41
|
|
01158 DTSCS41
|
|
01159 IF PAGE-TAX-WAGE (COL-OCC) = +0 DTSCS41
|
|
01160 MOVE LOW-VALUE TO MAP-TAX-WAGE (COL-OCC) DTSCS41
|
|
01161 ELSE DTSCS41
|
|
01162 COMPUTE MAP-TAX-WAGE-9 (COL-OCC) = PAGE-TAX-WAGE(COL-OCC)DTSCS41
|
|
01163 ON SIZE ERROR DTSCS41
|
|
01164 MOVE ' OVERFLOW' TO MAP-TAX-WAGE (COL-OCC). DTSCS41
|
|
01165 SKIP3 DTSCS41
|
|
01166 IF PAGE-TAX-CHARGED (COL-OCC) = +0 DTSCS41
|
|
01167 MOVE LOW-VALUE DTSCS41
|
|
01168 TO MAP-TAX-CHARGED (COL-OCC) DTSCS41
|
|
01169 ELSE DTSCS41
|
|
01170 MOVE PAGE-TAX-CHARGED (COL-OCC) DTSCS41
|
|
01171 TO MAP-TAX-CHARGED-9 (COL-OCC). DTSCS41
|
|
01172 DTSCS41
|
|
01173 DTSCS41
|
|
01174 IF PAGE-INT-CHARGED (COL-OCC) = +0 DTSCS41
|
|
01175 MOVE LOW-VALUE DTSCS41
|
|
01176 TO MAP-INT-CHARGED (COL-OCC) DTSCS41
|
|
01177 ELSE DTSCS41
|
|
01178 MOVE PAGE-INT-CHARGED (COL-OCC) DTSCS41
|
|
01179 TO MAP-INT-CHARGED-9 (COL-OCC). DTSCS41
|
|
01180 DTSCS41
|
|
01181 DTSCS41
|
|
01182 IF PAGE-PEN-CHARGED (COL-OCC) = +0 DTSCS41
|
|
01183 MOVE LOW-VALUE DTSCS41
|
|
01184 TO MAP-PEN-CHARGED (COL-OCC) DTSCS41
|
|
01185 ELSE DTSCS41
|
|
01186 MOVE PAGE-PEN-CHARGED (COL-OCC) DTSCS41
|
|
01187 TO MAP-PEN-CHARGED-9 (COL-OCC). DTSCS41
|
|
01188 DTSCS41
|
|
01189 DTSCS41
|
|
01190 IF PAGE-TAX-PAID (COL-OCC) = +0 DTSCS41
|
|
01191 MOVE LOW-VALUE DTSCS41
|
|
01192 TO MAP-TAX-PAID (COL-OCC) DTSCS41
|
|
01193 ELSE DTSCS41
|
|
01194 MOVE PAGE-TAX-PAID (COL-OCC) DTSCS41
|
|
01195 TO MAP-TAX-PAID-9 (COL-OCC). DTSCS41
|
|
01196 DTSCS41
|
|
01197 DTSCS41
|
|
01198 IF PAGE-INT-PAID (COL-OCC) = +0 DTSCS41
|
|
01199 MOVE LOW-VALUE DTSCS41
|
|
01200 TO MAP-INT-PAID (COL-OCC) DTSCS41
|
|
01201 ELSE DTSCS41
|
|
01202 MOVE PAGE-INT-PAID (COL-OCC) DTSCS41
|
|
01203 TO MAP-INT-PAID-9 (COL-OCC). DTSCS41
|
|
01204 DTSCS41
|
|
01205 DTSCS41
|
|
01206 IF PAGE-PEN-PAID (COL-OCC) = +0 DTSCS41
|
|
01207 MOVE LOW-VALUE DTSCS41
|
|
01208 TO MAP-PEN-PAID (COL-OCC) DTSCS41
|
|
01209 ELSE DTSCS41
|
|
01210 MOVE PAGE-PEN-PAID (COL-OCC) DTSCS41
|
|
01211 TO MAP-PEN-PAID-9 (COL-OCC). DTSCS41
|
|
01212 DTSCS41
|
|
01213 DTSCS41
|
|
01214 IF PAGE-TAX-BALANCE (COL-OCC) = +0 DTSCS41
|
|
01215 MOVE LOW-VALUE DTSCS41
|
|
01216 TO MAP-TAX-BALANCE (COL-OCC) DTSCS41
|
|
01217 ELSE DTSCS41
|
|
01218 MOVE PAGE-TAX-BALANCE (COL-OCC) DTSCS41
|
|
01219 TO MAP-TAX-BALANCE-9 (COL-OCC). DTSCS41
|
|
01220 DTSCS41
|
|
01221 DTSCS41
|
|
01222 IF PAGE-INT-BALANCE (COL-OCC) = +0 DTSCS41
|
|
01223 MOVE LOW-VALUE DTSCS41
|
|
01224 TO MAP-INT-BALANCE (COL-OCC) DTSCS41
|
|
01225 ELSE DTSCS41
|
|
01226 MOVE PAGE-INT-BALANCE (COL-OCC) DTSCS41
|
|
01227 TO MAP-INT-BALANCE-9 (COL-OCC). DTSCS41
|
|
01228 DTSCS41
|
|
01229 DTSCS41
|
|
01230 IF PAGE-PEN-BALANCE (COL-OCC) = +0 DTSCS41
|
|
01231 MOVE LOW-VALUE DTSCS41
|
|
01232 TO MAP-PEN-BALANCE (COL-OCC) DTSCS41
|
|
01233 ELSE DTSCS41
|
|
01234 MOVE PAGE-PEN-BALANCE (COL-OCC) DTSCS41
|
|
01235 TO MAP-PEN-BALANCE-9 (COL-OCC). DTSCS41
|
|
01236 DTSCS41
|
|
01237 DTSCS41
|
|
01238 IF PAGE-TOT-BALANCE (COL-OCC) = +0 DTSCS41
|
|
01239 MOVE LOW-VALUE DTSCS41
|
|
01240 TO MAP-TOT-BALANCE (COL-OCC) DTSCS41
|
|
01241 ELSE DTSCS41
|
|
01242 MOVE PAGE-TOT-BALANCE (COL-OCC) DTSCS41
|
|
01243 TO MAP-TOT-BALANCE-9 (COL-OCC). DTSCS41
|
|
01244 P6913-EXIT. DTSCS41
|
|
01245 EXIT. DTSCS41
|
|
01246 DTSCS41
|
|
01247 DTSCS41
|
|
01248 DTSCS41
|
|
01249 P6914-DISPLAY-0-IF-0. DTSCS41
|
|
01250 IF PAGE-YRQ (COL-OCC) = LCCM-PICKUP-YRQ DTSCS41
|
|
01251 MOVE LOW-VALUES TO MAP-TOT-WAGE (COL-OCC) DTSCS41
|
|
01252 ELSE DTSCS41
|
|
01253 COMPUTE MAP-TOT-WAGE-9 (COL-OCC) = PAGE-TOT-WAGE (COL-OCC) DTSCS41
|
|
01254 ON SIZE ERROR DTSCS41
|
|
01255 MOVE ' OVERFLOW' TO MAP-TOT-WAGE (COL-OCC). DTSCS41
|
|
01256 DTSCS41
|
|
01257 IF PAGE-YRQ (COL-OCC) = LCCM-PICKUP-YRQ DTSCS41
|
|
01258 MOVE LOW-VALUES TO MAP-TAX-WAGE (COL-OCC) DTSCS41
|
|
01259 ELSE DTSCS41
|
|
01260 COMPUTE MAP-TAX-WAGE-9 (COL-OCC) = PAGE-TAX-WAGE (COL-OCC) DTSCS41
|
|
01261 ON SIZE ERROR DTSCS41
|
|
01262 MOVE ' OVERFLOW' TO MAP-TAX-WAGE (COL-OCC). DTSCS41
|
|
01263 SKIP3 DTSCS41
|
|
01264 MOVE PAGE-TAX-CHARGED (COL-OCC) DTSCS41
|
|
01265 TO MAP-TAX-CHARGED-9 (COL-OCC). DTSCS41
|
|
01266 DTSCS41
|
|
01267 MOVE PAGE-INT-CHARGED (COL-OCC) DTSCS41
|
|
01268 TO MAP-INT-CHARGED-9 (COL-OCC). DTSCS41
|
|
01269 DTSCS41
|
|
01270 MOVE PAGE-PEN-CHARGED (COL-OCC) DTSCS41
|
|
01271 TO MAP-PEN-CHARGED-9 (COL-OCC). DTSCS41
|
|
01272 DTSCS41
|
|
01273 MOVE PAGE-TAX-PAID (COL-OCC) DTSCS41
|
|
01274 TO MAP-TAX-PAID-9 (COL-OCC). DTSCS41
|
|
01275 DTSCS41
|
|
01276 MOVE PAGE-INT-PAID (COL-OCC) DTSCS41
|
|
01277 TO MAP-INT-PAID-9 (COL-OCC). DTSCS41
|
|
01278 DTSCS41
|
|
01279 MOVE PAGE-PEN-PAID (COL-OCC) DTSCS41
|
|
01280 TO MAP-PEN-PAID-9 (COL-OCC). DTSCS41
|
|
01281 DTSCS41
|
|
01282 MOVE PAGE-TAX-BALANCE (COL-OCC) DTSCS41
|
|
01283 TO MAP-TAX-BALANCE-9 (COL-OCC). DTSCS41
|
|
01284 DTSCS41
|
|
01285 MOVE PAGE-INT-BALANCE (COL-OCC) DTSCS41
|
|
01286 TO MAP-INT-BALANCE-9 (COL-OCC). DTSCS41
|
|
01287 DTSCS41
|
|
01288 MOVE PAGE-PEN-BALANCE (COL-OCC) DTSCS41
|
|
01289 TO MAP-PEN-BALANCE-9 (COL-OCC). DTSCS41
|
|
01290 DTSCS41
|
|
01291 MOVE PAGE-TOT-BALANCE (COL-OCC) DTSCS41
|
|
01292 TO MAP-TOT-BALANCE-9 (COL-OCC). DTSCS41
|
|
01293 P6914-EXIT. DTSCS41
|
|
01294 EXIT. DTSCS41
|
|
01295 DTSCS41
|
|
01296 DTSCS41
|
|
01297 DTSCS41
|
|
01298 P6990-PAGE-NUMBER. DTSCS41
|
|
01299 MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCS41
|
|
01300 MOVE LCCM-SCR-LAST-PAGE-NUM TO MAP-LAST-PAGE. DTSCS41
|
|
01301 DTSCS41
|
|
01302 IF CURR-PAGE-NUM = +1 DTSCS41
|
|
01303 IF LCCM-SCR-LAST-PAGE-NUM = +1 DTSCS41
|
|
01304 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS41
|
|
01305 ELSE DTSCS41
|
|
01306 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS41
|
|
01307 ELSE DTSCS41
|
|
01308 IF CURR-PAGE-NUM = LCCM-SCR-LAST-PAGE-NUM DTSCS41
|
|
01309 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS41
|
|
01310 P6990-EXIT. DTSCS41
|
|
01311 EXIT. DTSCS41
|
|
01312 EJECT DTSCS41
|
|
01313 P7000-CONSTRUCT-PAGES. DTSCS41
|
|
01314 *-------------------------------------------------------------- DTSCS41
|
|
01315 * INQUIRY FOR WRK-EMP-NO HAS BEEN REQUESTED. DTSCS41
|
|
01316 * P7000 ASSEMBLES PAGES OF INFORMATION INTO LCCM-SCR-HOLD-AREA DTSCS41
|
|
01317 * (WITH OVERFLOW INTO TS). DTSCS41
|
|
01318 * DTSCS41
|
|
01319 *-------------------------------------------------------------- DTSCS41
|
|
01320 IF LCCM-SCR-CONTROL-AREA = LOW-VALUES DTSCS41
|
|
01321 NEXT SENTENCE DTSCS41
|
|
01322 ELSE DTSCS41
|
|
01323 IF LCCM-SCR-LAST-PAGE-NUM > ITEM-MAX-LCCM DTSCS41
|
|
01324 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS41
|
|
01325 DTSCS41
|
|
01326 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS41
|
|
01327 DTSCS41
|
|
01328 INITIALIZE LCCM-SCR-EMPLOYER-AREA. DTSCS41
|
|
01329 DTSCS41
|
|
01330 INITIALIZE TOTAL-COL-AREA. DTSCS41
|
|
01331 MOVE ' / / ' TO TOTAL-COL-ALD. DTSCS41
|
|
01332 DTSCS41
|
|
01333 MOVE WRK-EMP-NO TO LCCM-SE-NO. DTSCS41
|
|
01334 DTSCS41
|
|
01335 MOVE LCCM-COMP-DATE TO LCCM-SCR-COMP-DATE. DTSCS41
|
|
01336 DTSCS41
|
|
01337 MOVE MPRF-UPDATE-END-ABSTIME TO LCCM-S-ABSTIME. DTSCS41
|
|
01338 DTSCS41
|
|
01339 MOVE +0 TO LCCM-SCR-LAST-PAGE-NUM. DTSCS41
|
|
01340 DTSCS41
|
|
01341 MOVE +0 TO ITEM-CNT. DTSCS41
|
|
01342 DTSCS41
|
|
01343 PERFORM P7100-REFRESH-HOLD-EMP-AREA THRU P7100-EXIT. DTSCS41
|
|
01344 DTSCS41
|
|
01345 PERFORM P7200-ALD-TABLE THRU P7200-EXIT. DTSCS41
|
|
01346 DTSCS41
|
|
01347 PERFORM P7300-ALL-QUARTERS THRU P7300-EXIT. DTSCS41
|
|
01348 DTSCS41
|
|
01349 IF LCCM-SE-TOT-DUE-AMT = +0 DTSCS41
|
|
01350 IF MPRF-TOT-CREDIT-AMT > +0 DTSCS41
|
|
01351 COMPUTE LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01352 = MPRF-TOT-CREDIT-AMT * -1. DTSCS41
|
|
01353 DTSCS41
|
|
01354 MOVE ITEM-CNT TO LCCM-SCR-LAST-PAGE-NUM. DTSCS41
|
|
01355 P7000-EXIT. DTSCS41
|
|
01356 EXIT. DTSCS41
|
|
01357 /*****************************************************************DTSCS41
|
|
01358 * DTSCS41
|
|
01359 ******************************************************************DTSCS41
|
|
01360 P7100-REFRESH-HOLD-EMP-AREA. DTSCS41
|
|
01361 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS41
|
|
01362 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS41
|
|
01363 SET MSKL-NTE-88 TO TRUE. DTSCS41
|
|
01364 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS41
|
|
01365 IF L810-OK-88 DTSCS41
|
|
01366 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS41
|
|
01367 MOVE 'Y' TO LCCM-SE-NOTE DTSCS41
|
|
01368 ELSE DTSCS41
|
|
01369 MOVE SPACE TO LCCM-SE-NOTE. DTSCS41
|
|
01370 SKIP3 DTSCS41
|
|
01371 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSCS41
|
|
01372 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSCS41
|
|
01373 PERFORM S061-FLD-REP-FROM-ZIP THRU S061-EXIT. DTSCS41
|
|
01374 MOVE L061-FLD-REP-ID TO LCCM-SE-FLD-REP-ID. DTSCS41
|
|
01375 SKIP3 DTSCS41
|
|
01376 MOVE MPRF-EMP-CLASS TO LCCM-SE-CLASS. DTSCS41
|
|
01377 SKIP3 DTSCS41
|
|
01378 MOVE SPACES TO LCCM-SE-RECENT-SOL. DTSCS41
|
|
01379 MOVE ':' TO LCCM-SE-RECENT-COLON. DTSCS41
|
|
01380 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS41
|
|
01381 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS41
|
|
01382 SET MSKL-SOL-88 TO TRUE. DTSCS41
|
|
01383 PERFORM S810-COUNT THRU S810-EXIT. DTSCS41
|
|
01384 MOVE L810-RECORD-CNT TO LCCM-SE-NBR-SPANS. DTSCS41
|
|
01385 DTSCS41
|
|
01386 IF L810-RECORD-CNT > +0 DTSCS41
|
|
01387 PERFORM S810-READ THRU S810-EXIT DTSCS41
|
|
01388 MOVE MSKL-REC TO MSOL-REC DTSCS41
|
|
01389 IF MSOL-INACT-WITHDRAWN-88 DTSCS41
|
|
01390 AND LCCM-SE-NBR-SPANS > +1 DTSCS41
|
|
01391 SUBTRACT 1 FROM LCCM-SE-NBR-SPANS DTSCS41
|
|
01392 PERFORM P7110-LOCATE-MSOL THRU P7110-EXIT DTSCS41
|
|
01393 END-IF DTSCS41
|
|
01394 PERFORM P7120-GET-LIAB-YRQ THRU P7120-EXIT. DTSCS41
|
|
01395 SKIP3 DTSCS41
|
|
01396 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS41
|
|
01397 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS41
|
|
01398 SET MTAD-TAD-88 TO TRUE. DTSCS41
|
|
01399 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS41
|
|
01400 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS41
|
|
01401 PERFORM S810-READ THRU S810-EXIT. DTSCS41
|
|
01402 IF L810-OK-88 DTSCS41
|
|
01403 MOVE MSKL-REC TO MTAD-REC DTSCS41
|
|
01404 MOVE MTAD-VOICE-1 TO LCCM-SE-VOICE-1 DTSCS41
|
|
01405 ELSE DTSCS41
|
|
01406 MOVE SPACES TO LCCM-SE-VOICE-1. DTSCS41
|
|
01407 SKIP3 DTSCS41
|
|
01408 IF MPRF-WRITE-OFF-DATE > +0 DTSCS41
|
|
01409 MOVE 'Y' TO LCCM-SE-WRITE-OFF-IND DTSCS41
|
|
01410 ELSE DTSCS41
|
|
01411 MOVE ' ' TO LCCM-SE-WRITE-OFF-IND. DTSCS41
|
|
01412 SKIP3 DTSCS41
|
|
01413 MOVE MPRF-EMP-STATUS TO LCCM-SE-STATUS. DTSCS41
|
|
01414 SKIP3 DTSCS41
|
|
01415 MOVE SPACE TO LCCM-SE-SUBPOENA-CD DTSCS41
|
|
01416 LCCM-SE-SUBPOENA-DATE. DTSCS41
|
|
01417 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS41
|
|
01418 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS41
|
|
01419 SET MSKL-COL-88 TO TRUE. DTSCS41
|
|
01420 PERFORM S810-READ THRU S810-EXIT DTSCS41
|
|
01421 IF L810-OK-88 DTSCS41
|
|
01422 MOVE MSKL-REC TO MCOL-REC DTSCS41
|
|
01423 MOVE MCOL-SUBPOENA-ACTIVITY-CD TO LCCM-SE-SUBPOENA-CD DTSCS41
|
|
01424 IF MCOL-SUBPOENA-ACTIVITY-DATE > +0 DTSCS41
|
|
01425 MOVE MCOL-SUBPOENA-ACTIVITY-DATE TO L001-FED-8-DATE-9DTSCS41
|
|
01426 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS41
|
|
01427 MOVE L001-SLASH-DATE TO LCCM-SE-SUBPOENA-DATE. DTSCS41
|
|
01428 SKIP3 DTSCS41
|
|
01429 MOVE MPRF-BANKRUPTCY-OPEN-IND TO LCCM-SE-BNK-OPEN-IND. DTSCS41
|
|
01430 SKIP3 DTSCS41
|
|
01431 * MOVE MPRF-ORG-TYPE TO LCCM-SE-ORG-TYPE. DTSCS41
|
|
01432 SKIP3 DTSCS41
|
|
01433 MOVE MPRF-PURSUED-RPT-CNT TO LCCM-SE-PURSUED-RPT-CNT. DTSCS41
|
|
01434 SKIP3 DTSCS41
|
|
01435 MOVE +0 TO LCCM-SE-WAIVE-AMT DTSCS41
|
|
01436 LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01437 LCCM-SE-INT-PER-MONTH. DTSCS41
|
|
01438 P7100-EXIT. DTSCS41
|
|
01439 EXIT. DTSCS41
|
|
01440 EJECT DTSCS41
|
|
01441 P7110-LOCATE-MSOL. DTSCS41
|
|
01442 MOVE MSKL-KEY-AREA TO HOLD-KEY-AREA. DTSCS41
|
|
01443 DTSCS41
|
|
01444 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS41
|
|
01445 MOVE MSKL-REC TO MSOL-REC. DTSCS41
|
|
01446 DTSCS41
|
|
01447 PERFORM UNTIL L810-NO-REC-88 DTSCS41
|
|
01448 OR NOT MSOL-INACT-WITHDRAWN-88 DTSCS41
|
|
01449 PERFORM S810-READ-PREV THRU S810-EXIT DTSCS41
|
|
01450 MOVE MSKL-REC TO MSOL-REC DTSCS41
|
|
01451 END-PERFORM. DTSCS41
|
|
01452 DTSCS41
|
|
01453 IF L810-OK-88 DTSCS41
|
|
01454 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS41
|
|
01455 ELSE DTSCS41
|
|
01456 MOVE HOLD-KEY-AREA TO MSKL-KEY-AREA DTSCS41
|
|
01457 PERFORM S810-READ THRU S810-EXIT DTSCS41
|
|
01458 MOVE MSKL-REC TO MSOL-REC. DTSCS41
|
|
01459 P7110-EXIT. DTSCS41
|
|
01460 EXIT. DTSCS41
|
|
01461 SKIP3 DTSCS41
|
|
01462 P7120-GET-LIAB-YRQ. DTSCS41
|
|
01463 IF MSOL-FIRST-LIAB-YRQ = +0 DTSCS41
|
|
01464 NEXT SENTENCE DTSCS41
|
|
01465 ELSE DTSCS41
|
|
01466 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCS41
|
|
01467 PERFORM P6911-SLASH-YRQ THRU P6911-EXIT DTSCS41
|
|
01468 MOVE L004-SLASH-QTR TO LCCM-SE-RECENT-FROM-YRQ. DTSCS41
|
|
01469 DTSCS41
|
|
01470 IF MSOL-LAST-LIAB-YRQ = +0 OR ALL-NINES-YRQ DTSCS41
|
|
01471 NEXT SENTENCE DTSCS41
|
|
01472 ELSE DTSCS41
|
|
01473 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSCS41
|
|
01474 PERFORM P6911-SLASH-YRQ THRU P6911-EXIT DTSCS41
|
|
01475 MOVE L004-SLASH-QTR TO LCCM-SE-RECENT-TO-YRQ. DTSCS41
|
|
01476 P7120-EXIT. DTSCS41
|
|
01477 EXIT. DTSCS41
|
|
01478 EJECT DTSCS41
|
|
01479 P7200-ALD-TABLE. DTSCS41
|
|
01480 MOVE SPACES TO WRK-ALD-TBL. DTSCS41
|
|
01481 DTSCS41
|
|
01482 IF MPRF-MAPL-EXISTS-88 DTSCS41
|
|
01483 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS41
|
|
01484 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS41
|
|
01485 SET MSKL-APL-88 TO TRUE DTSCS41
|
|
01486 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS41
|
|
01487 PERFORM P7210-MAPL-SCAN THRU P7210-EXIT DTSCS41
|
|
01488 UNTIL L810-NO-REC-88. DTSCS41
|
|
01489 DTSCS41
|
|
01490 IF MPRF-MLIN-EXISTS-88 DTSCS41
|
|
01491 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS41
|
|
01492 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS41
|
|
01493 SET MSKL-LIN-88 TO TRUE DTSCS41
|
|
01494 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS41
|
|
01495 PERFORM P7220-MLIN-SCAN THRU P7220-EXIT DTSCS41
|
|
01496 UNTIL L810-NO-REC-88. DTSCS41
|
|
01497 DTSCS41
|
|
01498 IF MPRF-MDPC-EXISTS-88 DTSCS41
|
|
01499 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS41
|
|
01500 MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS41
|
|
01501 SET MSKL-DPC-88 TO TRUE DTSCS41
|
|
01502 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS41
|
|
01503 PERFORM P7230-MDPC-SCAN THRU P7230-EXIT DTSCS41
|
|
01504 UNTIL L810-NO-REC-88. DTSCS41
|
|
01505 P7200-EXIT. DTSCS41
|
|
01506 EXIT. DTSCS41
|
|
01507 DTSCS41
|
|
01508 DTSCS41
|
|
01509 P7210-MAPL-SCAN. DTSCS41
|
|
01510 MOVE MSKL-REC TO MAPL-REC. DTSCS41
|
|
01511 DTSCS41
|
|
01512 IF MAPL-STATUS-OPEN-88 DTSCS41
|
|
01513 PERFORM VARYING MAPL-COV-IDX DTSCS41
|
|
01514 FROM 1 BY 1 UNTIL MAPL-COV-IDX > MAPL-COVERED-CNT DTSCS41
|
|
01515 MOVE MAPL-COVERED-YRQ(MAPL-COV-IDX) TO L004-QTR-5-9 DTSCS41
|
|
01516 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS41
|
|
01517 IF L004-VALID-QTR DTSCS41
|
|
01518 MOVE 'A' TO WRK-APL-IND(L004-ABS-QTR) DTSCS41
|
|
01519 END-IF DTSCS41
|
|
01520 END-PERFORM. DTSCS41
|
|
01521 DTSCS41
|
|
01522 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS41
|
|
01523 P7210-EXIT. DTSCS41
|
|
01524 EXIT. DTSCS41
|
|
01525 DTSCS41
|
|
01526 DTSCS41
|
|
01527 P7220-MLIN-SCAN. DTSCS41
|
|
01528 MOVE MSKL-REC TO MLIN-REC. DTSCS41
|
|
01529 DTSCS41
|
|
01530 IF MLIN-STATUS-ACTIVE-88 DTSCS41
|
|
01531 PERFORM VARYING MLIN-COV-IDX DTSCS41
|
|
01532 FROM 1 BY 1 UNTIL MLIN-COV-IDX > MLIN-COV-CNT DTSCS41
|
|
01533 MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO L004-QTR-5-9 DTSCS41
|
|
01534 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS41
|
|
01535 IF L004-VALID-QTR DTSCS41
|
|
01536 MOVE 'L' TO WRK-LIN-IND(L004-ABS-QTR) DTSCS41
|
|
01537 END-IF DTSCS41
|
|
01538 END-PERFORM. DTSCS41
|
|
01539 DTSCS41
|
|
01540 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS41
|
|
01541 P7220-EXIT. DTSCS41
|
|
01542 EXIT. DTSCS41
|
|
01543 DTSCS41
|
|
01544 DTSCS41
|
|
01545 P7230-MDPC-SCAN. DTSCS41
|
|
01546 MOVE MSKL-REC TO MDPC-REC. DTSCS41
|
|
01547 DTSCS41
|
|
01548 IF MDPC-STATUS-ACTIVE-88 DTSCS41
|
|
01549 PERFORM VARYING MDPC-COV-IDX DTSCS41
|
|
01550 FROM 1 BY 1 UNTIL MDPC-COV-IDX > MDPC-COV-CNT DTSCS41
|
|
01551 MOVE MDPC-COVERED-YRQ(MDPC-COV-IDX) TO L004-QTR-5-9 DTSCS41
|
|
01552 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS41
|
|
01553 IF L004-VALID-QTR DTSCS41
|
|
01554 MOVE 'D' TO WRK-DPC-IND(L004-ABS-QTR) DTSCS41
|
|
01555 END-IF DTSCS41
|
|
01556 END-PERFORM. DTSCS41
|
|
01557 DTSCS41
|
|
01558 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS41
|
|
01559 P7230-EXIT. DTSCS41
|
|
01560 EXIT. DTSCS41
|
|
01561 EJECT DTSCS41
|
|
01562 P7300-ALL-QUARTERS. DTSCS41
|
|
01563 *-------------------------------------------------------------- DTSCS41
|
|
01564 * PROCESS ALL MQTR RECORDS DTSCS41
|
|
01565 *-------------------------------------------------------------- DTSCS41
|
|
01566 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS41
|
|
01567 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS41
|
|
01568 SET MQTR-QTR-88 TO TRUE. DTSCS41
|
|
01569 DTSCS41
|
|
01570 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS41
|
|
01571 MOVE +0 TO PAGE-COL-CNT. DTSCS41
|
|
01572 DTSCS41
|
|
01573 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS41
|
|
01574 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS41
|
|
01575 IF L810-NO-REC-88 DTSCS41
|
|
01576 GO TO P7300-EXIT. DTSCS41
|
|
01577 DTSCS41
|
|
01578 PERFORM P7310-SCAN-MQTR THRU P7310-EXIT DTSCS41
|
|
01579 UNTIL L810-NO-REC-88. DTSCS41
|
|
01580 DTSCS41
|
|
01581 IF (ITEM-CNT = +0) DTSCS41
|
|
01582 AND DTSCS41
|
|
01583 (PAGE-COL-CNT = +0 OR +1) DTSCS41
|
|
01584 NEXT SENTENCE DTSCS41
|
|
01585 ELSE DTSCS41
|
|
01586 PERFORM P7320-TOTAL-COL-TO-PAGE THRU P7320-EXIT. DTSCS41
|
|
01587 DTSCS41
|
|
01588 IF PAGE-COL-CNT > +0 DTSCS41
|
|
01589 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS41
|
|
01590 P7300-EXIT. DTSCS41
|
|
01591 EXIT. DTSCS41
|
|
01592 DTSCS41
|
|
01593 DTSCS41
|
|
01594 DTSCS41
|
|
01595 P7310-SCAN-MQTR. DTSCS41
|
|
01596 MOVE MSKL-REC TO MQTR-REC. DTSCS41
|
|
01597 DTSCS41
|
|
01598 IF PAGE-COL-CNT < COLS-PER-PAGE DTSCS41
|
|
01599 NEXT SENTENCE DTSCS41
|
|
01600 ELSE DTSCS41
|
|
01601 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSCS41
|
|
01602 IF MQTR-ANNUAL-YES-88 DTSCS41
|
|
01603 AND L004-QTR-5-YR = WRK-CURR-ANN-YR DTSCS41
|
|
01604 NEXT SENTENCE DTSCS41
|
|
01605 ELSE DTSCS41
|
|
01606 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS41
|
|
01607 MOVE +0 TO PAGE-COL-CNT. DTSCS41
|
|
01608 DTSCS41
|
|
01609 IF MQTR-ANNUAL-YES-88 DTSCS41
|
|
01610 PERFORM P7315-PROCESS-ANN-MQTR THRU P7315-EXIT DTSCS41
|
|
01611 ELSE DTSCS41
|
|
01612 PERFORM P7311-PROCESS-MQTR THRU P7311-EXIT. DTSCS41
|
|
01613 DTSCS41
|
|
01614 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS41
|
|
01615 P7310-EXIT. DTSCS41
|
|
01616 EXIT. DTSCS41
|
|
01617 DTSCS41
|
|
01618 DTSCS41
|
|
01619 DTSCS41
|
|
01620 P7311-PROCESS-MQTR. DTSCS41
|
|
01621 MOVE 'N' TO WRK-BALANCE-IND. DTSCS41
|
|
01622 DTSCS41
|
|
01623 PERFORM DTSCS41
|
|
01624 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS41
|
|
01625 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS41
|
|
01626 DTSCS41
|
|
01627 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01628 TO LCCM-SE-WAIVE-AMT DTSCS41
|
|
01629 DTSCS41
|
|
01630 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSCS41
|
|
01631 MOVE 'Y' TO WRK-BALANCE-IND DTSCS41
|
|
01632 END-IF DTSCS41
|
|
01633 END-PERFORM. DTSCS41
|
|
01634 DTSCS41
|
|
01635 IF (WRK-BALANCE-IND = 'Y') DTSCS41
|
|
01636 OR DTSCS41
|
|
01637 (MQTR-RPT-IS-PURSUED-88) DTSCS41
|
|
01638 NEXT SENTENCE DTSCS41
|
|
01639 ELSE DTSCS41
|
|
01640 GO TO P7311-EXIT. DTSCS41
|
|
01641 DTSCS41
|
|
01642 DTSCS41
|
|
01643 ADD +1 TO PAGE-COL-CNT. DTSCS41
|
|
01644 DTSCS41
|
|
01645 INITIALIZE PAGE-COL(PAGE-COL-CNT). DTSCS41
|
|
01646 DTSCS41
|
|
01647 MOVE MQTR-YRQ TO PAGE-YRQ (PAGE-COL-CNT). DTSCS41
|
|
01648 DTSCS41
|
|
01649 MOVE MQTR-CURR-RPT-TYPE TO PAGE-RPT-TYPE (PAGE-COL-CNT). DTSCS41
|
|
01650 DTSCS41
|
|
01651 MOVE MQTR-TOT-WAGE TO PAGE-TOT-WAGE (PAGE-COL-CNT). DTSCS41
|
|
01652 DTSCS41
|
|
01653 MOVE MQTR-TAX-WAGE TO PAGE-TAX-WAGE (PAGE-COL-CNT). DTSCS41
|
|
01654 DTSCS41
|
|
01655 MOVE MQTR-UI-RATE TO PAGE-UI-RATE (PAGE-COL-CNT). DTSCS41
|
|
01656 DTSCS41
|
|
01657 MOVE +0 TO L101-PAID-CHNG. DTSCS41
|
|
01658 DTSCS41
|
|
01659 PERFORM DTSCS41
|
|
01660 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS41
|
|
01661 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS41
|
|
01662 DTSCS41
|
|
01663 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01664 TO LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01665 DTSCS41
|
|
01666 PERFORM P7312-ACCUM THRU P7312-EXIT DTSCS41
|
|
01667 DTSCS41
|
|
01668 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS41
|
|
01669 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01670 TO L101-PAID-CHNG DTSCS41
|
|
01671 END-IF DTSCS41
|
|
01672 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS41
|
|
01673 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS41
|
|
01674 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01675 TO L101-PAID-CHNG DTSCS41
|
|
01676 END-IF DTSCS41
|
|
01677 DTSCS41
|
|
01678 * IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSCS41
|
|
01679 * ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01680 * TO L101-PEN-CHARGED-AMT DTSCS41
|
|
01681 * END-IF DTSCS41
|
|
01682 END-PERFORM. DTSCS41
|
|
01683 DTSCS41
|
|
01684 DTSCS41
|
|
01685 IF MQTR-CMP-ESTB-ABSTIME > ZERO DTSCS41
|
|
01686 MOVE 'CMP' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT) DTSCS41
|
|
01687 ELSE DTSCS41
|
|
01688 IF MQTR-WAIVE-PEN-START-DATE = +0 DTSCS41
|
|
01689 IF MQTR-WAIVE-INT-START-DATE = +0 DTSCS41
|
|
01690 MOVE ' / ' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT) DTSCS41
|
|
01691 ELSE DTSCS41
|
|
01692 MOVE ' /I' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT) DTSCS41
|
|
01693 ELSE DTSCS41
|
|
01694 IF MQTR-WAIVE-INT-START-DATE = +0 DTSCS41
|
|
01695 MOVE 'P/ ' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT) DTSCS41
|
|
01696 ELSE DTSCS41
|
|
01697 MOVE 'P/I' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT). DTSCS41
|
|
01698 DTSCS41
|
|
01699 MOVE MQTR-CURR-RPT-TYPE TO L033-CURR-RPT-TYPE. DTSCS41
|
|
01700 MOVE MQTR-PURSUED-RPT-IND TO L033-PURSUED-RPT-IND. DTSCS41
|
|
01701 PERFORM S033-MQTR-RPT-PURSUE THRU S033-EXIT. DTSCS41
|
|
01702 MOVE L033-SHORT-DSCR-RIGHT TO PAGE-REPORT(PAGE-COL-CNT). DTSCS41
|
|
01703 DTSCS41
|
|
01704 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS41
|
|
01705 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS41
|
|
01706 MOVE ' / / ' TO PAGE-ALD(PAGE-COL-CNT). DTSCS41
|
|
01707 DTSCS41
|
|
01708 MOVE WRK-APL-IND(L004-ABS-QTR) TO PAGE-APL-IND(PAGE-COL-CNT).DTSCS41
|
|
01709 MOVE WRK-LIN-IND(L004-ABS-QTR) TO PAGE-LIN-IND(PAGE-COL-CNT).DTSCS41
|
|
01710 MOVE WRK-DPC-IND(L004-ABS-QTR) TO PAGE-DPC-IND(PAGE-COL-CNT).DTSCS41
|
|
01711 IF WRK-APL-IND (L004-ABS-QTR) NOT = SPACE DTSCS41
|
|
01712 MOVE WRK-APL-IND (L004-ABS-QTR) TO TOTAL-COL-APL-IND. DTSCS41
|
|
01713 IF WRK-LIN-IND (L004-ABS-QTR) NOT = SPACE DTSCS41
|
|
01714 MOVE WRK-LIN-IND (L004-ABS-QTR) TO TOTAL-COL-LIN-IND. DTSCS41
|
|
01715 IF WRK-DPC-IND (L004-ABS-QTR) NOT = SPACE DTSCS41
|
|
01716 MOVE WRK-DPC-IND (L004-ABS-QTR) TO TOTAL-COL-DPC-IND. DTSCS41
|
|
01717 DTSCS41
|
|
01718 IF L101-PAID-CHNG > +0 DTSCS41
|
|
01719 NEXT SENTENCE DTSCS41
|
|
01720 ELSE DTSCS41
|
|
01721 PERFORM P7313-MQTR-TO-TOTAL-AREA THRU P7313-EXIT DTSCS41
|
|
01722 GO TO P7311-EXIT. DTSCS41
|
|
01723 DTSCS41
|
|
01724 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS41
|
|
01725 PERFORM P7313-MQTR-TO-TOTAL-AREA THRU P7313-EXIT DTSCS41
|
|
01726 GO TO P7311-EXIT. DTSCS41
|
|
01727 DTSCS41
|
|
01728 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE. DTSCS41
|
|
01729 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSCS41
|
|
01730 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSCS41
|
|
01731 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSCS41
|
|
01732 DTSCS41
|
|
01733 PERFORM S101-PER-MONTH-YES THRU S101-EXIT. DTSCS41
|
|
01734 DTSCS41
|
|
01735 ADD L101-INT-PER-MONTH TO LCCM-SE-INT-PER-MONTH. DTSCS41
|
|
01736 DTSCS41
|
|
01737 ADD L101-INT-WAIVE-CHNG DTSCS41
|
|
01738 TO LCCM-SE-WAIVE-AMT. DTSCS41
|
|
01739 DTSCS41
|
|
01740 * ADD L101-PEN-WAIVE-CHNG DTSCS41
|
|
01741 * TO LCCM-SE-WAIVE-AMT. DTSCS41
|
|
01742 DTSCS41
|
|
01743 ADD L101-INT-CHARGE-CHNG DTSCS41
|
|
01744 TO LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01745 PAGE-INT-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01746 PAGE-INT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01747 PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01748 DTSCS41
|
|
01749 SUBTRACT L101-INT-WAIVE-CHNG DTSCS41
|
|
01750 FROM LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01751 PAGE-INT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01752 PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01753 DTSCS41
|
|
01754 * ADD L101-PEN-CHARGE-CHNG DTSCS41
|
|
01755 * TO LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01756 * PAGE-PEN-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01757 * PAGE-PEN-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01758 * PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01759 DTSCS41
|
|
01760 * SUBTRACT L101-PEN-ABATE-CHNG DTSCS41
|
|
01761 * FROM LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01762 * PAGE-PEN-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01763 * PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01764 DTSCS41
|
|
01765 PERFORM P7313-MQTR-TO-TOTAL-AREA THRU P7313-EXIT. DTSCS41
|
|
01766 P7311-EXIT. DTSCS41
|
|
01767 EXIT. DTSCS41
|
|
01768 DTSCS41
|
|
01769 P7312-ACCUM. DTSCS41
|
|
01770 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS41
|
|
01771 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01772 TO PAGE-TAX-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01773 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01774 TO PAGE-TAX-PAID (PAGE-COL-CNT) DTSCS41
|
|
01775 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01776 TO PAGE-TAX-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01777 ELSE DTSCS41
|
|
01778 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSCS41
|
|
01779 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01780 TO PAGE-INT-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01781 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01782 TO PAGE-INT-PAID (PAGE-COL-CNT) DTSCS41
|
|
01783 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01784 TO PAGE-INT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01785 ELSE DTSCS41
|
|
01786 IF (MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)) DTSCS41
|
|
01787 OR DTSCS41
|
|
01788 (MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)) DTSCS41
|
|
01789 OR DTSCS41
|
|
01790 (MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)) DTSCS41
|
|
01791 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01792 TO PAGE-PEN-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01793 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01794 TO PAGE-PEN-PAID (PAGE-COL-CNT) DTSCS41
|
|
01795 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01796 TO PAGE-PEN-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01797 DTSCS41
|
|
01798 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01799 TO PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01800 P7312-EXIT. DTSCS41
|
|
01801 EXIT. DTSCS41
|
|
01802 DTSCS41
|
|
01803 DTSCS41
|
|
01804 DTSCS41
|
|
01805 * GET THE GRAND TOTAL TO BE DISPLAYED ON THE LAST PAGE DTSCS41
|
|
01806 P7313-MQTR-TO-TOTAL-AREA. DTSCS41
|
|
01807 ADD PAGE-TOT-WAGE (PAGE-COL-CNT) DTSCS41
|
|
01808 TO TOTAL-COL-TOT-WAGE. DTSCS41
|
|
01809 ADD PAGE-TAX-WAGE (PAGE-COL-CNT) DTSCS41
|
|
01810 TO TOTAL-COL-TAX-WAGE. DTSCS41
|
|
01811 ADD PAGE-TAX-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01812 TO TOTAL-COL-TAX-CHARGED. DTSCS41
|
|
01813 ADD PAGE-INT-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01814 TO TOTAL-COL-INT-CHARGED. DTSCS41
|
|
01815 ADD PAGE-PEN-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01816 TO TOTAL-COL-PEN-CHARGED. DTSCS41
|
|
01817 ADD PAGE-TAX-PAID (PAGE-COL-CNT) DTSCS41
|
|
01818 TO TOTAL-COL-TAX-PAID. DTSCS41
|
|
01819 ADD PAGE-INT-PAID (PAGE-COL-CNT) DTSCS41
|
|
01820 TO TOTAL-COL-INT-PAID. DTSCS41
|
|
01821 ADD PAGE-PEN-PAID (PAGE-COL-CNT) DTSCS41
|
|
01822 TO TOTAL-COL-PEN-PAID. DTSCS41
|
|
01823 ADD PAGE-TAX-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01824 TO TOTAL-COL-TAX-BALANCE. DTSCS41
|
|
01825 ADD PAGE-INT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01826 TO TOTAL-COL-INT-BALANCE. DTSCS41
|
|
01827 ADD PAGE-PEN-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01828 TO TOTAL-COL-PEN-BALANCE. DTSCS41
|
|
01829 ADD PAGE-TOT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01830 TO TOTAL-COL-TOT-BALANCE. DTSCS41
|
|
01831 P7313-EXIT. DTSCS41
|
|
01832 EXIT. DTSCS41
|
|
01833 DTSCS41
|
|
01834 DTSCS41
|
|
01835 DTSCS41
|
|
01836 DTSCS41
|
|
01837 P7315-PROCESS-ANN-MQTR. DTSCS41
|
|
01838 MOVE 'N' TO WRK-BALANCE-IND. DTSCS41
|
|
01839 DTSCS41
|
|
01840 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS41
|
|
01841 DTSCS41
|
|
01842 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS41
|
|
01843 DTSCS41
|
|
01844 PERFORM DTSCS41
|
|
01845 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS41
|
|
01846 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS41
|
|
01847 DTSCS41
|
|
01848 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01849 TO LCCM-SE-WAIVE-AMT DTSCS41
|
|
01850 DTSCS41
|
|
01851 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSCS41
|
|
01852 MOVE 'Y' TO WRK-BALANCE-IND DTSCS41
|
|
01853 END-IF DTSCS41
|
|
01854 END-PERFORM. DTSCS41
|
|
01855 DTSCS41
|
|
01856 IF (WRK-BALANCE-IND = 'Y') DTSCS41
|
|
01857 OR DTSCS41
|
|
01858 (MQTR-RPT-IS-PURSUED-88) DTSCS41
|
|
01859 NEXT SENTENCE DTSCS41
|
|
01860 ELSE DTSCS41
|
|
01861 GO TO P7315-EXIT. DTSCS41
|
|
01862 DTSCS41
|
|
01863 MOVE ZERO TO WRK-MQTR-TOT-WAGE DTSCS41
|
|
01864 WRK-MQTR-TAX-WAGE DTSCS41
|
|
01865 WRK-MQTR-TAX-CHG DTSCS41
|
|
01866 WRK-MQTR-TAX-PAID DTSCS41
|
|
01867 WRK-MQTR-TAX-BAL DTSCS41
|
|
01868 WRK-MQTR-INT-CHG DTSCS41
|
|
01869 WRK-MQTR-INT-PAID DTSCS41
|
|
01870 WRK-MQTR-INT-BAL DTSCS41
|
|
01871 WRK-MQTR-PEN-CHG DTSCS41
|
|
01872 WRK-MQTR-PEN-PAID DTSCS41
|
|
01873 WRK-MQTR-PEN-BAL DTSCS41
|
|
01874 WRK-MQTR-TOT-BAL. DTSCS41
|
|
01875 DTSCS41
|
|
01876 IF L004-QTR-5-YR = WRK-CURR-ANN-YR DTSCS41
|
|
01877 NEXT SENTENCE DTSCS41
|
|
01878 ELSE DTSCS41
|
|
01879 PERFORM P7316-INIT-ANN-RPT THRU P7316-EXIT. DTSCS41
|
|
01880 DTSCS41
|
|
01881 DTSCS41
|
|
01882 ADD MQTR-TOT-WAGE TO PAGE-TOT-WAGE (PAGE-COL-CNT) DTSCS41
|
|
01883 WRK-MQTR-TOT-WAGE. DTSCS41
|
|
01884 DTSCS41
|
|
01885 ADD MQTR-TAX-WAGE TO PAGE-TAX-WAGE (PAGE-COL-CNT) DTSCS41
|
|
01886 WRK-MQTR-TAX-WAGE. DTSCS41
|
|
01887 DTSCS41
|
|
01888 MOVE +0 TO L101-PAID-CHNG. DTSCS41
|
|
01889 DTSCS41
|
|
01890 PERFORM DTSCS41
|
|
01891 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS41
|
|
01892 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS41
|
|
01893 DTSCS41
|
|
01894 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01895 TO LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01896 DTSCS41
|
|
01897 PERFORM P7315A-ACCUM THRU P7315A-EXIT DTSCS41
|
|
01898 DTSCS41
|
|
01899 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS41
|
|
01900 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01901 TO L101-PAID-CHNG DTSCS41
|
|
01902 END-IF DTSCS41
|
|
01903 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS41
|
|
01904 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS41
|
|
01905 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01906 TO L101-PAID-CHNG DTSCS41
|
|
01907 END-IF DTSCS41
|
|
01908 END-PERFORM. DTSCS41
|
|
01909 DTSCS41
|
|
01910 DTSCS41
|
|
01911 IF L101-PAID-CHNG > +0 DTSCS41
|
|
01912 NEXT SENTENCE DTSCS41
|
|
01913 ELSE DTSCS41
|
|
01914 PERFORM P7315B-MQTR-TO-TOTAL-AREA THRU P7315B-EXIT DTSCS41
|
|
01915 GO TO P7315-EXIT. DTSCS41
|
|
01916 DTSCS41
|
|
01917 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS41
|
|
01918 PERFORM P7315B-MQTR-TO-TOTAL-AREA THRU P7315B-EXIT DTSCS41
|
|
01919 GO TO P7315-EXIT. DTSCS41
|
|
01920 DTSCS41
|
|
01921 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE. DTSCS41
|
|
01922 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSCS41
|
|
01923 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSCS41
|
|
01924 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSCS41
|
|
01925 DTSCS41
|
|
01926 PERFORM S101-PER-MONTH-YES THRU S101-EXIT. DTSCS41
|
|
01927 DTSCS41
|
|
01928 ADD L101-INT-PER-MONTH TO LCCM-SE-INT-PER-MONTH. DTSCS41
|
|
01929 DTSCS41
|
|
01930 ADD L101-INT-WAIVE-CHNG DTSCS41
|
|
01931 TO LCCM-SE-WAIVE-AMT. DTSCS41
|
|
01932 DTSCS41
|
|
01933 ADD L101-INT-CHARGE-CHNG DTSCS41
|
|
01934 TO LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01935 WRK-MQTR-INT-CHG DTSCS41
|
|
01936 WRK-MQTR-INT-BAL DTSCS41
|
|
01937 WRK-MQTR-TOT-BAL DTSCS41
|
|
01938 PAGE-INT-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01939 PAGE-INT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01940 PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01941 DTSCS41
|
|
01942 SUBTRACT L101-INT-WAIVE-CHNG DTSCS41
|
|
01943 FROM LCCM-SE-TOT-DUE-AMT DTSCS41
|
|
01944 WRK-MQTR-INT-BAL DTSCS41
|
|
01945 WRK-MQTR-TOT-BAL DTSCS41
|
|
01946 PAGE-INT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01947 PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
01948 DTSCS41
|
|
01949 PERFORM P7315B-MQTR-TO-TOTAL-AREA THRU P7315B-EXIT. DTSCS41
|
|
01950 P7315-EXIT. DTSCS41
|
|
01951 EXIT. DTSCS41
|
|
01952 DTSCS41
|
|
01953 P7315A-ACCUM. DTSCS41
|
|
01954 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS41
|
|
01955 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01956 TO PAGE-TAX-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01957 WRK-MQTR-TAX-CHG DTSCS41
|
|
01958 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01959 TO PAGE-TAX-PAID (PAGE-COL-CNT) DTSCS41
|
|
01960 WRK-MQTR-TAX-PAID DTSCS41
|
|
01961 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01962 TO PAGE-TAX-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01963 WRK-MQTR-TAX-BAL DTSCS41
|
|
01964 ELSE DTSCS41
|
|
01965 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSCS41
|
|
01966 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01967 TO PAGE-INT-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01968 WRK-MQTR-INT-CHG DTSCS41
|
|
01969 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01970 TO PAGE-INT-PAID (PAGE-COL-CNT) DTSCS41
|
|
01971 WRK-MQTR-INT-PAID DTSCS41
|
|
01972 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01973 TO PAGE-INT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01974 WRK-MQTR-TAX-BAL DTSCS41
|
|
01975 ELSE DTSCS41
|
|
01976 IF (MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)) DTSCS41
|
|
01977 OR DTSCS41
|
|
01978 (MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)) DTSCS41
|
|
01979 OR DTSCS41
|
|
01980 (MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)) DTSCS41
|
|
01981 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01982 TO PAGE-PEN-CHARGED (PAGE-COL-CNT) DTSCS41
|
|
01983 WRK-MQTR-PEN-CHG DTSCS41
|
|
01984 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01985 TO PAGE-PEN-PAID (PAGE-COL-CNT) DTSCS41
|
|
01986 WRK-MQTR-PEN-PAID DTSCS41
|
|
01987 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01988 TO PAGE-PEN-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01989 WRK-MQTR-PEN-BAL. DTSCS41
|
|
01990 DTSCS41
|
|
01991 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS41
|
|
01992 TO PAGE-TOT-BALANCE (PAGE-COL-CNT) DTSCS41
|
|
01993 WRK-MQTR-TOT-BAL. DTSCS41
|
|
01994 P7315A-EXIT. DTSCS41
|
|
01995 EXIT. DTSCS41
|
|
01996 DTSCS41
|
|
01997 * GET THE GRAND TOTAL TO BE DISPLAYED ON THE LAST PAGE DTSCS41
|
|
01998 P7315B-MQTR-TO-TOTAL-AREA. DTSCS41
|
|
01999 ADD WRK-MQTR-TOT-WAGE DTSCS41
|
|
02000 TO TOTAL-COL-TOT-WAGE. DTSCS41
|
|
02001 ADD WRK-MQTR-TAX-WAGE DTSCS41
|
|
02002 TO TOTAL-COL-TAX-WAGE. DTSCS41
|
|
02003 ADD WRK-MQTR-TAX-CHG DTSCS41
|
|
02004 TO TOTAL-COL-TAX-CHARGED. DTSCS41
|
|
02005 ADD WRK-MQTR-INT-CHG DTSCS41
|
|
02006 TO TOTAL-COL-INT-CHARGED. DTSCS41
|
|
02007 ADD WRK-MQTR-PEN-CHG DTSCS41
|
|
02008 TO TOTAL-COL-PEN-CHARGED. DTSCS41
|
|
02009 ADD WRK-MQTR-TAX-PAID DTSCS41
|
|
02010 TO TOTAL-COL-TAX-PAID. DTSCS41
|
|
02011 ADD WRK-MQTR-INT-PAID DTSCS41
|
|
02012 TO TOTAL-COL-INT-PAID. DTSCS41
|
|
02013 ADD WRK-MQTR-PEN-PAID DTSCS41
|
|
02014 TO TOTAL-COL-PEN-PAID. DTSCS41
|
|
02015 ADD WRK-MQTR-TAX-BAL DTSCS41
|
|
02016 TO TOTAL-COL-TAX-BALANCE. DTSCS41
|
|
02017 ADD WRK-MQTR-INT-BAL DTSCS41
|
|
02018 TO TOTAL-COL-INT-BALANCE. DTSCS41
|
|
02019 ADD WRK-MQTR-PEN-BAL DTSCS41
|
|
02020 TO TOTAL-COL-PEN-BALANCE. DTSCS41
|
|
02021 ADD WRK-MQTR-TOT-BAL DTSCS41
|
|
02022 TO TOTAL-COL-TOT-BALANCE. DTSCS41
|
|
02023 P7315B-EXIT. DTSCS41
|
|
02024 EXIT. DTSCS41
|
|
02025 DTSCS41
|
|
02026 P7316-INIT-ANN-RPT. DTSCS41
|
|
02027 MOVE L004-QTR-5-YR TO WRK-CURR-ANN-YR. DTSCS41
|
|
02028 DTSCS41
|
|
02029 ADD +1 TO PAGE-COL-CNT. DTSCS41
|
|
02030 INITIALIZE PAGE-COL(PAGE-COL-CNT). DTSCS41
|
|
02031 MOVE +0 TO L101-PAID-CHNG. DTSCS41
|
|
02032 DTSCS41
|
|
02033 MOVE 0 TO L004-QTR-5-Q. DTSCS41
|
|
02034 MOVE L004-QTR-5-9 TO PAGE-YRQ(PAGE-COL-CNT). DTSCS41
|
|
02035 DTSCS41
|
|
02036 MOVE MQTR-CURR-RPT-TYPE TO PAGE-RPT-TYPE (PAGE-COL-CNT). DTSCS41
|
|
02037 DTSCS41
|
|
02038 MOVE MQTR-UI-RATE TO PAGE-UI-RATE (PAGE-COL-CNT). DTSCS41
|
|
02039 DTSCS41
|
|
02040 DTSCS41
|
|
02041 IF MQTR-WAIVE-PEN-START-DATE = +0 DTSCS41
|
|
02042 IF MQTR-WAIVE-INT-START-DATE = +0 DTSCS41
|
|
02043 MOVE ' / ' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT) DTSCS41
|
|
02044 ELSE DTSCS41
|
|
02045 MOVE ' /I' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT) DTSCS41
|
|
02046 ELSE DTSCS41
|
|
02047 IF MQTR-WAIVE-INT-START-DATE = +0 DTSCS41
|
|
02048 MOVE 'P/ ' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT) DTSCS41
|
|
02049 ELSE DTSCS41
|
|
02050 MOVE 'P/I' TO PAGE-PEN-INT-WAIVE-IND(PAGE-COL-CNT). DTSCS41
|
|
02051 DTSCS41
|
|
02052 MOVE MQTR-CURR-RPT-TYPE TO L033-CURR-RPT-TYPE. DTSCS41
|
|
02053 MOVE MQTR-PURSUED-RPT-IND TO L033-PURSUED-RPT-IND. DTSCS41
|
|
02054 PERFORM S033-MQTR-RPT-PURSUE THRU S033-EXIT. DTSCS41
|
|
02055 MOVE L033-SHORT-DSCR-RIGHT TO PAGE-REPORT(PAGE-COL-CNT). DTSCS41
|
|
02056 DTSCS41
|
|
02057 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS41
|
|
02058 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS41
|
|
02059 MOVE ' / / ' TO PAGE-ALD(PAGE-COL-CNT). DTSCS41
|
|
02060 DTSCS41
|
|
02061 MOVE WRK-APL-IND(L004-ABS-QTR) TO PAGE-APL-IND(PAGE-COL-CNT).DTSCS41
|
|
02062 MOVE WRK-LIN-IND(L004-ABS-QTR) TO PAGE-LIN-IND(PAGE-COL-CNT).DTSCS41
|
|
02063 MOVE WRK-DPC-IND(L004-ABS-QTR) TO PAGE-DPC-IND(PAGE-COL-CNT).DTSCS41
|
|
02064 IF WRK-APL-IND (L004-ABS-QTR) NOT = SPACE DTSCS41
|
|
02065 MOVE WRK-APL-IND (L004-ABS-QTR) TO TOTAL-COL-APL-IND. DTSCS41
|
|
02066 IF WRK-LIN-IND (L004-ABS-QTR) NOT = SPACE DTSCS41
|
|
02067 MOVE WRK-LIN-IND (L004-ABS-QTR) TO TOTAL-COL-LIN-IND. DTSCS41
|
|
02068 IF WRK-DPC-IND (L004-ABS-QTR) NOT = SPACE DTSCS41
|
|
02069 MOVE WRK-DPC-IND (L004-ABS-QTR) TO TOTAL-COL-DPC-IND. DTSCS41
|
|
02070 DTSCS41
|
|
02071 P7316-EXIT. DTSCS41
|
|
02072 EXIT. DTSCS41
|
|
02073 DTSCS41
|
|
02074 DTSCS41
|
|
02075 P7320-TOTAL-COL-TO-PAGE. DTSCS41
|
|
02076 IF PAGE-COL-CNT < COLS-PER-PAGE DTSCS41
|
|
02077 NEXT SENTENCE DTSCS41
|
|
02078 ELSE DTSCS41
|
|
02079 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS41
|
|
02080 MOVE +0 TO PAGE-COL-CNT. DTSCS41
|
|
02081 DTSCS41
|
|
02082 ADD +1 TO PAGE-COL-CNT. DTSCS41
|
|
02083 DTSCS41
|
|
02084 MOVE ALL-NINES-YRQ TO PAGE-YRQ (PAGE-COL-CNT). DTSCS41
|
|
02085 DTSCS41
|
|
02086 SET PAGE-RPT-TOTAL-88 (PAGE-COL-CNT) DTSCS41
|
|
02087 TO TRUE. DTSCS41
|
|
02088 DTSCS41
|
|
02089 MOVE TOTAL-COL-TOT-WAGE DTSCS41
|
|
02090 TO PAGE-TOT-WAGE (PAGE-COL-CNT). DTSCS41
|
|
02091 DTSCS41
|
|
02092 MOVE TOTAL-COL-TAX-WAGE DTSCS41
|
|
02093 TO PAGE-TAX-WAGE (PAGE-COL-CNT). DTSCS41
|
|
02094 DTSCS41
|
|
02095 SET L056-NO-RATE-88 TO TRUE. DTSCS41
|
|
02096 MOVE L056-RATE DTSCS41
|
|
02097 TO PAGE-UI-RATE (PAGE-COL-CNT). DTSCS41
|
|
02098 DTSCS41
|
|
02099 MOVE TOTAL-COL-TAX-CHARGED DTSCS41
|
|
02100 TO PAGE-TAX-CHARGED (PAGE-COL-CNT). DTSCS41
|
|
02101 DTSCS41
|
|
02102 MOVE TOTAL-COL-INT-CHARGED DTSCS41
|
|
02103 TO PAGE-INT-CHARGED (PAGE-COL-CNT). DTSCS41
|
|
02104 DTSCS41
|
|
02105 MOVE TOTAL-COL-PEN-CHARGED DTSCS41
|
|
02106 TO PAGE-PEN-CHARGED (PAGE-COL-CNT). DTSCS41
|
|
02107 DTSCS41
|
|
02108 MOVE TOTAL-COL-TAX-PAID DTSCS41
|
|
02109 TO PAGE-TAX-PAID (PAGE-COL-CNT). DTSCS41
|
|
02110 DTSCS41
|
|
02111 MOVE TOTAL-COL-INT-PAID DTSCS41
|
|
02112 TO PAGE-INT-PAID (PAGE-COL-CNT). DTSCS41
|
|
02113 DTSCS41
|
|
02114 MOVE TOTAL-COL-PEN-PAID DTSCS41
|
|
02115 TO PAGE-PEN-PAID (PAGE-COL-CNT). DTSCS41
|
|
02116 DTSCS41
|
|
02117 MOVE TOTAL-COL-TAX-BALANCE DTSCS41
|
|
02118 TO PAGE-TAX-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
02119 DTSCS41
|
|
02120 MOVE TOTAL-COL-INT-BALANCE DTSCS41
|
|
02121 TO PAGE-INT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
02122 DTSCS41
|
|
02123 MOVE TOTAL-COL-PEN-BALANCE DTSCS41
|
|
02124 TO PAGE-PEN-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
02125 DTSCS41
|
|
02126 MOVE TOTAL-COL-TOT-BALANCE DTSCS41
|
|
02127 TO PAGE-TOT-BALANCE (PAGE-COL-CNT). DTSCS41
|
|
02128 DTSCS41
|
|
02129 ***** DTSCS41
|
|
02130 ***** PAGE-ALD IN TOTAL COLUMN ALWAYS EQUAL TO SPACES. DTSCS41
|
|
02131 ***** PER RUDY. 02/27/95. DTSCS41
|
|
02132 ***** DTSCS41
|
|
02133 DTSCS41
|
|
02134 *****MOVE TOTAL-COL-ALD DTSCS41
|
|
02135 ***** TO PAGE-ALD (PAGE-COL-CNT). DTSCS41
|
|
02136 DTSCS41
|
|
02137 MOVE SPACES DTSCS41
|
|
02138 TO PAGE-ALD (PAGE-COL-CNT) DTSCS41
|
|
02139 PAGE-PEN-INT-WAIVE-IND (PAGE-COL-CNT) DTSCS41
|
|
02140 PAGE-REPORT (PAGE-COL-CNT). DTSCS41
|
|
02141 P7320-EXIT. DTSCS41
|
|
02142 EXIT. DTSCS41
|
|
02143 EJECT DTSCS41
|
|
02144 P8100-STORE-PAGE-AREA. DTSCS41
|
|
02145 IF ITEM-CNT < ITEM-MAX-LCCM DTSCS41
|
|
02146 ADD +1 TO ITEM-CNT DTSCS41
|
|
02147 MOVE PAGE-AREA TO LCCM-SCR-PAGE-AREA (ITEM-CNT) DTSCS41
|
|
02148 GO TO P8100-EXIT. DTSCS41
|
|
02149 DTSCS41
|
|
02150 IF ITEM-CNT < ITEM-MAX DTSCS41
|
|
02151 ADD +1 TO ITEM-CNT DTSCS41
|
|
02152 MOVE PAGE-AREA TO L829-REC DTSCS41
|
|
02153 PERFORM S829-WRITE THRU S829-EXIT. DTSCS41
|
|
02154 P8100-EXIT. DTSCS41
|
|
02155 EXIT. DTSCS41
|
|
02156 DTSCS41
|
|
02157 DTSCS41
|
|
02158 DTSCS41
|
|
02159 P8200-RETREIVE-PAGE-AREA. DTSCS41
|
|
02160 IF ITEM-SUB > ITEM-MAX-LCCM DTSCS41
|
|
02161 COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM DTSCS41
|
|
02162 PERFORM S829-READ-ITEM THRU S829-EXIT DTSCS41
|
|
02163 IF L829-NO-REC-88 DTSCS41
|
|
02164 GO TO S899-ABEND DTSCS41
|
|
02165 ELSE DTSCS41
|
|
02166 MOVE L829-REC TO PAGE-AREA DTSCS41
|
|
02167 ELSE DTSCS41
|
|
02168 MOVE LCCM-SCR-PAGE-AREA (ITEM-SUB) TO PAGE-AREA. DTSCS41
|
|
02169 P8200-EXIT. DTSCS41
|
|
02170 EXIT. DTSCS41
|
|
02171 /*****************************************************************DTSCS41
|
|
02172 * LINKS TO UTILITY MODULES DTSCS41
|
|
02173 ******************************************************************DTSCS41
|
|
02174 DTSCS41
|
|
02175 S001-FROM-FED-8. DTSCS41
|
|
02176 SET L001-FROM-FED-8 TO TRUE. DTSCS41
|
|
02177 GO TO S001-DATE. DTSCS41
|
|
02178 DTSCS41
|
|
02179 *S001-FROM-ABS. DTSCS41
|
|
02180 *****SET L001-FROM-ABS TO TRUE. DTSCS41
|
|
02181 *****GO TO S001-DATE. DTSCS41
|
|
02182 DTSCS41
|
|
02183 S001-DATE. DTSCS41
|
|
02184 EXEC CICS LINK DTSCS41
|
|
02185 PROGRAM('DTSCU001') DTSCS41
|
|
02186 COMMAREA(L001-COMM-AREA) DTSCS41
|
|
02187 END-EXEC. DTSCS41
|
|
02188 S001-EXIT. DTSCS41
|
|
02189 EXIT. DTSCS41
|
|
02190 DTSCS41
|
|
02191 S004-FROM-5. DTSCS41
|
|
02192 SET L004-FROM-5 TO TRUE. DTSCS41
|
|
02193 GO TO S004-QTR. DTSCS41
|
|
02194 DTSCS41
|
|
02195 *S004-FROM-ABS. DTSCS41
|
|
02196 *****SET L004-FROM-ABS TO TRUE. DTSCS41
|
|
02197 *****GO TO S004-QTR. DTSCS41
|
|
02198 DTSCS41
|
|
02199 S004-QTR. DTSCS41
|
|
02200 EXEC CICS LINK DTSCS41
|
|
02201 PROGRAM('DTSCU004') DTSCS41
|
|
02202 COMMAREA(L004-COMM-AREA) DTSCS41
|
|
02203 END-EXEC. DTSCS41
|
|
02204 S004-EXIT. DTSCS41
|
|
02205 EXIT. DTSCS41
|
|
02206 DTSCS41
|
|
02207 S015-DATE-FROM-SCREEN. DTSCS41
|
|
02208 EXEC CICS LINK DTSCS41
|
|
02209 PROGRAM('DTSCU015') DTSCS41
|
|
02210 COMMAREA(L015-COMM-AREA) DTSCS41
|
|
02211 END-EXEC. DTSCS41
|
|
02212 S015-EXIT. DTSCS41
|
|
02213 EXIT. DTSCS41
|
|
02214 DTSCS41
|
|
02215 S018-EMP-NO-FROM-SCREEN. DTSCS41
|
|
02216 EXEC CICS LINK DTSCS41
|
|
02217 PROGRAM('DTSCU018') DTSCS41
|
|
02218 COMMAREA(L018-COMM-AREA) DTSCS41
|
|
02219 END-EXEC. DTSCS41
|
|
02220 S018-EXIT. DTSCS41
|
|
02221 EXIT. DTSCS41
|
|
02222 DTSCS41
|
|
02223 *S031-MPRF-EMP-CLASS. DTSCS41
|
|
02224 *****SET L031-MPRF-EMP-CLASS TO TRUE. DTSCS41
|
|
02225 *****GO TO S031-LINK. DTSCS41
|
|
02226 ***** DTSCS41
|
|
02227 *S031-MPRF-EMP-STATUS. DTSCS41
|
|
02228 *****SET L031-MPRF-EMP-STATUS TO TRUE. DTSCS41
|
|
02229 *****GO TO S031-LINK. DTSCS41
|
|
02230 ***** DTSCS41
|
|
02231 *S031-LINK. DTSCS41
|
|
02232 *****EXEC CICS LINK DTSCS41
|
|
02233 ***** PROGRAM ('MACCU031') DTSCS41
|
|
02234 ***** COMMAREA (L031-COMM-AREA) DTSCS41
|
|
02235 ***** LENGTH (L031-LENGTH) DTSCS41
|
|
02236 *****END-EXEC. DTSCS41
|
|
02237 *S031-EXIT. DTSCS41
|
|
02238 *****EXIT. DTSCS41
|
|
02239 DTSCS41
|
|
02240 S033-MQTR-RPT-PURSUE. DTSCS41
|
|
02241 SET L033-MQTR-RPT-PURSUE TO TRUE. DTSCS41
|
|
02242 GO TO S033-LINK. DTSCS41
|
|
02243 DTSCS41
|
|
02244 S033-LINK. DTSCS41
|
|
02245 EXEC CICS LINK DTSCS41
|
|
02246 PROGRAM ('DTSCU033') DTSCS41
|
|
02247 COMMAREA (L033-COMM-AREA) DTSCS41
|
|
02248 END-EXEC. DTSCS41
|
|
02249 S033-EXIT. DTSCS41
|
|
02250 EXIT. DTSCS41
|
|
02251 DTSCS41
|
|
02252 S056-DISP1-RIGHT. DTSCS41
|
|
02253 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS41
|
|
02254 GO TO S056-RATE-DISPLAY. DTSCS41
|
|
02255 DTSCS41
|
|
02256 S056-RATE-DISPLAY. DTSCS41
|
|
02257 EXEC CICS LINK DTSCS41
|
|
02258 PROGRAM('DTSCU056') DTSCS41
|
|
02259 COMMAREA(L056-COMM-AREA) DTSCS41
|
|
02260 END-EXEC. DTSCS41
|
|
02261 S056-EXIT. DTSCS41
|
|
02262 EXIT. DTSCS41
|
|
02263 DTSCS41
|
|
02264 S061-FLD-REP-FROM-ZIP. DTSCS41
|
|
02265 EXEC CICS LINK DTSCS41
|
|
02266 PROGRAM ('DTSCU061') DTSCS41
|
|
02267 COMMAREA (L061-COMM-AREA) DTSCS41
|
|
02268 END-EXEC. DTSCS41
|
|
02269 DTSCS41
|
|
02270 IF L061-FILE-CLOSED DTSCS41
|
|
02271 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS41
|
|
02272 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS41
|
|
02273 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS41
|
|
02274 GO TO MAINLINE-EXIT. DTSCS41
|
|
02275 S061-EXIT. DTSCS41
|
|
02276 EXIT. DTSCS41
|
|
02277 DTSCS41
|
|
02278 *S101-PER-DIEM-NO. DTSCS41
|
|
02279 *****SET L101-PER-DIEM-NO-88 TO TRUE. DTSCS41
|
|
02280 *****GO TO S101-INT-PEN-COMP. DTSCS41
|
|
02281 DTSCS41
|
|
02282 S101-PER-MONTH-YES. DTSCS41
|
|
02283 SET L101-PER-MONTH-YES-88 TO TRUE. DTSCS41
|
|
02284 GO TO S101-INT-PEN-COMP. DTSCS41
|
|
02285 DTSCS41
|
|
02286 S101-INT-PEN-COMP. DTSCS41
|
|
02287 EXEC CICS LINK DTSCS41
|
|
02288 PROGRAM ('DTSCU101') DTSCS41
|
|
02289 COMMAREA (L101-COMM-AREA) DTSCS41
|
|
02290 END-EXEC. DTSCS41
|
|
02291 S101-EXIT. DTSCS41
|
|
02292 EXIT. DTSCS41
|
|
02293 DTSCS41
|
|
02294 S109-SUR-TAX-QTR. DTSCS41
|
|
02295 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS41
|
|
02296 DTSCS41
|
|
02297 EXEC CICS LINK DTSCS41
|
|
02298 PROGRAM ('DTSCU109') DTSCS41
|
|
02299 COMMAREA (L109-COMM-AREA) DTSCS41
|
|
02300 END-EXEC. DTSCS41
|
|
02301 S109-EXIT. DTSCS41
|
|
02302 EXIT. DTSCS41
|
|
02303 DTSCS41
|
|
02304 S803-REQ-SCR-ID-EDIT. DTSCS41
|
|
02305 EXEC CICS LINK DTSCS41
|
|
02306 PROGRAM ('DTSCU803') DTSCS41
|
|
02307 COMMAREA (DFHCOMMAREA) DTSCS41
|
|
02308 END-EXEC. DTSCS41
|
|
02309 S803-EXIT. DTSCS41
|
|
02310 EXIT. DTSCS41
|
|
02311 DTSCS41
|
|
02312 S804-INVALID-KEY. DTSCS41
|
|
02313 EXEC CICS LINK DTSCS41
|
|
02314 PROGRAM ('DTSCU804') DTSCS41
|
|
02315 COMMAREA (DFHCOMMAREA) DTSCS41
|
|
02316 END-EXEC. DTSCS41
|
|
02317 S804-EXIT. DTSCS41
|
|
02318 EXIT. DTSCS41
|
|
02319 DTSCS41
|
|
02320 S805-MSG-AREA. DTSCS41
|
|
02321 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS41
|
|
02322 DTSCS41
|
|
02323 EXEC CICS LINK DTSCS41
|
|
02324 PROGRAM ('DTSCU805') DTSCS41
|
|
02325 COMMAREA (L805-COMM-AREA) DTSCS41
|
|
02326 END-EXEC. DTSCS41
|
|
02327 DTSCS41
|
|
02328 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS41
|
|
02329 S805-EXIT. DTSCS41
|
|
02330 EXIT. DTSCS41
|
|
02331 EJECT DTSCS41
|
|
02332 S810-READ. DTSCS41
|
|
02333 SET L810-READ-88 TO TRUE. DTSCS41
|
|
02334 GO TO S810-IO. DTSCS41
|
|
02335 DTSCS41
|
|
02336 S810-START-BROWSE. DTSCS41
|
|
02337 SET L810-START-BROWSE-88 TO TRUE. DTSCS41
|
|
02338 GO TO S810-IO. DTSCS41
|
|
02339 DTSCS41
|
|
02340 S810-READ-NEXT. DTSCS41
|
|
02341 SET L810-READ-NEXT-88 TO TRUE. DTSCS41
|
|
02342 GO TO S810-IO. DTSCS41
|
|
02343 DTSCS41
|
|
02344 S810-READ-PREV. DTSCS41
|
|
02345 SET L810-READ-PREV-88 TO TRUE. DTSCS41
|
|
02346 GO TO S810-IO. DTSCS41
|
|
02347 DTSCS41
|
|
02348 S810-END-BROWSE. DTSCS41
|
|
02349 SET L810-END-BROWSE-88 TO TRUE. DTSCS41
|
|
02350 GO TO S810-IO. DTSCS41
|
|
02351 DTSCS41
|
|
02352 S810-COUNT. DTSCS41
|
|
02353 SET L810-COUNT-88 TO TRUE. DTSCS41
|
|
02354 GO TO S810-IO. DTSCS41
|
|
02355 DTSCS41
|
|
02356 *S810-REWRITE. DTSCS41
|
|
02357 *****SET L810-REWRITE-88 TO TRUE. DTSCS41
|
|
02358 *****GO TO S810-IO. DTSCS41
|
|
02359 ***** DTSCS41
|
|
02360 *S810-WRITE. DTSCS41
|
|
02361 *****SET L810-WRITE-88 TO TRUE. DTSCS41
|
|
02362 *****GO TO S810-IO. DTSCS41
|
|
02363 ***** DTSCS41
|
|
02364 *S810-DELETE. DTSCS41
|
|
02365 *****SET L810-DELETE-88 TO TRUE. DTSCS41
|
|
02366 *****GO TO S810-IO. DTSCS41
|
|
02367 DTSCS41
|
|
02368 S810-IO. DTSCS41
|
|
02369 DTSCS41
|
|
02370 EXEC CICS LINK DTSCS41
|
|
02371 PROGRAM ('DTSCU810') DTSCS41
|
|
02372 COMMAREA (L810-COMM-AREA) DTSCS41
|
|
02373 END-EXEC. DTSCS41
|
|
02374 DTSCS41
|
|
02375 IF L810-FILE-CLOSED-88 DTSCS41
|
|
02376 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS41
|
|
02377 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS41
|
|
02378 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS41
|
|
02379 GO TO MAINLINE-EXIT. DTSCS41
|
|
02380 S810-EXIT. DTSCS41
|
|
02381 EXIT. DTSCS41
|
|
02382 EJECT DTSCS41
|
|
02383 S829-READ-ITEM. DTSCS41
|
|
02384 SET L829-READ-ITEM-88 TO TRUE. DTSCS41
|
|
02385 GO TO S829-IO. DTSCS41
|
|
02386 DTSCS41
|
|
02387 S829-WRITE. DTSCS41
|
|
02388 SET L829-WRITE-88 TO TRUE. DTSCS41
|
|
02389 GO TO S829-IO. DTSCS41
|
|
02390 DTSCS41
|
|
02391 S829-DELETE-QUEUE. DTSCS41
|
|
02392 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS41
|
|
02393 GO TO S829-IO. DTSCS41
|
|
02394 DTSCS41
|
|
02395 S829-IO. DTSCS41
|
|
02396 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS41
|
|
02397 MOVE 'S' TO L829-QUEUE-NAME-SUFFIX. DTSCS41
|
|
02398 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCS41
|
|
02399 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS41
|
|
02400 DTSCS41
|
|
02401 EXEC CICS DTSCS41
|
|
02402 LINK DTSCS41
|
|
02403 PROGRAM ('DTSCU829') DTSCS41
|
|
02404 COMMAREA (L829-COMM-AREA) DTSCS41
|
|
02405 END-EXEC. DTSCS41
|
|
02406 S829-EXIT. DTSCS41
|
|
02407 EXIT. DTSCS41
|
|
02408 EJECT DTSCS41
|
|
02409 S851-SCREEN-PROCESSING. DTSCS41
|
|
02410 EXEC CICS LINK DTSCS41
|
|
02411 PROGRAM ('DTSCU851') DTSCS41
|
|
02412 COMMAREA (L851-COMM-AREA) DTSCS41
|
|
02413 END-EXEC. DTSCS41
|
|
02414 S851-EXIT. DTSCS41
|
|
02415 EXIT. DTSCS41
|
|
02416 DTSCS41
|
|
02417 S899-ABEND. DTSCS41
|
|
02418 EXEC CICS ABEND DTSCS41
|
|
02419 ABCODE(WRK-ABEND-CD) DTSCS41
|
|
02420 END-EXEC. DTSCS41
|
|
02421 *S899-EXIT. DTSCS41
|
|
02422 * EXIT. DTSCS41
|
|
02423 EJECT DTSCS41
|
|
02424 S1100-EDIT-KEY. DTSCS41
|
|
02425 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS41
|
|
02426 S1100-EXIT. DTSCS41
|
|
02427 EXIT. DTSCS41
|
|
02428 /*****************************************************************DTSCS41
|
|
02429 * DTSCS41
|
|
02430 ******************************************************************DTSCS41
|
|
02431 S1101-EMP-NO. DTSCS41
|
|
02432 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS41
|
|
02433 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS41
|
|
02434 DTSCS41
|
|
02435 IF L018-NO-ENTRY DTSCS41
|
|
02436 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS41
|
|
02437 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS41
|
|
02438 GO TO S1101-EXIT. DTSCS41
|
|
02439 DTSCS41
|
|
02440 IF L018-NOT-VALID DTSCS41
|
|
02441 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS41
|
|
02442 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS41
|
|
02443 GO TO S1101-EXIT. DTSCS41
|
|
02444 DTSCS41
|
|
02445 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS41
|
|
02446 DTSCS41
|
|
02447 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS41
|
|
02448 S1101-EXIT. DTSCS41
|
|
02449 EXIT. DTSCS41
|
|
02450 DTSCS41
|
|
02451 S1110-READ-MPRF. DTSCS41
|
|
02452 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS41
|
|
02453 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS41
|
|
02454 SET MPRF-PRF-88 TO TRUE. DTSCS41
|
|
02455 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS41
|
|
02456 PERFORM S810-READ THRU S810-EXIT. DTSCS41
|
|
02457 IF L810-NO-REC-88 DTSCS41
|
|
02458 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS41
|
|
02459 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS41
|
|
02460 ELSE DTSCS41
|
|
02461 MOVE MSKL-REC TO MPRF-REC DTSCS41
|
|
02462 SET WRK-MPRF-YES-88 TO TRUE. DTSCS41
|
|
02463 S1110-EXIT. DTSCS41
|
|
02464 EXIT. DTSCS41
|
|
02465 DTSCS41
|
|
02466 S1199-ERROR. DTSCS41
|
|
02467 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS41
|
|
02468 MAP-EMP-NO-2-A. DTSCS41
|
|
02469 IF LCCM-NO-MSG DTSCS41
|
|
02470 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS41
|
|
02471 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS41
|
|
02472 SET CURSOR-SET-YES TO TRUE. DTSCS41
|
|
02473 S1199-EXIT. DTSCS41
|
|
02474 EXIT. DTSCS41
|
|
02475 /*****************************************************************DTSCS41
|
|
02476 * *DTSCS41
|
|
02477 ******************************************************************DTSCS41
|
|
02478 S1200-COMP-DATE. DTSCS41
|
|
02479 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS41
|
|
02480 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS41
|
|
02481 DTSCS41
|
|
02482 IF MAP-COMP-MO = '99' DTSCS41
|
|
02483 AND MAP-COMP-DA = '99' DTSCS41
|
|
02484 AND MAP-COMP-YR = '99' DTSCS41
|
|
02485 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS41
|
|
02486 GO TO S1200-EXIT. DTSCS41
|
|
02487 DTSCS41
|
|
02488 IF L015-NO-ENTRY DTSCS41
|
|
02489 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS41
|
|
02490 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO DTSCS41
|
|
02491 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA DTSCS41
|
|
02492 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR DTSCS41
|
|
02493 ELSE DTSCS41
|
|
02494 IF L015-NOT-VALID DTSCS41
|
|
02495 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS41
|
|
02496 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS41
|
|
02497 ELSE DTSCS41
|
|
02498 MOVE L015-DATE TO LCCM-COMP-DATE. DTSCS41
|
|
02499 S1200-EXIT. DTSCS41
|
|
02500 EXIT. DTSCS41
|
|
02501 DTSCS41
|
|
02502 S1201-ERROR. DTSCS41
|
|
02503 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS41
|
|
02504 TO MAP-COMP-MO-A DTSCS41
|
|
02505 MAP-COMP-DA-A DTSCS41
|
|
02506 MAP-COMP-YR-A. DTSCS41
|
|
02507 IF LCCM-NO-MSG DTSCS41
|
|
02508 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS41
|
|
02509 MOVE CATB-CURSOR TO MAP-COMP-MO-L DTSCS41
|
|
02510 SET CURSOR-SET-YES TO TRUE. DTSCS41
|
|
02511 S1201-EXIT. DTSCS41
|
|
02512 EXIT. DTSCS41
|
|
02513 DTSCS41
|
|
02514 /*****************************************************************DTSCS41
|
|
02515 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS41
|
|
02516 ******************************************************************DTSCS41
|
|
02517 S5300-SET-INQ-ATTRB. DTSCS41
|
|
02518 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS41
|
|
02519 WRK-ATB-NUM. DTSCS41
|
|
02520 DTSCS41
|
|
02521 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS41
|
|
02522 S5300-EXIT. DTSCS41
|
|
02523 EXIT. DTSCS41
|
|
02524 DTSCS41
|
|
02525 S5900-SET-ATTRB. DTSCS41
|
|
02526 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS41
|
|
02527 MAP-EMP-NO-2-A. DTSCS41
|
|
02528 DTSCS41
|
|
02529 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-PRIMARY-NAME-A DTSCS41
|
|
02530 MAP-NOTE-A DTSCS41
|
|
02531 MAP-FLD-REP-ID-A DTSCS41
|
|
02532 MAP-EMP-CLASS-A DTSCS41
|
|
02533 MAP-RECENT-SOL-A DTSCS41
|
|
02534 MAP-SOL-CNT-A DTSCS41
|
|
02535 MAP-CURR-PAGE-A DTSCS41
|
|
02536 MAP-LAST-PAGE-A DTSCS41
|
|
02537 MAP-VOICE-1-AREA-A DTSCS41
|
|
02538 MAP-VOICE-1-PREFIX-A DTSCS41
|
|
02539 MAP-VOICE-1-SUFFIX-A DTSCS41
|
|
02540 MAP-WRITE-OFF-IND-A DTSCS41
|
|
02541 MAP-EMP-STATUS-A DTSCS41
|
|
02542 MAP-TOT-WAIVE-AMT-PROJ-A DTSCS41
|
|
02543 MAP-TOT-DUE-AMT-A DTSCS41
|
|
02544 MAP-SUBPOENA-CD-A DTSCS41
|
|
02545 MAP-SUBPOENA-DATE-A DTSCS41
|
|
02546 MAP-BNK-OPEN-IND-A DTSCS41
|
|
02547 MAP-INT-PER-MONTH-AMT-A DTSCS41
|
|
02548 MAP-PURSUED-RPT-CNT-A. DTSCS41
|
|
02549 DTSCS41
|
|
02550 PERFORM DTSCS41
|
|
02551 VARYING COL-OCC FROM 1 BY 1 DTSCS41
|
|
02552 UNTIL COL-OCC > COLS-PER-PAGE DTSCS41
|
|
02553 MOVE CATB-ASKIP-BRT-MDTOFF TO DTSCS41
|
|
02554 MAP-ALD-A (COL-OCC) DTSCS41
|
|
02555 MAP-INT-BALANCE-A (COL-OCC) DTSCS41
|
|
02556 MAP-INT-CHARGED-A (COL-OCC) DTSCS41
|
|
02557 MAP-INT-PAID-A (COL-OCC) DTSCS41
|
|
02558 MAP-PEN-INT-WAIVE-IND-A (COL-OCC) DTSCS41
|
|
02559 MAP-PEN-BALANCE-A (COL-OCC) DTSCS41
|
|
02560 MAP-PEN-CHARGED-A (COL-OCC) DTSCS41
|
|
02561 MAP-PEN-PAID-A (COL-OCC) DTSCS41
|
|
02562 MAP-REPORT-A (COL-OCC) DTSCS41
|
|
02563 MAP-TAX-BALANCE-A (COL-OCC) DTSCS41
|
|
02564 MAP-TAX-CHARGED-A (COL-OCC) DTSCS41
|
|
02565 MAP-TAX-PAID-A (COL-OCC) DTSCS41
|
|
02566 MAP-TAX-WAGE-A (COL-OCC) DTSCS41
|
|
02567 MAP-TOT-WAGE-A (COL-OCC) DTSCS41
|
|
02568 MAP-TOT-BALANCE-A (COL-OCC) DTSCS41
|
|
02569 MAP-UI-RATE-A (COL-OCC) DTSCS41
|
|
02570 MAP-YRQ-DISPLAY-A (COL-OCC) DTSCS41
|
|
02571 END-PERFORM. DTSCS41
|
|
02572 DTSCS41
|
|
02573 MOVE CATB-UNPROT-BRT-NUM-MDTON TO DTSCS41
|
|
02574 MAP-COMP-DA-A DTSCS41
|
|
02575 MAP-COMP-MO-A DTSCS41
|
|
02576 MAP-COMP-YR-A. DTSCS41
|
|
02577 DTSCS41
|
|
02578 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS41
|
|
02579 S5900-EXIT. DTSCS41
|
|
02580 EXIT. DTSCS41
|
|
02581 /*****************************************************************DTSCS41
|
|
02582 * MAP ROUTINES *DTSCS41
|
|
02583 ******************************************************************DTSCS41
|
|
02584 S9100-RECEIVE. DTSCS41
|
|
02585 SET L851-RECEIVE-88 TO TRUE. DTSCS41
|
|
02586 DTSCS41
|
|
02587 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS41
|
|
02588 DTSCS41
|
|
02589 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS41
|
|
02590 DTSCS41
|
|
02591 MOVE L851-AID TO LCCM-AID. DTSCS41
|
|
02592 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS41
|
|
02593 S9100-EXIT. DTSCS41
|
|
02594 EXIT. DTSCS41
|
|
02595 DTSCS41
|
|
02596 S9200-SEND-DATAONLY. DTSCS41
|
|
02597 MOVE LOW-VALUES TO MAP-AREA. DTSCS41
|
|
02598 DTSCS41
|
|
02599 IF LCCM-NO-MSG DTSCS41
|
|
02600 NEXT SENTENCE DTSCS41
|
|
02601 ELSE DTSCS41
|
|
02602 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS41
|
|
02603 DTSCS41
|
|
02604 IF CURSOR-SET-GOTO DTSCS41
|
|
02605 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS41
|
|
02606 ELSE DTSCS41
|
|
02607 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS41
|
|
02608 DTSCS41
|
|
02609 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS41
|
|
02610 DTSCS41
|
|
02611 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS41
|
|
02612 DTSCS41
|
|
02613 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS41
|
|
02614 S9200-EXIT. DTSCS41
|
|
02615 EXIT. DTSCS41
|
|
02616 DTSCS41
|
|
02617 S9300-SEND-MAP. DTSCS41
|
|
02618 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS41
|
|
02619 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS41
|
|
02620 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS41
|
|
02621 DTSCS41
|
|
02622 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS41
|
|
02623 DTSCS41
|
|
02624 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS41
|
|
02625 DTSCS41
|
|
02626 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS41
|
|
02627 DTSCS41
|
|
02628 IF CURSOR-SET-NO DTSCS41
|
|
02629 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS41
|
|
02630 DTSCS41
|
|
02631 SET L851-SEND-88 TO TRUE. DTSCS41
|
|
02632 DTSCS41
|
|
02633 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS41
|
|
02634 DTSCS41
|
|
02635 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS41
|
|
02636 S9300-EXIT. DTSCS41
|
|
02637 EXIT. DTSCS41
|
|
02638 DTSCS41
|
|
02639 S9320-INQUIRY-FKEYS. DTSCS41
|
|
02640 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS41
|
|
02641 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS41
|
|
02642 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS41
|
|
02643 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS41
|
|
02644 DTSCS41
|
|
02645 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS41
|
|
02646 S9320-EXIT. DTSCS41
|
|
02647 EXIT. DTSCS41
|
|
02648 DTSCS41
|
|
02649 *S9321-JUMP-KEYS. DTSCS41
|
|
02650 * MOVE 'F9=NOTE' TO MAP-KEY-NOTE. DTSCS41
|
|
02651 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS41
|
|
02652 * MOVE CFKD-REG-SEARCH TO MAP-KEY-SEARCH. DTSCS41
|
|
02653 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS41
|
|
02654 *S9321-EXIT. DTSCS41
|
|
02655 * EXIT. DTSCS41
|
|
02656 DTSCS41
|
|
02657 S9330-DSCR-FIELDS. DTSCS41
|
|
02658 IF WRK-MPRF-YES-88 DTSCS41
|
|
02659 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS41
|
|
02660 ELSE DTSCS41
|
|
02661 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS41
|
|
02662 S9330-EXIT. DTSCS41
|
|
02663 EXIT. DTSCS41
|
|
02664 DTSCS41
|
|
02665 S9900-PREPARE-SEND. DTSCS41
|
|
02666 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS41
|
|
02667 LCCM-SCR-ID. DTSCS41
|
|
02668 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS41
|
|
02669 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS41
|
|
02670 S9900-EXIT. DTSCS41
|
|
02671 EXIT. DTSCS41
|