MP Batchs, copybooks, jcls, Procs
This commit is contained in:
931
Batch/EFTBD120.cob
Normal file
931
Batch/EFTBD120.cob
Normal file
@ -0,0 +1,931 @@
|
||||
00001 IDENTIFICATION DIVISION. 03/18/04
|
||||
00002 PROGRAM-ID. EFTBD120. EFTBD120
|
||||
00003 AUTHOR. NORTHROP GRUMMAN. LV147
|
||||
00004 DATE-WRITTEN. JULY 2003. CL168
|
||||
00005 DATE-COMPILED. CL146
|
||||
00006 SKIP3 CL146
|
||||
00007 ***** CL146
|
||||
00008 * CL146
|
||||
00009 * FUNCTION: 1. THIS PROGRAM PROCESSES STATUS UPDATE RECORDS CL198
|
||||
00010 * FROM THE WEB REPORTING SYSTEM. THE EFTIFEST CL232
|
||||
00011 * RECORD WHICH CONTAINS THE STATUS OF EACH FIELD CL232
|
||||
00012 * TO BE CHANGED. CL*50
|
||||
00013 * 2. IT MATCHES THE EMP-NO WITH THE MTAD MASTER TO CL198
|
||||
00014 * PRODUCE A BUSINESS T002 STATUS CHANGE REC. ON CL199
|
||||
00015 * THE FIELDS OF BUSINESS NAME, ADDRESS, TELEPHONE CL232
|
||||
00016 * NUMBER, OR EMAIL ADDRESS. CL232
|
||||
00017 * 3. THEN IT MATCHES THE EMP-NO WITH THE MOPO MASTER CL199
|
||||
00018 * TO PRODUCE A CONTACT T002 STATUS CHANGE REC. ON CL199
|
||||
00019 * THE FIELDS OF CONTACT NAME, SSN, TITLE, TELEPHONE CL232
|
||||
00020 * NUMBER, OR FAX NUMBER. CL232
|
||||
00021 * 4. IT ALSO PRODUCES PRINTED REPORTS FOR OTHER CL198
|
||||
00022 * STATUS CHANGES. CL180
|
||||
00023 * CL146
|
||||
00024 * MODIFICATION LOG: CL146
|
||||
00025 * CL146
|
||||
00026 * 07/15/03 INITIAL DEVELOPMENT CL228
|
||||
00027 * WORK ORDER: PROGRAMMER: RW1 CL**3
|
||||
00028 * CL**3
|
||||
00029 * 99/99/99 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
||||
00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
||||
00031 * WORK ORDER: PROGRAMMER: XXX CL**3
|
||||
00032 * CL146
|
||||
00033 * DESCRIPTION: CL146
|
||||
00034 * CL146
|
||||
00035 * INITIATION: CL146
|
||||
00036 * NONE CL*91
|
||||
00037 * CL146
|
||||
00038 * PARAMETERS INPUT: CL*50
|
||||
00039 * NONE CL*91
|
||||
00040 * CL*50
|
||||
00041 * PROCESSING: CL146
|
||||
00042 * READ THE STATUS UPDATE FILE SEQUENTIALLY FROM GOVONE CL169
|
||||
00043 * AND MATCHES THE FEST-EMP-NO WITH THE MPRF MASTER FILE, CL170
|
||||
00044 * MTAD, AND MOPO FILES TO CREATE A T002 STATUS UPDATE CL*55
|
||||
00045 * FILE FOR ACCOUNT UPDATING PROCESSES. CL*50
|
||||
00046 * CL181
|
||||
00047 * TERMINATION: CL146
|
||||
00048 * OUTPUT STATISTICAL RECORDS COUNT. CL*50
|
||||
00049 * CL146
|
||||
00050 * RECORDS READ: CL206
|
||||
00051 * MASTER: CL**3
|
||||
00052 * MPRF, MTAD, AND MOPO MASTER FILES. CL*55
|
||||
00053 * CL**3
|
||||
00054 * ALTERNATE INDEX: CL146
|
||||
00055 * YES. CL170
|
||||
00056 * CL146
|
||||
00057 * REFERENCE: CL146
|
||||
00058 * NONE. CL146
|
||||
00059 * CL146
|
||||
00060 * REPORT RECORDS WRITTEN: CL146
|
||||
00061 * STATUS REPORT. CL170
|
||||
00062 * CL*50
|
||||
00063 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: CL241
|
||||
00064 * T002 CL170
|
||||
00065 * CL146
|
||||
00066 * MODULES CALLED: CL146
|
||||
00067 * DTSBU001 DATE CONVERSION/EDIT. CL146
|
||||
00068 * DTSBU004 QUARERLY SUMMARY REPORT REC. CL*47
|
||||
00069 * DTSBU910 VSAM MASTER FILES I/O. CL*74
|
||||
00070 * DTSBU927 VARIABLE LENGTH RECORD BTC OUTPUT. CL166
|
||||
00071 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. CL166
|
||||
00072 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. CL*35
|
||||
00073 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. CL*35
|
||||
00074 * CL146
|
||||
00075 * VERMONT REFERENCE: CL146
|
||||
00076 * NONE. CL146
|
||||
00077 * CL146
|
||||
00078 ***** CL146
|
||||
00079 SKIP3 CL*13
|
||||
00080 ENVIRONMENT DIVISION. CL146
|
||||
00081 CL211
|
||||
00082 INPUT-OUTPUT SECTION. CL*58
|
||||
00083 CL*58
|
||||
00084 DATA DIVISION. CL*13
|
||||
00085 CL*58
|
||||
00086 WORKING-STORAGE SECTION. CL146
|
||||
000865 77 PAN-VALET PICTURE X(24) VALUE '147EFTBD120 03/18/04'. CL146
|
||||
00087 CL*40
|
||||
00088 01 WRK-AREA. CL146
|
||||
00089 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120. CL243
|
||||
00090 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD120'. CL243
|
||||
00091 05 WRK-ABEND-MSG PIC X(60). CL*83
|
||||
00092 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL126
|
||||
00093 CL*98
|
||||
00094 05 DISP-DATE PIC X(10) VALUE SPACES. CL*92
|
||||
00095 05 DISP-TIME PIC X(08) VALUE SPACES. CL*92
|
||||
00096 05 DISP-ABSTIME PIC X(16) VALUE SPACES. CL132
|
||||
00097 05 WRK-L076-NAME PIC X(32) VALUE SPACES. CL125
|
||||
00098 CL132
|
||||
00099 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. CL133
|
||||
00100 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. CL132
|
||||
00101 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. CL*92
|
||||
00102 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL132
|
||||
00103 05 WRK-MPRF-FEIN PIC S9(09) COMP-3 VALUE +0. CL102
|
||||
00104 CL132
|
||||
00105 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL101
|
||||
00106 05 WRK-ERROR-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*78
|
||||
00107 05 WRK-STATUS-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL234
|
||||
00108 05 WRK-BTC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL172
|
||||
00109 05 WRK-R907-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL172
|
||||
00110 05 WRK-R120-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*23
|
||||
00111 05 WRK-T002-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. CL240
|
||||
00112 05 WRK-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. CL240
|
||||
00113 05 WRK-REPORT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL209
|
||||
00114 CL112
|
||||
00115 05 WRK-MPRF-IND PIC X(01). CL182
|
||||
00116 88 WRK-MPRF-OK-88 VALUE '0'. CL182
|
||||
00117 88 WRK-MPRF-NO-REC-88 VALUE '1'. CL235
|
||||
00118 CL182
|
||||
00119 05 WRK-ERROR-IND PIC X(01). CL*37
|
||||
00120 88 WRK-ERROR-YES-88 VALUE 'Y'. CL182
|
||||
00121 88 WRK-ERROR-NO-88 VALUE 'N'. CL182
|
||||
00122 CL141
|
||||
00123 05 WRK-MOPO-IND PIC X(01). CL141
|
||||
00124 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL182
|
||||
00125 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL182
|
||||
00126 CL176
|
||||
00127 05 WRK-STATUS-CHNG-IND PIC X(01). CL240
|
||||
00128 88 WRK-STATUS-CHNG-YES-88 VALUE 'Y'. CL240
|
||||
00129 88 WRK-STATUS-CHNG-NO-88 VALUE 'N'. CL240
|
||||
00130 CL241
|
||||
00131 05 WRK-MTAD-T002-IND PIC X(01). CL*18
|
||||
00132 88 WRK-MTAD-T002-YES-88 VALUE 'Y'. CL*18
|
||||
00133 88 WRK-MTAD-T002-NO-88 VALUE 'N'. CL*18
|
||||
00134 CL238
|
||||
00135 05 WRK-MOPO-T002-IND PIC X(01). CL*18
|
||||
00136 88 WRK-MOPO-T002-YES-88 VALUE 'Y'. CL*18
|
||||
00137 88 WRK-MOPO-T002-NO-88 VALUE 'N'. CL*18
|
||||
00138 CL*18
|
||||
00139 05 WRK-CONT-T002-IND PIC X(01). CL118
|
||||
00140 88 WRK-CONT-T002-YES-88 VALUE 'Y'. CL118
|
||||
00141 88 WRK-CONT-T002-NO-88 VALUE 'N'. CL118
|
||||
00142 CL118
|
||||
00143 05 WRK-NAME-IN PIC X(40). CL238
|
||||
00144 05 WRK-NAME-OUT PIC X(40). CL238
|
||||
00145 05 START-SUB PIC S9(04) COMP. CL238
|
||||
00146 05 SUB1 PIC S9(04) COMP. CL238
|
||||
00147 05 SUB2 PIC S9(04) COMP. CL238
|
||||
00148 CL*91
|
||||
00149 01 ERROR-ADDRESS-AREA. CL*91
|
||||
00150 05 FILLER PIC X(03). CL*95
|
||||
00151 05 WRK-ERROR-ADDR PIC X(26). CL100
|
||||
00152 05 WRK-ERROR-CITY PIC X(16). CL100
|
||||
00153 05 WRK-ERROR-STATE PIC X(02). CL*91
|
||||
00154 05 FILLER PIC X(01). CL*96
|
||||
00155 05 WRK-ERROR-ZIP PIC X(10). CL*91
|
||||
00156 CL*91
|
||||
00157 01 ERROR-MESSAGE-AREA. CL236
|
||||
00158 05 MSG1-CHG-ONLY. CL236
|
||||
00159 10 MSG1-ID PIC X(03) VALUE '001'. CL236
|
||||
00160 10 MSG1-TEXT. CL236
|
||||
00161 15 FILLER PIC X(30) CL236
|
||||
00162 VALUE 'TRANSACTION FAILED - CHARGING '. CL236
|
||||
00163 15 FILLER PIC X(30) CL236
|
||||
00164 VALUE 'ONLY EMPLOYER '. CL236
|
||||
00165 CL236
|
||||
00166 05 MSG2-INACTIVE. CL236
|
||||
00167 10 MSG2-ID PIC X(03) VALUE '002'. CL236
|
||||
00168 10 MSG2-TEXT. CL236
|
||||
00169 15 FILLER PIC X(30) CL236
|
||||
00170 VALUE 'STATUS CHANGE ACCEPTED FOR INA'. CL236
|
||||
00171 15 FILLER PIC X(30) CL236
|
||||
00172 VALUE 'CTIVE EMPLOYER '. CL236
|
||||
00173 CL236
|
||||
00174 05 MSG3-NOT-LIABLE. CL236
|
||||
00175 10 MSG3-ID PIC X(03) VALUE '003'. CL236
|
||||
00176 10 MSG3-TEXT. CL236
|
||||
00177 15 FILLER PIC X(30) CL236
|
||||
00178 VALUE 'STATUS CHANGE ACCEPTED FOR NON'. CL236
|
||||
00179 15 FILLER PIC X(30) CL236
|
||||
00180 VALUE '-LIABLE EMPLOYER '. CL236
|
||||
00181 CL236
|
||||
00182 05 MSG4-INVALID-ADDRESS. CL237
|
||||
00183 10 MSG4-ID PIC X(03) VALUE '004'. CL237
|
||||
00184 10 MSG4-TEXT. CL237
|
||||
00185 15 FILLER PIC X(30) CL237
|
||||
00186 VALUE 'TRANSACTION REJECTED - INVALID'. CL237
|
||||
00187 15 FILLER PIC X(30) CL237
|
||||
00188 VALUE ' ADDRESS '. CL237
|
||||
00189 CL237
|
||||
00190 05 MSG5-INCOMPLETE-NAMES. CL*71
|
||||
00191 10 MSG5-ID PIC X(03) VALUE '005'. CL238
|
||||
00192 10 MSG5-TEXT. CL238
|
||||
00193 15 FILLER PIC X(30) CL238
|
||||
00194 VALUE 'TRANSACTION REJECTED - NO TRAD'. CL*73
|
||||
00195 15 FILLER PIC X(30) CL238
|
||||
00196 VALUE 'E/ENTITY NAMES '. CL*73
|
||||
00197 CL238
|
||||
00198 05 MSG6-INCOMPLETE-CONTACT. CL*71
|
||||
00199 10 MSG6-ID PIC X(03) VALUE '006'. CL*71
|
||||
00200 10 MSG6-TEXT. CL*71
|
||||
00201 15 FILLER PIC X(30) CL*71
|
||||
00202 VALUE 'TRANSACTION REJECTED - CONTACT'. CL*71
|
||||
00203 15 FILLER PIC X(30) CL*71
|
||||
00204 VALUE ' INFORMATION NOT COMPLETE '. CL*71
|
||||
00205 CL*71
|
||||
00206 EJECT CL211
|
||||
00207 01 FEST-REC. CL176
|
||||
00208 ++INCLUDE EFTIFEST CL167
|
||||
00209 SKIP3 CL*58
|
||||
00210 01 T002-REC. CL167
|
||||
00211 ++INCLUDE DTSIT002 CL167
|
||||
00212 SKIP3 CL167
|
||||
00213 01 R120-REC. CL*22
|
||||
00214 ++INCLUDE EFTIR120 CL*22
|
||||
00215 SKIP3 CL*22
|
||||
00216 01 EFTE-REC. CL*22
|
||||
00217 ++INCLUDE EFTERMSG CL*22
|
||||
00218 SKIP3 CL*22
|
||||
00219 01 L001-LINK-AREA. CL146
|
||||
00220 ++INCLUDE DTSIL001 CL146
|
||||
00221 EJECT CL146
|
||||
00222 01 L004-LINK-AREA. CL*24
|
||||
00223 ++INCLUDE DTSIL004 CL*24
|
||||
00224 EJECT CL*24
|
||||
00225 01 L005-COMM-AREA. CL*61
|
||||
00226 ++INCLUDE DTSIL005 CL*61
|
||||
00227 EJECT CL100
|
||||
00228 01 L021-COMM-AREA. CL*17
|
||||
00229 ++INCLUDE DTSIL021 CL*17
|
||||
00230 EJECT CL*17
|
||||
00231 01 L072-LINK-AREA. CL242
|
||||
00232 ++INCLUDE DTSIL072 CL241
|
||||
00233 EJECT CL241
|
||||
00234 01 L076-LINK-AREA. CL125
|
||||
00235 ++INCLUDE DTSIL076 CL125
|
||||
00236 EJECT CL*15
|
||||
00237 01 L910-LINK-AREA. CL*94
|
||||
00238 ++INCLUDE DTSIL910 CL*94
|
||||
00239 EJECT CL162
|
||||
00240 01 MSKL-REC. CL234
|
||||
00241 ++INCLUDE DTSIMSKL CL234
|
||||
00242 EJECT CL234
|
||||
00243 01 MPRF-REC. CL234
|
||||
00244 ++INCLUDE DTSIMPRF CL234
|
||||
00245 EJECT CL234
|
||||
00246 01 MTAD-REC. CL234
|
||||
00247 ++INCLUDE DTSIMTAD CL234
|
||||
00248 EJECT CL234
|
||||
00249 01 MOPO-REC. CL234
|
||||
00250 ++INCLUDE DTSIMOPO CL234
|
||||
00251 EJECT CL234
|
||||
00252 01 L927-LINK-AREA. CL173
|
||||
00253 ++INCLUDE DTSIL927 CL167
|
||||
00254 EJECT CL167
|
||||
00255 01 TSKL-REC. CL167
|
||||
00256 ++INCLUDE DTSITSKL CL167
|
||||
00257 EJECT CL167
|
||||
00258 01 L941-LINK-AREA. CL162
|
||||
00259 ++INCLUDE DTSIL941 CL162
|
||||
00260 EJECT CL*94
|
||||
00261 01 STATUS-REC. CL234
|
||||
00262 ++INCLUDE DTSIRSK3 CL234
|
||||
00263 SKIP3 CL234
|
||||
00264 01 F907-REC. CL**8
|
||||
00265 ++INCLUDE EFTIF907 CL**6
|
||||
00266 EJECT CL226
|
||||
00267 CL249
|
||||
00268 LINKAGE SECTION. CL249
|
||||
00269 01 EFT-REC-TYPE-LINK-AREA. CL249
|
||||
00270 ++INCLUDE EFTIL100 CL249
|
||||
00271 CL249
|
||||
00272 01 RSKL-REC. CL249
|
||||
00273 ++INCLUDE EFTIRSKL CL249
|
||||
00274 CL249
|
||||
00275 PROCEDURE DIVISION USING CL248
|
||||
00276 EFT-REC-TYPE-LINK-AREA CL248
|
||||
00277 RSKL-REC. CL248
|
||||
00278 CL248
|
||||
00279 MOVE RSKL-REC TO FEST-REC. CL248
|
||||
00280 CL248
|
||||
00281 IF EFT-L100-CMD-INIT-88 CL248
|
||||
00282 PERFORM I0000-INITIALIZE THRU I0000-EXIT CL248
|
||||
00283 ELSE CL248
|
||||
00284 IF EFT-L100-CMD-PROCESS-88 CL248
|
||||
00285 PERFORM P0000-PROCESS THRU P0000-EXIT CL248
|
||||
00286 ELSE CL248
|
||||
00287 IF EFT-L100-CMD-TERMINATE-88 CL251
|
||||
00288 PERFORM T0000-TERMINATE THRU T0000-EXIT CL248
|
||||
00289 ELSE CL248
|
||||
00290 DISPLAY 'INVLAID CALL FROM BD100 ' CL248
|
||||
00291 PERFORM S999-ABEND THRU S999-EXIT. CL248
|
||||
00292 CL*62
|
||||
00293 GOBACK. CL146
|
||||
00294 EJECT CL146
|
||||
00295 I0000-INITIALIZE. CL146
|
||||
00296 CL*72
|
||||
00297 SET WRK-MPRF-OK-88 TO TRUE. CL151
|
||||
00298 CL*72
|
||||
00299 PERFORM I1000-SYS-DATE THRU I1000-EXIT. CL*74
|
||||
00300 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*74
|
||||
00301 CL*63
|
||||
00302 PERFORM I3000-INIT-T002 THRU I3000-EXIT. CL240
|
||||
00303 CL240
|
||||
00304 I0000-EXIT. CL146
|
||||
00305 EXIT. CL146
|
||||
00306 CL107
|
||||
00307 I1000-SYS-DATE. CL*72
|
||||
00308 SET L005-FROM-SYS TO TRUE. CL*72
|
||||
00309 PERFORM S005-SYS-DATE THRU S005-EXIT. CL*72
|
||||
00310 MOVE L005-DATE TO DISP-DATE WRK-CURR-DATE. CL132
|
||||
00311 MOVE L005-TIME TO DISP-TIME WRK-CURR-TIME. CL132
|
||||
00312 MOVE L005-ABSTIME TO DISP-ABSTIME WRK-ABSTIME. CL132
|
||||
00313 CL132
|
||||
00314 * DISPLAY ' '. CL245
|
||||
00315 * DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME CL245
|
||||
00316 * ' L005-ABSTIME ' DISP-ABSTIME. CL247
|
||||
00317 I1000-EXIT. CL*72
|
||||
00318 EXIT. CL*72
|
||||
00319 CL**1
|
||||
00320 I2000-OPEN-FILES. CL*72
|
||||
00321 CL172
|
||||
00322 MOVE LENGTH OF T002-REC TO T002-LENGTH. CL172
|
||||
00323 MOVE LENGTH OF F907-REC TO F907-LENGTH. CL**6
|
||||
00324 MOVE LENGTH OF R120-REC TO R120-LENGTH. CL*25
|
||||
00325 CL161
|
||||
00326 I2000-EXIT. CL*72
|
||||
00327 EXIT. CL*58
|
||||
00328 CL*58
|
||||
00329 I3000-INIT-T002. CL240
|
||||
00330 CL240
|
||||
00331 MOVE ZERO TO T002-EMP-NO CL240
|
||||
00332 T002-SYS-DATE CL240
|
||||
00333 T002-SYS-TIME. CL240
|
||||
00334 CL240
|
||||
00335 MOVE SPACES TO T002-ORIGIN CL240
|
||||
00336 T002-DATA-AREA. CL240
|
||||
00337 CL240
|
||||
00338 I3000-EXIT. CL240
|
||||
00339 EXIT. CL240
|
||||
00340 CL240
|
||||
00341 ************************************************************** CL146
|
||||
00342 * READ THE EFT STATUS CHANGE FILE FROM GOVONE AND * CL175
|
||||
00343 * MATCHES THE EMPLOYER NNUMBER WITH THE MPRF MASTER. * CL175
|
||||
00344 ************************************************************** CL146
|
||||
00345 CL146
|
||||
00346 P0000-PROCESS. CL146
|
||||
00347 DISPLAY ' FEST EMP NO...... ' FEST-EMP-NO CL127
|
||||
00348 SET WRK-MOPO-FOUND-NO-88 TO TRUE. CL*90
|
||||
00349 SET WRK-MTAD-T002-YES-88 TO TRUE. CL138
|
||||
00350 SET WRK-MOPO-T002-YES-88 TO TRUE. CL*90
|
||||
00351 SET WRK-CONT-T002-YES-88 TO TRUE. CL120
|
||||
00352 SET WRK-STATUS-CHNG-NO-88 TO TRUE. CL*90
|
||||
00353 ADD +1 TO WRK-STATUS-READ-CNT CL*90
|
||||
00354 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90
|
||||
00355 CL*18
|
||||
00356 PERFORM P1100-READ-MPRF THRU P1100-EXIT CL*90
|
||||
00357 CL*18
|
||||
00358 IF WRK-MPRF-NO-REC-88 CL*90
|
||||
00359 DISPLAY ' EMP REC NOT FOUND ' FEST-EMP-NO CL117
|
||||
00360 GO TO P0000-EXIT. CL*90
|
||||
00361 CL*18
|
||||
00362 PERFORM P1200-CHECK-FEST-NAME THRU P1200-EXIT. CL122
|
||||
00363 CL120
|
||||
00364 IF WRK-MTAD-T002-YES-88 CL*90
|
||||
00365 PERFORM P1300-CHECK-FEST-ADDRESS THRU P1300-EXIT CL135
|
||||
00366 PERFORM P1600-CHECK-FEST-DATA THRU P1600-EXIT CL120
|
||||
00367 PERFORM P1700-WRITE-MTAD-T002 THRU P1700-EXIT CL134
|
||||
00368 ELSE CL120
|
||||
00369 DISPLAY '***** NO MTAD T002 REC CREATED ' FEST-EMP-NO. CL134
|
||||
00370 * CL120
|
||||
00371 ***** WRITE T002 CONTACT REC. CL118
|
||||
00372 * CL118
|
||||
00373 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90
|
||||
00374 INITIALIZE MOPO-REC CL*90
|
||||
00375 PERFORM P2000-MOPO THRU P2000-EXIT CL*90
|
||||
00376 * CL128
|
||||
00377 PERFORM P2100-CONT-NAME THRU P2100-EXIT CL128
|
||||
00378 * CL118
|
||||
00379 IF WRK-CONT-T002-YES-88 CL118
|
||||
00380 DISPLAY ' T002 YES FOUND ' FEST-EMP-NO CL127
|
||||
00381 PERFORM P2300-WRITE-CONT-T002 THRU P2300-EXIT. CL118
|
||||
00382 * CL120
|
||||
00383 ***** WRITE 120 REPORT REC. CL118
|
||||
00384 * CL118
|
||||
00385 PERFORM P3000-STATUS-SALES THRU P3000-EXIT CL*90
|
||||
00386 PERFORM P3100-STATUS-PAID THRU P3100-EXIT CL*90
|
||||
00387 PERFORM P3200-STATUS-DESC THRU P3200-EXIT CL*90
|
||||
00388 PERFORM P3300-STATUS-FEIN THRU P3300-EXIT CL*90
|
||||
00389 PERFORM P3400-STATUS-TRACE THRU P3400-EXIT CL*90
|
||||
00390 CL*18
|
||||
00391 IF WRK-STATUS-CHNG-YES-88 CL*21
|
||||
00392 PERFORM P3500-WRITE-R120 THRU P3500-EXIT. CL*36
|
||||
00393 CL*18
|
||||
00394 P0000-EXIT. CL146
|
||||
00395 EXIT. CL146
|
||||
00396 CL135
|
||||
00397 CL234
|
||||
00398 P1100-READ-MPRF. CL235
|
||||
00399 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL235
|
||||
00400 MOVE FEST-EMP-NO TO MSKL-EMP-NO. CL235
|
||||
00401 SET MSKL-PRF-88 TO TRUE. CL235
|
||||
00402 PERFORM S910-READ THRU S910-EXIT. CL235
|
||||
00403 IF L910-NO-REC-88 CL235
|
||||
00404 SET WRK-MPRF-NO-REC-88 TO TRUE CL240
|
||||
00405 DISPLAY 'NO MPRF RECORD FOUND ' FEST-EMP-NO CL235
|
||||
00406 GO TO P1100-EXIT CL236
|
||||
00407 ELSE CL235
|
||||
00408 MOVE MSKL-REC TO MPRF-REC CL235
|
||||
00409 SET WRK-MPRF-OK-88 TO TRUE CL235
|
||||
00410 END-IF. CL235
|
||||
00411 CL235
|
||||
00412 EVALUATE TRUE CL236
|
||||
00413 WHEN MPRF-CLASS-CHG-ONLY-88 CL236
|
||||
00414 MOVE MSG1-ID TO F907-MSG-ID CL**6
|
||||
00415 MOVE MSG1-TEXT TO F907-MSG-TEXT CL*11
|
||||
00416 PERFORM S946-ERROR THRU S946-EXIT CL**6
|
||||
00417 CL236
|
||||
00418 WHEN MPRF-STATUS-INACT-88 CL236
|
||||
00419 MOVE MSG2-ID TO F907-MSG-ID CL**6
|
||||
00420 MOVE MSG2-TEXT TO F907-MSG-TEXT CL*11
|
||||
00421 PERFORM S946-ERROR THRU S946-EXIT CL**6
|
||||
00422 CL236
|
||||
00423 WHEN MPRF-STATUS-UNK-88 CL236
|
||||
00424 OR MPRF-STATUS-NEVERSUB-88 CL236
|
||||
00425 MOVE MSG3-ID TO F907-MSG-ID CL**6
|
||||
00426 MOVE MSG3-TEXT TO F907-MSG-TEXT CL*11
|
||||
00427 PERFORM S946-ERROR THRU S946-EXIT CL**6
|
||||
00428 CL236
|
||||
00429 END-EVALUATE. CL236
|
||||
00430 CL236
|
||||
00431 P1100-EXIT. CL235
|
||||
00432 EXIT. CL235
|
||||
00433 CL235
|
||||
00434 P1200-CHECK-FEST-NAME. CL122
|
||||
00435 *BW1 CL*71
|
||||
00436 MOVE SPACES TO T002-BSNS-ENTITY-NAME. CL122
|
||||
00437 MOVE SPACES TO T002-BSNS-TRADE-NAME. CL122
|
||||
00438 CL135
|
||||
00439 IF (FEST-TRADE-NAME = SPACES OR LOW-VALUES) AND CL*71
|
||||
00440 (FEST-ENTITY-NAME = SPACES OR LOW-VALUES) CL*71
|
||||
00441 MOVE MSG5-ID TO F907-MSG-ID CL*71
|
||||
00442 MOVE MSG5-TEXT TO F907-MSG-TEXT CL*71
|
||||
00443 PERFORM S946-ERROR THRU S946-EXIT CL*71
|
||||
00444 SET WRK-MTAD-T002-NO-88 TO TRUE CL135
|
||||
00445 GO TO P1200-EXIT. CL*71
|
||||
00446 *BW2 CL*71
|
||||
00447 CL*71
|
||||
00448 IF FEST-TRADE-NAME = SPACES OR LOW-VALUES CL244
|
||||
00449 MOVE SPACES TO T002-BSNS-TRADE-NAME CL*55
|
||||
00450 ELSE CL244
|
||||
00451 MOVE FEST-TRADE-NAME TO WRK-NAME-IN CL236
|
||||
00452 MOVE SPACES TO WRK-NAME-OUT CL236
|
||||
00453 PERFORM P1210-UPDATE-NAME THRU P1210-EXIT CL241
|
||||
00454 MOVE WRK-NAME-OUT TO T002-BSNS-TRADE-NAME CL120
|
||||
00455 END-IF. CL236
|
||||
00456 CL236
|
||||
00457 P1200-EXIT. CL235
|
||||
00458 EXIT. CL235
|
||||
00459 CL235
|
||||
00460 P1210-UPDATE-NAME. CL236
|
||||
00461 MOVE +0 TO START-SUB CL236
|
||||
00462 SUB2. CL236
|
||||
00463 CL236
|
||||
00464 IF WRK-NAME-IN (1:2) = 'A ' CL236
|
||||
00465 IF WRK-NAME-IN (4:1) = ' ' CL236
|
||||
00466 NEXT SENTENCE CL236
|
||||
00467 ELSE CL236
|
||||
00468 MOVE +3 TO START-SUB CL236
|
||||
00469 END-IF CL236
|
||||
00470 ELSE CL236
|
||||
00471 IF WRK-NAME-IN (1:3) = 'AN ' CL236
|
||||
00472 MOVE +4 TO START-SUB CL236
|
||||
00473 ELSE CL236
|
||||
00474 IF WRK-NAME-IN (1:4) = 'THE ' CL236
|
||||
00475 MOVE +5 TO START-SUB CL236
|
||||
00476 END-IF CL236
|
||||
00477 END-IF CL236
|
||||
00478 END-IF. CL236
|
||||
00479 CL236
|
||||
00480 IF START-SUB > +0 CL236
|
||||
00481 PERFORM CL236
|
||||
00482 VARYING SUB1 FROM START-SUB BY +1 CL236
|
||||
00483 UNTIL SUB1 > +40 CL236
|
||||
00484 ADD +1 TO SUB2 CL236
|
||||
00485 MOVE WRK-NAME-IN (SUB1:1) TO WRK-NAME-OUT (SUB2:1) CL236
|
||||
00486 END-PERFORM CL236
|
||||
00487 ELSE CL236
|
||||
00488 MOVE WRK-NAME-IN TO WRK-NAME-OUT CL236
|
||||
00489 END-IF. CL236
|
||||
00490 CL236
|
||||
00491 P1210-EXIT. CL236
|
||||
00492 EXIT. CL236
|
||||
00493 CL236
|
||||
00494 P1300-CHECK-FEST-ADDRESS. CL120
|
||||
00495 CL120
|
||||
00496 SET WRK-MTAD-T002-YES-88 TO TRUE CL120
|
||||
00497 MOVE SPACES TO T002-BSNS-ATTN CL120
|
||||
00498 MOVE SPACES TO T002-BSNS-DELV1 CL120
|
||||
00499 MOVE SPACES TO T002-BSNS-DELV2 CL120
|
||||
00500 MOVE SPACES TO T002-BSNS-CITY CL120
|
||||
00501 MOVE SPACES TO T002-BSNS-ST CL120
|
||||
00502 MOVE SPACES TO T002-BSNS-ZIP CL120
|
||||
00503 MOVE SPACES TO T002-BSNS-ENTITY-NAME CL142
|
||||
00504 CL**4
|
||||
00505 IF FEST-ADDRESS-AREA = SPACES OR LOW-VALUES CL236
|
||||
00506 SET WRK-MTAD-T002-NO-88 TO TRUE CL120
|
||||
00507 MOVE MSG4-ID TO F907-MSG-ID CL*55
|
||||
00508 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*55
|
||||
00509 PERFORM S946-ERROR THRU S946-EXIT CL*55
|
||||
00510 GO TO P1300-EXIT. CL238
|
||||
00511 CL236
|
||||
00512 MOVE SPACES TO L072-ADDRESS. CL237
|
||||
00513 MOVE 'Y' TO L072-CASS-IND. CL110
|
||||
00514 SET L072-MTAD-88 TO TRUE. CL236
|
||||
00515 MOVE MPRF-PRIMARY-NAME TO L072-NAME. CL237
|
||||
00516 MOVE FEST-ATTN-LINE TO L072-ATTN-LINE. CL237
|
||||
00517 MOVE FEST-STREET-ADDRESS-1 TO L072-DELIV-LINE-1. CL236
|
||||
00518 MOVE FEST-STREET-ADDRESS-2 TO L072-DELIV-LINE-2. CL236
|
||||
00519 MOVE FEST-CITY TO L072-CITY. CL237
|
||||
00520 MOVE FEST-STATE TO L072-ST. CL237
|
||||
00521 MOVE FEST-ZIP TO L072-ZIP. CL237
|
||||
00522 CL*27
|
||||
00523 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. CL236
|
||||
00524 CL120
|
||||
00525 IF L072-ADDRESS-NOT-VALID-88 CL*46
|
||||
00526 DISPLAY 'L072 ADDRESS INVALID ' L072-MSG-AREA CL120
|
||||
00527 SET WRK-MTAD-T002-NO-88 TO TRUE CL*47
|
||||
00528 MOVE MSG4-ID TO F907-MSG-ID CL*46
|
||||
00529 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*46
|
||||
00530 MOVE FEST-STREET-ADDRESS-2 TO WRK-ERROR-ADDR CL*91
|
||||
00531 MOVE FEST-CITY TO WRK-ERROR-CITY CL*91
|
||||
00532 MOVE FEST-STATE TO WRK-ERROR-STATE CL*91
|
||||
00533 MOVE FEST-ZIP TO WRK-ERROR-ZIP CL*91
|
||||
00534 MOVE ERROR-ADDRESS-AREA TO F907-GOV1-REC-ERR CL*93
|
||||
00535 PERFORM S946-ERROR THRU S946-EXIT CL*91
|
||||
00536 GO TO P1300-EXIT. CL*46
|
||||
00537 CL239
|
||||
00538 MOVE L072-ATTN-LINE TO T002-BSNS-ATTN. CL121
|
||||
00539 MOVE L072-DELIV-LINE-1 TO T002-BSNS-DELV1. CL121
|
||||
00540 MOVE L072-DELIV-LINE-2 TO T002-BSNS-DELV2. CL121
|
||||
00541 MOVE L072-CITY TO T002-BSNS-CITY. CL121
|
||||
00542 MOVE L072-ST TO T002-BSNS-ST. CL121
|
||||
00543 MOVE L072-ZIP TO T002-BSNS-ZIP. CL121
|
||||
00544 CL115
|
||||
00545 P1300-EXIT. CL120
|
||||
00546 EXIT. CL120
|
||||
00547 CL120
|
||||
00548 P1600-CHECK-FEST-DATA. CL120
|
||||
00549 CL120
|
||||
00550 IF FEST-BUSINESS-PHONE > SPACES CL120
|
||||
00551 MOVE FEST-BUSINESS-PHONE TO T002-BUSINESS-VOICE CL120
|
||||
00552 *RW1 CL144
|
||||
00553 * (THIS IS THE BUSINESS !!!) R120-CONTACT-PHONE CL145
|
||||
00554 *RW2 CL144
|
||||
00555 ELSE CL120
|
||||
00556 MOVE SPACES TO T002-BUSINESS-VOICE. CL120
|
||||
00557 CL*18
|
||||
00558 IF FEST-FAX > SPACES CL120
|
||||
00559 MOVE FEST-FAX TO T002-BUSINESS-FAX CL120
|
||||
00560 ELSE CL120
|
||||
00561 MOVE SPACES TO T002-BUSINESS-FAX. CL120
|
||||
00562 CL*19
|
||||
00563 IF FEST-EMAIL-ADDRESS > SPACES CL120
|
||||
00564 MOVE FEST-EMAIL-ADDRESS TO T002-BUSINESS-EMAIL CL120
|
||||
00565 ELSE CL120
|
||||
00566 MOVE SPACES TO T002-BUSINESS-EMAIL. CL120
|
||||
00567 CL*19
|
||||
00568 P1600-EXIT. CL*19
|
||||
00569 EXIT. CL*19
|
||||
00570 CL*18
|
||||
00571 P1700-WRITE-MTAD-T002. CL134
|
||||
00572 CL137
|
||||
00573 DISPLAY ' WRITING T002 STATUS REC ' T002-EMP-NO. CL137
|
||||
00574 CL137
|
||||
00575 IF WRK-MTAD-T002-NO-88 CL137
|
||||
00576 GO TO P1700-EXIT. CL137
|
||||
00577 CL137
|
||||
00578 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL237
|
||||
00579 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL237
|
||||
00580 MOVE L005-DATE TO T002-SYS-DATE. CL237
|
||||
00581 MOVE L005-TIME TO T002-SYS-TIME. CL237
|
||||
00582 SET T002-UPD-MAIL-ADDR-88 TO TRUE. CL237
|
||||
00583 CL237
|
||||
00584 MOVE T002-REC TO TSKL-REC. CL239
|
||||
00585 PERFORM S927B-WRITE THRU S927B-EXIT CL239
|
||||
00586 ADD +1 TO WRK-T002-ADDR-CNT. CL240
|
||||
00587 CL237
|
||||
00588 P1700-EXIT. CL*18
|
||||
00589 EXIT. CL237
|
||||
00590 CL237
|
||||
00591 ************************************************************** CL*37
|
||||
00592 * USING THE MPRF EMP-NO TO FIND MOPO RECORD. * CL135
|
||||
00593 ************************************************************** CL*37
|
||||
00594 CL176
|
||||
00595 P2000-MOPO. CL239
|
||||
00596 CL*17
|
||||
00597 MOVE LOW-VALUES TO MOPO-KEY-AREA. CL176
|
||||
00598 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. CL176
|
||||
00599 SET MOPO-OPO-88 TO TRUE. CL176
|
||||
00600 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. CL176
|
||||
00601 CL176
|
||||
00602 PERFORM S910-START-BROWSE THRU S910-EXIT. CL176
|
||||
00603 IF L910-NO-REC-88 CL176
|
||||
00604 NEXT SENTENCE CL238
|
||||
00605 ELSE CL176
|
||||
00606 PERFORM CL176
|
||||
00607 UNTIL L910-NO-REC-88 CL176
|
||||
00608 OR WRK-MOPO-FOUND-YES-88 CL176
|
||||
00609 MOVE MSKL-REC TO MOPO-REC CL*78
|
||||
00610 IF MOPO-TYPE-STATUS-88 CL*75
|
||||
00611 MOVE MOPO-REC TO MSKL-REC CL*79
|
||||
00612 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL192
|
||||
00613 ELSE CL192
|
||||
00614 PERFORM S910-READ-NEXT THRU S910-EXIT CL176
|
||||
00615 END-IF CL176
|
||||
00616 END-PERFORM CL176
|
||||
00617 END-IF. CL176
|
||||
00618 CL**1
|
||||
00619 CL179
|
||||
00620 P2000-EXIT. CL239
|
||||
00621 EXIT. CL176
|
||||
00622 CL135
|
||||
00623 P2100-CONT-NAME. CL*20
|
||||
00624 SET WRK-CONT-T002-YES-88 TO TRUE CL118
|
||||
00625 MOVE FEST-CONTACT-FIRST-NAME TO L076-NAMEF CL125
|
||||
00626 MOVE FEST-CONTACT-MI TO L076-NAMEI CL125
|
||||
00627 MOVE FEST-CONTACT-LAST-NAME TO L076-NAMEL CL125
|
||||
00628 CL*28
|
||||
00629 PERFORM S076-NAME THRU S076-EXIT CL125
|
||||
00630 CL*28
|
||||
00631 IF L076-NAME-INVALID CL125
|
||||
00632 MOVE '061' TO F907-MSG-ID CL139
|
||||
00633 MOVE L076-NAME-GROUP TO F907-GOV1-DATA CL133
|
||||
00634 MOVE EFT061 TO F907-MSG-TEXT CL139
|
||||
00635 PERFORM S946-ERROR THRU S946-EXIT CL*20
|
||||
00636 MOVE SPACES TO F907-GOV1-DATA CL*72
|
||||
00637 MOVE SPACES TO T002-CONTACT-NAME CL*20
|
||||
00638 *RW1 CL144
|
||||
00639 MOVE SPACES TO R120-CONTACT-NAME CL144
|
||||
00640 *RW2 CL144
|
||||
00641 SET WRK-CONT-T002-NO-88 TO TRUE CL118
|
||||
00642 DISPLAY ' INV CONT NAME NO T002 CREATED' FEST-EMP-NO CL118
|
||||
00643 ELSE CL118
|
||||
00644 DISPLAY ' L076 NAME STATUS CONT NAME ' L076-NAM CL126
|
||||
00645 MOVE L076-NAM TO T002-CONTACT-NAME CL142
|
||||
00646 R120-CONTACT-NAME. CL142
|
||||
00647 CL*28
|
||||
00648 P2100-EXIT. CL*20
|
||||
00649 EXIT. CL*20
|
||||
00650 CL*20
|
||||
00651 CL*20
|
||||
00652 P2300-WRITE-CONT-T002. CL*81
|
||||
00653 CL118
|
||||
00654 MOVE SPACES TO TSKL-REC. CL118
|
||||
00655 CL118
|
||||
00656 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL*20
|
||||
00657 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL*20
|
||||
00658 MOVE L005-DATE TO T002-SYS-DATE. CL*20
|
||||
00659 MOVE L005-TIME TO T002-SYS-TIME. CL*20
|
||||
00660 MOVE ZEROS TO T002-CONTACT-SSN. CL118
|
||||
00661 MOVE SPACES TO T002-CONTACT-TITLE. CL118
|
||||
00662 MOVE SPACES TO T002-CONTACT-FAX. CL118
|
||||
00663 MOVE SPACES TO T002-CONTACT-EMAIL. CL118
|
||||
00664 MOVE FEST-CONTACT-AREA-CD TO T002-C-VOICE-AREA-CD. CL119
|
||||
00665 MOVE FEST-CONTACT-PREFIX TO T002-C-VOICE-PREFIX. CL119
|
||||
00666 MOVE FEST-CONTACT-SUFFIX TO T002-C-VOICE-SUFFIX. CL119
|
||||
00667 MOVE FEST-CONTACT-EXT TO T002-C-VOICE-EXT. CL119
|
||||
00668 CL*20
|
||||
00669 IF WRK-MOPO-FOUND-YES-88 CL*20
|
||||
00670 SET T002-UPD-CONTACT-88 TO TRUE CL*20
|
||||
00671 ELSE CL*20
|
||||
00672 SET T002-ADD-CONTACT-88 TO TRUE CL*20
|
||||
00673 END-IF. CL*20
|
||||
00674 CL*20
|
||||
00675 SET T002-CONTACT-STATUS-88 TO TRUE. CL*76
|
||||
00676 CL*20
|
||||
00677 MOVE T002-REC TO TSKL-REC. CL*20
|
||||
00678 PERFORM S927B-WRITE THRU S927B-EXIT. CL*20
|
||||
00679 ADD +1 TO WRK-T002-CONTACT-CNT. CL*20
|
||||
00680 CL*81
|
||||
00681 CL118
|
||||
00682 P2300-EXIT. CL*20
|
||||
00683 EXIT. CL*20
|
||||
00684 CL*20
|
||||
00685 ************************************************************** CL207
|
||||
00686 * IF FEST SALE DATE, LAST WAGES PAID DATE, OR STATUS CHANGE * CL209
|
||||
00687 * DESCRIPTION FIELDS CONTAIN DATA, PRINT A STATUS CHANGE * CL207
|
||||
00688 * REPORT RECORD. * CL207
|
||||
00689 ************************************************************** CL207
|
||||
00690 CL207
|
||||
00691 P3000-STATUS-SALES. CL*21
|
||||
00692 CL207
|
||||
00693 IF FEST-SALE-DATE NUMERIC CL106
|
||||
00694 IF FEST-SALE-DATE > ZEROS CL106
|
||||
00695 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106
|
||||
00696 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106
|
||||
00697 ELSE CL106
|
||||
00698 MOVE ZEROS TO R120-SALE-DATE CL106
|
||||
00699 END-IF CL106
|
||||
00700 ELSE CL106
|
||||
00701 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106
|
||||
00702 END-IF. CL106
|
||||
00703 CL106
|
||||
00704 P3000-EXIT. CL*21
|
||||
00705 EXIT. CL*21
|
||||
00706 CL*21
|
||||
00707 P3100-STATUS-PAID. CL*21
|
||||
00708 CL209
|
||||
00709 IF FEST-LAST-WAGES-PAID-DATE NUMERIC CL106
|
||||
00710 IF FEST-LAST-WAGES-PAID-DATE > ZEROS CL106
|
||||
00711 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106
|
||||
00712 R120-LAST-WAGES-PAID-DATE CL106
|
||||
00713 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106
|
||||
00714 ELSE CL106
|
||||
00715 MOVE ZEROS TO R120-LAST-WAGES-PAID-DATE CL106
|
||||
00716 END-IF CL106
|
||||
00717 ELSE CL106
|
||||
00718 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106
|
||||
00719 R120-LAST-WAGES-PAID-DATE CL106
|
||||
00720 END-IF. CL209
|
||||
00721 CL209
|
||||
00722 P3100-EXIT. CL*21
|
||||
00723 EXIT. CL*21
|
||||
00724 CL*21
|
||||
00725 P3200-STATUS-DESC. CL*21
|
||||
00726 IF FEST-STATUS-CHG-DESCRIPTION NOT = SPACES CL209
|
||||
00727 MOVE FEST-STATUS-CHG-DESCRIPTION TO CL209
|
||||
00728 R120-STATUS-CHNG-DESC CL*23
|
||||
00729 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL241
|
||||
00730 ELSE CL221
|
||||
00731 MOVE SPACES TO R120-STATUS-CHNG-DESC CL*23
|
||||
00732 END-IF. CL209
|
||||
00733 CL209
|
||||
00734 P3200-EXIT. CL*21
|
||||
00735 EXIT. CL*21
|
||||
00736 CL*36
|
||||
00737 P3300-STATUS-FEIN. CL*36
|
||||
00738 * IF FEST-FEIN > ZEROS CL101
|
||||
00739 MOVE MPRF-FEIN TO WRK-MPRF-FEIN CL103
|
||||
00740 IF FEST-FEIN NOT = WRK-MPRF-FEIN CL102
|
||||
00741 MOVE FEST-FEIN TO R120-FEIN CL140
|
||||
00742 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL140
|
||||
00743 ELSE CL*36
|
||||
00744 MOVE ZEROS TO R120-FEIN CL140
|
||||
00745 END-IF. CL*36
|
||||
00746 CL*36
|
||||
00747 P3300-EXIT. CL*36
|
||||
00748 EXIT. CL*36
|
||||
00749 CL*36
|
||||
00750 P3400-STATUS-TRACE. CL*36
|
||||
00751 IF FEST-TRACE-NO > ZEROS CL*36
|
||||
00752 MOVE FEST-TRACE-NO TO R120-TRACE-NO CL*36
|
||||
00753 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL*36
|
||||
00754 ELSE CL*36
|
||||
00755 MOVE ZEROS TO R120-TRACE-NO CL*36
|
||||
00756 END-IF. CL*36
|
||||
00757 CL*36
|
||||
00758 P3400-EXIT. CL*36
|
||||
00759 EXIT. CL*36
|
||||
00760 CL*21
|
||||
00761 P3500-WRITE-R120. CL*36
|
||||
00762 MOVE '120' TO R120-REC-TYPE. CL105
|
||||
00763 MOVE MPRF-EMP-NO TO R120-EMP-NO CL105
|
||||
00764 *RW1 CL147
|
||||
00765 IF MPRF-PRIMARY-IS-ENTITY-88 CL147
|
||||
00766 IF FEST-ENTITY-NAME NOT = MPRF-PRIMARY-NAME CL147
|
||||
00767 IF FEST-ENTITY-NAME <= SPACES CL147
|
||||
00768 MOVE SPACES TO R120-ENTITY-NAME CL147
|
||||
00769 ELSE CL147
|
||||
00770 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147
|
||||
00771 END-IF CL147
|
||||
00772 ELSE CL147
|
||||
00773 MOVE SPACES TO R120-ENTITY-NAME CL147
|
||||
00774 END-IF CL147
|
||||
00775 ELSE CL147
|
||||
00776 IF FEST-ENTITY-NAME NOT = MPRF-ENTITY-NAME CL147
|
||||
00777 IF FEST-ENTITY-NAME <= SPACES CL147
|
||||
00778 MOVE SPACES TO R120-ENTITY-NAME CL147
|
||||
00779 ELSE CL147
|
||||
00780 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147
|
||||
00781 END-IF CL147
|
||||
00782 ELSE CL147
|
||||
00783 MOVE SPACES TO R120-ENTITY-NAME CL147
|
||||
00784 END-IF CL147
|
||||
00785 END-IF. CL147
|
||||
00786 CL147
|
||||
00787 IF FEST-CONTACT-PHONE > SPACES CL144
|
||||
00788 MOVE FEST-CONTACT-AREA-CD TO R120-VOICE-AREA-CD CL144
|
||||
00789 MOVE FEST-CONTACT-PREFIX TO R120-VOICE-PREFIX CL144
|
||||
00790 MOVE FEST-CONTACT-SUFFIX TO R120-VOICE-SUFFIX CL144
|
||||
00791 MOVE FEST-CONTACT-EXT TO R120-VOICE-EXT CL144
|
||||
00792 ELSE CL144
|
||||
00793 MOVE SPACES TO R120-CONTACT-PHONE. CL144
|
||||
00794 *RW2 CL144
|
||||
00795 MOVE R120-REC TO RSKL-REC CL105
|
||||
00796 PERFORM S946-RPT-O THRU S946-EXIT CL105
|
||||
00797 ADD +1 TO WRK-R120-WRITE-CNT. CL105
|
||||
00798 CL226
|
||||
00799 P3500-EXIT. CL*36
|
||||
00800 EXIT. CL207
|
||||
00801 CL207
|
||||
00802 T0000-TERMINATE. CL146
|
||||
00803 CL212
|
||||
00804 DISPLAY ' '. CL221
|
||||
00805 DISPLAY ' '. CL221
|
||||
00806 CL*71
|
||||
00807 DISPLAY '*** EFTBD120 TERMINATION STATISTICS ***'. CL243
|
||||
00808 CL*71
|
||||
00809 DISPLAY ' '. CL237
|
||||
00810 DISPLAY ' EFT-STATUS-(01) RECS PASSED FROM BD100 :' CL253
|
||||
00811 WRK-STATUS-READ-CNT. CL242
|
||||
00812 CL*98
|
||||
00813 DISPLAY ' '. CL205
|
||||
00814 CL195
|
||||
00815 DISPLAY ' T002 MTAD - BUSINESS TRANSACTIONS WRITTEN :' CL*37
|
||||
00816 WRK-T002-ADDR-CNT. CL240
|
||||
00817 CL205
|
||||
00818 DISPLAY ' T002 MOPO - CONTACT TRANSACTIONS WRITTEN :' CL*41
|
||||
00819 WRK-T002-CONTACT-CNT. CL240
|
||||
00820 CL205
|
||||
00821 DISPLAY ' '. CL205
|
||||
00822 CL210
|
||||
00823 DISPLAY ' REPORT RECS TYPE(120) WRITTEN TO ERROR FILE :' CL*51
|
||||
00824 WRK-R120-WRITE-CNT. CL*21
|
||||
00825 CL*41
|
||||
00826 DISPLAY ' EDIT ERRORS TYPE(907) WRITTEN TO ERROR FILE :' CL*41
|
||||
00827 WRK-R907-REC-CNT. CL*41
|
||||
00828 CL210
|
||||
00829 DISPLAY ' '. CL210
|
||||
00830 CL226
|
||||
00831 T0000-EXIT. CL146
|
||||
00832 EXIT. CL146
|
||||
00833 CL*59
|
||||
00834 S001-FROM-FED-8. CL108
|
||||
00835 SET L001-FROM-FED-8 TO TRUE. CL108
|
||||
00836 GO TO S001-DATE. CL108
|
||||
00837 CL108
|
||||
00838 S001-FROM-ABS-DAY. CL108
|
||||
00839 SET L001-FROM-ABS-DAY TO TRUE. CL108
|
||||
00840 GO TO S001-DATE. CL108
|
||||
00841 CL108
|
||||
00842 S001-FROM-CAL-6. CL108
|
||||
00843 SET L001-FROM-CAL-6 TO TRUE. CL108
|
||||
00844 GO TO S001-DATE. CL108
|
||||
00845 CL108
|
||||
00846 S001-DATE. CL108
|
||||
00847 CALL 'DTSBU001' USING L001-LINK-AREA. CL108
|
||||
00848 S001-EXIT. CL108
|
||||
00849 EXIT. CL108
|
||||
00850 CL*15
|
||||
00851 S004-FROM-3. CL*24
|
||||
00852 SET L004-FROM-3 TO TRUE. CL*24
|
||||
00853 GO TO S004-YRQ. CL*24
|
||||
00854 CL*24
|
||||
00855 S004-YRQ. CL*24
|
||||
00856 CALL 'DTSBU004' USING L004-LINK-AREA. CL*24
|
||||
00857 CL*24
|
||||
00858 S004-EXIT. CL*24
|
||||
00859 EXIT. CL*24
|
||||
00860 CL*24
|
||||
00861 S005-SYS-DATE. CL*61
|
||||
00862 CALL 'DTSBU005' USING L005-COMM-AREA. CL*61
|
||||
00863 CL*61
|
||||
00864 S005-EXIT. CL*61
|
||||
00865 EXIT. CL*61
|
||||
00866 CL*17
|
||||
00867 S072-ADDRESS-EDIT. CL242
|
||||
00868 CALL 'DTSBU072' USING L072-LINK-AREA. CL242
|
||||
00869 CL242
|
||||
00870 S072-EXIT. CL242
|
||||
00871 EXIT. CL242
|
||||
00872 CL*15
|
||||
00873 S076-NAME. CL126
|
||||
00874 CALL 'DTSBU076' USING L076-LINK-AREA. CL126
|
||||
00875 CL*15
|
||||
00876 S076-EXIT. CL126
|
||||
00877 EXIT. CL*15
|
||||
00878 CL*70
|
||||
00879 S910-READ. CL*70
|
||||
00880 SET L910-READ-88 TO TRUE. CL*70
|
||||
00881 GO TO S910-MSTR-IO. CL*70
|
||||
00882 CL*70
|
||||
00883 S910-START-BROWSE. CL*70
|
||||
00884 SET L910-START-BROWSE-88 TO TRUE. CL*70
|
||||
00885 GO TO S910-MSTR-IO. CL*70
|
||||
00886 CL*13
|
||||
00887 S910-READ-NEXT. CL*70
|
||||
00888 SET L910-READ-NEXT-88 TO TRUE. CL*70
|
||||
00889 GO TO S910-MSTR-IO. CL*70
|
||||
00890 CL*70
|
||||
00891 S910-COUNT. CL*70
|
||||
00892 SET L910-COUNT-88 TO TRUE. CL*70
|
||||
00893 GO TO S910-MSTR-IO. CL*70
|
||||
00894 CL*70
|
||||
00895 S910-MSTR-IO. CL*70
|
||||
00896 CALL 'DTSBU910' USING L910-LINK-AREA CL*70
|
||||
00897 MSKL-REC. CL*70
|
||||
00898 S910-EXIT. CL*70
|
||||
00899 EXIT. CL*70
|
||||
00900 CL*80
|
||||
00901 S927B-WRITE. CL238
|
||||
00902 SET L927-WRITE-88 TO TRUE. CL166
|
||||
00903 CALL 'DTSBU927' USING L927-LINK-AREA CL238
|
||||
00904 TSKL-REC. CL238
|
||||
00905 CL238
|
||||
00906 S927B-EXIT. CL238
|
||||
00907 EXIT. CL238
|
||||
00908 CL161
|
||||
00909 S946-RPT-O. CL226
|
||||
00910 CALL 'DTSBU946' USING RSKL-REC. CL252
|
||||
00911 GO TO S946-EXIT. CL**6
|
||||
00912 CL*42
|
||||
00913 S946-ERROR. CL**6
|
||||
00914 ADD +1 TO WRK-R907-REC-CNT. CL*43
|
||||
00915 MOVE FEST-EMP-NO TO F907-EMP-NO. CL**6
|
||||
00916 MOVE '34' TO F907-GOV1-RECID. CL*34
|
||||
00917 MOVE 'EFTBD120 ' TO F907-MODULE-NAME. CL*42
|
||||
00918 CALL 'DTSBU946' USING F907-REC. CL*42
|
||||
00919 CL*42
|
||||
00920 S946-EXIT. CL226
|
||||
00921 EXIT. CL226
|
||||
00922 CL226
|
||||
00923 S999-ABEND. CL146
|
||||
00924 DISPLAY '*** EFTBD120 ABENDING : ' CL243
|
||||
00925 WRK-ABEND-MSG. CL*83
|
||||
00926 CL146
|
||||
00927 CALL 'DTSBU999' USING WRK-ABEND-CD. CL146
|
||||
00928 S999-EXIT. CL146
|
||||
00929 EXIT. CL146
|
||||
00930 CL*42
|
||||
Reference in New Issue
Block a user