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