00001  IDENTIFICATION DIVISION.                                         05/18/99
00002  PROGRAM-ID.             DTSCS34.                                 DTSCS34
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV009
00004  DATE-WRITTEN.           JUNE 1994.                               DTSCS34
00005  DATE-COMPILED.                                                   DTSCS34
00006      SKIP3                                                        DTSCS34
00007 *****                                                             DTSCS34
00008 *                                                                 DTSCS34
00009 *    FUNCTION:  PAYMENT INQUIRY SCREEN PROCESSOR.                 DTSCS34
00010 *                                                                 DTSCS34
00011 *                                                                 DTSCS34
00012 *    MODIFICATION LOG:                                            DTSCS34
00013 *                                                                    CL**2
00014 *    12/23/98  INITIAL DEVELOPMENT.          COPIED FROM MACCS34     CL**2
00015 *              WORK ORDER:                      PROGRAMMER: ZL1      CL**2
00016 *                                                                 DTSCS34
00017 *    05/18/1999  PICKUP MODIFICATIONS.                               CL**8
00018 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH      CL**8
00019 *                                                                    CL**8
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**8
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**8
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**8
00023 *                                                                 DTSCS34
00024 *                                                                 DTSCS34
00025 *  DESCRIPTION:                                                   DTSCS34
00026 *                                                                 DTSCS34
00027 *    CLEAR:                                                       DTSCS34
00028 *                                                                 DTSCS34
00029 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS34
00030 *                                                                 DTSCS34
00031 *                                                                 DTSCS34
00032 *    JUMP:                                                        DTSCS34
00033 *                                                                 DTSCS34
00034 *      F09  QUARTER INQUIRY (31).                                 DTSCS34
00035 *      F10  REPORT INQUIRY (33).                                  DTSCS34
00036 *      F12  ADJUSTMENT INQUIRY (35).                              DTSCS34
00037 *                                                                 DTSCS34
00038 *                                                                 DTSCS34
00039 *    INQUIRY:                                                     DTSCS34
00040 *                                                                 DTSCS34
00041 *      CONTROL FIELD(S): MAP-EMP-NO                               DTSCS34
00042 *                        MAP-YRQ.                                 DTSCS34
00043 *                                                                 DTSCS34
00044 *                                                                 DTSCS34
00045 *      JUMP IN:  IF LCCM-EMP-NO = LCCM-SCR34-HOLD-AREA  EMP-NO    DTSCS34
00046 *                    IF LCCM-YRQ = LCCM-SCR34-HOLD-AREA  YRQ      DTSCS34
00047 *                        DISPLAY THE PAGE INDICATED IN            DTSCS34
00048 *                        LCCM-SCR34-HOLD-AREA                     DTSCS34
00049 *                    ELSE                                         DTSCS34
00050 *                        IF LCCM-YRQ = 0                          DTSCS34
00051 *                            DISPLAY PAGE 1 OF "ALL QUARTERS"     DTSCS34
00052 *                        ELSE                                     DTSCS34
00053 *                            DISPLAY PAGE 1 OF "LCCM-YRQ"         DTSCS34
00054 *                ELSE                                             DTSCS34
00055 *                IF LCCM-EMP-NO = 0                               DTSCS34
00056 *                    DISPLAY 'PLEASE ENTER' MESSAGE               DTSCS34
00057 *                ELSE                                             DTSCS34
00058 *                    IF LCCM-YRQ = 0                              DTSCS34
00059 *                        DISPLAY PAGE 1 OF "ALL QUARTERS"         DTSCS34
00060 *                    ELSE                                         DTSCS34
00061 *                        DISPLAY PAGE 1 OF "LCCM-YRQ".            DTSCS34
00062 *                                                                 DTSCS34
00063 *                                                                 DTSCS34
00064 *      ENTER, F05, F06, F07, F08:                                 DTSCS34
00065 *                                                                 DTSCS34
00066 *               DISPLAY SEQUENCE: SEE SCREEN DESCRIPTION.         DTSCS34
00067 *                                                                 DTSCS34
00068 *       PAGE INITIALLY DISPLAYED: FIRST.                          DTSCS34
00069 *                                                                 DTSCS34
00070 *                                                                 DTSCS34
00071 *      CONSTRUCTION OF THE PAGES IS SO COMPLEX THAT IT            DTSCS34
00072 *      WILL PROBABLY BE NECESSARY TO CONSTRUCT PAGES              DTSCS34
00073 *      OF INFORMATION IN TS Q 'S'.                                DTSCS34
00074 *                                                                 DTSCS34
00075 *      NOTE THAT, WHEN A MAP-YRQ IS SPECIFIED, ONLY               DTSCS34
00076 *      "PAYMENT DISTRIBUTION" LINES ARE DISPLAYED.                DTSCS34
00077 *                                                                 DTSCS34
00078 *                                                                 DTSCS34
00079 *      JUMP OUT:  STORE INFORMATION REPRESENTING PAGE             DTSCS34
00080 *                 CURRENTLY DISPLAYED IN LCCM-SCR34-HOLD-AREA.    DTSCS34
00081 *                                                                 DTSCS34
00082 *                 DELETE TEMPORARY STORAGE QUEUE 'S'.             DTSCS34
00083 *                                                                 DTSCS34
00084 *                                                                 DTSCS34
00085 *    LCCM-MISC-CONTROL-AREA MAINTENANCE:                          DTSCS34
00086 *                                                                 DTSCS34
00087 *      LCCM-EMP-NO                                                DTSCS34
00088 *                                                                 DTSCS34
00089 *      LCCM-YRQ                                                   DTSCS34
00090 *                                                                 DTSCS34
00091 *                                                                 DTSCS34
00092 *    UPDATE:                                                      DTSCS34
00093 *                                                                 DTSCS34
00094 *      NONE.                                                      DTSCS34
00095 *                                                                 DTSCS34
00096 *                                                                 DTSCS34
00097 *    RECORDS READ:                                                DTSCS34
00098 *                                                                 DTSCS34
00099 *      MASTER:                                                    DTSCS34
00100 *                                                                 DTSCS34
00101 *        MPRF                                                     DTSCS34
00102 *        MPAY                                                     DTSCS34
00103 *        MDST                                                     DTSCS34
00104 *        MREV                                                     DTSCS34
00105 *                                                                 DTSCS34
00106 *                                                                 DTSCS34
00107 *      ALTERNATE INDEX:                                           DTSCS34
00108 *                                                                 DTSCS34
00109 *        NONE.                                                    DTSCS34
00110 *                                                                 DTSCS34
00111 *                                                                 DTSCS34
00112 *      REFERENCE:                                                 DTSCS34
00113 *                                                                 DTSCS34
00114 *        NONE.                                                    DTSCS34
00115 *                                                                 DTSCS34
00116 *                                                                 DTSCS34
00117 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS34
00118 *                                                                 DTSCS34
00119 *        NONE.                                                    DTSCS34
00120 *                                                                 DTSCS34
00121 *                                                                 DTSCS34
00122 *    RECORDS UPDATED:                                             DTSCS34
00123 *                                                                 DTSCS34
00124 *      MASTER:                                                    DTSCS34
00125 *                                                                 DTSCS34
00126 *        NONE.                                                    DTSCS34
00127 *                                                                 DTSCS34
00128 *                                                                 DTSCS34
00129 *      REFERENCE:                                                 DTSCS34
00130 *                                                                 DTSCS34
00131 *        NONE.                                                    DTSCS34
00132 *                                                                 DTSCS34
00133 *                                                                 DTSCS34
00134 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS34
00135 *                                                                 DTSCS34
00136 *        NONE.                                                    DTSCS34
00137 *                                                                 DTSCS34
00138 *                                                                 DTSCS34
00139 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS34
00140 *                                                                 DTSCS34
00141 *      NONE.                                                      DTSCS34
00142 *                                                                 DTSCS34
00143 *                                                                 DTSCS34
00144 *    TEMPORARY STORAGE USAGE:                                     DTSCS34
00145 *                                                                 DTSCS34
00146 *      S  IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL.             DTSCS34
00147 *                                                                 DTSCS34
00148 *                                                                 DTSCS34
00149 *    MODULES LINKED TO:                                           DTSCS34
00150 *                                                                 DTSCS34
00151 *      DTSCU001  DATE EDIT/CONVERSION.                               CL**2
00152 *      DTSCU004  QUARTER EDIT/CONVERSION.                            CL**2
00153 *      DTSCU029  YEAR/QUARTER FROM SCREEN FORMAT/EDIT.               CL**8
00154 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.            CL**2
00155 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                           CL**2
00156 *      DTSCU829  TEMPORARY STORAGE INPUT/OUTPUT.                     CL**2
00157 *                                                                 DTSCS34
00158 *                                                                 DTSCS34
00159 *    VERMONT REFERENCE:                                           DTSCS34
00160 *                                                                 DTSCS34
00161 *      TXC230C.                                                   DTSCS34
00162 *                                                                 DTSCS34
00163 *****                                                             DTSCS34
00164      SKIP3                                                        DTSCS34
00165  ENVIRONMENT DIVISION.                                            DTSCS34
00166      SKIP3                                                        DTSCS34
00167  DATA DIVISION.                                                   DTSCS34
00168      SKIP3                                                        DTSCS34
00169  WORKING-STORAGE SECTION.                                         DTSCS34
001695 77  PAN-VALET PICTURE X(24) VALUE '009DTSCS34   05/18/99'.       DTSCS34
00170      SKIP3                                                        DTSCS34
00171  01  WRK-AREA.                                                    DTSCS34
00172      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S34 '.    DTSCS34
00173      SKIP1                                                        DTSCS34
00174      05  WRK-SCR-ID.                                              DTSCS34
00175          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 34.        DTSCS34
00176      SKIP1                                                        DTSCS34
00177      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '30'.      DTSCS34
00178                                                                   DTSCS34
00179      05  LINES-PER-PAGE              PIC S9(04)  COMP  VALUE +16. DTSCS34
00180                                                                   DTSCS34
00181      05  ALL-NINES-YRQ               PIC S9(05)  COMP-3           DTSCS34
00182                                                  VALUE +99999.    DTSCS34
00183                                                                   DTSCS34
00184      05  NULL-DOC-NO.                                             DTSCS34
00185          10  FILLER                  PIC S9(05)  COMP-3 VALUE +0. DTSCS34
00186          10  FILLER                  PIC S9(03)  COMP-3 VALUE +0. DTSCS34
00187      SKIP3                                                        DTSCS34
00188      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS34
00189          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS34
00190          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS34
00191      SKIP1                                                        DTSCS34
00192      05  CURSOR-SET-IND              PIC X(01).                   DTSCS34
00193          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS34
00194          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS34
00195          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS34
00196      SKIP1                                                        DTSCS34
00197      05  REQ-IND                     PIC X(01).                   DTSCS34
00198          88  REQ-ERROR                       VALUE 'O'.           DTSCS34
00199          88  REQ-JUMP                        VALUE 'J'.           DTSCS34
00200          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS34
00201          88  REQ-CLEAR                       VALUE 'C'.           DTSCS34
00202          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS34
00203      SKIP1                                                        DTSCS34
00204      05  RESP-IND                    PIC X(01).                   DTSCS34
00205          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS34
00206          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS34
00207          88  RESP-JUMP                       VALUE 'J'.           DTSCS34
00208          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS34
00209      SKIP1                                                        DTSCS34
00210      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS34
00211      SKIP1                                                        DTSCS34
00212      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS34
00213      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS34
00214      SKIP3                                                        DTSCS34
00215      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS34
00216                                                                   DTSCS34
00217      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS34
00218          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS34
00219          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS34
00220                                                                   DTSCS34
00221      05  WRK-YRQ                     PIC S9(05)  COMP-3.          DTSCS34
00222      SKIP3                                                        DTSCS34
00223      05  PROCESS-YRQ                 PIC S9(05)  COMP-3.          DTSCS34
00224      SKIP3                                                        DTSCS34
00225      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS34
00226      SKIP1                                                        DTSCS34
00227      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS34
00228          10  FILLER                  PIC X(05).                   DTSCS34
00229          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS34
00230          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS34
00231      SKIP1                                                        DTSCS34
00232      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS34
00233          10  FILLER                  PIC X(08).                   DTSCS34
00234          10  WRK-DISPLAY-YRQ-YR      PIC X(02).                   DTSCS34
00235          10  WRK-DISPLAY-YRQ-Q       PIC X(01).                   DTSCS34
00236      SKIP3                                                        DTSCS34
00237      05  LINE-OCC                    PIC S9(04)  COMP.            DTSCS34
00238                                                                   DTSCS34
00239      05  DOC-NO-BREAK-IND            PIC  X(01).                  DTSCS34
00240      05  LINE-TYPE-BREAK-IND         PIC  X(01).                  DTSCS34
00241      05  YRQ-BREAK-IND               PIC  X(01).                  DTSCS34
00242                                                                   DTSCS34
00243      05  HOLD-MDST-KEY-AREA          PIC  X(16).                  DTSCS34
00244                                                                   DTSCS34
00245      05  PAY-BROWSE-IN-PROGRESS-IND  PIC  X(01).                  DTSCS34
00246                                                                   DTSCS34
00247      05  HOLD-MDST-SUB               PIC S9(04)  COMP.            DTSCS34
00248      SKIP3                                                        DTSCS34
00249      05  SCR-HOLD-AREA.                                           DTSCS34
00250          10  SCR-HOLD-EMP-NO         PIC S9(07)  COMP-3.          DTSCS34
00251          10  SCR-HOLD-YRQ            PIC S9(05)  COMP-3.          DTSCS34
00252          10  SCR-HOLD-CURR-PAGE-NUM  PIC S9(04)  COMP.            DTSCS34
00253      SKIP3                                                        DTSCS34
00254      05  INQUIRY-CONTROL-AREA.                                    DTSCS34
00255          10  ITEM-LENGTH         PIC S9(04)  COMP VALUE +594.        CL**6
00256                                                                   DTSCS34
00257          10  ITEM-MAX            PIC S9(05)  COMP VALUE +32760.   DTSCS34
00258                                                                   DTSCS34
00259          10  ITEM-MAX-LCCM       PIC S9(04)  COMP VALUE +3.       DTSCS34
00260                                                                   DTSCS34
00261          10  CURR-PAGE-NUM       PIC S9(04)  COMP.                DTSCS34
00262                                                                   DTSCS34
00263          10  ITEM-SUB            PIC S9(04)  COMP.                DTSCS34
00264                                                                   DTSCS34
00265          10  ITEM-CNT            PIC S9(04)  COMP.                DTSCS34
00266      SKIP3                                                        DTSCS34
00267 *****                                                             DTSCS34
00268 *                                                                 DTSCS34
00269 *    IF THE LENGTH OF PAGE-AREA IS MODIFIED, THEN MAKE            DTSCS34
00270 *    CORRESPONDING MODIFICATIONS TO ITEM-LENGTH, L829-REC,        DTSCS34
00271 *    AND LCCM-SCR-HOLD-PAGE-AREA.                                 DTSCS34
00272 *                                                                 DTSCS34
00273 *****                                                             DTSCS34
00274                                                                   DTSCS34
00275      05  PAGE-AREA               PIC  X(594).                        CL**6
00276                                                                   DTSCS34
00277      05  FILLER REDEFINES PAGE-AREA.                              DTSCS34
00278          10  PAGE-LINE-CNT       PIC S9(04)  COMP.                DTSCS34
00279                                                                   DTSCS34
00280          10  PAGE-LINE OCCURS 16 TIMES.                           DTSCS34
00281              15  PAGE-PAY-TYPE            PIC  X(02).             DTSCS34
00282              15  PAGE-DOC-NO.                                     DTSCS34
00283                  20  PAGE-BATCH-NO        PIC S9(05)       COMP-3.DTSCS34
00284                  20  PAGE-ITEM-NO         PIC S9(03)       COMP-3.DTSCS34
00285              15  PAGE-RECEIVED-DATE       PIC S9(09)       COMP-3.DTSCS34
00286              15  PAGE-PROCESSED-DATE      PIC S9(09)       COMP-3.DTSCS34
00287              15  PAGE-WAIVE-INT-IND       PIC  X(01).                CL**2
00288              15  PAGE-WAIVE-PEN-IND       PIC  X(01).                CL**2
00289              15  PAGE-NSF-PEN-IND         PIC  X(01).                CL**2
00290              15  PAGE-LINE-TYPE           PIC  X(01).             DTSCS34
00291                  88  PAGE-LINE-TYPE-TRAN-88      VALUE 'T'.       DTSCS34
00292                  88  PAGE-LINE-TYPE-DSTR-88      VALUE 'D'.       DTSCS34
00293                  88  PAGE-LINE-TYPE-REVR-88      VALUE 'R'.       DTSCS34
00294              15  PAGE-APPLIC-YRQ          PIC S9(05)       COMP-3.DTSCS34
00295              15  PAGE-APPLIC-IND          PIC  X(02).             DTSCS34
00296              15  PAGE-APPLIC-DOC-NO.                              DTSCS34
00297                  20  PAGE-APPLIC-BATCH-NO PIC S9(05)       COMP-3.DTSCS34
00298                  20  PAGE-APPLIC-ITEM-NO  PIC S9(03)       COMP-3.DTSCS34
00299              15  PAGE-APPLIC-AMT          PIC S9(09)V9(02) COMP-3.DTSCS34
00300 *****EJECT                                                        DTSCS34
00301 *01  MSG-LITERALS.                                                DTSCS34
00302 *****05  MSG-E341-AREA.                                           DTSCS34
00303 *****    10  FILLER                  PIC  X(04)  VALUE 'E341'.    DTSCS34
00304 *****    10  FILLER                  PIC  X(30)                   DTSCS34
00305 *****          VALUE '                              '.            DTSCS34
00306 *****    10  FILLER                  PIC  X(30)                   DTSCS34
00307 *****          VALUE '                              '.            DTSCS34
00308      EJECT                                                        DTSCS34
00309  01  L001-COMM-AREA.                                              DTSCS34
00310  ++INCLUDE DTSIL001                                                  CL**2
00311      EJECT                                                        DTSCS34
00312  01  L004-COMM-AREA.                                              DTSCS34
00313  ++INCLUDE DTSIL004                                                  CL**2
00314      EJECT                                                        DTSCS34
00315  01  L018-COMM-AREA.                                              DTSCS34
00316  ++INCLUDE DTSIL018                                                  CL**2
00317      EJECT                                                           CL**8
00318  01  L029-COMM-AREA.                                                 CL**8
00319  ++INCLUDE DTSIL029                                                  CL**8
00320      EJECT                                                        DTSCS34
00321  01  L805-COMM-AREA.                                              DTSCS34
00322  ++INCLUDE DTSIL805                                                  CL**2
00323      EJECT                                                        DTSCS34
00324  01  L810-COMM-AREA.                                              DTSCS34
00325      05  L810-CONTROL-BLOCK.                                      DTSCS34
00326  ++INCLUDE DTSIL810                                                  CL**2
00327      EJECT                                                        DTSCS34
00328      05  MSKL-REC.                                                DTSCS34
00329  ++INCLUDE DTSIMSKL                                                  CL**2
00330      EJECT                                                        DTSCS34
00331  01  MPRF-REC.                                                    DTSCS34
00332  ++INCLUDE DTSIMPRF                                                  CL**2
00333      EJECT                                                        DTSCS34
00334  01  MPAY-REC.                                                    DTSCS34
00335  ++INCLUDE DTSIMPAY                                                  CL**2
00336      EJECT                                                        DTSCS34
00337  01  MDST-REC.                                                    DTSCS34
00338  ++INCLUDE DTSIMDST                                                  CL**2
00339      EJECT                                                        DTSCS34
00340  01  MREV-REC.                                                    DTSCS34
00341  ++INCLUDE DTSIMREV                                                  CL**2
00342      EJECT                                                        DTSCS34
00343  01  L829-COMM-AREA.                                              DTSCS34
00344      05  L829-CONTROL-BLOCK.                                      DTSCS34
00345  ++INCLUDE DTSIL829                                                  CL**2
00346      SKIP3                                                        DTSCS34
00347      05  L829-REC                 PIC  X(594).                       CL**6
00348      EJECT                                                        DTSCS34
00349  01  L851-COMM-AREA.                                              DTSCS34
00350  ++INCLUDE DTSIL851                                                  CL**2
00351      SKIP3                                                        DTSCS34
00352      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS34
00353  ++INCLUDE DTSIS34                                                   CL**2
00354      EJECT                                                        DTSCS34
00355  01  CATB-LITERALS.                                               DTSCS34
00356  ++INCLUDE DTSICATB                                                  CL**2
00357      SKIP3                                                        DTSCS34
00358  01  CFKD-LITERALS.                                               DTSCS34
00359  ++INCLUDE DTSICFKD                                                  CL**2
00360      SKIP3                                                        DTSCS34
00361  01  CECD-LITERALS.                                               DTSCS34
00362  ++INCLUDE DTSICECD                                                  CL**2
00363      SKIP3                                                        DTSCS34
00364  01  CPCD-LITERALS.                                               DTSCS34
00365  ++INCLUDE DTSICPCD                                                  CL**2
00366      EJECT                                                        DTSCS34
00367  01  DST-TABLE.                                                   DTSCS34
00368      05  DST-OCC-MAX                PIC S9(04)  COMP  VALUE +500. DTSCS34
00369                                                                   DTSCS34
00370      05  DST-OCC-CNT                PIC S9(04)  COMP.             DTSCS34
00371                                                                   DTSCS34
00372      05  DST-GROUP OCCURS 500 TIMES                               DTSCS34
00373                    INDEXED BY DST-GROUP-IDX.                      DTSCS34
00374          10  DST-YRQ                PIC S9(05)        COMP-3.     DTSCS34
00375          10  DST-DOC-NO.                                          DTSCS34
00376              15  DST-BATCH-NO       PIC S9(05)        COMP-3.     DTSCS34
00377              15  DST-ITEM-NO        PIC S9(03)        COMP-3.     DTSCS34
00378          10  DST-ACCT-IND           PIC  X(02).                   DTSCS34
00379          10  DST-AMT                PIC S9(09)V9(02)  COMP-3.     DTSCS34
00380      SKIP3                                                        DTSCS34
00381  01  REV-TABLE.                                                   DTSCS34
00382      05  REV-OCC-MAX                PIC S9(04)  COMP  VALUE +250. DTSCS34
00383                                                                   DTSCS34
00384      05  REV-OCC-CNT                PIC S9(04)  COMP.             DTSCS34
00385                                                                   DTSCS34
00386      05  REV-GROUP OCCURS 250 TIMES                               DTSCS34
00387                    INDEXED BY REV-GROUP-IDX.                      DTSCS34
00388          10  REV-PA-DOC-NO.                                       DTSCS34
00389              15  REV-PA-BATCH-NO    PIC S9(05)        COMP-3.     DTSCS34
00390              15  REV-PA-ITEM-NO     PIC S9(03)        COMP-3.     DTSCS34
00391          10  REV-PU-RF-PR-DOC-NO.                                 DTSCS34
00392              15  REV-PU-RF-PR-BATCH-NO  PIC S9(05)    COMP-3.     DTSCS34
00393              15  REV-PU-RF-PR-ITEM-NO   PIC S9(03)    COMP-3.     DTSCS34
00394          10  REV-FATE               PIC  X(02).                   DTSCS34
00395          10  REV-AMT                PIC S9(09)V9(02)  COMP-3.     DTSCS34
00396      EJECT                                                        DTSCS34
00397  LINKAGE SECTION.                                                 DTSCS34
00398      SKIP3                                                        DTSCS34
00399  01  DFHCOMMAREA.                                                 DTSCS34
00400  ++INCLUDE DTSILCCM                                                  CL**2
00401      SKIP3                                                        DTSCS34
00402              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS34
00403                  20  LCCM-SCR-HOLD-CONTROL-AREA.                  DTSCS34
00404                      25  LCCM-SCR-HOLD-EMP-NO  PIC S9(07)  COMP-3.DTSCS34
00405                      25  LCCM-SCR-HOLD-YRQ     PIC S9(05)  COMP-3.DTSCS34
00406                      25  LCCM-SCR-HOLD-ABSTIME PIC S9(15)  COMP-3.DTSCS34
00407                      25  LCCM-SCR-HOLD-LAST-PAGE-NUM              DTSCS34
00408                                                PIC S9(04)  COMP.  DTSCS34
00409                                                                   DTSCS34
00410                  20  LCCM-SCR-HOLD-PAGE-AREA OCCURS 3 TIMES       DTSCS34
00411                                                PIC  X(594).          CL**6
00412      EJECT                                                        DTSCS34
00413 ******************************************************************DTSCS34
00414 *                                                                *DTSCS34
00415 ******************************************************************DTSCS34
00416      SKIP1                                                        DTSCS34
00417  PROCEDURE DIVISION.                                              DTSCS34
00418      SKIP2                                                        DTSCS34
00419      MOVE +0 TO WRK-EMP-NO.                                       DTSCS34
00420                                                                   DTSCS34
00421      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS34
00422                                                                   DTSCS34
00423      MOVE +0 TO WRK-YRQ.                                          DTSCS34
00424      SKIP1                                                        DTSCS34
00425      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS34
00426      SKIP1                                                        DTSCS34
00427      SET CURSOR-SET-NO TO TRUE.                                   DTSCS34
00428      SKIP1                                                        DTSCS34
00429      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS34
00430        TO SCR-ACCESS-IND.                                         DTSCS34
00431      SKIP3                                                        DTSCS34
00432      MOVE SPACE TO REQ-IND.                                       DTSCS34
00433      SKIP1                                                        DTSCS34
00434      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS34
00435      SKIP1                                                        DTSCS34
00436 *-----------------------------------------------------            DTSCS34
00437 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS34
00438 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS34
00439 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS34
00440 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS34
00441 *                                                                 DTSCS34
00442 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS34
00443 *    PROCESSED.                                                   DTSCS34
00444 *                                                                 DTSCS34
00445 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS34
00446 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS34
00447 *    WORK STATION OPERATOR.                                       DTSCS34
00448 *-----------------------------------------------------            DTSCS34
00449      SKIP1                                                        DTSCS34
00450      MOVE SPACE TO RESP-IND.                                      DTSCS34
00451      SKIP1                                                        DTSCS34
00452      IF REQ-ERROR                                                 DTSCS34
00453         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS34
00454      ELSE                                                         DTSCS34
00455      IF REQ-JUMP                                                  DTSCS34
00456         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS34
00457      ELSE                                                         DTSCS34
00458      IF REQ-CLEAR                                                 DTSCS34
00459         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS34
00460      ELSE                                                         DTSCS34
00461      IF REQ-CURSOR-TO-GOTO                                        DTSCS34
00462         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS34
00463      ELSE                                                         DTSCS34
00464      IF REQ-INQUIRE                                               DTSCS34
00465         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS34
00466      ELSE                                                         DTSCS34
00467 *****IF REQ-EDIT                                                  DTSCS34
00468 *****   PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS34
00469 *****ELSE                                                         DTSCS34
00470 *****IF REQ-UPDATE                                                DTSCS34
00471 *****   PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS34
00472 *****ELSE                                                         DTSCS34
00473         GO TO S899-ABEND.                                         DTSCS34
00474      SKIP3                                                        DTSCS34
00475 *-----------------------------------------------------            DTSCS34
00476 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS34
00477 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS34
00478 *-----------------------------------------------------            DTSCS34
00479      SKIP1                                                        DTSCS34
00480      IF RESP-SEND-MAP                                             DTSCS34
00481          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS34
00482          SET LCCM-END-TASK-88 TO TRUE                             DTSCS34
00483      ELSE                                                         DTSCS34
00484      IF RESP-SEND-MSGONLY                                         DTSCS34
00485          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS34
00486          SET LCCM-END-TASK-88 TO TRUE                             DTSCS34
00487      ELSE                                                         DTSCS34
00488      IF RESP-JUMP                                                 DTSCS34
00489          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS34
00490      ELSE                                                         DTSCS34
00491      IF RESP-CURSOR-TO-GOTO                                       DTSCS34
00492          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS34
00493          SET LCCM-END-TASK-88 TO TRUE                             DTSCS34
00494      ELSE                                                         DTSCS34
00495          GO TO S899-ABEND.                                        DTSCS34
00496      SKIP3                                                        DTSCS34
00497  MAINLINE-EXIT.                                                   DTSCS34
00498      SKIP1                                                        DTSCS34
00499      EXEC CICS                                                    DTSCS34
00500          RETURN                                                   DTSCS34
00501      END-EXEC.                                                    DTSCS34
00502      SKIP2                                                        DTSCS34
00503      GOBACK.                                                      DTSCS34
00504      EJECT                                                        DTSCS34
00505 /*****************************************************************DTSCS34
00506 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS34
00507 ******************************************************************DTSCS34
00508  P1000-ANALYZE-REQUEST.                                           DTSCS34
00509      SKIP1                                                        DTSCS34
00510 *-----------------------------------------------------            DTSCS34
00511 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS34
00512 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS34
00513 *     REPLACED WITH ENTER)                                        DTSCS34
00514 *-----------------------------------------------------            DTSCS34
00515      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS34
00516          MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA                    DTSCS34
00517          SET LCCM-ENTER-88 TO TRUE                                DTSCS34
00518          IF LCCM-EMP-NO = +0                                      DTSCS34
00519              MOVE +0 TO LCCM-YRQ                                  DTSCS34
00520              MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA                DTSCS34
00521              SET REQ-CLEAR TO TRUE                                DTSCS34
00522          ELSE                                                     DTSCS34
00523              SET REQ-INQUIRE TO TRUE                              DTSCS34
00524              MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                   DTSCS34
00525              MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                   DTSCS34
00526              PERFORM P1100-CHECK-LCCM-YRQ THRU P1100-EXIT         DTSCS34
00527          END-IF                                                   DTSCS34
00528          GO TO P1000-EXIT.                                        DTSCS34
00529      SKIP3                                                        DTSCS34
00530 *-----------------------------------------------------            DTSCS34
00531 *      MAP IS RECEIVED                                            DTSCS34
00532 *-----------------------------------------------------            DTSCS34
00533      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS34
00534      SKIP3                                                        DTSCS34
00535 *-----------------------------------------------------            DTSCS34
00536 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS34
00537 *    WORK STATION                                                 DTSCS34
00538 *-----------------------------------------------------            DTSCS34
00539      IF LCCM-CLEAR-88                                             DTSCS34
00540         SET REQ-CLEAR TO TRUE                                     DTSCS34
00541         GO TO P1000-EXIT.                                         DTSCS34
00542      SKIP3                                                        DTSCS34
00543 *-----------------------------------------------------               CL**2
00544 *    IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS                CL**2
00545 *    CLEAR SCREEN                                                    CL**2
00546 *-----------------------------------------------------               CL**2
00547      IF LCCM-F12-88                                                  CL**2
00548         MOVE LOW-VALUES TO MAP-AREA                                  CL**2
00549         SET REQ-CLEAR TO TRUE                                        CL**2
00550         GO TO P1000-EXIT.                                            CL**2
00551      SKIP3                                                           CL**2
00552 *-----------------------------------------------------            DTSCS34
00553 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS34
00554 *-----------------------------------------------------            DTSCS34
00555      IF LCCM-PA2-88                                               DTSCS34
00556          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS34
00557          GO TO P1000-EXIT.                                        DTSCS34
00558      SKIP3                                                        DTSCS34
00559 *-----------------------------------------------------            DTSCS34
00560 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS34
00561 *-----------------------------------------------------            DTSCS34
00562      IF LCCM-PA-88                                                DTSCS34
00563        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS34
00564        SET REQ-ERROR TO TRUE                                      DTSCS34
00565        GO TO P1000-EXIT.                                          DTSCS34
00566      SKIP3                                                        DTSCS34
00567 *-----------------------------------------------------            DTSCS34
00568 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS34
00569 *-----------------------------------------------------            DTSCS34
00570      IF LCCM-F03-88                                               DTSCS34
00571         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS34
00572         SET REQ-JUMP TO TRUE                                      DTSCS34
00573         GO TO P1000-EXIT.                                         DTSCS34
00574      SKIP3                                                        DTSCS34
00575 *-----------------------------------------------------            DTSCS34
00576 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS34
00577 *-----------------------------------------------------            DTSCS34
00578      IF LCCM-F04-88                                               DTSCS34
00579         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS34
00580         SET REQ-JUMP TO TRUE                                      DTSCS34
00581         GO TO P1000-EXIT.                                         DTSCS34
00582      SKIP3                                                        DTSCS34
00583 *-----------------------------------------------------            DTSCS34
00584 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS34
00585 *    CORRESPONDENCE SCREEN                                        DTSCS34
00586 *-----------------------------------------------------            DTSCS34
00587      IF LCCM-F14-88                                                  CL**7
00588         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                     CL**7
00589         SET REQ-JUMP TO TRUE                                         CL**7
00590         GO TO P1000-EXIT.                                            CL**7
00591      SKIP3                                                           CL**7
00592 *    IF LCCM-F09-88                                                  CL**2
00593 *        MOVE '31' TO LCCM-REQ-SCR-ID                                CL**2
00594 *        SET REQ-JUMP TO TRUE                                        CL**2
00595 *        GO TO P1000-EXIT.                                           CL**2
00596 *                                                                    CL**2
00597 *    IF LCCM-F10-88                                                  CL**2
00598 *        MOVE '33' TO LCCM-REQ-SCR-ID                                CL**2
00599 *        SET REQ-JUMP TO TRUE                                        CL**2
00600 *        GO TO P1000-EXIT.                                           CL**2
00601 *                                                                    CL**2
00602 *    IF LCCM-F12-88                                                  CL**2
00603 *        MOVE '35' TO LCCM-REQ-SCR-ID                                CL**2
00604 *        SET REQ-JUMP TO TRUE                                        CL**2
00605 *        GO TO P1000-EXIT.                                           CL**2
00606 *    SKIP3                                                           CL**2
00607 *-----------------------------------------------------            DTSCS34
00608 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS34
00609 *    REQUESTED SCREEN TYPE                                        DTSCS34
00610 *-----------------------------------------------------            DTSCS34
00611      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS34
00612         NEXT SENTENCE                                             DTSCS34
00613      ELSE                                                         DTSCS34
00614        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS34
00615        SET REQ-JUMP TO TRUE                                       DTSCS34
00616        GO TO P1000-EXIT.                                          DTSCS34
00617      SKIP3                                                        DTSCS34
00618 *-----------------------------------------------------            DTSCS34
00619 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS34
00620 *          F8), INDICATE INQUIRY REQUEST                          DTSCS34
00621 *-----------------------------------------------------            DTSCS34
00622      IF LCCM-INQUIRY-88                                           DTSCS34
00623          SET REQ-INQUIRE TO TRUE                                  DTSCS34
00624          GO TO P1000-EXIT.                                        DTSCS34
00625      SKIP3                                                        DTSCS34
00626 *-----------------------------------------------------            DTSCS34
00627 *     ANY OTHER KEY IS INVALID                                    DTSCS34
00628 *-----------------------------------------------------            DTSCS34
00629      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS34
00630      SET REQ-ERROR TO TRUE.                                       DTSCS34
00631  P1000-EXIT.                                                      DTSCS34
00632      EXIT.                                                        DTSCS34
00633      SKIP3                                                        DTSCS34
00634  P1100-CHECK-LCCM-YRQ.                                            DTSCS34
00635 *****IF LCCM-YRQ = ALL-NINES-YRQ                                  DTSCS34
00636 *********MOVE +0 TO LCCM-YRQ                                         CL**9
00637 *********GO TO P1100-EXIT.                                           CL**9
00638                                                                      CL**9
00639      IF LCCM-YRQ < LCCM-PICKUP-YRQ                                   CL**9
00640          MOVE +0 TO LCCM-YRQ                                         CL**9
00641          GO TO P1100-EXIT.                                           CL**9
00642                                                                   DTSCS34
00643      IF LCCM-YRQ > +0                                             DTSCS34
00644          PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT                DTSCS34
00645          GO TO P1100-EXIT.                                        DTSCS34
00646                                                                      CL**9
00647 *****MOVE LCCM-SCR34-HOLD-AREA TO SCR-HOLD-AREA.                  DTSCS34
00648 *****IF SCR-HOLD-AREA  NOT =  LOW-VALUES                          DTSCS34
00649 *********IF SCR-HOLD-EMP-NO = LCCM-EMP-NO                            CL**9
00650 ***********IF SCR-HOLD-YRQ > +0                                      CL**9
00651 *************MOVE SCR-HOLD-YRQ TO LCCM-YRQ                           CL**9
00652 *************PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT.              CL**9
00653  P1100-EXIT.                                                      DTSCS34
00654      EXIT.                                                        DTSCS34
00655      SKIP3                                                        DTSCS34
00656  P1110-DISPLAY-YRQ.                                               DTSCS34
00657      IF LCCM-YRQ = LCCM-PICKUP-YRQ                                   CL**9
00658          MOVE 'PU' TO MAP-YRQ-YR                                     CL**9
00659          MOVE ' ' TO MAP-YRQ-Q                                       CL**9
00660      ELSE                                                            CL**9
00661          MOVE LCCM-YRQ TO WRK-DISPLAY                                CL**9
00662          MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR                       CL**9
00663          MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q.                        CL**9
00664  P1110-EXIT.                                                      DTSCS34
00665      EXIT.                                                        DTSCS34
00666 /*****************************************************************DTSCS34
00667 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS34
00668 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS34
00669 ******************************************************************DTSCS34
00670      SKIP1                                                        DTSCS34
00671  P2000-REQUEST-ERROR.                                             DTSCS34
00672      IF LCCM-MSG                                                  DTSCS34
00673         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS34
00674      ELSE                                                         DTSCS34
00675         GO TO S899-ABEND.                                         DTSCS34
00676  P2000-EXIT.                                                      DTSCS34
00677      EXIT.                                                        DTSCS34
00678 /*****************************************************************DTSCS34
00679 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS34
00680 ******************************************************************DTSCS34
00681      SKIP1                                                        DTSCS34
00682  P3000-REQUEST-JUMP.                                              DTSCS34
00683 *-----------------------------------------------------            DTSCS34
00684 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS34
00685 *    BY USER                                                      DTSCS34
00686 *-----------------------------------------------------            DTSCS34
00687      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS34
00688      SKIP3                                                        DTSCS34
00689 *-----------------------------------------------------            DTSCS34
00690 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS34
00691 *-----------------------------------------------------            DTSCS34
00692      IF LCCM-MSG                                                  DTSCS34
00693         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS34
00694         SET CURSOR-SET-GOTO TO TRUE                               DTSCS34
00695         GO TO P3000-EXIT.                                         DTSCS34
00696      SKIP3                                                        DTSCS34
00697      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS34
00698      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS34
00699      IF L018-VALID                                                DTSCS34
00700          MOVE L018-EMP-NO TO LCCM-EMP-NO                          DTSCS34
00701                                                                   DTSCS34
00702          MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA                        CL**8
00703          PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT                 CL**8
00704          IF L029-VALID                                               CL**8
00705              MOVE L029-YRQ TO LCCM-YRQ.                              CL**8
00706      SKIP3                                                        DTSCS34
00707 *-----------------------------------------------------            DTSCS34
00708 *    IF PAGES OF INFORMATION ARE IN TS, THEN BEFORE               DTSCS34
00709 *    JUMPING OUT OF THIS MODULE, DELETE THE TS QUEUE.             DTSCS34
00710 *-----------------------------------------------------            DTSCS34
00711                                                                   DTSCS34
00712      IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES                   DTSCS34
00713          NEXT SENTENCE                                            DTSCS34
00714      ELSE                                                         DTSCS34
00715          IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM           DTSCS34
00716              PERFORM S829-DELETE-QUEUE THRU S829-EXIT.            DTSCS34
00717      SKIP3                                                        DTSCS34
00718 *-----------------------------------------------------            DTSCS34
00719 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS34
00720 *-----------------------------------------------------            DTSCS34
00721      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS34
00722                         LCCM-SCR-HOLD-AREA.                       DTSCS34
00723      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS34
00724      SET RESP-JUMP TO TRUE.                                       DTSCS34
00725  P3000-EXIT.                                                      DTSCS34
00726      EXIT.                                                        DTSCS34
00727 /*****************************************************************DTSCS34
00728 * CLEAR KEY WAS PRESSED                                          *DTSCS34
00729 ******************************************************************DTSCS34
00730      SKIP1                                                        DTSCS34
00731  P4000-REQUEST-CLEAR.                                             DTSCS34
00732 *-----------------------------------------------------            DTSCS34
00733 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS34
00734 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS34
00735 *-----------------------------------------------------            DTSCS34
00736      IF LCCM-EMP-NO > ZERO                                        DTSCS34
00737          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS34
00738          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS34
00739                                                                   DTSCS34
00740      MOVE ZERO TO LCCM-EMP-NO                                     DTSCS34
00741                   LCCM-YRQ.                                       DTSCS34
00742                                                                   DTSCS34
00743      MOVE LOW-VALUES TO LCCM-SCR34-HOLD-AREA.                     DTSCS34
00744                                                                   DTSCS34
00745                                                                   DTSCS34
00746      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS34
00747                                                                   DTSCS34
00748      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS34
00749                                                                   DTSCS34
00750      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS34
00751                                                                   DTSCS34
00752      SET RESP-SEND-MAP TO TRUE.                                   DTSCS34
00753  P4000-EXIT.                                                      DTSCS34
00754      EXIT.                                                        DTSCS34
00755 /*****************************************************************DTSCS34
00756 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS34
00757 ******************************************************************DTSCS34
00758      SKIP1                                                        DTSCS34
00759  P5000-CURSOR-TO-GOTO.                                            DTSCS34
00760      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS34
00761      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS34
00762  P5000-EXIT.                                                      DTSCS34
00763      EXIT.                                                        DTSCS34
00764 /*****************************************************************DTSCS34
00765 * INQUIRY WAS REQUESTED                                          *DTSCS34
00766 ******************************************************************DTSCS34
00767      SKIP1                                                        DTSCS34
00768  P6000-REQUEST-INQUIRE.                                           DTSCS34
00769 *------------------------------------------------------------     DTSCS34
00770 *    CLEAR MAP-AREA WHILE PRESERVING MAP-EMP-NO-AREA AND          DTSCS34
00771 *    MAP-YRQ-AREA.                                                DTSCS34
00772 *------------------------------------------------------------     DTSCS34
00773                                                                   DTSCS34
00774      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS34
00775                                                                   DTSCS34
00776      MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA.                           CL**8
00777                                                                   DTSCS34
00778      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS34
00779                                                                   DTSCS34
00780      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS34
00781                                                                   DTSCS34
00782      MOVE L029-S-YRQ-AREA TO MAP-YRQ-AREA.                           CL**8
00783                                                                   DTSCS34
00784                                                                   DTSCS34
00785      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS34
00786                                                                   DTSCS34
00787      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS34
00788                                                                   DTSCS34
00789      SET RESP-SEND-MAP TO TRUE.                                   DTSCS34
00790                                                                   DTSCS34
00791      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS34
00792                                                                   DTSCS34
00793                                                                   DTSCS34
00794 *------------------------------------------------------------     DTSCS34
00795 *    IF LAST ACTION WAS A SCREEN 33 DISPLAY, THEN LCCM-SCR34      DTSCS34
00796 *    HOLD-AREA CONTAINS EMP NO, YRQ AND PAGE NUMBER LAST          DTSCS34
00797 *    DISPLAYED.                                                   DTSCS34
00798 *------------------------------------------------------------     DTSCS34
00799                                                                   DTSCS34
00800      MOVE LCCM-SCR34-HOLD-AREA TO SCR-HOLD-AREA.                  DTSCS34
00801                                                                   DTSCS34
00802      MOVE LOW-VALUES TO LCCM-SCR34-HOLD-AREA.                     DTSCS34
00803                                                                   DTSCS34
00804                                                                   DTSCS34
00805 *------------------------------------------------------------     DTSCS34
00806 *    EDIT MAP-EMP-NO-AREA AND MAP-YRQ-AREA FOR VALIDITY.          DTSCS34
00807 *------------------------------------------------------------     DTSCS34
00808                                                                   DTSCS34
00809      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS34
00810      IF LCCM-MSG                                                  DTSCS34
00811          NEXT SENTENCE                                            DTSCS34
00812      ELSE                                                         DTSCS34
00813          MOVE WRK-EMP-NO TO LCCM-EMP-NO.                          DTSCS34
00814                                                                   DTSCS34
00815      PERFORM S1200-YRQ THRU S1200-EXIT.                           DTSCS34
00816      IF LCCM-MSG                                                  DTSCS34
00817          GO TO P6000-EXIT.                                        DTSCS34
00818                                                                   DTSCS34
00819      MOVE WRK-YRQ TO LCCM-YRQ.                                    DTSCS34
00820                                                                   DTSCS34
00821                                                                   DTSCS34
00822 *------------------------------------------------------------     DTSCS34
00823 *    THIS MODULE CONSTRUCTS PAGES OF INFORMATION INTO             DTSCS34
00824 *    LCCM-SCR-HOLD-AREA (WITH ANY OVERFLOW STORED IN TS)          DTSCS34
00825 *    AND RETAINS THIS INFORMATION BETWEEN TASKS.                  DTSCS34
00826 *                                                                 DTSCS34
00827 *    IF LCCM-SCR-HOLD-AREA CONTAINS INFORMATION FOR THE EMP-NO    DTSCS34
00828 *    AND YRQ SPECIFIED ON THE SCREEN AND THE EMPLOYER'S           DTSCS34
00829 *    RECORDS HAVE NOT BEEN UPDATED SINCE THE LCCM-SCR-HOLD-AREA   DTSCS34
00830 *    WAS CONSTRUCTED, THEN THE INFORMATION IN LCCM-SCR-HOLD-AREA  DTSCS34
00831 *    MAY BE USED FOR PAGING AND DISPLAY - IT IS NOT NECESSARY     DTSCS34
00832 *    TO REBUILD LCCM-SCR-HOLD-AREA.                               DTSCS34
00833 *------------------------------------------------------------     DTSCS34
00834                                                                   DTSCS34
00835      IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES)                 DTSCS34
00836            OR                                                     DTSCS34
00837         (WRK-EMP-NO NOT = LCCM-SCR-HOLD-EMP-NO)                   DTSCS34
00838            OR                                                     DTSCS34
00839         (WRK-YRQ NOT = LCCM-SCR-HOLD-YRQ)                         DTSCS34
00840            OR                                                     DTSCS34
00841         (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME)         DTSCS34
00842          PERFORM P7000-CONSTRUCT-PAGES THRU P7000-EXIT.           DTSCS34
00843                                                                   DTSCS34
00844                                                                   DTSCS34
00845 *------------------------------------------------------------     DTSCS34
00846 *    IF NO INFORMATION IS AVAILABLE FOR DISPLAY, THEN YOU         DTSCS34
00847 *    ARE DONE.                                                    DTSCS34
00848 *------------------------------------------------------------     DTSCS34
00849                                                                   DTSCS34
00850      IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0                          DTSCS34
00851          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS34
00852          PERFORM S1299-ERROR THRU S1299-EXIT                      DTSCS34
00853          GO TO P6000-EXIT.                                        DTSCS34
00854                                                                   DTSCS34
00855                                                                   DTSCS34
00856 *------------------------------------------------------------     DTSCS34
00857 *    DETERMINE WHICH PAGE TO DISPLAY.                             DTSCS34
00858 *------------------------------------------------------------     DTSCS34
00859                                                                   DTSCS34
00860      PERFORM P6200-LOCATE-PAGE THRU P6200-EXIT.                   DTSCS34
00861      IF LCCM-MSG                                                  DTSCS34
00862          GO TO P6000-EXIT.                                        DTSCS34
00863                                                                   DTSCS34
00864                                                                   DTSCS34
00865 *------------------------------------------------------------     DTSCS34
00866 *    PLACE INFORMATION INTO MAP-AREA.                             DTSCS34
00867 *------------------------------------------------------------     DTSCS34
00868                                                                   DTSCS34
00869      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS34
00870                                                                   DTSCS34
00871                                                                   DTSCS34
00872      MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO.                          DTSCS34
00873                                                                   DTSCS34
00874      MOVE WRK-YRQ TO SCR-HOLD-YRQ.                                DTSCS34
00875                                                                   DTSCS34
00876      MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM.                DTSCS34
00877                                                                   DTSCS34
00878      MOVE SCR-HOLD-AREA TO LCCM-SCR34-HOLD-AREA.                  DTSCS34
00879                                                                   DTSCS34
00880                                                                   DTSCS34
00881      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS34
00882  P6000-EXIT.                                                      DTSCS34
00883      EXIT.                                                        DTSCS34
00884      EJECT                                                        DTSCS34
00885  P6200-LOCATE-PAGE.                                               DTSCS34
00886      IF (SCR-HOLD-AREA = LOW-VALUES)                              DTSCS34
00887            OR                                                     DTSCS34
00888         (SCR-HOLD-EMP-NO NOT = WRK-EMP-NO)                        DTSCS34
00889            OR                                                     DTSCS34
00890         (SCR-HOLD-YRQ NOT = WRK-YRQ)                              DTSCS34
00891          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS34
00892          GO TO P6200-EXIT.                                        DTSCS34
00893                                                                   DTSCS34
00894      IF LCCM-ENTER-88                                             DTSCS34
00895          MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM             DTSCS34
00896      ELSE                                                         DTSCS34
00897      IF LCCM-F05-88                                               DTSCS34
00898          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS34
00899      ELSE                                                         DTSCS34
00900      IF LCCM-F06-88                                               DTSCS34
00901          MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM        DTSCS34
00902      ELSE                                                         DTSCS34
00903      IF LCCM-F07-88                                               DTSCS34
00904          COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1       DTSCS34
00905      ELSE                                                         DTSCS34
00906      IF LCCM-F08-88                                               DTSCS34
00907          COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1       DTSCS34
00908      ELSE                                                         DTSCS34
00909          GO TO S899-ABEND.                                        DTSCS34
00910                                                                   DTSCS34
00911      IF CURR-PAGE-NUM < +1                                        DTSCS34
00912          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS34
00913      ELSE                                                         DTSCS34
00914      IF CURR-PAGE-NUM > LCCM-SCR-HOLD-LAST-PAGE-NUM               DTSCS34
00915          MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM.       DTSCS34
00916  P6200-EXIT.                                                      DTSCS34
00917      EXIT.                                                        DTSCS34
00918 /*****************************************************************DTSCS34
00919 *                                                                *DTSCS34
00920 ******************************************************************DTSCS34
00921      SKIP1                                                        DTSCS34
00922  P6900-CONSTRUCT-SCREEN.                                          DTSCS34
00923 *--------------------------------------------------------------   DTSCS34
00924 *    PAGES OF INFORMATION HAVE BEEN ASSEMBLED AND PLACED INTO     DTSCS34
00925 *    LCCM-SCR-HOLD-AREA AND A PAGE (CURR-PAGE-NUM) HAS BEEN       DTSCS34
00926 *    SELECTED FOR DISPLAY.  THUS, ALL THAT IS LEFT IS TO RETRIEVE DTSCS34
00927 *    THE SELECTED PAGE OF INFORMATION FROM LCCM-SCR-HOLD-AREA     DTSCS34
00928 *    (OR THE TS OVERFLOW) INTO PAGE-AREA AND MOVE DATA ELEMENTS   DTSCS34
00929 *    FROM PAGE-AREA TO MAP-AREA.                                  DTSCS34
00930 *--------------------------------------------------------------   DTSCS34
00931                                                                   DTSCS34
00932      MOVE CURR-PAGE-NUM TO ITEM-SUB.                              DTSCS34
00933                                                                   DTSCS34
00934      PERFORM P8200-RETREIVE-PAGE-AREA THRU P8200-EXIT.            DTSCS34
00935                                                                   DTSCS34
00936      PERFORM P6910-PAGE-AREA-TO-MAP THRU P6910-EXIT               DTSCS34
00937          VARYING LINE-OCC FROM 1 BY 1                             DTSCS34
00938          UNTIL LINE-OCC > PAGE-LINE-CNT.                          DTSCS34
00939                                                                   DTSCS34
00940      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCS34
00941  P6900-EXIT.                                                      DTSCS34
00942      EXIT.                                                        DTSCS34
00943      SKIP3                                                        DTSCS34
00944  P6910-PAGE-AREA-TO-MAP.                                          DTSCS34
00945      MOVE SPACE TO MAP-LINE (LINE-OCC).                           DTSCS34
00946                                                                   DTSCS34
00947      MOVE 'N' TO DOC-NO-BREAK-IND                                 DTSCS34
00948                  LINE-TYPE-BREAK-IND                              DTSCS34
00949                  YRQ-BREAK-IND.                                   DTSCS34
00950                                                                   DTSCS34
00951      IF LINE-OCC = +1                                             DTSCS34
00952          MOVE 'Y' TO DOC-NO-BREAK-IND                             DTSCS34
00953                      LINE-TYPE-BREAK-IND                          DTSCS34
00954                      YRQ-BREAK-IND                                DTSCS34
00955      ELSE                                                         DTSCS34
00956          IF PAGE-DOC-NO (LINE-OCC) = PAGE-DOC-NO (LINE-OCC - 1)   DTSCS34
00957              IF PAGE-LINE-TYPE (LINE-OCC)                         DTSCS34
00958                       = PAGE-LINE-TYPE (LINE-OCC - 1)             DTSCS34
00959                  IF PAGE-APPLIC-YRQ (LINE-OCC)                    DTSCS34
00960                              = PAGE-APPLIC-YRQ (LINE-OCC - 1)     DTSCS34
00961                      NEXT SENTENCE                                DTSCS34
00962                  ELSE                                             DTSCS34
00963                      MOVE 'Y' TO YRQ-BREAK-IND                    DTSCS34
00964              ELSE                                                 DTSCS34
00965                  MOVE 'Y' TO LINE-TYPE-BREAK-IND                  DTSCS34
00966                              YRQ-BREAK-IND                        DTSCS34
00967          ELSE                                                     DTSCS34
00968              MOVE 'Y' TO DOC-NO-BREAK-IND                         DTSCS34
00969                          LINE-TYPE-BREAK-IND                      DTSCS34
00970                          YRQ-BREAK-IND.                           DTSCS34
00971                                                                   DTSCS34
00972      IF DOC-NO-BREAK-IND = 'Y'                                    DTSCS34
00973          MOVE PAGE-PAY-TYPE (LINE-OCC)                            DTSCS34
00974            TO MAP-PAY-TYPE (LINE-OCC)                             DTSCS34
00975          MOVE PAGE-BATCH-NO (LINE-OCC)                            DTSCS34
00976            TO MAP-BATCH-NO (LINE-OCC)                             DTSCS34
00977          MOVE PAGE-ITEM-NO (LINE-OCC)                             DTSCS34
00978            TO MAP-ITEM-NO (LINE-OCC)                              DTSCS34
00979          MOVE PAGE-RECEIVED-DATE (LINE-OCC) TO L001-FED-8-DATE-9  DTSCS34
00980          PERFORM P6912-SLASH-DATE THRU P6912-EXIT                 DTSCS34
00981          MOVE L001-SLASH-DATE TO MAP-RECEIVED-DATE (LINE-OCC)     DTSCS34
00982          MOVE PAGE-PROCESSED-DATE (LINE-OCC) TO L001-FED-8-DATE-9 DTSCS34
00983          PERFORM P6912-SLASH-DATE THRU P6912-EXIT                 DTSCS34
00984          MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE (LINE-OCC)    DTSCS34
00985          MOVE PAGE-WAIVE-INT-IND (LINE-OCC)                          CL**2
00986            TO MAP-WAIVE-INT-IND (LINE-OCC)                           CL**2
00987          MOVE PAGE-NSF-PEN-IND (LINE-OCC)                            CL**2
00988            TO MAP-NSF-PEN-IND (LINE-OCC)                             CL**2
00989          MOVE PAGE-WAIVE-PEN-IND (LINE-OCC)                          CL**2
00990            TO MAP-WAIVE-PEN-IND (LINE-OCC).                          CL**2
00991                                                                   DTSCS34
00992      IF LINE-TYPE-BREAK-IND = 'Y'                                 DTSCS34
00993          IF PAGE-LINE-TYPE-TRAN-88 (LINE-OCC)                     DTSCS34
00994              MOVE 'TRAN' TO MAP-LINE-TYPE (LINE-OCC)              DTSCS34
00995          ELSE                                                     DTSCS34
00996          IF PAGE-LINE-TYPE-DSTR-88 (LINE-OCC)                     DTSCS34
00997              MOVE 'DSTR' TO MAP-LINE-TYPE (LINE-OCC)              DTSCS34
00998          ELSE                                                     DTSCS34
00999          IF PAGE-LINE-TYPE-REVR-88 (LINE-OCC)                     DTSCS34
01000              MOVE 'REVR' TO MAP-LINE-TYPE (LINE-OCC).             DTSCS34
01001                                                                   DTSCS34
01002      IF YRQ-BREAK-IND = 'Y'                                       DTSCS34
01003          MOVE PAGE-APPLIC-YRQ (LINE-OCC) TO L004-QTR-5-9          DTSCS34
01004          PERFORM P6911-SLASH-YRQ THRU P6911-EXIT                  DTSCS34
01005          MOVE L004-SLASH-QTR TO MAP-LINE-YRQ (LINE-OCC).          DTSCS34
01006                                                                   DTSCS34
01007      MOVE PAGE-APPLIC-IND (LINE-OCC)                              DTSCS34
01008        TO MAP-APPLIC-IND (LINE-OCC).                              DTSCS34
01009                                                                   DTSCS34
01010      IF PAGE-APPLIC-DOC-NO (LINE-OCC) = NULL-DOC-NO               DTSCS34
01011          NEXT SENTENCE                                            DTSCS34
01012      ELSE                                                         DTSCS34
01013          MOVE PAGE-APPLIC-BATCH-NO (LINE-OCC)                     DTSCS34
01014            TO MAP-APPLIC-BATCH-NO (LINE-OCC)                      DTSCS34
01015          MOVE PAGE-APPLIC-ITEM-NO (LINE-OCC)                      DTSCS34
01016            TO MAP-APPLIC-ITEM-NO (LINE-OCC).                      DTSCS34
01017                                                                   DTSCS34
01018      IF PAGE-LINE-TYPE-TRAN-88 (LINE-OCC)                         DTSCS34
01019          MOVE PAGE-APPLIC-AMT (LINE-OCC)                          DTSCS34
01020            TO MAP-TRAN-AMT-Z (LINE-OCC)                           DTSCS34
01021      ELSE                                                         DTSCS34
01022          MOVE PAGE-APPLIC-AMT (LINE-OCC)                          DTSCS34
01023            TO MAP-DSTR-REVR-AMT-Z (LINE-OCC).                     DTSCS34
01024  P6910-EXIT.                                                      DTSCS34
01025      EXIT.                                                        DTSCS34
01026      SKIP3                                                        DTSCS34
01027  P6911-SLASH-YRQ.                                                 DTSCS34
01028      IF L004-QTR-5-9 = +0                                         DTSCS34
01029          MOVE SPACES TO L004-SLASH-QTR                            DTSCS34
01030      ELSE                                                            CL**9
01031      IF L004-QTR-5-9 = LCCM-PICKUP-YRQ                               CL**9
01032          MOVE 'PKUP' TO L004-SLASH-QTR                               CL**9
01033      ELSE                                                         DTSCS34
01034          MOVE L004-QTR-5-YR TO L004-SLASH-YR                      DTSCS34
01035          MOVE '/' TO L004-SLASH-LIT                               DTSCS34
01036          MOVE L004-QTR-5-Q TO L004-SLASH-Q.                       DTSCS34
01037  P6911-EXIT.                                                      DTSCS34
01038      EXIT.                                                        DTSCS34
01039      SKIP3                                                        DTSCS34
01040  P6912-SLASH-DATE.                                                DTSCS34
01041      IF L001-FED-8-DATE-9 = +0                                    DTSCS34
01042          MOVE SPACES TO L001-SLASH-DATE                           DTSCS34
01043      ELSE                                                         DTSCS34
01044          MOVE '  /  /  ' TO L001-SLASH-DATE                       DTSCS34
01045          MOVE L001-FED-8-MO TO L001-SLASH-MO                      DTSCS34
01046          MOVE L001-FED-8-DA TO L001-SLASH-DA                      DTSCS34
01047          MOVE L001-FED-8-YR TO L001-SLASH-YR.                     DTSCS34
01048  P6912-EXIT.                                                      DTSCS34
01049      EXIT.                                                        DTSCS34
01050      SKIP3                                                        DTSCS34
01051  P6990-PAGE-NUMBER.                                               DTSCS34
01052      MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE.                         DTSCS34
01053      MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE.           DTSCS34
01054                                                                   DTSCS34
01055      IF CURR-PAGE-NUM = +1                                        DTSCS34
01056          IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1                      DTSCS34
01057              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS34
01058          ELSE                                                     DTSCS34
01059              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS34
01060      ELSE                                                         DTSCS34
01061          IF CURR-PAGE-NUM = LCCM-SCR-HOLD-LAST-PAGE-NUM           DTSCS34
01062              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS34
01063  P6990-EXIT.                                                      DTSCS34
01064      EXIT.                                                        DTSCS34
01065      EJECT                                                        DTSCS34
01066  P7000-CONSTRUCT-PAGES.                                           DTSCS34
01067 *--------------------------------------------------------------   DTSCS34
01068 *    INQUIRY FOR WRK-EMP-NO AND WRK-YRQ HAS BEEN REQUESTED.       DTSCS34
01069 *    P7000 ASSEMBLES PAGES OF INFORMATION INTO LCCM-SCR-HOLD-AREA DTSCS34
01070 *    (WITH OVERFLOW INTO TS).                                     DTSCS34
01071 *                                                                 DTSCS34
01072 *    THE PRINCIPLE DIFFICULTIES ARE WITH THE SEQUENCE IN WITH     DTSCS34
01073 *    MPAY RECORDS MUST BE DISPLAYED: DESCENDING ON DOC NO         DTSCS34
01074 *    AND WEAVING THE DISPLAY OF MDST AND MREV INFORMATION         DTSCS34
01075 *    INTO THE DISPLAY.                                            DTSCS34
01076 *                                                                 DTSCS34
01077 *    IF WRK-YRQ IS EQUAL TO ZERO, THEN ALL MPAY RECORDS FOR EMP   DTSCS34
01078 *    NO MUST BE DISPLAYED (P7100).                                DTSCS34
01079 *                                                                 DTSCS34
01080 *    IF WRK-YRQ IS NOT EQUAL TO ZERO, THEN ONLY THOSE MPAY        DTSCS34
01081 *    RECORDS WITH MPAY-YRQ EQUAL TO WRK-YRQ ARE DISPLAYED         DTSCS34
01082 *    (P7200).                                                     DTSCS34
01083 *--------------------------------------------------------------   DTSCS34
01084      IF LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES                   DTSCS34
01085          NEXT SENTENCE                                            DTSCS34
01086      ELSE                                                         DTSCS34
01087          IF LCCM-SCR-HOLD-LAST-PAGE-NUM > ITEM-MAX-LCCM           DTSCS34
01088              PERFORM S829-DELETE-QUEUE THRU S829-EXIT.            DTSCS34
01089                                                                   DTSCS34
01090      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS34
01091                                                                   DTSCS34
01092      MOVE WRK-EMP-NO TO LCCM-SCR-HOLD-EMP-NO.                     DTSCS34
01093      MOVE WRK-YRQ TO LCCM-SCR-HOLD-YRQ.                           DTSCS34
01094      MOVE MPRF-UPDATE-END-ABSTIME TO LCCM-SCR-HOLD-ABSTIME.       DTSCS34
01095      MOVE +0 TO LCCM-SCR-HOLD-LAST-PAGE-NUM.                      DTSCS34
01096                                                                   DTSCS34
01097      MOVE +0 TO ITEM-CNT.                                         DTSCS34
01098                                                                   DTSCS34
01099      IF WRK-YRQ = +0                                              DTSCS34
01100          PERFORM P7100-ALL-QUARTERS THRU P7100-EXIT               DTSCS34
01101      ELSE                                                         DTSCS34
01102          PERFORM P7200-ONE-QUARTER THRU P7200-EXIT.               DTSCS34
01103                                                                   DTSCS34
01104      MOVE ITEM-CNT TO LCCM-SCR-HOLD-LAST-PAGE-NUM.                DTSCS34
01105  P7000-EXIT.                                                      DTSCS34
01106      EXIT.                                                        DTSCS34
01107      EJECT                                                        DTSCS34
01108  P7100-ALL-QUARTERS.                                              DTSCS34
01109      MOVE +0 TO DST-OCC-CNT.                                      DTSCS34
01110                                                                   DTSCS34
01111      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSCS34
01112      MOVE WRK-EMP-NO TO MDST-EMP-NO.                              DTSCS34
01113      SET MDST-DST-88 TO TRUE.                                     DTSCS34
01114      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01115      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS34
01116      PERFORM P7110-MDST-SCAN THRU P7110-EXIT                      DTSCS34
01117          UNTIL L810-NO-REC-88.                                    DTSCS34
01118                                                                   DTSCS34
01119      MOVE +0 TO REV-OCC-CNT.                                      DTSCS34
01120                                                                   DTSCS34
01121      MOVE LOW-VALUES TO MREV-KEY-AREA.                            DTSCS34
01122      MOVE WRK-EMP-NO TO MREV-EMP-NO.                              DTSCS34
01123      SET MREV-REV-88 TO TRUE.                                     DTSCS34
01124      MOVE MREV-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01125      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS34
01126      PERFORM P7120-MREV-SCAN THRU P7120-EXIT                      DTSCS34
01127          UNTIL L810-NO-REC-88.                                    DTSCS34
01128                                                                   DTSCS34
01129      MOVE LOW-VALUES TO MPAY-KEY-AREA.                            DTSCS34
01130      MOVE WRK-EMP-NO TO MPAY-EMP-NO.                              DTSCS34
01131      SET MPAY-PAY-88 TO TRUE.                                     DTSCS34
01132      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01133      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS34
01134      IF L810-RECORD-CNT = +0                                      DTSCS34
01135          GO TO P7100-EXIT.                                        DTSCS34
01136                                                                   DTSCS34
01137      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS34
01138      IF L810-NO-REC-88                                            DTSCS34
01139          GO TO P7100-EXIT.                                        DTSCS34
01140      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS34
01141      IF L810-NO-REC-88                                            DTSCS34
01142          GO TO P7100-EXIT.                                        DTSCS34
01143                                                                   DTSCS34
01144      MOVE +0 TO PAGE-LINE-CNT.                                    DTSCS34
01145                                                                   DTSCS34
01146      PERFORM P7130-MPAY-SCAN THRU P7130-EXIT                      DTSCS34
01147          UNTIL L810-NO-REC-88.                                    DTSCS34
01148                                                                   DTSCS34
01149      IF PAGE-LINE-CNT > +0                                        DTSCS34
01150          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT.           DTSCS34
01151  P7100-EXIT.                                                      DTSCS34
01152      EXIT.                                                        DTSCS34
01153      SKIP3                                                        DTSCS34
01154  P7110-MDST-SCAN.                                                 DTSCS34
01155      MOVE MSKL-REC TO MDST-REC.                                   DTSCS34
01156                                                                   DTSCS34
01157      PERFORM P7111-MDST-TO-DST-TABLE THRU P7111-EXIT              DTSCS34
01158          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSCS34
01159          UNTIL (MDST-ACCT-IDX > MDST-ACCT-CNT)                    DTSCS34
01160                   OR                                              DTSCS34
01161                (DST-OCC-CNT NOT < DST-OCC-MAX).                   DTSCS34
01162                                                                   DTSCS34
01163      IF DST-OCC-CNT < DST-OCC-MAX                                 DTSCS34
01164          NEXT SENTENCE                                            DTSCS34
01165      ELSE                                                         DTSCS34
01166          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS34
01167          SET L810-NO-REC-88 TO TRUE                               DTSCS34
01168          GO TO P7110-EXIT.                                        DTSCS34
01169                                                                   DTSCS34
01170      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS34
01171  P7110-EXIT.                                                      DTSCS34
01172      EXIT.                                                        DTSCS34
01173      SKIP3                                                        DTSCS34
01174  P7111-MDST-TO-DST-TABLE.                                         DTSCS34
01175      ADD +1 TO DST-OCC-CNT.                                       DTSCS34
01176                                                                   DTSCS34
01177      MOVE MDST-YRQ TO DST-YRQ (DST-OCC-CNT).                      DTSCS34
01178      MOVE MDST-DOC-NO TO DST-DOC-NO (DST-OCC-CNT).                DTSCS34
01179      MOVE MDST-ACCT-IND (MDST-ACCT-IDX)                           DTSCS34
01180        TO DST-ACCT-IND (DST-OCC-CNT).                             DTSCS34
01181      MOVE MDST-AMT (MDST-ACCT-IDX)                                DTSCS34
01182        TO DST-AMT (DST-OCC-CNT).                                  DTSCS34
01183  P7111-EXIT.                                                      DTSCS34
01184      EXIT.                                                        DTSCS34
01185      SKIP3                                                        DTSCS34
01186  P7120-MREV-SCAN.                                                 DTSCS34
01187      MOVE MSKL-REC TO MREV-REC.                                   DTSCS34
01188                                                                   DTSCS34
01189      ADD +1 TO REV-OCC-CNT.                                       DTSCS34
01190                                                                   DTSCS34
01191      MOVE MREV-PA-DOC-NO TO REV-PA-DOC-NO (REV-OCC-CNT).          DTSCS34
01192      MOVE MREV-PU-RF-PR-DOC-NO                                    DTSCS34
01193        TO REV-PU-RF-PR-DOC-NO (REV-OCC-CNT).                      DTSCS34
01194      MOVE MREV-FATE TO REV-FATE (REV-OCC-CNT).                    DTSCS34
01195      MOVE MREV-AMT TO REV-AMT (REV-OCC-CNT).                      DTSCS34
01196                                                                   DTSCS34
01197      IF REV-OCC-CNT < REV-OCC-MAX                                 DTSCS34
01198          NEXT SENTENCE                                            DTSCS34
01199      ELSE                                                         DTSCS34
01200          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS34
01201          SET L810-NO-REC-88 TO TRUE                               DTSCS34
01202          GO TO P7120-EXIT.                                        DTSCS34
01203                                                                   DTSCS34
01204      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS34
01205  P7120-EXIT.                                                      DTSCS34
01206      EXIT.                                                        DTSCS34
01207      SKIP3                                                        DTSCS34
01208  P7130-MPAY-SCAN.                                                 DTSCS34
01209      MOVE MSKL-REC TO MPAY-REC.                                   DTSCS34
01210                                                                   DTSCS34
01211      PERFORM P7140-MPAY-TO-PAGE-LINE THRU P7140-EXIT.             DTSCS34
01212                                                                   DTSCS34
01213      MOVE 'Y' TO PAY-BROWSE-IN-PROGRESS-IND.                      DTSCS34
01214                                                                   DTSCS34
01215      PERFORM P7150-DST-PROCESS THRU P7150-EXIT.                   DTSCS34
01216                                                                   DTSCS34
01217      PERFORM P7160-REV-PROCESS THRU P7160-EXIT.                   DTSCS34
01218                                                                   DTSCS34
01219      IF PAY-BROWSE-IN-PROGRESS-IND = 'N'                          DTSCS34
01220          MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA                      DTSCS34
01221          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS34
01222          IF L810-OK-88                                            DTSCS34
01223              PERFORM S810-READ-PREV THRU S810-EXIT                DTSCS34
01224              IF L810-NO-REC-88                                    DTSCS34
01225                  GO TO P7130-EXIT                                 DTSCS34
01226              ELSE                                                 DTSCS34
01227                  NEXT SENTENCE                                    DTSCS34
01228          ELSE                                                     DTSCS34
01229              GO TO P7130-EXIT.                                    DTSCS34
01230                                                                   DTSCS34
01231      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS34
01232  P7130-EXIT.                                                      DTSCS34
01233      EXIT.                                                        DTSCS34
01234      SKIP3                                                        DTSCS34
01235  P7140-MPAY-TO-PAGE-LINE.                                         DTSCS34
01236      IF PAGE-LINE-CNT < LINES-PER-PAGE                            DTSCS34
01237          NEXT SENTENCE                                            DTSCS34
01238      ELSE                                                         DTSCS34
01239          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS34
01240          MOVE +0 TO PAGE-LINE-CNT.                                DTSCS34
01241                                                                   DTSCS34
01242      ADD +1 TO PAGE-LINE-CNT.                                     DTSCS34
01243                                                                   DTSCS34
01244      PERFORM P7191-TYPE-THRU-PEN-IND THRU P7191-EXIT.             DTSCS34
01245      SET PAGE-LINE-TYPE-TRAN-88 (PAGE-LINE-CNT) TO TRUE.          DTSCS34
01246      MOVE MPAY-APPLIC-YRQ TO PAGE-APPLIC-YRQ (PAGE-LINE-CNT).     DTSCS34
01247      MOVE MPAY-APPLIC-IND TO PAGE-APPLIC-IND (PAGE-LINE-CNT).     DTSCS34
01248      MOVE MPAY-APPLIC-DOC-NO                                      DTSCS34
01249        TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).                     DTSCS34
01250      MOVE MPAY-REMIT-AMT                                          DTSCS34
01251        TO PAGE-APPLIC-AMT (PAGE-LINE-CNT).                        DTSCS34
01252  P7140-EXIT.                                                      DTSCS34
01253      EXIT.                                                        DTSCS34
01254      SKIP3                                                        DTSCS34
01255  P7150-DST-PROCESS.                                               DTSCS34
01256      PERFORM P7151-DST-TABLE-TO-PAGE-LINE THRU P7151-EXIT         DTSCS34
01257          VARYING DST-GROUP-IDX FROM 1 BY 1                        DTSCS34
01258          UNTIL DST-GROUP-IDX > DST-OCC-CNT.                       DTSCS34
01259                                                                   DTSCS34
01260      IF DST-OCC-CNT < DST-OCC-MAX                                 DTSCS34
01261          GO TO P7150-EXIT.                                        DTSCS34
01262                                                                   DTSCS34
01263      IF PAY-BROWSE-IN-PROGRESS-IND = 'Y'                          DTSCS34
01264          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS34
01265          MOVE 'N' TO PAY-BROWSE-IN-PROGRESS-IND.                  DTSCS34
01266                                                                   DTSCS34
01267      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSCS34
01268      MOVE WRK-EMP-NO TO MDST-EMP-NO.                              DTSCS34
01269      SET MDST-DST-88 TO TRUE.                                     DTSCS34
01270      MOVE DST-YRQ (DST-OCC-CNT) TO MDST-YRQ.                      DTSCS34
01271      MOVE DST-DOC-NO (DST-OCC-CNT) TO MDST-DOC-NO.                DTSCS34
01272      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01273      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS34
01274      IF L810-NO-REC-88                                            DTSCS34
01275          GO TO P7150-EXIT.                                        DTSCS34
01276      MOVE MSKL-REC TO MDST-REC.                                   DTSCS34
01277      MOVE +0 TO HOLD-MDST-SUB.                                    DTSCS34
01278      IF (MDST-YRQ = DST-YRQ (DST-OCC-CNT))                        DTSCS34
01279            AND                                                    DTSCS34
01280         (MDST-DOC-NO = DST-DOC-NO (DST-OCC-CNT))                  DTSCS34
01281          PERFORM P7152-SET-HOLD-MDST-SUB THRU P7152-EXIT          DTSCS34
01282              VARYING MDST-ACCT-IDX FROM 1 BY 1                    DTSCS34
01283              UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                 DTSCS34
01284                                                                   DTSCS34
01285      ADD +1 TO HOLD-MDST-SUB.                                     DTSCS34
01286                                                                   DTSCS34
01287      IF MDST-DOC-NO = MPAY-DOC-NO                                 DTSCS34
01288          PERFORM P7154-MDST-TO-PAGE-LINE THRU P7154-EXIT          DTSCS34
01289              VARYING MDST-ACCT-IDX FROM HOLD-MDST-SUB BY 1        DTSCS34
01290              UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                 DTSCS34
01291                                                                   DTSCS34
01292      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS34
01293                                                                   DTSCS34
01294      PERFORM P7153-SCAN-MDST THRU P7153-EXIT                      DTSCS34
01295          UNTIL L810-NO-REC-88.                                    DTSCS34
01296  P7150-EXIT.                                                      DTSCS34
01297      EXIT.                                                        DTSCS34
01298      SKIP3                                                        DTSCS34
01299  P7151-DST-TABLE-TO-PAGE-LINE.                                    DTSCS34
01300      IF DST-DOC-NO (DST-GROUP-IDX) = MPAY-DOC-NO                  DTSCS34
01301          NEXT SENTENCE                                            DTSCS34
01302      ELSE                                                         DTSCS34
01303          GO TO P7151-EXIT.                                        DTSCS34
01304                                                                   DTSCS34
01305      IF PAGE-LINE-CNT < LINES-PER-PAGE                            DTSCS34
01306          NEXT SENTENCE                                            DTSCS34
01307      ELSE                                                         DTSCS34
01308          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS34
01309          MOVE +0 TO PAGE-LINE-CNT.                                DTSCS34
01310                                                                   DTSCS34
01311      ADD +1 TO PAGE-LINE-CNT.                                     DTSCS34
01312                                                                   DTSCS34
01313      PERFORM P7191-TYPE-THRU-PEN-IND THRU P7191-EXIT.             DTSCS34
01314      SET PAGE-LINE-TYPE-DSTR-88 (PAGE-LINE-CNT) TO TRUE.          DTSCS34
01315      MOVE DST-YRQ (DST-GROUP-IDX)                                 DTSCS34
01316        TO PAGE-APPLIC-YRQ (PAGE-LINE-CNT).                        DTSCS34
01317      MOVE DST-ACCT-IND (DST-GROUP-IDX)                            DTSCS34
01318        TO PAGE-APPLIC-IND (PAGE-LINE-CNT).                        DTSCS34
01319      MOVE NULL-DOC-NO TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).      DTSCS34
01320      MOVE DST-AMT (DST-GROUP-IDX)                                 DTSCS34
01321        TO PAGE-APPLIC-AMT (PAGE-LINE-CNT).                        DTSCS34
01322  P7151-EXIT.                                                      DTSCS34
01323      EXIT.                                                        DTSCS34
01324      SKIP3                                                        DTSCS34
01325  P7152-SET-HOLD-MDST-SUB.                                         DTSCS34
01326      IF MDST-ACCT-IND (MDST-ACCT-IDX)                             DTSCS34
01327        = DST-ACCT-IND (DST-OCC-CNT)                               DTSCS34
01328         SET HOLD-MDST-SUB TO MDST-ACCT-IDX.                       DTSCS34
01329  P7152-EXIT.                                                      DTSCS34
01330      EXIT.                                                        DTSCS34
01331      SKIP3                                                        DTSCS34
01332  P7153-SCAN-MDST.                                                 DTSCS34
01333      MOVE MSKL-REC TO MDST-REC.                                   DTSCS34
01334                                                                   DTSCS34
01335      IF MDST-DOC-NO = MPAY-DOC-NO                                 DTSCS34
01336          PERFORM P7154-MDST-TO-PAGE-LINE THRU P7154-EXIT          DTSCS34
01337              VARYING MDST-ACCT-IDX FROM 1 BY 1                    DTSCS34
01338              UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                 DTSCS34
01339                                                                   DTSCS34
01340      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS34
01341  P7153-EXIT.                                                      DTSCS34
01342      EXIT.                                                        DTSCS34
01343      SKIP3                                                        DTSCS34
01344  P7154-MDST-TO-PAGE-LINE.                                         DTSCS34
01345      IF PAGE-LINE-CNT < LINES-PER-PAGE                            DTSCS34
01346          NEXT SENTENCE                                            DTSCS34
01347      ELSE                                                         DTSCS34
01348          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS34
01349          MOVE +0 TO PAGE-LINE-CNT.                                DTSCS34
01350                                                                   DTSCS34
01351      ADD +1 TO PAGE-LINE-CNT.                                     DTSCS34
01352                                                                   DTSCS34
01353      PERFORM P7191-TYPE-THRU-PEN-IND THRU P7191-EXIT.             DTSCS34
01354      SET PAGE-LINE-TYPE-DSTR-88 (PAGE-LINE-CNT) TO TRUE.          DTSCS34
01355      MOVE MDST-YRQ TO PAGE-APPLIC-YRQ (PAGE-LINE-CNT).            DTSCS34
01356      MOVE MDST-ACCT-IND (MDST-ACCT-IDX)                           DTSCS34
01357        TO PAGE-APPLIC-IND (PAGE-LINE-CNT).                        DTSCS34
01358      MOVE NULL-DOC-NO TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).      DTSCS34
01359      MOVE MDST-AMT (MDST-ACCT-IDX)                                DTSCS34
01360        TO PAGE-APPLIC-AMT (PAGE-LINE-CNT).                        DTSCS34
01361  P7154-EXIT.                                                      DTSCS34
01362      EXIT.                                                        DTSCS34
01363      SKIP3                                                        DTSCS34
01364  P7160-REV-PROCESS.                                               DTSCS34
01365      PERFORM P7161-REV-TABLE-TO-PAGE-LINE THRU P7161-EXIT         DTSCS34
01366          VARYING REV-GROUP-IDX FROM 1 BY 1                        DTSCS34
01367          UNTIL REV-GROUP-IDX > REV-OCC-CNT.                       DTSCS34
01368                                                                   DTSCS34
01369      IF REV-OCC-CNT < REV-OCC-MAX                                 DTSCS34
01370          GO TO P7160-EXIT.                                        DTSCS34
01371                                                                   DTSCS34
01372      IF PAY-BROWSE-IN-PROGRESS-IND = 'Y'                          DTSCS34
01373          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS34
01374          MOVE 'N' TO PAY-BROWSE-IN-PROGRESS-IND.                  DTSCS34
01375                                                                   DTSCS34
01376      MOVE LOW-VALUES TO MREV-KEY-AREA.                            DTSCS34
01377      MOVE WRK-EMP-NO TO MREV-EMP-NO.                              DTSCS34
01378      SET MREV-REV-88 TO TRUE.                                     DTSCS34
01379      MOVE REV-PA-DOC-NO (REV-OCC-CNT) TO MREV-PA-DOC-NO.          DTSCS34
01380      MOVE REV-PU-RF-PR-DOC-NO (REV-OCC-CNT)                       DTSCS34
01381        TO MREV-PU-RF-PR-DOC-NO.                                   DTSCS34
01382      MOVE MREV-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01383      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS34
01384      IF L810-NO-REC-88                                            DTSCS34
01385          GO TO P7160-EXIT.                                        DTSCS34
01386      MOVE MSKL-REC TO MREV-REC.                                   DTSCS34
01387      IF (MREV-PA-DOC-NO = REV-PA-DOC-NO (REV-OCC-CNT))            DTSCS34
01388            AND                                                    DTSCS34
01389         (MREV-PU-RF-PR-DOC-NO = REV-PU-RF-PR-DOC-NO (REV-OCC-CNT))DTSCS34
01390          PERFORM S810-READ-NEXT THRU S810-EXIT.                   DTSCS34
01391                                                                   DTSCS34
01392      PERFORM P7162-SCAN-MREV THRU P7162-EXIT                      DTSCS34
01393          UNTIL L810-NO-REC-88.                                    DTSCS34
01394  P7160-EXIT.                                                      DTSCS34
01395      EXIT.                                                        DTSCS34
01396      SKIP3                                                        DTSCS34
01397  P7161-REV-TABLE-TO-PAGE-LINE.                                    DTSCS34
01398      IF REV-PA-DOC-NO (REV-GROUP-IDX) = MPAY-DOC-NO               DTSCS34
01399          NEXT SENTENCE                                            DTSCS34
01400      ELSE                                                         DTSCS34
01401          GO TO P7161-EXIT.                                        DTSCS34
01402                                                                   DTSCS34
01403      IF PAGE-LINE-CNT < LINES-PER-PAGE                            DTSCS34
01404          NEXT SENTENCE                                            DTSCS34
01405      ELSE                                                         DTSCS34
01406          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS34
01407          MOVE +0 TO PAGE-LINE-CNT.                                DTSCS34
01408                                                                   DTSCS34
01409      ADD +1 TO PAGE-LINE-CNT.                                     DTSCS34
01410                                                                   DTSCS34
01411      PERFORM P7191-TYPE-THRU-PEN-IND THRU P7191-EXIT.             DTSCS34
01412      SET PAGE-LINE-TYPE-REVR-88 (PAGE-LINE-CNT) TO TRUE.          DTSCS34
01413      MOVE +0 TO PAGE-APPLIC-YRQ (PAGE-LINE-CNT).                  DTSCS34
01414      MOVE REV-FATE (REV-GROUP-IDX)                                DTSCS34
01415        TO PAGE-APPLIC-IND (PAGE-LINE-CNT).                        DTSCS34
01416      MOVE REV-PU-RF-PR-DOC-NO (REV-GROUP-IDX)                     DTSCS34
01417        TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).                     DTSCS34
01418      MOVE REV-AMT (REV-GROUP-IDX)                                 DTSCS34
01419        TO PAGE-APPLIC-AMT (PAGE-LINE-CNT).                        DTSCS34
01420  P7161-EXIT.                                                      DTSCS34
01421      EXIT.                                                        DTSCS34
01422      SKIP3                                                        DTSCS34
01423  P7162-SCAN-MREV.                                                 DTSCS34
01424      MOVE MSKL-REC TO MREV-REC.                                   DTSCS34
01425                                                                   DTSCS34
01426      IF MREV-PA-DOC-NO = MPAY-DOC-NO                              DTSCS34
01427          PERFORM P7163-MREV-TO-PAGE-LINE THRU P7163-EXIT.         DTSCS34
01428                                                                   DTSCS34
01429      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS34
01430  P7162-EXIT.                                                      DTSCS34
01431      EXIT.                                                        DTSCS34
01432      SKIP3                                                        DTSCS34
01433  P7163-MREV-TO-PAGE-LINE.                                         DTSCS34
01434      IF PAGE-LINE-CNT < LINES-PER-PAGE                            DTSCS34
01435          NEXT SENTENCE                                            DTSCS34
01436      ELSE                                                         DTSCS34
01437          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS34
01438          MOVE +0 TO PAGE-LINE-CNT.                                DTSCS34
01439                                                                   DTSCS34
01440      ADD +1 TO PAGE-LINE-CNT.                                     DTSCS34
01441                                                                   DTSCS34
01442      PERFORM P7191-TYPE-THRU-PEN-IND THRU P7191-EXIT.             DTSCS34
01443      SET PAGE-LINE-TYPE-REVR-88 (PAGE-LINE-CNT) TO TRUE.          DTSCS34
01444      MOVE +0 TO PAGE-APPLIC-YRQ (PAGE-LINE-CNT).                  DTSCS34
01445      MOVE MREV-FATE TO PAGE-APPLIC-IND (PAGE-LINE-CNT).           DTSCS34
01446      MOVE MREV-PU-RF-PR-DOC-NO                                    DTSCS34
01447        TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).                     DTSCS34
01448      MOVE MREV-AMT TO PAGE-APPLIC-AMT (PAGE-LINE-CNT).            DTSCS34
01449  P7163-EXIT.                                                      DTSCS34
01450      EXIT.                                                        DTSCS34
01451      SKIP3                                                        DTSCS34
01452  P7191-TYPE-THRU-PEN-IND.                                         DTSCS34
01453       MOVE MPAY-PAY-TYPE TO PAGE-PAY-TYPE (PAGE-LINE-CNT).        DTSCS34
01454       MOVE MPAY-DOC-NO TO PAGE-DOC-NO (PAGE-LINE-CNT).            DTSCS34
01455       MOVE MPAY-RECEIVED-DATE                                     DTSCS34
01456         TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT).                    DTSCS34
01457      MOVE MPAY-ESTB-DATE                                          DTSCS34
01458        TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT).                    DTSCS34
01459      MOVE MPAY-WAIVE-INT-IND                                         CL**2
01460        TO PAGE-WAIVE-INT-IND (PAGE-LINE-CNT).                        CL**2
01461      MOVE MPAY-WAIVE-LATE-PEN-IND                                    CL**2
01462        TO PAGE-WAIVE-PEN-IND (PAGE-LINE-CNT).                        CL**2
01463      MOVE MPAY-NSF-PEN-CHARGE-IND                                    CL**5
01464        TO PAGE-NSF-PEN-IND (PAGE-LINE-CNT).                          CL**2
01465  P7191-EXIT.                                                      DTSCS34
01466      EXIT.                                                        DTSCS34
01467      EJECT                                                        DTSCS34
01468  P7200-ONE-QUARTER.                                               DTSCS34
01469      MOVE +0 TO DST-OCC-CNT.                                      DTSCS34
01470                                                                   DTSCS34
01471      MOVE LOW-VALUES TO MDST-KEY-AREA.                            DTSCS34
01472      MOVE WRK-EMP-NO TO MDST-EMP-NO.                              DTSCS34
01473      SET MDST-DST-88 TO TRUE.                                     DTSCS34
01474      MOVE WRK-YRQ TO MDST-YRQ.                                    DTSCS34
01475      MOVE MDST-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01476      MOVE LOW-VALUES TO HOLD-MDST-KEY-AREA.                       DTSCS34
01477      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS34
01478      PERFORM P7210-SCAN-MDST THRU P7210-EXIT                      DTSCS34
01479          UNTIL L810-NO-REC-88.                                    DTSCS34
01480      IF HOLD-MDST-KEY-AREA = LOW-VALUES                           DTSCS34
01481          GO TO P7200-EXIT.                                        DTSCS34
01482                                                                   DTSCS34
01483      MOVE HOLD-MDST-KEY-AREA TO MSKL-KEY-AREA.                    DTSCS34
01484      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS34
01485      IF L810-NO-REC-88                                            DTSCS34
01486          GO TO P7200-EXIT.                                        DTSCS34
01487      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS34
01488      IF L810-NO-REC-88                                            DTSCS34
01489          GO TO P7200-EXIT.                                        DTSCS34
01490                                                                   DTSCS34
01491      MOVE +0 TO DST-OCC-CNT.                                      DTSCS34
01492      MOVE +0 TO PAGE-LINE-CNT.                                    DTSCS34
01493                                                                   DTSCS34
01494      MOVE HIGH-VALUES TO MPAY-KEY-AREA.                           DTSCS34
01495                                                                   DTSCS34
01496      PERFORM P7220-PROCESS-MDST THRU P7220-EXIT                   DTSCS34
01497          UNTIL L810-NO-REC-88.                                    DTSCS34
01498                                                                   DTSCS34
01499      PERFORM P7230-DST-TABLE-TO-PAGE THRU P7230-EXIT              DTSCS34
01500          VARYING DST-GROUP-IDX FROM 1 BY 1                        DTSCS34
01501          UNTIL DST-GROUP-IDX > DST-OCC-CNT.                       DTSCS34
01502                                                                   DTSCS34
01503      IF PAGE-LINE-CNT > +0                                        DTSCS34
01504          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT.           DTSCS34
01505  P7200-EXIT.                                                      DTSCS34
01506      EXIT.                                                        DTSCS34
01507      SKIP3                                                        DTSCS34
01508  P7210-SCAN-MDST.                                                 DTSCS34
01509      MOVE MSKL-REC TO MDST-REC.                                   DTSCS34
01510                                                                   DTSCS34
01511      IF MDST-YRQ = WRK-YRQ                                        DTSCS34
01512          NEXT SENTENCE                                            DTSCS34
01513      ELSE                                                         DTSCS34
01514          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS34
01515          SET L810-NO-REC-88 TO TRUE                               DTSCS34
01516          GO TO P7210-EXIT.                                        DTSCS34
01517                                                                   DTSCS34
01518      MOVE MDST-KEY-AREA TO HOLD-MDST-KEY-AREA.                    DTSCS34
01519                                                                   DTSCS34
01520      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS34
01521  P7210-EXIT.                                                      DTSCS34
01522      EXIT.                                                        DTSCS34
01523      SKIP3                                                        DTSCS34
01524  P7220-PROCESS-MDST.                                              DTSCS34
01525      MOVE MSKL-REC TO MDST-REC.                                   DTSCS34
01526                                                                   DTSCS34
01527      IF MDST-YRQ = WRK-YRQ                                        DTSCS34
01528          NEXT SENTENCE                                            DTSCS34
01529      ELSE                                                         DTSCS34
01530          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS34
01531          SET L810-NO-REC-88 TO TRUE                               DTSCS34
01532          GO TO P7220-EXIT.                                        DTSCS34
01533                                                                   DTSCS34
01534      PERFORM P7221-MDST-TO-DST-TABLE THRU P7221-EXIT              DTSCS34
01535          VARYING MDST-ACCT-IDX FROM 1 BY 1                        DTSCS34
01536          UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT.                     DTSCS34
01537                                                                   DTSCS34
01538      IF L810-NO-REC-88                                            DTSCS34
01539          GO TO P7220-EXIT.                                        DTSCS34
01540                                                                   DTSCS34
01541      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS34
01542  P7220-EXIT.                                                      DTSCS34
01543      EXIT.                                                        DTSCS34
01544      SKIP3                                                        DTSCS34
01545  P7221-MDST-TO-DST-TABLE.                                         DTSCS34
01546      IF DST-OCC-CNT < DST-OCC-MAX                                 DTSCS34
01547          NEXT SENTENCE                                            DTSCS34
01548      ELSE                                                         DTSCS34
01549          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS34
01550          PERFORM P7230-DST-TABLE-TO-PAGE THRU P7230-EXIT          DTSCS34
01551              VARYING DST-GROUP-IDX FROM 1 BY 1                    DTSCS34
01552              UNTIL DST-GROUP-IDX > DST-OCC-CNT                    DTSCS34
01553          MOVE +0 TO DST-OCC-CNT                                   DTSCS34
01554          MOVE MDST-KEY-AREA TO MSKL-KEY-AREA                      DTSCS34
01555          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS34
01556          IF L810-OK-88                                            DTSCS34
01557              PERFORM S810-READ-PREV THRU S810-EXIT.               DTSCS34
01558                                                                   DTSCS34
01559      ADD +1 TO DST-OCC-CNT.                                       DTSCS34
01560                                                                   DTSCS34
01561      MOVE MDST-YRQ TO DST-YRQ (DST-OCC-CNT).                      DTSCS34
01562      MOVE MDST-DOC-NO TO DST-DOC-NO (DST-OCC-CNT).                DTSCS34
01563      MOVE MDST-ACCT-IND (MDST-ACCT-IDX)                           DTSCS34
01564        TO DST-ACCT-IND (DST-OCC-CNT).                             DTSCS34
01565      MOVE MDST-AMT (MDST-ACCT-IDX)                                DTSCS34
01566        TO DST-AMT (DST-OCC-CNT).                                  DTSCS34
01567  P7221-EXIT.                                                      DTSCS34
01568      EXIT.                                                        DTSCS34
01569      SKIP3                                                        DTSCS34
01570  P7230-DST-TABLE-TO-PAGE.                                         DTSCS34
01571      IF DST-DOC-NO (DST-GROUP-IDX) = MPAY-DOC-NO                  DTSCS34
01572          NEXT SENTENCE                                            DTSCS34
01573      ELSE                                                         DTSCS34
01574          PERFORM P7231-READ-MPAY THRU P7231-EXIT.                 DTSCS34
01575                                                                   DTSCS34
01576      IF PAGE-LINE-CNT < LINES-PER-PAGE                            DTSCS34
01577          NEXT SENTENCE                                            DTSCS34
01578      ELSE                                                         DTSCS34
01579          PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS34
01580          MOVE +0 TO PAGE-LINE-CNT.                                DTSCS34
01581                                                                   DTSCS34
01582      ADD +1 TO PAGE-LINE-CNT.                                     DTSCS34
01583                                                                   DTSCS34
01584      MOVE MPAY-PAY-TYPE                                           DTSCS34
01585        TO PAGE-PAY-TYPE (PAGE-LINE-CNT).                          DTSCS34
01586      MOVE DST-DOC-NO (DST-GROUP-IDX)                              DTSCS34
01587        TO PAGE-DOC-NO (PAGE-LINE-CNT).                            DTSCS34
01588      MOVE MPAY-RECEIVED-DATE                                      DTSCS34
01589        TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT).                     DTSCS34
01590      MOVE MPAY-ESTB-DATE                                          DTSCS34
01591        TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT).                    DTSCS34
01592      MOVE MPAY-WAIVE-INT-IND                                         CL**2
01593        TO PAGE-WAIVE-INT-IND (PAGE-LINE-CNT).                        CL**2
01594      MOVE MPAY-WAIVE-LATE-PEN-IND                                    CL**2
01595        TO PAGE-WAIVE-PEN-IND (PAGE-LINE-CNT).                        CL**2
01596      MOVE MPAY-NSF-PEN-CHARGE-IND                                    CL**5
01597        TO PAGE-NSF-PEN-IND (PAGE-LINE-CNT).                          CL**2
01598      SET PAGE-LINE-TYPE-DSTR-88 (PAGE-LINE-CNT) TO TRUE.          DTSCS34
01599      MOVE DST-YRQ (DST-GROUP-IDX)                                 DTSCS34
01600        TO PAGE-APPLIC-YRQ (PAGE-LINE-CNT).                        DTSCS34
01601      MOVE DST-ACCT-IND (DST-GROUP-IDX)                            DTSCS34
01602        TO PAGE-APPLIC-IND (PAGE-LINE-CNT).                        DTSCS34
01603      MOVE NULL-DOC-NO                                             DTSCS34
01604        TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).                     DTSCS34
01605      MOVE DST-AMT (DST-GROUP-IDX)                                 DTSCS34
01606        TO PAGE-APPLIC-AMT (PAGE-LINE-CNT).                        DTSCS34
01607  P7230-EXIT.                                                      DTSCS34
01608      EXIT.                                                        DTSCS34
01609      SKIP3                                                        DTSCS34
01610  P7231-READ-MPAY.                                                 DTSCS34
01611      MOVE LOW-VALUES TO MPAY-KEY-AREA.                            DTSCS34
01612      MOVE WRK-EMP-NO TO MPAY-EMP-NO.                              DTSCS34
01613      SET MPAY-PAY-88 TO TRUE.                                     DTSCS34
01614      MOVE DST-DOC-NO (DST-GROUP-IDX) TO MPAY-DOC-NO.              DTSCS34
01615      MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01616      PERFORM S810-READ THRU S810-EXIT.                            DTSCS34
01617      IF L810-NO-REC-88                                            DTSCS34
01618          MOVE 'NA' TO MPAY-PAY-TYPE                               DTSCS34
01619          MOVE +0 TO MPAY-REMIT-AMT                                DTSCS34
01620          MOVE SPACE TO MPAY-WAIVE-INT-IND                            CL**2
01621                        MPAY-WAIVE-LATE-PEN-IND                       CL**2
01622                        MPAY-NSF-PEN-CHARGE-IND                       CL**5
01623          MOVE +0 TO MPAY-RECEIVED-DATE                            DTSCS34
01624          MOVE SPACE TO MPAY-APPLIC-IND                            DTSCS34
01625          MOVE NULL-DOC-NO TO MPAY-APPLIC-DOC-NO                   DTSCS34
01626          MOVE +0 TO MPAY-ESTB-DATE                                DTSCS34
01627      ELSE                                                         DTSCS34
01628          MOVE MSKL-REC TO MPAY-REC.                               DTSCS34
01629                                                                   DTSCS34
01630 *****IF PAGE-LINE-CNT < LINES-PER-PAGE                            DTSCS34
01631 *****    NEXT SENTENCE                                            DTSCS34
01632 *****ELSE                                                         DTSCS34
01633 *****    PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT            DTSCS34
01634 *****    MOVE +0 TO PAGE-LINE-CNT.                                DTSCS34
01635 *****                                                             DTSCS34
01636 *****ADD +1 TO PAGE-LINE-CNT.                                     DTSCS34
01637 *****                                                             DTSCS34
01638 *****MOVE MPAY-PAY-TYPE                                           DTSCS34
01639 *****  TO PAGE-PAY-TYPE (PAGE-LINE-CNT).                          DTSCS34
01640 *****MOVE MPAY-DOC-NO                                             DTSCS34
01641 *****  TO PAGE-DOC-NO (PAGE-LINE-CNT).                            DTSCS34
01642 *****MOVE MPAY-RECEIVED-DATE                                      DTSCS34
01643 *****  TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT).                     DTSCS34
01644 *****MOVE MPAY-ESTB-DATE                                          DTSCS34
01645 *****  TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT).                    DTSCS34
01646 *****MOVE MPAY-ABATE-INT-IND                                      DTSCS34
01647 *****  TO PAGE-ABATE-INT-IND (PAGE-LINE-CNT).                     DTSCS34
01648 *****MOVE MPAY-ABATE-PEN-IND                                      DTSCS34
01649 *****  TO PAGE-ABATE-PEN-IND (PAGE-LINE-CNT).                     DTSCS34
01650 *****SET PAGE-LINE-TYPE-TRAN-88 (PAGE-LINE-CNT) TO TRUE.          DTSCS34
01651 *****MOVE MPAY-APPLIC-YRQ                                         DTSCS34
01652 *****  TO PAGE-APPLIC-YRQ (PAGE-LINE-CNT).                        DTSCS34
01653 *****MOVE MPAY-APPLIC-IND                                         DTSCS34
01654 *****  TO PAGE-APPLIC-IND (PAGE-LINE-CNT).                        DTSCS34
01655 *****MOVE MPAY-APPLIC-DOC-NO                                      DTSCS34
01656 *****  TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).                     DTSCS34
01657 *****MOVE MPAY-APPLIC-DOC-NO                                      DTSCS34
01658 *****  TO PAGE-APPLIC-DOC-NO (PAGE-LINE-CNT).                     DTSCS34
01659 *****MOVE MPAY-REMIT-AMT                                          DTSCS34
01660 *****  TO PAGE-APPLIC-AMT (PAGE-LINE-CNT).                        DTSCS34
01661  P7231-EXIT.                                                      DTSCS34
01662      EXIT.                                                        DTSCS34
01663      EJECT                                                        DTSCS34
01664  P8100-STORE-PAGE-AREA.                                           DTSCS34
01665      IF ITEM-CNT < ITEM-MAX-LCCM                                  DTSCS34
01666          ADD +1 TO ITEM-CNT                                       DTSCS34
01667          MOVE PAGE-AREA TO LCCM-SCR-HOLD-PAGE-AREA (ITEM-CNT)     DTSCS34
01668          GO TO P8100-EXIT.                                        DTSCS34
01669                                                                   DTSCS34
01670      IF ITEM-CNT < ITEM-MAX                                       DTSCS34
01671          ADD +1 TO ITEM-CNT                                       DTSCS34
01672          MOVE PAGE-AREA TO L829-REC                               DTSCS34
01673          PERFORM S829-WRITE THRU S829-EXIT.                       DTSCS34
01674  P8100-EXIT.                                                      DTSCS34
01675      EXIT.                                                        DTSCS34
01676      SKIP3                                                        DTSCS34
01677  P8200-RETREIVE-PAGE-AREA.                                        DTSCS34
01678      IF ITEM-SUB > ITEM-MAX-LCCM                                  DTSCS34
01679          COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM          DTSCS34
01680          PERFORM S829-READ-ITEM THRU S829-EXIT                    DTSCS34
01681          IF L829-NO-REC-88                                        DTSCS34
01682              GO TO S899-ABEND                                     DTSCS34
01683          ELSE                                                     DTSCS34
01684              MOVE L829-REC TO PAGE-AREA                           DTSCS34
01685      ELSE                                                         DTSCS34
01686          MOVE LCCM-SCR-HOLD-PAGE-AREA (ITEM-SUB) TO PAGE-AREA.    DTSCS34
01687  P8200-EXIT.                                                      DTSCS34
01688      EXIT.                                                        DTSCS34
01689 /*****************************************************************DTSCS34
01690 * LINKS TO UTILITY MODULES                                        DTSCS34
01691 ******************************************************************DTSCS34
01692      SKIP1                                                        DTSCS34
01693  S001-FROM-FED-8.                                                 DTSCS34
01694      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS34
01695      GO TO S001-DATE.                                             DTSCS34
01696      SKIP1                                                        DTSCS34
01697 *S001-FROM-ABS-DATE.                                              DTSCS34
01698 *****SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS34
01699 *****GO TO S001-DATE.                                             DTSCS34
01700 *****SKIP1                                                        DTSCS34
01701  S001-DATE.                                                       DTSCS34
01702      EXEC CICS LINK                                               DTSCS34
01703          PROGRAM('DTSCU001')                                         CL**2
01704          COMMAREA(L001-COMM-AREA)                                 DTSCS34
01705      END-EXEC.                                                    DTSCS34
01706  S001-EXIT.                                                       DTSCS34
01707      EXIT.                                                        DTSCS34
01708      SKIP3                                                        DTSCS34
01709  S004-FROM-5.                                                     DTSCS34
01710      SET L004-FROM-5 TO TRUE.                                     DTSCS34
01711      GO TO S004-QTR.                                              DTSCS34
01712      SKIP1                                                        DTSCS34
01713  S004-FROM-ABS.                                                   DTSCS34
01714      SET L004-FROM-ABS TO TRUE.                                   DTSCS34
01715      GO TO S004-QTR.                                              DTSCS34
01716      SKIP1                                                        DTSCS34
01717  S004-QTR.                                                        DTSCS34
01718      EXEC CICS LINK                                               DTSCS34
01719          PROGRAM('DTSCU004')                                         CL**2
01720          COMMAREA(L004-COMM-AREA)                                 DTSCS34
01721      END-EXEC.                                                    DTSCS34
01722  S004-EXIT.                                                       DTSCS34
01723      EXIT.                                                        DTSCS34
01724      SKIP3                                                        DTSCS34
01725  S018-EMP-NO-FROM-SCREEN.                                         DTSCS34
01726      EXEC CICS LINK                                               DTSCS34
01727          PROGRAM('DTSCU018')                                         CL**2
01728          COMMAREA(L018-COMM-AREA)                                 DTSCS34
01729      END-EXEC.                                                    DTSCS34
01730  S018-EXIT.                                                       DTSCS34
01731      EXIT.                                                        DTSCS34
01732      SKIP3                                                           CL**8
01733  S029-YRQ-FROM-SCREEN.                                               CL**8
01734      EXEC CICS LINK                                                  CL**8
01735          PROGRAM('DTSCU029')                                         CL**8
01736          COMMAREA(L029-COMM-AREA)                                    CL**8
01737      END-EXEC.                                                       CL**8
01738  S029-EXIT.                                                          CL**8
01739      EXIT.                                                           CL**8
01740      SKIP3                                                        DTSCS34
01741  S803-REQ-SCR-ID-EDIT.                                            DTSCS34
01742      EXEC CICS LINK                                               DTSCS34
01743          PROGRAM ('DTSCU803')                                        CL**2
01744          COMMAREA (DFHCOMMAREA)                                   DTSCS34
01745      END-EXEC.                                                    DTSCS34
01746  S803-EXIT.                                                       DTSCS34
01747      EXIT.                                                        DTSCS34
01748      SKIP3                                                        DTSCS34
01749  S804-INVALID-KEY.                                                DTSCS34
01750      EXEC CICS LINK                                               DTSCS34
01751          PROGRAM ('DTSCU804')                                        CL**2
01752          COMMAREA (DFHCOMMAREA)                                   DTSCS34
01753      END-EXEC.                                                    DTSCS34
01754  S804-EXIT.                                                       DTSCS34
01755      EXIT.                                                        DTSCS34
01756      SKIP3                                                        DTSCS34
01757  S805-MSG-AREA.                                                   DTSCS34
01758      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS34
01759      SKIP1                                                        DTSCS34
01760      EXEC CICS LINK                                               DTSCS34
01761          PROGRAM ('DTSCU805')                                        CL**2
01762          COMMAREA (L805-COMM-AREA)                                DTSCS34
01763      END-EXEC.                                                    DTSCS34
01764      SKIP1                                                        DTSCS34
01765      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS34
01766  S805-EXIT.                                                       DTSCS34
01767      EXIT.                                                        DTSCS34
01768      EJECT                                                        DTSCS34
01769  S810-READ.                                                       DTSCS34
01770      SET L810-READ-88 TO TRUE.                                    DTSCS34
01771      GO TO S810-IO.                                               DTSCS34
01772      SKIP1                                                        DTSCS34
01773  S810-START-BROWSE.                                               DTSCS34
01774      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS34
01775      GO TO S810-IO.                                               DTSCS34
01776      SKIP1                                                        DTSCS34
01777  S810-READ-NEXT.                                                  DTSCS34
01778      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS34
01779      GO TO S810-IO.                                               DTSCS34
01780      SKIP1                                                        DTSCS34
01781  S810-READ-PREV.                                                  DTSCS34
01782      SET L810-READ-PREV-88 TO TRUE.                               DTSCS34
01783      GO TO S810-IO.                                               DTSCS34
01784      SKIP1                                                        DTSCS34
01785  S810-END-BROWSE.                                                 DTSCS34
01786      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS34
01787      GO TO S810-IO.                                               DTSCS34
01788      SKIP1                                                        DTSCS34
01789  S810-COUNT.                                                      DTSCS34
01790      SET L810-COUNT-88 TO TRUE.                                   DTSCS34
01791      GO TO S810-IO.                                               DTSCS34
01792      SKIP1                                                        DTSCS34
01793 *S810-REWRITE.                                                    DTSCS34
01794 *****SET L810-REWRITE-88 TO TRUE.                                 DTSCS34
01795 *****GO TO S810-IO.                                               DTSCS34
01796 *****SKIP1                                                        DTSCS34
01797 *S810-WRITE.                                                      DTSCS34
01798 *****SET L810-WRITE-88 TO TRUE.                                   DTSCS34
01799 *****GO TO S810-IO.                                               DTSCS34
01800 *****SKIP1                                                        DTSCS34
01801 *S810-DELETE.                                                     DTSCS34
01802 *****SET L810-DELETE-88 TO TRUE.                                  DTSCS34
01803 *****GO TO S810-IO.                                               DTSCS34
01804      SKIP1                                                        DTSCS34
01805  S810-IO.                                                         DTSCS34
01806      SKIP1                                                        DTSCS34
01807      EXEC CICS LINK                                               DTSCS34
01808          PROGRAM ('DTSCU810')                                        CL**3
01809          COMMAREA (L810-COMM-AREA)                                DTSCS34
01810      END-EXEC.                                                    DTSCS34
01811      SKIP1                                                        DTSCS34
01812      IF L810-FILE-CLOSED-88                                       DTSCS34
01813          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS34
01814          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS34
01815          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS34
01816          GO TO MAINLINE-EXIT.                                     DTSCS34
01817  S810-EXIT.                                                       DTSCS34
01818      EXIT.                                                        DTSCS34
01819      EJECT                                                        DTSCS34
01820  S829-READ-ITEM.                                                  DTSCS34
01821      SET L829-READ-ITEM-88 TO TRUE.                               DTSCS34
01822      GO TO S829-IO.                                               DTSCS34
01823                                                                   DTSCS34
01824  S829-WRITE.                                                      DTSCS34
01825      SET L829-WRITE-88 TO TRUE.                                   DTSCS34
01826      GO TO S829-IO.                                               DTSCS34
01827                                                                   DTSCS34
01828  S829-DELETE-QUEUE.                                               DTSCS34
01829      SET L829-DELETE-QUEUE-88 TO TRUE.                            DTSCS34
01830      GO TO S829-IO.                                               DTSCS34
01831                                                                   DTSCS34
01832  S829-IO.                                                         DTSCS34
01833 *    COMPUTE L829-COMM-AREA-LENGTH                                   CL**4
01834 *      = L829-CONTROL-BLOCK-LENGTH + ITEM-LENGTH.                    CL**4
01835      MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX.          DTSCS34
01836      MOVE 'S' TO L829-QUEUE-NAME-SUFFIX.                          DTSCS34
01837      MOVE ITEM-LENGTH TO L829-REC-LENGTH.                         DTSCS34
01838      SET L829-DEFAULT-STORAGE-88 TO TRUE.                         DTSCS34
01839                                                                   DTSCS34
01840      EXEC CICS                                                    DTSCS34
01841          LINK                                                     DTSCS34
01842              PROGRAM ('DTSCU829')                                    CL**3
01843              COMMAREA (L829-COMM-AREA)                            DTSCS34
01844      END-EXEC.                                                    DTSCS34
01845  S829-EXIT.                                                       DTSCS34
01846      EXIT.                                                        DTSCS34
01847      EJECT                                                        DTSCS34
01848  S851-SCREEN-PROCESSING.                                          DTSCS34
01849      EXEC CICS LINK                                               DTSCS34
01850          PROGRAM ('DTSCU851')                                        CL**3
01851          COMMAREA (L851-COMM-AREA)                                DTSCS34
01852      END-EXEC.                                                    DTSCS34
01853  S851-EXIT.                                                       DTSCS34
01854      EXIT.                                                        DTSCS34
01855      SKIP3                                                        DTSCS34
01856  S899-ABEND.                                                      DTSCS34
01857      EXEC CICS ABEND                                              DTSCS34
01858          ABCODE(WRK-ABEND-CD)                                     DTSCS34
01859      END-EXEC.                                                    DTSCS34
01860  S899-EXIT.                                                       DTSCS34
01861      EXIT.                                                        DTSCS34
01862      EJECT                                                        DTSCS34
01863  S1100-EDIT-KEY.                                                  DTSCS34
01864      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS34
01865  S1100-EXIT. EXIT.                                                DTSCS34
01866 /*****************************************************************DTSCS34
01867 *                                                                 DTSCS34
01868 ******************************************************************DTSCS34
01869  S1101-EMP-NO.                                                    DTSCS34
01870      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS34
01871      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS34
01872                                                                   DTSCS34
01873      IF L018-NO-ENTRY                                             DTSCS34
01874         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS34
01875         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS34
01876         GO TO S1101-EXIT.                                         DTSCS34
01877                                                                   DTSCS34
01878      IF L018-NOT-VALID                                            DTSCS34
01879         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS34
01880         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS34
01881         GO TO S1101-EXIT.                                         DTSCS34
01882                                                                   DTSCS34
01883      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS34
01884                                                                   DTSCS34
01885      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS34
01886  S1101-EXIT. EXIT.                                                DTSCS34
01887      SKIP3                                                        DTSCS34
01888  S1110-READ-MPRF.                                                 DTSCS34
01889      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS34
01890      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS34
01891      SET MPRF-PRF-88 TO TRUE.                                     DTSCS34
01892      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS34
01893      PERFORM S810-READ THRU S810-EXIT.                            DTSCS34
01894      IF L810-NO-REC-88                                            DTSCS34
01895          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS34
01896          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS34
01897      ELSE                                                         DTSCS34
01898          MOVE MSKL-REC TO MPRF-REC                                DTSCS34
01899          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS34
01900  S1110-EXIT.                                                      DTSCS34
01901      EXIT.                                                        DTSCS34
01902      SKIP3                                                        DTSCS34
01903  S1199-ERROR.                                                     DTSCS34
01904      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS34
01905                                         MAP-EMP-NO-2-A.           DTSCS34
01906      IF LCCM-NO-MSG                                               DTSCS34
01907         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS34
01908         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS34
01909         SET CURSOR-SET-YES TO TRUE.                               DTSCS34
01910  S1199-EXIT. EXIT.                                                DTSCS34
01911 /*****************************************************************DTSCS34
01912 *                                                                 DTSCS34
01913 ******************************************************************DTSCS34
01914  S1200-YRQ.                                                       DTSCS34
01915      MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA.                           CL**8
01916      PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT.                    CL**8
01917                                                                   DTSCS34
01918      IF L029-NO-ENTRY                                                CL**8
01919          MOVE +0 TO WRK-YRQ                                       DTSCS34
01920      ELSE                                                         DTSCS34
01921      IF L029-VALID                                                   CL**8
01922          MOVE L029-YRQ TO WRK-YRQ                                    CL**8
01923      ELSE                                                         DTSCS34
01924      IF (MAP-YRQ-YR = '99') AND (MAP-YRQ-Q = '9')                 DTSCS34
01925          MOVE ALL-NINES-YRQ TO WRK-YRQ                            DTSCS34
01926      ELSE                                                         DTSCS34
01927          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS34
01928          PERFORM S1299-ERROR THRU S1299-EXIT.                     DTSCS34
01929  S1200-EXIT.                                                      DTSCS34
01930      EXIT.                                                        DTSCS34
01931      SKIP3                                                        DTSCS34
01932  S1299-ERROR.                                                     DTSCS34
01933      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A                  CL**8
01934                                        MAP-YRQ-Q-A.                  CL**8
01935                                                                   DTSCS34
01936      IF LCCM-NO-MSG                                               DTSCS34
01937          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS34
01938          MOVE CATB-CURSOR TO MAP-YRQ-YR-L                         DTSCS34
01939          SET CURSOR-SET-YES TO TRUE.                              DTSCS34
01940  S1299-EXIT.                                                      DTSCS34
01941      EXIT.                                                        DTSCS34
01942 /*****************************************************************DTSCS34
01943 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS34
01944 ******************************************************************DTSCS34
01945  S5300-SET-INQ-ATTRB.                                             DTSCS34
01946      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS34
01947                                    WRK-ATB-NUM.                   DTSCS34
01948                                                                   DTSCS34
01949      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS34
01950  S5300-EXIT.                                                      DTSCS34
01951      EXIT.                                                        DTSCS34
01952      SKIP3                                                        DTSCS34
01953  S5900-SET-ATTRB.                                                 DTSCS34
01954      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS34
01955                                        MAP-EMP-NO-2-A.            DTSCS34
01956                                                                   DTSCS34
01957      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A                   CL**8
01958                                       MAP-YRQ-Q-A.                   CL**8
01959                                                                   DTSCS34
01960      MOVE CATB-ASKIP-BRT-MDTOFF  TO MAP-PRIMARY-NAME-A               CL**3
01961                                     MAP-CURR-PAGE-A               DTSCS34
01962                                     MAP-LAST-PAGE-A.              DTSCS34
01963                                                                   DTSCS34
01964      PERFORM                                                      DTSCS34
01965        VARYING LINE-OCC FROM 1 BY 1                               DTSCS34
01966        UNTIL LINE-OCC > LINES-PER-PAGE                            DTSCS34
01967          MOVE CATB-ASKIP-BRT-MDTOFF                               DTSCS34
01968            TO MAP-LINE-A (LINE-OCC)                               DTSCS34
01969      END-PERFORM.                                                 DTSCS34
01970                                                                   DTSCS34
01971      MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A.                DTSCS34
01972  S5900-EXIT.                                                      DTSCS34
01973      EXIT.                                                        DTSCS34
01974 /*****************************************************************DTSCS34
01975 * MAP ROUTINES                                                   *DTSCS34
01976 ******************************************************************DTSCS34
01977  S9100-RECEIVE.                                                   DTSCS34
01978      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS34
01979      SKIP1                                                        DTSCS34
01980      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS34
01981      SKIP1                                                        DTSCS34
01982      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS34
01983      SKIP1                                                        DTSCS34
01984      MOVE L851-AID TO LCCM-AID.                                   DTSCS34
01985      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS34
01986  S9100-EXIT.                                                      DTSCS34
01987      EXIT.                                                        DTSCS34
01988      SKIP3                                                        DTSCS34
01989  S9200-SEND-DATAONLY.                                             DTSCS34
01990      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS34
01991      SKIP1                                                        DTSCS34
01992      IF LCCM-NO-MSG                                               DTSCS34
01993          NEXT SENTENCE                                            DTSCS34
01994      ELSE                                                         DTSCS34
01995          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS34
01996      SKIP1                                                        DTSCS34
01997      IF CURSOR-SET-GOTO                                           DTSCS34
01998          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS34
01999      ELSE                                                         DTSCS34
02000          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS34
02001      SKIP1                                                        DTSCS34
02002      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS34
02003      SKIP1                                                        DTSCS34
02004      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS34
02005      SKIP1                                                        DTSCS34
02006      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS34
02007  S9200-EXIT.                                                      DTSCS34
02008      EXIT.                                                        DTSCS34
02009      SKIP3                                                        DTSCS34
02010  S9300-SEND-MAP.                                                  DTSCS34
02011      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS34
02012      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS34
02013      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS34
02014      SKIP1                                                        DTSCS34
02015      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS34
02016      SKIP1                                                        DTSCS34
02017      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS34
02018      SKIP1                                                        DTSCS34
02019      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS34
02020      SKIP1                                                        DTSCS34
02021      IF CURSOR-SET-NO                                             DTSCS34
02022          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS34
02023      SKIP1                                                        DTSCS34
02024      SET L851-SEND-88 TO TRUE.                                    DTSCS34
02025      SKIP1                                                        DTSCS34
02026      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS34
02027      SKIP1                                                        DTSCS34
02028      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS34
02029  S9300-EXIT.                                                      DTSCS34
02030      EXIT.                                                        DTSCS34
02031      SKIP3                                                        DTSCS34
02032  S9320-INQUIRY-FKEYS.                                             DTSCS34
02033      MOVE CFKD-FIRST TO MAP-KEY-FIRST.                            DTSCS34
02034      MOVE CFKD-LAST TO MAP-KEY-LAST.                              DTSCS34
02035      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS34
02036      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS34
02037      SKIP1                                                        DTSCS34
02038 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                        CL**3
02039  S9320-EXIT.                                                      DTSCS34
02040      EXIT.                                                        DTSCS34
02041      SKIP3                                                        DTSCS34
02042 *S9321-JUMP-KEYS.                                                    CL**3
02043 *    MOVE 'F9=QTR' TO MAP-KEY-QTR-INQ.                               CL**3
02044 *    MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ.                              CL**3
02045 *    MOVE 'F12=ADJ' TO MAP-KEY-ADJ-INQ.                              CL**3
02046 *S9321-EXIT.                                                         CL**3
02047 *    EXIT.                                                           CL**3
02048      SKIP3                                                        DTSCS34
02049  S9330-DSCR-FIELDS.                                               DTSCS34
02050      IF WRK-MPRF-YES-88                                           DTSCS34
02051          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME                  CL**3
02052      ELSE                                                         DTSCS34
02053          MOVE LOW-VALUES TO MAP-PRIMARY-NAME.                        CL**3
02054  S9330-EXIT.                                                      DTSCS34
02055      EXIT.                                                        DTSCS34
02056      SKIP3                                                        DTSCS34
02057  S9900-PREPARE-SEND.                                              DTSCS34
02058      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS34
02059                         LCCM-SCR-ID.                              DTSCS34
02060      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS34
02061      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS34
02062  S9900-EXIT.                                                      DTSCS34
02063      EXIT.                                                        DTSCS34
