00001 IDENTIFICATION DIVISION. 06/29/02 00002 PROGRAM-ID. DTSBD370. DTSBD370 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV007 00004 DATE-WRITTEN. JANUARY 1991. DTSBD370 00005 DATE-COMPILED. DTSBD370 00006 SKIP3 DTSBD370 00007 ***** DTSBD370 00008 * DTSBD370 00009 * FUNCTION: ACCOUNTING TRANSACTION PROCESSING DRIVER. DTSBD370 00010 * DTSBD370 00011 * DTSBD370 00012 * MODIFICATION LOG: DTSBD370 00013 * DTSBD370 00014 * 01/25/92 INITIAL DEVELOPMENT. DTSBD370 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD370 00016 * DTSBD370 00017 * 12/13/1998 REVIEWED AND MODIFIED FOR DC. DTSBD370 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD370 00019 * DTSBD370 00020 * 01/28/2002 MODIFIED FOR ANNUAL REPORT (AATX) TRANSACTION DTSBD370 00021 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD370 00022 * DTSBD370 00023 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD370 00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD370 00025 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD370 00026 * DTSBD370 00027 * DTSBD370 00028 * DESCRIPTION: DTSBD370 00029 * DTSBD370 00030 * DRIVES THE PROCESSING OF ACCOUNTING TRANSACTIONS. DTSBD370 00031 * DTSBD370 00032 * DTSBD370 00033 * MASTER FILE RECORDS READ: DTSBD370 00034 * DTSBD370 00035 * NONE. DTSBD370 00036 * DTSBD370 00037 * DTSBD370 00038 * MASTER FILE RECORDS UPDATED: DTSBD370 00039 * DTSBD370 00040 * NONE. DTSBD370 00041 * DTSBD370 00042 * DTSBD370 00043 * REPORT RECORDS WRITTEN: DTSBD370 00044 * DTSBD370 00045 * NONE. DTSBD370 00046 * DTSBD370 00047 * DTSBD370 00048 * MODULES CALLED: DTSBD370 00049 * DTSBD370 00050 * DTSBD371 REPORT TRANSACTION PROCESSING. DTSBD370 00051 * DTSBD372 PAYMENT TRANSACTION PROCESSING. DTSBD370 00052 * DTSBD373 ADJUSTMENT TRANSACTION PROCESSING. DTSBD370 00053 * DTSBU549 JOURNALING/BATCH DETAIL LISTING. DTSBD370 00054 * DTSBD370 00055 ***** DTSBD370 00056 SKIP3 DTSBD370 00057 ENVIRONMENT DIVISION. DTSBD370 00058 EJECT DTSBD370 00059 DATA DIVISION. DTSBD370 00060 SKIP3 DTSBD370 00061 WORKING-STORAGE SECTION. DTSBD370 000615 77 PAN-VALET PICTURE X(24) VALUE '007DTSBD370 06/29/02'. DTSBD370 00062 SKIP3 DTSBD370 00063 01 WRK-AREA. DTSBD370 00064 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +370.DTSBD370 00065 EJECT DTSBD370 00066 01 L549-LINK-AREA. DTSBD370 00067 ++INCLUDE DTSIL549 DTSBD370 00068 EJECT DTSBD370 00069 01 MSG-TABLE. DTSBD370 00070 05 MSG1-INVALID-TRN-CD. DTSBD370 00071 10 MSG1-ID PIC X(11) VALUE 'DTSBD370905'. DTSBD370 00072 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INVALID TRN CD'. DTSBD370 00073 10 MSG1-LONG-TEXT. DTSBD370 00074 15 FILLER PIC X(30) DTSBD370 00075 VALUE 'TRANSACTION FAILED - TRANSACTI'. DTSBD370 00076 15 FILLER PIC X(30) DTSBD370 00077 VALUE 'ON CODE NOT VALID '. DTSBD370 00078 DTSBD370 00079 05 MSG2-CHARGING-ONLY. DTSBD370 00080 10 MSG2-ID PIC X(11) VALUE 'DTSBD370301'. DTSBD370 00081 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'CHARGING ONLY '. DTSBD370 00082 10 MSG2-LONG-TEXT. DTSBD370 00083 15 FILLER PIC X(30) DTSBD370 00084 VALUE 'TRANSACTION FAILED - ACCOUNTIN'. DTSBD370 00085 15 FILLER PIC X(30) DTSBD370 00086 VALUE 'G TRAN FOR CHRG ONLY EMPLOYER '. DTSBD370 00087 DTSBD370 00088 05 MSG3-WRITTEN-OFF. DTSBD370 00089 10 MSG3-ID PIC X(11) VALUE 'DTSBD370302'. DTSBD370 00090 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'WRITTEN OFF EMP'. DTSBD370 00091 10 MSG3-LONG-TEXT. DTSBD370 00092 15 FILLER PIC X(30) DTSBD370 00093 VALUE 'TRANSACTION FAILED - NOT A VAL'. DTSBD370 00094 15 FILLER PIC X(30) DTSBD370 00095 VALUE 'ID TRAN FOR A WRITTEN OFF EMPL'. DTSBD370 00096 DTSBD370 00097 05 MSG4-NEVER-SUBJECT. DTSBD370 00098 10 MSG4-ID PIC X(11) VALUE 'DTSBD370303'. DTSBD370 00099 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'NEVER SUBJ EMP'. DTSBD370 00100 10 MSG4-LONG-TEXT. DTSBD370 00101 15 FILLER PIC X(30) DTSBD370 00102 VALUE 'TRANSACTION FAILED - NOT A VAL'. DTSBD370 00103 15 FILLER PIC X(30) DTSBD370 00104 VALUE 'ID TRAN FOR NEVER SUBJECT EMPL'. DTSBD370 00105 EJECT DTSBD370 00106 LINKAGE SECTION. DTSBD370 00107 SKIP3 DTSBD370 00108 01 LBCM-LINK-AREA. DTSBD370 00109 ++INCLUDE DTSILBCM DTSBD370 00110 EJECT DTSBD370 00111 01 MPRF-REC. DTSBD370 00112 ++INCLUDE DTSIMPRF DTSBD370 00113 EJECT DTSBD370 00114 01 T051-REC. DTSBD370 00115 ++INCLUDE DTSIT051 DTSBD370 00116 SKIP3 DTSBD370 00117 05 ASKL-REC REDEFINES T051-DATA-AREA. DTSBD370 00118 ++INCLUDE DTSIASKL DTSBD370 00119 SKIP3 DTSBD370 00120 05 ARPT-REC REDEFINES T051-DATA-AREA. DTSBD370 00121 ++INCLUDE DTSIARPT DTSBD370 00122 SKIP3 DTSBD370 00123 05 APAY-REC REDEFINES T051-DATA-AREA. DTSBD370 00124 ++INCLUDE DTSIAPAY DTSBD370 00125 SKIP3 DTSBD370 00126 05 AADJ-REC REDEFINES T051-DATA-AREA. DTSBD370 00127 ++INCLUDE DTSIAADJ DTSBD370 00128 SKIP3 DTSBD370 00129 05 AATX-REC REDEFINES T051-DATA-AREA. DTSBD370 00130 ++INCLUDE DTSIAATX DTSBD370 00131 EJECT DTSBD370 00132 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD370 00133 MPRF-REC DTSBD370 00134 T051-REC. DTSBD370 00135 DTSBD370 00136 DTSBD370 00137 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD370 00138 DTSBD370 00139 DTSBD370 00140 GOBACK. DTSBD370 00141 EJECT DTSBD370 00142 P0000-PROCESS. DTSBD370 00143 IF ASKL-RPT-88 DTSBD370 00144 IF ARPT-NAME-CHECK = LOW-VALUES OR SPACES DTSBD370 00145 MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK DTSBD370 00146 ELSE DTSBD370 00147 NEXT SENTENCE DTSBD370 00148 ELSE DTSBD370 00149 IF ASKL-PAY-88 DTSBD370 00150 IF APAY-NAME-CHECK = LOW-VALUES OR SPACES DTSBD370 00151 MOVE MPRF-PRIMARY-NAME TO APAY-NAME-CHECK DTSBD370 00152 ELSE DTSBD370 00153 NEXT SENTENCE DTSBD370 00154 ELSE DTSBD370 00155 IF ASKL-ADJ-88 DTSBD370 00156 IF AADJ-NAME-CHECK = LOW-VALUES OR SPACES DTSBD370 00157 MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK DTSBD370 00158 ELSE DTSBD370 00159 NEXT SENTENCE DTSBD370 00160 ELSE DTSBD370 00161 IF ASKL-ATX-88 DTSBD370 00162 IF AATX-NAME-CHECK = LOW-VALUES OR SPACES DTSBD370 00163 MOVE MPRF-PRIMARY-NAME TO AATX-NAME-CHECK DTSBD370 00164 ELSE DTSBD370 00165 NEXT SENTENCE DTSBD370 00166 ELSE DTSBD370 00167 NEXT SENTENCE. DTSBD370 00168 DTSBD370 00169 PERFORM P1000-MJRN-TABLE-INIT THRU P1000-EXIT. DTSBD370 00170 DTSBD370 00171 IF MPRF-CLASS-CHG-ONLY-88 DTSBD370 00172 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD370 00173 MOVE MSG2-CHARGING-ONLY TO LBCM-TRN-MSG-AREA DTSBD370 00174 PERFORM S549-CANCEL-TRAN THRU S549-EXIT DTSBD370 00175 GO TO P0000-EXIT. DTSBD370 00176 DTSBD370 00177 IF MPRF-NOT-WRITTEN-OFF-88 DTSBD370 00178 NEXT SENTENCE DTSBD370 00179 ELSE DTSBD370 00180 IF (ASKL-PAY-88) AND (APAY-PAYMENT-88) DTSBD370 00181 NEXT SENTENCE DTSBD370 00182 ELSE DTSBD370 00183 IF (ASKL-ADJ-88) AND (AADJ-WRITE-OFF-REV-88) DTSBD370 00184 NEXT SENTENCE DTSBD370 00185 ELSE DTSBD370 00186 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD370 00187 MOVE MSG3-WRITTEN-OFF TO LBCM-TRN-MSG-AREA DTSBD370 00188 PERFORM S549-CANCEL-TRAN THRU S549-EXIT DTSBD370 00189 GO TO P0000-EXIT. DTSBD370 00190 DTSBD370 00191 IF MPRF-CLASS-UNK-88 DTSBD370 00192 IF ASKL-PAY-88 DTSBD370 00193 NEXT SENTENCE DTSBD370 00194 ELSE DTSBD370 00195 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD370 00196 MOVE MSG4-NEVER-SUBJECT TO LBCM-TRN-MSG-AREA DTSBD370 00197 PERFORM S549-CANCEL-TRAN THRU S549-EXIT DTSBD370 00198 GO TO P0000-EXIT. DTSBD370 00199 DTSBD370 00200 IF ASKL-RPT-88 DTSBD370 00201 CALL 'DTSBD371' USING LBCM-LINK-AREA DTSBD370 00202 MPRF-REC DTSBD370 00203 ARPT-REC DTSBD370 00204 ELSE DTSBD370 00205 IF ASKL-PAY-88 DTSBD370 00206 CALL 'DTSBD372' USING LBCM-LINK-AREA DTSBD370 00207 MPRF-REC DTSBD370 00208 APAY-REC DTSBD370 00209 ELSE DTSBD370 00210 IF ASKL-ADJ-88 DTSBD370 00211 CALL 'DTSBD373' USING LBCM-LINK-AREA DTSBD370 00212 MPRF-REC DTSBD370 00213 AADJ-REC DTSBD370 00214 ELSE DTSBD370 00215 IF ASKL-ATX-88 DTSBD370 00216 CALL 'DTSBD374' USING LBCM-LINK-AREA DTSBD370 00217 MPRF-REC DTSBD370 00218 AATX-REC DTSBD370 00219 GO TO P0000-EXIT DTSBD370 00220 ELSE DTSBD370 00221 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD370 00222 MOVE MSG1-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA DTSBD370 00223 PERFORM S549-CANCEL-TRAN THRU S549-EXIT DTSBD370 00224 GO TO P0000-EXIT. DTSBD370 00225 DTSBD370 00226 *& IF ASKL-ATX-88 DTSBD370 00227 * NEXT SENTENCE DTSBD370 00228 * ELSE DTSBD370 00229 IF LBCM-TRN-OK-88 DTSBD370 00230 PERFORM S549-TERM-TRAN-PRIM THRU S549-EXIT DTSBD370 00231 ELSE DTSBD370 00232 PERFORM S549-CANCEL-TRAN THRU S549-EXIT. DTSBD370 00233 P0000-EXIT. DTSBD370 00234 EXIT. DTSBD370 00235 EJECT DTSBD370 00236 ***************************************************************** DTSBD370 00237 * NOTE: FOR ANNUAL REPORT TRANSACTIONS (DTSIAATX), THE DTSBD370 00238 * INITIALIZATION OF THE JOURNAL RECORD UTILITY DTSBD370 00239 * (DTSBU549) TAKES PLACE IN DTSBD374 RATHER THAN HERE. DTSBD370 00240 * DTSBD374 PROCESSES EACH QUARTER COVERED BY THE DTSBD370 00241 * ANNUAL REPORT SEPARATELY, AND HANDLES ALL CALLS TO DTSBD370 00242 * DTSBU549. DTSBD370 00243 ***************************************************************** DTSBD370 00244 P1000-MJRN-TABLE-INIT. DTSBD370 00245 MOVE ASKL-DOC-NO TO L549-TRN-DOC-NO. DTSBD370 00246 DTSBD370 00247 MOVE LBCM-TRACE-IND TO L549-INIT-TRACE-IND. DTSBD370 00248 DTSBD370 00249 MOVE LBCM-CURR-RUN-DATE TO L549-INIT-CURR-RUN-DATE. DTSBD370 00250 DTSBD370 00251 MOVE LBCM-EMP-ABSTIME TO L549-INIT-ABSTIME. DTSBD370 00252 DTSBD370 00253 MOVE MPRF-EMP-NO TO L549-INIT-EMP-NO. DTSBD370 00254 DTSBD370 00255 MOVE MPRF-EMP-CLASS TO L549-INIT-EMP-CLASS. DTSBD370 00256 DTSBD370 00257 MOVE MPRF-ELIGIBLE-CD TO L549-INIT-ELIGIBLE-CD. DTSBD370 00258 DTSBD370 00259 IF ASKL-RPT-88 DTSBD370 00260 MOVE ARPT-REC-TYPE TO L549-INIT-REC-TYPE DTSBD370 00261 MOVE ARPT-RPT-TYPE TO L549-INIT-TRANS-TYPE DTSBD370 00262 MOVE ARPT-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE DTSBD370 00263 MOVE ARPT-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE DTSBD370 00264 MOVE ARPT-REMIT-AMT TO L549-INIT-REMIT-AMT DTSBD370 00265 IF ARPT-WAIVE-BOTH-YES-88 DTSBD370 00266 MOVE ARPT-WAIVE-BOTH-IND TO ARPT-WAIVE-INT-IND DTSBD370 00267 ARPT-WAIVE-LATE-PEN-IND DTSBD370 00268 SET ARPT-WAIVE-BOTH-NO-88 TO TRUE DTSBD370 00269 END-IF DTSBD370 00270 MOVE ARPT-WAIVE-INT-IND DTSBD370 00271 TO L549-INIT-WAIVE-INT-IND DTSBD370 00272 MOVE ARPT-WAIVE-LATE-PEN-IND DTSBD370 00273 TO L549-INIT-WAIVE-LATE-PEN-IND DTSBD370 00274 MOVE ARPT-YRQ TO L549-INIT-APPLIC-YRQ DTSBD370 00275 MOVE SPACE TO L549-INIT-APPLIC-ACCT-IND DTSBD370 00276 MOVE +0 TO L549-INIT-APPLIC-BATCH-NO DTSBD370 00277 L549-INIT-APPLIC-ITEM-NO DTSBD370 00278 MOVE ARPT-RESPONSIBLE-ACTIVITY DTSBD370 00279 TO L549-INIT-RESP-ACTIVITY DTSBD370 00280 MOVE ARPT-RESPONSIBLE-OP-ID DTSBD370 00281 TO L549-INIT-RESP-OP-ID DTSBD370 00282 ELSE DTSBD370 00283 IF ASKL-ATX-88 DTSBD370 00284 GO TO P1000-EXIT DTSBD370 00285 ELSE DTSBD370 00286 IF ASKL-PAY-88 DTSBD370 00287 MOVE APAY-REC-TYPE TO L549-INIT-REC-TYPE DTSBD370 00288 MOVE APAY-PAY-TYPE TO L549-INIT-TRANS-TYPE DTSBD370 00289 MOVE APAY-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE DTSBD370 00290 MOVE APAY-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE DTSBD370 00291 MOVE APAY-REMIT-AMT TO L549-INIT-REMIT-AMT DTSBD370 00292 *********IF APAY-WAIVE-BOTH-88 DTSBD370 00293 *************MOVE APAY-WAIVE-BOTH-IND TO APAY-WAIVE-INT-IND DTSBD370 00294 *****************************************APAY-WAIVE-LATE-PEN-IND DTSBD370 00295 *************SET APAY-NOT-WAIVE-BOTH-88 TO TRUE DTSBD370 00296 *********END-IF DTSBD370 00297 MOVE APAY-WAIVE-INT-IND DTSBD370 00298 TO L549-INIT-WAIVE-INT-IND DTSBD370 00299 MOVE APAY-WAIVE-LATE-PEN-IND DTSBD370 00300 TO L549-INIT-WAIVE-LATE-PEN-IND DTSBD370 00301 MOVE APAY-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ DTSBD370 00302 MOVE APAY-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND DTSBD370 00303 MOVE APAY-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO DTSBD370 00304 MOVE APAY-RESPONSIBLE-ACTIVITY DTSBD370 00305 TO L549-INIT-RESP-ACTIVITY DTSBD370 00306 MOVE APAY-RESPONSIBLE-OP-ID DTSBD370 00307 TO L549-INIT-RESP-OP-ID DTSBD370 00308 ELSE DTSBD370 00309 IF ASKL-ADJ-88 DTSBD370 00310 MOVE AADJ-REC-TYPE TO L549-INIT-REC-TYPE DTSBD370 00311 MOVE AADJ-ADJ-TYPE TO L549-INIT-TRANS-TYPE DTSBD370 00312 MOVE AADJ-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE DTSBD370 00313 MOVE AADJ-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE DTSBD370 00314 MOVE +0 TO L549-INIT-REMIT-AMT DTSBD370 00315 MOVE SPACE TO L549-INIT-WAIVE-INT-IND DTSBD370 00316 L549-INIT-WAIVE-LATE-PEN-IND DTSBD370 00317 MOVE AADJ-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ DTSBD370 00318 MOVE AADJ-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND DTSBD370 00319 MOVE AADJ-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO DTSBD370 00320 MOVE AADJ-RESPONSIBLE-ACTIVITY DTSBD370 00321 TO L549-INIT-RESP-ACTIVITY DTSBD370 00322 MOVE AADJ-RESPONSIBLE-OP-ID DTSBD370 00323 TO L549-INIT-RESP-OP-ID DTSBD370 00324 ELSE DTSBD370 00325 MOVE SPACE TO L549-INIT-REC-TYPE DTSBD370 00326 MOVE SPACE TO L549-INIT-TRANS-TYPE DTSBD370 00327 MOVE +0 TO L549-INIT-RECEIVED-DATE DTSBD370 00328 MOVE +0 TO L549-INIT-DEPOSIT-DATE DTSBD370 00329 MOVE +0 TO L549-INIT-REMIT-AMT DTSBD370 00330 MOVE SPACE TO L549-INIT-WAIVE-INT-IND DTSBD370 00331 L549-INIT-WAIVE-LATE-PEN-IND DTSBD370 00332 MOVE +0 TO L549-INIT-APPLIC-YRQ DTSBD370 00333 MOVE SPACE TO L549-INIT-APPLIC-ACCT-IND DTSBD370 00334 MOVE +0 TO L549-INIT-APPLIC-DOC-NO DTSBD370 00335 L549-INIT-APPLIC-ITEM-NO DTSBD370 00336 MOVE SPACE TO L549-INIT-RESP-ACTIVITY DTSBD370 00337 L549-INIT-RESP-OP-ID. DTSBD370 00338 DTSBD370 00339 PERFORM S549-INIT-TRAN THRU S549-EXIT. DTSBD370 00340 P1000-EXIT. DTSBD370 00341 EXIT. DTSBD370 00342 EJECT DTSBD370 00343 S549-INIT-TRAN. DTSBD370 00344 SET L549-INIT-TRAN-88 TO TRUE. DTSBD370 00345 GO TO S549-MJRN-TABLE. DTSBD370 00346 DTSBD370 00347 S549-CANCEL-TRAN. DTSBD370 00348 SET L549-CANCEL-TRAN-88 TO TRUE. DTSBD370 00349 GO TO S549-MJRN-TABLE. DTSBD370 00350 DTSBD370 00351 S549-TERM-TRAN-PRIM. DTSBD370 00352 SET L549-TERM-TRAN-PRIM-88 TO TRUE. DTSBD370 00353 GO TO S549-MJRN-TABLE. DTSBD370 00354 DTSBD370 00355 S549-MJRN-TABLE. DTSBD370 00356 CALL 'DTSBU549' USING L549-LINK-AREA. DTSBD370 00357 S549-EXIT. DTSBD370 00358 EXIT. DTSBD370 00359 SKIP3 DTSBD370 00360 S999-ABEND. DTSBD370 00361 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD370 00362 S999-EXIT. DTSBD370 00363 EXIT. DTSBD370