00001 IDENTIFICATION DIVISION. 04/01/11 00002 PROGRAM-ID. DTSCS46. DTSCS46 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV047 00004 DATE-WRITTEN. DECEMBER 1994. DTSCS46 00005 DATE-COMPILED. DTSCS46 00006 SKIP3 DTSCS46 00007 ***** DTSCS46 00008 ****** DTSCS46 00009 * FUNCTION: DUE/CREDIT PRINT SCREEN PROCESSOR. DTSCS46 00010 * DTSCS46 00011 * DTSCS46 00012 * MODIFICATION LOG: DTSCS46 00013 * DTSCS46 00014 * 01-02-96 ADDED HEAD01-SCREEN-ID (THE DEBIT MEMO IS SOMETIMES DTSCS46 00015 * USED AS A DATA ENTRY FORM). DTSCS46 00016 * REFERENCE RFP #PROD RECOVERY PROGRAMMER: MJA DTSCS46 00017 * DTSCS46 00018 * 11-07-97 MODIFICATIONS TO REFLECT THE TRANSFER OF UI TAX DTSCS46 00019 * FUNCTIONS FROM DLI TO DOR. DTSCS46 00020 * REFERENCE RFP #TCL 208 PROGRAMMER: EHH DTSCS46 00021 * DTSCS46 00022 * 08/06/1999 REVIEWED AND MODIFIED FOR DC. DTSCS46 00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCS46 00024 * DTSCS46 00025 * 08/08/2001 CHANGED ENFORCEMENT UNIT PHONE NUMBER TO DTSCS46 00026 * FIELD REP PHONE NUMBER. DTSCS46 00027 * REFERENCE: ENH043 PROGRAMMER: GD DTSCS46 00028 * DTSCS46 00029 * DTSCS46 00030 * 09/17/2002 CHANGED PROGRAM TO DISPLAY ANNUAL FILERS ON ONE DTSCS46 00031 * LINE AND PLACE (*) IN THE QTR FIELD. DTSCS46 00032 * REFERENCE: HOUSEHOLD PROGRAMMER: ZL1 DTSCS46 00033 * DTSCS46 00034 * 05/26/2005 MODIFIED CODE IN P7310 TO CORRECT ERROR IN DTSCS46 00035 * TOTALS FOR ANNUAL REPORTS. DTSCS46 00036 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSCS46 00037 * DTSCS46 00038 * 04/26/2007 MODIFIED CODE TO EXCLUDE SUR TAX FROM INTEREST DTSCS46 00039 * CALC. DTSCS46 00040 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS46 00041 * DTSCS46 00042 * 02/12/2008 MODIFIED CODE TO INCLUDE SUR TAX FROM INTEREST DTSCS46 00043 * CALC. DTSCS46 00044 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS46 00045 * DTSCS46 00046 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS46 00047 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS46 00048 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS46 00049 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS46 00050 * DTSCS46 00051 * DTSCS46 00052 * DESCRIPTION: DTSCS46 00053 * DTSCS46 00054 * CLEAR: DTSCS46 00055 * DTSCS46 00056 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS46 00057 * DTSCS46 00058 * DTSCS46 00059 * JUMP: DTSCS46 00060 * DTSCS46 00061 * STANDRAD DTSCS46 00062 * DTSCS46 00063 * DTSCS46 00064 * INQUIRY: DTSCS46 00065 * DTSCS46 00066 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS46 00067 * DTSCS46 00068 * JUMP IN: DISPLAY INFOMRATION INDICATED BY LCCM-EMP-NO DTSCS46 00069 * DTSCS46 00070 * FIRST PAGE DISPLAYED SHOULD BE FIRST DETAIL DTSCS46 00071 * LINES OF THE STATEMENT. DTSCS46 00072 * DTSCS46 00073 * ENTER, F05, F06, F07, F08: PAGING THRU PRINT LINES DTSCS46 00074 * STORED IN TS Q 'S'. DTSCS46 00075 * DTSCS46 00076 * DISPLAY SEQUENCE: ASCENDING ON TS Q 'S' DTSCS46 00077 * ITEM NUMBER. DTSCS46 00078 * DTSCS46 00079 * PAGE INITIALLY DISPLAYED: FIRST DETAIL LINES OF STATEMENT.DTSCS46 00080 * DTSCS46 00081 * DTSCS46 00082 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS46 00083 * DTSCS46 00084 * DELETE TS Q 'S'. DTSCS46 00085 * DTSCS46 00086 * DTSCS46 00087 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS46 00088 * DTSCS46 00089 * TRY FOR SOME EFFICIENCY. THAT IS, AS LONG AS THE DTSCS46 00090 * CONTROL INFOMATION (EMP NO, YR/Q, ADDRESS TYPE/ID, DTSCS46 00091 * ORIGINATOR) DOES NOT CHANGE AND THE PRINT LINES DTSCS46 00092 * STORED IN TS Q 'S' ARE NOT OUT OF DATE; KEEP THE DTSCS46 00093 * TS Q 'S' RECORDS AROUND BETWEEN TASKS AND DON'T, DTSCS46 00094 * AS THE TERMINAL OPERATOR PAGES THRU THE TS Q 'S' DTSCS46 00095 * RECORDS, REBUILD THE TS Q 'S' RECORDS. DTSCS46 00096 * DTSCS46 00097 * DTSCS46 00098 * MAINTAIN LCCM-COMP-DATE. DTSCS46 00099 * DTSCS46 00100 * MAINTAIN LCCM-PRINTER-ID. DTSCS46 00101 * DTSCS46 00102 * MAINTAIN LCCM-RESP-OP-ID. DTSCS46 00103 * DTSCS46 00104 * DTSCS46 00105 * PRINT: DTSCS46 00106 * DTSCS46 00107 * 'PRINT' SHOULD BE MADE TO WORK MUCH LIKE A 'MOD' ON AN DTSCS46 00108 * UPDATE SCREEN (SUCCESSFUL INQUIRY; F9; PRINT OR CANCEL DTSCS46 00109 * PRINT). DTSCS46 00110 * DTSCS46 00111 * ON THIS SCREEN LCCM-OP-SCR-NUM-UPD-ACCESS-88 IMPLIES DTSCS46 00112 * PRINT AUTHORITY. DTSCS46 00113 * DTSCS46 00114 * COPY TS Q 'S' RECORDS MAP-COPIES TIMES TO TS Q 'P'. DTSCS46 00115 * LINK TO DTSCU357, TELLING DTSCU357 TO PRINT TS Q 'P'. DTSCS46 00116 * DTSCS46 00117 * DTSCS46 00118 * UPDATE: DTSCS46 00119 * DTSCS46 00120 * NONE. DTSCS46 00121 * DTSCS46 00122 * DTSCS46 00123 * RECORDS READ: DTSCS46 00124 * DTSCS46 00125 * MASTER: DTSCS46 00126 * DTSCS46 00127 * MPRF DTSCS46 00128 * MCOL DTSCS46 00129 * MQTR DTSCS46 00130 * MPAY DTSCS46 00131 * MAPL DTSCS46 00132 * DTSCS46 00133 * DTSCS46 00134 * ALTERNATE INDEX: DTSCS46 00135 * DTSCS46 00136 * NONE. DTSCS46 00137 * DTSCS46 00138 * DTSCS46 00139 * REFERENCE: DTSCS46 00140 * DTSCS46 00141 * NONE. DTSCS46 00142 * DTSCS46 00143 * DTSCS46 00144 * ACCOUNTING TRANSACTION COLLECTION: DTSCS46 00145 * DTSCS46 00146 * NONE. DTSCS46 00147 * DTSCS46 00148 * DTSCS46 00149 * RECORDS UPDATED: DTSCS46 00150 * DTSCS46 00151 * MASTER: DTSCS46 00152 * DTSCS46 00153 * MEVL (WRITE) (WHEN A STATEMENT IS PRINTED, DTSCS46 00154 * WRITE A MEVL RECORD). DTSCS46 00155 * MCOL (REWRITE, WRITE) DTSCS46 00156 * (WHEN A STATEMENT IS PRINTED) DTSCS46 00157 * DTSCS46 00158 * DTSCS46 00159 * DTSCS46 00160 * REFERENCE: DTSCS46 00161 * DTSCS46 00162 * NONE. DTSCS46 00163 * DTSCS46 00164 * DTSCS46 00165 * ACCOUNTING TRANSACTION COLLECTION: DTSCS46 00166 * DTSCS46 00167 * NONE. DTSCS46 00168 * DTSCS46 00169 * DTSCS46 00170 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS46 00171 * DTSCS46 00172 * NONE. DTSCS46 00173 * DTSCS46 00174 * DTSCS46 00175 * TEMPORARY STORAGE USAGE: DTSCS46 00176 * DTSCS46 00177 * P TELL DTSCU357 TO PRINT TS Q 'P' RECORDS. DTSCS46 00178 * DTSCS46 00179 * DTSCS46 00180 * MODULES LINKED TO: DTSCS46 00181 * DTSCS46 00182 * DTSCU001 DATE EDIT/CONVERSION. DTSCS46 00183 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS46 00184 * DTSCU013 COUNT (INTEGER) FROM SCREEN FORMAT/EDIT. DTSCS46 00185 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS46 00186 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS46 00187 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS46 00188 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS46 00189 * DTSCU101 INTEREST CHARGE/WAIVER COMPUTATION DTSCS46 00190 * DTSCU111 ADDRESS LOOKUP. DTSCS46 00191 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS46 00192 * DTSCU119 AGENCY FACTS. DTSCS46 00193 * DTSCU221 EMPLOYER LOCK/UNLOCK. DTSCS46 00194 * DTSCU356 PRINTER CONTROL CODES. DTSCS46 00195 * DTSCU357 ON-LINE PRINTING. DTSCS46 00196 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS46 00197 * DTSCU829 TEMPORARY STORAGE INPUT/OUTPUT. DTSCS46 00198 * DTSCS46 00199 ***** DTSCS46 00200 DTSCS46 00201 DTSCS46 00202 DTSCS46 00203 ENVIRONMENT DIVISION. DTSCS46 00204 DTSCS46 00205 DTSCS46 00206 DATA DIVISION. DTSCS46 00207 DTSCS46 00208 DTSCS46 00209 WORKING-STORAGE SECTION. DTSCS46 002095 77 PAN-VALET PICTURE X(24) VALUE '047DTSCS46 04/01/11'. DTSCS46 00210 DTSCS46 00211 01 WRK-AREA. DTSCS46 00212 05 WRK-ABEND-CD PIC X(04) VALUE 'S46 '. DTSCS46 00213 DTSCS46 00214 05 WRK-SCR-ID. DTSCS46 00215 10 WRK-SCR-ID-N PIC 9(02) VALUE 46. DTSCS46 00216 DTSCS46 00217 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS46 00218 DTSCS46 00219 05 TEXT-LINE-MAX PIC S9(04) COMP VALUE +4. DTSCS46 00220 DTSCS46 00221 DTSCS46 00222 05 WINDOW-LINE-MAX PIC S9(04) COMP VALUE +8. DTSCS46 00223 DTSCS46 00224 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCS46 00225 VALUE +99999. DTSCS46 00226 DTSCS46 00227 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS46 00228 VALUE +999999999. DTSCS46 00229 DTSCS46 00230 05 LINE-MAX PIC S9(03) COMP-3 DTSCS46 00231 VALUE +60. DTSCS46 00232 DTSCS46 00233 05 SCREEN-QUEUE-NAME-SUFFIX PIC X(01) VALUE 'S'. DTSCS46 00234 DTSCS46 00235 05 PRINT-QUEUE-NAME-SUFFIX PIC X(01) VALUE 'P'. DTSCS46 00236 DTSCS46 00237 DTSCS46 00238 DTSCS46 00239 05 TS-ITEM-LENGTH PIC S9(04) COMP. DTSCS46 00240 DTSCS46 00241 05 WRK-YRQ PIC 9(05). DTSCS46 00242 05 FILLER REDEFINES WRK-YRQ. DTSCS46 00243 10 WRK-YRQ-YR PIC 9(04). DTSCS46 00244 10 WRK-YRQ-Q PIC 9(01). DTSCS46 00245 DTSCS46 00246 DTSCS46 00247 05 WRK-CURR-ANN-YRQ PIC 9(05). DTSCS46 00248 05 FILLER REDEFINES WRK-CURR-ANN-YRQ. DTSCS46 00249 10 WRK-CURR-ANN-YR PIC 9(04). DTSCS46 00250 10 WRK-CURR-ANN-Q PIC 9(01). DTSCS46 00251 DTSCS46 00252 05 WRK-QUEUE-NAME-SUFFIX PIC X(01). DTSCS46 00253 DTSCS46 00254 DTSCS46 00255 05 SCR-ACCESS-IND PIC X(01). DTSCS46 00256 88 SCR-ACCESS-INQ VALUE '1'. DTSCS46 00257 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS46 00258 DTSCS46 00259 DTSCS46 00260 05 CURSOR-SET-IND PIC X(01). DTSCS46 00261 88 CURSOR-SET-YES VALUE 'Y'. DTSCS46 00262 88 CURSOR-SET-NO VALUE 'N'. DTSCS46 00263 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS46 00264 DTSCS46 00265 DTSCS46 00266 05 REQ-IND PIC X(01). DTSCS46 00267 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS46 00268 88 REQ-ERROR VALUE 'O'. DTSCS46 00269 88 REQ-JUMP VALUE 'J'. DTSCS46 00270 88 REQ-UPDATE VALUE 'U'. DTSCS46 00271 88 REQ-INQUIRE VALUE 'I'. DTSCS46 00272 88 REQ-CLEAR VALUE 'C'. DTSCS46 00273 88 REQ-EDIT VALUE 'E'. DTSCS46 00274 DTSCS46 00275 DTSCS46 00276 05 RESP-IND PIC X(01). DTSCS46 00277 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS46 00278 88 RESP-SEND-MAP VALUE 'M'. DTSCS46 00279 88 RESP-JUMP VALUE 'J'. DTSCS46 00280 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS46 00281 DTSCS46 00282 DTSCS46 00283 05 WRK-MSG-AREA PIC X(64). DTSCS46 00284 DTSCS46 00285 DTSCS46 00286 05 WRK-ATB-AN PIC X(01). DTSCS46 00287 DTSCS46 00288 05 WRK-ATB-NUM PIC X(01). DTSCS46 00289 DTSCS46 00290 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS46 00291 DTSCS46 00292 05 WRK-CTR PIC S9(04) COMP. DTSCS46 00293 DTSCS46 00294 05 WRK-COPIES PIC X(01). DTSCS46 00295 DTSCS46 00296 DTSCS46 00297 05 WRK-MPRF-IND PIC X(01). DTSCS46 00298 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS46 00299 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS46 00300 DTSCS46 00301 DTSCS46 00302 05 WRK-DISPLAY PIC 9(11). DTSCS46 00303 DTSCS46 00304 05 FILLER REDEFINES WRK-DISPLAY. DTSCS46 00305 10 FILLER PIC X(05). DTSCS46 00306 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS46 00307 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS46 00308 DTSCS46 00309 05 FILLER REDEFINES WRK-DISPLAY. DTSCS46 00310 10 FILLER PIC X(08). DTSCS46 00311 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS46 00312 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS46 00313 10 WRK-YRQ-Q REDEFINES WRK-DISPLAY-QTR-Q PIC 9(01). DTSCS46 00314 DTSCS46 00315 05 FILLER REDEFINES WRK-DISPLAY. DTSCS46 00316 10 FILLER PIC X(06). DTSCS46 00317 10 WRK-DISPLAY-QTR-BIG-YR PIC X(04). DTSCS46 00318 10 WRK-DISPLAY-QTR-BIG-Q PIC X(01). DTSCS46 00319 DTSCS46 00320 05 FILLER REDEFINES WRK-DISPLAY. DTSCS46 00321 10 FILLER PIC 9(05). DTSCS46 00322 10 WRK-DISPLAY-YR PIC 9(02). DTSCS46 00323 10 WRK-DISPLAY-MO PIC 9(02). DTSCS46 00324 10 WRK-DISPLAY-DA PIC 9(02). DTSCS46 00325 DTSCS46 00326 DTSCS46 00327 05 WS-AMT PIC X(14). DTSCS46 00328 05 WS-AMT-EDIT REDEFINES WS-AMT DTSCS46 00329 PIC ZZZ,ZZZ,ZZ9.99. DTSCS46 00330 DTSCS46 00331 DTSCS46 00332 05 WRK-SCR-HOLD-CONTROL-AREA. DTSCS46 00333 10 WRK-SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS46 00334 10 WRK-SCR-HOLD-FROM-YRQ PIC S9(05) COMP-3. DTSCS46 00335 10 WRK-SCR-HOLD-TO-YRQ PIC S9(05) COMP-3. DTSCS46 00336 10 WRK-SCR-HOLD-COMP-DATE PIC S9(09) COMP-3. DTSCS46 00337 10 WRK-SCR-HOLD-ADDR-TYPE PIC X(01). DTSCS46 00338 10 WRK-SCR-HOLD-ADDR-ID-NO PIC S9(03) COMP-3. DTSCS46 00339 10 WRK-SCR-HOLD-RESP-OP-ID PIC X(08). DTSCS46 00340 10 WRK-SCR-HOLD-NOTE-LINES. DTSCS46 00341 15 WRK-SCR-HOLD-NOTE-LINE OCCURS 4 TIMES DTSCS46 00342 INDEXED BY WRK-SCR-HOLD-NOTE-IDX DTSCS46 00343 PIC X(72). DTSCS46 00344 DTSCS46 00345 DTSCS46 00346 DTSCS46 00347 05 WRK-APPEAL-TBL. DTSCS46 00348 10 WRK-APPEAL-IND OCCURS 400 TIMES DTSCS46 00349 PIC X(01). DTSCS46 00350 DTSCS46 00351 DTSCS46 00352 DTSCS46 00353 05 FREE-TEXT-CNT PIC S9(04) COMP. DTSCS46 00354 DTSCS46 00355 05 FREE-TEXT-LINES. DTSCS46 00356 10 FREE-TEXT-LINE OCCURS 13 TIMES DTSCS46 00357 INDEXED BY FREE-TEXT-IDX DTSCS46 00358 PIC X(72). DTSCS46 00359 DTSCS46 00360 DTSCS46 00361 DTSCS46 00362 05 INT-TEL. DTSCS46 00363 10 INT-TEL-AREA-CD PIC X(03). DTSCS46 00364 10 INT-TEL-PREFIX PIC X(03). DTSCS46 00365 10 INT-TEL-SUFFIX PIC X(04). DTSCS46 00366 10 INT-TEL-EXT PIC X(05). DTSCS46 00367 DTSCS46 00368 DTSCS46 00369 05 DISP-TEL. DTSCS46 00370 10 FILLER PIC X(01) VALUE '('. DTSCS46 00371 10 DISP-TEL-AREA-CD PIC X(03). DTSCS46 00372 10 FILLER PIC X(02) VALUE ') '. DTSCS46 00373 10 DISP-TEL-PREFIX PIC X(03). DTSCS46 00374 10 FILLER PIC X(01) VALUE '-'. DTSCS46 00375 10 DISP-TEL-SUFFIX PIC X(04). DTSCS46 00376 DTSCS46 00377 DTSCS46 00378 DTSCS46 00379 05 LINE-CNT PIC S9(04) COMP. DTSCS46 00380 DTSCS46 00381 05 PAGE-CNT PIC S9(04) COMP. DTSCS46 00382 DTSCS46 00383 05 PAGE-LAST PIC S9(04) COMP. DTSCS46 00384 DTSCS46 00385 05 WRITE-TS-IND PIC X(01). DTSCS46 00386 88 WRITE-TS-YES-88 VALUE 'Y'. DTSCS46 00387 88 WRITE-TS-NO-88 VALUE 'N'. DTSCS46 00388 DTSCS46 00389 05 AMT-DISPLAYED-IND PIC X(01). DTSCS46 00390 88 AMT-DISPLAYED-NO-88 VALUE 'N'. DTSCS46 00391 88 AMT-DISPLAYED-YES-88 VALUE 'Y'. DTSCS46 00392 DTSCS46 00393 05 APPEAL-ON-PAGE-IND PIC X(01). DTSCS46 00394 88 APPEAL-ON-PAGE-NO-88 VALUE 'N'. DTSCS46 00395 88 APPEAL-ON-PAGE-YES-88 VALUE 'Y'. DTSCS46 00396 DTSCS46 00397 05 QTR-ON-PAGE-IND PIC X(01). DTSCS46 00398 88 QTR-ON-PAGE-NO-88 VALUE 'N'. DTSCS46 00399 88 QTR-ON-PAGE-YES-88 VALUE 'Y'. DTSCS46 00400 DTSCS46 00401 05 LINES-REQUIRED-CNT PIC S9(04) COMP. DTSCS46 00402 DTSCS46 00403 05 PAGE-BREAK-IND PIC X(01). DTSCS46 00404 88 PAGE-BREAK-NO-88 VALUE 'N'. DTSCS46 00405 88 PAGE-BREAK-YES-88 VALUE 'Y'. DTSCS46 00406 DTSCS46 00407 05 APPEAL-MSG PIC X(44) DTSCS46 00408 VALUE '* INDICATES QUARTER IS COVERED BY AN APPEAL.'. DTSCS46 00409 DTSCS46 00410 DTSCS46 00411 DTSCS46 00412 05 HOLD-XPTS-DATA PIC X(132). DTSCS46 00413 DTSCS46 00414 DTSCS46 00415 DTSCS46 00416 05 QTR-ACCUMULATORS. DTSCS46 00417 10 QTR-TAX-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00418 10 QTR-TAX-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00419 10 QTR-PEN-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00420 10 QTR-PEN-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00421 10 QTR-INT-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00422 10 QTR-INT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00423 10 QTR-TOT-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00424 10 QTR-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00425 DTSCS46 00426 DTSCS46 00427 DTSCS46 00428 05 DB-QTR-MAX PIC S9(04) COMP VALUE +50. DTSCS46 00429 DTSCS46 00430 05 DB-QTR-CNT PIC S9(04) COMP. DTSCS46 00431 DTSCS46 00432 05 DB-QTR-AREA OCCURS 50 TIMES DTSCS46 00433 INDEXED BY DB-QTR-IDX. DTSCS46 00434 10 DB-QTR-YRQ PIC S9(05) COMP-3. DTSCS46 00435 10 DB-QTR-APPEAL-IND PIC X(01). DTSCS46 00436 88 DB-QTR-APPEAL-YES-88 VALUE 'Y'. DTSCS46 00437 88 DB-QTR-APPEAL-NO-88 VALUE 'N'. DTSCS46 00438 10 DB-QTR-EST-RPT-IND PIC X(01). DTSCS46 00439 88 DB-QTR-EST-RPT-YES-88 VALUE 'Y'. DTSCS46 00440 88 DB-QTR-EST-RPT-NO-88 VALUE 'N'. DTSCS46 00441 10 DB-QTR-STATUS PIC X(34). DTSCS46 00442 10 DB-QTR-PAID-AMT PIC S9(09)V9(02) COMP-3 VALUE 0.DTSCS46 00443 10 DB-QTR-BALANCE-AMT PIC S9(09)V9(02) COMP-3 VALUE 0.DTSCS46 00444 DTSCS46 00445 05 DB-TOT-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00446 DTSCS46 00447 05 DB-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS46 00448 DTSCS46 00449 05 DB-PURSUED-RPT-CNT PIC S9(03) COMP-3. DTSCS46 00450 EJECT DTSCS46 00451 01 MSG-LITERALS. DTSCS46 00452 05 MSG-E461-AREA. DTSCS46 00453 10 FILLER PIC X(04) VALUE 'E461'. DTSCS46 00454 10 FILLER PIC X(30) DTSCS46 00455 VALUE 'NO CREDITS; OR, NO BAL DUE OR '. DTSCS46 00456 10 FILLER PIC X(30) DTSCS46 00457 VALUE 'PURSUED RPTS IN YR/Q RANGE '. DTSCS46 00458 DTSCS46 00459 05 MSG-E462-AREA. DTSCS46 00460 10 FILLER PIC X(04) VALUE 'E462'. DTSCS46 00461 10 FILLER PIC X(30) DTSCS46 00462 VALUE 'MOVE THAN 50 QUARTERS IN COLLE'. DTSCS46 00463 10 FILLER PIC X(30) DTSCS46 00464 VALUE 'CTIONS VISIT PROGRAMMERS '. DTSCS46 00465 EJECT DTSCS46 00466 01 EVL-TEXT-AREA. DTSCS46 00467 05 EVL-CREDIT-TEXT. DTSCS46 00468 10 FILLER PIC X(21) DTSCS46 00469 VALUE 'CREDIT STMT TO ADDR: '. DTSCS46 00470 10 EVL-CREDIT-ADDR-TYPE PIC X(01). DTSCS46 00471 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00472 10 EVL-CREDIT-ADDR-ID-NO PIC 9(03). DTSCS46 00473 10 EVL-CREDIT-ADDR-ID-NO-X DTSCS46 00474 REDEFINES EVL-CREDIT-ADDR-ID-NO DTSCS46 00475 PIC X(03). DTSCS46 00476 10 FILLER PIC X(12) DTSCS46 00477 VALUE ' AMT:'. DTSCS46 00478 10 EVL-CREDIT-AMT PIC ZZZZZ,ZZ9.99. DTSCS46 00479 DTSCS46 00480 05 EVL-DEBIT-TEXT. DTSCS46 00481 10 FILLER PIC X(21) DTSCS46 00482 VALUE 'DEBIT STMT TO ADDR: '. DTSCS46 00483 10 EVL-DEBIT-ADDR-TYPE PIC X(01). DTSCS46 00484 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00485 10 EVL-DEBIT-ADDR-ID-NO PIC 9(03). DTSCS46 00486 10 EVL-DEBIT-ADDR-ID-NO-X DTSCS46 00487 REDEFINES EVL-DEBIT-ADDR-ID-NO DTSCS46 00488 PIC X(03). DTSCS46 00489 10 FILLER PIC X(12) DTSCS46 00490 VALUE ' AMT:'. DTSCS46 00491 10 EVL-DEBIT-AMT PIC ZZZZZ,ZZ9.99. DTSCS46 00492 EJECT DTSCS46 00493 01 REPORT-LINE-AREA. DTSCS46 00494 05 HEAD01. DTSCS46 00495 10 HEAD01-SCREEN-ID PIC X(02). DTSCS46 00496 10 FILLER PIC X(23) VALUE SPACES. DTSCS46 00497 10 HEAD01-STROKE-WEIGHT-BOLD DTSCS46 00498 PIC X(01). DTSCS46 00499 10 HEAD01-AGY-NAMEB1 PIC X(40). DTSCS46 00500 10 HEAD01-STROKE-WEIGHT-REGULAR DTSCS46 00501 PIC X(01). DTSCS46 00502 10 FILLER PIC X(08). DTSCS46 00503 10 HEAD01-OUTPUT-ID PIC X(06). DTSCS46 00504 DTSCS46 00505 05 HEAD02. DTSCS46 00506 10 FILLER PIC X(18) VALUE SPACES. DTSCS46 00507 10 HEAD02-STROKE-WEIGHT-BOLD DTSCS46 00508 PIC X(01). DTSCS46 00509 10 HEAD02-AGY-NAMEB2 PIC X(61). DTSCS46 00510 DTSCS46 00511 05 HEAD03. DTSCS46 00512 10 FILLER PIC X(29) VALUE SPACES. DTSCS46 00513 10 HEAD03-TAX-DIV-NAME PIC X(50). DTSCS46 00514 DTSCS46 00515 05 HEAD04. DTSCS46 00516 10 FILLER PIC X(23) VALUE SPACES. DTSCS46 00517 10 HEAD04-AGY-MAIL1 PIC X(56). DTSCS46 00518 DTSCS46 00519 05 HEAD05. DTSCS46 00520 10 FILLER PIC X(25) VALUE SPACES. DTSCS46 00521 10 HEAD05-AGY-MAIL2 PIC X(54). DTSCS46 00522 DTSCS46 00523 05 HEAD06. DTSCS46 00524 10 FILLER PIC X(12) VALUE SPACES. DTSCS46 00525 10 FILLER PIC X(11) DTSCS46 00526 VALUE 'TELEPHONE: '. DTSCS46 00527 10 HEAD06-AR-UNIT-VOICE PIC X(14). DTSCS46 00528 10 FILLER PIC X(08) VALUE ' FAX: '.DTSCS46 00529 10 HEAD06-AR-UNIT-FAX PIC X(14). DTSCS46 00530 10 FILLER PIC X(20) VALUE SPACES. DTSCS46 00531 DTSCS46 00532 05 HEAD09. DTSCS46 00533 10 FILLER PIC X(29) VALUE SPACES. DTSCS46 00534 10 FILLER PIC X(20) DTSCS46 00535 VALUE 'STATEMENT OF ACCOUNT'. DTSCS46 00536 10 HEAD09-STROKE-WEIGHT-REGULAR DTSCS46 00537 PIC X(01). DTSCS46 00538 10 FILLER PIC X(30) VALUE SPACES. DTSCS46 00539 DTSCS46 00540 05 FREENN. DTSCS46 00541 10 FILLER PIC X(04) VALUE SPACES. DTSCS46 00542 10 FREENN-TEXT-AREA PIC X(72). DTSCS46 00543 10 FILLER PIC X(03) VALUE SPACES. DTSCS46 00544 DTSCS46 00545 DTSCS46 00546 DTSCS46 00547 05 CRADDR01. DTSCS46 00548 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00549 10 CRADDR01-MAILING-LINE-1 PIC X(40). DTSCS46 00550 10 FILLER PIC X(21) DTSCS46 00551 VALUE ' ACCOUNT NO: '. DTSCS46 00552 10 CRADDR01-EMP-NO PIC 999B999. DTSCS46 00553 10 FILLER PIC X(04) VALUE SPACES. DTSCS46 00554 DTSCS46 00555 05 CRADDR02. DTSCS46 00556 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00557 10 CRADDR02-MAILING-LINE-2 PIC X(40). DTSCS46 00558 10 FILLER PIC X(32) VALUE SPACES. DTSCS46 00559 DTSCS46 00560 05 CRADDR03. DTSCS46 00561 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00562 10 CRADDR03-MAILING-LINE-3 PIC X(40). DTSCS46 00563 10 FILLER PIC X(21) DTSCS46 00564 VALUE ' STATEMENT DATE: '. DTSCS46 00565 10 CRADDR03-CURR-RUN-DATE PIC X(10). DTSCS46 00566 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00567 DTSCS46 00568 05 CRADDR04. DTSCS46 00569 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00570 10 CRADDR04-MAILING-LINE-4 PIC X(40). DTSCS46 00571 10 FILLER PIC X(32) VALUE SPACES. DTSCS46 00572 DTSCS46 00573 05 CRADDR05. DTSCS46 00574 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00575 10 CRADDR05-MAILING-LINE-5 PIC X(40). DTSCS46 00576 10 FILLER PIC X(32) VALUE SPACES. DTSCS46 00577 DTSCS46 00578 05 CRVARNN. DTSCS46 00579 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00580 10 CRVARNN-TEXT-AREA PIC X(78). DTSCS46 00581 DTSCS46 00582 05 CRFIX01. DTSCS46 00583 10 FILLER PIC X(39) DTSCS46 00584 VALUE ' TO REQUEST A REFUND, SIGN BELOW AND RE'. DTSCS46 00585 10 FILLER PIC X(40) DTSCS46 00586 VALUE 'TURN THIS FORM TO THE DISTRICT''S '. DTSCS46 00587 DTSCS46 00588 05 CRFIX02. DTSCS46 00589 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00590 10 FILLER PIC X(39) DTSCS46 00591 VALUE 'UNEMPLOYMENT INSURANCE TAX DIVISION. '. DTSCS46 00592 10 FILLER PIC X(40) DTSCS46 00593 VALUE ' '. DTSCS46 00594 DTSCS46 00595 05 CRFIX04. DTSCS46 00596 10 FILLER PIC X(39) DTSCS46 00597 VALUE ' NOTE: ALL CREDITS ARE SUBJECT TO REVI'. DTSCS46 00598 10 FILLER PIC X(40) DTSCS46 00599 VALUE 'EW. IF OTHER LIABILITIES ACCRUE TO '. DTSCS46 00600 DTSCS46 00601 05 CRFIX05. DTSCS46 00602 10 FILLER PIC X(39) DTSCS46 00603 VALUE ' YOUR UNEMPLOYMENT INSURANCE ACCOUNT, T'. DTSCS46 00604 10 FILLER PIC X(40) DTSCS46 00605 VALUE 'HIS CREDIT WILL BE APPLIED TOWARD '. DTSCS46 00606 DTSCS46 00607 05 CRFIX06. DTSCS46 00608 10 FILLER PIC X(39) DTSCS46 00609 VALUE ' AMOUNTS DUE. IF THERE ARE CONTRIBUTIO'. DTSCS46 00610 10 FILLER PIC X(40) DTSCS46 00611 VALUE 'N REPORTS THAT HAVE NOT BEEN FILED, '. DTSCS46 00612 DTSCS46 00613 05 CRFIX07. DTSCS46 00614 10 FILLER PIC X(39) DTSCS46 00615 VALUE ' YOUR REFUND WILL BE DENIED. '. DTSCS46 00616 10 FILLER PIC X(40) DTSCS46 00617 VALUE ' '. DTSCS46 00618 DTSCS46 00619 05 CRFIX09. DTSCS46 00620 10 FILLER PIC X(39) DTSCS46 00621 VALUE ' THE INFORMATION SHOWN ABOVE REFLECTS T'. DTSCS46 00622 10 FILLER PIC X(27) DTSCS46 00623 VALUE 'RANSACTIONS PROCESSED THRU '. DTSCS46 00624 10 CRFIX09-PRIOR-RUN-DATE PIC X(10). DTSCS46 00625 10 FILLER PIC X(03) VALUE '. '. DTSCS46 00626 DTSCS46 00627 05 CRFIX10. DTSCS46 00628 10 FILLER PIC X(39) DTSCS46 00629 VALUE ' (*) INDICATES ANNUAL FILER. '. DTSCS46 00630 DTSCS46 00631 05 CRFIX11. DTSCS46 00632 10 FILLER PIC X(39) DTSCS46 00633 VALUE ' REFUND AUTHORIZATION: (COMPLETE ONLY '. DTSCS46 00634 10 FILLER PIC X(40) DTSCS46 00635 VALUE 'IF YOU ARE REQUESTING A REFUND) '. DTSCS46 00636 DTSCS46 00637 05 CRFIX13. DTSCS46 00638 10 FILLER PIC X(39) DTSCS46 00639 VALUE ' I REQUEST A REFUND OF MY CREDIT. I UN'. DTSCS46 00640 10 FILLER PIC X(40) DTSCS46 00641 VALUE 'DERSTAND THE CREDIT IS SUBJECT TO '. DTSCS46 00642 DTSCS46 00643 05 CRFIX14. DTSCS46 00644 10 FILLER PIC X(39) DTSCS46 00645 VALUE ' REVIEW PRIOR TO REFUNDING. ANY ADDRES'. DTSCS46 00646 10 FILLER PIC X(40) DTSCS46 00647 VALUE 'S CHANGE IS INDICATED BELOW. '. DTSCS46 00648 DTSCS46 00649 05 CRFIX17. DTSCS46 00650 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00651 10 FILLER PIC X(37) VALUE ALL '_'. DTSCS46 00652 10 FILLER PIC X(12) VALUE SPACES. DTSCS46 00653 10 FILLER PIC X(16) VALUE ALL '_'. DTSCS46 00654 10 FILLER PIC X(13) VALUE SPACES. DTSCS46 00655 DTSCS46 00656 05 CRFIX18. DTSCS46 00657 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00658 10 FILLER PIC X(20) DTSCS46 00659 VALUE 'AUTHORIZED SIGNATURE'. DTSCS46 00660 10 FILLER PIC X(29) VALUE SPACES. DTSCS46 00661 10 FILLER PIC X(04) VALUE 'DATE'. DTSCS46 00662 10 FILLER PIC X(25) VALUE SPACES. DTSCS46 00663 DTSCS46 00664 05 CRFIX20. DTSCS46 00665 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00666 10 FILLER PIC X(15) DTSCS46 00667 VALUE 'ADDRESS CHANGE:'. DTSCS46 00668 10 FILLER PIC X(63) VALUE SPACES. DTSCS46 00669 DTSCS46 00670 05 CRFIX22. DTSCS46 00671 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00672 10 FILLER PIC X(45) VALUE ALL '_'. DTSCS46 00673 10 FILLER PIC X(33) VALUE SPACES. DTSCS46 00674 DTSCS46 00675 05 CRFIX24. DTSCS46 00676 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00677 10 FILLER PIC X(45) VALUE ALL '_'. DTSCS46 00678 10 FILLER PIC X(33) VALUE SPACES. DTSCS46 00679 DTSCS46 00680 DTSCS46 00681 DTSCS46 00682 05 DBADDR01. DTSCS46 00683 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00684 10 DBADDR01-MAILING-LINE-1 PIC X(40). DTSCS46 00685 10 FILLER PIC X(21) DTSCS46 00686 VALUE ' PAGE: '. DTSCS46 00687 10 DBADDR01-PAGE-CURR PIC 9. DTSCS46 00688 10 FILLER PIC X(04) VALUE ' OF '. DTSCS46 00689 10 DBADDR01-PAGE-LAST PIC 9. DTSCS46 00690 10 FILLER PIC X(05) VALUE SPACES. DTSCS46 00691 DTSCS46 00692 05 DBADDR02. DTSCS46 00693 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00694 10 DBADDR02-MAILING-LINE-2 PIC X(40). DTSCS46 00695 10 FILLER PIC X(21) DTSCS46 00696 VALUE ' ACCOUNT NO: '. DTSCS46 00697 10 DBADDR02-EMP-NO PIC 999B999. DTSCS46 00698 10 FILLER PIC X(04) VALUE SPACES. DTSCS46 00699 DTSCS46 00700 05 DBADDR03. DTSCS46 00701 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00702 10 DBADDR03-MAILING-LINE-3 PIC X(40). DTSCS46 00703 10 FILLER PIC X(21) DTSCS46 00704 VALUE ' STATEMENT DATE: '. DTSCS46 00705 10 DBADDR03-CURR-RUN-DATE PIC X(10). DTSCS46 00706 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00707 DTSCS46 00708 05 DBADDR04. DTSCS46 00709 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00710 10 DBADDR04-MAILING-LINE-4 PIC X(40). DTSCS46 00711 10 FILLER PIC X(21) DTSCS46 00712 VALUE ' INT COMPUTED THRU: '. DTSCS46 00713 10 DBADDR04-COMP-DATE PIC X(10). DTSCS46 00714 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00715 DTSCS46 00716 05 DBADDR05. DTSCS46 00717 10 FILLER PIC X(07) VALUE SPACES. DTSCS46 00718 10 DBADDR05-MAILING-LINE-5 PIC X(40). DTSCS46 00719 10 FILLER PIC X(32) VALUE SPACES. DTSCS46 00720 DTSCS46 00721 05 DBPAYENC. DTSCS46 00722 10 FILLER PIC X(49) VALUE SPACES. DTSCS46 00723 10 FILLER PIC X(19) DTSCS46 00724 VALUE 'PAYMENT ENCLOSED $ '. DTSCS46 00725 10 FILLER PIC X(10) VALUE ALL '_'. DTSCS46 00726 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00727 DTSCS46 00728 05 DBQTRHEAD01. DTSCS46 00729 10 FILLER PIC X(02) VALUE SPACES. DTSCS46 00730 10 FILLER PIC X(04) VALUE 'YEAR'. DTSCS46 00731 10 FILLER PIC X(49) VALUE SPACES. DTSCS46 00732 10 FILLER PIC X(06) VALUE 'AMOUNT'. DTSCS46 00733 10 FILLER PIC X(18) VALUE SPACES. DTSCS46 00734 DTSCS46 00735 05 DBQTRHEAD02. DTSCS46 00736 10 FILLER PIC X(01) VALUE SPACES. DTSCS46 00737 10 FILLER PIC X(07) VALUE 'QUARTER'. DTSCS46 00738 10 FILLER PIC X(15) VALUE SPACES. DTSCS46 00739 10 FILLER PIC X(06) VALUE 'STATUS'. DTSCS46 00740 10 FILLER PIC X(27) VALUE SPACES. DTSCS46 00741 10 FILLER PIC X(04) VALUE 'PAID'. DTSCS46 00742 10 FILLER PIC X(10) VALUE SPACES. DTSCS46 00743 10 FILLER PIC X(07) VALUE 'BALANCE'. DTSCS46 00744 10 FILLER PIC X(02) VALUE SPACES. DTSCS46 00745 DTSCS46 00746 05 DBQTRDET. DTSCS46 00747 10 FILLER PIC X(01). DTSCS46 00748 10 DBQTRDET-YEAR-QTR. DTSCS46 00749 15 DBQTRDET-QTR-YR PIC X(04). DTSCS46 00750 15 FILLER PIC X(01). DTSCS46 00751 15 DBQTRDET-QTR-Q PIC X(01). DTSCS46 00752 10 DBQTRDET-APPEAL-IND PIC X(01). DTSCS46 00753 10 FILLER PIC X(03). DTSCS46 00754 10 DBQTRDET-STATUS PIC X(34). DTSCS46 00755 10 FILLER PIC X(02). DTSCS46 00756 10 DBQTRDET-PAID-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSCS46 00757 10 FILLER PIC X(02). DTSCS46 00758 10 DBQTRDET-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSCS46 00759 10 FILLER PIC X(02). DTSCS46 00760 DTSCS46 00761 05 DBQTRTOT. DTSCS46 00762 10 FILLER PIC X(38) VALUE SPACES. DTSCS46 00763 10 FILLER PIC X(09) DTSCS46 00764 VALUE 'TOTALS: '. DTSCS46 00765 10 DBQTRTOT-PAID-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSCS46 00766 10 FILLER PIC X(02) VALUE SPACES. DTSCS46 00767 10 DBQTRTOT-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSCS46 00768 10 FILLER PIC X(02) VALUE SPACES. DTSCS46 00769 DTSCS46 00770 05 DBQTRTRAIL. DTSCS46 00771 10 FILLER PIC X(06) VALUE SPACES. DTSCS46 00772 10 DBQTRTRAIL-APPEAL-MSG PIC X(44). DTSCS46 00773 10 FILLER PIC X(18) VALUE SPACES. DTSCS46 00774 10 DBQTRTRAIL-CONTINUED-MSG DTSCS46 00775 PIC X(09). DTSCS46 00776 10 FILLER PIC X(02) VALUE SPACES. DTSCS46 00777 DTSCS46 00778 05 DBOPID01. DTSCS46 00779 10 FILLER PIC X(03) VALUE SPACES. DTSCS46 00780 10 DBOPID01-AR-UNIT-NAME PIC X(40). DTSCS46 00781 10 FILLER PIC X(36) VALUE SPACES. DTSCS46 00782 DTSCS46 00783 05 DBOPID02. DTSCS46 00784 10 FILLER PIC X(03) VALUE SPACES. DTSCS46 00785 10 DBOPID02-FIELD-REP-NAME PIC X(40). DTSCS46 00786 10 FILLER PIC X(36) VALUE SPACES. DTSCS46 00787 DTSCS46 00788 05 DBOPID03. DTSCS46 00789 10 FILLER PIC X(03) VALUE SPACES. DTSCS46 00790 10 DBOPID03-AR-UNIT-VOICE PIC X(14). DTSCS46 00791 10 FILLER PIC X(62) VALUE SPACES. DTSCS46 00792 DTSCS46 00793 05 DBOPID06. DTSCS46 00794 10 FILLER PIC X(39) DTSCS46 00795 VALUE ' THE INFORMATION SHOWN ABOVE REFLECTS T'. DTSCS46 00796 10 FILLER PIC X(27) DTSCS46 00797 VALUE 'RANSACTIONS PROCESSED THRU '. DTSCS46 00798 10 DBOPID06-PRIOR-RUN-DATE PIC X(10). DTSCS46 00799 10 FILLER PIC X(03) VALUE '. '. DTSCS46 00800 05 DBOPID07. DTSCS46 00801 10 FILLER PIC X(39) DTSCS46 00802 VALUE ' (*) INDICATES ANNUAL FILER. '. DTSCS46 00803 DTSCS46 00804 EJECT DTSCS46 00805 01 L001-COMM-AREA. DTSCS46 00806 ++INCLUDE DTSIL001 DTSCS46 00807 EJECT DTSCS46 00808 01 L004-COMM-AREA. DTSCS46 00809 ++INCLUDE DTSIL004 DTSCS46 00810 EJECT DTSCS46 00811 01 L009-COMM-AREA. DTSCS46 00812 ++INCLUDE DTSIL009 DTSCS46 00813 EJECT DTSCS46 00814 01 L013-COMM-AREA. DTSCS46 00815 ++INCLUDE DTSIL013 DTSCS46 00816 EJECT DTSCS46 00817 01 L015-COMM-AREA. DTSCS46 00818 ++INCLUDE DTSIL015 DTSCS46 00819 EJECT DTSCS46 00820 01 L029-COMM-AREA. DTSCS46 00821 ++INCLUDE DTSIL029 DTSCS46 00822 EJECT DTSCS46 00823 01 L018-COMM-AREA. DTSCS46 00824 ++INCLUDE DTSIL018 DTSCS46 00825 EJECT DTSCS46 00826 01 L061-COMM-AREA. DTSCS46 00827 ++INCLUDE DTSIL061 DTSCS46 00828 EJECT DTSCS46 00829 01 L062-COMM-AREA. DTSCS46 00830 ++INCLUDE DTSIL062 DTSCS46 00831 EJECT DTSCS46 00832 01 L071-COMM-AREA. DTSCS46 00833 ++INCLUDE DTSIL071 DTSCS46 00834 EJECT DTSCS46 00835 01 L082-COMM-AREA. DTSCS46 00836 ++INCLUDE DTSIL082 DTSCS46 00837 EJECT DTSCS46 00838 01 L090-COMM-AREA. DTSCS46 00839 ++INCLUDE DTSIL090 DTSCS46 00840 EJECT DTSCS46 00841 01 L101-COMM-AREA. DTSCS46 00842 ++INCLUDE DTSIL101 DTSCS46 00843 EJECT DTSCS46 00844 01 L109-COMM-AREA. DTSCS46 00845 ++INCLUDE DTSIL109 DTSCS46 00846 EJECT DTSCS46 00847 01 L111-COMM-AREA. DTSCS46 00848 ++INCLUDE DTSIL111 DTSCS46 00849 EJECT DTSCS46 00850 01 L112-COMM-AREA. DTSCS46 00851 ++INCLUDE DTSIL112 DTSCS46 00852 EJECT DTSCS46 00853 01 L119-COMM-AREA. DTSCS46 00854 ++INCLUDE DTSIL119 DTSCS46 00855 EJECT DTSCS46 00856 01 L221-COMM-AREA. DTSCS46 00857 ++INCLUDE DTSIL221 DTSCS46 00858 EJECT DTSCS46 00859 01 L356-COMM-AREA. DTSCS46 00860 ++INCLUDE DTSIL356 DTSCS46 00861 EJECT DTSCS46 00862 01 L357-COMM-AREA. DTSCS46 00863 ++INCLUDE DTSIL357 DTSCS46 00864 EJECT DTSCS46 00865 01 L805-COMM-AREA. DTSCS46 00866 ++INCLUDE DTSIL805 DTSCS46 00867 EJECT DTSCS46 00868 01 L810-COMM-AREA. DTSCS46 00869 05 L810-CONTROL-BLOCK. DTSCS46 00870 ++INCLUDE DTSIL810 DTSCS46 00871 EJECT DTSCS46 00872 05 MSKL-REC. DTSCS46 00873 ++INCLUDE DTSIMSKL DTSCS46 00874 EJECT DTSCS46 00875 01 MPRF-REC. DTSCS46 00876 ++INCLUDE DTSIMPRF DTSCS46 00877 EJECT DTSCS46 00878 01 MCOL-REC. DTSCS46 00879 ++INCLUDE DTSIMCOL DTSCS46 00880 EJECT DTSCS46 00881 01 MEVL-REC. DTSCS46 00882 ++INCLUDE DTSIMEVL DTSCS46 00883 EJECT DTSCS46 00884 01 MQTR-REC. DTSCS46 00885 ++INCLUDE DTSIMQTR DTSCS46 00886 EJECT DTSCS46 00887 01 MAPL-REC. DTSCS46 00888 ++INCLUDE DTSIMAPL DTSCS46 00889 EJECT DTSCS46 00890 01 L829-COMM-AREA. DTSCS46 00891 05 L829-CONTROL-BLOCK. DTSCS46 00892 ++INCLUDE DTSIL829 DTSCS46 00893 DTSCS46 00894 05 L829-REC. DTSCS46 00895 ++INCLUDE DTSIXPTS DTSCS46 00896 EJECT DTSCS46 00897 01 L851-COMM-AREA. DTSCS46 00898 ++INCLUDE DTSIL851 DTSCS46 00899 DTSCS46 00900 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS46 00901 ++INCLUDE DTSIS46 DTSCS46 00902 EJECT DTSCS46 00903 01 CATB-LITERALS. DTSCS46 00904 ++INCLUDE DTSICATB DTSCS46 00905 DTSCS46 00906 01 CPRT-LITERALS. DTSCS46 00907 ++INCLUDE DTSICPRT DTSCS46 00908 DTSCS46 00909 01 CFKD-LITERALS. DTSCS46 00910 ++INCLUDE DTSICFKD DTSCS46 00911 DTSCS46 00912 01 CECD-LITERALS. DTSCS46 00913 ++INCLUDE DTSICECD DTSCS46 00914 DTSCS46 00915 01 CPCD-LITERALS. DTSCS46 00916 ++INCLUDE DTSICPCD DTSCS46 00917 EJECT DTSCS46 00918 LINKAGE SECTION. DTSCS46 00919 DTSCS46 00920 01 DFHCOMMAREA. DTSCS46 00921 ++INCLUDE DTSILCCM DTSCS46 00922 DTSCS46 00923 DTSCS46 00924 DTSCS46 00925 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS46 00926 20 LCCM-SCR-HOLD-CONTROL-AREA. DTSCS46 00927 25 LCCM-SCR-HOLD-EMP-NO DTSCS46 00928 PIC S9(07) COMP-3. DTSCS46 00929 25 LCCM-SCR-HOLD-FROM-YRQ DTSCS46 00930 PIC S9(05) COMP-3. DTSCS46 00931 25 LCCM-SCR-HOLD-TO-YRQ DTSCS46 00932 PIC S9(05) COMP-3. DTSCS46 00933 25 LCCM-SCR-HOLD-COMP-DATE DTSCS46 00934 PIC S9(09) COMP-3. DTSCS46 00935 25 LCCM-SCR-HOLD-ADDR-TYPE DTSCS46 00936 PIC X(01). DTSCS46 00937 88 LCCM-SCR-HOLD-ADDR-TAD-88 DTSCS46 00938 VALUE 'T' 'P'. DTSCS46 00939 25 LCCM-SCR-HOLD-ADDR-ID-NO DTSCS46 00940 PIC S9(03) COMP-3. DTSCS46 00941 25 LCCM-SCR-HOLD-RESP-OP-ID DTSCS46 00942 PIC X(08). DTSCS46 00943 25 LCCM-SCR-HOLD-NOTE-LINES. DTSCS46 00944 30 LCCM-SCR-HOLD-NOTE-LINE DTSCS46 00945 OCCURS 4 TIMES DTSCS46 00946 PIC X(72). DTSCS46 00947 DTSCS46 00948 20 LCCM-SCR-HOLD-ABSTIME DTSCS46 00949 PIC S9(15) COMP-3. DTSCS46 00950 20 LCCM-SCR-HOLD-PAGING-AREA. DTSCS46 00951 25 LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 00952 PIC S9(04) COMP. DTSCS46 00953 25 LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS46 00954 PIC S9(04) COMP. DTSCS46 00955 25 LCCM-SCR-HOLD-TS-ITEM-CNT DTSCS46 00956 PIC S9(04) COMP. DTSCS46 00957 DTSCS46 00958 20 LCCM-SCR-HOLD-DISPLAY-AREA. DTSCS46 00959 25 LCCM-SCR-HOLD-TOT-AMT DTSCS46 00960 PIC S9(09)V9(02) COMP-3.DTSCS46 00961 25 LCCM-SCR-HOLD-RPTS-PUR-CNT DTSCS46 00962 PIC S9(03) COMP-3.DTSCS46 00963 25 LCCM-SCR-HOLD-DOC-IND DTSCS46 00964 PIC X(01). DTSCS46 00965 88 LCCM-SCR-HOLD-CREDIT-88 VALUE 'C'. DTSCS46 00966 88 LCCM-SCR-HOLD-DEBIT-88 VALUE 'D'. DTSCS46 00967 88 LCCM-SCR-HOLD-NO-DOC-88 DTSCS46 00968 VALUE LOW-VALUES. DTSCS46 00969 25 LCCM-SCR-HOLD-MCOL-TEMP-IND DTSCS46 00970 PIC X(01). DTSCS46 00971 88 LCCM-SCR-HOLD-MCOL-TEMP-YES-88 DTSCS46 00972 VALUE 'Y'. DTSCS46 00973 88 LCCM-SCR-HOLD-MCOL-TEMP-NO-88 DTSCS46 00974 VALUE 'N'. DTSCS46 00975 EJECT DTSCS46 00976 PROCEDURE DIVISION. DTSCS46 00977 DTSCS46 00978 MOVE +0 TO WRK-EMP-NO. DTSCS46 00979 DTSCS46 00980 SET WRK-MPRF-NO-88 TO TRUE. DTSCS46 00981 DTSCS46 00982 MOVE LENGTH OF L829-REC TO TS-ITEM-LENGTH. DTSCS46 00983 DTSCS46 00984 MOVE LOW-VALUES TO MAP-AREA. DTSCS46 00985 DTSCS46 00986 SET CURSOR-SET-NO TO TRUE. DTSCS46 00987 DTSCS46 00988 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS46 00989 TO SCR-ACCESS-IND. DTSCS46 00990 DTSCS46 00991 MOVE +0 TO QTR-TAX-PAID-AMT DTSCS46 00992 QTR-TAX-BALANCE-AMT DTSCS46 00993 QTR-PEN-PAID-AMT DTSCS46 00994 QTR-PEN-BALANCE-AMT DTSCS46 00995 QTR-INT-PAID-AMT DTSCS46 00996 QTR-INT-BALANCE-AMT DTSCS46 00997 QTR-TOT-PAID-AMT DTSCS46 00998 QTR-TOT-BALANCE-AMT. DTSCS46 00999 DTSCS46 01000 MOVE 9999 TO WRK-CURR-ANN-YR. DTSCS46 01001 MOVE SPACE TO REQ-IND. DTSCS46 01002 DTSCS46 01003 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS46 01004 DTSCS46 01005 DTSCS46 01006 *----------------------------------------------------- DTSCS46 01007 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS46 01008 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS46 01009 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS46 01010 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS46 01011 * DTSCS46 01012 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS46 01013 * PROCESSED. DTSCS46 01014 * DTSCS46 01015 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS46 01016 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS46 01017 * WORK STATION OPERATOR. DTSCS46 01018 *----------------------------------------------------- DTSCS46 01019 DTSCS46 01020 MOVE SPACE TO RESP-IND. DTSCS46 01021 DTSCS46 01022 IF REQ-ERROR DTSCS46 01023 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS46 01024 ELSE DTSCS46 01025 IF REQ-JUMP DTSCS46 01026 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS46 01027 ELSE DTSCS46 01028 IF REQ-CLEAR DTSCS46 01029 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS46 01030 ELSE DTSCS46 01031 IF REQ-CURSOR-TO-GOTO DTSCS46 01032 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS46 01033 ELSE DTSCS46 01034 IF REQ-INQUIRE DTSCS46 01035 PERFORM P6000-REQUEST-INQUIRY THRU P6000-EXIT DTSCS46 01036 ELSE DTSCS46 01037 IF REQ-UPDATE DTSCS46 01038 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS46 01039 ELSE DTSCS46 01040 GO TO S899-ABEND. DTSCS46 01041 DTSCS46 01042 DTSCS46 01043 *----------------------------------------------------- DTSCS46 01044 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS46 01045 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS46 01046 *----------------------------------------------------- DTSCS46 01047 DTSCS46 01048 IF RESP-SEND-MAP DTSCS46 01049 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS46 01050 SET LCCM-END-TASK-88 TO TRUE DTSCS46 01051 ELSE DTSCS46 01052 IF RESP-SEND-MSGONLY DTSCS46 01053 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS46 01054 SET LCCM-END-TASK-88 TO TRUE DTSCS46 01055 ELSE DTSCS46 01056 IF RESP-JUMP DTSCS46 01057 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS46 01058 ELSE DTSCS46 01059 IF RESP-CURSOR-TO-GOTO DTSCS46 01060 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS46 01061 SET LCCM-END-TASK-88 TO TRUE DTSCS46 01062 ELSE DTSCS46 01063 GO TO S899-ABEND. DTSCS46 01064 DTSCS46 01065 DTSCS46 01066 MAINLINE-EXIT. DTSCS46 01067 DTSCS46 01068 EXEC CICS DTSCS46 01069 RETURN DTSCS46 01070 END-EXEC. DTSCS46 01071 DTSCS46 01072 GOBACK. DTSCS46 01073 /*****************************************************************DTSCS46 01074 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS46 01075 ******************************************************************DTSCS46 01076 P1000-ANALYZE-REQUEST. DTSCS46 01077 DTSCS46 01078 *----------------------------------------------------- DTSCS46 01079 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS46 01080 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS46 01081 * REPLACED WITH ENTER) DTSCS46 01082 *----------------------------------------------------- DTSCS46 01083 DTSCS46 01084 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS46 01085 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS46 01086 SET LCCM-ENTER-88 TO TRUE DTSCS46 01087 SET REQ-INQUIRE TO TRUE DTSCS46 01088 IF LCCM-EMP-NO > ZERO DTSCS46 01089 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS46 01090 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS46 01091 END-IF DTSCS46 01092 GO TO P1000-EXIT. DTSCS46 01093 DTSCS46 01094 DTSCS46 01095 *----------------------------------------------------- DTSCS46 01096 * RECEIVE THE MAP DTSCS46 01097 *----------------------------------------------------- DTSCS46 01098 DTSCS46 01099 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS46 01100 DTSCS46 01101 DTSCS46 01102 *----------------------------------------------------- DTSCS46 01103 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS46 01104 * WORK STATION DTSCS46 01105 *----------------------------------------------------- DTSCS46 01106 DTSCS46 01107 IF LCCM-CLEAR-88 DTSCS46 01108 SET REQ-CLEAR TO TRUE DTSCS46 01109 GO TO P1000-EXIT. DTSCS46 01110 DTSCS46 01111 DTSCS46 01112 *----------------------------------------------------- DTSCS46 01113 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS46 01114 *----------------------------------------------------- DTSCS46 01115 DTSCS46 01116 IF LCCM-SCR-PRT-LOCKED DTSCS46 01117 PERFORM P1100-PRT-LOCKED THRU P1100-EXIT DTSCS46 01118 GO TO P1000-EXIT. DTSCS46 01119 DTSCS46 01120 DTSCS46 01121 *----------------------------------------------------- DTSCS46 01122 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS46 01123 *----------------------------------------------------- DTSCS46 01124 DTSCS46 01125 IF LCCM-PA2-88 DTSCS46 01126 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS46 01127 GO TO P1000-EXIT. DTSCS46 01128 DTSCS46 01129 DTSCS46 01130 *----------------------------------------------------- DTSCS46 01131 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS46 01132 *----------------------------------------------------- DTSCS46 01133 DTSCS46 01134 IF LCCM-PA-88 DTSCS46 01135 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS46 01136 SET REQ-ERROR TO TRUE DTSCS46 01137 GO TO P1000-EXIT. DTSCS46 01138 DTSCS46 01139 DTSCS46 01140 *------------------------------------------------------- DTSCS46 01141 * F12 PRESSED WHEN PRINT NOT IN PROGRESS IS A REQUEST DTSCS46 01142 * TO CLEAR THE SCREEN. DTSCS46 01143 *------------------------------------------------------- DTSCS46 01144 DTSCS46 01145 IF LCCM-F12-88 DTSCS46 01146 MOVE LOW-VALUES TO MAP-AREA DTSCS46 01147 SET REQ-CLEAR TO TRUE DTSCS46 01148 GO TO P1000-EXIT. DTSCS46 01149 DTSCS46 01150 DTSCS46 01151 *----------------------------------------------------- DTSCS46 01152 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS46 01153 *----------------------------------------------------- DTSCS46 01154 DTSCS46 01155 IF LCCM-F03-88 DTSCS46 01156 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS46 01157 SET REQ-JUMP TO TRUE DTSCS46 01158 GO TO P1000-EXIT. DTSCS46 01159 DTSCS46 01160 DTSCS46 01161 *----------------------------------------------------- DTSCS46 01162 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS46 01163 *----------------------------------------------------- DTSCS46 01164 DTSCS46 01165 IF LCCM-F04-88 DTSCS46 01166 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS46 01167 SET REQ-JUMP TO TRUE DTSCS46 01168 GO TO P1000-EXIT. DTSCS46 01169 DTSCS46 01170 DTSCS46 01171 *--------------------------------------------------------- DTSCS46 01172 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS46 01173 * CORRESPONDENCE SCREEN. DTSCS46 01174 *--------------------------------------------------------- DTSCS46 01175 DTSCS46 01176 IF LCCM-F14-88 DTSCS46 01177 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS46 01178 SET REQ-JUMP TO TRUE DTSCS46 01179 GO TO P1000-EXIT. DTSCS46 01180 DTSCS46 01181 DTSCS46 01182 *----------------------------------------------------- DTSCS46 01183 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS46 01184 * REQUESTED SCREEN TYPE DTSCS46 01185 *----------------------------------------------------- DTSCS46 01186 DTSCS46 01187 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS46 01188 NEXT SENTENCE DTSCS46 01189 ELSE DTSCS46 01190 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS46 01191 SET REQ-JUMP TO TRUE DTSCS46 01192 GO TO P1000-EXIT. DTSCS46 01193 DTSCS46 01194 DTSCS46 01195 *----------------------------------------------------- DTSCS46 01196 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS46 01197 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS46 01198 *----------------------------------------------------- DTSCS46 01199 DTSCS46 01200 IF LCCM-F09-88 DTSCS46 01201 AND SCR-ACCESS-UPDATE DTSCS46 01202 SET REQ-INQUIRE TO TRUE DTSCS46 01203 GO TO P1000-EXIT DTSCS46 01204 ELSE DTSCS46 01205 IF LCCM-INQUIRY-88 DTSCS46 01206 SET REQ-INQUIRE TO TRUE DTSCS46 01207 GO TO P1000-EXIT. DTSCS46 01208 DTSCS46 01209 DTSCS46 01210 *----------------------------------------------------- DTSCS46 01211 * ANY OTHER KEY IS INVALID DTSCS46 01212 *----------------------------------------------------- DTSCS46 01213 DTSCS46 01214 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS46 01215 DTSCS46 01216 SET REQ-ERROR TO TRUE. DTSCS46 01217 P1000-EXIT. DTSCS46 01218 EXIT. DTSCS46 01219 DTSCS46 01220 DTSCS46 01221 DTSCS46 01222 ******************************************************************DTSCS46 01223 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS46 01224 ******************************************************************DTSCS46 01225 DTSCS46 01226 P1100-PRT-LOCKED. DTSCS46 01227 DTSCS46 01228 *----------------------------------------------------- DTSCS46 01229 * IF THE SCREEN IS "LOCKED FOR PRINTING", THEN DTSCS46 01230 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER OR F09 DTSCS46 01231 * (CONFIRMING PRINTING) OR F12 (CANCELLING PRINTING). DTSCS46 01232 *----------------------------------------------------- DTSCS46 01233 DTSCS46 01234 IF LCCM-ENTER-88 OR LCCM-F09-88 OR LCCM-F12-88 DTSCS46 01235 SET REQ-UPDATE TO TRUE DTSCS46 01236 ELSE DTSCS46 01237 SET REQ-ERROR TO TRUE DTSCS46 01238 IF LCCM-SCR-PRT-LOCKED DTSCS46 01239 MOVE PMSG-ALT-PRT-CONFIRM TO LCCM-MSG-ID DTSCS46 01240 ELSE DTSCS46 01241 GO TO S899-ABEND. DTSCS46 01242 P1100-EXIT. DTSCS46 01243 EXIT. DTSCS46 01244 /*****************************************************************DTSCS46 01245 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS46 01246 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS46 01247 ******************************************************************DTSCS46 01248 DTSCS46 01249 P2000-REQUEST-ERROR. DTSCS46 01250 IF LCCM-MSG DTSCS46 01251 SET RESP-SEND-MSGONLY TO TRUE DTSCS46 01252 ELSE DTSCS46 01253 GO TO S899-ABEND. DTSCS46 01254 P2000-EXIT. DTSCS46 01255 EXIT. DTSCS46 01256 /*****************************************************************DTSCS46 01257 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS46 01258 ******************************************************************DTSCS46 01259 DTSCS46 01260 P3000-REQUEST-JUMP. DTSCS46 01261 DTSCS46 01262 *----------------------------------------------------- DTSCS46 01263 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS46 01264 * BY USER DTSCS46 01265 *----------------------------------------------------- DTSCS46 01266 DTSCS46 01267 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS46 01268 DTSCS46 01269 DTSCS46 01270 *----------------------------------------------------- DTSCS46 01271 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS46 01272 *----------------------------------------------------- DTSCS46 01273 DTSCS46 01274 IF LCCM-MSG DTSCS46 01275 SET RESP-SEND-MSGONLY TO TRUE DTSCS46 01276 SET CURSOR-SET-GOTO TO TRUE DTSCS46 01277 GO TO P3000-EXIT. DTSCS46 01278 DTSCS46 01279 DTSCS46 01280 MOVE SCREEN-QUEUE-NAME-SUFFIX TO WRK-QUEUE-NAME-SUFFIX. DTSCS46 01281 DTSCS46 01282 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS46 01283 DTSCS46 01284 DTSCS46 01285 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS46 01286 DTSCS46 01287 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS46 01288 DTSCS46 01289 IF L018-VALID DTSCS46 01290 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS46 01291 DTSCS46 01292 DTSCS46 01293 *----------------------------------------------------------- DTSCS46 01294 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS46 01295 *----------------------------------------------------------- DTSCS46 01296 DTSCS46 01297 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS46 01298 LCCM-SCR-HOLD-AREA. DTSCS46 01299 DTSCS46 01300 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS46 01301 DTSCS46 01302 SET RESP-JUMP TO TRUE. DTSCS46 01303 P3000-EXIT. DTSCS46 01304 EXIT. DTSCS46 01305 /*****************************************************************DTSCS46 01306 * CLEAR KEY WAS PRESSED *DTSCS46 01307 ******************************************************************DTSCS46 01308 DTSCS46 01309 P4000-REQUEST-CLEAR. DTSCS46 01310 DTSCS46 01311 *----------------------------------------------------- DTSCS46 01312 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS46 01313 * FIELDS FROM EARLIER REQUESTS DTSCS46 01314 *----------------------------------------------------- DTSCS46 01315 DTSCS46 01316 IF LCCM-EMP-NO > ZERO DTSCS46 01317 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS46 01318 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS46 01319 DTSCS46 01320 MOVE ZERO TO LCCM-EMP-NO. DTSCS46 01321 DTSCS46 01322 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS46 01323 DTSCS46 01324 SET LCCM-SCR-CLEAR TO TRUE. DTSCS46 01325 DTSCS46 01326 IF SCR-ACCESS-UPDATE DTSCS46 01327 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS46 01328 ELSE DTSCS46 01329 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS46 01330 DTSCS46 01331 SET RESP-SEND-MAP TO TRUE. DTSCS46 01332 P4000-EXIT. DTSCS46 01333 EXIT. DTSCS46 01334 /*****************************************************************DTSCS46 01335 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS46 01336 ******************************************************************DTSCS46 01337 DTSCS46 01338 P5000-CURSOR-TO-GOTO. DTSCS46 01339 SET CURSOR-SET-GOTO TO TRUE. DTSCS46 01340 DTSCS46 01341 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS46 01342 P5000-EXIT. DTSCS46 01343 EXIT. DTSCS46 01344 /*****************************************************************DTSCS46 01345 * FUNCTION KEY TO INQUIRE OR PRINT STATEMENT WAS PRESSED. DTSCS46 01346 * EDIT THE INPUT FIELDS, CONSTRUCT A STATEMENT IN TS AND DTSCS46 01347 * DISPLAY A PAGE OF THE STATEMENT IN THE STATEMENT REVIEW DTSCS46 01348 * WINDOW. DTSCS46 01349 ******************************************************************DTSCS46 01350 DTSCS46 01351 P6000-REQUEST-INQUIRY. DTSCS46 01352 MOVE LOW-VALUES TO MAP-PRIMARY-NAME-AREA DTSCS46 01353 MAP-CURR-PAGE-AREA DTSCS46 01354 MAP-LAST-PAGE-AREA DTSCS46 01355 MAP-TOT-DUE-AMT-AREA DTSCS46 01356 MAP-PURSUED-RPTS-CNT-AREA DTSCS46 01357 MAP-RESP-OP-ID-DSCR-AREA DTSCS46 01358 MAP-STMT-LINES-AREA. DTSCS46 01359 DTSCS46 01360 SET LCCM-SCR-CLEAR TO TRUE. DTSCS46 01361 DTSCS46 01362 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS46 01363 DTSCS46 01364 SET RESP-SEND-MAP TO TRUE. DTSCS46 01365 DTSCS46 01366 IF SCR-ACCESS-UPDATE DTSCS46 01367 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS46 01368 ELSE DTSCS46 01369 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS46 01370 DTSCS46 01371 DTSCS46 01372 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS46 01373 DTSCS46 01374 IF LCCM-MSG DTSCS46 01375 NEXT SENTENCE DTSCS46 01376 ELSE DTSCS46 01377 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS46 01378 DTSCS46 01379 DTSCS46 01380 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS46 01381 DTSCS46 01382 IF LCCM-MSG DTSCS46 01383 GO TO P6000-EXIT. DTSCS46 01384 DTSCS46 01385 DTSCS46 01386 IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES) DTSCS46 01387 OR DTSCS46 01388 (WRK-SCR-HOLD-CONTROL-AREA DTSCS46 01389 NOT = LCCM-SCR-HOLD-CONTROL-AREA) DTSCS46 01390 OR DTSCS46 01391 (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME) DTSCS46 01392 PERFORM P7000-CONSTRUCT-PAGES THRU P7000-EXIT. DTSCS46 01393 DTSCS46 01394 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0 DTSCS46 01395 MOVE MSG-E461-AREA TO WRK-MSG-AREA DTSCS46 01396 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS46 01397 GO TO P6000-EXIT. DTSCS46 01398 DTSCS46 01399 DTSCS46 01400 PERFORM P6100-LOCATE-PAGE THRU P6100-EXIT. DTSCS46 01401 DTSCS46 01402 IF LCCM-MSG DTSCS46 01403 GO TO P6000-EXIT. DTSCS46 01404 DTSCS46 01405 DTSCS46 01406 PERFORM P6200-CONSTRUCT-SCREEN THRU P6200-EXIT. DTSCS46 01407 DTSCS46 01408 DTSCS46 01409 IF LCCM-F09-88 DTSCS46 01410 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS46 01411 SET LCCM-SCR-PRT-LOCKED TO TRUE DTSCS46 01412 MOVE PMSG-ALT-PRT-CONFIRM TO LCCM-MSG-AREA DTSCS46 01413 ELSE DTSCS46 01414 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS46 01415 P6000-EXIT. DTSCS46 01416 EXIT. DTSCS46 01417 EJECT DTSCS46 01418 P6100-LOCATE-PAGE. DTSCS46 01419 IF LCCM-F05-88 DTSCS46 01420 MOVE +1 TO LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 01421 ELSE DTSCS46 01422 IF LCCM-F06-88 DTSCS46 01423 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS46 01424 TO LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 01425 ELSE DTSCS46 01426 IF LCCM-SCR-HOLD-CURR-PAGE-NUM = +0 DTSCS46 01427 MOVE +2 TO LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 01428 ELSE DTSCS46 01429 IF LCCM-F07-88 DTSCS46 01430 SUBTRACT +1 FROM LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 01431 ELSE DTSCS46 01432 IF LCCM-F08-88 DTSCS46 01433 ADD +1 TO LCCM-SCR-HOLD-CURR-PAGE-NUM. DTSCS46 01434 DTSCS46 01435 DTSCS46 01436 IF LCCM-SCR-HOLD-CURR-PAGE-NUM < +1 DTSCS46 01437 MOVE +1 TO LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 01438 ELSE DTSCS46 01439 IF LCCM-SCR-HOLD-CURR-PAGE-NUM > LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS46 01440 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS46 01441 TO LCCM-SCR-HOLD-CURR-PAGE-NUM. DTSCS46 01442 P6100-EXIT. DTSCS46 01443 EXIT. DTSCS46 01444 EJECT DTSCS46 01445 P6200-CONSTRUCT-SCREEN. DTSCS46 01446 MOVE LCCM-SCR-HOLD-RPTS-PUR-CNT DTSCS46 01447 TO MAP-PURSUED-RPTS-CNT-Z. DTSCS46 01448 DTSCS46 01449 DTSCS46 01450 MOVE LCCM-SCR-HOLD-TOT-AMT TO MAP-TOT-DUE-AMT-Z. DTSCS46 01451 DTSCS46 01452 COMPUTE L829-ITEM-NO DTSCS46 01453 = (LCCM-SCR-HOLD-CURR-PAGE-NUM - 1) * WINDOW-LINE-MAX. DTSCS46 01454 DTSCS46 01455 MOVE SCREEN-QUEUE-NAME-SUFFIX TO WRK-QUEUE-NAME-SUFFIX. DTSCS46 01456 DTSCS46 01457 MOVE LCCM-CICS-TERM-ID TO L356-DEVICE-ID. DTSCS46 01458 DTSCS46 01459 SET L356-DEVICE-TERMINAL-88 TO TRUE. DTSCS46 01460 DTSCS46 01461 PERFORM P6210-RETRIEVE-STMT-LINES THRU P6210-EXIT DTSCS46 01462 VARYING WRK-CTR FROM 1 BY 1 DTSCS46 01463 UNTIL WRK-CTR > +8. DTSCS46 01464 DTSCS46 01465 PERFORM P6290-PAGE-NUMBER THRU P6290-EXIT. DTSCS46 01466 P6200-EXIT. DTSCS46 01467 EXIT. DTSCS46 01468 SKIP3 DTSCS46 01469 P6210-RETRIEVE-STMT-LINES. DTSCS46 01470 ADD +1 TO L829-ITEM-NO. DTSCS46 01471 DTSCS46 01472 PERFORM S829-READ-ITEM THRU S829-EXIT. DTSCS46 01473 DTSCS46 01474 IF L829-NO-REC-88 DTSCS46 01475 GO TO P6210-EXIT. DTSCS46 01476 DTSCS46 01477 DTSCS46 01478 MOVE XPTS-DATA TO L356-PRINT-LINE. DTSCS46 01479 DTSCS46 01480 PERFORM S356-LINK-PRINTER-CONTROL THRU S356-EXIT. DTSCS46 01481 DTSCS46 01482 MOVE L356-PRINT-LINE TO MAP-STMT-LINE (WRK-CTR). DTSCS46 01483 P6210-EXIT. DTSCS46 01484 EXIT. DTSCS46 01485 SKIP3 DTSCS46 01486 P6290-PAGE-NUMBER. DTSCS46 01487 MOVE LCCM-SCR-HOLD-CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCS46 01488 DTSCS46 01489 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE. DTSCS46 01490 DTSCS46 01491 IF LCCM-SCR-HOLD-CURR-PAGE-NUM = +1 DTSCS46 01492 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1 DTSCS46 01493 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS46 01494 ELSE DTSCS46 01495 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS46 01496 ELSE DTSCS46 01497 IF LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 01498 = LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS46 01499 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS46 01500 P6290-EXIT. DTSCS46 01501 EXIT. DTSCS46 01502 EJECT DTSCS46 01503 P7000-CONSTRUCT-PAGES. DTSCS46 01504 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS46 01505 DTSCS46 01506 MOVE WRK-SCR-HOLD-CONTROL-AREA TO LCCM-SCR-HOLD-CONTROL-AREA.DTSCS46 01507 DTSCS46 01508 MOVE LCCM-SCR-ABSTIME TO LCCM-SCR-HOLD-ABSTIME. DTSCS46 01509 DTSCS46 01510 MOVE +0 TO LCCM-SCR-HOLD-CURR-PAGE-NUM DTSCS46 01511 LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS46 01512 LCCM-SCR-HOLD-TS-ITEM-CNT. DTSCS46 01513 DTSCS46 01514 MOVE +0 TO LCCM-SCR-HOLD-TOT-AMT DTSCS46 01515 LCCM-SCR-HOLD-RPTS-PUR-CNT. DTSCS46 01516 DTSCS46 01517 SET LCCM-SCR-HOLD-NO-DOC-88 TO TRUE. DTSCS46 01518 DTSCS46 01519 SET LCCM-SCR-HOLD-MCOL-TEMP-NO-88 TO TRUE. DTSCS46 01520 DTSCS46 01521 MOVE SCREEN-QUEUE-NAME-SUFFIX TO WRK-QUEUE-NAME-SUFFIX. DTSCS46 01522 DTSCS46 01523 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS46 01524 DTSCS46 01525 DTSCS46 01526 IF (MPRF-PURSUED-RPT-CNT > +0) DTSCS46 01527 OR DTSCS46 01528 (MPRF-TOT-BALANCE-AMT > +0) DTSCS46 01529 PERFORM P7200-CONSTRUCT-DEBIT-MEMO THRU P7200-EXIT DTSCS46 01530 ELSE DTSCS46 01531 IF MPRF-TOT-CREDIT-AMT > +0 DTSCS46 01532 PERFORM P7100-CONSTRUCT-CREDIT-MEMO THRU P7100-EXIT. DTSCS46 01533 DTSCS46 01534 DTSCS46 01535 IF LCCM-SCR-HOLD-NO-DOC-88 DTSCS46 01536 MOVE +0 TO LCCM-SCR-HOLD-TS-ITEM-CNT DTSCS46 01537 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS46 01538 DTSCS46 01539 DTSCS46 01540 IF LCCM-SCR-HOLD-TS-ITEM-CNT = +0 DTSCS46 01541 NEXT SENTENCE DTSCS46 01542 ELSE DTSCS46 01543 COMPUTE LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCS46 01544 = (LCCM-SCR-HOLD-TS-ITEM-CNT - 1) / 8 DTSCS46 01545 ADD +1 TO LCCM-SCR-HOLD-LAST-PAGE-NUM. DTSCS46 01546 P7000-EXIT. DTSCS46 01547 EXIT. DTSCS46 01548 EJECT DTSCS46 01549 P7100-CONSTRUCT-CREDIT-MEMO. DTSCS46 01550 SET LCCM-SCR-HOLD-CREDIT-88 TO TRUE. DTSCS46 01551 DTSCS46 01552 MOVE SPACES TO HEAD01-SCREEN-ID. DTSCS46 01553 DTSCS46 01554 MOVE 'R309R1' TO HEAD01-OUTPUT-ID. DTSCS46 01555 DTSCS46 01556 PERFORM P7910-FORMAT-HEADING THRU P7910-EXIT. DTSCS46 01557 DTSCS46 01558 PERFORM P7920-FORMAT-ADDR THRU P7920-EXIT. DTSCS46 01559 DTSCS46 01560 MOVE L112-MAILING-LINE-1 TO CRADDR01-MAILING-LINE-1. DTSCS46 01561 DTSCS46 01562 MOVE LCCM-SCR-HOLD-EMP-NO TO CRADDR01-EMP-NO. DTSCS46 01563 DTSCS46 01564 MOVE L112-MAILING-LINE-2 TO CRADDR02-MAILING-LINE-2. DTSCS46 01565 DTSCS46 01566 MOVE L112-MAILING-LINE-3 TO CRADDR03-MAILING-LINE-3. DTSCS46 01567 DTSCS46 01568 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS46 01569 DTSCS46 01570 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS46 01571 DTSCS46 01572 MOVE L001-SLASH-8-DATE TO CRADDR03-CURR-RUN-DATE. DTSCS46 01573 DTSCS46 01574 MOVE L112-MAILING-LINE-4 TO CRADDR04-MAILING-LINE-4. DTSCS46 01575 DTSCS46 01576 MOVE L112-MAILING-LINE-5 TO CRADDR05-MAILING-LINE-5. DTSCS46 01577 DTSCS46 01578 PERFORM P7930-CONSTRUCT-FREE-TEXT THRU P7930-EXIT. DTSCS46 01579 DTSCS46 01580 COMPUTE LINE-CNT = LINE-MAX + 1. DTSCS46 01581 DTSCS46 01582 MOVE +0 TO PAGE-CNT. DTSCS46 01583 DTSCS46 01584 MOVE +1 TO PAGE-LAST. DTSCS46 01585 DTSCS46 01586 SET WRITE-TS-YES-88 TO TRUE. DTSCS46 01587 DTSCS46 01588 PERFORM P7940-WRITE-FREE-TEXT THRU P7940-EXIT. DTSCS46 01589 DTSCS46 01590 COMPUTE WRK-CTR = 15 - FREE-TEXT-CNT. DTSCS46 01591 DTSCS46 01592 MOVE SPACES TO XPTS-DATA. DTSCS46 01593 DTSCS46 01594 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 01595 WRK-CTR TIMES. DTSCS46 01596 DTSCS46 01597 MOVE 'YOUR ACCOUNT HAS A CREDIT BALANCE OF $' DTSCS46 01598 TO L090-PHRASE-TABLE (1). DTSCS46 01599 DTSCS46 01600 MOVE MPRF-TOT-CREDIT-AMT TO WS-AMT-EDIT. DTSCS46 01601 DTSCS46 01602 MOVE +0 TO WRK-CTR. DTSCS46 01603 DTSCS46 01604 INSPECT WS-AMT TALLYING WRK-CTR FOR LEADING SPACES. DTSCS46 01605 DTSCS46 01606 MOVE WS-AMT (WRK-CTR + 1:) TO L090-PHRASE-TABLE (2). DTSCS46 01607 DTSCS46 01608 DTSCS46 01609 COMPUTE LCCM-SCR-HOLD-TOT-AMT = MPRF-TOT-CREDIT-AMT * -1. DTSCS46 01610 DTSCS46 01611 MOVE '. YOU EITHER NEED TO DEDUCT THIS AMOUNT' DTSCS46 01612 TO L090-PHRASE-TABLE (3). DTSCS46 01613 DTSCS46 01614 MOVE 'FROM YOUR NEXT UNEMPLOYMENT INSURANCE' DTSCS46 01615 TO L090-PHRASE-TABLE (4). DTSCS46 01616 DTSCS46 01617 MOVE 'EMPLOYER''S QUARTERLY WAGE REPORT OR' DTSCS46 01618 TO L090-PHRASE-TABLE (5). DTSCS46 01619 DTSCS46 01620 MOVE 'REQUEST A REFUND.' DTSCS46 01621 TO L090-PHRASE-TABLE (6). DTSCS46 01622 DTSCS46 01623 MOVE +6 TO L090-PHRASE-CNT. DTSCS46 01624 DTSCS46 01625 MOVE +77 TO L090-DESIRED-LINE-LIMIT. DTSCS46 01626 DTSCS46 01627 PERFORM S090-CONSTRUCT-PARAGRAPH THRU S090-EXIT. DTSCS46 01628 DTSCS46 01629 IF L090-SUCCESSFUL-88 DTSCS46 01630 PERFORM DTSCS46 01631 VARYING L090-PARAGRAPH-IDX FROM 1 BY 1 DTSCS46 01632 UNTIL L090-PARAGRAPH-IDX > L090-PARAGRAPH-LINE-CNT DTSCS46 01633 MOVE L090-PARAGRAPH-LINE (L090-PARAGRAPH-IDX) DTSCS46 01634 TO CRVARNN-TEXT-AREA DTSCS46 01635 MOVE CRVARNN TO XPTS-DATA DTSCS46 01636 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 01637 END-PERFORM DTSCS46 01638 IF L090-PARAGRAPH-LINE-CNT < +3 DTSCS46 01639 COMPUTE WRK-CTR = 3 - L090-PARAGRAPH-LINE-CNT DTSCS46 01640 MOVE SPACES TO XPTS-DATA DTSCS46 01641 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 01642 WRK-CTR TIMES DTSCS46 01643 END-IF DTSCS46 01644 ELSE DTSCS46 01645 MOVE SPACES TO XPTS-DATA DTSCS46 01646 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 01647 3 TIMES. DTSCS46 01648 DTSCS46 01649 DTSCS46 01650 MOVE SPACES TO XPTS-DATA. DTSCS46 01651 DTSCS46 01652 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01653 DTSCS46 01654 DTSCS46 01655 MOVE CRFIX01 TO XPTS-DATA. DTSCS46 01656 DTSCS46 01657 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01658 DTSCS46 01659 DTSCS46 01660 MOVE CRFIX02 TO XPTS-DATA. DTSCS46 01661 DTSCS46 01662 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01663 DTSCS46 01664 DTSCS46 01665 MOVE SPACES TO XPTS-DATA. DTSCS46 01666 DTSCS46 01667 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01668 DTSCS46 01669 DTSCS46 01670 MOVE CRFIX04 TO XPTS-DATA. DTSCS46 01671 DTSCS46 01672 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01673 DTSCS46 01674 DTSCS46 01675 MOVE CRFIX05 TO XPTS-DATA. DTSCS46 01676 DTSCS46 01677 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01678 DTSCS46 01679 DTSCS46 01680 MOVE CRFIX06 TO XPTS-DATA. DTSCS46 01681 DTSCS46 01682 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01683 DTSCS46 01684 DTSCS46 01685 MOVE CRFIX07 TO XPTS-DATA. DTSCS46 01686 DTSCS46 01687 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01688 DTSCS46 01689 DTSCS46 01690 MOVE SPACES TO XPTS-DATA. DTSCS46 01691 DTSCS46 01692 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01693 DTSCS46 01694 DTSCS46 01695 MOVE LCCM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS46 01696 DTSCS46 01697 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS46 01698 DTSCS46 01699 MOVE L001-SLASH-8-DATE TO CRFIX09-PRIOR-RUN-DATE. DTSCS46 01700 DTSCS46 01701 MOVE CRFIX09 TO XPTS-DATA. DTSCS46 01702 DTSCS46 01703 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01704 DTSCS46 01705 DTSCS46 01706 MOVE SPACES TO XPTS-DATA. DTSCS46 01707 DTSCS46 01708 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01709 DTSCS46 01710 DTSCS46 01711 MOVE SPACES TO XPTS-DATA. DTSCS46 01712 DTSCS46 01713 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01714 DTSCS46 01715 DTSCS46 01716 MOVE CRFIX11 TO XPTS-DATA. DTSCS46 01717 DTSCS46 01718 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01719 DTSCS46 01720 DTSCS46 01721 MOVE SPACES TO XPTS-DATA. DTSCS46 01722 DTSCS46 01723 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01724 DTSCS46 01725 DTSCS46 01726 MOVE CRFIX13 TO XPTS-DATA. DTSCS46 01727 DTSCS46 01728 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01729 DTSCS46 01730 DTSCS46 01731 MOVE CRFIX14 TO XPTS-DATA. DTSCS46 01732 DTSCS46 01733 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01734 DTSCS46 01735 DTSCS46 01736 MOVE SPACES TO XPTS-DATA. DTSCS46 01737 DTSCS46 01738 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01739 DTSCS46 01740 DTSCS46 01741 MOVE CRFIX17 TO XPTS-DATA. DTSCS46 01742 DTSCS46 01743 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01744 DTSCS46 01745 DTSCS46 01746 MOVE CRFIX18 TO XPTS-DATA. DTSCS46 01747 DTSCS46 01748 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01749 DTSCS46 01750 DTSCS46 01751 MOVE SPACES TO XPTS-DATA. DTSCS46 01752 DTSCS46 01753 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01754 DTSCS46 01755 DTSCS46 01756 MOVE CRFIX20 TO XPTS-DATA. DTSCS46 01757 DTSCS46 01758 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01759 DTSCS46 01760 DTSCS46 01761 MOVE SPACES TO XPTS-DATA. DTSCS46 01762 DTSCS46 01763 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01764 DTSCS46 01765 DTSCS46 01766 MOVE CRFIX22 TO XPTS-DATA. DTSCS46 01767 DTSCS46 01768 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01769 DTSCS46 01770 DTSCS46 01771 MOVE SPACES TO XPTS-DATA. DTSCS46 01772 DTSCS46 01773 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01774 DTSCS46 01775 DTSCS46 01776 MOVE CRFIX24 TO XPTS-DATA. DTSCS46 01777 DTSCS46 01778 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 01779 P7100-EXIT. DTSCS46 01780 EXIT. DTSCS46 01781 EJECT DTSCS46 01782 P7200-CONSTRUCT-DEBIT-MEMO. DTSCS46 01783 SET LCCM-SCR-HOLD-DEBIT-88 TO TRUE. DTSCS46 01784 DTSCS46 01785 MOVE '25' TO HEAD01-SCREEN-ID. DTSCS46 01786 DTSCS46 01787 MOVE 'R414R1' TO HEAD01-OUTPUT-ID. DTSCS46 01788 DTSCS46 01789 DTSCS46 01790 PERFORM P7950-CONSTRUCT-APPEAL-TBL THRU P7950-EXIT. DTSCS46 01791 DTSCS46 01792 DTSCS46 01793 MOVE +0 TO DB-QTR-CNT DTSCS46 01794 DB-TOT-PAID-AMT DTSCS46 01795 DB-TOT-BALANCE-AMT DTSCS46 01796 DB-PURSUED-RPT-CNT. DTSCS46 01797 DTSCS46 01798 DTSCS46 01799 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS46 01800 DTSCS46 01801 MOVE LCCM-SCR-HOLD-EMP-NO TO MQTR-EMP-NO. DTSCS46 01802 DTSCS46 01803 SET MQTR-QTR-88 TO TRUE. DTSCS46 01804 DTSCS46 01805 MOVE LCCM-SCR-HOLD-FROM-YRQ TO MQTR-YRQ. DTSCS46 01806 DTSCS46 01807 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS46 01808 DTSCS46 01809 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS46 01810 DTSCS46 01811 PERFORM P7300-MQTR-SCAN THRU P7300-EXIT DTSCS46 01812 UNTIL L810-NO-REC-88. DTSCS46 01813 DTSCS46 01814 DTSCS46 01815 IF DB-QTR-CNT = +0 DTSCS46 01816 SET LCCM-SCR-HOLD-NO-DOC-88 TO TRUE DTSCS46 01817 GO TO P7200-EXIT. DTSCS46 01818 DTSCS46 01819 DTSCS46 01820 IF DB-QTR-CNT > DB-QTR-MAX DTSCS46 01821 MOVE MSG-E462-AREA TO WRK-MSG-AREA DTSCS46 01822 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS46 01823 SET LCCM-SCR-HOLD-NO-DOC-88 TO TRUE DTSCS46 01824 GO TO P7200-EXIT. DTSCS46 01825 DTSCS46 01826 DTSCS46 01827 MOVE DB-TOT-BALANCE-AMT TO LCCM-SCR-HOLD-TOT-AMT. DTSCS46 01828 DTSCS46 01829 MOVE DB-PURSUED-RPT-CNT TO LCCM-SCR-HOLD-RPTS-PUR-CNT. DTSCS46 01830 DTSCS46 01831 DTSCS46 01832 PERFORM P7910-FORMAT-HEADING THRU P7910-EXIT. DTSCS46 01833 DTSCS46 01834 DTSCS46 01835 PERFORM P7920-FORMAT-ADDR THRU P7920-EXIT. DTSCS46 01836 DTSCS46 01837 DTSCS46 01838 MOVE L112-MAILING-LINE-1 TO DBADDR01-MAILING-LINE-1. DTSCS46 01839 DTSCS46 01840 MOVE L112-MAILING-LINE-2 TO DBADDR02-MAILING-LINE-2. DTSCS46 01841 DTSCS46 01842 MOVE LCCM-SCR-HOLD-EMP-NO TO DBADDR02-EMP-NO. DTSCS46 01843 DTSCS46 01844 MOVE L112-MAILING-LINE-3 TO DBADDR03-MAILING-LINE-3. DTSCS46 01845 DTSCS46 01846 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS46 01847 DTSCS46 01848 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS46 01849 DTSCS46 01850 MOVE L001-SLASH-8-DATE TO DBADDR03-CURR-RUN-DATE. DTSCS46 01851 DTSCS46 01852 MOVE L112-MAILING-LINE-4 TO DBADDR04-MAILING-LINE-4. DTSCS46 01853 DTSCS46 01854 MOVE LCCM-SCR-HOLD-COMP-DATE TO L001-FED-8-DATE-9. DTSCS46 01855 DTSCS46 01856 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS46 01857 DTSCS46 01858 IF L001-INVALID-DATE DTSCS46 01859 MOVE SPACES TO DBADDR04-COMP-DATE DTSCS46 01860 ELSE DTSCS46 01861 MOVE L001-SLASH-8-DATE TO DBADDR04-COMP-DATE. DTSCS46 01862 DTSCS46 01863 MOVE L112-MAILING-LINE-5 TO DBADDR05-MAILING-LINE-5. DTSCS46 01864 DTSCS46 01865 DTSCS46 01866 PERFORM P7930-CONSTRUCT-FREE-TEXT THRU P7930-EXIT. DTSCS46 01867 DTSCS46 01868 DTSCS46 01869 *****PERFORM P7210-CONSTRUCT-RESP-OP-ID THRU P7210-EXIT. DTSCS46 01870 DTSCS46 01871 DTSCS46 01872 MOVE L119-UNIT-NAME TO DBOPID01-AR-UNIT-NAME. DTSCS46 01873 DTSCS46 01874 DTSCS46 01875 MOVE L062-VOICE-1 TO INT-TEL. DTSCS46 01876 DTSCS46 01877 PERFORM P7911-INT-TO-DISP-TEL THRU P7911-EXIT. DTSCS46 01878 DTSCS46 01879 MOVE DISP-TEL TO DBOPID03-AR-UNIT-VOICE. DTSCS46 01880 DTSCS46 01881 DTSCS46 01882 MOVE LCCM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS46 01883 DTSCS46 01884 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS46 01885 DTSCS46 01886 MOVE L001-SLASH-8-DATE TO DBOPID06-PRIOR-RUN-DATE. DTSCS46 01887 DTSCS46 01888 DTSCS46 01889 MOVE +0 TO PAGE-LAST. DTSCS46 01890 DTSCS46 01891 DTSCS46 01892 SET WRITE-TS-NO-88 TO TRUE. DTSCS46 01893 DTSCS46 01894 DTSCS46 01895 PERFORM P7400-FORMAT-DEBIT-MEMO THRU P7400-EXIT. DTSCS46 01896 DTSCS46 01897 DTSCS46 01898 MOVE PAGE-CNT TO PAGE-LAST. DTSCS46 01899 DTSCS46 01900 SET WRITE-TS-YES-88 TO TRUE. DTSCS46 01901 DTSCS46 01902 DTSCS46 01903 PERFORM P7400-FORMAT-DEBIT-MEMO THRU P7400-EXIT. DTSCS46 01904 P7200-EXIT. DTSCS46 01905 EXIT. DTSCS46 01906 SKIP3 DTSCS46 01907 P7300-MQTR-SCAN. DTSCS46 01908 MOVE MSKL-REC TO MQTR-REC. DTSCS46 01909 MOVE ZEROS TO WRK-YRQ. DTSCS46 01910 IF MQTR-YRQ > LCCM-SCR-HOLD-TO-YRQ DTSCS46 01911 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS46 01912 SET L810-NO-REC-88 TO TRUE DTSCS46 01913 GO TO P7300-EXIT. DTSCS46 01914 DTSCS46 01915 IF MQTR-ANNUAL-YES-88 DTSCS46 01916 MOVE MQTR-YRQ TO WRK-YRQ. DTSCS46 01917 DTSCS46 01918 PERFORM P7310-MQTR-PROCESS THRU P7310-EXIT. DTSCS46 01919 DTSCS46 01920 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS46 01921 P7300-EXIT. DTSCS46 01922 EXIT. DTSCS46 01923 SKIP3 DTSCS46 01924 P7310-MQTR-PROCESS. DTSCS46 01925 MOVE +0 TO QTR-TAX-PAID-AMT DTSCS46 01926 QTR-TAX-BALANCE-AMT DTSCS46 01927 QTR-PEN-PAID-AMT DTSCS46 01928 QTR-PEN-BALANCE-AMT DTSCS46 01929 QTR-INT-PAID-AMT DTSCS46 01930 QTR-INT-BALANCE-AMT DTSCS46 01931 QTR-TOT-PAID-AMT DTSCS46 01932 QTR-TOT-BALANCE-AMT. DTSCS46 01933 DTSCS46 01934 PERFORM P7311-PROJECT-INT THRU P7311-EXIT. DTSCS46 01935 DTSCS46 01936 DTSCS46 01937 ADD QTR-TAX-PAID-AMT DTSCS46 01938 QTR-PEN-PAID-AMT DTSCS46 01939 QTR-INT-PAID-AMT GIVING QTR-TOT-PAID-AMT. DTSCS46 01940 DTSCS46 01941 DTSCS46 01942 ADD QTR-TAX-BALANCE-AMT DTSCS46 01943 QTR-PEN-BALANCE-AMT DTSCS46 01944 QTR-INT-BALANCE-AMT GIVING QTR-TOT-BALANCE-AMT. DTSCS46 01945 DTSCS46 01946 DTSCS46 01947 IF (QTR-TOT-BALANCE-AMT > +0) DTSCS46 01948 OR DTSCS46 01949 (MQTR-RPT-IS-PURSUED-88) DTSCS46 01950 NEXT SENTENCE DTSCS46 01951 ELSE DTSCS46 01952 GO TO P7310-EXIT. DTSCS46 01953 DTSCS46 01954 IF MQTR-ANNUAL-YES-88 DTSCS46 01955 MOVE MQTR-YRQ TO WRK-YRQ DTSCS46 01956 END-IF. DTSCS46 01957 DTSCS46 01958 IF MQTR-ANNUAL-YES-88 DTSCS46 01959 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YR DTSCS46 01960 ADD +1 TO DB-QTR-CNT DTSCS46 01961 END-IF DTSCS46 01962 ELSE DTSCS46 01963 ADD +1 TO DB-QTR-CNT DTSCS46 01964 END-IF. DTSCS46 01965 DTSCS46 01966 IF DB-QTR-CNT > DB-QTR-MAX DTSCS46 01967 GO TO P7310-EXIT. DTSCS46 01968 DTSCS46 01969 IF MQTR-ANNUAL-YES-88 DTSCS46 01970 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YR DTSCS46 01971 IF MQTR-RPT-IS-PURSUED-88 DTSCS46 01972 ADD +1 TO DB-PURSUED-RPT-CNT DTSCS46 01973 END-IF DTSCS46 01974 END-IF DTSCS46 01975 ELSE DTSCS46 01976 IF MQTR-RPT-IS-PURSUED-88 DTSCS46 01977 ADD +1 TO DB-PURSUED-RPT-CNT DTSCS46 01978 END-IF DTSCS46 01979 END-IF. DTSCS46 01980 DTSCS46 01981 IF MQTR-ANNUAL-YES-88 DTSCS46 01982 MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YR DTSCS46 01983 MOVE ZERO TO WRK-CURR-ANN-Q DTSCS46 01984 MOVE WRK-CURR-ANN-YRQ TO DB-QTR-YRQ (DB-QTR-CNT) DTSCS46 01985 ELSE DTSCS46 01986 MOVE MQTR-YRQ TO DB-QTR-YRQ (DB-QTR-CNT). DTSCS46 01987 DTSCS46 01988 IF MQTR-CURR-ESTIM-88 DTSCS46 01989 SET DB-QTR-EST-RPT-YES-88 (DB-QTR-CNT) TO TRUE DTSCS46 01990 ELSE DTSCS46 01991 SET DB-QTR-EST-RPT-NO-88 (DB-QTR-CNT) TO TRUE. DTSCS46 01992 DTSCS46 01993 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS46 01994 DTSCS46 01995 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS46 01996 DTSCS46 01997 IF L004-VALID-QTR DTSCS46 01998 MOVE WRK-APPEAL-IND (L004-ABS-QTR) DTSCS46 01999 TO DB-QTR-APPEAL-IND (DB-QTR-CNT) DTSCS46 02000 ELSE DTSCS46 02001 SET DB-QTR-APPEAL-NO-88 (DB-QTR-CNT) TO TRUE. DTSCS46 02002 DTSCS46 02003 PERFORM P7312-QTR-STATUS THRU P7312-EXIT. DTSCS46 02004 DTSCS46 02005 IF MQTR-ANNUAL-YES-88 DTSCS46 02006 ADD QTR-TOT-PAID-AMT TO DTSCS46 02007 DB-QTR-PAID-AMT (DB-QTR-CNT) DTSCS46 02008 ADD QTR-TOT-BALANCE-AMT TO DTSCS46 02009 DB-QTR-BALANCE-AMT (DB-QTR-CNT) DTSCS46 02010 ELSE DTSCS46 02011 MOVE QTR-TOT-PAID-AMT TO DTSCS46 02012 DB-QTR-PAID-AMT (DB-QTR-CNT) DTSCS46 02013 MOVE QTR-TOT-BALANCE-AMT TO DTSCS46 02014 DB-QTR-BALANCE-AMT (DB-QTR-CNT). DTSCS46 02015 DTSCS46 02016 IF QTR-TOT-BALANCE-AMT > +0 DTSCS46 02017 ADD QTR-TOT-PAID-AMT TO DB-TOT-PAID-AMT DTSCS46 02018 ADD QTR-TOT-BALANCE-AMT TO DB-TOT-BALANCE-AMT. DTSCS46 02019 DTSCS46 02020 P7310-EXIT. DTSCS46 02021 EXIT. DTSCS46 02022 DTSCS46 02023 P7311-PROJECT-INT. DTSCS46 02024 MOVE +0 TO L101-PAID-CHNG. DTSCS46 02025 DTSCS46 02026 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS46 02027 DTSCS46 02028 PERFORM DTSCS46 02029 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS46 02030 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS46 02031 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS46 02032 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS46 02033 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS46 02034 TO QTR-TAX-PAID-AMT DTSCS46 02035 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS46 02036 TO QTR-TAX-BALANCE-AMT DTSCS46 02037 L101-PAID-CHNG DTSCS46 02038 END-IF DTSCS46 02039 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS46 02040 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS46 02041 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS46 02042 TO L101-PAID-CHNG DTSCS46 02043 END-IF DTSCS46 02044 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSCS46 02045 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS46 02046 TO QTR-TAX-PAID-AMT DTSCS46 02047 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS46 02048 TO QTR-TAX-BALANCE-AMT DTSCS46 02049 END-IF DTSCS46 02050 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSCS46 02051 OR DTSCS46 02052 MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSCS46 02053 OR DTSCS46 02054 MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSCS46 02055 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS46 02056 TO QTR-PEN-PAID-AMT DTSCS46 02057 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS46 02058 TO QTR-PEN-BALANCE-AMT DTSCS46 02059 END-IF DTSCS46 02060 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSCS46 02061 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS46 02062 TO QTR-INT-PAID-AMT DTSCS46 02063 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS46 02064 TO QTR-INT-BALANCE-AMT DTSCS46 02065 END-IF DTSCS46 02066 END-PERFORM. DTSCS46 02067 DTSCS46 02068 DTSCS46 02069 IF L101-PAID-CHNG > +0 DTSCS46 02070 NEXT SENTENCE DTSCS46 02071 ELSE DTSCS46 02072 GO TO P7311-EXIT. DTSCS46 02073 DTSCS46 02074 DTSCS46 02075 IF LCCM-SCR-HOLD-COMP-DATE = ALL-NINES-DATE DTSCS46 02076 GO TO P7311-EXIT. DTSCS46 02077 DTSCS46 02078 DTSCS46 02079 MOVE LCCM-SCR-HOLD-COMP-DATE TO L101-RECEIVED-DATE. DTSCS46 02080 DTSCS46 02081 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSCS46 02082 DTSCS46 02083 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSCS46 02084 DTSCS46 02085 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSCS46 02086 DTSCS46 02087 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSCS46 02088 DTSCS46 02089 ADD L101-INT-CHARGE-CHNG TO QTR-INT-BALANCE-AMT. DTSCS46 02090 DTSCS46 02091 SUBTRACT L101-INT-WAIVE-CHNG FROM QTR-INT-BALANCE-AMT. DTSCS46 02092 P7311-EXIT. DTSCS46 02093 EXIT. DTSCS46 02094 SKIP3 DTSCS46 02095 P7312-QTR-STATUS. DTSCS46 02096 IF MQTR-CURR-ESTIM-88 DTSCS46 02097 NEXT SENTENCE DTSCS46 02098 ELSE DTSCS46 02099 IF MQTR-RPT-IS-PURSUED-88 DTSCS46 02100 MOVE 'REPORT MISSING' DTSCS46 02101 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02102 GO TO P7312-EXIT. DTSCS46 02103 DTSCS46 02104 DTSCS46 02105 IF QTR-TAX-BALANCE-AMT > +0 DTSCS46 02106 IF QTR-PEN-BALANCE-AMT > +0 DTSCS46 02107 IF QTR-INT-BALANCE-AMT > +0 DTSCS46 02108 MOVE 'TAX, PENALTY, AND INTEREST DUE' DTSCS46 02109 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02110 ELSE DTSCS46 02111 MOVE 'TAX AND PENALTY DUE' DTSCS46 02112 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02113 ELSE DTSCS46 02114 IF QTR-INT-BALANCE-AMT > +0 DTSCS46 02115 MOVE 'TAX AND INTEREST DUE' DTSCS46 02116 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02117 ELSE DTSCS46 02118 MOVE 'TAX DUE' DTSCS46 02119 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02120 ELSE DTSCS46 02121 IF QTR-PEN-BALANCE-AMT > +0 DTSCS46 02122 IF QTR-INT-BALANCE-AMT > +0 DTSCS46 02123 MOVE 'PENALTY AND INTEREST DUE' DTSCS46 02124 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02125 ELSE DTSCS46 02126 MOVE 'PENALTY DUE' DTSCS46 02127 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02128 ELSE DTSCS46 02129 IF QTR-INT-BALANCE-AMT > +0 DTSCS46 02130 MOVE 'INTEREST DUE' DTSCS46 02131 TO DB-QTR-STATUS (DB-QTR-CNT) DTSCS46 02132 ELSE DTSCS46 02133 MOVE SPACES DTSCS46 02134 TO DB-QTR-STATUS (DB-QTR-CNT). DTSCS46 02135 P7312-EXIT. DTSCS46 02136 EXIT. DTSCS46 02137 EJECT DTSCS46 02138 P7400-FORMAT-DEBIT-MEMO. DTSCS46 02139 COMPUTE LINE-CNT = LINE-MAX + 1. DTSCS46 02140 DTSCS46 02141 MOVE +0 TO PAGE-CNT. DTSCS46 02142 DTSCS46 02143 SET AMT-DISPLAYED-NO-88 TO TRUE. DTSCS46 02144 DTSCS46 02145 SET APPEAL-ON-PAGE-NO-88 TO TRUE. DTSCS46 02146 DTSCS46 02147 SET QTR-ON-PAGE-YES-88 TO TRUE. DTSCS46 02148 DTSCS46 02149 DTSCS46 02150 PERFORM P7410-DISPLAY-QTR THRU P7410-EXIT DTSCS46 02151 VARYING DB-QTR-IDX FROM 1 BY 1 DTSCS46 02152 UNTIL DB-QTR-IDX > DB-QTR-CNT. DTSCS46 02153 DTSCS46 02154 DTSCS46 02155 IF AMT-DISPLAYED-YES-88 DTSCS46 02156 MOVE SPACES TO XPTS-DATA DTSCS46 02157 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02158 2 TIMES DTSCS46 02159 MOVE DB-TOT-PAID-AMT TO DBQTRTOT-PAID-AMT DTSCS46 02160 MOVE DB-TOT-BALANCE-AMT TO DBQTRTOT-BALANCE-AMT DTSCS46 02161 MOVE DBQTRTOT TO XPTS-DATA DTSCS46 02162 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02163 DTSCS46 02164 DTSCS46 02165 IF APPEAL-ON-PAGE-YES-88 DTSCS46 02166 MOVE SPACES TO XPTS-DATA DTSCS46 02167 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02168 2 TIMES DTSCS46 02169 MOVE APPEAL-MSG TO DBQTRTRAIL-APPEAL-MSG DTSCS46 02170 MOVE SPACES TO DBQTRTRAIL-CONTINUED-MSG DTSCS46 02171 MOVE DBQTRTRAIL TO XPTS-DATA DTSCS46 02172 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02173 DTSCS46 02174 DTSCS46 02175 MOVE +2 TO LINES-REQUIRED-CNT. DTSCS46 02176 DTSCS46 02177 ADD FREE-TEXT-CNT TO LINES-REQUIRED-CNT. DTSCS46 02178 DTSCS46 02179 IF FREE-TEXT-CNT > +0 DTSCS46 02180 ADD +2 TO LINES-REQUIRED-CNT. DTSCS46 02181 DTSCS46 02182 ADD +06 TO LINES-REQUIRED-CNT. DTSCS46 02183 DTSCS46 02184 IF (LINE-CNT + LINES-REQUIRED-CNT) > LINE-MAX DTSCS46 02185 COMPUTE WRK-CTR = LINE-MAX - LINE-CNT DTSCS46 02186 SUBTRACT 1 FROM WRK-CTR DTSCS46 02187 MOVE SPACES TO XPTS-DATA DTSCS46 02188 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02189 WRK-CTR TIMES DTSCS46 02190 MOVE SPACES TO DBQTRTRAIL-APPEAL-MSG DTSCS46 02191 MOVE 'CONTINUED' TO DBQTRTRAIL-CONTINUED-MSG DTSCS46 02192 MOVE DBQTRTRAIL TO XPTS-DATA DTSCS46 02193 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02194 DTSCS46 02195 DTSCS46 02196 SET QTR-ON-PAGE-NO-88 TO TRUE. DTSCS46 02197 DTSCS46 02198 DTSCS46 02199 MOVE SPACES TO XPTS-DATA. DTSCS46 02200 DTSCS46 02201 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02202 2 TIMES. DTSCS46 02203 DTSCS46 02204 DTSCS46 02205 PERFORM P7940-WRITE-FREE-TEXT THRU P7940-EXIT. DTSCS46 02206 DTSCS46 02207 IF FREE-TEXT-CNT > +0 DTSCS46 02208 MOVE SPACES TO XPTS-DATA DTSCS46 02209 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02210 2 TIMES. DTSCS46 02211 DTSCS46 02212 DTSCS46 02213 COMPUTE WRK-CTR = LINE-MAX - LINE-CNT. DTSCS46 02214 DTSCS46 02215 SUBTRACT 08 FROM WRK-CTR. DTSCS46 02216 DTSCS46 02217 IF WRK-CTR > +0 DTSCS46 02218 MOVE SPACES TO XPTS-DATA DTSCS46 02219 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02220 WRK-CTR TIMES. DTSCS46 02221 DTSCS46 02222 DTSCS46 02223 MOVE DBOPID01 TO XPTS-DATA. DTSCS46 02224 DTSCS46 02225 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02226 DTSCS46 02227 DTSCS46 02228 MOVE DBOPID02 TO XPTS-DATA. DTSCS46 02229 DTSCS46 02230 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02231 DTSCS46 02232 DTSCS46 02233 MOVE DBOPID03 TO XPTS-DATA. DTSCS46 02234 DTSCS46 02235 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02236 DTSCS46 02237 DTSCS46 02238 MOVE SPACE TO XPTS-DATA. DTSCS46 02239 DTSCS46 02240 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02241 2 TIMES. DTSCS46 02242 DTSCS46 02243 DTSCS46 02244 MOVE DBOPID06 TO XPTS-DATA. DTSCS46 02245 DTSCS46 02246 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02247 DTSCS46 02248 IF MQTR-ANNUAL-YES-88 DTSCS46 02249 MOVE DBOPID07 TO XPTS-DATA DTSCS46 02250 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02251 DTSCS46 02252 P7400-EXIT. DTSCS46 02253 EXIT. DTSCS46 02254 SKIP3 DTSCS46 02255 P7410-DISPLAY-QTR. DTSCS46 02256 SET PAGE-BREAK-NO-88 TO TRUE. DTSCS46 02257 DTSCS46 02258 PERFORM P7411-EVALUATE-FOR-PAGE-BREAK THRU P7411-EXIT. DTSCS46 02259 DTSCS46 02260 IF PAGE-BREAK-YES-88 DTSCS46 02261 PERFORM P7412-DISPLAY-PAGE-TRAILER THRU P7412-EXIT DTSCS46 02262 COMPUTE LINE-CNT = LINE-MAX + 1 DTSCS46 02263 SET APPEAL-ON-PAGE-NO-88 TO TRUE. DTSCS46 02264 DTSCS46 02265 DTSCS46 02266 MOVE SPACES TO XPTS-DATA. DTSCS46 02267 DTSCS46 02268 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02269 DTSCS46 02270 DTSCS46 02271 MOVE SPACES TO DBQTRDET. DTSCS46 02272 DTSCS46 02273 MOVE DB-QTR-YRQ (DB-QTR-IDX) TO WRK-DISPLAY. DTSCS46 02274 DTSCS46 02275 MOVE WRK-DISPLAY-QTR-BIG-YR TO DBQTRDET-QTR-YR. DTSCS46 02276 DTSCS46 02277 IF WRK-DISPLAY-QTR-BIG-Q = +0 DTSCS46 02278 MOVE '*' TO DBQTRDET-QTR-Q DTSCS46 02279 ELSE DTSCS46 02280 MOVE WRK-DISPLAY-QTR-BIG-Q TO DBQTRDET-QTR-Q. DTSCS46 02281 DTSCS46 02282 IF DB-QTR-YRQ (DB-QTR-IDX) = LCCM-PICKUP-YRQ DTSCS46 02283 MOVE '< 1993' TO DBQTRDET-YEAR-QTR. DTSCS46 02284 DTSCS46 02285 IF DB-QTR-APPEAL-YES-88 (DB-QTR-IDX) DTSCS46 02286 MOVE '*' TO DBQTRDET-APPEAL-IND DTSCS46 02287 SET APPEAL-ON-PAGE-YES-88 TO TRUE. DTSCS46 02288 DTSCS46 02289 IF DB-QTR-EST-RPT-YES-88 (DB-QTR-IDX) DTSCS46 02290 MOVE 'ESTIMATED REPORT ON FILE' DTSCS46 02291 TO DBQTRDET-STATUS DTSCS46 02292 ELSE DTSCS46 02293 MOVE DB-QTR-STATUS (DB-QTR-IDX) DTSCS46 02294 TO DBQTRDET-STATUS. DTSCS46 02295 DTSCS46 02296 IF DB-QTR-BALANCE-AMT (DB-QTR-IDX) > +0 DTSCS46 02297 MOVE DB-QTR-PAID-AMT (DB-QTR-IDX) DTSCS46 02298 TO DBQTRDET-PAID-AMT DTSCS46 02299 MOVE DB-QTR-BALANCE-AMT (DB-QTR-IDX) DTSCS46 02300 TO DBQTRDET-BALANCE-AMT. DTSCS46 02301 DTSCS46 02302 MOVE DBQTRDET TO XPTS-DATA. DTSCS46 02303 DTSCS46 02304 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02305 DTSCS46 02306 DTSCS46 02307 IF DB-QTR-EST-RPT-YES-88 (DB-QTR-IDX) DTSCS46 02308 IF DB-QTR-STATUS (DB-QTR-IDX) NOT = SPACES DTSCS46 02309 MOVE SPACE TO DBQTRDET DTSCS46 02310 MOVE DB-QTR-STATUS (DB-QTR-IDX) DTSCS46 02311 TO DBQTRDET-STATUS DTSCS46 02312 MOVE DBQTRDET TO XPTS-DATA DTSCS46 02313 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02314 P7410-EXIT. DTSCS46 02315 EXIT. DTSCS46 02316 SKIP3 DTSCS46 02317 P7411-EVALUATE-FOR-PAGE-BREAK. DTSCS46 02318 MOVE +2 TO LINES-REQUIRED-CNT. DTSCS46 02319 DTSCS46 02320 IF DB-QTR-EST-RPT-YES-88 (DB-QTR-IDX) DTSCS46 02321 IF DB-QTR-STATUS (DB-QTR-IDX) NOT = SPACES DTSCS46 02322 ADD +1 TO LINES-REQUIRED-CNT. DTSCS46 02323 DTSCS46 02324 IF DB-QTR-BALANCE-AMT (DB-QTR-IDX) > +0 DTSCS46 02325 SET AMT-DISPLAYED-YES-88 TO TRUE. DTSCS46 02326 DTSCS46 02327 SET WRK-CTR TO DB-QTR-IDX. DTSCS46 02328 DTSCS46 02329 IF (WRK-CTR = DB-QTR-CNT) DTSCS46 02330 AND DTSCS46 02331 (AMT-DISPLAYED-YES-88) DTSCS46 02332 ADD +3 TO LINES-REQUIRED-CNT. DTSCS46 02333 DTSCS46 02334 *****IF (APPEAL-ON-PAGE-YES-88) DTSCS46 02335 ***********OR DTSCS46 02336 ********(DB-QTR-APPEAL-YES-88 (DB-QTR-IDX)) DTSCS46 02337 ADD +3 TO LINES-REQUIRED-CNT. DTSCS46 02338 DTSCS46 02339 IF (LINE-CNT + LINES-REQUIRED-CNT) > LINE-MAX DTSCS46 02340 SET PAGE-BREAK-YES-88 TO TRUE. DTSCS46 02341 P7411-EXIT. DTSCS46 02342 EXIT. DTSCS46 02343 SKIP3 DTSCS46 02344 P7412-DISPLAY-PAGE-TRAILER. DTSCS46 02345 IF PAGE-CNT = +0 DTSCS46 02346 GO TO P7412-EXIT. DTSCS46 02347 DTSCS46 02348 DTSCS46 02349 COMPUTE WRK-CTR = LINE-MAX - LINE-CNT. DTSCS46 02350 DTSCS46 02351 SUBTRACT 1 FROM WRK-CTR. DTSCS46 02352 DTSCS46 02353 MOVE SPACES TO XPTS-DATA. DTSCS46 02354 DTSCS46 02355 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02356 WRK-CTR TIMES. DTSCS46 02357 DTSCS46 02358 DTSCS46 02359 IF APPEAL-ON-PAGE-YES-88 DTSCS46 02360 MOVE APPEAL-MSG DTSCS46 02361 TO DBQTRTRAIL-APPEAL-MSG DTSCS46 02362 ELSE DTSCS46 02363 MOVE SPACES TO DBQTRTRAIL-APPEAL-MSG. DTSCS46 02364 DTSCS46 02365 MOVE 'CONTINUED' TO DBQTRTRAIL-CONTINUED-MSG. DTSCS46 02366 DTSCS46 02367 MOVE DBQTRTRAIL TO XPTS-DATA. DTSCS46 02368 DTSCS46 02369 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT. DTSCS46 02370 P7412-EXIT. DTSCS46 02371 EXIT. DTSCS46 02372 EJECT DTSCS46 02373 P7910-FORMAT-HEADING. DTSCS46 02374 PERFORM S119-AGENCY-FACTS THRU S119-EXIT. DTSCS46 02375 DTSCS46 02376 MOVE CPRT-STROKE-WEIGHT-BOLD TO HEAD01-STROKE-WEIGHT-BOLD. DTSCS46 02377 DTSCS46 02378 MOVE L119-AGY-NAMEB1 TO HEAD01-AGY-NAMEB1. DTSCS46 02379 DTSCS46 02380 MOVE CPRT-STROKE-WEIGHT-REGULAR DTSCS46 02381 TO HEAD01-STROKE-WEIGHT-REGULAR. DTSCS46 02382 DTSCS46 02383 DTSCS46 02384 MOVE CPRT-STROKE-WEIGHT-BOLD DTSCS46 02385 TO HEAD02-STROKE-WEIGHT-BOLD. DTSCS46 02386 DTSCS46 02387 MOVE L119-AGY-NAMEB2 TO HEAD02-AGY-NAMEB2. DTSCS46 02388 DTSCS46 02389 DTSCS46 02390 MOVE L119-TAX-DIV-NAME TO HEAD03-TAX-DIV-NAME. DTSCS46 02391 DTSCS46 02392 DTSCS46 02393 MOVE L119-AGY-MAIL1 TO HEAD04-AGY-MAIL1. DTSCS46 02394 DTSCS46 02395 DTSCS46 02396 MOVE L119-AGY-MAIL2 TO HEAD05-AGY-MAIL2. DTSCS46 02397 DTSCS46 02398 DTSCS46 02399 IF (MPRF-PURSUED-RPT-CNT > +0) DTSCS46 02400 OR (MPRF-TOT-BALANCE-AMT > +0) DTSCS46 02401 PERFORM P7960-FIELD-REP-PHONE THRU P7960-EXIT DTSCS46 02402 ELSE DTSCS46 02403 PERFORM P7965-OPID-PHONE THRU P7965-EXIT. DTSCS46 02404 DTSCS46 02405 DTSCS46 02406 MOVE L119-UNIT-FAX TO INT-TEL. DTSCS46 02407 DTSCS46 02408 PERFORM P7911-INT-TO-DISP-TEL THRU P7911-EXIT. DTSCS46 02409 DTSCS46 02410 MOVE DISP-TEL TO HEAD06-AR-UNIT-FAX. DTSCS46 02411 DTSCS46 02412 DTSCS46 02413 MOVE CPRT-STROKE-WEIGHT-REGULAR DTSCS46 02414 TO HEAD09-STROKE-WEIGHT-REGULAR. DTSCS46 02415 P7910-EXIT. DTSCS46 02416 EXIT. DTSCS46 02417 DTSCS46 02418 DTSCS46 02419 DTSCS46 02420 P7911-INT-TO-DISP-TEL. DTSCS46 02421 MOVE INT-TEL-AREA-CD TO DISP-TEL-AREA-CD. DTSCS46 02422 DTSCS46 02423 MOVE INT-TEL-PREFIX TO DISP-TEL-PREFIX. DTSCS46 02424 DTSCS46 02425 MOVE INT-TEL-SUFFIX TO DISP-TEL-SUFFIX. DTSCS46 02426 P7911-EXIT. DTSCS46 02427 EXIT. DTSCS46 02428 DTSCS46 02429 DTSCS46 02430 DTSCS46 02431 P7920-FORMAT-ADDR. DTSCS46 02432 MOVE LCCM-SCR-HOLD-EMP-NO TO L111-EMP-NO. DTSCS46 02433 DTSCS46 02434 MOVE LCCM-SCR-HOLD-ADDR-TYPE TO MAP-ADDR-TYPE. DTSCS46 02435 DTSCS46 02436 IF MAP-ADDR-TAD-88 DTSCS46 02437 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS46 02438 ELSE DTSCS46 02439 IF MAP-ADDR-TAX-ALT-88 DTSCS46 02440 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS46 02441 ELSE DTSCS46 02442 IF MAP-ADDR-OPO-88 DTSCS46 02443 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS46 02444 ELSE DTSCS46 02445 SET L111-LOOKUP-TAD-88 TO TRUE. DTSCS46 02446 MOVE LCCM-SCR-HOLD-ADDR-ID-NO TO L111-ID-NO. DTSCS46 02447 DTSCS46 02448 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS46 02449 DTSCS46 02450 IF L111-ADDR-FOUND-88 DTSCS46 02451 PERFORM S112-ADDR-FORMAT THRU S112-EXIT DTSCS46 02452 ELSE DTSCS46 02453 MOVE ALL '?' TO L112-MAILING-ADDRESS. DTSCS46 02454 P7920-EXIT. DTSCS46 02455 EXIT. DTSCS46 02456 DTSCS46 02457 DTSCS46 02458 DTSCS46 02459 P7930-CONSTRUCT-FREE-TEXT. DTSCS46 02460 MOVE +0 TO FREE-TEXT-CNT. DTSCS46 02461 DTSCS46 02462 DTSCS46 02463 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS46 02464 DTSCS46 02465 MOVE LCCM-SCR-HOLD-EMP-NO TO MSKL-EMP-NO. DTSCS46 02466 DTSCS46 02467 SET MSKL-COL-88 TO TRUE. DTSCS46 02468 DTSCS46 02469 PERFORM S810-READ THRU S810-EXIT. DTSCS46 02470 DTSCS46 02471 IF L810-NO-REC-88 DTSCS46 02472 NEXT SENTENCE DTSCS46 02473 ELSE DTSCS46 02474 MOVE MSKL-REC TO MCOL-REC DTSCS46 02475 PERFORM P7931-MCOL-TEXT THRU P7931-EXIT. DTSCS46 02476 DTSCS46 02477 DTSCS46 02478 MOVE +0 TO WRK-CTR. DTSCS46 02479 DTSCS46 02480 PERFORM DTSCS46 02481 VARYING WRK-SCR-HOLD-NOTE-IDX FROM 1 BY 1 DTSCS46 02482 UNTIL WRK-SCR-HOLD-NOTE-IDX > TEXT-LINE-MAX DTSCS46 02483 IF WRK-SCR-HOLD-NOTE-LINE (WRK-SCR-HOLD-NOTE-IDX) DTSCS46 02484 NOT = SPACES DTSCS46 02485 SET WRK-CTR TO WRK-SCR-HOLD-NOTE-IDX DTSCS46 02486 END-IF DTSCS46 02487 END-PERFORM. DTSCS46 02488 DTSCS46 02489 IF WRK-CTR > +0 DTSCS46 02490 IF FREE-TEXT-CNT > +0 DTSCS46 02491 ADD +1 TO FREE-TEXT-CNT DTSCS46 02492 MOVE SPACES TO FREE-TEXT-LINE (FREE-TEXT-CNT) DTSCS46 02493 END-IF DTSCS46 02494 PERFORM DTSCS46 02495 VARYING WRK-SCR-HOLD-NOTE-IDX FROM 1 BY 1 DTSCS46 02496 UNTIL WRK-SCR-HOLD-NOTE-IDX > WRK-CTR DTSCS46 02497 ADD +1 TO FREE-TEXT-CNT DTSCS46 02498 MOVE WRK-SCR-HOLD-NOTE-LINE (WRK-SCR-HOLD-NOTE-IDX) DTSCS46 02499 TO FREE-TEXT-LINE (FREE-TEXT-CNT) DTSCS46 02500 END-PERFORM DTSCS46 02501 END-IF. DTSCS46 02502 P7930-EXIT. DTSCS46 02503 EXIT. DTSCS46 02504 DTSCS46 02505 DTSCS46 02506 DTSCS46 02507 P7931-MCOL-TEXT. DTSCS46 02508 IF (MCOL-STMT-TEXT-TYPE-CREDIT-88 DTSCS46 02509 AND LCCM-SCR-HOLD-CREDIT-88) DTSCS46 02510 OR DTSCS46 02511 (MCOL-STMT-TEXT-TYPE-DEBIT-88 DTSCS46 02512 AND LCCM-SCR-HOLD-DEBIT-88) DTSCS46 02513 NEXT SENTENCE DTSCS46 02514 ELSE DTSCS46 02515 GO TO P7931-EXIT. DTSCS46 02516 DTSCS46 02517 DTSCS46 02518 IF MCOL-STMT-TEXT-PERM-NO-88 DTSCS46 02519 SET LCCM-SCR-HOLD-MCOL-TEMP-YES-88 TO TRUE DTSCS46 02520 ELSE DTSCS46 02521 IF MCOL-STMT-TEXT-PERM-YES-88 DTSCS46 02522 SET LCCM-SCR-HOLD-MCOL-TEMP-NO-88 TO TRUE DTSCS46 02523 ELSE DTSCS46 02524 SET LCCM-SCR-HOLD-MCOL-TEMP-NO-88 TO TRUE. DTSCS46 02525 DTSCS46 02526 PERFORM DTSCS46 02527 VARYING MCOL-STMT-TEXT-IDX FROM 1 BY 1 DTSCS46 02528 UNTIL MCOL-STMT-TEXT-IDX > MCOL-STMT-TEXT-CNT DTSCS46 02529 ADD +1 TO FREE-TEXT-CNT DTSCS46 02530 MOVE MCOL-STMT-TEXT (MCOL-STMT-TEXT-IDX) DTSCS46 02531 TO FREE-TEXT-LINE (FREE-TEXT-CNT) DTSCS46 02532 END-PERFORM. DTSCS46 02533 P7931-EXIT. DTSCS46 02534 EXIT. DTSCS46 02535 DTSCS46 02536 DTSCS46 02537 DTSCS46 02538 P7940-WRITE-FREE-TEXT. DTSCS46 02539 PERFORM DTSCS46 02540 VARYING FREE-TEXT-IDX FROM 1 BY 1 DTSCS46 02541 UNTIL FREE-TEXT-IDX > FREE-TEXT-CNT DTSCS46 02542 MOVE FREE-TEXT-LINE (FREE-TEXT-IDX) DTSCS46 02543 TO FREENN-TEXT-AREA DTSCS46 02544 MOVE FREENN TO XPTS-DATA DTSCS46 02545 PERFORM P7970-WRITE-DETAIL THRU P7970-EXIT DTSCS46 02546 END-PERFORM. DTSCS46 02547 P7940-EXIT. DTSCS46 02548 EXIT. DTSCS46 02549 DTSCS46 02550 DTSCS46 02551 DTSCS46 02552 P7950-CONSTRUCT-APPEAL-TBL. DTSCS46 02553 MOVE ALL 'N' TO WRK-APPEAL-TBL. DTSCS46 02554 DTSCS46 02555 IF MPRF-MAPL-EXISTS-88 DTSCS46 02556 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS46 02557 MOVE LCCM-SCR-HOLD-EMP-NO TO MSKL-EMP-NO DTSCS46 02558 SET MSKL-APL-88 TO TRUE DTSCS46 02559 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS46 02560 PERFORM P7951-MAPL-SCAN THRU P7951-EXIT DTSCS46 02561 UNTIL L810-NO-REC-88. DTSCS46 02562 P7950-EXIT. DTSCS46 02563 EXIT. DTSCS46 02564 DTSCS46 02565 DTSCS46 02566 DTSCS46 02567 P7951-MAPL-SCAN. DTSCS46 02568 MOVE MSKL-REC TO MAPL-REC. DTSCS46 02569 DTSCS46 02570 IF MAPL-STATUS-OPEN-88 DTSCS46 02571 PERFORM DTSCS46 02572 VARYING MAPL-COV-IDX FROM 1 BY 1 DTSCS46 02573 UNTIL MAPL-COV-IDX > MAPL-COVERED-CNT DTSCS46 02574 MOVE MAPL-COVERED-YRQ (MAPL-COV-IDX) DTSCS46 02575 TO L004-QTR-5-9 DTSCS46 02576 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS46 02577 IF L004-VALID-QTR DTSCS46 02578 MOVE 'Y' TO WRK-APPEAL-IND (L004-ABS-QTR) DTSCS46 02579 END-IF DTSCS46 02580 END-PERFORM. DTSCS46 02581 DTSCS46 02582 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS46 02583 P7951-EXIT. DTSCS46 02584 EXIT. DTSCS46 02585 DTSCS46 02586 DTSCS46 02587 P7960-FIELD-REP-PHONE. DTSCS46 02588 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSCS46 02589 MOVE MPRF-FLD-ST TO L061-FLD-ST. DTSCS46 02590 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSCS46 02591 PERFORM S061-GET-FIELD-REP THRU S061-EXIT. DTSCS46 02592 IF NOT L061-OK DTSCS46 02593 MOVE SPACES TO L062-VOICE-1 DTSCS46 02594 GO TO P7960-EXIT. DTSCS46 02595 DTSCS46 02596 MOVE L061-FLD-REP-ID TO L062-FLD-REP-ID. DTSCS46 02597 PERFORM S062-FIELD-REP-INFO THRU S062-EXIT. DTSCS46 02598 DTSCS46 02599 MOVE L062-VOICE-1 TO INT-TEL. DTSCS46 02600 PERFORM P7911-INT-TO-DISP-TEL THRU P7911-EXIT. DTSCS46 02601 MOVE DISP-TEL TO HEAD06-AR-UNIT-VOICE. DTSCS46 02602 DTSCS46 02603 MOVE L062-NAME TO L071-NAM. DTSCS46 02604 DTSCS46 02605 PERFORM S071-NAME-CONVERT THRU S071-EXIT. DTSCS46 02606 DTSCS46 02607 MOVE L071-NAM TO L009-DATA. DTSCS46 02608 DTSCS46 02609 PERFORM S009-CONVERT-MIXED-CASE THRU S009-EXIT. DTSCS46 02610 DTSCS46 02611 MOVE L009-DATA TO DBOPID02-FIELD-REP-NAME. DTSCS46 02612 DTSCS46 02613 P7960-EXIT. DTSCS46 02614 EXIT. DTSCS46 02615 DTSCS46 02616 P7965-OPID-PHONE. DTSCS46 02617 MOVE LCCM-OP-VOICE TO INT-TEL. DTSCS46 02618 DTSCS46 02619 PERFORM P7911-INT-TO-DISP-TEL THRU P7911-EXIT. DTSCS46 02620 DTSCS46 02621 MOVE DISP-TEL TO HEAD06-AR-UNIT-VOICE. DTSCS46 02622 DTSCS46 02623 P7965-EXIT. DTSCS46 02624 EXIT. DTSCS46 02625 EJECT DTSCS46 02626 DTSCS46 02627 P7970-WRITE-DETAIL. DTSCS46 02628 IF LINE-CNT < LINE-MAX DTSCS46 02629 NEXT SENTENCE DTSCS46 02630 ELSE DTSCS46 02631 MOVE XPTS-DATA TO HOLD-XPTS-DATA DTSCS46 02632 PERFORM P7980-TOP-OF-PAGE THRU P7980-EXIT DTSCS46 02633 MOVE HOLD-XPTS-DATA TO XPTS-DATA. DTSCS46 02634 DTSCS46 02635 SET XPTS-SS-88 TO TRUE. DTSCS46 02636 DTSCS46 02637 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02638 P7970-EXIT. DTSCS46 02639 EXIT. DTSCS46 02640 DTSCS46 02641 DTSCS46 02642 DTSCS46 02643 P7980-TOP-OF-PAGE. DTSCS46 02644 ADD +1 TO PAGE-CNT. DTSCS46 02645 DTSCS46 02646 MOVE +0 TO LINE-CNT. DTSCS46 02647 DTSCS46 02648 DTSCS46 02649 SET XPTS-FF-88 TO TRUE. DTSCS46 02650 DTSCS46 02651 MOVE HEAD01 TO XPTS-DATA. DTSCS46 02652 DTSCS46 02653 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02654 DTSCS46 02655 DTSCS46 02656 SET XPTS-SS-88 TO TRUE. DTSCS46 02657 DTSCS46 02658 DTSCS46 02659 MOVE HEAD02 TO XPTS-DATA. DTSCS46 02660 DTSCS46 02661 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02662 DTSCS46 02663 DTSCS46 02664 MOVE HEAD03 TO XPTS-DATA. DTSCS46 02665 DTSCS46 02666 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02667 DTSCS46 02668 DTSCS46 02669 MOVE HEAD04 TO XPTS-DATA. DTSCS46 02670 DTSCS46 02671 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02672 DTSCS46 02673 DTSCS46 02674 MOVE HEAD05 TO XPTS-DATA. DTSCS46 02675 DTSCS46 02676 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02677 DTSCS46 02678 DTSCS46 02679 MOVE HEAD06 TO XPTS-DATA. DTSCS46 02680 DTSCS46 02681 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02682 DTSCS46 02683 DTSCS46 02684 MOVE SPACES TO XPTS-DATA. DTSCS46 02685 DTSCS46 02686 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02687 DTSCS46 02688 DTSCS46 02689 MOVE SPACES TO XPTS-DATA. DTSCS46 02690 DTSCS46 02691 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02692 DTSCS46 02693 DTSCS46 02694 MOVE HEAD09 TO XPTS-DATA. DTSCS46 02695 DTSCS46 02696 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02697 DTSCS46 02698 DTSCS46 02699 IF LCCM-SCR-HOLD-CREDIT-88 DTSCS46 02700 PERFORM P7981-CREDIT-TOP-OF-PAGE THRU P7981-EXIT DTSCS46 02701 ELSE DTSCS46 02702 PERFORM P7982-DEBIT-TOP-OF-PAGE THRU P7982-EXIT. DTSCS46 02703 P7980-EXIT. DTSCS46 02704 EXIT. DTSCS46 02705 DTSCS46 02706 DTSCS46 02707 DTSCS46 02708 P7981-CREDIT-TOP-OF-PAGE. DTSCS46 02709 MOVE SPACES TO XPTS-DATA. DTSCS46 02710 DTSCS46 02711 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02712 DTSCS46 02713 DTSCS46 02714 MOVE CRADDR01 TO XPTS-DATA. DTSCS46 02715 DTSCS46 02716 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02717 DTSCS46 02718 DTSCS46 02719 MOVE CRADDR02 TO XPTS-DATA. DTSCS46 02720 DTSCS46 02721 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02722 DTSCS46 02723 DTSCS46 02724 MOVE CRADDR03 TO XPTS-DATA. DTSCS46 02725 DTSCS46 02726 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02727 DTSCS46 02728 DTSCS46 02729 MOVE CRADDR04 TO XPTS-DATA. DTSCS46 02730 DTSCS46 02731 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02732 DTSCS46 02733 DTSCS46 02734 MOVE CRADDR05 TO XPTS-DATA. DTSCS46 02735 DTSCS46 02736 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02737 DTSCS46 02738 DTSCS46 02739 MOVE SPACES TO XPTS-DATA. DTSCS46 02740 DTSCS46 02741 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02742 DTSCS46 02743 DTSCS46 02744 MOVE SPACES TO XPTS-DATA. DTSCS46 02745 DTSCS46 02746 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02747 P7981-EXIT. DTSCS46 02748 EXIT. DTSCS46 02749 DTSCS46 02750 DTSCS46 02751 DTSCS46 02752 P7982-DEBIT-TOP-OF-PAGE. DTSCS46 02753 MOVE PAGE-CNT TO DBADDR01-PAGE-CURR. DTSCS46 02754 DTSCS46 02755 MOVE PAGE-LAST TO DBADDR01-PAGE-LAST. DTSCS46 02756 DTSCS46 02757 DTSCS46 02758 MOVE SPACES TO XPTS-DATA. DTSCS46 02759 DTSCS46 02760 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02761 DTSCS46 02762 DTSCS46 02763 MOVE DBADDR01 TO XPTS-DATA. DTSCS46 02764 DTSCS46 02765 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02766 DTSCS46 02767 DTSCS46 02768 MOVE DBADDR02 TO XPTS-DATA. DTSCS46 02769 DTSCS46 02770 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02771 DTSCS46 02772 DTSCS46 02773 MOVE DBADDR03 TO XPTS-DATA. DTSCS46 02774 DTSCS46 02775 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02776 DTSCS46 02777 DTSCS46 02778 MOVE DBADDR04 TO XPTS-DATA. DTSCS46 02779 DTSCS46 02780 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02781 DTSCS46 02782 DTSCS46 02783 MOVE DBADDR05 TO XPTS-DATA. DTSCS46 02784 DTSCS46 02785 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02786 DTSCS46 02787 DTSCS46 02788 MOVE DBPAYENC TO XPTS-DATA. DTSCS46 02789 DTSCS46 02790 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02791 DTSCS46 02792 DTSCS46 02793 MOVE SPACES TO XPTS-DATA. DTSCS46 02794 DTSCS46 02795 PERFORM P7990-WRITE-TS THRU P7990-EXIT DTSCS46 02796 2 TIMES. DTSCS46 02797 DTSCS46 02798 DTSCS46 02799 IF QTR-ON-PAGE-YES-88 DTSCS46 02800 MOVE DBQTRHEAD01 TO XPTS-DATA DTSCS46 02801 PERFORM P7990-WRITE-TS THRU P7990-EXIT DTSCS46 02802 MOVE DBQTRHEAD02 TO XPTS-DATA DTSCS46 02803 PERFORM P7990-WRITE-TS THRU P7990-EXIT. DTSCS46 02804 P7982-EXIT. DTSCS46 02805 EXIT. DTSCS46 02806 DTSCS46 02807 DTSCS46 02808 DTSCS46 02809 P7990-WRITE-TS. DTSCS46 02810 IF WRITE-TS-YES-88 DTSCS46 02811 PERFORM S829-WRITE-ITEM THRU S829-EXIT DTSCS46 02812 ADD +1 TO LCCM-SCR-HOLD-TS-ITEM-CNT. DTSCS46 02813 DTSCS46 02814 ADD +1 TO LINE-CNT. DTSCS46 02815 P7990-EXIT. DTSCS46 02816 EXIT. DTSCS46 02817 /*****************************************************************DTSCS46 02818 * THE PRINT FUNCTION WAS CONFIRMED OR CANCELED DTSCS46 02819 ******************************************************************DTSCS46 02820 DTSCS46 02821 P8000-REQUEST-UPDATE. DTSCS46 02822 IF LCCM-SCR-PRT-LOCKED DTSCS46 02823 PERFORM P8100-PRT THRU P8100-EXIT DTSCS46 02824 ELSE DTSCS46 02825 GO TO S899-ABEND. DTSCS46 02826 P8000-EXIT. DTSCS46 02827 EXIT. DTSCS46 02828 /*****************************************************************DTSCS46 02829 * *DTSCS46 02830 ******************************************************************DTSCS46 02831 DTSCS46 02832 P8100-PRT. DTSCS46 02833 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS46 02834 DTSCS46 02835 SET RESP-SEND-MAP TO TRUE. DTSCS46 02836 DTSCS46 02837 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS46 02838 DTSCS46 02839 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS46 02840 DTSCS46 02841 IF LCCM-F12-88 DTSCS46 02842 MOVE PMSG-PRINT-CANCELED TO LCCM-MSG-ID DTSCS46 02843 GO TO P8100-EXIT. DTSCS46 02844 DTSCS46 02845 DTSCS46 02846 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS46 02847 DTSCS46 02848 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS46 02849 DTSCS46 02850 IF LCCM-MSG DTSCS46 02851 GO TO P8100-EXIT. DTSCS46 02852 DTSCS46 02853 DTSCS46 02854 PERFORM P8110-SCREEN-Q-TO-PRINT-Q THRU P8110-EXIT. DTSCS46 02855 DTSCS46 02856 DTSCS46 02857 MOVE LCCM-PRINTER-ID TO L357-PRINTER-ID. DTSCS46 02858 DTSCS46 02859 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS46 02860 DTSCS46 02861 MOVE PRINT-QUEUE-NAME-SUFFIX TO L829-QUEUE-NAME-SUFFIX. DTSCS46 02862 DTSCS46 02863 MOVE L829-QUEUE-NAME TO L357-QUEUE-NAME. DTSCS46 02864 DTSCS46 02865 PERFORM S357-LINK-PRINT THRU S357-EXIT. DTSCS46 02866 DTSCS46 02867 IF L357-FAILED-88 DTSCS46 02868 NEXT SENTENCE DTSCS46 02869 ELSE DTSCS46 02870 PERFORM P8120-MASTER-UPDATE THRU P8120-EXIT. DTSCS46 02871 DTSCS46 02872 DTSCS46 02873 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS46 02874 DTSCS46 02875 DTSCS46 02876 IF L357-FAILED-88 DTSCS46 02877 MOVE EMSG-PRINTER-NOT-VALID TO WRK-MSG-AREA DTSCS46 02878 PERFORM S1899-ERROR THRU S1899-EXIT DTSCS46 02879 GO TO P8100-EXIT. DTSCS46 02880 DTSCS46 02881 DTSCS46 02882 MOVE MAP-COPIES TO WRK-COPIES. DTSCS46 02883 DTSCS46 02884 MOVE LOW-VALUES TO MAP-AREA. DTSCS46 02885 DTSCS46 02886 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS46 02887 DTSCS46 02888 MOVE LCCM-SCR-HOLD-EMP-NO TO WRK-DISPLAY. DTSCS46 02889 DTSCS46 02890 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS46 02891 DTSCS46 02892 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS46 02893 DTSCS46 02894 IF LCCM-F09-88 DTSCS46 02895 IF LCCM-SCR-HOLD-FROM-YRQ = +0 OR ALL-NINES-YRQ DTSCS46 02896 CONTINUE DTSCS46 02897 ELSE DTSCS46 02898 MOVE LCCM-SCR-HOLD-FROM-YRQ TO WRK-DISPLAY DTSCS46 02899 MOVE WRK-DISPLAY-QTR-YR TO MAP-YRQ-FROM-YR DTSCS46 02900 MOVE WRK-DISPLAY-QTR-Q TO MAP-YRQ-FROM-Q DTSCS46 02901 IF LCCM-SCR-HOLD-FROM-YRQ = LCCM-PICKUP-YRQ DTSCS46 02902 MOVE 'PU' TO MAP-YRQ-FROM-YR DTSCS46 02903 MOVE LOW-VALUES TO MAP-YRQ-FROM-Q DTSCS46 02904 END-IF DTSCS46 02905 END-IF DTSCS46 02906 IF LCCM-SCR-HOLD-TO-YRQ = +0 OR ALL-NINES-YRQ DTSCS46 02907 CONTINUE DTSCS46 02908 ELSE DTSCS46 02909 MOVE LCCM-SCR-HOLD-TO-YRQ TO WRK-DISPLAY DTSCS46 02910 MOVE WRK-DISPLAY-QTR-YR TO MAP-YRQ-TO-YR DTSCS46 02911 MOVE WRK-DISPLAY-QTR-Q TO MAP-YRQ-TO-Q DTSCS46 02912 IF LCCM-SCR-HOLD-TO-YRQ = LCCM-PICKUP-YRQ DTSCS46 02913 MOVE 'PU' TO MAP-YRQ-TO-YR DTSCS46 02914 MOVE LOW-VALUES TO MAP-YRQ-TO-Q DTSCS46 02915 END-IF DTSCS46 02916 END-IF DTSCS46 02917 MOVE LCCM-SCR-HOLD-COMP-DATE TO WRK-DISPLAY DTSCS46 02918 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO DTSCS46 02919 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA DTSCS46 02920 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR DTSCS46 02921 MOVE LCCM-SCR-HOLD-ADDR-TYPE TO MAP-ADDR-TYPE DTSCS46 02922 MOVE LCCM-SCR-HOLD-ADDR-ID-NO TO MAP-ADDR-ID-NO-Z DTSCS46 02923 IF MAP-ADDR-TAD-88 DTSCS46 02924 MOVE LOW-VALUES TO MAP-ADDR-ID-NO DTSCS46 02925 END-IF DTSCS46 02926 MOVE WRK-COPIES TO MAP-COPIES DTSCS46 02927 MOVE LCCM-PRINTER-ID TO MAP-PRINTER-ID DTSCS46 02928 MOVE LCCM-RESP-OP-ID TO MAP-RESP-OP-ID DTSCS46 02929 PERFORM DTSCS46 02930 VARYING WRK-CTR FROM 1 BY 1 DTSCS46 02931 UNTIL WRK-CTR > TEXT-LINE-MAX DTSCS46 02932 MOVE LCCM-SCR-HOLD-NOTE-LINE (WRK-CTR) DTSCS46 02933 TO MAP-NOTE-LINE (WRK-CTR) DTSCS46 02934 END-PERFORM DTSCS46 02935 END-IF. DTSCS46 02936 DTSCS46 02937 DTSCS46 02938 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS46 02939 DTSCS46 02940 DTSCS46 02941 MOVE SCREEN-QUEUE-NAME-SUFFIX TO WRK-QUEUE-NAME-SUFFIX. DTSCS46 02942 DTSCS46 02943 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS46 02944 DTSCS46 02945 MOVE PMSG-PRINT-SUCCESSFUL TO LCCM-MSG-ID. DTSCS46 02946 P8100-EXIT. DTSCS46 02947 EXIT. DTSCS46 02948 DTSCS46 02949 DTSCS46 02950 DTSCS46 02951 P8110-SCREEN-Q-TO-PRINT-Q. DTSCS46 02952 MOVE PRINT-QUEUE-NAME-SUFFIX TO WRK-QUEUE-NAME-SUFFIX. DTSCS46 02953 DTSCS46 02954 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCS46 02955 DTSCS46 02956 PERFORM DTSCS46 02957 MAP-COPIES-N TIMES DTSCS46 02958 PERFORM P8111-MOVE-TS-ITEM THRU P8111-EXIT DTSCS46 02959 VARYING WRK-CTR FROM 1 BY 1 DTSCS46 02960 UNTIL WRK-CTR > LCCM-SCR-HOLD-TS-ITEM-CNT DTSCS46 02961 END-PERFORM. DTSCS46 02962 P8110-EXIT. DTSCS46 02963 EXIT. DTSCS46 02964 DTSCS46 02965 DTSCS46 02966 DTSCS46 02967 P8111-MOVE-TS-ITEM. DTSCS46 02968 MOVE SCREEN-QUEUE-NAME-SUFFIX TO WRK-QUEUE-NAME-SUFFIX. DTSCS46 02969 DTSCS46 02970 MOVE WRK-CTR TO L829-ITEM-NO. DTSCS46 02971 DTSCS46 02972 PERFORM S829-READ-ITEM THRU S829-EXIT. DTSCS46 02973 DTSCS46 02974 IF L829-NO-REC-88 DTSCS46 02975 GO TO S899-ABEND. DTSCS46 02976 DTSCS46 02977 DTSCS46 02978 MOVE PRINT-QUEUE-NAME-SUFFIX TO WRK-QUEUE-NAME-SUFFIX. DTSCS46 02979 DTSCS46 02980 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCS46 02981 P8111-EXIT. DTSCS46 02982 EXIT. DTSCS46 02983 DTSCS46 02984 DTSCS46 02985 DTSCS46 02986 P8120-MASTER-UPDATE. DTSCS46 02987 MOVE LOW-VALUES TO MEVL-REC. DTSCS46 02988 DTSCS46 02989 DTSCS46 02990 MOVE LCCM-SCR-HOLD-EMP-NO TO MEVL-EMP-NO. DTSCS46 02991 DTSCS46 02992 SET MEVL-EVL-88 TO TRUE. DTSCS46 02993 DTSCS46 02994 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS46 02995 DTSCS46 02996 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS46 02997 DTSCS46 02998 MOVE +0 TO MEVL-PURGE-DATE. DTSCS46 02999 DTSCS46 03000 IF LCCM-SCR-HOLD-CREDIT-88 DTSCS46 03001 MOVE LCCM-SCR-HOLD-ADDR-TYPE TO EVL-CREDIT-ADDR-TYPE DTSCS46 03002 MOVE LCCM-SCR-HOLD-ADDR-ID-NO TO EVL-CREDIT-ADDR-ID-NO DTSCS46 03003 IF LCCM-SCR-HOLD-ADDR-TAD-88 DTSCS46 03004 MOVE SPACES TO EVL-CREDIT-ADDR-ID-NO-X DTSCS46 03005 END-IF DTSCS46 03006 COMPUTE EVL-CREDIT-AMT DTSCS46 03007 = LCCM-SCR-HOLD-TOT-AMT * -1 DTSCS46 03008 MOVE EVL-CREDIT-TEXT TO MEVL-TEXT DTSCS46 03009 ELSE DTSCS46 03010 IF LCCM-SCR-HOLD-DEBIT-88 DTSCS46 03011 MOVE LCCM-SCR-HOLD-ADDR-TYPE TO EVL-DEBIT-ADDR-TYPE DTSCS46 03012 MOVE LCCM-SCR-HOLD-ADDR-ID-NO TO EVL-DEBIT-ADDR-ID-NO DTSCS46 03013 IF LCCM-SCR-HOLD-ADDR-TAD-88 DTSCS46 03014 MOVE SPACES TO EVL-DEBIT-ADDR-ID-NO-X DTSCS46 03015 END-IF DTSCS46 03016 MOVE LCCM-SCR-HOLD-TOT-AMT TO EVL-DEBIT-AMT DTSCS46 03017 MOVE EVL-DEBIT-TEXT TO MEVL-TEXT DTSCS46 03018 ELSE DTSCS46 03019 GO TO S899-ABEND. DTSCS46 03020 DTSCS46 03021 MOVE LCCM-RESP-OP-ID TO MEVL-SOURCE DTSCS46 03022 DTSCS46 03023 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS46 03024 DTSCS46 03025 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS46 03026 MEVL-CHNG-DATE. DTSCS46 03027 DTSCS46 03028 MOVE MEVL-REC TO MSKL-REC. DTSCS46 03029 DTSCS46 03030 PERFORM S810-WRITE THRU S810-EXIT. DTSCS46 03031 DTSCS46 03032 DTSCS46 03033 IF LCCM-SCR-HOLD-MCOL-TEMP-NO-88 DTSCS46 03034 GO TO P8120-EXIT. DTSCS46 03035 DTSCS46 03036 DTSCS46 03037 MOVE LOW-VALUES TO MSKL-REC. DTSCS46 03038 DTSCS46 03039 MOVE LCCM-SCR-HOLD-EMP-NO TO MSKL-EMP-NO. DTSCS46 03040 DTSCS46 03041 SET MSKL-COL-88 TO TRUE. DTSCS46 03042 DTSCS46 03043 PERFORM S810-READ THRU S810-EXIT. DTSCS46 03044 DTSCS46 03045 IF L810-NO-REC-88 DTSCS46 03046 GO TO P8120-EXIT. DTSCS46 03047 DTSCS46 03048 DTSCS46 03049 MOVE MSKL-REC TO MCOL-REC. DTSCS46 03050 DTSCS46 03051 SET MCOL-STMT-TEXT-TYPE-NONE-88 TO TRUE. DTSCS46 03052 DTSCS46 03053 SET MCOL-STMT-TEXT-PERM-NONE-88 TO TRUE. DTSCS46 03054 DTSCS46 03055 MOVE +0 TO MCOL-STMT-TEXT-CNT. DTSCS46 03056 DTSCS46 03057 DTSCS46 03058 MOVE MCOL-REC TO MSKL-REC. DTSCS46 03059 DTSCS46 03060 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS46 03061 P8120-EXIT. DTSCS46 03062 EXIT. DTSCS46 03063 DTSCS46 03064 DTSCS46 03065 DTSCS46 03066 P8810-LOCK-EMPLOYER. DTSCS46 03067 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS46 03068 DTSCS46 03069 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS46 03070 DTSCS46 03071 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS46 03072 DTSCS46 03073 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS46 03074 DTSCS46 03075 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS46 03076 DTSCS46 03077 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS46 03078 DTSCS46 03079 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS46 03080 DTSCS46 03081 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS46 03082 DTSCS46 03083 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS46 03084 DTSCS46 03085 DTSCS46 03086 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS46 03087 P8810-EXIT. DTSCS46 03088 EXIT. DTSCS46 03089 /*****************************************************************DTSCS46 03090 * LINKS TO UTILITY MODULES DTSCS46 03091 ******************************************************************DTSCS46 03092 DTSCS46 03093 S001-FROM-FED-8. DTSCS46 03094 SET L001-FROM-FED-8 TO TRUE. DTSCS46 03095 GO TO S001-DATE. DTSCS46 03096 DTSCS46 03097 *S001-FROM-ABS-DATE. DTSCS46 03098 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS46 03099 *****GO TO S001-DATE. DTSCS46 03100 DTSCS46 03101 S001-DATE. DTSCS46 03102 EXEC CICS LINK DTSCS46 03103 PROGRAM('DTSCU001') DTSCS46 03104 COMMAREA(L001-COMM-AREA) DTSCS46 03105 END-EXEC. DTSCS46 03106 S001-EXIT. DTSCS46 03107 EXIT. DTSCS46 03108 DTSCS46 03109 DTSCS46 03110 DTSCS46 03111 S004-FROM-5. DTSCS46 03112 SET L004-FROM-5 TO TRUE. DTSCS46 03113 GO TO S004-YRQ. DTSCS46 03114 DTSCS46 03115 S004-FROM-ABS. DTSCS46 03116 SET L004-FROM-ABS TO TRUE. DTSCS46 03117 GO TO S004-YRQ. DTSCS46 03118 DTSCS46 03119 *S004-FROM-DATE. DTSCS46 03120 *****SET L004-FROM-DATE TO TRUE. DTSCS46 03121 *****GO TO S004-YRQ. DTSCS46 03122 DTSCS46 03123 S004-YRQ. DTSCS46 03124 EXEC CICS LINK DTSCS46 03125 PROGRAM('DTSCU004') DTSCS46 03126 COMMAREA(L004-COMM-AREA) DTSCS46 03127 END-EXEC. DTSCS46 03128 S004-EXIT. DTSCS46 03129 EXIT. DTSCS46 03130 DTSCS46 03131 DTSCS46 03132 DTSCS46 03133 S009-CONVERT-MIXED-CASE. DTSCS46 03134 EXEC CICS LINK DTSCS46 03135 PROGRAM('DTSCU009') DTSCS46 03136 COMMAREA(L009-COMM-AREA) DTSCS46 03137 END-EXEC. DTSCS46 03138 S009-EXIT. DTSCS46 03139 EXIT. DTSCS46 03140 DTSCS46 03141 DTSCS46 03142 DTSCS46 03143 S013-COUNT-FROM-SCREEN. DTSCS46 03144 EXEC CICS LINK DTSCS46 03145 PROGRAM ('DTSCU013') DTSCS46 03146 COMMAREA (L013-COMM-AREA) DTSCS46 03147 END-EXEC. DTSCS46 03148 S013-EXIT. DTSCS46 03149 EXIT. DTSCS46 03150 DTSCS46 03151 DTSCS46 03152 DTSCS46 03153 S015-DATE-FROM-SCREEN. DTSCS46 03154 EXEC CICS LINK DTSCS46 03155 PROGRAM ('DTSCU015') DTSCS46 03156 COMMAREA (L015-COMM-AREA) DTSCS46 03157 END-EXEC. DTSCS46 03158 S015-EXIT. DTSCS46 03159 EXIT. DTSCS46 03160 DTSCS46 03161 DTSCS46 03162 DTSCS46 03163 S018-EMP-NO-FROM-SCREEN. DTSCS46 03164 EXEC CICS LINK DTSCS46 03165 PROGRAM ('DTSCU018') DTSCS46 03166 COMMAREA (L018-COMM-AREA) DTSCS46 03167 END-EXEC. DTSCS46 03168 S018-EXIT. DTSCS46 03169 EXIT. DTSCS46 03170 DTSCS46 03171 DTSCS46 03172 DTSCS46 03173 S029-YRQ-FROM-SCREEN. DTSCS46 03174 EXEC CICS LINK DTSCS46 03175 PROGRAM ('DTSCU029') DTSCS46 03176 COMMAREA (L029-COMM-AREA) DTSCS46 03177 END-EXEC. DTSCS46 03178 S029-EXIT. DTSCS46 03179 EXIT. DTSCS46 03180 DTSCS46 03181 DTSCS46 03182 S061-GET-FIELD-REP. DTSCS46 03183 EXEC CICS LINK DTSCS46 03184 PROGRAM ('DTSCU061') DTSCS46 03185 COMMAREA (L061-COMM-AREA) DTSCS46 03186 END-EXEC. DTSCS46 03187 S061-EXIT. DTSCS46 03188 EXIT. DTSCS46 03189 DTSCS46 03190 DTSCS46 03191 S062-FIELD-REP-INFO. DTSCS46 03192 EXEC CICS LINK DTSCS46 03193 PROGRAM ('DTSCU062') DTSCS46 03194 COMMAREA (L062-COMM-AREA) DTSCS46 03195 END-EXEC. DTSCS46 03196 S062-EXIT. DTSCS46 03197 EXIT. DTSCS46 03198 DTSCS46 03199 S071-NAME-CONVERT. DTSCS46 03200 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS46 03201 DTSCS46 03202 EXEC CICS LINK DTSCS46 03203 PROGRAM ('DTSCU071') DTSCS46 03204 COMMAREA (L071-COMM-AREA) DTSCS46 03205 END-EXEC. DTSCS46 03206 S071-EXIT. DTSCS46 03207 EXIT. DTSCS46 03208 DTSCS46 03209 DTSCS46 03210 DTSCS46 03211 S082-OPID-LOOKUP. DTSCS46 03212 EXEC CICS LINK DTSCS46 03213 PROGRAM ('DTSCU082') DTSCS46 03214 COMMAREA (L082-COMM-AREA) DTSCS46 03215 END-EXEC. DTSCS46 03216 DTSCS46 03217 IF L082-FILE-CLOSED DTSCS46 03218 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03219 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS46 03220 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS46 03221 GO TO MAINLINE-EXIT. DTSCS46 03222 S082-EXIT. DTSCS46 03223 EXIT. DTSCS46 03224 DTSCS46 03225 DTSCS46 03226 DTSCS46 03227 S090-CONSTRUCT-PARAGRAPH. DTSCS46 03228 MOVE +0 TO L090-INDENT. DTSCS46 03229 SET L090-SPECIAL-CHAR-STD-88 TO TRUE. DTSCS46 03230 DTSCS46 03231 EXEC CICS LINK DTSCS46 03232 PROGRAM('DTSCU090') DTSCS46 03233 COMMAREA(L090-COMM-AREA) DTSCS46 03234 END-EXEC. DTSCS46 03235 S090-EXIT. DTSCS46 03236 EXIT. DTSCS46 03237 DTSCS46 03238 DTSCS46 03239 DTSCS46 03240 S101-PER-MONTH-NO. DTSCS46 03241 SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS46 03242 GO TO S101-INT-COMP. DTSCS46 03243 DTSCS46 03244 S101-INT-COMP. DTSCS46 03245 EXEC CICS LINK DTSCS46 03246 PROGRAM('DTSCU101') DTSCS46 03247 COMMAREA(L101-COMM-AREA) DTSCS46 03248 END-EXEC. DTSCS46 03249 S101-EXIT. DTSCS46 03250 EXIT. DTSCS46 03251 DTSCS46 03252 S109-SUR-TAX-QTR. DTSCS46 03253 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS46 03254 EXEC CICS LINK DTSCS46 03255 PROGRAM('DTSCU109') DTSCS46 03256 COMMAREA(L109-COMM-AREA) DTSCS46 03257 END-EXEC. DTSCS46 03258 S109-EXIT. DTSCS46 03259 EXIT. DTSCS46 03260 DTSCS46 03261 DTSCS46 03262 DTSCS46 03263 S111-ADDR-LOOKUP. DTSCS46 03264 EXEC CICS LINK DTSCS46 03265 PROGRAM ('DTSCU111') DTSCS46 03266 COMMAREA (L111-COMM-AREA) DTSCS46 03267 END-EXEC. DTSCS46 03268 DTSCS46 03269 IF L111-FILE-CLOSED-88 DTSCS46 03270 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03271 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS46 03272 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS46 03273 GO TO MAINLINE-EXIT. DTSCS46 03274 DTSCS46 03275 S111-EXIT. DTSCS46 03276 EXIT. DTSCS46 03277 DTSCS46 03278 DTSCS46 03279 DTSCS46 03280 S112-ADDR-FORMAT. DTSCS46 03281 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS46 03282 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS46 03283 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS46 03284 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS46 03285 DTSCS46 03286 EXEC CICS LINK DTSCS46 03287 PROGRAM('DTSCU112') DTSCS46 03288 COMMAREA(L112-COMM-AREA) DTSCS46 03289 END-EXEC. DTSCS46 03290 S112-EXIT. DTSCS46 03291 EXIT. DTSCS46 03292 DTSCS46 03293 DTSCS46 03294 DTSCS46 03295 S119-AGENCY-FACTS. DTSCS46 03296 SET L119-REQ-CAPS-88 TO TRUE. DTSCS46 03297 SET L119-REQ-COLLECTIONS-88 TO TRUE. DTSCS46 03298 DTSCS46 03299 EXEC CICS DTSCS46 03300 LINK DTSCS46 03301 PROGRAM ('DTSCU119') DTSCS46 03302 COMMAREA (L119-COMM-AREA) DTSCS46 03303 END-EXEC. DTSCS46 03304 S119-EXIT. DTSCS46 03305 EXIT. DTSCS46 03306 DTSCS46 03307 DTSCS46 03308 DTSCS46 03309 S221-EMP-LOCK. DTSCS46 03310 SET L221-START-UPDATE TO TRUE. DTSCS46 03311 GO TO S221-EMP-LOCK-UNLOCK. DTSCS46 03312 DTSCS46 03313 S221-EMP-UNLOCK. DTSCS46 03314 SET L221-END-UPDATE TO TRUE. DTSCS46 03315 GO TO S221-EMP-LOCK-UNLOCK. DTSCS46 03316 DTSCS46 03317 S221-EMP-LOCK-UNLOCK. DTSCS46 03318 EXEC CICS DTSCS46 03319 LINK DTSCS46 03320 PROGRAM ('DTSCU221') DTSCS46 03321 COMMAREA (L221-COMM-AREA) DTSCS46 03322 END-EXEC. DTSCS46 03323 DTSCS46 03324 IF L221-FILE-CLOSED DTSCS46 03325 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03326 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS46 03327 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS46 03328 GO TO MAINLINE-EXIT. DTSCS46 03329 DTSCS46 03330 IF L221-NOT-OK DTSCS46 03331 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS46 03332 S221-EXIT. DTSCS46 03333 EXIT. DTSCS46 03334 DTSCS46 03335 DTSCS46 03336 DTSCS46 03337 S356-LINK-PRINTER-CONTROL. DTSCS46 03338 EXEC CICS LINK DTSCS46 03339 PROGRAM ('DTSCU356') DTSCS46 03340 COMMAREA (L356-COMM-AREA) DTSCS46 03341 END-EXEC. DTSCS46 03342 S356-EXIT. DTSCS46 03343 EXIT. DTSCS46 03344 DTSCS46 03345 DTSCS46 03346 DTSCS46 03347 S357-LINK-PRINT. DTSCS46 03348 SET L357-EJECT-PAGE-88 TO TRUE. DTSCS46 03349 DTSCS46 03350 EXEC CICS LINK DTSCS46 03351 PROGRAM ('DTSCU357') DTSCS46 03352 COMMAREA (L357-COMM-AREA) DTSCS46 03353 END-EXEC. DTSCS46 03354 S357-EXIT. DTSCS46 03355 EXIT. DTSCS46 03356 DTSCS46 03357 DTSCS46 03358 DTSCS46 03359 S803-REQ-SCR-ID-EDIT. DTSCS46 03360 EXEC CICS LINK DTSCS46 03361 PROGRAM ('DTSCU803') DTSCS46 03362 COMMAREA (DFHCOMMAREA) DTSCS46 03363 END-EXEC. DTSCS46 03364 S803-EXIT. DTSCS46 03365 EXIT. DTSCS46 03366 DTSCS46 03367 DTSCS46 03368 DTSCS46 03369 S804-INVALID-KEY. DTSCS46 03370 EXEC CICS LINK DTSCS46 03371 PROGRAM ('DTSCU804') DTSCS46 03372 COMMAREA (DFHCOMMAREA) DTSCS46 03373 END-EXEC. DTSCS46 03374 S804-EXIT. DTSCS46 03375 EXIT. DTSCS46 03376 DTSCS46 03377 DTSCS46 03378 DTSCS46 03379 S805-MSG-AREA. DTSCS46 03380 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS46 03381 DTSCS46 03382 EXEC CICS LINK DTSCS46 03383 PROGRAM ('DTSCU805') DTSCS46 03384 COMMAREA (L805-COMM-AREA) DTSCS46 03385 END-EXEC. DTSCS46 03386 DTSCS46 03387 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS46 03388 S805-EXIT. DTSCS46 03389 EXIT. DTSCS46 03390 DTSCS46 03391 DTSCS46 03392 DTSCS46 03393 S810-READ. DTSCS46 03394 SET L810-READ-88 TO TRUE. DTSCS46 03395 GO TO S810-IO. DTSCS46 03396 DTSCS46 03397 S810-START-BROWSE. DTSCS46 03398 SET L810-START-BROWSE-88 TO TRUE. DTSCS46 03399 GO TO S810-IO. DTSCS46 03400 DTSCS46 03401 S810-READ-NEXT. DTSCS46 03402 SET L810-READ-NEXT-88 TO TRUE. DTSCS46 03403 GO TO S810-IO. DTSCS46 03404 DTSCS46 03405 S810-READ-PREV. DTSCS46 03406 SET L810-READ-PREV-88 TO TRUE. DTSCS46 03407 GO TO S810-IO. DTSCS46 03408 DTSCS46 03409 S810-END-BROWSE. DTSCS46 03410 SET L810-END-BROWSE-88 TO TRUE. DTSCS46 03411 GO TO S810-IO. DTSCS46 03412 DTSCS46 03413 S810-COUNT. DTSCS46 03414 SET L810-COUNT-88 TO TRUE. DTSCS46 03415 GO TO S810-IO. DTSCS46 03416 DTSCS46 03417 S810-REWRITE. DTSCS46 03418 SET L810-REWRITE-88 TO TRUE. DTSCS46 03419 GO TO S810-IO. DTSCS46 03420 DTSCS46 03421 S810-WRITE. DTSCS46 03422 SET L810-WRITE-88 TO TRUE. DTSCS46 03423 GO TO S810-IO. DTSCS46 03424 DTSCS46 03425 S810-READ-UPDATE. DTSCS46 03426 SET L810-READ-UPDATE-88 TO TRUE. DTSCS46 03427 GO TO S810-IO. DTSCS46 03428 DTSCS46 03429 S810-REWRITE-UPDATE. DTSCS46 03430 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS46 03431 GO TO S810-IO. DTSCS46 03432 DTSCS46 03433 S810-DELETE. DTSCS46 03434 SET L810-DELETE-88 TO TRUE. DTSCS46 03435 GO TO S810-IO. DTSCS46 03436 DTSCS46 03437 S810-IO. DTSCS46 03438 DTSCS46 03439 EXEC CICS LINK DTSCS46 03440 PROGRAM ('DTSCU810') DTSCS46 03441 COMMAREA (L810-COMM-AREA) DTSCS46 03442 END-EXEC. DTSCS46 03443 DTSCS46 03444 IF L810-FILE-CLOSED-88 DTSCS46 03445 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03446 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS46 03447 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS46 03448 GO TO MAINLINE-EXIT. DTSCS46 03449 S810-EXIT. DTSCS46 03450 EXIT. DTSCS46 03451 DTSCS46 03452 DTSCS46 03453 DTSCS46 03454 S829-READ-ITEM. DTSCS46 03455 SET L829-READ-ITEM-88 TO TRUE. DTSCS46 03456 GO TO S829-TS-IO. DTSCS46 03457 DTSCS46 03458 S829-READ-NEXT. DTSCS46 03459 SET L829-READ-NEXT-88 TO TRUE. DTSCS46 03460 GO TO S829-TS-IO. DTSCS46 03461 DTSCS46 03462 S829-WRITE-ITEM. DTSCS46 03463 SET L829-WRITE-88 TO TRUE. DTSCS46 03464 GO TO S829-TS-IO. DTSCS46 03465 DTSCS46 03466 S829-DELETE-QUEUE. DTSCS46 03467 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS46 03468 GO TO S829-TS-IO. DTSCS46 03469 DTSCS46 03470 S829-TS-IO. DTSCS46 03471 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS46 03472 DTSCS46 03473 MOVE WRK-QUEUE-NAME-SUFFIX TO L829-QUEUE-NAME-SUFFIX. DTSCS46 03474 DTSCS46 03475 MOVE TS-ITEM-LENGTH TO L829-REC-LENGTH. DTSCS46 03476 DTSCS46 03477 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS46 03478 DTSCS46 03479 EXEC CICS DTSCS46 03480 LINK DTSCS46 03481 PROGRAM ('DTSCU829') DTSCS46 03482 COMMAREA (L829-COMM-AREA) DTSCS46 03483 END-EXEC. DTSCS46 03484 S829-EXIT. DTSCS46 03485 EXIT. DTSCS46 03486 DTSCS46 03487 DTSCS46 03488 DTSCS46 03489 S851-SCREEN-PROCESSING. DTSCS46 03490 EXEC CICS LINK DTSCS46 03491 PROGRAM ('DTSCU851') DTSCS46 03492 COMMAREA (L851-COMM-AREA) DTSCS46 03493 END-EXEC. DTSCS46 03494 S851-EXIT. DTSCS46 03495 EXIT. DTSCS46 03496 DTSCS46 03497 DTSCS46 03498 DTSCS46 03499 S899-ABEND. DTSCS46 03500 EXEC CICS ABEND DTSCS46 03501 ABCODE(WRK-ABEND-CD) DTSCS46 03502 END-EXEC. DTSCS46 03503 S899-EXIT. DTSCS46 03504 EXIT. DTSCS46 03505 /*****************************************************************DTSCS46 03506 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS46 03507 ******************************************************************DTSCS46 03508 DTSCS46 03509 S1000-SCREEN-EDITS. DTSCS46 03510 MOVE LOW-VALUES TO WRK-SCR-HOLD-CONTROL-AREA. DTSCS46 03511 DTSCS46 03512 DTSCS46 03513 MOVE WRK-EMP-NO TO WRK-SCR-HOLD-EMP-NO. DTSCS46 03514 DTSCS46 03515 DTSCS46 03516 MOVE +0 TO WRK-SCR-HOLD-FROM-YRQ DTSCS46 03517 WRK-SCR-HOLD-TO-YRQ DTSCS46 03518 WRK-SCR-HOLD-COMP-DATE DTSCS46 03519 WRK-SCR-HOLD-ADDR-ID-NO. DTSCS46 03520 DTSCS46 03521 DTSCS46 03522 MOVE SPACE TO WRK-SCR-HOLD-ADDR-TYPE DTSCS46 03523 WRK-SCR-HOLD-RESP-OP-ID DTSCS46 03524 WRK-SCR-HOLD-NOTE-LINES. DTSCS46 03525 DTSCS46 03526 PERFORM S1200-FROM-YRQ THRU S1200-EXIT. DTSCS46 03527 DTSCS46 03528 PERFORM S1300-TO-YRQ THRU S1300-EXIT. DTSCS46 03529 DTSCS46 03530 PERFORM S1400-COMP-DATE THRU S1400-EXIT. DTSCS46 03531 DTSCS46 03532 PERFORM S1500-ADDR-TYPE THRU S1500-EXIT. DTSCS46 03533 DTSCS46 03534 PERFORM S1600-ADDR-ID-NO THRU S1600-EXIT. DTSCS46 03535 DTSCS46 03536 PERFORM S1700-COPIES THRU S1700-EXIT. DTSCS46 03537 DTSCS46 03538 PERFORM S1800-PRINTER-ID THRU S1800-EXIT. DTSCS46 03539 DTSCS46 03540 PERFORM S1900-RESP-OP-ID THRU S1900-EXIT. DTSCS46 03541 DTSCS46 03542 PERFORM S2100-NOTE-LINE THRU S2100-EXIT DTSCS46 03543 VARYING WRK-CTR FROM 1 BY 1 DTSCS46 03544 UNTIL WRK-CTR > TEXT-LINE-MAX. DTSCS46 03545 S1000-EXIT. DTSCS46 03546 EXIT. DTSCS46 03547 EJECT DTSCS46 03548 S1100-EDIT-KEY. DTSCS46 03549 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS46 03550 S1100-EXIT. DTSCS46 03551 EXIT. DTSCS46 03552 DTSCS46 03553 DTSCS46 03554 DTSCS46 03555 S1101-EMP-NO. DTSCS46 03556 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS46 03557 DTSCS46 03558 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS46 03559 DTSCS46 03560 IF L018-NO-ENTRY DTSCS46 03561 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS46 03562 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS46 03563 GO TO S1101-EXIT. DTSCS46 03564 DTSCS46 03565 IF L018-NOT-VALID DTSCS46 03566 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03567 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS46 03568 GO TO S1101-EXIT. DTSCS46 03569 DTSCS46 03570 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS46 03571 DTSCS46 03572 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS46 03573 S1101-EXIT. DTSCS46 03574 EXIT. DTSCS46 03575 DTSCS46 03576 DTSCS46 03577 DTSCS46 03578 S1110-READ-MPRF. DTSCS46 03579 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS46 03580 DTSCS46 03581 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS46 03582 DTSCS46 03583 SET MPRF-PRF-88 TO TRUE. DTSCS46 03584 DTSCS46 03585 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS46 03586 DTSCS46 03587 PERFORM S810-READ THRU S810-EXIT. DTSCS46 03588 DTSCS46 03589 IF L810-NO-REC-88 DTSCS46 03590 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS46 03591 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS46 03592 ELSE DTSCS46 03593 MOVE MSKL-REC TO MPRF-REC DTSCS46 03594 SET WRK-MPRF-YES-88 TO TRUE. DTSCS46 03595 S1110-EXIT. DTSCS46 03596 EXIT. DTSCS46 03597 DTSCS46 03598 DTSCS46 03599 S1199-ERROR. DTSCS46 03600 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS46 03601 MAP-EMP-NO-2-A. DTSCS46 03602 IF LCCM-NO-MSG DTSCS46 03603 SET CURSOR-SET-YES TO TRUE DTSCS46 03604 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03605 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS46 03606 S1199-EXIT. DTSCS46 03607 EXIT. DTSCS46 03608 /*****************************************************************DTSCS46 03609 * *DTSCS46 03610 ******************************************************************DTSCS46 03611 S1200-FROM-YRQ. DTSCS46 03612 MOVE MAP-YRQ-FROM-AREA TO L029-S-YRQ-AREA. DTSCS46 03613 DTSCS46 03614 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS46 03615 DTSCS46 03616 IF L029-NO-ENTRY DTSCS46 03617 NEXT SENTENCE DTSCS46 03618 ELSE DTSCS46 03619 IF L029-VALID DTSCS46 03620 MOVE L029-YRQ TO WRK-SCR-HOLD-FROM-YRQ DTSCS46 03621 ELSE DTSCS46 03622 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03623 PERFORM S1299-ERROR THRU S1299-EXIT. DTSCS46 03624 S1200-EXIT. DTSCS46 03625 EXIT. DTSCS46 03626 DTSCS46 03627 DTSCS46 03628 DTSCS46 03629 S1299-ERROR. DTSCS46 03630 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-FROM-YR-A DTSCS46 03631 MAP-YRQ-FROM-Q-A. DTSCS46 03632 DTSCS46 03633 IF LCCM-NO-MSG DTSCS46 03634 SET CURSOR-SET-YES TO TRUE DTSCS46 03635 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03636 MOVE CATB-CURSOR TO MAP-YRQ-FROM-YR-L. DTSCS46 03637 S1299-EXIT. DTSCS46 03638 EXIT. DTSCS46 03639 /*****************************************************************DTSCS46 03640 * *DTSCS46 03641 ******************************************************************DTSCS46 03642 S1300-TO-YRQ. DTSCS46 03643 MOVE MAP-YRQ-TO-AREA TO L029-S-YRQ-AREA. DTSCS46 03644 DTSCS46 03645 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS46 03646 DTSCS46 03647 IF L029-NO-ENTRY DTSCS46 03648 MOVE ALL-NINES-YRQ TO WRK-SCR-HOLD-TO-YRQ DTSCS46 03649 ELSE DTSCS46 03650 IF L029-VALID DTSCS46 03651 MOVE L029-YRQ TO WRK-SCR-HOLD-TO-YRQ DTSCS46 03652 ELSE DTSCS46 03653 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03654 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS46 03655 DTSCS46 03656 IF (MAP-YRQ-FROM-YR-A = CATB-UNPROT-NORM-AN-MDTON) DTSCS46 03657 OR DTSCS46 03658 (MAP-YRQ-TO-YR-A = CATB-UNPROT-NORM-AN-MDTON) DTSCS46 03659 NEXT SENTENCE DTSCS46 03660 ELSE DTSCS46 03661 PERFORM S1310-TO-FROM-CROSS-EDITS THRU S1310-EXIT. DTSCS46 03662 S1300-EXIT. DTSCS46 03663 EXIT. DTSCS46 03664 DTSCS46 03665 DTSCS46 03666 DTSCS46 03667 S1310-TO-FROM-CROSS-EDITS. DTSCS46 03668 IF (WRK-SCR-HOLD-FROM-YRQ = +0) DTSCS46 03669 AND DTSCS46 03670 (WRK-SCR-HOLD-TO-YRQ = ALL-NINES-YRQ) DTSCS46 03671 GO TO S1310-EXIT. DTSCS46 03672 DTSCS46 03673 DTSCS46 03674 IF WRK-SCR-HOLD-FROM-YRQ = +0 DTSCS46 03675 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS46 03676 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS46 03677 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS46 03678 DTSCS46 03679 DTSCS46 03680 IF WRK-SCR-HOLD-TO-YRQ = ALL-NINES-YRQ DTSCS46 03681 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS46 03682 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS46 03683 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS46 03684 DTSCS46 03685 DTSCS46 03686 IF WRK-SCR-HOLD-TO-YRQ < WRK-SCR-HOLD-FROM-YRQ DTSCS46 03687 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS46 03688 PERFORM S1299-ERROR THRU S1299-EXIT DTSCS46 03689 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS46 03690 S1310-EXIT. DTSCS46 03691 EXIT. DTSCS46 03692 DTSCS46 03693 DTSCS46 03694 DTSCS46 03695 S1399-ERROR. DTSCS46 03696 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-TO-YR-A DTSCS46 03697 MAP-YRQ-TO-Q-A. DTSCS46 03698 DTSCS46 03699 IF LCCM-NO-MSG DTSCS46 03700 SET CURSOR-SET-YES TO TRUE DTSCS46 03701 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03702 MOVE CATB-CURSOR TO MAP-YRQ-TO-YR-L. DTSCS46 03703 S1399-EXIT. DTSCS46 03704 EXIT. DTSCS46 03705 /*****************************************************************DTSCS46 03706 * *DTSCS46 03707 ******************************************************************DTSCS46 03708 S1400-COMP-DATE. DTSCS46 03709 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS46 03710 DTSCS46 03711 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS46 03712 DTSCS46 03713 DTSCS46 03714 IF MAP-COMP-MO = '99' DTSCS46 03715 AND MAP-COMP-DA = '99' DTSCS46 03716 AND MAP-COMP-YR = '99' DTSCS46 03717 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS46 03718 WRK-SCR-HOLD-COMP-DATE DTSCS46 03719 GO TO S1400-EXIT. DTSCS46 03720 DTSCS46 03721 DTSCS46 03722 IF L015-NO-ENTRY DTSCS46 03723 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS46 03724 WRK-SCR-HOLD-COMP-DATE DTSCS46 03725 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO DTSCS46 03726 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA DTSCS46 03727 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR DTSCS46 03728 ELSE DTSCS46 03729 IF L015-NOT-VALID DTSCS46 03730 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03731 PERFORM S1499-ERROR THRU S1499-EXIT DTSCS46 03732 ELSE DTSCS46 03733 MOVE L015-DATE TO LCCM-COMP-DATE DTSCS46 03734 WRK-SCR-HOLD-COMP-DATE. DTSCS46 03735 S1400-EXIT. DTSCS46 03736 EXIT. DTSCS46 03737 DTSCS46 03738 DTSCS46 03739 DTSCS46 03740 S1499-ERROR. DTSCS46 03741 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COMP-MO-A DTSCS46 03742 MAP-COMP-DA-A DTSCS46 03743 MAP-COMP-YR-A. DTSCS46 03744 DTSCS46 03745 IF LCCM-NO-MSG DTSCS46 03746 SET CURSOR-SET-YES TO TRUE DTSCS46 03747 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03748 MOVE CATB-CURSOR TO MAP-COMP-MO-L. DTSCS46 03749 S1499-EXIT. DTSCS46 03750 EXIT. DTSCS46 03751 /*****************************************************************DTSCS46 03752 * *DTSCS46 03753 ******************************************************************DTSCS46 03754 S1500-ADDR-TYPE. DTSCS46 03755 IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS46 03756 SET MAP-ADDR-TAX-88 TO TRUE DTSCS46 03757 ELSE DTSCS46 03758 IF MAP-ADDR-VALID-88 DTSCS46 03759 NEXT SENTENCE DTSCS46 03760 ELSE DTSCS46 03761 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03762 PERFORM S1599-ERROR THRU S1599-EXIT. DTSCS46 03763 DTSCS46 03764 MOVE MAP-ADDR-TYPE TO WRK-SCR-HOLD-ADDR-TYPE. DTSCS46 03765 S1500-EXIT. DTSCS46 03766 EXIT. DTSCS46 03767 DTSCS46 03768 DTSCS46 03769 DTSCS46 03770 S1599-ERROR. DTSCS46 03771 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS46 03772 DTSCS46 03773 IF LCCM-NO-MSG DTSCS46 03774 SET CURSOR-SET-YES TO TRUE DTSCS46 03775 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03776 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L. DTSCS46 03777 S1599-EXIT. DTSCS46 03778 EXIT. DTSCS46 03779 /*****************************************************************DTSCS46 03780 * *DTSCS46 03781 ******************************************************************DTSCS46 03782 S1600-ADDR-ID-NO. DTSCS46 03783 INSPECT MAP-ADDR-ID-NO DTSCS46 03784 CONVERTING LOW-VALUES TO SPACES. DTSCS46 03785 DTSCS46 03786 DTSCS46 03787 IF MAP-ADDR-ID-NO = SPACES DTSCS46 03788 IF MAP-ADDR-TAD-88 DTSCS46 03789 IF MAP-ADDR-TAX-88 DTSCS46 03790 MOVE +1 TO L013-CNT DTSCS46 03791 ELSE DTSCS46 03792 MOVE +2 TO L013-CNT DTSCS46 03793 END-IF DTSCS46 03794 PERFORM S1610-ADDR-LOOKUP THRU S1610-EXIT DTSCS46 03795 GO TO S1600-EXIT DTSCS46 03796 ELSE DTSCS46 03797 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS46 03798 PERFORM S1699-ERROR THRU S1699-EXIT DTSCS46 03799 GO TO S1600-EXIT. DTSCS46 03800 DTSCS46 03801 DTSCS46 03802 IF MAP-ADDR-TAD-88 DTSCS46 03803 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS46 03804 PERFORM S1699-ERROR THRU S1699-EXIT DTSCS46 03805 GO TO S1600-EXIT. DTSCS46 03806 DTSCS46 03807 DTSCS46 03808 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS46 03809 DTSCS46 03810 MOVE +1 TO L013-MIN-CNT. DTSCS46 03811 DTSCS46 03812 MOVE +999 TO L013-MAX-CNT. DTSCS46 03813 DTSCS46 03814 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS46 03815 DTSCS46 03816 IF L013-VALID DTSCS46 03817 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS46 03818 PERFORM S1610-ADDR-LOOKUP THRU S1610-EXIT DTSCS46 03819 ELSE DTSCS46 03820 IF L013-NO-ENTRY DTSCS46 03821 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS46 03822 PERFORM S1699-ERROR THRU S1699-EXIT DTSCS46 03823 ELSE DTSCS46 03824 IF L013-INVALID-NEGATIVE DTSCS46 03825 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS46 03826 PERFORM S1699-ERROR THRU S1699-EXIT DTSCS46 03827 ELSE DTSCS46 03828 IF L013-EXCEEDS-MIN-MAX DTSCS46 03829 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS46 03830 PERFORM S1699-ERROR THRU S1699-EXIT DTSCS46 03831 ELSE DTSCS46 03832 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03833 PERFORM S1699-ERROR THRU S1699-EXIT. DTSCS46 03834 S1600-EXIT. DTSCS46 03835 EXIT. DTSCS46 03836 DTSCS46 03837 DTSCS46 03838 DTSCS46 03839 S1610-ADDR-LOOKUP. DTSCS46 03840 IF WRK-MPRF-NO-88 DTSCS46 03841 GO TO S1610-EXIT. DTSCS46 03842 DTSCS46 03843 DTSCS46 03844 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS46 03845 DTSCS46 03846 IF MAP-ADDR-TAD-88 DTSCS46 03847 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS46 03848 ELSE DTSCS46 03849 IF MAP-ADDR-TAX-ALT-88 DTSCS46 03850 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS46 03851 ELSE DTSCS46 03852 IF MAP-ADDR-OPO-88 DTSCS46 03853 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS46 03854 ELSE DTSCS46 03855 GO TO S1610-EXIT. DTSCS46 03856 DTSCS46 03857 MOVE L013-CNT TO L111-ID-NO. DTSCS46 03858 DTSCS46 03859 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS46 03860 DTSCS46 03861 IF L111-ADDR-NOT-FOUND-88 DTSCS46 03862 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS46 03863 PERFORM S1699-ERROR THRU S1699-EXIT DTSCS46 03864 GO TO S1610-EXIT. DTSCS46 03865 DTSCS46 03866 MOVE L013-CNT TO WRK-SCR-HOLD-ADDR-ID-NO. DTSCS46 03867 S1610-EXIT. DTSCS46 03868 EXIT. DTSCS46 03869 DTSCS46 03870 DTSCS46 03871 DTSCS46 03872 S1699-ERROR. DTSCS46 03873 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A. DTSCS46 03874 DTSCS46 03875 IF LCCM-NO-MSG DTSCS46 03876 SET CURSOR-SET-YES TO TRUE DTSCS46 03877 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03878 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L. DTSCS46 03879 S1699-EXIT. DTSCS46 03880 EXIT. DTSCS46 03881 /*****************************************************************DTSCS46 03882 * *DTSCS46 03883 ******************************************************************DTSCS46 03884 S1700-COPIES. DTSCS46 03885 IF MAP-COPIES = LOW-VALUES OR SPACES DTSCS46 03886 SET MAP-COPIES-DEFAULT-88 TO TRUE. DTSCS46 03887 DTSCS46 03888 IF MAP-COPIES-VALID-88 DTSCS46 03889 NEXT SENTENCE DTSCS46 03890 ELSE DTSCS46 03891 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03892 PERFORM S1799-ERROR THRU S1799-EXIT. DTSCS46 03893 S1700-EXIT. DTSCS46 03894 EXIT. DTSCS46 03895 DTSCS46 03896 DTSCS46 03897 DTSCS46 03898 S1799-ERROR. DTSCS46 03899 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPIES-A. DTSCS46 03900 DTSCS46 03901 IF LCCM-NO-MSG DTSCS46 03902 SET CURSOR-SET-YES TO TRUE DTSCS46 03903 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03904 MOVE CATB-CURSOR TO MAP-COPIES-L. DTSCS46 03905 S1799-EXIT. DTSCS46 03906 EXIT. DTSCS46 03907 /*****************************************************************DTSCS46 03908 * *DTSCS46 03909 ******************************************************************DTSCS46 03910 S1800-PRINTER-ID. DTSCS46 03911 IF MAP-PRINTER-ID = LOW-VALUES OR SPACES DTSCS46 03912 MOVE LCCM-PRINTER-ID TO MAP-PRINTER-ID DTSCS46 03913 ELSE DTSCS46 03914 MOVE MAP-PRINTER-ID TO LCCM-PRINTER-ID. DTSCS46 03915 S1800-EXIT. DTSCS46 03916 EXIT. DTSCS46 03917 DTSCS46 03918 DTSCS46 03919 DTSCS46 03920 S1899-ERROR. DTSCS46 03921 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRINTER-ID-A. DTSCS46 03922 DTSCS46 03923 IF LCCM-NO-MSG DTSCS46 03924 SET CURSOR-SET-YES TO TRUE DTSCS46 03925 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03926 MOVE CATB-CURSOR TO MAP-PRINTER-ID-L. DTSCS46 03927 S1899-EXIT. DTSCS46 03928 EXIT. DTSCS46 03929 /*****************************************************************DTSCS46 03930 * *DTSCS46 03931 ******************************************************************DTSCS46 03932 S1900-RESP-OP-ID. DTSCS46 03933 IF MAP-RESP-OP-ID = LOW-VALUES OR SPACES DTSCS46 03934 MOVE LCCM-RESP-OP-ID TO MAP-RESP-OP-ID. DTSCS46 03935 DTSCS46 03936 IF MAP-RESP-OP-ID = LCCM-OP-ID DTSCS46 03937 MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID DTSCS46 03938 WRK-SCR-HOLD-RESP-OP-ID DTSCS46 03939 GO TO S1900-EXIT. DTSCS46 03940 DTSCS46 03941 MOVE MAP-RESP-OP-ID TO L082-OP-ID. DTSCS46 03942 DTSCS46 03943 PERFORM S082-OPID-LOOKUP THRU S082-EXIT. DTSCS46 03944 DTSCS46 03945 IF (L082-VALID-OP) DTSCS46 03946 AND DTSCS46 03947 (L082-EXTERNAL-88) DTSCS46 03948 MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID DTSCS46 03949 WRK-SCR-HOLD-RESP-OP-ID DTSCS46 03950 ELSE DTSCS46 03951 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS46 03952 PERFORM S1999-ERROR THRU S1999-EXIT. DTSCS46 03953 S1900-EXIT. DTSCS46 03954 EXIT. DTSCS46 03955 DTSCS46 03956 DTSCS46 03957 DTSCS46 03958 S1999-ERROR. DTSCS46 03959 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESP-OP-ID-A. DTSCS46 03960 DTSCS46 03961 IF LCCM-NO-MSG DTSCS46 03962 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS46 03963 MOVE CATB-CURSOR TO MAP-RESP-OP-ID-L DTSCS46 03964 SET CURSOR-SET-YES TO TRUE. DTSCS46 03965 S1999-EXIT. DTSCS46 03966 EXIT. DTSCS46 03967 /*****************************************************************DTSCS46 03968 * *DTSCS46 03969 ******************************************************************DTSCS46 03970 S2100-NOTE-LINE. DTSCS46 03971 INSPECT MAP-NOTE-LINE (WRK-CTR) DTSCS46 03972 CONVERTING LOW-VALUES TO SPACES. DTSCS46 03973 DTSCS46 03974 MOVE MAP-NOTE-LINE (WRK-CTR) DTSCS46 03975 TO WRK-SCR-HOLD-NOTE-LINE (WRK-CTR). DTSCS46 03976 S2100-EXIT. DTSCS46 03977 EXIT. DTSCS46 03978 /*****************************************************************DTSCS46 03979 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS46 03980 ******************************************************************DTSCS46 03981 DTSCS46 03982 S5100-SET-LOCK-ATTRB. DTSCS46 03983 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS46 03984 WRK-ATB-NUM. DTSCS46 03985 DTSCS46 03986 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS46 03987 DTSCS46 03988 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS46 03989 MAP-EMP-NO-2-A DTSCS46 03990 MAP-GOTO-A. DTSCS46 03991 S5100-EXIT. DTSCS46 03992 EXIT. DTSCS46 03993 DTSCS46 03994 DTSCS46 03995 DTSCS46 03996 ******************************************************************DTSCS46 03997 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS46 03998 ******************************************************************DTSCS46 03999 DTSCS46 04000 S5200-SET-UPDATE-ATTRB. DTSCS46 04001 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS46 04002 DTSCS46 04003 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS46 04004 DTSCS46 04005 DTSCS46 04006 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS46 04007 S5200-EXIT. DTSCS46 04008 EXIT. DTSCS46 04009 DTSCS46 04010 DTSCS46 04011 DTSCS46 04012 ******************************************************************DTSCS46 04013 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS46 04014 ******************************************************************DTSCS46 04015 DTSCS46 04016 S5300-SET-INQ-ATTRB. DTSCS46 04017 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS46 04018 DTSCS46 04019 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS46 04020 DTSCS46 04021 DTSCS46 04022 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS46 04023 S5300-EXIT. DTSCS46 04024 EXIT. DTSCS46 04025 DTSCS46 04026 DTSCS46 04027 DTSCS46 04028 S5900-SET-ATTRB. DTSCS46 04029 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS46 04030 MAP-EMP-NO-2-A. DTSCS46 04031 DTSCS46 04032 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS46 04033 MAP-CURR-PAGE-A DTSCS46 04034 MAP-LAST-PAGE-A. DTSCS46 04035 DTSCS46 04036 MOVE WRK-ATB-AN TO MAP-YRQ-FROM-YR-A DTSCS46 04037 MAP-YRQ-FROM-Q-A DTSCS46 04038 MAP-YRQ-TO-YR-A DTSCS46 04039 MAP-YRQ-TO-Q-A. DTSCS46 04040 DTSCS46 04041 MOVE CATB-ASKIP-BRT-MDTON TO MAP-TOT-DUE-AMT-A. DTSCS46 04042 DTSCS46 04043 MOVE WRK-ATB-NUM TO MAP-COMP-MO-A DTSCS46 04044 MAP-COMP-DA-A DTSCS46 04045 MAP-COMP-YR-A. DTSCS46 04046 DTSCS46 04047 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PURSUED-RPTS-CNT-A. DTSCS46 04048 DTSCS46 04049 MOVE WRK-ATB-AN TO MAP-ADDR-TYPE-A. DTSCS46 04050 DTSCS46 04051 MOVE WRK-ATB-NUM TO MAP-ADDR-ID-NO-A. DTSCS46 04052 DTSCS46 04053 MOVE WRK-ATB-NUM TO MAP-COPIES-A. DTSCS46 04054 DTSCS46 04055 MOVE WRK-ATB-AN TO MAP-PRINTER-ID-A. DTSCS46 04056 DTSCS46 04057 MOVE WRK-ATB-AN TO MAP-RESP-OP-ID-A. DTSCS46 04058 DTSCS46 04059 MOVE CATB-ASKIP-NORM-MDTON TO MAP-RESP-OP-ID-DSCR-A. DTSCS46 04060 DTSCS46 04061 PERFORM DTSCS46 04062 VARYING WRK-CTR FROM 1 BY 1 DTSCS46 04063 UNTIL WRK-CTR > TEXT-LINE-MAX DTSCS46 04064 MOVE WRK-ATB-AN DTSCS46 04065 TO MAP-NOTE-LINE-A (WRK-CTR) DTSCS46 04066 END-PERFORM. DTSCS46 04067 DTSCS46 04068 PERFORM DTSCS46 04069 VARYING WRK-CTR FROM 1 BY 1 DTSCS46 04070 UNTIL WRK-CTR > WINDOW-LINE-MAX DTSCS46 04071 MOVE CATB-ASKIP-BRT-MDTON DTSCS46 04072 TO MAP-STMT-LINE-A (WRK-CTR) DTSCS46 04073 END-PERFORM. DTSCS46 04074 DTSCS46 04075 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS46 04076 S5900-EXIT. DTSCS46 04077 EXIT. DTSCS46 04078 /*****************************************************************DTSCS46 04079 * MAP ROUTINES *DTSCS46 04080 ******************************************************************DTSCS46 04081 DTSCS46 04082 S9100-RECEIVE. DTSCS46 04083 SET L851-RECEIVE-88 TO TRUE. DTSCS46 04084 DTSCS46 04085 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS46 04086 DTSCS46 04087 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS46 04088 DTSCS46 04089 MOVE L851-AID TO LCCM-AID. DTSCS46 04090 DTSCS46 04091 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS46 04092 S9100-EXIT. DTSCS46 04093 EXIT. DTSCS46 04094 DTSCS46 04095 DTSCS46 04096 DTSCS46 04097 S9200-SEND-DATAONLY. DTSCS46 04098 MOVE LOW-VALUES TO MAP-AREA. DTSCS46 04099 DTSCS46 04100 IF LCCM-NO-MSG DTSCS46 04101 NEXT SENTENCE DTSCS46 04102 ELSE DTSCS46 04103 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS46 04104 DTSCS46 04105 IF CURSOR-SET-GOTO DTSCS46 04106 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS46 04107 ELSE DTSCS46 04108 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS46 04109 DTSCS46 04110 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS46 04111 DTSCS46 04112 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS46 04113 DTSCS46 04114 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS46 04115 S9200-EXIT. DTSCS46 04116 EXIT. DTSCS46 04117 DTSCS46 04118 DTSCS46 04119 DTSCS46 04120 S9300-SEND-MAP. DTSCS46 04121 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS46 04122 DTSCS46 04123 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS46 04124 DTSCS46 04125 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS46 04126 DTSCS46 04127 IF SCR-ACCESS-UPDATE DTSCS46 04128 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS46 04129 ELSE DTSCS46 04130 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS46 04131 DTSCS46 04132 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS46 04133 DTSCS46 04134 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS46 04135 DTSCS46 04136 IF CURSOR-SET-NO DTSCS46 04137 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS46 04138 DTSCS46 04139 SET L851-SEND-88 TO TRUE. DTSCS46 04140 DTSCS46 04141 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS46 04142 DTSCS46 04143 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS46 04144 S9300-EXIT. DTSCS46 04145 EXIT. DTSCS46 04146 DTSCS46 04147 DTSCS46 04148 DTSCS46 04149 S9310-UPDATE-FKEYS. DTSCS46 04150 IF LCCM-SCR-PRT-LOCKED DTSCS46 04151 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS46 04152 MAP-KEY-LAST DTSCS46 04153 MAP-KEY-BACK DTSCS46 04154 MAP-KEY-FWRD DTSCS46 04155 MAP-KEY-PRINT DTSCS46 04156 ELSE DTSCS46 04157 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT DTSCS46 04158 MOVE 'F9=PRINT' TO MAP-KEY-PRINT. DTSCS46 04159 S9310-EXIT. DTSCS46 04160 EXIT. DTSCS46 04161 DTSCS46 04162 DTSCS46 04163 DTSCS46 04164 S9320-INQUIRY-FKEYS. DTSCS46 04165 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS46 04166 DTSCS46 04167 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS46 04168 DTSCS46 04169 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS46 04170 DTSCS46 04171 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS46 04172 DTSCS46 04173 MOVE LOW-VALUES TO MAP-KEY-PRINT. DTSCS46 04174 S9320-EXIT. DTSCS46 04175 EXIT. DTSCS46 04176 DTSCS46 04177 DTSCS46 04178 DTSCS46 04179 S9330-DSCR-FIELDS. DTSCS46 04180 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS46 04181 DTSCS46 04182 IF WRK-MPRF-YES-88 DTSCS46 04183 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS46 04184 ELSE DTSCS46 04185 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA DTSCS46 04186 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT DTSCS46 04187 IF L018-VALID DTSCS46 04188 MOVE LOW-VALUES TO MSKL-KEY-AREA DTSCS46 04189 MOVE L018-EMP-NO TO MSKL-EMP-NO DTSCS46 04190 SET MSKL-PRF-88 TO TRUE DTSCS46 04191 PERFORM S810-READ THRU S810-EXIT DTSCS46 04192 IF L810-NO-REC-88 DTSCS46 04193 NEXT SENTENCE DTSCS46 04194 ELSE DTSCS46 04195 MOVE MSKL-REC TO MPRF-REC DTSCS46 04196 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS46 04197 ELSE DTSCS46 04198 NEXT SENTENCE. DTSCS46 04199 DTSCS46 04200 IF MAP-RESP-OP-ID = SPACES OR LOW-VALUES DTSCS46 04201 MOVE LOW-VALUES TO MAP-RESP-OP-ID-DSCR DTSCS46 04202 ELSE DTSCS46 04203 IF MAP-RESP-OP-ID = LCCM-OP-ID DTSCS46 04204 MOVE LCCM-OP-NAME TO MAP-RESP-OP-ID-DSCR DTSCS46 04205 ELSE DTSCS46 04206 MOVE MAP-RESP-OP-ID TO L082-OP-ID DTSCS46 04207 PERFORM S082-OPID-LOOKUP THRU S082-EXIT DTSCS46 04208 MOVE L082-NAME TO MAP-RESP-OP-ID-DSCR. DTSCS46 04209 S9330-EXIT. DTSCS46 04210 EXIT. DTSCS46 04211 DTSCS46 04212 DTSCS46 04213 DTSCS46 04214 S9900-PREPARE-SEND. DTSCS46 04215 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS46 04216 LCCM-SCR-ID. DTSCS46 04217 DTSCS46 04218 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS46 04219 DTSCS46 04220 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS46 04221 S9900-EXIT. DTSCS46 04222 EXIT. DTSCS46