Re: RTV???? command question

[Mike.Collins@xxxxxxxxxx]

This is a multipart message in MIME format.
--
[ Picked text/plain from multipart/alternative ]
Hey Jeff, looks like you have nicked MY code! Glad it all works for you.




Jeff Crosby <jlcrosby@DILGARDFOODS.COM>
Sent by: midrange-l-admin@midrange.com
02/10/2002 18:13
Please respond to midrange-l


        To:     midrange-l@midrange.com
        cc:
        Subject:        Re: RTV???? command question


Rubino, Jim wrote:
> Yes please, if it is not to much trouble.

Here is the command:

CMD        PROMPT('Retrieve OW Control Record')

PARM       KWD(IPNAME) TYPE(*CHAR) LEN(40) RTNVAL(*YES) +
              PROMPT('IP name')
PARM       KWD(IPADRS) TYPE(*CHAR) LEN(15) RTNVAL(*YES) +
              PROMPT('IP address')
PARM       KWD(ACSUSR) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
              PROMPT('ACS user')
PARM       KWD(ACSPWD) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
              PROMPT('ACS password')
PARM       KWD(HSTUSR) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
              PROMPT('Host user')
PARM       KWD(HSTPWD) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
              PROMPT('Host password')
PARM       KWD(ACSDLPTH) TYPE(*CHAR) LEN(40) +
              RTNVAL(*YES) PROMPT('ACS download path')
PARM       KWD(ACSULPTH) TYPE(*CHAR) LEN(40) +
              RTNVAL(*YES) PROMPT('ACS upload path')
PARM       KWD(IFSDLPTH) TYPE(*CHAR) LEN(40) +
              RTNVAL(*YES) PROMPT('IFS download path')
PARM       KWD(IFSULPTH) TYPE(*CHAR) LEN(40) +
              RTNVAL(*YES) PROMPT('IFS upload path')
PARM       KWD(OWCTLFND) TYPE(*CHAR) LEN(1) +
              RTNVAL(*YES) PROMPT('OW control record +
              found?')

Here is the CL:

              PGM        PARM(&IPNAME &IPADRS &ACSUSR &ACSPWD &HSTUSR +
                           &HSTPWD &ACSDLPTH &ACSULPTH &IFSDLPTH +
                           &IFSULPTH &OWCTLFND)

/* PARAMETERS */

              DCL        VAR(&IPNAME) TYPE(*CHAR) LEN(40)
              DCL        VAR(&IPADRS) TYPE(*CHAR) LEN(15)
              DCL        VAR(&ACSUSR) TYPE(*CHAR) LEN(10)
              DCL        VAR(&ACSPWD) TYPE(*CHAR) LEN(10)
              DCL        VAR(&HSTUSR) TYPE(*CHAR) LEN(10)
              DCL        VAR(&HSTPWD) TYPE(*CHAR) LEN(10)
              DCL        VAR(&ACSDLPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&ACSULPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&IFSDLPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&IFSULPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&OWCTLFND) TYPE(*CHAR) LEN(1)

/* VARIABLES (MUST REPEAT PARMS FOR CALL TO RPG PROGRAM) */

              DCL        VAR(&RIPNAME) TYPE(*CHAR) LEN(40)
              DCL        VAR(&RIPADRS) TYPE(*CHAR) LEN(15)
              DCL        VAR(&RACSUSR) TYPE(*CHAR) LEN(10)
              DCL        VAR(&RACSPWD) TYPE(*CHAR) LEN(10)
              DCL        VAR(&RHSTUSR) TYPE(*CHAR) LEN(10)
              DCL        VAR(&RHSTPWD) TYPE(*CHAR) LEN(10)
              DCL        VAR(&RACSDLPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&RACSULPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&RIFSDLPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&RIFSULPTH) TYPE(*CHAR) LEN(40)
              DCL        VAR(&ROWCTLFND) TYPE(*CHAR) LEN(1)

/* GET IT */

              CALL       PGM(RTVOWCNT) PARM(&RIPNAME &RIPADRS +
                           &RACSUSR &RACSPWD &RHSTUSR &RHSTPWD +
                           &RACSDLPTH &RACSULPTH &RIFSDLPTH +
                           &RIFSULPTH &ROWCTLFND)

/* MOVE TO PARMS - THE MCH3601 IS FOR A NULL PTR.  IF THE COMMAND */
/*                 DID NOT REQUEST A PARTICULAR VARIABLE, THE     */
/*                 MCH3601 WILL OCCUR.                            */

              CHGVAR     VAR(&IPNAME) VALUE(&RIPNAME)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&IPADRS) VALUE(&RIPADRS)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&ACSUSR) VALUE(&RACSUSR)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&ACSPWD) VALUE(&RACSPWD)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&HSTUSR) VALUE(&RHSTUSR)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&HSTPWD) VALUE(&RHSTPWD)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&ACSDLPTH) VALUE(&RACSDLPTH)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&ACSULPTH) VALUE(&RACSULPTH)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&IFSDLPTH) VALUE(&RIFSDLPTH)
              MONMSG     MSGID(MCH3601)
              CHGVAR     VAR(&IFSULPTH) VALUE(&RIFSULPTH)
              MONMSG     MSGID(MCH3601)

              ENDPGM

Here is the RPG:

       /TITLE 'Retrieve OrderWriter Control Record

       /COPY QRPGSRC,HDefault

      FACCSCNT   IF   E             DISK    UsrOpn

      D @No             C                   'N'
      D OWCtlFnd        S              1
      D @Yes            C                   'Y'

      C/EJECT
      C     *ENTRY        Plist
      C                   Parm                    IPNAME
      C                   Parm                    IPADRS
      C                   Parm                    ACSUSR
      C                   Parm                    ACSPWD
      C                   Parm                    HSTUSR
      C                   Parm                    HSTPWD
      C                   Parm                    ACSDLPTH
      C                   Parm                    ACSULPTH
      C                   Parm                    IFSDLPTH
      C                   Parm                    IFSULPTH
      C                   Parm                    OWCtlFnd
      C                   Return
       /FREE
        // Get control record
        Open ACCSCNT;
        CHAIN 1 ACCSCNT;
        // Clear if not found
        If Not %Found(ACCSCNT);
          IPNAME = *Blanks;
          IPADRS = *Blanks;
          ACSUSR = *Blanks;
          ACSPWD = *Blanks;
          HSTUSR = *Blanks;
          HSTPWD = *Blanks;
          ACSDLPTH = *Blanks;
          ACSULPTH = *Blanks;
          IFSDLPTH = *Blanks;
          IFSULPTH = *Blanks;
          OWCtlFnd = @No;
        Else;
          OWCtlFnd = @Yes;
        Endif;
        // END THE JOB
        Close ACCSCNT;
        *INLR = *On;
        Return;
       /END-FREE

--
Jeff Crosby
Dilgard Frozen Foods, Inc.
P.O. Box 13369
Ft. Wayne, IN 46868-3369
260-422-7531

The opinions expressed are my own and not necessarily
the opinion of my company.  Unless I say so.



_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
To post a message email: MIDRANGE-L@midrange.com
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/cgi-bin/listinfo/midrange-l
or email: MIDRANGE-L-request@midrange.com
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.