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