00001 IDENTIFICATION DIVISION. 10/02/09 00002 PROGRAM-ID. DTSBD382. DTSBD382 00003 AUTHOR. NORTHROP GRUMMAN. LV003 00004 DATE-WRITTEN. JUNE 2005. DTSBD382 00005 DATE-COMPILED. DTSBD382 00006 DTSBD382 00007 ***** DTSBD382 00008 * DTSBD382 00009 * FUNCTION: ADD EMPLOYER RATES FROM WEB REGISTRATIONS DTSBD382 00010 * DTSBD382 00011 * DTSBD382 00012 * MODIFICATION LOG: DTSBD382 00013 * DTSBD382 00014 * 06/01/2005 INITIAL DEVELOPMENT. DTSBD382 00015 * WORK ORDER: PROGRAMMER: GD DTSBD382 00016 * DTSBD382 00017 * 09/25/2009 MODIFIED S330 TO SET L331-OP-ID FROM T002-OP-ID DTSBD382 00018 * TO DISTINGUISH MODIFICATIONS FROM THE WEB FROM DTSBD382 00019 * THOSE MADE BY STAFF. DTSBD382 00020 * WORK ORDER: PROGRAMMER: GD DTSBD382 00021 * DTSBD382 00022 * MM/DD/CCYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD382 00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD382 00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD382 00025 * DTSBD382 00026 * DTSBD382 00027 * DESCRIPTION: DTSBD382 00028 * DTSBD382 00029 * DTSBD382 00030 * DTSBD382 00031 * MASTER FILE RECORDS READ: DTSBD382 00032 * DTSBD382 00033 * MRTE DTSBD382 00034 * DTSBD382 00035 * DTSBD382 00036 * MASTER FILE RECORDS UPDATED: DTSBD382 00037 * DTSBD382 00038 * MRTE DTSBD382 00039 * DTSBD382 00040 * DTSBD382 00041 * REPORT RECORDS WRITTEN: DTSBD382 00042 * DTSBD382 00043 * NONE DTSBD382 00044 * DTSBD382 00045 * DTSBD382 00046 * MODULES CALLED: DTSBD382 00047 * DTSBD382 00048 * DTSBU331 FORMAT AND WRITE MLOG RECORD OCCURRENCE. DTSBD382 00049 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD382 00050 * DTSBU927 BTC FILE OUTPUT. DTSBD382 00051 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. DTSBD382 00052 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD382 00053 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. DTSBD382 00054 * DTSBD382 00055 ***** DTSBD382 00056 SKIP3 DTSBD382 00057 ENVIRONMENT DIVISION. DTSBD382 00058 SKIP3 DTSBD382 00059 DATA DIVISION. DTSBD382 00060 EJECT DTSBD382 00061 WORKING-STORAGE SECTION. DTSBD382 000615 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD382 10/02/09'. DTSBD382 00062 SKIP3 DTSBD382 00063 01 WRK-AREA. DTSBD382 00064 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +382.DTSBD382 00065 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD382'.DTSBD382 00066 05 WRK-ABEND-MSG PIC X(60). DTSBD382 00067 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD382 00068 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD382 00069 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. DTSBD382 00070 DTSBD382 00071 05 DISP-DATE PIC X(10) VALUE SPACES. DTSBD382 00072 05 DISP-TIME PIC X(08) VALUE SPACES. DTSBD382 00073 05 DISP-ABSTIME PIC X(16) VALUE SPACES. DTSBD382 00074 DTSBD382 00075 05 WRK-MSG-TEXT. DTSBD382 00076 10 WRK-MSG-LINE PIC X(50). DTSBD382 00077 DTSBD382 00078 01 MSG-TABLE. DTSBD382 00079 05 MSG1-AREA. DTSBD382 00080 10 MSG1-ID PIC X(11) VALUE 'DTSBD382001'. DTSBD382 00081 10 MSG1-SHORT-TEXT PIC X(20) VALUE ' '. DTSBD382 00082 10 MSG1-LONG-TEXT. DTSBD382 00083 15 FILLER PIC X(30) DTSBD382 00084 VALUE 'TRANSACTION FAILED - '. DTSBD382 00085 15 FILLER PIC X(30) DTSBD382 00086 VALUE ' '. DTSBD382 00087 EJECT DTSBD382 00088 01 Y108-REC. DTSBD382 00089 ++INCLUDE DTSIY108 DTSBD382 00090 EJECT DTSBD382 00091 01 L004-LINK-AREA. DTSBD382 00092 ++INCLUDE DTSIL004 DTSBD382 00093 EJECT DTSBD382 00094 01 L006-LINK-AREA. DTSBD382 00095 ++INCLUDE DTSIL006 DTSBD382 00096 EJECT DTSBD382 00097 01 L056-LINK-AREA. DTSBD382 00098 ++INCLUDE DTSIL056 DTSBD382 00099 EJECT DTSBD382 00100 01 L331-LINK-AREA. DTSBD382 00101 ++INCLUDE DTSIL331 DTSBD382 00102 EJECT DTSBD382 00103 01 L910-LINK-AREA. DTSBD382 00104 ++INCLUDE DTSIL910 DTSBD382 00105 EJECT DTSBD382 00106 01 MSKL-REC. DTSBD382 00107 ++INCLUDE DTSIMSKL DTSBD382 00108 EJECT DTSBD382 00109 01 MRTE-REC. DTSBD382 00110 ++INCLUDE DTSIMRTE DTSBD382 00111 DTSBD382 00112 01 R907-REC. DTSBD382 00113 ++INCLUDE DTSIR907 DTSBD382 00114 EJECT DTSBD382 00115 DTSBD382 00116 LINKAGE SECTION. DTSBD382 00117 SKIP3 DTSBD382 00118 01 LBCM-LINK-AREA. DTSBD382 00119 ++INCLUDE DTSILBCM DTSBD382 00120 EJECT DTSBD382 00121 01 MPRF-REC. DTSBD382 00122 ++INCLUDE DTSIMPRF DTSBD382 00123 EJECT DTSBD382 00124 01 T002-REC. DTSBD382 00125 ++INCLUDE DTSIT002 DTSBD382 00126 EJECT DTSBD382 00127 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD382 00128 MPRF-REC DTSBD382 00129 T002-REC. DTSBD382 00130 DTSBD382 00131 *& DTSBD382 00132 DISPLAY 'DTSBD382 ' MPRF-EMP-NO ' ' T002-TRN-CD DTSBD382 00133 ' WRK ' WRK-EMP-NO. DTSBD382 00134 *& DTSBD382 00135 IF FIRST-TIME-IND = 'Y' DTSBD382 00136 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD382 00137 MOVE 'N' TO FIRST-TIME-IND DTSBD382 00138 END-IF. DTSBD382 00139 DTSBD382 00140 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD382 00141 DTSBD382 00142 GOBACK. DTSBD382 00143 DTSBD382 00144 I0000-INITIATE. DTSBD382 00145 DTSBD382 00146 MOVE +0 TO WRK-EMP-NO. DTSBD382 00147 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD382 00148 DTSBD382 00149 I0000-EXIT. DTSBD382 00150 EXIT. DTSBD382 00151 DTSBD382 00152 P0000-PROCESS. DTSBD382 00153 DTSBD382 00154 IF T002-EMP-RATE-88 DTSBD382 00155 MOVE T002-DATA-AREA TO Y108-REC DTSBD382 00156 PERFORM P1000-ADD-RATE THRU P1000-EXIT DTSBD382 00157 END-IF. DTSBD382 00158 DTSBD382 00159 P0000-EXIT. DTSBD382 00160 EXIT. DTSBD382 00161 DTSBD382 00162 P1000-ADD-RATE. DTSBD382 00163 *& DTSBD382 00164 DISPLAY 'BD382 P1000 ' MPRF-EMP-NO DTSBD382 00165 ' ' Y108-RATE-EFF-YRQ ' ' Y108-UI-RATE. DTSBD382 00166 *& DTSBD382 00167 MOVE LOW-VALUES TO MRTE-REC. DTSBD382 00168 DTSBD382 00169 MOVE T002-EMP-NO TO MRTE-EMP-NO. DTSBD382 00170 SET MRTE-RTE-88 TO TRUE. DTSBD382 00171 MOVE Y108-RATE-EFF-YRQ TO MRTE-EFF-YRQ. DTSBD382 00172 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBD382 00173 DTSBD382 00174 PERFORM S910-READ THRU S910-EXIT. DTSBD382 00175 IF L910-OK-88 DTSBD382 00176 MOVE MSKL-REC TO MRTE-REC DTSBD382 00177 DISPLAY 'DTSBD382: RATE ALREADY ON FILE ' MPRF-EMP-NO DTSBD382 00178 ' ' MRTE-EFF-YRQ ' ' MRTE-UI-RATE DTSBD382 00179 END-IF. DTSBD382 00180 DTSBD382 00181 PERFORM S330-INIT-MLOG THRU S330-EXIT. DTSBD382 00182 DTSBD382 00183 MOVE +0 TO MRTE-PURGE-DATE. DTSBD382 00184 SET L006-FROM-QTR TO TRUE. DTSBD382 00185 MOVE MRTE-EFF-YRQ TO L006-YRQ. DTSBD382 00186 PERFORM S006-RATING-YRQ THRU S006-EXIT. DTSBD382 00187 MOVE L006-RTE-YR-END-YRQ TO MRTE-END-YRQ. DTSBD382 00188 MOVE Y108-UI-RATE TO MRTE-UI-RATE. DTSBD382 00189 SET MRTE-RATE-TYPE-REG-88 TO TRUE. DTSBD382 00190 MOVE +0 TO MRTE-NOTICE-DATE. DTSBD382 00191 MOVE LBCM-CURR-RUN-DATE TO MRTE-CHNG-DATE. DTSBD382 00192 DTSBD382 00193 IF L910-OK-88 DTSBD382 00194 MOVE MRTE-REC TO MSKL-REC DTSBD382 00195 PERFORM S910-REWRITE THRU S910-EXIT DTSBD382 00196 ELSE DTSBD382 00197 SET MRTE-NOT-CONVERTED-88 TO TRUE DTSBD382 00198 MOVE LBCM-CURR-RUN-DATE TO MRTE-ESTB-DATE DTSBD382 00199 MOVE MRTE-REC TO MSKL-REC DTSBD382 00200 PERFORM S910-WRITE THRU S910-EXIT DTSBD382 00201 END-IF. DTSBD382 00202 DTSBD382 00203 MOVE SPACES TO L331-REC-OCC-ID. DTSBD382 00204 DTSBD382 00205 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSBD382 00206 STRING L004-QTR-5-YR DELIMITED BY SIZE DTSBD382 00207 '/' DELIMITED BY SIZE DTSBD382 00208 L004-QTR-5-Q DELIMITED BY SIZE DTSBD382 00209 INTO DTSBD382 00210 L331-REC-OCC-ID. DTSBD382 00211 DTSBD382 00212 MOVE SPACES TO L331-FROM-VALUE. DTSBD382 00213 DTSBD382 00214 MOVE MRTE-UI-RATE TO L056-RATE. DTSBD382 00215 DTSBD382 00216 SET L056-DISP1-LEFT-88 TO TRUE. DTSBD382 00217 DTSBD382 00218 PERFORM S056-RATE-DISPLAY THRU S056-EXIT. DTSBD382 00219 DTSBD382 00220 MOVE 'MRTE-UI-RATE' TO L331-FIELD-NAME. DTSBD382 00221 DTSBD382 00222 MOVE L056-DISP-RATE TO L331-TO-VALUE. DTSBD382 00223 DTSBD382 00224 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD382 00225 DTSBD382 00226 P1000-EXIT. DTSBD382 00227 EXIT. DTSBD382 00228 DTSBD382 00229 S006-RATING-YRQ. DTSBD382 00230 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD382 00231 DTSBD382 00232 S006-EXIT. DTSBD382 00233 EXIT. DTSBD382 00234 DTSBD382 00235 S056-RATE-DISPLAY. DTSBD382 00236 CALL 'DTSBU056' USING L056-LINK-AREA. DTSBD382 00237 DTSBD382 00238 S056-EXIT. DTSBD382 00239 EXIT. DTSBD382 00240 DTSBD382 00241 S330-INIT-MLOG. DTSBD382 00242 MOVE T002-EMP-NO TO L331-EMP-NO. DTSBD382 00243 MOVE LBCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSBD382 00244 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD382 00245 MOVE LBCM-EMP-ABSTIME TO L331-UPDATE-ABSTIME. DTSBD382 00246 MOVE T002-OP-ID TO L331-OP-ID. DTSBD382 00247 DTSBD382 00248 S330-EXIT. DTSBD382 00249 EXIT. DTSBD382 00250 DTSBD382 00251 S331-WRITE-MLOG. DTSBD382 00252 CALL 'DTSBU331' USING L331-LINK-AREA. DTSBD382 00253 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD382 00254 DTSBD382 00255 S331-EXIT. DTSBD382 00256 EXIT. DTSBD382 00257 DTSBD382 00258 S910-OPEN-READ. DTSBD382 00259 SET L910-OPEN-READ-88 TO TRUE. DTSBD382 00260 GO TO S910-MSTR-IO. DTSBD382 00261 DTSBD382 00262 S910-OPEN-UPDATE. DTSBD382 00263 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD382 00264 GO TO S910-MSTR-IO. DTSBD382 00265 DTSBD382 00266 S910-OPEN-UPDATE-NO-AIX. DTSBD382 00267 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBD382 00268 GO TO S910-MSTR-IO. DTSBD382 00269 DTSBD382 00270 S910-READ. DTSBD382 00271 SET L910-READ-88 TO TRUE. DTSBD382 00272 GO TO S910-MSTR-IO. DTSBD382 00273 DTSBD382 00274 S910-START-BROWSE. DTSBD382 00275 SET L910-START-BROWSE-88 TO TRUE. DTSBD382 00276 GO TO S910-MSTR-IO. DTSBD382 00277 DTSBD382 00278 S910-READ-NEXT. DTSBD382 00279 SET L910-READ-NEXT-88 TO TRUE. DTSBD382 00280 GO TO S910-MSTR-IO. DTSBD382 00281 DTSBD382 00282 S910-COUNT. DTSBD382 00283 SET L910-COUNT-88 TO TRUE. DTSBD382 00284 GO TO S910-MSTR-IO. DTSBD382 00285 DTSBD382 00286 S910-WRITE. DTSBD382 00287 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD382 00288 SET L910-WRITE-88 TO TRUE. DTSBD382 00289 GO TO S910-MSTR-IO. DTSBD382 00290 DTSBD382 00291 S910-REWRITE. DTSBD382 00292 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD382 00293 SET L910-REWRITE-88 TO TRUE. DTSBD382 00294 GO TO S910-MSTR-IO. DTSBD382 00295 DTSBD382 00296 S910-DELETE. DTSBD382 00297 SET L910-DELETE-88 TO TRUE. DTSBD382 00298 GO TO S910-MSTR-IO. DTSBD382 00299 DTSBD382 00300 S910-CLOSE. DTSBD382 00301 SET L910-CLOSE-88 TO TRUE. DTSBD382 00302 GO TO S910-MSTR-IO. DTSBD382 00303 DTSBD382 00304 S910-MSTR-IO. DTSBD382 00305 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD382 00306 MSKL-REC. DTSBD382 00307 S910-EXIT. DTSBD382 00308 EXIT. DTSBD382 00309 DTSBD382 00310 S947-WRITE-R907. DTSBD382 00311 CALL 'DTSBU947' USING R907-REC. DTSBD382 00312 DTSBD382 00313 S947-EXIT. DTSBD382 00314 EXIT. DTSBD382 00315 DTSBD382 00316 S999-ABEND. DTSBD382 00317 DISPLAY '*** DTSBD382 ABENDING : ' DTSBD382 00318 WRK-ABEND-MSG. DTSBD382 00319 DTSBD382 00320 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD382 00321 S999-EXIT. DTSBD382 00322 EXIT. DTSBD382 00323 DTSBD382