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