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
