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