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