00001 IDENTIFICATION DIVISION. 10/15/98 00002 PROGRAM-ID. DTSCU111. DTSCU111 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005 00004 DATE-WRITTEN. OCTOBER 1998. CL**2 00005 DATE-COMPILED. DTSCU111 00006 SKIP3 DTSCU111 00007 ***** DTSCU111 00008 * DTSCU111 00009 * FUNCTION: ADDRESS LOOKUP. DTSCU111 00010 * DTSCU111 00011 * DTSCU111 00012 * MODIFICATION LOG: DTSCU111 00013 * DTSCU111 00014 * 10/06/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCU111. CL**2 00015 * WORK ORDER: PROGRAMMER: GD CL**2 00016 * DTSCU111 00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00019 * WORK ORDER: PROGRAMMER: XXX CL**2 00020 * DTSCU111 00021 * DTSCU111 00022 * DESCRIPTION: DTSCU111 00023 * DTSCU111 00024 * DTSCU111 LOOKS UP AN EMPLOYER ADDRESS. CL**2 00025 * DTSCU111 00026 * IF L111-LOOKUP-TAD-MAIL-88 (MAILING ADDRESS REQUESTED) CL**2 00027 * READ THE MTAD RECORD INDICATED BY L111-EMP-NO CL**3 00028 * L111-ID-NO SHOULD BE SET TO L111-ID-NO-TAD-88 CL**4 00029 * RETURN L111-ADDRESS FROM MTAD-ADDRESS DTSCU111 00030 * CL**2 00031 * IF L111-LOOKUP-TAA-88 DTSCU111 00032 * READ THE MTAA RECORD INDICATED BY L111-EMP-NO, L111-ID-NODTSCU111 00033 * RETURN L111-NAME FROM MTAA-NAME (MAY = SPACES) CL**2 00034 * RETURN L111-ADDRESS FROM MTAA-ADDRESS. CL**2 00035 * DTSCU111 00036 * IF L111-LOOKUP-OPO-88 DTSCU111 00037 * READ THE MOPO RECORD INDICATED BY L111-EMP-NO, L111-ID-NODTSCU111 00038 * RETURN L111-ADDRESS-NAME FROM MOPO-NAME DTSCU111 00039 * RETURN L111-ADDRESS FROM MOPO-ADDRESS. DTSCU111 00040 * DTSCU111 00041 * IF L111-LOOKUP-BAA-88 DTSCU111 00042 * READ THE MBAA RECORD INDICATED BY L111-EMP-NO CL**3 00043 * L111-ID-NO SHOULD BE SET TO L111-ID-NO-BAA-PRIM-88 CL**4 00044 * RETURN L111-ADDRESS-NAME FROM MBAA-NAME DTSCU111 00045 * RETURN L111-ADDRESS FROM MBAA-ADDRESS. DTSCU111 00046 * DTSCU111 00047 * DTSCU111 00048 * IF A MASTER FILE RECORD IS NOT FOUND, THEN RETURN DTSCU111 00049 * L111-ADDR-NOT-FOUND-88. CL**2 00050 * DTSCU111 00051 * IF THE MASTER FILE IS NOT AVAILABLE, THEN RETURN DTSCU111 00052 * L111-FILE-CLOSED-88. DTSCU111 00053 * DTSCU111 00054 ***** DTSCU111 00055 SKIP3 DTSCU111 00056 ENVIRONMENT DIVISION. DTSCU111 00057 SKIP3 DTSCU111 00058 DATA DIVISION. DTSCU111 00059 SKIP3 DTSCU111 00060 WORKING-STORAGE SECTION. DTSCU111 000605 77 PAN-VALET PICTURE X(24) VALUE '005DTSCU111 10/15/98'. DTSCU111 00061 SKIP3 DTSCU111 00062 01 WRK-AREA. DTSCU111 00063 05 WRK-ABEND-CODE PIC X(04) VALUE 'U111'. DTSCU111 00064 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU111 00065 EJECT DTSCU111 00066 01 L810-COMM-AREA. DTSCU111 00067 05 L810-CONTROL-AREA. DTSCU111 00068 ++INCLUDE DTSIL810 CL**2 00069 SKIP3 DTSCU111 00070 05 MSKL-REC. DTSCU111 00071 ++INCLUDE DTSIMSKL CL**2 00072 SKIP3 DTSCU111 00073 01 MTAD-REC. DTSCU111 00074 ++INCLUDE DTSIMTAD CL**2 00075 EJECT DTSCU111 00076 01 MTAA-REC. DTSCU111 00077 ++INCLUDE DTSIMTAA CL**2 00078 EJECT DTSCU111 00079 01 MOPO-REC. DTSCU111 00080 ++INCLUDE DTSIMOPO CL**2 00081 EJECT DTSCU111 00082 01 MBAA-REC. DTSCU111 00083 ++INCLUDE DTSIMBAA CL**2 00084 EJECT DTSCU111 00085 LINKAGE SECTION. DTSCU111 00086 SKIP3 DTSCU111 00087 01 DFHCOMMAREA. DTSCU111 00088 ++INCLUDE DTSIL111 CL**2 00089 EJECT DTSCU111 00090 PROCEDURE DIVISION. DTSCU111 00091 SKIP2 DTSCU111 00092 SET L111-ADDR-NOT-FOUND-88 TO TRUE. DTSCU111 00093 MOVE SPACE TO L111-RETURN-AREA DTSCU111 00094 L111-MSG-AREA. DTSCU111 00095 SKIP1 DTSCU111 00096 EVALUATE TRUE DTSCU111 00097 WHEN L111-LOOKUP-TAD-88 CL**2 00098 PERFORM P1000-TAD THRU P1000-EXIT DTSCU111 00099 WHEN L111-LOOKUP-TAA-88 DTSCU111 00100 PERFORM P2000-TAA THRU P2000-EXIT DTSCU111 00101 WHEN L111-LOOKUP-OPO-88 DTSCU111 00102 PERFORM P3000-OPO THRU P3000-EXIT DTSCU111 00103 WHEN L111-LOOKUP-BAA-88 DTSCU111 00104 PERFORM P4000-BAA THRU P4000-EXIT DTSCU111 00105 WHEN OTHER DTSCU111 00106 PERFORM S899-ABEND THRU S899-EXIT. DTSCU111 00107 SKIP2 DTSCU111 00108 EXEC CICS DTSCU111 00109 RETURN DTSCU111 00110 END-EXEC. DTSCU111 00111 SKIP2 DTSCU111 00112 GOBACK. DTSCU111 00113 EJECT DTSCU111 00114 P1000-TAD. DTSCU111 00115 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCU111 00116 MOVE L111-EMP-NO TO MTAD-EMP-NO. DTSCU111 00117 MOVE L111-ID-NO TO MTAD-ID-NO. CL**5 00118 SET MTAD-TAD-88 TO TRUE. DTSCU111 00119 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCU111 00120 PERFORM S810-READ THRU S810-EXIT. DTSCU111 00121 IF L810-OK-88 DTSCU111 00122 MOVE MSKL-REC TO MTAD-REC DTSCU111 00123 DTSCU111 00124 SET L111-ADDR-FOUND-88 TO TRUE DTSCU111 00125 MOVE MTAD-ADDRESS TO L111-ADDRESS. CL**2 00126 P1000-EXIT. DTSCU111 00127 EXIT. DTSCU111 00128 EJECT DTSCU111 00129 P2000-TAA. CL**2 00130 DTSCU111 00131 MOVE LOW-VALUES TO MTAA-KEY-AREA. CL**2 00132 MOVE L111-EMP-NO TO MTAA-EMP-NO. CL**2 00133 SET MTAA-TAA-88 TO TRUE. CL**2 00134 MOVE L111-ID-NO TO MTAA-ID-NO. CL**2 00135 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. CL**2 00136 PERFORM S810-READ THRU S810-EXIT. CL**2 00137 IF L810-OK-88 CL**2 00138 MOVE MSKL-REC TO MTAA-REC CL**2 00139 DTSCU111 00140 IF MTAA-ADDRESS = SPACES OR LOW-VALUES CL**2 00141 NEXT SENTENCE CL**2 00142 ELSE CL**2 00143 SET L111-ADDR-FOUND-88 TO TRUE CL**2 00144 MOVE MTAA-NAME TO L111-NAME CL**2 00145 MOVE MTAA-ADDRESS TO L111-ADDRESS. CL**2 00146 P2000-EXIT. DTSCU111 00147 EXIT. DTSCU111 00148 EJECT DTSCU111 00149 P3000-OPO. DTSCU111 00150 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCU111 00151 MOVE L111-EMP-NO TO MOPO-EMP-NO. DTSCU111 00152 SET MOPO-OPO-88 TO TRUE. DTSCU111 00153 MOVE L111-ID-NO TO MOPO-ID-NO. DTSCU111 00154 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCU111 00155 PERFORM S810-READ THRU S810-EXIT. DTSCU111 00156 IF L810-OK-88 DTSCU111 00157 MOVE MSKL-REC TO MOPO-REC DTSCU111 00158 DTSCU111 00159 IF MOPO-ADDRESS = LOW-VALUES OR SPACES DTSCU111 00160 NEXT SENTENCE DTSCU111 00161 ELSE DTSCU111 00162 SET L111-ADDR-FOUND-88 TO TRUE DTSCU111 00163 MOVE MOPO-NAME TO L111-NAME DTSCU111 00164 MOVE MOPO-TITLE TO L111-TITLE DTSCU111 00165 MOVE MOPO-ADDRESS TO L111-ADDRESS. DTSCU111 00166 P3000-EXIT. DTSCU111 00167 EXIT. DTSCU111 00168 SKIP3 DTSCU111 00169 P4000-BAA. DTSCU111 00170 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSCU111 00171 MOVE L111-EMP-NO TO MBAA-EMP-NO. DTSCU111 00172 MOVE L111-ID-NO TO MBAA-ID-NO. CL**5 00173 SET MBAA-BAA-88 TO TRUE. DTSCU111 00174 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSCU111 00175 PERFORM S810-READ THRU S810-EXIT. DTSCU111 00176 IF L810-OK-88 DTSCU111 00177 MOVE MSKL-REC TO MBAA-REC DTSCU111 00178 DTSCU111 00179 IF MBAA-ADDRESS = SPACES OR LOW-VALUES DTSCU111 00180 NEXT SENTENCE DTSCU111 00181 ELSE DTSCU111 00182 SET L111-ADDR-FOUND-88 TO TRUE DTSCU111 00183 MOVE MBAA-NAME TO L111-NAME DTSCU111 00184 MOVE MBAA-ADDRESS TO L111-ADDRESS. DTSCU111 00185 P4000-EXIT. DTSCU111 00186 EXIT. DTSCU111 00187 EJECT DTSCU111 00188 S810-READ. DTSCU111 00189 SET L810-READ-88 TO TRUE. DTSCU111 00190 GO TO S810-MSTR-IO. DTSCU111 00191 SKIP1 DTSCU111 00192 S810-MSTR-IO. DTSCU111 00193 SKIP1 DTSCU111 00194 EXEC CICS DTSCU111 00195 LINK DTSCU111 00196 PROGRAM('DTSCU810') CL**2 00197 COMMAREA(L810-COMM-AREA) DTSCU111 00198 END-EXEC. DTSCU111 00199 SKIP1 DTSCU111 00200 IF L810-FILE-CLOSED-88 DTSCU111 00201 SET L111-FILE-CLOSED-88 TO TRUE DTSCU111 00202 MOVE L810-MSG-AREA TO L111-MSG-AREA. DTSCU111 00203 S810-EXIT. DTSCU111 00204 EXIT. DTSCU111 00205 SKIP3 DTSCU111 00206 S899-ABEND. DTSCU111 00207 SKIP1 DTSCU111 00208 EXEC CICS DTSCU111 00209 ABEND DTSCU111 00210 ABCODE (WRK-ABEND-CODE) DTSCU111 00211 END-EXEC. DTSCU111 00212 SKIP1 DTSCU111 00213 S899-EXIT. DTSCU111 00214 EXIT. DTSCU111