00001  IDENTIFICATION DIVISION.                                         09/19/98
00002  PROGRAM-ID.             DTSCU203.                                DTSCU203
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           SEPTEMBER 1998.                             CL**2
00005  DATE-COMPILED.                                                   DTSCU203
00006      SKIP3                                                        DTSCU203
00007 *****                                                             DTSCU203
00008 *                                                                 DTSCU203
00009 *    FUNCTION:  DETERMINE FIELD ZIP CODE AND FIELD STATE CODE        CL**3
00010 *                                                                 DTSCU203
00011 *                                                                 DTSCU203
00012 *    MODIFICATION LOG:                                            DTSCU203
00013 *                                                                 DTSCU203
00014 *    09/02/1998  INITIAL DEVELOPMENT. MODIFIED FROM MACCU203.        CL**2
00015 *                WORK ORDER:                      PROGRAMMER: GD     CL**2
00016 *                                                                 DTSCU203
00017 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX    CL**2
00018 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX    CL**2
00019 *                WORK ORDER:                      PROGRAMMER: XXX    CL**2
00020 *                                                                 DTSCU203
00021 *                                                                 DTSCU203
00022 *    DESCRIPTION:                                                 DTSCU203
00023 *                                                                 DTSCU203
00024 *    DTSCU203 DETERMINES THE FIELD ZIP CODE AND FIELD STATE CODE.    CL**3
00025 *                                                                 DTSCU203
00026 *                                                                 DTSCU203
00027 *    SEE MPRF-FLD-ZIP, MPRF-FLD-STATE, MPRF-TAX-REC-ADDR-EXISTS-IN   CL**3
00028 *    IN THE DATA ELEMENT DEFINITIONS FOR A DESCRIPTION OF         DTSCU203
00029 *    THE REQUIRED LOGIC.                                          DTSCU203
00030 *                                                                 DTSCU203
00031 *                                                                 DTSCU203
00032 *    IF A NECESSARY MTAD RECORD IS NOT FOUND, THEN RETURN         DTSCU203
00033 *    L203-ADDR-NOT-FOUND-88.                                      DTSCU203
00034 *                                                                 DTSCU203
00035 *    IF THE MASTER FILE IS NOT AVAILABLE, THEN RETURN             DTSCU203
00036 *    L203-FILE-CLOSED-88.                                         DTSCU203
00037 *                                                                 DTSCU203
00038 *****                                                             DTSCU203
00039      SKIP3                                                        DTSCU203
00040  ENVIRONMENT DIVISION.                                            DTSCU203
00041      SKIP3                                                        DTSCU203
00042  DATA DIVISION.                                                   DTSCU203
00043      SKIP3                                                        DTSCU203
00044  WORKING-STORAGE SECTION.                                         DTSCU203
000445 77  PAN-VALET PICTURE X(24) VALUE '004DTSCU203  09/19/98'.       DTSCU203
00045      SKIP3                                                        DTSCU203
00046  01  WRK-AREA.                                                    DTSCU203
00047      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U203'.    DTSCU203
00048      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSCU203
00049      EJECT                                                        DTSCU203
00050  01  L810-COMM-AREA.                                              DTSCU203
00051      05  L810-CONTROL-AREA.                                       DTSCU203
00052  ++INCLUDE DTSIL810                                                  CL**2
00053      SKIP3                                                        DTSCU203
00054      05  MSKL-REC.                                                DTSCU203
00055  ++INCLUDE DTSIMSKL                                                  CL**2
00056      SKIP3                                                        DTSCU203
00057      05  MTAD-REC   REDEFINES   MSKL-REC.                         DTSCU203
00058  ++INCLUDE DTSIMTAD                                                  CL**2
00059      EJECT                                                        DTSCU203
00060  LINKAGE SECTION.                                                 DTSCU203
00061      SKIP3                                                        DTSCU203
00062  01  DFHCOMMAREA.                                                 DTSCU203
00063  ++INCLUDE DTSIL203                                                  CL**2
00064      EJECT                                                        DTSCU203
00065  PROCEDURE DIVISION.                                              DTSCU203
00066      SKIP2                                                        DTSCU203
00067      SET L203-OK-88 TO TRUE.                                      DTSCU203
00068      MOVE SPACE TO L203-FLD-ZIP                                   DTSCU203
00069                    L203-FLD-STATE                                    CL**3
00070                    L203-MSG-AREA.                                 DTSCU203
00071      SKIP1                                                        DTSCU203
00072      IF L203-TAX-REC-ADDR-NO-88                                      CL**2
00073          PERFORM P1000-READ-INITIALIZE THRU P1000-EXIT            DTSCU203
00074          MOVE +001 TO MTAD-ID-NO                                     CL**2
00075          PERFORM P2000-FIND-ZIP        THRU P2000-EXIT               CL**2
00076      ELSE                                                            CL**2
00077          PERFORM P1000-READ-INITIALIZE THRU P1000-EXIT               CL**2
00078          MOVE +002 TO MTAD-ID-NO                                     CL**2
00079          PERFORM P2000-FIND-ZIP        THRU P2000-EXIT.              CL**2
00080      SKIP1                                                        DTSCU203
00081      IF L203-OK-88                                                DTSCU203
00082          IF L203-FLD-ZIP = SPACE                                     CL**2
00083          OR L203-FLD-STATE = SPACE                                   CL**3
00084              SET L203-ADDR-NOT-FOUND-88 TO TRUE.                  DTSCU203
00085      SKIP2                                                        DTSCU203
00086  P0000-EXIT.                                                      DTSCU203
00087      SKIP2                                                        DTSCU203
00088      EXEC CICS                                                    DTSCU203
00089          RETURN                                                   DTSCU203
00090      END-EXEC.                                                    DTSCU203
00091      SKIP2                                                        DTSCU203
00092      GOBACK.                                                      DTSCU203
00093      EJECT                                                        DTSCU203
00094  P1000-READ-INITIALIZE.                                           DTSCU203
00095      MOVE LOW-VALUES     TO MTAD-KEY-AREA.                        DTSCU203
00096      MOVE L203-EMP-NO    TO MTAD-EMP-NO.                          DTSCU203
00097      SET MTAD-TAD-88 TO TRUE.                                     DTSCU203
00098  P1000-EXIT.                                                      DTSCU203
00099      EXIT.                                                        DTSCU203
00100      SKIP1                                                           CL**2
00101  P2000-FIND-ZIP.                                                     CL**2
00102      PERFORM S810-READ THRU S810-EXIT.                               CL**2
00103      IF L810-FILE-CLOSED-88                                          CL**2
00104          GO TO P2000-EXIT                                            CL**2
00105      ELSE                                                            CL**2
00106      IF L810-OK-88                                                   CL**2
00107          MOVE MTAD-ZIP TO L203-FLD-ZIP                               CL**3
00108          MOVE MTAD-ST  TO L203-FLD-STATE.                            CL**3
00109  P2000-EXIT.                                                         CL**2
00110      EXIT.                                                           CL**2
00111      SKIP1                                                           CL**2
00112      EJECT                                                        DTSCU203
00113  S810-READ.                                                       DTSCU203
00114      SET L810-READ-88 TO TRUE.                                    DTSCU203
00115      GO TO S810-MSTR-IO.                                          DTSCU203
00116      SKIP1                                                        DTSCU203
00117  S810-MSTR-IO.                                                    DTSCU203
00118      SKIP1                                                        DTSCU203
00119      EXEC CICS                                                    DTSCU203
00120          LINK                                                     DTSCU203
00121              PROGRAM('DTSCU810')                                     CL**4
00122              COMMAREA(L810-COMM-AREA)                             DTSCU203
00123      END-EXEC.                                                    DTSCU203
00124      SKIP1                                                        DTSCU203
00125      IF L810-FILE-CLOSED-88                                       DTSCU203
00126          SET L203-FILE-CLOSED-88 TO TRUE                          DTSCU203
00127          MOVE L810-MSG-AREA TO L203-MSG-AREA.                     DTSCU203
00128  S810-EXIT.                                                       DTSCU203
00129      EXIT.                                                        DTSCU203
00130      SKIP3                                                        DTSCU203
00131 ******************  S899-ABEND NOT USED.                          DTSCU203
00132 *S899-ABEND.                                                      DTSCU203
00133 *    SKIP1                                                        DTSCU203
00134 *    EXEC CICS                                                    DTSCU203
00135 *        ABEND                                                    DTSCU203
00136 *            ABCODE (WRK-ABEND-CODE)                              DTSCU203
00137 *    END-EXEC.                                                    DTSCU203
00138 *    SKIP1                                                        DTSCU203
00139 *S899-EXIT.                                                       DTSCU203
00140 *    EXIT.                                                        DTSCU203
