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