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
