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