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