773 lines
61 KiB
COBOL
773 lines
61 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/07/12
|
|
00002 PROGRAM-ID. DTSBD388. DTSBD388
|
|
00003 AUTHOR. NORTHROP GRUMMAN. LV001
|
|
00004 DATE-WRITTEN. JUNE 2005. DTSBD388
|
|
00005 DATE-COMPILED. DTSBD388
|
|
00006 DTSBD388
|
|
00007 ***** DTSBD388
|
|
00008 * FUNCTION: UPDATE MAINFRAME AUDIT DATA FROM WEB APPLICATION DTSBD388
|
|
00009 * DATA. DTSBD388
|
|
00010 * DTSBD388
|
|
00011 * DTSBD388
|
|
00012 * MODIFICATION LOG: DTSBD388
|
|
00013 * DTSBD388
|
|
00014 * 04/2600012 INITIAL DEVELOPMENT. DTSBD388
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1 DTSBD388
|
|
00016 * DTSBD388
|
|
00017 * MM/DD/CCYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD388
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD388
|
|
00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD388
|
|
00020 * DTSBD388
|
|
00021 * DTSBD388
|
|
00022 * DESCRIPTION: DTSBD388
|
|
00023 * DTSBD388
|
|
00024 * DTSBD388
|
|
00025 * DTSBD388
|
|
00026 * MASTER FILE RECORDS READ: DTSBD388
|
|
00027 * DTSBD388
|
|
00028 * MRTE DTSBD388
|
|
00029 * DTSBD388
|
|
00030 * DTSBD388
|
|
00031 * MASTER FILE RECORDS UPDATED: DTSBD388
|
|
00032 * DTSBD388
|
|
00033 * MREL DTSBD388
|
|
00034 * DTSBD388
|
|
00035 * DTSBD388
|
|
00036 * REPORT RECORDS WRITTEN: DTSBD388
|
|
00037 * DTSBD388
|
|
00038 * NONE DTSBD388
|
|
00039 * DTSBD388
|
|
00040 * DTSBD388
|
|
00041 * MODULES CALLED: DTSBD388
|
|
00042 * DTSBD388
|
|
00043 * DTSBU331 FORMAT AND WRITE MLOG RECORD OCCURRENCE. DTSBD388
|
|
00044 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD388
|
|
00045 * DTSBU927 BTC FILE OUTPUT. DTSBD388
|
|
00046 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. DTSBD388
|
|
00047 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD388
|
|
00048 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. DTSBD388
|
|
00049 * DTSBD388
|
|
00050 ***** DTSBD388
|
|
00051 SKIP3 DTSBD388
|
|
00052 ENVIRONMENT DIVISION. DTSBD388
|
|
00053 SKIP3 DTSBD388
|
|
00054 DATA DIVISION. DTSBD388
|
|
00055 EJECT DTSBD388
|
|
00056 WORKING-STORAGE SECTION. DTSBD388
|
|
000565 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD388 08/07/12'. DTSBD388
|
|
00057 SKIP3 DTSBD388
|
|
00058 01 WRK-AREA. DTSBD388
|
|
00059 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +388.DTSBD388
|
|
00060 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD388'.DTSBD388
|
|
00061 05 WRK-ABEND-MSG PIC X(60). DTSBD388
|
|
00062 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD388
|
|
00063 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD388
|
|
00064 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. DTSBD388
|
|
00065 05 MSUB PIC 9(01) VALUE ZEROS. DTSBD388
|
|
00066 05 MFAS-UPD-CNT PIC 9(02) VALUE ZEROS. DTSBD388
|
|
00067 05 MAUR-UPD-CNT PIC 9(02) VALUE ZEROS. DTSBD388
|
|
00068 05 MAUR-ADD-CNT PIC 9(02) VALUE ZEROS. DTSBD388
|
|
00069 05 MAUY-UPD-CNT PIC 9(02) VALUE ZEROS. DTSBD388
|
|
00070 05 MAUY-ADD-CNT PIC 9(02) VALUE ZEROS. DTSBD388
|
|
00071 05 W-MONEY-AMT PIC 9(09)V99. DTSBD388
|
|
00072 05 X-MONEY-AMT REDEFINES W-MONEY-AMT PIC X(12). DTSBD388
|
|
00073 05 WRK-HRS PIC 9(4)V9. DTSBD388
|
|
00074 05 WRK-HRS-X REDEFINES WRK-HRS PIC 9(6). DTSBD388
|
|
00075 05 WRK-NUMBER PIC 9(05). DTSBD388
|
|
00076 DTSBD388
|
|
00077 05 DISP-DATE PIC X(10) VALUE SPACES. DTSBD388
|
|
00078 05 DISP-TIME PIC X(08) VALUE SPACES. DTSBD388
|
|
00079 05 DISP-ABSTIME PIC X(16) VALUE SPACES. DTSBD388
|
|
00080 05 MAUR-RECORD-UPDATED PIC X(01). DTSBD388
|
|
00081 88 MAUR-REC-FOUND-88 VALUE '0'. DTSBD388
|
|
00082 88 MAUR-REC-NOT-FOUND-88 VALUE '1'. DTSBD388
|
|
00083 05 MAUY-RECORD-UPDATED PIC X(01). DTSBD388
|
|
00084 88 MAUY-REC-FOUND-88 VALUE '0'. DTSBD388
|
|
00085 88 MAUY-REC-NOT-FOUND-88 VALUE '1'. DTSBD388
|
|
00086 EJECT DTSBD388
|
|
00087 DTSBD388
|
|
00088 01 L004-LINK-AREA. DTSBD388
|
|
00089 ++INCLUDE DTSIL004 DTSBD388
|
|
00090 EJECT DTSBD388
|
|
00091 01 L005-LINK-AREA. DTSBD388
|
|
00092 ++INCLUDE DTSIL005 DTSBD388
|
|
00093 EJECT DTSBD388
|
|
00094 01 L006-LINK-AREA. DTSBD388
|
|
00095 ++INCLUDE DTSIL006 DTSBD388
|
|
00096 EJECT DTSBD388
|
|
00097 01 L056-LINK-AREA. DTSBD388
|
|
00098 ++INCLUDE DTSIL056 DTSBD388
|
|
00099 EJECT DTSBD388
|
|
00100 01 L331-LINK-AREA. DTSBD388
|
|
00101 ++INCLUDE DTSIL331 DTSBD388
|
|
00102 EJECT DTSBD388
|
|
00103 01 L910-LINK-AREA. DTSBD388
|
|
00104 ++INCLUDE DTSIL910 DTSBD388
|
|
00105 EJECT DTSBD388
|
|
00106 01 MSKL-REC. DTSBD388
|
|
00107 ++INCLUDE DTSIMSKL DTSBD388
|
|
00108 EJECT DTSBD388
|
|
00109 01 MFAS-REC. DTSBD388
|
|
00110 ++INCLUDE DTSIMFAS DTSBD388
|
|
00111 DTSBD388
|
|
00112 01 MAUR-REC. DTSBD388
|
|
00113 ++INCLUDE DTSIMAUR DTSBD388
|
|
00114 DTSBD388
|
|
00115 01 MAUY-REC. DTSBD388
|
|
00116 ++INCLUDE DTSIMAUY DTSBD388
|
|
00117 DTSBD388
|
|
00118 01 R907-REC. DTSBD388
|
|
00119 ++INCLUDE DTSIR907 DTSBD388
|
|
00120 EJECT DTSBD388
|
|
00121 DTSBD388
|
|
00122 01 X163-REC. DTSBD388
|
|
00123 ++INCLUDE DTSIX163 DTSBD388
|
|
00124 EJECT DTSBD388
|
|
00125 01 X164-REC. DTSBD388
|
|
00126 ++INCLUDE DTSIX164 DTSBD388
|
|
00127 EJECT DTSBD388
|
|
00128 LINKAGE SECTION. DTSBD388
|
|
00129 SKIP3 DTSBD388
|
|
00130 01 LBCM-LINK-AREA. DTSBD388
|
|
00131 ++INCLUDE DTSILBCM DTSBD388
|
|
00132 EJECT DTSBD388
|
|
00133 01 MPRF-REC. DTSBD388
|
|
00134 ++INCLUDE DTSIMPRF DTSBD388
|
|
00135 EJECT DTSBD388
|
|
00136 01 T040-REC. DTSBD388
|
|
00137 ++INCLUDE DTSIT040 DTSBD388
|
|
00138 EJECT DTSBD388
|
|
00139 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD388
|
|
00140 MPRF-REC DTSBD388
|
|
00141 T040-REC. DTSBD388
|
|
00142 DTSBD388
|
|
00143 IF FIRST-TIME-IND = 'Y' DTSBD388
|
|
00144 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD388
|
|
00145 MOVE 'N' TO FIRST-TIME-IND. DTSBD388
|
|
00146 DTSBD388
|
|
00147 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD388
|
|
00148 DTSBD388
|
|
00149 GOBACK. DTSBD388
|
|
00150 DTSBD388
|
|
00151 I0000-INITIATE. DTSBD388
|
|
00152 DTSBD388
|
|
00153 MOVE +0 TO WRK-EMP-NO. DTSBD388
|
|
00154 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD388
|
|
00155 DTSBD388
|
|
00156 I0000-EXIT. DTSBD388
|
|
00157 EXIT. DTSBD388
|
|
00158 DTSBD388
|
|
00159 P0000-PROCESS. DTSBD388
|
|
00160 DISPLAY 'BD388 AUDIT PROCESS... ' T040-TRN-CD. DTSBD388
|
|
00161 DTSBD388
|
|
00162 IF T040-MFAS-88 DTSBD388
|
|
00163 DISPLAY 'PROCESSING MFAS.....' T040-EMP-NO DTSBD388
|
|
00164 PERFORM P1000-READ-MFAS THRU P1000-EXIT DTSBD388
|
|
00165 ELSE DTSBD388
|
|
00166 IF T040-MAUR-88 DTSBD388
|
|
00167 DISPLAY 'PROCESSING MAUR.....' T040-EMP-NO DTSBD388
|
|
00168 PERFORM P2000-READ-MAUR THRU P2000-EXIT DTSBD388
|
|
00169 ELSE DTSBD388
|
|
00170 IF T040-MAUY-88 DTSBD388
|
|
00171 DISPLAY 'PROCESSING MAUY.....' T040-EMP-NO DTSBD388
|
|
00172 PERFORM P3000-READ-MAUY THRU P3000-EXIT DTSBD388
|
|
00173 ELSE DTSBD388
|
|
00174 DISPLAY 'INVALID AUDIT TYPE RECORD ' DTSBD388
|
|
00175 END-IF. DTSBD388
|
|
00176 DTSBD388
|
|
00177 P0000-EXIT. DTSBD388
|
|
00178 EXIT. DTSBD388
|
|
00179 DTSBD388
|
|
00180 P1000-READ-MFAS. DTSBD388
|
|
00181 *& DTSBD388
|
|
00182 DTSBD388
|
|
00183 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSBD388
|
|
00184 MOVE T040-EMP-NO TO MFAS-EMP-NO. DTSBD388
|
|
00185 MOVE T040-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBD388
|
|
00186 SET MFAS-FAS-88 TO TRUE. DTSBD388
|
|
00187 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBD388
|
|
00188 DTSBD388
|
|
00189 PERFORM S910-READ THRU S910-EXIT DTSBD388
|
|
00190 IF L910-OK-88 DTSBD388
|
|
00191 MOVE MSKL-REC TO MFAS-REC DTSBD388
|
|
00192 ELSE DTSBD388
|
|
00193 DISPLAY ' MFAS REC NOT FOUND.ABENDING' X163-EMP-NO DTSBD388
|
|
00194 GO TO S999-ABEND. DTSBD388
|
|
00195 DTSBD388
|
|
00196 PERFORM S330-INIT-MLOG THRU S330-EXIT. DTSBD388
|
|
00197 DTSBD388
|
|
00198 IF T040-COMPLETED-DATE > ZEROS DTSBD388
|
|
00199 MOVE 'MFAS-COMPLETED-DATE ' TO L331-FIELD-NAME DTSBD388
|
|
00200 MOVE MFAS-COMPLETED-DATE TO L331-FROM-VALUE DTSBD388
|
|
00201 MOVE T040-COMPLETED-DATE TO L331-TO-VALUE DTSBD388
|
|
00202 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD388
|
|
00203 MOVE T040-COMPLETED-DATE TO MFAS-COMPLETED-DATE. DTSBD388
|
|
00204 DTSBD388
|
|
00205 IF T040-PROCESSED-DATE > ZEROS DTSBD388
|
|
00206 MOVE 'MFAS-PROCESSED-DATE ' TO L331-FIELD-NAME DTSBD388
|
|
00207 MOVE MFAS-PROCESSED-DATE TO L331-FROM-VALUE DTSBD388
|
|
00208 MOVE T040-PROCESSED-DATE TO L331-TO-VALUE DTSBD388
|
|
00209 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD388
|
|
00210 MOVE T040-PROCESSED-DATE TO MFAS-PROCESSED-DATE. DTSBD388
|
|
00211 DTSBD388
|
|
00212 IF T040-STATUS-CD > SPACES DTSBD388
|
|
00213 MOVE 'MFAS-STATUS-CD ' TO L331-FIELD-NAME DTSBD388
|
|
00214 MOVE MFAS-STATUS-CD TO L331-FROM-VALUE DTSBD388
|
|
00215 MOVE T040-STATUS-CD TO L331-TO-VALUE DTSBD388
|
|
00216 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD388
|
|
00217 MOVE T040-STATUS-CD TO MFAS-STATUS-CD. DTSBD388
|
|
00218 DTSBD388
|
|
00219 IF T040-FLD-REP-ID > ZEROS DTSBD388
|
|
00220 MOVE 'MFAS-FLD-REP-ID ' TO L331-FIELD-NAME DTSBD388
|
|
00221 MOVE MFAS-FLD-REP-ID TO L331-FROM-VALUE DTSBD388
|
|
00222 MOVE T040-FLD-REP-ID TO L331-TO-VALUE DTSBD388
|
|
00223 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD388
|
|
00224 MOVE T040-FLD-REP-ID TO MFAS-FLD-REP-ID. DTSBD388
|
|
00225 DTSBD388
|
|
00226 IF T040-OP-ID > SPACES DTSBD388
|
|
00227 MOVE 'MFAS-SOURCE-OP-ID ' TO L331-FIELD-NAME DTSBD388
|
|
00228 MOVE MFAS-SOURCE-OP-ID TO L331-FROM-VALUE DTSBD388
|
|
00229 MOVE T040-OP-ID TO L331-TO-VALUE DTSBD388
|
|
00230 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD388
|
|
00231 MOVE T040-OP-ID TO MFAS-SOURCE-OP-ID. DTSBD388
|
|
00232 DTSBD388
|
|
00233 IF T040-EMP-SIZE-IND > SPACES DTSBD388
|
|
00234 MOVE 'MFAS-EMP-SIZE-IND ' TO L331-FIELD-NAME DTSBD388
|
|
00235 MOVE MFAS-EMP-SIZE-IND TO L331-FROM-VALUE DTSBD388
|
|
00236 MOVE T040-EMP-SIZE-IND TO L331-TO-VALUE DTSBD388
|
|
00237 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD388
|
|
00238 MOVE T040-EMP-SIZE-IND TO MFAS-EMP-SIZE-IND. DTSBD388
|
|
00239 DTSBD388
|
|
00240 MOVE T040-SYS-DATE TO MFAS-CHNG-DATE. DTSBD388
|
|
00241 MOVE T040-OP-ID TO MFAS-SOURCE-OP-ID. DTSBD388
|
|
00242 DTSBD388
|
|
00243 MOVE MFAS-REC TO MSKL-REC. DTSBD388
|
|
00244 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD388
|
|
00245 ADD 1 TO MFAS-UPD-CNT. DTSBD388
|
|
00246 DISPLAY ' UPDATED MFAS ...' MFAS-EMP-NO. DTSBD388
|
|
00247 DTSBD388
|
|
00248 P1000-EXIT. DTSBD388
|
|
00249 EXIT. DTSBD388
|
|
00250 DTSBD388
|
|
00251 P2000-READ-MAUR. DTSBD388
|
|
00252 DTSBD388
|
|
00253 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSBD388
|
|
00254 MOVE T040-EMP-NO TO MAUR-EMP-NO. DTSBD388
|
|
00255 MOVE T040-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSBD388
|
|
00256 SET MAUR-AUR-88 TO TRUE. DTSBD388
|
|
00257 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSBD388
|
|
00258 DTSBD388
|
|
00259 PERFORM S910-READ THRU S910-EXIT DTSBD388
|
|
00260 IF L910-OK-88 DTSBD388
|
|
00261 SET MAUR-REC-FOUND-88 TO TRUE DTSBD388
|
|
00262 MOVE MSKL-REC TO MAUR-REC DTSBD388
|
|
00263 ELSE DTSBD388
|
|
00264 SET MAUR-REC-NOT-FOUND-88 TO TRUE. DTSBD388
|
|
00265 DTSBD388
|
|
00266 DISPLAY ' MAUR-EMP-NO ' MAUR-EMP-NO. DTSBD388
|
|
00267 DISPLAY ' MAUR-ASSIGN-NO ' MAUR-ASSIGN-NO. DTSBD388
|
|
00268 DTSBD388
|
|
00269 IF MAUR-REC-NOT-FOUND-88 DTSBD388
|
|
00270 PERFORM P2100-ADD-MAUR THRU P2100-EXIT DTSBD388
|
|
00271 ELSE DTSBD388
|
|
00272 PERFORM P2200-UPD-MAUR THRU P2200-EXIT. DTSBD388
|
|
00273 P2000-EXIT. DTSBD388
|
|
00274 EXIT. DTSBD388
|
|
00275 P2100-ADD-MAUR. DTSBD388
|
|
00276 MOVE LOW-VALUES TO MAUR-REC. DTSBD388
|
|
00277 MOVE MFAS-EMP-NO TO MAUR-EMP-NO. DTSBD388
|
|
00278 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSBD388
|
|
00279 SET MAUR-AUR-88 TO TRUE. DTSBD388
|
|
00280 DTSBD388
|
|
00281 MOVE +0 TO MAUR-PURGE-DATE. DTSBD388
|
|
00282 MOVE T040-SYS-DATE TO MAUR-ESTB-DATE DTSBD388
|
|
00283 MAUR-CHNG-DATE. DTSBD388
|
|
00284 SET MAUR-NOT-CONVERTED-88 TO TRUE. DTSBD388
|
|
00285 DTSBD388
|
|
00286 PERFORM P2150-MOVE-MAUR-FIELDS THRU P2150-EXIT. DTSBD388
|
|
00287 DTSBD388
|
|
00288 MOVE MAUR-REC TO MSKL-REC. DTSBD388
|
|
00289 PERFORM S910-WRITE THRU S910-EXIT. DTSBD388
|
|
00290 ADD 1 TO MAUR-ADD-CNT. DTSBD388
|
|
00291 DISPLAY ' ADDING MAUR ...' MAUR-EMP-NO. DTSBD388
|
|
00292 P2100-EXIT. DTSBD388
|
|
00293 EXIT. DTSBD388
|
|
00294 DTSBD388
|
|
00295 P2150-MOVE-MAUR-FIELDS. DTSBD388
|
|
00296 DTSBD388
|
|
00297 IF MAUR-REC-NOT-FOUND-88 DTSBD388
|
|
00298 MOVE ZEROS TO MAUR-FIRST-YRQ DTSBD388
|
|
00299 MAUR-LAST-YRQ DTSBD388
|
|
00300 MAUR-QTRS-AUDITED-CNT DTSBD388
|
|
00301 MAUR-ERROR-CNT DTSBD388
|
|
00302 MAUR-ERROR-TYPE(1) DTSBD388
|
|
00303 MAUR-ERROR-TYPE(2) DTSBD388
|
|
00304 MAUR-ERROR-TYPE(3) DTSBD388
|
|
00305 MAUR-ERROR-TYPE(4) DTSBD388
|
|
00306 MAUR-ERROR-TYPE(5) DTSBD388
|
|
00307 MAUR-MONEY-DUE-AMT DTSBD388
|
|
00308 MAUR-MONEY-COLLECT-AMT DTSBD388
|
|
00309 MAUR-AUDIT-HRS DTSBD388
|
|
00310 MAUR-NEW-EMPLOYEE-CNT DTSBD388
|
|
00311 MAUR-INDCON-TO-EMPL-CNT DTSBD388
|
|
00312 MOVE SPACES TO MAUR-EMP-SIZE-IND DTSBD388
|
|
00313 MAUR-MONEY-REASON-CD DTSBD388
|
|
00314 MAUR-PEN-WAIVE-IND DTSBD388
|
|
00315 MAUR-INT-WAIVE-IND. DTSBD388
|
|
00316 IF T040-FIRST-YRQ > ZEROS DTSBD388
|
|
00317 MOVE 'MAUR-FIRST-YRQ ' TO L331-FIELD-NAME DTSBD388
|
|
00318 MOVE MAUR-FIRST-YRQ TO WRK-NUMBER DTSBD388
|
|
00319 MOVE WRK-NUMBER TO L331-FROM-VALUE DTSBD388
|
|
00320 DISPLAY 'MAUR-FIRST-YRQ ' WRK-NUMBER DTSBD388
|
|
00321 MOVE T040-FIRST-YRQ TO WRK-NUMBER DTSBD388
|
|
00322 MOVE WRK-NUMBER TO L331-TO-VALUE DTSBD388
|
|
00323 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00324 MOVE T040-FIRST-YRQ TO MAUR-FIRST-YRQ. DTSBD388
|
|
00325 DTSBD388
|
|
00326 IF T040-LAST-YRQ > ZEROS DTSBD388
|
|
00327 MOVE 'MAUR-LAST-YRQ ' TO L331-FIELD-NAME DTSBD388
|
|
00328 MOVE MAUR-LAST-YRQ TO WRK-NUMBER DTSBD388
|
|
00329 MOVE WRK-NUMBER TO L331-FROM-VALUE DTSBD388
|
|
00330 DISPLAY 'MAUR-LASTT-YRQ ' WRK-NUMBER DTSBD388
|
|
00331 MOVE T040-LAST-YRQ TO WRK-NUMBER DTSBD388
|
|
00332 MOVE WRK-NUMBER TO L331-TO-VALUE DTSBD388
|
|
00333 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00334 MOVE T040-LAST-YRQ TO MAUR-LAST-YRQ. DTSBD388
|
|
00335 DTSBD388
|
|
00336 IF T040-QTRS-AUDITED-CNT > ZEROS DTSBD388
|
|
00337 DISPLAY 'MAUR-QTRS-AUDIT-CNT' DTSBD388
|
|
00338 MOVE 'MAUR-QTRS-AUDIT-CNT' TO L331-FIELD-NAME DTSBD388
|
|
00339 MOVE MAUR-QTRS-AUDITED-CNT TO L331-FROM-VALUE DTSBD388
|
|
00340 MOVE T040-QTRS-AUDITED-CNT TO L331-TO-VALUE DTSBD388
|
|
00341 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00342 MOVE T040-QTRS-AUDITED-CNT TO MAUR-QTRS-AUDITED-CNT. DTSBD388
|
|
00343 DTSBD388
|
|
00344 DTSBD388
|
|
00345 DISPLAY 'MEMP ' MAUR-EMP-SIZE-IND DTSBD388
|
|
00346 DISPLAY 'TMEP ' T040-EMP-SIZE-IND DTSBD388
|
|
00347 DTSBD388
|
|
00348 IF T040-EMP-SIZE-IND > SPACES DTSBD388
|
|
00349 DISPLAY 'MAUR-EMP-SIZE-IND ' DTSBD388
|
|
00350 MOVE 'MAUR-EMP-SIZE-IND ' TO L331-FIELD-NAME DTSBD388
|
|
00351 MOVE MAUR-EMP-SIZE-IND TO L331-FROM-VALUE DTSBD388
|
|
00352 MOVE T040-EMP-SIZE-IND TO L331-TO-VALUE DTSBD388
|
|
00353 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00354 MOVE T040-EMP-SIZE-IND TO MAUR-EMP-SIZE-IND. DTSBD388
|
|
00355 DTSBD388
|
|
00356 IF T040-ERR-TYPE(1) > ZEROS DTSBD388
|
|
00357 DISPLAY 'MAUR-ERROR-TYPE1 ' DTSBD388
|
|
00358 MOVE 'MAUR-ERROR-TYPE1 ' TO L331-FIELD-NAME DTSBD388
|
|
00359 MOVE MAUR-ERROR-TYPE(1) TO L331-FROM-VALUE DTSBD388
|
|
00360 MOVE T040-ERR-TYPE(1) TO L331-TO-VALUE DTSBD388
|
|
00361 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00362 MOVE T040-ERR-TYPE (1) TO MAUR-ERROR-TYPE (1). DTSBD388
|
|
00363 DTSBD388
|
|
00364 IF T040-ERR-TYPE(2) > ZEROS DTSBD388
|
|
00365 DISPLAY 'MAUR-ERROR-TYPE2 ' DTSBD388
|
|
00366 MOVE 'MAUR-ERROR-TYPE2 ' TO L331-FIELD-NAME DTSBD388
|
|
00367 MOVE MAUR-ERROR-TYPE(2) TO L331-FROM-VALUE DTSBD388
|
|
00368 MOVE T040-ERR-TYPE(2) TO L331-TO-VALUE DTSBD388
|
|
00369 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00370 MOVE T040-ERR-TYPE (2) TO MAUR-ERROR-TYPE (2). DTSBD388
|
|
00371 DTSBD388
|
|
00372 IF T040-ERR-TYPE(3) > ZEROS DTSBD388
|
|
00373 DISPLAY 'MAUR-ERROR-TYPE3 ' DTSBD388
|
|
00374 MOVE 'MAUR-ERROR-TYPE3 ' TO L331-FIELD-NAME DTSBD388
|
|
00375 MOVE MAUR-ERROR-TYPE(3) TO L331-FROM-VALUE DTSBD388
|
|
00376 MOVE T040-ERR-TYPE(3) TO L331-TO-VALUE DTSBD388
|
|
00377 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00378 MOVE T040-ERR-TYPE (3) TO MAUR-ERROR-TYPE (3). DTSBD388
|
|
00379 DTSBD388
|
|
00380 IF T040-ERR-TYPE(4) > ZEROS DTSBD388
|
|
00381 DISPLAY 'MAUR-ERROR-TYPE4 ' DTSBD388
|
|
00382 MOVE 'MAUR-ERROR-TYPE4 ' TO L331-FIELD-NAME DTSBD388
|
|
00383 MOVE MAUR-ERROR-TYPE(4) TO L331-FROM-VALUE DTSBD388
|
|
00384 MOVE T040-ERR-TYPE(4) TO L331-TO-VALUE DTSBD388
|
|
00385 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00386 MOVE T040-ERR-TYPE (4) TO MAUR-ERROR-TYPE (4). DTSBD388
|
|
00387 DTSBD388
|
|
00388 IF T040-ERR-TYPE(5) > ZEROS DTSBD388
|
|
00389 DISPLAY 'MAUR-ERROR-TYPE5 ' DTSBD388
|
|
00390 MOVE 'MAUR-ERROR-TYPE5 ' TO L331-FIELD-NAME DTSBD388
|
|
00391 MOVE MAUR-ERROR-TYPE(5) TO L331-FROM-VALUE DTSBD388
|
|
00392 MOVE T040-ERR-TYPE(5) TO L331-TO-VALUE DTSBD388
|
|
00393 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00394 MOVE T040-ERR-TYPE (5) TO MAUR-ERROR-TYPE (5). DTSBD388
|
|
00395 DTSBD388
|
|
00396 IF T040-MONEY-DUE-AMT > ZEROS DTSBD388
|
|
00397 DISPLAY 'MAUR-MONEY-DUE-AMT ' DTSBD388
|
|
00398 MOVE 'MAUR-MONEY-DUE-AMT ' TO L331-FIELD-NAME DTSBD388
|
|
00399 MOVE MAUR-MONEY-DUE-AMT TO W-MONEY-AMT DTSBD388
|
|
00400 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00401 MOVE T040-MONEY-DUE-AMT TO W-MONEY-AMT DTSBD388
|
|
00402 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00403 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00404 MOVE T040-MONEY-DUE-AMT TO MAUR-MONEY-DUE-AMT. DTSBD388
|
|
00405 DTSBD388
|
|
00406 IF T040-MONEY-COLLECT-AMT > ZEROS DTSBD388
|
|
00407 DISPLAY 'MAUR-MONEY-COLL-AMT' DTSBD388
|
|
00408 MOVE 'MAUR-MONEY-COLL-AMT' TO L331-FIELD-NAME DTSBD388
|
|
00409 MOVE MAUR-MONEY-COLLECT-AMT TO W-MONEY-AMT DTSBD388
|
|
00410 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00411 MOVE T040-MONEY-COLLECT-AMT TO W-MONEY-AMT DTSBD388
|
|
00412 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00413 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00414 MOVE T040-MONEY-COLLECT-AMT TO MAUR-MONEY-COLLECT-AMT. DTSBD388
|
|
00415 DTSBD388
|
|
00416 IF T040-MONEY-REASON-CD > SPACES DTSBD388
|
|
00417 DISPLAY 'MAUR-MONEY-REASON-CD ' DTSBD388
|
|
00418 MOVE 'MAUR-MONEY-REASON-CD ' TO L331-FIELD-NAME DTSBD388
|
|
00419 MOVE MAUR-MONEY-REASON-CD TO L331-FROM-VALUE DTSBD388
|
|
00420 MOVE T040-MONEY-REASON-CD TO L331-TO-VALUE DTSBD388
|
|
00421 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00422 MOVE T040-MONEY-REASON-CD TO MAUR-MONEY-REASON-CD. DTSBD388
|
|
00423 DTSBD388
|
|
00424 IF T040-PEN-WAIVE-IND > SPACES DTSBD388
|
|
00425 DISPLAY 'MAUR-PEN-WAIVE-IND ' DTSBD388
|
|
00426 MOVE 'MAUR-PEN-WAIVE-IND ' TO L331-FIELD-NAME DTSBD388
|
|
00427 MOVE MAUR-PEN-WAIVE-IND TO L331-FROM-VALUE DTSBD388
|
|
00428 MOVE T040-PEN-WAIVE-IND TO L331-TO-VALUE DTSBD388
|
|
00429 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00430 MOVE T040-PEN-WAIVE-IND TO MAUR-PEN-WAIVE-IND. DTSBD388
|
|
00431 DTSBD388
|
|
00432 IF T040-INT-WAIVE-IND > SPACES DTSBD388
|
|
00433 DISPLAY 'MAUR-INT-WAIVE-IND ' DTSBD388
|
|
00434 MOVE 'MAUR-INT-WAIVE-IND ' TO L331-FIELD-NAME DTSBD388
|
|
00435 MOVE MAUR-INT-WAIVE-IND TO L331-FROM-VALUE DTSBD388
|
|
00436 MOVE T040-INT-WAIVE-IND TO L331-TO-VALUE DTSBD388
|
|
00437 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00438 MOVE T040-INT-WAIVE-IND TO MAUR-INT-WAIVE-IND. DTSBD388
|
|
00439 DTSBD388
|
|
00440 IF T040-AUDIT-HRS > ZEROS DTSBD388
|
|
00441 DISPLAY 'MAUR-AUDIT-HRS ' DTSBD388
|
|
00442 MOVE 'MAUR-AUDIT-HRS ' TO L331-FIELD-NAME DTSBD388
|
|
00443 MOVE MAUR-AUDIT-HRS TO WRK-HRS DTSBD388
|
|
00444 MOVE WRK-HRS-X TO L331-FROM-VALUE DTSBD388
|
|
00445 MOVE T040-AUDIT-HRS TO WRK-HRS DTSBD388
|
|
00446 MOVE WRK-HRS-X TO L331-TO-VALUE DTSBD388
|
|
00447 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00448 MOVE T040-AUDIT-HRS TO MAUR-AUDIT-HRS. DTSBD388
|
|
00449 DTSBD388
|
|
00450 IF T040-NEW-EMPLOYEE-CNT > ZEROS DTSBD388
|
|
00451 DISPLAY 'MAUR-NEW=EMPLEE-CNT ' DTSBD388
|
|
00452 MOVE 'MAUR-NEW=EMPLEE-CNT ' TO L331-FIELD-NAME DTSBD388
|
|
00453 MOVE MAUR-NEW-EMPLOYEE-CNT TO WRK-NUMBER DTSBD388
|
|
00454 MOVE WRK-NUMBER TO L331-FROM-VALUE DTSBD388
|
|
00455 MOVE T040-NEW-EMPLOYEE-CNT TO WRK-NUMBER DTSBD388
|
|
00456 MOVE WRK-NUMBER TO L331-TO-VALUE DTSBD388
|
|
00457 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00458 MOVE T040-NEW-EMPLOYEE-CNT TO MAUR-NEW-EMPLOYEE-CNT. DTSBD388
|
|
00459 DTSBD388
|
|
00460 IF T040-INDCON-TO-EMPL-CNT > ZEROS DTSBD388
|
|
00461 DISPLAY 'MAUR-INDCON-TO-EMPL-CNT' DTSBD388
|
|
00462 MOVE 'MAUR-INDCON-TO-EMPL-CNT' TO L331-FIELD-NAME DTSBD388
|
|
00463 MOVE MAUR-INDCON-TO-EMPL-CNT TO WRK-NUMBER DTSBD388
|
|
00464 MOVE WRK-NUMBER TO L331-FROM-VALUE DTSBD388
|
|
00465 MOVE T040-INDCON-TO-EMPL-CNT TO WRK-NUMBER DTSBD388
|
|
00466 MOVE WRK-NUMBER TO L331-TO-VALUE DTSBD388
|
|
00467 PERFORM P2400-MAUR-MLOG THRU P2400-EXIT DTSBD388
|
|
00468 MOVE T040-INDCON-TO-EMPL-CNT TO MAUR-INDCON-TO-EMPL-CNT. DTSBD388
|
|
00469 DTSBD388
|
|
00470 P2150-EXIT. DTSBD388
|
|
00471 EXIT. DTSBD388
|
|
00472 DTSBD388
|
|
00473 P2200-UPD-MAUR. DTSBD388
|
|
00474 MOVE T040-SYS-DATE TO MAUR-CHNG-DATE. DTSBD388
|
|
00475 DTSBD388
|
|
00476 PERFORM P2150-MOVE-MAUR-FIELDS THRU P2150-EXIT. DTSBD388
|
|
00477 DTSBD388
|
|
00478 MOVE MAUR-REC TO MSKL-REC. DTSBD388
|
|
00479 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD388
|
|
00480 DTSBD388
|
|
00481 ADD 1 TO MAUR-UPD-CNT. DTSBD388
|
|
00482 DISPLAY ' UPDATE MAUR ...' MAUR-EMP-NO. DTSBD388
|
|
00483 P2200-EXIT. DTSBD388
|
|
00484 EXIT. DTSBD388
|
|
00485 DTSBD388
|
|
00486 P2400-MAUR-MLOG. DTSBD388
|
|
00487 DTSBD388
|
|
00488 * IF MAUR-REC-NOT-FOUND-88 DTSBD388
|
|
00489 * GO TO P2400-EXIT. DTSBD388
|
|
00490 DTSBD388
|
|
00491 PERFORM S330-INIT-MLOG THRU S330-EXIT. DTSBD388
|
|
00492 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD388
|
|
00493 DTSBD388
|
|
00494 P2400-EXIT. DTSBD388
|
|
00495 EXIT. DTSBD388
|
|
00496 P3000-READ-MAUY. DTSBD388
|
|
00497 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSBD388
|
|
00498 MOVE T040-EMP-NO TO MAUY-EMP-NO. DTSBD388
|
|
00499 MOVE T040-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSBD388
|
|
00500 MOVE T040-CALENDAR-YEAR TO MAUY-CALENDAR-YEAR. DTSBD388
|
|
00501 SET MAUY-AUY-88 TO TRUE. DTSBD388
|
|
00502 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSBD388
|
|
00503 DTSBD388
|
|
00504 DISPLAY ' MAUY ......... ' MAUY-KEY-AREA. DTSBD388
|
|
00505 DTSBD388
|
|
00506 PERFORM S910-READ THRU S910-EXIT DTSBD388
|
|
00507 IF L910-NO-REC-88 DTSBD388
|
|
00508 SET MAUY-REC-NOT-FOUND-88 TO TRUE DTSBD388
|
|
00509 ELSE DTSBD388
|
|
00510 SET MAUY-REC-FOUND-88 TO TRUE DTSBD388
|
|
00511 MOVE MSKL-REC TO MAUY-REC. DTSBD388
|
|
00512 DTSBD388
|
|
00513 IF MAUY-REC-NOT-FOUND-88 DTSBD388
|
|
00514 PERFORM P3100-ADD-MAUY THRU P3100-EXIT DTSBD388
|
|
00515 DISPLAY ' MAUY NOT FOUND.. MUST ADD' DTSBD388
|
|
00516 ELSE DTSBD388
|
|
00517 DISPLAY ' MAUY FOUND MUST UPD ' DTSBD388
|
|
00518 PERFORM P3200-UPD-MAUY THRU P3200-EXIT. DTSBD388
|
|
00519 P3000-EXIT. DTSBD388
|
|
00520 EXIT. DTSBD388
|
|
00521 P3100-ADD-MAUY. DTSBD388
|
|
00522 MOVE LOW-VALUES TO MAUY-REC. DTSBD388
|
|
00523 DTSBD388
|
|
00524 MOVE MFAS-EMP-NO TO MAUY-EMP-NO. DTSBD388
|
|
00525 MOVE MFAS-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSBD388
|
|
00526 MOVE T040-CALENDAR-YEAR TO MAUY-CALENDAR-YEAR. DTSBD388
|
|
00527 SET MAUY-AUY-88 TO TRUE. DTSBD388
|
|
00528 DTSBD388
|
|
00529 MOVE +0 TO MAUY-PURGE-DATE. DTSBD388
|
|
00530 SET MAUY-NOT-CONVERTED-88 TO TRUE. DTSBD388
|
|
00531 MOVE T040-SYS-DATE TO MAUY-ESTB-DATE. DTSBD388
|
|
00532 MOVE T040-SYS-DATE TO MAUY-CHNG-DATE. DTSBD388
|
|
00533 DTSBD388
|
|
00534 MOVE 0 TO MSUB. DTSBD388
|
|
00535 PERFORM P3150-MOVE-MAUY-FIELDS THRU P3150-EXIT 4 TIMES. DTSBD388
|
|
00536 DTSBD388
|
|
00537 MOVE MAUY-REC TO MSKL-REC. DTSBD388
|
|
00538 PERFORM S910-WRITE THRU S910-EXIT. DTSBD388
|
|
00539 DTSBD388
|
|
00540 DISPLAY ' ADDING MAUY ...' MAUY-EMP-NO. DTSBD388
|
|
00541 ADD 1 TO MAUY-ADD-CNT. DTSBD388
|
|
00542 P3100-EXIT. DTSBD388
|
|
00543 EXIT. DTSBD388
|
|
00544 P3150-MOVE-MAUY-FIELDS. DTSBD388
|
|
00545 ADD 1 TO MSUB. DTSBD388
|
|
00546 DISPLAY ' MAUY SUB COUNT ' MSUB. DTSBD388
|
|
00547 DTSBD388
|
|
00548 IF MAUY-REC-NOT-FOUND-88 DTSBD388
|
|
00549 MOVE SPACES TO MAUY-QTR-AUDITED-IND(MSUB) DTSBD388
|
|
00550 MOVE ZEROS TO MAUY-QTR-GROSS-PAYROLL(MSUB) DTSBD388
|
|
00551 MAUY-QTR-UNDER-TOT-WAGE(MSUB) DTSBD388
|
|
00552 MAUY-QTR-UNDER-TAX-WAGE(MSUB) DTSBD388
|
|
00553 MAUY-QTR-UNDER-CONTRIB(MSUB) DTSBD388
|
|
00554 MAUY-QTR-OVER-TOT-WAGE(MSUB) DTSBD388
|
|
00555 MAUY-QTR-OVER-TAX-WAGE(MSUB) DTSBD388
|
|
00556 MAUY-QTR-OVER-CONTRIB(MSUB). DTSBD388
|
|
00557 DTSBD388
|
|
00558 IF T040-QTR-AUDITED-IND(MSUB) > SPACES DTSBD388
|
|
00559 DISPLAY 'MAUY-QTR-AUDITED ' DTSBD388
|
|
00560 MOVE 'MAUY-QTR-AUDITED ' TO L331-FIELD-NAME DTSBD388
|
|
00561 MOVE MAUY-QTR-AUDITED-IND(MSUB) TO L331-FROM-VALUE DTSBD388
|
|
00562 MOVE T040-QTR-AUDITED-IND(MSUB) TO L331-TO-VALUE DTSBD388
|
|
00563 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00564 MOVE T040-QTR-AUDITED-IND(MSUB) TO DTSBD388
|
|
00565 MAUY-QTR-AUDITED-IND(MSUB). DTSBD388
|
|
00566 DTSBD388
|
|
00567 IF T040-QTR-GROSS-PAYROLL(MSUB) > ZEROS DTSBD388
|
|
00568 DISPLAY 'MAUY-QTR-GROSS-PAY ' DTSBD388
|
|
00569 DISPLAY 'MGPAY ' MAUY-QTR-GROSS-PAYROLL(MSUB) DTSBD388
|
|
00570 DISPLAY 'TGPAY ' T040-QTR-GROSS-PAYROLL(MSUB) DTSBD388
|
|
00571 MOVE 'MAUY-QTR-GROSS-P0Y ' TO L331-FIELD-NAME DTSBD388
|
|
00572 DISPLAY 'MAUY-QTR-GROSS-PAYA ' DTSBD388
|
|
00573 MOVE MAUY-QTR-GROSS-PAYROLL(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00574 DISPLAY 'MAUY-QTR-GROSS-PAYB ' DTSBD388
|
|
00575 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00576 DISPLAY 'MAUY-QTR-GROSS-PAYC ' L331-FROM-VALUE DTSBD388
|
|
00577 MOVE T040-QTR-GROSS-PAYROLL(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00578 DISPLAY 'MAUY-QTR-GROSS-PAYD ' DTSBD388
|
|
00579 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00580 DISPLAY 'MAUY-QTR-GROSS-PAYF ' L331-TO-VALUE DTSBD388
|
|
00581 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00582 DISPLAY 'MAUY-QTR-GROSS-PAYG ' DTSBD388
|
|
00583 MOVE T040-QTR-GROSS-PAYROLL(MSUB) TO DTSBD388
|
|
00584 MAUY-QTR-GROSS-PAYROLL(MSUB). DTSBD388
|
|
00585 DTSBD388
|
|
00586 DISPLAY 'MUTOT ' MAUY-QTR-UNDER-TOT-WAGE(MSUB). DTSBD388
|
|
00587 DISPLAY 'TUTOT ' T040-QTR-UNDER-TOT-WAGE(MSUB). DTSBD388
|
|
00588 DTSBD388
|
|
00589 IF T040-QTR-UNDER-TOT-WAGE(MSUB) > ZEROS DTSBD388
|
|
00590 DISPLAY 'MAUY-QTR-UNDER-TOT-WAGE' DTSBD388
|
|
00591 MOVE 'MAUY-QTR-UNDER-TOT-WAGE' TO L331-FIELD-NAME DTSBD388
|
|
00592 MOVE MAUY-QTR-UNDER-TOT-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00593 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00594 MOVE T040-QTR-UNDER-TOT-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00595 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00596 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00597 MOVE T040-QTR-UNDER-TOT-WAGE(MSUB) TO DTSBD388
|
|
00598 MAUY-QTR-UNDER-TOT-WAGE(MSUB). DTSBD388
|
|
00599 DTSBD388
|
|
00600 IF T040-QTR-UNDER-TAX-WAGE(MSUB) > ZEROS DTSBD388
|
|
00601 DISPLAY 'MAUY-QTR-UNDER-TAX-WAGE' DTSBD388
|
|
00602 MOVE 'MAUY-QTR-UNDER-TAX-WAGE' TO L331-FIELD-NAME DTSBD388
|
|
00603 MOVE MAUY-QTR-UNDER-TAX-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00604 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00605 MOVE T040-QTR-UNDER-TAX-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00606 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00607 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00608 MOVE T040-QTR-UNDER-TAX-WAGE(MSUB) TO DTSBD388
|
|
00609 MAUY-QTR-UNDER-TAX-WAGE(MSUB). DTSBD388
|
|
00610 DTSBD388
|
|
00611 IF T040-QTR-UNDER-CONTRIB(MSUB) > ZEROS DTSBD388
|
|
00612 DISPLAY 'MAUY-QTR-UNDER-CONTRIB' DTSBD388
|
|
00613 MOVE 'MAUY-QTR-UNDER-CONTRIB' TO L331-FIELD-NAME DTSBD388
|
|
00614 MOVE MAUY-QTR-UNDER-CONTRIB(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00615 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00616 MOVE T040-QTR-UNDER-CONTRIB(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00617 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00618 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00619 MOVE T040-QTR-UNDER-CONTRIB(MSUB) TO DTSBD388
|
|
00620 MAUY-QTR-UNDER-CONTRIB(MSUB). DTSBD388
|
|
00621 DTSBD388
|
|
00622 IF T040-QTR-OVER-TOT-WAGE(MSUB) > ZEROS DTSBD388
|
|
00623 DISPLAY 'MAUY-QTR-OVER-TOT-WAGE' DTSBD388
|
|
00624 MOVE 'MAUY-QTR-OVER-TOT-WAGE' TO L331-FIELD-NAME DTSBD388
|
|
00625 MOVE MAUY-QTR-OVER-TOT-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00626 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00627 MOVE T040-QTR-OVER-TOT-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00628 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00629 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00630 MOVE T040-QTR-OVER-TOT-WAGE(MSUB) TO DTSBD388
|
|
00631 MAUY-QTR-OVER-TOT-WAGE(MSUB). DTSBD388
|
|
00632 DTSBD388
|
|
00633 IF T040-QTR-OVER-TAX-WAGE(MSUB) > ZEROS DTSBD388
|
|
00634 DISPLAY 'MAUY-QTR-OVER-TAX-WAGE' DTSBD388
|
|
00635 MOVE 'MAUY-QTR-OVER-TAX-WAGE' TO L331-FIELD-NAME DTSBD388
|
|
00636 MOVE MAUY-QTR-OVER-TAX-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00637 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00638 MOVE T040-QTR-OVER-TAX-WAGE(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00639 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00640 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00641 MOVE T040-QTR-OVER-TAX-WAGE(MSUB) TO DTSBD388
|
|
00642 MAUY-QTR-OVER-TAX-WAGE(MSUB). DTSBD388
|
|
00643 DTSBD388
|
|
00644 IF T040-QTR-OVER-CONTRIB(MSUB) > ZEROS DTSBD388
|
|
00645 DISPLAY 'MAUY-QTR-OVER-CONTRIB' DTSBD388
|
|
00646 MOVE 'MAUY-QTR-OVER-CONTRIB' TO L331-FIELD-NAME DTSBD388
|
|
00647 MOVE MAUY-QTR-OVER-CONTRIB(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00648 MOVE X-MONEY-AMT TO L331-FROM-VALUE DTSBD388
|
|
00649 MOVE T040-QTR-OVER-CONTRIB(MSUB) TO W-MONEY-AMT DTSBD388
|
|
00650 MOVE X-MONEY-AMT TO L331-TO-VALUE DTSBD388
|
|
00651 PERFORM P3300-UPD-MLOG-MAUY THRU P3300-EXIT DTSBD388
|
|
00652 MOVE T040-QTR-OVER-CONTRIB(MSUB) TO DTSBD388
|
|
00653 MAUY-QTR-OVER-CONTRIB(MSUB). DTSBD388
|
|
00654 DTSBD388
|
|
00655 P3150-EXIT. DTSBD388
|
|
00656 EXIT. DTSBD388
|
|
00657 DTSBD388
|
|
00658 P3200-UPD-MAUY. DTSBD388
|
|
00659 MOVE T040-SYS-DATE TO MAUY-CHNG-DATE. DTSBD388
|
|
00660 MOVE 0 TO MSUB. DTSBD388
|
|
00661 PERFORM P3150-MOVE-MAUY-FIELDS THRU P3150-EXIT 4 TIMES. DTSBD388
|
|
00662 DTSBD388
|
|
00663 MOVE MAUY-REC TO MSKL-REC. DTSBD388
|
|
00664 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD388
|
|
00665 ADD 1 TO MAUY-UPD-CNT. DTSBD388
|
|
00666 DISPLAY ' UPDATE MAUY ...' MAUY-EMP-NO. DTSBD388
|
|
00667 P3200-EXIT. DTSBD388
|
|
00668 EXIT. DTSBD388
|
|
00669 P3300-UPD-MLOG-MAUY. DTSBD388
|
|
00670 * IF MAUY-REC-NOT-FOUND-88 DTSBD388
|
|
00671 * GO TO P3300-EXIT. DTSBD388
|
|
00672 DTSBD388
|
|
00673 PERFORM S330-INIT-MLOG THRU S330-EXIT. DTSBD388
|
|
00674 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD388
|
|
00675 DTSBD388
|
|
00676 P3300-EXIT. DTSBD388
|
|
00677 EXIT. DTSBD388
|
|
00678 DTSBD388
|
|
00679 S005-FROM-ABSTIME. DTSBD388
|
|
00680 SET L005-FROM-ABSTIME TO TRUE. DTSBD388
|
|
00681 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD388
|
|
00682 DTSBD388
|
|
00683 S005-EXIT. DTSBD388
|
|
00684 EXIT. DTSBD388
|
|
00685 DTSBD388
|
|
00686 S330-INIT-MLOG. DTSBD388
|
|
00687 MOVE T040-EMP-NO TO L331-EMP-NO. DTSBD388
|
|
00688 MOVE LBCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSBD388
|
|
00689 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD388
|
|
00690 MOVE LBCM-EMP-ABSTIME TO L331-UPDATE-ABSTIME. DTSBD388
|
|
00691 MOVE 'BATCH' TO L331-OP-ID. DTSBD388
|
|
00692 MOVE LBCM-ABSTIME TO L005-ABSTIME. DTSBD388
|
|
00693 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD388
|
|
00694 MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID. DTSBD388
|
|
00695 DTSBD388
|
|
00696 S330-EXIT. DTSBD388
|
|
00697 EXIT. DTSBD388
|
|
00698 DTSBD388
|
|
00699 S331-WRITE-MLOG. DTSBD388
|
|
00700 CALL 'DTSBU331' USING L331-LINK-AREA. DTSBD388
|
|
00701 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD388
|
|
00702 DTSBD388
|
|
00703 S331-EXIT. DTSBD388
|
|
00704 EXIT. DTSBD388
|
|
00705 DTSBD388
|
|
00706 S910-OPEN-READ. DTSBD388
|
|
00707 SET L910-OPEN-READ-88 TO TRUE. DTSBD388
|
|
00708 GO TO S910-MSTR-IO. DTSBD388
|
|
00709 DTSBD388
|
|
00710 S910-OPEN-UPDATE. DTSBD388
|
|
00711 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD388
|
|
00712 GO TO S910-MSTR-IO. DTSBD388
|
|
00713 DTSBD388
|
|
00714 S910-OPEN-UPDATE-NO-AIX. DTSBD388
|
|
00715 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBD388
|
|
00716 GO TO S910-MSTR-IO. DTSBD388
|
|
00717 DTSBD388
|
|
00718 S910-READ. DTSBD388
|
|
00719 SET L910-READ-88 TO TRUE. DTSBD388
|
|
00720 GO TO S910-MSTR-IO. DTSBD388
|
|
00721 DTSBD388
|
|
00722 S910-START-BROWSE. DTSBD388
|
|
00723 SET L910-START-BROWSE-88 TO TRUE. DTSBD388
|
|
00724 GO TO S910-MSTR-IO. DTSBD388
|
|
00725 DTSBD388
|
|
00726 S910-READ-NEXT. DTSBD388
|
|
00727 SET L910-READ-NEXT-88 TO TRUE. DTSBD388
|
|
00728 GO TO S910-MSTR-IO. DTSBD388
|
|
00729 DTSBD388
|
|
00730 S910-COUNT. DTSBD388
|
|
00731 SET L910-COUNT-88 TO TRUE. DTSBD388
|
|
00732 GO TO S910-MSTR-IO. DTSBD388
|
|
00733 DTSBD388
|
|
00734 S910-WRITE. DTSBD388
|
|
00735 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD388
|
|
00736 SET L910-WRITE-88 TO TRUE. DTSBD388
|
|
00737 GO TO S910-MSTR-IO. DTSBD388
|
|
00738 DTSBD388
|
|
00739 S910-REWRITE. DTSBD388
|
|
00740 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD388
|
|
00741 SET L910-REWRITE-88 TO TRUE. DTSBD388
|
|
00742 GO TO S910-MSTR-IO. DTSBD388
|
|
00743 DTSBD388
|
|
00744 S910-DELETE. DTSBD388
|
|
00745 SET L910-DELETE-88 TO TRUE. DTSBD388
|
|
00746 GO TO S910-MSTR-IO. DTSBD388
|
|
00747 DTSBD388
|
|
00748 S910-CLOSE. DTSBD388
|
|
00749 SET L910-CLOSE-88 TO TRUE. DTSBD388
|
|
00750 GO TO S910-MSTR-IO. DTSBD388
|
|
00751 DTSBD388
|
|
00752 S910-MSTR-IO. DTSBD388
|
|
00753 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD388
|
|
00754 MSKL-REC. DTSBD388
|
|
00755 S910-EXIT. DTSBD388
|
|
00756 EXIT. DTSBD388
|
|
00757 DTSBD388
|
|
00758 S947-WRITE-R907. DTSBD388
|
|
00759 CALL 'DTSBU947' USING R907-REC. DTSBD388
|
|
00760 DTSBD388
|
|
00761 S947-EXIT. DTSBD388
|
|
00762 EXIT. DTSBD388
|
|
00763 DTSBD388
|
|
00764 S999-ABEND. DTSBD388
|
|
00765 DISPLAY '*** DTSBD388 ABENDING : ' DTSBD388
|
|
00766 WRK-ABEND-MSG. DTSBD388
|
|
00767 DTSBD388
|
|
00768 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD388
|
|
00769 S999-EXIT. DTSBD388
|
|
00770 EXIT. DTSBD388
|
|
00771 DTSBD388
|