00001  IDENTIFICATION DIVISION.                                         10/20/98
00002  PROGRAM-ID.             DTSBU112.                                DTSBU112
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           JULY 1994.                               DTSBU112
00005  DATE-COMPILED.                                                   DTSBU112
00006      SKIP3                                                        DTSBU112
00007 *****                                                             DTSBU112
00008 *                                                                 DTSBU112
00009 *    FUNCTION:  FORMAT ADDRESS FOR MAILING.                       DTSBU112
00010 *                                                                 DTSBU112
00011 *                                                                 DTSBU112
00012 *    MODIFICATION LOG:                                            DTSBU112
00013 *                                                                 DTSBU112
00014 *    09/17/98  CLONED FROM MACCU112.                                 CL**2
00015 *              WORK ORDER:                      PROGRAMMER: ZL1.     CL**2
00016 *                                                                 DTSBU112
00017 *    10/20/1998  REVIEWED AND MODIFIED FOR DC.                       CL**3
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**3
00019 *                                                                 DTSBU112
00020 *                                                                 DTSBU112
00021 *    DESCRIPTION:                                                 DTSBU112
00022 *                                                                 DTSBU112
00023 *    DTSBU112 FORMATS L112-NAME-ADDRESS-AREA FOR MAILING             CL**2
00024 *    (INTO L112-MAILING-ADDDRESS).                                DTSBU112
00025 *                                                                 DTSBU112
00026 *    SEE SECTION 3 OF ISSUE NUMBER 13.                            DTSBU112
00027 *                                                                 DTSBU112
00028 *    IF L112-ANCHOR-LAST-88                                       DTSBU112
00029 *        L112-MAILING-LINE-5 IS ALWAYS OCCUPIED                   DTSBU112
00030 *    ELSE                                                         DTSBU112
00031 *    IF L112-ANCHOR-FIRST-88                                      DTSBU112
00032 *        L112-MAILING-LINE-1 IS ALWAYS OCCUPIED.                  DTSBU112
00033 *                                                                 DTSBU112
00034 *                                                                 DTSBU112
00035 *    THE USE OF L111-BUSINESS-NAME AND L111-ADDRESS-NAME IS       DTSBU112
00036 *    A BIT TRICKY.                                                DTSBU112
00037 *                                                                 DTSBU112
00038 *    IF L112-TAD-ADDR-88                                          DTSBU112
00039 *        USE L112-BUSINESS-NAME                                   DTSBU112
00040 *        IF L112-ADDRESS-NAME IS NOT EQUAL TO SPACES              DTSBU112
00041 *            L112-ADDRESS-NAME IS AN OPO NAME                     DTSBU112
00042 *            CONVERT L112-ADDRESS-NAME (USING DTSBU071)              CL**2
00043 *            USE CONVERTED L112-ADDRESS-NAME (AS INDICATED IN ISSUDTSBU112
00044 *                                             STATEMENT).         DTSBU112
00045 *                                                                 DTSBU112
00046 *    IF L112-TAA-ADDR-88                                          DTSBU112
00047 *        USE L112-ADDRESS-NAME                                    DTSBU112
00048 *        IGNORE L112-BUSINESS-NAME.                               DTSBU112
00049 *                                                                 DTSBU112
00050 *    IF L112-OPO-ADDR-88                                          DTSBU112
00051 *        CONVERT L112-ADDRESS-NAME (USING DTSBU071)                  CL**2
00052 *        USE CONVERTED L112-ADDRESS-NAME                          DTSBU112
00053 *        USE L112-BUSINESS-NAME (AS INDICATED IN ISSUE STATEMENT).DTSBU112
00054 *                                                                 DTSBU112
00055 *    IF L112-BAA-ADDR-88                                          DTSBU112
00056 *         USE L112-ADDRESS-NAME                                   DTSBU112
00057 *         IGNORE L112-BUSINESS-NAME.                              DTSBU112
00058 *                                                                 DTSBU112
00059 *    IF L112-FID-MAILING-ADDR-88 OR L112-FID-PHYSICAL-ADDR-88     DTSBU112
00060 *        CONVERT L112-ADRESS-NAME (USING DTSBU071)                   CL**2
00061 *        USE CONVERTED L112-ADDRESS-NAME                          DTSBU112
00062 *        IGNORE L112-BUSINESS-NAME.                               DTSBU112
00063 *                                                                 DTSBU112
00064 *****                                                             DTSBU112
00065      SKIP3                                                        DTSBU112
00066  ENVIRONMENT DIVISION.                                            DTSBU112
00067      SKIP3                                                        DTSBU112
00068  DATA DIVISION.                                                   DTSBU112
00069      SKIP3                                                        DTSBU112
00070  WORKING-STORAGE SECTION.                                         DTSBU112
000705 77  PAN-VALET PICTURE X(24) VALUE '004DTSBU112  10/20/98'.       DTSBU112
00071      SKIP3                                                        DTSBU112
00072  01  WRK-AREA.                                                    DTSBU112
00073      05  WRK-ABEND-CODE              PIC S9(04)  COMP             DTSBU112
00074                                                  VALUE +112.      DTSBU112
00075                                                                      CL**3
00076      05  WRK-PTR                     PIC S9(04)  COMP.            DTSBU112
00077                                                                      CL**3
00078      05  WRK-PTR-NEW                 PIC S9(04)  COMP.            DTSBU112
00079      EJECT                                                        DTSBU112
00080  01  L071-LINK-AREA.                                              DTSBU112
00081  ++INCLUDE DTSIL071                                                  CL**2
00082      EJECT                                                        DTSBU112
00083  01  C072-LITERALS.                                               DTSBU112
00084  ++INCLUDE DTSIC072                                                  CL**2
00085      EJECT                                                        DTSBU112
00086  LINKAGE SECTION.                                                 DTSBU112
00087      SKIP3                                                        DTSBU112
00088  01  L112-LINK-AREA.                                              DTSBU112
00089  ++INCLUDE DTSIL112                                                  CL**2
00090      EJECT                                                        DTSBU112
00091  PROCEDURE DIVISION                                               DTSBU112
00092      USING L112-LINK-AREA.                                        DTSBU112
00093                                                                   DTSBU112
00094      MOVE SPACE TO L112-MAILING-ADDRESS.                          DTSBU112
00095                                                                   DTSBU112
00096      MOVE L112-ST TO C072-ST.                                     DTSBU112
00097                                                                   DTSBU112
00098      IF C072-FOREIGN-88                                           DTSBU112
00099          MOVE L112-CITY TO L112-MAILING-LINE (5)                  DTSBU112
00100          MOVE +4 TO WRK-PTR                                       DTSBU112
00101      ELSE                                                         DTSBU112
00102      IF C072-CANADA-88                                            DTSBU112
00103          MOVE 'CANADA' TO L112-MAILING-LINE (5)                   DTSBU112
00104          MOVE +4 TO WRK-PTR                                       DTSBU112
00105      ELSE                                                         DTSBU112
00106          MOVE +5 TO WRK-PTR.                                      DTSBU112
00107                                                                   DTSBU112
00108      IF C072-FOREIGN-88                                           DTSBU112
00109          NEXT SENTENCE                                            DTSBU112
00110      ELSE                                                         DTSBU112
00111          STRING L112-CITY ' '                                     DTSBU112
00112                 L112-ST   ' '  ' '                                DTSBU112
00113                 L112-ZIP                                          DTSBU112
00114              DELIMITED BY '  '                                    DTSBU112
00115              INTO L112-MAILING-LINE (WRK-PTR)                     DTSBU112
00116          SUBTRACT +1 FROM WRK-PTR.                                DTSBU112
00117                                                                   DTSBU112
00118      IF L112-DELIV-LINE-2 NOT = SPACE                                CL**3
00119          MOVE L112-DELIV-LINE-2 TO L112-MAILING-LINE (WRK-PTR)       CL**3
00120          SUBTRACT +1 FROM WRK-PTR.                                DTSBU112
00121                                                                      CL**3
00122      IF L112-DELIV-LINE-1 NOT = SPACE                                CL**3
00123          MOVE L112-DELIV-LINE-1 TO L112-MAILING-LINE (WRK-PTR)       CL**3
00124          SUBTRACT +1 FROM WRK-PTR.                                   CL**3
00125                                                                   DTSBU112
00126      IF L112-ATTN-LINE  NOT =  SPACE                                 CL**3
00127          MOVE L112-ATTN-LINE TO L112-MAILING-LINE (WRK-PTR)       DTSBU112
00128          SUBTRACT +1 FROM WRK-PTR.                                DTSBU112
00129                                                                   DTSBU112
00130      IF L112-TAD-ADDR-88                                          DTSBU112
00131          PERFORM P1000-PRIMARY-NAME THROUGH P1000-EXIT               CL**3
00132      ELSE                                                         DTSBU112
00133      IF L112-TAA-ADDR-88                                          DTSBU112
00134      OR L112-BAA-ADDR-88                                          DTSBU112
00135          PERFORM P2000-ADDRESS-NAME THROUGH P2000-EXIT               CL**3
00136      ELSE                                                         DTSBU112
00137      IF L112-OPO-ADDR-88                                          DTSBU112
00138      OR L112-FID-MAILING-ADDR-88                                  DTSBU112
00139      OR L112-FID-PHYSICAL-ADDR-88                                 DTSBU112
00140          PERFORM P3000-ADDRESS-CONVERT THROUGH P3000-EXIT            CL**3
00141      ELSE                                                         DTSBU112
00142          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU112
00143                                                                   DTSBU112
00144 *****IF WRK-PTR  NOT =  +0                                           CL**3
00145 *********IF L112-TAD-ADDR-88                                         CL**3
00146 ************ PERFORM P3000-ADDRESS-CONVERT   THROUGH P3000-EXIT      CL**3
00147 *********ELSE                                                        CL**3
00148 *********IF L112-OPO-ADDR-88                                         CL**3
00149 *************PERFORM P1000-PRIMARY-NAME      THROUGH P1000-EXIT.     CL**4
00150                                                                   DTSBU112
00151      IF  L112-ANCHOR-FIRST-88                                     DTSBU112
00152      AND WRK-PTR  NOT =  +0                                       DTSBU112
00153          ADD +1 TO WRK-PTR                                        DTSBU112
00154          MOVE +1 TO WRK-PTR-NEW                                   DTSBU112
00155          PERFORM P5000-ANCHOR-FIRST THROUGH P5000-EXIT               CL**3
00156                  UNTIL WRK-PTR  GREATER THAN  +5.                 DTSBU112
00157      SKIP2                                                        DTSBU112
00158      GOBACK.                                                      DTSBU112
00159      EJECT                                                        DTSBU112
00160  P1000-PRIMARY-NAME.                                                 CL**4
00161      IF L112-PRIMARY-NAME = SPACES OR LOW-VALUES                     CL**3
00162          NEXT SENTENCE                                               CL**3
00163      ELSE                                                            CL**3
00164          MOVE L112-PRIMARY-NAME TO L112-MAILING-LINE (WRK-PTR)       CL**3
00165          SUBTRACT +1 FROM WRK-PTR.                                DTSBU112
00166  P1000-EXIT.                                                      DTSBU112
00167      EXIT.                                                        DTSBU112
00168      SKIP3                                                        DTSBU112
00169  P2000-ADDRESS-NAME.                                              DTSBU112
00170      IF L112-NAME  = SPACES OR LOW-VALUES                            CL**3
00171          IF L112-PRIMARY-NAME = SPACES OR LOW-VALUES                 CL**3
00172              NEXT SENTENCE                                           CL**3
00173          ELSE                                                        CL**3
00174              MOVE L112-PRIMARY-NAME TO L112-MAILING-LINE (WRK-PTR)   CL**3
00175              SUBTRACT +1 FROM WRK-PTR                                CL**3
00176      ELSE                                                            CL**3
00177          MOVE L112-NAME TO L112-MAILING-LINE (WRK-PTR)            DTSBU112
00178          SUBTRACT +1 FROM WRK-PTR.                                DTSBU112
00179  P2000-EXIT.                                                      DTSBU112
00180      EXIT.                                                        DTSBU112
00181      SKIP3                                                        DTSBU112
00182  P3000-ADDRESS-CONVERT.                                           DTSBU112
00183      IF L112-NAME = SPACES OR LOW-VALUES                          DTSBU112
00184          NEXT SENTENCE                                            DTSBU112
00185      ELSE                                                         DTSBU112
00186          SET L071-FROM-LAST-NAME-FIRST TO TRUE                    DTSBU112
00187          MOVE L112-NAME TO L071-NAM                               DTSBU112
00188          PERFORM S071-NAME-CONVERT THROUGH S071-EXIT                 CL**3
00189          IF L112-TITLE = SPACES OR LOW-VALUES                     DTSBU112
00190              MOVE L071-NAM TO L112-MAILING-LINE (WRK-PTR)         DTSBU112
00191              SUBTRACT +1 FROM WRK-PTR                             DTSBU112
00192          ELSE                                                     DTSBU112
00193              STRING L071-NAM             DELIMITED BY '  '        DTSBU112
00194                     '  '                 DELIMITED BY SIZE        DTSBU112
00195                     L112-TITLE           DELIMITED BY '  '        DTSBU112
00196                INTO                                               DTSBU112
00197                  L112-MAILING-LINE (WRK-PTR)                      DTSBU112
00198              SUBTRACT +1 FROM WRK-PTR.                            DTSBU112
00199  P3000-EXIT.                                                      DTSBU112
00200      EXIT.                                                        DTSBU112
00201      EJECT                                                        DTSBU112
00202  P5000-ANCHOR-FIRST.                                              DTSBU112
00203      MOVE L112-MAILING-LINE (WRK-PTR)                             DTSBU112
00204        TO L112-MAILING-LINE (WRK-PTR-NEW).                           CL**3
00205                                                                      CL**3
00206      MOVE SPACE TO L112-MAILING-LINE (WRK-PTR).                      CL**3
00207                                                                      CL**3
00208      ADD +1 TO WRK-PTR.                                           DTSBU112
00209                                                                      CL**3
00210      ADD +1 TO WRK-PTR-NEW.                                       DTSBU112
00211  P5000-EXIT.                                                      DTSBU112
00212      EXIT.                                                        DTSBU112
00213      EJECT                                                        DTSBU112
00214  S071-NAME-CONVERT.                                               DTSBU112
00215      CALL 'DTSBU071'                                                 CL**2
00216          USING L071-LINK-AREA.                                    DTSBU112
00217  S071-EXIT.                                                       DTSBU112
00218      EXIT.                                                        DTSBU112
00219      SKIP3                                                        DTSBU112
00220  S999-ABEND.                                                      DTSBU112
00221      CALL 'DTSBU999'                                                 CL**2
00222          USING WRK-ABEND-CODE.                                    DTSBU112
00223  S999-EXIT.                                                       DTSBU112
00224      EXIT.                                                        DTSBU112
