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