DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
409
Batch/CHGBD207.cob
Normal file
409
Batch/CHGBD207.cob
Normal file
@ -0,0 +1,409 @@
|
||||
00001 IDENTIFICATION DIVISION. 12/08/20
|
||||
00002 PROGRAM-ID. CHGBD207. CHGBD207
|
||||
00003 *AUTHOR. TRW. LV005
|
||||
00004 *DATE-WRITTEN. AUGUST 2002. CHGBD207
|
||||
00005 DATE-COMPILED. CHGBD207
|
||||
00006 SKIP3 CHGBD207
|
||||
00007 ***** CHGBD207
|
||||
00008 * CHGBD207
|
||||
00009 * FUNCTION: CHGBD207
|
||||
00010 * CHGBD207
|
||||
00011 * READ NEW BENEFIT CHARGE FILE CREATED FROM PROGRAM CHGBD207
|
||||
00012 * CHGBD200, LISTING CHARGES TO EACH CLAIMANT BY THE CHGBD207
|
||||
00013 * BENEFIT YEAR AND DATE OF PAYMENT OR ADJUSTMENT. CHGBD207
|
||||
00014 * CHGBD207
|
||||
00015 * WRITE BD207CHG OUTPUT RECORD. CHGBD207
|
||||
00016 * CHGBD207
|
||||
00017 * *** IF NO OUTPUT RECORDS WRITTEN, SET RETURN-CODE CHGBD207
|
||||
00018 * *** TO +1. THIS WILL BYPASS ALL REMAINING JOB STEPS. CHGBD207
|
||||
00019 * CHGBD207
|
||||
00020 * INPUT: CHGBD207
|
||||
00021 * CHGBD207
|
||||
00022 * BD200DAY - DAILY CHARGE RECORDS GENERATED BY CHGBD207
|
||||
00023 * CHGBD200. CHGBD207
|
||||
00024 * CHGBD207
|
||||
00025 * OUTPUT: CHGBD207
|
||||
00026 * CHGBD207
|
||||
00027 * BD207CHG - CHARGE RECORDS SELECTED IN CHGBD207
|
||||
00028 * CHGBD207. CHGBD207
|
||||
00029 ***** CHGBD207
|
||||
00030 CHGBD207
|
||||
00031 ******************************************************************CHGBD207
|
||||
00032 * MODIFICATION HISTORY: *CHGBD207
|
||||
00033 * *CHGBD207
|
||||
00034 * 08-07-2002 INITIAL DEVELOPMENT CHGBD207
|
||||
00035 * REFERENCE RFP #**** AUTHOR OF CHANGE - RW1 *CHGBD207
|
||||
00036 * *CHGBD207
|
||||
00037 * 02-10-2003 ADD TEST FOR RECORDS WRITTEN = ZERO. CHGBD207
|
||||
00038 * REFERENCE RFP #**** AUTHOR OF CHANGE - GD *CHGBD207
|
||||
00039 * *CHGBD207
|
||||
00040 * 06-29-2004 ADDED EMP-TYPE 17 - DOMESTIC VIOLENCE. CHGBD207
|
||||
00041 * REFERENCE RFP #**** AUTHOR OF CHANGE - GD *CHGBD207
|
||||
00042 * *CHGBD207
|
||||
00043 * 01-11-2006 REMOVE CODE IN P1000 THAT EXCLUDED POTENTIALLY CHGBD207
|
||||
00044 * INCORRECT CHARGES. THE PROBLEM IN THE BENEFITS CHGBD207
|
||||
00045 * SYSTEM HAS BEEN FIXED. CHGBD207
|
||||
00046 * REFERENCE: AUTHOR OF CHANGE - GD *CHGBD207
|
||||
00047 * CHGBD207
|
||||
00048 * 03-06-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED *CHGBD207
|
||||
00049 * FROM NUMERIC TO CHARACTER. *CHGBD207
|
||||
00050 * UPDATED EMPLOYER TYPES. *CHGBD207
|
||||
00051 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD207
|
||||
00052 * CHGBD207
|
||||
00053 * 12-03-2009 MODIFIED FOR NEW FORMAT OF PROGRAM CODE - CHANGED *CHGBD207
|
||||
00054 * REMOVED WORKING-STORAGE WRK-AREA AND CHANGE CODE *CHGBD207
|
||||
00055 * TO USE CHGIM002 COPYBOOK FIELDS. *CHGBD207
|
||||
00056 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD207
|
||||
00057 * CHGBD207
|
||||
00058 * 09-26-2014 RECOMPILED FOR NEW PROGRAM CODE UCPIA *CHGBD207
|
||||
00059 * CHGIM002 COPYBOOK FIELDS. *CHGBD207
|
||||
00060 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBD207
|
||||
00061 * CHGBD207
|
||||
00062 * 04-13-2020 RECOMPILED FOR NEW PROGRAM CODE PUA FPUC FRUR * CL**2
|
||||
00063 * CHGIM002 COPYBOOK FIELDS. * CL**2
|
||||
00064 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**2
|
||||
00065 * CL**2
|
||||
00066 * 04-24-2020 RECOMPILED FOR NEW PROGRAM CODE PEUC * CL**3
|
||||
00067 * CHGIM002 COPYBOOK FIELDS. * CL**3
|
||||
00068 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**3
|
||||
00069 * CL**3
|
||||
00070 * 08-18-2020 RECOMPILED FOR NEW PROGRAM CODE LWA * CL**4
|
||||
00071 * CHGIM002 COPYBOOK FIELDS. * CL**4
|
||||
00072 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**4
|
||||
00073 * CL**5
|
||||
00074 * 12-08-2020 RECOMPILED FOR NEW PROGRAM CODE PUA STIMULUS * CL**5
|
||||
00075 * CHGIM002 COPYBOOK FIELDS. * CL**5
|
||||
00076 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 * CL**5
|
||||
00077 * CL**4
|
||||
00078 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD207
|
||||
00079 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD207
|
||||
00080 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD207
|
||||
00081 ******************************************************************CHGBD207
|
||||
00082 CHGBD207
|
||||
00083 SKIP3 CHGBD207
|
||||
00084 ENVIRONMENT DIVISION. CHGBD207
|
||||
00085 SKIP3 CHGBD207
|
||||
00086 INPUT-OUTPUT SECTION. CHGBD207
|
||||
00087 SKIP3 CHGBD207
|
||||
00088 FILE-CONTROL. CHGBD207
|
||||
00089 CHGBD207
|
||||
00090 SELECT BD200-CHG-FILE-IN ASSIGN TO BD200DAY CHGBD207
|
||||
00091 FILE STATUS IS BD200-CHG-STATUS. CHGBD207
|
||||
00092 CHGBD207
|
||||
00093 SELECT BD207-CHG-FILE-OUT ASSIGN TO BD207CHG CHGBD207
|
||||
00094 FILE STATUS IS BD207-CHG-STATUS. CHGBD207
|
||||
00095 CHGBD207
|
||||
00096 DATA DIVISION. CHGBD207
|
||||
00097 CHGBD207
|
||||
00098 FILE SECTION. CHGBD207
|
||||
00099 CHGBD207
|
||||
00100 FD BD200-CHG-FILE-IN CHGBD207
|
||||
00101 RECORDING MODE IS F CHGBD207
|
||||
00102 RECORD CONTAINS 64 CHARACTERS CHGBD207
|
||||
00103 DATA RECORD IS BD200-CHG-REC. CHGBD207
|
||||
00104 01 BD200-CHRG-REC PIC X(64). CHGBD207
|
||||
00105 CHGBD207
|
||||
00106 FD BD207-CHG-FILE-OUT CHGBD207
|
||||
00107 RECORDING MODE IS F CHGBD207
|
||||
00108 LABEL RECORDS ARE STANDARD CHGBD207
|
||||
00109 RECORD CONTAINS 64 CHARACTERS CHGBD207
|
||||
00110 BLOCK CONTAINS 0 CHARACTERS CHGBD207
|
||||
00111 DATA RECORD IS BD207-CHG-REC. CHGBD207
|
||||
00112 SKIP1 CHGBD207
|
||||
00113 01 BD207-CHG-REC PIC X(64). CHGBD207
|
||||
00114 CHGBD207
|
||||
00115 EJECT CHGBD207
|
||||
00116 WORKING-STORAGE SECTION. CHGBD207
|
||||
001165 77 PAN-VALET PICTURE X(24) VALUE '005CHGBD207 12/08/20'. CHGBD207
|
||||
00117 77 PAN-VALET PICTURE X(24) VALUE '016CHGBD207 10/01/14'. CHGBD207
|
||||
00118 77 PAN-VALET PICTURE X(24) VALUE '002CHGBD207 09/26/14'. CHGBD207
|
||||
00119 77 PAN-VALET PICTURE X(24) VALUE '014CHGBD207 04/01/10'. CHGBD207
|
||||
00120 CHGBD207
|
||||
00121 01 WRK-AREA. CHGBD207
|
||||
00122 CHGBD207
|
||||
00123 05 WRK-DISP-AREA. CHGBD207
|
||||
00124 10 WRK-DATE PIC 9999B99B99. CHGBD207
|
||||
00125 10 FILLER PIC X(02) VALUE SPACES. CHGBD207
|
||||
00126 10 WRK-EMP-DISP PIC 9(06). CHGBD207
|
||||
00127 10 FILLER PIC X(02) VALUE SPACES. CHGBD207
|
||||
00128 10 WRK-SSN-DISP PIC 9(10). CHGBD207
|
||||
00129 10 FILLER PIC X(02) VALUE SPACES. CHGBD207
|
||||
00130 10 WRK-CHG-AMT-DISP PIC Z(07)9.99-. CHGBD207
|
||||
00131 CHGBD207
|
||||
00132 05 WRK-SSN PIC 9(10). CHGBD207
|
||||
00133 05 FILLER REDEFINES WRK-SSN. CHGBD207
|
||||
00134 10 WRK-SSN9 PIC 9(09). CHGBD207
|
||||
00135 10 WRK-SSN0 PIC 9(01). CHGBD207
|
||||
00136 CHGBD207
|
||||
00137 05 WRK-TOT-CHG PIC S9(08)V99 COMP-3 CHGBD207
|
||||
00138 VALUE +0. CHGBD207
|
||||
00139 05 WRK-TOT-CHG-DISP PIC ZZ,ZZZ,ZZ9.99-. CHGBD207
|
||||
00140 05 ABEND-CODE PIC S9(04) COMP CHGBD207
|
||||
00141 VALUE +207. CHGBD207
|
||||
00142 05 ABEND-MOD PIC X(08) CHGBD207
|
||||
00143 VALUE 'DTSBU999'. CHGBD207
|
||||
00144 05 ABEND-MSG PIC X(60). CHGBD207
|
||||
00145 CHGBD207
|
||||
00146 05 BD200-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD207
|
||||
00147 88 BD200-FILE-OK-88 VALUE ZERO. CHGBD207
|
||||
00148 88 BD200-FILE-EOF-88 VALUE '10'. CHGBD207
|
||||
00149 CHGBD207
|
||||
00150 05 BD207-CHG-STATUS PIC X(02) VALUE SPACES. CHGBD207
|
||||
00151 88 BD207-FILE-OK-88 VALUE ZERO. CHGBD207
|
||||
00152 88 BD207-FILE-EOF-88 VALUE '10'. CHGBD207
|
||||
00153 CHGBD207
|
||||
00154 05 WRK-ERROR-IND PIC X(01). CHGBD207
|
||||
00155 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD207
|
||||
00156 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD207
|
||||
00157 CHGBD207
|
||||
00158 05 WRK-EMP-VALID-IND PIC X(01). CHGBD207
|
||||
00159 88 WRK-EMP-VALID-YES-88 VALUE 'Y'. CHGBD207
|
||||
00160 88 WRK-EMP-VALID-NO-88 VALUE 'N'. CHGBD207
|
||||
00161 CHGBD207
|
||||
00162 05 WRK-BEGIN-DATE PIC S9(09) COMP-3. CHGBD207
|
||||
00163 05 WRK-END-DATE PIC S9(09) COMP-3. CHGBD207
|
||||
00164 CHGBD207
|
||||
00165 05 WRK-BEGIN-DATE-DISP PIC 9(08). CHGBD207
|
||||
00166 05 FILLER REDEFINES WRK-BEGIN-DATE-DISP. CHGBD207
|
||||
00167 10 WRK-BEGIN-YR PIC 9(04). CHGBD207
|
||||
00168 10 WRK-BEGIN-MO PIC 9(02). CHGBD207
|
||||
00169 10 WRK-BEGIN-DA PIC 9(02). CHGBD207
|
||||
00170 CHGBD207
|
||||
00171 05 WRK-END-DATE-DISP PIC 9(08). CHGBD207
|
||||
00172 05 FILLER REDEFINES WRK-END-DATE-DISP. CHGBD207
|
||||
00173 10 WRK-END-YR PIC 9(04). CHGBD207
|
||||
00174 10 WRK-END-MO PIC 9(02). CHGBD207
|
||||
00175 10 WRK-END-DA PIC 9(02). CHGBD207
|
||||
00176 CHGBD207
|
||||
00177 05 WRK-EMP-NO PIC S9(07) COMP-3. CHGBD207
|
||||
00178 88 WRK-POOL-ACCT-88 VALUE +028411, CHGBD207
|
||||
00179 +999000 THRU +999992. CHGBD207
|
||||
00180 88 WRK-FED-ACCT-88 VALUE +1 THRU +1999. CHGBD207
|
||||
00181 CHGBD207
|
||||
00182 CHGBD207
|
||||
00183 05 WRK-RPT-TYPE PIC 9(02) VALUE ZERO. CHGBD207
|
||||
00184 88 WRK-RPT-TYPE-RATED-88 VALUE 00. CHGBD207
|
||||
00185 88 WRK-RPT-TYPE-FED-88 VALUE 01, 02. CHGBD207
|
||||
00186 88 WRK-RPT-TYPE-CWC-88 VALUE 04. CHGBD207
|
||||
00187 88 WRK-RPT-TYPE-SELF-INS-88 VALUE 08, 10. CHGBD207
|
||||
00188 88 WRK-RPT-TYPE-EMP-88 VALUE 00, 01, 02, CHGBD207
|
||||
00189 04, 08, 10. CHGBD207
|
||||
00190 CHGBD207
|
||||
00191 05 WRK-REC-SELECTED-IND PIC X(01) VALUE SPACE. CHGBD207
|
||||
00192 88 WRK-REC-SELECTED-YES VALUE 'Y'. CHGBD207
|
||||
00193 88 WRK-REC-SELECTED-NO VALUE 'N'. CHGBD207
|
||||
00194 CHGBD207
|
||||
00195 05 WRK-BD200-CHG-READ PIC 9(09) COMP-3 VALUE 0. CHGBD207
|
||||
00196 05 WRK-BD207-WRITE PIC 9(09) COMP-3 VALUE 0. CHGBD207
|
||||
00197 05 WRK-BD200-CHG-DELETE PIC 9(09) COMP-3 VALUE 0. CHGBD207
|
||||
00198 05 WRK-CHG-DELETE-AMT PIC S9(08)V99 COMP-3 CHGBD207
|
||||
00199 VALUE +0. CHGBD207
|
||||
00200 05 WRK-BD200-NOT-LIAB-CNT PIC 9(09) COMP-3 VALUE 0. CHGBD207
|
||||
00201 05 WRK-INV-CHRG-ERR-CNT PIC 9(09) COMP-3 VALUE 0. CHGBD207
|
||||
00202 05 WRK-INV-CHRG-AMT PIC S9(08)V99 COMP-3 CHGBD207
|
||||
00203 VALUE +0. CHGBD207
|
||||
00204 05 WRK-CNT-DISP PIC Z(08)9. CHGBD207
|
||||
00205 01 BD200-CHG-REC. CHGBD207
|
||||
00206 ++INCLUDE CHGIM002 CHGBD207
|
||||
00207 CHGBD207
|
||||
00208 01 L001-LINK-AREA. CHGBD207
|
||||
00209 ++INCLUDE DTSIL001 CHGBD207
|
||||
00210 CHGBD207
|
||||
00211 01 L004-LINK-AREA. CHGBD207
|
||||
00212 ++INCLUDE DTSIL004 CHGBD207
|
||||
00213 CHGBD207
|
||||
00214 EJECT CHGBD207
|
||||
00215 PROCEDURE DIVISION. CHGBD207
|
||||
00216 SKIP2 CHGBD207
|
||||
00217 CHGBD207-MAIN. CHGBD207
|
||||
00218 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD207
|
||||
00219 IF WRK-ERROR-YES-88 CHGBD207
|
||||
00220 GO TO CHGBD207-EXIT. CHGBD207
|
||||
00221 CHGBD207
|
||||
00222 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD207
|
||||
00223 CHGBD207
|
||||
00224 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD207
|
||||
00225 CHGBD207
|
||||
00226 CHGBD207-EXIT. CHGBD207
|
||||
00227 STOP RUN. CHGBD207
|
||||
00228 EJECT CHGBD207
|
||||
00229 I0000-INITIATE. CHGBD207
|
||||
00230 CHGBD207
|
||||
00231 MOVE ZERO TO WRK-BD200-CHG-READ CHGBD207
|
||||
00232 WRK-BD200-NOT-LIAB-CNT CHGBD207
|
||||
00233 WRK-BD207-WRITE CHGBD207
|
||||
00234 WRK-BD200-CHG-DELETE. CHGBD207
|
||||
00235 CHGBD207
|
||||
00236 SET WRK-ERROR-NO-88 TO TRUE. CHGBD207
|
||||
00237 CHGBD207
|
||||
00238 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. CHGBD207
|
||||
00239 CHGBD207
|
||||
00240 I0000-EXIT. CHGBD207
|
||||
00241 EXIT. CHGBD207
|
||||
00242 CHGBD207
|
||||
00243 I1000-OPEN-FILES. CHGBD207
|
||||
00244 CHGBD207
|
||||
00245 OPEN INPUT BD200-CHG-FILE-IN. CHGBD207
|
||||
00246 IF NOT BD200-FILE-OK-88 CHGBD207
|
||||
00247 DISPLAY 'BD200 FILE OPEN ERROR: ' BD200-CHG-STATUS CHGBD207
|
||||
00248 PERFORM S999-ABEND THRU S999-EXIT. CHGBD207
|
||||
00249 CHGBD207
|
||||
00250 OPEN OUTPUT BD207-CHG-FILE-OUT. CHGBD207
|
||||
00251 IF NOT BD207-FILE-OK-88 CHGBD207
|
||||
00252 DISPLAY 'BD207 FILE OPEN ERROR: ' BD207-CHG-STATUS CHGBD207
|
||||
00253 PERFORM S999-ABEND THRU S999-EXIT. CHGBD207
|
||||
00254 CHGBD207
|
||||
00255 I1000-EXIT. CHGBD207
|
||||
00256 EXIT. CHGBD207
|
||||
00257 CHGBD207
|
||||
00258 P0000-PROCESS. CHGBD207
|
||||
00259 CHGBD207
|
||||
00260 PERFORM P1000-READ-CHARGES THRU P1000-EXIT CHGBD207
|
||||
00261 UNTIL BD200-FILE-EOF-88 CHGBD207
|
||||
00262 OR WRK-ERROR-YES-88. CHGBD207
|
||||
00263 CHGBD207
|
||||
00264 P0000-EXIT. CHGBD207
|
||||
00265 EXIT. CHGBD207
|
||||
00266 CHGBD207
|
||||
00267 P1000-READ-CHARGES. CHGBD207
|
||||
00268 READ BD200-CHG-FILE-IN INTO BD200-CHG-REC. CHGBD207
|
||||
00269 CHGBD207
|
||||
00270 IF BD200-FILE-EOF-88 CHGBD207
|
||||
00271 GO TO P1000-EXIT CHGBD207
|
||||
00272 ELSE CHGBD207
|
||||
00273 IF NOT BD200-FILE-OK-88 CHGBD207
|
||||
00274 DISPLAY 'BD200 FILE READ ERROR: ' BD200-CHG-STATUS CHGBD207
|
||||
00275 SET WRK-ERROR-YES-88 TO TRUE CHGBD207
|
||||
00276 GO TO P1000-EXIT. CHGBD207
|
||||
00277 CHGBD207
|
||||
00278 ADD 1 TO WRK-BD200-CHG-READ. CHGBD207
|
||||
00279 CHGBD207
|
||||
00280 ** MOVE CHG2-EMP-TYPE TO WRK-EMP-TYPE. CHGBD207
|
||||
00281 *** IF WRK-EMP-TYPE-POOL-88 CHGBD207
|
||||
00282 *** ADD +1 TO WRK-BD200-CHG-DELETE CHGBD207
|
||||
00283 *** COMPUTE WRK-CHG-DELETE-AMT = WRK-CHG-DELETE-AMT + CHGBD207
|
||||
00284 *** (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT) CHGBD207
|
||||
00285 *** GO TO P1000-EXIT. CHGBD207
|
||||
00286 CHGBD207
|
||||
00287 MOVE CHG2-EMP-NO TO WRK-EMP-NO. CHGBD207
|
||||
00288 *** IF WRK-POOL-ACCT-88 CHGBD207
|
||||
00289 *** ADD +1 TO WRK-BD200-CHG-DELETE CHGBD207
|
||||
00290 *** COMPUTE WRK-CHG-DELETE-AMT = WRK-CHG-DELETE-AMT + CHGBD207
|
||||
00291 *** (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT) CHGBD207
|
||||
00292 *** GO TO P1000-EXIT. CHGBD207
|
||||
00293 CHGBD207
|
||||
00294 *& EXCLUDE RECORDS WITH BYE PRIOR TO 1/1/2001 CHGBD207
|
||||
00295 *& FOR EMPLOYER TYPE = UCX, UCFE, SELF-INSURED, CHGBD207
|
||||
00296 *& DC GOVERNMENT. PER FRANK ORLANDO 2/21/2002 - GD. CHGBD207
|
||||
00297 * CHGBD207
|
||||
00298 ** THERE IS NO LONGER ANY NEED TO BYPASS THE CHARGE CHGBD207
|
||||
00299 ** DATA - THE PROBLEM IN THE BENEFITS PROCESS HAS CHGBD207
|
||||
00300 ** BEEN FIXED PER BRUCE. 3/31/2010 GD CHGBD207
|
||||
00301 ** IF (CHG2-BYE = ZERO) OR (CHG2-CHARGE-DATE < 20010101) CHGBD207
|
||||
00302 * NEXT SENTENCE CHGBD207
|
||||
00303 * ELSE CHGBD207
|
||||
00304 * IF CHG2-BYE < 20010101 CHGBD207
|
||||
00305 * IF CHG2-EMP-TYPE-UCX-88 CHGBD207
|
||||
00306 * OR CHG2-EMP-TYPE-UCFE-88 CHGBD207
|
||||
00307 * OR CHG2-EMP-TYPE-SELF-INS-88 CHGBD207
|
||||
00308 * OR CHG2-EMP-TYPE-DC-GOV-88 CHGBD207
|
||||
00309 * OR (CHG2-EMP-TYPE-CWC-88 AND WRK-FED-ACCT-88) CHGBD207
|
||||
00310 * ADD +1 TO WRK-INV-CHRG-ERR-CNT CHGBD207
|
||||
00311 * COMPUTE WRK-INV-CHRG-AMT = WRK-INV-CHRG-AMT + CHGBD207
|
||||
00312 * (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT) CHGBD207
|
||||
00313 ** GO TO P1000-EXIT. CHGBD207
|
||||
00314 CHGBD207
|
||||
00315 PERFORM S1100-WRITE-BD207 THRU S1100-EXIT CHGBD207
|
||||
00316 COMPUTE WRK-TOT-CHG = WRK-TOT-CHG + CHGBD207
|
||||
00317 (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT). CHGBD207
|
||||
00318 CHGBD207
|
||||
00319 P1000-EXIT. CHGBD207
|
||||
00320 EXIT. CHGBD207
|
||||
00321 CHGBD207
|
||||
00322 S1100-WRITE-BD207. CHGBD207
|
||||
00323 WRITE BD207-CHG-REC FROM BD200-CHG-REC. CHGBD207
|
||||
00324 IF BD207-FILE-OK-88 CHGBD207
|
||||
00325 ADD 1 TO WRK-BD207-WRITE. CHGBD207
|
||||
00326 CHGBD207
|
||||
00327 S1100-EXIT. CHGBD207
|
||||
00328 EXIT. CHGBD207
|
||||
00329 CHGBD207
|
||||
00330 *S001-FROM-CAL-6. CHGBD207
|
||||
00331 ** SET L001-FROM-CAL-6 TO TRUE. CHGBD207
|
||||
00332 ** GO TO S001-DATE. CHGBD207
|
||||
00333 CHGBD207
|
||||
00334 *S001-FROM-FED-8. CHGBD207
|
||||
00335 ** SET L001-FROM-FED-8 TO TRUE. CHGBD207
|
||||
00336 ** GO TO S001-DATE. CHGBD207
|
||||
00337 CHGBD207
|
||||
00338 *S001-FROM-ABS. CHGBD207
|
||||
00339 ** SET L001-FROM-ABS-DAY TO TRUE. CHGBD207
|
||||
00340 ** GO TO S001-DATE. CHGBD207
|
||||
00341 CHGBD207
|
||||
00342 *S001-DATE. CHGBD207
|
||||
00343 ** CALL 'DTSBU001' USING L001-LINK-AREA. CHGBD207
|
||||
00344 *S001-EXIT. EXIT. CHGBD207
|
||||
00345 CHGBD207
|
||||
00346 *S004-FROM-DATE. CHGBD207
|
||||
00347 ** SET L004-FROM-DATE TO TRUE. CHGBD207
|
||||
00348 ** GO TO S004-YRQ. CHGBD207
|
||||
00349 CHGBD207
|
||||
00350 *S004-YRQ. CHGBD207
|
||||
00351 * CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD207
|
||||
00352 *S004-EXIT. EXIT. CHGBD207
|
||||
00353 CHGBD207
|
||||
00354 T0000-TERMINATE. CHGBD207
|
||||
00355 CLOSE BD200-CHG-FILE-IN CHGBD207
|
||||
00356 BD207-CHG-FILE-OUT. CHGBD207
|
||||
00357 CHGBD207
|
||||
00358 DISPLAY '************** CHGBD207 COUNTS **************'. CHGBD207
|
||||
00359 DISPLAY '*** ***'. CHGBD207
|
||||
00360 CHGBD207
|
||||
00361 MOVE WRK-BD200-CHG-READ TO WRK-CNT-DISP. CHGBD207
|
||||
00362 DISPLAY 'CHARGE RECORDS READ: ' CHGBD207
|
||||
00363 WRK-CNT-DISP. CHGBD207
|
||||
00364 CHGBD207
|
||||
00365 MOVE WRK-BD207-WRITE TO WRK-CNT-DISP. CHGBD207
|
||||
00366 DISPLAY 'CHARGE RECORDS WRITTEN: ' CHGBD207
|
||||
00367 WRK-CNT-DISP. CHGBD207
|
||||
00368 CHGBD207
|
||||
00369 ******************************************************************CHGBD207
|
||||
00370 * IF NO CHARGE RECORDS WRITTEN, SET RETURN CODE TO +1 TO BYPASS CHGBD207
|
||||
00371 * REMAINING JOB STEPS. CHGBD207
|
||||
00372 ******************************************************************CHGBD207
|
||||
00373 IF WRK-BD207-WRITE = ZERO CHGBD207
|
||||
00374 MOVE +1 TO RETURN-CODE CHGBD207
|
||||
00375 DISPLAY '>>> NO CHARGES: REMAINING JOB STEPS IGNORED <<<'.CHGBD207
|
||||
00376 CHGBD207
|
||||
00377 DISPLAY SPACE. CHGBD207
|
||||
00378 CHGBD207
|
||||
00379 MOVE WRK-BD200-CHG-DELETE TO WRK-CNT-DISP. CHGBD207
|
||||
00380 MOVE WRK-CHG-DELETE-AMT TO WRK-TOT-CHG-DISP. CHGBD207
|
||||
00381 DISPLAY 'POOL ACCOUNTS EXCLUDED: ' CHGBD207
|
||||
00382 WRK-CNT-DISP ' ' WRK-TOT-CHG-DISP. CHGBD207
|
||||
00383 CHGBD207
|
||||
00384 MOVE WRK-INV-CHRG-ERR-CNT TO WRK-CNT-DISP. CHGBD207
|
||||
00385 MOVE WRK-INV-CHRG-AMT TO WRK-TOT-CHG-DISP. CHGBD207
|
||||
00386 DISPLAY 'PRE-2001 CHRG EXCLUDED: ' CHGBD207
|
||||
00387 WRK-CNT-DISP ' ' WRK-TOT-CHG-DISP. CHGBD207
|
||||
00388 CHGBD207
|
||||
00389 DISPLAY SPACE. CHGBD207
|
||||
00390 CHGBD207
|
||||
00391 MOVE WRK-TOT-CHG TO WRK-TOT-CHG-DISP. CHGBD207
|
||||
00392 DISPLAY 'CHGBD207 TOTAL CHARGE: ' CHGBD207
|
||||
00393 WRK-TOT-CHG-DISP. CHGBD207
|
||||
00394 CHGBD207
|
||||
00395 DISPLAY '***********************************************'. CHGBD207
|
||||
00396 CHGBD207
|
||||
00397 T0000-EXIT. CHGBD207
|
||||
00398 EXIT. CHGBD207
|
||||
00399 EJECT CHGBD207
|
||||
00400 CHGBD207
|
||||
00401 S999-ABEND. CHGBD207
|
||||
00402 DISPLAY '**** CHGBD207 ABENDING ' CHGBD207
|
||||
00403 ABEND-MSG. CHGBD207
|
||||
00404 CALL ABEND-MOD USING ABEND-CODE. CHGBD207
|
||||
00405 CHGBD207
|
||||
00406 S999-EXIT. CHGBD207
|
||||
00407 EXIT. CHGBD207
|
||||
00408 CHGBD207
|
||||
Reference in New Issue
Block a user