**********************************************************************************************
      * SETHLPTXT: Upload helptext to On-Line document files
      * 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
      *  PGMR:    MJR  Mar'96
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
     FDBGDFTD1  O    E             DISK
     FDBGDFTH1  O    E             DISK
     FQTXTSRC   IF   E             DISK    RENAME(QTXTSRC:DATA)
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
      *  PROGRAM NAME
     D                SDS
     D PGM                           10
     D SDS#User              254    263
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    DFDOCD
     C                   PARM                    DFDOCH
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
      * Write the document header
     C                   EVAL      DFCDTE = *DATE
     C                   EVAL      DFADTE = *DATE
     C                   EVAL      DFCUSR = SDS#User
     C                   EVAL      DFAUSR = SDS#User
     C                   EVAL      DFLOCK = 'F'
     C                   EVAL      DFHEAD = 'N'
     C                   WRITE     DB1DFTH
      * Write the document body
     C     1             SETLL     QTXTSRC
     C                   READ      QTXTSRC
B001 C                   DOW       NOT %EOF(QTXTSRC)
     C                   EVAL      DFTEXT = SRCDTA
     C                   EVAL      DFLINE = DFLINE + 10
     C                   WRITE     DB1DFT0
     C                   READ      QTXTSRC
E001 C                   ENDDO
      *
     C                   EVAL      *INLR = *on
     C                   RETURN
      **********************************************************************************************
Topic revision: r1 - 26 May 2005 - 20:00:15 - MartinRowe
 
This site is powered by FoswikiCopyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback