00001 IDENTIFICATION DIVISION. 11/08/00 00002 PROGRAM-ID. DTSBE909. DTSBE909 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. JULY 1999. DTSBE909 00005 DATE-COMPILED. DTSBE909 00006 SKIP3 DTSBE909 00007 ***** DTSBE909 00008 * DTSBE909 00009 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE909 00010 * DTSBE909 WHICH UPDATES DTSIR909 DTSBE909 00011 * DTSBR909 READS DTSIR909 RECORDS. DTSBE909 00012 * DTSBE909 00013 * FUNCTION: CREATE IR RECORD FOR EACH EMPLOYER WITHOUT DTSBE909 00014 * SIC/NAIC CODE. DTSBE909 00015 * DTSBE909 00016 * MODIFICATION LOG: DTSBE909 00017 * DTSBE909 00018 * 11/04/2000 INITIAL DEVELOPMENT DTSBE909 00019 * REFERENCE RFP: PROGRAMMER: ZL1 DTSBE909 00020 * DTSBE909 00021 * DTSBE909 00022 * DESCRIPTION: DTSBE909 00023 * DTSBE909 00024 * DTSBE909 00025 * INITIATION: DTSBE909 00026 * DTSBE909 00027 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE909 00028 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE909 00029 * DTSBE909 00030 * EDIT PARAMTERS (SEE 909R1). DTSBE909 00031 * DTSBE909 00032 * DTSBE909 00033 * PROCESSING: DTSBE909 00034 * DTSBE909 00035 * SEE EXTRACT DESCRIPTION 909R1. DTSBE909 00036 * DTSBE909 00037 * DTSBE909 00038 * TERMINATION: DTSBE909 00039 * DTSBE909 00040 * NONE. DTSBE909 00041 * DTSBE909 00042 * DTSBE909 00043 * RECORDS READ: DTSBE909 00044 * DTSBE909 00045 * MASTER: DTSBE909 00046 * DTSBE909 00047 * NONE. DTSBE909 00048 * DTSBE909 00049 * DTSBE909 00050 * ALTERNATE INDEX: DTSBE909 00051 * DTSBE909 00052 * NONE. DTSBE909 00053 * DTSBE909 00054 * DTSBE909 00055 * REFERENCE: DTSBE909 00056 * DTSBE909 00057 * NONE. DTSBE909 00058 * DTSBE909 00059 * DTSBE909 00060 * RECORDS UPDATED: DTSBE909 00061 * DTSBE909 00062 * NONE. DTSBE909 00063 * DTSBE909 00064 * DTSBE909 00065 * REPORT RECORDS WRITTEN: DTSBE909 00066 * DTSBE909 00067 * R909 EMPLOYERS WITH MISSING INDUSTRY CODE. DTSBE909 00068 * DTSBE909 00069 * DTSBE909 00070 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE909 00071 * DTSBE909 00072 * NONE. DTSBE909 00073 * DTSBE909 00074 * DTSBE909 00075 * MODULES CALLED: DTSBE909 00076 * DTSBE909 00077 * DTSBU001 DATE CONVERSION/EDIT. DTSBE909 00078 * DTSBU111 FIND MTAD ADDRESS. DTSBE909 00079 * DTSBU112 ADDRESS FORMATTING. DTSBE909 00080 * DTSBU910 MASTER FILE I/O. DTSBE909 00081 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE909 00082 * DTSBE909 00083 ***** DTSBE909 00084 SKIP3 DTSBE909 00085 ENVIRONMENT DIVISION. DTSBE909 00086 SKIP3 DTSBE909 00087 DATA DIVISION. DTSBE909 00088 SKIP3 DTSBE909 00089 WORKING-STORAGE SECTION. DTSBE909 000895 77 PAN-VALET PICTURE X(24) VALUE '001DTSBE909 11/08/00'. DTSBE909 00090 SKIP3 DTSBE909 00091 01 WRK-AREA. DTSBE909 00092 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +909.DTSBE909 00093 DTSBE909 00094 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE909'.DTSBE909 00095 SKIP3 DTSBE909 00096 05 ABEND-MSG PIC X(60) VALUE SPACES. DTSBE909 00097 SKIP3 DTSBE909 00098 EJECT DTSBE909 00099 01 L001-LINK-AREA. DTSBE909 00100 ++INCLUDE DTSIL001 DTSBE909 00101 EJECT DTSBE909 00102 01 L111-LINK-AREA. DTSBE909 00103 ++INCLUDE DTSIL111 DTSBE909 00104 EJECT DTSBE909 00105 01 L112-LINK-AREA. DTSBE909 00106 ++INCLUDE DTSIL112 DTSBE909 00107 EJECT DTSBE909 00108 01 L910-LINK-AREA. DTSBE909 00109 ++INCLUDE DTSIL910 DTSBE909 00110 SKIP3 DTSBE909 00111 01 MSKL-REC. DTSBE909 00112 ++INCLUDE DTSIMSKL DTSBE909 00113 EJECT DTSBE909 00114 01 MTAD-REC. DTSBE909 00115 ++INCLUDE DTSIMTAD DTSBE909 00116 EJECT DTSBE909 00117 01 R909-REC. DTSBE909 00118 ++INCLUDE DTSIR909 DTSBE909 00119 EJECT DTSBE909 00120 LINKAGE SECTION. DTSBE909 00121 SKIP3 DTSBE909 00122 01 LECM-LINK-AREA. DTSBE909 00123 ++INCLUDE DTSILECM DTSBE909 00124 EJECT DTSBE909 00125 01 MPRF-LINK-REC. DTSBE909 00126 ++INCLUDE DTSIMPRF DTSBE909 00127 EJECT DTSBE909 00128 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE909 00129 MPRF-LINK-REC. DTSBE909 00130 SKIP2 DTSBE909 00131 IF LECM-PROCESS-88 DTSBE909 00132 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE909 00133 ELSE DTSBE909 00134 IF LECM-INITIALIZE-88 DTSBE909 00135 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE909 00136 ELSE DTSBE909 00137 IF LECM-TERMINATE-88 DTSBE909 00138 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE909 00139 ELSE DTSBE909 00140 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE909 00141 TO ABEND-MSG DTSBE909 00142 PERFORM S999-ABEND THRU S999-EXIT. DTSBE909 00143 SKIP2 DTSBE909 00144 GOBACK. DTSBE909 00145 EJECT DTSBE909 00146 I0000-INITIALIZE. DTSBE909 00147 MOVE LENGTH OF R909-REC TO R909-LENGTH. DTSBE909 00148 MOVE '909' TO R909-REC-TYPE. DTSBE909 00149 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE909 00150 DTSBE909 00151 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE909 00152 DTSBE909 00153 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE909 00154 DTSBE909 00155 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE909 00156 I0000-EXIT. DTSBE909 00157 EXIT. DTSBE909 00158 EJECT DTSBE909 00159 P0000-PROCESS. DTSBE909 00160 DTSBE909 00161 IF NOT MPRF-STATUS-ACT-88 DTSBE909 00162 GO TO P0000-EXIT DTSBE909 00163 END-IF. DTSBE909 00164 DTSBE909 00165 IF MPRF-NAICS-CD-NONCLASSIF-88 AND DTSBE909 00166 MPRF-SIC-CD-NONCLASSIF-88 DTSBE909 00167 PERFORM P1000-CONSTRUCT-R909 THRU P1000-EXIT DTSBE909 00168 END-IF. DTSBE909 00169 DTSBE909 00170 P0000-EXIT. DTSBE909 00171 EXIT. DTSBE909 00172 EJECT DTSBE909 00173 P1000-CONSTRUCT-R909. DTSBE909 00174 DTSBE909 00175 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSBE909 00176 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE909 00177 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE909 00178 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBE909 00179 DTSBE909 00180 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE909 00181 DTSBE909 00182 IF L111-ADDR-FOUND-88 DTSBE909 00183 PERFORM P1100-FORMAT-ADDR THRU P1100-EXIT DTSBE909 00184 ELSE DTSBE909 00185 DISPLAY ' EMPLOYER ADDRESS NOT FOUND - ' MPRF-EMP-NO DTSBE909 00186 GO TO P1000-EXIT DTSBE909 00187 END-IF. DTSBE909 00188 DTSBE909 00189 MOVE SPACES TO R909-OP-ID DTSBE909 00190 R909-FIELD-REP-ID. DTSBE909 00191 MOVE MPRF-EMP-NO TO R909-EMP-NO. DTSBE909 00192 DTSBE909 00193 IF MPRF-FEIN > ZEROS DTSBE909 00194 MOVE MPRF-FEIN TO R909-FEIN DTSBE909 00195 ELSE DTSBE909 00196 MOVE SPACES TO R909-FEIN. DTSBE909 00197 DTSBE909 00198 PERFORM S946-WRITE-R909 THRU S946-EXIT. DTSBE909 00199 DTSBE909 00200 P1000-EXIT. DTSBE909 00201 EXIT. DTSBE909 00202 EJECT DTSBE909 00203 DTSBE909 00204 P1100-FORMAT-ADDR. DTSBE909 00205 DTSBE909 00206 SET L112-TAD-ADDR-88 TO TRUE DTSBE909 00207 SET L112-ANCHOR-FIRST-88 TO TRUE DTSBE909 00208 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE909 00209 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBE909 00210 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE909 00211 DTSBE909 00212 MOVE L112-MAILING-ADDRESS TO R909-FMT-ADDR. DTSBE909 00213 MOVE L112-ZIP TO R909-ZIP. DTSBE909 00214 MOVE L112-ADVANCED-BARCODE TO R909-ADVANCED-BARCODE. DTSBE909 00215 DTSBE909 00216 P1100-EXIT. DTSBE909 00217 EXIT. DTSBE909 00218 EJECT DTSBE909 00219 T0000-TERMINATE. DTSBE909 00220 SKIP2 DTSBE909 00221 SKIP2 DTSBE909 00222 T0000-EXIT. DTSBE909 00223 EXIT. DTSBE909 00224 EJECT DTSBE909 00225 S001-FROM-FED-8. DTSBE909 00226 SET L001-FROM-FED-8 TO TRUE. DTSBE909 00227 GO TO S001-DATE. DTSBE909 00228 DTSBE909 00229 S001-FROM-CAL-6. DTSBE909 00230 SET L001-FROM-CAL-6 TO TRUE. DTSBE909 00231 GO TO S001-DATE. DTSBE909 00232 DTSBE909 00233 S001-FROM-ABS-DAY. DTSBE909 00234 SET L001-FROM-ABS-DAY TO TRUE. DTSBE909 00235 GO TO S001-DATE. DTSBE909 00236 DTSBE909 00237 S001-DATE. DTSBE909 00238 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE909 00239 S001-EXIT. DTSBE909 00240 EXIT. DTSBE909 00241 SKIP3 DTSBE909 00242 S111-LOOKUP-ADDR. DTSBE909 00243 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE909 00244 S111-EXIT. DTSBE909 00245 EXIT. DTSBE909 00246 SKIP3 DTSBE909 00247 S112-FORMAT-ADDR. DTSBE909 00248 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE909 00249 S112-EXIT. DTSBE909 00250 EXIT. DTSBE909 00251 SKIP3 DTSBE909 00252 S910-READ. DTSBE909 00253 SET L910-READ-88 TO TRUE. DTSBE909 00254 GO TO S910-MSTR-IO. DTSBE909 00255 DTSBE909 00256 S910-START-BROWSE. DTSBE909 00257 SET L910-START-BROWSE-88 TO TRUE. DTSBE909 00258 GO TO S910-MSTR-IO. DTSBE909 00259 DTSBE909 00260 S910-READ-NEXT. DTSBE909 00261 SET L910-READ-NEXT-88 TO TRUE. DTSBE909 00262 GO TO S910-MSTR-IO. DTSBE909 00263 DTSBE909 00264 S910-COUNT. DTSBE909 00265 SET L910-COUNT-88 TO TRUE. DTSBE909 00266 GO TO S910-MSTR-IO. DTSBE909 00267 DTSBE909 00268 S910-MSTR-IO. DTSBE909 00269 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE909 00270 MSKL-REC. DTSBE909 00271 S910-EXIT. DTSBE909 00272 EXIT. DTSBE909 00273 SKIP3 DTSBE909 00274 S946-WRITE-R909. DTSBE909 00275 CALL 'DTSBU946' USING R909-REC. DTSBE909 00276 GO TO S946-EXIT. DTSBE909 00277 DTSBE909 00278 S946-EXIT. DTSBE909 00279 EXIT. DTSBE909 00280 SKIP3 DTSBE909 00281 S999-ABEND. DTSBE909 00282 DISPLAY '*** DTSBE761 ABENDING. ' DTSBE909 00283 ABEND-MSG. DTSBE909 00284 DTSBE909 00285 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE909 00286 S999-EXIT. DTSBE909 00287 EXIT. DTSBE909