2322 lines
181 KiB
COBOL
2322 lines
181 KiB
COBOL
00001 IDENTIFICATION DIVISION. 02/07/12
|
|
00002 PROGRAM-ID. DTSCS64. DTSCS64
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008
|
|
00004 DATE-WRITTEN. MAY 1994. DTSCS64
|
|
00005 DATE-COMPILED. DTSCS64
|
|
00006 SKIP3 DTSCS64
|
|
00007 ***** DTSCS64
|
|
00008 * DTSCS64
|
|
00009 * FUNCTION: QUARTERLY AUDIT RESULTS INQUIRY/UPDATE DTSCS64
|
|
00010 * SCREEN PROCESSOR. DTSCS64
|
|
00011 * DTSCS64
|
|
00012 * DTSCS64
|
|
00013 * MODIFICATION LOG: DTSCS64
|
|
00014 * DTSCS64
|
|
00015 * 11/16/98 INITIAL DEVLOPMENT. COPIED FROM MACCS65 DTSCS64
|
|
00016 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS64
|
|
00017 * DTSCS64
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS64
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS64
|
|
00020 * WORK ORDER: PROGRAMMER: XXX DTSCS64
|
|
00021 * DTSCS64
|
|
00022 * DTSCS64
|
|
00023 * DESCRIPTION: DTSCS64
|
|
00024 * DTSCS64
|
|
00025 * CLEAR: DTSCS64
|
|
00026 * DTSCS64
|
|
00027 * FIELD DISPLAYED: MAP-ASSIGN-NO (FROM LCCM-ASSIGN-NO). DTSCS64
|
|
00028 * DTSCS64
|
|
00029 * DTSCS64
|
|
00030 * JUMP: DTSCS64
|
|
00031 * DTSCS64
|
|
00032 * F17 REGISTRATION INQUIRY (11). DTSCS64
|
|
00033 * F21 FIELD ASSIGNMENT INQUIRY/UPDATE (62). DTSCS64
|
|
00034 * F22 AUDIT RESULTS INQUIRY/UPDATE (63). DTSCS64
|
|
00035 * DTSCS64
|
|
00036 * DTSCS64
|
|
00037 * INQUIRY: DTSCS64
|
|
00038 * DTSCS64
|
|
00039 * CONTROL FIELD(S): MAP-ASSIGN-NO. DTSCS64
|
|
00040 * DTSCS64
|
|
00041 * JUMP IN: IF LCCM-ASSIGN-NO = LCCM-SCR64-HOLD-AREA DTSCS64
|
|
00042 * ASSIGN-NO DTSCS64
|
|
00043 * DISPLAY RECORD INDICATED BY DTSCS64
|
|
00044 * LCCM-SCR64-HOLD-AREA DTSCS64
|
|
00045 * ELSE DTSCS64
|
|
00046 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS64
|
|
00047 * WITH LCCM-ASSIGN-NO. DTSCS64
|
|
00048 * DTSCS64
|
|
00049 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS64
|
|
00050 * DTSCS64
|
|
00051 * DISPLAY SEQUENCE: ASCENDING ON DTSCS64
|
|
00052 * MAUY-CALENDAR-YEAR. DTSCS64
|
|
00053 * DTSCS64
|
|
00054 * PAGE INITIALLY DISPLAYED: LAST. DTSCS64
|
|
00055 * DTSCS64
|
|
00056 * JUMP OUT: NO SPECIAL PROCESSING. DTSCS64
|
|
00057 * DTSCS64
|
|
00058 * NOTE. IF MFAS-NON-AUDIT-88, THEN RATHER THEN DISPLAYING DTSCS64
|
|
00059 * THE MAUY RECORD, DISPLAY AN ERROR MESSAGE. DTSCS64
|
|
00060 * DTSCS64
|
|
00061 * DTSCS64
|
|
00062 * LCCM DATA ELEMENT MAINTENANCE: DTSCS64
|
|
00063 * DTSCS64
|
|
00064 * STANDARD LCCM-ASSIGN-NO MAINTENANCE. DTSCS64
|
|
00065 * DTSCS64
|
|
00066 * MAINTAIN LCCM-EMP-NO IN SYNC WITH LCCM-ASSIGN-NO. DTSCS64
|
|
00067 * DTSCS64
|
|
00068 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS64
|
|
00069 * DTSCS64
|
|
00070 * DTSCS64
|
|
00071 * UPDATE: DTSCS64
|
|
00072 * DTSCS64
|
|
00073 * ADD DTSCS64
|
|
00074 * MOD DTSCS64
|
|
00075 * DEL DTSCS64
|
|
00076 * DTSCS64
|
|
00077 * DTSCS64
|
|
00078 * RECORDS READ: DTSCS64
|
|
00079 * DTSCS64
|
|
00080 * MASTER: DTSCS64
|
|
00081 * DTSCS64
|
|
00082 * MPRF DTSCS64
|
|
00083 * MFAS DTSCS64
|
|
00084 * MAUR DTSCS64
|
|
00085 * MAUY DTSCS64
|
|
00086 * DTSCS64
|
|
00087 * DTSCS64
|
|
00088 * ALTERNATE INDEX: DTSCS64
|
|
00089 * DTSCS64
|
|
00090 * IFAN. DTSCS64
|
|
00091 * DTSCS64
|
|
00092 * DTSCS64
|
|
00093 * REFERENCE: DTSCS64
|
|
00094 * DTSCS64
|
|
00095 * NONE. DTSCS64
|
|
00096 * DTSCS64
|
|
00097 * DTSCS64
|
|
00098 * ACCOUNTING TRANSACTION COLLECTION: DTSCS64
|
|
00099 * DTSCS64
|
|
00100 * NONE. DTSCS64
|
|
00101 * DTSCS64
|
|
00102 * DTSCS64
|
|
00103 * RECORDS UPDATED: DTSCS64
|
|
00104 * DTSCS64
|
|
00105 * MASTER: DTSCS64
|
|
00106 * DTSCS64
|
|
00107 * MAUY (ADD, REWRITE, DELETE) DTSCS64
|
|
00108 * DTSCS64
|
|
00109 * DTSCS64
|
|
00110 * REFERENCE: DTSCS64
|
|
00111 * DTSCS64
|
|
00112 * NONE. DTSCS64
|
|
00113 * DTSCS64
|
|
00114 * DTSCS64
|
|
00115 * ACCOUNTING TRANSACTION COLLECTION: DTSCS64
|
|
00116 * DTSCS64
|
|
00117 * NONE. DTSCS64
|
|
00118 * DTSCS64
|
|
00119 * DTSCS64
|
|
00120 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS64
|
|
00121 * DTSCS64
|
|
00122 * NONE. DTSCS64
|
|
00123 * DTSCS64
|
|
00124 * DTSCS64
|
|
00125 * TEMPORARY STORAGE USAGE: DTSCS64
|
|
00126 * DTSCS64
|
|
00127 * NONE DTSCS64
|
|
00128 * DTSCS64
|
|
00129 * DTSCS64
|
|
00130 * MODULES LINKED TO: DTSCS64
|
|
00131 * DTSCS64
|
|
00132 * DTSCS64
|
|
00133 * DTSCU001 DATE EDIT/CONVERSION. DTSCS64
|
|
00134 * DTSCU007 CALENDAR YEAR EDIT/CONVERSION. DTSCS64
|
|
00135 * DTSCU011 MONEY AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS64
|
|
00136 * DTSCU022 FIELD ASSIGNMENT NUMBER FROM SCREEN FORMAT/EDIT. DTSCS64
|
|
00137 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS64
|
|
00138 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS64
|
|
00139 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCS64
|
|
00140 * DTSCS64
|
|
00141 * DTSCS64
|
|
00142 ***** DTSCS64
|
|
00143 DTSCS64
|
|
00144 ENVIRONMENT DIVISION. DTSCS64
|
|
00145 DTSCS64
|
|
00146 DATA DIVISION. DTSCS64
|
|
00147 DTSCS64
|
|
00148 WORKING-STORAGE SECTION. DTSCS64
|
|
001485 77 PAN-VALET PICTURE X(24) VALUE '008DTSCS64 02/07/12'. DTSCS64
|
|
00149 DTSCS64
|
|
00150 01 WRK-AREA. DTSCS64
|
|
00151 05 WRK-ABEND-CD PIC X(04) VALUE 'S64 '. DTSCS64
|
|
00152 DTSCS64
|
|
00153 05 WRK-SCR-ID. DTSCS64
|
|
00154 10 WRK-SCR-ID-N PIC 9(02) VALUE 64. DTSCS64
|
|
00155 DTSCS64
|
|
00156 05 WRK-F03-SCR-ID PIC X(02) VALUE '60'. DTSCS64
|
|
00157 DTSCS64
|
|
00158 05 SCR-ACCESS-IND PIC X(01). DTSCS64
|
|
00159 88 SCR-ACCESS-INQ VALUE '1'. DTSCS64
|
|
00160 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS64
|
|
00161 DTSCS64
|
|
00162 05 CURSOR-SET-IND PIC X(01). DTSCS64
|
|
00163 88 CURSOR-SET-YES VALUE 'Y'. DTSCS64
|
|
00164 88 CURSOR-SET-NO VALUE 'N'. DTSCS64
|
|
00165 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS64
|
|
00166 DTSCS64
|
|
00167 05 REQ-IND PIC X(01). DTSCS64
|
|
00168 88 REQ-ERROR VALUE 'O'. DTSCS64
|
|
00169 88 REQ-JUMP VALUE 'J'. DTSCS64
|
|
00170 88 REQ-INQUIRE VALUE 'I'. DTSCS64
|
|
00171 88 REQ-CLEAR VALUE 'C'. DTSCS64
|
|
00172 88 REQ-EDIT VALUE 'E'. DTSCS64
|
|
00173 88 REQ-UPDATE VALUE 'U'. DTSCS64
|
|
00174 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS64
|
|
00175 DTSCS64
|
|
00176 05 RESP-IND PIC X(01). DTSCS64
|
|
00177 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS64
|
|
00178 88 RESP-SEND-MAP VALUE 'M'. DTSCS64
|
|
00179 88 RESP-JUMP VALUE 'J'. DTSCS64
|
|
00180 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS64
|
|
00181 DTSCS64
|
|
00182 05 WRK-MSG-AREA PIC X(64). DTSCS64
|
|
00183 DTSCS64
|
|
00184 05 WRK-ATB-AN PIC X(01). DTSCS64
|
|
00185 05 WRK-ATB-NUM PIC X(01). DTSCS64
|
|
00186 DTSCS64
|
|
00187 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS64
|
|
00188 05 WRK-ASSIGN-NO PIC S9(09) COMP-3. DTSCS64
|
|
00189 DTSCS64
|
|
00190 05 WRK-MPRF-IND PIC X(01). DTSCS64
|
|
00191 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS64
|
|
00192 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS64
|
|
00193 DTSCS64
|
|
00194 05 WRK-YRQ-1 PIC 9(05). DTSCS64
|
|
00195 05 FILLER REDEFINES WRK-YRQ-1. DTSCS64
|
|
00196 15 WRK-QTR-1-YR PIC 9(04). DTSCS64
|
|
00197 15 WRK-QTR-1-Q PIC 9(01). DTSCS64
|
|
00198 DTSCS64
|
|
00199 05 WRK-YRQ-2 PIC 9(05). DTSCS64
|
|
00200 05 FILLER REDEFINES WRK-YRQ-2. DTSCS64
|
|
00201 15 WRK-QTR-2-YR PIC 9(04). DTSCS64
|
|
00202 15 WRK-QTR-2-Q PIC 9(01). DTSCS64
|
|
00203 DTSCS64
|
|
00204 05 WRK-CALENDAR-YEAR PIC 9(04). DTSCS64
|
|
00205 DTSCS64
|
|
00206 05 WRK-DISPLAY PIC 9(11). DTSCS64
|
|
00207 DTSCS64
|
|
00208 05 FILLER REDEFINES WRK-DISPLAY. DTSCS64
|
|
00209 10 FILLER PIC X(04). DTSCS64
|
|
00210 10 WRK-DISPLAY-ASSIGN-NO-1 PIC X(02). DTSCS64
|
|
00211 10 WRK-DISPLAY-ASSIGN-NO-2 PIC X(05). DTSCS64
|
|
00212 DTSCS64
|
|
00213 05 FILLER REDEFINES WRK-DISPLAY. DTSCS64
|
|
00214 10 FILLER PIC X(05). DTSCS64
|
|
00215 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS64
|
|
00216 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS64
|
|
00217 DTSCS64
|
|
00218 05 FILLER REDEFINES WRK-DISPLAY. DTSCS64
|
|
00219 10 FILLER PIC 9(05). DTSCS64
|
|
00220 10 WRK-DISPLAY-YR PIC 9(02). DTSCS64
|
|
00221 10 WRK-DISPLAY-MO PIC 9(02). DTSCS64
|
|
00222 10 WRK-DISPLAY-DA PIC 9(02). DTSCS64
|
|
00223 10 WRK-DISPLAY-CAL-YR REDEFINES WRK-DISPLAY-DA DTSCS64
|
|
00224 PIC 9(02). DTSCS64
|
|
00225 DTSCS64
|
|
00226 05 INQUIRY-CONTROL-AREA. DTSCS64
|
|
00227 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS64
|
|
00228 10 WS-REC-NUM PIC S9(08) COMP. DTSCS64
|
|
00229 DTSCS64
|
|
00230 10 LAST-REC-KEY-AREA PIC X(16). DTSCS64
|
|
00231 10 SCR-REC-KEY-AREA PIC X(16). DTSCS64
|
|
00232 DTSCS64
|
|
00233 10 WS-REC-FOUND-IND PIC X(01). DTSCS64
|
|
00234 10 WRK-OCC PIC S9(04) COMP. DTSCS64
|
|
00235 EJECT DTSCS64
|
|
00236 * SCREEN SPECIFIC ERROR MESSAGES DTSCS64
|
|
00237 DTSCS64
|
|
00238 01 MSG-LITERALS. DTSCS64
|
|
00239 DTSCS64
|
|
00240 05 MSG-E641-AREA. DTSCS64
|
|
00241 10 FILLER PIC X(04) VALUE 'E641'. DTSCS64
|
|
00242 10 FILLER PIC X(30) DTSCS64
|
|
00243 VALUE 'QUARTER OUTSIDE OF PERIOD AUDI'. DTSCS64
|
|
00244 10 FILLER PIC X(30) DTSCS64
|
|
00245 VALUE 'TED '. DTSCS64
|
|
00246 DTSCS64
|
|
00247 05 MSG-E642-AREA. DTSCS64
|
|
00248 10 FILLER PIC X(04) VALUE 'E642'. DTSCS64
|
|
00249 10 FILLER PIC X(30) DTSCS64
|
|
00250 VALUE 'PROCESSED DATE DOES NOT EXIST.'. DTSCS64
|
|
00251 10 FILLER PIC X(30) DTSCS64
|
|
00252 VALUE ' '. DTSCS64
|
|
00253 DTSCS64
|
|
00254 05 MSG-E643-AREA. DTSCS64
|
|
00255 10 FILLER PIC X(04) VALUE 'E643'. DTSCS64
|
|
00256 10 FILLER PIC X(30) DTSCS64
|
|
00257 VALUE 'NON AUDIT ASSIGNMENT '. DTSCS64
|
|
00258 10 FILLER PIC X(30) DTSCS64
|
|
00259 VALUE ' '. DTSCS64
|
|
00260 DTSCS64
|
|
00261 05 MSG-E644-AREA. DTSCS64
|
|
00262 10 FILLER PIC X(04) VALUE 'E644'. DTSCS64
|
|
00263 10 FILLER PIC X(30) DTSCS64
|
|
00264 VALUE 'MAXIMUM OF 6 YEARS EXIST FOR T'. DTSCS64
|
|
00265 10 FILLER PIC X(30) DTSCS64
|
|
00266 VALUE 'HIS ASSIGNMENT. ADD NOT VALID.'. DTSCS64
|
|
00267 DTSCS64
|
|
00268 05 MSG-E645-AREA. DTSCS64
|
|
00269 10 FILLER PIC X(04) VALUE 'E645'. DTSCS64
|
|
00270 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS64
|
|
00271 10 MSG-E645-MSG PIC X(50) VALUE DTSCS64
|
|
00272 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS64
|
|
00273 EJECT DTSCS64
|
|
00274 01 L001-COMM-AREA. DTSCS64
|
|
00275 ++INCLUDE DTSIL001 DTSCS64
|
|
00276 EJECT DTSCS64
|
|
00277 01 L007-COMM-AREA. DTSCS64
|
|
00278 ++INCLUDE DTSIL007 DTSCS64
|
|
00279 EJECT DTSCS64
|
|
00280 01 L011-COMM-AREA. DTSCS64
|
|
00281 ++INCLUDE DTSIL011 DTSCS64
|
|
00282 EJECT DTSCS64
|
|
00283 01 L022-COMM-AREA. DTSCS64
|
|
00284 ++INCLUDE DTSIL022 DTSCS64
|
|
00285 EJECT DTSCS64
|
|
00286 01 L221-COMM-AREA. DTSCS64
|
|
00287 ++INCLUDE DTSIL221 DTSCS64
|
|
00288 EJECT DTSCS64
|
|
00289 01 L805-COMM-AREA. DTSCS64
|
|
00290 ++INCLUDE DTSIL805 DTSCS64
|
|
00291 EJECT DTSCS64
|
|
00292 01 L810-COMM-AREA. DTSCS64
|
|
00293 05 L810-CONTROL-BLOCK. DTSCS64
|
|
00294 ++INCLUDE DTSIL810 DTSCS64
|
|
00295 EJECT DTSCS64
|
|
00296 05 MSKL-REC. DTSCS64
|
|
00297 ++INCLUDE DTSIMSKL DTSCS64
|
|
00298 EJECT DTSCS64
|
|
00299 * DTSCS64
|
|
00300 01 MPRF-REC. DTSCS64
|
|
00301 ++INCLUDE DTSIMPRF DTSCS64
|
|
00302 EJECT DTSCS64
|
|
00303 01 MFAS-REC. DTSCS64
|
|
00304 ++INCLUDE DTSIMFAS DTSCS64
|
|
00305 EJECT DTSCS64
|
|
00306 01 MAUR-REC. DTSCS64
|
|
00307 ++INCLUDE DTSIMAUR DTSCS64
|
|
00308 EJECT DTSCS64
|
|
00309 01 MAUY-REC. DTSCS64
|
|
00310 ++INCLUDE DTSIMAUY DTSCS64
|
|
00311 EJECT DTSCS64
|
|
00312 01 L851-COMM-AREA. DTSCS64
|
|
00313 ++INCLUDE DTSIL851 DTSCS64
|
|
00314 DTSCS64
|
|
00315 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS64
|
|
00316 ++INCLUDE DTSIS64 DTSCS64
|
|
00317 EJECT DTSCS64
|
|
00318 01 L821-COMM-AREA. DTSCS64
|
|
00319 05 L821-CONTROL-BLOCK. DTSCS64
|
|
00320 ++INCLUDE DTSIL821 DTSCS64
|
|
00321 DTSCS64
|
|
00322 05 ISKL-REC. DTSCS64
|
|
00323 ++INCLUDE DTSIISKL DTSCS64
|
|
00324 05 FILLER REDEFINES ISKL-REC. DTSCS64
|
|
00325 ++INCLUDE DTSIIFAN DTSCS64
|
|
00326 EJECT DTSCS64
|
|
00327 01 CATB-LITERALS. DTSCS64
|
|
00328 ++INCLUDE DTSICATB DTSCS64
|
|
00329 DTSCS64
|
|
00330 01 CFKD-LITERALS. DTSCS64
|
|
00331 ++INCLUDE DTSICFKD DTSCS64
|
|
00332 DTSCS64
|
|
00333 01 CECD-LITERALS. DTSCS64
|
|
00334 ++INCLUDE DTSICECD DTSCS64
|
|
00335 DTSCS64
|
|
00336 01 CPCD-LITERALS. DTSCS64
|
|
00337 ++INCLUDE DTSICPCD DTSCS64
|
|
00338 DTSCS64
|
|
00339 01 MMAX-LITERALS. DTSCS64
|
|
00340 ++INCLUDE DTSIMMAX DTSCS64
|
|
00341 EJECT DTSCS64
|
|
00342 LINKAGE SECTION. DTSCS64
|
|
00343 DTSCS64
|
|
00344 01 DFHCOMMAREA. DTSCS64
|
|
00345 ++INCLUDE DTSILCCM DTSCS64
|
|
00346 EJECT DTSCS64
|
|
00347 ******************************************************************DTSCS64
|
|
00348 * *DTSCS64
|
|
00349 ******************************************************************DTSCS64
|
|
00350 DTSCS64
|
|
00351 PROCEDURE DIVISION. DTSCS64
|
|
00352 DTSCS64
|
|
00353 MOVE +0 TO WRK-EMP-NO. DTSCS64
|
|
00354 SET WRK-MPRF-NO-88 TO TRUE. DTSCS64
|
|
00355 DTSCS64
|
|
00356 MOVE +0 TO WRK-ASSIGN-NO. DTSCS64
|
|
00357 DTSCS64
|
|
00358 MOVE LOW-VALUES TO MAP-AREA. DTSCS64
|
|
00359 DTSCS64
|
|
00360 SET CURSOR-SET-NO TO TRUE. DTSCS64
|
|
00361 DTSCS64
|
|
00362 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS64
|
|
00363 TO SCR-ACCESS-IND. DTSCS64
|
|
00364 DTSCS64
|
|
00365 MOVE SPACE TO REQ-IND. DTSCS64
|
|
00366 DTSCS64
|
|
00367 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS64
|
|
00368 DTSCS64
|
|
00369 *----------------------------------------------------- DTSCS64
|
|
00370 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS64
|
|
00371 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS64
|
|
00372 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS64
|
|
00373 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS64
|
|
00374 * DTSCS64
|
|
00375 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS64
|
|
00376 * PROCESSED. DTSCS64
|
|
00377 * DTSCS64
|
|
00378 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS64
|
|
00379 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS64
|
|
00380 * WORK STATION OPERATOR. DTSCS64
|
|
00381 *----------------------------------------------------- DTSCS64
|
|
00382 DTSCS64
|
|
00383 MOVE SPACE TO RESP-IND. DTSCS64
|
|
00384 DTSCS64
|
|
00385 IF REQ-ERROR DTSCS64
|
|
00386 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS64
|
|
00387 ELSE DTSCS64
|
|
00388 IF REQ-JUMP DTSCS64
|
|
00389 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS64
|
|
00390 ELSE DTSCS64
|
|
00391 IF REQ-CLEAR DTSCS64
|
|
00392 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS64
|
|
00393 ELSE DTSCS64
|
|
00394 IF REQ-CURSOR-TO-GOTO DTSCS64
|
|
00395 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS64
|
|
00396 ELSE DTSCS64
|
|
00397 IF REQ-INQUIRE DTSCS64
|
|
00398 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS64
|
|
00399 ELSE DTSCS64
|
|
00400 IF REQ-EDIT DTSCS64
|
|
00401 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS64
|
|
00402 ELSE DTSCS64
|
|
00403 IF REQ-UPDATE DTSCS64
|
|
00404 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS64
|
|
00405 ELSE DTSCS64
|
|
00406 GO TO S899-ABEND. DTSCS64
|
|
00407 DTSCS64
|
|
00408 *----------------------------------------------------- DTSCS64
|
|
00409 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS64
|
|
00410 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS64
|
|
00411 *----------------------------------------------------- DTSCS64
|
|
00412 DTSCS64
|
|
00413 IF RESP-SEND-MAP DTSCS64
|
|
00414 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS64
|
|
00415 SET LCCM-END-TASK-88 TO TRUE DTSCS64
|
|
00416 ELSE DTSCS64
|
|
00417 IF RESP-SEND-MSGONLY DTSCS64
|
|
00418 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS64
|
|
00419 SET LCCM-END-TASK-88 TO TRUE DTSCS64
|
|
00420 ELSE DTSCS64
|
|
00421 IF RESP-JUMP DTSCS64
|
|
00422 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64
|
|
00423 ELSE DTSCS64
|
|
00424 IF RESP-CURSOR-TO-GOTO DTSCS64
|
|
00425 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS64
|
|
00426 SET LCCM-END-TASK-88 TO TRUE DTSCS64
|
|
00427 ELSE DTSCS64
|
|
00428 GO TO S899-ABEND. DTSCS64
|
|
00429 DTSCS64
|
|
00430 MAINLINE-EXIT. DTSCS64
|
|
00431 DTSCS64
|
|
00432 EXEC CICS DTSCS64
|
|
00433 RETURN DTSCS64
|
|
00434 END-EXEC. DTSCS64
|
|
00435 DTSCS64
|
|
00436 GOBACK. DTSCS64
|
|
00437 EJECT DTSCS64
|
|
00438 /*****************************************************************DTSCS64
|
|
00439 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS64
|
|
00440 ******************************************************************DTSCS64
|
|
00441 P1000-ANALYZE-REQUEST. DTSCS64
|
|
00442 DTSCS64
|
|
00443 *----------------------------------------------------- DTSCS64
|
|
00444 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS64
|
|
00445 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS64
|
|
00446 * REPLACED WITH ENTER) DTSCS64
|
|
00447 *----------------------------------------------------- DTSCS64
|
|
00448 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS64
|
|
00449 SET LCCM-ENTER-88 TO TRUE DTSCS64
|
|
00450 IF LCCM-ASSIGN-NO > ZERO DTSCS64
|
|
00451 SET REQ-INQUIRE TO TRUE DTSCS64
|
|
00452 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS64
|
|
00453 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS64
|
|
00454 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2 DTSCS64
|
|
00455 ELSE DTSCS64
|
|
00456 SET REQ-INQUIRE TO TRUE DTSCS64
|
|
00457 END-IF DTSCS64
|
|
00458 GO TO P1000-EXIT. DTSCS64
|
|
00459 DTSCS64
|
|
00460 *----------------------------------------------------- DTSCS64
|
|
00461 * MAP IS RECEIVED DTSCS64
|
|
00462 *----------------------------------------------------- DTSCS64
|
|
00463 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS64
|
|
00464 DTSCS64
|
|
00465 *----------------------------------------------------- DTSCS64
|
|
00466 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS64
|
|
00467 * WORK STATION DTSCS64
|
|
00468 *----------------------------------------------------- DTSCS64
|
|
00469 IF LCCM-CLEAR-88 DTSCS64
|
|
00470 SET REQ-CLEAR TO TRUE DTSCS64
|
|
00471 GO TO P1000-EXIT. DTSCS64
|
|
00472 DTSCS64
|
|
00473 *----------------------------------------------------- DTSCS64
|
|
00474 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS64
|
|
00475 *----------------------------------------------------- DTSCS64
|
|
00476 IF LCCM-SCR-UPDATE-LOCKED DTSCS64
|
|
00477 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS64
|
|
00478 GO TO P1000-EXIT. DTSCS64
|
|
00479 DTSCS64
|
|
00480 *----------------------------------------------------- DTSCS64
|
|
00481 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS64
|
|
00482 *----------------------------------------------------- DTSCS64
|
|
00483 IF LCCM-PA2-88 DTSCS64
|
|
00484 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS64
|
|
00485 GO TO P1000-EXIT. DTSCS64
|
|
00486 DTSCS64
|
|
00487 *----------------------------------------------------- DTSCS64
|
|
00488 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS64
|
|
00489 *----------------------------------------------------- DTSCS64
|
|
00490 IF LCCM-PA-88 DTSCS64
|
|
00491 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS64
|
|
00492 SET REQ-ERROR TO TRUE DTSCS64
|
|
00493 GO TO P1000-EXIT. DTSCS64
|
|
00494 DTSCS64
|
|
00495 *----------------------------------------------------- DTSCS64
|
|
00496 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS64
|
|
00497 * CLEAR SCREEN DTSCS64
|
|
00498 *----------------------------------------------------- DTSCS64
|
|
00499 IF LCCM-F12-88 DTSCS64
|
|
00500 MOVE LOW-VALUES TO MAP-AREA DTSCS64
|
|
00501 SET REQ-CLEAR TO TRUE DTSCS64
|
|
00502 GO TO P1000-EXIT. DTSCS64
|
|
00503 DTSCS64
|
|
00504 *----------------------------------------------------- DTSCS64
|
|
00505 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS64
|
|
00506 *----------------------------------------------------- DTSCS64
|
|
00507 IF LCCM-F03-88 DTSCS64
|
|
00508 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS64
|
|
00509 SET REQ-JUMP TO TRUE DTSCS64
|
|
00510 GO TO P1000-EXIT. DTSCS64
|
|
00511 DTSCS64
|
|
00512 *----------------------------------------------------- DTSCS64
|
|
00513 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS64
|
|
00514 *----------------------------------------------------- DTSCS64
|
|
00515 IF LCCM-F04-88 DTSCS64
|
|
00516 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS64
|
|
00517 SET REQ-JUMP TO TRUE DTSCS64
|
|
00518 GO TO P1000-EXIT. DTSCS64
|
|
00519 DTSCS64
|
|
00520 *--------------------------------------------------------- DTSCS64
|
|
00521 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS64
|
|
00522 * CORRESPONDENCE SCREEN. DTSCS64
|
|
00523 *--------------------------------------------------------- DTSCS64
|
|
00524 DTSCS64
|
|
00525 IF LCCM-F14-88 DTSCS64
|
|
00526 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS64
|
|
00527 SET REQ-JUMP TO TRUE DTSCS64
|
|
00528 GO TO P1000-EXIT. DTSCS64
|
|
00529 DTSCS64
|
|
00530 *----------------------------------------------------- DTSCS64
|
|
00531 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS64
|
|
00532 * REQUESTED SCREEN TYPE DTSCS64
|
|
00533 *----------------------------------------------------- DTSCS64
|
|
00534 * IF LCCM-F17-88 DTSCS64
|
|
00535 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS64
|
|
00536 * SET REQ-JUMP TO TRUE DTSCS64
|
|
00537 * GO TO P1000-EXIT. DTSCS64
|
|
00538 * DTSCS64
|
|
00539 * IF LCCM-F21-88 DTSCS64
|
|
00540 * MOVE '62' TO LCCM-REQ-SCR-ID DTSCS64
|
|
00541 * SET REQ-JUMP TO TRUE DTSCS64
|
|
00542 * GO TO P1000-EXIT. DTSCS64
|
|
00543 * DTSCS64
|
|
00544 * IF LCCM-F22-88 DTSCS64
|
|
00545 * MOVE '63' TO LCCM-REQ-SCR-ID DTSCS64
|
|
00546 * SET REQ-JUMP TO TRUE DTSCS64
|
|
00547 * GO TO P1000-EXIT. DTSCS64
|
|
00548 * DTSCS64
|
|
00549 *----------------------------------------------------- DTSCS64
|
|
00550 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS64
|
|
00551 * REQUESTED SCREEN TYPE DTSCS64
|
|
00552 *----------------------------------------------------- DTSCS64
|
|
00553 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS64
|
|
00554 NEXT SENTENCE DTSCS64
|
|
00555 ELSE DTSCS64
|
|
00556 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS64
|
|
00557 SET REQ-JUMP TO TRUE DTSCS64
|
|
00558 GO TO P1000-EXIT. DTSCS64
|
|
00559 DTSCS64
|
|
00560 *----------------------------------------------------- DTSCS64
|
|
00561 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS64
|
|
00562 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS64
|
|
00563 *----------------------------------------------------- DTSCS64
|
|
00564 IF LCCM-F09-88 DTSCS64
|
|
00565 OR LCCM-F10-88 DTSCS64
|
|
00566 OR LCCM-F23-88 DTSCS64
|
|
00567 IF SCR-ACCESS-UPDATE DTSCS64
|
|
00568 SET REQ-EDIT TO TRUE DTSCS64
|
|
00569 GO TO P1000-EXIT DTSCS64
|
|
00570 ELSE DTSCS64
|
|
00571 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS64
|
|
00572 SET REQ-ERROR TO TRUE DTSCS64
|
|
00573 GO TO P1000-EXIT. DTSCS64
|
|
00574 DTSCS64
|
|
00575 *----------------------------------------------------- DTSCS64
|
|
00576 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS64
|
|
00577 * OR F8), INDICATE INQUIRY REQUEST DTSCS64
|
|
00578 *----------------------------------------------------- DTSCS64
|
|
00579 IF LCCM-INQUIRY-88 DTSCS64
|
|
00580 SET REQ-INQUIRE TO TRUE DTSCS64
|
|
00581 GO TO P1000-EXIT. DTSCS64
|
|
00582 DTSCS64
|
|
00583 *----------------------------------------------------- DTSCS64
|
|
00584 * ANY OTHER KEY IS INVALID DTSCS64
|
|
00585 *----------------------------------------------------- DTSCS64
|
|
00586 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS64
|
|
00587 SET REQ-ERROR TO TRUE. DTSCS64
|
|
00588 P1000-EXIT. DTSCS64
|
|
00589 EXIT. DTSCS64
|
|
00590 DTSCS64
|
|
00591 ******************************************************************DTSCS64
|
|
00592 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS64
|
|
00593 ******************************************************************DTSCS64
|
|
00594 DTSCS64
|
|
00595 P1100-UPDATE-LOCKED. DTSCS64
|
|
00596 *----------------------------------------------------- DTSCS64
|
|
00597 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS64
|
|
00598 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS64
|
|
00599 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS64
|
|
00600 *----------------------------------------------------- DTSCS64
|
|
00601 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS64
|
|
00602 SET REQ-UPDATE TO TRUE DTSCS64
|
|
00603 ELSE DTSCS64
|
|
00604 SET REQ-ERROR TO TRUE DTSCS64
|
|
00605 IF LCCM-SCR-ADD-LOCKED DTSCS64
|
|
00606 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS64
|
|
00607 ELSE DTSCS64
|
|
00608 IF LCCM-SCR-MOD-LOCKED DTSCS64
|
|
00609 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS64
|
|
00610 ELSE DTSCS64
|
|
00611 IF LCCM-SCR-DEL-LOCKED DTSCS64
|
|
00612 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS64
|
|
00613 ELSE DTSCS64
|
|
00614 GO TO S899-ABEND. DTSCS64
|
|
00615 P1100-EXIT. DTSCS64
|
|
00616 EXIT. DTSCS64
|
|
00617 /*****************************************************************DTSCS64
|
|
00618 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS64
|
|
00619 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS64
|
|
00620 ******************************************************************DTSCS64
|
|
00621 DTSCS64
|
|
00622 P2000-REQUEST-ERROR. DTSCS64
|
|
00623 IF LCCM-MSG DTSCS64
|
|
00624 SET RESP-SEND-MSGONLY TO TRUE DTSCS64
|
|
00625 ELSE DTSCS64
|
|
00626 GO TO S899-ABEND. DTSCS64
|
|
00627 P2000-EXIT. DTSCS64
|
|
00628 EXIT. DTSCS64
|
|
00629 /*****************************************************************DTSCS64
|
|
00630 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS64
|
|
00631 ******************************************************************DTSCS64
|
|
00632 DTSCS64
|
|
00633 P3000-REQUEST-JUMP. DTSCS64
|
|
00634 *----------------------------------------------------- DTSCS64
|
|
00635 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS64
|
|
00636 * BY USER DTSCS64
|
|
00637 *----------------------------------------------------- DTSCS64
|
|
00638 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS64
|
|
00639 DTSCS64
|
|
00640 *----------------------------------------------------- DTSCS64
|
|
00641 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS64
|
|
00642 *----------------------------------------------------- DTSCS64
|
|
00643 IF LCCM-MSG DTSCS64
|
|
00644 SET RESP-SEND-MSGONLY TO TRUE DTSCS64
|
|
00645 SET CURSOR-SET-GOTO TO TRUE DTSCS64
|
|
00646 GO TO P3000-EXIT. DTSCS64
|
|
00647 SKIP3 DTSCS64
|
|
00648 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS64
|
|
00649 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS64
|
|
00650 IF L022-VALID DTSCS64
|
|
00651 MOVE L022-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS64
|
|
00652 DTSCS64
|
|
00653 *----------------------------------------------------- DTSCS64
|
|
00654 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS64
|
|
00655 *----------------------------------------------------- DTSCS64
|
|
00656 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS64
|
|
00657 LCCM-SCR-HOLD-AREA. DTSCS64
|
|
00658 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS64
|
|
00659 SET RESP-JUMP TO TRUE. DTSCS64
|
|
00660 P3000-EXIT. DTSCS64
|
|
00661 EXIT. DTSCS64
|
|
00662 /*****************************************************************DTSCS64
|
|
00663 * CLEAR KEY WAS PRESSED *DTSCS64
|
|
00664 ******************************************************************DTSCS64
|
|
00665 DTSCS64
|
|
00666 P4000-REQUEST-CLEAR. DTSCS64
|
|
00667 DTSCS64
|
|
00668 *----------------------------------------------------- DTSCS64
|
|
00669 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS64
|
|
00670 * FIELDS FROM EARLIER REQUESTS DTSCS64
|
|
00671 *----------------------------------------------------- DTSCS64
|
|
00672 IF LCCM-ASSIGN-NO > ZERO DTSCS64
|
|
00673 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS64
|
|
00674 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS64
|
|
00675 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2. DTSCS64
|
|
00676 DTSCS64
|
|
00677 MOVE ZERO TO LCCM-ASSIGN-NO DTSCS64
|
|
00678 DTSCS64
|
|
00679 MOVE LOW-VALUES TO LCCM-SCR64-HOLD-AREA. DTSCS64
|
|
00680 DTSCS64
|
|
00681 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64
|
|
00682 DTSCS64
|
|
00683 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64
|
|
00684 DTSCS64
|
|
00685 IF SCR-ACCESS-UPDATE DTSCS64
|
|
00686 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS64
|
|
00687 ELSE DTSCS64
|
|
00688 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS64
|
|
00689 DTSCS64
|
|
00690 SET RESP-SEND-MAP TO TRUE. DTSCS64
|
|
00691 P4000-EXIT. DTSCS64
|
|
00692 EXIT. DTSCS64
|
|
00693 /*****************************************************************DTSCS64
|
|
00694 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS64
|
|
00695 ******************************************************************DTSCS64
|
|
00696 DTSCS64
|
|
00697 P5000-CURSOR-TO-GOTO. DTSCS64
|
|
00698 SET CURSOR-SET-GOTO TO TRUE. DTSCS64
|
|
00699 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS64
|
|
00700 P5000-EXIT. DTSCS64
|
|
00701 EXIT. DTSCS64
|
|
00702 /*****************************************************************DTSCS64
|
|
00703 * INQUIRY WAS REQUESTED *DTSCS64
|
|
00704 ******************************************************************DTSCS64
|
|
00705 DTSCS64
|
|
00706 P6000-REQUEST-INQUIRE. DTSCS64
|
|
00707 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS64
|
|
00708 MOVE LOW-VALUES TO MAP-AREA. DTSCS64
|
|
00709 MOVE L022-S-ASSIGN-NO-AREA TO MAP-ASSIGN-NO-AREA. DTSCS64
|
|
00710 DTSCS64
|
|
00711 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64
|
|
00712 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64
|
|
00713 DTSCS64
|
|
00714 SET RESP-SEND-MAP TO TRUE. DTSCS64
|
|
00715 DTSCS64
|
|
00716 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS64
|
|
00717 DTSCS64
|
|
00718 MOVE LCCM-SCR64-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS64
|
|
00719 MOVE LOW-VALUES TO LCCM-SCR64-HOLD-AREA. DTSCS64
|
|
00720 DTSCS64
|
|
00721 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64
|
|
00722 IF LCCM-MSG DTSCS64
|
|
00723 GO TO P6000-EXIT. DTSCS64
|
|
00724 DTSCS64
|
|
00725 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64
|
|
00726 IF LCCM-MSG DTSCS64
|
|
00727 GO TO P6000-EXIT. DTSCS64
|
|
00728 DTSCS64
|
|
00729 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS64
|
|
00730 DTSCS64
|
|
00731 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64
|
|
00732 DTSCS64
|
|
00733 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS64
|
|
00734 DTSCS64
|
|
00735 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64
|
|
00736 DTSCS64
|
|
00737 IF LCCM-MSG DTSCS64
|
|
00738 GO TO P6000-EXIT. DTSCS64
|
|
00739 DTSCS64
|
|
00740 IF SCR-ACCESS-UPDATE DTSCS64
|
|
00741 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64
|
|
00742 DTSCS64
|
|
00743 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64
|
|
00744 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64
|
|
00745 SET MAUY-AUY-88 TO TRUE. DTSCS64
|
|
00746 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64
|
|
00747 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
00748 PERFORM S810-COUNT THRU S810-EXIT. DTSCS64
|
|
00749 DTSCS64
|
|
00750 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS64
|
|
00751 IF L810-NO-REC-88 DTSCS64
|
|
00752 MOVE LOW-VALUE TO LAST-REC-KEY-AREA DTSCS64
|
|
00753 ELSE DTSCS64
|
|
00754 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS64
|
|
00755 DTSCS64
|
|
00756 IF LAST-REC-NUM = +0 DTSCS64
|
|
00757 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64
|
|
00758 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
00759 GO TO P6000-EXIT. DTSCS64
|
|
00760 DTSCS64
|
|
00761 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS64
|
|
00762 IF LCCM-MSG DTSCS64
|
|
00763 GO TO P6000-EXIT. DTSCS64
|
|
00764 DTSCS64
|
|
00765 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS64
|
|
00766 DTSCS64
|
|
00767 MOVE MAUY-KEY-AREA TO LCCM-SCR64-HOLD-AREA. DTSCS64
|
|
00768 DTSCS64
|
|
00769 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS64
|
|
00770 DTSCS64
|
|
00771 IF SCR-ACCESS-UPDATE DTSCS64
|
|
00772 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64
|
|
00773 P6000-EXIT. DTSCS64
|
|
00774 EXIT. DTSCS64
|
|
00775 EJECT DTSCS64
|
|
00776 P6100-LOCATE-REC. DTSCS64
|
|
00777 *------------------------------------------------------------ DTSCS64
|
|
00778 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS64
|
|
00779 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS64
|
|
00780 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS64
|
|
00781 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS64
|
|
00782 * RECORD WITH THE GREATEST CALENDAR-YEAR (THE MOST DTSCS64
|
|
00783 * RECENT CALENDAR YEAR ASSOCIATED WITH ASSIGN-NO). DTSCS64
|
|
00784 *------------------------------------------------------------ DTSCS64
|
|
00785 DTSCS64
|
|
00786 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS64
|
|
00787 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64
|
|
00788 GO TO P6100-EXIT. DTSCS64
|
|
00789 DTSCS64
|
|
00790 MOVE SCR-REC-KEY-AREA TO MAUY-KEY-AREA. DTSCS64
|
|
00791 DTSCS64
|
|
00792 IF WRK-ASSIGN-NO = MAUY-ASSIGN-NO DTSCS64
|
|
00793 NEXT SENTENCE DTSCS64
|
|
00794 ELSE DTSCS64
|
|
00795 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64
|
|
00796 GO TO P6100-EXIT. DTSCS64
|
|
00797 DTSCS64
|
|
00798 IF LCCM-F05-88 DTSCS64
|
|
00799 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS64
|
|
00800 GO TO P6100-EXIT. DTSCS64
|
|
00801 DTSCS64
|
|
00802 IF LCCM-F06-88 DTSCS64
|
|
00803 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64
|
|
00804 GO TO P6100-EXIT. DTSCS64
|
|
00805 DTSCS64
|
|
00806 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64
|
|
00807 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64
|
|
00808 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64
|
|
00809 SET MAUY-AUY-88 TO TRUE. DTSCS64
|
|
00810 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
00811 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS64
|
|
00812 IF L810-NO-REC-88 DTSCS64
|
|
00813 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64
|
|
00814 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
00815 GO TO P6100-EXIT. DTSCS64
|
|
00816 DTSCS64
|
|
00817 MOVE +0 TO WS-REC-NUM. DTSCS64
|
|
00818 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS64
|
|
00819 PERFORM P6190-BROWSE-MAUY THRU P6190-EXIT DTSCS64
|
|
00820 UNTIL (L810-NO-REC-88) DTSCS64
|
|
00821 OR DTSCS64
|
|
00822 (WS-REC-FOUND-IND = 'Y'). DTSCS64
|
|
00823 DTSCS64
|
|
00824 IF L810-NO-REC-88 DTSCS64
|
|
00825 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS64
|
|
00826 GO TO P6100-EXIT. DTSCS64
|
|
00827 DTSCS64
|
|
00828 IF LCCM-ENTER-88 DTSCS64
|
|
00829 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS64
|
|
00830 GO TO P6100-EXIT. DTSCS64
|
|
00831 DTSCS64
|
|
00832 IF LCCM-F07-88 DTSCS64
|
|
00833 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS64
|
|
00834 GO TO P6100-EXIT. DTSCS64
|
|
00835 DTSCS64
|
|
00836 IF LCCM-F08-88 DTSCS64
|
|
00837 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS64
|
|
00838 GO TO P6100-EXIT. DTSCS64
|
|
00839 DTSCS64
|
|
00840 GO TO S899-ABEND. DTSCS64
|
|
00841 P6100-EXIT. DTSCS64
|
|
00842 EXIT. DTSCS64
|
|
00843 DTSCS64
|
|
00844 P6110-FIRST-REC. DTSCS64
|
|
00845 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64
|
|
00846 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64
|
|
00847 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64
|
|
00848 SET MAUY-AUY-88 TO TRUE. DTSCS64
|
|
00849 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
00850 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS64
|
|
00851 IF L810-NO-REC-88 DTSCS64
|
|
00852 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64
|
|
00853 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
00854 GO TO P6110-EXIT. DTSCS64
|
|
00855 DTSCS64
|
|
00856 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS64
|
|
00857 DTSCS64
|
|
00858 MOVE MSKL-REC TO MAUY-REC. DTSCS64
|
|
00859 DTSCS64
|
|
00860 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64
|
|
00861 NEXT SENTENCE DTSCS64
|
|
00862 ELSE DTSCS64
|
|
00863 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64
|
|
00864 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
00865 GO TO P6110-EXIT. DTSCS64
|
|
00866 DTSCS64
|
|
00867 MOVE +1 TO WS-REC-NUM. DTSCS64
|
|
00868 P6110-EXIT. DTSCS64
|
|
00869 EXIT. DTSCS64
|
|
00870 DTSCS64
|
|
00871 P6120-PREV-REC. DTSCS64
|
|
00872 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS64
|
|
00873 IF L810-NO-REC-88 DTSCS64
|
|
00874 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64
|
|
00875 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
00876 GO TO P6120-EXIT. DTSCS64
|
|
00877 DTSCS64
|
|
00878 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS64
|
|
00879 IF L810-NO-REC-88 DTSCS64
|
|
00880 GO TO P6120-EXIT. DTSCS64
|
|
00881 DTSCS64
|
|
00882 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS64
|
|
00883 DTSCS64
|
|
00884 SUBTRACT 1 FROM WS-REC-NUM. DTSCS64
|
|
00885 DTSCS64
|
|
00886 MOVE MSKL-REC TO MAUY-REC. DTSCS64
|
|
00887 DTSCS64
|
|
00888 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64
|
|
00889 NEXT SENTENCE DTSCS64
|
|
00890 ELSE DTSCS64
|
|
00891 PERFORM P6110-FIRST-REC THRU P6110-EXIT. DTSCS64
|
|
00892 P6120-EXIT. DTSCS64
|
|
00893 EXIT. DTSCS64
|
|
00894 DTSCS64
|
|
00895 P6130-NEXT-REC. DTSCS64
|
|
00896 IF MAUY-KEY-AREA > SCR-REC-KEY-AREA DTSCS64
|
|
00897 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS64
|
|
00898 GO TO P6130-EXIT. DTSCS64
|
|
00899 DTSCS64
|
|
00900 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS64
|
|
00901 DTSCS64
|
|
00902 IF L810-NO-REC-88 DTSCS64
|
|
00903 GO TO P6130-EXIT. DTSCS64
|
|
00904 DTSCS64
|
|
00905 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS64
|
|
00906 DTSCS64
|
|
00907 ADD +1 TO WS-REC-NUM. DTSCS64
|
|
00908 DTSCS64
|
|
00909 MOVE MSKL-REC TO MAUY-REC. DTSCS64
|
|
00910 DTSCS64
|
|
00911 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64
|
|
00912 NEXT SENTENCE DTSCS64
|
|
00913 ELSE DTSCS64
|
|
00914 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCS64
|
|
00915 P6130-EXIT. DTSCS64
|
|
00916 EXIT. DTSCS64
|
|
00917 DTSCS64
|
|
00918 P6140-LAST-REC. DTSCS64
|
|
00919 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
00920 PERFORM S810-READ THRU S810-EXIT. DTSCS64
|
|
00921 IF L810-NO-REC-88 DTSCS64
|
|
00922 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS64
|
|
00923 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
00924 GO TO P6140-EXIT. DTSCS64
|
|
00925 DTSCS64
|
|
00926 MOVE MSKL-REC TO MAUY-REC. DTSCS64
|
|
00927 DTSCS64
|
|
00928 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS64
|
|
00929 P6140-EXIT. DTSCS64
|
|
00930 EXIT. DTSCS64
|
|
00931 DTSCS64
|
|
00932 P6190-BROWSE-MAUY. DTSCS64
|
|
00933 MOVE MSKL-REC TO MAUY-REC. DTSCS64
|
|
00934 DTSCS64
|
|
00935 IF MAUY-ASSIGN-NO = WRK-ASSIGN-NO DTSCS64
|
|
00936 NEXT SENTENCE DTSCS64
|
|
00937 ELSE DTSCS64
|
|
00938 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS64
|
|
00939 SET L810-NO-REC-88 TO TRUE DTSCS64
|
|
00940 GO TO P6190-EXIT. DTSCS64
|
|
00941 DTSCS64
|
|
00942 ADD +1 TO WS-REC-NUM. DTSCS64
|
|
00943 IF MAUY-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS64
|
|
00944 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS64
|
|
00945 ELSE DTSCS64
|
|
00946 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS64
|
|
00947 P6190-EXIT. DTSCS64
|
|
00948 EXIT. DTSCS64
|
|
00949 /*****************************************************************DTSCS64
|
|
00950 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS64
|
|
00951 ******************************************************************DTSCS64
|
|
00952 DTSCS64
|
|
00953 P6900-CONSTRUCT-SCREEN. DTSCS64
|
|
00954 PERFORM P6910-FROM-MAUY THRU P6910-EXIT. DTSCS64
|
|
00955 DTSCS64
|
|
00956 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS64
|
|
00957 P6900-EXIT. DTSCS64
|
|
00958 EXIT. DTSCS64
|
|
00959 DTSCS64
|
|
00960 P6910-FROM-MAUY. DTSCS64
|
|
00961 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
00962 UNTIL WRK-OCC > 4 DTSCS64
|
|
00963 IF MAUY-QTR-AUDITED-88(WRK-OCC) DTSCS64
|
|
00964 MOVE MAUY-QTR-GROSS-PAYROLL (WRK-OCC) DTSCS64
|
|
00965 TO MAP-GROSS-PAYROLL-N (WRK-OCC) DTSCS64
|
|
00966 MOVE MAUY-QTR-UNDER-TOT-WAGE (WRK-OCC) DTSCS64
|
|
00967 TO MAP-UNDER-TOT-WAGE-N (WRK-OCC) DTSCS64
|
|
00968 MOVE MAUY-QTR-UNDER-TAX-WAGE (WRK-OCC) DTSCS64
|
|
00969 TO MAP-UNDER-TAX-WAGE-N (WRK-OCC) DTSCS64
|
|
00970 MOVE MAUY-QTR-UNDER-CONTRIB (WRK-OCC) DTSCS64
|
|
00971 TO MAP-UNDER-CONTRIB-N (WRK-OCC) DTSCS64
|
|
00972 MOVE MAUY-QTR-OVER-TOT-WAGE (WRK-OCC) DTSCS64
|
|
00973 TO MAP-OVER-TOT-WAGE-N (WRK-OCC) DTSCS64
|
|
00974 MOVE MAUY-QTR-OVER-TAX-WAGE (WRK-OCC) DTSCS64
|
|
00975 TO MAP-OVER-TAX-WAGE-N (WRK-OCC) DTSCS64
|
|
00976 MOVE MAUY-QTR-OVER-CONTRIB (WRK-OCC) DTSCS64
|
|
00977 TO MAP-OVER-CONTRIB-N (WRK-OCC) DTSCS64
|
|
00978 END-IF DTSCS64
|
|
00979 END-PERFORM. DTSCS64
|
|
00980 MOVE MAUY-CALENDAR-YEAR TO WRK-DISPLAY. DTSCS64
|
|
00981 MOVE WRK-DISPLAY-CAL-YR TO MAP-CALENDAR-YEAR. DTSCS64
|
|
00982 P6910-EXIT. DTSCS64
|
|
00983 EXIT. DTSCS64
|
|
00984 DTSCS64
|
|
00985 P6990-PAGE-NUMBER. DTSCS64
|
|
00986 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS64
|
|
00987 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS64
|
|
00988 DTSCS64
|
|
00989 IF WS-REC-NUM = +1 DTSCS64
|
|
00990 IF LAST-REC-NUM = +1 DTSCS64
|
|
00991 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS64
|
|
00992 ELSE DTSCS64
|
|
00993 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS64
|
|
00994 ELSE DTSCS64
|
|
00995 IF WS-REC-NUM = LAST-REC-NUM DTSCS64
|
|
00996 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS64
|
|
00997 P6990-EXIT. DTSCS64
|
|
00998 EXIT. DTSCS64
|
|
00999 /*****************************************************************DTSCS64
|
|
01000 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS64
|
|
01001 ******************************************************************DTSCS64
|
|
01002 DTSCS64
|
|
01003 P7000-REQUEST-EDIT. DTSCS64
|
|
01004 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64
|
|
01005 DTSCS64
|
|
01006 IF LCCM-F09-88 DTSCS64
|
|
01007 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS64
|
|
01008 ELSE DTSCS64
|
|
01009 IF LCCM-F10-88 DTSCS64
|
|
01010 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS64
|
|
01011 ELSE DTSCS64
|
|
01012 IF LCCM-F23-88 DTSCS64
|
|
01013 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS64
|
|
01014 ELSE DTSCS64
|
|
01015 GO TO S899-ABEND. DTSCS64
|
|
01016 DTSCS64
|
|
01017 *------------------------------------------------------ DTSCS64
|
|
01018 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS64
|
|
01019 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS64
|
|
01020 * REMAIN IN 'INQUIRE' STATUS. DTSCS64
|
|
01021 *------------------------------------------------------ DTSCS64
|
|
01022 DTSCS64
|
|
01023 IF LCCM-MSG DTSCS64
|
|
01024 NEXT SENTENCE DTSCS64
|
|
01025 ELSE DTSCS64
|
|
01026 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS64
|
|
01027 IF LCCM-F09-88 DTSCS64
|
|
01028 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS64
|
|
01029 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS64
|
|
01030 ELSE DTSCS64
|
|
01031 IF LCCM-F10-88 DTSCS64
|
|
01032 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS64
|
|
01033 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS64
|
|
01034 ELSE DTSCS64
|
|
01035 IF LCCM-F23-88 DTSCS64
|
|
01036 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS64
|
|
01037 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS64
|
|
01038 DTSCS64
|
|
01039 SET RESP-SEND-MAP TO TRUE. DTSCS64
|
|
01040 P7000-EXIT. DTSCS64
|
|
01041 EXIT. DTSCS64
|
|
01042 /*****************************************************************DTSCS64
|
|
01043 * ADD FUNCTION WAS REQUESTED *DTSCS64
|
|
01044 ******************************************************************DTSCS64
|
|
01045 DTSCS64
|
|
01046 P7100-EDIT-ADD. DTSCS64
|
|
01047 *----------------------------------------------------- DTSCS64
|
|
01048 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS64
|
|
01049 *----------------------------------------------------- DTSCS64
|
|
01050 IF NOT LCCM-SCR-CLEAR DTSCS64
|
|
01051 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS64
|
|
01052 GO TO P7100-EXIT. DTSCS64
|
|
01053 DTSCS64
|
|
01054 *----------------------------------------------------- DTSCS64
|
|
01055 * DTSCS64
|
|
01056 *----------------------------------------------------- DTSCS64
|
|
01057 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64
|
|
01058 IF LCCM-MSG DTSCS64
|
|
01059 GO TO P7100-EXIT. DTSCS64
|
|
01060 DTSCS64
|
|
01061 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64
|
|
01062 IF LCCM-MSG DTSCS64
|
|
01063 GO TO P7100-EXIT. DTSCS64
|
|
01064 DTSCS64
|
|
01065 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS64
|
|
01066 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS64
|
|
01067 DTSCS64
|
|
01068 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64
|
|
01069 DTSCS64
|
|
01070 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64
|
|
01071 IF LCCM-MSG DTSCS64
|
|
01072 GO TO P7100-EXIT. DTSCS64
|
|
01073 DTSCS64
|
|
01074 PERFORM S1140-READ-MAUR THRU S1140-EXIT. DTSCS64
|
|
01075 IF LCCM-MSG DTSCS64
|
|
01076 GO TO P7100-EXIT. DTSCS64
|
|
01077 DTSCS64
|
|
01078 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64
|
|
01079 DTSCS64
|
|
01080 P7100-EXIT. DTSCS64
|
|
01081 EXIT. DTSCS64
|
|
01082 /*****************************************************************DTSCS64
|
|
01083 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS64
|
|
01084 ******************************************************************DTSCS64
|
|
01085 DTSCS64
|
|
01086 P7200-EDIT-MOD. DTSCS64
|
|
01087 *----------------------------------------------------- DTSCS64
|
|
01088 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS64
|
|
01089 * INQUIRED DTSCS64
|
|
01090 *----------------------------------------------------- DTSCS64
|
|
01091 IF NOT LCCM-SCR-INQUIRE DTSCS64
|
|
01092 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS64
|
|
01093 GO TO P7200-EXIT. DTSCS64
|
|
01094 DTSCS64
|
|
01095 *----------------------------------------------------- DTSCS64
|
|
01096 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE MOD DTSCS64
|
|
01097 *----------------------------------------------------- DTSCS64
|
|
01098 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64
|
|
01099 IF LCCM-MSG DTSCS64
|
|
01100 GO TO P7200-EXIT. DTSCS64
|
|
01101 DTSCS64
|
|
01102 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64
|
|
01103 IF LCCM-MSG DTSCS64
|
|
01104 GO TO P7200-EXIT. DTSCS64
|
|
01105 DTSCS64
|
|
01106 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64
|
|
01107 DTSCS64
|
|
01108 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64
|
|
01109 DTSCS64
|
|
01110 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS64
|
|
01111 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS64
|
|
01112 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01113 GO TO P7200-EXIT. DTSCS64
|
|
01114 DTSCS64
|
|
01115 MOVE MAP-CALENDAR-YEAR TO L007-YR-2-X. DTSCS64
|
|
01116 PERFORM S007-CAL-YEAR-EDIT THRU S007-EXIT. DTSCS64
|
|
01117 MOVE LCCM-SCR64-HOLD-AREA TO MAUY-KEY-AREA. DTSCS64
|
|
01118 IF (L007-VALID-YR) DTSCS64
|
|
01119 AND DTSCS64
|
|
01120 (L007-YR-4-9 = MAUY-CALENDAR-YEAR) DTSCS64
|
|
01121 NEXT SENTENCE DTSCS64
|
|
01122 ELSE DTSCS64
|
|
01123 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS64
|
|
01124 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64
|
|
01125 GO TO P7200-EXIT. DTSCS64
|
|
01126 DTSCS64
|
|
01127 PERFORM S1140-READ-MAUR THRU S1140-EXIT. DTSCS64
|
|
01128 IF LCCM-MSG DTSCS64
|
|
01129 GO TO P7200-EXIT. DTSCS64
|
|
01130 DTSCS64
|
|
01131 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64
|
|
01132 DTSCS64
|
|
01133 P7200-EXIT. DTSCS64
|
|
01134 EXIT. DTSCS64
|
|
01135 /*****************************************************************DTSCS64
|
|
01136 * DELETE FUNCTION WAS REQUESTED *DTSCS64
|
|
01137 ******************************************************************DTSCS64
|
|
01138 DTSCS64
|
|
01139 P7300-EDIT-DEL. DTSCS64
|
|
01140 *----------------------------------------------------- DTSCS64
|
|
01141 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS64
|
|
01142 * INQUIRED DTSCS64
|
|
01143 *----------------------------------------------------- DTSCS64
|
|
01144 IF NOT LCCM-SCR-INQUIRE DTSCS64
|
|
01145 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS64
|
|
01146 GO TO P7300-EXIT. DTSCS64
|
|
01147 DTSCS64
|
|
01148 *----------------------------------------------------- DTSCS64
|
|
01149 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE DEL DTSCS64
|
|
01150 *----------------------------------------------------- DTSCS64
|
|
01151 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64
|
|
01152 IF LCCM-MSG DTSCS64
|
|
01153 GO TO P7300-EXIT. DTSCS64
|
|
01154 DTSCS64
|
|
01155 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64
|
|
01156 IF LCCM-MSG DTSCS64
|
|
01157 GO TO P7300-EXIT. DTSCS64
|
|
01158 DTSCS64
|
|
01159 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS64
|
|
01160 DTSCS64
|
|
01161 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64
|
|
01162 DTSCS64
|
|
01163 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS64
|
|
01164 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS64
|
|
01165 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01166 GO TO P7300-EXIT. DTSCS64
|
|
01167 DTSCS64
|
|
01168 MOVE MAP-CALENDAR-YEAR TO L007-YR-2-X. DTSCS64
|
|
01169 PERFORM S007-CAL-YEAR-EDIT THRU S007-EXIT. DTSCS64
|
|
01170 MOVE LCCM-SCR64-HOLD-AREA TO MAUY-KEY-AREA. DTSCS64
|
|
01171 IF (L007-VALID-YR) DTSCS64
|
|
01172 AND DTSCS64
|
|
01173 (L007-YR-4-9 = MAUY-CALENDAR-YEAR) DTSCS64
|
|
01174 NEXT SENTENCE DTSCS64
|
|
01175 ELSE DTSCS64
|
|
01176 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS64
|
|
01177 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64
|
|
01178 GO TO P7300-EXIT. DTSCS64
|
|
01179 DTSCS64
|
|
01180 P7300-EXIT. DTSCS64
|
|
01181 EXIT. DTSCS64
|
|
01182 /*****************************************************************DTSCS64
|
|
01183 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS64
|
|
01184 ******************************************************************DTSCS64
|
|
01185 DTSCS64
|
|
01186 P8000-REQUEST-UPDATE. DTSCS64
|
|
01187 DTSCS64
|
|
01188 DTSCS64
|
|
01189 IF LCCM-SCR-ADD-LOCKED DTSCS64
|
|
01190 PERFORM P8100-ADD THRU P8100-EXIT DTSCS64
|
|
01191 ELSE DTSCS64
|
|
01192 IF LCCM-SCR-MOD-LOCKED DTSCS64
|
|
01193 PERFORM P8200-MOD THRU P8200-EXIT DTSCS64
|
|
01194 ELSE DTSCS64
|
|
01195 IF LCCM-SCR-DEL-LOCKED DTSCS64
|
|
01196 PERFORM P8300-DEL THRU P8300-EXIT DTSCS64
|
|
01197 ELSE DTSCS64
|
|
01198 GO TO S899-ABEND. DTSCS64
|
|
01199 DTSCS64
|
|
01200 SET RESP-SEND-MAP TO TRUE. DTSCS64
|
|
01201 P8000-EXIT. DTSCS64
|
|
01202 EXIT. DTSCS64
|
|
01203 /*****************************************************************DTSCS64
|
|
01204 * *DTSCS64
|
|
01205 ******************************************************************DTSCS64
|
|
01206 DTSCS64
|
|
01207 P8100-ADD. DTSCS64
|
|
01208 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64
|
|
01209 DTSCS64
|
|
01210 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64
|
|
01211 DTSCS64
|
|
01212 IF LCCM-F12-88 DTSCS64
|
|
01213 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS64
|
|
01214 GO TO P8100-EXIT. DTSCS64
|
|
01215 DTSCS64
|
|
01216 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64
|
|
01217 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64
|
|
01218 DTSCS64
|
|
01219 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS64
|
|
01220 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS64
|
|
01221 IF LCCM-MSG DTSCS64
|
|
01222 GO TO P8100-EXIT. DTSCS64
|
|
01223 DTSCS64
|
|
01224 DTSCS64
|
|
01225 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64
|
|
01226 PERFORM P8110-CONSTRUCT-MAUY THRU P8110-EXIT. DTSCS64
|
|
01227 DTSCS64
|
|
01228 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS64
|
|
01229 DTSCS64
|
|
01230 DTSCS64
|
|
01231 MOVE MAUY-KEY-AREA TO LCCM-SCR64-HOLD-AREA. DTSCS64
|
|
01232 SET LCCM-ENTER-88 TO TRUE. DTSCS64
|
|
01233 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS64
|
|
01234 DTSCS64
|
|
01235 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS64
|
|
01236 DTSCS64
|
|
01237 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64
|
|
01238 P8100-EXIT. DTSCS64
|
|
01239 EXIT. DTSCS64
|
|
01240 DTSCS64
|
|
01241 P8110-CONSTRUCT-MAUY. DTSCS64
|
|
01242 MOVE LOW-VALUES TO MAUY-REC. DTSCS64
|
|
01243 DTSCS64
|
|
01244 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64
|
|
01245 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64
|
|
01246 SET MAUY-AUY-88 TO TRUE. DTSCS64
|
|
01247 DTSCS64
|
|
01248 MOVE +0 TO MAUY-PURGE-DATE. DTSCS64
|
|
01249 SET MAUY-NOT-CONVERTED-88 TO TRUE. DTSCS64
|
|
01250 MOVE LCCM-CURR-RUN-DATE TO MAUY-ESTB-DATE. DTSCS64
|
|
01251 MOVE LCCM-CURR-RUN-DATE TO MAUY-CHNG-DATE. DTSCS64
|
|
01252 DTSCS64
|
|
01253 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64
|
|
01254 DTSCS64
|
|
01255 MOVE MAUY-REC TO MSKL-REC. DTSCS64
|
|
01256 PERFORM S810-WRITE THRU S810-EXIT. DTSCS64
|
|
01257 DTSCS64
|
|
01258 P8110-EXIT. DTSCS64
|
|
01259 EXIT. DTSCS64
|
|
01260 /*****************************************************************DTSCS64
|
|
01261 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS64
|
|
01262 ******************************************************************DTSCS64
|
|
01263 DTSCS64
|
|
01264 P8200-MOD. DTSCS64
|
|
01265 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS64
|
|
01266 DTSCS64
|
|
01267 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64
|
|
01268 DTSCS64
|
|
01269 IF LCCM-F12-88 DTSCS64
|
|
01270 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS64
|
|
01271 GO TO P8200-EXIT. DTSCS64
|
|
01272 DTSCS64
|
|
01273 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64
|
|
01274 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64
|
|
01275 DTSCS64
|
|
01276 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS64
|
|
01277 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS64
|
|
01278 IF LCCM-MSG DTSCS64
|
|
01279 GO TO P8200-EXIT. DTSCS64
|
|
01280 DTSCS64
|
|
01281 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS64
|
|
01282 PERFORM P8210-CONSTRUCT-MAUY THRU P8210-EXIT. DTSCS64
|
|
01283 DTSCS64
|
|
01284 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS64
|
|
01285 DTSCS64
|
|
01286 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS64
|
|
01287 DTSCS64
|
|
01288 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64
|
|
01289 P8200-EXIT. DTSCS64
|
|
01290 EXIT. DTSCS64
|
|
01291 EJECT DTSCS64
|
|
01292 P8210-CONSTRUCT-MAUY. DTSCS64
|
|
01293 MOVE LCCM-SCR64-HOLD-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
01294 PERFORM S810-READ THRU S810-EXIT. DTSCS64
|
|
01295 IF L810-NO-REC-88 DTSCS64
|
|
01296 GO TO S899-ABEND. DTSCS64
|
|
01297 DTSCS64
|
|
01298 MOVE MSKL-REC TO MAUY-REC. DTSCS64
|
|
01299 DTSCS64
|
|
01300 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS64
|
|
01301 DTSCS64
|
|
01302 MOVE LCCM-CURR-RUN-DATE TO MAUY-CHNG-DATE. DTSCS64
|
|
01303 DTSCS64
|
|
01304 MOVE MAUY-REC TO MSKL-REC. DTSCS64
|
|
01305 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS64
|
|
01306 P8210-EXIT. DTSCS64
|
|
01307 EXIT. DTSCS64
|
|
01308 /*****************************************************************DTSCS64
|
|
01309 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS64
|
|
01310 ******************************************************************DTSCS64
|
|
01311 DTSCS64
|
|
01312 P8300-DEL. DTSCS64
|
|
01313 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS64
|
|
01314 DTSCS64
|
|
01315 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64
|
|
01316 DTSCS64
|
|
01317 IF LCCM-F12-88 DTSCS64
|
|
01318 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS64
|
|
01319 GO TO P8300-EXIT. DTSCS64
|
|
01320 DTSCS64
|
|
01321 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS64
|
|
01322 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS64
|
|
01323 DTSCS64
|
|
01324 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS64
|
|
01325 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS64
|
|
01326 IF LCCM-MSG DTSCS64
|
|
01327 GO TO P8300-EXIT. DTSCS64
|
|
01328 DTSCS64
|
|
01329 MOVE LCCM-SCR64-HOLD-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
01330 PERFORM S810-READ THRU S810-EXIT. DTSCS64
|
|
01331 IF L810-NO-REC-88 DTSCS64
|
|
01332 GO TO S899-ABEND. DTSCS64
|
|
01333 DTSCS64
|
|
01334 PERFORM S810-DELETE THRU S810-EXIT. DTSCS64
|
|
01335 DTSCS64
|
|
01336 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS64
|
|
01337 DTSCS64
|
|
01338 MOVE LOW-VALUES TO MAP-AREA. DTSCS64
|
|
01339 DTSCS64
|
|
01340 MOVE WRK-ASSIGN-NO TO WRK-DISPLAY. DTSCS64
|
|
01341 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1. DTSCS64
|
|
01342 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2. DTSCS64
|
|
01343 DTSCS64
|
|
01344 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS64
|
|
01345 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS64
|
|
01346 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS64
|
|
01347 DTSCS64
|
|
01348 MOVE LCCM-SCR64-HOLD-AREA TO MAUY-KEY-AREA. DTSCS64
|
|
01349 MOVE MAUY-CALENDAR-YEAR TO WRK-DISPLAY. DTSCS64
|
|
01350 MOVE WRK-DISPLAY-CAL-YR TO MAP-CALENDAR-YEAR. DTSCS64
|
|
01351 DTSCS64
|
|
01352 SET LCCM-SCR-CLEAR TO TRUE. DTSCS64
|
|
01353 DTSCS64
|
|
01354 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS64
|
|
01355 DTSCS64
|
|
01356 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS64
|
|
01357 DTSCS64
|
|
01358 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS64
|
|
01359 P8300-EXIT. DTSCS64
|
|
01360 EXIT. DTSCS64
|
|
01361 EJECT DTSCS64
|
|
01362 DTSCS64
|
|
01363 P8810-LOCK-EMPLOYER. DTSCS64
|
|
01364 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS64
|
|
01365 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS64
|
|
01366 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS64
|
|
01367 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS64
|
|
01368 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS64
|
|
01369 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS64
|
|
01370 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS64
|
|
01371 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS64
|
|
01372 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS64
|
|
01373 DTSCS64
|
|
01374 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS64
|
|
01375 P8810-EXIT. DTSCS64
|
|
01376 EXIT. DTSCS64
|
|
01377 EJECT DTSCS64
|
|
01378 DTSCS64
|
|
01379 /*****************************************************************DTSCS64
|
|
01380 * LINKS TO UTILITY MODULES DTSCS64
|
|
01381 ******************************************************************DTSCS64
|
|
01382 DTSCS64
|
|
01383 S001-FROM-FED-8. DTSCS64
|
|
01384 SET L001-FROM-FED-8 TO TRUE. DTSCS64
|
|
01385 GO TO S001-DATE. DTSCS64
|
|
01386 DTSCS64
|
|
01387 S001-FROM-ABS-DATE. DTSCS64
|
|
01388 SET L001-FROM-ABS-DAY TO TRUE. DTSCS64
|
|
01389 GO TO S001-DATE. DTSCS64
|
|
01390 DTSCS64
|
|
01391 S001-DATE. DTSCS64
|
|
01392 EXEC CICS LINK DTSCS64
|
|
01393 PROGRAM('DTSCU001') DTSCS64
|
|
01394 COMMAREA(L001-COMM-AREA) DTSCS64
|
|
01395 END-EXEC. DTSCS64
|
|
01396 S001-EXIT. DTSCS64
|
|
01397 EXIT. DTSCS64
|
|
01398 DTSCS64
|
|
01399 DTSCS64
|
|
01400 S007-CAL-YEAR-EDIT. DTSCS64
|
|
01401 SET L007-FROM-YR-2 TO TRUE. DTSCS64
|
|
01402 EXEC CICS LINK DTSCS64
|
|
01403 PROGRAM('DTSCU007') DTSCS64
|
|
01404 COMMAREA(L007-COMM-AREA) DTSCS64
|
|
01405 END-EXEC. DTSCS64
|
|
01406 S007-EXIT. DTSCS64
|
|
01407 EXIT. DTSCS64
|
|
01408 DTSCS64
|
|
01409 S011-MONEY-FROM-SCREEN. DTSCS64
|
|
01410 MOVE +99999999.99 TO L011-MAX-AMT. DTSCS64
|
|
01411 MOVE +0 TO L011-MIN-AMT. DTSCS64
|
|
01412 EXEC CICS LINK DTSCS64
|
|
01413 PROGRAM('DTSCU011') DTSCS64
|
|
01414 COMMAREA(L011-COMM-AREA) DTSCS64
|
|
01415 END-EXEC. DTSCS64
|
|
01416 S011-EXIT. DTSCS64
|
|
01417 EXIT. DTSCS64
|
|
01418 DTSCS64
|
|
01419 S022-ASSIGN-NO-FROM-SCREEN. DTSCS64
|
|
01420 EXEC CICS LINK DTSCS64
|
|
01421 PROGRAM('DTSCU022') DTSCS64
|
|
01422 COMMAREA(L022-COMM-AREA) DTSCS64
|
|
01423 END-EXEC. DTSCS64
|
|
01424 S022-EXIT. DTSCS64
|
|
01425 EXIT. DTSCS64
|
|
01426 DTSCS64
|
|
01427 S221-EMP-LOCK. DTSCS64
|
|
01428 SET L221-START-UPDATE TO TRUE. DTSCS64
|
|
01429 GO TO S221-EMP-LOCK-UNLOCK. DTSCS64
|
|
01430 DTSCS64
|
|
01431 S221-EMP-UNLOCK. DTSCS64
|
|
01432 SET L221-END-UPDATE TO TRUE. DTSCS64
|
|
01433 GO TO S221-EMP-LOCK-UNLOCK. DTSCS64
|
|
01434 DTSCS64
|
|
01435 S221-EMP-LOCK-UNLOCK. DTSCS64
|
|
01436 EXEC CICS LINK DTSCS64
|
|
01437 PROGRAM('DTSCU221') DTSCS64
|
|
01438 COMMAREA(L221-COMM-AREA) DTSCS64
|
|
01439 END-EXEC. DTSCS64
|
|
01440 DTSCS64
|
|
01441 IF L221-FILE-CLOSED DTSCS64
|
|
01442 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01443 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64
|
|
01444 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64
|
|
01445 GO TO MAINLINE-EXIT. DTSCS64
|
|
01446 DTSCS64
|
|
01447 IF L221-NOT-OK DTSCS64
|
|
01448 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS64
|
|
01449 S221-EXIT. DTSCS64
|
|
01450 EXIT. DTSCS64
|
|
01451 DTSCS64
|
|
01452 S803-REQ-SCR-ID-EDIT. DTSCS64
|
|
01453 EXEC CICS LINK DTSCS64
|
|
01454 PROGRAM ('DTSCU803') DTSCS64
|
|
01455 COMMAREA (DFHCOMMAREA) DTSCS64
|
|
01456 END-EXEC. DTSCS64
|
|
01457 S803-EXIT. DTSCS64
|
|
01458 EXIT. DTSCS64
|
|
01459 DTSCS64
|
|
01460 S804-INVALID-KEY. DTSCS64
|
|
01461 EXEC CICS LINK DTSCS64
|
|
01462 PROGRAM ('DTSCU804') DTSCS64
|
|
01463 COMMAREA (DFHCOMMAREA) DTSCS64
|
|
01464 END-EXEC. DTSCS64
|
|
01465 S804-EXIT. DTSCS64
|
|
01466 EXIT. DTSCS64
|
|
01467 DTSCS64
|
|
01468 S805-MSG-AREA. DTSCS64
|
|
01469 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS64
|
|
01470 DTSCS64
|
|
01471 EXEC CICS LINK DTSCS64
|
|
01472 PROGRAM ('DTSCU805') DTSCS64
|
|
01473 COMMAREA (L805-COMM-AREA) DTSCS64
|
|
01474 END-EXEC. DTSCS64
|
|
01475 DTSCS64
|
|
01476 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS64
|
|
01477 S805-EXIT. DTSCS64
|
|
01478 EXIT. DTSCS64
|
|
01479 EJECT DTSCS64
|
|
01480 S810-READ. DTSCS64
|
|
01481 SET L810-READ-88 TO TRUE. DTSCS64
|
|
01482 GO TO S810-IO. DTSCS64
|
|
01483 DTSCS64
|
|
01484 S810-START-BROWSE. DTSCS64
|
|
01485 SET L810-START-BROWSE-88 TO TRUE. DTSCS64
|
|
01486 GO TO S810-IO. DTSCS64
|
|
01487 DTSCS64
|
|
01488 S810-READ-NEXT. DTSCS64
|
|
01489 SET L810-READ-NEXT-88 TO TRUE. DTSCS64
|
|
01490 GO TO S810-IO. DTSCS64
|
|
01491 DTSCS64
|
|
01492 S810-READ-PREV. DTSCS64
|
|
01493 SET L810-READ-PREV-88 TO TRUE. DTSCS64
|
|
01494 GO TO S810-IO. DTSCS64
|
|
01495 DTSCS64
|
|
01496 S810-END-BROWSE. DTSCS64
|
|
01497 SET L810-END-BROWSE-88 TO TRUE. DTSCS64
|
|
01498 GO TO S810-IO. DTSCS64
|
|
01499 DTSCS64
|
|
01500 S810-COUNT. DTSCS64
|
|
01501 SET L810-COUNT-88 TO TRUE. DTSCS64
|
|
01502 GO TO S810-IO. DTSCS64
|
|
01503 DTSCS64
|
|
01504 S810-REWRITE. DTSCS64
|
|
01505 SET L810-REWRITE-88 TO TRUE. DTSCS64
|
|
01506 GO TO S810-IO. DTSCS64
|
|
01507 DTSCS64
|
|
01508 S810-WRITE. DTSCS64
|
|
01509 SET L810-WRITE-88 TO TRUE. DTSCS64
|
|
01510 GO TO S810-IO. DTSCS64
|
|
01511 DTSCS64
|
|
01512 S810-DELETE. DTSCS64
|
|
01513 SET L810-DELETE-88 TO TRUE. DTSCS64
|
|
01514 GO TO S810-IO. DTSCS64
|
|
01515 DTSCS64
|
|
01516 S810-IO. DTSCS64
|
|
01517 DTSCS64
|
|
01518 EXEC CICS LINK DTSCS64
|
|
01519 PROGRAM ('DTSCU810') DTSCS64
|
|
01520 COMMAREA (L810-COMM-AREA) DTSCS64
|
|
01521 END-EXEC. DTSCS64
|
|
01522 DTSCS64
|
|
01523 IF L810-FILE-CLOSED-88 DTSCS64
|
|
01524 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01525 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64
|
|
01526 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64
|
|
01527 GO TO MAINLINE-EXIT. DTSCS64
|
|
01528 S810-EXIT. DTSCS64
|
|
01529 EXIT. DTSCS64
|
|
01530 EJECT DTSCS64
|
|
01531 S821-START-BROWSE. DTSCS64
|
|
01532 SET L821-START-BROWSE-88 TO TRUE. DTSCS64
|
|
01533 GO TO S821-MASTER-IO. DTSCS64
|
|
01534 S821-END-BROWSE. DTSCS64
|
|
01535 SET L821-END-BROWSE-88 TO TRUE. DTSCS64
|
|
01536 GO TO S821-MASTER-IO. DTSCS64
|
|
01537 S821-READ-PREV. DTSCS64
|
|
01538 SET L821-READ-PREV-88 TO TRUE. DTSCS64
|
|
01539 GO TO S821-MASTER-IO. DTSCS64
|
|
01540 S821-READ-NEXT. DTSCS64
|
|
01541 SET L821-READ-NEXT-88 TO TRUE. DTSCS64
|
|
01542 GO TO S821-MASTER-IO. DTSCS64
|
|
01543 S821-MASTER-IO. DTSCS64
|
|
01544 EXEC CICS LINK DTSCS64
|
|
01545 PROGRAM ('DTSCU821') DTSCS64
|
|
01546 COMMAREA (L821-COMM-AREA) DTSCS64
|
|
01547 END-EXEC. DTSCS64
|
|
01548 IF L821-FILE-CLOSED-88 DTSCS64
|
|
01549 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01550 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64
|
|
01551 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64
|
|
01552 GO TO MAINLINE-EXIT DTSCS64
|
|
01553 END-IF. DTSCS64
|
|
01554 S821-EXIT. EXIT. DTSCS64
|
|
01555 EJECT DTSCS64
|
|
01556 S851-SCREEN-PROCESSING. DTSCS64
|
|
01557 EXEC CICS LINK DTSCS64
|
|
01558 PROGRAM ('DTSCU851') DTSCS64
|
|
01559 COMMAREA (L851-COMM-AREA) DTSCS64
|
|
01560 END-EXEC. DTSCS64
|
|
01561 S851-EXIT. DTSCS64
|
|
01562 EXIT. DTSCS64
|
|
01563 DTSCS64
|
|
01564 S899-ABEND. DTSCS64
|
|
01565 EXEC CICS ABEND DTSCS64
|
|
01566 ABCODE(WRK-ABEND-CD) DTSCS64
|
|
01567 END-EXEC. DTSCS64
|
|
01568 S899-EXIT. DTSCS64
|
|
01569 EXIT. DTSCS64
|
|
01570 /*****************************************************************DTSCS64
|
|
01571 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS64
|
|
01572 ******************************************************************DTSCS64
|
|
01573 DTSCS64
|
|
01574 S1000-SCREEN-EDITS. DTSCS64
|
|
01575 DTSCS64
|
|
01576 PERFORM S1200-CALENDAR-YEAR THRU S1200-EXIT. DTSCS64
|
|
01577 DTSCS64
|
|
01578 PERFORM S1300-GROSS-PAYROLL THRU S1300-EXIT DTSCS64
|
|
01579 VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
01580 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64
|
|
01581 DTSCS64
|
|
01582 PERFORM S1400-UNDER-TOT-WAGE THRU S1400-EXIT DTSCS64
|
|
01583 VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
01584 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64
|
|
01585 DTSCS64
|
|
01586 PERFORM S1500-UNDER-TAX-WAGE THRU S1500-EXIT DTSCS64
|
|
01587 VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
01588 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64
|
|
01589 DTSCS64
|
|
01590 PERFORM S1600-UNDER-CONTRIB THRU S1600-EXIT DTSCS64
|
|
01591 VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
01592 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64
|
|
01593 DTSCS64
|
|
01594 PERFORM S1700-OVER-TOT-WAGE THRU S1700-EXIT DTSCS64
|
|
01595 VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
01596 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64
|
|
01597 DTSCS64
|
|
01598 PERFORM S1800-OVER-TAX-WAGE THRU S1800-EXIT DTSCS64
|
|
01599 VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
01600 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64
|
|
01601 DTSCS64
|
|
01602 PERFORM S1900-OVER-CONTRIB THRU S1900-EXIT DTSCS64
|
|
01603 VARYING WRK-OCC FROM 1 BY 1 DTSCS64
|
|
01604 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX. DTSCS64
|
|
01605 DTSCS64
|
|
01606 IF LCCM-MSG DTSCS64
|
|
01607 GO TO S1000-EXIT. DTSCS64
|
|
01608 DTSCS64
|
|
01609 PERFORM S2000-MISC-EDITS THRU S2000-EXIT. DTSCS64
|
|
01610 S1000-EXIT. EXIT. DTSCS64
|
|
01611 EJECT DTSCS64
|
|
01612 /*****************************************************************DTSCS64
|
|
01613 * DTSCS64
|
|
01614 ******************************************************************DTSCS64
|
|
01615 S1100-EDIT-KEY. DTSCS64
|
|
01616 PERFORM S1101-ASSIGN-NO THRU S1101-EXIT. DTSCS64
|
|
01617 S1100-EXIT. EXIT. DTSCS64
|
|
01618 /*****************************************************************DTSCS64
|
|
01619 * DTSCS64
|
|
01620 ******************************************************************DTSCS64
|
|
01621 S1101-ASSIGN-NO. DTSCS64
|
|
01622 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS64
|
|
01623 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS64
|
|
01624 DTSCS64
|
|
01625 IF L022-NO-ENTRY DTSCS64
|
|
01626 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS64
|
|
01627 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01628 GO TO S1101-EXIT. DTSCS64
|
|
01629 DTSCS64
|
|
01630 IF L022-NOT-VALID DTSCS64
|
|
01631 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
01632 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01633 GO TO S1101-EXIT. DTSCS64
|
|
01634 DTSCS64
|
|
01635 MOVE L022-ASSIGN-NO TO WRK-ASSIGN-NO. DTSCS64
|
|
01636 S1101-EXIT. EXIT. DTSCS64
|
|
01637 DTSCS64
|
|
01638 /*****************************************************************DTSCS64
|
|
01639 * DTSCS64
|
|
01640 ******************************************************************DTSCS64
|
|
01641 S1110-READ-MFAS. DTSCS64
|
|
01642 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCS64
|
|
01643 MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSCS64
|
|
01644 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSCS64
|
|
01645 SET MFAS-FAS-88 TO TRUE. DTSCS64
|
|
01646 DTSCS64
|
|
01647 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
01648 DTSCS64
|
|
01649 PERFORM S810-READ THRU S810-EXIT. DTSCS64
|
|
01650 DTSCS64
|
|
01651 IF L810-NO-REC-88 DTSCS64
|
|
01652 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS64
|
|
01653 MOVE MSG-E645-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01654 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64
|
|
01655 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64
|
|
01656 GO TO MAINLINE-EXIT DTSCS64
|
|
01657 ELSE DTSCS64
|
|
01658 MOVE MSKL-REC TO MFAS-REC DTSCS64
|
|
01659 END-IF. DTSCS64
|
|
01660 DTSCS64
|
|
01661 IF MFAS-NON-AUDIT-88 DTSCS64
|
|
01662 MOVE MSG-E643-AREA TO WRK-MSG-AREA DTSCS64
|
|
01663 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01664 GO TO S1110-EXIT. DTSCS64
|
|
01665 DTSCS64
|
|
01666 IF MFAS-STATUS-PROCESSED-88 DTSCS64
|
|
01667 CONTINUE DTSCS64
|
|
01668 ELSE DTSCS64
|
|
01669 MOVE MSG-E642-AREA TO WRK-MSG-AREA DTSCS64
|
|
01670 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01671 GO TO S1110-EXIT DTSCS64
|
|
01672 END-IF. DTSCS64
|
|
01673 DTSCS64
|
|
01674 S1110-EXIT. DTSCS64
|
|
01675 EXIT. DTSCS64
|
|
01676 /*****************************************************************DTSCS64
|
|
01677 * DTSCS64
|
|
01678 ******************************************************************DTSCS64
|
|
01679 S1120-READ-IFAN. DTSCS64
|
|
01680 MOVE LOW-VALUES TO IFAN-KEY-AREA. DTSCS64
|
|
01681 SET IFAN-FAN-88 TO TRUE. DTSCS64
|
|
01682 MOVE WRK-ASSIGN-NO TO IFAN-ASSIGN-NO. DTSCS64
|
|
01683 DTSCS64
|
|
01684 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS64
|
|
01685 DTSCS64
|
|
01686 IF L821-OK-88 DTSCS64
|
|
01687 IF IFAN-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS64
|
|
01688 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS64
|
|
01689 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01690 ELSE DTSCS64
|
|
01691 MOVE IFAN-EMP-NO TO WRK-EMP-NO DTSCS64
|
|
01692 END-IF DTSCS64
|
|
01693 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS64
|
|
01694 ELSE DTSCS64
|
|
01695 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS64
|
|
01696 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01697 END-IF. DTSCS64
|
|
01698 DTSCS64
|
|
01699 S1120-EXIT. DTSCS64
|
|
01700 EXIT. DTSCS64
|
|
01701 DTSCS64
|
|
01702 /*****************************************************************DTSCS64
|
|
01703 * DTSCS64
|
|
01704 ******************************************************************DTSCS64
|
|
01705 S1130-READ-MPRF. DTSCS64
|
|
01706 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS64
|
|
01707 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS64
|
|
01708 SET MPRF-PRF-88 TO TRUE. DTSCS64
|
|
01709 DTSCS64
|
|
01710 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
01711 DTSCS64
|
|
01712 PERFORM S810-READ THRU S810-EXIT. DTSCS64
|
|
01713 DTSCS64
|
|
01714 IF L810-NO-REC-88 DTSCS64
|
|
01715 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS64
|
|
01716 MOVE MSG-E645-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01717 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS64
|
|
01718 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS64
|
|
01719 GO TO MAINLINE-EXIT DTSCS64
|
|
01720 ELSE DTSCS64
|
|
01721 MOVE MSKL-REC TO MPRF-REC DTSCS64
|
|
01722 SET WRK-MPRF-YES-88 TO TRUE DTSCS64
|
|
01723 END-IF. DTSCS64
|
|
01724 DTSCS64
|
|
01725 S1130-EXIT. DTSCS64
|
|
01726 EXIT. DTSCS64
|
|
01727 DTSCS64
|
|
01728 S1140-READ-MAUR. DTSCS64
|
|
01729 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS64
|
|
01730 MOVE WRK-EMP-NO TO MAUR-EMP-NO. DTSCS64
|
|
01731 SET MAUR-AUR-88 TO TRUE. DTSCS64
|
|
01732 MOVE WRK-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS64
|
|
01733 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
01734 DTSCS64
|
|
01735 PERFORM S810-READ THRU S810-EXIT. DTSCS64
|
|
01736 DTSCS64
|
|
01737 IF L810-NO-REC-88 DTSCS64
|
|
01738 MOVE MSG-E642-AREA TO WRK-MSG-AREA DTSCS64
|
|
01739 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
01740 ELSE DTSCS64
|
|
01741 MOVE MSKL-REC TO MAUR-REC. DTSCS64
|
|
01742 S1140-EXIT. DTSCS64
|
|
01743 EXIT. DTSCS64
|
|
01744 DTSCS64
|
|
01745 S1199-ERROR. DTSCS64
|
|
01746 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS64
|
|
01747 MAP-ASSIGN-NO-2-A. DTSCS64
|
|
01748 IF LCCM-NO-MSG DTSCS64
|
|
01749 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01750 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L DTSCS64
|
|
01751 SET CURSOR-SET-YES TO TRUE. DTSCS64
|
|
01752 S1199-EXIT. EXIT. DTSCS64
|
|
01753 DTSCS64
|
|
01754 /*****************************************************************DTSCS64
|
|
01755 * DTSCS64
|
|
01756 ******************************************************************DTSCS64
|
|
01757 S1200-CALENDAR-YEAR. DTSCS64
|
|
01758 MOVE 0 TO WRK-CALENDAR-YEAR. DTSCS64
|
|
01759 IF MAP-CALENDAR-YEAR = LOW-VALUES OR SPACES DTSCS64
|
|
01760 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS64
|
|
01761 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64
|
|
01762 GO TO S1200-EXIT DTSCS64
|
|
01763 ELSE DTSCS64
|
|
01764 MOVE MAP-CALENDAR-YEAR TO L007-YR-2-X DTSCS64
|
|
01765 PERFORM S007-CAL-YEAR-EDIT THRU S007-EXIT DTSCS64
|
|
01766 IF L007-NOT-VALID-YR DTSCS64
|
|
01767 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
01768 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64
|
|
01769 GO TO S1200-EXIT DTSCS64
|
|
01770 ELSE DTSCS64
|
|
01771 MOVE L007-YR-4-9 TO MAUY-CALENDAR-YEAR DTSCS64
|
|
01772 WRK-CALENDAR-YEAR DTSCS64
|
|
01773 END-IF. DTSCS64
|
|
01774 DTSCS64
|
|
01775 IF LCCM-F09-88 OR LCCM-F10-88 DTSCS64
|
|
01776 NEXT SENTENCE DTSCS64
|
|
01777 ELSE DTSCS64
|
|
01778 GO TO S1200-EXIT. DTSCS64
|
|
01779 DTSCS64
|
|
01780 ***** EVEN IF MAP-CALENDAR-YEAR WAS INVALID THIS SHOULD DTSCS64
|
|
01781 ****** STILL WORK MAUY-CALENDAR-YEAR SHOULD HAVE 0000 IN IT DTSCS64
|
|
01782 ****** AND MAUR BETTER HAVE BEEN READ. DTSCS64
|
|
01783 DTSCS64
|
|
01784 MOVE WRK-CALENDAR-YEAR TO WRK-QTR-1-YR. DTSCS64
|
|
01785 MOVE 1 TO WRK-QTR-1-Q. DTSCS64
|
|
01786 MOVE WRK-CALENDAR-YEAR TO WRK-QTR-2-YR. DTSCS64
|
|
01787 MOVE 4 TO WRK-QTR-2-Q. DTSCS64
|
|
01788 IF (WRK-YRQ-2 < MAUR-FIRST-YRQ) DTSCS64
|
|
01789 OR (WRK-YRQ-1 > MAUR-LAST-YRQ) DTSCS64
|
|
01790 MOVE MSG-E641-AREA TO WRK-MSG-AREA DTSCS64
|
|
01791 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64
|
|
01792 END-IF. DTSCS64
|
|
01793 DTSCS64
|
|
01794 S1200-EXIT. DTSCS64
|
|
01795 EXIT. DTSCS64
|
|
01796 DTSCS64
|
|
01797 S1201-ERROR. DTSCS64
|
|
01798 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CALENDAR-YEAR-A. DTSCS64
|
|
01799 IF LCCM-NO-MSG DTSCS64
|
|
01800 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
01801 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01802 MOVE CATB-CURSOR TO MAP-CALENDAR-YEAR-L. DTSCS64
|
|
01803 S1201-EXIT. DTSCS64
|
|
01804 EXIT. DTSCS64
|
|
01805 /*****************************************************************DTSCS64
|
|
01806 * DTSCS64
|
|
01807 ******************************************************************DTSCS64
|
|
01808 DTSCS64
|
|
01809 S1300-GROSS-PAYROLL. DTSCS64
|
|
01810 SET MAUY-QTR-NOT-AUDITED-88 (WRK-OCC) TO TRUE. DTSCS64
|
|
01811 DTSCS64
|
|
01812 MOVE +0 TO MAUY-QTR-GROSS-PAYROLL (WRK-OCC). DTSCS64
|
|
01813 DTSCS64
|
|
01814 MOVE MAP-GROSS-PAYROLL-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64
|
|
01815 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64
|
|
01816 DTSCS64
|
|
01817 IF L011-NO-ENTRY DTSCS64
|
|
01818 GO TO S1300-EXIT. DTSCS64
|
|
01819 DTSCS64
|
|
01820 SET MAUY-QTR-AUDITED-88(WRK-OCC) TO TRUE. DTSCS64
|
|
01821 IF L011-NOT-VALID DTSCS64
|
|
01822 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
01823 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS64
|
|
01824 ELSE DTSCS64
|
|
01825 MOVE L011-AMT TO MAP-GROSS-PAYROLL-N (WRK-OCC) DTSCS64
|
|
01826 MAUY-QTR-GROSS-PAYROLL (WRK-OCC) DTSCS64
|
|
01827 END-IF. DTSCS64
|
|
01828 DTSCS64
|
|
01829 IF LCCM-F09-88 OR LCCM-F10-88 DTSCS64
|
|
01830 NEXT SENTENCE DTSCS64
|
|
01831 ELSE DTSCS64
|
|
01832 GO TO S1300-EXIT. DTSCS64
|
|
01833 DTSCS64
|
|
01834 ***** EVEN IF MAP-CALENDAR-YEAR WAS INVALID THIS SHOULD DTSCS64
|
|
01835 ****** STILL WORK MAUY-CALENDAR-YEAR SHOULD HAVE 0000 IN IT DTSCS64
|
|
01836 ****** AND MAUR BETTER HAVE BEEN READ. DTSCS64
|
|
01837 DTSCS64
|
|
01838 MOVE WRK-CALENDAR-YEAR TO WRK-QTR-1-YR. DTSCS64
|
|
01839 MOVE WRK-OCC TO WRK-QTR-1-Q. DTSCS64
|
|
01840 IF WRK-YRQ-1 < MAUR-FIRST-YRQ DTSCS64
|
|
01841 OR WRK-YRQ-1 > MAUR-LAST-YRQ DTSCS64
|
|
01842 MOVE MSG-E641-AREA TO WRK-MSG-AREA DTSCS64
|
|
01843 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS64
|
|
01844 END-IF. DTSCS64
|
|
01845 DTSCS64
|
|
01846 S1300-EXIT. DTSCS64
|
|
01847 EXIT. DTSCS64
|
|
01848 DTSCS64
|
|
01849 S1301-ERROR. DTSCS64
|
|
01850 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64
|
|
01851 TO MAP-GROSS-PAYROLL-A(WRK-OCC). DTSCS64
|
|
01852 DTSCS64
|
|
01853 IF LCCM-NO-MSG DTSCS64
|
|
01854 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
01855 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01856 MOVE CATB-CURSOR TO MAP-GROSS-PAYROLL-L(WRK-OCC). DTSCS64
|
|
01857 S1301-EXIT. DTSCS64
|
|
01858 EXIT. DTSCS64
|
|
01859 /*****************************************************************DTSCS64
|
|
01860 * DTSCS64
|
|
01861 ******************************************************************DTSCS64
|
|
01862 DTSCS64
|
|
01863 S1400-UNDER-TOT-WAGE. DTSCS64
|
|
01864 MOVE +0 TO MAUY-QTR-UNDER-TOT-WAGE(WRK-OCC). DTSCS64
|
|
01865 DTSCS64
|
|
01866 MOVE MAP-UNDER-TOT-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64
|
|
01867 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64
|
|
01868 DTSCS64
|
|
01869 IF L011-NO-ENTRY DTSCS64
|
|
01870 NEXT SENTENCE DTSCS64
|
|
01871 ELSE DTSCS64
|
|
01872 IF L011-NOT-VALID DTSCS64
|
|
01873 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
01874 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS64
|
|
01875 ELSE DTSCS64
|
|
01876 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64
|
|
01877 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64
|
|
01878 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS64
|
|
01879 ELSE DTSCS64
|
|
01880 MOVE L011-AMT TO MAP-UNDER-TOT-WAGE-N (WRK-OCC) DTSCS64
|
|
01881 MAUY-QTR-UNDER-TOT-WAGE(WRK-OCC) DTSCS64
|
|
01882 END-IF. DTSCS64
|
|
01883 S1400-EXIT. DTSCS64
|
|
01884 EXIT. DTSCS64
|
|
01885 DTSCS64
|
|
01886 S1401-ERROR. DTSCS64
|
|
01887 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64
|
|
01888 TO MAP-UNDER-TOT-WAGE-A(WRK-OCC). DTSCS64
|
|
01889 DTSCS64
|
|
01890 IF LCCM-NO-MSG DTSCS64
|
|
01891 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
01892 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01893 MOVE CATB-CURSOR TO MAP-UNDER-TOT-WAGE-L(WRK-OCC).DTSCS64
|
|
01894 S1401-EXIT. DTSCS64
|
|
01895 EXIT. DTSCS64
|
|
01896 /*****************************************************************DTSCS64
|
|
01897 * DTSCS64
|
|
01898 ******************************************************************DTSCS64
|
|
01899 DTSCS64
|
|
01900 S1500-UNDER-TAX-WAGE. DTSCS64
|
|
01901 MOVE +0 TO MAUY-QTR-UNDER-TAX-WAGE(WRK-OCC). DTSCS64
|
|
01902 DTSCS64
|
|
01903 MOVE MAP-UNDER-TAX-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64
|
|
01904 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64
|
|
01905 DTSCS64
|
|
01906 IF L011-NO-ENTRY DTSCS64
|
|
01907 NEXT SENTENCE DTSCS64
|
|
01908 ELSE DTSCS64
|
|
01909 IF L011-NOT-VALID DTSCS64
|
|
01910 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
01911 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS64
|
|
01912 ELSE DTSCS64
|
|
01913 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64
|
|
01914 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64
|
|
01915 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS64
|
|
01916 ELSE DTSCS64
|
|
01917 MOVE L011-AMT TO MAP-UNDER-TAX-WAGE-N (WRK-OCC) DTSCS64
|
|
01918 MAUY-QTR-UNDER-TAX-WAGE(WRK-OCC) DTSCS64
|
|
01919 END-IF. DTSCS64
|
|
01920 S1500-EXIT. DTSCS64
|
|
01921 EXIT. DTSCS64
|
|
01922 DTSCS64
|
|
01923 S1501-ERROR. DTSCS64
|
|
01924 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64
|
|
01925 TO MAP-UNDER-TAX-WAGE-A(WRK-OCC). DTSCS64
|
|
01926 DTSCS64
|
|
01927 IF LCCM-NO-MSG DTSCS64
|
|
01928 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
01929 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01930 MOVE CATB-CURSOR TO MAP-UNDER-TAX-WAGE-L(WRK-OCC).DTSCS64
|
|
01931 S1501-EXIT. DTSCS64
|
|
01932 EXIT. DTSCS64
|
|
01933 /*****************************************************************DTSCS64
|
|
01934 * DTSCS64
|
|
01935 ******************************************************************DTSCS64
|
|
01936 DTSCS64
|
|
01937 S1600-UNDER-CONTRIB. DTSCS64
|
|
01938 MOVE +0 TO MAUY-QTR-UNDER-CONTRIB(WRK-OCC). DTSCS64
|
|
01939 DTSCS64
|
|
01940 MOVE MAP-UNDER-CONTRIB-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64
|
|
01941 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64
|
|
01942 DTSCS64
|
|
01943 IF L011-NO-ENTRY DTSCS64
|
|
01944 NEXT SENTENCE DTSCS64
|
|
01945 ELSE DTSCS64
|
|
01946 IF L011-NOT-VALID DTSCS64
|
|
01947 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
01948 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS64
|
|
01949 ELSE DTSCS64
|
|
01950 IF MAUY-QTR-NOT-AUDITED-88 (WRK-OCC) DTSCS64
|
|
01951 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64
|
|
01952 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS64
|
|
01953 ELSE DTSCS64
|
|
01954 MOVE L011-AMT TO MAP-UNDER-CONTRIB-N (WRK-OCC) DTSCS64
|
|
01955 MAUY-QTR-UNDER-CONTRIB (WRK-OCC) DTSCS64
|
|
01956 END-IF. DTSCS64
|
|
01957 S1600-EXIT. DTSCS64
|
|
01958 EXIT. DTSCS64
|
|
01959 DTSCS64
|
|
01960 S1601-ERROR. DTSCS64
|
|
01961 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64
|
|
01962 TO MAP-UNDER-CONTRIB-A(WRK-OCC). DTSCS64
|
|
01963 DTSCS64
|
|
01964 IF LCCM-NO-MSG DTSCS64
|
|
01965 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
01966 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
01967 MOVE CATB-CURSOR TO MAP-UNDER-CONTRIB-L(WRK-OCC). DTSCS64
|
|
01968 S1601-EXIT. DTSCS64
|
|
01969 EXIT. DTSCS64
|
|
01970 /*****************************************************************DTSCS64
|
|
01971 * DTSCS64
|
|
01972 ******************************************************************DTSCS64
|
|
01973 DTSCS64
|
|
01974 S1700-OVER-TOT-WAGE. DTSCS64
|
|
01975 MOVE +0 TO MAUY-QTR-OVER-TOT-WAGE(WRK-OCC). DTSCS64
|
|
01976 DTSCS64
|
|
01977 MOVE MAP-OVER-TOT-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64
|
|
01978 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64
|
|
01979 DTSCS64
|
|
01980 IF L011-NO-ENTRY DTSCS64
|
|
01981 NEXT SENTENCE DTSCS64
|
|
01982 ELSE DTSCS64
|
|
01983 IF L011-NOT-VALID DTSCS64
|
|
01984 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
01985 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS64
|
|
01986 ELSE DTSCS64
|
|
01987 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64
|
|
01988 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64
|
|
01989 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS64
|
|
01990 ELSE DTSCS64
|
|
01991 MOVE L011-AMT TO MAP-OVER-TOT-WAGE-N (WRK-OCC) DTSCS64
|
|
01992 MAUY-QTR-OVER-TOT-WAGE(WRK-OCC) DTSCS64
|
|
01993 END-IF. DTSCS64
|
|
01994 S1700-EXIT. DTSCS64
|
|
01995 EXIT. DTSCS64
|
|
01996 DTSCS64
|
|
01997 S1701-ERROR. DTSCS64
|
|
01998 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64
|
|
01999 TO MAP-OVER-TOT-WAGE-A(WRK-OCC). DTSCS64
|
|
02000 DTSCS64
|
|
02001 IF LCCM-NO-MSG DTSCS64
|
|
02002 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
02003 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
02004 MOVE CATB-CURSOR TO MAP-OVER-TOT-WAGE-L(WRK-OCC). DTSCS64
|
|
02005 S1701-EXIT. DTSCS64
|
|
02006 EXIT. DTSCS64
|
|
02007 /*****************************************************************DTSCS64
|
|
02008 * DTSCS64
|
|
02009 ******************************************************************DTSCS64
|
|
02010 DTSCS64
|
|
02011 S1800-OVER-TAX-WAGE. DTSCS64
|
|
02012 MOVE +0 TO MAUY-QTR-OVER-TAX-WAGE(WRK-OCC). DTSCS64
|
|
02013 DTSCS64
|
|
02014 MOVE MAP-OVER-TAX-WAGE-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64
|
|
02015 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64
|
|
02016 DTSCS64
|
|
02017 IF L011-NO-ENTRY DTSCS64
|
|
02018 NEXT SENTENCE DTSCS64
|
|
02019 ELSE DTSCS64
|
|
02020 IF L011-NOT-VALID DTSCS64
|
|
02021 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
02022 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS64
|
|
02023 ELSE DTSCS64
|
|
02024 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64
|
|
02025 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64
|
|
02026 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS64
|
|
02027 ELSE DTSCS64
|
|
02028 MOVE L011-AMT TO MAP-OVER-TAX-WAGE-N (WRK-OCC) DTSCS64
|
|
02029 MAUY-QTR-OVER-TAX-WAGE(WRK-OCC) DTSCS64
|
|
02030 END-IF. DTSCS64
|
|
02031 S1800-EXIT. DTSCS64
|
|
02032 EXIT. DTSCS64
|
|
02033 DTSCS64
|
|
02034 S1801-ERROR. DTSCS64
|
|
02035 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64
|
|
02036 TO MAP-OVER-TAX-WAGE-A(WRK-OCC). DTSCS64
|
|
02037 DTSCS64
|
|
02038 IF LCCM-NO-MSG DTSCS64
|
|
02039 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
02040 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
02041 MOVE CATB-CURSOR TO MAP-OVER-TAX-WAGE-L(WRK-OCC). DTSCS64
|
|
02042 S1801-EXIT. DTSCS64
|
|
02043 EXIT. DTSCS64
|
|
02044 /*****************************************************************DTSCS64
|
|
02045 * DTSCS64
|
|
02046 ******************************************************************DTSCS64
|
|
02047 DTSCS64
|
|
02048 S1900-OVER-CONTRIB. DTSCS64
|
|
02049 MOVE +0 TO MAUY-QTR-OVER-CONTRIB(WRK-OCC). DTSCS64
|
|
02050 DTSCS64
|
|
02051 MOVE MAP-OVER-CONTRIB-AREA (WRK-OCC) TO L011-S-AMT-AREA. DTSCS64
|
|
02052 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS64
|
|
02053 DTSCS64
|
|
02054 IF L011-NO-ENTRY DTSCS64
|
|
02055 NEXT SENTENCE DTSCS64
|
|
02056 ELSE DTSCS64
|
|
02057 IF L011-NOT-VALID DTSCS64
|
|
02058 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS64
|
|
02059 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS64
|
|
02060 ELSE DTSCS64
|
|
02061 IF MAUY-QTR-NOT-AUDITED-88(WRK-OCC) DTSCS64
|
|
02062 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS64
|
|
02063 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS64
|
|
02064 ELSE DTSCS64
|
|
02065 MOVE L011-AMT TO MAP-OVER-CONTRIB-N (WRK-OCC) DTSCS64
|
|
02066 MAUY-QTR-OVER-CONTRIB(WRK-OCC) DTSCS64
|
|
02067 END-IF. DTSCS64
|
|
02068 S1900-EXIT. DTSCS64
|
|
02069 EXIT. DTSCS64
|
|
02070 DTSCS64
|
|
02071 S1901-ERROR. DTSCS64
|
|
02072 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS64
|
|
02073 TO MAP-OVER-CONTRIB-A(WRK-OCC). DTSCS64
|
|
02074 DTSCS64
|
|
02075 IF LCCM-NO-MSG DTSCS64
|
|
02076 SET CURSOR-SET-YES TO TRUE DTSCS64
|
|
02077 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS64
|
|
02078 MOVE CATB-CURSOR TO MAP-OVER-CONTRIB-L(WRK-OCC). DTSCS64
|
|
02079 S1901-EXIT. DTSCS64
|
|
02080 EXIT. DTSCS64
|
|
02081 /*****************************************************************DTSCS64
|
|
02082 * DTSCS64
|
|
02083 ******************************************************************DTSCS64
|
|
02084 S2000-MISC-EDITS. DTSCS64
|
|
02085 IF LCCM-F09-88 DTSCS64
|
|
02086 PERFORM S2010-COUNT-YEARS THRU S2010-EXIT DTSCS64
|
|
02087 PERFORM S2020-CHECK-DUPE THRU S2020-EXIT DTSCS64
|
|
02088 END-IF. DTSCS64
|
|
02089 S2000-EXIT. DTSCS64
|
|
02090 EXIT. DTSCS64
|
|
02091 DTSCS64
|
|
02092 DTSCS64
|
|
02093 S2010-COUNT-YEARS. DTSCS64
|
|
02094 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS64
|
|
02095 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64
|
|
02096 SET MAUY-AUY-88 TO TRUE. DTSCS64
|
|
02097 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64
|
|
02098 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
02099 PERFORM S810-COUNT THRU S810-EXIT. DTSCS64
|
|
02100 DTSCS64
|
|
02101 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS64
|
|
02102 IF L810-NO-REC-88 DTSCS64
|
|
02103 MOVE LOW-VALUE TO LAST-REC-KEY-AREA DTSCS64
|
|
02104 ELSE DTSCS64
|
|
02105 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS64
|
|
02106 DTSCS64
|
|
02107 IF L810-RECORD-CNT > 5 DTSCS64
|
|
02108 MOVE MSG-E644-AREA TO WRK-MSG-AREA DTSCS64
|
|
02109 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS64
|
|
02110 END-IF. DTSCS64
|
|
02111 S2010-EXIT. DTSCS64
|
|
02112 EXIT. DTSCS64
|
|
02113 DTSCS64
|
|
02114 S2020-CHECK-DUPE. DTSCS64
|
|
02115 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS64
|
|
02116 SET MAUY-AUY-88 TO TRUE. DTSCS64
|
|
02117 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS64
|
|
02118 MOVE WRK-CALENDAR-YEAR TO MAUY-CALENDAR-YEAR. DTSCS64
|
|
02119 MOVE LOW-VALUES TO MAUY-KEY-FILLER. DTSCS64
|
|
02120 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS64
|
|
02121 PERFORM S810-READ THRU S810-EXIT. DTSCS64
|
|
02122 IF L810-OK-88 DTSCS64
|
|
02123 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS64
|
|
02124 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS64
|
|
02125 END-IF. DTSCS64
|
|
02126 S2020-EXIT. DTSCS64
|
|
02127 EXIT. DTSCS64
|
|
02128 /*****************************************************************DTSCS64
|
|
02129 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS64
|
|
02130 ******************************************************************DTSCS64
|
|
02131 S5100-SET-LOCK-ATTRB. DTSCS64
|
|
02132 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS64
|
|
02133 WRK-ATB-NUM. DTSCS64
|
|
02134 DTSCS64
|
|
02135 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS64
|
|
02136 DTSCS64
|
|
02137 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ASSIGN-NO-1-A DTSCS64
|
|
02138 MAP-ASSIGN-NO-2-A DTSCS64
|
|
02139 MAP-GOTO-A. DTSCS64
|
|
02140 S5100-EXIT. DTSCS64
|
|
02141 EXIT. DTSCS64
|
|
02142 DTSCS64
|
|
02143 ******************************************************************DTSCS64
|
|
02144 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS64
|
|
02145 ******************************************************************DTSCS64
|
|
02146 S5200-SET-UPDATE-ATTRB. DTSCS64
|
|
02147 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS64
|
|
02148 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS64
|
|
02149 DTSCS64
|
|
02150 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS64
|
|
02151 DTSCS64
|
|
02152 DTSCS64
|
|
02153 ***** DTSCS64
|
|
02154 * CALLENDAR-YEAR ATTRIBUTE BYTE TRICKS. DTSCS64
|
|
02155 * DTSCS64
|
|
02156 ***** DTSCS64
|
|
02157 DTSCS64
|
|
02158 IF LCCM-SCR-INQUIRE DTSCS64
|
|
02159 MOVE CATB-ASKIP-BRT-MDTON TO MAP-CALENDAR-YEAR-A. DTSCS64
|
|
02160 S5200-EXIT. DTSCS64
|
|
02161 EXIT. DTSCS64
|
|
02162 DTSCS64
|
|
02163 ******************************************************************DTSCS64
|
|
02164 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS64
|
|
02165 ******************************************************************DTSCS64
|
|
02166 S5300-SET-INQ-ATTRB. DTSCS64
|
|
02167 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS64
|
|
02168 WRK-ATB-NUM. DTSCS64
|
|
02169 DTSCS64
|
|
02170 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS64
|
|
02171 S5300-EXIT. DTSCS64
|
|
02172 EXIT. DTSCS64
|
|
02173 DTSCS64
|
|
02174 S5900-SET-ATTRB. DTSCS64
|
|
02175 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS64
|
|
02176 MAP-ASSIGN-NO-2-A. DTSCS64
|
|
02177 DTSCS64
|
|
02178 MOVE WRK-ATB-NUM TO MAP-CALENDAR-YEAR-A. DTSCS64
|
|
02179 DTSCS64
|
|
02180 PERFORM VARYING WRK-OCC DTSCS64
|
|
02181 FROM 1 BY 1 DTSCS64
|
|
02182 UNTIL WRK-OCC > MMAX-AUY-QTR-MAX DTSCS64
|
|
02183 MOVE WRK-ATB-NUM TO DTSCS64
|
|
02184 MAP-GROSS-PAYROLL-A (WRK-OCC) DTSCS64
|
|
02185 MAP-UNDER-TOT-WAGE-A (WRK-OCC) DTSCS64
|
|
02186 MAP-UNDER-TAX-WAGE-A (WRK-OCC) DTSCS64
|
|
02187 MAP-UNDER-CONTRIB-A (WRK-OCC) DTSCS64
|
|
02188 MAP-OVER-TOT-WAGE-A (WRK-OCC) DTSCS64
|
|
02189 MAP-OVER-TAX-WAGE-A (WRK-OCC) DTSCS64
|
|
02190 MAP-OVER-CONTRIB-A (WRK-OCC) DTSCS64
|
|
02191 END-PERFORM. DTSCS64
|
|
02192 DTSCS64
|
|
02193 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS64
|
|
02194 MAP-EMP-NO-2-A DTSCS64
|
|
02195 MAP-PRIMARY-NAME-A DTSCS64
|
|
02196 MAP-CURR-PAGE-A DTSCS64
|
|
02197 MAP-LAST-PAGE-A. DTSCS64
|
|
02198 DTSCS64
|
|
02199 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS64
|
|
02200 S5900-EXIT. DTSCS64
|
|
02201 EXIT. DTSCS64
|
|
02202 EJECT DTSCS64
|
|
02203 /*****************************************************************DTSCS64
|
|
02204 * MAP ROUTINES *DTSCS64
|
|
02205 ******************************************************************DTSCS64
|
|
02206 S9100-RECEIVE. DTSCS64
|
|
02207 SET L851-RECEIVE-88 TO TRUE. DTSCS64
|
|
02208 DTSCS64
|
|
02209 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS64
|
|
02210 DTSCS64
|
|
02211 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS64
|
|
02212 DTSCS64
|
|
02213 MOVE L851-AID TO LCCM-AID. DTSCS64
|
|
02214 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS64
|
|
02215 S9100-EXIT. DTSCS64
|
|
02216 EXIT. DTSCS64
|
|
02217 DTSCS64
|
|
02218 S9200-SEND-DATAONLY. DTSCS64
|
|
02219 MOVE LOW-VALUES TO MAP-AREA. DTSCS64
|
|
02220 DTSCS64
|
|
02221 IF LCCM-NO-MSG DTSCS64
|
|
02222 NEXT SENTENCE DTSCS64
|
|
02223 ELSE DTSCS64
|
|
02224 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS64
|
|
02225 DTSCS64
|
|
02226 IF CURSOR-SET-GOTO DTSCS64
|
|
02227 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS64
|
|
02228 ELSE DTSCS64
|
|
02229 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS64
|
|
02230 DTSCS64
|
|
02231 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS64
|
|
02232 DTSCS64
|
|
02233 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS64
|
|
02234 DTSCS64
|
|
02235 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS64
|
|
02236 S9200-EXIT. DTSCS64
|
|
02237 EXIT. DTSCS64
|
|
02238 DTSCS64
|
|
02239 S9300-SEND-MAP. DTSCS64
|
|
02240 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS64
|
|
02241 MOVE SPACES TO MAP-SYS-TIME. DTSCS64
|
|
02242 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS64
|
|
02243 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS64
|
|
02244 DTSCS64
|
|
02245 IF SCR-ACCESS-UPDATE DTSCS64
|
|
02246 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS64
|
|
02247 ELSE DTSCS64
|
|
02248 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS64
|
|
02249 DTSCS64
|
|
02250 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS64
|
|
02251 DTSCS64
|
|
02252 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS64
|
|
02253 DTSCS64
|
|
02254 IF CURSOR-SET-NO DTSCS64
|
|
02255 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS64
|
|
02256 DTSCS64
|
|
02257 SET L851-SEND-88 TO TRUE. DTSCS64
|
|
02258 DTSCS64
|
|
02259 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS64
|
|
02260 DTSCS64
|
|
02261 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS64
|
|
02262 S9300-EXIT. DTSCS64
|
|
02263 EXIT. DTSCS64
|
|
02264 DTSCS64
|
|
02265 S9310-UPDATE-FKEYS. DTSCS64
|
|
02266 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS64
|
|
02267 DTSCS64
|
|
02268 DTSCS64
|
|
02269 IF LCCM-SCR-CLEAR DTSCS64
|
|
02270 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS64
|
|
02271 ELSE DTSCS64
|
|
02272 IF LCCM-SCR-INQUIRE DTSCS64
|
|
02273 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS64
|
|
02274 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS64
|
|
02275 ELSE DTSCS64
|
|
02276 IF LCCM-SCR-UPDATE-LOCKED DTSCS64
|
|
02277 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS64
|
|
02278 MAP-KEY-LAST DTSCS64
|
|
02279 MAP-KEY-BACK DTSCS64
|
|
02280 MAP-KEY-FWRD. DTSCS64
|
|
02281 S9310-EXIT. DTSCS64
|
|
02282 EXIT. DTSCS64
|
|
02283 DTSCS64
|
|
02284 S9320-INQUIRY-FKEYS. DTSCS64
|
|
02285 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS64
|
|
02286 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS64
|
|
02287 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS64
|
|
02288 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS64
|
|
02289 DTSCS64
|
|
02290 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS64
|
|
02291 MAP-KEY-MOD DTSCS64
|
|
02292 MAP-KEY-DEL. DTSCS64
|
|
02293 DTSCS64
|
|
02294 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS64
|
|
02295 S9320-EXIT. DTSCS64
|
|
02296 EXIT. DTSCS64
|
|
02297 DTSCS64
|
|
02298 *S9321-JUMP-KEYS. DTSCS64
|
|
02299 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS64
|
|
02300 * MOVE CFKD-ASSIGN TO MAP-KEY-ASSIGN. DTSCS64
|
|
02301 * MOVE CFKD-AUDIT-RSLT-22 TO MAP-KEY-AUDIT-RSLT. DTSCS64
|
|
02302 *S9321-EXIT. DTSCS64
|
|
02303 * EXIT. DTSCS64
|
|
02304 * DTSCS64
|
|
02305 S9330-DSCR-FIELDS. DTSCS64
|
|
02306 IF WRK-MPRF-YES-88 DTSCS64
|
|
02307 MOVE WRK-EMP-NO TO WRK-DISPLAY DTSCS64
|
|
02308 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS64
|
|
02309 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS64
|
|
02310 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS64
|
|
02311 DTSCS64
|
|
02312 S9330-EXIT. EXIT. DTSCS64
|
|
02313 DTSCS64
|
|
02314 S9900-PREPARE-SEND. DTSCS64
|
|
02315 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS64
|
|
02316 LCCM-SCR-ID. DTSCS64
|
|
02317 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS64
|
|
02318 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS64
|
|
02319 S9900-EXIT. DTSCS64
|
|
02320 EXIT. DTSCS64
|