Re: 4GL v4.10 CONSTRUCT question
Posted in 1994
shaneb@mentat.mel.cocam.oz.au (Shane Booth) writes: >I believe that the following message didn't make it to the group so I >am resending it. Apologies if you have already seen it. >------------------------------------------------------------------------- >On page S-89 of the Informix-4GL Supplement (for version 4.10), it states >that in an ON KEY clause of a CONSTRUCT statement that you can override >the default and change the input buffer value for the current field. >I didn't understand the bit that said: '...assigning a new value to the >corresponding variable...' What is the 'corresponding variable'? The 'corresponding variable' is the field to which you want to put the buffer value. See the DISPLAY statements in the code example below. That's what's puting the values in the where clause. >I would be most grateful if someone could provide a code snippet to show >me how this is done. Here's some code from one of my applications: #---------------------------------------------------------------------# FUNCTION qry_stat(typ) # Arguments: What for: Query, Report, Purge # Purpose: Construct query on table stat # Returns: N/A #---------------------------------------------------------------------# DEFINE typ CHAR(1) DEFINE mondate DATE DEFINE disptxt CHAR(80) # any variables you see below no listed above are modular CLEAR FORM # clear the menu CALL disp(0,1,1) CALL disp(0,2,1) OPEN WINDOW sqry AT 3,3 WITH FORM "sqry" ATTRIBUTE(BORDER,FORM LINE 2) CALL disp(2,1,1) # QUERY: ESC accepts, DEL quits CONSTRUCT mclause ON stat.sdate, stat.catid, stat.sdetl FROM s_qry.* BEFORE CONSTRUCT # put a default date evaluation in the date field # Default date ranges are as follows: # Query: >= Monday of this week # Report: Monday: <= today, else: >= Monday # Purge: < Monday LET mondate = TODAY WHILE WEEKDAY(mondate) != 1 LET mondate = mondate - 1 END WHILE CASE WHEN typ = "P" LET disptxt = "<", mondate USING "mmddyy" WHEN typ = "R" AND WEEKDAY(TODAY) = 1 LET disptxt = "<=", mondate USING "mmddyy" OTHERWISE LET disptxt = ">=", mondate USING "mmddyy" END CASE DISPLAY disptxt TO s_qry.sdate ON KEY (CONTROL-V) # pop-up window to pick a date or a category code CASE WHEN INFIELD(sdate) LET disptxt = do_pick("D") DISPLAY disptxt TO s_qry.sdate WHEN INFIELD(catid) LET disptxt = do_pick("C") IF LENGTH(disptxt) > 0 THEN DISPLAY disptxt TO s_qry.catid END IF OTHERWISE CALL err(0) END CASE END CONSTRUCT CLOSE WINDOW sqry IF int_flag THEN CALL err(0) LET int_flag = FALSE LET mstat_t = 0 RETURN END IF # now, build the select statement CALL sel_stat(typ) END FUNCTION # qry_stat(typ) >If anyone's interested, I am using 4GL/RDS version 4.10.UD1 on >SunOS 4.1.3. Unfortunately, you may run into bug #14985, which kills what I tried to do in the ON KEY statement above. Here's my workaround: DEFINE lloop SMALLINT # looping flag DEFINE l_const RECORD sdate CHAR(80), # value in the sdate field catid CHAR(80), # value in the catid field sdetl CHAR(80), # value in the sdetl field END RECORD ... INITIALIZE l_const.* TO NULL LET lloop = TRUE # set up the default sdate # Default date ranges are as follows: # Query: >= Monday of this week # Report: Monday: <= today, else: >= Monday # Purge: < Monday LET mondate = TODAY WHILE WEEKDAY(mondate) != 1 LET mondate = mondate - 1 END WHILE CASE WHEN typ = "P" LET l_const.sdate = "<", mondate USING "mmddyy" WHEN typ = "R" AND WEEKDAY(TODAY) = 1 LET l_const.sdate = "<=", mondate USING "mmddyy" OTHERWISE LET l_const.sdate = ">=", mondate USING "mmddyy" END CASE WHILE lloop LET lloop = FALSE CONSTRUCT mclause ON stat.sdate, stat.catid, stat.sdetl FROM s_qry.* BEFORE CONSTRUCT # see if we need to put anything into any of the fields IF LENGTH(l_const.sdate) > 0 THEN DISPLAY l_const.sdate TO s_qry.sdate END IF IF LENGTH(l_const.catid) > 0 THEN DISPLAY l_const.catid TO s_qry.catid END IF IF LENGTH(l_const.sdetl) > 0 THEN DISPLAY l_const.sdetl TO s_qry.sdetl END IF # just to be sure, get the values in every field after each # one input. AFTER FIELD sdate CALL get_fldbuf(s_qry.*) RETURNING l_const.* AFTER FIELD catid CALL get_fldbuf(s_qry.*) RETURNING l_const.* AFTER FIELD sdetl CALL get_fldbuf(s_qry.*) RETURNING l_const.* ON KEY (CONTROL-V) CASE WHEN INFIELD(sdate) LET disptxt = do_pick("D") # dodge the bug by setting the value and the # looping flag, exiting construct, and looping # back into it again. IF LENGTH(disptxt) > 0 THEN LET l_const.sdate = disptxt CLIPPED END IF IF LENGTH(l_const.sdate) > 0 THEN LET lloop = TRUE EXIT CONSTRUCT END IF WHEN INFIELD(catid) LET disptxt = do_pick("C") IF LENGTH(disptxt) > 0 THEN LET l_const.catid = disptxt CLIPPED END IF IF LENGTH(l_const.catid) > 0 THEN LET lloop = TRUE EXIT CONSTRUCT END IF OTHERWISE CALL err(0) END CASE END CONSTRUCT END WHILE # lloop Feel free to email any questions. ============================================================ Dennis J. Pimple Informix Software Inc Senior Consultant Denver Colorado USA dennisp@informix.com Voice:303-850-0210 Fax:303-779-4025