home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / a / a610 / 6.ddi / DEMO / FGL / PRODUCT.4GL < prev    next >
Encoding:
Text File  |  1989-12-08  |  3.7 KB  |  137 lines
  1. DATABASE leads
  2. GLOBALS "globals.4gl"
  3.  
  4. FUNCTION product()
  5. {
  6. The product function displays the f_listprod form and,
  7. depending on the user's input, it adds, deletes, or updates
  8. rows in the product table.
  9. }
  10. DEFINE   pa_prod                 ARRAY[20] OF RECORD LIKE product.*,
  11.          idx, iflag, scrn, cnt   SMALLINT
  12.  
  13. DECLARE c_prod CURSOR FOR
  14.    SELECT      *
  15.       INTO     pr_product.*
  16.       FROM     product
  17.       ORDER BY pcode
  18. LET idx = 0
  19. FOREACH c_prod
  20.    LET idx = idx + 1
  21.    LET pa_prod[idx].* = pr_product.*
  22. END FOREACH
  23. CALL SET_COUNT(idx)
  24.  
  25. CLEAR SCREEN
  26. OPEN FORM f_listprod FROM "f_listprod"
  27. DISPLAY FORM f_listprod
  28.  
  29. INPUT ARRAY pa_prod WITHOUT DEFAULTS FROM sr_product.*
  30. BEFORE ROW
  31.    LET idx = ARR_CURR()
  32.    LET scrn = SCR_LINE()
  33.    LET pr_product.* = pa_prod[idx].*
  34.    LET iflag = 0
  35.  
  36. ON KEY (CONTROL-B)
  37.    LET pa_prod[idx].* = pr_product.*
  38.    DISPLAY pa_prod[idx].* TO sr_product[scrn].*
  39.    NEXT FIELD pcode
  40.  
  41. AFTER FIELD pcode
  42.    IF (pa_prod[idx].pcode IS NULL) THEN
  43.       IF (pa_prod[idx].price IS NOT NULL
  44.          OR pa_prod[idx].descrip IS NOT NULL) THEN
  45.          ERROR "You must enter a product code."
  46.          NEXT FIELD pcode
  47.       END IF
  48.    ELSE
  49.       IF (pa_prod[idx].pcode != pr_product.pcode
  50.          OR pr_product.pcode IS NULL) THEN
  51.          SELECT      COUNT(*)
  52.             INTO     cnt
  53.             FROM     product
  54.             WHERE    pcode = pa_prod[idx].pcode
  55.          IF (cnt != 0) THEN
  56.             ERROR "Product code must be unique."
  57.             NEXT FIELD pcode
  58.          END IF
  59.       END IF
  60.    END IF
  61.  
  62. AFTER FIELD price
  63.    IF (pa_prod[idx].price IS NULL
  64.       AND (pa_prod[idx].pcode IS NOT NULL
  65.          OR pa_prod[idx].descrip IS NOT NULL)) THEN
  66.       ERROR "You must enter a price."
  67.       NEXT FIELD price
  68.    END IF
  69.  
  70. AFTER FIELD descrip
  71.    IF (pa_prod[idx].descrip IS NULL
  72.       AND (pa_prod[idx].pcode IS NOT NULL
  73.          OR pa_prod[idx].price IS NOT NULL)) THEN
  74.       ERROR "You must enter a description."
  75.       NEXT FIELD descrip
  76.    END IF
  77.  
  78. BEFORE INSERT
  79.    INITIALIZE pr_product.* TO NULL
  80.  
  81. AFTER INSERT
  82.    LET iflag = -1
  83.    LET eflag = 0
  84.    IF (pa_prod[idx].pcode IS NOT NULL) THEN
  85.       WHENEVER ERROR CONTINUE
  86.       INSERT INTO product VALUES (pa_prod[idx].*)
  87.       IF (status < 0) THEN LET eflag = -1 END IF 
  88.       WHENEVER ERROR STOP
  89.    ELSE
  90.       LET eflag = -1
  91.    END IF
  92.    IF (eflag < 0) THEN
  93.       ERROR "An error has occurred.  Please enter the information again."
  94.       INITIALIZE pa_prod[idx].* TO NULL
  95.       CLEAR sr_product[scrn].*
  96.       LET eflag = 0
  97.    END IF
  98.  
  99. AFTER DELETE
  100.    LET iflag = -1
  101.    DELETE FROM product WHERE pcode = pr_product.pcode
  102.  
  103. AFTER ROW
  104.    {All nulls, set flag to ignore row.}
  105.    IF (pa_prod[idx].pcode IS NULL
  106.       AND pa_prod[idx].price IS NULL
  107.       AND pa_prod[idx].descrip IS NULL) THEN
  108.       LET iflag = -1
  109.    END IF
  110.  
  111.    {User made a change to the row: update.}
  112.    IF (iflag = 0
  113.       AND (pr_product.pcode != pa_prod[idx].pcode
  114.          OR pr_product.price != pa_prod[idx].price
  115.          OR pr_product.descrip != pa_prod[idx].descrip)) THEN
  116.       UPDATE product SET
  117.          product.* = pa_prod[idx].*
  118.          WHERE pcode = pr_product.pcode
  119.    END IF
  120.  
  121.    {User entered new data in a previously null row: insert.}
  122.    IF (iflag = 0
  123.       AND (pa_prod[idx].pcode IS NOT NULL
  124.          AND pr_product.pcode IS NULL)) THEN
  125.       WHENEVER ERROR CONTINUE
  126.       INSERT INTO product VALUES (pa_prod[idx].*)
  127.       IF (status < 0) THEN
  128.          ERROR "An error has occurred.  Please enter the information again."
  129.          INITIALIZE pa_prod[idx].* TO NULL
  130.          CLEAR sr_product[scrn].*
  131.       END IF
  132.       WHENEVER ERROR STOP
  133.    END IF
  134. END INPUT
  135. CLEAR SCREEN
  136. END FUNCTION
  137.