DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
432
Batch/DTSBR751.cob
Normal file
432
Batch/DTSBR751.cob
Normal file
@ -0,0 +1,432 @@
|
||||
00001 IDENTIFICATION DIVISION. 07/09/04
|
||||
00002 PROGRAM-ID. DTSBR751. DTSBR751
|
||||
00003 AUTHOR. TRW. LV022
|
||||
00004 DATE-WRITTEN. NOVEMBER 2002. DTSBR751
|
||||
00005 DATE-COMPILED. DTSBR751
|
||||
00006 SKIP3 DTSBR751
|
||||
00007 ***** DTSBR751
|
||||
00008 * DTSBR751
|
||||
00009 * CALLING SEQUENCE: DTSCS7D CREATES BR751 RECORDS DIRECTLY. DTSBR751
|
||||
00010 * DTSBR751
|
||||
00011 * FUNCTION: PRINT EMPLOYER WAGE REQUEST NOTICE. DTSBR751
|
||||
00012 * DTSBR751
|
||||
00013 * DTSBR751
|
||||
00014 * MODIFICATION HISTORY: DTSBR751
|
||||
00015 * DTSBR751
|
||||
00016 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR751
|
||||
00017 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR751
|
||||
00018 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR751
|
||||
00019 * DTSBR751
|
||||
00020 * DTSBR751
|
||||
00021 * DESCRIPTION: DTSBR751
|
||||
00022 * DTSBR751
|
||||
00023 * THIS MODULE PRINTS A NOTICE TO AN EMPLOYER REQUESTING DTSBR751
|
||||
00024 * THE WAGES PAID TO A UI BENEFIT CLAIMANT. DTSBR751
|
||||
00025 * DTSBR751
|
||||
00026 * RECORDS READ: DTSBR751
|
||||
00027 * DTSBR751
|
||||
00028 * NONE. DTSBR751
|
||||
00029 * DTSBR751
|
||||
00030 * DTSBR751
|
||||
00031 * PRINTED OUTPUTS: DTSBR751
|
||||
00032 * DTSBR751
|
||||
00033 * 751R1 EMPLOYER WAGE REQUEST NOTICE (XEROX FORM). DTSBR751
|
||||
00034 * DTSBR751
|
||||
00035 * DTSBR751
|
||||
00036 * RECORDS WRITTEN: DTSBR751
|
||||
00037 * DTSBR751
|
||||
00038 * NONE. DTSBR751
|
||||
00039 * DTSBR751
|
||||
00040 * DTSBR751
|
||||
00041 * MODULES CALLED: DTSBR751
|
||||
00042 * DTSBR751
|
||||
00043 * DTSBU001 DATE CONVERSION DTSBR751
|
||||
00044 * DTSBU002 MIXED CASE CONVERSION DTSBR751
|
||||
00045 * DTSBR751
|
||||
00046 ***** DTSBR751
|
||||
00047 EJECT DTSBR751
|
||||
00048 ENVIRONMENT DIVISION. DTSBR751
|
||||
00049 DTSBR751
|
||||
00050 CONFIGURATION SECTION. DTSBR751
|
||||
00051 SPECIAL-NAMES. C01 IS TOP-PAGE. DTSBR751
|
||||
00052 DTSBR751
|
||||
00053 INPUT-OUTPUT SECTION. DTSBR751
|
||||
00054 DTSBR751
|
||||
00055 FILE-CONTROL. DTSBR751
|
||||
00056 SELECT PRT-FILE ASSIGN TO RPT751R1. DTSBR751
|
||||
00057 DTSBR751
|
||||
00058 DATA DIVISION. DTSBR751
|
||||
00059 DTSBR751
|
||||
00060 FILE SECTION. DTSBR751
|
||||
00061 DTSBR751
|
||||
00062 FD PRT-FILE DTSBR751
|
||||
00063 RECORDING MODE IS F DTSBR751
|
||||
00064 BLOCK CONTAINS 0 RECORDS DTSBR751
|
||||
00065 LABEL RECORDS ARE OMITTED. DTSBR751
|
||||
00066 DTSBR751
|
||||
00067 01 PRINT-RECORD PIC X(133). DTSBR751
|
||||
00068 EJECT DTSBR751
|
||||
00069 WORKING-STORAGE SECTION. DTSBR751
|
||||
000695 77 PAN-VALET PICTURE X(24) VALUE '022DTSBR751 07/09/04'. DTSBR751
|
||||
00070 DTSBR751
|
||||
00071 01 WRK-AREA. DTSBR751
|
||||
00072 05 SUB1 PIC S9(04) COMP VALUE +0. DTSBR751
|
||||
00073 05 SUB2 PIC S9(04) COMP VALUE +0. DTSBR751
|
||||
00074 05 SUB3 PIC S9(04) COMP VALUE +0. DTSBR751
|
||||
00075 05 SPACER PIC X(01) VALUE SPACE. DTSBR751
|
||||
00076 05 PROGRAM-ESP902D PIC X(08) VALUE 'ESP902D'. DTSBR751
|
||||
00077 DTSBR751
|
||||
00078 05 ESP902-WORK-NAME. DTSBR751
|
||||
00079 10 ESP902-NAME-FORMAT PIC 9(1). DTSBR751
|
||||
00080 88 ESP902-FIRST-NAME-FIRST VALUE 1. DTSBR751
|
||||
00081 88 ESP902-LAST-NAME-FIRST VALUE 2. DTSBR751
|
||||
00082 10 ESP902-NAME-RETURN PIC 9(1). DTSBR751
|
||||
00083 88 ESP902-NAME-CONVERTED VALUE 0. DTSBR751
|
||||
00084 88 ESP902-NAME-INVALID VALUE 8. DTSBR751
|
||||
00085 88 ESP902-INVALID-FORMAT-CODE VALUE 9. DTSBR751
|
||||
00086 10 ESP902-NAM. DTSBR751
|
||||
00087 15 ESP902-NAME DTSBR751
|
||||
00088 OCCURS 32 TIMES PIC X(1) VALUE SPACE. DTSBR751
|
||||
00089 10 ESP902-NAME-SEGMENT. DTSBR751
|
||||
00090 15 ESP902-NAME-FIRST PIC X(32) VALUE SPACE. DTSBR751
|
||||
00091 15 ESP902-NAME-LAST PIC X(32) VALUE SPACE. DTSBR751
|
||||
00092 DTSBR751
|
||||
00093 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR751
|
||||
00094 DTSBR751
|
||||
00095 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +751.DTSBR751
|
||||
00096 05 ABEND-MSG PIC X(60). DTSBR751
|
||||
00097 DTSBR751
|
||||
00098 05 WRK-HOLD-YRQ PIC 9(5). DTSBR751
|
||||
00099 05 WRK-HOLD-EMP-NO PIC 9(6). DTSBR751
|
||||
00100 05 WRK-HOLD-OP-NAME PIC X(32) VALUE SPACES. DTSBR751
|
||||
00101 05 WRK-MONTH-LITERAL-TO-USE PIC 9(1). DTSBR751
|
||||
00102 DTSBR751
|
||||
00103 05 WRK-DATE. DTSBR751
|
||||
00104 10 WRK-DATE-YEAR PIC 9(04). DTSBR751
|
||||
00105 10 FILLER PIC X(04) VALUE '0301'. DTSBR751
|
||||
00106 05 WRK-DATE-RE REDEFINES WRK-DATE PIC 9(08). DTSBR751
|
||||
00107 DTSBR751
|
||||
00108 05 WRK-FORMAT-QUARTER. DTSBR751
|
||||
00109 10 WRK-FQ-QTR PIC X(04). DTSBR751
|
||||
00110 10 FILLER PIC X(08) VALUE 'QUARTER'. DTSBR751
|
||||
00111 10 WRK-FQ-YEAR PIC X(04). DTSBR751
|
||||
00112 DTSBR751
|
||||
00113 05 WRK-QTR-BEGIN-DATE PIC 9(08). DTSBR751
|
||||
00114 05 WRK-PREV-QTR-END-DAY PIC 9(02). DTSBR751
|
||||
00115 05 WRK-QTR-BEGIN-DAY PIC 9(01). DTSBR751
|
||||
00116 05 WRK-DAYS-IN-MONTH. DTSBR751
|
||||
00117 10 WRK-MONTH1-DAYS PIC 9(02). DTSBR751
|
||||
00118 10 WRK-MONTH2-DAYS PIC 9(02). DTSBR751
|
||||
00119 10 WRK-MONTH3-DAYS PIC 9(02). DTSBR751
|
||||
00120 05 WRK-MONTH-LITERAL. DTSBR751
|
||||
00121 10 WRK-MONTH1-LITERAL. DTSBR751
|
||||
00122 15 WRK-MTH1-ALPHA PIC X(04). DTSBR751
|
||||
00123 15 WRK-MTH1-ALPHA-YR PIC X(02). DTSBR751
|
||||
00124 10 WRK-MONTH2-LITERAL. DTSBR751
|
||||
00125 15 WRK-MTH2-ALPHA PIC X(04). DTSBR751
|
||||
00126 15 WRK-MTH2-ALPHA-YR PIC X(02). DTSBR751
|
||||
00127 10 WRK-MONTH3-LITERAL. DTSBR751
|
||||
00128 15 WRK-MTH3-ALPHA PIC X(04). DTSBR751
|
||||
00129 15 WRK-MTH3-ALPHA-YR PIC X(02). DTSBR751
|
||||
00130 DTSBR751
|
||||
00131 05 WRK-FORMAT-SSN. DTSBR751
|
||||
00132 10 WRK-FS-SSN1 PIC X(03). DTSBR751
|
||||
00133 10 FILLER PIC X(01) VALUE '-'. DTSBR751
|
||||
00134 10 WRK-FS-SSN2 PIC X(02). DTSBR751
|
||||
00135 10 FILLER PIC X(01) VALUE '-'. DTSBR751
|
||||
00136 10 WRK-FS-SSN3 PIC X(04). DTSBR751
|
||||
00137 DTSBR751
|
||||
00138 05 WRK-QUARTER-ARRAY. DTSBR751
|
||||
00139 10 WRK-QTR-DAY OCCURS 91 TIMES PIC 9(02). DTSBR751
|
||||
00140 DTSBR751
|
||||
00141 05 RPT-LINE-1. DTSBR751
|
||||
00142 10 FILLER PIC X(58) VALUE SPACES. DTSBR751
|
||||
00143 10 RPT-MAIL-DATE PIC X(20) JUSTIFIED RIGHT. DTSBR751
|
||||
00144 DTSBR751
|
||||
00145 05 RPT-LINE-2. DTSBR751
|
||||
00146 * 10 FILLER PIC X(01) VALUE SPACES. DTSBR751
|
||||
00147 10 RPT-EMP-ACCT PIC X(07). DTSBR751
|
||||
00148 10 FILLER PIC X(01) VALUE SPACES. DTSBR751
|
||||
00149 10 RPT-EMP-NAME PIC X(40). DTSBR751
|
||||
00150 10 FILLER PIC X(08) VALUE SPACES. DTSBR751
|
||||
00151 10 RPT-YRQ PIC X(16). DTSBR751
|
||||
00152 DTSBR751
|
||||
00153 05 RPT-LINE-3. DTSBR751
|
||||
00154 10 FILLER PIC X(18) VALUE SPACES. DTSBR751
|
||||
00155 10 RPT-CLAIMANT-NAME PIC X(28). DTSBR751
|
||||
00156 10 FILLER PIC X(15) VALUE SPACES. DTSBR751
|
||||
00157 10 RPT-SSN PIC X(11). DTSBR751
|
||||
00158 DTSBR751
|
||||
00159 05 RPT-LINE-4. DTSBR751
|
||||
00160 10 FILLER PIC X(08) VALUE SPACES. DTSBR751
|
||||
00161 10 RPT-DAY OCCURS 7 TIMES PIC X(05). DTSBR751
|
||||
00162 10 RPT-ALPHA-MTH PIC X(06). DTSBR751
|
||||
00163 DTSBR751
|
||||
00164 01 L001-LINK-AREA. DTSBR751
|
||||
00165 ++INCLUDE DTSIL001 DTSBR751
|
||||
00166 DTSBR751
|
||||
00167 01 L002-LINK-AREA. DTSBR751
|
||||
00168 ++INCLUDE DTSIL002 DTSBR751
|
||||
00169 DTSBR751
|
||||
00170 ++INCLUDE DTSXL751 DTSBR751
|
||||
00171 DTSBR751
|
||||
00172 LINKAGE SECTION. DTSBR751
|
||||
00173 01 LRCM-LINK-AREA. DTSBR751
|
||||
00174 ++INCLUDE DTSILRCM DTSBR751
|
||||
00175 DTSBR751
|
||||
00176 01 R751-REC. DTSBR751
|
||||
00177 ++INCLUDE DTSIR751 DTSBR751
|
||||
00178 EJECT DTSBR751
|
||||
00179 PROCEDURE DIVISION USING LRCM-LINK-AREA, DTSBR751
|
||||
00180 R751-REC. DTSBR751
|
||||
00181 DTSBR751
|
||||
00182 IF FIRST-TIME-IND = 'Y' DTSBR751
|
||||
00183 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR751
|
||||
00184 MOVE 'N' TO FIRST-TIME-IND. DTSBR751
|
||||
00185 DTSBR751
|
||||
00186 IF LRCM-EOR-88 DTSBR751
|
||||
00187 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR751
|
||||
00188 ELSE DTSBR751
|
||||
00189 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR751
|
||||
00190 DTSBR751
|
||||
00191 GOBACK. DTSBR751
|
||||
00192 DTSBR751
|
||||
00193 I1000-INITIATE. DTSBR751
|
||||
00194 OPEN OUTPUT PRT-FILE. DTSBR751
|
||||
00195 WRITE PRINT-RECORD FROM XEROX-CNTL-LINE AFTER TOP-PAGE. DTSBR751
|
||||
00196 ** WRITE PRINT-RECORD FROM XEROX-CNTL-LINE2 AFTER 1. DTSBR751
|
||||
00197 I1000-EXIT. DTSBR751
|
||||
00198 EXIT. DTSBR751
|
||||
00199 DTSBR751
|
||||
00200 P1000-PROCESS. DTSBR751
|
||||
00201 IF R751-OP-NAME NOT EQUAL WRK-HOLD-OP-NAME DTSBR751
|
||||
00202 MOVE R751-OP-NAME TO WRK-HOLD-OP-NAME, DTSBR751
|
||||
00203 ROUTE-OP-NAME DTSBR751
|
||||
00204 WRITE PRINT-RECORD FROM SPACER AFTER TOP-PAGE DTSBR751
|
||||
00205 WRITE PRINT-RECORD FROM SPACER AFTER ADVANCING 4 DTSBR751
|
||||
00206 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE1 DTSBR751
|
||||
00207 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE2 DTSBR751
|
||||
00208 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE3 DTSBR751
|
||||
00209 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE4 DTSBR751
|
||||
00210 WRITE PRINT-RECORD FROM ROUTE-INFO-LINE5. DTSBR751
|
||||
00211 DTSBR751
|
||||
00212 MOVE R751-MAIL-DATE TO L002-DATE. DTSBR751
|
||||
00213 PERFORM S002-MIXED-CASE THRU S002-EXIT. DTSBR751
|
||||
00214 MOVE L002-LONG-TEXT-AREA TO RPT-MAIL-DATE. DTSBR751
|
||||
00215 DTSBR751
|
||||
00216 IF R751-EMP-NO GREATER ZEROS DTSBR751
|
||||
00217 MOVE R751-EMP-NO TO WRK-HOLD-EMP-NO DTSBR751
|
||||
00218 MOVE WRK-HOLD-EMP-NO (1:3) TO RPT-EMP-ACCT (1:3) DTSBR751
|
||||
00219 MOVE '-' TO RPT-EMP-ACCT (4:1) DTSBR751
|
||||
00220 MOVE WRK-HOLD-EMP-NO (4:3) TO RPT-EMP-ACCT (5:3) DTSBR751
|
||||
00221 ELSE DTSBR751
|
||||
00222 MOVE SPACES TO RPT-EMP-ACCT. DTSBR751
|
||||
00223 DTSBR751
|
||||
00224 MOVE R751-CLAIMANT-NAME TO RPT-CLAIMANT-NAME. DTSBR751
|
||||
00225 MOVE R751-EMP-PRIMARY-NAME TO RPT-EMP-NAME. DTSBR751
|
||||
00226 DTSBR751
|
||||
00227 PERFORM P1100-FORMAT-DATA THRU P1100-EXIT. DTSBR751
|
||||
00228 MOVE WRK-FORMAT-QUARTER TO RPT-YRQ. DTSBR751
|
||||
00229 MOVE WRK-FORMAT-SSN TO RPT-SSN. DTSBR751
|
||||
00230 DTSBR751
|
||||
00231 MOVE WRK-QTR-BEGIN-DATE TO L001-FED-8-DATE-9. DTSBR751
|
||||
00232 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR751
|
||||
00233 MOVE L001-DAY-OF-WEEK TO WRK-QTR-BEGIN-DAY. DTSBR751
|
||||
00234 DTSBR751
|
||||
00235 PERFORM P1300-SET-QUARTER-ARRAY THRU P1300-EXIT. DTSBR751
|
||||
00236 DTSBR751
|
||||
00237 MOVE ZERO TO SUB3. DTSBR751
|
||||
00238 MOVE 1 TO WRK-MONTH-LITERAL-TO-USE. DTSBR751
|
||||
00239 WRITE PRINT-RECORD FROM SPACER AFTER TOP-PAGE. DTSBR751
|
||||
00240 WRITE PRINT-RECORD FROM RPT-LINE-1 AFTER 3. DTSBR751
|
||||
00241 WRITE PRINT-RECORD FROM RPT-LINE-2 AFTER 2. DTSBR751
|
||||
00242 WRITE PRINT-RECORD FROM RPT-LINE-3 AFTER 3. DTSBR751
|
||||
00243 WRITE PRINT-RECORD FROM SPACER AFTER 14. DTSBR751
|
||||
00244 DTSBR751
|
||||
00245 PERFORM P1400-PRINT-QTR-ARRAY THRU P1400-EXIT DTSBR751
|
||||
00246 VARYING SUB1 FROM 1 BY 1 DTSBR751
|
||||
00247 UNTIL SUB1 GREATER 13. DTSBR751
|
||||
00248 DTSBR751
|
||||
00249 P1000-EXIT. DTSBR751
|
||||
00250 EXIT. DTSBR751
|
||||
00251 DTSBR751
|
||||
00252 P1100-FORMAT-DATA. DTSBR751
|
||||
00253 MOVE R751-YRQ TO WRK-HOLD-YRQ. DTSBR751
|
||||
00254 MOVE WRK-HOLD-YRQ (1:4) TO WRK-FQ-YEAR, DTSBR751
|
||||
00255 WRK-QTR-BEGIN-DATE (1:4), DTSBR751
|
||||
00256 WRK-DATE-YEAR. DTSBR751
|
||||
00257 DTSBR751
|
||||
00258 MOVE WRK-HOLD-YRQ (3:2) TO WRK-MTH1-ALPHA-YR, DTSBR751
|
||||
00259 WRK-MTH2-ALPHA-YR, DTSBR751
|
||||
00260 WRK-MTH3-ALPHA-YR. DTSBR751
|
||||
00261 DTSBR751
|
||||
00262 IF WRK-HOLD-YRQ (5:1) EQUAL 1 DTSBR751
|
||||
00263 MOVE '1ST' TO WRK-FQ-QTR DTSBR751
|
||||
00264 MOVE 'JAN-' TO WRK-MTH1-ALPHA DTSBR751
|
||||
00265 MOVE 'FEB-' TO WRK-MTH2-ALPHA DTSBR751
|
||||
00266 MOVE 'MAR-' TO WRK-MTH3-ALPHA DTSBR751
|
||||
00267 MOVE 0101 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751
|
||||
00268 MOVE 31 TO WRK-MONTH1-DAYS DTSBR751
|
||||
00269 PERFORM P1200-GET-FEB-DAYS THRU P1200-EXIT DTSBR751
|
||||
00270 MOVE 31 TO WRK-MONTH3-DAYS DTSBR751
|
||||
00271 MOVE 31 TO WRK-PREV-QTR-END-DAY DTSBR751
|
||||
00272 ELSE DTSBR751
|
||||
00273 IF WRK-HOLD-YRQ (5:1) EQUAL 2 DTSBR751
|
||||
00274 MOVE '2ND' TO WRK-FQ-QTR DTSBR751
|
||||
00275 MOVE 'APR-' TO WRK-MTH1-ALPHA DTSBR751
|
||||
00276 MOVE 'MAY-' TO WRK-MTH2-ALPHA DTSBR751
|
||||
00277 MOVE 'JUN-' TO WRK-MTH3-ALPHA DTSBR751
|
||||
00278 MOVE 0401 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751
|
||||
00279 MOVE 30 TO WRK-MONTH1-DAYS DTSBR751
|
||||
00280 MOVE 31 TO WRK-MONTH2-DAYS DTSBR751
|
||||
00281 MOVE 30 TO WRK-MONTH3-DAYS DTSBR751
|
||||
00282 MOVE 31 TO WRK-PREV-QTR-END-DAY DTSBR751
|
||||
00283 ELSE DTSBR751
|
||||
00284 IF WRK-HOLD-YRQ (5:1) EQUAL 3 DTSBR751
|
||||
00285 MOVE '3RD' TO WRK-FQ-QTR DTSBR751
|
||||
00286 MOVE 'JUL-' TO WRK-MTH1-ALPHA DTSBR751
|
||||
00287 MOVE 'AUG-' TO WRK-MTH2-ALPHA DTSBR751
|
||||
00288 MOVE 'SEP-' TO WRK-MTH3-ALPHA DTSBR751
|
||||
00289 MOVE 0701 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751
|
||||
00290 MOVE 31 TO WRK-MONTH1-DAYS DTSBR751
|
||||
00291 MOVE 31 TO WRK-MONTH2-DAYS DTSBR751
|
||||
00292 MOVE 30 TO WRK-MONTH3-DAYS DTSBR751
|
||||
00293 MOVE 30 TO WRK-PREV-QTR-END-DAY DTSBR751
|
||||
00294 ELSE DTSBR751
|
||||
00295 MOVE '4TH' TO WRK-FQ-QTR DTSBR751
|
||||
00296 MOVE 'OCT-' TO WRK-MTH1-ALPHA DTSBR751
|
||||
00297 MOVE 'NOV-' TO WRK-MTH2-ALPHA DTSBR751
|
||||
00298 MOVE 'DEC-' TO WRK-MTH3-ALPHA DTSBR751
|
||||
00299 MOVE 1001 TO WRK-QTR-BEGIN-DATE (5:4) DTSBR751
|
||||
00300 MOVE 31 TO WRK-MONTH1-DAYS DTSBR751
|
||||
00301 MOVE 30 TO WRK-MONTH2-DAYS DTSBR751
|
||||
00302 MOVE 31 TO WRK-MONTH3-DAYS DTSBR751
|
||||
00303 MOVE 30 TO WRK-PREV-QTR-END-DAY. DTSBR751
|
||||
00304 DTSBR751
|
||||
00305 MOVE R751-SSN (1:3) TO WRK-FS-SSN1. DTSBR751
|
||||
00306 MOVE R751-SSN (4:2) TO WRK-FS-SSN2. DTSBR751
|
||||
00307 MOVE R751-SSN (6:4) TO WRK-FS-SSN3. DTSBR751
|
||||
00308 DTSBR751
|
||||
00309 P1100-EXIT. DTSBR751
|
||||
00310 EXIT. DTSBR751
|
||||
00311 DTSBR751
|
||||
00312 P1200-GET-FEB-DAYS. DTSBR751
|
||||
00313 **************************************************************** DTSBR751
|
||||
00314 * WRK-DATE CONTAINS THE 1ST OF MARCH DATE FOR CURRENT YEAR. DTSBR751
|
||||
00315 * USING THIS DATE IN A CALL TO THE DATE ROUTINE, YOU CAN DTSBR751
|
||||
00316 * DETERMINE THE NUMBER OF DAYS IN FEBRUARY BY SUBTRACTING DTSBR751
|
||||
00317 * 1 FROM THE ABSOLUTE DATE, THEN CALL THE DATE ROUTINE AGAIN. DTSBR751
|
||||
00318 *************************************************************** DTSBR751
|
||||
00319 DTSBR751
|
||||
00320 MOVE WRK-DATE TO L001-FED-8-DATE-9. DTSBR751
|
||||
00321 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBR751
|
||||
00322 SUBTRACT 1 FROM L001-JUL-ABS-DAY. DTSBR751
|
||||
00323 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBR751
|
||||
00324 MOVE L001-SLASH-8-DA TO WRK-MONTH2-DAYS. DTSBR751
|
||||
00325 P1200-EXIT. DTSBR751
|
||||
00326 EXIT. DTSBR751
|
||||
00327 DTSBR751
|
||||
00328 P1300-SET-QUARTER-ARRAY. DTSBR751
|
||||
00329 SUBTRACT 1 FROM WRK-QTR-BEGIN-DAY GIVING SUB1. DTSBR751
|
||||
00330 PERFORM P1310-SQA THRU P1310-EXIT DTSBR751
|
||||
00331 VARYING SUB1 FROM SUB1 BY -1 DTSBR751
|
||||
00332 UNTIL SUB1 EQUAL ZERO. DTSBR751
|
||||
00333 DTSBR751
|
||||
00334 MOVE WRK-QTR-BEGIN-DAY TO SUB1. DTSBR751
|
||||
00335 MOVE ZEROS TO SUB2. DTSBR751
|
||||
00336 PERFORM P1320-SQA THRU P1320-EXIT DTSBR751
|
||||
00337 VARYING SUB1 FROM SUB1 BY +1 DTSBR751
|
||||
00338 UNTIL SUB2 EQUAL WRK-MONTH1-DAYS. DTSBR751
|
||||
00339 DTSBR751
|
||||
00340 MOVE ZEROS TO SUB2. DTSBR751
|
||||
00341 PERFORM P1320-SQA THRU P1320-EXIT DTSBR751
|
||||
00342 VARYING SUB1 FROM SUB1 BY +1 DTSBR751
|
||||
00343 UNTIL SUB2 EQUAL WRK-MONTH2-DAYS. DTSBR751
|
||||
00344 DTSBR751
|
||||
00345 MOVE ZEROS TO SUB2. DTSBR751
|
||||
00346 PERFORM P1320-SQA THRU P1320-EXIT DTSBR751
|
||||
00347 VARYING SUB1 FROM SUB1 BY +1 DTSBR751
|
||||
00348 UNTIL SUB1 GREATER 91. DTSBR751
|
||||
00349 P1300-EXIT. DTSBR751
|
||||
00350 EXIT. DTSBR751
|
||||
00351 DTSBR751
|
||||
00352 P1310-SQA. DTSBR751
|
||||
00353 MOVE WRK-PREV-QTR-END-DAY TO WRK-QTR-DAY (SUB1). DTSBR751
|
||||
00354 SUBTRACT 1 FROM WRK-PREV-QTR-END-DAY. DTSBR751
|
||||
00355 P1310-EXIT. DTSBR751
|
||||
00356 EXIT. DTSBR751
|
||||
00357 DTSBR751
|
||||
00358 P1320-SQA. DTSBR751
|
||||
00359 ADD 1 TO SUB2. DTSBR751
|
||||
00360 MOVE SUB2 TO WRK-QTR-DAY (SUB1). DTSBR751
|
||||
00361 P1320-EXIT. DTSBR751
|
||||
00362 EXIT. DTSBR751
|
||||
00363 DTSBR751
|
||||
00364 P1400-PRINT-QTR-ARRAY. DTSBR751
|
||||
00365 PERFORM P1410-PQA THRU P1410-EXIT DTSBR751
|
||||
00366 VARYING SUB2 FROM 1 BY 1 DTSBR751
|
||||
00367 UNTIL SUB2 GREATER 7. DTSBR751
|
||||
00368 DTSBR751
|
||||
00369 IF WRK-MONTH-LITERAL-TO-USE EQUAL 1 DTSBR751
|
||||
00370 MOVE WRK-MONTH1-LITERAL TO RPT-ALPHA-MTH DTSBR751
|
||||
00371 ELSE DTSBR751
|
||||
00372 IF WRK-MONTH-LITERAL-TO-USE EQUAL 2 DTSBR751
|
||||
00373 MOVE WRK-MONTH2-LITERAL TO RPT-ALPHA-MTH DTSBR751
|
||||
00374 ELSE DTSBR751
|
||||
00375 MOVE WRK-MONTH3-LITERAL TO RPT-ALPHA-MTH. DTSBR751
|
||||
00376 DTSBR751
|
||||
00377 WRITE PRINT-RECORD FROM SPACER AFTER 1. DTSBR751
|
||||
00378 WRITE PRINT-RECORD FROM RPT-LINE-4 AFTER 1. DTSBR751
|
||||
00379 P1400-EXIT. DTSBR751
|
||||
00380 EXIT. DTSBR751
|
||||
00381 DTSBR751
|
||||
00382 P1410-PQA. DTSBR751
|
||||
00383 ADD 1 TO SUB3. DTSBR751
|
||||
00384 IF SUB3 GREATER 7 DTSBR751
|
||||
00385 IF WRK-QTR-DAY (SUB3) LESS WRK-QTR-DAY (SUB3 - 1) DTSBR751
|
||||
00386 ADD 1 TO WRK-MONTH-LITERAL-TO-USE. DTSBR751
|
||||
00387 MOVE WRK-QTR-DAY (SUB3) TO RPT-DAY (SUB2). DTSBR751
|
||||
00388 P1410-EXIT. DTSBR751
|
||||
00389 EXIT. DTSBR751
|
||||
00390 DTSBR751
|
||||
00391 T1000-TERMINATE. DTSBR751
|
||||
00392 CLOSE PRT-FILE. DTSBR751
|
||||
00393 T1000-EXIT. DTSBR751
|
||||
00394 EXIT. DTSBR751
|
||||
00395 DTSBR751
|
||||
00396 S001-FROM-FED-8. DTSBR751
|
||||
00397 SET L001-FROM-FED-8 TO TRUE. DTSBR751
|
||||
00398 GO TO S001-DATE. DTSBR751
|
||||
00399 DTSBR751
|
||||
00400 S001-FROM-ABS-DAY. DTSBR751
|
||||
00401 SET L001-FROM-ABS-DAY TO TRUE. DTSBR751
|
||||
00402 GO TO S001-DATE. DTSBR751
|
||||
00403 DTSBR751
|
||||
00404 S001-DATE. DTSBR751
|
||||
00405 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBR751
|
||||
00406 S001-EXIT. DTSBR751
|
||||
00407 EXIT. DTSBR751
|
||||
00408 DTSBR751
|
||||
00409 S002-UPPER-CASE. DTSBR751
|
||||
00410 SET L002-UPPER-CASE TO TRUE. DTSBR751
|
||||
00411 GO TO S002-DATE-ALPHA. DTSBR751
|
||||
00412 DTSBR751
|
||||
00413 S002-MIXED-CASE. DTSBR751
|
||||
00414 SET L002-MIXED-CASE TO TRUE. DTSBR751
|
||||
00415 GO TO S002-DATE-ALPHA. DTSBR751
|
||||
00416 DTSBR751
|
||||
00417 S002-DATE-ALPHA. DTSBR751
|
||||
00418 CALL 'DTSBU002' USING L002-LINK-AREA. DTSBR751
|
||||
00419 S002-EXIT. DTSBR751
|
||||
00420 EXIT. DTSBR751
|
||||
00421 DTSBR751
|
||||
00422 S999-ABEND. DTSBR751
|
||||
00423 DISPLAY '***'. DTSBR751
|
||||
00424 DISPLAY '*** ' DTSBR751
|
||||
00425 ABEND-MSG. DTSBR751
|
||||
00426 DISPLAY '***'. DTSBR751
|
||||
00427 DTSBR751
|
||||
00428 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR751
|
||||
00429 S999-EXIT. DTSBR751
|
||||
00430 EXIT. DTSBR751
|
||||
00431 DTSBR751
|
||||
Reference in New Issue
Block a user