giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

DUTAS re-platformed to Raincode - Initial Source Code

Browse Source
This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

282
Batch/DTSBR125.cob Normal file
View File

@ -0,0 +1,282 @@
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