00001  IDENTIFICATION DIVISION.                                         10/02/98
00002  PROGRAM-ID.             DTSCU833.                                DTSCU833
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCU833
00005  DATE-COMPILED.                                                   DTSCU833
00006      SKIP3                                                        DTSCU833
00007 *****                                                             DTSCU833
00008 *                                                                 DTSCU833
00009 *    FUNCTION:  SIC FILE INPUT.                                   DTSCU833
00010 *                                                                 DTSCU833
00011 *                                                                 DTSCU833
00012 *    MODIFICATION LOG:                                            DTSCU833
00013 *                                                                 DTSCU833
00014 *    09/13/98  INITIAL DEVELOPMENT.   COPIED FROM MACCU833.          CL**2
00015 *              WORK ORDER:                      PROGRAMMER: ZL1.     CL**2
00016 *                                                                 DTSCU833
00017 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU833
00018 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU833
00019 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCU833
00020 *                                                                 DTSCU833
00021 *                                                                 DTSCU833
00022 *    DESCRIPTION:                                                 DTSCU833
00023 *                                                                 DTSCU833
00024 *    READ THE SPECIFIED SIC DESCRIPTION RECORD FROM THE LMI          CL**2
00025 *    "SIC DESCRIPTION" FILE.                                      DTSCU833
00026 *                                                                 DTSCU833
00027 *    THE TAX SYSTEM DOES NOT UPDATE THE LMI "SIC DESCRIPTION"        CL**2
00028 *    FILE.  THUS, THE ONLY VALID COMMAND IS READ.                 DTSCU833
00029 *                                                                 DTSCU833
00030 *    IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE MODULE.   DTSCU833
00031 *                                                                 DTSCU833
00032 *    IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN NORMAL,  DTSCU833
00033 *    NOT FOUND, CLOSED, OR DISABLED, THEN ABEND THE MODULE.       DTSCU833
00034 *                                                                 DTSCU833
00035 *                                                                 DTSCU833
00036 *****                                                             DTSCU833
00037      SKIP3                                                        DTSCU833
00038  ENVIRONMENT DIVISION.                                            DTSCU833
00039      SKIP3                                                        DTSCU833
00040  DATA DIVISION.                                                   DTSCU833
00041      SKIP3                                                        DTSCU833
00042  WORKING-STORAGE SECTION.                                         DTSCU833
000425 77  PAN-VALET PICTURE X(24) VALUE '004DTSCU833  10/02/98'.       DTSCU833
00043      SKIP3                                                        DTSCU833
00044  01  WRK-AREA.                                                    DTSCU833
00045      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U833'.    DTSCU833
00046      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU833
00047      SKIP1                                                        DTSCU833
00048      05  EMSG-NOT-AVAILABLE.                                      DTSCU833
00049          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU833
00050          10  FILLER                  PIC  X(06)  VALUE 'FILE  '.  DTSCU833
00051          10  EMSG-FILE-NAME          PIC  X(08).                  DTSCU833
00052          10  FILLER                  PIC  X(33)                   DTSCU833
00053            VALUE '  NOT AVAILABLE  PLEASE TRY LATER'.             DTSCU833
00054      SKIP1                                                        DTSCU833
00055      05  WRK-FILE-NAME               PIC  X(08)  VALUE 'DTSFSIC'.    CL**4
00056      SKIP1                                                        DTSCU833
00057      05  WRK-REC-LENGTH              PIC S9(04)  COMP             DTSCU833
00058                                                  VALUE +46.       DTSCU833
00059      EJECT                                                        DTSCU833
00060  LINKAGE SECTION.                                                 DTSCU833
00061      SKIP3                                                        DTSCU833
00062  01  DFHCOMMAREA.                                                 DTSCU833
00063      05  L833-CONTROL-BLOCK.                                      DTSCU833
00064  ++INCLUDE DTSIL833                                                  CL**2
00065      SKIP3                                                        DTSCU833
00066      05  XSIC-REC.                                                DTSCU833
00067  ++INCLUDE DTSIXSIC                                                  CL**2
00068      EJECT                                                        DTSCU833
00069  PROCEDURE DIVISION.                                              DTSCU833
00070      SKIP2                                                        DTSCU833
00071      MOVE SPACES TO L833-MSG-AREA.                                DTSCU833
00072      SET L833-OK-88 TO TRUE.                                      DTSCU833
00073      SKIP1                                                        DTSCU833
00074      IF L833-READ-88                                              DTSCU833
00075          PERFORM P1100-READ THRU P1100-EXIT                       DTSCU833
00076      ELSE                                                         DTSCU833
00077          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU833
00078      SKIP2                                                        DTSCU833
00079      EXEC CICS                                                    DTSCU833
00080          RETURN                                                   DTSCU833
00081      END-EXEC.                                                    DTSCU833
00082      SKIP2                                                        DTSCU833
00083      GOBACK.                                                      DTSCU833
00084      EJECT                                                        DTSCU833
00085  P1100-READ.                                                      DTSCU833
00086      MOVE '01' TO XSIC-LINE-NUMBER.                               DTSCU833
00087      SKIP1                                                        DTSCU833
00088      EXEC CICS                                                    DTSCU833
00089          READ                                                     DTSCU833
00090              DATASET (WRK-FILE-NAME)                              DTSCU833
00091              INTO (XSIC-REC)                                      DTSCU833
00092              LENGTH (WRK-REC-LENGTH)                              DTSCU833
00093              RIDFLD (XSIC-KEY-AREA)                               DTSCU833
00094              RESP (WRK-RESP-CD)                                   DTSCU833
00095      END-EXEC.                                                    DTSCU833
00096      SKIP1                                                        DTSCU833
00097      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU833
00098                         OR DFHRESP (SYSIDERR)                     DTSCU833
00099          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU833
00100          GO TO P1100-EXIT.                                        DTSCU833
00101      SKIP1                                                        DTSCU833
00102      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU833
00103         PERFORM S1200-NOT-FOUND THRU S1200-EXIT                   DTSCU833
00104         GO TO P1100-EXIT.                                         DTSCU833
00105      SKIP1                                                        DTSCU833
00106      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU833
00107          NEXT SENTENCE                                            DTSCU833
00108      ELSE                                                         DTSCU833
00109          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU833
00110  P1100-EXIT.                                                      DTSCU833
00111      EXIT.                                                        DTSCU833
00112      EJECT                                                        DTSCU833
00113  S1100-NOT-AVAILABLE.                                             DTSCU833
00114      MOVE WRK-FILE-NAME TO EMSG-FILE-NAME.                        DTSCU833
00115      MOVE EMSG-NOT-AVAILABLE TO L833-MSG-AREA.                    DTSCU833
00116      SET L833-FILE-CLOSED-88 TO TRUE.                             DTSCU833
00117  S1100-EXIT.                                                      DTSCU833
00118      EXIT.                                                        DTSCU833
00119      SKIP3                                                        DTSCU833
00120  S1200-NOT-FOUND.                                                 DTSCU833
00121      SET L833-NO-REC-88 TO TRUE.                                  DTSCU833
00122  S1200-EXIT.                                                      DTSCU833
00123      EXIT.                                                        DTSCU833
00124      EJECT                                                        DTSCU833
00125  S899-ABEND.                                                      DTSCU833
00126      SKIP1                                                        DTSCU833
00127      EXEC CICS                                                    DTSCU833
00128          ABEND                                                    DTSCU833
00129              ABCODE (WRK-ABEND-CD)                                DTSCU833
00130      END-EXEC.                                                    DTSCU833
00131      SKIP1                                                        DTSCU833
00132  S899-EXIT.                                                       DTSCU833
00133      EXIT.                                                        DTSCU833
