00001  IDENTIFICATION DIVISION.                                         04/05/04
00002  PROGRAM-ID.             DTSBU072.                                DTSBU072
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV001
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSBU072
00005  DATE-COMPILED.                                                   DTSBU072
00006      SKIP3                                                        DTSBU072
00007 *****                                                             DTSBU072
00008 *                                                                 DTSBU072
00009 *    FUNCTION:  ADDRESS EDIT.                                     DTSBU072
00010 *                                                                 DTSBU072
00011 *    MODIFICATION LOG:                                            DTSBU072
00012 *                                                                 DTSBU072
00013 *    01/16/92  INITIAL DEVELOPMENT.                               DTSBU072
00014 *              WORK ORDER:                      PROGRAMMER: JME   DTSBU072
00015 *                                                                 DTSBU072
00016 *    09/18/95  FOREIGN ADDRESS LOGIC ADDED.                       DTSBU072
00017 *              WORK ORDER: JR                   PROGRAMMER: EHH   DTSBU072
00018 *                                                                 DTSBU072
00019 *    10-20-95  NEW VERSION OF FINALST -- COPY MEMBER LENGTH       DTSBU072
00020 *              CHANGED, FIELDS MOVED AROUND, RENAMED, ETC.        DTSBU072
00021 *              ADDED COMM-AREA-LENGTH-FIELD, CHANGED CODE IN      DTSBU072
00022 *              S1000-LINK-TO-FINALIST TO USE IT.  CHANGED CODE    DTSBU072
00023 *              IN P2120-FINALIST-RESULTS.                         DTSBU072
00024 *              WORK ORDER:  NONE                PROGRAMMER: EHH   DTSBU072
00025 *                                                                 DTSBU072
00026 *    08/13/96  RECOMPILED FOR NEW VERSION OF FINALIST (REL 670).  DTSBU072
00027 *              REFERENCE RFP: NONE              PROGRAMMER: MJA   DTSBU072
00028 *                                                                 DTSBU072
00029 *    08/20/97  RECOMPILED FOR NEW VERSION OF FINALIST (REL 680).  DTSBU072
00030 *              REFERENCE RFP: NONE              PROGRAMMER: EHH   DTSBU072
00031 *                                                                 DTSBU072
00032 *    12/30/97  INITIALIZE FINAL-FIRMCORR-OPT WITH A VALUE OF      DTSBU072
00033 *              'Y' AND FINAL-ALSLBL-OPT WITH A VALUE OF 'N'.      DTSBU072
00034 *              BATCH TESTING WITH CNFIGAAR INDICATES IN ORDER     DTSBU072
00035 *              TO FORCE THE ONLINE VERSION OF FINALIST TO YIELD   DTSBU072
00036 *              THE SAME RESULTS AS THE BATCH VERSION OF FINALIST `DTSBU072
00037 *              WITH CNFIGAAR SPECIFIED THESE TWO OPTIONS MUST BE  DTSBU072
00038 *              SET AS INDICATED.  THESE TWO OPTIONS WERE ADDED    DTSBU072
00039 *              TO FINALIST AFTER SYSTEM IMPLEMENTATION, BUT THE   DTSBU072
00040 *              MAINTENANCE PROGRAMMERS OVERLOOKED THEM.           DTSBU072
00041 *              REFERENCE RFP: TCL 214           PROGRAMMER: EHH   DTSBU072
00042 *                                                                 DTSBU072
00043 *    09/08/1998  FINALIST ORIENTED CODE COMMENTED OUT.  LPFNCL01  DTSBU072
00044 *                COPY MEMBER NOT AVAILABLE.  AFTER LPFNCL01       DTSBU072
00045 *                BECOMES AVAILABLE AND THE LINK TO FINALIST IS    DTSBU072
00046 *                WORKING, THIS MODULE MUST BE REVISITED.          DTSBU072
00047 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBU072
00048 *                                                                 DTSBU072
00049 *    09/08/1999  FINALIST ORIENTED CODE UNCOMMENTED AND PROGRAM   DTSBU072
00050 *                RECOMPILED FOR RELEASE 700.  LPFNCL01 TURNED     DTSBU072
00051 *                OUT TO BE UNCHANGED FROM 680   PROGRAMMER: TKT   DTSBU072
00052 *                                                                 DTSBU072
00053 *    09/20/2000  RECOMPILED FOR NEW VERSION(R720) OF FINALIST.    DTSBU072
00054 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: ZL1   DTSBU072
00055 *                                                                 DTSBU072
00056 *                                                                 DTSBU072
00057 *    04/02/2002  RECOMPILED FOR NEW VERSION(R730) OF FINALIST.    DTSBU072
00058 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: ZL1   DTSBU072
00059 *                                                                 DTSBU072
00060 *    99/99/9999  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU072
00061 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU072
00062 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU072
00063 *                                                                 DTSBU072
00064 *                                                                 DTSBU072
00065 *    DESCRIPTION:                                                 DTSBU072
00066 *                                                                 DTSBU072
00067 *    EDIT AN ADDRESS.                                             DTSBU072
00068 *                                                                 DTSBU072
00069 *                                                                 DTSBU072
00070 *    SEE ISSUE STATEMENT 12, ISSUE STATEMENT 13, AND              DTSBU072
00071 *    THE 'FINALIST' MANUAL.                                       DTSBU072
00072 *                                                                 DTSBU072
00073 *    SEE THE COMMENTS IN THE CODE.                                DTSBU072
00074 *                                                                 DTSBU072
00075 *                                                                 DTSBU072
00076 *    04/20/94  THE LOGIC PERMITTING A BLANK DELIVERY LINE         DTSBU072
00077 *              (IF L072-NAME IS A VALID FIRM NAME) IS             DTSBU072
00078 *              SUPPRESSED.                                        DTSBU072
00079 *                                                                 DTSBU072
00080 *              STATUS UNIT WORKERS INDICATE THEY "NEVER"          DTSBU072
00081 *              ENCOUNTER A BLANK DELIVERY LINE.                   DTSBU072
00082 *                                                                 DTSBU072
00083 *****                                                             DTSBU072
00084      SKIP3                                                        DTSBU072
00085  ENVIRONMENT DIVISION.                                            DTSBU072
00086      SKIP3                                                        DTSBU072
00087  DATA DIVISION.                                                   DTSBU072
00088      SKIP3                                                        DTSBU072
00089  WORKING-STORAGE SECTION.                                         DTSBU072
000895 77  PAN-VALET PICTURE X(24) VALUE '001DTSBU072  04/05/04'.       DTSBU072
00090      SKIP3                                                        DTSBU072
00091  01  WRK-AREA.                                                    DTSBU072
00092      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +072.DTSBU072
00093      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBU072'.DTSBU072
00094      05  WRK-ABEND-MSG               PIC  X(60).                  DTSBU072
00095                                                                   DTSBU072
00096  01  FC-FINALIST-RETURN-CODES.                                    DTSBU072
00097      05  FC-REASON-CODES.                                         DTSBU072
00098          10  FC-REASON-CODE1     PIC  9(01).                      DTSBU072
00099              88  FC-ZIP-VERIF-88       VALUE 0                  . DTSBU072
00100              88  FC-ZIP-GUESSED-88     VALUE         4          . DTSBU072
00101              88  FC-ZIP-FIXED-88       VALUE           5 6 7    . DTSBU072
00102              88  FC-ZIP-RETURNED-88    VALUE   1                . DTSBU072
00103              88  FC-ZIP-BYPASSED-88    VALUE     2 3            . DTSBU072
00104              88  FC-ZIP-BAD-88         VALUE                   9. DTSBU072
00105          10  FC-MSG-E081-ARE     PIC  9(01).                      DTSBU072
00106              88  FC-CITY-VERIF-88      VALUE 0                  . DTSBU072
00107              88  FC-CITY-VANITY-88     VALUE               7    . DTSBU072
00108              88  FC-CITY-STANDARD-88   VALUE     2 3            . DTSBU072
00109              88  FC-CITY-GUESSED-88    VALUE             6      . DTSBU072
00110              88  FC-CITY-FIXED-88      VALUE           5        . DTSBU072
00111              88  FC-CITY-RETURNED-88   VALUE   1                . DTSBU072
00112              88  FC-CITY-BYPASSED-88   VALUE         4          . DTSBU072
00113              88  FC-CITY-BAD-88        VALUE                   9. DTSBU072
00114          10  FC-REASON-CODE3-CARRIER-ROUTE   PIC  9(01).          DTSBU072
00115          10  FC-REASON-CODE4-ZIP-PLUS-4      PIC  9(01).          DTSBU072
00116          10  FC-REASON-CODE5     PIC  9(01).                      DTSBU072
00117              88  FC-STREET-VERIF-88    VALUE 0                  . DTSBU072
00118              88  FC-STREET-STANDARD-88 VALUE   1                . DTSBU072
00119              88  FC-STREET-GUESSED-88  VALUE     2 3 4   6      . DTSBU072
00120              88  FC-STREET-BAD-88      VALUE                   9. DTSBU072
00121          10  FC-REASON-CODE6     PIC  9(01).                      DTSBU072
00122              88  FC-RANGE-VERIF-88     VALUE 0                  . DTSBU072
00123              88  FC-RANGE-GUESSED-88   VALUE         4          . DTSBU072
00124              88  FC-RANGE-BAD-88       VALUE   1 2 3           9. DTSBU072
00125          10  FC-REASON-CODE7     PIC  9(01).                      DTSBU072
00126              88  FC-SUFDIR-VERIF-88    VALUE 0                  . DTSBU072
00127              88  FC-SUFDIR-MULTI-88    VALUE         4          . DTSBU072
00128              88  FC-SUFDIR-FIXED-88    VALUE   1 2 3            . DTSBU072
00129              88  FC-SUFDIR-BAD-88      VALUE                   9. DTSBU072
00130      05  FC-ADDRESS-INFO-CODES.                                   DTSBU072
00131          10  FC-INFO-CODE1       PIC  9(01).                      DTSBU072
00132          10  FC-INFO-CODE2       PIC  9(01).                      DTSBU072
00133          10  FC-INFO-CODE3       PIC  9(01).                      DTSBU072
00134          10  FC-INFO-CODE4       PIC  9(01).                      DTSBU072
00135              88  FC-BOTH-ADDR-BAD-88   VALUE                   9. DTSBU072
00136          10  FC-INFO-CODE5       PIC  9(01).                      DTSBU072
00137          10  FC-INFO-CODE678     PIC  9(03).                      DTSBU072
00138      SKIP3                                                        DTSBU072
00139  01  MSG-AREAS.                                                   DTSBU072
00140      05  MSG-E081-AREA.                                           DTSBU072
00141          10  MSG-E081-MSG-ID             PIC  X(04)  VALUE 'E081'.DTSBU072
00142          10  MSG-E081-MSG-TXT.                                    DTSBU072
00143              15  FILLER                  PIC  X(25)               DTSBU072
00144                  VALUE 'FINALIST NOT AVAILABLE'.                  DTSBU072
00145              15  MSG-E081-CAERRMOD       PIC  X(08).              DTSBU072
00146              15  FILLER                  PIC  X(02)  VALUE SPACES.DTSBU072
00147              15  MSG-E081-CAERRSRC       PIC  X(08).              DTSBU072
00148              15  FILLER                  PIC  X(02)  VALUE SPACES.DTSBU072
00149              15  MSG-E081-CAERRDSC       PIC  X(09).              DTSBU072
00150              15  FILLER                  PIC  X(06)  VALUE SPACES.DTSBU072
00151      05  MSG-E082-AREA.                                           DTSBU072
00152          10  FILLER     PIC  X(21)  VALUE 'E082FINALIST RESULT: '.DTSBU072
00153          10  FILLER     PIC  X(43)                                DTSBU072
00154             VALUE 'UNABLE TO DETERMINE ZIP PLUS FOUR'.            DTSBU072
00155      05  MSG-E083-AREA.                                           DTSBU072
00156          10  FILLER     PIC  X(21)  VALUE 'E083FINALIST RESULT: '.DTSBU072
00157          10  FILLER     PIC  X(43)                                DTSBU072
00158             VALUE 'ZIP CODE FAILED'.                              DTSBU072
00159      05  MSG-E084-AREA.                                           DTSBU072
00160          10  FILLER     PIC  X(21)  VALUE 'E084FINALIST RESULT: '.DTSBU072
00161          10  FILLER     PIC  X(43)                                DTSBU072
00162             VALUE 'CITY FAILED'.                                  DTSBU072
00163      05  MSG-E085-AREA.                                           DTSBU072
00164          10  FILLER     PIC  X(21)  VALUE 'E085FINALIST RESULT: '.DTSBU072
00165          10  FILLER     PIC  X(43)                                DTSBU072
00166             VALUE 'STREET ADDRESS FAILED'.                        DTSBU072
00167      05  MSG-E086-AREA.                                           DTSBU072
00168          10  FILLER     PIC  X(21)  VALUE 'E086FINALIST RESULT: '.DTSBU072
00169          10  FILLER     PIC  X(43)                                DTSBU072
00170             VALUE 'ADDRESS FAILED'.                               DTSBU072
00171      05  MSG-E087-AREA.                                           DTSBU072
00172          10  FILLER     PIC  X(21)  VALUE 'E087FINALIST RESULT: '.DTSBU072
00173          10  FILLER     PIC  X(43)                                DTSBU072
00174             VALUE 'ADDRESS LINE LONGER THAN 40 CHARACTERS'.       DTSBU072
00175 *****05  MSG-E08Y-AREA.                                           DTSBU072
00176 *****    10  FILLER     PIC  X(04)  VALUE 'E08Y'.                 DTSBU072
00177 *****    10  FILLER     PIC  X(60)                                DTSBU072
00178 *****       VALUE 'ILLEGAL NAME FORMAT FOUND ON MASTER FILE'.     DTSBU072
00179 *****05  MSG-E08Z-AREA.                                           DTSBU072
00180 *****    10  FILLER     PIC  X(04)  VALUE 'E08ZFINALIST RESULT: '.DTSBU072
00181 *****    10  FILLER     PIC  X(43)                                DTSBU072
00182 *****       VALUE 'NON-FIRM NAME FOUND ON MASTER FILE'.           DTSBU072
00183      EJECT                                                        DTSBU072
00184  01  C072-LITERALS.                                               DTSBU072
00185  ++INCLUDE DTSIC072                                               DTSBU072
00186      SKIP3                                                        DTSBU072
00187  ++INCLUDE LPFNCL01                                               DTSBU072
00188      EJECT                                                        DTSBU072
00189  01  CECD-LITERALS.                                               DTSBU072
00190  ++INCLUDE DTSICECD                                               DTSBU072
00191      EJECT                                                        DTSBU072
00192  LINKAGE SECTION.                                                 DTSBU072
00193      SKIP3                                                        DTSBU072
00194  01  L072-LINK-AREA.                                              DTSBU072
00195  ++INCLUDE DTSIL072                                               DTSBU072
00196      EJECT                                                        DTSBU072
00197  PROCEDURE DIVISION USING L072-LINK-AREA.                         DTSBU072
00198                                                                   DTSBU072
00199 *& NOTE: THE FOLLOWING LINE DISABLES CASS CERTIFICATION.          DTSBU072
00200 *&       IT MUST BE REMOVED WHEN FINALIST IS AVAILABLE.           DTSBU072
00201                                                                   DTSBU072
00202 *&   SET L072-NO-CASS-EDITS-88 TO TRUE.                           DTSBU072
00203 *&                                                                DTSBU072
00204      PERFORM I1000-INITIALIZE THROUGH I1000-EXIT.                 DTSBU072
00205                                                                   DTSBU072
00206      MOVE L072-ST TO C072-ST.                                     DTSBU072
00207      IF C072-DC-88                                                DTSBU072
00208          PERFORM P2000-US-ADDRESS THRU P2000-EXIT                 DTSBU072
00209      ELSE                                                         DTSBU072
00210      IF C072-US-88                                                DTSBU072
00211          PERFORM P2000-US-ADDRESS THRU P2000-EXIT                 DTSBU072
00212      ELSE                                                         DTSBU072
00213      IF C072-CANADA-88                                            DTSBU072
00214          PERFORM P1000-CANADA-ADDRESS THRU P1000-EXIT             DTSBU072
00215      ELSE                                                         DTSBU072
00216      IF C072-FOREIGN-88                                           DTSBU072
00217          PERFORM P3000-FOREIGN-ADDRESS THRU P3000-EXIT            DTSBU072
00218      ELSE                                                         DTSBU072
00219          SET L072-ST-NOT-VALID-88 TO TRUE                         DTSBU072
00220          IF L072-ST = SPACE OR LOW-VALUE                          DTSBU072
00221              MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA            DTSBU072
00222          ELSE                                                     DTSBU072
00223              MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA.          DTSBU072
00224                                                                   DTSBU072
00225      IF L072-MSG-ID NOT = SPACE                                   DTSBU072
00226          SET L072-ADDRESS-NOT-VALID-88 TO TRUE.                   DTSBU072
00227                                                                   DTSBU072
00228      IF L072-ADDRESS-NOT-VALID-88                                 DTSBU072
00229          NEXT SENTENCE                                            DTSBU072
00230      ELSE                                                         DTSBU072
00231          IF L072-DELIV-LINE-1-NOT-VALID-88                        DTSBU072
00232          OR L072-DELIV-LINE-2-NOT-VALID-88                        DTSBU072
00233          OR L072-CITY-NOT-VALID-88                                DTSBU072
00234          OR L072-ST-NOT-VALID-88                                  DTSBU072
00235          OR L072-ZIP-NOT-VALID-88                                 DTSBU072
00236              SET L072-ADDRESS-NOT-VALID-88 TO TRUE                DTSBU072
00237          ELSE                                                     DTSBU072
00238              IF L072-DELIV-LINE-1-CHANGED-88                      DTSBU072
00239              OR L072-DELIV-LINE-2-CHANGED-88                      DTSBU072
00240              OR L072-CITY-CHANGED-88                              DTSBU072
00241              OR L072-ST-CHANGED-88                                DTSBU072
00242              OR L072-ZIP-CHANGED-88                               DTSBU072
00243                  SET L072-ADDRESS-CHANGED-88 TO TRUE.             DTSBU072
00244                                                                   DTSBU072
00245      GOBACK.                                                      DTSBU072
00246      EJECT                                                        DTSBU072
00247  I1000-INITIALIZE.                                                DTSBU072
00248      IF L072-NO-CASS-EDITS-88                                     DTSBU072
00249          NEXT SENTENCE                                            DTSBU072
00250      ELSE                                                         DTSBU072
00251          SET L072-CASS-EDITS-88 TO TRUE.                          DTSBU072
00252                                                                   DTSBU072
00253      SET L072-ADDRESS-UNCHANGED-88 TO TRUE.                       DTSBU072
00254                                                                   DTSBU072
00255                                                                   DTSBU072
00256      SET L072-ATTN-LINE-UNCHANGED-88 TO TRUE.                     DTSBU072
00257                                                                   DTSBU072
00258      SET L072-DELIV-LINE-1-UNCHANGED-88 TO TRUE.                  DTSBU072
00259                                                                   DTSBU072
00260      SET L072-DELIV-LINE-2-UNCHANGED-88 TO TRUE.                  DTSBU072
00261                                                                   DTSBU072
00262      SET L072-CITY-UNCHANGED-88 TO TRUE.                          DTSBU072
00263                                                                   DTSBU072
00264      SET L072-ST-UNCHANGED-88 TO TRUE.                            DTSBU072
00265                                                                   DTSBU072
00266      SET L072-ZIP-UNCHANGED-88 TO TRUE.                           DTSBU072
00267                                                                   DTSBU072
00268                                                                   DTSBU072
00269      IF L072-ATTN-LINE = LOW-VALUES                               DTSBU072
00270          MOVE SPACES TO L072-ATTN-LINE.                           DTSBU072
00271                                                                   DTSBU072
00272      IF L072-DELIV-LINE-1 = LOW-VALUES                            DTSBU072
00273          MOVE SPACES TO L072-DELIV-LINE-1.                        DTSBU072
00274                                                                   DTSBU072
00275      IF L072-DELIV-LINE-2 = LOW-VALUES                            DTSBU072
00276          MOVE SPACES TO L072-DELIV-LINE-2.                        DTSBU072
00277                                                                   DTSBU072
00278      IF L072-CITY = LOW-VALUES                                    DTSBU072
00279          MOVE SPACES TO L072-CITY.                                DTSBU072
00280                                                                   DTSBU072
00281      IF L072-ST = LOW-VALUES                                      DTSBU072
00282          MOVE SPACES TO L072-ST.                                  DTSBU072
00283                                                                   DTSBU072
00284      IF L072-ZIP = LOW-VALUES                                     DTSBU072
00285          MOVE SPACES TO L072-ZIP.                                 DTSBU072
00286                                                                   DTSBU072
00287                                                                   DTSBU072
00288      MOVE SPACES TO L072-ADVANCED-BARCODE                         DTSBU072
00289                     L072-CASS-RETURN-CODES                        DTSBU072
00290                     L072-MSG-AREA.                                DTSBU072
00291                                                                   DTSBU072
00292      MOVE L072-ST TO C072-ST.                                     DTSBU072
00293                                                                   DTSBU072
00294  I1000-EXIT.                                                      DTSBU072
00295      EXIT.                                                        DTSBU072
00296      EJECT                                                        DTSBU072
00297  P1000-CANADA-ADDRESS.                                            DTSBU072
00298      SET L072-NO-CASS-EDITS-88 TO TRUE.                           DTSBU072
00299                                                                   DTSBU072
00300      IF (L072-DELIV-LINE-1 NOT = SPACES)                          DTSBU072
00301              AND                                                  DTSBU072
00302         (L072-DELIV-LINE-2 = SPACES)                              DTSBU072
00303          MOVE L072-DELIV-LINE-1 TO L072-DELIV-LINE-2              DTSBU072
00304          MOVE SPACES TO L072-DELIV-LINE-1                         DTSBU072
00305          SET L072-DELIV-LINE-1-CHANGED-88                         DTSBU072
00306              L072-DELIV-LINE-2-CHANGED-88 TO TRUE.                DTSBU072
00307                                                                   DTSBU072
00308      IF L072-DELIV-LINE-2 = SPACES                                DTSBU072
00309          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00310          SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE               DTSBU072
00311          GO TO P1000-EXIT.                                        DTSBU072
00312                                                                   DTSBU072
00313      IF L072-CITY = SPACE                                         DTSBU072
00314          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00315          SET L072-CITY-NOT-VALID-88 TO TRUE                       DTSBU072
00316          GO TO P1000-EXIT.                                        DTSBU072
00317                                                                   DTSBU072
00318      IF L072-ZIP = SPACES                                         DTSBU072
00319          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00320          SET L072-ZIP-NOT-VALID-88 TO TRUE                        DTSBU072
00321          GO TO P1000-EXIT.                                        DTSBU072
00322                                                                   DTSBU072
00323      IF L072-ZIP (1:1) NOT ALPHABETIC                             DTSBU072
00324      OR L072-ZIP (2:1) NOT NUMERIC                                DTSBU072
00325      OR L072-ZIP (3:1) NOT ALPHABETIC                             DTSBU072
00326      OR L072-ZIP (4:1) NOT = SPACE                                DTSBU072
00327      OR L072-ZIP (5:1) NOT NUMERIC                                DTSBU072
00328      OR L072-ZIP (6:1) NOT ALPHABETIC                             DTSBU072
00329      OR L072-ZIP (7:1) NOT NUMERIC                                DTSBU072
00330      OR L072-ZIP (8:3) NOT = SPACE                                DTSBU072
00331          SET L072-ZIP-NOT-VALID-88  TO TRUE                       DTSBU072
00332          MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA.              DTSBU072
00333  P1000-EXIT.                                                      DTSBU072
00334      EXIT.                                                        DTSBU072
00335      SKIP3                                                        DTSBU072
00336  P2000-US-ADDRESS.                                                DTSBU072
00337      IF L072-CASS-EDITS-88                                        DTSBU072
00338          PERFORM P2100-CASS THRU P2100-EXIT                       DTSBU072
00339      ELSE                                                         DTSBU072
00340          PERFORM P2200-NO-CASS THRU P2200-EXIT.                   DTSBU072
00341  P2000-EXIT.                                                      DTSBU072
00342      EXIT.                                                        DTSBU072
00343      EJECT                                                        DTSBU072
00344  P2100-CASS.                                                      DTSBU072
00345      MOVE SPACE      TO FINAL-ORIGINAL-RETURN-AREA                DTSBU072
00346                         FINAL-EXPANDED-RETURN-AREA.               DTSBU072
00347      MOVE HIGH-VALUE TO FINAL-FILLER.                             DTSBU072
00348                                                                   DTSBU072
00349      MOVE '0'        TO FINAL-FUNCTION-CODE.                      DTSBU072
00350                                                                   DTSBU072
00351 *--------------------------------------------------------------   DTSBU072
00352 *    FINALIST ONLINE DOES NOT ACCEPT VALID CASS CONFIGURATIONS    DTSBU072
00353 *    (CONFIGXXX).  HOWEVER, THE FOLLOWING CODE SETS THE           DTSBU072
00354 *    INDIVIDUAL TAILORING OPTIONS TO DUPLICATE (WHEN COMBINED     DTSBU072
00355 *    WITH LATER USE OF FUNCTION CODE EQUAL TO 5) THE              DTSBU072
00356 *    'CNFIGAAR' CONFIGURATION.                                    DTSBU072
00357 *--------------------------------------------------------------   DTSBU072
00358      MOVE 'X  ' TO FINAL-FUNCTION-OPTION.                         DTSBU072
00359      MOVE 'Y' TO FINAL-UNIQUE-OPT.                                DTSBU072
00360      MOVE 'Y' TO FINAL-STRTPHON-OPT.                              DTSBU072
00361      MOVE 'Y' TO FINAL-FIRMCORR-OPT.                              DTSBU072
00362      MOVE 'Y' TO FINAL-CITYPHON-OPT.                              DTSBU072
00363      MOVE 'N' TO FINAL-WEIGHT-OPT.                                DTSBU072
00364      MOVE 'Y' TO FINAL-ZIPCORR-OPT.                               DTSBU072
00365      MOVE 'Y' TO FINAL-CITYCORR-OPT.                              DTSBU072
00366      MOVE 'N' TO FINAL-STRCOSM-OPT.                               DTSBU072
00367      MOVE 'Y' TO FINAL-FRMPRS-OPT.                                DTSBU072
00368      MOVE 'Y' TO FINAL-UNITDES-OPT.                               DTSBU072
00369      MOVE 'Y' TO FINAL-CTYLONG-OPT.                               DTSBU072
00370      MOVE 'N' TO FINAL-ALSLBL-OPT.                                DTSBU072
00371 *    MOVE 'LPFNMODS' TO CAMODNAM.                                 DTSBU072
00372      MOVE 'CNFIGAAR' TO FINAL-CNFIG-ID.                           DTSBU072
00373                                                                   DTSBU072
00374      PERFORM S1000-LINK-TO-FINALIST      THROUGH S1000-EXIT.      DTSBU072
00375                                                                   DTSBU072
00376      IF FINAL-RETURN-CODE1 = 'E'                                  DTSBU072
00377          PERFORM P2110-FINALIST-ABEND    THROUGH P2110-EXIT       DTSBU072
00378          GO TO P2100-EXIT.                                        DTSBU072
00379                                                                   DTSBU072
00380      MOVE SPACES TO FINAL-INPUT-ADDR-AREA.                        DTSBU072
00381                                                                   DTSBU072
00382      IF L072-DELIV-LINE-1 > SPACES                                DTSBU072
00383          MOVE L072-DELIV-LINE-1 TO USER-INPUT-ADDRESS-1.          DTSBU072
00384                                                                   DTSBU072
00385 *    IF L072-DELIV-LINE = SPACE                                   DTSBU072
00386 *        IF L072-MOPO-88                                          DTSBU072
00387 *        OR L072-FFID-88                                          DTSBU072
00388 *            SET L071-FROM-LAST-NAME-FIRST TO TRUE                DTSBU072
00389 *            MOVE L072-NAME TO L071-NAM                           DTSBU072
00390 *            PERFORM S071-NAME-CONVERT       THROUGH S071-EXIT    DTSBU072
00391 *            IF L071-NAME-CONVERTED                               DTSBU072
00392 *                MOVE L071-NAM TO USER-INPUT-ADDRESS-2            DTSBU072
00393 *            ELSE                                                 DTSBU072
00394 *                SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE         DTSBU072
00395 *                MOVE MSG-E08Y-AREA TO L072-MSG-AREA              DTSBU072
00396 *                GO TO P2100-EXIT                                 DTSBU072
00397 *        ELSE                                                     DTSBU072
00398 *            MOVE L072-NAME TO USER-INPUT-ADDRESS-2               DTSBU072
00399 *    ELSE                                                         DTSBU072
00400 *        MOVE L072-DELIV-LINE TO USER-INPUT-ADDRESS-2.            DTSBU072
00401 *    IF L072-DELIV-LINE = SPACE                                   DTSBU072
00402 *        SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE                 DTSBU072
00403 *        MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00404 *        GO TO P2100-EXIT                                         DTSBU072
00405 *    ELSE                                                         DTSBU072
00406 *        MOVE L072-DELIV-LINE TO USER-INPUT-ADDRESS-2.            DTSBU072
00407 *                                                                 DTSBU072
00408 *    MOVE SPACES TO USER-INPUT-CSZ-AREA.                          DTSBU072
00409                                                                   DTSBU072
00410      MOVE L072-DELIV-LINE-2 TO USER-INPUT-ADDRESS-2.              DTSBU072
00411                                                                   DTSBU072
00412 *    STRING L072-CITY ' ' L072-ST                                 DTSBU072
00413 *            DELIMITED BY '  '                                    DTSBU072
00414 *            INTO USER-INPUT-CITY-STATE.                          DTSBU072
00415                                                                   DTSBU072
00416      MOVE L072-CITY TO USER-INPUT-CITY-STATE (1:25).              DTSBU072
00417      MOVE L072-ST   TO USER-INPUT-CITY-STATE (28:2).              DTSBU072
00418                                                                   DTSBU072
00419      MOVE L072-ZIP       TO USER-INPUT-ZIP.                       DTSBU072
00420      MOVE L072-ZIP (7:4) TO USER-INPUT-SEC-SEG.                   DTSBU072
00421                                                                   DTSBU072
00422      MOVE '5'        TO FINAL-FUNCTION-CODE.                      DTSBU072
00423      PERFORM S1000-LINK-TO-FINALIST          THROUGH S1000-EXIT.  DTSBU072
00424      IF FINAL-RETURN-CODE1 = 'E'                                  DTSBU072
00425          PERFORM P2110-FINALIST-ABEND        THROUGH P2110-EXIT   DTSBU072
00426          GO TO P2100-EXIT.                                        DTSBU072
00427                                                                   DTSBU072
00428      PERFORM P2120-FINALIST-RESULTS          THROUGH P2120-EXIT.  DTSBU072
00429      IF L072-MSG-ID = SPACE                                       DTSBU072
00430          PERFORM P2130-CHECK-FINALIST-CODES  THROUGH P2130-EXIT.  DTSBU072
00431 *        IF L072-DELIV-LINE-NOT-VALID-88                          DTSBU072
00432 *** WORKAROUND FOR FINALIST BUG: GENERAL DELIVERY W/ GARBAGE CITY DTSBU072
00433 *            IF L072-DELIV-LINE = 'GENERAL DELIVERY'              DTSBU072
00434 *                SET L072-DELIV-LINE-UNCHANGED-88 TO TRUE         DTSBU072
00435 *                MOVE MSG-E084-AREA TO L072-MSG-AREA              DTSBU072
00436 *                SET L072-CITY-NOT-VALID-88       TO TRUE.        DTSBU072
00437                                                                   DTSBU072
00438      IF L072-MSG-ID = SPACE                                       DTSBU072
00439          IF FINAL-OUTSEL-BAD = 'Y'                                DTSBU072
00440              SET L072-ADDRESS-NOT-VALID-88 TO TRUE                DTSBU072
00441              MOVE MSG-E086-AREA TO L072-MSG-AREA.                 DTSBU072
00442                                                                   DTSBU072
00443      MOVE '9'        TO FINAL-FUNCTION-CODE.                      DTSBU072
00444      PERFORM S1000-LINK-TO-FINALIST          THROUGH S1000-EXIT.  DTSBU072
00445      IF FINAL-RETURN-CODE1 = 'E'                                  DTSBU072
00446          PERFORM P2110-FINALIST-ABEND        THROUGH P2110-EXIT.  DTSBU072
00447                                                                   DTSBU072
00448  P2100-EXIT.                                                      DTSBU072
00449      EXIT.                                                        DTSBU072
00450      SKIP3                                                        DTSBU072
00451  P2110-FINALIST-ABEND.                                            DTSBU072
00452      DISPLAY 'P2110 -ABEN'                                        DTSBU072
00453      SET L072-ADDRESS-NOT-VALID-88 TO TRUE.                       DTSBU072
00454                                                                   DTSBU072
00455      MOVE CAERRMOD TO MSG-E081-CAERRMOD.                          DTSBU072
00456      MOVE CAERRSRC TO MSG-E081-CAERRSRC.                          DTSBU072
00457      MOVE CAERRDSC TO MSG-E081-CAERRDSC.                          DTSBU072
00458                                                                   DTSBU072
00459 *****MOVE SPACES TO MSG-E081-CAERRMOD                             DTSBU072
00460 *****               MSG-E081-CAERRSRC                             DTSBU072
00461 *****               MSG-E081-CAERRDSC.                            DTSBU072
00462                                                                   DTSBU072
00463      MOVE MSG-E081-AREA TO L072-MSG-AREA.                         DTSBU072
00464  P2110-EXIT.                                                      DTSBU072
00465      EXIT.                                                        DTSBU072
00466      EJECT                                                        DTSBU072
00467  P2120-FINALIST-RESULTS.                                          DTSBU072
00468 *    DISPLAY 'P2120 RSLT '                                        DTSBU072
00469      IF FINAL-LABEL-LENGTH1 > 40                                  DTSBU072
00470         MOVE MSG-E087-AREA TO L072-MSG-AREA                       DTSBU072
00471         SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE                DTSBU072
00472      ELSE                                                         DTSBU072
00473         IF L072-DELIV-LINE-1 > SPACES                             DTSBU072
00474            IF FINAL-LABEL-LENGTH1 > 0                             DTSBU072
00475               MOVE EMSG-FIELD-NOT-ALLOWED TO L072-MSG-AREA        DTSBU072
00476               SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE          DTSBU072
00477            ELSE                                                   DTSBU072
00478               MOVE SPACES TO L072-DELIV-LINE-1                    DTSBU072
00479         ELSE                                                      DTSBU072
00480            IF L072-DELIV-LINE-1 = SPACES                          DTSBU072
00481               IF FINAL-LABEL-LENGTH1 > 0                          DTSBU072
00482                  MOVE FINAL-LABEL-LINE1 TO L072-DELIV-LINE-1      DTSBU072
00483                  SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE         DTSBU072
00484 *                SET L072-ATTN-DELIV-88 TO TRUE                   DTSBU072
00485               ELSE                                                DTSBU072
00486                  NEXT SENTENCE                                    DTSBU072
00487            ELSE                                                   DTSBU072
00488               IF FINAL-LABEL-LENGTH1 > 0                          DTSBU072
00489                  MOVE FINAL-LABEL-LINE1 TO L072-DELIV-LINE-1      DTSBU072
00490                  SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE         DTSBU072
00491 *                SET L072-ATTN-DELIV-88 TO TRUE                   DTSBU072
00492               ELSE                                                DTSBU072
00493                  MOVE SPACES TO L072-DELIV-LINE-1                 DTSBU072
00494                  SET L072-DELIV-LINE-1-CHANGED-88 TO TRUE.        DTSBU072
00495 *                SET L072-ATTN-NONE-88 TO TRUE.                   DTSBU072
00496                                                                   DTSBU072
00497      IF FINAL-LABEL-LENGTH2 > 40                                  DTSBU072
00498          MOVE MSG-E087-AREA TO L072-MSG-AREA                      DTSBU072
00499          SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE               DTSBU072
00500      ELSE                                                         DTSBU072
00501 *    IF L072-DELIV-LINE = SPACE                                   DTSBU072
00502 *        IF FINAL-MAIL-FIRM-NAME = SPACE                          DTSBU072
00503 *            SET L072-DELIV-LINE-NOT-VALID-88 TO TRUE             DTSBU072
00504 *            MOVE MSG-E08Z-AREA TO L072-MSG-AREA                  DTSBU072
00505 *        ELSE                                                     DTSBU072
00506 *            NEXT SENTENCE                                        DTSBU072
00507 *    ELSE                                                         DTSBU072
00508          IF FINAL-LABEL-LINE2  NOT =  L072-DELIV-LINE-2           DTSBU072
00509              MOVE FINAL-LABEL-LINE2  TO  L072-DELIV-LINE-2        DTSBU072
00510              SET L072-DELIV-LINE-2-CHANGED-88 TO TRUE.            DTSBU072
00511                                                                   DTSBU072
00512      IF FINAL-FULL-CITY-NAME  NOT =  L072-CITY                    DTSBU072
00513          MOVE FINAL-FULL-CITY-NAME  TO  L072-CITY                 DTSBU072
00514          SET L072-CITY-CHANGED-88 TO TRUE.                        DTSBU072
00515                                                                   DTSBU072
00516      IF FINAL-STATE  NOT =  L072-ST                               DTSBU072
00517          MOVE FINAL-STATE  TO  L072-ST                            DTSBU072
00518          SET L072-ST-CHANGED-88 TO TRUE.                          DTSBU072
00519                                                                   DTSBU072
00520      IF FINAL-ZIP  NOT =  L072-ZIP (1:5)                          DTSBU072
00521          MOVE FINAL-ZIP  TO  L072-ZIP (1:5)                       DTSBU072
00522          SET L072-ZIP-CHANGED-88 TO TRUE.                         DTSBU072
00523                                                                   DTSBU072
00524      IF FINAL-SEC-SEG = SPACE                                     DTSBU072
00525          MOVE SPACE  TO  L072-ZIP (6:5)                           DTSBU072
00526      ELSE                                                         DTSBU072
00527          IF  L072-ZIP (7:4) NOT =  SPACE                          DTSBU072
00528          AND FINAL-SEC-SEG  NOT =  L072-ZIP (7:4)                 DTSBU072
00529              SET L072-ZIP-CHANGED-88 TO TRUE                      DTSBU072
00530          END-IF                                                   DTSBU072
00531          MOVE '-'           TO L072-ZIP (6:1)                     DTSBU072
00532          MOVE FINAL-SEC-SEG TO L072-ZIP (7:4).                    DTSBU072
00533                                                                   DTSBU072
00534      STRING FINAL-RETURN-CODE1             DELIMITED BY SIZE      DTSBU072
00535             '-'                            DELIMITED BY SIZE      DTSBU072
00536             FINAL-REASON-CODES (1:9)       DELIMITED BY SIZE      DTSBU072
00537             '-'                            DELIMITED BY SIZE      DTSBU072
00538             FINAL-ADDRESS-INFO-CODES (1:6) DELIMITED BY SIZE      DTSBU072
00539          INTO L072-CASS-RETURN-CODES.                             DTSBU072
00540                                                                   DTSBU072
00541      MOVE FINAL-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE.        DTSBU072
00542  P2120-EXIT.                                                      DTSBU072
00543      EXIT.                                                        DTSBU072
00544      EJECT                                                        DTSBU072
00545  P2130-CHECK-FINALIST-CODES.                                      DTSBU072
00546 *    DISPLAY 'P2130 CODE '                                        DTSBU072
00547      MOVE FINAL-REASON-CODES       TO FC-REASON-CODES.            DTSBU072
00548      MOVE FINAL-ADDRESS-INFO-CODES TO FC-ADDRESS-INFO-CODES.      DTSBU072
00549                                                                   DTSBU072
00550      IF FC-STREET-BAD-88                                          DTSBU072
00551      OR FC-RANGE-BAD-88                                           DTSBU072
00552      OR FC-SUFDIR-BAD-88                                          DTSBU072
00553          MOVE MSG-E085-AREA TO L072-MSG-AREA                      DTSBU072
00554          SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE               DTSBU072
00555          GO TO P2130-EXIT.                                        DTSBU072
00556                                                                   DTSBU072
00557      IF FC-CITY-BYPASSED-88                                       DTSBU072
00558      OR FC-CITY-BAD-88                                            DTSBU072
00559          MOVE MSG-E084-AREA TO L072-MSG-AREA                      DTSBU072
00560          SET L072-CITY-NOT-VALID-88 TO TRUE                       DTSBU072
00561          GO TO P2130-EXIT.                                        DTSBU072
00562                                                                   DTSBU072
00563      IF FC-ZIP-BYPASSED-88                                        DTSBU072
00564      OR FC-ZIP-BAD-88                                             DTSBU072
00565          MOVE MSG-E083-AREA TO L072-MSG-AREA                      DTSBU072
00566          SET L072-ZIP-NOT-VALID-88 TO TRUE                        DTSBU072
00567          GO TO P2130-EXIT.                                        DTSBU072
00568                                                                   DTSBU072
00569      IF FC-BOTH-ADDR-BAD-88                                       DTSBU072
00570          MOVE MSG-E086-AREA TO L072-MSG-AREA                      DTSBU072
00571          SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE               DTSBU072
00572          GO TO P2130-EXIT.                                        DTSBU072
00573                                                                   DTSBU072
00574      IF FINAL-RETURN-CODE1  NOT =  '0'                            DTSBU072
00575          IF FC-SUFDIR-MULTI-88                                    DTSBU072
00576              MOVE MSG-E085-AREA TO L072-MSG-AREA                  DTSBU072
00577              SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE           DTSBU072
00578              GO TO P2130-EXIT                                     DTSBU072
00579          ELSE                                                     DTSBU072
00580              MOVE MSG-E082-AREA TO L072-MSG-AREA                  DTSBU072
00581              SET L072-ZIP-NOT-VALID-88 TO TRUE                    DTSBU072
00582              GO TO P2130-EXIT.                                    DTSBU072
00583  P2130-EXIT.                                                      DTSBU072
00584      EXIT.                                                        DTSBU072
00585      EJECT                                                        DTSBU072
00586  P2200-NO-CASS.                                                   DTSBU072
00587      DISPLAY 'P2200 NCAS '                                        DTSBU072
00588      IF (L072-DELIV-LINE-1 NOT = SPACES)                          DTSBU072
00589              AND                                                  DTSBU072
00590         (L072-DELIV-LINE-2 = SPACES)                              DTSBU072
00591          MOVE L072-DELIV-LINE-1 TO L072-DELIV-LINE-2              DTSBU072
00592          MOVE SPACES TO L072-DELIV-LINE-1                         DTSBU072
00593          SET L072-DELIV-LINE-1-CHANGED-88                         DTSBU072
00594              L072-DELIV-LINE-2-CHANGED-88 TO TRUE.                DTSBU072
00595                                                                   DTSBU072
00596      IF L072-DELIV-LINE-2 = SPACES                                DTSBU072
00597          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00598          SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE               DTSBU072
00599          GO TO P2200-EXIT.                                        DTSBU072
00600                                                                   DTSBU072
00601      IF L072-CITY = SPACE                                         DTSBU072
00602          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00603          SET L072-CITY-NOT-VALID-88 TO TRUE                       DTSBU072
00604          GO TO P2200-EXIT.                                        DTSBU072
00605                                                                   DTSBU072
00606      IF L072-ZIP = SPACES                                         DTSBU072
00607          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00608          SET L072-ZIP-NOT-VALID-88 TO TRUE                        DTSBU072
00609          GO TO P2200-EXIT.                                        DTSBU072
00610                                                                   DTSBU072
00611      IF L072-ZIP (1:5) NOT NUMERIC                                DTSBU072
00612      OR L072-ZIP (1:5) = '00000'                                  DTSBU072
00613          MOVE EMSG-FIELD-NOT-VALID TO L072-MSG-AREA               DTSBU072
00614          SET L072-ZIP-NOT-VALID-88 TO TRUE                        DTSBU072
00615      ELSE                                                         DTSBU072
00616      IF L072-ZIP (6:5)  NOT =  SPACE                              DTSBU072
00617          MOVE SPACE TO L072-ZIP (6:5)                             DTSBU072
00618          SET L072-ZIP-CHANGED-88 TO TRUE.                         DTSBU072
00619  P2200-EXIT.                                                      DTSBU072
00620      EXIT.                                                        DTSBU072
00621      EJECT                                                        DTSBU072
00622  P3000-FOREIGN-ADDRESS.                                           DTSBU072
00623      SET L072-NO-CASS-EDITS-88 TO TRUE.                           DTSBU072
00624                                                                   DTSBU072
00625      DISPLAY 'P3000 FORI '                                        DTSBU072
00626      IF L072-ZIP = ALL '*'                                        DTSBU072
00627          NEXT SENTENCE                                            DTSBU072
00628      ELSE                                                         DTSBU072
00629          MOVE ALL '*' TO L072-ZIP                                 DTSBU072
00630          SET L072-ZIP-CHANGED-88 TO TRUE.                         DTSBU072
00631                                                                   DTSBU072
00632      IF L072-DELIV-LINE-1 = SPACES                                DTSBU072
00633          SET L072-DELIV-LINE-1-NOT-VALID-88 TO TRUE               DTSBU072
00634          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00635          GO TO P3000-EXIT.                                        DTSBU072
00636                                                                   DTSBU072
00637      IF L072-DELIV-LINE-2 = SPACES                                DTSBU072
00638          SET L072-DELIV-LINE-2-NOT-VALID-88 TO TRUE               DTSBU072
00639          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00640          GO TO P3000-EXIT.                                        DTSBU072
00641                                                                   DTSBU072
00642      IF L072-CITY = SPACES                                        DTSBU072
00643          SET L072-CITY-NOT-VALID-88 TO TRUE                       DTSBU072
00644          MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA                DTSBU072
00645          GO TO P3000-EXIT.                                        DTSBU072
00646  P3000-EXIT.                                                      DTSBU072
00647      EXIT.                                                        DTSBU072
00648      EJECT                                                        DTSBU072
00649  S1000-LINK-TO-FINALIST.                                          DTSBU072
00650                                                                   DTSBU072
00651      CALL 'FINAL' USING FINAL-CALL-AREA.                          DTSBU072
00652                                                                   DTSBU072
00653  S1000-EXIT.                                                      DTSBU072
00654      EXIT.                                                        DTSBU072
00655      SKIP3                                                        DTSBU072
00656 ******************  S071-NAME-CONVERT NOT USED.                   DTSBU072
00657 *S071-NAME-CONVERT.                                               DTSBU072
00658 *    EXEC CICS                                                    DTSBU072
00659 *        LINK                                                     DTSBU072
00660 *            PROGRAM ('DTSCU071')                                 DTSBU072
00661 *            COMMAREA (L071-COMM-AREA)                            DTSBU072
00662 *    END-EXEC.                                                    DTSBU072
00663 *S071-EXIT.                                                       DTSBU072
00664 *    EXIT.                                                        DTSBU072
00665 *                                                                 DTSBU072
00666  S999-ABEND.                                                      DTSBU072
00667      DISPLAY '*** DTSBD383 ABENDING : '                           DTSBU072
00668              WRK-ABEND-MSG.                                       DTSBU072
00669                                                                   DTSBU072
00670      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBU072
00671  S999-EXIT.                                                       DTSBU072
00672      EXIT.                                                        DTSBU072
00673                                                                   DTSBU072
