1697 lines
132 KiB
COBOL
1697 lines
132 KiB
COBOL
00001 IDENTIFICATION DIVISION. 04/09/13
|
|
00002 PROGRAM-ID. DTSCS89. DTSCS89
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002
|
|
00004 DATE-WRITTEN. APRIL 2002. DTSCS89
|
|
00005 DATE-COMPILED. DTSCS89
|
|
00006 SKIP3 DTSCS89
|
|
00007 ***** DTSCS89
|
|
00008 * DTSCS89
|
|
00009 * FUNCTION: ANNUAL FILING INQUIRY/UPDATE DTSCS89
|
|
00010 * SCREEN PROCESSOR. DTSCS89
|
|
00011 * DTSCS89
|
|
00012 * DTSCS89
|
|
00013 * MODIFICATION LOG: DTSCS89
|
|
00014 * DTSCS89
|
|
00015 * 05/01/2002 INITIAL DEVELOPMENT. MODIFIED FROM DTSCS82. DTSCS89
|
|
00016 * WORK ORDER: PROGRAMMER: Z1L DTSCS89
|
|
00017 * DTSCS89
|
|
00018 * DTSCS89
|
|
00019 * 04/10/2013 MODIFIED TO CHANGE FINAL DATE TO ESTIMATED DATE. CL**2
|
|
00020 * WORK ORDER: PROGRAMMER: Z1L CL**2
|
|
00021 * CL**2
|
|
00022 * CL**2
|
|
00023 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS89
|
|
00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS89
|
|
00025 * REFERENCE: PROGRAMMER: XXX DTSCS89
|
|
00026 * DTSCS89
|
|
00027 * DTSCS89
|
|
00028 * DESCRIPTION: DTSCS89
|
|
00029 * DTSCS89
|
|
00030 * CLEAR: DTSCS89
|
|
00031 * DTSCS89
|
|
00032 * DATA FIELDS DISPLAYED: NONE. DTSCS89
|
|
00033 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS89
|
|
00034 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89
|
|
00035 * DTSCS89
|
|
00036 * DTSCS89
|
|
00037 * INQUIRY: DTSCS89
|
|
00038 * DTSCS89
|
|
00039 * CONTROL FIELD(S): MAP-YR, MAP-Q. DTSCS89
|
|
00040 * DTSCS89
|
|
00041 * JUMP IN: USE CLEAR LOGIC. DTSCS89
|
|
00042 * DTSCS89
|
|
00043 * ENTER: DISPLAY FAFD RECORD ASSOCIATED WITH MAP-YR DTSCS89
|
|
00044 * DTSCS89
|
|
00045 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS89
|
|
00046 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS89
|
|
00047 * DTSCS89
|
|
00048 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS89
|
|
00049 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS89
|
|
00050 * DTSCS89
|
|
00051 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS89
|
|
00052 * DO NOT "WRAP" PAGING. DTSCS89
|
|
00053 * DTSCS89
|
|
00054 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS89
|
|
00055 * FAFD-KEY-AREA OF THE DISPLAYED FAFD RECORD IN DTSCS89
|
|
00056 * LCCM-SCR-KEY-AREA. DTSCS89
|
|
00057 * DTSCS89
|
|
00058 * DTSCS89
|
|
00059 * UPDATE: DTSCS89
|
|
00060 * DTSCS89
|
|
00061 * ADD DTSCS89
|
|
00062 * MOD DTSCS89
|
|
00063 * DEL DTSCS89
|
|
00064 * DTSCS89
|
|
00065 * DTSCS89
|
|
00066 * RECORDS READ: DTSCS89
|
|
00067 * DTSCS89
|
|
00068 * MASTER: DTSCS89
|
|
00069 * DTSCS89
|
|
00070 * NONE. DTSCS89
|
|
00071 * DTSCS89
|
|
00072 * DTSCS89
|
|
00073 * ALTERNATE INDEX: DTSCS89
|
|
00074 * DTSCS89
|
|
00075 * NONE. DTSCS89
|
|
00076 * DTSCS89
|
|
00077 * DTSCS89
|
|
00078 * REFERENCE: DTSCS89
|
|
00079 * DTSCS89
|
|
00080 * FAFD. DTSCS89
|
|
00081 * DTSCS89
|
|
00082 * DTSCS89
|
|
00083 * ACCOUNTING TRANSACTION COLLECTION: DTSCS89
|
|
00084 * DTSCS89
|
|
00085 * NONE. DTSCS89
|
|
00086 * DTSCS89
|
|
00087 * DTSCS89
|
|
00088 * RECORDS UPDATED: DTSCS89
|
|
00089 * DTSCS89
|
|
00090 * MASTER: DTSCS89
|
|
00091 * DTSCS89
|
|
00092 * NONE. DTSCS89
|
|
00093 * DTSCS89
|
|
00094 * DTSCS89
|
|
00095 * REFERENCE: DTSCS89
|
|
00096 * DTSCS89
|
|
00097 * FAFD (ADD, MOD, DEL). DTSCS89
|
|
00098 * DTSCS89
|
|
00099 * DTSCS89
|
|
00100 * ACCOUNTING TRANSACTION COLLECTION: DTSCS89
|
|
00101 * DTSCS89
|
|
00102 * NONE. DTSCS89
|
|
00103 * DTSCS89
|
|
00104 * DTSCS89
|
|
00105 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS89
|
|
00106 * DTSCS89
|
|
00107 * NONE. DTSCS89
|
|
00108 * DTSCS89
|
|
00109 * DTSCS89
|
|
00110 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS89
|
|
00111 * UTILITY MODULES) LINKED TO: DTSCS89
|
|
00112 * DTSCS89
|
|
00113 * DTSCU001 DATE EDIT/CONVERSION. DTSCS89
|
|
00114 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS89
|
|
00115 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS89
|
|
00116 * DTSCU016 QUARTER FROM SCREEN FORMAT/EDIT. DTSCS89
|
|
00117 * DTSCU831 REFERENCE FILE I/O. DTSCS89
|
|
00118 * DTSCS89
|
|
00119 * DTSCS89
|
|
00120 * MAINTENANCE NOTES: DTSCS89
|
|
00121 * DTSCS89
|
|
00122 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS89
|
|
00123 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS89
|
|
00124 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS89
|
|
00125 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS89
|
|
00126 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS89), DTSCS89
|
|
00127 * ALTER THE MAP (DTDM89) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS89
|
|
00128 * DTSCS89
|
|
00129 ***** DTSCS89
|
|
00130 SKIP3 DTSCS89
|
|
00131 ENVIRONMENT DIVISION. DTSCS89
|
|
00132 SKIP3 DTSCS89
|
|
00133 DATA DIVISION. DTSCS89
|
|
00134 SKIP3 DTSCS89
|
|
00135 WORKING-STORAGE SECTION. DTSCS89
|
|
001355 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS89 04/09/13'. DTSCS89
|
|
00136 77 PAN-VALET PICTURE X(24) VALUE '001DTSCS89 11/11/02'. DTSCS89
|
|
00137 SKIP3 DTSCS89
|
|
00138 01 WRK-AREA. DTSCS89
|
|
00139 05 WRK-ABEND-CD PIC X(04) VALUE 'S89 '. DTSCS89
|
|
00140 SKIP1 DTSCS89
|
|
00141 05 WRK-SCR-ID. DTSCS89
|
|
00142 10 WRK-SCR-ID-9 PIC 9(02) VALUE 89. DTSCS89
|
|
00143 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS89
|
|
00144 SKIP1 DTSCS89
|
|
00145 05 WRK-KEY-AREA. DTSCS89
|
|
00146 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS89
|
|
00147 10 WRK-YR PIC S9(05) COMP-3. DTSCS89
|
|
00148 10 FILLER PIC X(11). DTSCS89
|
|
00149 SKIP1 DTSCS89
|
|
00150 05 WRK-DISP-DATE PIC 9(08). DTSCS89
|
|
00151 05 FILLER REDEFINES WRK-DISP-DATE. DTSCS89
|
|
00152 10 WRK-DISP-CC PIC X(02). DTSCS89
|
|
00153 10 WRK-DISP-YY PIC X(02). DTSCS89
|
|
00154 10 WRK-DISP-MM PIC X(02). DTSCS89
|
|
00155 10 WRK-DISP-DD PIC X(02). DTSCS89
|
|
00156 SKIP1 DTSCS89
|
|
00157 05 WRK-NO-ENTRY PIC S9(09) COMP-3 DTSCS89
|
|
00158 VALUE +999999999. DTSCS89
|
|
00159 05 WRK-UC30H-FINAL-ACT-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00160 05 WRK-UC30H-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00161 05 WRK-UC30H-RPT-DUE-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00162 05 WRK-UC30H-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00163 05 WRK-UC30H-ESTIMATED-DATE PIC S9(09) COMP-3. CL**2
|
|
00164 05 WRK-YRQ-START-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00165 05 WRK-ANN-START-YR PIC S9(02) VALUE +01. DTSCS89
|
|
00166 05 WRK-YRQ-END-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00167 05 WRK-UC30H-PLUS1-1ST-DEL-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00168 05 WRK-UC30H-PLUS1-RPT-DUE-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00169 05 WRK-YRQ-PLUS1-START-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00170 05 WRK-YRQ-PLUS1-END-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00171 05 WRK-UC30H-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCS89
|
|
00172 EJECT DTSCS89
|
|
00173 01 SCREEN-PROCESSING. DTSCS89
|
|
00174 05 SCR-ACCESS-IND PIC X(01). DTSCS89
|
|
00175 88 SCR-ACCESS-INQ VALUE '1'. DTSCS89
|
|
00176 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS89
|
|
00177 SKIP1 DTSCS89
|
|
00178 05 CURSOR-SET-IND PIC X(01). DTSCS89
|
|
00179 88 CURSOR-SET-YES VALUE 'Y'. DTSCS89
|
|
00180 88 CURSOR-SET-NO VALUE 'N'. DTSCS89
|
|
00181 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS89
|
|
00182 SKIP1 DTSCS89
|
|
00183 05 REQ-IND PIC X(01). DTSCS89
|
|
00184 88 REQ-ERROR VALUE 'O'. DTSCS89
|
|
00185 88 REQ-JUMP VALUE 'J'. DTSCS89
|
|
00186 88 REQ-INQUIRE VALUE 'I'. DTSCS89
|
|
00187 88 REQ-CLEAR VALUE 'C'. DTSCS89
|
|
00188 88 REQ-EDIT VALUE 'E'. DTSCS89
|
|
00189 88 REQ-UPDATE VALUE 'U'. DTSCS89
|
|
00190 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS89
|
|
00191 SKIP1 DTSCS89
|
|
00192 05 RESP-IND PIC X(01). DTSCS89
|
|
00193 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS89
|
|
00194 88 RESP-SEND-MAP VALUE 'M'. DTSCS89
|
|
00195 88 RESP-JUMP VALUE 'J'. DTSCS89
|
|
00196 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS89
|
|
00197 SKIP1 DTSCS89
|
|
00198 05 WRK-NEW-KEY-IND PIC X(01). DTSCS89
|
|
00199 SKIP1 DTSCS89
|
|
00200 05 WRK-MSG-ID PIC X(04). DTSCS89
|
|
00201 SKIP1 DTSCS89
|
|
00202 05 WRK-ATB-AN PIC X(01). DTSCS89
|
|
00203 05 WRK-ATB-NUM PIC X(01). DTSCS89
|
|
00204 EJECT DTSCS89
|
|
00205 01 L001-COMM-AREA. DTSCS89
|
|
00206 ++INCLUDE DTSIL001 DTSCS89
|
|
00207 EJECT DTSCS89
|
|
00208 01 L004-COMM-AREA. DTSCS89
|
|
00209 ++INCLUDE DTSIL004 DTSCS89
|
|
00210 EJECT DTSCS89
|
|
00211 01 L015-COMM-AREA. DTSCS89
|
|
00212 ++INCLUDE DTSIL015 DTSCS89
|
|
00213 EJECT DTSCS89
|
|
00214 01 L007-COMM-AREA. DTSCS89
|
|
00215 ++INCLUDE DTSIL007 DTSCS89
|
|
00216 EJECT DTSCS89
|
|
00217 01 L016-COMM-AREA. DTSCS89
|
|
00218 ++INCLUDE DTSIL016 DTSCS89
|
|
00219 EJECT DTSCS89
|
|
00220 * ERROR MSG MODULE DTSCS89
|
|
00221 01 L805-COMM-AREA. DTSCS89
|
|
00222 ++INCLUDE DTSIL805 DTSCS89
|
|
00223 EJECT DTSCS89
|
|
00224 * REFERENCE FILE I-O LINKAGE DTSCS89
|
|
00225 01 L831-COMM-AREA. DTSCS89
|
|
00226 05 L831-CONTROL-BLOCK. DTSCS89
|
|
00227 ++INCLUDE DTSIL831 DTSCS89
|
|
00228 EJECT DTSCS89
|
|
00229 * COMMON SKELETAL RECORD DTSCS89
|
|
00230 05 FCOMM-REC. DTSCS89
|
|
00231 ++INCLUDE DTSIFSKL DTSCS89
|
|
00232 EJECT DTSCS89
|
|
00233 * CALENDAR YEAR RECORD LAYOUT DTSCS89
|
|
00234 05 FAFD-REC REDEFINES FCOMM-REC. DTSCS89
|
|
00235 ++INCLUDE DTSIFAFD DTSCS89
|
|
00236 EJECT DTSCS89
|
|
00237 * MAP DEFINITION DTSCS89
|
|
00238 01 L851-COMM-AREA. DTSCS89
|
|
00239 ++INCLUDE DTSIL851 DTSCS89
|
|
00240 SKIP3 DTSCS89
|
|
00241 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS89
|
|
00242 ++INCLUDE DTSIS89 DTSCS89
|
|
00243 EJECT DTSCS89
|
|
00244 * ATTRIBUTE LITERALS DTSCS89
|
|
00245 01 CATB-LITERALS. DTSCS89
|
|
00246 ++INCLUDE DTSICATB DTSCS89
|
|
00247 SKIP3 DTSCS89
|
|
00248 * FUNCTION KEY DESCRIPTION LITERALS DTSCS89
|
|
00249 01 CFKD-LITERALS. DTSCS89
|
|
00250 ++INCLUDE DTSICFKD DTSCS89
|
|
00251 SKIP3 DTSCS89
|
|
00252 * ERROR CODE MESSAGE LITERALS DTSCS89
|
|
00253 01 CECD-LITERALS. DTSCS89
|
|
00254 ++INCLUDE DTSICECD DTSCS89
|
|
00255 SKIP3 DTSCS89
|
|
00256 * PROMPT CODE MESSAGE LITERALS DTSCS89
|
|
00257 01 CPCD-LITERALS. DTSCS89
|
|
00258 ++INCLUDE DTSICPCD DTSCS89
|
|
00259 EJECT DTSCS89
|
|
00260 LINKAGE SECTION. DTSCS89
|
|
00261 SKIP3 DTSCS89
|
|
00262 01 DFHCOMMAREA. DTSCS89
|
|
00263 ++INCLUDE DTSILCCM DTSCS89
|
|
00264 SKIP3 DTSCS89
|
|
00265 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS89
|
|
00266 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS89
|
|
00267 EJECT DTSCS89
|
|
00268 ******************************************************************DTSCS89
|
|
00269 * *DTSCS89
|
|
00270 ******************************************************************DTSCS89
|
|
00271 SKIP1 DTSCS89
|
|
00272 PROCEDURE DIVISION. DTSCS89
|
|
00273 SKIP2 DTSCS89
|
|
00274 SET CURSOR-SET-NO TO TRUE. DTSCS89
|
|
00275 SKIP1 DTSCS89
|
|
00276 MOVE LOW-VALUES TO MAP-AREA. DTSCS89
|
|
00277 SKIP1 DTSCS89
|
|
00278 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS89
|
|
00279 TO SCR-ACCESS-IND. DTSCS89
|
|
00280 SKIP3 DTSCS89
|
|
00281 MOVE SPACE TO REQ-IND. DTSCS89
|
|
00282 SKIP1 DTSCS89
|
|
00283 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS89
|
|
00284 SKIP1 DTSCS89
|
|
00285 *----------------------------------------------------- DTSCS89
|
|
00286 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS89
|
|
00287 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS89
|
|
00288 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS89
|
|
00289 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS89
|
|
00290 * DTSCS89
|
|
00291 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS89
|
|
00292 * PROCESSED. DTSCS89
|
|
00293 * DTSCS89
|
|
00294 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS89
|
|
00295 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS89
|
|
00296 * WORK STATION OPERATOR. DTSCS89
|
|
00297 *----------------------------------------------------- DTSCS89
|
|
00298 SKIP1 DTSCS89
|
|
00299 MOVE SPACE TO RESP-IND. DTSCS89
|
|
00300 SKIP1 DTSCS89
|
|
00301 IF REQ-ERROR DTSCS89
|
|
00302 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS89
|
|
00303 ELSE DTSCS89
|
|
00304 IF REQ-JUMP DTSCS89
|
|
00305 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS89
|
|
00306 ELSE DTSCS89
|
|
00307 IF REQ-CLEAR DTSCS89
|
|
00308 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS89
|
|
00309 ELSE DTSCS89
|
|
00310 IF REQ-CURSOR-TO-GOTO DTSCS89
|
|
00311 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS89
|
|
00312 ELSE DTSCS89
|
|
00313 IF REQ-INQUIRE DTSCS89
|
|
00314 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS89
|
|
00315 ELSE DTSCS89
|
|
00316 IF REQ-EDIT DTSCS89
|
|
00317 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS89
|
|
00318 ELSE DTSCS89
|
|
00319 IF REQ-UPDATE DTSCS89
|
|
00320 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS89
|
|
00321 ELSE DTSCS89
|
|
00322 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89
|
|
00323 SKIP3 DTSCS89
|
|
00324 *----------------------------------------------------- DTSCS89
|
|
00325 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS89
|
|
00326 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS89
|
|
00327 *----------------------------------------------------- DTSCS89
|
|
00328 SKIP1 DTSCS89
|
|
00329 IF RESP-SEND-MAP DTSCS89
|
|
00330 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS89
|
|
00331 SET LCCM-END-TASK-88 TO TRUE DTSCS89
|
|
00332 ELSE DTSCS89
|
|
00333 IF RESP-SEND-MSGONLY DTSCS89
|
|
00334 OR RESP-CURSOR-TO-GOTO DTSCS89
|
|
00335 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS89
|
|
00336 SET LCCM-END-TASK-88 TO TRUE DTSCS89
|
|
00337 ELSE DTSCS89
|
|
00338 IF RESP-JUMP DTSCS89
|
|
00339 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS89
|
|
00340 ELSE DTSCS89
|
|
00341 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89
|
|
00342 SKIP3 DTSCS89
|
|
00343 MAINLINE-EXIT. DTSCS89
|
|
00344 SKIP1 DTSCS89
|
|
00345 EXEC CICS DTSCS89
|
|
00346 RETURN DTSCS89
|
|
00347 END-EXEC. DTSCS89
|
|
00348 SKIP2 DTSCS89
|
|
00349 GOBACK. DTSCS89
|
|
00350 /*****************************************************************DTSCS89
|
|
00351 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS89
|
|
00352 ******************************************************************DTSCS89
|
|
00353 P1000-ANALYZE-REQUEST. DTSCS89
|
|
00354 SKIP1 DTSCS89
|
|
00355 *----------------------------------------------------- DTSCS89
|
|
00356 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS89
|
|
00357 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS89
|
|
00358 * REPLACED WITH ENTER) DTSCS89
|
|
00359 *----------------------------------------------------- DTSCS89
|
|
00360 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS89
|
|
00361 SET LCCM-ENTER-88 TO TRUE DTSCS89
|
|
00362 SET REQ-CLEAR TO TRUE DTSCS89
|
|
00363 GO TO P1000-EXIT. DTSCS89
|
|
00364 SKIP3 DTSCS89
|
|
00365 *----------------------------------------------------- DTSCS89
|
|
00366 * MAP IS RECEIVED DTSCS89
|
|
00367 *----------------------------------------------------- DTSCS89
|
|
00368 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS89
|
|
00369 SKIP3 DTSCS89
|
|
00370 *----------------------------------------------------- DTSCS89
|
|
00371 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS89
|
|
00372 * WORK STATION DTSCS89
|
|
00373 *----------------------------------------------------- DTSCS89
|
|
00374 IF LCCM-CLEAR-88 DTSCS89
|
|
00375 SET REQ-CLEAR TO TRUE DTSCS89
|
|
00376 GO TO P1000-EXIT. DTSCS89
|
|
00377 SKIP3 DTSCS89
|
|
00378 *----------------------------------------------------- DTSCS89
|
|
00379 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS89
|
|
00380 *----------------------------------------------------- DTSCS89
|
|
00381 IF LCCM-SCR-UPDATE-LOCKED DTSCS89
|
|
00382 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS89
|
|
00383 GO TO P1000-EXIT. DTSCS89
|
|
00384 SKIP3 DTSCS89
|
|
00385 *----------------------------------------------------- DTSCS89
|
|
00386 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS89
|
|
00387 *----------------------------------------------------- DTSCS89
|
|
00388 IF LCCM-PA2-88 DTSCS89
|
|
00389 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS89
|
|
00390 GO TO P1000-EXIT. DTSCS89
|
|
00391 SKIP3 DTSCS89
|
|
00392 *----------------------------------------------------- DTSCS89
|
|
00393 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS89
|
|
00394 *----------------------------------------------------- DTSCS89
|
|
00395 IF LCCM-PA-88 DTSCS89
|
|
00396 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS89
|
|
00397 SET REQ-ERROR TO TRUE DTSCS89
|
|
00398 GO TO P1000-EXIT. DTSCS89
|
|
00399 SKIP3 DTSCS89
|
|
00400 *----------------------------------------------------- DTSCS89
|
|
00401 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS89
|
|
00402 * REQUEST TO CLEAR THE SCREEN. DTSCS89
|
|
00403 *----------------------------------------------------- DTSCS89
|
|
00404 IF LCCM-F12-88 DTSCS89
|
|
00405 MOVE LOW-VALUES TO MAP-AREA DTSCS89
|
|
00406 SET REQ-CLEAR TO TRUE DTSCS89
|
|
00407 GO TO P1000-EXIT. DTSCS89
|
|
00408 SKIP3 DTSCS89
|
|
00409 *----------------------------------------------------- DTSCS89
|
|
00410 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS89
|
|
00411 *----------------------------------------------------- DTSCS89
|
|
00412 IF LCCM-F03-88 DTSCS89
|
|
00413 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89
|
|
00414 SET REQ-JUMP TO TRUE DTSCS89
|
|
00415 GO TO P1000-EXIT. DTSCS89
|
|
00416 SKIP3 DTSCS89
|
|
00417 *----------------------------------------------------- DTSCS89
|
|
00418 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS89
|
|
00419 *----------------------------------------------------- DTSCS89
|
|
00420 IF LCCM-F04-88 DTSCS89
|
|
00421 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89
|
|
00422 SET REQ-JUMP TO TRUE DTSCS89
|
|
00423 GO TO P1000-EXIT. DTSCS89
|
|
00424 SKIP3 DTSCS89
|
|
00425 *----------------------------------------------------- DTSCS89
|
|
00426 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS89
|
|
00427 * CORRESPONDENCE SCREEN DTSCS89
|
|
00428 *----------------------------------------------------- DTSCS89
|
|
00429 IF LCCM-F14-88 DTSCS89
|
|
00430 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89
|
|
00431 SET REQ-JUMP TO TRUE DTSCS89
|
|
00432 GO TO P1000-EXIT. DTSCS89
|
|
00433 SKIP3 DTSCS89
|
|
00434 *----------------------------------------------------- DTSCS89
|
|
00435 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS89
|
|
00436 * REQUESTED SCREEN TYPE DTSCS89
|
|
00437 *----------------------------------------------------- DTSCS89
|
|
00438 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS89
|
|
00439 NEXT SENTENCE DTSCS89
|
|
00440 ELSE DTSCS89
|
|
00441 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS89
|
|
00442 SET REQ-JUMP TO TRUE DTSCS89
|
|
00443 GO TO P1000-EXIT. DTSCS89
|
|
00444 SKIP3 DTSCS89
|
|
00445 *----------------------------------------------------- DTSCS89
|
|
00446 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS89
|
|
00447 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS89
|
|
00448 *----------------------------------------------------- DTSCS89
|
|
00449 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS89
|
|
00450 IF SCR-ACCESS-UPDATE DTSCS89
|
|
00451 SET REQ-EDIT TO TRUE DTSCS89
|
|
00452 GO TO P1000-EXIT DTSCS89
|
|
00453 ELSE DTSCS89
|
|
00454 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS89
|
|
00455 SET REQ-ERROR TO TRUE DTSCS89
|
|
00456 GO TO P1000-EXIT. DTSCS89
|
|
00457 SKIP3 DTSCS89
|
|
00458 *----------------------------------------------------- DTSCS89
|
|
00459 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS89
|
|
00460 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS89
|
|
00461 *----------------------------------------------------- DTSCS89
|
|
00462 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS89
|
|
00463 SET REQ-INQUIRE TO TRUE DTSCS89
|
|
00464 GO TO P1000-EXIT. DTSCS89
|
|
00465 SKIP3 DTSCS89
|
|
00466 *----------------------------------------------------- DTSCS89
|
|
00467 * ANY OTHER KEY IS INVALID DTSCS89
|
|
00468 *----------------------------------------------------- DTSCS89
|
|
00469 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS89
|
|
00470 SET REQ-ERROR TO TRUE. DTSCS89
|
|
00471 P1000-EXIT. DTSCS89
|
|
00472 EXIT. DTSCS89
|
|
00473 SKIP3 DTSCS89
|
|
00474 ******************************************************************DTSCS89
|
|
00475 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS89
|
|
00476 ******************************************************************DTSCS89
|
|
00477 SKIP1 DTSCS89
|
|
00478 P1100-UPDATE-LOCKED. DTSCS89
|
|
00479 *----------------------------------------------------- DTSCS89
|
|
00480 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS89
|
|
00481 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS89
|
|
00482 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS89
|
|
00483 *----------------------------------------------------- DTSCS89
|
|
00484 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS89
|
|
00485 SET REQ-UPDATE TO TRUE DTSCS89
|
|
00486 ELSE DTSCS89
|
|
00487 SET REQ-ERROR TO TRUE DTSCS89
|
|
00488 IF LCCM-SCR-ADD-LOCKED DTSCS89
|
|
00489 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS89
|
|
00490 ELSE DTSCS89
|
|
00491 IF LCCM-SCR-MOD-LOCKED DTSCS89
|
|
00492 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS89
|
|
00493 ELSE DTSCS89
|
|
00494 IF LCCM-SCR-DEL-LOCKED DTSCS89
|
|
00495 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS89
|
|
00496 ELSE DTSCS89
|
|
00497 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89
|
|
00498 P1100-EXIT. DTSCS89
|
|
00499 EXIT. DTSCS89
|
|
00500 /*****************************************************************DTSCS89
|
|
00501 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS89
|
|
00502 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS89
|
|
00503 ******************************************************************DTSCS89
|
|
00504 SKIP1 DTSCS89
|
|
00505 P2000-REQUEST-ERROR. DTSCS89
|
|
00506 IF LCCM-MSG DTSCS89
|
|
00507 SET RESP-SEND-MSGONLY TO TRUE DTSCS89
|
|
00508 ELSE DTSCS89
|
|
00509 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89
|
|
00510 P2000-EXIT. DTSCS89
|
|
00511 EXIT. DTSCS89
|
|
00512 /*****************************************************************DTSCS89
|
|
00513 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS89
|
|
00514 ******************************************************************DTSCS89
|
|
00515 SKIP1 DTSCS89
|
|
00516 P3000-REQUEST-JUMP. DTSCS89
|
|
00517 *----------------------------------------------------- DTSCS89
|
|
00518 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS89
|
|
00519 * BY USER DTSCS89
|
|
00520 *----------------------------------------------------- DTSCS89
|
|
00521 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS89
|
|
00522 SKIP3 DTSCS89
|
|
00523 *----------------------------------------------------- DTSCS89
|
|
00524 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS89
|
|
00525 *----------------------------------------------------- DTSCS89
|
|
00526 IF LCCM-MSG DTSCS89
|
|
00527 SET RESP-SEND-MSGONLY TO TRUE DTSCS89
|
|
00528 SET CURSOR-SET-GOTO TO TRUE DTSCS89
|
|
00529 GO TO P3000-EXIT. DTSCS89
|
|
00530 SKIP3 DTSCS89
|
|
00531 *----------------------------------------------------- DTSCS89
|
|
00532 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS89
|
|
00533 *----------------------------------------------------- DTSCS89
|
|
00534 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS89
|
|
00535 LCCM-SCR-HOLD-AREA. DTSCS89
|
|
00536 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS89
|
|
00537 SET RESP-JUMP TO TRUE. DTSCS89
|
|
00538 P3000-EXIT. DTSCS89
|
|
00539 EXIT. DTSCS89
|
|
00540 /*****************************************************************DTSCS89
|
|
00541 * CLEAR KEY WAS PRESSED *DTSCS89
|
|
00542 ******************************************************************DTSCS89
|
|
00543 SKIP1 DTSCS89
|
|
00544 P4000-REQUEST-CLEAR. DTSCS89
|
|
00545 IF SCR-ACCESS-UPDATE DTSCS89
|
|
00546 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS89
|
|
00547 ELSE DTSCS89
|
|
00548 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS89
|
|
00549 SKIP3 DTSCS89
|
|
00550 *----------------------------------------------------- DTSCS89
|
|
00551 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS89
|
|
00552 * FIELDS FROM EARLIER REQUESTS DTSCS89
|
|
00553 *----------------------------------------------------- DTSCS89
|
|
00554 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS89
|
|
00555 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89
|
|
00556 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89
|
|
00557 SET RESP-SEND-MAP TO TRUE. DTSCS89
|
|
00558 P4000-EXIT. DTSCS89
|
|
00559 EXIT. DTSCS89
|
|
00560 /*****************************************************************DTSCS89
|
|
00561 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS89
|
|
00562 ******************************************************************DTSCS89
|
|
00563 SKIP1 DTSCS89
|
|
00564 P5000-CURSOR-TO-GOTO. DTSCS89
|
|
00565 SET CURSOR-SET-GOTO TO TRUE. DTSCS89
|
|
00566 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS89
|
|
00567 P5000-EXIT. DTSCS89
|
|
00568 EXIT. DTSCS89
|
|
00569 /*****************************************************************DTSCS89
|
|
00570 * INQUIRY WAS REQUESTED *DTSCS89
|
|
00571 ******************************************************************DTSCS89
|
|
00572 SKIP1 DTSCS89
|
|
00573 P6000-REQUEST-INQUIRE. DTSCS89
|
|
00574 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCS89
|
|
00575 SET FAFD-AFD-88 TO TRUE. DTSCS89
|
|
00576 SKIP1 DTSCS89
|
|
00577 MOVE MAP-YR TO L007-YR-2-X. DTSCS89
|
|
00578 MOVE LOW-VALUES TO MAP-AREA. DTSCS89
|
|
00579 MOVE L007-YR-2-X TO MAP-YR. DTSCS89
|
|
00580 IF MAP-YR = LOW-VALUES OR SPACES DTSCS89
|
|
00581 MOVE +0 TO FAFD-YR DTSCS89
|
|
00582 ELSE DTSCS89
|
|
00583 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT DTSCS89
|
|
00584 IF L007-VALID-YR AND DTSCS89
|
|
00585 L007-YR-2-9 > WRK-ANN-START-YR DTSCS89
|
|
00586 MOVE L007-YR-4-9 TO FAFD-YR DTSCS89
|
|
00587 ELSE DTSCS89
|
|
00588 MOVE +0 TO FAFD-YR DTSCS89
|
|
00589 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
00590 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89
|
|
00591 DTSCS89
|
|
00592 IF LCCM-SCR-INQUIRE DTSCS89
|
|
00593 AND FAFD-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS89
|
|
00594 MOVE 'N' TO WRK-NEW-KEY-IND DTSCS89
|
|
00595 ELSE DTSCS89
|
|
00596 MOVE 'Y' TO WRK-NEW-KEY-IND. DTSCS89
|
|
00597 SKIP1 DTSCS89
|
|
00598 IF SCR-ACCESS-UPDATE DTSCS89
|
|
00599 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS89
|
|
00600 ELSE DTSCS89
|
|
00601 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS89
|
|
00602 SKIP1 DTSCS89
|
|
00603 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89
|
|
00604 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89
|
|
00605 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89
|
|
00606 SKIP1 DTSCS89
|
|
00607 IF LCCM-MSG DTSCS89
|
|
00608 NEXT SENTENCE DTSCS89
|
|
00609 ELSE DTSCS89
|
|
00610 IF LCCM-ENTER-88 DTSCS89
|
|
00611 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS89
|
|
00612 ELSE DTSCS89
|
|
00613 IF LCCM-F07-88 DTSCS89
|
|
00614 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS89
|
|
00615 ELSE DTSCS89
|
|
00616 IF LCCM-F08-88 DTSCS89
|
|
00617 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS89
|
|
00618 ELSE DTSCS89
|
|
00619 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89
|
|
00620 SKIP1 DTSCS89
|
|
00621 SET RESP-SEND-MAP TO TRUE. DTSCS89
|
|
00622 P6000-EXIT. DTSCS89
|
|
00623 EXIT. DTSCS89
|
|
00624 EJECT DTSCS89
|
|
00625 P6100-NO-PAGE. DTSCS89
|
|
00626 IF L007-NOT-VALID-YR DTSCS89
|
|
00627 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS89
|
|
00628 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00629 GO TO P6100-EXIT. DTSCS89
|
|
00630 SKIP1 DTSCS89
|
|
00631 PERFORM S831-READ THRU S831-EXIT. DTSCS89
|
|
00632 IF L831-NO-REC-88 DTSCS89
|
|
00633 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00634 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00635 GO TO P6100-EXIT. DTSCS89
|
|
00636 SKIP1 DTSCS89
|
|
00637 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89
|
|
00638 P6100-EXIT. DTSCS89
|
|
00639 EXIT. DTSCS89
|
|
00640 EJECT DTSCS89
|
|
00641 P6200-PAGE-BACK. DTSCS89
|
|
00642 MOVE FAFD-KEY-AREA TO WRK-KEY-AREA. DTSCS89
|
|
00643 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS89
|
|
00644 IF L831-NO-REC-88 DTSCS89
|
|
00645 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00646 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00647 GO TO P6200-EXIT. DTSCS89
|
|
00648 SKIP1 DTSCS89
|
|
00649 IF (WRK-NEW-KEY-IND = 'Y') DTSCS89
|
|
00650 AND DTSCS89
|
|
00651 (WRK-KEY-AREA = FAFD-KEY-AREA) DTSCS89
|
|
00652 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89
|
|
00653 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89
|
|
00654 GO TO P6200-EXIT. DTSCS89
|
|
00655 SKIP1 DTSCS89
|
|
00656 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS89
|
|
00657 IF L831-NO-REC-88 DTSCS89
|
|
00658 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00659 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00660 GO TO P6200-EXIT. DTSCS89
|
|
00661 SKIP1 DTSCS89
|
|
00662 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS89
|
|
00663 IF L831-NO-REC-88 DTSCS89
|
|
00664 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89
|
|
00665 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS89
|
|
00666 ELSE DTSCS89
|
|
00667 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89
|
|
00668 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89
|
|
00669 P6200-EXIT. DTSCS89
|
|
00670 EXIT. DTSCS89
|
|
00671 EJECT DTSCS89
|
|
00672 P6300-PAGE-NEXT. DTSCS89
|
|
00673 MOVE FAFD-KEY-AREA TO WRK-KEY-AREA. DTSCS89
|
|
00674 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS89
|
|
00675 IF L831-NO-REC-88 DTSCS89
|
|
00676 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00677 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00678 GO TO P6300-EXIT. DTSCS89
|
|
00679 SKIP1 DTSCS89
|
|
00680 IF (WRK-NEW-KEY-IND = 'N') DTSCS89
|
|
00681 AND DTSCS89
|
|
00682 (WRK-KEY-AREA = FAFD-KEY-AREA) DTSCS89
|
|
00683 NEXT SENTENCE DTSCS89
|
|
00684 ELSE DTSCS89
|
|
00685 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89
|
|
00686 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89
|
|
00687 GO TO P6300-EXIT. DTSCS89
|
|
00688 SKIP1 DTSCS89
|
|
00689 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS89
|
|
00690 IF L831-NO-REC-88 DTSCS89
|
|
00691 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89
|
|
00692 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS89
|
|
00693 ELSE DTSCS89
|
|
00694 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89
|
|
00695 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89
|
|
00696 P6300-EXIT. DTSCS89
|
|
00697 EXIT. DTSCS89
|
|
00698 /*****************************************************************DTSCS89
|
|
00699 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS89
|
|
00700 ******************************************************************DTSCS89
|
|
00701 SKIP1 DTSCS89
|
|
00702 P6900-CONSTRUCT-SCREEN. DTSCS89
|
|
00703 PERFORM S007-CONVERT-FAFD-YR THROUGH S007-EXIT. DTSCS89
|
|
00704 IF L007-VALID-YR DTSCS89
|
|
00705 MOVE L007-YR-2-X TO MAP-YR DTSCS89
|
|
00706 ELSE DTSCS89
|
|
00707 GO TO S899-ABEND. DTSCS89
|
|
00708 * SKIP1 DTSCS89
|
|
00709 IF FAFD-UC30H-MASS-MAIL-DATE NOT = +0 DTSCS89
|
|
00710 MOVE FAFD-UC30H-MASS-MAIL-DATE TO WRK-DISP-DATE DTSCS89
|
|
00711 MOVE WRK-DISP-MM TO MAP-UC30H-MASS-MAIL-MM DTSCS89
|
|
00712 MOVE WRK-DISP-DD TO MAP-UC30H-MASS-MAIL-DD DTSCS89
|
|
00713 MOVE WRK-DISP-YY TO MAP-UC30H-MASS-MAIL-YY. DTSCS89
|
|
00714 * SKIP1 DTSCS89
|
|
00715 IF FAFD-UC30H-RPT-DUE-DATE NOT = +0 DTSCS89
|
|
00716 MOVE FAFD-UC30H-RPT-DUE-DATE TO WRK-DISP-DATE DTSCS89
|
|
00717 MOVE WRK-DISP-MM TO MAP-UC30H-RPT-DUE-MM DTSCS89
|
|
00718 MOVE WRK-DISP-DD TO MAP-UC30H-RPT-DUE-DD DTSCS89
|
|
00719 MOVE WRK-DISP-YY TO MAP-UC30H-RPT-DUE-YY. DTSCS89
|
|
00720 SKIP1 DTSCS89
|
|
00721 IF FAFD-LATE-PEN-ASSESSED-DATE NOT = +0 DTSCS89
|
|
00722 MOVE FAFD-LATE-PEN-ASSESSED-DATE TO WRK-DISP-DATE DTSCS89
|
|
00723 MOVE WRK-DISP-MM TO MAP-LATE-PEN-ASSESSED-MM DTSCS89
|
|
00724 MOVE WRK-DISP-DD TO MAP-LATE-PEN-ASSESSED-DD DTSCS89
|
|
00725 MOVE WRK-DISP-YY TO MAP-LATE-PEN-ASSESSED-YY. DTSCS89
|
|
00726 SKIP1 DTSCS89
|
|
00727 IF FAFD-UC30H-FIRST-DEL-DATE NOT = +0 DTSCS89
|
|
00728 MOVE FAFD-UC30H-FIRST-DEL-DATE TO WRK-DISP-DATE DTSCS89
|
|
00729 MOVE WRK-DISP-MM TO MAP-UC30H-FIRST-DEL-MM DTSCS89
|
|
00730 MOVE WRK-DISP-DD TO MAP-UC30H-FIRST-DEL-DD DTSCS89
|
|
00731 MOVE WRK-DISP-YY TO MAP-UC30H-FIRST-DEL-YY. DTSCS89
|
|
00732 SKIP1 DTSCS89
|
|
00733 IF FAFD-UC30H-ESTIMATED-DATE NOT = +0 CL**2
|
|
00734 MOVE FAFD-UC30H-ESTIMATED-DATE TO WRK-DISP-DATE CL**2
|
|
00735 MOVE WRK-DISP-MM TO MAP-UC30H-ESTIMATED-MM CL**2
|
|
00736 MOVE WRK-DISP-DD TO MAP-UC30H-ESTIMATED-DD CL**2
|
|
00737 MOVE WRK-DISP-YY TO MAP-UC30H-ESTIMATED-YY. CL**2
|
|
00738 SKIP1 DTSCS89
|
|
00739 IF FAFD-UC30H-FINAL-ACTION-DATE NOT = +0 DTSCS89
|
|
00740 MOVE FAFD-UC30H-FINAL-ACTION-DATE TO WRK-DISP-DATE DTSCS89
|
|
00741 MOVE WRK-DISP-MM TO MAP-UC30H-FINAL-ACTION-MM DTSCS89
|
|
00742 MOVE WRK-DISP-DD TO MAP-UC30H-FINAL-ACTION-DD DTSCS89
|
|
00743 MOVE WRK-DISP-YY TO MAP-UC30H-FINAL-ACTION-YY. DTSCS89
|
|
00744 SKIP1 DTSCS89
|
|
00745 IF FAFD-ESTB-DATE NOT = +0 DTSCS89
|
|
00746 MOVE FAFD-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS89
|
|
00747 SET L001-FROM-FED-8 TO TRUE DTSCS89
|
|
00748 PERFORM S001-DATE THRU S001-EXIT DTSCS89
|
|
00749 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS89
|
|
00750 SKIP1 DTSCS89
|
|
00751 IF FAFD-CHNG-DATE NOT = +0 DTSCS89
|
|
00752 MOVE FAFD-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS89
|
|
00753 SET L001-FROM-FED-8 TO TRUE DTSCS89
|
|
00754 PERFORM S001-DATE THRU S001-EXIT DTSCS89
|
|
00755 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS89
|
|
00756 SKIP1 DTSCS89
|
|
00757 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89
|
|
00758 MOVE FAFD-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS89
|
|
00759 P6900-EXIT. DTSCS89
|
|
00760 EXIT. DTSCS89
|
|
00761 /*****************************************************************DTSCS89
|
|
00762 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS89
|
|
00763 ******************************************************************DTSCS89
|
|
00764 SKIP1 DTSCS89
|
|
00765 P7000-REQUEST-EDIT. DTSCS89
|
|
00766 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89
|
|
00767 SKIP1 DTSCS89
|
|
00768 IF LCCM-F09-88 DTSCS89
|
|
00769 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS89
|
|
00770 ELSE DTSCS89
|
|
00771 IF LCCM-F10-88 DTSCS89
|
|
00772 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS89
|
|
00773 ELSE DTSCS89
|
|
00774 IF LCCM-F23-88 DTSCS89
|
|
00775 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS89
|
|
00776 ELSE DTSCS89
|
|
00777 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89
|
|
00778 SKIP3 DTSCS89
|
|
00779 *------------------------------------------------------ DTSCS89
|
|
00780 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS89
|
|
00781 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS89
|
|
00782 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS89
|
|
00783 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS89
|
|
00784 *------------------------------------------------------ DTSCS89
|
|
00785 SKIP1 DTSCS89
|
|
00786 IF LCCM-MSG DTSCS89
|
|
00787 NEXT SENTENCE DTSCS89
|
|
00788 ELSE DTSCS89
|
|
00789 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS89
|
|
00790 IF LCCM-F09-88 DTSCS89
|
|
00791 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS89
|
|
00792 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS89
|
|
00793 ELSE DTSCS89
|
|
00794 IF LCCM-F10-88 DTSCS89
|
|
00795 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS89
|
|
00796 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS89
|
|
00797 ELSE DTSCS89
|
|
00798 IF LCCM-F23-88 DTSCS89
|
|
00799 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS89
|
|
00800 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS89
|
|
00801 SKIP1 DTSCS89
|
|
00802 SET RESP-SEND-MAP TO TRUE. DTSCS89
|
|
00803 P7000-EXIT. DTSCS89
|
|
00804 EXIT. DTSCS89
|
|
00805 /*****************************************************************DTSCS89
|
|
00806 * ADD FUNCTION WAS REQUESTED *DTSCS89
|
|
00807 ******************************************************************DTSCS89
|
|
00808 SKIP1 DTSCS89
|
|
00809 P7100-EDIT-ADD. DTSCS89
|
|
00810 *------------------------------------------------------ DTSCS89
|
|
00811 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS89
|
|
00812 *------------------------------------------------------ DTSCS89
|
|
00813 IF NOT LCCM-SCR-CLEAR DTSCS89
|
|
00814 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS89
|
|
00815 GO TO P7100-EXIT. DTSCS89
|
|
00816 SKIP1 DTSCS89
|
|
00817 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS89
|
|
00818 SKIP1 DTSCS89
|
|
00819 IF LCCM-NO-MSG DTSCS89
|
|
00820 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89
|
|
00821 IF L831-OK-88 DTSCS89
|
|
00822 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS89
|
|
00823 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00824 ELSE DTSCS89
|
|
00825 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS89
|
|
00826 P7100-EXIT. DTSCS89
|
|
00827 EXIT. DTSCS89
|
|
00828 /*****************************************************************DTSCS89
|
|
00829 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS89
|
|
00830 ******************************************************************DTSCS89
|
|
00831 SKIP1 DTSCS89
|
|
00832 P7200-EDIT-MOD. DTSCS89
|
|
00833 *----------------------------------------------------- DTSCS89
|
|
00834 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS89
|
|
00835 * INQUIRED DTSCS89
|
|
00836 *----------------------------------------------------- DTSCS89
|
|
00837 IF NOT LCCM-SCR-INQUIRE DTSCS89
|
|
00838 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS89
|
|
00839 GO TO P7200-EXIT. DTSCS89
|
|
00840 SKIP3 DTSCS89
|
|
00841 *----------------------------------------------------- DTSCS89
|
|
00842 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS89
|
|
00843 *----------------------------------------------------- DTSCS89
|
|
00844 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS89
|
|
00845 MOVE MAP-YR TO L007-YR-2-X. DTSCS89
|
|
00846 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89
|
|
00847 IF L007-NOT-VALID-YR DTSCS89
|
|
00848 OR L007-YR-4-9 NOT = WRK-YR DTSCS89
|
|
00849 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS89
|
|
00850 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00851 GO TO P7200-EXIT. DTSCS89
|
|
00852 SKIP1 DTSCS89
|
|
00853 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS89
|
|
00854 SKIP1 DTSCS89
|
|
00855 IF LCCM-NO-MSG DTSCS89
|
|
00856 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89
|
|
00857 IF L831-NO-REC-88 DTSCS89
|
|
00858 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00859 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00860 ELSE DTSCS89
|
|
00861 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS89
|
|
00862 P7200-EXIT. DTSCS89
|
|
00863 EXIT. DTSCS89
|
|
00864 /*****************************************************************DTSCS89
|
|
00865 * DELETE FUNCTION WAS REQUESTED *DTSCS89
|
|
00866 ******************************************************************DTSCS89
|
|
00867 SKIP1 DTSCS89
|
|
00868 P7300-EDIT-DEL. DTSCS89
|
|
00869 *----------------------------------------------------- DTSCS89
|
|
00870 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS89
|
|
00871 * INQUIRED DTSCS89
|
|
00872 *----------------------------------------------------- DTSCS89
|
|
00873 IF NOT LCCM-SCR-INQUIRE DTSCS89
|
|
00874 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS89
|
|
00875 GO TO P7300-EXIT. DTSCS89
|
|
00876 SKIP3 DTSCS89
|
|
00877 *----------------------------------------------------- DTSCS89
|
|
00878 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS89
|
|
00879 *----------------------------------------------------- DTSCS89
|
|
00880 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS89
|
|
00881 MOVE MAP-YR TO L007-YR-2-X. DTSCS89
|
|
00882 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89
|
|
00883 IF L007-NOT-VALID-YR DTSCS89
|
|
00884 OR L007-YR-4-9 NOT = WRK-YR DTSCS89
|
|
00885 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS89
|
|
00886 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89
|
|
00887 SKIP1 DTSCS89
|
|
00888 IF LCCM-NO-MSG DTSCS89
|
|
00889 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89
|
|
00890 IF L831-NO-REC-88 DTSCS89
|
|
00891 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00892 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89
|
|
00893 P7300-EXIT. DTSCS89
|
|
00894 EXIT. DTSCS89
|
|
00895 /*****************************************************************DTSCS89
|
|
00896 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS89
|
|
00897 ******************************************************************DTSCS89
|
|
00898 SKIP1 DTSCS89
|
|
00899 P8000-REQUEST-UPDATE. DTSCS89
|
|
00900 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89
|
|
00901 SKIP1 DTSCS89
|
|
00902 IF LCCM-SCR-ADD-LOCKED DTSCS89
|
|
00903 PERFORM P8100-ADD THRU P8100-EXIT DTSCS89
|
|
00904 ELSE DTSCS89
|
|
00905 IF LCCM-SCR-MOD-LOCKED DTSCS89
|
|
00906 PERFORM P8200-MOD THRU P8200-EXIT DTSCS89
|
|
00907 ELSE DTSCS89
|
|
00908 IF LCCM-SCR-DEL-LOCKED DTSCS89
|
|
00909 PERFORM P8300-DEL THRU P8300-EXIT DTSCS89
|
|
00910 ELSE DTSCS89
|
|
00911 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89
|
|
00912 SKIP1 DTSCS89
|
|
00913 SET RESP-SEND-MAP TO TRUE. DTSCS89
|
|
00914 P8000-EXIT. DTSCS89
|
|
00915 EXIT. DTSCS89
|
|
00916 /*****************************************************************DTSCS89
|
|
00917 * *DTSCS89
|
|
00918 ******************************************************************DTSCS89
|
|
00919 SKIP1 DTSCS89
|
|
00920 P8100-ADD. DTSCS89
|
|
00921 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89
|
|
00922 SKIP1 DTSCS89
|
|
00923 IF LCCM-F12-88 DTSCS89
|
|
00924 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS89
|
|
00925 GO TO P8100-EXIT. DTSCS89
|
|
00926 SKIP1 DTSCS89
|
|
00927 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89
|
|
00928 IF L831-OK-88 DTSCS89
|
|
00929 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS89
|
|
00930 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00931 GO TO P8100-EXIT. DTSCS89
|
|
00932 SKIP1 DTSCS89
|
|
00933 MOVE LOW-VALUES TO FAFD-DATA-AREA. DTSCS89
|
|
00934 SKIP1 DTSCS89
|
|
00935 PERFORM P8900-CONSTRUCT-FAFD THRU P8900-EXIT. DTSCS89
|
|
00936 SKIP1 DTSCS89
|
|
00937 MOVE LCCM-CURR-RUN-DATE TO FAFD-ESTB-DATE. DTSCS89
|
|
00938 MOVE LCCM-CURR-RUN-DATE TO FAFD-CHNG-DATE. DTSCS89
|
|
00939 SKIP1 DTSCS89
|
|
00940 PERFORM S831-WRITE THRU S831-EXIT. DTSCS89
|
|
00941 SKIP1 DTSCS89
|
|
00942 MOVE LOW-VALUES TO MAP-AREA. DTSCS89
|
|
00943 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89
|
|
00944 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89
|
|
00945 P8100-EXIT. DTSCS89
|
|
00946 EXIT. DTSCS89
|
|
00947 /*****************************************************************DTSCS89
|
|
00948 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS89
|
|
00949 ******************************************************************DTSCS89
|
|
00950 SKIP1 DTSCS89
|
|
00951 P8200-MOD. DTSCS89
|
|
00952 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89
|
|
00953 SKIP1 DTSCS89
|
|
00954 IF LCCM-F12-88 DTSCS89
|
|
00955 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS89
|
|
00956 GO TO P8200-EXIT. DTSCS89
|
|
00957 SKIP1 DTSCS89
|
|
00958 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89
|
|
00959 IF L831-NO-REC-88 DTSCS89
|
|
00960 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00961 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00962 GO TO P8200-EXIT. DTSCS89
|
|
00963 SKIP1 DTSCS89
|
|
00964 PERFORM P8900-CONSTRUCT-FAFD THRU P8900-EXIT. DTSCS89
|
|
00965 SKIP1 DTSCS89
|
|
00966 MOVE LCCM-CURR-RUN-DATE TO FAFD-CHNG-DATE. DTSCS89
|
|
00967 SKIP1 DTSCS89
|
|
00968 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS89
|
|
00969 SKIP1 DTSCS89
|
|
00970 MOVE FAFD-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS89
|
|
00971 SET L001-FROM-FED-8 TO TRUE. DTSCS89
|
|
00972 PERFORM S001-DATE THRU S001-EXIT. DTSCS89
|
|
00973 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS89
|
|
00974 SKIP1 DTSCS89
|
|
00975 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89
|
|
00976 P8200-EXIT. DTSCS89
|
|
00977 EXIT. DTSCS89
|
|
00978 /*****************************************************************DTSCS89
|
|
00979 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS89
|
|
00980 ******************************************************************DTSCS89
|
|
00981 SKIP1 DTSCS89
|
|
00982 P8300-DEL. DTSCS89
|
|
00983 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89
|
|
00984 SKIP1 DTSCS89
|
|
00985 IF LCCM-F12-88 DTSCS89
|
|
00986 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS89
|
|
00987 GO TO P8300-EXIT. DTSCS89
|
|
00988 SKIP1 DTSCS89
|
|
00989 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89
|
|
00990 IF NOT L831-OK-88 DTSCS89
|
|
00991 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89
|
|
00992 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
00993 GO TO P8300-EXIT. DTSCS89
|
|
00994 SKIP1 DTSCS89
|
|
00995 PERFORM S831-DELETE THRU S831-EXIT. DTSCS89
|
|
00996 SKIP1 DTSCS89
|
|
00997 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89
|
|
00998 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89
|
|
00999 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89
|
|
01000 SKIP1 DTSCS89
|
|
01001 MOVE LOW-VALUES TO MAP-AREA. DTSCS89
|
|
01002 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89
|
|
01003 SKIP1 DTSCS89
|
|
01004 PERFORM S007-CONVERT-FAFD-YR THRU S007-EXIT. DTSCS89
|
|
01005 IF L007-VALID-YR DTSCS89
|
|
01006 MOVE L007-YR-2-X TO MAP-YR DTSCS89
|
|
01007 ELSE DTSCS89
|
|
01008 GO TO S899-ABEND. DTSCS89
|
|
01009 SKIP1 DTSCS89
|
|
01010 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89
|
|
01011 P8300-EXIT. DTSCS89
|
|
01012 EXIT. DTSCS89
|
|
01013 EJECT DTSCS89
|
|
01014 P8900-CONSTRUCT-FAFD. DTSCS89
|
|
01015 SKIP1 DTSCS89
|
|
01016 MOVE MAP-UC30H-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01017 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01018 MOVE L015-DATE TO FAFD-UC30H-MASS-MAIL-DATEDTSCS89
|
|
01019 SKIP1 DTSCS89
|
|
01020 MOVE MAP-UC30H-RPT-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01021 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01022 MOVE L015-DATE TO FAFD-UC30H-RPT-DUE-DATE. DTSCS89
|
|
01023 SKIP1 DTSCS89
|
|
01024 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01025 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01026 MOVE L015-DATE TO FAFD-LATE-PEN-ASSESSED-DATE. DTSCS89
|
|
01027 SKIP1 DTSCS89
|
|
01028 MOVE MAP-UC30H-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01029 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01030 MOVE L015-DATE TO FAFD-UC30H-FIRST-DEL-DATEDTSCS89
|
|
01031 SKIP1 DTSCS89
|
|
01032 MOVE MAP-UC30H-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. CL**2
|
|
01033 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01034 MOVE L015-DATE TO FAFD-UC30H-ESTIMATED-DATE CL**2
|
|
01035 SKIP1 DTSCS89
|
|
01036 MOVE MAP-UC30H-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01037 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01038 MOVE L015-DATE TO FAFD-UC30H-FINAL-ACTION-DATE. DTSCS89
|
|
01039 SKIP1 DTSCS89
|
|
01040 P8900-EXIT. DTSCS89
|
|
01041 EXIT. DTSCS89
|
|
01042 /*****************************************************************DTSCS89
|
|
01043 * LINKS TO UTILITY MODULES DTSCS89
|
|
01044 ******************************************************************DTSCS89
|
|
01045 SKIP1 DTSCS89
|
|
01046 S001-DATE. DTSCS89
|
|
01047 EXEC CICS LINK DTSCS89
|
|
01048 PROGRAM ('DTSCU001') DTSCS89
|
|
01049 COMMAREA (L001-COMM-AREA) DTSCS89
|
|
01050 END-EXEC. DTSCS89
|
|
01051 S001-EXIT. DTSCS89
|
|
01052 EXIT. DTSCS89
|
|
01053 SKIP3 DTSCS89
|
|
01054 S004-YRQ-CONVERT. DTSCS89
|
|
01055 EXEC CICS LINK DTSCS89
|
|
01056 PROGRAM ('DTSCU004') DTSCS89
|
|
01057 COMMAREA (L004-COMM-AREA) DTSCS89
|
|
01058 END-EXEC. DTSCS89
|
|
01059 S004-EXIT. DTSCS89
|
|
01060 EXIT. DTSCS89
|
|
01061 SKIP3 DTSCS89
|
|
01062 S015-DATE-AREA. DTSCS89
|
|
01063 EXEC CICS LINK DTSCS89
|
|
01064 PROGRAM ('DTSCU015') DTSCS89
|
|
01065 COMMAREA (L015-COMM-AREA) DTSCS89
|
|
01066 END-EXEC. DTSCS89
|
|
01067 S015-EXIT. DTSCS89
|
|
01068 EXIT. DTSCS89
|
|
01069 SKIP3 DTSCS89
|
|
01070 S016-YRQ-CONVERT. DTSCS89
|
|
01071 EXEC CICS LINK DTSCS89
|
|
01072 PROGRAM ('DTSCU016') DTSCS89
|
|
01073 COMMAREA (L016-COMM-AREA) DTSCS89
|
|
01074 END-EXEC. DTSCS89
|
|
01075 S016-EXIT. DTSCS89
|
|
01076 EXIT. DTSCS89
|
|
01077 SKIP3 DTSCS89
|
|
01078 S007-CHECK-MAP-YR. DTSCS89
|
|
01079 MOVE MAP-YR TO L007-YR-2-X. DTSCS89
|
|
01080 SET L007-FROM-YR-2 TO TRUE. DTSCS89
|
|
01081 GO TO S007-YR-CONVERT. DTSCS89
|
|
01082 S007-CONVERT-FAFD-YR. DTSCS89
|
|
01083 MOVE FAFD-YR TO L007-YR-4-9. DTSCS89
|
|
01084 SET L007-FROM-YR-4 TO TRUE. DTSCS89
|
|
01085 GO TO S007-YR-CONVERT. DTSCS89
|
|
01086 S007-YR-CONVERT. DTSCS89
|
|
01087 EXEC CICS LINK DTSCS89
|
|
01088 PROGRAM ('DTSCU007') DTSCS89
|
|
01089 COMMAREA (L007-COMM-AREA) DTSCS89
|
|
01090 END-EXEC. DTSCS89
|
|
01091 S007-EXIT. DTSCS89
|
|
01092 EXIT. DTSCS89
|
|
01093 SKIP3 DTSCS89
|
|
01094 S803-REQ-SCR-ID-EDIT. DTSCS89
|
|
01095 EXEC CICS LINK DTSCS89
|
|
01096 PROGRAM ('DTSCU803') DTSCS89
|
|
01097 COMMAREA (DFHCOMMAREA) DTSCS89
|
|
01098 END-EXEC. DTSCS89
|
|
01099 S803-EXIT. DTSCS89
|
|
01100 EXIT. DTSCS89
|
|
01101 SKIP3 DTSCS89
|
|
01102 S804-INVALID-KEY. DTSCS89
|
|
01103 EXEC CICS LINK DTSCS89
|
|
01104 PROGRAM ('DTSCU804') DTSCS89
|
|
01105 COMMAREA (DFHCOMMAREA) DTSCS89
|
|
01106 END-EXEC. DTSCS89
|
|
01107 S804-EXIT. DTSCS89
|
|
01108 EXIT. DTSCS89
|
|
01109 SKIP3 DTSCS89
|
|
01110 S805-MSG-AREA. DTSCS89
|
|
01111 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS89
|
|
01112 SKIP1 DTSCS89
|
|
01113 EXEC CICS LINK DTSCS89
|
|
01114 PROGRAM ('DTSCU805') DTSCS89
|
|
01115 COMMAREA (L805-COMM-AREA) DTSCS89
|
|
01116 END-EXEC. DTSCS89
|
|
01117 SKIP1 DTSCS89
|
|
01118 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS89
|
|
01119 S805-EXIT. DTSCS89
|
|
01120 EXIT. DTSCS89
|
|
01121 EJECT DTSCS89
|
|
01122 S831-READ. DTSCS89
|
|
01123 SET L831-READ-88 TO TRUE. DTSCS89
|
|
01124 GO TO S831-IO. DTSCS89
|
|
01125 SKIP1 DTSCS89
|
|
01126 S831-START-BROWSE. DTSCS89
|
|
01127 SET L831-START-BROWSE-88 TO TRUE. DTSCS89
|
|
01128 GO TO S831-IO. DTSCS89
|
|
01129 SKIP1 DTSCS89
|
|
01130 S831-READ-NEXT. DTSCS89
|
|
01131 SET L831-READ-NEXT-88 TO TRUE. DTSCS89
|
|
01132 GO TO S831-IO. DTSCS89
|
|
01133 SKIP1 DTSCS89
|
|
01134 S831-READ-PREV. DTSCS89
|
|
01135 SET L831-READ-PREV-88 TO TRUE. DTSCS89
|
|
01136 GO TO S831-IO. DTSCS89
|
|
01137 SKIP1 DTSCS89
|
|
01138 S831-END-BROWSE. DTSCS89
|
|
01139 SET L831-END-BROWSE-88 TO TRUE. DTSCS89
|
|
01140 GO TO S831-IO. DTSCS89
|
|
01141 SKIP1 DTSCS89
|
|
01142 S831-REWRITE. DTSCS89
|
|
01143 SET L831-REWRITE-88 TO TRUE. DTSCS89
|
|
01144 GO TO S831-IO. DTSCS89
|
|
01145 SKIP1 DTSCS89
|
|
01146 S831-WRITE. DTSCS89
|
|
01147 SET L831-WRITE-88 TO TRUE. DTSCS89
|
|
01148 GO TO S831-IO. DTSCS89
|
|
01149 SKIP1 DTSCS89
|
|
01150 S831-DELETE. DTSCS89
|
|
01151 SET L831-DELETE-88 TO TRUE. DTSCS89
|
|
01152 GO TO S831-IO. DTSCS89
|
|
01153 SKIP1 DTSCS89
|
|
01154 S831-IO. DTSCS89
|
|
01155 SKIP1 DTSCS89
|
|
01156 EXEC CICS LINK DTSCS89
|
|
01157 PROGRAM ('DTSCU831') DTSCS89
|
|
01158 COMMAREA (L831-COMM-AREA) DTSCS89
|
|
01159 END-EXEC. DTSCS89
|
|
01160 SKIP1 DTSCS89
|
|
01161 IF L831-FILE-CLOSED-88 DTSCS89
|
|
01162 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS89
|
|
01163 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS89
|
|
01164 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS89
|
|
01165 GO TO MAINLINE-EXIT. DTSCS89
|
|
01166 S831-EXIT. DTSCS89
|
|
01167 EXIT. DTSCS89
|
|
01168 SKIP3 DTSCS89
|
|
01169 S851-SCREEN-PROCESSING. DTSCS89
|
|
01170 EXEC CICS LINK DTSCS89
|
|
01171 PROGRAM ('DTSCU851') DTSCS89
|
|
01172 COMMAREA (L851-COMM-AREA) DTSCS89
|
|
01173 END-EXEC. DTSCS89
|
|
01174 S851-EXIT. DTSCS89
|
|
01175 EXIT. DTSCS89
|
|
01176 SKIP3 DTSCS89
|
|
01177 S899-ABEND. DTSCS89
|
|
01178 EXEC CICS ABEND DTSCS89
|
|
01179 ABCODE(WRK-ABEND-CD) DTSCS89
|
|
01180 END-EXEC. DTSCS89
|
|
01181 S899-EXIT. DTSCS89
|
|
01182 EXIT. DTSCS89
|
|
01183 /*****************************************************************DTSCS89
|
|
01184 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS89
|
|
01185 ******************************************************************DTSCS89
|
|
01186 SKIP1 DTSCS89
|
|
01187 S1001-SCREEN-KEY-EDITS. DTSCS89
|
|
01188 SKIP1 DTSCS89
|
|
01189 PERFORM S1100-YR THRU S1100-EXIT. DTSCS89
|
|
01190 SKIP1 DTSCS89
|
|
01191 S1001-EXIT. DTSCS89
|
|
01192 EXIT. DTSCS89
|
|
01193 SKIP3 DTSCS89
|
|
01194 S1002-SCREEN-DATA-EDITS. DTSCS89
|
|
01195 SKIP1 DTSCS89
|
|
01196 MOVE +0 TO WRK-UC30H-MASS-MAIL-DATE DTSCS89
|
|
01197 WRK-UC30H-RPT-DUE-DATE DTSCS89
|
|
01198 WRK-UC30H-LATE-PEN-DATE DTSCS89
|
|
01199 WRK-UC30H-FIRST-DEL-DATE DTSCS89
|
|
01200 WRK-UC30H-ESTIMATED-DATE. CL**2
|
|
01201 SKIP1 DTSCS89
|
|
01202 MOVE FAFD-YR TO L004-QTR-5-YR. DTSCS89
|
|
01203 MOVE 3 TO L004-QTR-5-Q. DTSCS89
|
|
01204 SET L004-FROM-5 TO TRUE. DTSCS89
|
|
01205 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS89
|
|
01206 MOVE L004-QTR-START-DATE TO WRK-YRQ-START-DATE. DTSCS89
|
|
01207 MOVE L004-QTR-END-DATE TO WRK-YRQ-END-DATE. DTSCS89
|
|
01208 SKIP1 DTSCS89
|
|
01209 MOVE FAFD-YR TO L004-QTR-5-YR. DTSCS89
|
|
01210 ADD +1 TO L004-QTR-5-YR. DTSCS89
|
|
01211 MOVE 1 TO L004-QTR-5-Q. DTSCS89
|
|
01212 SET L004-FROM-5 TO TRUE. DTSCS89
|
|
01213 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS89
|
|
01214 MOVE L004-QTR-START-DATE TO WRK-YRQ-PLUS1-START-DATE. DTSCS89
|
|
01215 MOVE L004-QTR-END-DATE TO WRK-YRQ-PLUS1-END-DATE. DTSCS89
|
|
01216 SKIP1 DTSCS89
|
|
01217 ******************************************************************DTSCS89
|
|
01218 * REPORT DUE DATE CANNOT BE LESS THAN 4/15 OF THE YEAR *DTSCS89
|
|
01219 * FOLLOWING THE REPORT YEAR OR MAY NOT BE GREATER THAN 4/15 *DTSCS89
|
|
01220 * OF THE SECOND YEAR FOLLOWING THE REPORT YEAR DTSCS89
|
|
01221 ******************************************************************DTSCS89
|
|
01222 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS89
|
|
01223 MOVE 4 TO L001-FED-8-MO. DTSCS89
|
|
01224 MOVE 15 TO L001-FED-8-DA. DTSCS89
|
|
01225 SET L001-FROM-FED-8 TO TRUE DTSCS89
|
|
01226 PERFORM S001-DATE THRU S001-EXIT DTSCS89
|
|
01227 IF L001-VALID-DATE DTSCS89
|
|
01228 MOVE L001-FED-8-DATE-9 TO WRK-YRQ-PLUS1-START-DATE DTSCS89
|
|
01229 ELSE DTSCS89
|
|
01230 MOVE ZERO TO WRK-YRQ-PLUS1-START-DATE. DTSCS89
|
|
01231 DTSCS89
|
|
01232 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS89
|
|
01233 ADD 1 TO L001-FED-8-YR. DTSCS89
|
|
01234 SET L001-FROM-FED-8 TO TRUE DTSCS89
|
|
01235 PERFORM S001-DATE THRU S001-EXIT DTSCS89
|
|
01236 IF L001-VALID-DATE DTSCS89
|
|
01237 MOVE L001-FED-8-DATE-9 TO WRK-YRQ-PLUS1-END-DATE DTSCS89
|
|
01238 ELSE DTSCS89
|
|
01239 MOVE ZERO TO WRK-YRQ-PLUS1-END-DATE. DTSCS89
|
|
01240 SKIP1 DTSCS89
|
|
01241 PERFORM S1200-UC30H-MASS-MAIL-DATE THRU S1200-EXIT. DTSCS89
|
|
01242 PERFORM S1250-UC30H-RPT-DUE-DATE THRU S1250-EXIT. DTSCS89
|
|
01243 PERFORM S1300-UC30H-FIRST-DEL-DATE THRU S1300-EXIT. DTSCS89
|
|
01244 PERFORM S1400-UC30H-ESTIMATED-DATE THRU S1400-EXIT. CL**2
|
|
01245 PERFORM S1600-LATE-PEN-ASSESSED-DATE THRU S1600-EXIT. DTSCS89
|
|
01246 PERFORM S1700-UC30H-FINAL-ACT-DATE THRU S1700-EXIT. DTSCS89
|
|
01247 SKIP1 DTSCS89
|
|
01248 S1002-EXIT. DTSCS89
|
|
01249 EXIT. DTSCS89
|
|
01250 EJECT DTSCS89
|
|
01251 S1100-YR. DTSCS89
|
|
01252 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89
|
|
01253 IF L007-NOT-VALID-YR DTSCS89
|
|
01254 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS89
|
|
01255 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89
|
|
01256 ELSE DTSCS89
|
|
01257 IF (L007-START-YRQ <= LCCM-PICKUP-YRQ) DTSCS89
|
|
01258 OR DTSCS89
|
|
01259 (L007-YR-2-9 NOT > WRK-ANN-START-YR) DTSCS89
|
|
01260 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01261 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89
|
|
01262 S1100-EXIT. DTSCS89
|
|
01263 EXIT. DTSCS89
|
|
01264 SKIP3 DTSCS89
|
|
01265 S1101-ERROR. DTSCS89
|
|
01266 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YR-A. DTSCS89
|
|
01267 DTSCS89
|
|
01268 IF LCCM-NO-MSG DTSCS89
|
|
01269 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89
|
|
01270 MOVE CATB-CURSOR TO MAP-YR-L DTSCS89
|
|
01271 SET CURSOR-SET-YES TO TRUE. DTSCS89
|
|
01272 S1101-EXIT. DTSCS89
|
|
01273 EXIT. DTSCS89
|
|
01274 EJECT DTSCS89
|
|
01275 S1200-UC30H-MASS-MAIL-DATE. DTSCS89
|
|
01276 MOVE MAP-UC30H-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01277 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01278 IF L015-NO-ENTRY DTSCS89
|
|
01279 MOVE WRK-NO-ENTRY TO WRK-UC30H-MASS-MAIL-DATE DTSCS89
|
|
01280 GO TO S1200-EXIT. DTSCS89
|
|
01281 IF L015-NOT-VALID DTSCS89
|
|
01282 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01283 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS89
|
|
01284 GO TO S1200-EXIT. DTSCS89
|
|
01285 SKIP1 DTSCS89
|
|
01286 IF L015-DATE < WRK-YRQ-END-DATE DTSCS89
|
|
01287 OR L015-DATE > WRK-YRQ-PLUS1-START-DATE DTSCS89
|
|
01288 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01289 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS89
|
|
01290 ELSE DTSCS89
|
|
01291 MOVE L015-DATE TO WRK-UC30H-MASS-MAIL-DATE. DTSCS89
|
|
01292 S1200-EXIT. DTSCS89
|
|
01293 EXIT. DTSCS89
|
|
01294 SKIP3 DTSCS89
|
|
01295 S1201-ERROR. DTSCS89
|
|
01296 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-MASS-MAIL-MM-A DTSCS89
|
|
01297 MAP-UC30H-MASS-MAIL-DD-A DTSCS89
|
|
01298 MAP-UC30H-MASS-MAIL-YY-A. DTSCS89
|
|
01299 IF LCCM-NO-MSG DTSCS89
|
|
01300 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89
|
|
01301 MOVE CATB-CURSOR TO MAP-UC30H-MASS-MAIL-MM-L DTSCS89
|
|
01302 SET CURSOR-SET-YES TO TRUE. DTSCS89
|
|
01303 S1201-EXIT. DTSCS89
|
|
01304 EXIT. DTSCS89
|
|
01305 /*****************************************************************DTSCS89
|
|
01306 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1250 *DTSCS89
|
|
01307 ******************************************************************DTSCS89
|
|
01308 S1250-UC30H-RPT-DUE-DATE. DTSCS89
|
|
01309 MOVE MAP-UC30H-RPT-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01310 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01311 IF L015-NO-ENTRY DTSCS89
|
|
01312 NEXT SENTENCE DTSCS89
|
|
01313 ELSE DTSCS89
|
|
01314 IF L015-NOT-VALID DTSCS89
|
|
01315 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01316 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89
|
|
01317 ELSE DTSCS89
|
|
01318 IF WRK-UC30H-MASS-MAIL-DATE = WRK-NO-ENTRY DTSCS89
|
|
01319 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89
|
|
01320 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89
|
|
01321 ELSE DTSCS89
|
|
01322 IF L015-DATE < WRK-UC30H-MASS-MAIL-DATE DTSCS89
|
|
01323 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01324 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89
|
|
01325 ELSE DTSCS89
|
|
01326 IF L015-DATE > WRK-YRQ-PLUS1-END-DATE DTSCS89
|
|
01327 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01328 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89
|
|
01329 ELSE DTSCS89
|
|
01330 MOVE L015-DATE TO WRK-UC30H-RPT-DUE-DATE. DTSCS89
|
|
01331 * DTSCS89
|
|
01332 MOVE WRK-UC30H-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSCS89
|
|
01333 ADD 1 TO L001-FED-8-YR. DTSCS89
|
|
01334 SET L001-FROM-FED-8 TO TRUE DTSCS89
|
|
01335 PERFORM S001-DATE THRU S001-EXIT DTSCS89
|
|
01336 IF L001-VALID-DATE DTSCS89
|
|
01337 MOVE L001-FED-8-DATE-9 TO WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89
|
|
01338 ELSE DTSCS89
|
|
01339 MOVE ZERO TO WRK-UC30H-PLUS1-RPT-DUE-DATE. DTSCS89
|
|
01340 DTSCS89
|
|
01341 S1250-EXIT. DTSCS89
|
|
01342 EXIT. DTSCS89
|
|
01343 SKIP3 DTSCS89
|
|
01344 S1251-ERROR. DTSCS89
|
|
01345 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-RPT-DUE-MM-A DTSCS89
|
|
01346 MAP-UC30H-RPT-DUE-DD-A DTSCS89
|
|
01347 MAP-UC30H-RPT-DUE-YY-A. DTSCS89
|
|
01348 IF LCCM-NO-MSG DTSCS89
|
|
01349 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89
|
|
01350 MOVE CATB-CURSOR TO MAP-UC30H-RPT-DUE-MM-L DTSCS89
|
|
01351 SET CURSOR-SET-YES TO TRUE. DTSCS89
|
|
01352 S1251-EXIT. DTSCS89
|
|
01353 EXIT. DTSCS89
|
|
01354 /*****************************************************************DTSCS89
|
|
01355 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1300 *DTSCS89
|
|
01356 ******************************************************************DTSCS89
|
|
01357 S1300-UC30H-FIRST-DEL-DATE. DTSCS89
|
|
01358 MOVE MAP-UC30H-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01359 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01360 IF L015-NO-ENTRY DTSCS89
|
|
01361 MOVE WRK-NO-ENTRY TO WRK-UC30H-FIRST-DEL-DATE DTSCS89
|
|
01362 ELSE DTSCS89
|
|
01363 IF L015-NOT-VALID DTSCS89
|
|
01364 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01365 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89
|
|
01366 ELSE DTSCS89
|
|
01367 IF L015-DATE < WRK-UC30H-RPT-DUE-DATE DTSCS89
|
|
01368 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01369 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89
|
|
01370 ELSE DTSCS89
|
|
01371 IF L015-DATE > WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89
|
|
01372 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01373 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89
|
|
01374 ELSE DTSCS89
|
|
01375 IF WRK-UC30H-RPT-DUE-DATE = WRK-NO-ENTRY DTSCS89
|
|
01376 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89
|
|
01377 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89
|
|
01378 ELSE DTSCS89
|
|
01379 MOVE L015-DATE TO WRK-UC30H-FIRST-DEL-DATE. DTSCS89
|
|
01380 * DTSCS89
|
|
01381 MOVE WRK-UC30H-FIRST-DEL-DATE TO L001-FED-8-DATE-9. DTSCS89
|
|
01382 ADD 1 TO L001-FED-8-YR. DTSCS89
|
|
01383 SET L001-FROM-FED-8 TO TRUE DTSCS89
|
|
01384 PERFORM S001-DATE THRU S001-EXIT DTSCS89
|
|
01385 IF L001-VALID-DATE DTSCS89
|
|
01386 MOVE L001-FED-8-DATE-9 TO WRK-UC30H-PLUS1-1ST-DEL-DATE DTSCS89
|
|
01387 ELSE DTSCS89
|
|
01388 MOVE ZERO TO WRK-UC30H-PLUS1-1ST-DEL-DATE. DTSCS89
|
|
01389 DTSCS89
|
|
01390 S1300-EXIT. DTSCS89
|
|
01391 EXIT. DTSCS89
|
|
01392 SKIP3 DTSCS89
|
|
01393 S1301-ERROR. DTSCS89
|
|
01394 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-FIRST-DEL-MM-A DTSCS89
|
|
01395 MAP-UC30H-FIRST-DEL-DD-A DTSCS89
|
|
01396 MAP-UC30H-FIRST-DEL-YY-A. DTSCS89
|
|
01397 IF LCCM-NO-MSG DTSCS89
|
|
01398 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89
|
|
01399 MOVE CATB-CURSOR TO MAP-UC30H-FIRST-DEL-MM-L DTSCS89
|
|
01400 SET CURSOR-SET-YES TO TRUE. DTSCS89
|
|
01401 S1301-EXIT. DTSCS89
|
|
01402 EXIT. DTSCS89
|
|
01403 /*****************************************************************DTSCS89
|
|
01404 * WORK FIELDS MUST BE SET BY S1300 BEFORE PERFORMING S1400 *DTSCS89
|
|
01405 ******************************************************************DTSCS89
|
|
01406 S1400-UC30H-ESTIMATED-DATE. CL**2
|
|
01407 MOVE MAP-UC30H-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. CL**2
|
|
01408 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01409 IF L015-NO-ENTRY DTSCS89
|
|
01410 MOVE WRK-NO-ENTRY TO WRK-UC30H-ESTIMATED-DATE CL**2
|
|
01411 ELSE DTSCS89
|
|
01412 IF L015-NOT-VALID DTSCS89
|
|
01413 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01414 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89
|
|
01415 ELSE DTSCS89
|
|
01416 IF L015-DATE < WRK-UC30H-FIRST-DEL-DATE DTSCS89
|
|
01417 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01418 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89
|
|
01419 ELSE DTSCS89
|
|
01420 IF WRK-UC30H-FIRST-DEL-DATE = WRK-NO-ENTRY DTSCS89
|
|
01421 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89
|
|
01422 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89
|
|
01423 ELSE DTSCS89
|
|
01424 IF L015-DATE > WRK-UC30H-PLUS1-1ST-DEL-DATE DTSCS89
|
|
01425 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01426 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89
|
|
01427 ELSE DTSCS89
|
|
01428 MOVE L015-DATE TO WRK-UC30H-ESTIMATED-DATE. CL**2
|
|
01429 S1400-EXIT. DTSCS89
|
|
01430 EXIT. DTSCS89
|
|
01431 SKIP3 DTSCS89
|
|
01432 S1401-ERROR. DTSCS89
|
|
01433 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-ESTIMATED-MM-A CL**2
|
|
01434 MAP-UC30H-ESTIMATED-DD-A CL**2
|
|
01435 MAP-UC30H-ESTIMATED-YY-A. CL**2
|
|
01436 IF LCCM-NO-MSG DTSCS89
|
|
01437 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89
|
|
01438 MOVE CATB-CURSOR TO MAP-UC30H-ESTIMATED-MM-L CL**2
|
|
01439 SET CURSOR-SET-YES TO TRUE. DTSCS89
|
|
01440 S1401-EXIT. DTSCS89
|
|
01441 EXIT. DTSCS89
|
|
01442 /*****************************************************************DTSCS89
|
|
01443 * WORK FIELDS MUST BE SET BY S1100 BEFORE PERFORMING S1600 *DTSCS89
|
|
01444 ******************************************************************DTSCS89
|
|
01445 S1600-LATE-PEN-ASSESSED-DATE. DTSCS89
|
|
01446 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01447 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01448 IF L015-NO-ENTRY DTSCS89
|
|
01449 NEXT SENTENCE DTSCS89
|
|
01450 ELSE DTSCS89
|
|
01451 IF L015-NOT-VALID DTSCS89
|
|
01452 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01453 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89
|
|
01454 ELSE DTSCS89
|
|
01455 IF L015-DATE < WRK-UC30H-RPT-DUE-DATE DTSCS89
|
|
01456 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01457 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89
|
|
01458 ELSE DTSCS89
|
|
01459 IF L015-DATE > WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89
|
|
01460 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01461 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89
|
|
01462 ELSE DTSCS89
|
|
01463 IF WRK-UC30H-RPT-DUE-DATE = WRK-NO-ENTRY DTSCS89
|
|
01464 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89
|
|
01465 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89
|
|
01466 ELSE DTSCS89
|
|
01467 MOVE L015-DATE TO WRK-UC30H-LATE-PEN-DATE. DTSCS89
|
|
01468 S1600-EXIT. DTSCS89
|
|
01469 EXIT. DTSCS89
|
|
01470 SKIP3 DTSCS89
|
|
01471 S1601-ERROR. DTSCS89
|
|
01472 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LATE-PEN-ASSESSED-MM-ADTSCS89
|
|
01473 MAP-LATE-PEN-ASSESSED-DD-A DTSCS89
|
|
01474 MAP-LATE-PEN-ASSESSED-YY-A. DTSCS89
|
|
01475 IF LCCM-NO-MSG DTSCS89
|
|
01476 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89
|
|
01477 MOVE CATB-CURSOR TO MAP-LATE-PEN-ASSESSED-MM-L DTSCS89
|
|
01478 SET CURSOR-SET-YES TO TRUE. DTSCS89
|
|
01479 S1601-EXIT. DTSCS89
|
|
01480 EXIT. DTSCS89
|
|
01481 /*****************************************************************DTSCS89
|
|
01482 * WORK FIELDS MUST BE SET BY S1400 BEFORE PERFORMING S1500 *DTSCS89
|
|
01483 ******************************************************************DTSCS89
|
|
01484 S1700-UC30H-FINAL-ACT-DATE. DTSCS89
|
|
01485 MOVE MAP-UC30H-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS89
|
|
01486 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89
|
|
01487 IF L015-NO-ENTRY DTSCS89
|
|
01488 NEXT SENTENCE DTSCS89
|
|
01489 ELSE DTSCS89
|
|
01490 IF L015-NOT-VALID DTSCS89
|
|
01491 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01492 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89
|
|
01493 ELSE DTSCS89
|
|
01494 IF L015-DATE < WRK-UC30H-FIRST-DEL-DATE CL**2
|
|
01495 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89
|
|
01496 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89
|
|
01497 ELSE DTSCS89
|
|
01498 IF WRK-UC30H-ESTIMATED-DATE = WRK-NO-ENTRY CL**2
|
|
01499 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89
|
|
01500 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89
|
|
01501 ELSE DTSCS89
|
|
01502 MOVE L015-DATE TO WRK-UC30H-FINAL-ACT-DATE. DTSCS89
|
|
01503 S1700-EXIT. DTSCS89
|
|
01504 EXIT. DTSCS89
|
|
01505 SKIP3 DTSCS89
|
|
01506 S1701-ERROR. DTSCS89
|
|
01507 MOVE CATB-UNPROT-NORM-NUM-MDTON TO DTSCS89
|
|
01508 MAP-UC30H-FINAL-ACTION-MM-A DTSCS89
|
|
01509 MAP-UC30H-FINAL-ACTION-DD-A DTSCS89
|
|
01510 MAP-UC30H-FINAL-ACTION-YY-A. DTSCS89
|
|
01511 IF LCCM-NO-MSG DTSCS89
|
|
01512 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89
|
|
01513 MOVE CATB-CURSOR TO MAP-UC30H-FINAL-ACTION-MM-L DTSCS89
|
|
01514 SET CURSOR-SET-YES TO TRUE. DTSCS89
|
|
01515 S1701-EXIT. DTSCS89
|
|
01516 EXIT. DTSCS89
|
|
01517 DTSCS89
|
|
01518 /*****************************************************************DTSCS89
|
|
01519 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS89
|
|
01520 ******************************************************************DTSCS89
|
|
01521 S5100-SET-LOCK-ATTRB. DTSCS89
|
|
01522 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS89
|
|
01523 WRK-ATB-NUM. DTSCS89
|
|
01524 SKIP1 DTSCS89
|
|
01525 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89
|
|
01526 SKIP1 DTSCS89
|
|
01527 MOVE CATB-ASKIP-BRT-MDTON TO MAP-YR-A DTSCS89
|
|
01528 MAP-GOTO-A. DTSCS89
|
|
01529 S5100-EXIT. DTSCS89
|
|
01530 EXIT. DTSCS89
|
|
01531 SKIP3 DTSCS89
|
|
01532 ******************************************************************DTSCS89
|
|
01533 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS89
|
|
01534 ******************************************************************DTSCS89
|
|
01535 S5200-SET-UPDATE-ATTRB. DTSCS89
|
|
01536 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS89
|
|
01537 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS89
|
|
01538 SKIP1 DTSCS89
|
|
01539 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89
|
|
01540 S5200-EXIT. DTSCS89
|
|
01541 EXIT. DTSCS89
|
|
01542 SKIP3 DTSCS89
|
|
01543 ******************************************************************DTSCS89
|
|
01544 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS89
|
|
01545 ******************************************************************DTSCS89
|
|
01546 S5300-SET-INQ-ATTRB. DTSCS89
|
|
01547 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS89
|
|
01548 WRK-ATB-NUM. DTSCS89
|
|
01549 SKIP1 DTSCS89
|
|
01550 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89
|
|
01551 S5300-EXIT. DTSCS89
|
|
01552 EXIT. DTSCS89
|
|
01553 SKIP3 DTSCS89
|
|
01554 ******************************************************************DTSCS89
|
|
01555 * DO IT *DTSCS89
|
|
01556 ******************************************************************DTSCS89
|
|
01557 S5900-SET-ATTRB. DTSCS89
|
|
01558 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-YR-A. DTSCS89
|
|
01559 SKIP1 DTSCS89
|
|
01560 MOVE WRK-ATB-NUM TO MAP-UC30H-MASS-MAIL-MM-A DTSCS89
|
|
01561 MAP-UC30H-MASS-MAIL-DD-A DTSCS89
|
|
01562 MAP-UC30H-MASS-MAIL-YY-A DTSCS89
|
|
01563 MAP-UC30H-RPT-DUE-MM-A DTSCS89
|
|
01564 MAP-UC30H-RPT-DUE-DD-A DTSCS89
|
|
01565 MAP-UC30H-RPT-DUE-YY-A DTSCS89
|
|
01566 MAP-UC30H-FIRST-DEL-MM-A DTSCS89
|
|
01567 MAP-UC30H-FIRST-DEL-DD-A DTSCS89
|
|
01568 MAP-UC30H-FIRST-DEL-YY-A DTSCS89
|
|
01569 MAP-UC30H-ESTIMATED-MM-A CL**2
|
|
01570 MAP-UC30H-ESTIMATED-DD-A CL**2
|
|
01571 MAP-UC30H-ESTIMATED-YY-A CL**2
|
|
01572 MAP-LATE-PEN-ASSESSED-MM-A DTSCS89
|
|
01573 MAP-LATE-PEN-ASSESSED-DD-A DTSCS89
|
|
01574 MAP-LATE-PEN-ASSESSED-YY-A DTSCS89
|
|
01575 MAP-UC30H-FINAL-ACTION-MM-A DTSCS89
|
|
01576 MAP-UC30H-FINAL-ACTION-DD-A DTSCS89
|
|
01577 MAP-UC30H-FINAL-ACTION-YY-A. DTSCS89
|
|
01578 SKIP1 DTSCS89
|
|
01579 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS89
|
|
01580 MAP-CHNG-DATE-A. DTSCS89
|
|
01581 SKIP1 DTSCS89
|
|
01582 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS89
|
|
01583 S5900-EXIT. DTSCS89
|
|
01584 EXIT. DTSCS89
|
|
01585 /*****************************************************************DTSCS89
|
|
01586 * READ PREPARATION ROUTINES *DTSCS89
|
|
01587 ******************************************************************DTSCS89
|
|
01588 S8010-READ-FAFD. DTSCS89
|
|
01589 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89
|
|
01590 IF L007-VALID-YR DTSCS89
|
|
01591 MOVE LOW-VALUES TO FAFD-KEY-AREA DTSCS89
|
|
01592 SET FAFD-AFD-88 TO TRUE DTSCS89
|
|
01593 MOVE L007-YR-4-9 TO FAFD-YR DTSCS89
|
|
01594 PERFORM S831-READ THRU S831-EXIT DTSCS89
|
|
01595 ELSE DTSCS89
|
|
01596 GO TO S899-ABEND. DTSCS89
|
|
01597 S8010-EXIT. DTSCS89
|
|
01598 EXIT. DTSCS89
|
|
01599 /*****************************************************************DTSCS89
|
|
01600 * MAP ROUTINES *DTSCS89
|
|
01601 ******************************************************************DTSCS89
|
|
01602 S9100-RECEIVE. DTSCS89
|
|
01603 SET L851-RECEIVE-88 TO TRUE. DTSCS89
|
|
01604 SKIP1 DTSCS89
|
|
01605 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS89
|
|
01606 SKIP1 DTSCS89
|
|
01607 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89
|
|
01608 SKIP1 DTSCS89
|
|
01609 MOVE L851-AID TO LCCM-AID. DTSCS89
|
|
01610 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS89
|
|
01611 S9100-EXIT. DTSCS89
|
|
01612 EXIT. DTSCS89
|
|
01613 SKIP3 DTSCS89
|
|
01614 S9200-SEND-DATAONLY. DTSCS89
|
|
01615 MOVE LOW-VALUES TO MAP-AREA. DTSCS89
|
|
01616 SKIP1 DTSCS89
|
|
01617 IF LCCM-NO-MSG DTSCS89
|
|
01618 NEXT SENTENCE DTSCS89
|
|
01619 ELSE DTSCS89
|
|
01620 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS89
|
|
01621 SKIP1 DTSCS89
|
|
01622 IF CURSOR-SET-GOTO DTSCS89
|
|
01623 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS89
|
|
01624 ELSE DTSCS89
|
|
01625 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS89
|
|
01626 SKIP1 DTSCS89
|
|
01627 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS89
|
|
01628 SKIP1 DTSCS89
|
|
01629 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS89
|
|
01630 SKIP1 DTSCS89
|
|
01631 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89
|
|
01632 S9200-EXIT. DTSCS89
|
|
01633 EXIT. DTSCS89
|
|
01634 SKIP3 DTSCS89
|
|
01635 S9300-SEND-MAP. DTSCS89
|
|
01636 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS89
|
|
01637 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS89
|
|
01638 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS89
|
|
01639 SKIP1 DTSCS89
|
|
01640 IF SCR-ACCESS-UPDATE DTSCS89
|
|
01641 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS89
|
|
01642 ELSE DTSCS89
|
|
01643 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS89
|
|
01644 SKIP1 DTSCS89
|
|
01645 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS89
|
|
01646 SKIP1 DTSCS89
|
|
01647 IF CURSOR-SET-NO DTSCS89
|
|
01648 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS89
|
|
01649 SKIP1 DTSCS89
|
|
01650 SET L851-SEND-88 TO TRUE. DTSCS89
|
|
01651 SKIP1 DTSCS89
|
|
01652 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS89
|
|
01653 SKIP1 DTSCS89
|
|
01654 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89
|
|
01655 S9300-EXIT. DTSCS89
|
|
01656 EXIT. DTSCS89
|
|
01657 SKIP3 DTSCS89
|
|
01658 S9310-UPDATE-FKEYS. DTSCS89
|
|
01659 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS89
|
|
01660 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS89
|
|
01661 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS89
|
|
01662 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS89
|
|
01663 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS89
|
|
01664 SKIP1 DTSCS89
|
|
01665 IF LCCM-SCR-CLEAR DTSCS89
|
|
01666 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS89
|
|
01667 MAP-KEY-DEL DTSCS89
|
|
01668 ELSE DTSCS89
|
|
01669 IF LCCM-SCR-UPDATE-LOCKED DTSCS89
|
|
01670 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS89
|
|
01671 MAP-KEY-FWRD DTSCS89
|
|
01672 MAP-KEY-ADD DTSCS89
|
|
01673 MAP-KEY-MOD DTSCS89
|
|
01674 MAP-KEY-DEL DTSCS89
|
|
01675 ELSE DTSCS89
|
|
01676 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS89
|
|
01677 S9310-EXIT. DTSCS89
|
|
01678 EXIT. DTSCS89
|
|
01679 SKIP3 DTSCS89
|
|
01680 S9320-INQUIRY-FKEYS. DTSCS89
|
|
01681 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS89
|
|
01682 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS89
|
|
01683 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS89
|
|
01684 MAP-KEY-MOD DTSCS89
|
|
01685 MAP-KEY-DEL. DTSCS89
|
|
01686 S9320-EXIT. DTSCS89
|
|
01687 EXIT. DTSCS89
|
|
01688 SKIP3 DTSCS89
|
|
01689 S9900-PREPARE-SEND. DTSCS89
|
|
01690 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS89
|
|
01691 LCCM-SCR-ID. DTSCS89
|
|
01692 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS89
|
|
01693 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS89
|
|
01694 S9900-EXIT. DTSCS89
|
|
01695 EXIT. DTSCS89
|