110 lines
8.6 KiB
COBOL
110 lines
8.6 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/18/98
|
|
00002 PROGRAM-ID. DTSBU082. DTSBU082
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN. JULY 1994. DTSBU082
|
|
00005 DATE-COMPILED. DTSBU082
|
|
00006 SKIP3 DTSBU082
|
|
00007 ***** DTSBU082
|
|
00008 * DTSBU082
|
|
00009 * FUNCTION: OPERATOR ID EDIT/LOOKUP. DTSBU082
|
|
00010 * DTSBU082
|
|
00011 * DTSBU082
|
|
00012 * MODIFICATION LOG: DTSBU082
|
|
00013 * DTSBU082
|
|
00014 * 09/17/98 CLONED FROM MACCU082. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * DTSBU082
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU082
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU082
|
|
00019 * WORK ORDER: PROGRAMMER: XXX DTSBU082
|
|
00020 * DTSBU082
|
|
00021 * DTSBU082
|
|
00022 * DESCRIPTION: DTSBU082
|
|
00023 * DTSBU082
|
|
00024 * DTSBU082 IS PASSED L082-OP-ID. CL**2
|
|
00025 * DTSBU082
|
|
00026 * REFERENCE FILE OPERATOR ID RECORDS ARE READ (VIA A LINK TO DTSBU082
|
|
00027 * DTSBU931) TO VALIDATE THE OPERATOR ID. CL**2
|
|
00028 * IF NO OPERATOR ID RECORD IS FOUND, THEN RETURN DTSBU082
|
|
00029 * 'NOT VALID' IN L082-OP-NAME (AS WELL AS THE APPROPRIATE DTSBU082
|
|
00030 * L082-RETURN-IND). DTSBU082
|
|
00031 * DTSBU082
|
|
00032 ***** DTSBU082
|
|
00033 SKIP3 DTSBU082
|
|
00034 ENVIRONMENT DIVISION. DTSBU082
|
|
00035 SKIP3 DTSBU082
|
|
00036 DATA DIVISION. DTSBU082
|
|
00037 SKIP3 DTSBU082
|
|
00038 WORKING-STORAGE SECTION. DTSBU082
|
|
000385 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU082 09/18/98'. DTSBU082
|
|
00039 SKIP3 DTSBU082
|
|
00040 01 WRK-AREA. DTSBU082
|
|
00041 05 WRK-ABEND-CODE PIC S9(04) COMP DTSBU082
|
|
00042 VALUE +082. DTSBU082
|
|
00043 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU082
|
|
00044 EJECT DTSBU082
|
|
00045 01 L931-LINK-AREA. DTSBU082
|
|
00046 05 L931-CONTROL-BLOCK. DTSBU082
|
|
00047 ++INCLUDE DTSIL931 CL**2
|
|
00048 EJECT DTSBU082
|
|
00049 01 FOPR-LINK-AREA. DTSBU082
|
|
00050 05 FOPR-REC. DTSBU082
|
|
00051 ++INCLUDE DTSIFOPR CL**2
|
|
00052 EJECT DTSBU082
|
|
00053 LINKAGE SECTION. DTSBU082
|
|
00054 SKIP3 DTSBU082
|
|
00055 01 L082-LINK-AREA. DTSBU082
|
|
00056 ++INCLUDE DTSIL082 CL**2
|
|
00057 EJECT DTSBU082
|
|
00058 PROCEDURE DIVISION DTSBU082
|
|
00059 USING L082-LINK-AREA. DTSBU082
|
|
00060 SKIP2 DTSBU082
|
|
00061 SET L082-NOT-VALID-OP TO TRUE. DTSBU082
|
|
00062 SKIP1 DTSBU082
|
|
00063 MOVE SPACE TO L082-DATA-AREA. DTSBU082
|
|
00064 SKIP1 DTSBU082
|
|
00065 MOVE 'NOT VALID' TO L082-NAME. DTSBU082
|
|
00066 SKIP1 DTSBU082
|
|
00067 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU082
|
|
00068 SKIP2 DTSBU082
|
|
00069 GOBACK. DTSBU082
|
|
00070 EJECT DTSBU082
|
|
00071 P1000-PROCESS. DTSBU082
|
|
00072 MOVE LOW-VALUES TO FOPR-KEY-AREA. DTSBU082
|
|
00073 SET FOPR-OPR-88 TO TRUE. DTSBU082
|
|
00074 MOVE L082-OP-ID TO FOPR-OP-ID. DTSBU082
|
|
00075 SKIP1 DTSBU082
|
|
00076 PERFORM S931-REF-READ THRU S931-EXIT. DTSBU082
|
|
00077 SKIP1 DTSBU082
|
|
00078 IF L931-NO-REC-88 DTSBU082
|
|
00079 GO TO P1000-EXIT. DTSBU082
|
|
00080 SKIP1 DTSBU082
|
|
00081 MOVE FOPR-TYPE TO L082-TYPE. DTSBU082
|
|
00082 MOVE FOPR-NAME TO L082-NAME. DTSBU082
|
|
00083 MOVE FOPR-TITLE TO L082-TITLE. DTSBU082
|
|
00084 MOVE FOPR-UNIT-NAME TO L082-UNIT-NAME. DTSBU082
|
|
00085 MOVE FOPR-BUREAU-NAME TO L082-BUREAU-NAME. DTSBU082
|
|
00086 MOVE FOPR-PHONE-NUMBERS TO L082-PHONE-NUMBERS. DTSBU082
|
|
00087 MOVE FOPR-UNIT-ID TO L082-UNIT-ID. DTSBU082
|
|
00088 MOVE FOPR-FLD-REP-ID TO L082-FLD-REP-ID. DTSBU082
|
|
00089 MOVE FOPR-FLD-DESK-IND TO L082-FLD-DESK-IND. DTSBU082
|
|
00090 MOVE FOPR-ACCOUNTING-DESK-IND TO L082-ACCOUNTING-DESK-IND. CL**2
|
|
00091 MOVE FOPR-EMAIL-ADDRESS TO L082-EMAIL-ADDRESS. CL**2
|
|
00092 SKIP1 DTSBU082
|
|
00093 SET L082-VALID-OP TO TRUE. DTSBU082
|
|
00094 P1000-EXIT. DTSBU082
|
|
00095 EXIT. DTSBU082
|
|
00096 EJECT DTSBU082
|
|
00097 S931-REF-READ. DTSBU082
|
|
00098 SET L931-READ-88 TO TRUE. DTSBU082
|
|
00099 GO TO S931-LINK-REF. DTSBU082
|
|
00100 SKIP1 DTSBU082
|
|
00101 S931-LINK-REF. DTSBU082
|
|
00102 SKIP1 DTSBU082
|
|
00103 CALL 'DTSBU931' CL**2
|
|
00104 USING L931-LINK-AREA DTSBU082
|
|
00105 FOPR-LINK-AREA. DTSBU082
|
|
00106 SKIP1 DTSBU082
|
|
00107 S931-EXIT. DTSBU082
|
|
00108 EXIT. DTSBU082
|