DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
557
Batch/DTSBX159.cob
Normal file
557
Batch/DTSBX159.cob
Normal file
@ -0,0 +1,557 @@
|
||||
00001 IDENTIFICATION DIVISION. 07/09/18
|
||||
00002 PROGRAM-ID. DTSBN070. DTSBX159
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV001
|
||||
00004 DATE-WRITTEN. DECEMBER 1998. DTSBX159
|
||||
00005 DATE-COMPILED. DTSBX159
|
||||
00006 SKIP3 DTSBX159
|
||||
00007 ***** DTSBX159
|
||||
00008 * DTSBX159
|
||||
00009 * FUNCTION: ADD NOTE PAD ENTRY FOR CREDIT REFUND DTSBX159
|
||||
00010 * ISSUES DTSBX159
|
||||
00011 * DTSBX159
|
||||
00012 * DTSBX159
|
||||
00013 ***** DTSBX159
|
||||
00014 SKIP3 DTSBX159
|
||||
00015 ENVIRONMENT DIVISION. DTSBX159
|
||||
00016 INPUT-OUTPUT SECTION. DTSBX159
|
||||
00017 SKIP3 DTSBX159
|
||||
00018 FILE-CONTROL. DTSBX159
|
||||
00019 SKIP2 DTSBX159
|
||||
00020 SELECT IN-FILE ASSIGN TO DTSIZ058 DTSBX159
|
||||
00021 FILE STATUS IS Z058-STATUS. DTSBX159
|
||||
00022 SKIP2 DTSBX159
|
||||
00023 DATA DIVISION. DTSBX159
|
||||
00024 FILE SECTION. DTSBX159
|
||||
00025 FD IN-FILE. DTSBX159
|
||||
00026 01 IN-REC. DTSBX159
|
||||
00027 05 IN-REC-TYPE PIC X(04). DTSBX159
|
||||
00028 05 FILLER PIC X(01). DTSBX159
|
||||
00029 05 IN-EMP-NO PIC X(06). DTSBX159
|
||||
00030 05 FILLER PIC X(01). DTSBX159
|
||||
00031 05 IN-BATCH PIC X(05). DTSBX159
|
||||
00032 05 FILLER PIC X(01). DTSBX159
|
||||
00033 05 IN-ITEM-NO PIC X(03). DTSBX159
|
||||
00034 05 FILLER PIC X(01). DTSBX159
|
||||
00035 05 IN-OPERID PIC X(30). DTSBX159
|
||||
00036 05 FILLER PIC X(01). DTSBX159
|
||||
00037 05 IN-DATE PIC X(10). DTSBX159
|
||||
00038 05 FILLER PIC X(01). DTSBX159
|
||||
00039 05 IN-SUBJECT PIC X(02). DTSBX159
|
||||
00040 05 FILLER PIC X(01). DTSBX159
|
||||
00041 05 IN-MESSAGE PIC X(500). DTSBX159
|
||||
00042 SKIP3 DTSBX159
|
||||
00043 EJECT DTSBX159
|
||||
00044 WORKING-STORAGE SECTION. DTSBX159
|
||||
000445 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX159 07/09/18'. DTSBX159
|
||||
00045 77 PAN-VALET PICTURE X(24) VALUE '042DTSBX159 07/03/18'. DTSBX159
|
||||
00046 SKIP3 DTSBX159
|
||||
00047 01 WRK-AREA. DTSBX159
|
||||
00048 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +057.DTSBX159
|
||||
00049 05 ABEND-MSG PIC X(60). DTSBX159
|
||||
00050 DTSBX159
|
||||
00051 05 W-IN-QTR PIC S9(05) COMP-3. DTSBX159
|
||||
00052 05 HOLD-LAST-USED-BATCH-NO PIC S9(05) COMP-3. DTSBX159
|
||||
00053 DTSBX159
|
||||
00054 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX159'.DTSBX159
|
||||
00055 05 Z057-STATUS PIC X(02). DTSBX159
|
||||
00056 88 Z057-FILE-OK-88 VALUE '00'. DTSBX159
|
||||
00057 DTSBX159
|
||||
00058 05 Z058-STATUS PIC X(02). DTSBX159
|
||||
00059 88 Z058-FILE-OK-88 VALUE '00'. DTSBX159
|
||||
00060 DTSBX159
|
||||
00061 05 SEQ PIC S9(07) COMP-3 VALUE +0. DTSBX159
|
||||
00062 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSBX159
|
||||
00063 05 WRK-UPDATE-CNT PIC S9(07) COMP-3. DTSBX159
|
||||
00064 05 WRK-EXCLUDE-CNT PIC S9(07) COMP-3. DTSBX159
|
||||
00065 05 WRK-INTEREST-AMT PIC S9(09)V99 COMP-3. DTSBX159
|
||||
00066 05 WRK-PENALTY-AMT PIC S9(09)V99 COMP-3. DTSBX159
|
||||
00067 05 WRK-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBX159
|
||||
00068 05 WRK-UI-BAL PIC S9(09)V99 COMP-3. DTSBX159
|
||||
00069 DTSBX159
|
||||
00070 05 WRK-OUT-REC. DTSBX159
|
||||
00071 10 OUT-EMP PIC 9(06). DTSBX159
|
||||
00072 10 FILLER PIC X(01) VALUE ','. DTSBX159
|
||||
00073 10 OUT-QTR PIC X(06). DTSBX159
|
||||
00074 10 FILLER PIC X(01) VALUE ','. DTSBX159
|
||||
00075 10 OUT-BATCH PIC 9(05). DTSBX159
|
||||
00076 10 FILLER PIC X(01) VALUE ','. DTSBX159
|
||||
00077 10 OUT-ITEM PIC 9(03). DTSBX159
|
||||
00078 DTSBX159
|
||||
00079 05 WRK-MQTR-CNT PIC S9(07) COMP-3. DTSBX159
|
||||
00080 05 EMP-ACCT-DISP PIC 9(06). DTSBX159
|
||||
00081 05 WRK-TIMELY-PMT-AREA. DTSBX159
|
||||
00082 10 WRK-ERROR-IND PIC X(01). DTSBX159
|
||||
00083 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX159
|
||||
00084 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX159
|
||||
00085 10 WRK-MPAY-FOUND-IND PIC X(01). DTSBX159
|
||||
00086 88 WRK-MPAY-FOUND-YES VALUE 'Y'. DTSBX159
|
||||
00087 88 WRK-MPAY-FOUND-NO VALUE 'N'. DTSBX159
|
||||
00088 10 WRK-MRPT-FOUND-IND PIC X(01). DTSBX159
|
||||
00089 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSBX159
|
||||
00090 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSBX159
|
||||
00091 10 WRK-EMP-SELECTED-IND PIC X(01). DTSBX159
|
||||
00092 88 WRK-EMP-SELECTED-YES VALUE 'Y'. DTSBX159
|
||||
00093 88 WRK-EMP-SELECTED-NO VALUE 'N'. DTSBX159
|
||||
00094 10 WRK-SUPPL-RPT-IND PIC X(01). DTSBX159
|
||||
00095 88 WRK-SUPPL-RPT-YES VALUE 'Y'. DTSBX159
|
||||
00096 88 WRK-SUPPL-RPT-NO VALUE 'N'. DTSBX159
|
||||
00097 10 WRK-WITHDRAWN-RPT-IND PIC X(01). DTSBX159
|
||||
00098 88 WRK-WITHDRAWN-RPT-YES VALUE 'Y'. DTSBX159
|
||||
00099 88 WRK-WITHDRAWN-RPT-NO VALUE 'N'. DTSBX159
|
||||
00100 10 WRK-RPT-BATCH-NO PIC S9(05) COMP-3. DTSBX159
|
||||
00101 10 WRK-RPT-ITEM-NO PIC S9(03) COMP-3. DTSBX159
|
||||
00102 10 WRK-OPID PIC X(08). DTSBX159
|
||||
00103 DTSBX159
|
||||
00104 05 WRK-TIMELY-RPT-AREA. DTSBX159
|
||||
00105 10 WRK-RPT-RECEIVED-DATE PIC S9(09) COMP-3. DTSBX159
|
||||
00106 DTSBX159
|
||||
00107 05 WRK-SUBJ-MSG-LINE1. DTSBX159
|
||||
00108 10 FILLER PIC X(42) VALUE DTSBX159
|
||||
00109 'CREDIT ON HOLD RETURN MAIL FLAG '. DTSBX159
|
||||
00110 DTSBX159
|
||||
00111 05 WRK-SUBJ-MSG-LINE2. DTSBX159
|
||||
00112 10 FILLER PIC X(19) VALUE DTSBX159
|
||||
00113 'CREDIT ON HOLD BY '. DTSBX159
|
||||
00114 10 WRK-MSG-OPER-ID PIC X(30). DTSBX159
|
||||
00115 DTSBX159
|
||||
00116 DTSBX159
|
||||
00117 05 WRK-MNTE-MSG-LINE1. DTSBX159
|
||||
00118 10 WRK-MNTE-MSG-EAN PIC X(06). DTSBX159
|
||||
00119 10 FILLER PIC X(01). DTSBX159
|
||||
00120 10 WRK-MNTE-MSG-QTR PIC X(01). DTSBX159
|
||||
00121 10 FILLER PIC X(42) VALUE DTSBX159
|
||||
00122 ' '. DTSBX159
|
||||
00123 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00124 ' '. DTSBX159
|
||||
00125 05 WRK-MNTE-MSG-LINE2. DTSBX159
|
||||
00126 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00127 ' '. DTSBX159
|
||||
00128 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00129 ' '. DTSBX159
|
||||
00130 05 WRK-MNTE-MSG-LINE3. DTSBX159
|
||||
00131 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00132 ' '. DTSBX159
|
||||
00133 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00134 ' '. DTSBX159
|
||||
00135 DTSBX159
|
||||
00136 05 WRK-MNTE-MSG-LINE4. DTSBX159
|
||||
00137 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00138 ' '. DTSBX159
|
||||
00139 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00140 ' '. DTSBX159
|
||||
00141 05 WRK-MNTE-MSG-LINE5. DTSBX159
|
||||
00142 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00143 ' '. DTSBX159
|
||||
00144 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00145 ' '. DTSBX159
|
||||
00146 05 WRK-MNTE-MSG-LINE6. DTSBX159
|
||||
00147 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00148 ' '. DTSBX159
|
||||
00149 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00150 ' '. DTSBX159
|
||||
00151 05 WRK-MNTE-MSG-LINE7. DTSBX159
|
||||
00152 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00153 ' '. DTSBX159
|
||||
00154 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00155 ' '. DTSBX159
|
||||
00156 05 WRK-MNTE-MSG-LINE8. DTSBX159
|
||||
00157 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00158 ' '. DTSBX159
|
||||
00159 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00160 ' '. DTSBX159
|
||||
00161 05 WRK-MNTE-MSG-LINE9. DTSBX159
|
||||
00162 10 FILLER PIC X(48) VALUE DTSBX159
|
||||
00163 ' '. DTSBX159
|
||||
00164 10 FILLER PIC X(22) VALUE DTSBX159
|
||||
00165 ' '. DTSBX159
|
||||
00166 DTSBX159
|
||||
00167 05 WRK-MPRF-IND PIC X(01). DTSBX159
|
||||
00168 88 WRK-MPRF-OK VALUE 'Y'. DTSBX159
|
||||
00169 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX159
|
||||
00170 05 WRK-MQTR-IND PIC X(01). DTSBX159
|
||||
00171 88 WRK-MQTR-OK VALUE 'Y'. DTSBX159
|
||||
00172 88 WRK-MQTR-NO-REC VALUE 'N'. DTSBX159
|
||||
00173 05 WRK-MRPT-IND PIC X(01). DTSBX159
|
||||
00174 88 WRK-MRPT-OK VALUE 'Y'. DTSBX159
|
||||
00175 88 WRK-MRPT-NO-REC VALUE 'N'. DTSBX159
|
||||
00176 DTSBX159
|
||||
00177 05 WRK-T003-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX159
|
||||
00178 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBX159
|
||||
00179 DTSBX159
|
||||
00180 05 PARM-EOF-IND PIC X(01). DTSBX159
|
||||
00181 DTSBX159
|
||||
00182 05 WRK-EMP-NO PIC 9(06). DTSBX159
|
||||
00183 DTSBX159
|
||||
00184 05 WRK-TRACE-IND PIC X(01). DTSBX159
|
||||
00185 DTSBX159
|
||||
00186 05 WRK-MST-OPEN-IND PIC X(01). DTSBX159
|
||||
00187 DTSBX159
|
||||
00188 05 WRK-REF-OPEN-IND PIC X(01). DTSBX159
|
||||
00189 DTSBX159
|
||||
00190 EJECT DTSBX159
|
||||
00191 01 TSKL-REC. DTSBX159
|
||||
00192 ++INCLUDE DTSITSKL DTSBX159
|
||||
00193 DTSBX159
|
||||
00194 01 T003-REC. DTSBX159
|
||||
00195 ++INCLUDE DTSIT003 DTSBX159
|
||||
00196 DTSBX159
|
||||
00197 01 L005-LINK-AREA. DTSBX159
|
||||
00198 ++INCLUDE DTSIL005 DTSBX159
|
||||
00199 DTSBX159
|
||||
00200 01 L910-LINK-AREA. DTSBX159
|
||||
00201 ++INCLUDE DTSIL910 DTSBX159
|
||||
00202 EJECT DTSBX159
|
||||
00203 01 MSKL-REC. DTSBX159
|
||||
00204 ++INCLUDE DTSIMSKL DTSBX159
|
||||
00205 EJECT DTSBX159
|
||||
00206 01 MHDR-REC. DTSBX159
|
||||
00207 ++INCLUDE DTSIMHDR DTSBX159
|
||||
00208 EJECT DTSBX159
|
||||
00209 01 MPRF-REC. DTSBX159
|
||||
00210 ++INCLUDE DTSIMPRF DTSBX159
|
||||
00211 EJECT DTSBX159
|
||||
00212 01 MQTR-REC. DTSBX159
|
||||
00213 ++INCLUDE DTSIMQTR DTSBX159
|
||||
00214 EJECT DTSBX159
|
||||
00215 01 MRPT-REC. DTSBX159
|
||||
00216 ++INCLUDE DTSIMRPT DTSBX159
|
||||
00217 EJECT DTSBX159
|
||||
00218 01 MDST-REC. DTSBX159
|
||||
00219 ++INCLUDE DTSIMDST DTSBX159
|
||||
00220 EJECT DTSBX159
|
||||
00221 01 MPAY-REC. DTSBX159
|
||||
00222 ++INCLUDE DTSIMPAY DTSBX159
|
||||
00223 EJECT DTSBX159
|
||||
00224 01 MNTE-REC. DTSBX159
|
||||
00225 ++INCLUDE DTSIMNTE DTSBX159
|
||||
00226 EJECT DTSBX159
|
||||
00227 01 L923-LINK-AREA. DTSBX159
|
||||
00228 ++INCLUDE DTSIL923 DTSBX159
|
||||
00229 EJECT DTSBX159
|
||||
00230 01 ASKL-REC. DTSBX159
|
||||
00231 ++INCLUDE DTSIASKL DTSBX159
|
||||
00232 EJECT DTSBX159
|
||||
00233 01 AHDR-REC. DTSBX159
|
||||
00234 ++INCLUDE DTSIAHDR DTSBX159
|
||||
00235 EJECT DTSBX159
|
||||
00236 01 ARPT-REC. DTSBX159
|
||||
00237 ++INCLUDE DTSIARPT DTSBX159
|
||||
00238 EJECT DTSBX159
|
||||
00239 01 APAY-REC. DTSBX159
|
||||
00240 ++INCLUDE DTSIAPAY DTSBX159
|
||||
00241 EJECT DTSBX159
|
||||
00242 01 L927-LINK-AREA. DTSBX159
|
||||
00243 ++INCLUDE DTSIL927 DTSBX159
|
||||
00244 DTSBX159
|
||||
00245 01 L004-COMM-AREA. DTSBX159
|
||||
00246 ++INCLUDE DTSIL004 DTSBX159
|
||||
00247 EJECT DTSBX159
|
||||
00248 PROCEDURE DIVISION. DTSBX159
|
||||
00249 SKIP2 DTSBX159
|
||||
00250 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX159
|
||||
00251 DTSBX159
|
||||
00252 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX159
|
||||
00253 DTSBX159
|
||||
00254 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX159
|
||||
00255 SKIP2 DTSBX159
|
||||
00256 GOBACK. DTSBX159
|
||||
00257 EJECT DTSBX159
|
||||
00258 I0000-INITIATE. DTSBX159
|
||||
00259 SKIP2 DTSBX159
|
||||
00260 MOVE 'N' TO WRK-TRACE-IND. DTSBX159
|
||||
00261 DTSBX159
|
||||
00262 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBX159
|
||||
00263 DTSBX159
|
||||
00264 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX159
|
||||
00265 DTSBX159
|
||||
00266 I0000-EXIT. DTSBX159
|
||||
00267 EXIT. DTSBX159
|
||||
00268 DTSBX159
|
||||
00269 I2000-OPEN-FILES-1. DTSBX159
|
||||
00270 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX159
|
||||
00271 DTSBX159
|
||||
00272 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX159
|
||||
00273 DTSBX159
|
||||
00274 PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. DTSBX159
|
||||
00275 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. DTSBX159
|
||||
00276 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSBX159
|
||||
00277 DTSBX159
|
||||
00278 OPEN INPUT IN-FILE. DTSBX159
|
||||
00279 IF NOT Z058-FILE-OK-88 DTSBX159
|
||||
00280 DISPLAY 'INPUT FILE OPEN ERROR: ' Z058-STATUS DTSBX159
|
||||
00281 PERFORM S999-ABEND THRU S999-EXIT DTSBX159
|
||||
00282 END-IF. DTSBX159
|
||||
00283 DTSBX159
|
||||
00284 I2000-EXIT. DTSBX159
|
||||
00285 EXIT. DTSBX159
|
||||
00286 DTSBX159
|
||||
00287 DTSBX159
|
||||
00288 P0000-PROCESS. DTSBX159
|
||||
00289 READ IN-FILE AT END GO TO P0000-EXIT. DTSBX159
|
||||
00290 DTSBX159
|
||||
00291 MOVE +0 TO WRK-MPRF-CNT DTSBX159
|
||||
00292 WRK-EXCLUDE-CNT DTSBX159
|
||||
00293 WRK-UPDATE-CNT DTSBX159
|
||||
00294 WRK-INTEREST-AMT. DTSBX159
|
||||
00295 SET WRK-ERROR-NO-88 TO TRUE. DTSBX159
|
||||
00296 DTSBX159
|
||||
00297 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX159
|
||||
00298 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBX159
|
||||
00299 DTSBX159
|
||||
00300 MOVE +0 TO MSKL-EMP-NO. DTSBX159
|
||||
00301 DTSBX159
|
||||
00302 SET MPRF-PRF-88 TO TRUE. DTSBX159
|
||||
00303 MOVE IN-EMP-NO TO MPRF-EMP-NO DTSBX159
|
||||
00304 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX159
|
||||
00305 PERFORM S910-READ THRU S910-EXIT. DTSBX159
|
||||
00306 IF L910-OK-88 DTSBX159
|
||||
00307 MOVE MSKL-REC TO MPRF-REC DTSBX159
|
||||
00308 SET WRK-MPRF-OK TO TRUE DTSBX159
|
||||
00309 ELSE DTSBX159
|
||||
00310 DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSBX159
|
||||
00311 SET L910-NO-REC-88 TO TRUE DTSBX159
|
||||
00312 GO TO P0000-EXIT. DTSBX159
|
||||
00313 DTSBX159
|
||||
00314 PERFORM P1000-READ-NEXT THRU P1000-EXIT DTSBX159
|
||||
00315 UNTIL WRK-MPRF-NO-REC DTSBX159
|
||||
00316 OR WRK-ERROR-YES-88. DTSBX159
|
||||
00317 P0000-EXIT. DTSBX159
|
||||
00318 EXIT. DTSBX159
|
||||
00319 EJECT DTSBX159
|
||||
00320 P1000-READ-NEXT. DTSBX159
|
||||
00321 DTSBX159
|
||||
00322 MOVE MSKL-REC TO MPRF-REC. DTSBX159
|
||||
00323 ADD +1 TO WRK-MPRF-CNT DTSBX159
|
||||
00324 PERFORM P5200-ADD-MNTE THRU P5200-EXIT DTSBX159
|
||||
00325 READ IN-FILE AT END DTSBX159
|
||||
00326 SET WRK-MPRF-NO-REC TO TRUE DTSBX159
|
||||
00327 GO TO P0000-EXIT. DTSBX159
|
||||
00328 DTSBX159
|
||||
00329 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX159
|
||||
00330 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBX159
|
||||
00331 DTSBX159
|
||||
00332 MOVE +0 TO MSKL-EMP-NO. DTSBX159
|
||||
00333 DTSBX159
|
||||
00334 SET MPRF-PRF-88 TO TRUE. DTSBX159
|
||||
00335 MOVE IN-EMP-NO TO MPRF-EMP-NO DTSBX159
|
||||
00336 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBX159
|
||||
00337 DTSBX159
|
||||
00338 PERFORM S910-READ THRU S910-EXIT. DTSBX159
|
||||
00339 DTSBX159
|
||||
00340 IF NOT L910-OK-88 DTSBX159
|
||||
00341 DISPLAY ' EMPLOYER NOT FOUND ' IN-EMP-NO DTSBX159
|
||||
00342 ELSE DTSBX159
|
||||
00343 SET WRK-MPRF-OK TO TRUE DTSBX159
|
||||
00344 MOVE MSKL-REC TO MPRF-REC. DTSBX159
|
||||
00345 DTSBX159
|
||||
00346 P1000-EXIT. DTSBX159
|
||||
00347 EXIT. DTSBX159
|
||||
00348 DTSBX159
|
||||
00349 P5200-ADD-MNTE. DTSBX159
|
||||
00350 MOVE LENGTH OF T003-REC TO T003-LENGTH. DTSBX159
|
||||
00351 MOVE '003' TO T003-REC-TYPE. DTSBX159
|
||||
00352 MOVE 'SYSTEM ' TO T003-ORIGIN. DTSBX159
|
||||
00353 MOVE L005-DATE TO T003-SYS-DATE. DTSBX159
|
||||
00354 MOVE L005-TIME TO T003-SYS-TIME. DTSBX159
|
||||
00355 SET T003-ADD-MNTE-88 TO TRUE. DTSBX159
|
||||
00356 DTSBX159
|
||||
00357 MOVE LOW-VALUES TO DTSBX159
|
||||
00358 MNTE-KEY-AREA. DTSBX159
|
||||
00359 MOVE MPRF-EMP-NO TO MNTE-EMP-NO. DTSBX159
|
||||
00360 SET MNTE-NTE-88 TO TRUE. DTSBX159
|
||||
00361 MOVE +0 TO MNTE-PURGE-DATE. DTSBX159
|
||||
00362 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX159
|
||||
00363 DTSBX159
|
||||
00364 MOVE L005-DATE TO MNTE-ESTB-DATE DTSBX159
|
||||
00365 MNTE-CHNG-DATE. DTSBX159
|
||||
00366 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBX159
|
||||
00367 MNTE-DATA-ESTB-ABSTIME DTSBX159
|
||||
00368 MNTE-CHNG-ABSTIME. DTSBX159
|
||||
00369 MOVE IN-OPERID TO MNTE-ESTB-OP-ID DTSBX159
|
||||
00370 MNTE-CHNG-OP-ID. DTSBX159
|
||||
00371 IF IN-SUBJECT = 01 DTSBX159
|
||||
00372 MOVE WRK-SUBJ-MSG-LINE1 TO MNTE-SUBJECT DTSBX159
|
||||
00373 ELSE DTSBX159
|
||||
00374 MOVE IN-OPERID TO WRK-MSG-OPER-ID DTSBX159
|
||||
00375 MOVE WRK-SUBJ-MSG-LINE2 TO MNTE-SUBJECT DTSBX159
|
||||
00376 END-IF. DTSBX159
|
||||
00377 DTSBX159
|
||||
00378 MOVE IN-DATE TO WRK-MNTE-MSG-LINE1(1:10) DTSBX159
|
||||
00379 MOVE IN-BATCH TO WRK-MNTE-MSG-LINE1(12:5) DTSBX159
|
||||
00380 MOVE IN-ITEM-NO TO WRK-MNTE-MSG-LINE1(18:3) DTSBX159
|
||||
00381 MOVE +10 TO MNTE-TEXT-CNT. DTSBX159
|
||||
00382 DTSBX159
|
||||
00383 MOVE IN-MESSAGE(1:70) TO WRK-MNTE-MSG-LINE2. DTSBX159
|
||||
00384 MOVE IN-MESSAGE(71:70) TO WRK-MNTE-MSG-LINE3. DTSBX159
|
||||
00385 MOVE IN-MESSAGE(141:70) TO WRK-MNTE-MSG-LINE4. DTSBX159
|
||||
00386 MOVE IN-MESSAGE(211:70) TO WRK-MNTE-MSG-LINE5. DTSBX159
|
||||
00387 MOVE IN-MESSAGE(281:70) TO WRK-MNTE-MSG-LINE6. DTSBX159
|
||||
00388 MOVE IN-MESSAGE(351:70) TO WRK-MNTE-MSG-LINE7. DTSBX159
|
||||
00389 MOVE IN-MESSAGE(421:70) TO WRK-MNTE-MSG-LINE8. DTSBX159
|
||||
00390 MOVE IN-MESSAGE(491:9) TO WRK-MNTE-MSG-LINE9. DTSBX159
|
||||
00391 MOVE WRK-MNTE-MSG-LINE1 TO MNTE-TEXT (1). DTSBX159
|
||||
00392 MOVE WRK-MNTE-MSG-LINE2 TO MNTE-TEXT (2). DTSBX159
|
||||
00393 MOVE WRK-MNTE-MSG-LINE3 TO MNTE-TEXT (3). DTSBX159
|
||||
00394 MOVE WRK-MNTE-MSG-LINE4 TO MNTE-TEXT (4). DTSBX159
|
||||
00395 MOVE WRK-MNTE-MSG-LINE5 TO MNTE-TEXT (5). DTSBX159
|
||||
00396 MOVE WRK-MNTE-MSG-LINE6 TO MNTE-TEXT (6). DTSBX159
|
||||
00397 MOVE WRK-MNTE-MSG-LINE7 TO MNTE-TEXT (7). DTSBX159
|
||||
00398 MOVE WRK-MNTE-MSG-LINE8 TO MNTE-TEXT (8). DTSBX159
|
||||
00399 MOVE WRK-MNTE-MSG-LINE9 TO MNTE-TEXT (9). DTSBX159
|
||||
00400 DTSBX159
|
||||
00401 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBX159
|
||||
00402 DTSBX159
|
||||
00403 MOVE MNTE-REC TO T003-MNTE-REC. DTSBX159
|
||||
00404 DTSBX159
|
||||
00405 DTSBX159
|
||||
00406 MOVE T003-REC TO TSKL-REC. DTSBX159
|
||||
00407 DTSBX159
|
||||
00408 PERFORM S927-WRITE THRU S927-EXIT. DTSBX159
|
||||
00409 ADD +1 TO WRK-T003-CNT. DTSBX159
|
||||
00410 DTSBX159
|
||||
00411 DTSBX159
|
||||
00412 P5200-EXIT. DTSBX159
|
||||
00413 EXIT. DTSBX159
|
||||
00414 DTSBX159
|
||||
00415 SKIP3 DTSBX159
|
||||
00416 T0000-TERMINATE. DTSBX159
|
||||
00417 DTSBX159
|
||||
00418 PERFORM S923-CLOSE THRU S923-EXIT. DTSBX159
|
||||
00419 PERFORM S927-CLOSE THRU S927-EXIT. DTSBX159
|
||||
00420 DTSBX159
|
||||
00421 DTSBX159
|
||||
00422 DISPLAY ' '. DTSBX159
|
||||
00423 DTSBX159
|
||||
00424 DTSBX159
|
||||
00425 DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DTSBX159
|
||||
00426 WRK-MPRF-CNT. DTSBX159
|
||||
00427 DTSBX159
|
||||
00428 DISPLAY 'NOTEPAD RECORDS CREATED : 'DTSBX159
|
||||
00429 WRK-T003-CNT. DTSBX159
|
||||
00430 DTSBX159
|
||||
00431 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX159
|
||||
00432 CLOSE IN-FILE. DTSBX159
|
||||
00433 DTSBX159
|
||||
00434 T0000-EXIT. DTSBX159
|
||||
00435 EXIT. DTSBX159
|
||||
00436 EJECT DTSBX159
|
||||
00437 DTSBX159
|
||||
00438 DTSBX159
|
||||
00439 DTSBX159
|
||||
00440 S005-FROM-SYS. DTSBX159
|
||||
00441 SET L005-FROM-SYS TO TRUE. DTSBX159
|
||||
00442 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX159
|
||||
00443 DTSBX159
|
||||
00444 S005-EXIT. DTSBX159
|
||||
00445 EXIT. DTSBX159
|
||||
00446 DTSBX159
|
||||
00447 S910-OPEN-READ. DTSBX159
|
||||
00448 SET L910-OPEN-READ-88 TO TRUE. DTSBX159
|
||||
00449 GO TO S910-MSTR-IO. DTSBX159
|
||||
00450 DTSBX159
|
||||
00451 S910-OPEN-UPDATE-NO-AIX. DTSBX159
|
||||
00452 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX159
|
||||
00453 GO TO S910-MSTR-IO. DTSBX159
|
||||
00454 DTSBX159
|
||||
00455 S910-OPEN-UPDATE-HDR. DTSBX159
|
||||
00456 SET L910-OPEN-UPDATE-HDR-88 TO TRUE. DTSBX159
|
||||
00457 GO TO S910-MSTR-IO. DTSBX159
|
||||
00458 DTSBX159
|
||||
00459 S910-READ. DTSBX159
|
||||
00460 SET L910-READ-88 TO TRUE. DTSBX159
|
||||
00461 GO TO S910-MSTR-IO. DTSBX159
|
||||
00462 DTSBX159
|
||||
00463 S910-START-BROWSE. DTSBX159
|
||||
00464 SET L910-START-BROWSE-88 TO TRUE. DTSBX159
|
||||
00465 GO TO S910-MSTR-IO. DTSBX159
|
||||
00466 DTSBX159
|
||||
00467 S910-READ-NEXT. DTSBX159
|
||||
00468 SET L910-READ-NEXT-88 TO TRUE. DTSBX159
|
||||
00469 GO TO S910-MSTR-IO. DTSBX159
|
||||
00470 DTSBX159
|
||||
00471 S910-COUNT. DTSBX159
|
||||
00472 SET L910-COUNT-88 TO TRUE. DTSBX159
|
||||
00473 GO TO S910-MSTR-IO. DTSBX159
|
||||
00474 DTSBX159
|
||||
00475 S910-REWRITE. DTSBX159
|
||||
00476 SET L910-REWRITE-88 TO TRUE. DTSBX159
|
||||
00477 GO TO S910-MSTR-IO. DTSBX159
|
||||
00478 DTSBX159
|
||||
00479 S910-DELETE. DTSBX159
|
||||
00480 SET L910-DELETE-88 TO TRUE. DTSBX159
|
||||
00481 GO TO S910-MSTR-IO. DTSBX159
|
||||
00482 DTSBX159
|
||||
00483 S910-CLOSE. DTSBX159
|
||||
00484 SET L910-CLOSE-88 TO TRUE. DTSBX159
|
||||
00485 GO TO S910-MSTR-IO. DTSBX159
|
||||
00486 DTSBX159
|
||||
00487 S910-MSTR-IO. DTSBX159
|
||||
00488 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX159
|
||||
00489 MSKL-REC. DTSBX159
|
||||
00490 S910-EXIT. DTSBX159
|
||||
00491 EXIT. DTSBX159
|
||||
00492 SKIP3 DTSBX159
|
||||
00493 S923-OPEN-UPDATE. DTSBX159
|
||||
00494 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX159
|
||||
00495 GO TO S923-ATC-IO. DTSBX159
|
||||
00496 DTSBX159
|
||||
00497 S923-READ. DTSBX159
|
||||
00498 SET L923-READ-88 TO TRUE. DTSBX159
|
||||
00499 GO TO S923-ATC-IO. DTSBX159
|
||||
00500 DTSBX159
|
||||
00501 S923-START-BROWSE. DTSBX159
|
||||
00502 SET L923-START-BROWSE-88 TO TRUE. DTSBX159
|
||||
00503 GO TO S923-ATC-IO. DTSBX159
|
||||
00504 DTSBX159
|
||||
00505 S923-READ-NEXT. DTSBX159
|
||||
00506 SET L923-READ-NEXT-88 TO TRUE. DTSBX159
|
||||
00507 GO TO S923-ATC-IO. DTSBX159
|
||||
00508 DTSBX159
|
||||
00509 S923-WRITE. DTSBX159
|
||||
00510 DISPLAY 'S923 WRITE ' DTSBX159
|
||||
00511 SET L923-WRITE-88 TO TRUE. DTSBX159
|
||||
00512 GO TO S923-ATC-IO. DTSBX159
|
||||
00513 DTSBX159
|
||||
00514 S923-REWRITE. DTSBX159
|
||||
00515 SET L923-REWRITE-88 TO TRUE. DTSBX159
|
||||
00516 GO TO S923-ATC-IO. DTSBX159
|
||||
00517 DTSBX159
|
||||
00518 S923-DELETE. DTSBX159
|
||||
00519 SET L923-DELETE-88 TO TRUE. DTSBX159
|
||||
00520 GO TO S923-ATC-IO. DTSBX159
|
||||
00521 DTSBX159
|
||||
00522 S923-CLOSE. DTSBX159
|
||||
00523 SET L923-CLOSE-88 TO TRUE. DTSBX159
|
||||
00524 GO TO S923-ATC-IO. DTSBX159
|
||||
00525 DTSBX159
|
||||
00526 S923-ATC-IO. DTSBX159
|
||||
00527 DISPLAY 'DTSBU923 ' DTSBX159
|
||||
00528 DISPLAY 'L923 LINK AREA ' L923-LINK-AREA DTSBX159
|
||||
00529 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX159
|
||||
00530 ASKL-REC. DTSBX159
|
||||
00531 S923-EXIT. DTSBX159
|
||||
00532 EXIT. DTSBX159
|
||||
00533 SKIP3 DTSBX159
|
||||
00534 S927-OPEN-UPDATE. DTSBX159
|
||||
00535 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX159
|
||||
00536 GO TO S927-BTC-O. DTSBX159
|
||||
00537 DTSBX159
|
||||
00538 S927-WRITE. DTSBX159
|
||||
00539 SET L927-WRITE-88 TO TRUE. DTSBX159
|
||||
00540 GO TO S927-BTC-O. DTSBX159
|
||||
00541 DTSBX159
|
||||
00542 S927-CLOSE. DTSBX159
|
||||
00543 SET L927-CLOSE-88 TO TRUE. DTSBX159
|
||||
00544 GO TO S927-BTC-O. DTSBX159
|
||||
00545 DTSBX159
|
||||
00546 S927-BTC-O. DTSBX159
|
||||
00547 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX159
|
||||
00548 TSKL-REC. DTSBX159
|
||||
00549 S927-EXIT. DTSBX159
|
||||
00550 EXIT. DTSBX159
|
||||
00551 DTSBX159
|
||||
00552 SKIP3 DTSBX159
|
||||
00553 S999-ABEND. DTSBX159
|
||||
00554 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX159
|
||||
00555 S999-EXIT. DTSBX159
|
||||
00556 EXIT. DTSBX159
|
||||
Reference in New Issue
Block a user