00001  IDENTIFICATION DIVISION.                                         08/04/04
00002  PROGRAM-ID.             DTSBR792.                                DTSBR792
00003  AUTHOR.                 D.SHEPPERSON                                LV081
00004  DATE-WRITTEN.           JULY 1999                                DTSBR792
00005  DATE-COMPILED.                                                   DTSBR792
00006                                                                   DTSBR792
00007 *****                                                             DTSBR792
00008 *                                                                 DTSBR792
00009 *    FUNCTION:  EMPLOYERS WITH MISSING INDUSTRIAL CODES PRINT     DTSBR792
00010 *                                                                 DTSBR792
00011 *                                                                 DTSBR792
00012 *    CALLING SEQUENCE:                                            DTSBR792
00013 *                                                                 DTSBR792
00014 *                                                                 DTSBR792
00015 *                                                                 DTSBR792
00016 *    MODIFICATION HISTORY:                                        DTSBR792
00017 *                                                                 DTSBR792
00018 * 07-13-99 INITIAL DEVELOPMENT                                    DTSBR792
00019 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - DVS  DTSBR792
00020 *                                                                 DTSBR792
00021 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR792
00022 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR792
00023 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR792
00024 *                                                                 DTSBR792
00025 *                                                                 DTSBR792
00026 *    DESCRIPTION:                                                 DTSBR792
00027 *                                                                 DTSBR792
00028 *        THIS MODULE PRINTS THE RUSULTS OF EMPLOYERS WITH         DTSBR792
00029 *        MISSING INDUSTRIAL CODE EXTRACT.                         DTSBR792
00030 *                                                                 DTSBR792
00031 *        THIS IS AN "AT LEAST ONCE" MODULE.                       DTSBR792
00032 *                                                                 DTSBR792
00033 *                                                                 DTSBR792
00034 *    RECORDS READ:                                                DTSBR792
00035 *                                                                 DTSBR792
00036 *        NONE.                                                    DTSBR792
00037 *                                                                 DTSBR792
00038 *                                                                 DTSBR792
00039 *    PRINTED OUTPUTS:                                             DTSBR792
00040 *                                                                 DTSBR792
00041 *        792R1  EMPLOYER WITH  MISSING INDUSTRY CODE              DTSBR792
00042 *                                                                 DTSBR792
00043 *                                                                 DTSBR792
00044 *    RECORDS WRITTEN:                                             DTSBR792
00045 *                                                                 DTSBR792
00046 *        NONE.                                                    DTSBR792
00047 *                                                                 DTSBR792
00048 *                                                                 DTSBR792
00049 *    MODULES CALLED:                                              DTSBR792
00050 *                                                                 DTSBR792
00051 *        NONE                                                     DTSBR792
00052 *                                                                 DTSBR792
00053 *****                                                             DTSBR792
00054      EJECT                                                        DTSBR792
00055  ENVIRONMENT DIVISION.                                            DTSBR792
00056  CONFIGURATION SECTION.                                           DTSBR792
00057  SPECIAL-NAMES.                                                   DTSBR792
00058      C01 IS TOP-OF-PAGE.                                          DTSBR792
00059  INPUT-OUTPUT SECTION.                                            DTSBR792
00060                                                                   DTSBR792
00061  FILE-CONTROL.                                                    DTSBR792
00062      SELECT PRT-FILE ASSIGN TO RPT792R1.                          DTSBR792
00063                                                                   DTSBR792
00064  DATA DIVISION.                                                   DTSBR792
00065                                                                   DTSBR792
00066  FILE SECTION.                                                    DTSBR792
00067                                                                   DTSBR792
00068  FD  PRT-FILE                                                     DTSBR792
00069      LABEL RECORDS ARE OMITTED                                    DTSBR792
00070      RECORD CONTAINS 133 CHARACTERS                               DTSBR792
00071      DATA RECORD IS REPORT-REC                                    DTSBR792
00072      RECORDING MODE IS F.                                         DTSBR792
00073  01  REPORT-REC              PIC X(133).                          DTSBR792
00074      EJECT                                                        DTSBR792
00075  WORKING-STORAGE SECTION.                                         DTSBR792
000755 77  PAN-VALET PICTURE X(24) VALUE '081DTSBR792  08/04/04'.       DTSBR792
00076                                                                   DTSBR792
00077  01  WRK-AREA.                                                    DTSBR792
00078      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +792.DTSBR792
00079      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR792
00080      05  WS-EMP-NO                   PIC  9(07)         VALUE  0. DTSBR792
00081      05  WS-CONSTANT                 PIC S9(03)  COMP-3 VALUE +1. DTSBR792
00082      05  WS-EMPLOYER-CNT             PIC S9(05)         VALUE +0. DTSBR792
00083      05  WS-PAGE-CNT                 PIC S9(03)         VALUE +0. DTSBR792
00084      05  WS-LINE-CNT                 PIC S9(02)         VALUE +57.DTSBR792
00085      05  WRK-PHONE-AREA.                                          DTSBR792
00086         10   FILLER                  PIC X VALUE '('.             DTSBR792
00087         10   WRK-VOICE-AREA-CD       PIC X(03).                   DTSBR792
00088         10   FILLER                  PIC X VALUE ')'.             DTSBR792
00089         10   FILLER                  PIC X.                       DTSBR792
00090         10   WRK-VOICE-PREFIX        PIC X(03).                   DTSBR792
00091         10   FILLER                  PIC X VALUE '-'.             DTSBR792
00092         10   WRK-VOICE-SUFFIX        PIC X(04).                   DTSBR792
00093      EJECT                                                        DTSBR792
00094  01  WRK-STANDARD-HEADING-LINE1.                                  DTSBR792
00095      05  FILLER                      PIC  X(06) VALUE ' 792R1'.   DTSBR792
00096      05  FILLER                      PIC  X(41) VALUE SPACES.     DTSBR792
00097      05  WS-LRCM-AGY-NAME-LINE1      PIC  X(50) VALUE SPACES.     DTSBR792
00098      05  FILLER                      PIC  X(22) VALUE SPACES.     DTSBR792
00099      05  FILLER                      PIC  X(06) VALUE 'DATE: '.   DTSBR792
00100      05  WS-LRCM-SYS-DATE            PIC  X(08) VALUE SPACES.     DTSBR792
00101  01  WRK-STANDARD-HEADING-LINE2.                                  DTSBR792
00102      05  FILLER                      PIC  X(05) VALUE SPACES.     DTSBR792
00103      05  FILLER                      PIC  X(41) VALUE SPACES.     DTSBR792
00104      05  WS-LRCM-AGY-NAME-LINE2      PIC  X(50) VALUE SPACES.     DTSBR792
00105      05  FILLER                      PIC  X(23) VALUE SPACES.     DTSBR792
00106      05  FILLER                      PIC  X(06) VALUE 'TIME: '.   DTSBR792
00107      05  WS-LRCM-SYS-TIME            PIC  X(08) VALUE SPACES.     DTSBR792
00108  01  WRK-STANDARD-HEADING-LINE3.                                  DTSBR792
00109      05  FILLER                      PIC  X(42) VALUE             DTSBR792
00110          ' ROUTE TO:  REGISTRATION AND RATES '.                   DTSBR792
00111      05  FILLER                      PIC  X(05) VALUE SPACES.     DTSBR792
00112      05  FILLER                      PIC  X(50) VALUE SPACES.     DTSBR792
00113      05  FILLER                      PIC  X(22) VALUE SPACES.     DTSBR792
00114      05  FILLER                      PIC  X(06) VALUE 'PAGE: '.   DTSBR792
00115      05  WRK-LRCM-PAGE               PIC  ZZ,ZZ9.                 DTSBR792
00116  01  WRK-TITLE-LINE1.                                             DTSBR792
00117      05  FILLER                      PIC  X(05) VALUE SPACES.     DTSBR792
00118      05  FILLER                      PIC  X(41) VALUE SPACES.     DTSBR792
00119      05  FILLER                      PIC  X(51) VALUE             DTSBR792
00120         '          EMPLOYER WITH MISSING INDUSTRY CODE      '.    DTSBR792
00121      05  FILLER                      PIC  X(22) VALUE SPACES.     DTSBR792
00122      05  FILLER                      PIC  X(06) VALUE SPACES.     DTSBR792
00123      05  FILLER                      PIC  X(08) VALUE SPACES.     DTSBR792
00124      EJECT                                                        DTSBR792
00125  01  WRK-REPORT-HEADING1.                                         DTSBR792
00126      05  FILLER                      PIC  X.                      DTSBR792
00127      05  FILLER                      PIC  X(104) VALUE SPACES.    DTSBR792
00128      05  FILLER                      PIC  X(09) VALUE             DTSBR792
00129          'TELEPHONE'.                                             DTSBR792
00130  01  WRK-REPORT-HEADING2.                                         DTSBR792
00131      05  FILLER                      PIC  X.                      DTSBR792
00132      05  FILLER                      PIC  X(02) VALUE SPACES.     DTSBR792
00133      05  FILLER                      PIC  X(07) VALUE             DTSBR792
00134          ' EMP NO'.                                               DTSBR792
00135      05  FILLER                      PIC  X(05) VALUE SPACES.     DTSBR792
00136      05  FILLER                      PIC  X(12) VALUE             DTSBR792
00137          'PRIMARY NAME'.                                          DTSBR792
00138      05  FILLER                      PIC  X(33) VALUE SPACES.     DTSBR792
00139      05  FILLER                      PIC  X(14) VALUE             DTSBR792
00140          'CONTACT PERSON'.                                        DTSBR792
00141      05  FILLER                      PIC  X(31) VALUE SPACES.     DTSBR792
00142      05  FILLER                      PIC  X(09) VALUE             DTSBR792
00143          '  NUMBER '.                                             DTSBR792
00144  01  WRK-DETAIL-LINE01.                                           DTSBR792
00145      05  FILLER                      PIC  X.                      DTSBR792
00146      05  FILLER                      PIC  X(02) VALUE SPACES.     DTSBR792
00147      05  WRK-EMPL-NO                 PIC  999B999.                DTSBR792
00148      05  FILLER                      PIC  X(05) VALUE SPACES.     DTSBR792
00149      05  WRK-PRIMARY-NAME            PIC  X(40) VALUE SPACES.     DTSBR792
00150      05  FILLER                      PIC  X(05) VALUE SPACES.     DTSBR792
00151      05  WRK-CONTACT-PERSON          PIC  X(40) VALUE SPACES.     DTSBR792
00152      05  FILLER                      PIC  X(03) VALUE SPACES.     DTSBR792
00153      05  WRK-TELEPHONE-NO            PIC X(15).                   DTSBR792
00154      EJECT                                                        DTSBR792
00155  01  WRK-FINAL-DETAIL01.                                          DTSBR792
00156      05  FILLER                      PIC  X(31) VALUE SPACES.     DTSBR792
00157      05  WRK-EMPLOYER-COUNT          PIC  ZZ,ZZ9.                 DTSBR792
00158      05  FILLER                      PIC  X(42) VALUE             DTSBR792
00159          ' EMPLOYERS ON LIST             '.                       DTSBR792
00160      05  FILLER                      PIC  X(80) VALUE SPACES.     DTSBR792
00161      EJECT                                                        DTSBR792
00162  LINKAGE SECTION.                                                 DTSBR792
00163                                                                   DTSBR792
00164  01  LRCM-LINK-AREA.                                              DTSBR792
00165  ++INCLUDE DTSILRCM                                               DTSBR792
00166      EJECT                                                        DTSBR792
00167  01  R792-REC.                                                    DTSBR792
00168  ++INCLUDE DTSIR792                                               DTSBR792
00169      EJECT                                                        DTSBR792
00170      EJECT                                                        DTSBR792
00171  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR792
00172                           R792-REC.                               DTSBR792
00173                                                                   DTSBR792
00174      IF FIRST-TIME-IND = 'Y'                                      DTSBR792
00175          PERFORM I1000-INITIATE                                   DTSBR792
00176             THRU I1000-EXIT                                       DTSBR792
00177          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR792
00178                                                                   DTSBR792
00179      IF LRCM-EOR-88                                               DTSBR792
00180          PERFORM T1000-TERMINATE                                  DTSBR792
00181             THRU T1000-EXIT                                       DTSBR792
00182      ELSE                                                         DTSBR792
00183          PERFORM P1000-PROCESS                                    DTSBR792
00184             THRU P1000-EXIT.                                      DTSBR792
00185                                                                   DTSBR792
00186      GOBACK.                                                      DTSBR792
00187      EJECT                                                        DTSBR792
00188  I1000-INITIATE.                                                  DTSBR792
00189                                                                   DTSBR792
00190      OPEN OUTPUT PRT-FILE.                                        DTSBR792
00191      INITIALIZE REPORT-REC.                                       DTSBR792
00192      IF LRCM-EOR-88                                               DTSBR792
00193          MOVE +0     TO WS-PAGE-CNT                               DTSBR792
00194      ELSE                                                         DTSBR792
00195         MOVE  LRCM-SYS-TIME        TO WS-LRCM-SYS-TIME            DTSBR792
00196         MOVE  LRCM-AGY-NAME-LINE1  TO WS-LRCM-AGY-NAME-LINE1      DTSBR792
00197         MOVE  LRCM-AGY-NAME-LINE2  TO WS-LRCM-AGY-NAME-LINE2      DTSBR792
00198         MOVE  LRCM-SYS-DATE        TO WS-LRCM-SYS-DATE.           DTSBR792
00199                                                                   DTSBR792
00200  I1000-EXIT.                                                      DTSBR792
00201      EXIT.                                                        DTSBR792
00202      EJECT                                                        DTSBR792
00203  I2000-INITIATE-REPORT.                                           DTSBR792
00204      ADD +1      TO WS-PAGE-CNT.                                  DTSBR792
00205      MOVE ZEROES TO WS-LINE-CNT.                                  DTSBR792
00206      MOVE WS-PAGE-CNT TO   WRK-LRCM-PAGE.                         DTSBR792
00207      WRITE REPORT-REC FROM WRK-STANDARD-HEADING-LINE1             DTSBR792
00208                        AFTER TOP-OF-PAGE.                         DTSBR792
00209      WRITE REPORT-REC FROM WRK-STANDARD-HEADING-LINE2 AFTER 1.    DTSBR792
00210      WRITE REPORT-REC FROM WRK-STANDARD-HEADING-LINE3 AFTER 1.    DTSBR792
00211      WRITE REPORT-REC FROM WRK-TITLE-LINE1     AFTER 1.           DTSBR792
00212      WRITE REPORT-REC FROM WRK-REPORT-HEADING1 AFTER 1.           DTSBR792
00213      WRITE REPORT-REC FROM WRK-REPORT-HEADING2 AFTER 1.           DTSBR792
00214                                                                   DTSBR792
00215      ADD +9      TO WS-LINE-CNT.                                  DTSBR792
00216  I2000-EXIT.                                                      DTSBR792
00217      EXIT.                                                        DTSBR792
00218      EJECT                                                        DTSBR792
00219  P1000-PROCESS.                                                   DTSBR792
00220      IF WS-LINE-CNT > +55                                         DTSBR792
00221         PERFORM I2000-INITIATE-REPORT  THRU I2000-EXIT            DTSBR792
00222      END-IF.                                                      DTSBR792
00223                                                                   DTSBR792
00224         PERFORM P1100-GENERATE-REPORT  THRU P1100-EXIT.           DTSBR792
00225                                                                   DTSBR792
00226  P1000-EXIT.                                                      DTSBR792
00227      EXIT.                                                        DTSBR792
00228      EJECT                                                        DTSBR792
00229                                                                   DTSBR792
00230  P1100-GENERATE-REPORT.                                           DTSBR792
00231                                                                   DTSBR792
00232      MOVE  R792-EMP-NO           TO WRK-EMPL-NO.                  DTSBR792
00233      MOVE  R792-PRIMARY-NAME     TO WRK-PRIMARY-NAME.             DTSBR792
00234      MOVE  R792-ATTN-LINE        TO WRK-CONTACT-PERSON.           DTSBR792
00235                                                                   DTSBR792
00236      IF    R792-PHONE-NUMBER > SPACES                             DTSBR792
00237            MOVE  R792-VOICE-1-AREA-CD  TO WRK-VOICE-AREA-CD       DTSBR792
00238            MOVE  R792-VOICE-1-PREFIX   TO WRK-VOICE-PREFIX        DTSBR792
00239            MOVE  R792-VOICE-1-SUFFIX   TO WRK-VOICE-SUFFIX        DTSBR792
00240            MOVE  WRK-PHONE-AREA        TO WRK-TELEPHONE-NO        DTSBR792
00241      ELSE                                                         DTSBR792
00242            MOVE  R792-PHONE-NUMBER     TO WRK-TELEPHONE-NO        DTSBR792
00243      END-IF.                                                      DTSBR792
00244                                                                   DTSBR792
00245      WRITE REPORT-REC FROM WRK-DETAIL-LINE01      AFTER 2.        DTSBR792
00246                                                                   DTSBR792
00247      ADD +2 TO  WS-LINE-CNT.                                      DTSBR792
00248      ADD +1 TO  WS-EMPLOYER-CNT.                                  DTSBR792
00249                                                                   DTSBR792
00250  P1100-EXIT.                                                      DTSBR792
00251      EXIT.                                                        DTSBR792
00252      EJECT                                                        DTSBR792
00253  T1000-TERMINATE.                                                 DTSBR792
00254                                                                   DTSBR792
00255      MOVE  WS-EMPLOYER-CNT TO WRK-EMPLOYER-COUNT.                 DTSBR792
00256      WRITE REPORT-REC FROM WRK-FINAL-DETAIL01 AFTER 3.            DTSBR792
00257                                                                   DTSBR792
00258      CLOSE PRT-FILE.                                              DTSBR792
00259  T1000-EXIT.                                                      DTSBR792
00260      EXIT.                                                        DTSBR792
00261      EJECT                                                        DTSBR792
00262  S999-ABEND.                                                      DTSBR792
00263                                                                   DTSBR792
00264      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR792
00265                                                                   DTSBR792
00266  S999-EXIT.                                                       DTSBR792
00267      EXIT.                                                        DTSBR792
