/* SHORT FORM DYNAMIC IP ADDRESS */  
/* DIALUP CONNECTION */  
   
/* LPD: OBTAIN IP ADDRESS OF USER AND MODIFY TCP/IP DEVICE */  
/* QUEUE TO USE NEW ADDRESS (FIREWALL PRINTING) */  
/* OS/400 V3.7 */  
/* */  
PGM  
   
   DCL  VAR(&RECEIVER) TYPE(*CHAR) LEN(892)  
   DCL  VAR(&DEVICE) TYPE(*CHAR) LEN(10)  
   DCL  VAR(&USER) TYPE(*CHAR) LEN(10)  
   DCL  VAR(&PRTQ) TYPE(*CHAR) LEN(10)  
   DCL  VAR(&CHANGE) TYPE(*CHAR) LEN(3)  
   DCL  VAR(&ERROR) TYPE(*CHAR) LEN(4) +  
     VALUE(X'00000000')  
   DCL  VAR(&RCVRLN) TYPE(*CHAR) LEN(4)  
   DCL  VAR(&FORMAT) TYPE(*CHAR) LEN(8) +  
     VALUE('DEVD0600')  
   DCL  VAR(&IPADDR) TYPE(*CHAR) LEN(15)  
   DCL  VAR(&DONEXT) TYPE(*CHAR) LEN(1)  
   DCL  VAR(&YESNO) TYPE(*CHAR) LEN(1)  
   DCL  VAR(&PRINTER) TYPE(*CHAR) LEN(10)  
   
/* OBTAIN DEVICE NAME AND USERID */  
   RTVJOBA  JOB(&DEVICE) CURUSER(&USER)  
   CHGVAR  VAR(&CHANGE) VALUE(%SST(&USER 1 3))  
   
/* NAME PRINT QUEUE TO CHANGE */  
   SNDUSRMSG  MSG('Enter the name of the printer to +  
    change!') MSGTYPE(*INQ) TOMSGQ(*) +  
    MSGRPY(&PRINTER)  
   CHGVAR  VAR(&PRTQ) VALUE(&PRINTER)  
   
/* OBTAIN IP ADDRESS */  
   CHGVAR  VAR(%BIN(&RCVRLN)) VALUE(892)  
   CALL  PGM(QDCRDEVD) PARM(&RECEIVER &RCVRLN &FORMAT +  
    &DEVICE &ERROR)  
   CHGVAR  VAR(&IPADDR) VALUE(%SST(&RECEIVER 878 15))  
   
/* MODIFY OUTQ WITH CURRENT IP ADDRESS */  
   SNDMSG  MSG('IP address is being updated, it will +  
    take about 15 seconds, please wait: +  
    <<<hit enter>>>') TOUSR(*REQUESTER) +  
    MSGTYPE(*INFO)  
   ENDWTR  WTR(&PRTQ) OPTION(*IMMED)  
   MONMSG  MSGID(CPF3313) /* SUPPRESS WRITER NOT STARTED MSG */  
   GOTO  CMDLBL(CHGOUTQ)  
   
TRYAGAIN:    
   CHGVAR  VAR(&DONEXT) VALUE('a')  
   SNDUSRMSG  MSG('Enter the name of the printer to +  
    change!') MSGTYPE(*INQ) TOMSGQ(*) +  
    MSGRPY(&PRINTER)  
   CHGVAR  VAR(&PRTQ) VALUE(&PRINTER)  
   SNDMSG  MSG('IP address is being updated, it will +  
    take about 15 seconds, please wait: +  
    <<<hit enter>>>') TOUSR(*REQUESTER) +  
     MSGTYPE(*INFO)  
   ENDWTR  WTR(&PRTQ) OPTION(*IMMED)  
   MONMSG  MSGID(CPF3313) /* SUPPRESS WRITER NOT STARTED MSG */  
   
CHGOUTQ:  
   DLYJOB  DLY(15) /* WAIT 15 SECONDS */  
   CHGOUTQ  OUTQ(QUSRSYS/&PRTQ) AUTOSTRWTR(1) +  
     INTNETADR(&IPADDR)  
   MONMSG  MSGID(CPF3319) EXEC(SNDMSG MSG('UNABLE TO +  
    MODIFY IP ADDRESS, WRITER IS CURRENTLY IN +  
    USE. (CPF3319)') TOUSR(&USER))  
   MONMSG  MSGID(CPF3357) EXEC(SNDUSRMSG MSG('Printer +  
    not found!, <<R-Retry(enter PRT name), +  
    C-Cancel(end program)>>') VALUES(R C) +  
    TOMSGQ(*) MSGRPY(&DONEXT))  
   IF  COND(&DONEXT *EQ 'C') THEN(GOTO CMDLBL(ENDPGM))  
   IF  COND(&DONEXT *EQ 'R') THEN(GOTO +  
    CMDLBL(TRYAGAIN))  
   
ADDPRT:  
   SNDUSRMSG  MSG('Update another printer address? +  
    Yes/No(Y/N)') VALUES(Y N) MSGTYPE(*INQ) +  
    TOMSGQ(*) MSGRPY(&YESNO)  
   IF  COND(&YESNO *EQ 'N') THEN(GOTO CMDLBL(ENDPGM))  
   IF  COND(&YESNO *EQ 'Y') THEN(GOTO +  
     CMDLBL(TRYAGAIN))  
   
ENDPGM:    
   ENDPGM