home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / a / a610 / 6.ddi / DEMO / FGL / QCONTACT.4GL < prev    next >
Encoding:
Text File  |  1989-12-08  |  4.1 KB  |  146 lines
  1. DATABASE leads
  2. GLOBALS "globals.4gl"
  3.  
  4. FUNCTION qcontact()
  5. {
  6. The qcontact function constructs a query by example based on
  7. the user's input in the f_qcontact form.  It retrieves contacts
  8. that satisfy the query and displays each one.  The contact the user
  9. selects to update is then updated in the contact table, and if
  10. the contact was a sale, in the sale table.
  11. }
  12. DEFINE   wbuf     CHAR(400),
  13.          qbuf     CHAR(500),
  14.          answer   CHAR(1),
  15.          cnt      SMALLINT
  16.  
  17. CLEAR SCREEN
  18. OPEN FORM f_qcontact FROM "f_qcontact"
  19. DISPLAY FORM f_qcontact
  20. CONSTRUCT wbuf ON
  21.       contact.cdate,
  22.       contact.empnum,
  23.       contact.ndate,
  24.       contact.nemp,
  25.       contact.notes,
  26.       contact.ctype,
  27.       prospect.lname,
  28.       prospect.company,
  29.       sale.pcode,
  30.       sale.quantity,
  31.       sale.discount
  32.    FROM sr_consale.*
  33. LET qbuf =
  34.    "SELECT      * ",
  35.       "FROM     contact, prospect, OUTER sale ",
  36.       "WHERE    sale.cnum = contact.cnum AND ",
  37.                 "prospect.ref = contact.ref AND ",
  38.                 wbuf CLIPPED
  39. PREPARE q_1 FROM qbuf
  40. DECLARE c_qcontact CURSOR FOR q_1 
  41. LET eflag = -1
  42.  
  43. FOREACH c_qcontact INTO pr_contact.*, pr_prospect.*, pr_sale.*
  44.    LET eflag = 1
  45.    DISPLAY BY NAME
  46.       pr_contact.cdate THRU pr_contact.ctype,
  47.       pr_prospect.lname, pr_prospect.company,
  48.       pr_sale.pcode THRU pr_sale.discount
  49.    PROMPT "RETURN for next row; u to update this row."
  50.       FOR CHAR answer
  51.    IF (answer IS NOT NULL) THEN
  52.        LET eflag = 0
  53.        EXIT FOREACH
  54.    END IF
  55. END FOREACH
  56.  
  57. IF (eflag = 0) THEN
  58.    INPUT BY NAME
  59.          pr_contact.cdate THRU pr_contact.ctype,
  60.          pr_sale.pcode THRU pr_sale.discount
  61.       WITHOUT DEFAULTS
  62.  
  63.       AFTER FIELD empnum
  64.          SELECT      COUNT(*)
  65.             INTO     cnt
  66.             FROM     sperson
  67.             WHERE    empnum = pr_contact.empnum
  68.          IF (cnt != 1) THEN
  69.             ERROR "There is no salesperson number ",
  70.                pr_contact.empnum USING "###"
  71.             CLEAR empnum
  72.             LET pr_contact.empnum = NULL
  73.             NEXT FIELD empnum
  74.          END IF
  75.  
  76.       AFTER FIELD nemp
  77.          SELECT      COUNT(*)
  78.             INTO     cnt
  79.             FROM     sperson
  80.             WHERE    empnum = pr_contact.nemp
  81.          IF (cnt != 1) THEN
  82.             ERROR "There is no salesperson number ",
  83.                pr_contact.nemp USING "###"
  84.             CLEAR nemp
  85.             LET pr_contact.nemp = NULL
  86.             NEXT FIELD nemp
  87.          END IF
  88.  
  89.       AFTER FIELD ctype
  90.          IF (pr_contact.ctype != "S"
  91.             OR pr_contact.ctype IS NULL) THEN
  92.             CLEAR pcode
  93.             CLEAR quantity
  94.             CLEAR discount
  95.             LET pr_sale.pcode = NULL
  96.             LET pr_sale.quantity = NULL
  97.             LET pr_sale.discount = NULL
  98.             EXIT INPUT
  99.          END IF
  100.    
  101.       AFTER FIELD pcode
  102.          SELECT      COUNT(*)
  103.             INTO     cnt
  104.             FROM     product
  105.             WHERE    pcode = pr_sale.pcode
  106.          IF (cnt != 1) THEN
  107.             ERROR "There is no product code ", pr_sale.pcode USING "###"
  108.             CLEAR pcode
  109.             LET pr_sale.pcode = NULL
  110.             NEXT FIELD pcode
  111.          END IF
  112.          
  113.       AFTER FIELD discount
  114.          IF (pr_sale.discount < 0
  115.             OR pr_sale.discount > 100) THEN
  116.             ERROR "Must be in the range 0-100"
  117.             NEXT FIELD discount
  118.          END IF
  119.    END INPUT
  120.  
  121.    UPDATE contact SET
  122.       cdate =        pr_contact.cdate,
  123.       empnum =       pr_contact.empnum,
  124.       ndate =        pr_contact.ndate,
  125.       nemp =         pr_contact.nemp,
  126.       notes =        pr_contact.notes,
  127.       ctype =        pr_contact.ctype
  128.       WHERE cnum =   pr_contact.cnum
  129.    UPDATE sale SET
  130.       pcode =        pr_sale.pcode,
  131.       quantity =     pr_sale.quantity,
  132.       discount =     pr_sale.discount
  133.       WHERE cnum =   pr_sale.cnum
  134. END IF
  135. IF (eflag = -1) THEN
  136.    ERROR "There are no rows that satisfy these criteria."
  137.    SLEEP 3
  138. END IF
  139. IF (eflag = 1) THEN
  140.    ERROR "There are no more rows."
  141.    SLEEP 3
  142. END IF
  143. LET eflag = 0
  144. CLEAR SCREEN
  145. END FUNCTION
  146.