00001 IDENTIFICATION DIVISION. 05/25/10 00002 PROGRAM-ID. CHGBR111. CHGBR111 00003 *AUTHOR. TCL. LV097 00004 *DATE-WRITTEN. JULY 1999. CHGBR111 00005 DATE-COMPILED. CHGBR111 00006 SKIP3 CHGBR111 00007 CHGBR111 00008 ***** CHGBR111 00009 * CALLING SEQUENCE: CHGBD300 CALLS CHGBR111 00010 * CHGBR111 READS CHGIM004 RECORDS CHGBR111 00011 * CHGBR111 THEN WRITES TPS-CHG-UNIV-REC CHGBR111 00012 * CHGBR111 00013 ***** CHGBR111 00014 * CHGBR111 00015 * FUNCTION: CHGBR111 00016 * CHGBR111 00017 * CREATE TPS BENEFIT CHARGE UNIVERSE RECORDS. CHGBR111 00018 * CHGBR111 00019 * RECORDS READ: CHGBR111 00020 * CHGBR111 00021 * NONE. CHGBR111 00022 * CHGBR111 00023 * INPUT: CHGBR111 00024 * CHGBR111 00025 * CHGIM002 RECORD PASSED FROM CHGBD300 CHGBR111 00026 * CHGBR111 00027 * OUTPUTS: CHGBR111 00028 * CHGBR111 00029 * RECORDS WRITTEN ON DISK - TPD-CHG-UNIV FILE CHGBR111 00030 * CHGBR111 00031 * MODULES CALLED: CHGBR111 00032 * CHGBR111 00033 * DTSBU001 DATE EDIT/CONVERSION MODULE CHGBR111 00034 * DTSBU999 ABEND MODULE CHGBR111 00035 * CHGBR111 00036 ***** CHGBR111 00037 CHGBR111 00038 ******************************************************************CHGBR111 00039 * MODIFICATION HISTORY: *CHGBR111 00040 * *CHGBR111 00041 * 07-02-1999 NEW DEVELOPMENT *CHGBR111 00042 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBR111 00043 * *CHGBR111 00044 * *CHGBR111 00045 * 05-14-2010 RECOMPILE FOR NEW VERSION OF CHGIM004 *CHGBR111 00046 * REFERENCE RFP # AUTHOR OF CHANGE - ZL1 *CHGBR111 00047 * *CHGBR111 00048 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR111 00049 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBR111 00050 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBR111 00051 ******************************************************************CHGBR111 00052 CHGBR111 00053 SKIP3 CHGBR111 00054 ENVIRONMENT DIVISION. CHGBR111 00055 SKIP3 CHGBR111 00056 INPUT-OUTPUT SECTION. CHGBR111 00057 SKIP3 CHGBR111 00058 FILE-CONTROL. CHGBR111 00059 * SELECT TPS-CHG-UNIV-FILE ASSIGN TO RPC111R1 CHGBR111 00060 SELECT TPS-CHG-UNIV-FILE ASSIGN TO TPSCHRG CHGBR111 00061 FILE STATUS IS TPS-STATUS. CHGBR111 00062 EJECT CHGBR111 00063 DATA DIVISION. CHGBR111 00064 SKIP3 CHGBR111 00065 FILE SECTION. CHGBR111 00066 SKIP3 CHGBR111 00067 FD TPS-CHG-UNIV-FILE CHGBR111 00068 RECORDING MODE IS F CHGBR111 00069 BLOCK CONTAINS 0 CHARACTERS. CHGBR111 00070 SKIP2 CHGBR111 00071 01 TPS-CHG-UNIV-REC. CHGBR111 00072 05 SEQ-NMBR PIC 9(8). CHGBR111 00073 05 REC-TYPE PIC X(5). CHGBR111 00074 05 TRANS-TYPE PIC X. CHGBR111 00075 05 SELECT-FLAG PIC X. CHGBR111 00076 05 DATE-FILE-CREATED PIC X(8). CHGBR111 00077 05 EMP-ID PIC X(12). CHGBR111 00078 05 SSN PIC 9(09). CHGBR111 00079 05 BYB-DATE PIC 9(08). CHGBR111 00080 05 CLAIM-TYPE PIC X(02). CHGBR111 00081 05 NAME PIC X(32). CHGBR111 00082 05 AMOUNT PIC 9(07)V99. CHGBR111 00083 05 STATE-OPTION PIC X(23). CHGBR111 00084 CHGBR111 00085 WORKING-STORAGE SECTION. CHGBR111 000855 77 PAN-VALET PICTURE X(24) VALUE '097CHGBR111 05/25/10'. CHGBR111 00086 CHGBR111 00087 01 CR-TPS-CHG-UNIV-REC. CHGBR111 00088 05 CR-SEQ-NMBR PIC 9(8). CHGBR111 00089 05 CR-REC-TYPE PIC X(5). CHGBR111 00090 05 CR-TRANS-TYPE PIC X. CHGBR111 00091 05 CR-SELECT-FLAG PIC X. CHGBR111 00092 05 CR-DATE-FILE-CREATED PIC X(8). CHGBR111 00093 05 CR-EMP-ID PIC X(12). CHGBR111 00094 05 CR-SSN PIC 9(09). CHGBR111 00095 05 CR-BYB-DATE PIC 9(08). CHGBR111 00096 05 CR-CLAIM-TYPE PIC X(02). CHGBR111 00097 05 CR-NAME PIC X(32). CHGBR111 00098 05 CR-AMOUNT PIC 9(07)V99. CHGBR111 00099 05 CR-STATE-OPTION PIC X(23). CHGBR111 00100 CHGBR111 00101 CHGBR111 00102 01 DB-TPS-CHG-UNIV-REC. CHGBR111 00103 05 DB-SEQ-NMBR PIC 9(8). CHGBR111 00104 05 DB-REC-TYPE PIC X(5). CHGBR111 00105 05 DB-TRANS-TYPE PIC X. CHGBR111 00106 05 DB-SELECT-FLAG PIC X. CHGBR111 00107 05 DB-DATE-FILE-CREATED PIC X(8). CHGBR111 00108 05 DB-EMP-ID PIC X(12). CHGBR111 00109 05 DB-SSN PIC 9(09). CHGBR111 00110 05 DB-BYB-DATE PIC 9(08). CHGBR111 00111 05 DB-CLAIM-TYPE PIC X(02). CHGBR111 00112 05 DB-NAME PIC X(32). CHGBR111 00113 05 DB-AMOUNT PIC 9(07)V99. CHGBR111 00114 05 DB-STATE-OPTION PIC X(23). CHGBR111 00115 CHGBR111 00116 CHGBR111 00117 01 WRK-AREA. CHGBR111 00118 CHGBR111 00119 05 WRK-ACCT-SW PIC X VALUE SPACE. CHGBR111 00120 CHGBR111 00121 05 WRK-HOLD-ACCT-NUM PIC 9(7) COMP-3 VALUE ZEROS. CHGBR111 00122 CHGBR111 00123 05 ABEND-CODE PIC S9(04) COMP CHGBR111 00124 VALUE +111. CHGBR111 00125 05 ABEND-MSG PIC X(60). CHGBR111 00126 CHGBR111 00127 05 WRK-FIRST-TIME-IND PIC X(01) VALUE 'Y'. CHGBR111 00128 88 WRK-FIRST-TIME-YES-88 VALUE 'Y'. CHGBR111 00129 88 WRK-FIRST-TIME-NO-88 VALUE 'N'. CHGBR111 00130 CHGBR111 00131 05 WRK-ERROR-IND PIC X(01). CHGBR111 00132 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBR111 00133 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBR111 00134 CHGBR111 00135 05 TPS-STATUS PIC X(02). CHGBR111 00136 88 TPS-STATUS-OK-88 VALUE '00'. CHGBR111 00137 CHGBR111 00138 05 WRK-EMP-NO-AREA PIC X(12). CHGBR111 00139 05 FILLER REDEFINES WRK-EMP-NO-AREA. CHGBR111 00140 10 WRK-EMP-FILLER PIC X(06). CHGBR111 00141 10 WRK-EMP-NO PIC 9(06). CHGBR111 00142 CHGBR111 00143 05 WRK-CURR-DATE PIC 9(08). CHGBR111 00144 05 WRK-CURR-SSN PIC 9(09). CHGBR111 00145 05 WRK-CURR-BYE PIC S9(09) COMP-3. CHGBR111 00146 05 WRK-CURR-EMP PIC S9(07) COMP-3. CHGBR111 00147 05 WRK-CHG-AMT PIC 9(07).99-. CHGBR111 00148 05 TPS-RECS-COUNT PIC S9(07) COMP-3 VALUE 0. CHGBR111 00149 CHGBR111 00150 01 L001-LINK-AREA. CHGBR111 00151 ++INCLUDE DTSIL001 CHGBR111 00152 CHGBR111 00153 EJECT CHGBR111 00154 LINKAGE SECTION. CHGBR111 00155 01 REPORT-LINK-AREA. CHGBR111 00156 ++INCLUDE CHGIL001 CHGBR111 00157 CHGBR111 00158 01 BD210-CHG-REC. CHGBR111 00159 ++INCLUDE CHGIM004 CHGBR111 00160 CHGBR111 00161 PROCEDURE DIVISION USING REPORT-LINK-AREA CHGBR111 00162 BD210-CHG-REC. CHGBR111 00163 SKIP2 CHGBR111 00164 CHGBR111-MAIN. CHGBR111 00165 CHGBR111 00166 SET WRK-ERROR-NO-88 TO TRUE. CHGBR111 00167 CHGBR111 00168 IF CHG-LINK1-CMD-INIT-88 CHGBR111 00169 PERFORM I0000-INITIATE THRU I0000-EXIT CHGBR111 00170 ELSE CHGBR111 00171 IF CHG-LINK1-CMD-PROCESS-88 CHGBR111 00172 PERFORM P0000-PROCESS THRU P0000-EXIT CHGBR111 00173 ELSE CHGBR111 00174 IF CHG-LINK1-CMD-CLOSE-88 CHGBR111 00175 PERFORM T0000-TERMINATE THRU T0000-EXIT CHGBR111 00176 ELSE CHGBR111 00177 DISPLAY 'CHGBR111 ABENDING: INVALID COMMAND ' CHGBR111 00178 CHG-LINK1-COMMAND CHGBR111 00179 PERFORM S999-ABEND THRU S999-EXIT. CHGBR111 00180 CHGBR111 00181 CHGBR111-EXIT. CHGBR111 00182 GOBACK. CHGBR111 00183 EJECT CHGBR111 00184 I0000-INITIATE. CHGBR111 00185 MOVE ZERO TO WRK-CURR-EMP, WRK-HOLD-ACCT-NUM CHGBR111 00186 WRK-CURR-SSN CHGBR111 00187 WRK-CURR-BYE. CHGBR111 00188 CHGBR111 00189 ACCEPT L001-FED-6-DATE-X FROM DATE. CHGBR111 00190 PERFORM S001-FROM-FED-6 THRU S001-EXIT. CHGBR111 00191 IF NOT L001-VALID-DATE CHGBR111 00192 DISPLAY 'INVALID DATE ' L001-FED-8-DATE-9 CHGBR111 00193 ELSE CHGBR111 00194 DISPLAY 'VALID DATE ' L001-FED-8-DATE-9. CHGBR111 00195 MOVE L001-FED-8-DATE-9 TO WRK-CURR-DATE. CHGBR111 00196 CHGBR111 00197 OPEN OUTPUT TPS-CHG-UNIV-FILE. CHGBR111 00198 IF NOT TPS-STATUS-OK-88 CHGBR111 00199 DISPLAY 'CHGBR111: CANNOT OPEN TPS FILE ' CHGBR111 00200 TPS-STATUS CHGBR111 00201 PERFORM S999-ABEND THRU S999-EXIT CHGBR111 00202 GO TO I0000-EXIT. CHGBR111 00203 CHGBR111 00204 INITIALIZE TPS-CHG-UNIV-REC, CR-TPS-CHG-UNIV-REC CHGBR111 00205 DB-TPS-CHG-UNIV-REC. CHGBR111 00206 I0000-EXIT. CHGBR111 00207 EXIT. CHGBR111 00208 CHGBR111 00209 P0000-PROCESS. CHGBR111 00210 CHGBR111 00211 COMPUTE WRK-CHG-AMT = CHG4-CURR-BEN-AMT + CHGBR111 00212 CHG4-CURR-ADJ-AMT. CHGBR111 00213 CHGBR111 00214 IF WRK-CHG-AMT = ZERO CHGBR111 00215 GO TO P0000-EXIT. CHGBR111 00216 CHGBR111 00217 IF WRK-ACCT-SW = SPACE CHGBR111 00218 MOVE 1 TO WRK-ACCT-SW CHGBR111 00219 MOVE CHG4-EMP-NO TO WRK-HOLD-ACCT-NUM CHGBR111 00220 PERFORM P0001-CREDIT THRU P0002-EXIT CHGBR111 00221 PERFORM P0002-DEBIT THRU P0002-EXIT CHGBR111 00222 GO TO P0000-EXIT. CHGBR111 00223 CHGBR111 00224 IF CHG4-EMP-NO = WRK-HOLD-ACCT-NUM CHGBR111 00225 MOVE CHG4-EMP-NO TO WRK-HOLD-ACCT-NUM CHGBR111 00226 PERFORM P0001-CREDIT THRU P0002-EXIT CHGBR111 00227 PERFORM P0002-DEBIT THRU P0002-EXIT CHGBR111 00228 GO TO P0000-EXIT. CHGBR111 00229 CHGBR111 00230 IF CHG4-EMP-NO > WRK-HOLD-ACCT-NUM CHGBR111 00231 MOVE CHG4-EMP-NO TO WRK-HOLD-ACCT-NUM CHGBR111 00232 PERFORM P0003-CR-WRITE-TPS THRU P0003-EXIT CHGBR111 00233 PERFORM P0004-DB-WRITE-TPS THRU P0004-EXIT CHGBR111 00234 PERFORM P0001-CREDIT THRU P0001-EXIT CHGBR111 00235 PERFORM P0002-DEBIT THRU P0002-EXIT CHGBR111 00236 GO TO P0000-EXIT. CHGBR111 00237 CHGBR111 00238 P0000-EXIT. CHGBR111 00239 EXIT. CHGBR111 00240 CHGBR111 00241 P0001-CREDIT. CHGBR111 00242 CHGBR111 00243 IF WRK-CHG-AMT < ZERO CHGBR111 00244 NEXT SENTENCE CHGBR111 00245 ELSE CHGBR111 00246 GO TO P0001-EXIT. CHGBR111 00247 CHGBR111 00248 MOVE ZERO TO CR-SEQ-NMBR. CHGBR111 00249 MOVE CHG4-SSN TO CR-SSN. CHGBR111 00250 MOVE CHG4-BYE TO CR-BYB-DATE. CHGBR111 00251 COMPUTE WRK-CHG-AMT = CHG4-CURR-BEN-AMT + CHGBR111 00252 CHG4-CURR-ADJ-AMT CHGBR111 00253 MOVE WRK-CHG-AMT TO CR-AMOUNT. CHGBR111 00254 CHGBR111 00255 MOVE SPACES TO CR-CLAIM-TYPE. CHGBR111 00256 MOVE CHG4-CLMNT-NAME TO CR-NAME CHGBR111 00257 MOVE SPACES TO CR-STATE-OPTION. CHGBR111 00258 CHGBR111 00259 MOVE 'CS044' TO CR-REC-TYPE. CHGBR111 00260 MOVE '1' TO CR-TRANS-TYPE CHGBR111 00261 CR-SELECT-FLAG. CHGBR111 00262 CHGBR111 00263 MOVE WRK-CURR-DATE TO CR-DATE-FILE-CREATED. CHGBR111 00264 MOVE SPACES TO WRK-EMP-FILLER. CHGBR111 00265 MOVE CHG4-EMP-NO TO WRK-EMP-NO. CHGBR111 00266 MOVE WRK-EMP-NO-AREA TO CR-EMP-ID. CHGBR111 00267 CHGBR111 00268 P0001-EXIT. CHGBR111 00269 EXIT. CHGBR111 00270 CHGBR111 00271 P0002-DEBIT. CHGBR111 00272 CHGBR111 00273 IF WRK-CHG-AMT > ZERO CHGBR111 00274 NEXT SENTENCE CHGBR111 00275 ELSE CHGBR111 00276 GO TO P0002-EXIT. CHGBR111 00277 CHGBR111 00278 MOVE ZERO TO CR-SEQ-NMBR. CHGBR111 00279 MOVE CHG4-SSN TO DB-SSN. CHGBR111 00280 MOVE CHG4-BYE TO DB-BYB-DATE. CHGBR111 00281 COMPUTE WRK-CHG-AMT = CHG4-CURR-BEN-AMT + CHGBR111 00282 CHG4-CURR-ADJ-AMT. CHGBR111 00283 MOVE WRK-CHG-AMT TO DB-AMOUNT. CHGBR111 00284 CHGBR111 00285 MOVE SPACES TO DB-CLAIM-TYPE CHGBR111 00286 MOVE CHG4-CLMNT-NAME TO DB-NAME. CHGBR111 00287 MOVE SPACES TO DB-STATE-OPTION. CHGBR111 00288 CHGBR111 00289 MOVE 'CS044' TO DB-REC-TYPE. CHGBR111 00290 MOVE '1' TO DB-TRANS-TYPE CHGBR111 00291 DB-SELECT-FLAG. CHGBR111 00292 CHGBR111 00293 MOVE WRK-CURR-DATE TO DB-DATE-FILE-CREATED. CHGBR111 00294 MOVE SPACES TO WRK-EMP-FILLER. CHGBR111 00295 MOVE CHG4-EMP-NO TO WRK-EMP-NO. CHGBR111 00296 MOVE WRK-EMP-NO-AREA TO DB-EMP-ID. CHGBR111 00297 CHGBR111 00298 P0002-EXIT. CHGBR111 00299 EXIT. CHGBR111 00300 CHGBR111 00301 P0003-CR-WRITE-TPS. CHGBR111 00302 CHGBR111 00303 IF CR-SSN > ZERO CHGBR111 00304 ADD 1 TO TPS-RECS-COUNT CHGBR111 00305 WRITE TPS-CHG-UNIV-REC FROM CR-TPS-CHG-UNIV-REC CHGBR111 00306 PERFORM P1000-INIT-TPS-REC THRU P1000-EXIT. CHGBR111 00307 CHGBR111 00308 P0003-EXIT. CHGBR111 00309 EXIT. CHGBR111 00310 CHGBR111 00311 P0004-DB-WRITE-TPS. CHGBR111 00312 CHGBR111 00313 IF DB-SSN > ZERO CHGBR111 00314 ADD 1 TO TPS-RECS-COUNT CHGBR111 00315 WRITE TPS-CHG-UNIV-REC FROM DB-TPS-CHG-UNIV-REC CHGBR111 00316 PERFORM P1000-INIT-TPS-REC THRU P1000-EXIT. CHGBR111 00317 CHGBR111 00318 P0004-EXIT. CHGBR111 00319 EXIT. CHGBR111 00320 CHGBR111 00321 P1000-INIT-TPS-REC. CHGBR111 00322 CHGBR111 00323 MOVE ZERO TO SEQ-NMBR, CR-SEQ-NMBR, DB-SEQ-NMBR CHGBR111 00324 SSN, CR-SSN, DB-SSN CHGBR111 00325 BYB-DATE, CR-BYB-DATE CHGBR111 00326 AMOUNT, CR-AMOUNT, DB-AMOUNT. CHGBR111 00327 CHGBR111 00328 MOVE SPACES TO CLAIM-TYPE, CR-CLAIM-TYPE, DB-CLAIM-TYPE CHGBR111 00329 NAME, CR-NAME, DB-NAME CHGBR111 00330 STATE-OPTION, CR-STATE-OPTION, DB-STATE-OPTIONCHGBR111 00331 CHGBR111 00332 MOVE 'CS044' TO REC-TYPE, CR-REC-TYPE, DB-REC-TYPE. CHGBR111 00333 MOVE '1' TO TRANS-TYPE, CR-TRANS-TYPE, DB-TRANS-TYPE CHGBR111 00334 SELECT-FLAG, CR-SELECT-FLAG, DB-SELECT-FLAG. CHGBR111 00335 CHGBR111 00336 MOVE WRK-CURR-DATE TO CR-DATE-FILE-CREATED CHGBR111 00337 DB-DATE-FILE-CREATED. CHGBR111 00338 CHGBR111 00339 MOVE SPACES TO WRK-EMP-FILLER. CHGBR111 00340 * MOVE CHG4-EMP-NO TO WRK-EMP-NO. CHGBR111 00341 CHGBR111 00342 P1000-EXIT. CHGBR111 00343 EXIT. CHGBR111 00344 CHGBR111 00345 *P2000-SUM-CHARGES. CHGBR111 00346 *P2000-EXIT. CHGBR111 00347 * EXIT. CHGBR111 00348 CHGBR111 00349 T0000-TERMINATE. CHGBR111 00350 PERFORM P0003-CR-WRITE-TPS THRU P0003-EXIT. CHGBR111 00351 PERFORM P0004-DB-WRITE-TPS THRU P0004-EXIT. CHGBR111 00352 DISPLAY 'BR111 TERMINATE'. CHGBR111 00353 DISPLAY 'TPS RECS WRITTEN = ' TPS-RECS-COUNT. CHGBR111 00354 CLOSE TPS-CHG-UNIV-FILE. CHGBR111 00355 T0000-EXIT. CHGBR111 00356 EXIT. CHGBR111 00357 EJECT CHGBR111 00358 CHGBR111 00359 CHGBR111 00360 S1000-WRITE-TPS-REC. CHGBR111 00361 WRITE TPS-CHG-UNIV-REC. CHGBR111 00362 ADD 1 TO TPS-RECS-COUNT. CHGBR111 00363 CHGBR111 00364 S1000-EXIT. CHGBR111 00365 EXIT. CHGBR111 00366 CHGBR111 00367 S001-FROM-FED-6. CHGBR111 00368 SET L001-FROM-FED-6 TO TRUE. CHGBR111 00369 GO TO S001-DATE. CHGBR111 00370 CHGBR111 00371 S001-DATE. CHGBR111 00372 CALL 'DTSBU001' USING L001-LINK-AREA. CHGBR111 00373 S001-EXIT. EXIT. CHGBR111 00374 CHGBR111 00375 S999-ABEND. CHGBR111 00376 DISPLAY '**** CHGBR111 ABENDING ' CHGBR111 00377 ABEND-MSG. CHGBR111 00378 *& ABEND COMMENTED OUT FOR TESTING CHGBR111 00379 CALL 'DTSBU999' USING ABEND-CODE. CHGBR111 00380 SET WRK-ERROR-YES-88 TO TRUE. CHGBR111 00381 S999-EXIT. CHGBR111 00382 EXIT. CHGBR111