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
