00001 IDENTIFICATION DIVISION. 02/07/12 00002 PROGRAM-ID. DTSBU063. DTSBU063 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004 00004 DATE-WRITTEN. JULY 1994. DTSBU063 00005 DATE-COMPILED. DTSBU063 00006 SKIP3 DTSBU063 00007 ***** DTSBU063 00008 * DTSBU063 00009 * FUNCTION: ASSIGNMENT TYPE EDIT/DESCRIPTION. DTSBU063 00010 * DTSBU063 00011 * DTSBU063 00012 * MODIFICATION LOG: DTSBU063 00013 * DTSBU063 00014 * 11/06/98 CLONED FROM MACCU063. DTSBU063 00015 * WORK ORDER: PROGRAMMER: ZL1 DTSBU063 00016 * DTSBU063 00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU063 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU063 00019 * WORK ORDER: PROGRAMMER: XXX DTSBU063 00020 * DTSBU063 00021 * DTSBU063 00022 * DESCRIPTION: DTSBU063 00023 * DTSBU063 00024 * DTSBU063 IS PASSED AN ASSIGN-TYPE. DTSBU063 00025 * DTSBU063 DETERMINES IF THE ASSIGN-TYPE IS VALID AND DTSBU063 00026 * RETURNS A RESULT INDICATOR AND (IF ASSIGN-TYPE IS VALID) DTSBU063 00027 * L063-DATA-AREA. DTSBU063 00028 * DTSBU063 00029 * IF ASSIGN-TYPE IS NOT VALID, RETURN SPACES IN L063-DATA-AREA,DTSBU063 00030 * EXCEPT RETURN 'NOT VALID' IN L063-DESCRIPTION. DTSBU063 00031 * DTSBU063 00032 * DTSBU063 READS A REFERENCE FILE FFAT RECORD TO DETERMINE DTSBU063 00033 * THE VALIDITY OF L063-TYPE AND TO FIND THE DESCRIPTION, ETC. DTSBU063 00034 * DTSBU063 00035 ***** DTSBU063 00036 SKIP3 DTSBU063 00037 ENVIRONMENT DIVISION. DTSBU063 00038 SKIP3 DTSBU063 00039 DATA DIVISION. DTSBU063 00040 SKIP3 DTSBU063 00041 WORKING-STORAGE SECTION. DTSBU063 000415 77 PAN-VALET PICTURE X(24) VALUE '004DTSBU063 02/07/12'. DTSBU063 00042 SKIP3 DTSBU063 00043 01 WRK-AREA. DTSBU063 00044 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU063 00045 VALUE +063. DTSBU063 00046 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU063 00047 EJECT DTSBU063 00048 01 L931-LINK-AREA. DTSBU063 00049 05 L931-CONTROL-BLOCK. DTSBU063 00050 ++INCLUDE DTSIL931 DTSBU063 00051 SKIP3 DTSBU063 00052 01 FFAT-LINK-AREA. DTSBU063 00053 05 FFAT-REC. DTSBU063 00054 ++INCLUDE DTSIFFAT DTSBU063 00055 EJECT DTSBU063 00056 LINKAGE SECTION. DTSBU063 00057 SKIP3 DTSBU063 00058 01 L063-LINK-AREA. DTSBU063 00059 ++INCLUDE DTSIL063 DTSBU063 00060 EJECT DTSBU063 00061 PROCEDURE DIVISION DTSBU063 00062 USING L063-LINK-AREA. DTSBU063 00063 SKIP2 DTSBU063 00064 MOVE '2' TO L063-RESULT-IND. DTSBU063 00065 MOVE SPACE TO L063-DATA-AREA. DTSBU063 00066 MOVE +0 TO L063-DEFAULT-DUE-DAYS. DTSBU063 00067 MOVE 'NOT VALID' TO L063-DESCRIPTION. DTSBU063 00068 SKIP1 DTSBU063 00069 MOVE LOW-VALUE TO FFAT-KEY-AREA. DTSBU063 00070 SET FFAT-FAT-88 TO TRUE. DTSBU063 00071 MOVE L063-TYPE TO FFAT-TYPE. DTSBU063 00072 SKIP1 DTSBU063 00073 PERFORM S931-READ DTSBU063 00074 THRU DTSBU063 00075 S931-EXIT. DTSBU063 00076 SKIP1 DTSBU063 00077 IF L931-OK-88 DTSBU063 00078 MOVE '1' TO L063-RESULT-IND DTSBU063 00079 MOVE FFAT-DATA-AREA TO L063-DATA-AREA. DTSBU063 00080 SKIP2 DTSBU063 00081 GOBACK. DTSBU063 00082 SKIP3 DTSBU063 00083 S931-READ. DTSBU063 00084 SET L931-READ-88 TO TRUE. DTSBU063 00085 GO TO S931-REF-FILE. DTSBU063 00086 S931-REF-FILE. DTSBU063 00087 SKIP1 DTSBU063 00088 CALL 'DTSBU931' DTSBU063 00089 USING L931-LINK-AREA DTSBU063 00090 FFAT-LINK-AREA. DTSBU063 00091 SKIP1 DTSBU063 00092 S931-EXIT. DTSBU063 00093 EXIT. DTSBU063