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