00001  IDENTIFICATION DIVISION.                                         09/09/98
00002  PROGRAM-ID.             DTSCU082.                                DTSCU082
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV003
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCU082
00005  DATE-COMPILED.                                                   DTSCU082
00006      SKIP3                                                        DTSCU082
00007 *****                                                             DTSCU082
00008 *                                                                 DTSCU082
00009 *    FUNCTION:  OPERATOR ID EDIT/LOOKUP.                          DTSCU082
00010 *                                                                 DTSCU082
00011 *                                                                 DTSCU082
00012 *    MODIFICATION LOG:                                            DTSCU082
00013 *                                                                 DTSCU082
00014 *    08/30/98  INITIAL DEVELOPMENT.    COPIED FROM MACCU082.         CL**2
00015 *              WORK ORDER:                      PROGRAMMER: ZL1      CL**2
00016 *                                                                 DTSCU082
00017 *                                                                 DTSCU082
00018 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU082
00019 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU082
00020 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCU082
00021 *                                                                 DTSCU082
00022 *                                                                 DTSCU082
00023 *    DESCRIPTION:                                                 DTSCU082
00024 *                                                                 DTSCU082
00025 *    DTSCU082 IS PASSED L082-OP-ID.                                  CL**2
00026 *                                                                 DTSCU082
00027 *    REFERENCE FILE OPERATOR ID RECORDS ARE READ (VIA A LINK TO   DTSCU082
00028 *    DTSCU831) TO VALIDATE THE OPERATOR ID.                          CL**2
00029 *    IF NO OPERATOR ID RECORD IS FOUND, THEN RETURN               DTSCU082
00030 *    'NOT VALID' IN L082-OP-NAME (AS WELL AS THE APPROPRIATE      DTSCU082
00031 *    L082-RETURN-IND).                                            DTSCU082
00032 *                                                                 DTSCU082
00033 *****                                                             DTSCU082
00034      SKIP3                                                        DTSCU082
00035  ENVIRONMENT DIVISION.                                            DTSCU082
00036      SKIP3                                                        DTSCU082
00037  DATA DIVISION.                                                   DTSCU082
00038      SKIP3                                                        DTSCU082
00039  WORKING-STORAGE SECTION.                                         DTSCU082
000395 77  PAN-VALET PICTURE X(24) VALUE '003DTSCU082  09/09/98'.       DTSCU082
00040      SKIP3                                                        DTSCU082
00041  01  WRK-AREA.                                                    DTSCU082
00042      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U082'.    DTSCU082
00043      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSCU082
00044      EJECT                                                        DTSCU082
00045  01  L831-COMM-AREA.                                              DTSCU082
00046      05  L831-CONTROL-BLOCK.                                      DTSCU082
00047  ++INCLUDE DTSIL831                                                  CL**2
00048      SKIP3                                                        DTSCU082
00049      05  FSKL-REC.                                                DTSCU082
00050  ++INCLUDE DTSIFSKL                                                  CL**2
00051      SKIP3                                                        DTSCU082
00052      05  FOPR-REC REDEFINES FSKL-REC.                             DTSCU082
00053  ++INCLUDE DTSIFOPR                                                  CL**2
00054      EJECT                                                        DTSCU082
00055  LINKAGE SECTION.                                                 DTSCU082
00056      SKIP3                                                        DTSCU082
00057  01  DFHCOMMAREA.                                                 DTSCU082
00058  ++INCLUDE DTSIL082                                                  CL**3
00059      EJECT                                                        DTSCU082
00060  PROCEDURE DIVISION.                                              DTSCU082
00061      SKIP2                                                        DTSCU082
00062      SET L082-NOT-VALID-OP TO TRUE.                               DTSCU082
00063      SKIP1                                                        DTSCU082
00064      MOVE SPACE TO L082-DATA-AREA.                                DTSCU082
00065      SKIP1                                                        DTSCU082
00066      MOVE 'NOT VALID' TO L082-NAME.                               DTSCU082
00067      SKIP1                                                        DTSCU082
00068      MOVE SPACE TO L082-MSG-AREA.                                 DTSCU082
00069      SKIP1                                                        DTSCU082
00070      PERFORM P1000-PROCESS THRU P1000-EXIT.                       DTSCU082
00071      SKIP1                                                        DTSCU082
00072      EXEC CICS                                                    DTSCU082
00073          RETURN                                                   DTSCU082
00074      END-EXEC.                                                    DTSCU082
00075      SKIP2                                                        DTSCU082
00076      GOBACK.                                                      DTSCU082
00077      EJECT                                                        DTSCU082
00078  P1000-PROCESS.                                                   DTSCU082
00079      MOVE LOW-VALUES TO FOPR-KEY-AREA.                            DTSCU082
00080      SET FOPR-OPR-88 TO TRUE.                                     DTSCU082
00081      MOVE L082-OP-ID TO FOPR-OP-ID.                               DTSCU082
00082      SKIP1                                                        DTSCU082
00083      PERFORM S831-REF-READ THRU S831-EXIT.                        DTSCU082
00084      SKIP1                                                        DTSCU082
00085      IF L831-FILE-CLOSED-88                                       DTSCU082
00086          MOVE L831-MSG-AREA TO L082-MSG-AREA                      DTSCU082
00087          SET L082-FILE-CLOSED TO TRUE                             DTSCU082
00088          GO TO P1000-EXIT.                                        DTSCU082
00089      SKIP1                                                        DTSCU082
00090      IF L831-NO-REC-88                                            DTSCU082
00091          GO TO P1000-EXIT.                                        DTSCU082
00092      SKIP1                                                        DTSCU082
00093      MOVE FOPR-TYPE TO L082-TYPE.                                 DTSCU082
00094      MOVE FOPR-NAME TO L082-NAME.                                 DTSCU082
00095      MOVE FOPR-TITLE TO L082-TITLE.                               DTSCU082
00096      MOVE FOPR-UNIT-NAME TO L082-UNIT-NAME.                       DTSCU082
00097      MOVE FOPR-BUREAU-NAME TO L082-BUREAU-NAME.                   DTSCU082
00098      MOVE FOPR-PHONE-NUMBERS TO L082-PHONE-NUMBERS.               DTSCU082
00099      MOVE FOPR-EMAIL-ADDRESS TO L082-EMAIL-ADDRESS.                  CL**3
00100      MOVE FOPR-UNIT-ID TO L082-UNIT-ID.                           DTSCU082
00101      MOVE FOPR-FLD-REP-ID TO L082-FLD-REP-ID.                     DTSCU082
00102      MOVE FOPR-FLD-DESK-IND TO L082-FLD-DESK-IND.                 DTSCU082
00103      MOVE FOPR-ACCOUNTING-DESK-IND TO L082-ACCOUNTING-DESK-IND.      CL**3
00104      SKIP1                                                        DTSCU082
00105      SET L082-VALID-OP TO TRUE.                                   DTSCU082
00106  P1000-EXIT.                                                      DTSCU082
00107      EXIT.                                                        DTSCU082
00108      EJECT                                                        DTSCU082
00109  S831-REF-READ.                                                   DTSCU082
00110      SET L831-READ-88 TO TRUE.                                    DTSCU082
00111      GO TO S831-LINK-REF.                                         DTSCU082
00112      SKIP1                                                        DTSCU082
00113  S831-LINK-REF.                                                   DTSCU082
00114      SKIP1                                                        DTSCU082
00115      EXEC CICS                                                    DTSCU082
00116          LINK                                                     DTSCU082
00117              PROGRAM ('DTSCU831')                                    CL**2
00118              COMMAREA (L831-COMM-AREA)                            DTSCU082
00119      END-EXEC.                                                    DTSCU082
00120      SKIP1                                                        DTSCU082
00121  S831-EXIT.                                                       DTSCU082
00122      EXIT.                                                        DTSCU082
00123      SKIP3                                                        DTSCU082
00124  S899-ABEND.                                                      DTSCU082
00125      SKIP1                                                        DTSCU082
00126      EXEC CICS                                                    DTSCU082
00127          ABEND                                                    DTSCU082
00128              ABCODE (WRK-ABEND-CODE)                              DTSCU082
00129      END-EXEC.                                                    DTSCU082
00130      SKIP1                                                        DTSCU082
00131  S899-EXIT.                                                       DTSCU082
00132      EXIT.                                                        DTSCU082
