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
