00001  IDENTIFICATION DIVISION.                                         09/08/98
00002  PROGRAM-ID.             DTSCU062.                                DTSCU062
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV003
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCU062
00005  DATE-COMPILED.                                                   DTSCU062
00006      SKIP3                                                        DTSCU062
00007 *****                                                             DTSCU062
00008 *                                                                 DTSCU062
00009 *    FUNCTION:  FIELD REP ID EDIT/DESCRIPTION.                    DTSCU062
00010 *                                                                 DTSCU062
00011 *                                                                 DTSCU062
00012 *    MODIFICATION LOG:                                            DTSCU062
00013 *                                                                 DTSCU062
00014 *    08/30/98  INITIAL DEVELOPMENT.     COPIED FROM MACCU062         CL**2
00015 *              WORK ORDER:                      PROGRAMMER: ZL1      CL**2
00016 *                                                                 DTSCU062
00017 *                                                                 DTSCU062
00018 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU062
00019 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU062
00020 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCU062
00021 *                                                                 DTSCU062
00022 *                                                                 DTSCU062
00023 *    DESCRIPTION:                                                 DTSCU062
00024 *                                                                 DTSCU062
00025 *    DTSCU062 EDITS FIELD REP ID.                                    CL**2
00026 *                                                                 DTSCU062
00027 *    DTSCU062 RETURNS A RESULT INDICATOR AND (IF FIELD REP ID IS     CL**2
00028 *    FOUND) L062-RETURN-AREA.                                     DTSCU062
00029 *                                                                 DTSCU062
00030 *    IF FIELD REP ID IS NOT FOUND, THEN RETURN SPACES IN          DTSCU062
00031 *    L062-RETURN-AREA, EXCEPT FOR 'NOT VALID' IN L062-NAME.       DTSCU062
00032 *                                                                 DTSCU062
00033 *    DTSCU062 READS A REFERENCE FILE FFID RECORD.                    CL**2
00034 *                                                                 DTSCU062
00035 *****                                                             DTSCU062
00036      SKIP3                                                        DTSCU062
00037  ENVIRONMENT DIVISION.                                            DTSCU062
00038      SKIP3                                                        DTSCU062
00039  DATA DIVISION.                                                   DTSCU062
00040      SKIP3                                                        DTSCU062
00041  WORKING-STORAGE SECTION.                                         DTSCU062
000415 77  PAN-VALET PICTURE X(24) VALUE '003DTSCU062  09/08/98'.       DTSCU062
00042      SKIP3                                                        DTSCU062
00043  01  WRK-AREA.                                                    DTSCU062
00044      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U062'.    DTSCU062
00045                                                                      CL**3
00046      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSCU062
00047      EJECT                                                        DTSCU062
00048  01  L831-COMM-AREA.                                              DTSCU062
00049      05  L831-CONTROL-AREA.                                       DTSCU062
00050  ++INCLUDE DTSIL831                                                  CL**3
00051      SKIP3                                                        DTSCU062
00052      05  FSKL-REC.                                                DTSCU062
00053  ++INCLUDE DTSIFSKL                                                  CL**3
00054      SKIP3                                                        DTSCU062
00055      05  FFID-REC REDEFINES FSKL-REC.                             DTSCU062
00056  ++INCLUDE DTSIFFID                                                  CL**3
00057      EJECT                                                        DTSCU062
00058  LINKAGE SECTION.                                                 DTSCU062
00059      SKIP3                                                        DTSCU062
00060  01  DFHCOMMAREA.                                                 DTSCU062
00061  ++INCLUDE DTSIL062                                                  CL**3
00062      EJECT                                                        DTSCU062
00063  PROCEDURE DIVISION.                                              DTSCU062
00064      SKIP2                                                        DTSCU062
00065      SET L062-NOT-VALID TO TRUE.                                     CL**3
00066                                                                      CL**3
00067      MOVE SPACE TO L062-RETURN-AREA.                              DTSCU062
00068                                                                      CL**3
00069      MOVE 'NOT VALID' TO L062-NAME.                               DTSCU062
00070                                                                      CL**3
00071                                                                      CL**3
00072      MOVE LOW-VALUE TO FFID-KEY-AREA.                             DTSCU062
00073                                                                      CL**3
00074      SET FFID-FID-88 TO TRUE.                                     DTSCU062
00075                                                                      CL**3
00076      MOVE L062-FLD-REP-ID TO FFID-FLD-REP-ID.                     DTSCU062
00077                                                                      CL**3
00078      PERFORM S831-READ THRU S831-EXIT.                               CL**3
00079                                                                      CL**3
00080      IF L831-OK-88                                                DTSCU062
00081         SET L062-VALID TO TRUE                                       CL**3
00082         MOVE FFID-DATA-AREA TO L062-RETURN-AREA                   DTSCU062
00083      ELSE                                                         DTSCU062
00084      IF L831-FILE-CLOSED-88                                       DTSCU062
00085         SET L062-FILE-CLOSED TO TRUE                                 CL**3
00086         MOVE L831-MSG-AREA TO L062-MSG-AREA.                      DTSCU062
00087                                                                      CL**3
00088                                                                      CL**3
00089      EXEC CICS                                                    DTSCU062
00090          RETURN                                                   DTSCU062
00091      END-EXEC.                                                    DTSCU062
00092                                                                      CL**3
00093                                                                      CL**3
00094      GOBACK.                                                      DTSCU062
00095      EJECT                                                           CL**3
00096  S831-READ.                                                       DTSCU062
00097      SET L831-READ-88 TO TRUE.                                    DTSCU062
00098      GO TO S831-REF-FILE.                                         DTSCU062
00099                                                                      CL**3
00100  S831-REF-FILE.                                                   DTSCU062
00101      EXEC CICS                                                    DTSCU062
00102          LINK                                                     DTSCU062
00103              PROGRAM('DTSCU831')                                     CL**2
00104              COMMAREA(L831-COMM-AREA)                             DTSCU062
00105      END-EXEC.                                                    DTSCU062
00106  S831-EXIT.                                                       DTSCU062
00107      EXIT.                                                        DTSCU062
00108                                                                      CL**3
00109                                                                      CL**3
00110                                                                      CL**3
00111 ******************  S899-ABEND NOT USED.                          DTSCU062
00112 *S899-ABEND.                                                      DTSCU062
00113 *    SKIP1                                                        DTSCU062
00114 *    EXEC CICS                                                    DTSCU062
00115 *        ABEND                                                    DTSCU062
00116 *            ABCODE (WRK-ABEND-CODE)                              DTSCU062
00117 *    END-EXEC.                                                    DTSCU062
00118 *    SKIP1                                                        DTSCU062
00119 *S899-EXIT.                                                       DTSCU062
00120 *    EXIT.                                                        DTSCU062
