00001 IDENTIFICATION DIVISION. 11/09/99 00002 PROGRAM-ID. DTSBR125. DTSBR125 00003 AUTHOR. TRW S&ITG (FORMERLY BDM). LV074 00004 DATE-WRITTEN. OCTOBER 1998. CL*13 00005 DATE-COMPILED. CL**4 00006 CL**5 00007 ***** CL**4 00008 * CL**4 00009 * CALLING SEQUENCE: DTSBD400 CALLS CL*23 00010 * DTSBE125 WHICH UPDATES DTSIR125 CL*23 00011 * DTSBR125 READS DTSIR125 RECORDS. CL*23 00012 * CL*23 00013 * MODIFICATION HISTORY: CL**4 00014 * CL**4 00015 * MM-DD-YY MODIFIED TO TO MOVE STANDARDIZE HEADING TO REPORT. CL*70 00016 * REFERENCE RFP #**** PROGRAMMER: DVS CL*70 00017 * CL**4 00018 * CL**4 00019 * DESCRIPTION: CL**4 00020 * CL**4 00021 * THIS MODULE PRINTS THE EMPLOYER ALPHA LIST. CL**8 00022 * CL**4 00023 * RECORDS READ: CL**4 00024 * CL**4 00025 * IR125. CL**8 00026 * CL**4 00027 * CL**4 00028 * PRINTED OUTPUTS: CL**4 00029 * CL**4 00030 * RPT125 EMPLOYER ALPHA LIST. CL**8 00031 * CL**4 00032 * CL**4 00033 * RECORDS WRITTEN: CL**4 00034 * CL**4 00035 * NONE. CL**4 00036 * CL**4 00037 * CL**4 00038 * MODULES CALLED: CL**4 00039 * CL**8 00040 ***** CL**4 00041 EJECT CL**4 00042 ENVIRONMENT DIVISION. CL**4 00043 CONFIGURATION SECTION. CL*20 00044 SPECIAL-NAMES. CL**9 00045 C01 IS TOP-OF-PAGE. CL**9 00046 INPUT-OUTPUT SECTION. CL**4 00047 FILE-CONTROL. CL**4 00048 SELECT PRINT-FILE ASSIGN TO RPT125R1. CL*59 00049 CL*22 00050 DATA DIVISION. CL**4 00051 FILE SECTION. CL**4 00052 CL**4 00053 FD PRINT-FILE CL*14 00054 RECORDING MODE IS F CL**8 00055 LABEL RECORDS ARE OMITTED CL**8 00056 RECORD CONTAINS 133 CHARACTERS CL**8 00057 DATA RECORD IS PRINT-RCD. CL**8 00058 01 PRINT-RCD PIC X(133). CL**8 00059 EJECT CL**4 00060 CL**8 00061 WORKING-STORAGE SECTION. CL**4 000615 77 PAN-VALET PICTURE X(24) VALUE '074DTSBR125 11/09/99'. CL**4 00062 CL**5 00063 01 WRK-AREA. CL**4 00064 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +125. CL*47 00065 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL*47 00066 05 WRK-INVALID-DATE PIC S9(9) COMP-3 VALUE CL*55 00067 +999999999. CL*55 00068 01 R125-OUT-REC. CL*20 00069 05 FILLER PIC X(07) VALUE SPACES. CL*59 00070 05 R125-OUT-EMP-NO PIC 999B999. CL*73 00071 05 FILLER PIC X(04) VALUE SPACES. CL*33 00072 05 R125-OUT-PRIMARY-NAME PIC X(40). CL*13 00073 05 FILLER PIC X(05) VALUE SPACES. CL*60 00074 05 R125-OUT-EMPLOYER-CLASS PIC X(13). CL*59 00075 05 FILLER PIC X(11) VALUE SPACES. CL*62 00076 05 R125-OUT-LIAB-DATE PIC X(10). CL*28 00077 05 FILLER PIC X(04) VALUE SPACES. CL*37 00078 05 R125-OUT-INACT-DATE PIC X(10). CL*28 00079 05 FILLER PIC X(08) VALUE SPACES. CL*37 00080 05 R125-OUT-FIELD-REP-CD PIC X(02). CL*13 00081 01 WRK-COUNTERS. CL*13 00082 05 PAGE-COUNT PIC 9(05). CL**9 00083 05 EMPLOYER-COUNT PIC 9(05). CL**9 00084 05 RECORD-COUNT PIC 9(02) VALUE 46. CL*68 00085 01 WRK-DATE-01 PIC 9(09) VALUE ZEROES. CL*38 00086 01 WRK-DATE-01-REDEFINE REDEFINES WRK-DATE-01. CL*34 00087 05 FILLER PIC 9. CL*36 00088 05 WRK-DATE-YEAR PIC 9(04). CL*35 00089 05 WRK-DATE-MONTH PIC 9(02). CL*29 00090 05 WRK-DATE-DAY PIC 9(02). CL*29 00091 01 WRK-CONV-DATE. CL*30 00092 05 WRK-DATE-MM PIC X(02). CL*34 00093 05 FILLER PIC X VALUE '/'. CL*31 00094 05 WRK-DATE-DD PIC X(02). CL*34 00095 05 FILLER PIC X VALUE '/'. CL*31 00096 05 WRK-DATE-YY PIC X(04). CL*34 00097 01 WRK-HEADER-1-TEXT. CL**8 00098 05 FILLER PIC X VALUE SPACE. CL*39 00099 05 FILLER PIC X(05) VALUE CL*39 00100 '125R1'. CL**8 00101 05 FILLER PIC X(36) VALUE SPACES. CL*71 00102 05 WRK-AGY-NAME-LINE1 PIC X(50) VALUE SPACES. CL*69 00103 05 FILLER PIC X(26) VALUE SPACES. CL*71 00104 05 FILLER PIC X(06) VALUE CL**8 00105 'DATE: '. CL**8 00106 05 HEADER-1-DATE PIC X(08). CL**8 00107 01 WRK-HEADER-2-TEXT. CL**9 00108 05 FILLER PIC X VALUE SPACE. CL*41 00109 05 FILLER PIC X(41) VALUE SPACES. CL*71 00110 05 WRK-AGY-NAME-LINE2 PIC X(50) VALUE SPACES. CL*69 00111 05 FILLER PIC X(26) VALUE SPACES. CL*72 00112 05 FILLER PIC X(06) VALUE CL**9 00113 'TIME: '. CL**9 00114 05 HEADER-2-TIME PIC X(08). CL**9 00115 01 WRK-HEADER-3-TEXT. CL**9 00116 05 FILLER PIC X(01) VALUE SPACES. CL*39 00117 05 FILLER PIC X(33) VALUE CL*39 00118 'ROUTE TO: REGISTRATION AND RATES'. CL*15 00119 05 FILLER PIC X(84) VALUE SPACES. CL*43 00120 05 FILLER PIC X(08) VALUE CL*42 00121 'PAGE: '. CL*35 00122 05 HEADER-3-PAGE PIC ZZ,ZZ9. CL*15 00123 01 WRK-REPORT-TITLE. CL*10 00124 05 FILLER PIC X(57) VALUE SPACES. CL*73 00125 05 FILLER PIC X(21) VALUE CL*10 00126 'EMPLOYER ACCOUNT LIST'. CL*34 00127 01 WRK-COLUMN-HEAD-1. CL*10 00128 05 FILLER PIC X(66) VALUE SPACES. CL*35 00129 05 FILLER PIC X(08) VALUE 'EMPLOYER'. CL*10 00130 05 FILLER PIC X(13) VALUE SPACES. CL*35 00131 05 FILLER PIC X(09) VALUE 'LIABILITY'. CL*10 00132 05 FILLER PIC X(06) VALUE SPACES. CL*10 00133 05 FILLER PIC X(08) VALUE 'INACTIVE'. CL*10 00134 05 FILLER PIC X(06) VALUE SPACES. CL*10 00135 05 FILLER PIC X(09) VALUE 'FIELD REP'. CL*10 00136 01 WRK-COLUMN-HEAD-2. CL*11 00137 05 FILLER PIC X(07) VALUE SPACES. CL*59 00138 05 FILLER PIC X(07) VALUE 'EMP NO '. CL*57 00139 05 FILLER PIC X(04) VALUE SPACES. CL*30 00140 05 FILLER PIC X(12) VALUE 'PRIMARY NAME'. CL*11 00141 05 FILLER PIC X(37) VALUE SPACES. CL*15 00142 05 FILLER PIC X(05) VALUE 'CLASS'. CL*15 00143 05 FILLER PIC X(17) VALUE SPACES. CL*35 00144 05 FILLER PIC X(04) VALUE 'DATE'. CL*15 00145 05 FILLER PIC X(10) VALUE SPACES. CL*30 00146 05 FILLER PIC X(11) VALUE 'DATE'. CL*15 00147 05 FILLER PIC X(03) VALUE SPACES. CL*35 00148 05 FILLER PIC X(04) VALUE 'CODE'. CL*15 00149 01 WRK-FOOTER. CL*15 00150 05 FILLER PIC X(46) VALUE SPACES. CL*15 00151 05 R125-OUT-EMPLOYER-COUNT PIC ZZ,ZZ9. CL*15 00152 05 FILLER PIC X(24) VALUE CL*15 00153 ' EMPLOYERS ON LIST'. CL*14 00154 EJECT CL*14 00155 CL**8 00156 01 L001-LINK-AREA. CL**8 00157 ++INCLUDE DTSIL001 CL**8 00158 CL**5 00159 LINKAGE SECTION. CL**4 00160 CL**5 00161 01 LRCM-LINK-AREA. CL**4 00162 ++INCLUDE DTSILRCM CL**5 00163 EJECT CL**4 00164 01 R125-REC. CL**8 00165 ++INCLUDE DTSIR125 CL**8 00166 EJECT CL**4 00167 CL**8 00168 PROCEDURE DIVISION USING LRCM-LINK-AREA CL**4 00169 R125-REC. CL**8 00170 CL**5 00171 IF FIRST-TIME-IND = 'Y' CL**4 00172 PERFORM I1000-INITIATE CL**5 00173 THRU I1000-EXIT CL**5 00174 MOVE 'N' TO FIRST-TIME-IND. CL**4 00175 CL**4 00176 IF LRCM-EOR-88 CL**4 00177 PERFORM T1000-TERMINATE CL**5 00178 THRU T1000-EXIT CL**5 00179 ELSE CL**4 00180 PERFORM P1000-PROCESS CL**5 00181 THRU P1000-EXIT. CL**5 00182 CL**5 00183 GOBACK. CL**4 00184 EJECT CL**4 00185 I1000-INITIATE. CL**4 00186 OPEN OUTPUT PRINT-FILE. CL*13 00187 MOVE ZEROS TO WRK-COUNTERS. CL*13 00188 MOVE LRCM-AGY-NAME-LINE1 TO WRK-AGY-NAME-LINE1. CL*69 00189 MOVE LRCM-AGY-NAME-LINE2 TO WRK-AGY-NAME-LINE2. CL*69 00190 MOVE LRCM-SYS-DATE TO HEADER-1-DATE. CL**8 00191 MOVE LRCM-SYS-TIME TO HEADER-2-TIME. CL**8 00192 PERFORM I1100-WRITE-HEADERS THRU I1100-WRITE-EXIT. CL*24 00193 I1000-EXIT. CL**4 00194 EXIT. CL**4 00195 EJECT CL**4 00196 I1100-WRITE-HEADERS. CL*24 00197 INITIALIZE PRINT-RCD. CL*13 00198 ADD 1 TO PAGE-COUNT. CL*13 00199 MOVE ZERO TO RECORD-COUNT. CL*22 00200 MOVE PAGE-COUNT TO HEADER-3-PAGE. CL*15 00201 WRITE PRINT-RCD FROM WRK-HEADER-1-TEXT CL*13 00202 AFTER ADVANCING TOP-OF-PAGE. CL*13 00203 WRITE PRINT-RCD FROM WRK-HEADER-2-TEXT CL*13 00204 AFTER ADVANCING 1 LINE. CL*13 00205 WRITE PRINT-RCD FROM WRK-HEADER-3-TEXT CL*13 00206 AFTER ADVANCING 1 LINE. CL*13 00207 WRITE PRINT-RCD FROM WRK-REPORT-TITLE CL*13 00208 AFTER ADVANCING 2 LINES. CL*13 00209 WRITE PRINT-RCD FROM WRK-COLUMN-HEAD-1 CL*13 00210 AFTER ADVANCING 3 LINES. CL*13 00211 WRITE PRINT-RCD FROM WRK-COLUMN-HEAD-2 CL*13 00212 AFTER ADVANCING 1 LINE. CL*13 00213 INITIALIZE PRINT-RCD. CL*58 00214 WRITE PRINT-RCD CL*58 00215 AFTER ADVANCING 1 LINE. CL*58 00216 ADD 8 TO RECORD-COUNT. CL*58 00217 I1100-WRITE-EXIT. CL*24 00218 EXIT. CL*13 00219 CL*13 00220 P1000-PROCESS. CL**4 00221 IF RECORD-COUNT > 56 CL*74 00222 PERFORM I1100-WRITE-HEADERS THRU I1100-WRITE-EXIT. CL*24 00223 MOVE R125-EMP-NO TO R125-OUT-EMP-NO. CL*14 00224 MOVE R125-PRIMARY-NAME TO R125-OUT-PRIMARY-NAME. CL*14 00225 *BO MOVE R125-EMPLOYER-CLASS TO R125-OUT-EMPLOYER-CLASS. CL*59 00226 IF R125-EMPLOYER-CLASS = 'R' CL*59 00227 MOVE ' RATED ' TO R125-OUT-EMPLOYER-CLASS CL*59 00228 ELSE IF R125-EMPLOYER-CLASS = 'S' CL*59 00229 MOVE ' SELF INSURED' TO R125-OUT-EMPLOYER-CLASS CL*61 00230 ELSE IF R125-EMPLOYER-CLASS = 'U' CL*59 00231 MOVE ' UNKNOWN ' TO R125-OUT-EMPLOYER-CLASS. CL*59 00232 MOVE R125-LIAB-DATE TO WRK-DATE-01. CL*45 00233 PERFORM P1100-DATE-RTN THRU P1100-DATE-RTN-EXIT. CL*45 00234 MOVE WRK-CONV-DATE TO R125-OUT-LIAB-DATE. CL*45 00235 IF R125-INACT-DATE EQUAL WRK-INVALID-DATE CL*56 00236 MOVE SPACES TO R125-OUT-INACT-DATE CL*45 00237 ELSE CL*45 00238 MOVE R125-INACT-DATE TO WRK-DATE-01 CL*45 00239 PERFORM P1100-DATE-RTN THRU P1100-DATE-RTN-EXIT CL*45 00240 MOVE WRK-CONV-DATE TO R125-OUT-INACT-DATE CL*49 00241 END-IF. CL*45 00242 MOVE R125-FIELD-REP-CD TO R125-OUT-FIELD-REP-CD. CL*44 00243 CL*44 00244 PERFORM P1200-WRITE-RECORDS THRU P1200-WRITE-EXIT. CL*20 00245 CL*44 00246 ADD 1 TO RECORD-COUNT EMPLOYER-COUNT. CL*30 00247 P1000-EXIT. CL**4 00248 EXIT. CL**4 00249 EJECT CL**4 00250 CL**5 00251 P1100-DATE-RTN. CL*32 00252 MOVE WRK-DATE-YEAR TO WRK-DATE-YY. CL*31 00253 MOVE WRK-DATE-MONTH TO WRK-DATE-MM. CL*31 00254 MOVE WRK-DATE-DAY TO WRK-DATE-DD. CL*31 00255 P1100-DATE-RTN-EXIT. CL*32 00256 EXIT. CL*14 00257 P1200-WRITE-RECORDS. CL*31 00258 WRITE PRINT-RCD FROM R125-OUT-REC CL*31 00259 AFTER ADVANCING 1 LINE. CL*31 00260 INITIALIZE PRINT-RCD. CL*31 00261 CL*31 00262 P1200-WRITE-EXIT. CL*31 00263 EXIT. CL*31 00264 EJECT CL*14 00265 CL**5 00266 T1000-TERMINATE. CL**4 00267 MOVE EMPLOYER-COUNT TO R125-OUT-EMPLOYER-COUNT. CL*15 00268 MOVE WRK-FOOTER TO PRINT-RCD. CL*15 00269 WRITE PRINT-RCD AFTER 3. CL*40 00270 CLOSE PRINT-FILE. CL*20 00271 CL*20 00272 T1000-EXIT. CL**4 00273 EXIT. CL**4 00274 EJECT CL**4 00275 CL**5 00276 S999-ABEND. CL**4 00277 CL**4 00278 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**5 00279 CL**4 00280 S999-EXIT. CL**4 00281 EXIT. CL**4