00001  IDENTIFICATION DIVISION.                                         02/07/12
00002  PROGRAM-ID.             DTSCS61.                                 DTSCS61
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV041
00004  DATE-WRITTEN.           MAY 1994.                                DTSCS61
00005  DATE-COMPILED.                                                   DTSCS61
00006      SKIP3                                                        DTSCS61
00007 *****                                                             DTSCS61
00008 *                                                                 DTSCS61
00009 *    FUNCTION:  FIELD ASSIGNMENT INITIATION                       DTSCS61
00010 *               SCREEN PROCESSOR.                                 DTSCS61
00011 *                                                                 DTSCS61
00012 *                                                                 DTSCS61
00013 *    MODIFICATION LOG:                                            DTSCS61
00014 *                                                                 DTSCS61
00015 *    11/11/98  INITIAL DEVELOPMENT.     COPIED FROM MACCS61       DTSCS61
00016 *              WORK ORDER:                      PROGRAMMER: ZL1   DTSCS61
00017 *                                                                 DTSCS61
00018 *                                                                 DTSCS61
00019 *    02/23/2000  ALLOW AN AUDIT ASSINMENT TO BE ATTACHED TO AN    DTSCS61
00020 *                MPRF-CLASS-UNK-88 EMPLOYER.                      DTSCS61
00021 *                REFERENCE: UIPL 03-99          PROGRAMMER: EHH   DTSCS61
00022 *                                                                 DTSCS61
00023 *                                                                 DTSCS61
00024 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS61
00025 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS61
00026 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS61
00027 *                                                                 DTSCS61
00028 *  DESCRIPTION:                                                   DTSCS61
00029 *                                                                 DTSCS61
00030 *                                                                 DTSCS61
00031 *    CLEAR:                                                       DTSCS61
00032 *                                                                 DTSCS61
00033 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS61
00034 *                                                                 DTSCS61
00035 *                                                                 DTSCS61
00036 *    JUMP:                                                        DTSCS61
00037 *                                                                 DTSCS61
00038 *      F17  REGISTRATION INQUIRY/UPDATE (11)                      DTSCS61
00039 *                                                                 DTSCS61
00040 *                                                                 DTSCS61
00041 *    INQUIRY:                                                     DTSCS61
00042 *                                                                 DTSCS61
00043 *      CONTROL FIELD: MAP-EMP-NO                                  DTSCS61
00044 *                                                                 DTSCS61
00045 *      JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS61
00046 *                                                                 DTSCS61
00047 *      ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO.   DTSCS61
00048 *                                                                 DTSCS61
00049 *      JUMP OUT: NO SPECIAL PROCESSING.                           DTSCS61
00050 *                                                                 DTSCS61
00051 *                                                                 DTSCS61
00052 *    LCCM DATA ELEMENT MAINTENANCE.                               DTSCS61
00053 *                                                                 DTSCS61
00054 *        STANDARD LCCM-EMP-NO MAINTENANCE.                        DTSCS61
00055 *                                                                 DTSCS61
00056 *        STANDARD LCCM-ASSIGN-NO MAINTENANCE.                     DTSCS61
00057 *                                                                 DTSCS61
00058 *        STANDARD LCCM-RESP-OP-ID MAINTENANCE.                    DTSCS61
00059 *                                                                 DTSCS61
00060 *        STANDARD LCCM-OP-PRINTER-ID MAINTENANCE.                 DTSCS61
00061 *                                                                 DTSCS61
00062 *                                                                 DTSCS61
00063 *    UPDATE:                                                      DTSCS61
00064 *                                                                 DTSCS61
00065 *      ADD                                                        DTSCS61
00066 *                                                                 DTSCS61
00067 *        ADD A MFAS RECORD TO THE MASTER FILE.  READ UPDATE/      DTSCS61
00068 *        REWRITE THE MASTER FILE MHDR RECORD TO OBTAIN AN         DTSCS61
00069 *        ASSIGNMENT NUMBER.                                       DTSCS61
00070 *                                                                 DTSCS61
00071 *        IF MAP-COPY-CNT IS GREATER THAN ZERO (IF MAP-COPY-CNT    DTSCS61
00072 *          IS NOT ENTERED, THEN MAP-COPY-CNT DEFAULTS TO 0),      DTSCS61
00073 *          THEN LINK TO MACCU351 FOR ON-LINE PRINT OF THE FIELD   DTSCS61
00074 *          ASSIGNMENT MEMORANDUM.                                 DTSCS61
00075 *                                                                 DTSCS61
00076 *        MOVE 'Y' TO MPRF-MFAS-IND.                               DTSCS61
00077 *                                                                 DTSCS61
00078 *        IF THE ASSIGNMENT IS AN AUDIT ASSIGNMENT, THEN WRITE     DTSCS61
00079 *          AN MEVL RECORD TO COMMEMORATE THE EVENT (FOR           DTSCS61
00080 *          EXAMPLE, SEE MACCS1A).                                 DTSCS61
00081 *                                                                 DTSCS61
00082 *                                                                 DTSCS61
00083 *    RECORDS READ:                                                DTSCS61
00084 *                                                                 DTSCS61
00085 *      MASTER:                                                    DTSCS61
00086 *                                                                 DTSCS61
00087 *        MHDR                                                     DTSCS61
00088 *        MPRF                                                     DTSCS61
00089 *        MFAS                                                     DTSCS61
00090 *                                                                 DTSCS61
00091 *                                                                 DTSCS61
00092 *      ALTERNATE INDEX:                                           DTSCS61
00093 *                                                                 DTSCS61
00094 *        NONE.                                                    DTSCS61
00095 *                                                                 DTSCS61
00096 *                                                                 DTSCS61
00097 *      REFERENCE:                                                 DTSCS61
00098 *                                                                 DTSCS61
00099 *        NONE.                                                    DTSCS61
00100 *                                                                 DTSCS61
00101 *                                                                 DTSCS61
00102 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS61
00103 *                                                                 DTSCS61
00104 *        NONE.                                                    DTSCS61
00105 *                                                                 DTSCS61
00106 *                                                                 DTSCS61
00107 *    RECORDS UPDATED:                                             DTSCS61
00108 *                                                                 DTSCS61
00109 *      MASTER:                                                    DTSCS61
00110 *                                                                 DTSCS61
00111 *        MHDR (REWRITE)                                           DTSCS61
00112 *        MPRF (REWRITE)                                           DTSCS61
00113 *        MFAS (WRITE)                                             DTSCS61
00114 *        MEVL (WRITE)                                             DTSCS61
00115 *                                                                 DTSCS61
00116 *                                                                 DTSCS61
00117 *      REFERENCE:                                                 DTSCS61
00118 *                                                                 DTSCS61
00119 *        NONE.                                                    DTSCS61
00120 *                                                                 DTSCS61
00121 *                                                                 DTSCS61
00122 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS61
00123 *                                                                 DTSCS61
00124 *        NONE.                                                    DTSCS61
00125 *                                                                 DTSCS61
00126 *                                                                 DTSCS61
00127 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS61
00128 *                                                                 DTSCS61
00129 *      IF MAP-TAX-EXTRACT = 'Y'                                   DTSCS61
00130 *        WRITE A T021 (TRN-CD = '01') RECORD.                     DTSCS61
00131 *                                                                 DTSCS61
00132 *      IF MAP-WAGE-EXTRACT = 'Y'                                  DTSCS61
00133 *        WRITE A T021 (TRN-CD = '02') RECORD.                     DTSCS61
00134 *                                                                 DTSCS61
00135 *                                                                 DTSCS61
00136 *    TEMPORARY STORAGE USAGE:                                     DTSCS61
00137 *                                                                 DTSCS61
00138 *      NONE.                                                      DTSCS61
00139 *                                                                 DTSCS61
00140 *                                                                 DTSCS61
00141 *    MODULES LINKED TO:                                           DTSCS61
00142 *                                                                 DTSCS61
00143 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS61
00144 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS61
00145 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS61
00146 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS61
00147 *      DTSCU020  SOCIAL SECURITY NUMBER FROM SCREEN FORMAT/EDIT.  DTSCS61
00148 *      DTSCU024  YEAR/QUARTER RANGE FROM SCREEN FORMAT/EDIT.      DTSCS61
00149 *      DTSCU038  R&A CODES EDIT/DESCRIPTION.                      DTSCS61
00150 *      DTSCU039  SIC CODE EDIT/DESCRIPTION.                       DTSCS61
00151 *      DTSCU061  FIELD ZIP/FIELD REP ID.                          DTSCS61
00152 *      DTSCU062  FIELD REP ID EDIT/DESCRIPTION.                   DTSCS61
00153 *      DTSCU063  FIELD ASSIGNMENT TYPE EDIT/DESCRIPTION.          DTSCS61
00154 *      DTSCU071  NAME EDIT/CONVERSION.                            DTSCS61
00155 *      DTSCU081  CLAIMANT NAME LOOKUP.                            DTSCS61
00156 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS61
00157 *      DTSCU221  MPRF-UPDATE DATA ELEMENT MAINTENANCE.            DTSCS61
00158 *      DTSCU351  FIELD ASSIGNMENT MEMORANDUM PRINT.               DTSCS61
00159 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS61
00160 *      DTSCU825  ON-LINE ACTIVITY FILE OUTPUT.                    DTSCS61
00161 *                                                                 DTSCS61
00162 *                                                                 DTSCS61
00163                                                                   DTSCS61
00164  ENVIRONMENT DIVISION.                                            DTSCS61
00165                                                                   DTSCS61
00166  DATA DIVISION.                                                   DTSCS61
00167                                                                   DTSCS61
00168  WORKING-STORAGE SECTION.                                         DTSCS61
001685 77  PAN-VALET PICTURE X(24) VALUE '041DTSCS61   02/07/12'.       DTSCS61
00169                                                                   DTSCS61
00170  01  WRK-AREA.                                                    DTSCS61
00171      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S61 '.    DTSCS61
00172                                                                   DTSCS61
00173      05  WRK-SCR-ID.                                              DTSCS61
00174          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 61.        DTSCS61
00175                                                                   DTSCS61
00176      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '60'.      DTSCS61
00177                                                                   DTSCS61
00178      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS61
00179          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS61
00180          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS61
00181                                                                   DTSCS61
00182      05  CURSOR-SET-IND              PIC X(01).                   DTSCS61
00183          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS61
00184          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS61
00185          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS61
00186                                                                   DTSCS61
00187      05  REQ-IND                     PIC X(01).                   DTSCS61
00188          88  REQ-ERROR                       VALUE 'O'.           DTSCS61
00189          88  REQ-JUMP                        VALUE 'J'.           DTSCS61
00190          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS61
00191          88  REQ-CLEAR                       VALUE 'C'.           DTSCS61
00192          88  REQ-EDIT                        VALUE 'E'.           DTSCS61
00193          88  REQ-UPDATE                      VALUE 'U'.           DTSCS61
00194          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS61
00195                                                                   DTSCS61
00196      05  RESP-IND                    PIC X(01).                   DTSCS61
00197          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS61
00198          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS61
00199          88  RESP-JUMP                       VALUE 'J'.           DTSCS61
00200          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS61
00201                                                                   DTSCS61
00202      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS61
00203                                                                   DTSCS61
00204      05  WRK-ATB-AN               PIC  X(01).                     DTSCS61
00205      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS61
00206                                                                   DTSCS61
00207      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS61
00208                                                                   DTSCS61
00209      05  WRK-CTR                     PIC S9(04)  COMP.            DTSCS61
00210                                                                   DTSCS61
00211      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS61
00212          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS61
00213          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS61
00214                                                                   DTSCS61
00215      05  WRK-EXTRACT-REQ-IND         PIC  X(01).                  DTSCS61
00216          88  WRK-EXTRACT-REQ-YES-88         VALUE 'Y'.            DTSCS61
00217          88  WRK-EXTRACT-REQ-NO-88          VALUE 'N'.            DTSCS61
00218                                                                   DTSCS61
00219      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS61
00220                                                                   DTSCS61
00221      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS61
00222          10  FILLER                  PIC X(05).                   DTSCS61
00223          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS61
00224          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS61
00225                                                                   DTSCS61
00226      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS61
00227          10  FILLER                  PIC X(08).                   DTSCS61
00228          10  WRK-DISPLAY-QTR-YR      PIC X(02).                   DTSCS61
00229          10  WRK-DISPLAY-QTR-Q       PIC X(01).                   DTSCS61
00230                                                                   DTSCS61
00231      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS61
00232          10  FILLER                  PIC 9(05).                   DTSCS61
00233          10  WRK-DISPLAY-YR          PIC 9(02).                   DTSCS61
00234          10  WRK-DISPLAY-MO          PIC 9(02).                   DTSCS61
00235          10  WRK-DISPLAY-DA          PIC 9(02).                   DTSCS61
00236                                                                   DTSCS61
00237      05  INQUIRY-CONTROL-AREA.                                    DTSCS61
00238          10  LAST-REC-NUM            PIC S9(08)  COMP.            DTSCS61
00239                                                                   DTSCS61
00240          10  WS-REC-NUM              PIC S9(08)  COMP.            DTSCS61
00241                                                                   DTSCS61
00242          10  LAST-REC-KEY-AREA       PIC  X(16).                  DTSCS61
00243                                                                   DTSCS61
00244          10  SCR-REC-KEY-AREA        PIC  X(16).                  DTSCS61
00245                                                                   DTSCS61
00246          10  WS-REC-FOUND-IND        PIC  X(01).                  DTSCS61
00247                                                                   DTSCS61
00248                                                                   DTSCS61
00249                                                                   DTSCS61
00250 *    05  WRK-ASSIGN-TYPE-ERROR-IND   PIC  X(01).                  DTSCS61
00251 *        88  WRK-ASSIGN-TYPE-ERROR-YES   VALUE 'Y'.               DTSCS61
00252 *        88  WRK-ASSIGN-TYPE-ERROR-NO    VALUE 'N'.               DTSCS61
00253                                                                   DTSCS61
00254      05  WRK-START-DATE-ERROR-IND    PIC  X(01).                  DTSCS61
00255          88  WRK-START-DATE-ERROR-YES    VALUE 'Y'.               DTSCS61
00256          88  WRK-START-DATE-ERROR-NO     VALUE 'N'.               DTSCS61
00257                                                                   DTSCS61
00258      05  WRK-FLD-REP-ENTERED-IND PIC X(01).                       DTSCS61
00259          88  WRK-FLD-REP-NOT-ENTERED   VALUE 'Y'.                 DTSCS61
00260          88  WRK-FLD-REP-ENTERED       VALUE 'N'.                 DTSCS61
00261                                                                   DTSCS61
00262      05  WRK-START-DATE              PIC S9(09) COMP-3.           DTSCS61
00263                                                                   DTSCS61
00264      05  WRK-L331-REC-OCC-ID         PIC X(20).                   DTSCS61
00265      05  FILLER REDEFINES WRK-L331-REC-OCC-ID.                    DTSCS61
00266          10  WRK-L331-ASSIGN-NO      PIC 9(09).                   DTSCS61
00267          10  FILLER                  PIC X(11).                   DTSCS61
00268                                                                   DTSCS61
00269      EJECT                                                        DTSCS61
00270                                                                   DTSCS61
00271 *****                                                             DTSCS61
00272 *                                                                 DTSCS61
00273 *****                                                             DTSCS61
00274                                                                   DTSCS61
00275  01  MSG-LITERALS.                                                DTSCS61
00276                                                                   DTSCS61
00277      05  MSG-E611-AREA.                                           DTSCS61
00278          10  FILLER                  PIC  X(04)  VALUE 'E611'.    DTSCS61
00279          10  FILLER                  PIC  X(30)                   DTSCS61
00280                VALUE 'OPEN ASSIGNMENT EXISTS.  TALK '.            DTSCS61
00281          10  FILLER                  PIC  X(30)                   DTSCS61
00282                VALUE 'TO THE FIELD DESK.            '.            DTSCS61
00283                                                                   DTSCS61
00284      05  MSG-E612-AREA.                                           DTSCS61
00285          10  FILLER                  PIC  X(04)  VALUE 'E612'.    DTSCS61
00286          10  FILLER                  PIC  X(30)                   DTSCS61
00287                VALUE 'SELF INSURED EMPLOYER OR OPEN '.            DTSCS61
00288          10  FILLER                  PIC  X(30)                   DTSCS61
00289                VALUE 'BANKRUPTCY - AUDIT NOT ALLOWED'.            DTSCS61
00290                                                                   DTSCS61
00291      05  MSG-E613-AREA.                                           DTSCS61
00292          10  FILLER                  PIC  X(04)  VALUE 'E613'.    DTSCS61
00293          10  FILLER                  PIC  X(30)                   DTSCS61
00294                VALUE 'RELATED EMPLOYER IS CHARGING O'.            DTSCS61
00295          10  FILLER                  PIC  X(30)                   DTSCS61
00296                VALUE 'NLY.  NOT VALID ENTRY.        '.            DTSCS61
00297                                                                   DTSCS61
00298      05  MSG-E614-AREA.                                           DTSCS61
00299          10  FILLER                  PIC  X(04)  VALUE 'E614'.    DTSCS61
00300          10  FILLER                  PIC  X(11) VALUE             DTSCS61
00301                       'ASSIGNMENT '.                              DTSCS61
00302          10  WRK-MSG-ASSIGN-NO       PIC  99B99999.               DTSCS61
00303          10  FILLER                  PIC  X(07) VALUE ' ADDED.'.  DTSCS61
00304          10  WRK-PRINTER-MSG         PIC  X(34) VALUE SPACES.     DTSCS61
00305                                                                   DTSCS61
00306      05  MSG-E615-AREA.                                           DTSCS61
00307          10  FILLER                  PIC  X(04)  VALUE 'E615'.    DTSCS61
00308          10  FILLER                  PIC  X(30)                   DTSCS61
00309                VALUE 'START DATE MUST BE <= ASSIGNME'.            DTSCS61
00310          10  FILLER                  PIC  X(30)                   DTSCS61
00311                VALUE 'NT DUE DATE                   '.            DTSCS61
00312                                                                   DTSCS61
00313      05  MSG-E616-AREA.                                           DTSCS61
00314          10  FILLER                  PIC  X(04)  VALUE 'E616'.    DTSCS61
00315          10  FILLER                  PIC  X(30)                   DTSCS61
00316                VALUE 'EXTRACT REQUESTED - YRQ RANGE '.            DTSCS61
00317          10  FILLER                  PIC  X(30)                   DTSCS61
00318                VALUE 'REQUIRED                      '.            DTSCS61
00319                                                                   DTSCS61
00320      05  MSG-E617-AREA.                                           DTSCS61
00321          10  FILLER                  PIC  X(04)  VALUE 'E617'.    DTSCS61
00322          10  FILLER                  PIC  X(30)                   DTSCS61
00323                VALUE 'ORIGINATOR IS NOT FIELD DESK  '.            DTSCS61
00324          10  FILLER                  PIC  X(30)                   DTSCS61
00325                VALUE '"FD" IS ONLY VALID VALUE      '.            DTSCS61
00326                                                                   DTSCS61
00327      05  MSG-E618-AREA.                                           DTSCS61
00328          10  FILLER                  PIC  X(04)  VALUE 'E618'.    DTSCS61
00329          10  FILLER                  PIC  X(30)                   DTSCS61
00330                VALUE 'ORIGINATOR IS NOT FIELD DESK  '.            DTSCS61
00331          10  FILLER                  PIC  X(30)                   DTSCS61
00332                VALUE '"AD" IS ONLY VALID VALUE      '.            DTSCS61
00333                                                                   DTSCS61
00334      05  MSG-E61A-AREA.                                           DTSCS61
00335          10  FILLER                  PIC  X(04)  VALUE 'E61A'.    DTSCS61
00336          10  FILLER                  PIC  X(30)                   DTSCS61
00337                VALUE 'NOT AN AUDIT ASSIGNMENT  ENTRY'.            DTSCS61
00338          10  FILLER                  PIC  X(30)                   DTSCS61
00339                VALUE ' NOT ALLOWED                  '.            DTSCS61
00340                                                                   DTSCS61
00341      05  MSG-E61B-AREA.                                           DTSCS61
00342          10  FILLER                  PIC  X(04)  VALUE 'E61B'.    DTSCS61
00343          10  FILLER                  PIC  X(30)                   DTSCS61
00344                VALUE 'AUDIT ASSIGNMENT  ENTRY IS REQ'.            DTSCS61
00345          10  FILLER                  PIC  X(30)                   DTSCS61
00346                VALUE 'UIRED                         '.            DTSCS61
00347                                                                   DTSCS61
00348      05  MSG-E61C-AREA.                                           DTSCS61
00349          10  FILLER                  PIC  X(04)  VALUE 'E61C'.    DTSCS61
00350          10  FILLER                  PIC  X(30)                   DTSCS61
00351                VALUE 'EMPLOYER WRITTEN OFF - EXTRACT'.            DTSCS61
00352          10  FILLER                  PIC  X(30)                   DTSCS61
00353                VALUE ' NOT ALLOWED                  '.            DTSCS61
00354      SKIP3                                                        DTSCS61
00355  01  EVL-TEXT.                                                    DTSCS61
00356      05  FILLER          PIC  X(17)  VALUE 'FIELD ASSIGNMENT '.   DTSCS61
00357      05  EVL-ASSIGN-NO   PIC  99B99999.                           DTSCS61
00358      05  FILLER          PIC  X(10)  VALUE ' INITIATED'.          DTSCS61
00359      EJECT                                                        DTSCS61
00360  01  L001-COMM-AREA.                                              DTSCS61
00361  ++INCLUDE DTSIL001                                               DTSCS61
00362      EJECT                                                        DTSCS61
00363  01  L004-COMM-AREA.                                              DTSCS61
00364  ++INCLUDE DTSIL004                                               DTSCS61
00365      EJECT                                                        DTSCS61
00366  01  L015-COMM-AREA.                                              DTSCS61
00367  ++INCLUDE DTSIL015                                               DTSCS61
00368      EJECT                                                        DTSCS61
00369  01  L018-COMM-AREA.                                              DTSCS61
00370  ++INCLUDE DTSIL018                                               DTSCS61
00371      EJECT                                                        DTSCS61
00372  01  L020-COMM-AREA.                                              DTSCS61
00373  ++INCLUDE DTSIL020                                               DTSCS61
00374      EJECT                                                        DTSCS61
00375  01  L024-COMM-AREA.                                              DTSCS61
00376  ++INCLUDE DTSIL024                                               DTSCS61
00377      EJECT                                                        DTSCS61
00378  01  L036-COMM-AREA.                                              DTSCS61
00379  ++INCLUDE DTSIL036                                               DTSCS61
00380      EJECT                                                        DTSCS61
00381  01  L038-COMM-AREA.                                              DTSCS61
00382  ++INCLUDE DTSIL038                                               DTSCS61
00383      EJECT                                                        DTSCS61
00384  01  L039-COMM-AREA.                                              DTSCS61
00385  ++INCLUDE DTSIL039                                               DTSCS61
00386      EJECT                                                        DTSCS61
00387  01  L061-COMM-AREA.                                              DTSCS61
00388  ++INCLUDE DTSIL061                                               DTSCS61
00389      EJECT                                                        DTSCS61
00390  01  L062-COMM-AREA.                                              DTSCS61
00391  ++INCLUDE DTSIL062                                               DTSCS61
00392      EJECT                                                        DTSCS61
00393  01  L063-COMM-AREA.                                              DTSCS61
00394  ++INCLUDE DTSIL063                                               DTSCS61
00395      EJECT                                                        DTSCS61
00396  01  L071-COMM-AREA.                                              DTSCS61
00397  ++INCLUDE DTSIL071                                               DTSCS61
00398      EJECT                                                        DTSCS61
00399  01  L081-COMM-AREA.                                              DTSCS61
00400  ++INCLUDE DTSIL081                                               DTSCS61
00401      EJECT                                                        DTSCS61
00402  01  L082-COMM-AREA.                                              DTSCS61
00403  ++INCLUDE DTSIL082                                               DTSCS61
00404      EJECT                                                        DTSCS61
00405  01  L221-COMM-AREA.                                              DTSCS61
00406  ++INCLUDE DTSIL221                                               DTSCS61
00407      EJECT                                                        DTSCS61
00408  01  L331-COMM-AREA.                                              DTSCS61
00409  ++INCLUDE DTSIL331                                               DTSCS61
00410      EJECT                                                        DTSCS61
00411 *01  L351-COMM-AREA.                                              DTSCS61
00412 ***INCLUDE DTSIL351                                               DTSCS61
00413      EJECT                                                        DTSCS61
00414  01  L805-COMM-AREA.                                              DTSCS61
00415  ++INCLUDE DTSIL805                                               DTSCS61
00416      EJECT                                                        DTSCS61
00417  01  L810-COMM-AREA.                                              DTSCS61
00418      05  L810-CONTROL-BLOCK.                                      DTSCS61
00419  ++INCLUDE DTSIL810                                               DTSCS61
00420      EJECT                                                        DTSCS61
00421      05  MSKL-REC.                                                DTSCS61
00422  ++INCLUDE DTSIMSKL                                               DTSCS61
00423      EJECT                                                        DTSCS61
00424  01  MPRF-REC.                                                    DTSCS61
00425  ++INCLUDE DTSIMPRF                                               DTSCS61
00426      EJECT                                                        DTSCS61
00427  01  MHDR-REC.                                                    DTSCS61
00428  ++INCLUDE DTSIMHDR                                               DTSCS61
00429      EJECT                                                        DTSCS61
00430  01  MFAS-REC.                                                    DTSCS61
00431  ++INCLUDE DTSIMFAS                                               DTSCS61
00432      EJECT                                                        DTSCS61
00433  01  MEVL-REC.                                                    DTSCS61
00434  ++INCLUDE DTSIMEVL                                               DTSCS61
00435      EJECT                                                        DTSCS61
00436  01  L825-COMM-AREA.                                              DTSCS61
00437      05  L825-CONTROL-BLOCK.                                      DTSCS61
00438  ++INCLUDE DTSIL825                                               DTSCS61
00439                                                                   DTSCS61
00440      05  RSKL-REC.                                                DTSCS61
00441  ++INCLUDE DTSIRSK1                                               DTSCS61
00442      EJECT                                                        DTSCS61
00443  01  T021-REC.                                                    DTSCS61
00444  ++INCLUDE DTSIT021                                               DTSCS61
00445      EJECT                                                        DTSCS61
00446  01  L851-COMM-AREA.                                              DTSCS61
00447  ++INCLUDE DTSIL851                                               DTSCS61
00448                                                                   DTSCS61
00449      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS61
00450  ++INCLUDE DTSIS61                                                DTSCS61
00451      EJECT                                                        DTSCS61
00452  01  CATB-LITERALS.                                               DTSCS61
00453  ++INCLUDE DTSICATB                                               DTSCS61
00454                                                                   DTSCS61
00455  01  CFKD-LITERALS.                                               DTSCS61
00456  ++INCLUDE DTSICFKD                                               DTSCS61
00457                                                                   DTSCS61
00458  01  CECD-LITERALS.                                               DTSCS61
00459  ++INCLUDE DTSICECD                                               DTSCS61
00460                                                                   DTSCS61
00461  01  CPCD-LITERALS.                                               DTSCS61
00462  ++INCLUDE DTSICPCD                                               DTSCS61
00463                                                                   DTSCS61
00464  01  MMAX-LITERALS.                                               DTSCS61
00465  ++INCLUDE DTSIMMAX                                               DTSCS61
00466      EJECT                                                        DTSCS61
00467  LINKAGE SECTION.                                                 DTSCS61
00468                                                                   DTSCS61
00469  01  DFHCOMMAREA.                                                 DTSCS61
00470  ++INCLUDE DTSILCCM                                               DTSCS61
00471      EJECT                                                        DTSCS61
00472 ******************************************************************DTSCS61
00473 *                                                                *DTSCS61
00474 ******************************************************************DTSCS61
00475                                                                   DTSCS61
00476  PROCEDURE DIVISION.                                              DTSCS61
00477                                                                   DTSCS61
00478      MOVE +0 TO WRK-EMP-NO.                                       DTSCS61
00479                                                                   DTSCS61
00480      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS61
00481      SET WRK-EXTRACT-REQ-NO-88 TO TRUE.                           DTSCS61
00482                                                                   DTSCS61
00483      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS61
00484                                                                   DTSCS61
00485      SET CURSOR-SET-NO TO TRUE.                                   DTSCS61
00486                                                                   DTSCS61
00487      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS61
00488        TO SCR-ACCESS-IND.                                         DTSCS61
00489                                                                   DTSCS61
00490      MOVE SPACE TO REQ-IND.                                       DTSCS61
00491                                                                   DTSCS61
00492      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS61
00493                                                                   DTSCS61
00494 *-----------------------------------------------------            DTSCS61
00495 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS61
00496 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS61
00497 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS61
00498 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS61
00499 *                                                                 DTSCS61
00500 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS61
00501 *    PROCESSED.                                                   DTSCS61
00502 *                                                                 DTSCS61
00503 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS61
00504 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS61
00505 *    WORK STATION OPERATOR.                                       DTSCS61
00506 *-----------------------------------------------------            DTSCS61
00507                                                                   DTSCS61
00508      MOVE SPACE TO RESP-IND.                                      DTSCS61
00509                                                                   DTSCS61
00510      IF REQ-ERROR                                                 DTSCS61
00511         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS61
00512      ELSE                                                         DTSCS61
00513      IF REQ-JUMP                                                  DTSCS61
00514         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS61
00515      ELSE                                                         DTSCS61
00516      IF REQ-CLEAR                                                 DTSCS61
00517         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS61
00518      ELSE                                                         DTSCS61
00519      IF REQ-CURSOR-TO-GOTO                                        DTSCS61
00520         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS61
00521      ELSE                                                         DTSCS61
00522      IF REQ-EDIT                                                  DTSCS61
00523         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS61
00524      ELSE                                                         DTSCS61
00525      IF REQ-UPDATE                                                DTSCS61
00526         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS61
00527      ELSE                                                         DTSCS61
00528         GO TO S899-ABEND.                                         DTSCS61
00529                                                                   DTSCS61
00530 *-----------------------------------------------------            DTSCS61
00531 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS61
00532 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS61
00533 *-----------------------------------------------------            DTSCS61
00534                                                                   DTSCS61
00535      IF RESP-SEND-MAP                                             DTSCS61
00536          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS61
00537          SET LCCM-END-TASK-88 TO TRUE                             DTSCS61
00538      ELSE                                                         DTSCS61
00539      IF RESP-SEND-MSGONLY                                         DTSCS61
00540          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS61
00541          SET LCCM-END-TASK-88 TO TRUE                             DTSCS61
00542      ELSE                                                         DTSCS61
00543      IF RESP-JUMP                                                 DTSCS61
00544          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
00545      ELSE                                                         DTSCS61
00546      IF RESP-CURSOR-TO-GOTO                                       DTSCS61
00547          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS61
00548          SET LCCM-END-TASK-88 TO TRUE                             DTSCS61
00549      ELSE                                                         DTSCS61
00550          GO TO S899-ABEND.                                        DTSCS61
00551                                                                   DTSCS61
00552  MAINLINE-EXIT.                                                   DTSCS61
00553                                                                   DTSCS61
00554      EXEC CICS                                                    DTSCS61
00555          RETURN                                                   DTSCS61
00556      END-EXEC.                                                    DTSCS61
00557                                                                   DTSCS61
00558      GOBACK.                                                      DTSCS61
00559      EJECT                                                        DTSCS61
00560 /*****************************************************************DTSCS61
00561 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS61
00562 ******************************************************************DTSCS61
00563  P1000-ANALYZE-REQUEST.                                           DTSCS61
00564                                                                   DTSCS61
00565 *-----------------------------------------------------            DTSCS61
00566 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS61
00567 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS61
00568 *     REPLACED WITH ENTER)                                        DTSCS61
00569 *-----------------------------------------------------            DTSCS61
00570      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS61
00571         SET LCCM-ENTER-88 TO TRUE                                 DTSCS61
00572         SET REQ-CLEAR TO TRUE                                     DTSCS61
00573         IF LCCM-EMP-NO > ZERO                                     DTSCS61
00574             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS61
00575             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS61
00576         END-IF                                                    DTSCS61
00577         GO TO P1000-EXIT.                                         DTSCS61
00578                                                                   DTSCS61
00579 *-----------------------------------------------------            DTSCS61
00580 *      MAP IS RECEIVED                                            DTSCS61
00581 *-----------------------------------------------------            DTSCS61
00582      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS61
00583                                                                   DTSCS61
00584 *-----------------------------------------------------            DTSCS61
00585 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS61
00586 *    WORK STATION                                                 DTSCS61
00587 *-----------------------------------------------------            DTSCS61
00588      IF LCCM-CLEAR-88                                             DTSCS61
00589         SET REQ-CLEAR TO TRUE                                     DTSCS61
00590         GO TO P1000-EXIT.                                         DTSCS61
00591                                                                   DTSCS61
00592 *-----------------------------------------------------            DTSCS61
00593 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS61
00594 *-----------------------------------------------------            DTSCS61
00595      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS61
00596         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS61
00597         GO TO P1000-EXIT.                                         DTSCS61
00598                                                                   DTSCS61
00599 *-----------------------------------------------------            DTSCS61
00600 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS61
00601 *-----------------------------------------------------            DTSCS61
00602      IF LCCM-PA2-88                                               DTSCS61
00603          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS61
00604          GO TO P1000-EXIT.                                        DTSCS61
00605                                                                   DTSCS61
00606 *-----------------------------------------------------            DTSCS61
00607 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS61
00608 *-----------------------------------------------------            DTSCS61
00609      IF LCCM-PA-88                                                DTSCS61
00610        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS61
00611        SET REQ-ERROR TO TRUE                                      DTSCS61
00612        GO TO P1000-EXIT.                                          DTSCS61
00613                                                                   DTSCS61
00614 *-----------------------------------------------------            DTSCS61
00615 *    IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN           DTSCS61
00616 *    CLEAR SCREEN                                                 DTSCS61
00617 *-----------------------------------------------------            DTSCS61
00618      IF LCCM-F12-88                                               DTSCS61
00619         MOVE LOW-VALUES TO MAP-AREA                               DTSCS61
00620         SET REQ-CLEAR TO TRUE                                     DTSCS61
00621         GO TO P1000-EXIT.                                         DTSCS61
00622                                                                   DTSCS61
00623 *-----------------------------------------------------            DTSCS61
00624 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS61
00625 *-----------------------------------------------------            DTSCS61
00626      IF LCCM-F03-88                                               DTSCS61
00627         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS61
00628         SET REQ-JUMP TO TRUE                                      DTSCS61
00629         GO TO P1000-EXIT.                                         DTSCS61
00630                                                                   DTSCS61
00631 *-----------------------------------------------------            DTSCS61
00632 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS61
00633 *-----------------------------------------------------            DTSCS61
00634      IF LCCM-F04-88                                               DTSCS61
00635         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS61
00636         SET REQ-JUMP TO TRUE                                      DTSCS61
00637         GO TO P1000-EXIT.                                         DTSCS61
00638                                                                   DTSCS61
00639 *---------------------------------------------------------        DTSCS61
00640 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS61
00641 *    CORRESPONDENCE SCREEN.                                       DTSCS61
00642 *---------------------------------------------------------        DTSCS61
00643                                                                   DTSCS61
00644      IF LCCM-F14-88                                               DTSCS61
00645          MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS61
00646          SET REQ-JUMP TO TRUE                                     DTSCS61
00647          GO TO P1000-EXIT.                                        DTSCS61
00648                                                                   DTSCS61
00649 *---------------------------------------------------------        DTSCS61
00650 *    IF REGISTRATION INQUIRY SCREEN KEY PRESSED,                  DTSCS61
00651 *    THEN JUMP TO REGISTRATION INQUIRY SCREEN.                    DTSCS61
00652 *---------------------------------------------------------        DTSCS61
00653 *                                                                 DTSCS61
00654 *    IF LCCM-F17-88                                               DTSCS61
00655 *        MOVE '11' TO LCCM-REQ-SCR-ID                             DTSCS61
00656 *        SET REQ-JUMP TO TRUE                                     DTSCS61
00657 *        GO TO P1000-EXIT.                                        DTSCS61
00658 *                                                                 DTSCS61
00659 *-----------------------------------------------------            DTSCS61
00660 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS61
00661 *    REQUESTED SCREEN TYPE                                        DTSCS61
00662 *-----------------------------------------------------            DTSCS61
00663      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS61
00664         NEXT SENTENCE                                             DTSCS61
00665      ELSE                                                         DTSCS61
00666        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS61
00667        SET REQ-JUMP TO TRUE                                       DTSCS61
00668        GO TO P1000-EXIT.                                          DTSCS61
00669                                                                   DTSCS61
00670 *-----------------------------------------------------            DTSCS61
00671 *    IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL)                  DTSCS61
00672 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS61
00673 *-----------------------------------------------------            DTSCS61
00674      IF LCCM-F09-88                                               DTSCS61
00675         IF SCR-ACCESS-UPDATE                                      DTSCS61
00676            SET REQ-EDIT TO TRUE                                   DTSCS61
00677            GO TO P1000-EXIT                                       DTSCS61
00678         ELSE                                                      DTSCS61
00679            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS61
00680            SET REQ-ERROR TO TRUE                                  DTSCS61
00681            GO TO P1000-EXIT.                                      DTSCS61
00682                                                                   DTSCS61
00683 *-----------------------------------------------------            DTSCS61
00684 *     ANY OTHER KEY IS INVALID                                    DTSCS61
00685 *-----------------------------------------------------            DTSCS61
00686      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS61
00687      SET REQ-ERROR TO TRUE.                                       DTSCS61
00688  P1000-EXIT.                                                      DTSCS61
00689      EXIT.                                                        DTSCS61
00690                                                                   DTSCS61
00691 ******************************************************************DTSCS61
00692 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS61
00693 ******************************************************************DTSCS61
00694                                                                   DTSCS61
00695  P1100-UPDATE-LOCKED.                                             DTSCS61
00696 *-----------------------------------------------------            DTSCS61
00697 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS61
00698 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS61
00699 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS61
00700 *-----------------------------------------------------            DTSCS61
00701      IF LCCM-ENTER-88 OR LCCM-F09-88 OR LCCM-F12-88               DTSCS61
00702         SET REQ-UPDATE TO TRUE                                    DTSCS61
00703      ELSE                                                         DTSCS61
00704         SET REQ-ERROR TO TRUE                                     DTSCS61
00705         IF LCCM-SCR-ADD-LOCKED                                    DTSCS61
00706            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS61
00707         ELSE                                                      DTSCS61
00708            GO TO S899-ABEND.                                      DTSCS61
00709  P1100-EXIT.                                                      DTSCS61
00710      EXIT.                                                        DTSCS61
00711 /*****************************************************************DTSCS61
00712 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS61
00713 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS61
00714 ******************************************************************DTSCS61
00715                                                                   DTSCS61
00716  P2000-REQUEST-ERROR.                                             DTSCS61
00717      IF LCCM-MSG                                                  DTSCS61
00718         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS61
00719      ELSE                                                         DTSCS61
00720         GO TO S899-ABEND.                                         DTSCS61
00721  P2000-EXIT.                                                      DTSCS61
00722      EXIT.                                                        DTSCS61
00723 /*****************************************************************DTSCS61
00724 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS61
00725 ******************************************************************DTSCS61
00726                                                                   DTSCS61
00727  P3000-REQUEST-JUMP.                                              DTSCS61
00728 *-----------------------------------------------------            DTSCS61
00729 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS61
00730 *    BY USER                                                      DTSCS61
00731 *-----------------------------------------------------            DTSCS61
00732      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS61
00733                                                                   DTSCS61
00734 *-----------------------------------------------------            DTSCS61
00735 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS61
00736 *-----------------------------------------------------            DTSCS61
00737      IF LCCM-MSG                                                  DTSCS61
00738         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS61
00739         SET CURSOR-SET-GOTO TO TRUE                               DTSCS61
00740         GO TO P3000-EXIT.                                         DTSCS61
00741      SKIP3                                                        DTSCS61
00742      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS61
00743      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS61
00744      IF L018-VALID                                                DTSCS61
00745          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS61
00746                                                                   DTSCS61
00747 *-----------------------------------------------------            DTSCS61
00748 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS61
00749 *-----------------------------------------------------            DTSCS61
00750      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS61
00751      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS61
00752      SET RESP-JUMP TO TRUE.                                       DTSCS61
00753  P3000-EXIT.                                                      DTSCS61
00754      EXIT.                                                        DTSCS61
00755 /*****************************************************************DTSCS61
00756 * CLEAR KEY WAS PRESSED                                          *DTSCS61
00757 ******************************************************************DTSCS61
00758                                                                   DTSCS61
00759  P4000-REQUEST-CLEAR.                                             DTSCS61
00760                                                                   DTSCS61
00761 *-----------------------------------------------------            DTSCS61
00762 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS61
00763 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS61
00764 *-----------------------------------------------------            DTSCS61
00765      IF LCCM-EMP-NO > ZERO                                        DTSCS61
00766          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS61
00767          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                       DTSCS61
00768          PERFORM S1101-EMP-NO THRU S1101-EXIT.                    DTSCS61
00769 *****                                                             DTSCS61
00770 *****MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS61
00771 *****                                                             DTSCS61
00772      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS61
00773                                                                   DTSCS61
00774      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS61
00775                                                                   DTSCS61
00776      IF SCR-ACCESS-UPDATE                                         DTSCS61
00777          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS61
00778      ELSE                                                         DTSCS61
00779          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS61
00780                                                                   DTSCS61
00781      SET RESP-SEND-MAP TO TRUE.                                   DTSCS61
00782  P4000-EXIT.                                                      DTSCS61
00783      EXIT.                                                        DTSCS61
00784 /*****************************************************************DTSCS61
00785 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS61
00786 ******************************************************************DTSCS61
00787                                                                   DTSCS61
00788  P5000-CURSOR-TO-GOTO.                                            DTSCS61
00789      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS61
00790      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS61
00791  P5000-EXIT.                                                      DTSCS61
00792      EXIT.                                                        DTSCS61
00793 /*****************************************************************DTSCS61
00794 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED.                     DTSCS61
00795 ******************************************************************DTSCS61
00796                                                                   DTSCS61
00797  P7000-REQUEST-EDIT.                                              DTSCS61
00798      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS61
00799                                                                   DTSCS61
00800      IF LCCM-F09-88                                               DTSCS61
00801         PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS61
00802      ELSE                                                         DTSCS61
00803         GO TO S899-ABEND.                                         DTSCS61
00804                                                                   DTSCS61
00805 *------------------------------------------------------           DTSCS61
00806 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS61
00807 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS61
00808 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS61
00809 *------------------------------------------------------           DTSCS61
00810                                                                   DTSCS61
00811      IF LCCM-MSG                                                  DTSCS61
00812         NEXT SENTENCE                                             DTSCS61
00813      ELSE                                                         DTSCS61
00814         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS61
00815         IF LCCM-F09-88                                            DTSCS61
00816            SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS61
00817            MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID.              DTSCS61
00818                                                                   DTSCS61
00819      SET RESP-SEND-MAP TO TRUE.                                   DTSCS61
00820  P7000-EXIT.                                                      DTSCS61
00821      EXIT.                                                        DTSCS61
00822 /*****************************************************************DTSCS61
00823 * ADD FUNCTION WAS REQUESTED                                     *DTSCS61
00824 ******************************************************************DTSCS61
00825                                                                   DTSCS61
00826  P7100-EDIT-ADD.                                                  DTSCS61
00827 *-----------------------------------------------------            DTSCS61
00828 *    ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST          DTSCS61
00829 *-----------------------------------------------------            DTSCS61
00830      IF NOT LCCM-SCR-CLEAR                                        DTSCS61
00831         MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                     DTSCS61
00832         GO TO P7100-EXIT.                                         DTSCS61
00833                                                                   DTSCS61
00834 *-----------------------------------------------------            DTSCS61
00835 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD                 DTSCS61
00836 *-----------------------------------------------------            DTSCS61
00837      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS61
00838      IF LCCM-MSG                                                  DTSCS61
00839          GO TO P7100-EXIT.                                        DTSCS61
00840      MOVE WRK-EMP-NO         TO LCCM-EMP-NO.                      DTSCS61
00841                                                                   DTSCS61
00842      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS61
00843                                                                   DTSCS61
00844  P7100-EXIT.                                                      DTSCS61
00845      EXIT.                                                        DTSCS61
00846 /*****************************************************************DTSCS61
00847 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS61
00848 ******************************************************************DTSCS61
00849                                                                   DTSCS61
00850  P8000-REQUEST-UPDATE.                                            DTSCS61
00851                                                                   DTSCS61
00852      IF LCCM-SCR-ADD-LOCKED                                       DTSCS61
00853         PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS61
00854      ELSE                                                         DTSCS61
00855         GO TO S899-ABEND.                                         DTSCS61
00856                                                                   DTSCS61
00857      SET RESP-SEND-MAP TO TRUE.                                   DTSCS61
00858  P8000-EXIT.                                                      DTSCS61
00859      EXIT.                                                        DTSCS61
00860 /*****************************************************************DTSCS61
00861 *                                                                *DTSCS61
00862 ******************************************************************DTSCS61
00863                                                                   DTSCS61
00864  P8100-ADD.                                                       DTSCS61
00865      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS61
00866                                                                   DTSCS61
00867      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS61
00868                                                                   DTSCS61
00869      IF LCCM-F12-88                                               DTSCS61
00870         MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID                     DTSCS61
00871         GO TO P8100-EXIT.                                         DTSCS61
00872                                                                   DTSCS61
00873      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS61
00874                                                                   DTSCS61
00875      MOVE 'A' TO L221-UPDATE-FUNCTION.                            DTSCS61
00876      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS61
00877      IF LCCM-MSG                                                  DTSCS61
00878          GO TO P8100-EXIT.                                        DTSCS61
00879                                                                   DTSCS61
00880      PERFORM P8110-UPD-HDR            THRU P8110-EXIT.            DTSCS61
00881                                                                   DTSCS61
00882      IF LCCM-MSG                                                  DTSCS61
00883         PERFORM S221-EMP-UNLOCK THRU S221-EXIT                    DTSCS61
00884         GO TO P8100-EXIT.                                         DTSCS61
00885                                                                   DTSCS61
00886      PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT.               DTSCS61
00887                                                                   DTSCS61
00888      PERFORM P8120-CONSTRUCT-MFAS THRU P8120-EXIT.                DTSCS61
00889                                                                   DTSCS61
00890      PERFORM P8130-MEVL-WRITE THRU P8130-EXIT.                    DTSCS61
00891                                                                   DTSCS61
00892      PERFORM P8140-UPDATE-MPRF    THRU P8140-EXIT.                DTSCS61
00893                                                                   DTSCS61
00894      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS61
00895                                                                   DTSCS61
00896 *    IF MAP-COPIES > +0                                           DTSCS61
00897 *       PERFORM P8150-FIELD-MEMO THRU P8150-EXIT                  DTSCS61
00898 *    END-IF.                                                      DTSCS61
00899                                                                   DTSCS61
00900      IF LCCM-ENTER-88                                             DTSCS61
00901          MOVE LOW-VALUES TO MAP-AREA                              DTSCS61
00902          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS61
00903          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS61
00904          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                       DTSCS61
00905          PERFORM S1101-EMP-NO THRU S1101-EXIT                     DTSCS61
00906      ELSE                                                         DTSCS61
00907          MOVE LOW-VALUES TO MAP-FLD-REP-ID                        DTSCS61
00908                             MAP-SIC-CD                            DTSCS61
00909                             MAP-OWN-CD.                           DTSCS61
00910                                                                   DTSCS61
00911      MOVE MFAS-ASSIGN-NO TO WRK-MSG-ASSIGN-NO.                    DTSCS61
00912      MOVE MSG-E614-AREA  TO LCCM-MSG-AREA.                        DTSCS61
00913 **** MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS61
00914                                                                   DTSCS61
00915      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS61
00916  P8100-EXIT.                                                      DTSCS61
00917      EXIT.                                                        DTSCS61
00918                                                                   DTSCS61
00919  P8110-UPD-HDR.                                                   DTSCS61
00920      MOVE LOW-VALUES                  TO MHDR-KEY-AREA.           DTSCS61
00921      MOVE ZEROS                       TO MHDR-EMP-NO.             DTSCS61
00922      SET MHDR-HDR-88                  TO TRUE.                    DTSCS61
00923      MOVE MHDR-KEY-AREA               TO MSKL-KEY-AREA.           DTSCS61
00924      PERFORM S810-READ-UPDATE         THRU S810-EXIT.             DTSCS61
00925      IF L810-NO-REC-88                                            DTSCS61
00926         GO TO S899-ABEND.                                         DTSCS61
00927                                                                   DTSCS61
00928      MOVE MSKL-REC                    TO MHDR-REC.                DTSCS61
00929      ADD +1                           TO MHDR-LAST-USED-ASSIGN-NO.DTSCS61
00930                                                                   DTSCS61
00931      MOVE MHDR-REC                    TO MSKL-REC.                DTSCS61
00932      PERFORM S810-REWRITE-UPDATE      THRU S810-EXIT.             DTSCS61
00933                                                                   DTSCS61
00934  P8110-EXIT. EXIT.                                                DTSCS61
00935                                                                   DTSCS61
00936                                                                   DTSCS61
00937  P8120-CONSTRUCT-MFAS.                                            DTSCS61
00938      MOVE LOW-VALUES TO MFAS-REC.                                 DTSCS61
00939      MOVE LCCM-EMP-NO TO MFAS-EMP-NO.                             DTSCS61
00940      SET MFAS-FAS-88 TO TRUE.                                     DTSCS61
00941      MOVE MHDR-LAST-USED-ASSIGN-NO TO MFAS-ASSIGN-NO              DTSCS61
00942                                       LCCM-ASSIGN-NO.             DTSCS61
00943      MOVE +0 TO MFAS-PURGE-DATE.                                  DTSCS61
00944                                                                   DTSCS61
00945      MOVE SPACES              TO WRK-L331-REC-OCC-ID.             DTSCS61
00946      MOVE MFAS-ASSIGN-NO      TO WRK-L331-ASSIGN-NO.              DTSCS61
00947      MOVE WRK-L331-REC-OCC-ID TO L331-REC-OCC-ID.                 DTSCS61
00948                                                                   DTSCS61
00949 *  INFORMATION RETURNED FROM L063 WILL BE NEEDED                  DTSCS61
00950      MOVE MAP-ASSIGN-TYPE TO L063-TYPE.                           DTSCS61
00951      PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT.           DTSCS61
00952                                                                   DTSCS61
00953      MOVE L063-AUDIT-IND TO MFAS-AUDIT-IND.                       DTSCS61
00954                                                                   DTSCS61
00955      MOVE L063-ACCOUNTING-DESK-IND                                DTSCS61
00956        TO MFAS-ACCOUNTING-DESK-IND.                               DTSCS61
00957                                                                   DTSCS61
00958      MOVE MAP-ASSIGN-TYPE TO MFAS-ASSIGN-TYPE.                    DTSCS61
00959      MOVE 'MFAS-ASSIGN-TYPE' TO L331-FIELD-NAME.                  DTSCS61
00960      MOVE SPACES             TO L331-FROM-VALUE.                  DTSCS61
00961      MOVE MFAS-ASSIGN-TYPE   TO L331-TO-VALUE.                    DTSCS61
00962      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS61
00963                                                                   DTSCS61
00964      SET MFAS-STATUS-ACTIVE-88 TO TRUE.                           DTSCS61
00965      MOVE 'MFAS-STATUS-CD'   TO L331-FIELD-NAME.                  DTSCS61
00966      MOVE SPACES             TO L331-FROM-VALUE.                  DTSCS61
00967      MOVE MFAS-STATUS-CD     TO L331-TO-VALUE.                    DTSCS61
00968      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS61
00969                                                                   DTSCS61
00970      MOVE MAP-FLD-REP-ID TO MFAS-FLD-REP-ID.                      DTSCS61
00971      MOVE 'MFAS-FLD-REP-ID'  TO L331-FIELD-NAME.                  DTSCS61
00972      MOVE SPACES             TO L331-FROM-VALUE.                  DTSCS61
00973      MOVE MFAS-FLD-REP-ID    TO L331-TO-VALUE.                    DTSCS61
00974      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS61
00975                                                                   DTSCS61
00976      MOVE MAP-ATTACHMENTS-IND TO MFAS-ATTACHMENTS-IND.            DTSCS61
00977                                                                   DTSCS61
00978      MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA.                DTSCS61
00979      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS61
00980      MOVE L015-DATE TO MFAS-START-DATE.                           DTSCS61
00981                                                                   DTSCS61
00982      MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA.                  DTSCS61
00983      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS61
00984      MOVE L015-DATE TO MFAS-DUE-DATE.                             DTSCS61
00985      MOVE 'MFAS-DUE-DATE'    TO L331-FIELD-NAME.                  DTSCS61
00986      MOVE SPACES             TO L331-FROM-VALUE.                  DTSCS61
00987      MOVE MFAS-DUE-DATE      TO L001-FED-8-DATE-9.                DTSCS61
00988      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS61
00989      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS61
00990      MOVE L001-SLASH-DATE    TO L331-TO-VALUE.                    DTSCS61
00991      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS61
00992                                                                   DTSCS61
00993      MOVE +0 TO MFAS-PROCESSED-DATE                               DTSCS61
00994                 MFAS-COMPLETED-DATE                               DTSCS61
00995                                                                   DTSCS61
00996      IF MAP-TAX-EXTRACT-YES                                       DTSCS61
00997         MOVE LCCM-CURR-RUN-DATE TO MFAS-TAX-DOWNLOAD-DATE         DTSCS61
00998      ELSE                                                         DTSCS61
00999         MOVE +0 TO MFAS-TAX-DOWNLOAD-DATE                         DTSCS61
01000      END-IF.                                                      DTSCS61
01001                                                                   DTSCS61
01002      IF MAP-WAGE-EXTRACT-YES                                      DTSCS61
01003         MOVE LCCM-CURR-RUN-DATE TO MFAS-WAGE-DOWNLOAD-DATE        DTSCS61
01004      ELSE                                                         DTSCS61
01005         MOVE +0 TO MFAS-WAGE-DOWNLOAD-DATE                        DTSCS61
01006      END-IF.                                                      DTSCS61
01007                                                                   DTSCS61
01008      MOVE MAP-SOURCE-OP-ID TO MFAS-SOURCE-OP-ID.                  DTSCS61
01009      MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA.               DTSCS61
01010      PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT.                 DTSCS61
01011      IF L020-NO-ENTRY                                             DTSCS61
01012         MOVE +0 TO MFAS-CLAIMANT-SSN                              DTSCS61
01013         MOVE SPACE TO MFAS-CLAIMANT-NAME                          DTSCS61
01014      ELSE                                                         DTSCS61
01015         MOVE MAP-CLAIMANT-NAME TO MFAS-CLAIMANT-NAME              DTSCS61
01016         MOVE L020-SSN TO MFAS-CLAIMANT-SSN                        DTSCS61
01017      END-IF.                                                      DTSCS61
01018                                                                   DTSCS61
01019      MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.          DTSCS61
01020      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS61
01021      MOVE L018-EMP-NO TO MFAS-RELATED-EMP-NO.                     DTSCS61
01022                                                                   DTSCS61
01023      IF MAP-NAICS-CD = LOW-VALUES OR SPACES                       DTSCS61
01024         MOVE SPACES TO MFAS-NAICS-CD                              DTSCS61
01025      ELSE                                                         DTSCS61
01026         MOVE MAP-NAICS-CD TO MFAS-NAICS-CD                        DTSCS61
01027      END-IF.                                                      DTSCS61
01028                                                                   DTSCS61
01029      IF MAP-SIC-CD = LOW-VALUES OR SPACES                         DTSCS61
01030         MOVE SPACES TO MFAS-SIC-CD                                DTSCS61
01031      ELSE                                                         DTSCS61
01032         MOVE MAP-SIC-CD TO MFAS-SIC-CD                            DTSCS61
01033      END-IF.                                                      DTSCS61
01034                                                                   DTSCS61
01035      IF MAP-OWN-CD = LOW-VALUES OR SPACES                         DTSCS61
01036         MOVE SPACES TO MFAS-OWN-CD                                DTSCS61
01037      ELSE                                                         DTSCS61
01038         MOVE MAP-OWN-CD TO MFAS-OWN-CD                            DTSCS61
01039      END-IF.                                                      DTSCS61
01040                                                                   DTSCS61
01041      MOVE MAP-EMP-SIZE-IND TO MFAS-EMP-SIZE-IND.                  DTSCS61
01042                                                                   DTSCS61
01043      MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA.      DTSCS61
01044      MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA.          DTSCS61
01045      PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT.                   DTSCS61
01046      IF L024-START-NO-ENTRY                                       DTSCS61
01047         MOVE +0 TO MFAS-START-YRQ                                 DTSCS61
01048      ELSE                                                         DTSCS61
01049         MOVE L024-START-YRQ TO MFAS-START-YRQ                     DTSCS61
01050      END-IF.                                                      DTSCS61
01051                                                                   DTSCS61
01052      IF L024-END-NO-ENTRY                                         DTSCS61
01053         MOVE +0 TO MFAS-END-YRQ                                   DTSCS61
01054      ELSE                                                         DTSCS61
01055         MOVE L024-END-YRQ TO MFAS-END-YRQ                         DTSCS61
01056      END-IF.                                                      DTSCS61
01057                                                                   DTSCS61
01058      PERFORM VARYING WRK-CTR FROM 1 BY 1                          DTSCS61
01059      UNTIL WRK-CTR > MMAX-FAS-SEL-MAX                             DTSCS61
01060         IF MAP-AUDIT-SEL-REASON(WRK-CTR) = LOW-VALUES OR SPACES   DTSCS61
01061            MOVE SPACES TO MFAS-AUDIT-SEL-REASON (WRK-CTR)         DTSCS61
01062         ELSE                                                      DTSCS61
01063            MOVE MAP-AUDIT-SEL-REASON(WRK-CTR)                     DTSCS61
01064              TO MFAS-AUDIT-SEL-REASON(WRK-CTR)                    DTSCS61
01065            MOVE WRK-CTR TO MFAS-SEL-CNT                           DTSCS61
01066         END-IF                                                    DTSCS61
01067      END-PERFORM                                                  DTSCS61
01068                                                                   DTSCS61
01069      MOVE LCCM-CURR-RUN-DATE TO MFAS-ESTB-DATE                    DTSCS61
01070                                 MFAS-CHNG-DATE                    DTSCS61
01071      SET MFAS-NOT-CONVERTED-88 TO TRUE.                           DTSCS61
01072      MOVE +0       TO MFAS-TEXT-CNT.                              DTSCS61
01073                                                                   DTSCS61
01074      PERFORM P8126-TEXT THRU P8126-EXIT                           DTSCS61
01075      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS61
01076       UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX.                          DTSCS61
01077                                                                   DTSCS61
01078                                                                   DTSCS61
01079      MOVE MFAS-REC TO MSKL-REC.                                   DTSCS61
01080      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS61
01081                                                                   DTSCS61
01082 *****                                                             DTSCS61
01083 *                                                                 DTSCS61
01084 *****                                                             DTSCS61
01085      IF MAP-TAX-EXTRACT-YES                                       DTSCS61
01086         SET T021-DOWNLOAD-TAX TO TRUE                             DTSCS61
01087         PERFORM P9100-CREATE-T021 THRU P9100-EXIT.                DTSCS61
01088                                                                   DTSCS61
01089      IF MAP-WAGE-EXTRACT-YES                                      DTSCS61
01090         SET T021-DOWNLOAD-WAGE TO TRUE                            DTSCS61
01091         PERFORM P9100-CREATE-T021 THRU P9100-EXIT.                DTSCS61
01092                                                                   DTSCS61
01093  P8120-EXIT.                                                      DTSCS61
01094      EXIT.                                                        DTSCS61
01095                                                                   DTSCS61
01096  P8126-TEXT.                                                      DTSCS61
01097      IF MAP-TEXT(WRK-CTR) EQUAL LOW-VALUES OR SPACES              DTSCS61
01098         MOVE SPACES TO MFAS-TEXT(WRK-CTR)                         DTSCS61
01099      ELSE                                                         DTSCS61
01100         MOVE MAP-TEXT(WRK-CTR) TO MFAS-TEXT(WRK-CTR)              DTSCS61
01101         MOVE WRK-CTR TO MFAS-TEXT-CNT.                            DTSCS61
01102  P8126-EXIT. EXIT.                                                DTSCS61
01103                                                                   DTSCS61
01104  P8130-MEVL-WRITE.                                                DTSCS61
01105      MOVE LOW-VALUES TO MEVL-REC.                                 DTSCS61
01106                                                                   DTSCS61
01107      MOVE WRK-EMP-NO TO MEVL-EMP-NO.                              DTSCS61
01108      SET MEVL-EVL-88 TO TRUE.                                     DTSCS61
01109      MOVE LCCM-TASK-START-DATE TO MEVL-DATE.                      DTSCS61
01110      MOVE LCCM-TASK-START-TIME TO MEVL-TIME.                      DTSCS61
01111                                                                   DTSCS61
01112      MOVE +0 TO MEVL-PURGE-DATE.                                  DTSCS61
01113                                                                   DTSCS61
01114      MOVE MFAS-ASSIGN-NO TO EVL-ASSIGN-NO.                        DTSCS61
01115      MOVE EVL-TEXT TO MEVL-TEXT.                                  DTSCS61
01116      MOVE LCCM-OP-ID TO MEVL-SOURCE.                              DTSCS61
01117      SET MEVL-NOT-CONVERTED-88 TO TRUE.                           DTSCS61
01118      MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE                    DTSCS61
01119                                 MEVL-CHNG-DATE.                   DTSCS61
01120                                                                   DTSCS61
01121      MOVE MEVL-REC TO MSKL-REC.                                   DTSCS61
01122      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS61
01123  P8130-EXIT.                                                      DTSCS61
01124      EXIT.                                                        DTSCS61
01125                                                                   DTSCS61
01126  P8140-UPDATE-MPRF.                                               DTSCS61
01127      PERFORM S1110-READ-MPRF         THRU S1110-EXIT.             DTSCS61
01128                                                                   DTSCS61
01129      SET MPRF-MFAS-EXISTS-88 TO TRUE.                             DTSCS61
01130      MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.                   DTSCS61
01131                                                                   DTSCS61
01132      MOVE MPRF-REC TO MSKL-REC.                                   DTSCS61
01133      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS61
01134                                                                   DTSCS61
01135  P8140-EXIT.                                                      DTSCS61
01136      EXIT.                                                        DTSCS61
01137                                                                   DTSCS61
01138                                                                   DTSCS61
01139 *P8150-FIELD-MEMO.                                                DTSCS61
01140 *****MOVE MFAS-EMP-NO TO L351-EMP-NO.                             DTSCS61
01141 *****MOVE MFAS-ASSIGN-NO TO L351-ASSIGN-NO.                       DTSCS61
01142 *****MOVE MAP-PRINTER-ID TO L351-PRINTER-ID.                      DTSCS61
01143 *****MOVE MAP-COPIES TO L351-COPY-CNT.                            DTSCS61
01144 *****MOVE LCCM-TASK-START-DISP-DATE TO L351-TASK-START-DISP-DATE. DTSCS61
01145 *****MOVE LCCM-TASK-START-DISP-TIME TO L351-TASK-START-DISP-TIME. DTSCS61
01146 *****MOVE LCCM-TS-NAME-PREFIX       TO L351-TS-NAME-PREFIX.       DTSCS61
01147                                                                   DTSCS61
01148 *****PERFORM S351-PRINT THRU S351-EXIT.                           DTSCS61
01149                                                                   DTSCS61
01150 *****IF L351-PRINT-FAILED                                         DTSCS61
01151 ********MOVE ' (BUT THE PRINT FAILED!)' TO WRK-PRINTER-MSG.       DTSCS61
01152 *P8150-EXIT. EXIT.                                                DTSCS61
01153                                                                   DTSCS61
01154  P8810-LOCK-EMPLOYER.                                             DTSCS61
01155      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS61
01156      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS61
01157      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS61
01158      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS61
01159      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS61
01160      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS61
01161      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS61
01162      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS61
01163      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS61
01164                                                                   DTSCS61
01165      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS61
01166  P8810-EXIT.                                                      DTSCS61
01167      EXIT.                                                        DTSCS61
01168      EJECT                                                        DTSCS61
01169                                                                   DTSCS61
01170  P8900-INITIALIZE-L331.                                           DTSCS61
01171      MOVE WRK-EMP-NO TO L331-EMP-NO.                              DTSCS61
01172                                                                   DTSCS61
01173      MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.               DTSCS61
01174                                                                   DTSCS61
01175      MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME.         DTSCS61
01176                                                                   DTSCS61
01177      MOVE LCCM-OP-ID TO L331-OP-ID.                               DTSCS61
01178                                                                   DTSCS61
01179  P8900-EXIT.                                                      DTSCS61
01180      EXIT.                                                        DTSCS61
01181                                                                   DTSCS61
01182 *                                                                 DTSCS61
01183  P9100-CREATE-T021.                                               DTSCS61
01184      MOVE WRK-EMP-NO TO T021-EMP-NO.                              DTSCS61
01185      MOVE LCCM-OP-ID TO T021-OP-ID.                               DTSCS61
01186      MOVE WRK-SCR-ID TO T021-SCR-ID.                              DTSCS61
01187      MOVE LCCM-TASK-START-DATE TO T021-SYS-DATE.                  DTSCS61
01188      MOVE LCCM-TASK-START-TIME TO T021-SYS-TIME.                  DTSCS61
01189      MOVE MFAS-ASSIGN-NO TO T021-ASSIGN-NO.                       DTSCS61
01190      MOVE LENGTH OF T021-REC TO T021-LENGTH.                      DTSCS61
01191      MOVE T021-REC TO RSKL-REC.                                   DTSCS61
01192      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS61
01193  P9100-EXIT.                                                      DTSCS61
01194      EXIT.                                                        DTSCS61
01195                                                                   DTSCS61
01196 /*****************************************************************DTSCS61
01197 * LINKS TO UTILITY MODULES                                        DTSCS61
01198 ******************************************************************DTSCS61
01199                                                                   DTSCS61
01200  S001-FROM-FED-8.                                                 DTSCS61
01201      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS61
01202      GO TO S001-DATE.                                             DTSCS61
01203                                                                   DTSCS61
01204  S001-FROM-ABS-DATE.                                              DTSCS61
01205      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS61
01206      GO TO S001-DATE.                                             DTSCS61
01207                                                                   DTSCS61
01208  S001-DATE.                                                       DTSCS61
01209      EXEC CICS LINK                                               DTSCS61
01210          PROGRAM('DTSCU001')                                      DTSCS61
01211          COMMAREA(L001-COMM-AREA)                                 DTSCS61
01212      END-EXEC.                                                    DTSCS61
01213  S001-EXIT.                                                       DTSCS61
01214      EXIT.                                                        DTSCS61
01215                                                                   DTSCS61
01216  S004-FROM-5.                                                     DTSCS61
01217      SET L004-FROM-5 TO TRUE.                                     DTSCS61
01218      GO TO S004-YRQ.                                              DTSCS61
01219                                                                   DTSCS61
01220  S004-FROM-ABS.                                                   DTSCS61
01221      SET L004-FROM-ABS TO TRUE.                                   DTSCS61
01222      GO TO S004-YRQ.                                              DTSCS61
01223                                                                   DTSCS61
01224  S004-FROM-DATE.                                                  DTSCS61
01225      SET L004-FROM-DATE TO TRUE.                                  DTSCS61
01226      GO TO S004-YRQ.                                              DTSCS61
01227                                                                   DTSCS61
01228  S004-YRQ.                                                        DTSCS61
01229      EXEC CICS LINK                                               DTSCS61
01230          PROGRAM('DTSCU004')                                      DTSCS61
01231          COMMAREA(L004-COMM-AREA)                                 DTSCS61
01232      END-EXEC.                                                    DTSCS61
01233  S004-EXIT.                                                       DTSCS61
01234      EXIT.                                                        DTSCS61
01235                                                                   DTSCS61
01236  S015-DATE-FROM-SCREEN.                                           DTSCS61
01237      EXEC CICS LINK                                               DTSCS61
01238          PROGRAM('DTSCU015')                                      DTSCS61
01239          COMMAREA(L015-COMM-AREA)                                 DTSCS61
01240      END-EXEC.                                                    DTSCS61
01241  S015-EXIT.                                                       DTSCS61
01242      EXIT.                                                        DTSCS61
01243                                                                   DTSCS61
01244  S018-EMP-NO-FROM-SCREEN.                                         DTSCS61
01245      EXEC CICS LINK                                               DTSCS61
01246          PROGRAM('DTSCU018')                                      DTSCS61
01247          COMMAREA(L018-COMM-AREA)                                 DTSCS61
01248      END-EXEC.                                                    DTSCS61
01249  S018-EXIT.                                                       DTSCS61
01250      EXIT.                                                        DTSCS61
01251                                                                   DTSCS61
01252  S020-SSN-FROM-SCREEN.                                            DTSCS61
01253      EXEC CICS LINK                                               DTSCS61
01254          PROGRAM('DTSCU020')                                      DTSCS61
01255          COMMAREA(L020-COMM-AREA)                                 DTSCS61
01256      END-EXEC.                                                    DTSCS61
01257  S020-EXIT.                                                       DTSCS61
01258      EXIT.                                                        DTSCS61
01259                                                                   DTSCS61
01260  S024-EDIT-QTR-SPAN.                                              DTSCS61
01261      SET L024-END-REQUIRED TO TRUE.                               DTSCS61
01262      EXEC CICS LINK                                               DTSCS61
01263          PROGRAM('DTSCU024')                                      DTSCS61
01264          COMMAREA(L024-COMM-AREA)                                 DTSCS61
01265      END-EXEC.                                                    DTSCS61
01266  S024-EXIT.                                                       DTSCS61
01267      EXIT.                                                        DTSCS61
01268                                                                   DTSCS61
01269  S036-EMP-SIZE.                                                   DTSCS61
01270      SET L036-MFAS-EMP-SIZE-IND TO TRUE.                          DTSCS61
01271      GO TO S036-FS-EDIT-DSCR.                                     DTSCS61
01272                                                                   DTSCS61
01273  S036-AUDIT-SEL-REASON.                                           DTSCS61
01274      SET L036-MFAS-AUDIT-SEL-REASON TO TRUE.                      DTSCS61
01275      GO TO S036-FS-EDIT-DSCR.                                     DTSCS61
01276                                                                   DTSCS61
01277  S036-FS-EDIT-DSCR.                                               DTSCS61
01278      EXEC CICS LINK                                               DTSCS61
01279          PROGRAM('DTSCU036')                                      DTSCS61
01280          COMMAREA(L036-COMM-AREA)                                 DTSCS61
01281      END-EXEC.                                                    DTSCS61
01282  S036-EXIT.                                                       DTSCS61
01283      EXIT.                                                        DTSCS61
01284                                                                   DTSCS61
01285 *S039-SIC-OWN-CODE-EDIT.                                          DTSCS61
01286 *****EXEC CICS LINK                                               DTSCS61
01287 *****    PROGRAM('MACCU039')                                      DTSCS61
01288 *****    COMMAREA(L039-COMM-AREA)                                 DTSCS61
01289 *****    LENGTH(L039-LENGTH)                                      DTSCS61
01290 *****END-EXEC.                                                    DTSCS61
01291 *****                                                             DTSCS61
01292 *****IF L039-SIC-FILE-CLOSED                                      DTSCS61
01293 *****    MOVE L039-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01294 *****    SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01295 *****    SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01296 *****    GO TO MAINLINE-EXIT.                                     DTSCS61
01297 *****                                                             DTSCS61
01298 *S039-EXIT.                                                       DTSCS61
01299 *****EXIT.                                                        DTSCS61
01300                                                                   DTSCS61
01301  S061-FIELD-ZIP-REP-ID.                                           DTSCS61
01302      EXEC CICS LINK                                               DTSCS61
01303          PROGRAM('DTSCU061')                                      DTSCS61
01304          COMMAREA(L061-COMM-AREA)                                 DTSCS61
01305      END-EXEC.                                                    DTSCS61
01306                                                                   DTSCS61
01307      IF L061-FILE-CLOSED                                          DTSCS61
01308          MOVE L061-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01309          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01310          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01311          GO TO MAINLINE-EXIT.                                     DTSCS61
01312                                                                   DTSCS61
01313  S061-EXIT.                                                       DTSCS61
01314      EXIT.                                                        DTSCS61
01315                                                                   DTSCS61
01316  S062-FLD-REP-ID-DESC.                                            DTSCS61
01317      EXEC CICS LINK                                               DTSCS61
01318          PROGRAM('DTSCU062')                                      DTSCS61
01319          COMMAREA(L062-COMM-AREA)                                 DTSCS61
01320      END-EXEC.                                                    DTSCS61
01321                                                                   DTSCS61
01322      IF L062-FILE-CLOSED                                          DTSCS61
01323          MOVE L062-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01324          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01325          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01326          GO TO MAINLINE-EXIT.                                     DTSCS61
01327                                                                   DTSCS61
01328  S062-EXIT.                                                       DTSCS61
01329      EXIT.                                                        DTSCS61
01330                                                                   DTSCS61
01331  S063-FIELD-ASSIGNMENT-EDIT.                                      DTSCS61
01332      EXEC CICS LINK                                               DTSCS61
01333          PROGRAM('DTSCU063')                                      DTSCS61
01334          COMMAREA(L063-COMM-AREA)                                 DTSCS61
01335      END-EXEC.                                                    DTSCS61
01336                                                                   DTSCS61
01337      IF L063-FILE-CLOSED                                          DTSCS61
01338          MOVE L063-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01339          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01340          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01341          GO TO MAINLINE-EXIT.                                     DTSCS61
01342                                                                   DTSCS61
01343  S063-EXIT.                                                       DTSCS61
01344      EXIT.                                                        DTSCS61
01345                                                                   DTSCS61
01346  S071-FROM-LAST-NAME-FIRST.                                       DTSCS61
01347      SET L071-FROM-LAST-NAME-FIRST TO TRUE.                       DTSCS61
01348      GO TO S071-NAME-EDIT.                                        DTSCS61
01349                                                                   DTSCS61
01350  S071-NAME-EDIT.                                                  DTSCS61
01351      EXEC CICS LINK                                               DTSCS61
01352          PROGRAM('DTSCU071')                                      DTSCS61
01353          COMMAREA(L071-COMM-AREA)                                 DTSCS61
01354      END-EXEC.                                                    DTSCS61
01355  S071-EXIT.                                                       DTSCS61
01356      EXIT.                                                        DTSCS61
01357                                                                   DTSCS61
01358  S081-CLAIMANT-NAME.                                              DTSCS61
01359      EXEC CICS LINK                                               DTSCS61
01360          PROGRAM('DTSCU081')                                      DTSCS61
01361          COMMAREA(L081-COMM-AREA)                                 DTSCS61
01362      END-EXEC.                                                    DTSCS61
01363                                                                   DTSCS61
01364      IF L081-FILE-CLOSED                                          DTSCS61
01365          MOVE L081-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01366          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01367          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01368          GO TO MAINLINE-EXIT.                                     DTSCS61
01369                                                                   DTSCS61
01370  S081-EXIT.                                                       DTSCS61
01371      EXIT.                                                        DTSCS61
01372                                                                   DTSCS61
01373  S082-OP-ID-EDIT.                                                 DTSCS61
01374      EXEC CICS LINK                                               DTSCS61
01375          PROGRAM('DTSCU082')                                      DTSCS61
01376          COMMAREA(L082-COMM-AREA)                                 DTSCS61
01377      END-EXEC.                                                    DTSCS61
01378                                                                   DTSCS61
01379      IF L082-FILE-CLOSED                                          DTSCS61
01380          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01381          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01382          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01383          GO TO MAINLINE-EXIT.                                     DTSCS61
01384                                                                   DTSCS61
01385  S082-EXIT.                                                       DTSCS61
01386      EXIT.                                                        DTSCS61
01387                                                                   DTSCS61
01388  S221-EMP-LOCK.                                                   DTSCS61
01389      SET L221-START-UPDATE TO TRUE.                               DTSCS61
01390      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS61
01391                                                                   DTSCS61
01392  S221-EMP-UNLOCK.                                                 DTSCS61
01393      SET L221-END-UPDATE TO TRUE.                                 DTSCS61
01394      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS61
01395                                                                   DTSCS61
01396  S221-EMP-LOCK-UNLOCK.                                            DTSCS61
01397      EXEC CICS LINK                                               DTSCS61
01398          PROGRAM('DTSCU221')                                      DTSCS61
01399          COMMAREA(L221-COMM-AREA)                                 DTSCS61
01400      END-EXEC.                                                    DTSCS61
01401                                                                   DTSCS61
01402      IF L221-FILE-CLOSED                                          DTSCS61
01403          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01404          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01405          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01406          GO TO MAINLINE-EXIT.                                     DTSCS61
01407                                                                   DTSCS61
01408      IF L221-NOT-OK                                               DTSCS61
01409          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS61
01410  S221-EXIT.                                                       DTSCS61
01411      EXIT.                                                        DTSCS61
01412                                                                   DTSCS61
01413  S331-WRITE-MLOG.                                                 DTSCS61
01414      EXEC CICS LINK                                               DTSCS61
01415          PROGRAM('DTSCU331')                                      DTSCS61
01416          COMMAREA(L331-COMM-AREA)                                 DTSCS61
01417      END-EXEC.                                                    DTSCS61
01418                                                                   DTSCS61
01419      IF L331-FILE-CLOSED                                          DTSCS61
01420          MOVE L331-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01421          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01422          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01423          GO TO MAINLINE-EXIT.                                     DTSCS61
01424                                                                   DTSCS61
01425  S331-EXIT.                                                       DTSCS61
01426      EXIT.                                                        DTSCS61
01427                                                                   DTSCS61
01428 *S351-PRINT.                                                      DTSCS61
01429 *****EXEC CICS LINK                                               DTSCS61
01430 *********PROGRAM('DTSCU351')                                      DTSCS61
01431 *********COMMAREA(L351-COMM-AREA)                                 DTSCS61
01432 *****END-EXEC.                                                    DTSCS61
01433 *S351-EXIT.                                                       DTSCS61
01434 *****EXIT.                                                        DTSCS61
01435                                                                   DTSCS61
01436  S803-REQ-SCR-ID-EDIT.                                            DTSCS61
01437      EXEC CICS LINK                                               DTSCS61
01438          PROGRAM ('DTSCU803')                                     DTSCS61
01439          COMMAREA (DFHCOMMAREA)                                   DTSCS61
01440      END-EXEC.                                                    DTSCS61
01441  S803-EXIT.                                                       DTSCS61
01442      EXIT.                                                        DTSCS61
01443                                                                   DTSCS61
01444  S804-INVALID-KEY.                                                DTSCS61
01445      EXEC CICS LINK                                               DTSCS61
01446          PROGRAM ('DTSCU804')                                     DTSCS61
01447          COMMAREA (DFHCOMMAREA)                                   DTSCS61
01448      END-EXEC.                                                    DTSCS61
01449  S804-EXIT.                                                       DTSCS61
01450      EXIT.                                                        DTSCS61
01451                                                                   DTSCS61
01452  S805-MSG-AREA.                                                   DTSCS61
01453      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS61
01454                                                                   DTSCS61
01455      EXEC CICS LINK                                               DTSCS61
01456          PROGRAM ('DTSCU805')                                     DTSCS61
01457          COMMAREA (L805-COMM-AREA)                                DTSCS61
01458      END-EXEC.                                                    DTSCS61
01459                                                                   DTSCS61
01460      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS61
01461  S805-EXIT.                                                       DTSCS61
01462      EXIT.                                                        DTSCS61
01463      EJECT                                                        DTSCS61
01464  S810-READ.                                                       DTSCS61
01465      SET L810-READ-88 TO TRUE.                                    DTSCS61
01466      GO TO S810-IO.                                               DTSCS61
01467                                                                   DTSCS61
01468  S810-START-BROWSE.                                               DTSCS61
01469      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS61
01470      GO TO S810-IO.                                               DTSCS61
01471                                                                   DTSCS61
01472  S810-READ-NEXT.                                                  DTSCS61
01473      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS61
01474      GO TO S810-IO.                                               DTSCS61
01475                                                                   DTSCS61
01476  S810-READ-PREV.                                                  DTSCS61
01477      SET L810-READ-PREV-88 TO TRUE.                               DTSCS61
01478      GO TO S810-IO.                                               DTSCS61
01479                                                                   DTSCS61
01480  S810-END-BROWSE.                                                 DTSCS61
01481      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS61
01482      GO TO S810-IO.                                               DTSCS61
01483                                                                   DTSCS61
01484  S810-COUNT.                                                      DTSCS61
01485      SET L810-COUNT-88 TO TRUE.                                   DTSCS61
01486      GO TO S810-IO.                                               DTSCS61
01487                                                                   DTSCS61
01488  S810-REWRITE.                                                    DTSCS61
01489      SET L810-REWRITE-88 TO TRUE.                                 DTSCS61
01490      GO TO S810-IO.                                               DTSCS61
01491                                                                   DTSCS61
01492  S810-WRITE.                                                      DTSCS61
01493      SET L810-WRITE-88 TO TRUE.                                   DTSCS61
01494      GO TO S810-IO.                                               DTSCS61
01495                                                                   DTSCS61
01496  S810-READ-UPDATE.                                                DTSCS61
01497      SET L810-READ-UPDATE-88 TO TRUE.                             DTSCS61
01498      GO TO S810-IO.                                               DTSCS61
01499                                                                   DTSCS61
01500  S810-REWRITE-UPDATE.                                             DTSCS61
01501      SET L810-REWRITE-UPDATE-88 TO TRUE.                          DTSCS61
01502      GO TO S810-IO.                                               DTSCS61
01503                                                                   DTSCS61
01504  S810-DELETE.                                                     DTSCS61
01505      SET L810-DELETE-88 TO TRUE.                                  DTSCS61
01506      GO TO S810-IO.                                               DTSCS61
01507                                                                   DTSCS61
01508  S810-IO.                                                         DTSCS61
01509                                                                   DTSCS61
01510      EXEC CICS LINK                                               DTSCS61
01511          PROGRAM ('DTSCU810')                                     DTSCS61
01512          COMMAREA (L810-COMM-AREA)                                DTSCS61
01513      END-EXEC.                                                    DTSCS61
01514                                                                   DTSCS61
01515      IF L810-FILE-CLOSED-88                                       DTSCS61
01516          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01517          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01518          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01519          GO TO MAINLINE-EXIT.                                     DTSCS61
01520  S810-EXIT.                                                       DTSCS61
01521      EXIT.                                                        DTSCS61
01522      EJECT                                                        DTSCS61
01523  S825-WRITE.                                                      DTSCS61
01524      SET L825-WRITE-88 TO TRUE.                                   DTSCS61
01525      GO TO S825-O.                                                DTSCS61
01526                                                                   DTSCS61
01527  S825-O.                                                          DTSCS61
01528                                                                   DTSCS61
01529                                                                   DTSCS61
01530      EXEC CICS LINK                                               DTSCS61
01531          PROGRAM ('DTSCU825')                                     DTSCS61
01532          COMMAREA (L825-COMM-AREA)                                DTSCS61
01533      END-EXEC.                                                    DTSCS61
01534                                                                   DTSCS61
01535      IF L825-FILE-CLOSED-88                                       DTSCS61
01536          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS61
01537          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS61
01538          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS61
01539          GO TO MAINLINE-EXIT.                                     DTSCS61
01540  S825-EXIT.                                                       DTSCS61
01541      EXIT.                                                        DTSCS61
01542      EJECT                                                        DTSCS61
01543  S851-SCREEN-PROCESSING.                                          DTSCS61
01544      EXEC CICS LINK                                               DTSCS61
01545          PROGRAM ('DTSCU851')                                     DTSCS61
01546          COMMAREA (L851-COMM-AREA)                                DTSCS61
01547      END-EXEC.                                                    DTSCS61
01548  S851-EXIT.                                                       DTSCS61
01549      EXIT.                                                        DTSCS61
01550                                                                   DTSCS61
01551  S899-ABEND.                                                      DTSCS61
01552      EXEC CICS ABEND                                              DTSCS61
01553          ABCODE(WRK-ABEND-CD)                                     DTSCS61
01554      END-EXEC.                                                    DTSCS61
01555  S899-EXIT.                                                       DTSCS61
01556      EXIT.                                                        DTSCS61
01557 /*****************************************************************DTSCS61
01558 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS61
01559 ******************************************************************DTSCS61
01560                                                                   DTSCS61
01561  S1000-SCREEN-EDITS.                                              DTSCS61
01562      PERFORM S1101-EMP-NO THRU S1101-EXIT.                        DTSCS61
01563      IF LCCM-MSG                                                  DTSCS61
01564         GO TO S1000-EXIT.                                         DTSCS61
01565                                                                   DTSCS61
01566      PERFORM S1200-ASSIGN-TYPE THRU S1200-EXIT.                   DTSCS61
01567      IF LCCM-MSG                                                  DTSCS61
01568         GO TO S1000-EXIT.                                         DTSCS61
01569                                                                   DTSCS61
01570      PERFORM S1300-ADD-OPEN-IND THRU S1300-EXIT.                  DTSCS61
01571      PERFORM S1400-START-DATE THRU S1400-EXIT.                    DTSCS61
01572      PERFORM S1500-DUE-DATE THRU S1500-EXIT.                      DTSCS61
01573      PERFORM S1600-FLD-REP-ID THRU S1600-EXIT.                    DTSCS61
01574      PERFORM S1700-ATTACHMENTS THRU S1700-EXIT.                   DTSCS61
01575      PERFORM S1800-SOURCE-OP-ID THRU S1800-EXIT.                  DTSCS61
01576      PERFORM S1900-EMP-SIZE-IND  THRU S1900-EXIT                  DTSCS61
01577      PERFORM S2000-AUDIT-SEL-REASON THRU S2000-EXIT               DTSCS61
01578      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS61
01579       UNTIL WRK-CTR > MMAX-FAS-SEL-MAX.                           DTSCS61
01580      SKIP1                                                        DTSCS61
01581      PERFORM S2100-TAX-EXTRACT THRU S2100-EXIT.                   DTSCS61
01582      PERFORM S2200-WAGE-EXTRACT THRU S2200-EXIT.                  DTSCS61
01583      PERFORM S2300-QTR-RANGE THRU S2300-EXIT                      DTSCS61
01584      PERFORM S2400-SIC-NAICS-OWN THRU S2400-EXIT.                 DTSCS61
01585      PERFORM S2500-RELATED-EMP-NO THRU S2500-EXIT.                DTSCS61
01586      PERFORM S2600-CLAIMANT-SSN THRU S2600-EXIT.                  DTSCS61
01587      PERFORM S2700-CLAIMANT-NAME THRU S2700-EXIT.                 DTSCS61
01588      SKIP1                                                        DTSCS61
01589      PERFORM S2800-TEXT THRU S2800-EXIT                           DTSCS61
01590      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS61
01591       UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX.                          DTSCS61
01592      SKIP1                                                        DTSCS61
01593                                                                   DTSCS61
01594      PERFORM S3000-MISC-EDITS THRU S3000-EXIT.                    DTSCS61
01595  S1000-EXIT. EXIT.                                                DTSCS61
01596      EJECT                                                        DTSCS61
01597  S1100-EDIT-KEY.                                                  DTSCS61
01598      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS61
01599  S1100-EXIT. EXIT.                                                DTSCS61
01600 /*****************************************************************DTSCS61
01601 *                                                                 DTSCS61
01602 ******************************************************************DTSCS61
01603  S1101-EMP-NO.                                                    DTSCS61
01604      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS61
01605      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS61
01606                                                                   DTSCS61
01607      IF L018-NO-ENTRY                                             DTSCS61
01608         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS61
01609         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS61
01610         GO TO S1101-EXIT.                                         DTSCS61
01611                                                                   DTSCS61
01612      IF L018-NOT-VALID                                            DTSCS61
01613         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS61
01614         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS61
01615         GO TO S1101-EXIT.                                         DTSCS61
01616                                                                   DTSCS61
01617      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS61
01618      PERFORM S1110-READ-MPRF         THRU S1110-EXIT.             DTSCS61
01619  S1101-EXIT. EXIT.                                                DTSCS61
01620                                                                   DTSCS61
01621  S1110-READ-MPRF.                                                 DTSCS61
01622      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS61
01623      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS61
01624      SET MPRF-PRF-88 TO TRUE.                                     DTSCS61
01625      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS61
01626      PERFORM S810-READ THRU S810-EXIT.                            DTSCS61
01627      IF L810-NO-REC-88                                            DTSCS61
01628          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS61
01629          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS61
01630      ELSE                                                         DTSCS61
01631          MOVE MSKL-REC TO MPRF-REC                                DTSCS61
01632          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS61
01633          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS61
01634  S1110-EXIT.                                                      DTSCS61
01635      EXIT.                                                        DTSCS61
01636                                                                   DTSCS61
01637  S1199-ERROR.                                                     DTSCS61
01638      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS61
01639                                         MAP-EMP-NO-2-A.           DTSCS61
01640      IF LCCM-NO-MSG                                               DTSCS61
01641         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01642         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS61
01643         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L.           DTSCS61
01644  S1199-EXIT. EXIT.                                                DTSCS61
01645 /*****************************************************************DTSCS61
01646 *                                                                *DTSCS61
01647 ******************************************************************DTSCS61
01648  S1200-ASSIGN-TYPE.                                               DTSCS61
01649                                                                   DTSCS61
01650      MOVE SPACES TO MAP-ASSIGN-TYPE-DESC.                         DTSCS61
01651                                                                   DTSCS61
01652      IF MAP-ASSIGN-TYPE EQUAL LOW-VALUES OR SPACES                DTSCS61
01653         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS61
01654         PERFORM S1201-ERROR THRU S1201-EXIT                       DTSCS61
01655      ELSE                                                         DTSCS61
01656         MOVE MAP-ASSIGN-TYPE TO L063-TYPE                         DTSCS61
01657         PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT         DTSCS61
01658         IF L063-NOT-VALID                                         DTSCS61
01659            MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA            DTSCS61
01660            PERFORM S1201-ERROR   THRU S1201-EXIT                  DTSCS61
01661         ELSE                                                      DTSCS61
01662            MOVE L063-DESCRIPTION TO MAP-ASSIGN-TYPE-DESC          DTSCS61
01663            PERFORM S1210-CROSS-EDITS THRU S1210-EXIT.             DTSCS61
01664                                                                   DTSCS61
01665  S1200-EXIT. EXIT.                                                DTSCS61
01666                                                                   DTSCS61
01667  S1201-ERROR.                                                     DTSCS61
01668      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-TYPE-A.        DTSCS61
01669      IF LCCM-NO-MSG                                               DTSCS61
01670         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01671         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
01672         MOVE CATB-CURSOR              TO MAP-ASSIGN-TYPE-L.       DTSCS61
01673  S1201-EXIT. EXIT.                                                DTSCS61
01674                                                                   DTSCS61
01675  S1210-CROSS-EDITS.                                               DTSCS61
01676      IF L063-AUDIT-88                                             DTSCS61
01677          IF (MPRF-CLASS-CHG-ONLY-88)                              DTSCS61
01678                OR                                                 DTSCS61
01679             (MPRF-CLASS-SELF-INS-88)                              DTSCS61
01680                OR                                                 DTSCS61
01681             (MPRF-BANKRP-OPEN-88)                                 DTSCS61
01682              MOVE MSG-E612-AREA TO WRK-MSG-AREA                   DTSCS61
01683              PERFORM S1201-ERROR THRU S1201-EXIT.                 DTSCS61
01684  S1210-EXIT.                                                      DTSCS61
01685      EXIT.                                                        DTSCS61
01686 /*****************************************************************DTSCS61
01687 *                                                                *DTSCS61
01688 ******************************************************************DTSCS61
01689  S1300-ADD-OPEN-IND.                                              DTSCS61
01690      IF (MAP-ADD-OPEN-IND = LOW-VALUES OR SPACES)                 DTSCS61
01691         MOVE 'N' TO MAP-ADD-OPEN-IND                              DTSCS61
01692      ELSE                                                         DTSCS61
01693      IF MAP-ADD-OPEN-IND-VALID                                    DTSCS61
01694         NEXT SENTENCE                                             DTSCS61
01695      ELSE                                                         DTSCS61
01696         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS61
01697         PERFORM S1301-ERROR THRU S1301-EXIT.                      DTSCS61
01698                                                                   DTSCS61
01699  S1300-EXIT. EXIT.                                                DTSCS61
01700                                                                   DTSCS61
01701  S1301-ERROR.                                                     DTSCS61
01702      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADD-OPEN-IND-A.        DTSCS61
01703      IF LCCM-NO-MSG                                               DTSCS61
01704         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01705         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
01706         MOVE CATB-CURSOR              TO MAP-ADD-OPEN-IND-L.      DTSCS61
01707  S1301-EXIT. EXIT.                                                DTSCS61
01708 /*****************************************************************DTSCS61
01709 *                                                                *DTSCS61
01710 ******************************************************************DTSCS61
01711  S1400-START-DATE.                                                DTSCS61
01712      SET WRK-START-DATE-ERROR-NO TO TRUE.                         DTSCS61
01713      MOVE +0 TO WRK-START-DATE.                                   DTSCS61
01714                                                                   DTSCS61
01715      MOVE MAP-START-DATE-AREA TO L015-S-DATE-AREA.                DTSCS61
01716      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS61
01717                                                                   DTSCS61
01718      IF L015-NO-ENTRY                                             DTSCS61
01719         IF L063-VERIF-AUDIT-88                                    DTSCS61
01720            PERFORM S1450-NEXT-QTR THRU S1450-EXIT                 DTSCS61
01721         ELSE                                                      DTSCS61
01722            MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY                 DTSCS61
01723                                       WRK-START-DATE              DTSCS61
01724         END-IF                                                    DTSCS61
01725         MOVE WRK-DISPLAY-MO TO MAP-START-DATE-MO                  DTSCS61
01726         MOVE WRK-DISPLAY-DA TO MAP-START-DATE-DA                  DTSCS61
01727         MOVE WRK-DISPLAY-YR TO MAP-START-DATE-YR                  DTSCS61
01728      ELSE                                                         DTSCS61
01729      IF L015-NOT-VALID                                            DTSCS61
01730         MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS61
01731         PERFORM S1401-ERROR    THRU S1401-EXIT                    DTSCS61
01732      ELSE                                                         DTSCS61
01733         MOVE L015-DATE TO WRK-START-DATE.                         DTSCS61
01734  S1400-EXIT. EXIT.                                                DTSCS61
01735                                                                   DTSCS61
01736  S1401-ERROR.                                                     DTSCS61
01737      SET WRK-START-DATE-ERROR-YES TO TRUE.                        DTSCS61
01738      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-START-DATE-MO-A       DTSCS61
01739                              MAP-START-DATE-DA-A                  DTSCS61
01740                              MAP-START-DATE-YR-A.                 DTSCS61
01741      IF LCCM-NO-MSG                                               DTSCS61
01742         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01743         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS61
01744         MOVE CATB-CURSOR             TO MAP-START-DATE-MO-L.      DTSCS61
01745  S1401-EXIT. EXIT.                                                DTSCS61
01746                                                                   DTSCS61
01747  S1450-NEXT-QTR.                                                  DTSCS61
01748      MOVE LCCM-CURR-RUN-DATE TO L004-DATE.                        DTSCS61
01749      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCS61
01750      ADD +1 TO L004-ABS-QTR.                                      DTSCS61
01751      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSCS61
01752      MOVE L004-QTR-START-DATE TO WRK-DISPLAY                      DTSCS61
01753                                  WRK-START-DATE.                  DTSCS61
01754  S1450-EXIT. EXIT.                                                DTSCS61
01755 /*****************************************************************DTSCS61
01756 *                                                                *DTSCS61
01757 ******************************************************************DTSCS61
01758  S1500-DUE-DATE.                                                  DTSCS61
01759      MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA.                  DTSCS61
01760      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS61
01761                                                                   DTSCS61
01762      IF L015-NO-ENTRY                                             DTSCS61
01763         IF WRK-START-DATE-ERROR-YES                               DTSCS61
01764            NEXT SENTENCE                                          DTSCS61
01765         ELSE                                                      DTSCS61
01766         IF L063-NO-DEFAULT-DUE-88                                 DTSCS61
01767            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS61
01768            PERFORM S1501-ERROR THRU S1501-EXIT                    DTSCS61
01769         ELSE                                                      DTSCS61
01770         IF L063-DEFAULT-DUE-NXT-Q-END-88                          DTSCS61
01771            MOVE LCCM-CURR-RUN-DATE TO L004-DATE                   DTSCS61
01772            PERFORM S004-FROM-DATE THRU S004-EXIT                  DTSCS61
01773            ADD +1 TO L004-ABS-QTR                                 DTSCS61
01774            PERFORM S004-FROM-ABS THRU S004-EXIT                   DTSCS61
01775            MOVE L004-QTR-END-DATE TO WRK-DISPLAY                  DTSCS61
01776            MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO                 DTSCS61
01777            MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA                 DTSCS61
01778            MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR                 DTSCS61
01779            PERFORM S1510-START-DUE-CROSS-EDIT THRU S1510-EXIT     DTSCS61
01780         ELSE                                                      DTSCS61
01781            MOVE WRK-START-DATE TO L001-FED-8-DATE-9               DTSCS61
01782            PERFORM S001-FROM-FED-8 THRU S001-EXIT                 DTSCS61
01783            ADD L063-DEFAULT-DUE-DAYS TO L001-JUL-ABS-DAY          DTSCS61
01784            PERFORM S001-FROM-ABS-DATE THRU S001-EXIT              DTSCS61
01785            MOVE L001-FED-8-DATE-9 TO WRK-DISPLAY                  DTSCS61
01786            MOVE WRK-DISPLAY-MO TO MAP-DUE-DATE-MO                 DTSCS61
01787            MOVE WRK-DISPLAY-DA TO MAP-DUE-DATE-DA                 DTSCS61
01788            MOVE WRK-DISPLAY-YR TO MAP-DUE-DATE-YR                 DTSCS61
01789            PERFORM S1510-START-DUE-CROSS-EDIT THRU S1510-EXIT     DTSCS61
01790      ELSE                                                         DTSCS61
01791      IF L015-NOT-VALID                                            DTSCS61
01792         MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS61
01793         PERFORM S1501-ERROR   THRU S1501-EXIT                     DTSCS61
01794      ELSE                                                         DTSCS61
01795         PERFORM S1510-START-DUE-CROSS-EDIT THRU S1510-EXIT.       DTSCS61
01796  S1500-EXIT. EXIT.                                                DTSCS61
01797                                                                   DTSCS61
01798  S1501-ERROR.                                                     DTSCS61
01799      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DUE-DATE-MO-A         DTSCS61
01800                                         MAP-DUE-DATE-DA-A         DTSCS61
01801                                         MAP-DUE-DATE-YR-A.        DTSCS61
01802      IF LCCM-NO-MSG                                               DTSCS61
01803         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01804         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS61
01805         MOVE CATB-CURSOR             TO MAP-DUE-DATE-MO-L.        DTSCS61
01806  S1501-EXIT. EXIT.                                                DTSCS61
01807      SKIP3                                                        DTSCS61
01808  S1510-START-DUE-CROSS-EDIT.                                      DTSCS61
01809      IF WRK-START-DATE = +0                                       DTSCS61
01810          GO TO S1510-EXIT.                                        DTSCS61
01811                                                                   DTSCS61
01812      MOVE MAP-DUE-DATE-AREA TO L015-S-DATE-AREA.                  DTSCS61
01813      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS61
01814      IF L015-VALID                                                DTSCS61
01815          NEXT SENTENCE                                            DTSCS61
01816      ELSE                                                         DTSCS61
01817          GO TO S1510-EXIT.                                        DTSCS61
01818                                                                   DTSCS61
01819      IF WRK-START-DATE > L015-DATE                                DTSCS61
01820          MOVE MSG-E615-AREA TO WRK-MSG-AREA                       DTSCS61
01821          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS61
01822          PERFORM S1501-ERROR THRU S1501-EXIT.                     DTSCS61
01823  S1510-EXIT.                                                      DTSCS61
01824      EXIT.                                                        DTSCS61
01825 /*****************************************************************DTSCS61
01826 *                                                                *DTSCS61
01827 ******************************************************************DTSCS61
01828  S1600-FLD-REP-ID.                                                DTSCS61
01829      MOVE SPACES TO MAP-FLD-REP-ID-DESC                           DTSCS61
01830                                                                   DTSCS61
01831      IF MAP-FLD-REP-ID EQUAL LOW-VALUES OR SPACES                 DTSCS61
01832         SET WRK-FLD-REP-NOT-ENTERED TO TRUE                       DTSCS61
01833      ELSE                                                         DTSCS61
01834         SET WRK-FLD-REP-ENTERED TO TRUE                           DTSCS61
01835         MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID                    DTSCS61
01836         PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT               DTSCS61
01837         IF L062-NOT-VALID                                         DTSCS61
01838            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS61
01839            PERFORM S1601-ERROR THRU S1601-EXIT.                   DTSCS61
01840  S1600-EXIT. EXIT.                                                DTSCS61
01841                                                                   DTSCS61
01842  S1601-ERROR.                                                     DTSCS61
01843      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-FLD-REP-ID-A.        DTSCS61
01844      IF LCCM-NO-MSG                                               DTSCS61
01845         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01846         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
01847         MOVE CATB-CURSOR              TO MAP-FLD-REP-ID-L.        DTSCS61
01848  S1601-EXIT. EXIT.                                                DTSCS61
01849 /*****************************************************************DTSCS61
01850 *                                                                *DTSCS61
01851 ******************************************************************DTSCS61
01852  S1700-ATTACHMENTS.                                               DTSCS61
01853      IF (MAP-ATTACHMENTS-IND = LOW-VALUES OR SPACES)              DTSCS61
01854          MOVE L063-DEFAULT-ATTACH-IND TO MAP-ATTACHMENTS-IND      DTSCS61
01855      ELSE                                                         DTSCS61
01856      IF MAP-ATTACHMENTS-IND-VALID                                 DTSCS61
01857         NEXT SENTENCE                                             DTSCS61
01858      ELSE                                                         DTSCS61
01859         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS61
01860         PERFORM S1701-ERROR THRU S1701-EXIT.                      DTSCS61
01861  S1700-EXIT. EXIT.                                                DTSCS61
01862                                                                   DTSCS61
01863  S1701-ERROR.                                                     DTSCS61
01864      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTACHMENTS-IND-A.     DTSCS61
01865      IF LCCM-NO-MSG                                               DTSCS61
01866         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01867         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
01868         MOVE CATB-CURSOR              TO MAP-ATTACHMENTS-IND-L.   DTSCS61
01869  S1701-EXIT. EXIT.                                                DTSCS61
01870 /*****************************************************************DTSCS61
01871 *                                                                *DTSCS61
01872 ******************************************************************DTSCS61
01873  S1800-SOURCE-OP-ID.                                              DTSCS61
01874      MOVE SPACES TO MAP-SOURCE-OP-ID-DESC.                        DTSCS61
01875                                                                   DTSCS61
01876      IF MAP-SOURCE-OP-ID EQUAL LOW-VALUES OR SPACES               DTSCS61
01877          MOVE LCCM-RESP-OP-ID TO MAP-SOURCE-OP-ID.                DTSCS61
01878                                                                   DTSCS61
01879      IF MAP-SOURCE-OP-ID = LCCM-OP-ID                             DTSCS61
01880          MOVE LCCM-OP-NAME TO L082-NAME                           DTSCS61
01881          MOVE LCCM-OP-FLD-DESK-IND TO L082-FLD-DESK-IND           DTSCS61
01882          MOVE LCCM-OP-ACCOUNTING-DESK-IND                         DTSCS61
01883            TO L082-ACCOUNTING-DESK-IND                            DTSCS61
01884      ELSE                                                         DTSCS61
01885          MOVE MAP-SOURCE-OP-ID       TO L082-OP-ID                DTSCS61
01886          PERFORM S082-OP-ID-EDIT    THRU S082-EXIT                DTSCS61
01887          IF L082-INTERNAL-88                                      DTSCS61
01888           OR L082-NOT-VALID-OP                                    DTSCS61
01889              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS61
01890              PERFORM S1801-ERROR THRU S1801-EXIT                  DTSCS61
01891              GO TO S1800-EXIT.                                    DTSCS61
01892                                                                   DTSCS61
01893      MOVE MAP-SOURCE-OP-ID TO LCCM-RESP-OP-ID.                    DTSCS61
01894                                                                   DTSCS61
01895      MOVE L082-NAME TO MAP-SOURCE-OP-ID-DESC.                     DTSCS61
01896                                                                   DTSCS61
01897      IF L082-IS-FLD-DESK-88                                       DTSCS61
01898         PERFORM S1810-FLD-DESK-OPER THRU S1810-EXIT               DTSCS61
01899      ELSE                                                         DTSCS61
01900         PERFORM S1820-NON-FLD-DESK-OPER THRU S1820-EXIT.          DTSCS61
01901                                                                   DTSCS61
01902      MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID.                      DTSCS61
01903                                                                   DTSCS61
01904      PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT.                 DTSCS61
01905                                                                   DTSCS61
01906      MOVE L062-NAME TO MAP-FLD-REP-ID-DESC.                       DTSCS61
01907  S1800-EXIT. EXIT.                                                DTSCS61
01908                                                                   DTSCS61
01909  S1801-ERROR.                                                     DTSCS61
01910      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-SOURCE-OP-ID-A.      DTSCS61
01911      IF LCCM-NO-MSG                                               DTSCS61
01912         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01913         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
01914         MOVE CATB-CURSOR              TO MAP-SOURCE-OP-ID-L.      DTSCS61
01915  S1801-EXIT. EXIT.                                                DTSCS61
01916                                                                   DTSCS61
01917  S1810-FLD-DESK-OPER.                                             DTSCS61
01918      IF WRK-FLD-REP-NOT-ENTERED                                   DTSCS61
01919         IF L063-ACCOUNTING-YES-88                                 DTSCS61
01920            MOVE 'AD' TO MAP-FLD-REP-ID                            DTSCS61
01921         ELSE                                                      DTSCS61
01922            MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP                      DTSCS61
01923            MOVE MPRF-FLD-ST  TO L061-FLD-ST                       DTSCS61
01924            MOVE MPRF-EMP-NO TO L061-EMP-NO                        DTSCS61
01925            PERFORM S061-FIELD-ZIP-REP-ID THRU S061-EXIT           DTSCS61
01926            MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID                 DTSCS61
01927         END-IF                                                    DTSCS61
01928      END-IF.                                                      DTSCS61
01929  S1810-EXIT. EXIT.                                                DTSCS61
01930                                                                   DTSCS61
01931  S1820-NON-FLD-DESK-OPER.                                         DTSCS61
01932      IF WRK-FLD-REP-NOT-ENTERED                                   DTSCS61
01933         IF L063-ACCOUNTING-YES-88                                 DTSCS61
01934            MOVE 'AD' TO MAP-FLD-REP-ID                            DTSCS61
01935            GO TO S1820-EXIT                                       DTSCS61
01936         ELSE                                                      DTSCS61
01937            MOVE 'FD' TO MAP-FLD-REP-ID                            DTSCS61
01938            GO TO S1820-EXIT.                                      DTSCS61
01939                                                                   DTSCS61
01940      IF L063-ACCOUNTING-YES-88                                    DTSCS61
01941         IF MAP-FLD-REP-ID NOT = 'AD'                              DTSCS61
01942            MOVE MSG-E618-AREA TO WRK-MSG-AREA                     DTSCS61
01943            PERFORM S1601-ERROR THRU S1601-EXIT                    DTSCS61
01944         ELSE                                                      DTSCS61
01945            NEXT SENTENCE                                          DTSCS61
01946      ELSE                                                         DTSCS61
01947         IF MAP-FLD-REP-ID NOT = 'FD'                              DTSCS61
01948            MOVE MSG-E617-AREA TO WRK-MSG-AREA                     DTSCS61
01949            PERFORM S1601-ERROR THRU S1601-EXIT                    DTSCS61
01950         ELSE                                                      DTSCS61
01951            NEXT SENTENCE.                                         DTSCS61
01952  S1820-EXIT. EXIT.                                                DTSCS61
01953                                                                   DTSCS61
01954 /*****************************************************************DTSCS61
01955 *  MORE EDITING HERE                                              DTSCS61
01956 ******************************************************************DTSCS61
01957  S1900-EMP-SIZE-IND.                                              DTSCS61
01958      IF MAP-EMP-SIZE-IND = LOW-VALUES                             DTSCS61
01959          MOVE SPACES TO MAP-EMP-SIZE-IND.                         DTSCS61
01960      SKIP1                                                        DTSCS61
01961      IF MAP-EMP-SIZE-IND = SPACES                                 DTSCS61
01962         IF L063-NON-AUDIT-88                                      DTSCS61
01963            NEXT SENTENCE                                          DTSCS61
01964         ELSE                                                      DTSCS61
01965            MOVE 'S' TO MAP-EMP-SIZE-IND                           DTSCS61
01966      ELSE                                                         DTSCS61
01967      IF MAP-EMP-SIZE-IND-VALID                                    DTSCS61
01968         IF L063-NON-AUDIT-88                                      DTSCS61
01969            MOVE MSG-E61A-AREA TO WRK-MSG-AREA                     DTSCS61
01970            PERFORM S1901-ERROR THRU S1901-EXIT                    DTSCS61
01971         ELSE                                                      DTSCS61
01972            NEXT SENTENCE                                          DTSCS61
01973      ELSE                                                         DTSCS61
01974         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS61
01975         PERFORM S1901-ERROR THRU S1901-EXIT.                      DTSCS61
01976                                                                   DTSCS61
01977  S1900-EXIT. EXIT.                                                DTSCS61
01978                                                                   DTSCS61
01979  S1901-ERROR.                                                     DTSCS61
01980      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-EMP-SIZE-IND-A.      DTSCS61
01981      IF LCCM-NO-MSG                                               DTSCS61
01982         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
01983         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
01984         MOVE CATB-CURSOR              TO MAP-EMP-SIZE-IND-L.      DTSCS61
01985  S1901-EXIT. EXIT.                                                DTSCS61
01986 /*****************************************************************DTSCS61
01987 *                                                                *DTSCS61
01988 ******************************************************************DTSCS61
01989  S2000-AUDIT-SEL-REASON.                                          DTSCS61
01990      INSPECT MAP-AUDIT-SEL-REASON(WRK-CTR)                        DTSCS61
01991         CONVERTING LOW-VALUES TO SPACES.                          DTSCS61
01992                                                                   DTSCS61
01993      IF MAP-AUDIT-SEL-REASON(WRK-CTR) = SPACES                    DTSCS61
01994           IF L063-AUDIT-88 AND WRK-CTR = 1                        DTSCS61
01995              SET MAP-AUDIT-SEL-DEFAULT-88 (WRK-CTR) TO TRUE       DTSCS61
01996              GO TO S2000-EXIT                                     DTSCS61
01997           ELSE                                                    DTSCS61
01998              GO TO S2000-EXIT.                                    DTSCS61
01999                                                                   DTSCS61
02000      IF L063-NON-AUDIT-88                                         DTSCS61
02001          MOVE MSG-E61A-AREA TO WRK-MSG-AREA                       DTSCS61
02002          PERFORM S2001-ERROR THRU S2001-EXIT                      DTSCS61
02003          GO TO S2000-EXIT.                                        DTSCS61
02004                                                                   DTSCS61
02005      MOVE MAP-AUDIT-SEL-REASON(WRK-CTR) TO L036-CD.               DTSCS61
02006      PERFORM S036-AUDIT-SEL-REASON THRU S036-EXIT.                DTSCS61
02007                                                                   DTSCS61
02008      IF L036-NOT-VALID                                            DTSCS61
02009         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS61
02010         PERFORM S2001-ERROR THRU S2001-EXIT.                      DTSCS61
02011  S2000-EXIT. EXIT.                                                DTSCS61
02012                                                                   DTSCS61
02013  S2001-ERROR.                                                     DTSCS61
02014      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS61
02015           TO MAP-AUDIT-SEL-REASON-A(WRK-CTR).                     DTSCS61
02016      IF LCCM-NO-MSG                                               DTSCS61
02017         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02018         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02019         MOVE CATB-CURSOR TO MAP-AUDIT-SEL-REASON-L(WRK-CTR).      DTSCS61
02020  S2001-EXIT. EXIT.                                                DTSCS61
02021 /*****************************************************************DTSCS61
02022 *                                                                *DTSCS61
02023 ******************************************************************DTSCS61
02024  S2100-TAX-EXTRACT.                                               DTSCS61
02025      IF MAP-TAX-EXTRACT EQUAL LOW-VALUES OR SPACES                DTSCS61
02026         SET MAP-TAX-EXTRACT-NO TO TRUE                            DTSCS61
02027      ELSE                                                         DTSCS61
02028      IF NOT MAP-TAX-EXTRACT-VALID                                 DTSCS61
02029         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS61
02030         PERFORM S2101-ERROR THRU S2101-EXIT                       DTSCS61
02031      ELSE                                                         DTSCS61
02032         IF MAP-TAX-EXTRACT-YES                                    DTSCS61
02033            SET WRK-EXTRACT-REQ-YES-88 TO TRUE.                    DTSCS61
02034                                                                   DTSCS61
02035      IF MAP-TAX-EXTRACT-YES                                       DTSCS61
02036         IF MPRF-NOT-WRITTEN-OFF-88                                DTSCS61
02037            NEXT SENTENCE                                          DTSCS61
02038         ELSE                                                      DTSCS61
02039            MOVE MSG-E61C-AREA TO WRK-MSG-AREA                     DTSCS61
02040            PERFORM S2101-ERROR THRU S2101-EXIT.                   DTSCS61
02041  S2100-EXIT. EXIT.                                                DTSCS61
02042                                                                   DTSCS61
02043  S2101-ERROR.                                                     DTSCS61
02044      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-TAX-EXTRACT-A.       DTSCS61
02045      IF LCCM-NO-MSG                                               DTSCS61
02046         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02047         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02048         MOVE CATB-CURSOR              TO MAP-TAX-EXTRACT-L.       DTSCS61
02049  S2101-EXIT. EXIT.                                                DTSCS61
02050 /*****************************************************************DTSCS61
02051 *                                                                *DTSCS61
02052 ******************************************************************DTSCS61
02053  S2200-WAGE-EXTRACT.                                              DTSCS61
02054      IF MAP-WAGE-EXTRACT EQUAL LOW-VALUES OR SPACES               DTSCS61
02055         SET MAP-WAGE-EXTRACT-NO TO TRUE                           DTSCS61
02056      ELSE                                                         DTSCS61
02057      IF NOT MAP-WAGE-EXTRACT-VALID                                DTSCS61
02058         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS61
02059         PERFORM S2201-ERROR THRU S2201-EXIT                       DTSCS61
02060      ELSE                                                         DTSCS61
02061         IF MAP-WAGE-EXTRACT-YES                                   DTSCS61
02062            SET WRK-EXTRACT-REQ-YES-88 TO TRUE.                    DTSCS61
02063                                                                   DTSCS61
02064      IF MAP-WAGE-EXTRACT-YES                                      DTSCS61
02065         IF MPRF-NOT-WRITTEN-OFF-88                                DTSCS61
02066            NEXT SENTENCE                                          DTSCS61
02067         ELSE                                                      DTSCS61
02068            MOVE MSG-E61C-AREA TO WRK-MSG-AREA                     DTSCS61
02069            PERFORM S2201-ERROR THRU S2201-EXIT.                   DTSCS61
02070  S2200-EXIT. EXIT.                                                DTSCS61
02071                                                                   DTSCS61
02072  S2201-ERROR.                                                     DTSCS61
02073      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-WAGE-EXTRACT-A.      DTSCS61
02074      IF LCCM-NO-MSG                                               DTSCS61
02075         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02076         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02077         MOVE CATB-CURSOR              TO MAP-WAGE-EXTRACT-L.      DTSCS61
02078  S2201-EXIT. EXIT.                                                DTSCS61
02079 /*****************************************************************DTSCS61
02080 *                                                                 DTSCS61
02081 ******************************************************************DTSCS61
02082  S2300-QTR-RANGE.                                                 DTSCS61
02083      MOVE MAP-AUDIT-START-YRQ-AREA TO L024-S-START-YRQ-AREA.      DTSCS61
02084      MOVE MAP-AUDIT-END-YRQ-AREA TO L024-S-END-YRQ-AREA.          DTSCS61
02085      PERFORM S024-EDIT-QTR-SPAN THRU S024-EXIT.                   DTSCS61
02086      IF L024-START-NO-ENTRY                                       DTSCS61
02087         IF L063-AUDIT-88                                          DTSCS61
02088            MOVE MSG-E61B-AREA TO WRK-MSG-AREA                     DTSCS61
02089            PERFORM S2301-ERROR THRU S2301-EXIT                    DTSCS61
02090         ELSE                                                      DTSCS61
02091            IF WRK-EXTRACT-REQ-YES-88                              DTSCS61
02092               MOVE MSG-E616-AREA TO WRK-MSG-AREA                  DTSCS61
02093               PERFORM S2301-ERROR THRU S2301-EXIT                 DTSCS61
02094            END-IF                                                 DTSCS61
02095         END-IF                                                    DTSCS61
02096      ELSE                                                         DTSCS61
02097         IF WRK-EXTRACT-REQ-NO-88 AND L063-NON-AUDIT-88            DTSCS61
02098            MOVE MSG-E61A-AREA TO WRK-MSG-AREA                     DTSCS61
02099            PERFORM S2301-ERROR THRU S2301-EXIT                    DTSCS61
02100         ELSE                                                      DTSCS61
02101            IF L024-START-NOT-VALID                                DTSCS61
02102               MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA           DTSCS61
02103               PERFORM S2301-ERROR THRU S2301-EXIT                 DTSCS61
02104            ELSE                                                   DTSCS61
02105               NEXT SENTENCE                                       DTSCS61
02106            END-IF                                                 DTSCS61
02107         END-IF                                                    DTSCS61
02108      END-IF.                                                      DTSCS61
02109                                                                   DTSCS61
02110      IF L024-END-NO-ENTRY                                         DTSCS61
02111         IF L063-AUDIT-88                                          DTSCS61
02112            MOVE MSG-E61B-AREA TO WRK-MSG-AREA                     DTSCS61
02113            PERFORM S2301-ERROR THRU S2301-EXIT                    DTSCS61
02114         ELSE                                                      DTSCS61
02115            IF WRK-EXTRACT-REQ-YES-88                              DTSCS61
02116               MOVE MSG-E616-AREA TO WRK-MSG-AREA                  DTSCS61
02117               PERFORM S2301-ERROR THRU S2301-EXIT                 DTSCS61
02118            END-IF                                                 DTSCS61
02119         END-IF                                                    DTSCS61
02120      ELSE                                                         DTSCS61
02121         IF WRK-EXTRACT-REQ-NO-88 AND L063-NON-AUDIT-88            DTSCS61
02122            MOVE MSG-E61A-AREA TO WRK-MSG-AREA                     DTSCS61
02123            PERFORM S2303-ERROR THRU S2303-EXIT                    DTSCS61
02124         ELSE                                                      DTSCS61
02125            IF L024-END-NOT-VALID                                  DTSCS61
02126               MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA           DTSCS61
02127               PERFORM S2303-ERROR THRU S2303-EXIT                 DTSCS61
02128            ELSE                                                   DTSCS61
02129               NEXT SENTENCE                                       DTSCS61
02130            END-IF                                                 DTSCS61
02131         END-IF                                                    DTSCS61
02132      END-IF.                                                      DTSCS61
02133                                                                   DTSCS61
02134                                                                   DTSCS61
02135      IF WRK-EXTRACT-REQ-NO-88 AND L063-NON-AUDIT-88               DTSCS61
02136         GO TO S2300-EXIT.                                         DTSCS61
02137                                                                   DTSCS61
02138      IF L024-SPAN-INVALID                                         DTSCS61
02139      OR L024-END-BEFORE-START                                     DTSCS61
02140      OR L024-QTRS-SPANNED > +12                                   DTSCS61
02141         MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                      DTSCS61
02142         PERFORM S2301-ERROR THRU S2301-EXIT                       DTSCS61
02143         PERFORM S2303-ERROR THRU S2303-EXIT                       DTSCS61
02144      END-IF.                                                      DTSCS61
02145  S2300-EXIT. EXIT.                                                DTSCS61
02146                                                                   DTSCS61
02147  S2301-ERROR.                                                     DTSCS61
02148      MOVE CATB-UNPROT-NORM-NUM-MDTON   TO MAP-AUDIT-START-YR-A    DTSCS61
02149                                           MAP-AUDIT-START-Q-A     DTSCS61
02150      IF LCCM-NO-MSG                                               DTSCS61
02151         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02152         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02153         MOVE CATB-CURSOR              TO MAP-AUDIT-START-YR-L.    DTSCS61
02154  S2301-EXIT. EXIT.                                                DTSCS61
02155                                                                   DTSCS61
02156  S2303-ERROR.                                                     DTSCS61
02157      MOVE CATB-UNPROT-NORM-NUM-MDTON   TO MAP-AUDIT-END-YR-A      DTSCS61
02158                                           MAP-AUDIT-END-Q-A       DTSCS61
02159      IF LCCM-NO-MSG                                               DTSCS61
02160         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02161         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02162         MOVE CATB-CURSOR              TO MAP-AUDIT-END-YR-L.      DTSCS61
02163  S2303-EXIT. EXIT.                                                DTSCS61
02164 /*****************************************************************DTSCS61
02165 *                                                                 DTSCS61
02166 ******************************************************************DTSCS61
02167  S2400-SIC-NAICS-OWN.                                             DTSCS61
02168      MOVE MPRF-NAICS-CD TO MAP-NAICS-CD.                          DTSCS61
02169      MOVE MPRF-SIC-CD TO MAP-SIC-CD.                              DTSCS61
02170      MOVE MPRF-OWN-CD TO MAP-OWN-CD.                              DTSCS61
02171                                                                   DTSCS61
02172 *****                                                             DTSCS61
02173 *****  SIC CODE AND OWN CODE CHANGED TO DISPLAY ONLY              DTSCS61
02174 *****  ON 03/01/95 PER LYNNETTE                                   DTSCS61
02175 *****                                                             DTSCS61
02176 *****IF MAP-SIC-CD = LOW-VALUES                                   DTSCS61
02177 *****    MOVE SPACES TO MAP-SIC-CD.                               DTSCS61
02178 *****                                                             DTSCS61
02179 *****IF MAP-OWN-CD = LOW-VALUES                                   DTSCS61
02180 *****    MOVE SPACES TO MAP-OWN-CD.                               DTSCS61
02181 *****                                                             DTSCS61
02182 *****IF (MAP-SIC-CD = SPACES)                                     DTSCS61
02183 *****       AND                                                   DTSCS61
02184 *****   (MAP-OWN-CD = SPACES)                                     DTSCS61
02185 *****    IF WRK-ASSIGN-TYPE-ERROR-YES                             DTSCS61
02186 *****        GO TO S2200-EXIT                                     DTSCS61
02187 *****    ELSE                                                     DTSCS61
02188 *****        IF L063-AUDIT-88                                     DTSCS61
02189 *****            MOVE MPRF-SIC-CD TO MAP-SIC-CD                   DTSCS61
02190 *****            MOVE MPRF-OWN-CD TO MAP-OWN-CD                   DTSCS61
02191 *****            GO TO S2200-EXIT                                 DTSCS61
02192 *****        ELSE                                                 DTSCS61
02193 *****            GO TO S2200-EXIT.                                DTSCS61
02194 *****                                                             DTSCS61
02195 *****MOVE MAP-SIC-CD TO L039-SIC-CD.                              DTSCS61
02196 *****MOVE MAP-OWN-CD TO L039-OWN-CD.                              DTSCS61
02197 *****                                                             DTSCS61
02198 *****PERFORM S039-SIC-OWN-CODE-EDIT THRU S039-EXIT.               DTSCS61
02199 *****                                                             DTSCS61
02200 *****IF L039-SIC-NOT-VALID                                        DTSCS61
02201 *****    MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS61
02202 *****    PERFORM S2201-ERROR THRU S2201-EXIT.                     DTSCS61
02203 *****                                                             DTSCS61
02204 *****IF L039-OWN-NOT-VALID                                        DTSCS61
02205 *****    MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS61
02206 *****    PERFORM S2202-ERROR THRU S2202-EXIT.                     DTSCS61
02207  S2400-EXIT. EXIT.                                                DTSCS61
02208                                                                   DTSCS61
02209 *S2201-ERROR.                                                     DTSCS61
02210 *****MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS61
02211 *****  TO MAP-SIC-CD-A.                                           DTSCS61
02212 *****IF LCCM-NO-MSG                                               DTSCS61
02213 *****   SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02214 *****   MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS61
02215 *****   MOVE CATB-CURSOR  TO MAP-SIC-CD-L.                        DTSCS61
02216 *S2201-EXIT. EXIT.                                                DTSCS61
02217                                                                   DTSCS61
02218 *S2202-ERROR.                                                     DTSCS61
02219 *****MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS61
02220 *****  TO MAP-OWN-CD-A.                                           DTSCS61
02221 *****IF LCCM-NO-MSG                                               DTSCS61
02222 *****   SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02223 *****   MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS61
02224 *****   MOVE CATB-CURSOR  TO MAP-OWN-CD-L.                        DTSCS61
02225 *S2202-EXIT. EXIT.                                                DTSCS61
02226 /*****************************************************************DTSCS61
02227 *                                                                *DTSCS61
02228 ******************************************************************DTSCS61
02229 *S2300-COPIES.                                                    DTSCS61
02230 *    IF MAP-COPIES = LOW-VALUE OR SPACE                           DTSCS61
02231 *        MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA            DTSCS61
02232 *        PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT              DTSCS61
02233 *        MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA       DTSCS61
02234 *        PERFORM S018-EMP-NO-FROM-SCREEN   THRU S018-EXIT         DTSCS61
02235 *        IF L018-NO-ENTRY                                         DTSCS61
02236 *        AND L020-NO-ENTRY                                        DTSCS61
02237 *            MOVE '0' TO MAP-COPIES                               DTSCS61
02238 *        ELSE                                                     DTSCS61
02239 *        IF L020-NO-ENTRY                                         DTSCS61
02240 *        OR L018-NO-ENTRY                                         DTSCS61
02241 *            MOVE '0' TO MAP-COPIES                               DTSCS61
02242 *        ELSE                                                     DTSCS61
02243 *            MOVE '0' TO MAP-COPIES                               DTSCS61
02244 *    ELSE                                                         DTSCS61
02245 *    IF NOT MAP-COPIES-VALID                                      DTSCS61
02246 *       MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS61
02247 *       PERFORM S2301-ERROR   THRU S2301-EXIT.                    DTSCS61
02248 *S2300-EXIT. EXIT.                                                DTSCS61
02249                                                                   DTSCS61
02250 *S2301-ERROR.                                                     DTSCS61
02251 *    MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPIES-A.             DTSCS61
02252 *    IF LCCM-NO-MSG                                               DTSCS61
02253 *       SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02254 *       MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02255 **      MOVE CATB-CURSOR              TO MAP-COPIES-L.            DTSCS61
02256 *S2301-EXIT. EXIT.                                                DTSCS61
02257 /*****************************************************************DTSCS61
02258 *                                                                *DTSCS61
02259 ******************************************************************DTSCS61
02260 *S2400-PRINTER-ID.                                                DTSCS61
02261 *    IF MAP-PRINTER-ID EQUAL LOW-VALUES OR SPACES                 DTSCS61
02262 *       IF LCCM-NO-PRINTER                                        DTSCS61
02263 *         AND MAP-COPIES NOT = '0'                                DTSCS61
02264 *           MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA              DTSCS61
02265 *           PERFORM S2401-ERROR THRU S2401-EXIT                   DTSCS61
02266 *       ELSE                                                      DTSCS61
02267 *          MOVE LCCM-PRINTER-ID TO MAP-PRINTER-ID                 DTSCS61
02268 *    ELSE                                                         DTSCS61
02269 *       MOVE MAP-PRINTER-ID TO LCCM-PRINTER-ID.                   DTSCS61
02270 *S2400-EXIT. EXIT.                                                DTSCS61
02271                                                                   DTSCS61
02272 *S2401-ERROR.                                                     DTSCS61
02273 *    MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-PRINTER-ID-A.        DTSCS61
02274 *    IF LCCM-NO-MSG                                               DTSCS61
02275 *       SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02276 *       MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02277 *       MOVE CATB-CURSOR              TO MAP-PRINTER-ID-L.        DTSCS61
02278 *S2401-EXIT. EXIT.                                                DTSCS61
02279 /*****************************************************************DTSCS61
02280 *                                                                *DTSCS61
02281 ******************************************************************DTSCS61
02282  S2500-RELATED-EMP-NO.                                            DTSCS61
02283      MOVE MAP-RELATED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.          DTSCS61
02284      PERFORM S018-EMP-NO-FROM-SCREEN   THRU S018-EXIT.            DTSCS61
02285      IF L018-NO-ENTRY                                             DTSCS61
02286         GO TO S2500-EXIT.                                         DTSCS61
02287                                                                   DTSCS61
02288      IF L018-NOT-VALID                                            DTSCS61
02289      OR L018-EMP-NO = LCCM-EMP-NO                                 DTSCS61
02290         MOVE EMSG-FIELD-NOT-VALID   TO WRK-MSG-AREA               DTSCS61
02291         PERFORM S2501-ERROR   THRU S2501-EXIT                     DTSCS61
02292         GO TO S2500-EXIT.                                         DTSCS61
02293                                                                   DTSCS61
02294      MOVE LOW-VALUES                 TO MPRF-KEY-AREA.            DTSCS61
02295      MOVE L018-EMP-NO                TO MPRF-EMP-NO.              DTSCS61
02296      SET  MPRF-PRF-88                TO TRUE.                     DTSCS61
02297      MOVE MPRF-KEY-AREA              TO MSKL-KEY-AREA.            DTSCS61
02298      PERFORM S810-READ               THRU S810-EXIT.              DTSCS61
02299                                                                   DTSCS61
02300      IF L810-NO-REC-88                                            DTSCS61
02301         MOVE EMSG-NO-RECORD         TO WRK-MSG-AREA               DTSCS61
02302         PERFORM S2501-ERROR         THRU S2501-EXIT               DTSCS61
02303         GO TO S2500-EXIT.                                         DTSCS61
02304                                                                   DTSCS61
02305      MOVE MSKL-REC                   TO MPRF-REC.                 DTSCS61
02306      MOVE MPRF-PRIMARY-NAME          TO MAP-RELATED-PRIMARY-NAME. DTSCS61
02307      IF MPRF-CLASS-CHG-ONLY-88                                    DTSCS61
02308         MOVE MSG-E613-AREA TO WRK-MSG-AREA                        DTSCS61
02309         PERFORM S2501-ERROR THRU S2501-EXIT.                      DTSCS61
02310                                                                   DTSCS61
02311 *** NEED TO REREAD THE EMPLOYER FOR LATER                         DTSCS61
02312                                                                   DTSCS61
02313      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS61
02314  S2500-EXIT. EXIT.                                                DTSCS61
02315                                                                   DTSCS61
02316  S2501-ERROR.                                                     DTSCS61
02317      MOVE CATB-UNPROT-NORM-NUM-MDTON  TO MAP-RELATED-EMP-NO-1-A   DTSCS61
02318                                          MAP-RELATED-EMP-NO-2-A.  DTSCS61
02319      IF LCCM-NO-MSG                                               DTSCS61
02320         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02321         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02322         MOVE CATB-CURSOR              TO MAP-RELATED-EMP-NO-1-L.  DTSCS61
02323  S2501-EXIT. EXIT.                                                DTSCS61
02324 /*****************************************************************DTSCS61
02325 *                                                                *DTSCS61
02326 ******************************************************************DTSCS61
02327  S2600-CLAIMANT-SSN.                                              DTSCS61
02328      MOVE MAP-CLAIMANT-SSN-AREA      TO L020-S-SSN-AREA           DTSCS61
02329      PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT                  DTSCS61
02330      IF L020-NO-ENTRY                                             DTSCS61
02331         NEXT SENTENCE                                             DTSCS61
02332      ELSE                                                         DTSCS61
02333      IF L020-NOT-VALID                                            DTSCS61
02334         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS61
02335         PERFORM S2601-ERROR THRU S2601-EXIT.                      DTSCS61
02336                                                                   DTSCS61
02337  S2600-EXIT. EXIT.                                                DTSCS61
02338                                                                   DTSCS61
02339  S2601-ERROR.                                                     DTSCS61
02340      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CLAIMANT-SSN-1-A      DTSCS61
02341                              MAP-CLAIMANT-SSN-2-A                 DTSCS61
02342                              MAP-CLAIMANT-SSN-3-A.                DTSCS61
02343      IF LCCM-NO-MSG                                               DTSCS61
02344         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02345         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02346         MOVE CATB-CURSOR              TO MAP-CLAIMANT-SSN-1-L.    DTSCS61
02347  S2601-EXIT. EXIT.                                                DTSCS61
02348 /*****************************************************************DTSCS61
02349 *                                                                *DTSCS61
02350 ******************************************************************DTSCS61
02351  S2700-CLAIMANT-NAME.                                             DTSCS61
02352      INSPECT MAP-CLAIMANT-NAME                                    DTSCS61
02353          CONVERTING LOW-VALUES TO SPACES.                         DTSCS61
02354                                                                   DTSCS61
02355      IF MAP-CLAIMANT-NAME = SPACES                                DTSCS61
02356         IF L020-NO-ENTRY                                          DTSCS61
02357            GO TO S2700-EXIT.                                      DTSCS61
02358                                                                   DTSCS61
02359      IF L020-NOT-VALID                                            DTSCS61
02360         GO TO S2700-EXIT.                                         DTSCS61
02361                                                                   DTSCS61
02362      IF L020-NO-ENTRY                                             DTSCS61
02363         MOVE EMSG-FIELD-NOT-ALLOWED  TO WRK-MSG-AREA              DTSCS61
02364         PERFORM S2701-ERROR          THRU S2701-EXIT              DTSCS61
02365         GO TO S2700-EXIT.                                         DTSCS61
02366                                                                   DTSCS61
02367      IF MAP-CLAIMANT-NAME = SPACES                                DTSCS61
02368         MOVE L020-SSN TO L081-CLAIMANT-SSN                        DTSCS61
02369         PERFORM S081-CLAIMANT-NAME      THRU S081-EXIT            DTSCS61
02370         IF L081-NAME-FOUND                                        DTSCS61
02371            MOVE L081-CLAIMANT-NAME     TO MAP-CLAIMANT-NAME.      DTSCS61
02372                                                                   DTSCS61
02373      IF MAP-CLAIMANT-NAME = SPACES                                DTSCS61
02374         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS61
02375         PERFORM S2701-ERROR          THRU S2701-EXIT              DTSCS61
02376      ELSE                                                         DTSCS61
02377         MOVE MAP-CLAIMANT-NAME        TO L071-NAM                 DTSCS61
02378         PERFORM S071-FROM-LAST-NAME-FIRST THRU S071-EXIT          DTSCS61
02379         IF L071-NAME-INVALID                                      DTSCS61
02380            MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA           DTSCS61
02381            PERFORM S2701-ERROR          THRU S2701-EXIT.          DTSCS61
02382                                                                   DTSCS61
02383  S2700-EXIT. EXIT.                                                DTSCS61
02384                                                                   DTSCS61
02385  S2701-ERROR.                                                     DTSCS61
02386      MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-CLAIMANT-NAME-A.     DTSCS61
02387      IF LCCM-NO-MSG                                               DTSCS61
02388         SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02389         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02390         MOVE CATB-CURSOR              TO MAP-CLAIMANT-NAME-L.     DTSCS61
02391  S2701-EXIT. EXIT.                                                DTSCS61
02392 /*****************************************************************DTSCS61
02393 *                                                                *DTSCS61
02394 ******************************************************************DTSCS61
02395  S2800-TEXT.                                                      DTSCS61
02396      INSPECT MAP-TEXT (WRK-CTR)                                   DTSCS61
02397          CONVERTING LOW-VALUES TO SPACES.                         DTSCS61
02398  S2800-EXIT. EXIT.                                                DTSCS61
02399                                                                   DTSCS61
02400 *S3001-ERROR.                                                     DTSCS61
02401 **** MOVE CATB-UNPROT-NORM-AN-MDTON   TO MAP-TEXT-A(WRK-CTR).     DTSCS61
02402 **** IF LCCM-NO-MSG                                               DTSCS61
02403 ****    SET CURSOR-SET-YES           TO TRUE                      DTSCS61
02404 ****    MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS61
02405 ****    MOVE CATB-CURSOR              TO MAP-TEXT-L(WRK-CTR).     DTSCS61
02406 *S3001-EXIT. EXIT.                                                DTSCS61
02407                                                                   DTSCS61
02408  S3000-MISC-EDITS.                                                DTSCS61
02409      IF MAP-ADD-OPEN-IND-YES                                      DTSCS61
02410          NEXT SENTENCE                                            DTSCS61
02411      ELSE                                                         DTSCS61
02412          PERFORM S3010-MFAS-OPEN-EDIT THRU S3010-EXIT.            DTSCS61
02413  S3000-EXIT. EXIT.                                                DTSCS61
02414                                                                   DTSCS61
02415  S3010-MFAS-OPEN-EDIT.                                            DTSCS61
02416      MOVE LOW-VALUES TO MFAS-KEY-AREA.                            DTSCS61
02417      MOVE WRK-EMP-NO TO MFAS-EMP-NO.                              DTSCS61
02418      SET MFAS-FAS-88 TO TRUE.                                     DTSCS61
02419      MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS61
02420      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS61
02421      PERFORM S3011-SCAN-MFAS THRU S3011-EXIT                      DTSCS61
02422          UNTIL L810-NO-REC-88.                                    DTSCS61
02423  S3010-EXIT.                                                      DTSCS61
02424      EXIT.                                                        DTSCS61
02425      SKIP3                                                        DTSCS61
02426  S3011-SCAN-MFAS.                                                 DTSCS61
02427      MOVE MSKL-REC TO MFAS-REC.                                   DTSCS61
02428      IF MFAS-STATUS-ACTIVE-88 OR MFAS-STATUS-HELD-88              DTSCS61
02429          MOVE MSG-E611-AREA TO WRK-MSG-AREA                       DTSCS61
02430          PERFORM S1301-ERROR THRU S1301-EXIT                      DTSCS61
02431          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS61
02432          SET L810-NO-REC-88 TO TRUE                               DTSCS61
02433          GO TO S3011-EXIT.                                        DTSCS61
02434      SKIP1                                                        DTSCS61
02435      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS61
02436  S3011-EXIT.                                                      DTSCS61
02437      EXIT.                                                        DTSCS61
02438 /*****************************************************************DTSCS61
02439 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS61
02440 ******************************************************************DTSCS61
02441  S5100-SET-LOCK-ATTRB.                                            DTSCS61
02442      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS61
02443                                 WRK-ATB-NUM.                      DTSCS61
02444                                                                   DTSCS61
02445      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS61
02446                                                                   DTSCS61
02447      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS61
02448                                 MAP-EMP-NO-2-A                    DTSCS61
02449                                 MAP-GOTO-A.                       DTSCS61
02450  S5100-EXIT.                                                      DTSCS61
02451      EXIT.                                                        DTSCS61
02452                                                                   DTSCS61
02453 ******************************************************************DTSCS61
02454 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS61
02455 ******************************************************************DTSCS61
02456  S5200-SET-UPDATE-ATTRB.                                          DTSCS61
02457      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS61
02458      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS61
02459                                                                   DTSCS61
02460      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS61
02461                                                                   DTSCS61
02462  S5200-EXIT.                                                      DTSCS61
02463      EXIT.                                                        DTSCS61
02464                                                                   DTSCS61
02465 ******************************************************************DTSCS61
02466 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS61
02467 ******************************************************************DTSCS61
02468  S5300-SET-INQ-ATTRB.                                             DTSCS61
02469      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS61
02470                                    WRK-ATB-NUM.                   DTSCS61
02471                                                                   DTSCS61
02472      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS61
02473  S5300-EXIT.                                                      DTSCS61
02474      EXIT.                                                        DTSCS61
02475                                                                   DTSCS61
02476  S5900-SET-ATTRB.                                                 DTSCS61
02477      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS61
02478                                        MAP-EMP-NO-2-A.            DTSCS61
02479                                                                   DTSCS61
02480      MOVE WRK-ATB-AN TO                                           DTSCS61
02481              MAP-SOURCE-OP-ID-A                                   DTSCS61
02482              MAP-TAX-EXTRACT-A                                    DTSCS61
02483              MAP-WAGE-EXTRACT-A                                   DTSCS61
02484              MAP-CLAIMANT-NAME-A                                  DTSCS61
02485              MAP-ADD-OPEN-IND-A                                   DTSCS61
02486              MAP-FLD-REP-ID-A                                     DTSCS61
02487              MAP-ATTACHMENTS-IND-A                                DTSCS61
02488              MAP-EMP-SIZE-IND-A.                                  DTSCS61
02489                                                                   DTSCS61
02490      PERFORM VARYING WRK-CTR FROM 1 BY 1                          DTSCS61
02491      UNTIL WRK-CTR > MMAX-FAS-SEL-MAX                             DTSCS61
02492         MOVE WRK-ATB-AN TO                                        DTSCS61
02493              MAP-AUDIT-SEL-REASON-A(WRK-CTR)                      DTSCS61
02494      END-PERFORM.                                                 DTSCS61
02495                                                                   DTSCS61
02496      PERFORM VARYING WRK-CTR FROM 1 BY 1                          DTSCS61
02497      UNTIL WRK-CTR > MMAX-FAS-TEXT-MAX                            DTSCS61
02498         MOVE WRK-ATB-AN TO                                        DTSCS61
02499              MAP-TEXT-A (WRK-CTR)                                 DTSCS61
02500      END-PERFORM.                                                 DTSCS61
02501                                                                   DTSCS61
02502      MOVE WRK-ATB-NUM TO                                          DTSCS61
02503              MAP-ASSIGN-TYPE-A                                    DTSCS61
02504                  MAP-DUE-DATE-MO-A                                DTSCS61
02505                  MAP-DUE-DATE-DA-A                                DTSCS61
02506                  MAP-DUE-DATE-YR-A                                DTSCS61
02507                  MAP-CLAIMANT-SSN-1-A                             DTSCS61
02508                  MAP-CLAIMANT-SSN-2-A                             DTSCS61
02509                  MAP-CLAIMANT-SSN-3-A                             DTSCS61
02510                  MAP-RELATED-EMP-NO-1-A                           DTSCS61
02511                  MAP-RELATED-EMP-NO-2-A                           DTSCS61
02512                  MAP-AUDIT-END-Q-A                                DTSCS61
02513                  MAP-AUDIT-END-YR-A                               DTSCS61
02514                  MAP-AUDIT-START-Q-A                              DTSCS61
02515                  MAP-AUDIT-START-YR-A                             DTSCS61
02516                  MAP-START-DATE-DA-A                              DTSCS61
02517                  MAP-START-DATE-MO-A                              DTSCS61
02518                  MAP-START-DATE-YR-A.                             DTSCS61
02519                                                                   DTSCS61
02520      MOVE CATB-ASKIP-BRT-MDTON TO MAP-SIC-CD-A                    DTSCS61
02521                                   MAP-NAICS-CD-A                  DTSCS61
02522                                   MAP-OWN-CD-A.                   DTSCS61
02523                                                                   DTSCS61
02524      MOVE CATB-ASKIP-BRT-MDTON     TO MAP-PRIMARY-NAME-A.         DTSCS61
02525                                                                   DTSCS61
02526      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS61
02527  S5900-EXIT.                                                      DTSCS61
02528      EXIT.                                                        DTSCS61
02529      EJECT                                                        DTSCS61
02530 /*****************************************************************DTSCS61
02531 * MAP ROUTINES                                                   *DTSCS61
02532 ******************************************************************DTSCS61
02533  S9100-RECEIVE.                                                   DTSCS61
02534      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS61
02535                                                                   DTSCS61
02536      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS61
02537                                                                   DTSCS61
02538      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS61
02539                                                                   DTSCS61
02540      MOVE L851-AID TO LCCM-AID.                                   DTSCS61
02541      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS61
02542  S9100-EXIT.                                                      DTSCS61
02543      EXIT.                                                        DTSCS61
02544                                                                   DTSCS61
02545  S9200-SEND-DATAONLY.                                             DTSCS61
02546      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS61
02547                                                                   DTSCS61
02548      IF LCCM-NO-MSG                                               DTSCS61
02549          NEXT SENTENCE                                            DTSCS61
02550      ELSE                                                         DTSCS61
02551          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS61
02552                                                                   DTSCS61
02553      IF CURSOR-SET-GOTO                                           DTSCS61
02554          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS61
02555      ELSE                                                         DTSCS61
02556          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS61
02557                                                                   DTSCS61
02558      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS61
02559                                                                   DTSCS61
02560      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS61
02561                                                                   DTSCS61
02562      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS61
02563  S9200-EXIT.                                                      DTSCS61
02564      EXIT.                                                        DTSCS61
02565                                                                   DTSCS61
02566  S9300-SEND-MAP.                                                  DTSCS61
02567      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS61
02568      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCS61
02569      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS61
02570      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS61
02571                                                                   DTSCS61
02572      IF SCR-ACCESS-UPDATE                                         DTSCS61
02573          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS61
02574      ELSE                                                         DTSCS61
02575          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS61
02576                                                                   DTSCS61
02577      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS61
02578                                                                   DTSCS61
02579      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS61
02580                                                                   DTSCS61
02581      IF CURSOR-SET-NO                                             DTSCS61
02582          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS61
02583                                                                   DTSCS61
02584      SET L851-SEND-88 TO TRUE.                                    DTSCS61
02585                                                                   DTSCS61
02586      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS61
02587                                                                   DTSCS61
02588      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS61
02589  S9300-EXIT.                                                      DTSCS61
02590      EXIT.                                                        DTSCS61
02591                                                                   DTSCS61
02592  S9310-UPDATE-FKEYS.                                              DTSCS61
02593      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS61
02594                                                                   DTSCS61
02595                                                                   DTSCS61
02596      IF LCCM-SCR-CLEAR                                            DTSCS61
02597          MOVE CFKD-ADD TO MAP-KEY-ADD                             DTSCS61
02598      ELSE                                                         DTSCS61
02599      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS61
02600          MOVE LOW-VALUES TO MAP-KEY-ADD.                          DTSCS61
02601  S9310-EXIT.                                                      DTSCS61
02602      EXIT.                                                        DTSCS61
02603                                                                   DTSCS61
02604  S9320-INQUIRY-FKEYS.                                             DTSCS61
02605      MOVE LOW-VALUES TO MAP-KEY-ADD.                              DTSCS61
02606                                                                   DTSCS61
02607 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS61
02608  S9320-EXIT.                                                      DTSCS61
02609      EXIT.                                                        DTSCS61
02610                                                                   DTSCS61
02611 *S9321-JUMP-KEYS.                                                 DTSCS61
02612 *    MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ.                        DTSCS61
02613 *S9321-EXIT.                                                      DTSCS61
02614 *    EXIT.                                                        DTSCS61
02615 *                                                                 DTSCS61
02616  S9330-DSCR-FIELDS.                                               DTSCS61
02617  S9330-EXIT. EXIT.                                                DTSCS61
02618                                                                   DTSCS61
02619  S9900-PREPARE-SEND.                                              DTSCS61
02620      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS61
02621                         LCCM-SCR-ID.                              DTSCS61
02622      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS61
02623      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS61
02624  S9900-EXIT.                                                      DTSCS61
02625      EXIT.                                                        DTSCS61
