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