midrange.com code scratchpad
Name:
Command replacement
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
10/29/2019 07:52:03 pm
IP:
Logged
Description:
Turn off triggers before CLRPFM on a file with delete triggers.
Code:
  1. The QIBM_QCA_CHG_COMMAND program.
  2.  
  3. **FREE
  4.  
  5.        // *ENTRY
  6.        Dcl-PI CLRTRGF ExtProc('CLRTRGF');
  7.          changeCommandExitInfo Char(32767);
  8.          replacementCommand Char(32000);
  9.          replacementLength Int(10);
  10.        END-PI;
  11.  
  12.        Dcl-Ds Chgc0100 Based(Chgc0100Pointer) Qualified;
  13.          exitPoint Char(20);
  14.          exitPointFormat Char(8);
  15.          commandName Char(10);
  16.          library Char(10);
  17.          changeAllowed Char(1);
  18.          prompt Char(1);
  19.          reserved Char(2);
  20.          commandOffset Int(10);
  21.          commandLen Int(10);
  22.          proxyOffset Int(10);
  23.          proxyEntries Int(10);
  24.        END-DS;
  25.  
  26.        Dcl-s command Char(32000) Based(commandPointer);
  27.        Dcl-s incomingLength Int(10);
  28.        Dcl-s replacement Char(32000);
  29.  
  30.        // Overlay CHGC0100 format on entry parm.
  31.        Monitor;
  32.        Chgc0100Pointer = %Addr(changeCommandExitInfo);
  33.        On-Error;
  34.          *Inlr = *On;
  35.          Return;
  36.        EndMon;
  37.        If Chgc0100.commandName = 'CLRPFM'; // maybe check for file name here also
  38.        // Overlay Command
  39.        commandPointer = Chgc0100Pointer + Chgc0100.commandOffset;
  40.        incomingLength = Chgc0100.commandLen;
  41.  
  42.        // Load original command into the replacement command
  43.        replacement = %Subst(command:1:incomingLength);
  44.  
  45.            replacement = %Scanrpl('CLRPFM':'CLRTRGF':replacement);
  46.  
  47.        replacementCommand = replacement;
  48.        replacementLength = %Len(%Trim(replacementCommand));
  49.       EndIf;
  50.  
  51.        *Inlr = *On;
  52.        Return; 
  53.  
  54. The replacement command.
  55.  
  56.  SRTRANS:    CMD        PROMPT('CLEAR FILE WITH DELETE TRIGGER')
  57.  
  58.              PARM       KWD(FILE) TYPE(FILE) MIN(1)
  59.              PARM       KWD(MBR) TYPE(*CHAR) LEN(10)
  60.  
  61.  FILE:       QUAL       TYPE(*NAME) LEN(10) MIN(1)
  62.              QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
  63.                           SPCVAL((*CURLIB) (*LIBL)) PROMPT('Library') 
  64.  
  65. CL to process the command.
  66.              PGM        PARM(&FILE &MEMBER)
  67.              DCL        VAR(&FILE) TYPE(*CHAR) LEN(20)
  68.              DCL        VAR(&MEMBER) TYPE(*CHAR) LEN(10)
  69.              DCL        VAR(&QUALF) TYPE(*CHAR) LEN(10)
  70.              DCL        VAR(&QUALL) TYPE(*CHAR) LEN(10)
  71.              CHGVAR     VAR(&QUALF) VALUE(%SST(&FILE 1 10))
  72.              CHGVAR     VAR(&QUALL) VALUE(%SST(&FILE 11 10))
  73.              CHGPFTRG   FILE(&QUALL/&QUALF) TRG(*ALL) STATE(*DISABLED)
  74.              QSYS/CLRPFM FILE(&QUALL/&QUALF) MBR(&MEMBER)
  75.              CHGPFTRG   FILE(&QUALL/&QUALF) TRG(*ALL) STATE(*ENABLED)
  76.              ENDPGM     
  77.  
© 2004-2019 by midrange.com generated in 0.005s valid xhtml & css