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
