00001  IDENTIFICATION DIVISION.                                         09/22/99
00002  PROGRAM-ID.             DTSCS42.                                 DTSCS42
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV047
00004  DATE-WRITTEN.           JUNE 1994.                               DTSCS42
00005  DATE-COMPILED.                                                   DTSCS42
00006                                                                   DTSCS42
00007                                                                   DTSCS42
00008 *****                                                             DTSCS42
00009 *                                                                 DTSCS42
00010 *    FUNCTION:  MISCELLANEOUS COLLECTIONS INQUIRY/UPDATE          DTSCS42
00011 *               SCREEN PROCESSOR.                                 DTSCS42
00012 *                                                                 DTSCS42
00013 *                                                                 DTSCS42
00014 *    MODIFICATION LOG:                                            DTSCS42
00015 *                                                                 DTSCS42
00016 *    01/29/99  INITIAL DEVELOPMENT.  COPIED FROM MACCS42             CL**2
00017 *              WORK ORDER:                      PROGRAMMER: ZL1      CL**2
00018 *                                                                 DTSCS42
00019 *                                                                 DTSCS42
00020 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS42
00021 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS42
00022 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCS42
00023 *                                                                 DTSCS42
00024 *                                                                 DTSCS42
00025 *  DESCRIPTION:                                                   DTSCS42
00026 *                                                                 DTSCS42
00027 *    CLEAR:                                                       DTSCS42
00028 *                                                                 DTSCS42
00029 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS42
00030 *                                                                 DTSCS42
00031 *                                                                 DTSCS42
00032 *    JUMP:                                                        DTSCS42
00033 *                                                                 DTSCS42
00034 *      F19  QUARTER INQUIRY (31).                                 DTSCS42
00035 *      F20  COLLECTIONS INQUIRY (41).                             DTSCS42
00036 *                                                                 DTSCS42
00037 *                                                                 DTSCS42
00038 *    INQUIRY:                                                     DTSCS42
00039 *                                                                 DTSCS42
00040 *      CONTROL FIELD(S): MAP-EMP-NO.                              DTSCS42
00041 *                                                                 DTSCS42
00042 *                                                                 DTSCS42
00043 *      JUMP IN:  DISPLAY INFORMATION ASSOCIATED WITH LCCM-EMP-NO. DTSCS42
00044 *                                                                 DTSCS42
00045 *                                                                 DTSCS42
00046 *      ENTER:  DISPLAY INFORMATION ASSOCIATED WITH MAP-EMP-NO.    DTSCS42
00047 *                                                                 DTSCS42
00048 *                                                                 DTSCS42
00049 *    LCCM-MISC-CONTROL-AREA MAINTENANCE:                          DTSCS42
00050 *                                                                 DTSCS42
00051 *      LCCM-EMP-NO                                                DTSCS42
00052 *                                                                 DTSCS42
00053 *                                                                 DTSCS42
00054 *    UPDATE:                                                      DTSCS42
00055 *                                                                 DTSCS42
00056 *      MOD                                                        DTSCS42
00057 *                                                                 DTSCS42
00058 *        DON'T FORGET TO UPDATE MPRF-BANKRUPTCY-OPEN-IND.         DTSCS42
00059 *                                                                 DTSCS42
00060 *                                                                 DTSCS42
00061 *    RECORDS READ:                                                DTSCS42
00062 *                                                                 DTSCS42
00063 *      MASTER:                                                    DTSCS42
00064 *                                                                 DTSCS42
00065 *        MPRF                                                     DTSCS42
00066 *        MTAD                                                     DTSCS42
00067 *        MCOL                                                     DTSCS42
00068 *                                                                 DTSCS42
00069 *                                                                 DTSCS42
00070 *      ALTERNATE INDEX:                                           DTSCS42
00071 *                                                                 DTSCS42
00072 *        NONE.                                                    DTSCS42
00073 *                                                                 DTSCS42
00074 *                                                                 DTSCS42
00075 *      REFERENCE:                                                 DTSCS42
00076 *                                                                 DTSCS42
00077 *        NONE.                                                    DTSCS42
00078 *                                                                 DTSCS42
00079 *                                                                 DTSCS42
00080 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS42
00081 *                                                                 DTSCS42
00082 *        NONE.                                                    DTSCS42
00083 *                                                                 DTSCS42
00084 *                                                                 DTSCS42
00085 *    RECORDS UPDATED:                                             DTSCS42
00086 *                                                                 DTSCS42
00087 *      MASTER:                                                    DTSCS42
00088 *                                                                 DTSCS42
00089 *        MPRF (REWRITE)                                           DTSCS42
00090 *        MTAD (REWRITE)                                           DTSCS42
00091 *        MCOL (WRITE, REWRITE, DELETE)                            DTSCS42
00092 *        MEVL (WRITE)                                                CL*26
00093 *           WRITE AN MEVL RECORD WHEN A USER ADDS AN                 CL*26
00094 *           MCOL-LEGAL-REFERRAL-DATE.                                CL*26
00095 *                                                                    CL*26
00096 *      REFERENCE:                                                 DTSCS42
00097 *                                                                 DTSCS42
00098 *        NONE.                                                    DTSCS42
00099 *                                                                 DTSCS42
00100 *                                                                 DTSCS42
00101 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS42
00102 *                                                                 DTSCS42
00103 *        NONE.                                                    DTSCS42
00104 *                                                                 DTSCS42
00105 *                                                                 DTSCS42
00106 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS42
00107 *                                                                 DTSCS42
00108 *      NONE.                                                      DTSCS42
00109 *                                                                 DTSCS42
00110 *                                                                 DTSCS42
00111 *    TEMPORARY STORAGE USAGE:                                     DTSCS42
00112 *                                                                 DTSCS42
00113 *      NONE.                                                      DTSCS42
00114 *                                                                 DTSCS42
00115 *                                                                 DTSCS42
00116 *    MODULES LINKED TO:                                           DTSCS42
00117 *                                                                 DTSCS42
00118 *      DTSCU001  DATE EDIT/CONVERSION.                               CL**2
00119 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                       CL**2
00120 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.            CL**2
00121 *      DTSCU031  EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION.       CL**2
00122 *      DTSCU034  COLLECTIONS CODES EDIT/DESCRIPTION.                 CL**2
00123 *      DTSCU061  FIELD ZIP / FIELD REP ID.                           CL**2
00124 *      DTSCU062  FIELD REP ID EDIT/DESCRIPTION.                      CL**2
00125 *      DTSCU082  OPID LOOKUP  EDIT/DESCRIPTION.                      CL**9
00126 *      DTSCU221  MPRF-UPDATE DATA ELEMENT MAINTENANCE.               CL**2
00127 *      DTSCU331  WRITE MAINTENANCE LIST REPORT RECORD.               CL**2
00128 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                           CL**2
00129 *                                                                 DTSCS42
00130 *****                                                                CL*28
00131                                                                   DTSCS42
00132                                                                      CL*28
00133  ENVIRONMENT DIVISION.                                            DTSCS42
00134                                                                   DTSCS42
00135                                                                      CL*28
00136  DATA DIVISION.                                                   DTSCS42
00137                                                                   DTSCS42
00138                                                                      CL*28
00139  WORKING-STORAGE SECTION.                                         DTSCS42
001395 77  PAN-VALET PICTURE X(24) VALUE '047DTSCS42   09/22/99'.       DTSCS42
00140                                                                   DTSCS42
00141  01  WRK-AREA.                                                    DTSCS42
00142      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S42 '.    DTSCS42
00143                                                                   DTSCS42
00144      05  WRK-SCR-ID.                                              DTSCS42
00145          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 42.        DTSCS42
00146                                                                   DTSCS42
00147      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '40'.      DTSCS42
00148                                                                   DTSCS42
00149      05  ALL-NINES-DATE              PIC S9(09)  COMP-3           DTSCS42
00150                                             VALUE +999999999.     DTSCS42
00151                                                                   DTSCS42
00152      05  WRK-MEVL-TEXT               PIC  X(50)                      CL*26
00153             VALUE 'CASE REFERRED TO GENERAL COUNSEL'.                CL*26
00154                                                                      CL*26
00155      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS42
00156          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS42
00157          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS42
00158                                                                   DTSCS42
00159      05  CURSOR-SET-IND              PIC X(01).                   DTSCS42
00160          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS42
00161          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS42
00162          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS42
00163                                                                   DTSCS42
00164      05  REQ-IND                     PIC X(01).                   DTSCS42
00165          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS42
00166          88  REQ-ERROR                       VALUE 'O'.           DTSCS42
00167          88  REQ-JUMP                        VALUE 'J'.           DTSCS42
00168          88  REQ-UPDATE                      VALUE 'U'.           DTSCS42
00169          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS42
00170          88  REQ-CLEAR                       VALUE 'C'.           DTSCS42
00171          88  REQ-EDIT                        VALUE 'E'.           DTSCS42
00172                                                                   DTSCS42
00173      05  RESP-IND                    PIC X(01).                   DTSCS42
00174          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS42
00175          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS42
00176          88  RESP-JUMP                       VALUE 'J'.           DTSCS42
00177          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS42
00178                                                                   DTSCS42
00179      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS42
00180                                                                   DTSCS42
00181      05  WRK-ATB-AN                  PIC  X(01).                     CL*28
00182                                                                      CL*28
00183      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS42
00184                                                                   DTSCS42
00185      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS42
00186                                                                   DTSCS42
00187      05  WRK-START-DATE              PIC S9(09)  COMP-3.          DTSCS42
00188                                                                      CL*28
00189      05  WRK-END-DATE                PIC S9(09)  COMP-3.          DTSCS42
00190                                                                   DTSCS42
00191      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS42
00192          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS42
00193          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS42
00194                                                                   DTSCS42
00195      05  WRK-MCOL-IND                PIC  X(01).                  DTSCS42
00196          88  WRK-MCOL-YES-88                VALUE 'Y'.            DTSCS42
00197          88  WRK-MCOL-NO-88                 VALUE 'N'.            DTSCS42
00198                                                                   DTSCS42
00199      05  WRK-PETITION-IND            PIC  X(01).                  DTSCS42
00200          88  WRK-PETITION-IND-YES-88            VALUE 'Y'.        DTSCS42
00201          88  WRK-PETITION-IND-NO-88             VALUE 'N'.        DTSCS42
00202                                                                   DTSCS42
00203      05  WRK-DISCHRG-IND             PIC  X(01).                  DTSCS42
00204          88  WRK-DISCHRG-IND-YES-88             VALUE 'Y'.        DTSCS42
00205          88  WRK-DISCHRG-IND-NO-88              VALUE 'N'.        DTSCS42
00206                                                                   DTSCS42
00207      05  WRK-POC-REQ-IND             PIC  X(01).                  DTSCS42
00208          88  WRK-POC-REQ-IND-YES-88             VALUE 'Y'.        DTSCS42
00209          88  WRK-POC-REQ-IND-NO-88              VALUE 'N'.        DTSCS42
00210                                                                   DTSCS42
00211 *****05  WRK-OVERLAP-IND             PIC  X(01).                     CL*28
00212 *********88  WRK-OVERLAP-YES-88                  VALUE 'Y'.          CL*28
00213 *********88  WRK-OVERLAP-NO-88                   VALUE 'N'.          CL*28
00214                                                                   DTSCS42
00215      05  WRK-ACTION-IND              PIC  X(01).                  DTSCS42
00216          88  WRK-ACTION-ADD-88                   VALUE 'A'.       DTSCS42
00217          88  WRK-ACTION-MOD-88                   VALUE 'M'.       DTSCS42
00218                                                                   DTSCS42
00219      05  WRK-NULL-MCOL-IND           PIC  X(01).                  DTSCS42
00220          88  WRK-NULL-MCOL-YES-88                VALUE 'Y'.       DTSCS42
00221          88  WRK-NULL-MCOL-NO-88                 VALUE 'N'.       DTSCS42
00222                                                                   DTSCS42
00223      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS42
00224                                                                   DTSCS42
00225      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS42
00226          10  FILLER                  PIC X(05).                   DTSCS42
00227          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS42
00228          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS42
00229                                                                   DTSCS42
00230      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS42
00231          10  FILLER                  PIC 9(05).                   DTSCS42
00232          10  WRK-DISPLAY-YR          PIC 9(02).                   DTSCS42
00233          10  WRK-DISPLAY-MO          PIC 9(02).                   DTSCS42
00234          10  WRK-DISPLAY-DA          PIC 9(02).                   DTSCS42
00235                                                                   DTSCS42
00236      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS42
00237          10  FILLER                  PIC X(08).                   DTSCS42
00238          10  WRK-DISPLAY-ID-NO       PIC X(03).                   DTSCS42
00239                                                                   DTSCS42
00240      05  WRK-OCC                     PIC S9(04)  COMP.            DTSCS42
00241      EJECT                                                           CL*28
00242  01  MSG-LITERALS.                                                DTSCS42
00243 *****05  MSG-E421-AREA.                                              CL*29
00244 *********10  FILLER                  PIC  X(04)  VALUE 'E421'.       CL*29
00245 *********10  FILLER                  PIC  X(60) VALUE                CL*29
00246 *****'BANKRUPT EMPLOYERS MUST BE INACTIVE                       '.   CL*29
00247                                                                   DTSCS42
00248 *****05  MSG-E422-AREA.                                              CL*29
00249 *********10  FILLER                  PIC  X(04)  VALUE 'E422'.       CL*29
00250 *********10  FILLER                  PIC  X(60) VALUE                CL*29
00251 *****'SPAN OF BANKRUPTCY MAY NOT OVERLAP A SPAN OF LIABILITY    '.   CL*29
00252                                                                   DTSCS42
00253      05  MSG-E421-AREA.                                           DTSCS42
00254          10  FILLER                  PIC  X(04)  VALUE 'E421'.    DTSCS42
00255          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00256      'PROOF REQ MUST BE > PETITION DATE                         '.DTSCS42
00257                                                                   DTSCS42
00258      05  MSG-E422-AREA.                                           DTSCS42
00259          10  FILLER                  PIC  X(04)  VALUE 'E422'.    DTSCS42
00260          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00261      'PROOF FILED MUST BE > PETITION DATE                       '.DTSCS42
00262                                                                   DTSCS42
00263      05  MSG-E423-AREA.                                           DTSCS42
00264          10  FILLER                  PIC  X(04)  VALUE 'E423'.    DTSCS42
00265          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00266      'PROOF FILED MUST BE <= CURRENT PROCESSING DATE            '.DTSCS42
00267                                                                   DTSCS42
00268      05  MSG-E424-AREA.                                           DTSCS42
00269          10  FILLER                  PIC  X(04)  VALUE 'E424'.    DTSCS42
00270          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00271      'DISCHRG/CLOSE MUST BE > PETITION DATE                     '.DTSCS42
00272                                                                   DTSCS42
00273      05  MSG-E425-AREA.                                           DTSCS42
00274          10  FILLER                  PIC  X(04)  VALUE 'E425'.    DTSCS42
00275          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00276      'DISCHRG/CLOSE MUST BE <= CURRENT PROCESSING DATE          '.DTSCS42
00277                                                                   DTSCS42
00278      05  MSG-E426-AREA.                                           DTSCS42
00279          10  FILLER                  PIC  X(04)  VALUE 'E426'.    DTSCS42
00280          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00281      'DISMISS MUST BE > PETITION DATE                           '.DTSCS42
00282                                                                   DTSCS42
00283      05  MSG-E427-AREA.                                           DTSCS42
00284          10  FILLER                  PIC  X(04)  VALUE 'E427'.    DTSCS42
00285          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00286      'DISMISS MUST BE <= CURRENT PROCESSING DATE                '.DTSCS42
00287                                                                   DTSCS42
00288      05  MSG-E428-AREA.                                           DTSCS42
00289          10  FILLER                  PIC  X(04)  VALUE 'E428'.    DTSCS42
00290          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00291      'LAST COMM MUST BE > PETITION DATE                         '.DTSCS42
00292                                                                   DTSCS42
00293      05  MSG-E429-AREA.                                           DTSCS42
00294          10  FILLER                  PIC  X(04)  VALUE 'E429'.    DTSCS42
00295          10  FILLER                  PIC  X(60) VALUE             DTSCS42
00296      'LAST COMM MUST BE <= CURRENT PROCESSING DATE              '.DTSCS42
00297      EJECT                                                        DTSCS42
00298  01  L001-COMM-AREA.                                              DTSCS42
00299  ++INCLUDE DTSIL001                                                  CL**2
00300      EJECT                                                        DTSCS42
00301  01  L015-COMM-AREA.                                              DTSCS42
00302  ++INCLUDE DTSIL015                                                  CL**2
00303      EJECT                                                        DTSCS42
00304  01  L018-COMM-AREA.                                              DTSCS42
00305  ++INCLUDE DTSIL018                                                  CL**2
00306      EJECT                                                        DTSCS42
00307  01  L031-COMM-AREA.                                              DTSCS42
00308  ++INCLUDE DTSIL031                                                  CL**2
00309      EJECT                                                        DTSCS42
00310  01  L034-COMM-AREA.                                              DTSCS42
00311  ++INCLUDE DTSIL034                                                  CL**2
00312      EJECT                                                        DTSCS42
00313  01  L061-COMM-AREA.                                              DTSCS42
00314  ++INCLUDE DTSIL061                                                  CL**2
00315      EJECT                                                        DTSCS42
00316  01  L062-COMM-AREA.                                              DTSCS42
00317  ++INCLUDE DTSIL062                                                  CL**2
00318      EJECT                                                        DTSCS42
00319  01  L082-COMM-AREA.                                                 CL**9
00320  ++INCLUDE DTSIL082                                                  CL**9
00321      EJECT                                                           CL**9
00322  01  L221-COMM-AREA.                                              DTSCS42
00323  ++INCLUDE DTSIL221                                                  CL**2
00324      EJECT                                                        DTSCS42
00325  01  L331-COMM-AREA.                                              DTSCS42
00326  ++INCLUDE DTSIL331                                                  CL**2
00327      EJECT                                                        DTSCS42
00328  01  L805-COMM-AREA.                                              DTSCS42
00329  ++INCLUDE DTSIL805                                                  CL**2
00330      EJECT                                                        DTSCS42
00331  01  L810-COMM-AREA.                                              DTSCS42
00332      05  L810-CONTROL-BLOCK.                                      DTSCS42
00333  ++INCLUDE DTSIL810                                                  CL**2
00334      EJECT                                                        DTSCS42
00335      05  MSKL-REC.                                                DTSCS42
00336  ++INCLUDE DTSIMSKL                                                  CL**2
00337      EJECT                                                        DTSCS42
00338  01  MPRF-REC.                                                    DTSCS42
00339  ++INCLUDE DTSIMPRF                                                  CL**2
00340      EJECT                                                        DTSCS42
00341  01  MCOL-REC.                                                    DTSCS42
00342  ++INCLUDE DTSIMCOL                                                  CL**2
00343      EJECT                                                        DTSCS42
00344  01  MTAD-REC.                                                    DTSCS42
00345  ++INCLUDE DTSIMTAD                                                  CL**2
00346      EJECT                                                        DTSCS42
00347  01  MEVL-REC.                                                       CL*26
00348  ++INCLUDE DTSIMEVL                                                  CL*26
00349      EJECT                                                           CL*26
00350  01  L851-COMM-AREA.                                              DTSCS42
00351  ++INCLUDE DTSIL851                                                  CL**2
00352                                                                   DTSCS42
00353      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS42
00354  ++INCLUDE DTSIS42                                                   CL**2
00355      EJECT                                                        DTSCS42
00356  01  CATB-LITERALS.                                               DTSCS42
00357  ++INCLUDE DTSICATB                                                  CL**2
00358                                                                   DTSCS42
00359  01  CFKD-LITERALS.                                               DTSCS42
00360  ++INCLUDE DTSICFKD                                                  CL**2
00361                                                                   DTSCS42
00362  01  CECD-LITERALS.                                               DTSCS42
00363  ++INCLUDE DTSICECD                                                  CL**2
00364                                                                   DTSCS42
00365  01  CPCD-LITERALS.                                               DTSCS42
00366  ++INCLUDE DTSICPCD                                                  CL**2
00367                                                                   DTSCS42
00368  01  MMAX-LITERALS.                                               DTSCS42
00369  ++INCLUDE DTSIMMAX                                                  CL**2
00370                                                                   DTSCS42
00371  LINKAGE SECTION.                                                 DTSCS42
00372                                                                   DTSCS42
00373  01  DFHCOMMAREA.                                                 DTSCS42
00374  ++INCLUDE DTSILCCM                                                  CL**2
00375      EJECT                                                        DTSCS42
00376 ******************************************************************DTSCS42
00377 *                                                                *DTSCS42
00378 ******************************************************************DTSCS42
00379                                                                   DTSCS42
00380  PROCEDURE DIVISION.                                              DTSCS42
00381                                                                   DTSCS42
00382      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS42
00383                                                                      CL*30
00384      SET WRK-MCOL-NO-88 TO TRUE.                                  DTSCS42
00385                                                                   DTSCS42
00386      MOVE +0 TO WRK-EMP-NO.                                       DTSCS42
00387                                                                   DTSCS42
00388      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS42
00389                                                                   DTSCS42
00390      SET CURSOR-SET-NO TO TRUE.                                   DTSCS42
00391                                                                   DTSCS42
00392      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS42
00393        TO SCR-ACCESS-IND.                                         DTSCS42
00394                                                                   DTSCS42
00395                                                                      CL*30
00396      MOVE SPACE TO REQ-IND.                                       DTSCS42
00397                                                                   DTSCS42
00398      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS42
00399                                                                   DTSCS42
00400                                                                      CL*30
00401 *-----------------------------------------------------            DTSCS42
00402 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS42
00403 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS42
00404 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS42
00405 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS42
00406 *                                                                 DTSCS42
00407 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS42
00408 *    PROCESSED.                                                   DTSCS42
00409 *                                                                 DTSCS42
00410 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS42
00411 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS42
00412 *    WORK STATION OPERATOR.                                       DTSCS42
00413 *-----------------------------------------------------            DTSCS42
00414                                                                   DTSCS42
00415      MOVE SPACE TO RESP-IND.                                      DTSCS42
00416                                                                   DTSCS42
00417      IF REQ-ERROR                                                 DTSCS42
00418         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS42
00419      ELSE                                                         DTSCS42
00420      IF REQ-JUMP                                                  DTSCS42
00421         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS42
00422      ELSE                                                         DTSCS42
00423      IF REQ-CLEAR                                                 DTSCS42
00424         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS42
00425      ELSE                                                         DTSCS42
00426      IF REQ-CURSOR-TO-GOTO                                        DTSCS42
00427         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS42
00428      ELSE                                                         DTSCS42
00429      IF REQ-INQUIRE                                               DTSCS42
00430         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS42
00431      ELSE                                                         DTSCS42
00432      IF REQ-EDIT                                                  DTSCS42
00433         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS42
00434      ELSE                                                         DTSCS42
00435      IF REQ-UPDATE                                                DTSCS42
00436         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS42
00437      ELSE                                                         DTSCS42
00438         GO TO S899-ABEND.                                         DTSCS42
00439                                                                   DTSCS42
00440                                                                      CL*30
00441 *-----------------------------------------------------            DTSCS42
00442 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS42
00443 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS42
00444 *-----------------------------------------------------            DTSCS42
00445                                                                   DTSCS42
00446      IF RESP-SEND-MAP                                             DTSCS42
00447          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS42
00448          SET LCCM-END-TASK-88 TO TRUE                             DTSCS42
00449      ELSE                                                         DTSCS42
00450      IF RESP-SEND-MSGONLY                                         DTSCS42
00451          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS42
00452          SET LCCM-END-TASK-88 TO TRUE                             DTSCS42
00453      ELSE                                                         DTSCS42
00454      IF RESP-JUMP                                                 DTSCS42
00455          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS42
00456      ELSE                                                         DTSCS42
00457      IF RESP-CURSOR-TO-GOTO                                       DTSCS42
00458          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS42
00459          SET LCCM-END-TASK-88 TO TRUE                             DTSCS42
00460      ELSE                                                         DTSCS42
00461          GO TO S899-ABEND.                                        DTSCS42
00462                                                                   DTSCS42
00463                                                                      CL*30
00464  MAINLINE-EXIT.                                                   DTSCS42
00465                                                                   DTSCS42
00466      EXEC CICS                                                    DTSCS42
00467          RETURN                                                   DTSCS42
00468      END-EXEC.                                                    DTSCS42
00469                                                                   DTSCS42
00470      GOBACK.                                                      DTSCS42
00471      EJECT                                                        DTSCS42
00472 /*****************************************************************DTSCS42
00473 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS42
00474 ******************************************************************DTSCS42
00475                                                                      CL*30
00476  P1000-ANALYZE-REQUEST.                                           DTSCS42
00477                                                                   DTSCS42
00478 *-----------------------------------------------------            DTSCS42
00479 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS42
00480 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS42
00481 *     REPLACED WITH ENTER)                                        DTSCS42
00482 *-----------------------------------------------------            DTSCS42
00483                                                                      CL*30
00484      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS42
00485         SET LCCM-ENTER-88 TO TRUE                                 DTSCS42
00486         IF LCCM-EMP-NO > ZERO                                     DTSCS42
00487             SET REQ-INQUIRE TO TRUE                               DTSCS42
00488             MOVE LCCM-EMP-NO     TO WRK-DISPLAY                   DTSCS42
00489             MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1             DTSCS42
00490             MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2             DTSCS42
00491         ELSE                                                      DTSCS42
00492             SET REQ-INQUIRE TO TRUE                               DTSCS42
00493         END-IF                                                    DTSCS42
00494         GO TO P1000-EXIT.                                         DTSCS42
00495                                                                   DTSCS42
00496                                                                      CL*30
00497 *-----------------------------------------------------            DTSCS42
00498 *      MAP IS RECEIVED                                            DTSCS42
00499 *-----------------------------------------------------            DTSCS42
00500                                                                      CL*30
00501      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS42
00502                                                                   DTSCS42
00503                                                                      CL*30
00504 *-----------------------------------------------------            DTSCS42
00505 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS42
00506 *    WORK STATION                                                 DTSCS42
00507 *-----------------------------------------------------            DTSCS42
00508                                                                      CL*30
00509      IF LCCM-CLEAR-88                                             DTSCS42
00510         SET REQ-CLEAR TO TRUE                                     DTSCS42
00511         GO TO P1000-EXIT.                                         DTSCS42
00512                                                                   DTSCS42
00513                                                                      CL*30
00514 *-----------------------------------------------------            DTSCS42
00515 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS42
00516 *-----------------------------------------------------            DTSCS42
00517                                                                      CL*30
00518      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS42
00519         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS42
00520         GO TO P1000-EXIT.                                         DTSCS42
00521                                                                   DTSCS42
00522                                                                      CL*30
00523 *-----------------------------------------------------            DTSCS42
00524 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS42
00525 *-----------------------------------------------------            DTSCS42
00526                                                                      CL*30
00527      IF LCCM-PA2-88                                               DTSCS42
00528          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS42
00529          GO TO P1000-EXIT.                                        DTSCS42
00530                                                                   DTSCS42
00531                                                                      CL*30
00532 *-----------------------------------------------------            DTSCS42
00533 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS42
00534 *-----------------------------------------------------            DTSCS42
00535                                                                      CL*30
00536      IF LCCM-PA-88                                                DTSCS42
00537        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS42
00538        SET REQ-ERROR TO TRUE                                      DTSCS42
00539        GO TO P1000-EXIT.                                          DTSCS42
00540                                                                   DTSCS42
00541                                                                      CL*30
00542 *-----------------------------------------------------               CL**2
00543 *    IF F12 KEY IS PRESSED AND UPDATE IN PROGRESS                    CL**2
00544 *    CLEAR SCREEN                                                    CL**2
00545 *-----------------------------------------------------               CL**2
00546                                                                      CL*30
00547      IF LCCM-F12-88                                                  CL**2
00548         MOVE LOW-VALUES TO MAP-AREA                                  CL**2
00549         SET REQ-CLEAR TO TRUE                                        CL**2
00550         GO TO P1000-EXIT.                                            CL**2
00551                                                                      CL**2
00552                                                                      CL*30
00553 *-----------------------------------------------------            DTSCS42
00554 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS42
00555 *-----------------------------------------------------            DTSCS42
00556                                                                      CL*30
00557      IF LCCM-F03-88                                               DTSCS42
00558         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS42
00559         SET REQ-JUMP TO TRUE                                      DTSCS42
00560         GO TO P1000-EXIT.                                         DTSCS42
00561                                                                   DTSCS42
00562                                                                      CL*30
00563 *-----------------------------------------------------            DTSCS42
00564 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS42
00565 *-----------------------------------------------------            DTSCS42
00566                                                                      CL*30
00567      IF LCCM-F04-88                                               DTSCS42
00568         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS42
00569         SET REQ-JUMP TO TRUE                                      DTSCS42
00570         GO TO P1000-EXIT.                                         DTSCS42
00571                                                                   DTSCS42
00572                                                                      CL*30
00573 *---------------------------------------------------------        DTSCS42
00574 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS42
00575 *    CORRESPONDENCE SCREEN.                                       DTSCS42
00576 *---------------------------------------------------------        DTSCS42
00577                                                                      CL*24
00578      IF LCCM-F14-88                                                  CL*24
00579         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                     CL*24
00580         SET REQ-JUMP TO TRUE                                         CL*24
00581         GO TO P1000-EXIT.                                            CL*24
00582                                                                      CL*24
00583                                                                      CL*30
00584 *-----------------------------------------------------            DTSCS42
00585 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS42
00586 *    REQUESTED SCREEN TYPE                                        DTSCS42
00587 *-----------------------------------------------------            DTSCS42
00588                                                                      CL*30
00589 *****IF LCCM-F19-88                                                  CL*30
00590 ********MOVE '31' TO LCCM-REQ-SCR-ID                                 CL*30
00591 ********SET REQ-JUMP TO TRUE                                         CL*30
00592 ********GO TO P1000-EXIT.                                            CL*30
00593                                                                      CL*30
00594 *****IF LCCM-F20-88                                                  CL*30
00595 ********MOVE '41' TO LCCM-REQ-SCR-ID                                 CL*30
00596 ********SET REQ-JUMP TO TRUE                                         CL*30
00597 ********GO TO P1000-EXIT.                                            CL*30
00598                                                                      CL*30
00599                                                                      CL*30
00600 *-----------------------------------------------------            DTSCS42
00601 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS42
00602 *    REQUESTED SCREEN TYPE                                        DTSCS42
00603 *-----------------------------------------------------            DTSCS42
00604                                                                      CL*30
00605      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS42
00606         NEXT SENTENCE                                             DTSCS42
00607      ELSE                                                         DTSCS42
00608        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS42
00609        SET REQ-JUMP TO TRUE                                       DTSCS42
00610        GO TO P1000-EXIT.                                          DTSCS42
00611                                                                   DTSCS42
00612                                                                      CL*30
00613 *-----------------------------------------------------            DTSCS42
00614 *    IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL)                  DTSCS42
00615 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS42
00616 *-----------------------------------------------------            DTSCS42
00617                                                                      CL*30
00618      IF LCCM-F10-88                                               DTSCS42
00619         IF SCR-ACCESS-UPDATE                                      DTSCS42
00620            SET REQ-EDIT TO TRUE                                   DTSCS42
00621            GO TO P1000-EXIT                                       DTSCS42
00622         ELSE                                                      DTSCS42
00623            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS42
00624            SET REQ-ERROR TO TRUE                                  DTSCS42
00625            GO TO P1000-EXIT.                                      DTSCS42
00626                                                                   DTSCS42
00627                                                                      CL*30
00628 *-----------------------------------------------------            DTSCS42
00629 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS42
00630 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS42
00631 *-----------------------------------------------------            DTSCS42
00632                                                                      CL*30
00633      IF LCCM-ENTER-88                                             DTSCS42
00634          SET REQ-INQUIRE TO TRUE                                  DTSCS42
00635          GO TO P1000-EXIT.                                        DTSCS42
00636                                                                   DTSCS42
00637                                                                      CL*30
00638 *-----------------------------------------------------            DTSCS42
00639 *     ANY OTHER KEY IS INVALID                                    DTSCS42
00640 *-----------------------------------------------------            DTSCS42
00641                                                                      CL*30
00642      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS42
00643                                                                      CL*30
00644      SET REQ-ERROR TO TRUE.                                       DTSCS42
00645  P1000-EXIT.                                                      DTSCS42
00646      EXIT.                                                        DTSCS42
00647                                                                   DTSCS42
00648                                                                      CL*30
00649                                                                      CL*30
00650 ******************************************************************DTSCS42
00651 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS42
00652 ******************************************************************DTSCS42
00653                                                                   DTSCS42
00654  P1100-UPDATE-LOCKED.                                             DTSCS42
00655                                                                      CL*30
00656 *-----------------------------------------------------            DTSCS42
00657 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS42
00658 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS42
00659 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS42
00660 *-----------------------------------------------------            DTSCS42
00661                                                                      CL*30
00662      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS42
00663         SET REQ-UPDATE TO TRUE                                    DTSCS42
00664      ELSE                                                         DTSCS42
00665         SET REQ-ERROR TO TRUE                                     DTSCS42
00666         IF LCCM-SCR-MOD-LOCKED                                    DTSCS42
00667            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS42
00668         ELSE                                                      DTSCS42
00669            GO TO S899-ABEND.                                      DTSCS42
00670  P1100-EXIT.                                                      DTSCS42
00671      EXIT.                                                        DTSCS42
00672 /*****************************************************************DTSCS42
00673 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS42
00674 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS42
00675 ******************************************************************DTSCS42
00676                                                                   DTSCS42
00677  P2000-REQUEST-ERROR.                                             DTSCS42
00678      IF LCCM-MSG                                                  DTSCS42
00679         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS42
00680      ELSE                                                         DTSCS42
00681         GO TO S899-ABEND.                                         DTSCS42
00682  P2000-EXIT.                                                      DTSCS42
00683      EXIT.                                                        DTSCS42
00684 /*****************************************************************DTSCS42
00685 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS42
00686 ******************************************************************DTSCS42
00687                                                                   DTSCS42
00688  P3000-REQUEST-JUMP.                                              DTSCS42
00689                                                                      CL*31
00690 *-----------------------------------------------------            DTSCS42
00691 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS42
00692 *    BY USER                                                      DTSCS42
00693 *-----------------------------------------------------            DTSCS42
00694                                                                      CL*31
00695      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS42
00696                                                                   DTSCS42
00697                                                                      CL*31
00698 *-----------------------------------------------------            DTSCS42
00699 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS42
00700 *-----------------------------------------------------            DTSCS42
00701                                                                      CL*31
00702      IF LCCM-MSG                                                  DTSCS42
00703         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS42
00704         SET CURSOR-SET-GOTO TO TRUE                               DTSCS42
00705         GO TO P3000-EXIT.                                         DTSCS42
00706                                                                      CL*31
00707                                                                      CL*31
00708      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS42
00709                                                                      CL*31
00710      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS42
00711                                                                      CL*31
00712      IF L018-VALID                                                DTSCS42
00713          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS42
00714                                                                   DTSCS42
00715                                                                      CL*31
00716 *-----------------------------------------------------            DTSCS42
00717 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS42
00718 *-----------------------------------------------------            DTSCS42
00719                                                                      CL*31
00720      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS42
00721                         LCCM-SCR-HOLD-AREA.                       DTSCS42
00722                                                                      CL*31
00723      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS42
00724                                                                      CL*31
00725      SET RESP-JUMP TO TRUE.                                       DTSCS42
00726  P3000-EXIT.                                                      DTSCS42
00727      EXIT.                                                        DTSCS42
00728 /*****************************************************************DTSCS42
00729 * CLEAR KEY WAS PRESSED                                          *DTSCS42
00730 ******************************************************************DTSCS42
00731                                                                   DTSCS42
00732  P4000-REQUEST-CLEAR.                                             DTSCS42
00733                                                                   DTSCS42
00734 *-----------------------------------------------------            DTSCS42
00735 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS42
00736 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS42
00737 *-----------------------------------------------------            DTSCS42
00738                                                                      CL*31
00739      IF LCCM-EMP-NO > ZERO                                        DTSCS42
00740         MOVE LCCM-EMP-NO TO WRK-DISPLAY                           DTSCS42
00741         MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1                 DTSCS42
00742         MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2.                DTSCS42
00743                                                                   DTSCS42
00744      MOVE ZERO TO LCCM-EMP-NO                                     DTSCS42
00745                                                                   DTSCS42
00746      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS42
00747                                                                   DTSCS42
00748      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS42
00749                                                                   DTSCS42
00750      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS42
00751                                                                   DTSCS42
00752      SET RESP-SEND-MAP TO TRUE.                                   DTSCS42
00753  P4000-EXIT.                                                      DTSCS42
00754      EXIT.                                                        DTSCS42
00755 /*****************************************************************DTSCS42
00756 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS42
00757 ******************************************************************DTSCS42
00758                                                                   DTSCS42
00759  P5000-CURSOR-TO-GOTO.                                            DTSCS42
00760      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS42
00761                                                                      CL*31
00762      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS42
00763  P5000-EXIT.                                                      DTSCS42
00764      EXIT.                                                        DTSCS42
00765 /*****************************************************************DTSCS42
00766 * INQUIRY WAS REQUESTED                                          *DTSCS42
00767 ******************************************************************DTSCS42
00768                                                                   DTSCS42
00769  P6000-REQUEST-INQUIRE.                                           DTSCS42
00770      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS42
00771                                                                      CL*31
00772      MOVE LOW-VALUES         TO MAP-AREA.                         DTSCS42
00773                                                                      CL*31
00774      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS42
00775                                                                   DTSCS42
00776      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS42
00777                                                                      CL*31
00778      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS42
00779                                                                   DTSCS42
00780      SET RESP-SEND-MAP TO TRUE.                                   DTSCS42
00781                                                                   DTSCS42
00782      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS42
00783                                                                   DTSCS42
00784                                                                      CL*31
00785      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS42
00786                                                                      CL*31
00787      IF LCCM-MSG                                                  DTSCS42
00788          GO TO P6000-EXIT.                                        DTSCS42
00789                                                                   DTSCS42
00790                                                                      CL*31
00791      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS42
00792                                                                   DTSCS42
00793      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS42
00794                                                                   DTSCS42
00795      IF LCCM-MSG                                                  DTSCS42
00796          GO TO P6000-EXIT.                                        DTSCS42
00797                                                                   DTSCS42
00798                                                                      CL*31
00799      IF SCR-ACCESS-UPDATE                                         DTSCS42
00800          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCS42
00801                                                                   DTSCS42
00802                                                                      CL*31
00803      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS42
00804                                                                   DTSCS42
00805      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS42
00806  P6000-EXIT.                                                      DTSCS42
00807      EXIT.                                                        DTSCS42
00808 /*****************************************************************DTSCS42
00809 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS42
00810 ******************************************************************DTSCS42
00811                                                                   DTSCS42
00812  P6900-CONSTRUCT-SCREEN.                                          DTSCS42
00813      IF MPRF-WRITE-OFF-DATE > +0                                     CL**2
00814          MOVE MPRF-WRITE-OFF-DATE TO L001-FED-8-DATE-9               CL**2
00815          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS42
00816          MOVE L001-SLASH-DATE TO MAP-WRITEOFF-DATE.                  CL*10
00817                                                                   DTSCS42
00818      MOVE MPRF-SUSPEND-COLL-IND TO MAP-SUSPEND-IND.                  CL**4
00819                                                                      CL**4
00820      MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP.                              CL*31
00821                                                                      CL*31
00822      MOVE MPRF-FLD-ST TO L061-FLD-ST.                                CL*31
00823                                                                      CL*31
00824      MOVE WRK-EMP-NO TO L061-EMP-NO.                                 CL*31
00825                                                                      CL*31
00826      PERFORM S061-FLD-ZIP THRU S061-EXIT.                            CL*31
00827                                                                      CL*31
00828      MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID                          CL*31
00829                              L062-FLD-REP-ID.                        CL*31
00830                                                                      CL**4
00831      PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT.                    CL*10
00832                                                                      CL*31
00833      MOVE L062-NAME TO MAP-FLD-REP-ID-DSCR.                          CL*31
00834                                                                      CL**4
00835                                                                      CL*31
00836      PERFORM S1110-READ-MCOL THRU S1110-EXIT.                     DTSCS42
00837                                                                   DTSCS42
00838      IF WRK-MCOL-YES-88                                           DTSCS42
00839         PERFORM P6910-FROM-MCOL THRU P6910-EXIT.                  DTSCS42
00840                                                                   DTSCS42
00841                                                                      CL*31
00842      MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSCS42
00843                                                                      CL*31
00844      MOVE WRK-EMP-NO TO MTAD-EMP-NO.                              DTSCS42
00845                                                                      CL*31
00846      SET MTAD-TAD-88 TO TRUE.                                     DTSCS42
00847                                                                      CL*31
00848      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                        CL**4
00849                                                                      CL*31
00850      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS42
00851                                                                      CL*31
00852      PERFORM S810-START-BROWSE THRU S810-EXIT.                       CL*22
00853                                                                      CL*31
00854      PERFORM P6930-MTAD-SCAN THRU P6930-EXIT                         CL*22
00855         UNTIL L810-NO-REC-88.                                        CL*22
00856  P6900-EXIT.                                                      DTSCS42
00857      EXIT.                                                        DTSCS42
00858                                                                   DTSCS42
00859                                                                      CL*31
00860                                                                      CL*31
00861  P6910-FROM-MCOL.                                                 DTSCS42
00862      IF MCOL-FINAL-NOTICE-DATE > +0                               DTSCS42
00863         MOVE MCOL-FINAL-NOTICE-DATE TO WRK-DISPLAY                DTSCS42
00864         MOVE WRK-DISPLAY-MO TO MAP-FINAL-NOTICE-MO                DTSCS42
00865         MOVE WRK-DISPLAY-DA TO MAP-FINAL-NOTICE-DA                DTSCS42
00866         MOVE WRK-DISPLAY-YR TO MAP-FINAL-NOTICE-YR                DTSCS42
00867      END-IF.                                                      DTSCS42
00868                                                                   DTSCS42
00869      MOVE MCOL-SUBPOENA-ACTIVITY-CD TO MAP-SUBPOENA-CD.           DTSCS42
00870                                                                   DTSCS42
00871      IF MCOL-LEGAL-REFERRAL-DATE > +0                                CL**2
00872         MOVE MCOL-LEGAL-REFERRAL-DATE TO WRK-DISPLAY                 CL**2
00873         MOVE WRK-DISPLAY-MO TO MAP-LEGAL-REF-MO                      CL**2
00874         MOVE WRK-DISPLAY-DA TO MAP-LEGAL-REF-DA                      CL**2
00875         MOVE WRK-DISPLAY-YR TO MAP-LEGAL-REF-YR                      CL**2
00876      END-IF.                                                         CL**2
00877                                                                      CL**2
00878      IF MCOL-SUBPOENA-ACTIVITY-DATE > +0                          DTSCS42
00879         MOVE MCOL-SUBPOENA-ACTIVITY-DATE TO WRK-DISPLAY           DTSCS42
00880         MOVE WRK-DISPLAY-MO TO MAP-SUBPOENA-MO                    DTSCS42
00881         MOVE WRK-DISPLAY-DA TO MAP-SUBPOENA-DA                    DTSCS42
00882         MOVE WRK-DISPLAY-YR TO MAP-SUBPOENA-YR                    DTSCS42
00883      END-IF.                                                      DTSCS42
00884                                                                   DTSCS42
00885                                                                      CL**2
00886      IF MCOL-CIVIL-ACTION-BEGIN-DATE > +0                            CL**2
00887         MOVE MCOL-CIVIL-ACTION-BEGIN-DATE TO WRK-DISPLAY             CL**2
00888         MOVE WRK-DISPLAY-MO TO MAP-CIVIL-ACTION-BEGIN-MO             CL**2
00889         MOVE WRK-DISPLAY-DA TO MAP-CIVIL-ACTION-BEGIN-DA             CL**2
00890         MOVE WRK-DISPLAY-YR TO MAP-CIVIL-ACTION-BEGIN-YR             CL**2
00891      END-IF.                                                         CL**2
00892                                                                   DTSCS42
00893      MOVE MCOL-SUBPOENA-RESP-OP-ID  TO MAP-SUBPOENA-OPID.            CL**2
00894                                                                   DTSCS42
00895      IF MCOL-CIVIL-ACTION-JUDGE-DATE > +0                            CL**2
00896         MOVE MCOL-CIVIL-ACTION-JUDGE-DATE TO WRK-DISPLAY             CL**2
00897         MOVE WRK-DISPLAY-MO TO MAP-CIVIL-ACTION-JUDGE-MO             CL**2
00898         MOVE WRK-DISPLAY-DA TO MAP-CIVIL-ACTION-JUDGE-DA             CL**2
00899         MOVE WRK-DISPLAY-YR TO MAP-CIVIL-ACTION-JUDGE-YR             CL**2
00900      END-IF.                                                         CL**2
00901                                                                      CL**2
00902      IF MCOL-BNK-PETITION-DATE > +0                                  CL**2
00903         MOVE MCOL-BNK-PETITION-DATE TO WRK-DISPLAY                   CL**2
00904         MOVE WRK-DISPLAY-MO TO MAP-BNK-PETITION-MO                   CL**2
00905         MOVE WRK-DISPLAY-DA TO MAP-BNK-PETITION-DA                   CL**2
00906         MOVE WRK-DISPLAY-YR TO MAP-BNK-PETITION-YR                   CL**2
00907      END-IF.                                                         CL**2
00908                                                                      CL**2
00909      MOVE MCOL-BNK-COURT-CASE-NO TO MAP-BNK-COURT-CASE-NO.           CL**2
00910                                                                      CL**2
00911      MOVE MCOL-BNK-CHAPTER TO MAP-BNK-CHAPTER.                       CL**2
00912                                                                      CL**2
00913      IF MCOL-BNK-POC-REQUIRED-DATE > +0                              CL**2
00914         MOVE MCOL-BNK-POC-REQUIRED-DATE TO WRK-DISPLAY               CL**2
00915         MOVE WRK-DISPLAY-MO TO MAP-BNK-POC-REQUIRED-MO               CL**2
00916         MOVE WRK-DISPLAY-DA TO MAP-BNK-POC-REQUIRED-DA               CL**2
00917         MOVE WRK-DISPLAY-YR TO MAP-BNK-POC-REQUIRED-YR               CL**2
00918      END-IF.                                                         CL**2
00919                                                                      CL**2
00920      IF MCOL-BNK-POC-FILED-DATE > +0                                 CL**2
00921         MOVE MCOL-BNK-POC-FILED-DATE TO WRK-DISPLAY                  CL**2
00922         MOVE WRK-DISPLAY-MO TO MAP-BNK-POC-FILED-MO                  CL**2
00923         MOVE WRK-DISPLAY-DA TO MAP-BNK-POC-FILED-DA                  CL**2
00924         MOVE WRK-DISPLAY-YR TO MAP-BNK-POC-FILED-YR                  CL**2
00925      END-IF.                                                         CL**2
00926                                                                      CL**2
00927      IF MCOL-BNK-CHAPTER-CHNG-DATE > +0                              CL**2
00928         MOVE MCOL-BNK-CHAPTER-CHNG-DATE TO WRK-DISPLAY               CL**2
00929         MOVE WRK-DISPLAY-MO TO MAP-BNK-CHAPTER-CHNG-MO               CL**2
00930         MOVE WRK-DISPLAY-DA TO MAP-BNK-CHAPTER-CHNG-DA               CL**2
00931         MOVE WRK-DISPLAY-YR TO MAP-BNK-CHAPTER-CHNG-YR               CL**2
00932      END-IF.                                                         CL**2
00933                                                                      CL**2
00934      IF MCOL-BNK-LAST-COMM-DATE > +0                                 CL**2
00935         MOVE MCOL-BNK-LAST-COMM-DATE TO WRK-DISPLAY                  CL**2
00936         MOVE WRK-DISPLAY-MO TO MAP-BNK-LAST-COMM-MO                  CL**2
00937         MOVE WRK-DISPLAY-DA TO MAP-BNK-LAST-COMM-DA                  CL**2
00938         MOVE WRK-DISPLAY-YR TO MAP-BNK-LAST-COMM-YR                  CL**2
00939      END-IF.                                                         CL**2
00940                                                                      CL**2
00941      IF MCOL-BNK-DISCHRG-CLOSE-DATE > +0                          DTSCS42
00942         MOVE MCOL-BNK-DISCHRG-CLOSE-DATE TO WRK-DISPLAY           DTSCS42
00943         MOVE WRK-DISPLAY-MO TO MAP-BNK-DISCHRG-CLOSE-MO           DTSCS42
00944         MOVE WRK-DISPLAY-DA TO MAP-BNK-DISCHRG-CLOSE-DA           DTSCS42
00945         MOVE WRK-DISPLAY-YR TO MAP-BNK-DISCHRG-CLOSE-YR           DTSCS42
00946      END-IF.                                                      DTSCS42
00947                                                                   DTSCS42
00948      IF MCOL-BNK-DISMISS-DATE > +0                                DTSCS42
00949         MOVE MCOL-BNK-DISMISS-DATE TO WRK-DISPLAY                 DTSCS42
00950         MOVE WRK-DISPLAY-MO TO MAP-BNK-DISMISS-MO                 DTSCS42
00951         MOVE WRK-DISPLAY-DA TO MAP-BNK-DISMISS-DA                 DTSCS42
00952         MOVE WRK-DISPLAY-YR TO MAP-BNK-DISMISS-YR                 DTSCS42
00953      END-IF.                                                      DTSCS42
00954                                                                   DTSCS42
00955      IF MCOL-BNK-PETITION-DATE = +0                               DTSCS42
00956          MOVE LOW-VALUES TO MAP-BANKRUPTCY-OPEN-IND               DTSCS42
00957      ELSE                                                         DTSCS42
00958          IF (MCOL-BNK-DISCHRG-CLOSE-DATE = +0)                    DTSCS42
00959                AND                                                DTSCS42
00960             (MCOL-BNK-DISMISS-DATE = +0)                          DTSCS42
00961              MOVE 'OPEN' TO MAP-BANKRUPTCY-OPEN-IND               DTSCS42
00962          ELSE                                                     DTSCS42
00963              MOVE 'CLOSED' TO MAP-BANKRUPTCY-OPEN-IND.            DTSCS42
00964                                                                   DTSCS42
00965      MOVE MCOL-STMT-TEXT-TYPE TO MAP-STMT-TYPE.                      CL*20
00966                                                                   DTSCS42
00967      MOVE MCOL-STMT-TEXT-PERM-IND TO MAP-STMT-PERMANENT-IND.         CL*17
00968                                                                   DTSCS42
00969      PERFORM                                                      DTSCS42
00970      VARYING WRK-OCC                                              DTSCS42
00971         FROM 1 BY 1                                               DTSCS42
00972        UNTIL WRK-OCC > MCOL-STMT-TEXT-CNT                            CL**2
00973            MOVE MCOL-STMT-TEXT(WRK-OCC)                              CL**2
00974              TO MAP-STMT-TEXT(WRK-OCC)                               CL*10
00975      END-PERFORM.                                                 DTSCS42
00976  P6910-EXIT.                                                      DTSCS42
00977      EXIT.                                                        DTSCS42
00978                                                                   DTSCS42
00979                                                                      CL*31
00980  P6930-MTAD-SCAN.                                                    CL*22
00981      MOVE MSKL-REC TO MTAD-REC.                                      CL*22
00982                                                                      CL*22
00983      IF MTAD-ID-TAX-MAILING-ADDR-88                                  CL*46
00984          MOVE MTAD-VOICE-1-AREA-CD TO MAP-VOICE-1-AREA-CD            CL*22
00985          MOVE MTAD-VOICE-1-PREFIX TO MAP-VOICE-1-PREFIX              CL*22
00986          MOVE MTAD-VOICE-1-SUFFIX TO MAP-VOICE-1-SUFFIX              CL*22
00987          MOVE MTAD-VOICE-1-EXT TO MAP-VOICE-1-EXT                    CL*47
00988          MOVE MTAD-UC223-IND                                         CL*22
00989            TO MAP-MAIL-DB-MEMO-IND                                   CL*22
00990          MOVE MTAD-MISSING-RPT-LETTERS-IND                           CL*22
00991            TO MAP-MAIL-MISS-RPT-IND                                  CL*22
00992      ELSE                                                            CL*22
00993          MOVE MTAD-UC223-IND                                         CL*22
00994            TO MAP-PHYS-DB-MEMO-IND                                   CL*22
00995          MOVE MTAD-MISSING-RPT-LETTERS-IND                           CL*22
00996            TO MAP-PHYS-MISS-RPT-IND.                                 CL*22
00997                                                                      CL*22
00998      PERFORM S810-READ-NEXT THRU S810-EXIT.                          CL*22
00999  P6930-EXIT.                                                         CL*31
01000      EXIT.                                                           CL*31
01001 /*****************************************************************DTSCS42
01002 * FUNCTION KEY TO  MOD THE RECORD WAS PRESSED.                   *DTSCS42
01003 ******************************************************************DTSCS42
01004                                                                   DTSCS42
01005  P7000-REQUEST-EDIT.                                              DTSCS42
01006      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS42
01007                                                                   DTSCS42
01008                                                                      CL*31
01009      IF LCCM-F10-88                                               DTSCS42
01010         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS42
01011      ELSE                                                         DTSCS42
01012         GO TO S899-ABEND.                                         DTSCS42
01013                                                                   DTSCS42
01014                                                                      CL*31
01015 *------------------------------------------------------           DTSCS42
01016 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS42
01017 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS42
01018 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS42
01019 *------------------------------------------------------           DTSCS42
01020                                                                   DTSCS42
01021      IF LCCM-MSG                                                  DTSCS42
01022         NEXT SENTENCE                                             DTSCS42
01023      ELSE                                                         DTSCS42
01024         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS42
01025         IF LCCM-F10-88                                            DTSCS42
01026            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS42
01027            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID.                  DTSCS42
01028                                                                   DTSCS42
01029                                                                      CL*31
01030      SET RESP-SEND-MAP TO TRUE.                                   DTSCS42
01031  P7000-EXIT.                                                      DTSCS42
01032      EXIT.                                                        DTSCS42
01033 /*****************************************************************DTSCS42
01034 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS42
01035 ******************************************************************DTSCS42
01036                                                                   DTSCS42
01037  P7200-EDIT-MOD.                                                  DTSCS42
01038                                                                      CL*32
01039 *-----------------------------------------------------            DTSCS42
01040 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS42
01041 *    INQUIRED                                                     DTSCS42
01042 *-----------------------------------------------------            DTSCS42
01043                                                                      CL*32
01044      IF NOT LCCM-SCR-INQUIRE                                      DTSCS42
01045         PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT               DTSCS42
01046         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS42
01047         GO TO P7200-EXIT.                                         DTSCS42
01048                                                                   DTSCS42
01049                                                                      CL*32
01050 *-----------------------------------------------------            DTSCS42
01051 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD                 DTSCS42
01052 *-----------------------------------------------------            DTSCS42
01053                                                                      CL*32
01054      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS42
01055                                                                      CL*32
01056      IF LCCM-MSG                                                  DTSCS42
01057          GO TO P7200-EXIT.                                        DTSCS42
01058                                                                   DTSCS42
01059                                                                      CL*32
01060      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS42
01061          MOVE EMSG-NO-EMP-NO-CHANGE TO WRK-MSG-AREA               DTSCS42
01062          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS42
01063          GO TO P7200-EXIT.                                        DTSCS42
01064                                                                   DTSCS42
01065                                                                      CL*32
01066      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS42
01067                                                                   DTSCS42
01068      IF LCCM-MSG                                                  DTSCS42
01069          GO TO P7200-EXIT.                                        DTSCS42
01070                                                                   DTSCS42
01071                                                                      CL*32
01072      PERFORM S1110-READ-MCOL THRU S1110-EXIT.                     DTSCS42
01073                                                                   DTSCS42
01074      IF LCCM-MSG                                                  DTSCS42
01075          GO TO P7200-EXIT.                                        DTSCS42
01076                                                                   DTSCS42
01077                                                                      CL*32
01078      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS42
01079  P7200-EXIT.                                                      DTSCS42
01080      EXIT.                                                        DTSCS42
01081 /*****************************************************************DTSCS42
01082 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS42
01083 ******************************************************************DTSCS42
01084                                                                   DTSCS42
01085  P8000-REQUEST-UPDATE.                                            DTSCS42
01086      IF LCCM-SCR-MOD-LOCKED                                       DTSCS42
01087         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS42
01088      ELSE                                                         DTSCS42
01089         GO TO S899-ABEND.                                         DTSCS42
01090                                                                   DTSCS42
01091      SET RESP-SEND-MAP TO TRUE.                                   DTSCS42
01092  P8000-EXIT.                                                      DTSCS42
01093      EXIT.                                                        DTSCS42
01094 /*****************************************************************DTSCS42
01095 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS42
01096 ******************************************************************DTSCS42
01097                                                                   DTSCS42
01098  P8200-MOD.                                                       DTSCS42
01099      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS42
01100                                                                   DTSCS42
01101      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS42
01102                                                                   DTSCS42
01103                                                                      CL*33
01104      IF LCCM-F12-88                                               DTSCS42
01105         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-ID              DTSCS42
01106         GO TO P8200-EXIT.                                         DTSCS42
01107                                                                   DTSCS42
01108                                                                      CL*33
01109      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS42
01110                                                                   DTSCS42
01111                                                                      CL*33
01112      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCS42
01113                                                                      CL*33
01114      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS42
01115                                                                      CL*33
01116      IF LCCM-MSG                                                  DTSCS42
01117          GO TO P8200-EXIT.                                        DTSCS42
01118                                                                   DTSCS42
01119                                                                      CL*33
01120      MOVE WRK-EMP-NO TO L331-EMP-NO.                                 CL*40
01121                                                                      CL*40
01122      MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.                  CL*40
01123                                                                      CL*40
01124      MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME.            CL*40
01125                                                                      CL*40
01126      MOVE LCCM-OP-ID TO L331-OP-ID.                                  CL*40
01127                                                                      CL*40
01128                                                                      CL*40
01129      PERFORM P8210-CONSTRUCT-MCOL THRU P8210-EXIT.                DTSCS42
01130                                                                   DTSCS42
01131                                                                      CL*33
01132      PERFORM P8212-UPDATE-MPRF THRU P8212-EXIT.                   DTSCS42
01133                                                                   DTSCS42
01134                                                                      CL*33
01135      PERFORM P8213-UPDATE-MTAD THRU P8213-EXIT                    DTSCS42
01136          VARYING WRK-OCC FROM 1 BY 1 UNTIL WRK-OCC > 2.              CL**4
01137                                                                   DTSCS42
01138                                                                      CL*33
01139      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS42
01140                                                                   DTSCS42
01141                                                                      CL*33
01142      IF MCOL-BNK-PETITION-DATE = +0                               DTSCS42
01143          MOVE LOW-VALUES TO MAP-BANKRUPTCY-OPEN-IND               DTSCS42
01144      ELSE                                                         DTSCS42
01145         IF (MCOL-BNK-DISCHRG-CLOSE-DATE = +0)                     DTSCS42
01146               AND                                                 DTSCS42
01147            (MCOL-BNK-DISMISS-DATE = +0)                           DTSCS42
01148             MOVE 'OPEN' TO MAP-BANKRUPTCY-OPEN-IND                DTSCS42
01149         ELSE                                                      DTSCS42
01150             MOVE 'CLOSED' TO MAP-BANKRUPTCY-OPEN-IND.             DTSCS42
01151                                                                      CL**9
01152      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS42
01153                                                                   DTSCS42
01154                                                                      CL*33
01155      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS42
01156  P8200-EXIT.                                                      DTSCS42
01157      EXIT.                                                        DTSCS42
01158      EJECT                                                        DTSCS42
01159  P8210-CONSTRUCT-MCOL.                                            DTSCS42
01160      PERFORM S1110-READ-MCOL THRU S1110-EXIT.                     DTSCS42
01161                                                                      CL*34
01162      IF L810-NO-REC-88                                            DTSCS42
01163          SET WRK-ACTION-ADD-88 TO TRUE                            DTSCS42
01164          PERFORM P8211-INIT-MCOL THRU P8211-EXIT                  DTSCS42
01165      ELSE                                                         DTSCS42
01166          SET WRK-ACTION-MOD-88 TO TRUE                            DTSCS42
01167          MOVE MSKL-REC TO MCOL-REC.                               DTSCS42
01168                                                                   DTSCS42
01169                                                                      CL*34
01170      MOVE LCCM-CURR-RUN-DATE TO MCOL-CHNG-DATE.                      CL*34
01171                                                                      CL**2
01172                                                                      CL*34
01173      MOVE MAP-FINAL-NOTICE-DATE TO L015-S-DATE-AREA.                 CL*34
01174                                                                      CL*34
01175      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**2
01176                                                                      CL*34
01177      MOVE L015-DATE TO MCOL-FINAL-NOTICE-DATE.                       CL*34
01178                                                                      CL**2
01179                                                                      CL*34
01180      MOVE MAP-SUBPOENA-CD TO MCOL-SUBPOENA-ACTIVITY-CD.              CL*34
01181                                                                   DTSCS42
01182                                                                      CL*34
01183      MOVE MAP-LEGAL-REF-DATE TO L015-S-DATE-AREA.                    CL*34
01184                                                                      CL*34
01185      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
01186                                                                      CL*34
01187      IF MCOL-LEGAL-REFERRAL-DATE = ZERO                              CL*34
01188           AND L015-DATE NOT = ZERO                                   CL*34
01189         PERFORM P8240-CREATE-MEVL THRU P8240-EXIT                    CL*34
01190      END-IF.                                                         CL*34
01191                                                                      CL*34
01192      MOVE L015-DATE TO MCOL-LEGAL-REFERRAL-DATE.                     CL*34
01193                                                                   DTSCS42
01194                                                                      CL*34
01195      MOVE MAP-SUBPOENA-DATE TO L015-S-DATE-AREA.                     CL*34
01196                                                                      CL*34
01197      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
01198                                                                      CL*34
01199      MOVE L015-DATE TO MCOL-SUBPOENA-ACTIVITY-DATE.                  CL*34
01200                                                                   DTSCS42
01201                                                                      CL*34
01202      MOVE MAP-CIVIL-ACTION-BEGIN-DATE TO L015-S-DATE-AREA.           CL*34
01203                                                                      CL*34
01204      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
01205                                                                      CL*34
01206      MOVE L015-DATE TO MCOL-CIVIL-ACTION-BEGIN-DATE.                 CL*34
01207                                                                      CL**2
01208                                                                      CL*34
01209      MOVE MAP-SUBPOENA-OPID TO MCOL-SUBPOENA-RESP-OP-ID.             CL*34
01210                                                                   DTSCS42
01211                                                                      CL*34
01212      MOVE MAP-CIVIL-ACTION-JUDGE-DATE TO L015-S-DATE-AREA.           CL*34
01213                                                                      CL*34
01214      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
01215                                                                      CL*34
01216      MOVE L015-DATE TO MCOL-CIVIL-ACTION-JUDGE-DATE.                 CL*34
01217                                                                   DTSCS42
01218                                                                      CL*34
01219      MOVE MAP-BNK-PETITION-DATE-AREA TO L015-S-DATE-AREA.            CL*34
01220                                                                      CL*34
01221      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**2
01222                                                                      CL*34
01223      MOVE L015-DATE TO MCOL-BNK-PETITION-DATE.                       CL*34
01224                                                                      CL**2
01225                                                                      CL*34
01226      MOVE MAP-BNK-COURT-CASE-NO TO MCOL-BNK-COURT-CASE-NO.           CL**2
01227                                                                   DTSCS42
01228                                                                      CL*34
01229      MOVE MAP-BNK-CHAPTER TO MCOL-BNK-CHAPTER.                       CL*34
01230                                                                      CL**2
01231                                                                      CL*34
01232      MOVE MAP-BNK-POC-REQUIRED-DATE-AREA TO L015-S-DATE-AREA.        CL*34
01233                                                                      CL*34
01234      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**2
01235                                                                      CL*34
01236      MOVE L015-DATE TO MCOL-BNK-POC-REQUIRED-DATE.                   CL*34
01237                                                                      CL*34
01238                                                                      CL*34
01239 *****CREATION OF TICKLER NOT REQUIRED IN DC                          CL*34
01240                                                                      CL*34
01241 *****IF L015-DATE > +0                                               CL*34
01242 *****AND L015-DATE NOT = MCOL-BNK-POC-REQUIRED-DATE                  CL*34
01243 ********PERFORM P8230-CREATE-MTCK  THRU P8230-EXIT.                  CL*34
01244                                                                      CL**2
01245                                                                      CL*34
01246      MOVE MAP-BNK-POC-FILED-DATE-AREA TO L015-S-DATE-AREA.           CL*34
01247                                                                      CL*34
01248      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**2
01249                                                                      CL*34
01250      MOVE L015-DATE TO MCOL-BNK-POC-FILED-DATE.                      CL*34
01251                                                                   DTSCS42
01252                                                                      CL*34
01253      MOVE MAP-BNK-CHAPTER-CHNG-DATE-AREA TO L015-S-DATE-AREA.        CL*34
01254                                                                      CL*34
01255      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
01256                                                                      CL*34
01257      MOVE L015-DATE TO MCOL-BNK-CHAPTER-CHNG-DATE.                   CL*34
01258                                                                   DTSCS42
01259                                                                      CL*34
01260      MOVE MAP-BNK-LAST-COMM-DATE-AREA TO L015-S-DATE-AREA.           CL*34
01261                                                                      CL*34
01262      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**2
01263                                                                      CL*34
01264      MOVE L015-DATE TO MCOL-BNK-LAST-COMM-DATE.                      CL*34
01265                                                                      CL**2
01266                                                                      CL*34
01267      MOVE MAP-BNK-DISCHRG-DATE-AREA TO L015-S-DATE-AREA.             CL**2
01268                                                                      CL*34
01269      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**2
01270                                                                      CL*34
01271      MOVE L015-DATE TO MCOL-BNK-DISCHRG-CLOSE-DATE.                  CL*34
01272                                                                      CL**2
01273                                                                      CL*34
01274      MOVE MAP-BNK-DISMISS-DATE-AREA TO L015-S-DATE-AREA.             CL*34
01275                                                                      CL*34
01276      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
01277                                                                      CL*34
01278      MOVE L015-DATE TO MCOL-BNK-DISMISS-DATE.                        CL*34
01279                                                                   DTSCS42
01280                                                                      CL*34
01281      MOVE MAP-STMT-TYPE TO MCOL-STMT-TEXT-TYPE.                      CL*17
01282                                                                      CL*34
01283                                                                      CL*34
01284      MOVE MAP-STMT-PERMANENT-IND TO MCOL-STMT-TEXT-PERM-IND.         CL*17
01285                                                                   DTSCS42
01286                                                                      CL*34
01287      MOVE +0 TO MCOL-STMT-TEXT-CNT.                                  CL**2
01288                                                                   DTSCS42
01289      PERFORM                                                      DTSCS42
01290        VARYING WRK-OCC FROM 1 BY 1                                   CL*34
01291        UNTIL WRK-OCC > MMAX-COL-TEXT-MAX                          DTSCS42
01292          MOVE MAP-STMT-TEXT(WRK-OCC)                                 CL*34
01293            TO MCOL-STMT-TEXT(WRK-OCC)                                CL*34
01294          IF MCOL-STMT-TEXT(WRK-OCC) NOT = SPACES                     CL*34
01295               MOVE WRK-OCC TO MCOL-STMT-TEXT-CNT                     CL*34
01296          END-IF                                                      CL*34
01297      END-PERFORM.                                                 DTSCS42
01298                                                                   DTSCS42
01299                                                                   DTSCS42
01300      SET WRK-NULL-MCOL-NO-88 TO TRUE.                             DTSCS42
01301                                                                   DTSCS42
01302      PERFORM P8220-CHECK-NULL THRU P8220-EXIT.                    DTSCS42
01303                                                                   DTSCS42
01304                                                                      CL*34
01305      IF WRK-ACTION-ADD-88                                         DTSCS42
01306          IF WRK-NULL-MCOL-YES-88                                  DTSCS42
01307              NEXT SENTENCE                                        DTSCS42
01308          ELSE                                                     DTSCS42
01309              MOVE MCOL-REC TO MSKL-REC                            DTSCS42
01310              PERFORM S810-WRITE THRU S810-EXIT                    DTSCS42
01311              SET WRK-MCOL-YES-88 TO TRUE                          DTSCS42
01312      ELSE                                                         DTSCS42
01313          IF WRK-NULL-MCOL-YES-88                                  DTSCS42
01314              MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA                  DTSCS42
01315              PERFORM S810-DELETE THRU S810-EXIT                   DTSCS42
01316              SET WRK-MCOL-NO-88 TO TRUE                           DTSCS42
01317          ELSE                                                     DTSCS42
01318              MOVE MCOL-REC TO MSKL-REC                            DTSCS42
01319              PERFORM S810-REWRITE THRU S810-EXIT.                 DTSCS42
01320  P8210-EXIT.                                                      DTSCS42
01321      EXIT.                                                        DTSCS42
01322                                                                   DTSCS42
01323                                                                      CL*34
01324                                                                      CL*34
01325  P8211-INIT-MCOL.                                                 DTSCS42
01326      MOVE +0 TO MCOL-PURGE-DATE                                   DTSCS42
01327                                                                   DTSCS42
01328      MOVE LOW-VALUES TO MCOL-DATA-AREA.                           DTSCS42
01329                                                                   DTSCS42
01330      SET MCOL-BNK-NOT-BANKRUPT-88 TO TRUE.                        DTSCS42
01331                                                                   DTSCS42
01332      MOVE SPACES TO MCOL-BNK-COURT-CASE-NO.                       DTSCS42
01333                                                                   DTSCS42
01334      MOVE +0 TO MCOL-BNK-CHAPTER-CHNG-DATE                           CL*34
01335                 MCOL-BNK-PETITION-DATE                               CL*34
01336                 MCOL-BNK-DISCHRG-CLOSE-DATE                          CL*34
01337                 MCOL-BNK-DISMISS-DATE                                CL*34
01338                 MCOL-BNK-POC-REQUIRED-DATE                           CL*34
01339                 MCOL-BNK-POC-FILED-DATE                              CL*34
01340                 MCOL-BNK-LAST-COMM-DATE                              CL*34
01341                 MCOL-FINAL-NOTICE-DATE                               CL*34
01342                 MCOL-LEGAL-REFERRAL-DATE                             CL*34
01343                 MCOL-CIVIL-ACTION-BEGIN-DATE                         CL*34
01344                 MCOL-CIVIL-ACTION-JUDGE-DATE.                        CL*34
01345                                                                   DTSCS42
01346      SET MCOL-STMT-TEXT-TYPE-NONE-88 TO TRUE.                        CL**2
01347                                                                   DTSCS42
01348      SET MCOL-STMT-TEXT-PERM-NONE-88 TO TRUE.                        CL**2
01349                                                                   DTSCS42
01350      MOVE SPACE TO MCOL-SUBPOENA-ACTIVITY-CD.                     DTSCS42
01351                                                                      CL*34
01352      MOVE SPACE TO MCOL-SUBPOENA-RESP-OP-ID.                         CL*34
01353                                                                   DTSCS42
01354      MOVE +0 TO MCOL-SUBPOENA-ACTIVITY-DATE.                         CL*34
01355                                                                   DTSCS42
01356      SET MCOL-NOT-CONVERTED-88 TO TRUE.                           DTSCS42
01357                                                                   DTSCS42
01358      MOVE LCCM-CURR-RUN-DATE                                      DTSCS42
01359        TO MCOL-ESTB-DATE                                          DTSCS42
01360           MCOL-CHNG-DATE.                                         DTSCS42
01361                                                                   DTSCS42
01362      MOVE +0 TO  MCOL-STMT-TEXT-CNT.                                 CL**2
01363                                                                   DTSCS42
01364      MOVE SPACES TO MCOL-STMT-TEXT-AREA.                             CL**2
01365  P8211-EXIT.                                                      DTSCS42
01366      EXIT.                                                        DTSCS42
01367                                                                   DTSCS42
01368                                                                      CL*34
01369                                                                      CL*34
01370  P8212-UPDATE-MPRF.                                               DTSCS42
01371      PERFORM S1130-READ-MPRF THRU S1130-EXIT.                     DTSCS42
01372                                                                      CL*34
01373                                                                      CL*40
01374      MOVE SPACES TO L331-REC-OCC-ID.                                 CL*40
01375                                                                      CL*40
01376                                                                      CL*40
01377      IF MAP-SUSPEND-IND = MPRF-SUSPEND-COLL-IND                      CL*40
01378          NEXT SENTENCE                                               CL*40
01379      ELSE                                                            CL*40
01380          MOVE 'MPRF-SUSPEND-COLL-IND' TO L331-FIELD-NAME             CL*40
01381          MOVE MPRF-SUSPEND-COLL-IND TO L331-FROM-VALUE               CL*40
01382          MOVE MAP-SUSPEND-IND TO L331-TO-VALUE                       CL*40
01383          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT                  CL*40
01384          MOVE MAP-SUSPEND-IND TO MPRF-SUSPEND-COLL-IND               CL*40
01385          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.                  CL*40
01386                                                                      CL*40
01387                                                                      CL*40
01388      IF (MCOL-BNK-PETITION-DATE > +0                              DTSCS42
01389            AND (MCOL-BNK-DISCHRG-CLOSE-DATE = +0                     CL*34
01390            AND MCOL-BNK-DISMISS-DATE = +0))                       DTSCS42
01391         SET MPRF-BANKRP-OPEN-88 TO TRUE                           DTSCS42
01392      ELSE                                                         DTSCS42
01393         SET MPRF-BANKRP-NOT-OPEN-88 TO TRUE                       DTSCS42
01394      END-IF.                                                      DTSCS42
01395                                                                   DTSCS42
01396      MOVE MPRF-REC TO MSKL-REC.                                   DTSCS42
01397                                                                      CL*35
01398      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS42
01399  P8212-EXIT.                                                      DTSCS42
01400      EXIT.                                                        DTSCS42
01401                                                                   DTSCS42
01402                                                                      CL*35
01403                                                                      CL*35
01404  P8213-UPDATE-MTAD.                                               DTSCS42
01405      MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSCS42
01406                                                                      CL*35
01407      MOVE LCCM-EMP-NO TO MTAD-EMP-NO.                             DTSCS42
01408                                                                      CL*35
01409      MOVE WRK-OCC TO MTAD-ID-NO.                                  DTSCS42
01410                                                                      CL*35
01411      SET MTAD-TAD-88 TO TRUE.                                     DTSCS42
01412                                                                   DTSCS42
01413      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS42
01414                                                                   DTSCS42
01415      PERFORM S810-READ THRU S810-EXIT.                            DTSCS42
01416                                                                   DTSCS42
01417      IF L810-OK-88                                                DTSCS42
01418         MOVE MSKL-REC TO MTAD-REC                                 DTSCS42
01419      ELSE                                                            CL*11
01420       IF WRK-OCC = 1                                                 CL*11
01421           MOVE LOW-VALUES TO MAP-MAIL-DB-MEMO-IND                    CL*11
01422                              MAP-MAIL-MISS-RPT-IND                   CL*11
01423           GO TO P8213-EXIT                                           CL*11
01424       ELSE                                                           CL*11
01425           MOVE LOW-VALUES TO MAP-PHYS-DB-MEMO-IND                    CL*11
01426                              MAP-PHYS-MISS-RPT-IND                   CL*11
01427           GO TO P8213-EXIT.                                          CL*11
01428                                                                      CL*11
01429       IF WRK-OCC = 1                                                 CL*11
01430         IF (MTAD-UC223-IND NOT = MAP-MAIL-DB-MEMO-IND)               CL*11
01431                      OR                                              CL*35
01432            (MTAD-MISSING-RPT-LETTERS-IND                             CL*35
01433             NOT = MAP-MAIL-MISS-RPT-IND)                             CL*18
01434            PERFORM P8214-MODIFY-MTAD-MAIL THRU P8214-EXIT            CL*16
01435            MOVE MTAD-REC TO MSKL-REC                              DTSCS42
01436            PERFORM S810-REWRITE THRU S810-EXIT                    DTSCS42
01437         ELSE                                                      DTSCS42
01438           NEXT SENTENCE                                              CL*11
01439       ELSE                                                           CL*11
01440         IF (MTAD-UC223-IND NOT = MAP-PHYS-DB-MEMO-IND)               CL*11
01441                      OR                                              CL*35
01442            (MTAD-MISSING-RPT-LETTERS-IND                             CL*35
01443             NOT = MAP-PHYS-MISS-RPT-IND)                             CL*18
01444            PERFORM P8215-MODIFY-MTAD-PHYS THRU P8215-EXIT            CL*16
01445            MOVE MTAD-REC TO MSKL-REC                                 CL*11
01446            PERFORM S810-REWRITE THRU S810-EXIT.                      CL*11
01447  P8213-EXIT.                                                      DTSCS42
01448      EXIT.                                                        DTSCS42
01449                                                                   DTSCS42
01450                                                                      CL*35
01451                                                                      CL*35
01452  P8214-MODIFY-MTAD-MAIL.                                             CL*16
01453      MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID.                      CL*37
01454                                                                      CL*37
01455      IF MAP-MAIL-DB-MEMO-VALID-88                                    CL*16
01456          IF MAP-MAIL-DB-MEMO-IND = MTAD-UC223-IND                    CL*16
01457              NEXT SENTENCE                                        DTSCS42
01458          ELSE                                                     DTSCS42
01459              MOVE 'MTAD-UC223-IND' TO L331-FIELD-NAME                CL**4
01460              MOVE MTAD-UC223-IND TO L331-FROM-VALUE                  CL**4
01461              MOVE MAP-MAIL-DB-MEMO-IND TO L331-TO-VALUE              CL*16
01462              PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT              CL**9
01463              MOVE MAP-MAIL-DB-MEMO-IND                               CL*16
01464                TO MTAD-UC223-IND                                     CL**4
01465              MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE            DTSCS42
01466      ELSE                                                         DTSCS42
01467          MOVE MTAD-UC223-IND                                         CL**4
01468            TO MAP-MAIL-DB-MEMO-IND.                                  CL*16
01469                                                                   DTSCS42
01470                                                                      CL*37
01471      IF MAP-MAIL-MISS-RPT-VALID-88                                   CL*16
01472          IF MAP-MAIL-MISS-RPT-IND                                    CL*16
01473              = MTAD-MISSING-RPT-LETTERS-IND                          CL*17
01474              NEXT SENTENCE                                        DTSCS42
01475          ELSE                                                     DTSCS42
01476              MOVE 'MTAD-MISSING-RPT-LETTERS-IND'                     CL*17
01477                TO L331-FIELD-NAME                                 DTSCS42
01478              MOVE MTAD-MISSING-RPT-LETTERS-IND TO L331-FROM-VALUE    CL*17
01479              MOVE MAP-MAIL-MISS-RPT-IND  TO L331-TO-VALUE            CL*16
01480              PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT              CL**9
01481              MOVE MAP-MAIL-MISS-RPT-IND                              CL*16
01482                TO MTAD-MISSING-RPT-LETTERS-IND                       CL*18
01483              MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE            DTSCS42
01484      ELSE                                                         DTSCS42
01485          MOVE MTAD-MISSING-RPT-LETTERS-IND                           CL*18
01486            TO MAP-MAIL-MISS-RPT-IND.                                 CL*16
01487  P8214-EXIT.                                                      DTSCS42
01488      EXIT.                                                        DTSCS42
01489                                                                   DTSCS42
01490                                                                      CL*37
01491                                                                      CL*37
01492  P8215-MODIFY-MTAD-PHYS.                                             CL*16
01493      MOVE 'RECORDS ADDRESS' TO L331-REC-OCC-ID.                      CL*38
01494                                                                      CL*38
01495      IF MAP-PHYS-DB-MEMO-VALID-88                                    CL*16
01496          IF MAP-PHYS-DB-MEMO-IND = MTAD-UC223-IND                    CL*16
01497              NEXT SENTENCE                                           CL*16
01498          ELSE                                                        CL*16
01499              MOVE 'MTAD-UC223-IND' TO L331-FIELD-NAME                CL*16
01500              MOVE MTAD-UC223-IND TO L331-FROM-VALUE                  CL*16
01501              MOVE MAP-PHYS-DB-MEMO-IND TO L331-TO-VALUE              CL*16
01502              PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT              CL*16
01503              MOVE MAP-PHYS-DB-MEMO-IND                               CL*16
01504                TO MTAD-UC223-IND                                     CL*16
01505              MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE               CL*16
01506      ELSE                                                            CL*16
01507          MOVE MTAD-UC223-IND                                         CL*16
01508            TO MAP-PHYS-DB-MEMO-IND.                                  CL*16
01509                                                                      CL*16
01510      IF MAP-PHYS-MISS-RPT-VALID-88                                   CL*16
01511          IF MAP-PHYS-MISS-RPT-IND                                    CL*16
01512              = MTAD-MISSING-RPT-LETTERS-IND                          CL*17
01513              NEXT SENTENCE                                           CL*16
01514          ELSE                                                        CL*16
01515              MOVE 'MTAD-MISSING-RPT-LETTERS-IND'                     CL*17
01516                TO L331-FIELD-NAME                                    CL*16
01517              MOVE MTAD-MISSING-RPT-LETTERS-IND TO L331-FROM-VALUE    CL*17
01518              MOVE MAP-PHYS-MISS-RPT-IND  TO L331-TO-VALUE            CL*16
01519              PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT              CL*16
01520              MOVE MAP-PHYS-MISS-RPT-IND                              CL*16
01521                TO MTAD-MISSING-RPT-LETTERS-IND                       CL*17
01522              MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE               CL*16
01523      ELSE                                                            CL*16
01524          MOVE MTAD-MISSING-RPT-LETTERS-IND                           CL*17
01525            TO MAP-PHYS-MISS-RPT-IND.                                 CL*16
01526  P8215-EXIT.                                                         CL*16
01527      EXIT.                                                           CL*16
01528                                                                      CL*16
01529                                                                      CL*38
01530                                                                   DTSCS42
01531  P8220-CHECK-NULL.                                                DTSCS42
01532      IF MCOL-BNK-NOT-BANKRUPT-88                                  DTSCS42
01533      AND  MCOL-BNK-COURT-CASE-NO = SPACES                         DTSCS42
01534      AND  MCOL-BNK-PETITION-DATE = +0                             DTSCS42
01535      AND  MCOL-BNK-DISCHRG-CLOSE-DATE = +0                        DTSCS42
01536      AND  MCOL-BNK-DISMISS-DATE = +0                              DTSCS42
01537      AND  MCOL-BNK-POC-REQUIRED-DATE = +0                         DTSCS42
01538      AND  MCOL-BNK-POC-FILED-DATE = +0                            DTSCS42
01539      AND  MCOL-BNK-LAST-COMM-DATE = +0                            DTSCS42
01540      AND  MCOL-BNK-CHAPTER-CHNG-DATE = +0                         DTSCS42
01541      AND  MCOL-FINAL-NOTICE-DATE = +0                             DTSCS42
01542      AND  MCOL-SUBPOENA-ACTIVITY-CD = SPACES                      DTSCS42
01543      AND  MCOL-SUBPOENA-RESP-OP-ID = SPACES                          CL*38
01544      AND  MCOL-SUBPOENA-ACTIVITY-DATE = +0                        DTSCS42
01545      AND  MCOL-LEGAL-REFERRAL-DATE = +0                              CL**2
01546      AND  MCOL-CIVIL-ACTION-BEGIN-DATE = +0                       DTSCS42
01547      AND  MCOL-CIVIL-ACTION-JUDGE-DATE = +0                       DTSCS42
01548      AND  MCOL-STMT-TEXT-TYPE-NONE-88                                CL**2
01549      AND  MCOL-STMT-TEXT-PERM-NONE-88                                CL**2
01550      AND  MCOL-STMT-TEXT-CNT = +0                                    CL**2
01551          SET WRK-NULL-MCOL-YES-88 TO TRUE.                        DTSCS42
01552  P8220-EXIT.                                                         CL*38
01553      EXIT.                                                           CL*38
01554                                                                      CL*38
01555                                                                      CL*38
01556                                                                   DTSCS42
01557 *P8230-CREATE-MTCK.                                                  CL*25
01558 *****PERFORM P8233-MTCK-COMMON THRU P8233-EXIT.                      CL*38
01559                                                                      CL*38
01560 *****SET MTCK-TYPE-PRF-CLM-88  TO TRUE.                              CL*38
01561                                                                      CL*38
01562 *****MOVE L015-DATE TO L001-FED-8-DATE-9.                            CL*38
01563 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT.                         CL*38
01564 *****SUBTRACT 10 FROM L001-JUL-ABS-DAY.                              CL*38
01565 *****PERFORM S001-FROM-ABS-DATE THRU S001-EXIT.                      CL*38
01566 *****IF L001-FED-8-DATE-9 NOT > LCCM-CURR-RUN-DATE                   CL*38
01567 *********GO TO P8230-EXIT.                                           CL*38
01568 *****MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE.                    CL*38
01569                                                                      CL*38
01570 *****SET MTCK-SOURCE-SYSTEM-88 TO TRUE.                              CL*38
01571                                                                      CL*38
01572 *****SET MTCK-DEST-SYSTEM-88 TO TRUE.                                CL*38
01573                                                                      CL*38
01574 *****MOVE MTCK-REC TO MSKL-REC.                                      CL*38
01575 *****PERFORM S810-WRITE THRU S810-EXIT.                              CL*38
01576 *P8230-EXIT. EXIT.                                                   CL*25
01577                                                                      CL*38
01578                                                                      CL*38
01579                                                                      CL*38
01580 *P8233-MTCK-COMMON.                                                  CL*25
01581 *****MOVE LOW-VALUES   TO MTCK-REC.                                  CL*38
01582                                                                      CL*38
01583 *****MOVE MCOL-EMP-NO  TO MTCK-EMP-NO.                               CL*38
01584                                                                      CL*38
01585 *****SET MTCK-TCK-88   TO TRUE.                                      CL*38
01586                                                                      CL*38
01587 *****ADD +1 TO LCCM-TASK-START-ABSTIME.                              CL*38
01588 *****MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME.              CL*38
01589                                                                      CL*38
01590 *****MOVE +0 TO MTCK-PURGE-DATE.                                     CL*38
01591                                                                      CL*38
01592 *****MOVE +0 TO MTCK-ACKNOWLEDGED-DATE.                              CL*38
01593                                                                      CL*38
01594 *****SET MTCK-NOT-CONVERTED-88 TO TRUE.                              CL*38
01595                                                                      CL*38
01596 *****MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE                       CL*38
01597 ********************************MTCK-CHNG-DATE.                      CL*38
01598                                                                      CL*38
01599 *****MOVE +0 TO MTCK-TEXT-CNT.                                       CL*38
01600 *P8233-EXIT. EXIT.                                                   CL*25
01601                                                                   DTSCS42
01602                                                                      CL*38
01603                                                                      CL*38
01604  P8240-CREATE-MEVL.                                                  CL*26
01605      MOVE LOW-VALUES TO MEVL-REC.                                    CL*38
01606                                                                      CL*38
01607      MOVE WRK-EMP-NO TO MEVL-EMP-NO.                                 CL*38
01608                                                                      CL*38
01609      SET MEVL-EVL-88 TO TRUE.                                        CL*38
01610                                                                      CL*38
01611      MOVE LCCM-TASK-START-DATE TO MEVL-DATE.                         CL*38
01612                                                                      CL*38
01613      MOVE LCCM-TASK-START-TIME TO MEVL-TIME.                         CL*38
01614                                                                      CL*38
01615      MOVE WRK-MEVL-TEXT TO MEVL-TEXT.                                CL*38
01616                                                                      CL*38
01617      MOVE LCCM-OP-ID TO MEVL-SOURCE.                                 CL*38
01618                                                                      CL*38
01619      SET MEVL-NOT-CONVERTED-88 TO TRUE.                              CL*38
01620                                                                      CL*38
01621      MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE                       CL*38
01622                                 MEVL-CHNG-DATE.                      CL*38
01623                                                                      CL*38
01624      MOVE MEVL-REC TO MSKL-REC.                                      CL*38
01625                                                                      CL*38
01626      PERFORM S810-WRITE THRU S810-EXIT.                              CL*38
01627  P8240-EXIT.                                                         CL*38
01628      EXIT.                                                           CL*38
01629                                                                      CL*38
01630                                                                      CL*38
01631                                                                      CL*26
01632  P8810-LOCK-EMPLOYER.                                             DTSCS42
01633      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS42
01634                                                                      CL*38
01635      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS42
01636                                                                      CL*38
01637      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS42
01638                                                                      CL*38
01639      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS42
01640                                                                      CL*38
01641      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS42
01642                                                                      CL*38
01643      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.                  CL**2
01644                                                                      CL*38
01645      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS42
01646                                                                      CL*38
01647      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS42
01648                                                                      CL*38
01649      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS42
01650                                                                   DTSCS42
01651                                                                      CL*38
01652      PERFORM S221-EMP-LOCK THRU S221-EXIT.                           CL*38
01653  P8810-EXIT.                                                      DTSCS42
01654      EXIT.                                                        DTSCS42
01655 /*****************************************************************DTSCS42
01656 * LINKS TO UTILITY MODULES                                        DTSCS42
01657 ******************************************************************DTSCS42
01658                                                                   DTSCS42
01659  S001-FROM-FED-8.                                                 DTSCS42
01660      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS42
01661      GO TO S001-DATE.                                             DTSCS42
01662                                                                   DTSCS42
01663  S001-FROM-ABS-DATE.                                              DTSCS42
01664      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS42
01665      GO TO S001-DATE.                                             DTSCS42
01666                                                                   DTSCS42
01667  S001-DATE.                                                       DTSCS42
01668      EXEC CICS LINK                                               DTSCS42
01669          PROGRAM('DTSCU001')                                         CL**2
01670          COMMAREA(L001-COMM-AREA)                                 DTSCS42
01671      END-EXEC.                                                    DTSCS42
01672  S001-EXIT.                                                       DTSCS42
01673      EXIT.                                                        DTSCS42
01674                                                                   DTSCS42
01675                                                                      CL*40
01676                                                                      CL*40
01677  S015-DATE-FROM-SCREEN.                                           DTSCS42
01678      EXEC CICS LINK                                               DTSCS42
01679          PROGRAM('DTSCU015')                                         CL**2
01680          COMMAREA(L015-COMM-AREA)                                 DTSCS42
01681      END-EXEC.                                                    DTSCS42
01682  S015-EXIT.                                                       DTSCS42
01683      EXIT.                                                        DTSCS42
01684                                                                   DTSCS42
01685                                                                      CL*40
01686                                                                      CL*40
01687  S018-EMP-NO-FROM-SCREEN.                                         DTSCS42
01688      EXEC CICS LINK                                               DTSCS42
01689          PROGRAM('DTSCU018')                                         CL**2
01690          COMMAREA(L018-COMM-AREA)                                 DTSCS42
01691      END-EXEC.                                                    DTSCS42
01692  S018-EXIT.                                                       DTSCS42
01693      EXIT.                                                        DTSCS42
01694                                                                   DTSCS42
01695                                                                      CL*40
01696                                                                      CL*40
01697  S031-MPRF-EMP-CLASS.                                             DTSCS42
01698      SET L031-MPRF-EMP-CLASS TO TRUE.                                CL*40
01699      GO TO S031-LINK.                                             DTSCS42
01700                                                                   DTSCS42
01701  S031-MPRF-EMP-STATUS.                                            DTSCS42
01702      SET L031-MPRF-EMP-STATUS TO TRUE.                               CL*40
01703      GO TO S031-LINK.                                             DTSCS42
01704                                                                   DTSCS42
01705  S031-LINK.                                                       DTSCS42
01706      EXEC CICS LINK                                               DTSCS42
01707          PROGRAM  ('DTSCU031')                                       CL**2
01708          COMMAREA (L031-COMM-AREA)                                DTSCS42
01709      END-EXEC.                                                    DTSCS42
01710  S031-EXIT.                                                       DTSCS42
01711      EXIT.                                                        DTSCS42
01712                                                                   DTSCS42
01713                                                                      CL*40
01714                                                                      CL*40
01715  S034-MCOL-SUBPOENA-CD.                                           DTSCS42
01716      SET L034-MCOL-SUBPOENA-CD TO TRUE.                              CL*40
01717      GO TO S034-LINK.                                             DTSCS42
01718                                                                   DTSCS42
01719  S034-MCOL-BNK-CHAPTER.                                           DTSCS42
01720      SET L034-MCOL-BNK-CHAPTER TO TRUE.                              CL*40
01721      GO TO S034-LINK.                                             DTSCS42
01722                                                                   DTSCS42
01723  S034-LINK.                                                       DTSCS42
01724      EXEC CICS LINK                                               DTSCS42
01725          PROGRAM  ('DTSCU034')                                       CL**2
01726          COMMAREA (L034-COMM-AREA)                                DTSCS42
01727      END-EXEC.                                                    DTSCS42
01728  S034-EXIT.                                                       DTSCS42
01729      EXIT.                                                        DTSCS42
01730                                                                   DTSCS42
01731                                                                      CL*40
01732                                                                      CL*40
01733  S061-FLD-ZIP.                                                       CL*10
01734      EXEC CICS LINK                                               DTSCS42
01735          PROGRAM('DTSCU061')                                         CL**2
01736          COMMAREA(L061-COMM-AREA)                                 DTSCS42
01737      END-EXEC.                                                    DTSCS42
01738                                                                   DTSCS42
01739      IF L061-FILE-CLOSED                                          DTSCS42
01740          MOVE L061-MSG-AREA TO LCCM-MSG-AREA                      DTSCS42
01741          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS42
01742          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS42
01743          GO TO MAINLINE-EXIT.                                     DTSCS42
01744  S061-EXIT.                                                       DTSCS42
01745      EXIT.                                                        DTSCS42
01746                                                                   DTSCS42
01747                                                                      CL*40
01748                                                                      CL*40
01749  S062-FLD-REP-ID-DESC.                                            DTSCS42
01750      EXEC CICS LINK                                               DTSCS42
01751          PROGRAM('DTSCU062')                                         CL**2
01752          COMMAREA(L062-COMM-AREA)                                 DTSCS42
01753      END-EXEC.                                                    DTSCS42
01754                                                                   DTSCS42
01755      IF L062-FILE-CLOSED                                          DTSCS42
01756          MOVE L062-MSG-AREA TO LCCM-MSG-AREA                      DTSCS42
01757          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS42
01758          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS42
01759          GO TO MAINLINE-EXIT.                                     DTSCS42
01760  S062-EXIT.                                                       DTSCS42
01761      EXIT.                                                        DTSCS42
01762                                                                   DTSCS42
01763                                                                      CL*40
01764                                                                      CL*40
01765  S082-OP-ID-LOOKUP.                                                  CL**9
01766      EXEC CICS LINK                                                  CL**9
01767          PROGRAM('DTSCU082')                                         CL**9
01768          COMMAREA(L082-COMM-AREA)                                    CL**9
01769      END-EXEC.                                                       CL**9
01770                                                                      CL**9
01771      IF L082-FILE-CLOSED                                             CL**9
01772          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                         CL**9
01773          SET LCCM-REQ-SCR-SF-88 TO TRUE                              CL**9
01774          SET LCCM-LINK-SCREEN-88 TO TRUE                             CL**9
01775          GO TO MAINLINE-EXIT.                                        CL**9
01776  S082-EXIT.                                                          CL**9
01777      EXIT.                                                           CL**9
01778                                                                      CL**9
01779                                                                      CL*40
01780                                                                      CL*40
01781  S221-EMP-LOCK.                                                   DTSCS42
01782      SET L221-START-UPDATE TO TRUE.                               DTSCS42
01783      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS42
01784                                                                   DTSCS42
01785  S221-EMP-UNLOCK.                                                 DTSCS42
01786      SET L221-END-UPDATE TO TRUE.                                 DTSCS42
01787      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS42
01788                                                                   DTSCS42
01789  S221-EMP-LOCK-UNLOCK.                                            DTSCS42
01790      EXEC CICS LINK                                               DTSCS42
01791          PROGRAM('DTSCU221')                                         CL**2
01792          COMMAREA(L221-COMM-AREA)                                 DTSCS42
01793      END-EXEC.                                                    DTSCS42
01794                                                                   DTSCS42
01795      IF L221-FILE-CLOSED                                          DTSCS42
01796          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS42
01797          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS42
01798          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS42
01799          GO TO MAINLINE-EXIT.                                     DTSCS42
01800                                                                   DTSCS42
01801      IF L221-NOT-OK                                               DTSCS42
01802          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS42
01803  S221-EXIT.                                                       DTSCS42
01804      EXIT.                                                        DTSCS42
01805                                                                   DTSCS42
01806                                                                      CL*40
01807                                                                      CL*40
01808  S331-EMP-WRITE-MLOG.                                                CL**9
01809      EXEC CICS LINK                                               DTSCS42
01810          PROGRAM('DTSCU331')                                         CL**2
01811          COMMAREA(L331-COMM-AREA)                                 DTSCS42
01812      END-EXEC.                                                    DTSCS42
01813                                                                   DTSCS42
01814      IF L331-FILE-CLOSED                                          DTSCS42
01815          MOVE L331-MSG-AREA TO LCCM-MSG-AREA                      DTSCS42
01816          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS42
01817          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS42
01818          GO TO MAINLINE-EXIT.                                     DTSCS42
01819  S331-EXIT.                                                       DTSCS42
01820      EXIT.                                                        DTSCS42
01821                                                                   DTSCS42
01822                                                                      CL*40
01823                                                                      CL*40
01824  S803-REQ-SCR-ID-EDIT.                                            DTSCS42
01825      EXEC CICS LINK                                               DTSCS42
01826          PROGRAM ('DTSCU803')                                        CL**2
01827          COMMAREA (DFHCOMMAREA)                                   DTSCS42
01828      END-EXEC.                                                    DTSCS42
01829  S803-EXIT.                                                       DTSCS42
01830      EXIT.                                                        DTSCS42
01831                                                                   DTSCS42
01832                                                                      CL*40
01833                                                                      CL*40
01834  S804-INVALID-KEY.                                                DTSCS42
01835      EXEC CICS LINK                                               DTSCS42
01836          PROGRAM ('DTSCU804')                                        CL**2
01837          COMMAREA (DFHCOMMAREA)                                   DTSCS42
01838      END-EXEC.                                                    DTSCS42
01839  S804-EXIT.                                                       DTSCS42
01840      EXIT.                                                        DTSCS42
01841                                                                   DTSCS42
01842                                                                      CL*40
01843                                                                      CL*40
01844  S805-MSG-AREA.                                                   DTSCS42
01845      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS42
01846                                                                   DTSCS42
01847      EXEC CICS LINK                                               DTSCS42
01848          PROGRAM ('DTSCU805')                                        CL**2
01849          COMMAREA (L805-COMM-AREA)                                DTSCS42
01850      END-EXEC.                                                    DTSCS42
01851                                                                   DTSCS42
01852      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS42
01853  S805-EXIT.                                                       DTSCS42
01854      EXIT.                                                        DTSCS42
01855                                                                      CL*40
01856                                                                      CL*40
01857                                                                      CL*40
01858  S810-READ.                                                       DTSCS42
01859      SET L810-READ-88 TO TRUE.                                    DTSCS42
01860      GO TO S810-IO.                                               DTSCS42
01861                                                                   DTSCS42
01862  S810-START-BROWSE.                                               DTSCS42
01863      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS42
01864      GO TO S810-IO.                                               DTSCS42
01865                                                                   DTSCS42
01866  S810-READ-NEXT.                                                  DTSCS42
01867      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS42
01868      GO TO S810-IO.                                               DTSCS42
01869                                                                   DTSCS42
01870  S810-READ-PREV.                                                  DTSCS42
01871      SET L810-READ-PREV-88 TO TRUE.                               DTSCS42
01872      GO TO S810-IO.                                               DTSCS42
01873                                                                   DTSCS42
01874  S810-END-BROWSE.                                                 DTSCS42
01875      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS42
01876      GO TO S810-IO.                                               DTSCS42
01877                                                                   DTSCS42
01878  S810-COUNT.                                                      DTSCS42
01879      SET L810-COUNT-88 TO TRUE.                                   DTSCS42
01880      GO TO S810-IO.                                               DTSCS42
01881                                                                   DTSCS42
01882  S810-REWRITE.                                                    DTSCS42
01883      SET L810-REWRITE-88 TO TRUE.                                 DTSCS42
01884      GO TO S810-IO.                                               DTSCS42
01885                                                                   DTSCS42
01886  S810-WRITE.                                                      DTSCS42
01887      SET L810-WRITE-88 TO TRUE.                                   DTSCS42
01888      GO TO S810-IO.                                               DTSCS42
01889                                                                   DTSCS42
01890  S810-DELETE.                                                     DTSCS42
01891      SET L810-DELETE-88 TO TRUE.                                  DTSCS42
01892      GO TO S810-IO.                                               DTSCS42
01893                                                                   DTSCS42
01894  S810-IO.                                                         DTSCS42
01895      EXEC CICS LINK                                               DTSCS42
01896          PROGRAM ('DTSCU810')                                        CL**2
01897          COMMAREA (L810-COMM-AREA)                                DTSCS42
01898      END-EXEC.                                                    DTSCS42
01899                                                                   DTSCS42
01900      IF L810-FILE-CLOSED-88                                       DTSCS42
01901          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS42
01902          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS42
01903          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS42
01904          GO TO MAINLINE-EXIT.                                     DTSCS42
01905  S810-EXIT.                                                       DTSCS42
01906      EXIT.                                                        DTSCS42
01907                                                                      CL*40
01908                                                                      CL*40
01909                                                                      CL*40
01910  S851-SCREEN-PROCESSING.                                          DTSCS42
01911      EXEC CICS LINK                                               DTSCS42
01912          PROGRAM ('DTSCU851')                                        CL**2
01913          COMMAREA (L851-COMM-AREA)                                DTSCS42
01914      END-EXEC.                                                    DTSCS42
01915  S851-EXIT.                                                       DTSCS42
01916      EXIT.                                                        DTSCS42
01917                                                                   DTSCS42
01918                                                                      CL*40
01919                                                                      CL*40
01920  S899-ABEND.                                                      DTSCS42
01921      EXEC CICS ABEND                                              DTSCS42
01922          ABCODE(WRK-ABEND-CD)                                     DTSCS42
01923      END-EXEC.                                                    DTSCS42
01924  S899-EXIT.                                                       DTSCS42
01925      EXIT.                                                        DTSCS42
01926 /*****************************************************************DTSCS42
01927 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS42
01928 ******************************************************************DTSCS42
01929                                                                   DTSCS42
01930  S1000-SCREEN-EDITS.                                              DTSCS42
01931      MOVE +0 TO WRK-START-DATE.                                   DTSCS42
01932                                                                      CL*40
01933      MOVE ALL-NINES-DATE TO WRK-END-DATE.                         DTSCS42
01934                                                                   DTSCS42
01935                                                                      CL*40
01936      PERFORM S1300-MTAD-EDITS THRU S1300-EXIT                        CL*40
01937          VARYING WRK-OCC FROM 1 BY 1                                 CL*40
01938          UNTIL WRK-OCC > 2.                                          CL*40
01939                                                                      CL*40
01940      PERFORM S1500-SUSPEND THRU S1500-EXIT.                          CL*40
01941                                                                      CL*40
01942      PERFORM S1600-FINAL-NOTICE-DATE THRU S1600-EXIT.                CL*40
01943                                                                      CL*40
01944      PERFORM S1700-SUBPOENA-CD THRU S1700-EXIT.                      CL*40
01945                                                                      CL*40
01946      PERFORM S1800-LEGAL-REFERRAL-DATE THRU S1800-EXIT.              CL*40
01947                                                                      CL*40
01948      PERFORM S1900-CIVIL-ACTION-BEGIN-DATE THRU S1900-EXIT.          CL*40
01949                                                                      CL*40
01950      PERFORM S2000-SUBPOENA-OPID THRU S2000-EXIT.                    CL*40
01951                                                                      CL*40
01952      PERFORM S2100-CIVIL-ACTION-JUDGE-DATE THRU S2100-EXIT.          CL*40
01953                                                                   DTSCS42
01954      PERFORM S2300-BNK-PETITION-DATE THRU S2300-EXIT.                CL*40
01955                                                                      CL*40
01956      PERFORM S2400-BNK-COURT-CASE-NO THRU S2400-EXIT.                CL*40
01957                                                                      CL*40
01958      PERFORM S2500-BNK-CHAPTER THRU S2500-EXIT.                      CL*40
01959                                                                      CL*40
01960      PERFORM S2600-BNK-POC-REQUIRED-DATE THRU S2600-EXIT.            CL*40
01961                                                                      CL*40
01962      PERFORM S2700-BNK-POC-FILED-DATE THRU S2700-EXIT.               CL*40
01963                                                                      CL*40
01964      PERFORM S2800-BNK-CHAPTER-CHNG-DATE THRU S2800-EXIT.            CL*40
01965                                                                      CL*40
01966      PERFORM S2900-BNK-LAST-COMM-DATE THRU S2900-EXIT.               CL*40
01967                                                                      CL*40
01968      PERFORM S3000-BNK-DISCHRG-CLOSE-DATE THRU S3000-EXIT.           CL*40
01969                                                                      CL*40
01970      PERFORM S3100-BNK-DISMISS-DATE THRU S3100-EXIT.                 CL*40
01971                                                                   DTSCS42
01972      PERFORM S3200-STMT-TEXT THRU S3200-EXIT.                        CL*40
01973                                                                      CL*40
01974      PERFORM S3300-STMT-TYPE THRU S3300-EXIT.                        CL*40
01975                                                                      CL*40
01976      PERFORM S3400-STMT-PERMANENT-IND THRU S3400-EXIT.               CL*40
01977                                                                   DTSCS42
01978 *****IF LCCM-MSG                                                  DTSCS42
01979 ********GO TO S1000-EXIT.                                            CL*40
01980                                                                      CL*40
01981 *****PERFORM S3500-MISC-EDITS THRU S3500-EXIT.                    DTSCS42
01982  S1000-EXIT.                                                         CL*40
01983      EXIT.                                                           CL*40
01984      EJECT                                                        DTSCS42
01985 /*****************************************************************DTSCS42
01986 *                                                                 DTSCS42
01987 ******************************************************************DTSCS42
01988                                                                      CL*40
01989  S1100-EDIT-KEY.                                                  DTSCS42
01990      PERFORM S1101-EMP-NO THRU S1101-EXIT.                           CL*40
01991  S1100-EXIT.                                                         CL*40
01992      EXIT.                                                           CL*40
01993 /*****************************************************************DTSCS42
01994 *                                                                 DTSCS42
01995 ******************************************************************DTSCS42
01996                                                                      CL*40
01997  S1101-EMP-NO.                                                    DTSCS42
01998      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                     CL*40
01999                                                                      CL*40
02000      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS42
02001                                                                   DTSCS42
02002      IF L018-NO-ENTRY                                             DTSCS42
02003         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                     CL*40
02004         PERFORM S1199-ERROR THRU S1199-EXIT                          CL*40
02005         GO TO S1101-EXIT.                                         DTSCS42
02006                                                                   DTSCS42
02007      IF L018-NOT-VALID                                            DTSCS42
02008         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*40
02009         PERFORM S1199-ERROR THRU S1199-EXIT                          CL*40
02010         GO TO S1101-EXIT.                                         DTSCS42
02011                                                                   DTSCS42
02012      MOVE L018-EMP-NO TO WRK-EMP-NO.                                 CL*40
02013  S1101-EXIT.                                                         CL*40
02014      EXIT.                                                           CL*40
02015 /*****************************************************************DTSCS42
02016 *                                                                 DTSCS42
02017 ******************************************************************DTSCS42
02018                                                                      CL*40
02019  S1110-READ-MCOL.                                                 DTSCS42
02020      MOVE LOW-VALUES TO MCOL-KEY-AREA.                               CL*40
02021                                                                      CL*40
02022      MOVE WRK-EMP-NO TO MCOL-EMP-NO.                                 CL*40
02023                                                                      CL*40
02024      SET MCOL-COL-88 TO TRUE.                                        CL*40
02025                                                                   DTSCS42
02026      MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA.                            CL*40
02027                                                                   DTSCS42
02028      PERFORM S810-READ THRU S810-EXIT.                               CL*40
02029                                                                   DTSCS42
02030      IF L810-NO-REC-88                                            DTSCS42
02031         NEXT SENTENCE                                             DTSCS42
02032      ELSE                                                         DTSCS42
02033         SET WRK-MCOL-YES-88 TO TRUE                               DTSCS42
02034         MOVE MSKL-REC TO MCOL-REC.                                   CL*40
02035  S1110-EXIT.                                                      DTSCS42
02036      EXIT.                                                        DTSCS42
02037 /*****************************************************************DTSCS42
02038 *                                                                 DTSCS42
02039 ******************************************************************DTSCS42
02040                                                                      CL*40
02041  S1130-READ-MPRF.                                                 DTSCS42
02042      MOVE LOW-VALUES TO MPRF-KEY-AREA.                               CL*40
02043                                                                      CL*40
02044      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                                 CL*40
02045                                                                      CL*40
02046      SET MPRF-PRF-88 TO TRUE.                                        CL*40
02047                                                                   DTSCS42
02048      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                            CL*40
02049                                                                   DTSCS42
02050      PERFORM S810-READ THRU S810-EXIT.                               CL*40
02051                                                                   DTSCS42
02052      IF L810-NO-REC-88                                            DTSCS42
02053         MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                       DTSCS42
02054         PERFORM S1199-ERROR THRU S1199-EXIT                          CL*40
02055      ELSE                                                         DTSCS42
02056          MOVE MSKL-REC TO MPRF-REC                                DTSCS42
02057          SET WRK-MPRF-YES-88 TO TRUE.                                CL*40
02058  S1130-EXIT.                                                      DTSCS42
02059      EXIT.                                                        DTSCS42
02060                                                                   DTSCS42
02061                                                                      CL*40
02062                                                                      CL*40
02063  S1199-ERROR.                                                     DTSCS42
02064      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS42
02065                                         MAP-EMP-NO-2-A.           DTSCS42
02066      IF LCCM-NO-MSG                                               DTSCS42
02067         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*40
02068         MOVE CATB-CURSOR TO MAP-EMP-NO-1-L                           CL*40
02069         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02070  S1199-EXIT.                                                         CL*40
02071      EXIT.                                                           CL*40
02072 /*****************************************************************DTSCS42
02073 *                                                                 DTSCS42
02074 ******************************************************************DTSCS42
02075                                                                      CL*40
02076  S1300-MTAD-EDITS.                                                DTSCS42
02077      IF MAP-MAIL-DB-MEMO-IND = LOW-VALUES                            CL*12
02078          MOVE SPACES TO MAP-MAIL-DB-MEMO-IND.                        CL*12
02079                                                                   DTSCS42
02080      IF MAP-PHYS-DB-MEMO-IND = LOW-VALUES                            CL*12
02081          MOVE SPACES TO MAP-PHYS-DB-MEMO-IND.                        CL*12
02082                                                                      CL*12
02083      IF MAP-MAIL-MISS-RPT-IND = LOW-VALUES                           CL*12
02084          MOVE SPACES TO MAP-MAIL-MISS-RPT-IND.                       CL*12
02085                                                                   DTSCS42
02086      IF MAP-PHYS-MISS-RPT-IND = LOW-VALUES                           CL*12
02087          MOVE SPACES TO MAP-PHYS-MISS-RPT-IND.                       CL*12
02088                                                                      CL*12
02089                                                                      CL*41
02090      MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSCS42
02091                                                                      CL*41
02092      MOVE WRK-EMP-NO TO MTAD-EMP-NO.                              DTSCS42
02093                                                                      CL*41
02094      SET MTAD-TAD-88 TO TRUE.                                     DTSCS42
02095                                                                      CL*41
02096      MOVE WRK-OCC TO MTAD-ID-NO.                                  DTSCS42
02097                                                                      CL*41
02098      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS42
02099                                                                      CL*41
02100      PERFORM S810-READ THRU S810-EXIT.                            DTSCS42
02101                                                                   DTSCS42
02102      IF L810-NO-REC-88                                            DTSCS42
02103          PERFORM S1310-NO-MTAD-EXISTS THRU S1310-EXIT             DTSCS42
02104      ELSE                                                         DTSCS42
02105          MOVE MSKL-REC TO MTAD-REC                                DTSCS42
02106          PERFORM S1320-MTAD-EXISTS THRU S1320-EXIT.               DTSCS42
02107  S1300-EXIT.                                                         CL*41
02108      EXIT.                                                           CL*41
02109                                                                      CL*41
02110                                                                      CL*41
02111                                                                      CL*41
02112  S1310-NO-MTAD-EXISTS.                                            DTSCS42
02113      IF WRK-OCC = +1                                                 CL*12
02114          PERFORM S1311-NO-MAIL-EXISTS THRU S1311-EXIT                CL*12
02115      ELSE                                                            CL*12
02116          PERFORM S1312-NO-PHYS-EXISTS THRU S1312-EXIT.               CL*12
02117  S1310-EXIT.                                                         CL*12
02118      EXIT.                                                           CL*12
02119                                                                      CL*12
02120                                                                      CL*41
02121                                                                      CL*41
02122  S1311-NO-MAIL-EXISTS.                                               CL*12
02123      IF MAP-MAIL-DB-MEMO-NO-MTAD-88                                  CL*12
02124          NEXT SENTENCE                                            DTSCS42
02125      ELSE                                                         DTSCS42
02126          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              DTSCS42
02127          PERFORM S1396-ERROR THRU S1396-EXIT.                        CL*13
02128                                                                   DTSCS42
02129      IF MAP-MAIL-MISS-RPT-NO-MTAD-88                                 CL*12
02130          NEXT SENTENCE                                               CL*12
02131      ELSE                                                            CL*12
02132          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA                 CL*12
02133          PERFORM S1397-ERROR THRU S1397-EXIT.                        CL*13
02134  S1311-EXIT.                                                         CL*12
02135      EXIT.                                                           CL*12
02136                                                                      CL*12
02137                                                                      CL*41
02138                                                                      CL*41
02139  S1312-NO-PHYS-EXISTS.                                               CL*12
02140      IF MAP-PHYS-DB-MEMO-NO-MTAD-88                                  CL*12
02141          NEXT SENTENCE                                               CL*12
02142      ELSE                                                            CL*12
02143          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA                 CL*12
02144          PERFORM S1398-ERROR THRU S1398-EXIT.                        CL*12
02145                                                                      CL*12
02146      IF MAP-PHYS-MISS-RPT-NO-MTAD-88                                 CL*13
02147          NEXT SENTENCE                                            DTSCS42
02148      ELSE                                                         DTSCS42
02149          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              DTSCS42
02150          PERFORM S1399-ERROR THRU S1399-EXIT.                     DTSCS42
02151  S1312-EXIT.                                                         CL*12
02152      EXIT.                                                        DTSCS42
02153                                                                   DTSCS42
02154                                                                      CL*41
02155                                                                      CL*41
02156  S1320-MTAD-EXISTS.                                               DTSCS42
02157      IF WRK-OCC = +1                                                 CL*13
02158          PERFORM S1321-MAIL-EXISTS THRU S1321-EXIT                   CL*13
02159      ELSE                                                            CL*13
02160          PERFORM S1322-PHYS-EXISTS THRU S1322-EXIT.                  CL*13
02161  S1320-EXIT.                                                         CL*13
02162      EXIT.                                                           CL*13
02163                                                                      CL*13
02164                                                                      CL*41
02165                                                                      CL*41
02166  S1321-MAIL-EXISTS.                                                  CL*13
02167      IF MAP-MAIL-DB-MEMO-NO-MTAD-88                                  CL*13
02168         MOVE 'Y' TO MAP-MAIL-DB-MEMO-IND                             CL*13
02169      ELSE                                                         DTSCS42
02170          IF MAP-MAIL-DB-MEMO-VALID-88                                CL*13
02171              NEXT SENTENCE                                        DTSCS42
02172          ELSE                                                     DTSCS42
02173              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS42
02174              PERFORM S1396-ERROR THRU S1396-EXIT.                    CL*13
02175                                                                   DTSCS42
02176      IF MAP-MAIL-MISS-RPT-NO-MTAD-88                                 CL*20
02177         MOVE 'Y' TO MAP-MAIL-MISS-RPT-IND                            CL*13
02178      ELSE                                                         DTSCS42
02179        IF MAP-MAIL-MISS-RPT-VALID-88                                 CL*13
02180           NEXT SENTENCE                                              CL*13
02181        ELSE                                                          CL*13
02182           MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                  CL*13
02183           PERFORM S1397-ERROR THRU S1397-EXIT.                       CL*13
02184  S1321-EXIT.                                                         CL*13
02185      EXIT.                                                        DTSCS42
02186                                                                   DTSCS42
02187                                                                      CL*41
02188                                                                      CL*41
02189  S1322-PHYS-EXISTS.                                                  CL*13
02190      IF MAP-PHYS-DB-MEMO-NO-MTAD-88                                  CL*13
02191         MOVE 'N' TO MAP-PHYS-DB-MEMO-IND                             CL*13
02192      ELSE                                                            CL*13
02193          IF MAP-PHYS-DB-MEMO-VALID-88                                CL*13
02194              NEXT SENTENCE                                           CL*13
02195          ELSE                                                        CL*13
02196              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA               CL*13
02197              PERFORM S1398-ERROR THRU S1398-EXIT.                    CL*13
02198                                                                      CL*13
02199      IF MAP-PHYS-MISS-RPT-NO-MTAD-88                                 CL*20
02200         MOVE 'N' TO MAP-PHYS-MISS-RPT-IND                            CL*13
02201      ELSE                                                            CL*13
02202        IF MAP-PHYS-MISS-RPT-VALID-88                                 CL*13
02203           NEXT SENTENCE                                              CL*13
02204        ELSE                                                          CL*13
02205           MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                  CL*13
02206           PERFORM S1399-ERROR THRU S1399-EXIT.                       CL*13
02207  S1322-EXIT.                                                         CL*13
02208      EXIT.                                                           CL*13
02209                                                                      CL*13
02210                                                                      CL*41
02211                                                                      CL*41
02212  S1396-ERROR.                                                        CL*13
02213      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS42
02214        TO MAP-MAIL-DB-MEMO-IND-A.                                    CL*13
02215                                                                      CL*41
02216      IF LCCM-NO-MSG                                               DTSCS42
02217         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02218         MOVE CATB-CURSOR TO MAP-MAIL-DB-MEMO-IND-L                   CL*41
02219         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02220  S1396-EXIT.                                                         CL*41
02221      EXIT.                                                           CL*41
02222                                                                   DTSCS42
02223                                                                      CL*41
02224                                                                      CL*41
02225  S1397-ERROR.                                                        CL*13
02226      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS42
02227        TO MAP-MAIL-MISS-RPT-IND-A.                                   CL*13
02228                                                                      CL*41
02229      IF LCCM-NO-MSG                                               DTSCS42
02230         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02231         MOVE CATB-CURSOR                                          DTSCS42
02232           TO MAP-MAIL-MISS-RPT-IND-L                                 CL*13
02233         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02234  S1397-EXIT.                                                         CL*41
02235      EXIT.                                                           CL*41
02236                                                                      CL*41
02237                                                                      CL*41
02238                                                                      CL*13
02239  S1398-ERROR.                                                        CL*13
02240      MOVE CATB-UNPROT-NORM-AN-MDTON                                  CL*13
02241        TO MAP-PHYS-DB-MEMO-IND-A.                                    CL*13
02242                                                                      CL*41
02243      IF LCCM-NO-MSG                                                  CL*13
02244         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02245         MOVE CATB-CURSOR TO MAP-PHYS-DB-MEMO-IND-L                   CL*41
02246         SET CURSOR-SET-YES TO TRUE.                                  CL*13
02247  S1398-EXIT.                                                         CL*41
02248      EXIT.                                                           CL*41
02249                                                                      CL*13
02250                                                                      CL*41
02251                                                                      CL*41
02252  S1399-ERROR.                                                        CL*13
02253      MOVE CATB-UNPROT-NORM-AN-MDTON                                  CL*13
02254        TO MAP-PHYS-MISS-RPT-IND-A.                                   CL*13
02255                                                                      CL*41
02256      IF LCCM-NO-MSG                                                  CL*13
02257         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02258         MOVE CATB-CURSOR                                             CL*13
02259           TO MAP-PHYS-MISS-RPT-IND-L                                 CL*13
02260         SET CURSOR-SET-YES TO TRUE.                                  CL*13
02261  S1399-EXIT.                                                         CL*41
02262      EXIT.                                                           CL*41
02263 /*****************************************************************DTSCS42
02264 *                                                                 DTSCS42
02265 ******************************************************************DTSCS42
02266                                                                      CL*41
02267  S1500-SUSPEND.                                                      CL**5
02268      IF MAP-SUSPEND-IND = LOW-VALUES OR SPACES                       CL**5
02269         MOVE 'N' TO MAP-SUSPEND-IND                                  CL**6
02270         GO TO S1500-EXIT                                             CL**5
02271      END-IF.                                                         CL**5
02272                                                                      CL**5
02273      IF NOT MAP-SUSPEND-VALID-88                                     CL*20
02274         MOVE EMSG-FIELD-NOT-VALID  TO WRK-MSG-AREA                   CL*41
02275         PERFORM S1501-ERROR THRU S1501-EXIT.                         CL*41
02276  S1500-EXIT.                                                         CL*41
02277      EXIT.                                                           CL*41
02278                                                                      CL**5
02279                                                                      CL*41
02280                                                                      CL*41
02281  S1501-ERROR.                                                        CL**5
02282      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SUSPEND-IND-A.            CL*18
02283                                                                      CL*41
02284      IF LCCM-NO-MSG                                                  CL**5
02285         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02286         MOVE CATB-CURSOR TO MAP-SUSPEND-IND-L                        CL*41
02287         SET CURSOR-SET-YES TO TRUE.                                  CL**5
02288  S1501-EXIT.                                                         CL*41
02289      EXIT.                                                           CL*41
02290 /*****************************************************************DTSCS42
02291 *                                                                 DTSCS42
02292 ******************************************************************DTSCS42
02293                                                                      CL**6
02294  S1600-FINAL-NOTICE-DATE.                                            CL**6
02295      MOVE MAP-FINAL-NOTICE-DATE TO L015-S-DATE-AREA.                 CL**6
02296                                                                      CL*41
02297      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**6
02298                                                                      CL**6
02299                                                                      CL**6
02300      IF L015-NO-ENTRY                                                CL**6
02301         GO TO S1600-EXIT                                             CL**6
02302      END-IF.                                                         CL**6
02303                                                                      CL**6
02304      IF L015-NOT-VALID                                               CL**6
02305         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*41
02306         PERFORM S1601-ERROR THRU S1601-EXIT.                         CL*41
02307  S1600-EXIT.                                                         CL*41
02308      EXIT.                                                           CL*41
02309                                                                      CL*41
02310                                                                      CL*41
02311                                                                      CL*41
02312  S1601-ERROR.                                                        CL**6
02313      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FINAL-NOTICE-MO-A        CL**6
02314                                         MAP-FINAL-NOTICE-DA-A        CL**6
02315                                         MAP-FINAL-NOTICE-YR-A.       CL**6
02316                                                                      CL*41
02317      IF LCCM-NO-MSG                                                  CL**6
02318         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02319         MOVE CATB-CURSOR TO MAP-FINAL-NOTICE-MO-L                    CL*41
02320         SET CURSOR-SET-YES TO TRUE.                                  CL**6
02321  S1601-EXIT.                                                         CL*41
02322      EXIT.                                                           CL*41
02323 /*****************************************************************   CL**5
02324 *                                                                    CL**5
02325 ******************************************************************   CL**5
02326  S1700-SUBPOENA-CD.                                                  CL*14
02327      IF MAP-SUBPOENA-CD = LOW-VALUE                                  CL**5
02328          MOVE SPACE TO MAP-SUBPOENA-CD.                              CL**5
02329                                                                      CL*41
02330                                                                      CL*41
02331      MOVE MAP-SUBPOENA-DATE TO L015-S-DATE-AREA.                     CL**5
02332                                                                      CL*41
02333      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL**5
02334                                                                      CL**5
02335                                                                      CL*41
02336      IF MAP-SUBPOENA-CD = SPACE                                      CL**5
02337         IF L015-NO-ENTRY                                             CL**5
02338             NEXT SENTENCE                                            CL**5
02339         ELSE                                                         CL**5
02340            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               CL*41
02341            PERFORM S1702-ERROR THRU S1702-EXIT                       CL*41
02342      ELSE                                                            CL**5
02343         MOVE MAP-SUBPOENA-CD TO L034-CD                              CL**5
02344         PERFORM S034-MCOL-SUBPOENA-CD THRU S034-EXIT                 CL**5
02345         IF L034-NOT-VALID                                            CL**5
02346            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 CL*41
02347            PERFORM S1701-ERROR THRU S1701-EXIT                       CL*41
02348         ELSE                                                         CL**5
02349            IF L015-NO-ENTRY                                          CL**5
02350               MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               CL*41
02351               PERFORM S1702-ERROR THRU S1702-EXIT.                   CL*41
02352                                                                      CL**5
02353      IF L015-NOT-VALID                                               CL**5
02354         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*41
02355         PERFORM S1702-ERROR THRU S1702-EXIT.                         CL*41
02356  S1700-EXIT.                                                         CL*41
02357      EXIT.                                                           CL*41
02358                                                                      CL*41
02359                                                                      CL*41
02360                                                                      CL*41
02361  S1701-ERROR.                                                        CL**5
02362      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-SUBPOENA-CD-A.           CL**5
02363                                                                      CL*41
02364      IF LCCM-NO-MSG                                                  CL**5
02365         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02366         MOVE CATB-CURSOR TO MAP-SUBPOENA-CD-L                        CL*41
02367         SET CURSOR-SET-YES TO TRUE.                                  CL**5
02368  S1701-EXIT.                                                         CL*41
02369      EXIT.                                                           CL*41
02370                                                                      CL*41
02371                                                                      CL*41
02372                                                                      CL*41
02373  S1702-ERROR.                                                        CL**5
02374      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SUBPOENA-MO-A            CL**5
02375                                         MAP-SUBPOENA-DA-A            CL**5
02376                                         MAP-SUBPOENA-YR-A.           CL**5
02377                                                                      CL*41
02378      IF LCCM-NO-MSG                                                  CL**5
02379         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02380         MOVE CATB-CURSOR TO MAP-SUBPOENA-MO-L                        CL*41
02381         SET CURSOR-SET-YES TO TRUE.                                  CL**5
02382  S1702-EXIT.                                                         CL*41
02383      EXIT.                                                           CL*41
02384 /*************************************************************       CL*41
02385 *                                                                    CL*41
02386 **************************************************************       CL*41
02387                                                                      CL*41
02388  S1800-LEGAL-REFERRAL-DATE.                                          CL**5
02389      MOVE MAP-LEGAL-REF-DATE TO L015-S-DATE-AREA.                    CL*18
02390                                                                      CL*41
02391      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02392                                                                   DTSCS42
02393                                                                   DTSCS42
02394      IF L015-NO-ENTRY                                             DTSCS42
02395         GO TO S1800-EXIT                                             CL**5
02396      END-IF.                                                      DTSCS42
02397                                                                   DTSCS42
02398      IF L015-NOT-VALID                                            DTSCS42
02399         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*41
02400         PERFORM S1801-ERROR THRU S1801-EXIT.                         CL*41
02401  S1800-EXIT.                                                         CL*41
02402      EXIT.                                                           CL*41
02403                                                                      CL*41
02404                                                                      CL*41
02405                                                                      CL*41
02406  S1801-ERROR.                                                        CL**5
02407      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LEGAL-REF-MO-A           CL*10
02408                                         MAP-LEGAL-REF-DA-A           CL*10
02409                                         MAP-LEGAL-REF-YR-A.          CL*10
02410                                                                      CL*41
02411      IF LCCM-NO-MSG                                               DTSCS42
02412         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02413         MOVE CATB-CURSOR TO MAP-LEGAL-REF-MO-L                       CL*41
02414         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02415  S1801-EXIT.                                                         CL*41
02416      EXIT.                                                           CL*41
02417                                                                      CL*41
02418                                                                      CL*41
02419                                                                      CL*41
02420 /*****************************************************************DTSCS42
02421 *                                                                 DTSCS42
02422 ******************************************************************DTSCS42
02423                                                                      CL*41
02424  S1900-CIVIL-ACTION-BEGIN-DATE.                                      CL**6
02425      MOVE MAP-CIVIL-ACTION-BEGIN-DATE TO L015-S-DATE-AREA.        DTSCS42
02426                                                                      CL*41
02427      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02428                                                                   DTSCS42
02429                                                                   DTSCS42
02430      IF L015-NO-ENTRY                                             DTSCS42
02431         GO TO S1900-EXIT                                             CL**7
02432      END-IF.                                                      DTSCS42
02433                                                                   DTSCS42
02434      IF L015-NOT-VALID                                            DTSCS42
02435         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*41
02436         PERFORM S1901-ERROR THRU S1901-EXIT.                         CL*41
02437  S1900-EXIT.                                                         CL*41
02438      EXIT.                                                           CL*41
02439                                                                      CL*41
02440                                                                      CL*41
02441                                                                      CL*41
02442  S1901-ERROR.                                                        CL**7
02443      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS42
02444        TO MAP-CIVIL-ACTION-BEGIN-MO-A                                CL*41
02445           MAP-CIVIL-ACTION-BEGIN-DA-A                                CL*41
02446           MAP-CIVIL-ACTION-BEGIN-YR-A.                               CL*41
02447                                                                      CL*41
02448      IF LCCM-NO-MSG                                               DTSCS42
02449         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*41
02450         MOVE CATB-CURSOR TO MAP-CIVIL-ACTION-BEGIN-MO-L              CL*41
02451         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02452  S1901-EXIT.                                                         CL*41
02453      EXIT.                                                           CL*41
02454 /*****************************************************************DTSCS42
02455 *                                                                 DTSCS42
02456 ******************************************************************DTSCS42
02457                                                                      CL*42
02458  S2000-SUBPOENA-OPID.                                                CL**7
02459      MOVE MAP-SUBPOENA-DATE TO L015-S-DATE-AREA.                     CL*27
02460                                                                      CL*42
02461      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                   CL*27
02462                                                                      CL*27
02463      IF L015-NO-ENTRY                                                CL*27
02464         IF MAP-SUBPOENA-OPID = SPACES OR LOW-VALUES                  CL*27
02465             MOVE SPACES TO MAP-SUBPOENA-OPID                         CL*42
02466             GO TO S2000-EXIT                                         CL*42
02467         ELSE                                                         CL*27
02468             MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              CL*42
02469             PERFORM S2001-ERROR THRU S2001-EXIT                      CL*42
02470             GO TO S2000-EXIT.                                        CL*42
02471                                                                      CL*27
02472      IF MAP-SUBPOENA-OPID = SPACES OR LOW-VALUES                     CL*27
02473         MOVE LCCM-RESP-OP-ID TO MAP-SUBPOENA-OPID.                   CL*27
02474                                                                      CL*27
02475      IF MAP-SUBPOENA-OPID = LCCM-OP-ID                               CL**9
02476         MOVE MAP-SUBPOENA-OPID TO LCCM-RESP-OP-ID                    CL**9
02477         GO TO S2000-EXIT                                             CL**7
02478      END-IF.                                                      DTSCS42
02479                                                                   DTSCS42
02480      MOVE MAP-SUBPOENA-OPID TO L082-OP-ID.                           CL*42
02481                                                                      CL*42
02482      PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT.                       CL*42
02483                                                                      CL**9
02484      IF (L082-VALID-OP) AND (L082-EXTERNAL-88)                       CL**9
02485         MOVE MAP-SUBPOENA-OPID TO LCCM-RESP-OP-ID                    CL**9
02486      ELSE                                                            CL**9
02487         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*42
02488         PERFORM S2001-ERROR THRU S2001-EXIT.                         CL*42
02489  S2000-EXIT.                                                         CL*42
02490      EXIT.                                                           CL*42
02491                                                                      CL*42
02492                                                                      CL*42
02493                                                                      CL*42
02494  S2001-ERROR.                                                        CL**7
02495      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SUBPOENA-OPID-A          CL**9
02496                                         MAP-SUBPOENA-OPID-A          CL**9
02497                                         MAP-SUBPOENA-OPID-A.         CL**9
02498                                                                      CL*42
02499      IF LCCM-NO-MSG                                               DTSCS42
02500         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02501         MOVE CATB-CURSOR TO MAP-SUBPOENA-OPID-L                      CL*42
02502         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02503  S2001-EXIT.                                                         CL*42
02504      EXIT.                                                           CL*42
02505 /*****************************************************************DTSCS42
02506 *                                                                 DTSCS42
02507 ******************************************************************DTSCS42
02508                                                                      CL*42
02509  S2100-CIVIL-ACTION-JUDGE-DATE.                                      CL**7
02510      MOVE MAP-CIVIL-ACTION-JUDGE-DATE TO L015-S-DATE-AREA.        DTSCS42
02511                                                                      CL*42
02512      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02513                                                                   DTSCS42
02514                                                                   DTSCS42
02515      IF L015-NO-ENTRY                                             DTSCS42
02516         GO TO S2100-EXIT                                             CL**7
02517      END-IF.                                                      DTSCS42
02518                                                                   DTSCS42
02519      IF L015-NOT-VALID                                            DTSCS42
02520         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*42
02521         PERFORM S2101-ERROR THRU S2101-EXIT.                         CL*42
02522  S2100-EXIT.                                                         CL*42
02523      EXIT.                                                           CL*42
02524                                                                      CL*42
02525                                                                      CL*42
02526                                                                      CL*42
02527  S2101-ERROR.                                                        CL**7
02528      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS42
02529        TO MAP-CIVIL-ACTION-JUDGE-MO-A                                CL*42
02530           MAP-CIVIL-ACTION-JUDGE-DA-A                                CL*42
02531           MAP-CIVIL-ACTION-JUDGE-YR-A.                               CL*42
02532                                                                      CL*42
02533      IF LCCM-NO-MSG                                               DTSCS42
02534         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02535         MOVE CATB-CURSOR TO MAP-CIVIL-ACTION-JUDGE-MO-L              CL*42
02536         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02537  S2101-EXIT.                                                         CL*42
02538      EXIT.                                                           CL*42
02539 /*****************************************************************DTSCS42
02540 *                                                                 DTSCS42
02541 ******************************************************************DTSCS42
02542                                                                      CL*42
02543  S2300-BNK-PETITION-DATE.                                            CL**7
02544      MOVE MAP-BNK-PETITION-DATE-AREA TO L015-S-DATE-AREA.         DTSCS42
02545                                                                      CL*42
02546      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02547                                                                   DTSCS42
02548      IF L015-NO-ENTRY                                             DTSCS42
02549         SET WRK-PETITION-IND-NO-88 TO TRUE                        DTSCS42
02550         GO TO S2300-EXIT                                             CL**7
02551      END-IF.                                                      DTSCS42
02552                                                                   DTSCS42
02553      SET WRK-PETITION-IND-YES-88 TO TRUE                          DTSCS42
02554                                                                   DTSCS42
02555      IF L015-NOT-VALID                                            DTSCS42
02556           OR L015-DATE > LCCM-CURR-RUN-DATE                          CL*42
02557         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL*42
02558         PERFORM S2301-ERROR THRU S2301-EXIT                          CL*42
02559      ELSE                                                         DTSCS42
02560 ********IF NOT MPRF-STATUS-INACT-88                               DTSCS42
02561 ***********SET WRK-PETITION-IND-NO-88 TO TRUE                        CL*42
02562 ***********MOVE MSG-E421-AREA TO WRK-MSG-AREA                        CL*42
02563 ***********PERFORM S2301-ERROR          THRU S2301-EXIT              CL*42
02564 ********ELSE                                                      DTSCS42
02565            MOVE L015-DATE TO WRK-START-DATE.                      DTSCS42
02566  S2300-EXIT.                                                         CL*42
02567      EXIT.                                                           CL*42
02568                                                                      CL*42
02569                                                                      CL*42
02570                                                                      CL*42
02571  S2301-ERROR.                                                        CL**7
02572      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-PETITION-MO-A     DTSCS42
02573                                         MAP-BNK-PETITION-DA-A     DTSCS42
02574                                         MAP-BNK-PETITION-YR-A.    DTSCS42
02575                                                                      CL*42
02576      IF LCCM-NO-MSG                                               DTSCS42
02577         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02578         MOVE CATB-CURSOR TO MAP-BNK-PETITION-MO-L                    CL*42
02579         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02580  S2301-EXIT.                                                         CL*42
02581      EXIT.                                                           CL*42
02582 /*****************************************************************   CL**7
02583 *                                                                    CL**7
02584 ******************************************************************   CL**7
02585                                                                      CL*42
02586  S2400-BNK-COURT-CASE-NO.                                            CL**7
02587      INSPECT MAP-BNK-COURT-CASE-NO CONVERTING                        CL**7
02588            LOW-VALUES TO SPACES.                                     CL**7
02589                                                                      CL**7
02590      IF MAP-BNK-COURT-CASE-NO = SPACES                               CL**7
02591          IF WRK-PETITION-IND-YES-88                                  CL**7
02592              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                CL**7
02593              PERFORM S2401-ERROR THRU S2401-EXIT                     CL**7
02594          ELSE                                                        CL**7
02595              NEXT SENTENCE                                           CL**7
02596      ELSE                                                            CL**7
02597          IF WRK-PETITION-IND-NO-88                                   CL**7
02598              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA             CL**7
02599              PERFORM S2401-ERROR THRU S2401-EXIT                     CL**7
02600          ELSE                                                        CL**7
02601              NEXT SENTENCE.                                          CL**7
02602  S2400-EXIT.                                                         CL*42
02603      EXIT.                                                           CL*42
02604                                                                      CL*42
02605                                                                      CL*42
02606                                                                      CL*42
02607  S2401-ERROR.                                                        CL**7
02608      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-BNK-COURT-CASE-NO-A.      CL*47
02609                                                                      CL*42
02610      IF LCCM-NO-MSG                                                  CL**7
02611         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02612         MOVE CATB-CURSOR TO MAP-BNK-COURT-CASE-NO-L                  CL*42
02613         SET CURSOR-SET-YES TO TRUE.                                  CL**7
02614  S2401-EXIT.                                                         CL*42
02615      EXIT.                                                           CL*42
02616 /*****************************************************************DTSCS42
02617 *                                                                 DTSCS42
02618 ******************************************************************DTSCS42
02619                                                                      CL*42
02620  S2500-BNK-CHAPTER.                                               DTSCS42
02621      INSPECT MAP-BNK-CHAPTER CONVERTING                           DTSCS42
02622            LOW-VALUES TO SPACES.                                  DTSCS42
02623                                                                   DTSCS42
02624      MOVE MAP-BNK-CHAPTER TO L034-CD.                             DTSCS42
02625                                                                   DTSCS42
02626      PERFORM S034-MCOL-BNK-CHAPTER THRU S034-EXIT.                DTSCS42
02627                                                                      CL*42
02628      IF L034-NOT-VALID                                            DTSCS42
02629         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS42
02630         PERFORM S2501-ERROR THRU S2501-EXIT                       DTSCS42
02631      ELSE                                                         DTSCS42
02632         IF WRK-PETITION-IND-NO-88                                 DTSCS42
02633            IF MAP-BNK-CHAPTER = SPACES                            DTSCS42
02634               NEXT SENTENCE                                       DTSCS42
02635            ELSE                                                   DTSCS42
02636               MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA         DTSCS42
02637               PERFORM S2501-ERROR THRU S2501-EXIT                 DTSCS42
02638         ELSE                                                      DTSCS42
02639           IF MAP-BNK-CHAPTER = SPACES                             DTSCS42
02640              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS42
02641              PERFORM S2501-ERROR THRU S2501-EXIT.                 DTSCS42
02642  S2500-EXIT.                                                         CL*42
02643      EXIT.                                                           CL*42
02644                                                                      CL*42
02645                                                                      CL*42
02646                                                                      CL*42
02647  S2501-ERROR.                                                     DTSCS42
02648      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-BNK-CHAPTER-A.         DTSCS42
02649                                                                      CL*42
02650      IF LCCM-NO-MSG                                               DTSCS42
02651         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02652         MOVE CATB-CURSOR TO MAP-BNK-CHAPTER-L                        CL*42
02653         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02654  S2501-EXIT.                                                         CL*42
02655      EXIT.                                                           CL*42
02656 /*****************************************************************DTSCS42
02657 *                                                                 DTSCS42
02658 ******************************************************************DTSCS42
02659                                                                      CL*42
02660  S2600-BNK-POC-REQUIRED-DATE.                                     DTSCS42
02661      MOVE MAP-BNK-POC-REQUIRED-DATE-AREA TO L015-S-DATE-AREA.     DTSCS42
02662                                                                      CL*42
02663      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02664                                                                   DTSCS42
02665      IF L015-NO-ENTRY                                             DTSCS42
02666         SET WRK-POC-REQ-IND-NO-88 TO TRUE                         DTSCS42
02667         GO TO S2600-EXIT                                          DTSCS42
02668      END-IF.                                                      DTSCS42
02669                                                                   DTSCS42
02670      SET WRK-POC-REQ-IND-YES-88 TO TRUE.                          DTSCS42
02671                                                                   DTSCS42
02672      IF WRK-PETITION-IND-NO-88                                    DTSCS42
02673         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA                  CL*42
02674         PERFORM S2601-ERROR THRU S2601-EXIT                          CL*42
02675      ELSE                                                         DTSCS42
02676         IF L015-NOT-VALID                                         DTSCS42
02677            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 CL*42
02678            PERFORM S2601-ERROR THRU S2601-EXIT                       CL*42
02679         ELSE                                                      DTSCS42
02680            PERFORM S2610-CROSS-EDITS THRU S2610-EXIT.             DTSCS42
02681  S2600-EXIT.                                                         CL*42
02682      EXIT.                                                           CL*42
02683                                                                      CL*42
02684                                                                      CL*42
02685                                                                      CL*42
02686  S2601-ERROR.                                                     DTSCS42
02687      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-POC-REQUIRED-MO-A DTSCS42
02688                                         MAP-BNK-POC-REQUIRED-DA-A DTSCS42
02689                                         MAP-BNK-POC-REQUIRED-YR-A.DTSCS42
02690                                                                      CL*42
02691      IF LCCM-NO-MSG                                               DTSCS42
02692         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02693         MOVE CATB-CURSOR TO MAP-BNK-POC-REQUIRED-MO-L                CL*42
02694         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02695  S2601-EXIT.                                                         CL*42
02696      EXIT.                                                           CL*42
02697                                                                      CL*42
02698                                                                      CL*42
02699                                                                      CL*42
02700  S2610-CROSS-EDITS.                                               DTSCS42
02701      IF L015-DATE > WRK-START-DATE                                DTSCS42
02702          NEXT SENTENCE                                            DTSCS42
02703      ELSE                                                         DTSCS42
02704          MOVE MSG-E421-AREA TO WRK-MSG-AREA                       DTSCS42
02705          PERFORM S2601-ERROR THRU S2601-EXIT.                     DTSCS42
02706  S2610-EXIT.                                                         CL*42
02707      EXIT.                                                           CL*42
02708 /*****************************************************************DTSCS42
02709 *                                                                 DTSCS42
02710 ******************************************************************DTSCS42
02711  S2700-BNK-POC-FILED-DATE.                                        DTSCS42
02712      MOVE MAP-BNK-POC-FILED-DATE-AREA TO L015-S-DATE-AREA.        DTSCS42
02713                                                                      CL*42
02714      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02715                                                                   DTSCS42
02716      IF L015-NO-ENTRY                                             DTSCS42
02717         GO TO S2700-EXIT                                          DTSCS42
02718      END-IF.                                                         CL*42
02719                                                                   DTSCS42
02720      IF WRK-PETITION-IND-NO-88                                    DTSCS42
02721         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA                  CL*42
02722         PERFORM S2701-ERROR THRU S2701-EXIT                          CL*42
02723      ELSE                                                         DTSCS42
02724         IF L015-NOT-VALID                                         DTSCS42
02725            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 CL*42
02726            PERFORM S2701-ERROR THRU S2701-EXIT                       CL*42
02727         ELSE                                                      DTSCS42
02728            PERFORM S2710-CROSS-EDITS THRU S2710-EXIT.             DTSCS42
02729  S2700-EXIT.                                                         CL*42
02730      EXIT.                                                           CL*42
02731                                                                      CL*42
02732                                                                      CL*42
02733                                                                      CL*42
02734  S2701-ERROR.                                                     DTSCS42
02735      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-POC-FILED-MO-A    DTSCS42
02736                                         MAP-BNK-POC-FILED-DA-A    DTSCS42
02737                                         MAP-BNK-POC-FILED-YR-A.   DTSCS42
02738                                                                      CL*42
02739      IF LCCM-NO-MSG                                               DTSCS42
02740         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02741         MOVE CATB-CURSOR TO MAP-BNK-POC-FILED-MO-L                   CL*42
02742         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02743  S2701-EXIT.                                                         CL*42
02744      EXIT.                                                           CL*42
02745                                                                      CL*42
02746                                                                      CL*42
02747                                                                      CL*42
02748  S2710-CROSS-EDITS.                                               DTSCS42
02749      IF L015-DATE > WRK-START-DATE                                DTSCS42
02750          NEXT SENTENCE                                            DTSCS42
02751      ELSE                                                         DTSCS42
02752          MOVE MSG-E422-AREA TO WRK-MSG-AREA                       DTSCS42
02753          PERFORM S2701-ERROR THRU S2701-EXIT                      DTSCS42
02754          GO TO S2710-EXIT.                                        DTSCS42
02755                                                                   DTSCS42
02756      IF L015-DATE <= LCCM-CURR-RUN-DATE                           DTSCS42
02757          NEXT SENTENCE                                            DTSCS42
02758      ELSE                                                         DTSCS42
02759          MOVE MSG-E423-AREA TO WRK-MSG-AREA                       DTSCS42
02760          PERFORM S2701-ERROR THRU S2701-EXIT                      DTSCS42
02761          GO TO S2710-EXIT.                                        DTSCS42
02762  S2710-EXIT.                                                         CL*42
02763      EXIT.                                                           CL*42
02764 /*****************************************************************DTSCS42
02765 *                                                                 DTSCS42
02766 ******************************************************************DTSCS42
02767                                                                      CL*42
02768  S2800-BNK-CHAPTER-CHNG-DATE.                                     DTSCS42
02769      MOVE MAP-BNK-CHAPTER-CHNG-DATE-AREA TO L015-S-DATE-AREA.     DTSCS42
02770                                                                      CL*42
02771      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02772                                                                   DTSCS42
02773      IF L015-NO-ENTRY                                             DTSCS42
02774         GO TO S2800-EXIT                                          DTSCS42
02775      END-IF.                                                         CL*42
02776                                                                   DTSCS42
02777      IF WRK-PETITION-IND-NO-88                                    DTSCS42
02778         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA                  CL*42
02779         PERFORM S2801-ERROR THRU S2801-EXIT                          CL*42
02780      ELSE                                                         DTSCS42
02781         IF L015-NOT-VALID                                         DTSCS42
02782            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 CL*42
02783            PERFORM S2801-ERROR THRU S2801-EXIT.                      CL*42
02784  S2800-EXIT.                                                         CL*42
02785      EXIT.                                                           CL*42
02786                                                                      CL*42
02787                                                                      CL*42
02788                                                                      CL*42
02789  S2801-ERROR.                                                     DTSCS42
02790      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-CHAPTER-CHNG-MO-A DTSCS42
02791                                         MAP-BNK-CHAPTER-CHNG-DA-A DTSCS42
02792                                         MAP-BNK-CHAPTER-CHNG-YR-A.DTSCS42
02793                                                                      CL*42
02794      IF LCCM-NO-MSG                                               DTSCS42
02795         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02796         MOVE CATB-CURSOR TO MAP-BNK-CHAPTER-CHNG-MO-L                CL*42
02797         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02798  S2801-EXIT.                                                         CL*42
02799      EXIT.                                                           CL*42
02800 /*****************************************************************DTSCS42
02801 *                                                                 DTSCS42
02802 ******************************************************************DTSCS42
02803                                                                      CL*42
02804  S2900-BNK-LAST-COMM-DATE.                                        DTSCS42
02805      MOVE MAP-BNK-LAST-COMM-DATE-AREA TO L015-S-DATE-AREA.        DTSCS42
02806                                                                      CL*42
02807      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02808                                                                   DTSCS42
02809      IF L015-NO-ENTRY                                             DTSCS42
02810          GO TO S2900-EXIT                                         DTSCS42
02811      END-IF.                                                      DTSCS42
02812                                                                   DTSCS42
02813      IF WRK-PETITION-IND-NO-88                                    DTSCS42
02814          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              DTSCS42
02815          PERFORM S2901-ERROR THRU S2901-EXIT                      DTSCS42
02816      ELSE                                                         DTSCS42
02817          IF L015-NOT-VALID                                        DTSCS42
02818              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS42
02819              PERFORM S2901-ERROR THRU S2901-EXIT                  DTSCS42
02820          ELSE                                                     DTSCS42
02821              PERFORM S2910-CROSS-EDITS THRU S2910-EXIT.           DTSCS42
02822  S2900-EXIT.                                                         CL*42
02823      EXIT.                                                           CL*42
02824                                                                      CL*42
02825                                                                      CL*42
02826                                                                      CL*42
02827  S2901-ERROR.                                                     DTSCS42
02828      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-LAST-COMM-MO-A    DTSCS42
02829                                         MAP-BNK-LAST-COMM-DA-A    DTSCS42
02830                                         MAP-BNK-LAST-COMM-YR-A.   DTSCS42
02831                                                                      CL*42
02832      IF LCCM-NO-MSG                                               DTSCS42
02833         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02834         MOVE CATB-CURSOR TO MAP-BNK-LAST-COMM-MO-L                   CL*42
02835         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02836  S2901-EXIT.                                                         CL*42
02837      EXIT.                                                           CL*42
02838                                                                      CL*42
02839                                                                      CL*42
02840                                                                      CL*42
02841  S2910-CROSS-EDITS.                                               DTSCS42
02842      IF L015-DATE > WRK-START-DATE                                DTSCS42
02843          NEXT SENTENCE                                            DTSCS42
02844      ELSE                                                         DTSCS42
02845          MOVE MSG-E428-AREA TO WRK-MSG-AREA                       DTSCS42
02846          PERFORM S2901-ERROR THRU S2901-EXIT                      DTSCS42
02847          GO TO S2910-EXIT.                                        DTSCS42
02848                                                                   DTSCS42
02849      IF L015-DATE <= LCCM-CURR-RUN-DATE                           DTSCS42
02850          NEXT SENTENCE                                            DTSCS42
02851      ELSE                                                         DTSCS42
02852          MOVE MSG-E429-AREA TO WRK-MSG-AREA                       DTSCS42
02853          PERFORM S2901-ERROR THRU S2901-EXIT                      DTSCS42
02854          GO TO S2910-EXIT.                                        DTSCS42
02855  S2910-EXIT.                                                         CL*42
02856      EXIT.                                                           CL*42
02857 /*****************************************************************DTSCS42
02858 *                                                                 DTSCS42
02859 ******************************************************************DTSCS42
02860                                                                      CL*42
02861  S3000-BNK-DISCHRG-CLOSE-DATE.                                    DTSCS42
02862      MOVE MAP-BNK-DISCHRG-DATE-AREA TO L015-S-DATE-AREA.          DTSCS42
02863                                                                      CL*42
02864      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02865                                                                   DTSCS42
02866      IF L015-NO-ENTRY                                             DTSCS42
02867         SET WRK-DISCHRG-IND-NO-88 TO TRUE                         DTSCS42
02868         GO TO S3000-EXIT                                          DTSCS42
02869      END-IF.                                                      DTSCS42
02870                                                                   DTSCS42
02871      SET WRK-DISCHRG-IND-YES-88 TO TRUE.                          DTSCS42
02872                                                                   DTSCS42
02873      IF WRK-PETITION-IND-NO-88                                    DTSCS42
02874         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA                  CL*42
02875         PERFORM S3001-ERROR THRU S3001-EXIT                          CL*42
02876      ELSE                                                         DTSCS42
02877         IF L015-NOT-VALID                                         DTSCS42
02878            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 CL*42
02879            PERFORM S3001-ERROR THRU S3001-EXIT                       CL*42
02880         ELSE                                                      DTSCS42
02881            PERFORM S3010-CROSS-EDITS THRU S3010-EXIT.             DTSCS42
02882  S3000-EXIT.                                                         CL*42
02883      EXIT.                                                           CL*42
02884                                                                      CL*42
02885                                                                      CL*42
02886                                                                      CL*42
02887  S3001-ERROR.                                                     DTSCS42
02888      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS42
02889        TO MAP-BNK-DISCHRG-CLOSE-MO-A                              DTSCS42
02890           MAP-BNK-DISCHRG-CLOSE-DA-A                              DTSCS42
02891           MAP-BNK-DISCHRG-CLOSE-YR-A.                             DTSCS42
02892                                                                      CL*42
02893      IF LCCM-NO-MSG                                               DTSCS42
02894         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02895         MOVE CATB-CURSOR TO MAP-BNK-DISCHRG-CLOSE-MO-L               CL*42
02896         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02897  S3001-EXIT.                                                         CL*42
02898      EXIT.                                                           CL*42
02899                                                                      CL*42
02900                                                                      CL*42
02901                                                                      CL*42
02902  S3010-CROSS-EDITS.                                               DTSCS42
02903      IF L015-DATE > WRK-START-DATE                                DTSCS42
02904          NEXT SENTENCE                                            DTSCS42
02905      ELSE                                                         DTSCS42
02906          MOVE MSG-E424-AREA TO WRK-MSG-AREA                       DTSCS42
02907          PERFORM S3001-ERROR THRU S3001-EXIT                      DTSCS42
02908          GO TO S3010-EXIT.                                        DTSCS42
02909                                                                   DTSCS42
02910      IF L015-DATE <= LCCM-CURR-RUN-DATE                           DTSCS42
02911          NEXT SENTENCE                                            DTSCS42
02912      ELSE                                                         DTSCS42
02913          MOVE MSG-E425-AREA TO WRK-MSG-AREA                       DTSCS42
02914          PERFORM S3001-ERROR THRU S3001-EXIT                      DTSCS42
02915          GO TO S3010-EXIT.                                        DTSCS42
02916                                                                   DTSCS42
02917      MOVE L015-DATE TO WRK-END-DATE.                              DTSCS42
02918  S3010-EXIT.                                                         CL*42
02919      EXIT.                                                           CL*42
02920 /*****************************************************************DTSCS42
02921 *                                                                 DTSCS42
02922 ******************************************************************DTSCS42
02923                                                                      CL*42
02924  S3100-BNK-DISMISS-DATE.                                          DTSCS42
02925      MOVE MAP-BNK-DISMISS-DATE-AREA TO L015-S-DATE-AREA.          DTSCS42
02926                                                                      CL*42
02927      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS42
02928                                                                   DTSCS42
02929      IF L015-NO-ENTRY                                             DTSCS42
02930         GO TO S3100-EXIT                                          DTSCS42
02931      END-IF.                                                      DTSCS42
02932                                                                   DTSCS42
02933      IF WRK-PETITION-IND-NO-88                                    DTSCS42
02934         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA                  CL*42
02935         PERFORM S3101-ERROR THRU S3101-EXIT                          CL*42
02936      ELSE                                                         DTSCS42
02937      IF WRK-DISCHRG-IND-YES-88                                    DTSCS42
02938         MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                      DTSCS42
02939         PERFORM S3001-ERROR THRU S3001-EXIT                       DTSCS42
02940         PERFORM S3101-ERROR THRU S3101-EXIT                       DTSCS42
02941      ELSE                                                         DTSCS42
02942         IF L015-NOT-VALID                                         DTSCS42
02943            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 CL*42
02944            PERFORM S3101-ERROR THRU S3101-EXIT                       CL*42
02945         ELSE                                                      DTSCS42
02946            PERFORM S3110-CROSS-EDITS THRU S3110-EXIT.             DTSCS42
02947  S3100-EXIT.                                                         CL*42
02948      EXIT.                                                           CL*42
02949                                                                      CL*42
02950                                                                      CL*42
02951                                                                      CL*42
02952  S3101-ERROR.                                                     DTSCS42
02953      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-DISMISS-MO-A      DTSCS42
02954                                         MAP-BNK-DISMISS-DA-A      DTSCS42
02955                                         MAP-BNK-DISMISS-YR-A.     DTSCS42
02956                                                                      CL*42
02957      IF LCCM-NO-MSG                                               DTSCS42
02958         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*42
02959         MOVE CATB-CURSOR TO MAP-BNK-DISMISS-MO-L                     CL*42
02960         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
02961  S3101-EXIT.                                                         CL*42
02962      EXIT.                                                           CL*42
02963                                                                      CL*42
02964                                                                      CL*42
02965                                                                      CL*42
02966  S3110-CROSS-EDITS.                                               DTSCS42
02967      IF L015-DATE > WRK-START-DATE                                DTSCS42
02968          NEXT SENTENCE                                            DTSCS42
02969      ELSE                                                         DTSCS42
02970          MOVE MSG-E426-AREA TO WRK-MSG-AREA                       DTSCS42
02971          PERFORM S3101-ERROR THRU S3101-EXIT                      DTSCS42
02972          GO TO S3110-EXIT.                                        DTSCS42
02973                                                                   DTSCS42
02974      IF L015-DATE <= LCCM-CURR-RUN-DATE                           DTSCS42
02975          NEXT SENTENCE                                            DTSCS42
02976      ELSE                                                         DTSCS42
02977          MOVE MSG-E427-AREA TO WRK-MSG-AREA                       DTSCS42
02978          PERFORM S3101-ERROR THRU S3101-EXIT                      DTSCS42
02979          GO TO S3110-EXIT.                                        DTSCS42
02980                                                                   DTSCS42
02981      MOVE L015-DATE TO WRK-END-DATE.                              DTSCS42
02982  S3110-EXIT.                                                         CL*42
02983      EXIT.                                                           CL*42
02984 /*****************************************************************DTSCS42
02985 *                                                                 DTSCS42
02986 ******************************************************************DTSCS42
02987                                                                      CL*43
02988  S3200-STMT-TEXT.                                                    CL**7
02989      MOVE +0 TO MCOL-STMT-TEXT-CNT.                                  CL**7
02990                                                                      CL*43
02991      PERFORM                                                      DTSCS42
02992        VARYING WRK-OCC FROM 1 BY 1                                   CL*43
02993        UNTIL WRK-OCC > MMAX-COL-TEXT-MAX                          DTSCS42
02994          INSPECT MAP-STMT-TEXT(WRK-OCC) CONVERTING                   CL*43
02995          LOW-VALUES TO SPACES                                        CL*43
02996          IF MAP-STMT-TEXT(WRK-OCC) NOT = SPACES                      CL*43
02997             MOVE WRK-OCC TO MCOL-STMT-TEXT-CNT                       CL*43
02998          END-IF                                                   DTSCS42
02999      END-PERFORM.                                                 DTSCS42
03000  S3200-EXIT.                                                         CL*43
03001      EXIT.                                                           CL*43
03002                                                                      CL*44
03003 /*****************************************************************DTSCS42
03004 *                                                                 DTSCS42
03005 ******************************************************************DTSCS42
03006                                                                      CL*44
03007  S3300-STMT-TYPE.                                                    CL*10
03008      IF MAP-STMT-TYPE = LOW-VALUES OR SPACES                         CL*10
03009         MOVE SPACES TO MAP-STMT-TYPE                                 CL*10
03010      END-IF.                                                      DTSCS42
03011                                                                   DTSCS42
03012      IF NOT MAP-STMT-TYPE-VALID                                      CL*10
03013         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS42
03014         PERFORM S3301-ERROR THRU S3301-EXIT                       DTSCS42
03015      ELSE                                                         DTSCS42
03016      IF (MAP-STMT-TYPE = ' ')                                        CL*10
03017           AND (MCOL-STMT-TEXT-CNT > +0)                              CL*44
03018         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS42
03019         PERFORM S3301-ERROR THRU S3301-EXIT                       DTSCS42
03020      ELSE                                                         DTSCS42
03021      IF (MAP-STMT-TYPE NOT = ' ')                                    CL*10
03022           AND (MCOL-STMT-TEXT-CNT = +0)                              CL*44
03023         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS42
03024         PERFORM S3301-ERROR THRU S3301-EXIT.                      DTSCS42
03025  S3300-EXIT.                                                         CL*44
03026      EXIT.                                                           CL*44
03027                                                                      CL*44
03028                                                                      CL*44
03029                                                                      CL*44
03030  S3301-ERROR.                                                     DTSCS42
03031      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STMT-TYPE-A.              CL*10
03032                                                                      CL*44
03033      IF LCCM-NO-MSG                                               DTSCS42
03034         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*44
03035         MOVE CATB-CURSOR TO MAP-STMT-TYPE-L                          CL*44
03036         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
03037  S3301-EXIT.                                                         CL*44
03038      EXIT.                                                           CL*44
03039 /*****************************************************************DTSCS42
03040 *                                                                 DTSCS42
03041 ******************************************************************DTSCS42
03042                                                                      CL*44
03043  S3400-STMT-PERMANENT-IND.                                           CL*10
03044      IF MAP-STMT-PERMANENT-IND = LOW-VALUES OR SPACES                CL*10
03045         MOVE SPACE TO MAP-STMT-PERMANENT-IND                         CL*10
03046      END-IF.                                                      DTSCS42
03047                                                                   DTSCS42
03048      IF NOT MAP-STMT-PERMANENT-VALID                                 CL*10
03049         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS42
03050         PERFORM S3401-ERROR THRU S3401-EXIT                       DTSCS42
03051      ELSE                                                         DTSCS42
03052      IF (MAP-STMT-PERMANENT-IND = ' ')                               CL*10
03053      AND (MCOL-STMT-TEXT-CNT > +0)                                   CL**7
03054         MOVE 'N' TO MAP-STMT-PERMANENT-IND                           CL*10
03055      ELSE                                                         DTSCS42
03056      IF (MAP-STMT-PERMANENT-IND NOT = ' ')                           CL*10
03057      AND (MCOL-STMT-TEXT-CNT = +0)                                   CL**7
03058         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS42
03059         PERFORM S3401-ERROR THRU S3401-EXIT.                      DTSCS42
03060  S3400-EXIT.                                                         CL*44
03061      EXIT.                                                           CL*44
03062                                                                      CL*44
03063                                                                      CL*44
03064                                                                      CL*44
03065  S3401-ERROR.                                                     DTSCS42
03066      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STMT-PERMANENT-IND-A.     CL*10
03067                                                                      CL*45
03068      IF LCCM-NO-MSG                                               DTSCS42
03069         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*45
03070         MOVE CATB-CURSOR TO MAP-STMT-PERMANENT-IND-L                 CL*45
03071         SET CURSOR-SET-YES TO TRUE.                               DTSCS42
03072  S3401-EXIT.                                                         CL*45
03073      EXIT.                                                           CL*45
03074 /*****************************************************************DTSCS42
03075 *                                                                 DTSCS42
03076 ******************************************************************DTSCS42
03077                                                                      CL*45
03078 *S3500-MISC-EDITS.                                                DTSCS42
03079 *****IF WRK-PETITION-IND-NO-88                                    DTSCS42
03080 ********GO TO S3500-EXIT                                             CL*45
03081 *****END-IF.                                                      DTSCS42
03082                                                                      CL*45
03083 *****MOVE LOW-VALUES      TO MSOL-KEY-AREA.                       DTSCS42
03084 *****MOVE WRK-EMP-NO      TO MSOL-EMP-NO.                         DTSCS42
03085 *****SET  MSOL-SOL-88     TO TRUE.                                DTSCS42
03086 *****MOVE +0              TO MSOL-LIAB-DATE.                      DTSCS42
03087 *****MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS42
03088                                                                      CL*45
03089 *****PERFORM S810-START-BROWSE THRU S810-EXIT                     DTSCS42
03090                                                                      CL*45
03091 *****SET WRK-OVERLAP-NO-88 TO TRUE.                               DTSCS42
03092                                                                      CL*45
03093 *****PERFORM S3510-MSOL-SCAN THRU S3510-EXIT                      DTSCS42
03094 *******UNTIL L810-NO-REC-88.                                         CL*45
03095                                                                      CL*45
03096 *****IF WRK-OVERLAP-YES-88                                        DTSCS42
03097 ********MOVE MSG-E422-AREA TO WRK-MSG-AREA                           CL*45
03098 ********PERFORM S2401-ERROR          THRU S2401-EXIT                 CL*45
03099 *****END-IF.                                                      DTSCS42
03100 *S3500-EXIT. EXIT.                                                DTSCS42
03101                                                                      CL*45
03102 *S3510-MSOL-SCAN.                                                 DTSCS42
03103 *****MOVE MSKL-REC TO MSOL-REC.                                   DTSCS42
03104                                                                      CL*45
03105 *****IF MSOL-INACT-WITHDRAWN-88                                   DTSCS42
03106 *********NEXT SENTENCE                                               CL*45
03107 *****ELSE                                                         DTSCS42
03108 *****IF (WRK-END-DATE < MSOL-LIAB-DATE)                           DTSCS42
03109 *************OR                                                      CL*45
03110 ********(WRK-START-DATE > MSOL-INACT-DATE)                           CL*45
03111 *********NEXT SENTENCE                                               CL*45
03112 *****ELSE                                                         DTSCS42
03113 *********SET WRK-OVERLAP-YES-88 TO TRUE.                             CL*45
03114                                                                      CL*45
03115 *****PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS42
03116 *S3510-EXIT.                                                      DTSCS42
03117 *****EXIT.                                                        DTSCS42
03118 /*****************************************************************DTSCS42
03119 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS42
03120 ******************************************************************DTSCS42
03121                                                                      CL*45
03122  S5100-SET-LOCK-ATTRB.                                            DTSCS42
03123      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS42
03124                                   WRK-ATB-NUM.                       CL*45
03125                                                                   DTSCS42
03126      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS42
03127                                                                   DTSCS42
03128      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS42
03129                                   MAP-EMP-NO-2-A                     CL*45
03130                                   MAP-GOTO-A.                        CL*45
03131  S5100-EXIT.                                                      DTSCS42
03132      EXIT.                                                        DTSCS42
03133                                                                   DTSCS42
03134                                                                      CL*45
03135                                                                      CL*45
03136 ******************************************************************DTSCS42
03137 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS42
03138 ******************************************************************DTSCS42
03139                                                                      CL*45
03140  S5200-SET-UPDATE-ATTRB.                                          DTSCS42
03141      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS42
03142                                                                      CL*45
03143      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS42
03144                                                                   DTSCS42
03145      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS42
03146  S5200-EXIT.                                                      DTSCS42
03147      EXIT.                                                        DTSCS42
03148                                                                   DTSCS42
03149                                                                      CL*45
03150                                                                      CL*45
03151 ******************************************************************DTSCS42
03152 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS42
03153 ******************************************************************DTSCS42
03154                                                                      CL*45
03155  S5300-SET-INQ-ATTRB.                                             DTSCS42
03156      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS42
03157                                    WRK-ATB-NUM.                   DTSCS42
03158                                                                   DTSCS42
03159      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS42
03160  S5300-EXIT.                                                      DTSCS42
03161      EXIT.                                                        DTSCS42
03162                                                                   DTSCS42
03163                                                                      CL*45
03164                                                                      CL*45
03165  S5900-SET-ATTRB.                                                 DTSCS42
03166      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS42
03167                                        MAP-EMP-NO-2-A.            DTSCS42
03168                                                                   DTSCS42
03169      MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A                 CL**9
03170                                   MAP-EMP-CLASS-A                 DTSCS42
03171                                   MAP-EMP-STATUS-A                DTSCS42
03172                                   MAP-WRITEOFF-DATE-A                CL**7
03173                                   MAP-BANKRUPTCY-OPEN-IND-A       DTSCS42
03174                                   MAP-VOICE-1-AREA-CD-A              CL**4
03175                                   MAP-VOICE-1-PREFIX-A               CL**4
03176                                   MAP-VOICE-1-SUFFIX-A               CL**4
03177                                   MAP-VOICE-1-EXT-A                  CL*47
03178                                   MAP-FLD-REP-ID-A.               DTSCS42
03179                                                                   DTSCS42
03180      MOVE CATB-ASKIP-NORM-MDTON TO MAP-FLD-REP-ID-DSCR-A.         DTSCS42
03181                                                                   DTSCS42
03182      MOVE WRK-ATB-NUM TO                                          DTSCS42
03183              MAP-BNK-PETITION-MO-A                                DTSCS42
03184              MAP-BNK-PETITION-DA-A                                DTSCS42
03185              MAP-BNK-PETITION-YR-A                                DTSCS42
03186              MAP-BNK-CHAPTER-CHNG-MO-A                            DTSCS42
03187              MAP-BNK-CHAPTER-CHNG-DA-A                            DTSCS42
03188              MAP-BNK-CHAPTER-CHNG-YR-A                            DTSCS42
03189              MAP-BNK-DISCHRG-CLOSE-MO-A                           DTSCS42
03190              MAP-BNK-DISCHRG-CLOSE-DA-A                           DTSCS42
03191              MAP-BNK-DISCHRG-CLOSE-YR-A                           DTSCS42
03192              MAP-BNK-POC-REQUIRED-MO-A                            DTSCS42
03193              MAP-BNK-POC-REQUIRED-DA-A                            DTSCS42
03194              MAP-BNK-POC-REQUIRED-YR-A                            DTSCS42
03195              MAP-BNK-CHAPTER-A                                    DTSCS42
03196              MAP-BNK-DISMISS-MO-A                                 DTSCS42
03197              MAP-BNK-DISMISS-DA-A                                 DTSCS42
03198              MAP-BNK-DISMISS-YR-A                                 DTSCS42
03199              MAP-BNK-POC-FILED-MO-A                               DTSCS42
03200              MAP-BNK-POC-FILED-DA-A                               DTSCS42
03201              MAP-BNK-POC-FILED-YR-A                               DTSCS42
03202              MAP-BNK-LAST-COMM-MO-A                               DTSCS42
03203              MAP-BNK-LAST-COMM-DA-A                               DTSCS42
03204              MAP-BNK-LAST-COMM-YR-A                               DTSCS42
03205              MAP-CIVIL-ACTION-BEGIN-DA-A                          DTSCS42
03206              MAP-CIVIL-ACTION-BEGIN-MO-A                          DTSCS42
03207              MAP-CIVIL-ACTION-BEGIN-YR-A                          DTSCS42
03208              MAP-CIVIL-ACTION-JUDGE-DA-A                          DTSCS42
03209              MAP-CIVIL-ACTION-JUDGE-MO-A                          DTSCS42
03210              MAP-CIVIL-ACTION-JUDGE-YR-A                          DTSCS42
03211              MAP-SUBPOENA-DA-A                                    DTSCS42
03212              MAP-SUBPOENA-MO-A                                    DTSCS42
03213              MAP-SUBPOENA-YR-A                                    DTSCS42
03214              MAP-FINAL-NOTICE-DA-A                                DTSCS42
03215              MAP-FINAL-NOTICE-MO-A                                DTSCS42
03216              MAP-FINAL-NOTICE-YR-A                                DTSCS42
03217              MAP-LEGAL-REF-DA-A                                      CL**7
03218              MAP-LEGAL-REF-MO-A                                      CL**7
03219              MAP-LEGAL-REF-YR-A.                                     CL**7
03220                                                                   DTSCS42
03221      MOVE WRK-ATB-AN TO                                           DTSCS42
03222                         MAP-BNK-COURT-CASE-NO-A                   DTSCS42
03223                         MAP-SUBPOENA-CD-A                         DTSCS42
03224                         MAP-SUBPOENA-OPID-A                          CL**8
03225                         MAP-SUSPEND-IND-A                            CL*23
03226                         MAP-STMT-TYPE-A                              CL*10
03227                         MAP-STMT-PERMANENT-IND-A                     CL*10
03228                         MAP-MAIL-DB-MEMO-IND-A                       CL*14
03229                         MAP-MAIL-MISS-RPT-IND-A                      CL*14
03230                         MAP-PHYS-DB-MEMO-IND-A                       CL*14
03231                         MAP-PHYS-MISS-RPT-IND-A.                     CL*14
03232                                                                   DTSCS42
03233      PERFORM VARYING WRK-OCC                                      DTSCS42
03234         FROM 1 BY 1                                               DTSCS42
03235         UNTIL WRK-OCC > MMAX-COL-TEXT-MAX                         DTSCS42
03236              MOVE WRK-ATB-AN TO                                   DTSCS42
03237              MAP-STMT-TEXT-A(WRK-OCC)                                CL*10
03238      END-PERFORM.                                                 DTSCS42
03239                                                                   DTSCS42
03240      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS42
03241  S5900-EXIT.                                                      DTSCS42
03242      EXIT.                                                        DTSCS42
03243      EJECT                                                        DTSCS42
03244 /*****************************************************************DTSCS42
03245 * MAP ROUTINES                                                   *DTSCS42
03246 ******************************************************************DTSCS42
03247                                                                      CL*45
03248  S9100-RECEIVE.                                                   DTSCS42
03249      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS42
03250                                                                   DTSCS42
03251      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS42
03252                                                                   DTSCS42
03253      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS42
03254                                                                   DTSCS42
03255      MOVE L851-AID TO LCCM-AID.                                   DTSCS42
03256                                                                      CL*45
03257      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS42
03258  S9100-EXIT.                                                      DTSCS42
03259      EXIT.                                                        DTSCS42
03260                                                                   DTSCS42
03261                                                                      CL*45
03262                                                                      CL*45
03263  S9200-SEND-DATAONLY.                                             DTSCS42
03264      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS42
03265                                                                   DTSCS42
03266      IF LCCM-NO-MSG                                               DTSCS42
03267          NEXT SENTENCE                                            DTSCS42
03268      ELSE                                                         DTSCS42
03269          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS42
03270                                                                   DTSCS42
03271      IF CURSOR-SET-GOTO                                           DTSCS42
03272          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS42
03273      ELSE                                                         DTSCS42
03274          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS42
03275                                                                   DTSCS42
03276      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS42
03277                                                                   DTSCS42
03278      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS42
03279                                                                   DTSCS42
03280      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS42
03281  S9200-EXIT.                                                      DTSCS42
03282      EXIT.                                                        DTSCS42
03283                                                                   DTSCS42
03284                                                                      CL*45
03285                                                                      CL*45
03286  S9300-SEND-MAP.                                                  DTSCS42
03287      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS42
03288                                                                      CL*45
03289      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCS42
03290                                                                      CL*45
03291      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS42
03292                                                                      CL*45
03293      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS42
03294                                                                   DTSCS42
03295      IF SCR-ACCESS-UPDATE                                         DTSCS42
03296          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS42
03297      ELSE                                                         DTSCS42
03298          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS42
03299                                                                   DTSCS42
03300      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS42
03301                                                                   DTSCS42
03302      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS42
03303                                                                   DTSCS42
03304      IF CURSOR-SET-NO                                             DTSCS42
03305          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS42
03306                                                                   DTSCS42
03307      SET L851-SEND-88 TO TRUE.                                    DTSCS42
03308                                                                   DTSCS42
03309      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS42
03310                                                                   DTSCS42
03311      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS42
03312  S9300-EXIT.                                                      DTSCS42
03313      EXIT.                                                        DTSCS42
03314                                                                   DTSCS42
03315                                                                      CL*45
03316                                                                      CL*45
03317  S9310-UPDATE-FKEYS.                                              DTSCS42
03318      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS42
03319                                                                   DTSCS42
03320      IF LCCM-SCR-INQUIRE                                          DTSCS42
03321          MOVE CFKD-MOD TO MAP-KEY-MOD.                            DTSCS42
03322  S9310-EXIT.                                                      DTSCS42
03323      EXIT.                                                        DTSCS42
03324                                                                   DTSCS42
03325                                                                      CL*45
03326                                                                      CL*45
03327  S9320-INQUIRY-FKEYS.                                             DTSCS42
03328      MOVE LOW-VALUES TO MAP-KEY-MOD.                              DTSCS42
03329                                                                   DTSCS42
03330 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                        CL*45
03331  S9320-EXIT.                                                      DTSCS42
03332      EXIT.                                                        DTSCS42
03333                                                                   DTSCS42
03334                                                                      CL*45
03335                                                                      CL*45
03336 *S9321-JUMP-KEYS.                                                    CL**7
03337 *****MOVE CFKD-QTR-INQ TO  MAP-KEY-QTR-INQ.                          CL*45
03338 *****MOVE CFKD-COLL-INQ TO  MAP-KEY-COLL-INQ.                        CL*45
03339 *S9321-EXIT.                                                         CL**7
03340 *****EXIT.                                                           CL*45
03341                                                                      CL*45
03342                                                                      CL*45
03343                                                                      CL*45
03344  S9330-DSCR-FIELDS.                                               DTSCS42
03345      IF WRK-MPRF-YES-88                                           DTSCS42
03346         PERFORM S9331-FROM-MPRF THRU S9331-EXIT                   DTSCS42
03347      END-IF.                                                      DTSCS42
03348  S9330-EXIT.                                                         CL*45
03349      EXIT.                                                           CL*45
03350                                                                      CL*45
03351                                                                      CL*45
03352                                                                      CL*45
03353  S9331-FROM-MPRF.                                                 DTSCS42
03354      MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME.                     CL**7
03355                                                                   DTSCS42
03356                                                                      CL*45
03357      MOVE MPRF-EMP-CLASS TO L031-CD.                              DTSCS42
03358                                                                      CL*45
03359      PERFORM S031-MPRF-EMP-CLASS THRU S031-EXIT.                  DTSCS42
03360                                                                      CL*45
03361      MOVE L031-SHORT-DSCR TO MAP-EMP-CLASS.                       DTSCS42
03362                                                                   DTSCS42
03363                                                                      CL*45
03364      MOVE MPRF-EMP-STATUS TO L031-CD.                             DTSCS42
03365                                                                      CL*45
03366      PERFORM S031-MPRF-EMP-STATUS THRU S031-EXIT.                 DTSCS42
03367                                                                      CL*45
03368      MOVE L031-SHORT-DSCR TO MAP-EMP-STATUS.                      DTSCS42
03369                                                                   DTSCS42
03370                                                                      CL*45
03371      MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP.                           DTSCS42
03372                                                                      CL*45
03373      MOVE MPRF-EMP-NO TO L061-EMP-NO.                             DTSCS42
03374                                                                      CL*45
03375      PERFORM S061-FLD-ZIP THRU S061-EXIT.                            CL*45
03376                                                                      CL*45
03377      MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID                       DTSCS42
03378                              L062-FLD-REP-ID.                     DTSCS42
03379                                                                      CL*45
03380      PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT.                 DTSCS42
03381                                                                      CL*45
03382      MOVE L062-NAME TO MAP-FLD-REP-ID-DSCR.                          CL*45
03383  S9331-EXIT.                                                      DTSCS42
03384      EXIT.                                                        DTSCS42
03385                                                                   DTSCS42
03386                                                                      CL*45
03387                                                                      CL*45
03388  S9900-PREPARE-SEND.                                              DTSCS42
03389      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS42
03390                         LCCM-SCR-ID.                              DTSCS42
03391                                                                      CL*45
03392      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS42
03393                                                                      CL*45
03394      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS42
03395  S9900-EXIT.                                                      DTSCS42
03396      EXIT.                                                        DTSCS42
