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