00001 IDENTIFICATION DIVISION. 10/18/06 00002 PROGRAM-ID. DTSCU221. DTSCU221 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008 00004 DATE-WRITTEN. DECEMBER 1991. DTSCU221 00005 DATE-COMPILED. DTSCU221 00006 SKIP3 DTSCU221 00007 ***** DTSCU221 00008 * DTSCU221 00009 * FUNCTION: PRF-UPDATE FIELDS MAINTENANCE. DTSCU221 00010 * DTSCU221 00011 * DTSCU221 00012 * MODIFICATION LOG: DTSCU221 00013 * DTSCU221 00014 * 12/01/91 INITIAL DEVELOPMENT. DTSCU221 00015 * WORK ORDER: PROGRAMMER: TCL DTSCU221 00016 * DTSCU221 00017 * 04/18/94 MODIFIED FOR MONTANA. DTSCU221 00018 * WORK ORDER: PROGRAMMER: EHH DTSCU221 00019 * DTSCU221 00020 * 09/09/1998 REVIEWED AND MODIFIED FOR DC. DTSCU221 00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCU221 00022 * DTSCU221 00023 * 09/15/2006 ADDED BATCH AND ITEM NUMBERS FOR TRACKING DTSCU221 00024 * UPDATES TO ACCOUNTING TRANSACTIONS. DTSCU221 00025 * ADDED R906-ONLY OPTION FOR THE SAME PURPOSE - DTSCU221 00026 * NO MPRF UPDATES ARE INVOLVED. DTSCU221 00027 * REFERENCE: ACTIVITY TRACKING PROGRAMMER: GD DTSCU221 00028 * DTSCU221 00029 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU221 00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU221 00031 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU221 00032 * DTSCU221 00033 * DTSCU221 00034 * DESCRIPTION: DTSCU221 00035 * DTSCU221 00036 * MAINTAIN THE MPRF-ONLINE-UPDATE-* FIELDS OF THE MPRF RECORD. DTSCU221 00037 * DTSCU221 00038 * IF L221-START-UPDATE DTSCU221 00039 * READ UPDATE MPRFRF RECORD DTSCU221 00040 * IF FILE CLOSED DTSCU221 00041 * MOVE '9' TO L221-RESULT-IND DTSCU221 00042 * ELSE DTSCU221 00043 * IF NO RECORD FOUND DTSCU221 00044 * MOVE '4' TO L221-RESULT-IND DTSCU221 00045 * ELSE DTSCU221 00046 * IF MPRF-UPDATE-ACTIVE-88 DTSCU221 00047 * MOVE '2' TO L221-RESULT-IND DTSCU221 00048 * REWRITE MPRF-RECORD DTSCU221 00049 * ELSE DTSCU221 00050 * IF MPRF-PURGE-ALL-YES-88 DTSCU221 00051 * MOVE '3' TO L221-RESULT-IND DTSCU221 00052 * REWRITE MPRF-RECORD DTSCU221 00053 * ELSE DTSCU221 00054 * IF L221-SCR-ABSTIME < MPRF-UPDATE-END-ABSTIME DTSCU221 00055 * MOVE '1' TO L221-RESULT-IND DTSCU221 00056 * REWRITE MPRF-RECORD DTSCU221 00057 * ELSE DTSCU221 00058 * MOVE '0' TO L221-RESULT-IND DTSCU221 00059 * LINK TO DTSCU005 TO GET SYSTEM ABSTIME DTSCU221 00060 * MOVE SYSTEM ABSTIME TO MPRF-UPDATE-START-ABSTIME DTSCU221 00061 * MOVE ALL 9 TO MRPF-UPDATE-END-ABSTIME DTSCU221 00062 * MOVE L221-UPDATE-* FIELDS TO MPRF-UPDATE-* FIELDS DTSCU221 00063 * REWRITE MPRF RECORD DTSCU221 00064 * ELSE DTSCU221 00065 * READ UPDATE MPRF RECORD DTSCU221 00066 * IF FILE CLOSED DTSCU221 00067 * MOVE '9' TO L221-RESULT-IND DTSCU221 00068 * ELSE DTSCU221 00069 * IF NO RECORD FOUND DTSCU221 00070 * MOVE '3' TO L221-RESULT-IND DTSCU221 00071 * ELSE DTSCU221 00072 * MOVE '0' TO L221-RESULT-IND DTSCU221 00073 * MOVE 0 TO MPRF-UPDATE-START-ABSTIME DTSCU221 00074 * LINK TO DTSCU005 TO GET SYSTEM ABSTIME DTSCU221 00075 * MOVE SYSTEM ABSTIME TO MPRF-UPDATE-END-ABSTIME DTSCU221 00076 * REWRITE MPRF-RECORD DTSCU221 00077 * WRITE R906 RECORD TO OLA FILE. DTSCU221 00078 * DTSCU221 00079 ***** DTSCU221 00080 SKIP3 DTSCU221 00081 ENVIRONMENT DIVISION. DTSCU221 00082 SKIP3 DTSCU221 00083 DATA DIVISION. DTSCU221 00084 SKIP3 DTSCU221 00085 WORKING-STORAGE SECTION. DTSCU221 000855 77 PAN-VALET PICTURE X(24) VALUE '008DTSCU221 10/18/06'. DTSCU221 00086 SKIP3 DTSCU221 00087 01 WRK-AREA. DTSCU221 00088 05 WRK-ABEND-CD PIC X(04) VALUE 'U221'. DTSCU221 00089 EJECT DTSCU221 00090 01 L005-COMM-AREA. DTSCU221 00091 ++INCLUDE DTSIL005 DTSCU221 00092 EJECT DTSCU221 00093 01 L810-COMM-AREA. DTSCU221 00094 05 L810-CONTROL-BLOCK. DTSCU221 00095 ++INCLUDE DTSIL810 DTSCU221 00096 SKIP3 DTSCU221 00097 05 MSKL-REC. DTSCU221 00098 ++INCLUDE DTSIMSKL DTSCU221 00099 SKIP3 DTSCU221 00100 05 MPRF-REC REDEFINES MSKL-REC. DTSCU221 00101 ++INCLUDE DTSIMPRF DTSCU221 00102 EJECT DTSCU221 00103 01 L825-COMM-AREA. DTSCU221 00104 05 L825-CONTROL-BLOCK. DTSCU221 00105 ++INCLUDE DTSIL825 DTSCU221 00106 SKIP3 DTSCU221 00107 05 R906-REC. DTSCU221 00108 ++INCLUDE DTSIR906 DTSCU221 00109 EJECT DTSCU221 00110 01 CECD-LITERALS. DTSCU221 00111 ++INCLUDE DTSICECD DTSCU221 00112 EJECT DTSCU221 00113 LINKAGE SECTION. DTSCU221 00114 SKIP3 DTSCU221 00115 01 DFHCOMMAREA. DTSCU221 00116 ++INCLUDE DTSIL221 DTSCU221 00117 EJECT DTSCU221 00118 PROCEDURE DIVISION. DTSCU221 00119 DTSCU221 00120 MOVE SPACES TO L221-MSG-AREA. DTSCU221 00121 DTSCU221 00122 SET L810-READ-UPDATE-88 TO TRUE. DTSCU221 00123 DTSCU221 00124 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCU221 00125 DTSCU221 00126 MOVE L221-EMP-NO TO MPRF-EMP-NO. DTSCU221 00127 DTSCU221 00128 SET MPRF-PRF-88 TO TRUE. DTSCU221 00129 DTSCU221 00130 EVALUATE TRUE DTSCU221 00131 WHEN L221-START-UPDATE DTSCU221 00132 PERFORM P1000-START-UPDATE THRU P1000-EXIT DTSCU221 00133 DTSCU221 00134 WHEN L221-END-UPDATE DTSCU221 00135 PERFORM P2000-END-UPDATE THRU P2000-EXIT DTSCU221 00136 DTSCU221 00137 WHEN L221-R906-ONLY DTSCU221 00138 PERFORM P3000-WRITE-R906 THRU P3000-EXIT DTSCU221 00139 DTSCU221 00140 WHEN OTHER DTSCU221 00141 PERFORM S899-ABEND THRU S899-EXIT DTSCU221 00142 END-EVALUATE. DTSCU221 00143 DTSCU221 00144 DTSCU221 00145 EXEC CICS DTSCU221 00146 RETURN DTSCU221 00147 END-EXEC. DTSCU221 00148 DTSCU221 00149 DTSCU221 00150 DTSCU221 00151 GOBACK. DTSCU221 00152 EJECT DTSCU221 00153 P1000-START-UPDATE. DTSCU221 00154 PERFORM S810-LINK-MSTR-IO THRU S810-EXIT. DTSCU221 00155 DTSCU221 00156 IF L810-FILE-CLOSED-88 DTSCU221 00157 SET L221-FILE-CLOSED TO TRUE DTSCU221 00158 MOVE L810-MSG-AREA TO L221-MSG-AREA DTSCU221 00159 GO TO P1000-EXIT. DTSCU221 00160 DTSCU221 00161 IF L810-NO-REC-88 DTSCU221 00162 SET L221-NO-REC TO TRUE DTSCU221 00163 MOVE EMSG-NO-RECORD TO L221-MSG-ID DTSCU221 00164 GO TO P1000-EXIT. DTSCU221 00165 DTSCU221 00166 IF MPRF-UPDATE-ACTIVE-88 DTSCU221 00167 SET L221-EMP-LOCKED-UPDATE TO TRUE DTSCU221 00168 MOVE EMSG-EMP-LOCKED TO L221-MSG-ID DTSCU221 00169 ELSE DTSCU221 00170 IF (MPRF-PURGE-ALL-YES-88) DTSCU221 00171 AND DTSCU221 00172 (NOT L221-BYPASS-PURGE-ALL-88) DTSCU221 00173 SET L221-EMP-LOCKED-PURGE TO TRUE DTSCU221 00174 MOVE EMSG-EMP-MARKED-FOR-PURGE TO L221-MSG-ID DTSCU221 00175 ELSE DTSCU221 00176 IF (MPRF-WRITE-OFF-DATE > +0) DTSCU221 00177 AND DTSCU221 00178 (NOT L221-BYPASS-WRITTEN-OFF-88) DTSCU221 00179 SET L221-EMP-WRITTEN-OFF TO TRUE DTSCU221 00180 MOVE EMSG-EMP-WRITTEN-OFF TO L221-MSG-ID DTSCU221 00181 ELSE DTSCU221 00182 IF L221-SCR-ABSTIME < MPRF-UPDATE-END-ABSTIME DTSCU221 00183 SET L221-SCR-NOT-CURRENT TO TRUE DTSCU221 00184 MOVE EMSG-NOT-CURRENT-UPDATE TO L221-MSG-ID DTSCU221 00185 ELSE DTSCU221 00186 SET L221-OK TO TRUE DTSCU221 00187 SET MPRF-UPDATE-ACTIVE-88 TO TRUE DTSCU221 00188 MOVE L221-UPDATE-TASK-ID TO MPRF-UPDATE-TASK-ID DTSCU221 00189 MOVE L221-UPDATE-OP-ID TO MPRF-UPDATE-OP-ID DTSCU221 00190 MOVE L221-UPDATE-TERMID TO MPRF-UPDATE-TERMID DTSCU221 00191 MOVE L221-UPDATE-NETNAME TO MPRF-UPDATE-NETNAME DTSCU221 00192 MOVE L221-UPDATE-START-DATE TO MPRF-UPDATE-START-DATE DTSCU221 00193 MOVE L221-UPDATE-START-TIME TO MPRF-UPDATE-START-TIME DTSCU221 00194 MOVE L221-UPDATE-SCR-ID TO MPRF-UPDATE-SCR-ID DTSCU221 00195 MOVE L221-UPDATE-FUNCTION TO MPRF-UPDATE-FUNCTION. DTSCU221 00196 DTSCU221 00197 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCU221 00198 DTSCU221 00199 PERFORM S810-LINK-MSTR-IO THRU S810-EXIT. DTSCU221 00200 DTSCU221 00201 P1000-EXIT. DTSCU221 00202 EXIT. DTSCU221 00203 EJECT DTSCU221 00204 P2000-END-UPDATE. DTSCU221 00205 PERFORM P3000-WRITE-R906 THRU P3000-EXIT. DTSCU221 00206 DTSCU221 00207 SET L005-FROM-SYS TO TRUE. DTSCU221 00208 DTSCU221 00209 PERFORM S005-LINK-TIME THRU S005-EXIT. DTSCU221 00210 DTSCU221 00211 COMPUTE L221-UPDATE-END-ABSTIME = L005-ABSTIME + 1. DTSCU221 00212 DTSCU221 00213 DTSCU221 00214 PERFORM S810-LINK-MSTR-IO THRU S810-EXIT. DTSCU221 00215 DTSCU221 00216 IF L810-FILE-CLOSED-88 DTSCU221 00217 SET L221-FILE-CLOSED TO TRUE DTSCU221 00218 MOVE L810-MSG-AREA TO L221-MSG-AREA DTSCU221 00219 GO TO P2000-EXIT. DTSCU221 00220 DTSCU221 00221 IF L810-NO-REC-88 DTSCU221 00222 SET L221-NO-REC TO TRUE DTSCU221 00223 MOVE EMSG-NO-RECORD TO L221-MSG-ID DTSCU221 00224 GO TO P2000-EXIT. DTSCU221 00225 DTSCU221 00226 MOVE L005-ABSTIME TO MPRF-UPDATE-END-ABSTIME. DTSCU221 00227 DTSCU221 00228 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCU221 00229 DTSCU221 00230 PERFORM S810-LINK-MSTR-IO THRU S810-EXIT. DTSCU221 00231 DTSCU221 00232 IF L825-FILE-CLOSED-88 DTSCU221 00233 SET L221-FILE-CLOSED TO TRUE DTSCU221 00234 MOVE L825-MSG-AREA TO L221-MSG-AREA DTSCU221 00235 GO TO P2000-EXIT DTSCU221 00236 ELSE DTSCU221 00237 SET L221-OK TO TRUE. DTSCU221 00238 P2000-EXIT. DTSCU221 00239 EXIT. DTSCU221 00240 EJECT DTSCU221 00241 P3000-WRITE-R906. DTSCU221 00242 MOVE LENGTH OF R906-REC TO R906-LENGTH. DTSCU221 00243 DTSCU221 00244 MOVE L221-EMP-NO TO R906-EMP-NO. DTSCU221 00245 DTSCU221 00246 MOVE L221-UPDATE-TASK-ID TO R906-TASK-ID. DTSCU221 00247 DTSCU221 00248 MOVE L221-UPDATE-OP-ID TO R906-OP-ID. DTSCU221 00249 DTSCU221 00250 MOVE L221-UPDATE-TERMID TO R906-TERM-ID. DTSCU221 00251 DTSCU221 00252 MOVE L221-UPDATE-NETNAME TO R906-NETNAME. DTSCU221 00253 DTSCU221 00254 MOVE L221-UPDATE-START-DATE TO R906-TASK-START-DATE. DTSCU221 00255 DTSCU221 00256 MOVE L221-UPDATE-START-TIME TO R906-TASK-START-TIME. DTSCU221 00257 DTSCU221 00258 MOVE L221-UPDATE-SCR-ID TO R906-SCR-ID. DTSCU221 00259 DTSCU221 00260 MOVE L221-UPDATE-FUNCTION TO R906-FUNCTION. DTSCU221 00261 DTSCU221 00262 IF L221-DOCUMENT-NO-AREA = LOW-VALUES DTSCU221 00263 OR L221-BATCH-NO NOT NUMERIC DTSCU221 00264 OR L221-ITEM-NO NOT NUMERIC DTSCU221 00265 MOVE ZEROS TO R906-BATCH-NO DTSCU221 00266 R906-ITEM-NO DTSCU221 00267 ELSE DTSCU221 00268 MOVE L221-BATCH-NO TO R906-BATCH-NO DTSCU221 00269 MOVE L221-ITEM-NO TO R906-ITEM-NO DTSCU221 00270 END-IF. DTSCU221 00271 DTSCU221 00272 MOVE LOW-VALUES TO R906-PADDING-FOR-SYNCSORT. DTSCU221 00273 DTSCU221 00274 SET L825-WRITE-88 TO TRUE. DTSCU221 00275 DTSCU221 00276 PERFORM S825-LINK-OLA THRU S825-EXIT. DTSCU221 00277 DTSCU221 00278 P3000-EXIT. DTSCU221 00279 EXIT. DTSCU221 00280 EJECT DTSCU221 00281 S005-LINK-TIME. DTSCU221 00282 DTSCU221 00283 EXEC CICS DTSCU221 00284 LINK DTSCU221 00285 PROGRAM('DTSCU005') DTSCU221 00286 COMMAREA(L005-COMM-AREA) DTSCU221 00287 END-EXEC. DTSCU221 00288 DTSCU221 00289 S005-EXIT. DTSCU221 00290 EXIT. DTSCU221 00291 EJECT DTSCU221 00292 S810-LINK-MSTR-IO. DTSCU221 00293 DTSCU221 00294 EXEC CICS DTSCU221 00295 LINK DTSCU221 00296 PROGRAM('DTSCU810') DTSCU221 00297 COMMAREA(L810-COMM-AREA) DTSCU221 00298 END-EXEC. DTSCU221 00299 DTSCU221 00300 S810-EXIT. DTSCU221 00301 EXIT. DTSCU221 00302 EJECT DTSCU221 00303 S825-LINK-OLA. DTSCU221 00304 DTSCU221 00305 EXEC CICS DTSCU221 00306 LINK DTSCU221 00307 PROGRAM('DTSCU825') DTSCU221 00308 COMMAREA(L825-COMM-AREA) DTSCU221 00309 END-EXEC. DTSCU221 00310 DTSCU221 00311 S825-EXIT. DTSCU221 00312 EXIT. DTSCU221 00313 EJECT DTSCU221 00314 S899-ABEND. DTSCU221 00315 DTSCU221 00316 EXEC CICS DTSCU221 00317 ABEND DTSCU221 00318 ABCODE (WRK-ABEND-CD) DTSCU221 00319 END-EXEC. DTSCU221 00320 DTSCU221 00321 S899-EXIT. DTSCU221 00322 EXIT. DTSCU221