RpgleDBG010R4 < DBG400

You are here: DBG/400>DBG400 Web>SourceCodeList>RpgleSource>RpgleDBG010R4 (26 May 2005, MartinRowe) (raw view)EditAttach
<verbatim>
      **********************************************************************************************
      * DBG010R4: Display/Edit document text
      * 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)
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
      *  Document headings
     FDBGDFTH1  UF A E           K DISK    USROPN
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
      *  PROGRAM NAME
     D                SDS
     D K#User                254    263
      *
     D                 DS
     D OVRDBF                  1     40    INZ('OVRDBF FILE(          ) -
     D                                     SECURE(*YES)')
     D  FileName              13     22
      *
     D                 DS
     D DLTOVR                  1     30    INZ('DLTOVR FILE(*ALL) LVL(*)')
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D K#Fnam          S              5
     D P#Docd          S             10
     D P#Edit          S              1
     D P#Pgm           S             10
     D P#Titl          S             50
     D P#CmdString     S            250
     D P#CmdLength     S             15  5
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    P#Pgm
      **********************************************************************************************
      * KEY LISTS:
      **********************************************************************************************
     C     Ufpkey        KLIST
     C                   KFLD                    K#User
     C                   KFLD                    K#Fnam
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
      * Assume it will be okay to edit any document - set P#Edit to *off if it's not
     C                   MOVE      *on           P#Edit
      *
     C                   EVAL      FileName = 'DBGDFTH1'
     C                   CALL      'QCMDEXC'                            90
     C                   PARM      OVRDBF        P#CmdString
     C                   PARM      40            P#CmdLength
      *
     C                   EVAL      FileName = 'DBGDFTD1'
     C                   CALL      'QCMDEXC'                            90
     C                   PARM      OVRDBF        P#CmdString
     C                   PARM      40            P#CmdLength
      *
     C                   EVAL      FileName = 'DBGDFTK1'
     C                   CALL      'QCMDEXC'                            90
     C                   PARM      OVRDBF        P#CmdString
     C                   PARM      40            P#CmdLength
      *
     C                   EVAL      FileName = 'DBGDFTK2'
     C                   CALL      'QCMDEXC'                            90
     C                   PARM      OVRDBF        P#CmdString
     C                   PARM      40            P#CmdLength
     C                   OPEN      DBGDFTH1
      *  Get the program text
     C     P#Pgm         CHAIN     DBGDFTH1                           80
      *  If not on file, get the object text
B001 C                   IF        *IN80 = *on
     C                   CALL      'DBG010CL'                           90
     C                   PARM                    P#Pgm
     C                   PARM                    P#Titl
      *  If in edit mode, add an index record for this program
B002 C                   IF        P#Edit = *on
     C                   MOVE      P#Pgm         DFDOCD
     C                   MOVE      P#Titl        DFDOCH
     C                   EVAL      DFCDTE = *DATE
     C                   EVAL      DFADTE = *DATE
     C                   MOVE      K#User        DFCUSR
     C                   MOVE      K#User        DFAUSR
     C                   MOVE      'F'           DFLOCK
     C                   MOVE      'N'           DFHEAD
     C                   WRITE     DB1DFTH
E002 C                   ENDIF
      *  Found on index - set up title from there
X001 C                   ELSE
      *  Free the record (need to have file open for update to stop record
      *  blocking on update).
     C                   UPDATE    DB1DFTH
     C                   MOVE      DFDOCH        P#Titl
      *  If document permanently locked, or being updated (temp lock)
B002 C                   IF        DFLOCK = 'P'
     C                             OR DFLOCK = 'T'
      *  Disable edit availability
     C                   MOVE      *off          P#Edit
E002 C                   ENDIF
E001 C                   ENDIF
      *  Call the display program
     C                   CALL      'DBG030R4'                           90
     C                   PARM      P#Pgm         P#Docd
     C                   PARM                    P#Titl
     C                   PARM                    P#Edit
      *
     C                   CALL      'QCMDEXC'                            90
     C                   PARM      DLTOVR        P#CmdString
     C                   PARM      30            P#CmdLength
      *  EXIT PROGRAM
     C                   EVAL      *INLR = *on
     C                   RETURN
      **********************************************************************************************
</verbatim>
Topic revision: r1 - 26 May 2005 - 19:06:43 - MartinRowe
DBG400
Send a link to this page
Copyright © 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