231 lines
18 KiB
COBOL
231 lines
18 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/13/10
|
|
00002 PROGRAM-ID. DTSBX469. DTSBX469
|
|
00003 LV001
|
|
00004 ******************************************************************DTSBX469
|
|
00005 * *DTSBX469
|
|
00006 * *DTSBX469
|
|
00007 * FUNCTION: *DTSBX469
|
|
00008 * *DTSBX469
|
|
00009 * THE FUNCTION OF DTSBX465 IS TO GENERATE A UI WAGE *DTSBX469
|
|
00010 * FILE OF UI WAGES UPDATED TO THE UI WAGE FILE ON A GIVEN *DTSBX469
|
|
00011 * DATE. *DTSBX469
|
|
00012 * THE WGD-ACTIVITY-DATE FIELD IN THE UI WAGE FILE. *DTSBX469
|
|
00013 * *DTSBX469
|
|
00014 * *DTSBX469
|
|
00015 * *DTSBX469
|
|
00016 * G.A.BROWN *DTSBX469
|
|
00017 ******************************************************************DTSBX469
|
|
00018 ***** DTSBX469
|
|
00019 DTSBX469
|
|
00020 ENVIRONMENT DIVISION. DTSBX469
|
|
00021 CONFIGURATION SECTION. DTSBX469
|
|
00022 INPUT-OUTPUT SECTION. DTSBX469
|
|
00023 FILE-CONTROL. DTSBX469
|
|
00024 SELECT WAGE-FILE ASSIGN TO UT-S-WAGE. DTSBX469
|
|
00025 DATA DIVISION. DTSBX469
|
|
00026 FILE SECTION. DTSBX469
|
|
00027 DTSBX469
|
|
00028 FD WAGE-FILE DTSBX469
|
|
00029 RECORDING MODE IS F DTSBX469
|
|
00030 LABEL RECORD ARE STANDARD DTSBX469
|
|
00031 RECORD CONTAINS 59 CHARACTERS DTSBX469
|
|
00032 BLOCK CONTAINS 0 RECORDS DTSBX469
|
|
00033 DATA RECORD IS WAGE-REC. DTSBX469
|
|
00034 DTSBX469
|
|
00035 01 WAGE-REC. DTSBX469
|
|
00036 03 EMPLOYEE-SSN PIC 9(9). DTSBX469
|
|
00037 03 EMPLOYEE-LAST-NAME PIC X(3). DTSBX469
|
|
00038 03 FIL PIC 9(3). DTSBX469
|
|
00039 03 EMPLOYER-ACCT-NUM PIC 9(6). DTSBX469
|
|
00040 03 FIL PIC 9(3). DTSBX469
|
|
00041 03 EMPLOYEE-WAGES PIC 9(7). DTSBX469
|
|
00042 03 FIL PIC 9(3). DTSBX469
|
|
00043 03 CEN-YEAR-QUARTER PIC 9(5). DTSBX469
|
|
00044 03 FIL PIC 9(3). DTSBX469
|
|
00045 03 WAGE-UPDATE-DATE PIC 9(8). DTSBX469
|
|
00046 03 FIL PIC 9(9). DTSBX469
|
|
00047 DTSBX469
|
|
00048 DTSBX469
|
|
00049 ******************************************************************DTSBX469
|
|
00050 * WORKING STORAGE SECTION *DTSBX469
|
|
00051 ******************************************************************DTSBX469
|
|
00052 WORKING-STORAGE SECTION. DTSBX469
|
|
000525 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX469 07/13/10'. DTSBX469
|
|
00053 DTSBX469
|
|
00054 DTSBX469
|
|
00055 01 COUNTERS. DTSBX469
|
|
00056 03 STOP-RECS PIC 9(5). DTSBX469
|
|
00057 03 ALL-NINES PIC 9. DTSBX469
|
|
00058 03 RECS-IN PIC 9(9). DTSBX469
|
|
00059 03 RECS-OUT PIC 9(9). DTSBX469
|
|
00060 DTSBX469
|
|
00061 03 WRK-ACCEPTED-DATE. DTSBX469
|
|
00062 05 WRK-ACCEPTED-YR PIC 9(02). DTSBX469
|
|
00063 05 WRK-ACCEPTED-MO PIC 9(02). DTSBX469
|
|
00064 05 WRK-ACCEPTED-DD PIC 9(02). DTSBX469
|
|
00065 DTSBX469
|
|
00066 03 WRK-ACCEPTED-DATE-RED. DTSBX469
|
|
00067 05 WRK-ACCEPTED-CEN-RED PIC 9(02). DTSBX469
|
|
00068 05 WRK-ACCEPTED-YR-RED PIC 9(02). DTSBX469
|
|
00069 05 WRK-ACCEPTED-MO-RED PIC 9(02). DTSBX469
|
|
00070 05 WRK-ACCEPTED-DD-RED PIC 9(02). DTSBX469
|
|
00071 DTSBX469
|
|
00072 DTSBX469
|
|
00073 03 WRK-END-DATE-DISP PIC 9(08). DTSBX469
|
|
00074 03 FILLER REDEFINES WRK-END-DATE-DISP. DTSBX469
|
|
00075 05 WRK-END-YR PIC 9(04). DTSBX469
|
|
00076 05 WRK-END-MO PIC 9(02). DTSBX469
|
|
00077 05 WRK-END-DA PIC 9(02). DTSBX469
|
|
00078 DTSBX469
|
|
00079 01 WRK-ACCEPTED-DATE-WS PIC 9(8). DTSBX469
|
|
00080 01 BLANK-LINE PIC X(80) VALUE SPACE. DTSBX469
|
|
00081 01 WRK-RECS-OUT. DTSBX469
|
|
00082 03 FIL PIC X(13) VALUE 'RECS UPDATED:'. DTSBX469
|
|
00083 03 FIL PIC XXX VALUE SPACES. DTSBX469
|
|
00084 03 WRK-RECS-OUT-WS PIC 9(9). DTSBX469
|
|
00085 03 FIL PIC X(56) VALUE SPACE. DTSBX469
|
|
00086 DTSBX469
|
|
00087 01 COMMON-LINKAGE-SECTION. DTSBX469
|
|
00088 ++INCLUDE EWGLINKB DTSBX469
|
|
00089 EJECT DTSBX469
|
|
00090 EJECT DTSBX469
|
|
00091 ******************************************************************DTSBX469
|
|
00092 * PROCEDURE DIVISION - CONTROL PROCEDURE *DTSBX469
|
|
00093 ******************************************************************DTSBX469
|
|
00094 PROCEDURE DIVISION. DTSBX469
|
|
00095 BEGIN00000. DTSBX469
|
|
00096 OPEN OUTPUT WAGE-FILE. DTSBX469
|
|
00097 MOVE LOW-VALUE TO VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX469
|
|
00098 DTSBX469
|
|
00099 ACCEPT WRK-ACCEPTED-DATE FROM DATE. DTSBX469
|
|
00100 DTSBX469
|
|
00101 DISPLAY 'CURRENT DATE ' WRK-ACCEPTED-DATE. DTSBX469
|
|
00102 DTSBX469
|
|
00103 MOVE WRK-ACCEPTED-YR TO WRK-ACCEPTED-YR-RED. DTSBX469
|
|
00104 MOVE WRK-ACCEPTED-MO TO WRK-ACCEPTED-MO-RED. DTSBX469
|
|
00105 MOVE WRK-ACCEPTED-DD TO WRK-ACCEPTED-DD-RED. DTSBX469
|
|
00106 MOVE 20 TO WRK-ACCEPTED-CEN-RED. DTSBX469
|
|
00107 SUBTRACT 1 FROM WRK-ACCEPTED-DD-RED. DTSBX469
|
|
00108 MOVE WRK-ACCEPTED-DATE-RED TO WRK-ACCEPTED-DATE-WS. DTSBX469
|
|
00109 DTSBX469
|
|
00110 DISPLAY 'YESTERDAY S DATE ' WRK-ACCEPTED-DATE-RED. DTSBX469
|
|
00111 DTSBX469
|
|
00112 PERFORM SERV2001-RESET-MASTER THRU SERV2001-EXIT. DTSBX469
|
|
00113 ** DTSBX469
|
|
00114 DTSBX469
|
|
00115 MOVE ZEROS TO COUNTERS. DTSBX469
|
|
00116 PERFORM MAIN0200-PROCESS-WAGE THRU MAIN0200-EX DTSBX469
|
|
00117 UNTIL DTSBX469
|
|
00118 DBW-END-OF-FILE. DTSBX469
|
|
00119 ******************************************************************DTSBX469
|
|
00120 * TERMINATION ROUTINE *DTSBX469
|
|
00121 ******************************************************************DTSBX469
|
|
00122 TERM0100-CLOSE-FILES. DTSBX469
|
|
00123 DTSBX469
|
|
00124 WRITE WAGE-REC FROM BLANK-LINE. DTSBX469
|
|
00125 MOVE RECS-OUT TO WRK-RECS-OUT-WS. DTSBX469
|
|
00126 WRITE WAGE-REC FROM WRK-RECS-OUT. DTSBX469
|
|
00127 CLOSE WAGE-FILE. DTSBX469
|
|
00128 DTSBX469
|
|
00129 MOVE 'C' TO DBW-COMMAND-CODE. DTSBX469
|
|
00130 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX469
|
|
00131 DTSBX469
|
|
00132 DTSBX469
|
|
00133 DISPLAY 'NUMBER RECORDS READ *** ' RECS-IN. DTSBX469
|
|
00134 DISPLAY ' ' . DTSBX469
|
|
00135 DISPLAY 'NUMBER RECORDS WRITTEN *** ' RECS-OUT. DTSBX469
|
|
00136 STOP RUN. DTSBX469
|
|
00137 TERM0100-EXIT. DTSBX469
|
|
00138 EXIT. DTSBX469
|
|
00139 DTSBX469
|
|
00140 MAIN0200-PROCESS-WAGE. DTSBX469
|
|
00141 DTSBX469
|
|
00142 MOVE 'S' TO DBW-PROCESSING-MODE. DTSBX469
|
|
00143 MOVE 'SG01' TO DBW-SEGNAME. DTSBX469
|
|
00144 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX469
|
|
00145 DTSBX469
|
|
00146 IF DBW-END-OF-FILE DTSBX469
|
|
00147 GO TO MAIN0200-EX. DTSBX469
|
|
00148 DTSBX469
|
|
00149 ADD 1 TO RECS-IN. DTSBX469
|
|
00150 PERFORM LOCATE-WAGE THRU L-W-EX DTSBX469
|
|
00151 UNTIL DBW-NO-RECORD-FOUND. DTSBX469
|
|
00152 DTSBX469
|
|
00153 MAIN0200-EX. DTSBX469
|
|
00154 EXIT. DTSBX469
|
|
00155 DTSBX469
|
|
00156 LOCATE-WAGE. DTSBX469
|
|
00157 MOVE 'R' TO DBW-PROCESSING-MODE. DTSBX469
|
|
00158 MOVE 'SG02' TO DBW-SEGNAME. DTSBX469
|
|
00159 PERFORM SERV1001-READ-MASTER THRU SERV1001-EXIT. DTSBX469
|
|
00160 IF DBW-NO-RECORD-FOUND DTSBX469
|
|
00161 GO TO L-W-EX. DTSBX469
|
|
00162 PERFORM SEGMENT-2-DATA THRU S-2-D-EX. DTSBX469
|
|
00163 L-W-EX. DTSBX469
|
|
00164 EXIT. DTSBX469
|
|
00165 DTSBX469
|
|
00166 SEGMENT-2-DATA. DTSBX469
|
|
00167 ********************************************************** DTSBX469
|
|
00168 * ALL NINES ARE BEING MOVE TO WGP-SSN PATCH BY CF BROOKS DTSBX469
|
|
00169 ******* ************************************************** DTSBX469
|
|
00170 * IF WGP-SSN = 999999999 DTSBX469
|
|
00171 * MOVE 1 TO ALL-NINES DTSBX469
|
|
00172 * GO TO S-2-D-EX. DTSBX469
|
|
00173 DTSBX469
|
|
00174 * DISPLAY ' WGD-ACTIVITY-DATE ' WGD-ACTIVITY-DATE. DTSBX469
|
|
00175 DTSBX469
|
|
00176 IF WGD-ACTIVITY-DATE = WRK-ACCEPTED-DATE-WS DTSBX469
|
|
00177 NEXT SENTENCE ELSE DTSBX469
|
|
00178 GO TO S-2-D-EX. DTSBX469
|
|
00179 DTSBX469
|
|
00180 * DISPLAY ' WGD-ACTIVITY-DATE' WGD-ACTIVITY-DATE. DTSBX469
|
|
00181 * DISPLAY ' FROM-ACTIVITY-DATE' FROM-ACTIVITY-DATE. DTSBX469
|
|
00182 * DISPLAY ' TO-ACTIVITY-DATE' TO-ACTIVITY-DATE. DTSBX469
|
|
00183 DTSBX469
|
|
00184 PERFORM 100-WRITE-ACCOUNTS THRU 100-W-B-A-EXT. DTSBX469
|
|
00185 DTSBX469
|
|
00186 GO TO S-2-D-EX. DTSBX469
|
|
00187 DTSBX469
|
|
00188 S-2-D-EX. DTSBX469
|
|
00189 EXIT. DTSBX469
|
|
00190 DTSBX469
|
|
00191 100-WRITE-ACCOUNTS. DTSBX469
|
|
00192 DTSBX469
|
|
00193 ADD 1 TO RECS-OUT. DTSBX469
|
|
00194 MOVE SPACES TO WAGE-REC. DTSBX469
|
|
00195 MOVE WGP-SSN TO EMPLOYEE-SSN. DTSBX469
|
|
00196 MOVE WGD-YR-QTR TO CEN-YEAR-QUARTER. DTSBX469
|
|
00197 MOVE WGD-ACCOUNT-NUMBER TO EMPLOYER-ACCT-NUM. DTSBX469
|
|
00198 MOVE WGD-QUARTER-EARNINGS TO EMPLOYEE-WAGES. DTSBX469
|
|
00199 MOVE WGP-NAME-CHK TO EMPLOYEE-LAST-NAME. DTSBX469
|
|
00200 MOVE WGD-ACTIVITY-DATE TO WAGE-UPDATE-DATE. DTSBX469
|
|
00201 WRITE WAGE-REC. DTSBX469
|
|
00202 MOVE SPACES TO WAGE-REC. DTSBX469
|
|
00203 DTSBX469
|
|
00204 100-W-B-A-EXT. DTSBX469
|
|
00205 EXIT. DTSBX469
|
|
00206 EJECT DTSBX469
|
|
00207 ******************************************************************DTSBX469
|
|
00208 * SERVICE ROUTINES *DTSBX469
|
|
00209 ******************************************************************DTSBX469
|
|
00210 SERV1001-READ-MASTER. DTSBX469
|
|
00211 MOVE 'R' TO DBW-COMMAND-CODE. DTSBX469
|
|
00212 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX469
|
|
00213 SERV1001-EXIT. DTSBX469
|
|
00214 EXIT. DTSBX469
|
|
00215 SERV2001-RESET-MASTER. DTSBX469
|
|
00216 MOVE 'S' TO DBW-COMMAND-CODE. DTSBX469
|
|
00217 PERFORM SERV9001-ACCESS-DATABASE THRU SERV9001-EXIT. DTSBX469
|
|
00218 SERV2001-EXIT. DTSBX469
|
|
00219 EXIT. DTSBX469
|
|
00220 SERV9001-ACCESS-DATABASE. DTSBX469
|
|
00221 IF DBW-SEGNAME = 'SG01' DTSBX469
|
|
00222 CALL 'EWG960D' DTSBX469
|
|
00223 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX469
|
|
00224 IF DBW-SEGNAME = 'SG02' DTSBX469
|
|
00225 CALL 'EWG960D' DTSBX469
|
|
00226 USING VSAM-WAGEDATA-CONTROL-BLOCK. DTSBX469
|
|
00227 SERV9001-EXIT. DTSBX469
|
|
00228 EXIT. DTSBX469
|
|
00229 DTSBX469
|