Re: CONSTRUCT Statement - Any experts in 4GL?
Posted in 1995
Quoting Ruchi Patel... } } I am using the CONSTRUCT statement to build the query. I want user to } select the values from the pop-up window on some fields. The following } constructs works fine but once the query is completed then the ctxt } variable shows "1=1" instead of what user just selected. I can } re-display the value back to the screen but how could I passed the } selection into ctxt variable? Does construct statement reserves the } information in buffer when user enters value on the screen? If this is } true then is there anyway I can put the value slected from the pop-up } window in buffer? } I ran into this problem several times before. I could never remember whether it was because I used DISPLAY ARRAY in my lookup function or INPUT ARRAY. I think I was using INPUT ARRAY because I wanted AFTER FIELD capabilities to do REVERSE video and it didn't work so I switched to DISPLAY ARRAY. Of course the users started to whine... so I wrote my own DISPLAY ARRAY which I've included below. THIS DOES WORK WITH CONSTRUCT!!! Some important info... 1) This function does validation & lookups for customer_num/company from the customer table of the "stores" database. 2) The fgl_getkey() function can be found in usr_funcs.c as produced by db4glgen. Here --------- Snip Here --------- Snip Here --------- Snip Here --------- Snip #!/bin/sh # This is a shell archive (produced by GNU shar 4.0). # To extract the files from this archive, save it to some FILE, remove # everything before the `!/bin/sh' line above, then type `sh FILE'. # # Made on 1995-03-31 06:58 EST by <dave@das13.snide.com>. # # Existing files will *not* be overwritten unless `-c' is specified. # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 8792 -r--r--r-- lu_cust.4gl # 499 -r--r--r-- lu_cust.per # touch -am 1231235999 $$.touch >/dev/null 2>&1 if test ! -f 1231235999 && test -f $$.touch; then shar_touch=touch else shar_touch=: echo 'WARNING: not restoring timestamps' fi rm -f 1231235999 $$.touch # # ============= lu_cust.4gl ============== if test -f 'lu_cust.4gl' && test X"$1" != X"-c"; then echo 'x - skipping lu_cust.4gl (File already exists)' else echo 'x - extracting lu_cust.4gl (text)' sed 's/^X//' << 'SHAR_EOF' > 'lu_cust.4gl' && X# @(#)lu_cust.4gl 1.5 13 Mar 1995 15:52:36 31 Mar 1995 06:53:15 X XDATABASE stores X X XDEFINE lu_arrcount SMALLINT XDEFINE lu_arrcurr SMALLINT XDEFINE lu_scrline SMALLINT XDEFINE p_record ARRAY[64] OF RECORD X customer_num LIKE customer.customer_num, X company LIKE customer.company X END RECORD X X X{******************************************************************************* X* This function validates a record in the customer table. * X*******************************************************************************} X XFUNCTION val_cust(validation, customer_num) XDEFINE validation CHAR(1) XDEFINE customer_num LIKE customer.customer_num X X DEFINE company LIKE customer.company X X LET company = NULL X X SELECT customer.company INTO company X FROM customer WHERE customer.customer_num = customer_num X X ### Do I <L>ookup ### X IF validation != "L" THEN X IF sqlca.sqlcode THEN X ### Validate... <N>o, <Y>es, <B>lank (validate but allow blanks) ### X CASE validation X WHEN "N" X ### No validation necessary, always return SUCCESS ### X LET sqlca.sqlcode = 0 X WHEN "Y" X ### Validation is necessary, always return NOTFOUND ### X LET sqlca.sqlcode = 100 X WHEN "B" X ### Validation is necessary, except if "customer_num" is null ## X IF customer_num IS NULL THEN X LET sqlca.sqlcode = 0 X ELSE X LET sqlca.sqlcode = 100 X END IF X END CASE X END IF X END IF X X RETURN sqlca.sqlcode, company XEND FUNCTION X X X{******************************************************************************* X* This function searches through the customer table. * X*******************************************************************************} X XFUNCTION lu_cust(customer_num, company) XDEFINE customer_num LIKE customer.customer_num XDEFINE company LIKE customer.company X X DEFINE keyhit INTEGER X DEFINE scratch CHAR(512) X X OPEN WINDOW ringout_customer AT 1,1 WITH 2 ROWS, 79 COLUMNS X DISPLAY "LU-QUERY: ESCAPE queries. DELETE aborts. ARROW keys move cursor.", "" AT 1,1 ATTRIBUTE(WHITE) X DISPLAY "Searches through the customer table.", "" AT 2,1 ATTRIBUTE(WHITE) X OPEN WINDOW lu_cust AT 6, 30 WITH FORM "lu_cust" X ATTRIBUTE(BORDER, WHITE, FORM LINE FIRST + 1) X XLABEL retry: X LET int_flag = FALSE X CONSTRUCT BY NAME scratch ON customer_num, company X IF int_flag THEN X CLOSE WINDOW lu_cust X CLOSE WINDOW ringout_customer X RETURN customer_num, company X END IF X X LET scratch = "SELECT customer_num, company FROM customer WHERE ", scratch CLIPPED, " ORDER BY customer_num" X PREPARE lu_stmt FROM scratch X DECLARE lu_curs CURSOR FOR lu_stmt X X LET lu_arrcount = 1 X FOREACH lu_curs INTO p_record[lu_arrcount].* X LET lu_arrcount = lu_arrcount + 1 X END FOREACH X LET lu_arrcount = lu_arrcount - 1 X IF lu_arrcount = 0 THEN X ERROR " There are no rows satisfying the conditions " X GOTO retry X END IF X LET lu_arrcurr = 1 X LET lu_scrline = 1 X X CURRENT WINDOW IS ringout_customer X DISPLAY "LOOKUP: ESCAPE selects. DELETE aborts. ARROW keys move cursor.", "" AT 1,1 ATTRIBUTE(WHITE) X CURRENT WINDOW IS lu_cust X X CALL lu_dsppage_customer() X X OPTIONS HELP KEY CONTROL-Q X WHILE (TRUE) X LET keyhit = fgl_getkey() X CASE X WHEN keyhit = fgl_keyval("ACCEPT") OR keyhit = fgl_keyval("INTERRUPT") X EXIT WHILE X WHEN keyhit = fgl_keyval("DOWN") OR keyhit = fgl_keyval("RIGHT") X CALL lu_down_customer() X WHEN keyhit = fgl_keyval("UP") OR keyhit = fgl_keyval("LEFT") X CALL lu_up_customer() X WHEN keyhit = fgl_keyval("CONTROL-F") # NEXT KEY X CALL lu_nextpage_customer() X WHEN keyhit = fgl_keyval("CONTROL-B") # PREVIOUS KEY X CALL lu_prevpage_customer() X WHEN keyhit = fgl_keyval("CONTROL-G") X CALL fgl_prtscr() X OTHERWISE X ERROR "" X