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