00001  IDENTIFICATION DIVISION.                                         06/02/99
00002  PROGRAM-ID.             DTSBD313.                                DTSBD313
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           JULY 1994.                               DTSBD313
00005  DATE-COMPILED.                                                   DTSBD313
00006      SKIP3                                                        DTSBD313
00007 *****                                                             DTSBD313
00008 *                                                                 DTSBD313
00009 *    FUNCTION:  INACTIVATION LETTER.                              DTSBD313
00010 *                                                                 DTSBD313
00011 *                                                                 DTSBD313
00012 *    MODIFICATION LOG:                                            DTSBD313
00013 *                                                                 DTSBD313
00014 *    07/19/94  CLONED FROM DTSBD312.                                 CL**2
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBD313
00016 *                                                                 DTSBD313
00017 *    10/27/1998  REVIEWED AND MODIFIED FOR DC.                       CL**2
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00019 *                                                                    CL**2
00020 *    06/02/1999  MODIFIED TO PROCESS T001-INACT-LTR-8ZEROWAGE-88     CL**4
00021 *                VALUE AND R117-8ZEROWAGE-88 VALUE.                  CL**4
00022 *                REFERENCE: 119R2 TO 117R3      PROGRAMMER: EHH      CL**4
00023 *                                                                    CL**4
00024 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**4
00025 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**4
00026 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**4
00027 *                                                                 DTSBD313
00028 *                                                                 DTSBD313
00029 *  DESCRIPTION:                                                   DTSBD313
00030 *                                                                 DTSBD313
00031 *      IF, FOR A GIVEN EMP-NO, DTSBD313 IS CALLED MORE THAN ONCE,    CL**2
00032 *      THEN BYPASS PROCESSING ON ALL CALLS OTHER THAN THE FIRST.  DTSBD313
00033 *                                                                 DTSBD313
00034 *      GENERATE A R117 RECORD.                                    DTSBD313
00035 *                                                                 DTSBD313
00036 *      PLEASE SEE PRINTED OUTPUTS DESCRIPTIONS AND LAYOUTS        DTSBD313
00037 *      FOR FURTHER INFORMATION.                                   DTSBD313
00038 *                                                                 DTSBD313
00039 *                                                                 DTSBD313
00040 *      MASTER FILE RECORDS READ:                                  DTSBD313
00041 *                                                                 DTSBD313
00042 *        NONE                                                     DTSBD313
00043 *                                                                 DTSBD313
00044 *                                                                 DTSBD313
00045 *      MASTER FILE RECORDS UPDATED:                               DTSBD313
00046 *                                                                 DTSBD313
00047 *        NONE                                                     DTSBD313
00048 *                                                                 DTSBD313
00049 *                                                                 DTSBD313
00050 *      REPORT RECORDS WRITTEN:                                    DTSBD313
00051 *                                                                 DTSBD313
00052 *        R117  INACTIVATION LETTER.                               DTSBD313
00053 *                                                                 DTSBD313
00054 *                                                                 DTSBD313
00055 *      MODULES CALLED:                                            DTSBD313
00056 *                                                                 DTSBD313
00057 *        DTSBU111 ADDRESS LOOKUP.                                    CL**2
00058 *        DTSBU112 ADDRESS FORMAT.                                    CL**2
00059 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.        CL**2
00060 *                                                                 DTSBD313
00061 *                                                                 DTSBD313
00062 *****                                                             DTSBD313
00063      SKIP3                                                        DTSBD313
00064  ENVIRONMENT DIVISION.                                            DTSBD313
00065      SKIP3                                                        DTSBD313
00066  DATA DIVISION.                                                   DTSBD313
00067      EJECT                                                        DTSBD313
00068  WORKING-STORAGE SECTION.                                         DTSBD313
000685 77  PAN-VALET PICTURE X(24) VALUE '004DTSBD313  06/02/99'.       DTSBD313
00069      SKIP3                                                        DTSBD313
00070  01  WRK-AREA.                                                    DTSBD313
00071      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +313.DTSBD313
00072                                                                      CL**2
00073      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD313'.   CL**2
00074                                                                      CL**2
00075      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBD313
00076                                                                      CL**2
00077      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSBD313
00078      SKIP3                                                        DTSBD313
00079  01  MSG-TABLE.                                                   DTSBD313
00080      05  MSG1-ADDRESS-MISSING.                                    DTSBD313
00081          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD313909'.        CL**2
00082          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'ADDRESS MISSING'. DTSBD313
00083          10  MSG1-LONG-TEXT.                                      DTSBD313
00084              15  FILLER      PIC  X(30)                           DTSBD313
00085                    VALUE 'TRANSACTION FAILED - EXPECTED '.        DTSBD313
00086              15  FILLER      PIC  X(30)                           DTSBD313
00087                    VALUE 'ADDRESS NOT FOUND             '.        DTSBD313
00088      EJECT                                                        DTSBD313
00089  01  L111-LINK-AREA.                                              DTSBD313
00090  ++INCLUDE DTSIL111                                                  CL**2
00091      EJECT                                                        DTSBD313
00092  01  L112-LINK-AREA.                                              DTSBD313
00093  ++INCLUDE DTSIL112                                                  CL**2
00094      EJECT                                                        DTSBD313
00095  01  R117-REC.                                                    DTSBD313
00096  ++INCLUDE DTSIR117                                                  CL**2
00097      EJECT                                                        DTSBD313
00098  LINKAGE SECTION.                                                 DTSBD313
00099      SKIP3                                                        DTSBD313
00100  01  LBCM-LINK-AREA.                                              DTSBD313
00101  ++INCLUDE DTSILBCM                                                  CL**2
00102      EJECT                                                        DTSBD313
00103  01  MPRF-REC.                                                    DTSBD313
00104  ++INCLUDE DTSIMPRF                                                  CL**2
00105      EJECT                                                        DTSBD313
00106  01  T001-REC.                                                    DTSBD313
00107  ++INCLUDE DTSIT001                                                  CL**2
00108      EJECT                                                        DTSBD313
00109  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD313
00110                           MPRF-REC                                DTSBD313
00111                           T001-REC.                               DTSBD313
00112                                                                      CL**2
00113      IF FIRST-TIME-IND = 'Y'                                      DTSBD313
00114          PERFORM I0000-INITIATE THRU I0000-EXIT                   DTSBD313
00115          MOVE 'N' TO FIRST-TIME-IND.                              DTSBD313
00116                                                                      CL**2
00117      IF MPRF-EMP-NO  NOT =  WRK-EMP-NO                            DTSBD313
00118          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBD313
00119          MOVE MPRF-EMP-NO TO WRK-EMP-NO.                          DTSBD313
00120                                                                      CL**2
00121      GOBACK.                                                      DTSBD313
00122      SKIP3                                                        DTSBD313
00123  I0000-INITIATE.                                                  DTSBD313
00124      MOVE +0 TO WRK-EMP-NO.                                       DTSBD313
00125                                                                      CL**2
00126      SET L111-LOOKUP-TAD-88 TO TRUE.                                 CL**2
00127                                                                      CL**2
00128      SET L112-TAD-ADDR-88 TO TRUE.                                   CL**2
00129                                                                      CL**2
00130      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSBD313
00131                                                                      CL**2
00132      MOVE LENGTH OF R117-REC TO R117-LENGTH.                         CL**2
00133  I0000-EXIT. EXIT.                                                DTSBD313
00134      EJECT                                                        DTSBD313
00135  P0000-PROCESS.                                                   DTSBD313
00136      MOVE MPRF-EMP-NO TO L111-EMP-NO.                                CL**3
00137                                                                      CL**3
00138      SET L111-ID-NO-TAD-MAIL-88 TO TRUE.                             CL**3
00139                                                                      CL**3
00140      PERFORM S111-LOOKUP-ADDRESS THRU S111-EXIT.                  DTSBD313
00141                                                                      CL**3
00142      IF L111-ADDR-NOT-FOUND-88                                    DTSBD313
00143          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD313
00144          MOVE MSG1-ADDRESS-MISSING TO LBCM-TRN-MSG-AREA           DTSBD313
00145          GO TO P0000-EXIT.                                        DTSBD313
00146                                                                      CL**2
00147      MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME.                    CL**3
00148                                                                      CL**3
00149      MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA.                CL**3
00150                                                                      CL**3
00151      PERFORM S112-FORMAT-ADDRESS THRU S112-EXIT.                  DTSBD313
00152                                                                      CL**2
00153      MOVE T001-RESP-OP-ID TO R117-OP-ID.                             CL**3
00154                                                                      CL**3
00155      IF T001-INACT-LTR-GENERIC-88                                 DTSBD313
00156          SET R117-GENERIC-88 TO TRUE                              DTSBD313
00157      ELSE                                                         DTSBD313
00158      IF T001-INACT-LTR-DEMAND-88                                  DTSBD313
00159          SET R117-DEMAND-88 TO TRUE                               DTSBD313
00160      ELSE                                                            CL**4
00161      IF T001-INACT-LTR-8ZEROWAGE-88                                  CL**4
00162          SET R117-8ZEROWAGE-88 TO TRUE                               CL**4
00163      ELSE                                                         DTSBD313
00164          SET R117-GENERIC-88 TO TRUE.                             DTSBD313
00165                                                                      CL**3
00166      MOVE MPRF-EMP-NO TO R117-EMP-NO.                                CL**3
00167                                                                      CL**3
00168      MOVE LBCM-CURR-MAIL-DATE TO R117-MAIL-DATE.                     CL**3
00169                                                                      CL**3
00170      MOVE L112-MAILING-ADDRESS TO R117-FMT-ADDR.                     CL**3
00171                                                                      CL**3
00172      MOVE L111-ZIP TO R117-ZIP.                                      CL**3
00173                                                                      CL**3
00174      MOVE L111-ADVANCED-BARCODE TO R117-ADVANCED-BARCODE.            CL**3
00175                                                                      CL**3
00176      PERFORM S946-RPT-O THRU S946-EXIT.                           DTSBD313
00177  P0000-EXIT. EXIT.                                                DTSBD313
00178      EJECT                                                        DTSBD313
00179  S111-LOOKUP-ADDRESS.                                             DTSBD313
00180      CALL 'DTSBU111' USING L111-LINK-AREA.                           CL**2
00181  S111-EXIT. EXIT.                                                 DTSBD313
00182      SKIP3                                                        DTSBD313
00183  S112-FORMAT-ADDRESS.                                             DTSBD313
00184      CALL 'DTSBU112' USING L112-LINK-AREA.                           CL**2
00185  S112-EXIT. EXIT.                                                 DTSBD313
00186      SKIP3                                                        DTSBD313
00187  S946-RPT-O.                                                      DTSBD313
00188      CALL 'DTSBU946' USING R117-REC.                                 CL**2
00189  S946-EXIT. EXIT.                                                 DTSBD313
