95 lines
7.4 KiB
COBOL
95 lines
7.4 KiB
COBOL
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
|