pgm /* User profile name... */ DCL VAR(&USRNAM) TYPE(*CHAR) LEN(10) /* User password... */ DCL VAR(&PWD) TYPE(*CHAR) LEN(10) /* Product library... */ DCL VAR(&PrdLib) TYPE(*CHAR) LEN(10) /* External text... */ DCL VAR(&ExtTxt) TYPE(*CHAR) LEN(80) /*------ ------*/ /* */ /* The VARRCD buffer areas... */ /* */ DCL VAR(&USRPWDBUF) TYPE(*CHAR) LEN(128) DCL VAR(&LibBUF) TYPE(*CHAR) LEN(128) DCL VAR(&ExtTxtBUF) TYPE(*CHAR) LEN( 80) /*------ ------*/ /* */ /* Various work areas and fields... */ /* */ /* The 'application handle'... */ DCL VAR(&APPHND) TYPE(*CHAR) LEN(8) /* Starting row/column for window position... */ DCL VAR(&SCOL) TYPE(*DEC) LEN(3) DCL VAR(&SROW) TYPE(*DEC) LEN(3) /* For character<==>decimal conversion... */ DCL VAR(&SCOL_C) TYPE(*CHAR) LEN(3) DCL VAR(&SROW_C) TYPE(*CHAR) LEN(3) /* The function-requested return code from the displayed panel... */ DCL VAR(&FUNCTION) TYPE(*CHAR) LEN(4) DCL VAR(&FUNC_NBR) TYPE(*DEC) LEN(6) /* Default call msgq identifier... */ dcl &CallMsgQ *char 256 value( '*CALLER' ) /* Some text... */ dcl &Text *char 256 value( + '==>This is external text that has been inserted. + <===' ) /*------------------------------------------------------------------*/ /* */ /* Any requested function constants... */ /* */ /* Enter-key was pressed... */ DCL VAR(&ENTER_KEY) TYPE(*DEC) LEN(3) VALUE(25) /*------------------------------------------------------------------*/ /* The 'redisplay option' for a displayed panel... */ DCL VAR(&REDSPOPT) TYPE(*CHAR) LEN(1) /* Used to test messages received from *pgmq... */ DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /*------------------------------------------------------------------*/ /* We need to initialize the UIM environment by opening the */ /* display application. Once done, we'll save the existing screen */ /* image so UIM can do a 'restore display' when we finally finish.*/ /*------------------------------------------------------------------*/ /* Open the UIM Display Application... */ call quiopnda ( + &apphnd + 'PTNINS *LIBL ' + x'FFFFFFFF' + x'00000002' + 'N' + x'00000000' + ) /* Save the existing screen image... */ call quisetsc ( + &apphnd + x'00000000' + ) /*------------------------------------------------------------------*/ /* The following sections place various UIM dialog variables into */ /* the variable pool. We use separate VARRCD buffer variables */ /* just for the convenience of having separate names to work with.*/ /*------------------------------------------------------------------*/ /*------ ------*/ /* This two-variable set is the object description and the object */ /* name. We display the description and rerturn the name. */ /*------ ------*/ /* Set description and default name... */ CHGVAR VAR(%SST(&usrpwdbuf 1 10)) VALUE(&usrnam ) CHGVAR VAR(%SST(&usrpwdbuf 11 10)) VALUE(&pwd ) /* Put the ObjBuf VARRCD into the variable pool... */ call quiputv ( + &apphnd + &usrpwdbuf + x'00000014' + 'USRPWD ' + x'00000000' + ) /*------------------------------------------------------------------*/ /* Start the screen I/O cycle... */ /*------------------------------------------------------------------*/ /* */ /* The VARRCD has been PUT, so display the panel... */ /* */ /* Initialize the redisplay option... */ CHGVAR &REDSPOPT 'N' /* */ /* ...and display the panel... */ /* */ DSP_LOOP: call quidspp ( + &apphnd + &Function + 'USRPMT ' + &ReDspOpt + x'00000000' + 'O' + x'00000000' + &CallMsgQ + 'FRST' + 'D' + 'NONE' + 'NONE' + x'FFFFFFFF' + ) MONMSG MSGID(CPF0000 CPD0000) EXEC(GOTO + CMDLBL(EXIT_APP)) /* Retrieve the function-requested return code... */ CHGVAR VAR(&FUNC_NBR) VALUE(%BIN(&FUNCTION 1 4)) /* Clean up this program's message queue for next display... */ RMVMSG CLEAR(*ALL) /*------ ------*/ /* */ /* If an exit-type function was requested, the FUNCTION value will */ /* be negative. We'll process non-negatives here... */ /* */ IF COND(&FUNC_NBR *GE 0) THEN(DO) /*------ ------*/ /* Set up for a redisplay... */ CHGVAR &REDSPOPT 'Y' /*------ ------*/ /* Get the ObjName VARRCD... */ call quigetv ( + &apphnd + &UsrPwdBuf + x'00000014' + 'USRPWD ' + x'00000000' + ) CHGVAR VAR(&USRNAM) VALUE(%SST(&USRPWDBUF 1 10)) CHGVAR VAR(&pwd ) VALUE(%SST(&USRPWDBUF 11 10)) SNDPGMMSG MSG('Name is <' *CAT &USRNAM *TCAT '> + Password is <' *CAT &PWD *TCAT '>') + TOPGMQ(*EXT) ENDDO /* For non-negative FUNCTIONs... */ /*------ ------*/ /* This is a pop-up text window... */ /*------ ------*/ /*------ ------*/ /* This variable set is for external text... */ /*------ ------*/ /* Set external text... */ CHGVAR &ExtTxtBuf &Text /* Put the ObjBuf VARRCD into the variable pool... */ call quiputv ( + &apphnd + &ExtTxtBuf + x'00000050' + 'EXTTXTVR ' + x'00000000' + ) /*------------------------------------------------------------------*/ /* Start the screen I/O cycle... */ /* Add a pop-up window... */ call quiaddpw ( + &apphnd + '*ROWCOL ' + x'00000004' + x'00000004' + x'00000000' + ) /*------------------------------------------------------------------*/ /* Initialize the redisplay option... */ CHGVAR &REDSPOPT 'N' /* */ /* ...and display the panel... */ /* */ DSP_LOOPw: call quidspp ( + &apphnd + &Function + 'TXTWIN ' + &ReDspOpt + x'00000000' + 'O' + x'00000000' + &CallMsgQ + 'FRST' + 'D' + 'NONE' + 'NONE' + x'FFFFFFFF' + ) MONMSG MSGID(CPF0000 CPD0000) EXEC(GOTO + CMDLBL(EXIT_APP)) /* Retrieve the function-requested return code... */ CHGVAR VAR(&FUNC_NBR) VALUE(%BIN(&FUNCTION 1 4)) /* Clean up this program's message queue for next display... */ RMVMSG CLEAR(*ALL) /*------ ------*/ /* */ /* If an exit-type function was requested, the FUNCTION value will */ /* be negative. We'll process non-negatives here... */ /* */ IF COND(&FUNC_NBR *GE 0) THEN(DO) /*------ ------*/ /* Set up for a redisplay... */ CHGVAR &REDSPOPT 'Y' /*------ ------*/ ENDDO /* For non-negative FUNCTIONs... */ /*------------------------------------------------------------------*/ /* Remove the pop-up window... */ call quirmvpw ( + &apphnd + 'L' + x'00000000' + ) /*------------------------------------------------------------------*/ /*------ ------*/ /* This variable set is for product library... */ /*------ ------*/ /* Set defualt library... */ CHGVAR VAR(%SST(&LibBuf 1 10)) VALUE( 'POWERCA' ) /* Put the ObjBuf VARRCD into the variable pool... */ call quiputv ( + &apphnd + &LibBuf + x'0000000A' + 'PRDLIB ' + x'00000000' + ) /*------------------------------------------------------------------*/ /* Start the screen I/O cycle... */ /*------------------------------------------------------------------*/ /* */ /* The VARRCD has been PUT, so display the panel... */ /* */ /* Initialize the redisplay option... */ CHGVAR &REDSPOPT 'N' /* */ /* ...and display the panel... */ /* */ DSP_LOOP2: call quidspp ( + &apphnd + &Function + 'PTNVAL ' + &ReDspOpt + x'00000000' + 'O' + x'00000000' + &CallMsgQ + 'FRST' + 'D' + 'NONE' + 'NONE' + x'FFFFFFFF' + ) MONMSG MSGID(CPF0000 CPD0000) EXEC(GOTO + CMDLBL(EXIT_APP)) /* Retrieve the function-requested return code... */ CHGVAR VAR(&FUNC_NBR) VALUE(%BIN(&FUNCTION 1 4)) /* Clean up this program's message queue for next display... */ RMVMSG CLEAR(*ALL) /*------ ------*/ /* */ /* If an exit-type function was requested, the FUNCTION value will */ /* be negative. We'll process non-negatives here... */ /* */ IF COND(&FUNC_NBR *GE 0) THEN(DO) /*------ ------*/ /* Set up for a redisplay... */ CHGVAR &REDSPOPT 'Y' /*------ ------*/ /* Get the ObjName VARRCD... */ call quigetv ( + &apphnd + &LibBuf + x'0000000A' + 'PRDLIB ' + x'00000000' + ) CHGVAR VAR(&PrdLib) VALUE(%SST(&LibBuf 1 10)) SNDPGMMSG MSG('Library is <' *CAT &PrdLib *TCAT '>') + TOPGMQ(*EXT) ENDDO /* For non-negative FUNCTIONs... */ /*------------------------------------------------------------------*/ /*------------------------------------------------------------------*/ /* Main exit for this application... */ /*------------------------------------------------------------------*/ /* Get out of the program with clean-up... */ EXIT_APP: /* Close the UIM application... */ /* CLOAPP APPHND(&APPHND) */ /*xxxx*/ call quicloa ( + &apphnd + 'M' + x'00000000' + ) /* And get rid of any resources that may have been tied up... */ RCLRSC RETURN ENDPGM