93 lines
7.3 KiB
COBOL
93 lines
7.3 KiB
COBOL
00001 IDENTIFICATION DIVISION. 11/05/98
|
|
00002 PROGRAM-ID. DTSBU062. DTSBU062
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN. JULY 1994. DTSBU062
|
|
00005 DATE-COMPILED. DTSBU062
|
|
00006 SKIP3 DTSBU062
|
|
00007 ***** DTSBU062
|
|
00008 * DTSBU062
|
|
00009 * FUNCTION: FIELD REP ID EDIT/DESCRIPTION. DTSBU062
|
|
00010 * DTSBU062
|
|
00011 * DTSBU062
|
|
00012 * MODIFICATION LOG: DTSBU062
|
|
00013 * DTSBU062
|
|
00014 * 07/12/94 CLONED FROM DTSCU062. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: RHC DTSBU062
|
|
00016 * DTSBU062
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU062
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU062
|
|
00019 * WORK ORDER: PROGRAMMER: XXX DTSBU062
|
|
00020 * DTSBU062
|
|
00021 * DTSBU062
|
|
00022 * DESCRIPTION: DTSBU062
|
|
00023 * DTSBU062
|
|
00024 * DTSBU062 EDITS FIELD REP ID. CL**2
|
|
00025 * DTSBU062
|
|
00026 * DTSBU062 RETURNS A RESULT INDICATOR AND (IF FIELD REP ID IS CL**2
|
|
00027 * FOUND) L062-RETURN-AREA. DTSBU062
|
|
00028 * DTSBU062
|
|
00029 * IF FIELD REP ID IS NOT FOUND, THEN RETURN SPACES IN DTSBU062
|
|
00030 * L062-RETURN-AREA, EXCEPT FOR 'NOT VALID' IN L062-NAME. DTSBU062
|
|
00031 * DTSBU062
|
|
00032 * DTSBU062 READS A REFERENCE FILE FFID RECORD. CL**2
|
|
00033 * DTSBU062
|
|
00034 ***** DTSBU062
|
|
00035 SKIP3 DTSBU062
|
|
00036 ENVIRONMENT DIVISION. DTSBU062
|
|
00037 SKIP3 DTSBU062
|
|
00038 DATA DIVISION. DTSBU062
|
|
00039 SKIP3 DTSBU062
|
|
00040 WORKING-STORAGE SECTION. DTSBU062
|
|
000405 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU062 11/05/98'. DTSBU062
|
|
00041 SKIP3 DTSBU062
|
|
00042 01 WRK-AREA. DTSBU062
|
|
00043 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU062
|
|
00044 VALUE +062. DTSBU062
|
|
00045 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU062
|
|
00046 EJECT DTSBU062
|
|
00047 01 L931-LINK-AREA. DTSBU062
|
|
00048 05 L931-CONTROL-AREA. DTSBU062
|
|
00049 ++INCLUDE DTSIL931 CL**3
|
|
00050 SKIP3 DTSBU062
|
|
00051 01 FFID-LINK-AREA. DTSBU062
|
|
00052 05 FFID-REC. DTSBU062
|
|
00053 ++INCLUDE DTSIFFID CL**3
|
|
00054 EJECT DTSBU062
|
|
00055 LINKAGE SECTION. DTSBU062
|
|
00056 SKIP3 DTSBU062
|
|
00057 01 L062-LINK-AREA. DTSBU062
|
|
00058 ++INCLUDE DTSIL062 CL**2
|
|
00059 EJECT DTSBU062
|
|
00060 PROCEDURE DIVISION DTSBU062
|
|
00061 USING L062-LINK-AREA. DTSBU062
|
|
00062 SKIP2 DTSBU062
|
|
00063 MOVE '2' TO L062-RESULT-IND. DTSBU062
|
|
00064 MOVE SPACE TO L062-RETURN-AREA. DTSBU062
|
|
00065 MOVE 'NOT VALID' TO L062-NAME. DTSBU062
|
|
00066 SKIP1 DTSBU062
|
|
00067 MOVE LOW-VALUE TO FFID-KEY-AREA. DTSBU062
|
|
00068 SET FFID-FID-88 TO TRUE. DTSBU062
|
|
00069 MOVE L062-FLD-REP-ID TO FFID-FLD-REP-ID. DTSBU062
|
|
00070 SKIP1 DTSBU062
|
|
00071 PERFORM S931-READ DTSBU062
|
|
00072 THRU DTSBU062
|
|
00073 S931-EXIT. DTSBU062
|
|
00074 SKIP1 DTSBU062
|
|
00075 IF L931-OK-88 DTSBU062
|
|
00076 MOVE '1' TO L062-RESULT-IND DTSBU062
|
|
00077 MOVE FFID-DATA-AREA TO L062-RETURN-AREA. DTSBU062
|
|
00078 SKIP2 DTSBU062
|
|
00079 GOBACK. DTSBU062
|
|
00080 SKIP3 DTSBU062
|
|
00081 S931-READ. DTSBU062
|
|
00082 SET L931-READ-88 TO TRUE. DTSBU062
|
|
00083 GO TO S931-REF-FILE. DTSBU062
|
|
00084 S931-REF-FILE. DTSBU062
|
|
00085 SKIP1 DTSBU062
|
|
00086 CALL 'DTSBU931' CL**2
|
|
00087 USING L931-LINK-AREA DTSBU062
|
|
00088 FFID-LINK-AREA. DTSBU062
|
|
00089 SKIP1 DTSBU062
|
|
00090 S931-EXIT. DTSBU062
|
|
00091 EXIT. DTSBU062
|