1375 lines
108 KiB
COBOL
1375 lines
108 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/13/98
|
|
00002 PROGRAM-ID. DTSCS81. DTSCS81
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005
|
|
00004 DATE-WRITTEN. APRIL 1994. DTSCS81
|
|
00005 DATE-COMPILED. DTSCS81
|
|
00006 SKIP3 DTSCS81
|
|
00007 ***** DTSCS81
|
|
00008 * DTSCS81
|
|
00009 * FUNCTION: CALENDAR YEAR INQUIRY/UPDATE DTSCS81
|
|
00010 * SCREEN PROCESSOR. DTSCS81
|
|
00011 * DTSCS81
|
|
00012 * DTSCS81
|
|
00013 * MODIFICATION LOG: DTSCS81
|
|
00014 * DTSCS81
|
|
00015 * 04/20/94 INITIAL DEVELOPMENT. DTSCS81
|
|
00016 * WORK ORDER: PROGRAMMER: RHC DTSCS81
|
|
00017 * DTSCS81
|
|
00018 * 08/01/97 MODIFY LOGIC TO ALLOW DELETE FUNCTION TO BE DTSCS81
|
|
00019 * PERFORMED USING FUNCTION KEY 23 INSTEAD OF 11. DTSCS81
|
|
00020 * REFERENCE RFP: TCL 096 PROGRAMMER: FLS DTSCS81
|
|
00021 * DTSCS81
|
|
00022 * 08/13/1998 REVIEWED AND MODIFIED FOR DC. CL**2
|
|
00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
|
00024 * CL**2
|
|
00025 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2
|
|
00028 * DTSCS81
|
|
00029 * DTSCS81
|
|
00030 * DESCRIPTION: DTSCS81
|
|
00031 * DTSCS81
|
|
00032 * CLEAR: DTSCS81
|
|
00033 * DTSCS81
|
|
00034 * DATA FIELDS DISPLAYED: NONE. DTSCS81
|
|
00035 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS81
|
|
00036 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS81
|
|
00037 * DTSCS81
|
|
00038 * DTSCS81
|
|
00039 * INQUIRY: DTSCS81
|
|
00040 * DTSCS81
|
|
00041 * CONTROL FIELD(S): MAP-YR. DTSCS81
|
|
00042 * DTSCS81
|
|
00043 * JUMP IN: USE CLEAR LOGIC. DTSCS81
|
|
00044 * DTSCS81
|
|
00045 * ENTER: DISPLAY FCYR RECORD ASSOCIATED WITH MAP-YR. DTSCS81
|
|
00046 * DTSCS81
|
|
00047 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS81
|
|
00048 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS81
|
|
00049 * DTSCS81
|
|
00050 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS81
|
|
00051 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS81
|
|
00052 * DTSCS81
|
|
00053 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS81
|
|
00054 * DO NOT "WRAP" PAGING. DTSCS81
|
|
00055 * DTSCS81
|
|
00056 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS81
|
|
00057 * FCYR-KEY-AREA OF THE DISPLAYED FCYR RECORD IN DTSCS81
|
|
00058 * LCCM-SCR-KEY-AREA. DTSCS81
|
|
00059 * DTSCS81
|
|
00060 * DTSCS81
|
|
00061 * UPDATE: DTSCS81
|
|
00062 * DTSCS81
|
|
00063 * ADD DTSCS81
|
|
00064 * MOD DTSCS81
|
|
00065 * DEL DTSCS81
|
|
00066 * DTSCS81
|
|
00067 * DTSCS81
|
|
00068 * RECORDS READ: DTSCS81
|
|
00069 * DTSCS81
|
|
00070 * MASTER: DTSCS81
|
|
00071 * DTSCS81
|
|
00072 * NONE. DTSCS81
|
|
00073 * DTSCS81
|
|
00074 * DTSCS81
|
|
00075 * ALTERNATE INDEX: DTSCS81
|
|
00076 * DTSCS81
|
|
00077 * NONE. DTSCS81
|
|
00078 * DTSCS81
|
|
00079 * DTSCS81
|
|
00080 * REFERENCE: DTSCS81
|
|
00081 * DTSCS81
|
|
00082 * FCYR. DTSCS81
|
|
00083 * DTSCS81
|
|
00084 * DTSCS81
|
|
00085 * ACCOUNTING TRANSACTION COLLECTION: DTSCS81
|
|
00086 * DTSCS81
|
|
00087 * NONE. DTSCS81
|
|
00088 * DTSCS81
|
|
00089 * DTSCS81
|
|
00090 * RECORDS UPDATED: DTSCS81
|
|
00091 * DTSCS81
|
|
00092 * MASTER: DTSCS81
|
|
00093 * DTSCS81
|
|
00094 * NONE. DTSCS81
|
|
00095 * DTSCS81
|
|
00096 * DTSCS81
|
|
00097 * REFERENCE: DTSCS81
|
|
00098 * DTSCS81
|
|
00099 * FCYR (ADD, MOD, DEL). DTSCS81
|
|
00100 * DTSCS81
|
|
00101 * DTSCS81
|
|
00102 * ACCOUNTING TRANSACTION COLLECTION: DTSCS81
|
|
00103 * DTSCS81
|
|
00104 * NONE. DTSCS81
|
|
00105 * DTSCS81
|
|
00106 * DTSCS81
|
|
00107 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS81
|
|
00108 * DTSCS81
|
|
00109 * NONE. DTSCS81
|
|
00110 * DTSCS81
|
|
00111 * DTSCS81
|
|
00112 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS81
|
|
00113 * UTILITY MODULES) LINKED TO: DTSCS81
|
|
00114 * DTSCS81
|
|
00115 * DTSCU001 DATE EDIT/CONVERSION. CL**2
|
|
00116 * DTSCU007 CALENDAR YEAR EDIT/CONVERSION. CL**2
|
|
00117 * DTSCU011 AMOUNT FROM SCREEN FORMAT/EDIT. CL**2
|
|
00118 * DTSCU012 RATE FROM SCREEN FORMAT/EDIT. CL**2
|
|
00119 * DTSCU056 RATE DISPLAY. CL**2
|
|
00120 * DTSCU831 REFERENCE FILE I/O. CL**2
|
|
00121 * DTSCS81
|
|
00122 * DTSCS81
|
|
00123 * MAINTENANCE NOTES: DTSCS81
|
|
00124 * DTSCS81
|
|
00125 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS81
|
|
00126 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS81
|
|
00127 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS81
|
|
00128 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1000, DTSCS81
|
|
00129 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS81), CL**2
|
|
00130 * ALTER THE MAP (DTSM81) AND ASSEMBLE THE MAPSET (DTSMSET). CL**2
|
|
00131 * DTSCS81
|
|
00132 ***** DTSCS81
|
|
00133 SKIP3 DTSCS81
|
|
00134 ENVIRONMENT DIVISION. DTSCS81
|
|
00135 SKIP3 DTSCS81
|
|
00136 DATA DIVISION. DTSCS81
|
|
00137 SKIP3 DTSCS81
|
|
00138 WORKING-STORAGE SECTION. DTSCS81
|
|
001385 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS81 08/13/98'. DTSCS81
|
|
00139 SKIP3 DTSCS81
|
|
00140 01 WRK-AREA. DTSCS81
|
|
00141 05 WRK-ABEND-CD PIC X(04) VALUE 'S81 '. DTSCS81
|
|
00142 CL**2
|
|
00143 05 WRK-SCR-ID. DTSCS81
|
|
00144 10 WRK-SCR-ID-9 PIC 9(02) VALUE 81. DTSCS81
|
|
00145 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS81
|
|
00146 SKIP3 DTSCS81
|
|
00147 05 SCR-ACCESS-IND PIC X(01). DTSCS81
|
|
00148 88 SCR-ACCESS-INQ VALUE '1'. DTSCS81
|
|
00149 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS81
|
|
00150 CL**2
|
|
00151 05 CURSOR-SET-IND PIC X(01). DTSCS81
|
|
00152 88 CURSOR-SET-YES VALUE 'Y'. DTSCS81
|
|
00153 88 CURSOR-SET-NO VALUE 'N'. DTSCS81
|
|
00154 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS81
|
|
00155 CL**2
|
|
00156 05 REQ-IND PIC X(01). DTSCS81
|
|
00157 88 REQ-ERROR VALUE 'O'. DTSCS81
|
|
00158 88 REQ-JUMP VALUE 'J'. DTSCS81
|
|
00159 88 REQ-INQUIRE VALUE 'I'. DTSCS81
|
|
00160 88 REQ-CLEAR VALUE 'C'. DTSCS81
|
|
00161 88 REQ-EDIT VALUE 'E'. DTSCS81
|
|
00162 88 REQ-UPDATE VALUE 'U'. DTSCS81
|
|
00163 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS81
|
|
00164 CL**2
|
|
00165 05 RESP-IND PIC X(01). DTSCS81
|
|
00166 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS81
|
|
00167 88 RESP-SEND-MAP VALUE 'M'. DTSCS81
|
|
00168 88 RESP-JUMP VALUE 'J'. DTSCS81
|
|
00169 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS81
|
|
00170 CL**2
|
|
00171 05 WRK-KEY-AREA. DTSCS81
|
|
00172 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS81
|
|
00173 10 WRK-YR PIC S9(05) COMP-3. DTSCS81
|
|
00174 10 FILLER PIC X(11). DTSCS81
|
|
00175 CL**2
|
|
00176 05 WRK-NEW-KEY-IND PIC X(01). DTSCS81
|
|
00177 CL**2
|
|
00178 05 WRK-MSG-ID PIC X(04). DTSCS81
|
|
00179 CL**2
|
|
00180 05 WRK-ATB-AN PIC X(01). CL**4
|
|
00181 05 WRK-ATB-NUM PIC X(01). DTSCS81
|
|
00182 CL**2
|
|
00183 05 WRK-DISP-DATE PIC 9(08). DTSCS81
|
|
00184 05 FILLER REDEFINES WRK-DISP-DATE. DTSCS81
|
|
00185 10 WRK-DISP-CC PIC X(02). DTSCS81
|
|
00186 10 WRK-DISP-YY PIC X(02). DTSCS81
|
|
00187 10 WRK-DISP-MM PIC X(02). DTSCS81
|
|
00188 10 WRK-DISP-DD PIC X(02). DTSCS81
|
|
00189 EJECT DTSCS81
|
|
00190 01 L001-COMM-AREA. DTSCS81
|
|
00191 ++INCLUDE DTSIL001 CL**3
|
|
00192 EJECT DTSCS81
|
|
00193 01 L007-COMM-AREA. DTSCS81
|
|
00194 ++INCLUDE DTSIL007 CL**3
|
|
00195 EJECT DTSCS81
|
|
00196 01 L011-COMM-AREA. DTSCS81
|
|
00197 ++INCLUDE DTSIL011 CL**3
|
|
00198 EJECT DTSCS81
|
|
00199 01 L012-COMM-AREA. DTSCS81
|
|
00200 ++INCLUDE DTSIL012 CL**3
|
|
00201 EJECT DTSCS81
|
|
00202 01 L056-COMM-AREA. DTSCS81
|
|
00203 ++INCLUDE DTSIL056 CL**3
|
|
00204 EJECT DTSCS81
|
|
00205 * ERROR MSG MODULE DTSCS81
|
|
00206 01 L805-COMM-AREA. DTSCS81
|
|
00207 ++INCLUDE DTSIL805 CL**3
|
|
00208 EJECT DTSCS81
|
|
00209 * REFERENCE FILE I-O LINKAGE DTSCS81
|
|
00210 01 L831-COMM-AREA. DTSCS81
|
|
00211 05 L831-CONTROL-BLOCK. DTSCS81
|
|
00212 ++INCLUDE DTSIL831 CL**5
|
|
00213 EJECT DTSCS81
|
|
00214 * COMMON SKELETAL RECORD DTSCS81
|
|
00215 05 FCOMM-REC. DTSCS81
|
|
00216 ++INCLUDE DTSIFSKL CL**5
|
|
00217 EJECT DTSCS81
|
|
00218 * CALENDAR YEAR RECORD LAYOUT DTSCS81
|
|
00219 05 FCYR-REC REDEFINES FCOMM-REC. DTSCS81
|
|
00220 ++INCLUDE DTSIFCYR CL**5
|
|
00221 EJECT DTSCS81
|
|
00222 * MAP DEFINITION DTSCS81
|
|
00223 01 L851-COMM-AREA. DTSCS81
|
|
00224 ++INCLUDE DTSIL851 CL**3
|
|
00225 SKIP3 DTSCS81
|
|
00226 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS81
|
|
00227 ++INCLUDE DTSIS81 CL**3
|
|
00228 EJECT DTSCS81
|
|
00229 * ATTRIBUTE LITERALS DTSCS81
|
|
00230 01 CATB-LITERALS. DTSCS81
|
|
00231 ++INCLUDE DTSICATB CL**3
|
|
00232 SKIP3 DTSCS81
|
|
00233 * FUNCTION KEY DESCRIPTION LITERALS DTSCS81
|
|
00234 01 CFKD-LITERALS. DTSCS81
|
|
00235 ++INCLUDE DTSICFKD CL**3
|
|
00236 SKIP3 DTSCS81
|
|
00237 * ERROR CODE MESSAGE LITERALS DTSCS81
|
|
00238 01 CECD-LITERALS. DTSCS81
|
|
00239 ++INCLUDE DTSICECD CL**3
|
|
00240 SKIP3 DTSCS81
|
|
00241 * PROMPT CODE MESSAGE LITERALS DTSCS81
|
|
00242 01 CPCD-LITERALS. DTSCS81
|
|
00243 ++INCLUDE DTSICPCD CL**3
|
|
00244 EJECT DTSCS81
|
|
00245 LINKAGE SECTION. DTSCS81
|
|
00246 SKIP3 DTSCS81
|
|
00247 01 DFHCOMMAREA. DTSCS81
|
|
00248 ++INCLUDE DTSILCCM CL**3
|
|
00249 SKIP3 DTSCS81
|
|
00250 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS81
|
|
00251 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS81
|
|
00252 EJECT DTSCS81
|
|
00253 ******************************************************************DTSCS81
|
|
00254 * *DTSCS81
|
|
00255 ******************************************************************DTSCS81
|
|
00256 CL**2
|
|
00257 PROCEDURE DIVISION. DTSCS81
|
|
00258 SKIP2 DTSCS81
|
|
00259 SET CURSOR-SET-NO TO TRUE. DTSCS81
|
|
00260 CL**2
|
|
00261 MOVE LOW-VALUES TO MAP-AREA. DTSCS81
|
|
00262 CL**2
|
|
00263 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS81
|
|
00264 TO SCR-ACCESS-IND. DTSCS81
|
|
00265 SKIP3 DTSCS81
|
|
00266 MOVE SPACE TO REQ-IND. DTSCS81
|
|
00267 CL**2
|
|
00268 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS81
|
|
00269 CL**2
|
|
00270 *----------------------------------------------------- DTSCS81
|
|
00271 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS81
|
|
00272 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS81
|
|
00273 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS81
|
|
00274 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS81
|
|
00275 * DTSCS81
|
|
00276 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS81
|
|
00277 * PROCESSED. DTSCS81
|
|
00278 * DTSCS81
|
|
00279 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS81
|
|
00280 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS81
|
|
00281 * WORK STATION OPERATOR. DTSCS81
|
|
00282 *----------------------------------------------------- DTSCS81
|
|
00283 CL**2
|
|
00284 MOVE SPACE TO RESP-IND. DTSCS81
|
|
00285 CL**2
|
|
00286 IF REQ-ERROR DTSCS81
|
|
00287 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS81
|
|
00288 ELSE DTSCS81
|
|
00289 IF REQ-JUMP DTSCS81
|
|
00290 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS81
|
|
00291 ELSE DTSCS81
|
|
00292 IF REQ-CLEAR DTSCS81
|
|
00293 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS81
|
|
00294 ELSE DTSCS81
|
|
00295 IF REQ-CURSOR-TO-GOTO DTSCS81
|
|
00296 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS81
|
|
00297 ELSE DTSCS81
|
|
00298 IF REQ-INQUIRE DTSCS81
|
|
00299 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS81
|
|
00300 ELSE DTSCS81
|
|
00301 IF REQ-EDIT DTSCS81
|
|
00302 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS81
|
|
00303 ELSE DTSCS81
|
|
00304 IF REQ-UPDATE DTSCS81
|
|
00305 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS81
|
|
00306 ELSE DTSCS81
|
|
00307 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81
|
|
00308 SKIP3 DTSCS81
|
|
00309 *----------------------------------------------------- DTSCS81
|
|
00310 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS81
|
|
00311 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS81
|
|
00312 *----------------------------------------------------- DTSCS81
|
|
00313 CL**2
|
|
00314 IF RESP-SEND-MAP DTSCS81
|
|
00315 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS81
|
|
00316 SET LCCM-END-TASK-88 TO TRUE DTSCS81
|
|
00317 ELSE DTSCS81
|
|
00318 IF RESP-SEND-MSGONLY DTSCS81
|
|
00319 OR RESP-CURSOR-TO-GOTO DTSCS81
|
|
00320 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS81
|
|
00321 SET LCCM-END-TASK-88 TO TRUE DTSCS81
|
|
00322 ELSE DTSCS81
|
|
00323 IF RESP-JUMP DTSCS81
|
|
00324 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS81
|
|
00325 ELSE DTSCS81
|
|
00326 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81
|
|
00327 SKIP3 DTSCS81
|
|
00328 MAINLINE-EXIT. DTSCS81
|
|
00329 CL**2
|
|
00330 EXEC CICS DTSCS81
|
|
00331 RETURN DTSCS81
|
|
00332 END-EXEC. DTSCS81
|
|
00333 SKIP2 DTSCS81
|
|
00334 GOBACK. DTSCS81
|
|
00335 /*****************************************************************DTSCS81
|
|
00336 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS81
|
|
00337 ******************************************************************DTSCS81
|
|
00338 P1000-ANALYZE-REQUEST. DTSCS81
|
|
00339 CL**2
|
|
00340 *----------------------------------------------------- DTSCS81
|
|
00341 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS81
|
|
00342 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS81
|
|
00343 * REPLACED WITH ENTER) DTSCS81
|
|
00344 *----------------------------------------------------- DTSCS81
|
|
00345 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS81
|
|
00346 SET LCCM-ENTER-88 TO TRUE DTSCS81
|
|
00347 SET REQ-CLEAR TO TRUE DTSCS81
|
|
00348 GO TO P1000-EXIT. DTSCS81
|
|
00349 SKIP3 DTSCS81
|
|
00350 *----------------------------------------------------- DTSCS81
|
|
00351 * MAP IS RECEIVED DTSCS81
|
|
00352 *----------------------------------------------------- DTSCS81
|
|
00353 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS81
|
|
00354 SKIP3 DTSCS81
|
|
00355 *----------------------------------------------------- DTSCS81
|
|
00356 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS81
|
|
00357 * WORK STATION DTSCS81
|
|
00358 *----------------------------------------------------- DTSCS81
|
|
00359 IF LCCM-CLEAR-88 DTSCS81
|
|
00360 SET REQ-CLEAR TO TRUE DTSCS81
|
|
00361 GO TO P1000-EXIT. DTSCS81
|
|
00362 SKIP3 DTSCS81
|
|
00363 *----------------------------------------------------- DTSCS81
|
|
00364 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS81
|
|
00365 *----------------------------------------------------- DTSCS81
|
|
00366 IF LCCM-SCR-UPDATE-LOCKED DTSCS81
|
|
00367 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS81
|
|
00368 GO TO P1000-EXIT. DTSCS81
|
|
00369 SKIP3 DTSCS81
|
|
00370 *----------------------------------------------------- DTSCS81
|
|
00371 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS81
|
|
00372 *----------------------------------------------------- DTSCS81
|
|
00373 IF LCCM-PA2-88 DTSCS81
|
|
00374 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS81
|
|
00375 GO TO P1000-EXIT. DTSCS81
|
|
00376 SKIP3 DTSCS81
|
|
00377 *----------------------------------------------------- DTSCS81
|
|
00378 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS81
|
|
00379 *----------------------------------------------------- DTSCS81
|
|
00380 IF LCCM-PA-88 DTSCS81
|
|
00381 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS81
|
|
00382 SET REQ-ERROR TO TRUE DTSCS81
|
|
00383 GO TO P1000-EXIT. DTSCS81
|
|
00384 SKIP3 DTSCS81
|
|
00385 *----------------------------------------------------- CL**3
|
|
00386 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A CL**3
|
|
00387 * REQUEST TO CLEAR THE SCREEN. CL**3
|
|
00388 *----------------------------------------------------- CL**3
|
|
00389 IF LCCM-F12-88 CL**3
|
|
00390 MOVE LOW-VALUES TO MAP-AREA CL**3
|
|
00391 SET REQ-CLEAR TO TRUE CL**3
|
|
00392 GO TO P1000-EXIT. CL**3
|
|
00393 SKIP3 CL**3
|
|
00394 *----------------------------------------------------- DTSCS81
|
|
00395 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS81
|
|
00396 *----------------------------------------------------- DTSCS81
|
|
00397 IF LCCM-F03-88 DTSCS81
|
|
00398 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS81
|
|
00399 SET REQ-JUMP TO TRUE DTSCS81
|
|
00400 GO TO P1000-EXIT. DTSCS81
|
|
00401 SKIP3 DTSCS81
|
|
00402 *----------------------------------------------------- DTSCS81
|
|
00403 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS81
|
|
00404 *----------------------------------------------------- DTSCS81
|
|
00405 IF LCCM-F04-88 DTSCS81
|
|
00406 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS81
|
|
00407 SET REQ-JUMP TO TRUE DTSCS81
|
|
00408 GO TO P1000-EXIT. DTSCS81
|
|
00409 SKIP3 DTSCS81
|
|
00410 *----------------------------------------------------- DTSCS81
|
|
00411 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS81
|
|
00412 * CORRESPONDENCE SCREEN DTSCS81
|
|
00413 *----------------------------------------------------- DTSCS81
|
|
00414 IF LCCM-F14-88 DTSCS81
|
|
00415 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS81
|
|
00416 SET REQ-JUMP TO TRUE DTSCS81
|
|
00417 GO TO P1000-EXIT. DTSCS81
|
|
00418 SKIP3 DTSCS81
|
|
00419 *----------------------------------------------------- DTSCS81
|
|
00420 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS81
|
|
00421 * REQUESTED SCREEN TYPE DTSCS81
|
|
00422 *----------------------------------------------------- DTSCS81
|
|
00423 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS81
|
|
00424 NEXT SENTENCE DTSCS81
|
|
00425 ELSE DTSCS81
|
|
00426 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS81
|
|
00427 SET REQ-JUMP TO TRUE DTSCS81
|
|
00428 GO TO P1000-EXIT. DTSCS81
|
|
00429 SKIP3 DTSCS81
|
|
00430 *----------------------------------------------------- DTSCS81
|
|
00431 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS81
|
|
00432 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS81
|
|
00433 *----------------------------------------------------- DTSCS81
|
|
00434 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS81
|
|
00435 IF SCR-ACCESS-UPDATE DTSCS81
|
|
00436 SET REQ-EDIT TO TRUE DTSCS81
|
|
00437 GO TO P1000-EXIT DTSCS81
|
|
00438 ELSE DTSCS81
|
|
00439 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS81
|
|
00440 SET REQ-ERROR TO TRUE DTSCS81
|
|
00441 GO TO P1000-EXIT. DTSCS81
|
|
00442 SKIP3 DTSCS81
|
|
00443 *----------------------------------------------------- DTSCS81
|
|
00444 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS81
|
|
00445 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS81
|
|
00446 *----------------------------------------------------- DTSCS81
|
|
00447 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS81
|
|
00448 SET REQ-INQUIRE TO TRUE DTSCS81
|
|
00449 GO TO P1000-EXIT. DTSCS81
|
|
00450 SKIP3 DTSCS81
|
|
00451 *----------------------------------------------------- DTSCS81
|
|
00452 * ANY OTHER KEY IS INVALID DTSCS81
|
|
00453 *----------------------------------------------------- DTSCS81
|
|
00454 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS81
|
|
00455 SET REQ-ERROR TO TRUE. DTSCS81
|
|
00456 P1000-EXIT. DTSCS81
|
|
00457 EXIT. DTSCS81
|
|
00458 SKIP3 DTSCS81
|
|
00459 ******************************************************************DTSCS81
|
|
00460 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS81
|
|
00461 ******************************************************************DTSCS81
|
|
00462 CL**2
|
|
00463 P1100-UPDATE-LOCKED. DTSCS81
|
|
00464 *----------------------------------------------------- DTSCS81
|
|
00465 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS81
|
|
00466 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS81
|
|
00467 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS81
|
|
00468 *----------------------------------------------------- DTSCS81
|
|
00469 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS81
|
|
00470 SET REQ-UPDATE TO TRUE DTSCS81
|
|
00471 ELSE DTSCS81
|
|
00472 SET REQ-ERROR TO TRUE DTSCS81
|
|
00473 IF LCCM-SCR-ADD-LOCKED DTSCS81
|
|
00474 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS81
|
|
00475 ELSE DTSCS81
|
|
00476 IF LCCM-SCR-MOD-LOCKED DTSCS81
|
|
00477 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS81
|
|
00478 ELSE DTSCS81
|
|
00479 IF LCCM-SCR-DEL-LOCKED DTSCS81
|
|
00480 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS81
|
|
00481 ELSE DTSCS81
|
|
00482 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81
|
|
00483 P1100-EXIT. DTSCS81
|
|
00484 EXIT. DTSCS81
|
|
00485 /*****************************************************************DTSCS81
|
|
00486 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS81
|
|
00487 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS81
|
|
00488 ******************************************************************DTSCS81
|
|
00489 CL**2
|
|
00490 P2000-REQUEST-ERROR. DTSCS81
|
|
00491 IF LCCM-MSG DTSCS81
|
|
00492 SET RESP-SEND-MSGONLY TO TRUE DTSCS81
|
|
00493 ELSE DTSCS81
|
|
00494 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81
|
|
00495 P2000-EXIT. DTSCS81
|
|
00496 EXIT. DTSCS81
|
|
00497 /*****************************************************************DTSCS81
|
|
00498 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS81
|
|
00499 ******************************************************************DTSCS81
|
|
00500 CL**2
|
|
00501 P3000-REQUEST-JUMP. DTSCS81
|
|
00502 *----------------------------------------------------- DTSCS81
|
|
00503 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS81
|
|
00504 * BY USER DTSCS81
|
|
00505 *----------------------------------------------------- DTSCS81
|
|
00506 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS81
|
|
00507 SKIP3 DTSCS81
|
|
00508 *----------------------------------------------------- DTSCS81
|
|
00509 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS81
|
|
00510 *----------------------------------------------------- DTSCS81
|
|
00511 IF LCCM-MSG DTSCS81
|
|
00512 SET RESP-SEND-MSGONLY TO TRUE DTSCS81
|
|
00513 SET CURSOR-SET-GOTO TO TRUE DTSCS81
|
|
00514 GO TO P3000-EXIT. DTSCS81
|
|
00515 SKIP3 DTSCS81
|
|
00516 *----------------------------------------------------- DTSCS81
|
|
00517 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS81
|
|
00518 *----------------------------------------------------- DTSCS81
|
|
00519 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS81
|
|
00520 LCCM-SCR-HOLD-AREA. DTSCS81
|
|
00521 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS81
|
|
00522 SET RESP-JUMP TO TRUE. DTSCS81
|
|
00523 P3000-EXIT. DTSCS81
|
|
00524 EXIT. DTSCS81
|
|
00525 /*****************************************************************DTSCS81
|
|
00526 * CLEAR KEY WAS PRESSED *DTSCS81
|
|
00527 ******************************************************************DTSCS81
|
|
00528 CL**2
|
|
00529 P4000-REQUEST-CLEAR. DTSCS81
|
|
00530 IF SCR-ACCESS-UPDATE DTSCS81
|
|
00531 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS81
|
|
00532 ELSE DTSCS81
|
|
00533 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS81
|
|
00534 SKIP3 DTSCS81
|
|
00535 *----------------------------------------------------- DTSCS81
|
|
00536 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS81
|
|
00537 * FIELDS FROM EARLIER REQUESTS DTSCS81
|
|
00538 *----------------------------------------------------- DTSCS81
|
|
00539 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS81
|
|
00540 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS81
|
|
00541 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81
|
|
00542 SET RESP-SEND-MAP TO TRUE. DTSCS81
|
|
00543 P4000-EXIT. DTSCS81
|
|
00544 EXIT. DTSCS81
|
|
00545 /*****************************************************************DTSCS81
|
|
00546 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS81
|
|
00547 ******************************************************************DTSCS81
|
|
00548 CL**2
|
|
00549 P5000-CURSOR-TO-GOTO. DTSCS81
|
|
00550 SET CURSOR-SET-GOTO TO TRUE. DTSCS81
|
|
00551 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS81
|
|
00552 P5000-EXIT. DTSCS81
|
|
00553 EXIT. DTSCS81
|
|
00554 /*****************************************************************DTSCS81
|
|
00555 * INQUIRY WAS REQUESTED *DTSCS81
|
|
00556 ******************************************************************DTSCS81
|
|
00557 CL**2
|
|
00558 P6000-REQUEST-INQUIRE. DTSCS81
|
|
00559 MOVE MAP-YR TO L007-YR-2-X. DTSCS81
|
|
00560 MOVE LOW-VALUES TO MAP-AREA. DTSCS81
|
|
00561 MOVE L007-YR-2-X TO MAP-YR. DTSCS81
|
|
00562 CL**2
|
|
00563 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSCS81
|
|
00564 SET FCYR-CYR-88 TO TRUE. DTSCS81
|
|
00565 IF MAP-YR = LOW-VALUE OR SPACE DTSCS81
|
|
00566 MOVE +0 TO FCYR-YR DTSCS81
|
|
00567 ELSE DTSCS81
|
|
00568 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT DTSCS81
|
|
00569 IF L007-VALID-YR DTSCS81
|
|
00570 MOVE L007-YR-4-9 TO FCYR-YR DTSCS81
|
|
00571 ELSE DTSCS81
|
|
00572 MOVE +0 TO FCYR-YR DTSCS81
|
|
00573 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81
|
|
00574 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81
|
|
00575 IF LCCM-SCR-INQUIRE DTSCS81
|
|
00576 AND FCYR-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS81
|
|
00577 MOVE 'N' TO WRK-NEW-KEY-IND DTSCS81
|
|
00578 ELSE DTSCS81
|
|
00579 MOVE 'Y' TO WRK-NEW-KEY-IND. DTSCS81
|
|
00580 CL**2
|
|
00581 IF SCR-ACCESS-UPDATE DTSCS81
|
|
00582 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS81
|
|
00583 ELSE DTSCS81
|
|
00584 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS81
|
|
00585 CL**2
|
|
00586 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81
|
|
00587 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS81
|
|
00588 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS81
|
|
00589 CL**2
|
|
00590 IF LCCM-MSG DTSCS81
|
|
00591 NEXT SENTENCE DTSCS81
|
|
00592 ELSE DTSCS81
|
|
00593 IF LCCM-ENTER-88 DTSCS81
|
|
00594 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS81
|
|
00595 ELSE DTSCS81
|
|
00596 IF LCCM-F07-88 DTSCS81
|
|
00597 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS81
|
|
00598 ELSE DTSCS81
|
|
00599 IF LCCM-F08-88 DTSCS81
|
|
00600 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS81
|
|
00601 ELSE DTSCS81
|
|
00602 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81
|
|
00603 CL**2
|
|
00604 SET RESP-SEND-MAP TO TRUE. DTSCS81
|
|
00605 P6000-EXIT. DTSCS81
|
|
00606 EXIT. DTSCS81
|
|
00607 EJECT DTSCS81
|
|
00608 P6100-NO-PAGE. DTSCS81
|
|
00609 IF MAP-YR = SPACES OR LOW-VALUES DTSCS81
|
|
00610 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81
|
|
00611 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00612 GO TO P6100-EXIT. DTSCS81
|
|
00613 CL**2
|
|
00614 PERFORM S831-READ THRU S831-EXIT. DTSCS81
|
|
00615 IF L831-NO-REC-88 DTSCS81
|
|
00616 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00617 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00618 GO TO P6100-EXIT. DTSCS81
|
|
00619 CL**2
|
|
00620 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS81
|
|
00621 P6100-EXIT. DTSCS81
|
|
00622 EXIT. DTSCS81
|
|
00623 EJECT DTSCS81
|
|
00624 P6200-PAGE-BACK. DTSCS81
|
|
00625 MOVE FCYR-KEY-AREA TO WRK-KEY-AREA. DTSCS81
|
|
00626 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS81
|
|
00627 IF L831-NO-REC-88 DTSCS81
|
|
00628 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00629 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00630 GO TO P6200-EXIT. DTSCS81
|
|
00631 CL**2
|
|
00632 IF (WRK-NEW-KEY-IND = 'Y') DTSCS81
|
|
00633 AND DTSCS81
|
|
00634 (WRK-KEY-AREA = FCYR-KEY-AREA) DTSCS81
|
|
00635 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81
|
|
00636 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81
|
|
00637 GO TO P6200-EXIT. DTSCS81
|
|
00638 CL**2
|
|
00639 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS81
|
|
00640 IF L831-NO-REC-88 DTSCS81
|
|
00641 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00642 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00643 GO TO P6200-EXIT. DTSCS81
|
|
00644 CL**2
|
|
00645 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS81
|
|
00646 IF L831-NO-REC-88 DTSCS81
|
|
00647 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81
|
|
00648 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS81
|
|
00649 ELSE DTSCS81
|
|
00650 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81
|
|
00651 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS81
|
|
00652 P6200-EXIT. DTSCS81
|
|
00653 EXIT. DTSCS81
|
|
00654 EJECT DTSCS81
|
|
00655 P6300-PAGE-NEXT. DTSCS81
|
|
00656 MOVE FCYR-KEY-AREA TO WRK-KEY-AREA. DTSCS81
|
|
00657 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS81
|
|
00658 IF L831-NO-REC-88 DTSCS81
|
|
00659 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00660 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00661 GO TO P6300-EXIT. DTSCS81
|
|
00662 CL**2
|
|
00663 IF (WRK-NEW-KEY-IND = 'N') DTSCS81
|
|
00664 AND DTSCS81
|
|
00665 (WRK-KEY-AREA = FCYR-KEY-AREA) DTSCS81
|
|
00666 NEXT SENTENCE DTSCS81
|
|
00667 ELSE DTSCS81
|
|
00668 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81
|
|
00669 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81
|
|
00670 GO TO P6300-EXIT. DTSCS81
|
|
00671 CL**2
|
|
00672 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS81
|
|
00673 IF L831-NO-REC-88 DTSCS81
|
|
00674 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS81
|
|
00675 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS81
|
|
00676 ELSE DTSCS81
|
|
00677 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS81
|
|
00678 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS81
|
|
00679 P6300-EXIT. DTSCS81
|
|
00680 EXIT. DTSCS81
|
|
00681 /*****************************************************************DTSCS81
|
|
00682 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS81
|
|
00683 ******************************************************************DTSCS81
|
|
00684 CL**2
|
|
00685 P6900-CONSTRUCT-SCREEN. DTSCS81
|
|
00686 PERFORM S007-CONVERT-FCYR-YR THROUGH S007-EXIT. DTSCS81
|
|
00687 IF L007-VALID-YR DTSCS81
|
|
00688 MOVE L007-YR-2-X TO MAP-YR DTSCS81
|
|
00689 ELSE DTSCS81
|
|
00690 GO TO S899-ABEND. DTSCS81
|
|
00691 SKIP3 DTSCS81
|
|
00692 MOVE FCYR-TAXABLE-WAGE-BASE TO MAP-TAXABLE-WAGE-BASE-N. DTSCS81
|
|
00693 CL**2
|
|
00694 MOVE FCYR-FUTA-CREDIT-RATE TO L056-RATE. DTSCS81
|
|
00695 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS81
|
|
00696 PERFORM S056-RATE-DISPLAY THROUGH S056-EXIT. DTSCS81
|
|
00697 MOVE L056-DISP-RATE TO MAP-FUTA-CREDIT-RATE. DTSCS81
|
|
00698 SKIP3 DTSCS81
|
|
00699 IF FCYR-ESTB-DATE NOT = +0 DTSCS81
|
|
00700 MOVE FCYR-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS81
|
|
00701 SET L001-FROM-FED-8 TO TRUE DTSCS81
|
|
00702 PERFORM S001-DATE THRU S001-EXIT DTSCS81
|
|
00703 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS81
|
|
00704 CL**2
|
|
00705 IF FCYR-CHNG-DATE NOT = +0 DTSCS81
|
|
00706 MOVE FCYR-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS81
|
|
00707 SET L001-FROM-FED-8 TO TRUE DTSCS81
|
|
00708 PERFORM S001-DATE THRU S001-EXIT DTSCS81
|
|
00709 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS81
|
|
00710 CL**2
|
|
00711 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS81
|
|
00712 MOVE FCYR-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS81
|
|
00713 P6900-EXIT. DTSCS81
|
|
00714 EXIT. DTSCS81
|
|
00715 /*****************************************************************DTSCS81
|
|
00716 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS81
|
|
00717 ******************************************************************DTSCS81
|
|
00718 CL**2
|
|
00719 P7000-REQUEST-EDIT. DTSCS81
|
|
00720 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81
|
|
00721 CL**2
|
|
00722 IF LCCM-F09-88 DTSCS81
|
|
00723 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS81
|
|
00724 ELSE DTSCS81
|
|
00725 IF LCCM-F10-88 DTSCS81
|
|
00726 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS81
|
|
00727 ELSE DTSCS81
|
|
00728 IF LCCM-F23-88 DTSCS81
|
|
00729 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS81
|
|
00730 ELSE DTSCS81
|
|
00731 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81
|
|
00732 SKIP3 DTSCS81
|
|
00733 *------------------------------------------------------ DTSCS81
|
|
00734 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS81
|
|
00735 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS81
|
|
00736 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS81
|
|
00737 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS81
|
|
00738 *------------------------------------------------------ DTSCS81
|
|
00739 CL**2
|
|
00740 IF LCCM-MSG DTSCS81
|
|
00741 NEXT SENTENCE DTSCS81
|
|
00742 ELSE DTSCS81
|
|
00743 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS81
|
|
00744 IF LCCM-F09-88 DTSCS81
|
|
00745 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS81
|
|
00746 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS81
|
|
00747 ELSE DTSCS81
|
|
00748 IF LCCM-F10-88 DTSCS81
|
|
00749 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS81
|
|
00750 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS81
|
|
00751 ELSE DTSCS81
|
|
00752 IF LCCM-F23-88 DTSCS81
|
|
00753 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS81
|
|
00754 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS81
|
|
00755 CL**2
|
|
00756 SET RESP-SEND-MAP TO TRUE. DTSCS81
|
|
00757 P7000-EXIT. DTSCS81
|
|
00758 EXIT. DTSCS81
|
|
00759 /*****************************************************************DTSCS81
|
|
00760 * ADD FUNCTION WAS REQUESTED *DTSCS81
|
|
00761 ******************************************************************DTSCS81
|
|
00762 CL**2
|
|
00763 P7100-EDIT-ADD. DTSCS81
|
|
00764 *------------------------------------------------------ DTSCS81
|
|
00765 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS81
|
|
00766 *------------------------------------------------------ DTSCS81
|
|
00767 IF NOT LCCM-SCR-CLEAR DTSCS81
|
|
00768 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS81
|
|
00769 GO TO P7100-EXIT. DTSCS81
|
|
00770 CL**2
|
|
00771 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS81
|
|
00772 CL**2
|
|
00773 IF LCCM-NO-MSG DTSCS81
|
|
00774 PERFORM S8010-READ-FCYR THRU S8010-EXIT DTSCS81
|
|
00775 IF L831-OK-88 DTSCS81
|
|
00776 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS81
|
|
00777 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81
|
|
00778 P7100-EXIT. DTSCS81
|
|
00779 EXIT. DTSCS81
|
|
00780 /*****************************************************************DTSCS81
|
|
00781 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS81
|
|
00782 ******************************************************************DTSCS81
|
|
00783 CL**2
|
|
00784 P7200-EDIT-MOD. DTSCS81
|
|
00785 *----------------------------------------------------- DTSCS81
|
|
00786 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS81
|
|
00787 * INQUIRED DTSCS81
|
|
00788 *----------------------------------------------------- DTSCS81
|
|
00789 IF NOT LCCM-SCR-INQUIRE DTSCS81
|
|
00790 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS81
|
|
00791 GO TO P7200-EXIT. DTSCS81
|
|
00792 SKIP3 DTSCS81
|
|
00793 *----------------------------------------------------- DTSCS81
|
|
00794 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS81
|
|
00795 *----------------------------------------------------- DTSCS81
|
|
00796 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS81
|
|
00797 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS81
|
|
00798 IF L007-NOT-VALID-YR DTSCS81
|
|
00799 OR L007-YR-4-9 NOT = WRK-YR DTSCS81
|
|
00800 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS81
|
|
00801 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00802 GO TO P7200-EXIT. DTSCS81
|
|
00803 CL**2
|
|
00804 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS81
|
|
00805 CL**2
|
|
00806 IF LCCM-NO-MSG DTSCS81
|
|
00807 PERFORM S8010-READ-FCYR THRU S8010-EXIT DTSCS81
|
|
00808 IF L831-NO-REC-88 DTSCS81
|
|
00809 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00810 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81
|
|
00811 P7200-EXIT. DTSCS81
|
|
00812 EXIT. DTSCS81
|
|
00813 /*****************************************************************DTSCS81
|
|
00814 * DELETE FUNCTION WAS REQUESTED *DTSCS81
|
|
00815 ******************************************************************DTSCS81
|
|
00816 CL**2
|
|
00817 P7300-EDIT-DEL. DTSCS81
|
|
00818 *----------------------------------------------------- DTSCS81
|
|
00819 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS81
|
|
00820 * INQUIRED DTSCS81
|
|
00821 *----------------------------------------------------- DTSCS81
|
|
00822 IF NOT LCCM-SCR-INQUIRE DTSCS81
|
|
00823 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS81
|
|
00824 GO TO P7300-EXIT. DTSCS81
|
|
00825 SKIP3 DTSCS81
|
|
00826 *----------------------------------------------------- DTSCS81
|
|
00827 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS81
|
|
00828 *----------------------------------------------------- DTSCS81
|
|
00829 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS81
|
|
00830 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS81
|
|
00831 IF L007-NOT-VALID-YR DTSCS81
|
|
00832 OR L007-YR-4-9 NOT = WRK-YR DTSCS81
|
|
00833 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS81
|
|
00834 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81
|
|
00835 CL**2
|
|
00836 IF LCCM-NO-MSG DTSCS81
|
|
00837 PERFORM S8010-READ-FCYR THRU S8010-EXIT DTSCS81
|
|
00838 IF L831-NO-REC-88 DTSCS81
|
|
00839 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00840 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81
|
|
00841 P7300-EXIT. DTSCS81
|
|
00842 EXIT. DTSCS81
|
|
00843 /*****************************************************************DTSCS81
|
|
00844 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS81
|
|
00845 ******************************************************************DTSCS81
|
|
00846 CL**2
|
|
00847 P8000-REQUEST-UPDATE. DTSCS81
|
|
00848 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81
|
|
00849 CL**2
|
|
00850 IF LCCM-SCR-ADD-LOCKED DTSCS81
|
|
00851 PERFORM P8100-ADD THRU P8100-EXIT DTSCS81
|
|
00852 ELSE DTSCS81
|
|
00853 IF LCCM-SCR-MOD-LOCKED DTSCS81
|
|
00854 PERFORM P8200-MOD THRU P8200-EXIT DTSCS81
|
|
00855 ELSE DTSCS81
|
|
00856 IF LCCM-SCR-DEL-LOCKED DTSCS81
|
|
00857 PERFORM P8300-DEL THRU P8300-EXIT DTSCS81
|
|
00858 ELSE DTSCS81
|
|
00859 PERFORM S899-ABEND THRU S899-EXIT. DTSCS81
|
|
00860 CL**2
|
|
00861 SET RESP-SEND-MAP TO TRUE. DTSCS81
|
|
00862 P8000-EXIT. DTSCS81
|
|
00863 EXIT. DTSCS81
|
|
00864 /*****************************************************************DTSCS81
|
|
00865 * *DTSCS81
|
|
00866 ******************************************************************DTSCS81
|
|
00867 CL**2
|
|
00868 P8100-ADD. DTSCS81
|
|
00869 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81
|
|
00870 CL**2
|
|
00871 IF LCCM-F12-88 DTSCS81
|
|
00872 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS81
|
|
00873 GO TO P8100-EXIT. DTSCS81
|
|
00874 CL**2
|
|
00875 PERFORM S8010-READ-FCYR THRU S8010-EXIT. DTSCS81
|
|
00876 CL**2
|
|
00877 IF L831-OK-88 DTSCS81
|
|
00878 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS81
|
|
00879 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00880 GO TO P8100-EXIT. DTSCS81
|
|
00881 CL**2
|
|
00882 MOVE LOW-VALUES TO FCYR-DATA-AREA. DTSCS81
|
|
00883 CL**2
|
|
00884 PERFORM P8900-CONSTRUCT-FCYR THRU P8900-EXIT. DTSCS81
|
|
00885 CL**2
|
|
00886 MOVE LCCM-CURR-RUN-DATE TO FCYR-ESTB-DATE. DTSCS81
|
|
00887 CL**3
|
|
00888 MOVE LCCM-CURR-RUN-DATE TO FCYR-CHNG-DATE. DTSCS81
|
|
00889 CL**2
|
|
00890 PERFORM S831-WRITE THRU S831-EXIT. DTSCS81
|
|
00891 CL**2
|
|
00892 MOVE LOW-VALUES TO MAP-AREA. DTSCS81
|
|
00893 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81
|
|
00894 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS81
|
|
00895 P8100-EXIT. DTSCS81
|
|
00896 EXIT. DTSCS81
|
|
00897 /*****************************************************************DTSCS81
|
|
00898 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS81
|
|
00899 ******************************************************************DTSCS81
|
|
00900 CL**2
|
|
00901 P8200-MOD. DTSCS81
|
|
00902 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS81
|
|
00903 CL**2
|
|
00904 IF LCCM-F12-88 DTSCS81
|
|
00905 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS81
|
|
00906 GO TO P8200-EXIT. DTSCS81
|
|
00907 CL**2
|
|
00908 PERFORM S8010-READ-FCYR THRU S8010-EXIT. DTSCS81
|
|
00909 IF L831-NO-REC-88 DTSCS81
|
|
00910 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00911 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00912 GO TO P8200-EXIT. DTSCS81
|
|
00913 CL**2
|
|
00914 PERFORM P8900-CONSTRUCT-FCYR THRU P8900-EXIT. DTSCS81
|
|
00915 CL**2
|
|
00916 MOVE LCCM-CURR-RUN-DATE TO FCYR-CHNG-DATE. DTSCS81
|
|
00917 CL**2
|
|
00918 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS81
|
|
00919 CL**2
|
|
00920 MOVE FCYR-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS81
|
|
00921 SET L001-FROM-FED-8 TO TRUE. DTSCS81
|
|
00922 PERFORM S001-DATE THRU S001-EXIT. DTSCS81
|
|
00923 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS81
|
|
00924 CL**2
|
|
00925 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS81
|
|
00926 P8200-EXIT. DTSCS81
|
|
00927 EXIT. DTSCS81
|
|
00928 /*****************************************************************DTSCS81
|
|
00929 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS81
|
|
00930 ******************************************************************DTSCS81
|
|
00931 CL**2
|
|
00932 P8300-DEL. DTSCS81
|
|
00933 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS81
|
|
00934 CL**2
|
|
00935 IF LCCM-F12-88 DTSCS81
|
|
00936 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS81
|
|
00937 GO TO P8300-EXIT. DTSCS81
|
|
00938 CL**2
|
|
00939 PERFORM S8010-READ-FCYR THRU S8010-EXIT. DTSCS81
|
|
00940 IF NOT L831-OK-88 DTSCS81
|
|
00941 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS81
|
|
00942 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
00943 GO TO P8300-EXIT. DTSCS81
|
|
00944 CL**2
|
|
00945 PERFORM S831-DELETE THRU S831-EXIT. DTSCS81
|
|
00946 CL**2
|
|
00947 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS81
|
|
00948 SET LCCM-SCR-CLEAR TO TRUE. DTSCS81
|
|
00949 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS81
|
|
00950 CL**2
|
|
00951 MOVE LOW-VALUES TO MAP-AREA. DTSCS81
|
|
00952 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS81
|
|
00953 PERFORM S007-CONVERT-FCYR-YR THRU S007-EXIT. DTSCS81
|
|
00954 IF L007-VALID-YR DTSCS81
|
|
00955 MOVE L007-YR-2-X TO MAP-YR DTSCS81
|
|
00956 ELSE DTSCS81
|
|
00957 GO TO S899-ABEND. DTSCS81
|
|
00958 CL**2
|
|
00959 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS81
|
|
00960 P8300-EXIT. DTSCS81
|
|
00961 EXIT. DTSCS81
|
|
00962 EJECT DTSCS81
|
|
00963 P8900-CONSTRUCT-FCYR. DTSCS81
|
|
00964 MOVE MAP-TAXABLE-WAGE-BASE-AREA DTSCS81
|
|
00965 TO L011-S-AMT-AREA. CL**3
|
|
00966 PERFORM S011-DOLLARS THRU S011-EXIT. DTSCS81
|
|
00967 MOVE L011-AMT TO FCYR-TAXABLE-WAGE-BASE. CL**3
|
|
00968 CL**2
|
|
00969 MOVE MAP-FUTA-CREDIT-RATE-AREA DTSCS81
|
|
00970 TO L012-S-RATE-AREA. DTSCS81
|
|
00971 PERFORM S012-RATE THRU S012-EXIT. DTSCS81
|
|
00972 MOVE L012-RATE TO FCYR-FUTA-CREDIT-RATE. DTSCS81
|
|
00973 P8900-EXIT. DTSCS81
|
|
00974 EXIT. DTSCS81
|
|
00975 /*****************************************************************DTSCS81
|
|
00976 * LINKS TO UTILITY MODULES DTSCS81
|
|
00977 ******************************************************************DTSCS81
|
|
00978 CL**2
|
|
00979 S001-DATE. DTSCS81
|
|
00980 EXEC CICS LINK DTSCS81
|
|
00981 PROGRAM ('DTSCU001') CL**2
|
|
00982 COMMAREA (L001-COMM-AREA) DTSCS81
|
|
00983 END-EXEC. DTSCS81
|
|
00984 S001-EXIT. DTSCS81
|
|
00985 EXIT. DTSCS81
|
|
00986 SKIP3 DTSCS81
|
|
00987 S007-CHECK-MAP-YR. DTSCS81
|
|
00988 MOVE MAP-YR TO L007-YR-2-X. DTSCS81
|
|
00989 SET L007-FROM-YR-2 TO TRUE. DTSCS81
|
|
00990 GO TO S007-YR-CONVERT. DTSCS81
|
|
00991 S007-CONVERT-FCYR-YR. DTSCS81
|
|
00992 MOVE FCYR-YR TO L007-YR-4-9. DTSCS81
|
|
00993 SET L007-FROM-YR-4 TO TRUE. DTSCS81
|
|
00994 GO TO S007-YR-CONVERT. DTSCS81
|
|
00995 S007-YR-CONVERT. DTSCS81
|
|
00996 EXEC CICS LINK DTSCS81
|
|
00997 PROGRAM ('DTSCU007') CL**2
|
|
00998 COMMAREA (L007-COMM-AREA) DTSCS81
|
|
00999 END-EXEC. DTSCS81
|
|
01000 S007-EXIT. DTSCS81
|
|
01001 EXIT. DTSCS81
|
|
01002 SKIP3 DTSCS81
|
|
01003 S011-DOLLARS. DTSCS81
|
|
01004 MOVE +1.00 TO L011-MIN-AMT. DTSCS81
|
|
01005 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS81
|
|
01006 CL**2
|
|
01007 EXEC CICS LINK DTSCS81
|
|
01008 PROGRAM ('DTSCU011') CL**2
|
|
01009 COMMAREA (L011-COMM-AREA) DTSCS81
|
|
01010 END-EXEC. DTSCS81
|
|
01011 S011-EXIT. DTSCS81
|
|
01012 EXIT. DTSCS81
|
|
01013 SKIP3 DTSCS81
|
|
01014 S012-RATE. DTSCS81
|
|
01015 EXEC CICS LINK DTSCS81
|
|
01016 PROGRAM ('DTSCU012') CL**2
|
|
01017 COMMAREA (L012-COMM-AREA) DTSCS81
|
|
01018 END-EXEC. DTSCS81
|
|
01019 S012-EXIT. DTSCS81
|
|
01020 EXIT. DTSCS81
|
|
01021 SKIP3 DTSCS81
|
|
01022 S056-RATE-DISPLAY. DTSCS81
|
|
01023 EXEC CICS LINK DTSCS81
|
|
01024 PROGRAM ('DTSCU056') CL**2
|
|
01025 COMMAREA (L056-COMM-AREA) DTSCS81
|
|
01026 END-EXEC. DTSCS81
|
|
01027 S056-EXIT. DTSCS81
|
|
01028 EXIT. DTSCS81
|
|
01029 EJECT DTSCS81
|
|
01030 S803-REQ-SCR-ID-EDIT. DTSCS81
|
|
01031 EXEC CICS LINK DTSCS81
|
|
01032 PROGRAM ('DTSCU803') CL**2
|
|
01033 COMMAREA (DFHCOMMAREA) DTSCS81
|
|
01034 END-EXEC. DTSCS81
|
|
01035 S803-EXIT. DTSCS81
|
|
01036 EXIT. DTSCS81
|
|
01037 SKIP3 DTSCS81
|
|
01038 S804-INVALID-KEY. DTSCS81
|
|
01039 EXEC CICS LINK DTSCS81
|
|
01040 PROGRAM ('DTSCU804') CL**2
|
|
01041 COMMAREA (DFHCOMMAREA) DTSCS81
|
|
01042 END-EXEC. DTSCS81
|
|
01043 S804-EXIT. DTSCS81
|
|
01044 EXIT. DTSCS81
|
|
01045 SKIP3 DTSCS81
|
|
01046 S805-MSG-AREA. DTSCS81
|
|
01047 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS81
|
|
01048 CL**2
|
|
01049 EXEC CICS LINK DTSCS81
|
|
01050 PROGRAM ('DTSCU805') CL**2
|
|
01051 COMMAREA (L805-COMM-AREA) DTSCS81
|
|
01052 END-EXEC. DTSCS81
|
|
01053 CL**2
|
|
01054 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS81
|
|
01055 S805-EXIT. DTSCS81
|
|
01056 EXIT. DTSCS81
|
|
01057 EJECT DTSCS81
|
|
01058 S831-READ. DTSCS81
|
|
01059 SET L831-READ-88 TO TRUE. DTSCS81
|
|
01060 GO TO S831-IO. DTSCS81
|
|
01061 CL**2
|
|
01062 S831-START-BROWSE. DTSCS81
|
|
01063 SET L831-START-BROWSE-88 TO TRUE. DTSCS81
|
|
01064 GO TO S831-IO. DTSCS81
|
|
01065 CL**2
|
|
01066 S831-READ-NEXT. DTSCS81
|
|
01067 SET L831-READ-NEXT-88 TO TRUE. DTSCS81
|
|
01068 GO TO S831-IO. DTSCS81
|
|
01069 CL**2
|
|
01070 S831-READ-PREV. DTSCS81
|
|
01071 SET L831-READ-PREV-88 TO TRUE. DTSCS81
|
|
01072 GO TO S831-IO. DTSCS81
|
|
01073 CL**2
|
|
01074 S831-END-BROWSE. DTSCS81
|
|
01075 SET L831-END-BROWSE-88 TO TRUE. DTSCS81
|
|
01076 GO TO S831-IO. DTSCS81
|
|
01077 CL**2
|
|
01078 S831-REWRITE. DTSCS81
|
|
01079 SET L831-REWRITE-88 TO TRUE. DTSCS81
|
|
01080 GO TO S831-IO. DTSCS81
|
|
01081 CL**2
|
|
01082 S831-WRITE. DTSCS81
|
|
01083 SET L831-WRITE-88 TO TRUE. DTSCS81
|
|
01084 GO TO S831-IO. DTSCS81
|
|
01085 CL**2
|
|
01086 S831-DELETE. DTSCS81
|
|
01087 SET L831-DELETE-88 TO TRUE. DTSCS81
|
|
01088 GO TO S831-IO. DTSCS81
|
|
01089 CL**2
|
|
01090 S831-IO. DTSCS81
|
|
01091 CL**2
|
|
01092 EXEC CICS LINK DTSCS81
|
|
01093 PROGRAM ('DTSCU831') CL**2
|
|
01094 COMMAREA (L831-COMM-AREA) DTSCS81
|
|
01095 END-EXEC. DTSCS81
|
|
01096 CL**2
|
|
01097 IF L831-FILE-CLOSED-88 DTSCS81
|
|
01098 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS81
|
|
01099 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS81
|
|
01100 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS81
|
|
01101 GO TO MAINLINE-EXIT. DTSCS81
|
|
01102 S831-EXIT. DTSCS81
|
|
01103 EXIT. DTSCS81
|
|
01104 SKIP3 DTSCS81
|
|
01105 S851-SCREEN-PROCESSING. DTSCS81
|
|
01106 EXEC CICS LINK DTSCS81
|
|
01107 PROGRAM ('DTSCU851') CL**2
|
|
01108 COMMAREA (L851-COMM-AREA) DTSCS81
|
|
01109 END-EXEC. DTSCS81
|
|
01110 S851-EXIT. DTSCS81
|
|
01111 EXIT. DTSCS81
|
|
01112 SKIP3 DTSCS81
|
|
01113 S899-ABEND. DTSCS81
|
|
01114 EXEC CICS ABEND DTSCS81
|
|
01115 ABCODE(WRK-ABEND-CD) DTSCS81
|
|
01116 END-EXEC. DTSCS81
|
|
01117 S899-EXIT. DTSCS81
|
|
01118 EXIT. DTSCS81
|
|
01119 /*****************************************************************DTSCS81
|
|
01120 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS81
|
|
01121 ******************************************************************DTSCS81
|
|
01122 CL**2
|
|
01123 S1000-SCREEN-EDITS. DTSCS81
|
|
01124 PERFORM S1100-YR THRU S1100-EXIT. DTSCS81
|
|
01125 PERFORM S1200-TAX-WAGE-BASE THRU S1200-EXIT. DTSCS81
|
|
01126 PERFORM S1300-FUTA-CR-RATE THRU S1300-EXIT. DTSCS81
|
|
01127 S1000-EXIT. DTSCS81
|
|
01128 EXIT. DTSCS81
|
|
01129 EJECT DTSCS81
|
|
01130 S1100-YR. DTSCS81
|
|
01131 IF MAP-YR = LOW-VALUES OR SPACES DTSCS81
|
|
01132 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81
|
|
01133 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS81
|
|
01134 ELSE DTSCS81
|
|
01135 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT DTSCS81
|
|
01136 IF L007-NOT-VALID-YR DTSCS81
|
|
01137 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81
|
|
01138 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS81
|
|
01139 S1100-EXIT. DTSCS81
|
|
01140 EXIT. DTSCS81
|
|
01141 SKIP3 DTSCS81
|
|
01142 S1101-ERROR. DTSCS81
|
|
01143 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YR-A. DTSCS81
|
|
01144 IF LCCM-NO-MSG DTSCS81
|
|
01145 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS81
|
|
01146 MOVE CATB-CURSOR TO MAP-YR-L DTSCS81
|
|
01147 SET CURSOR-SET-YES TO TRUE. DTSCS81
|
|
01148 S1101-EXIT. DTSCS81
|
|
01149 EXIT. DTSCS81
|
|
01150 EJECT DTSCS81
|
|
01151 S1200-TAX-WAGE-BASE. DTSCS81
|
|
01152 MOVE MAP-TAXABLE-WAGE-BASE-AREA TO L011-S-AMT-AREA. DTSCS81
|
|
01153 PERFORM S011-DOLLARS THRU S011-EXIT. DTSCS81
|
|
01154 IF L011-NO-ENTRY DTSCS81
|
|
01155 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81
|
|
01156 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81
|
|
01157 ELSE DTSCS81
|
|
01158 IF L011-NOT-NUMERIC DTSCS81
|
|
01159 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81
|
|
01160 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81
|
|
01161 ELSE DTSCS81
|
|
01162 IF L011-INVALID-NEGATIVE DTSCS81
|
|
01163 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-ID DTSCS81
|
|
01164 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81
|
|
01165 ELSE DTSCS81
|
|
01166 IF L011-EXCEEDS-MIN-MAX DTSCS81
|
|
01167 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-ID DTSCS81
|
|
01168 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS81
|
|
01169 ELSE DTSCS81
|
|
01170 MOVE L011-AMT TO MAP-TAXABLE-WAGE-BASE-N. DTSCS81
|
|
01171 S1200-EXIT. DTSCS81
|
|
01172 EXIT. DTSCS81
|
|
01173 SKIP3 DTSCS81
|
|
01174 S1201-ERROR. DTSCS81
|
|
01175 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TAXABLE-WAGE-BASE-A. DTSCS81
|
|
01176 IF LCCM-NO-MSG DTSCS81
|
|
01177 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS81
|
|
01178 MOVE CATB-CURSOR TO MAP-TAXABLE-WAGE-BASE-L DTSCS81
|
|
01179 SET CURSOR-SET-YES TO TRUE. DTSCS81
|
|
01180 S1201-EXIT. DTSCS81
|
|
01181 EXIT. DTSCS81
|
|
01182 EJECT DTSCS81
|
|
01183 S1300-FUTA-CR-RATE. DTSCS81
|
|
01184 MOVE MAP-FUTA-CREDIT-RATE-AREA TO L012-S-RATE-AREA. DTSCS81
|
|
01185 PERFORM S012-RATE THRU S012-EXIT. DTSCS81
|
|
01186 IF L012-NOT-VALID DTSCS81
|
|
01187 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS81
|
|
01188 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS81
|
|
01189 ELSE DTSCS81
|
|
01190 IF L012-NO-ENTRY DTSCS81
|
|
01191 OR L012-RATE = +0 DTSCS81
|
|
01192 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS81
|
|
01193 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS81
|
|
01194 ELSE DTSCS81
|
|
01195 MOVE L012-RATE TO L056-RATE DTSCS81
|
|
01196 SET L056-DISP1-LEFT-88 TO TRUE DTSCS81
|
|
01197 PERFORM S056-RATE-DISPLAY THRU S056-EXIT DTSCS81
|
|
01198 MOVE L056-DISP-RATE TO MAP-FUTA-CREDIT-RATE. DTSCS81
|
|
01199 S1300-EXIT. DTSCS81
|
|
01200 EXIT. DTSCS81
|
|
01201 SKIP3 DTSCS81
|
|
01202 S1301-ERROR. DTSCS81
|
|
01203 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FUTA-CREDIT-RATE-A. DTSCS81
|
|
01204 IF LCCM-NO-MSG DTSCS81
|
|
01205 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS81
|
|
01206 MOVE CATB-CURSOR TO MAP-FUTA-CREDIT-RATE-L DTSCS81
|
|
01207 SET CURSOR-SET-YES TO TRUE. DTSCS81
|
|
01208 S1301-EXIT. DTSCS81
|
|
01209 EXIT. DTSCS81
|
|
01210 /*****************************************************************DTSCS81
|
|
01211 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS81
|
|
01212 ******************************************************************DTSCS81
|
|
01213 S5100-SET-LOCK-ATTRB. DTSCS81
|
|
01214 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS81
|
|
01215 WRK-ATB-NUM. DTSCS81
|
|
01216 CL**2
|
|
01217 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS81
|
|
01218 CL**2
|
|
01219 MOVE CATB-ASKIP-BRT-MDTON TO MAP-YR-A DTSCS81
|
|
01220 MAP-GOTO-A. CL**3
|
|
01221 S5100-EXIT. DTSCS81
|
|
01222 EXIT. DTSCS81
|
|
01223 SKIP3 DTSCS81
|
|
01224 ******************************************************************DTSCS81
|
|
01225 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS81
|
|
01226 ******************************************************************DTSCS81
|
|
01227 S5200-SET-UPDATE-ATTRB. DTSCS81
|
|
01228 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS81
|
|
01229 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS81
|
|
01230 CL**2
|
|
01231 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS81
|
|
01232 S5200-EXIT. DTSCS81
|
|
01233 EXIT. DTSCS81
|
|
01234 SKIP3 DTSCS81
|
|
01235 ******************************************************************DTSCS81
|
|
01236 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS81
|
|
01237 ******************************************************************DTSCS81
|
|
01238 S5300-SET-INQ-ATTRB. DTSCS81
|
|
01239 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS81
|
|
01240 WRK-ATB-NUM. CL**3
|
|
01241 CL**2
|
|
01242 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS81
|
|
01243 S5300-EXIT. DTSCS81
|
|
01244 EXIT. DTSCS81
|
|
01245 SKIP3 DTSCS81
|
|
01246 ******************************************************************DTSCS81
|
|
01247 * DO IT *DTSCS81
|
|
01248 ******************************************************************DTSCS81
|
|
01249 S5900-SET-ATTRB. DTSCS81
|
|
01250 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-YR-A. DTSCS81
|
|
01251 CL**2
|
|
01252 MOVE WRK-ATB-NUM TO MAP-TAXABLE-WAGE-BASE-A DTSCS81
|
|
01253 MAP-FUTA-CREDIT-RATE-A. DTSCS81
|
|
01254 CL**2
|
|
01255 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS81
|
|
01256 MAP-CHNG-DATE-A. CL**3
|
|
01257 CL**2
|
|
01258 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS81
|
|
01259 S5900-EXIT. DTSCS81
|
|
01260 EXIT. DTSCS81
|
|
01261 /*****************************************************************DTSCS81
|
|
01262 * READ PREPARATION ROUTINES *DTSCS81
|
|
01263 ******************************************************************DTSCS81
|
|
01264 S8010-READ-FCYR. DTSCS81
|
|
01265 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS81
|
|
01266 IF L007-VALID-YR DTSCS81
|
|
01267 MOVE LOW-VALUES TO FCYR-KEY-AREA DTSCS81
|
|
01268 SET FCYR-CYR-88 TO TRUE DTSCS81
|
|
01269 MOVE L007-YR-4-9 TO FCYR-YR DTSCS81
|
|
01270 PERFORM S831-READ THRU S831-EXIT DTSCS81
|
|
01271 ELSE DTSCS81
|
|
01272 GO TO S899-ABEND. DTSCS81
|
|
01273 S8010-EXIT. DTSCS81
|
|
01274 EXIT. DTSCS81
|
|
01275 /*****************************************************************DTSCS81
|
|
01276 * MAP ROUTINES *DTSCS81
|
|
01277 ******************************************************************DTSCS81
|
|
01278 S9100-RECEIVE. DTSCS81
|
|
01279 SET L851-RECEIVE-88 TO TRUE. DTSCS81
|
|
01280 CL**2
|
|
01281 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS81
|
|
01282 CL**2
|
|
01283 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS81
|
|
01284 CL**2
|
|
01285 MOVE L851-AID TO LCCM-AID. DTSCS81
|
|
01286 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS81
|
|
01287 S9100-EXIT. DTSCS81
|
|
01288 EXIT. DTSCS81
|
|
01289 SKIP3 DTSCS81
|
|
01290 S9200-SEND-DATAONLY. DTSCS81
|
|
01291 MOVE LOW-VALUES TO MAP-AREA. DTSCS81
|
|
01292 CL**2
|
|
01293 IF LCCM-NO-MSG DTSCS81
|
|
01294 NEXT SENTENCE DTSCS81
|
|
01295 ELSE DTSCS81
|
|
01296 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS81
|
|
01297 CL**2
|
|
01298 IF CURSOR-SET-GOTO DTSCS81
|
|
01299 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS81
|
|
01300 ELSE DTSCS81
|
|
01301 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS81
|
|
01302 CL**2
|
|
01303 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS81
|
|
01304 CL**2
|
|
01305 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS81
|
|
01306 CL**2
|
|
01307 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS81
|
|
01308 S9200-EXIT. DTSCS81
|
|
01309 EXIT. DTSCS81
|
|
01310 SKIP3 DTSCS81
|
|
01311 S9300-SEND-MAP. DTSCS81
|
|
01312 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS81
|
|
01313 CL**3
|
|
01314 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS81
|
|
01315 CL**3
|
|
01316 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS81
|
|
01317 CL**2
|
|
01318 IF SCR-ACCESS-UPDATE DTSCS81
|
|
01319 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS81
|
|
01320 ELSE DTSCS81
|
|
01321 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS81
|
|
01322 CL**2
|
|
01323 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS81
|
|
01324 CL**2
|
|
01325 IF CURSOR-SET-NO DTSCS81
|
|
01326 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS81
|
|
01327 CL**2
|
|
01328 SET L851-SEND-88 TO TRUE. DTSCS81
|
|
01329 CL**2
|
|
01330 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS81
|
|
01331 CL**2
|
|
01332 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS81
|
|
01333 S9300-EXIT. DTSCS81
|
|
01334 EXIT. DTSCS81
|
|
01335 SKIP3 DTSCS81
|
|
01336 S9310-UPDATE-FKEYS. DTSCS81
|
|
01337 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS81
|
|
01338 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS81
|
|
01339 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS81
|
|
01340 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS81
|
|
01341 MOVE CFKD-DEL TO MAP-KEY-DEL. CL**3
|
|
01342 CL**2
|
|
01343 IF LCCM-SCR-CLEAR DTSCS81
|
|
01344 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS81
|
|
01345 MAP-KEY-DEL DTSCS81
|
|
01346 ELSE DTSCS81
|
|
01347 IF LCCM-SCR-UPDATE-LOCKED DTSCS81
|
|
01348 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS81
|
|
01349 MAP-KEY-FWRD DTSCS81
|
|
01350 MAP-KEY-ADD DTSCS81
|
|
01351 MAP-KEY-MOD DTSCS81
|
|
01352 MAP-KEY-DEL DTSCS81
|
|
01353 ELSE DTSCS81
|
|
01354 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS81
|
|
01355 S9310-EXIT. DTSCS81
|
|
01356 EXIT. DTSCS81
|
|
01357 SKIP3 DTSCS81
|
|
01358 S9320-INQUIRY-FKEYS. DTSCS81
|
|
01359 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS81
|
|
01360 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS81
|
|
01361 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS81
|
|
01362 MAP-KEY-MOD DTSCS81
|
|
01363 MAP-KEY-DEL. DTSCS81
|
|
01364 S9320-EXIT. DTSCS81
|
|
01365 EXIT. DTSCS81
|
|
01366 SKIP3 DTSCS81
|
|
01367 S9900-PREPARE-SEND. DTSCS81
|
|
01368 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS81
|
|
01369 LCCM-SCR-ID. DTSCS81
|
|
01370 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS81
|
|
01371 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS81
|
|
01372 S9900-EXIT. DTSCS81
|
|
01373 EXIT. DTSCS81
|