**********************************************************************************************
      * DBG103R4: Maintain script entries in DB link file
      * Copyright (C) 2000  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
      **********************************************************************************************
      * INDICATOR USAGE:
      **********************************************************************************************
      *     File access inds
      *  80  81  82  83
      *     Error ind (for calls)
      *  90
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
      * Database Generation links
     FDBGDGL00  UF A E           K DISK
      * Database Generation script headers
     FDBGSQLH1  IF   E           K DISK
      **********************************************************************************************
      * ARRAYS:
      **********************************************************************************************
     D P#OutStrings    S            132    DIM(50)
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
      *  PROGRAM NAME
     D                SDS
     D SDS#PGM                       10
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D K#DglSrc        S                   LIKE(DGLSRC) INZ('*SCRIPT')
      **********************************************************************************************
      * CONSTANTS:
      **********************************************************************************************
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
      **********************************************************************************************
      * KEY LISTS:
      **********************************************************************************************
     C     DBGDGL00KEY   KLIST
     C                   KFLD                    DFDOCD
     C                   KFLD                    K#DglSrc
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
      * Loop through all link records, looking for script entries
     C     *LOVAL        SETLL     DBGDGL00
     C                   READ      DBGDGL00                               80
B001 C                   DOW       NOT *IN80
B002 C                   IF        DGLSEQ = 0
      * If the script doesn't exist, delete the entry in the link file
     C     DGLTGT        CHAIN     DBGSQLH1                           81
B003 C                   IF        *IN81
     C                   DELETE    PFDGL
E003 C                   ENDIF
E002 C                   ENDIF
     C                   READ      DBGDGL00                               80
E001 C                   ENDDO
      * Now make sure any new scripts are added into the link file
      * Loop through all script headers
     C                   EVAL      DFDOCD = 'A'
     C     DFDOCD        SETLL     DBGSQLH1
     C                   READ      DBGSQLH1                               80
B001 C                   DOW       NOT *IN80
      * If a link record doesn't exist for this script, then create one
     C     DBGDGL00KEY   CHAIN     DBGDGL00                           81
B002 C                   IF        *IN81
     C                   EVAL      DGLTGT = DFDOCD
     C                   EVAL      DGLSRC = '*SCRIPT'
     C                   EVAL      DGLSEQ = 0
     C                   EVAL      DGLSQL = *BLANKS
     C                   EVAL      DGLTXT = DFDOCH
     C                   WRITE     PFDGL
      * Otherwise, make sure the text is up to date
X002 C                   ELSE
     C                   EVAL      DGLTXT = DFDOCH
     C                   UPDATE    PFDGL
E002 C                   ENDIF
     C                   READ      DBGSQLH1                               80
E001 C                   ENDDO
      *  Time to go...
     C     ENDPGM        TAG
      *    ======        ===
     C                   EVAL      *INLR = *ON
     C                   RETURN
      **********************************************************************************************