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