Example: custdata.4gl (Function appupd_cust)

Function append_cust (custdata.4gl):

  1 PUBLIC FUNCTION append_cust(curr_cust t_cust_num) RETURNS t_cust_num
  2   RETURN appupd_cust("A",curr_cust)
  3 END FUNCTION

Function update_cust (custdata.4gl):

  1 PUBLIC FUNCTION update_cust(curr_cust t_cust_num) RETURNS t_cust_num
  2   RETURN appupd_cust("U",curr_cust)
  3 END FUNCTION

Function appupd_cust (custdata.4gl):

  1 PRIVATE FUNCTION appupd_cust(au_flag CHAR(1), curr_cust t_cust_num) RETURNS t_cust_num
  2 
  3   IF au_flag == "A" THEN
  4      MESSAGE "Append a new customer "
  5      INITIALIZE mr_custrec.* TO NULL
  6      LET mr_custrec.cust_num = 0
  7      LET mr_custrec.cust_name = "<undefined>"
  8   ELSE
  9      MESSAGE "Update current customer"
 10      SELECT * INTO mr_custrec.* FROM customer WHERE cust_num = curr_cust
 11      IF SQLCA.SQLCODE == NOTFOUND THEN
 12          ERROR "Customer record no longer exists in the database"
 13          RETURN 0
 14      END IF
 15   END IF
 16 
 17   LET int_flag = FALSE
 18 
 19   INPUT BY NAME mr_custrec.* WITHOUT DEFAULTS ATTRIBUTE (UNBUFFERED)
 20 
 21      BEFORE INPUT
 22         IF au_flag == "U" THEN
 23            IF cust_orders_count(curr_cust) > 0 THEN
 24               CALL DIALOG.setFieldActive("cust_name",FALSE)
 25               CALL DIALOG.getForm().setFieldComment("cust_name",
 26                    "Cannot update customer name referenced by orders")
 27            END IF
 28         END IF
 29 
 30      AFTER FIELD cust_name
 31         IF cust_name_exists(mr_custrec.cust_name, mr_custrec.cust_num) THEN
 32            ERROR "Customer name already used"
 33            NEXT FIELD CURRENT
 34         END IF
 35 
 36   END INPUT
 37 
 38   IF int_flag THEN
 39      LET int_flag = FALSE
 40      MESSAGE "Operation cancelled by user"
 41      RETURN curr_cust
 42   END IF
 43 
 44   IF au_flag == "A" THEN
 45      SELECT MAX(cust_num)+1 INTO mr_custrec.cust_num FROM customer
 46      DISPLAY BY NAME mr_custrec.cust_num
 47      TRY
 48         INSERT INTO customer VALUES (mr_custrec.*)
 49      CATCH
 50         ERROR SFMT("INSERT failed: %1",SQLERRMESSAGE)
 51         RETURN 0
 52      END TRY
 53      MESSAGE "Row appended"
 54   ELSE
 55      TRY
 56         UPDATE customer
 57            SET cust_name = mr_custrec.cust_name,
 58                addr = mr_custrec.addr,
 59                city = mr_custrec.city,
 60                state = mr_custrec.state,
 61                zipcode = mr_custrec.zipcode,
 62                contact_name = mr_custrec.contact_name,
 63                phone = mr_custrec.phone
 64          WHERE cust_num = mr_custrec.cust_num
 65      CATCH
 66         ERROR SFMT("UPDATE failed: %1",SQLERRMESSAGE)
 67         RETURN 0
 68      END TRY
 69      IF SQLCA.SQLERRD[3] == 1 THEN
 70         MESSAGE "Row updated"
 71      ELSE
 72         MESSAGE "Row no longer exists in the database"
 73      END IF
 74   END IF
 75 
 76   RETURN 0
 77 
 78 END FUNCTION

• Line 1 Defines the function with a flag and current customer number as parameter. The function accepts a parameter defined as CHAR(1). In order to use the same function for both the input of a new record and the update of an existing one.
• Line 4 thru 7: When creating a new row, program variables for the INPUT dialog are initialized with default values.
• Lines 9 thru 14: When updating an existing row, we execute a SELECT statement with the current customer number passed as parameter, to get fresh data from the database. The customer row may no longer exist since the last query was performed, so we need to test the SQLCA.SQLCODE register for NOTFOUND and show an warn the user if need.
• Line 14 sets the int_flag global variable to FALSE prior to the INPUT statement, so the program can determine if the user cancels the dialog.
• Line 17 The UNBUFFERED and WITHOUT DEFAULTS clauses of the INPUT statement are used. The UNBUFFERED attribute insures that the program array the form fields are automatically synchronized for input and output. The WITHOUT DEFAULTS clause is used to get the value of the program variables when the dialog starts.
• Lines 21 thru 28: Before starting the INPUT, in case of update we check if the current customer is referenced in the orders table, and disable the customer name field if it's the case. We do not want customer name changes, if orders have already been issued for that customer.
• Lines 30 thru 34 implement an AFTER FIELD cust_name control block that verifies if the customer name is already used by another record. If the name is already used, an error message is displayed and we force the focus to return in the current field. The user cannot leave that field until a unique customer name was entered.
• Line 46 END INPUT is required when any of the optional control blocks of the INPUT statement are used.
• Lines 38 thru 42: The int_flag register is checked to see if the user has canceled the input. If so, we leave the function by returning the current customer number passed as parameter, indicating to the caller that the user can continue to browse in the list.
• Line 44 thru 54: When appending a new row, we execute a SELECT MAX(cust_num)+1 query to generate a new unique customer number, before creating a new row with the INSERT statement. Best practice to generate unique numbers would be SQL sequences.
• Lines 47 thru 52: The INSERT statement is executed in a TRY/CATCH block, to catch potential SQL errors and display a message to the user.
• Lines 55 thru 68: The UPDATE statement is executed in a TRY/CATCH block, to catch potential SQL errors and display a message to the user.
• Lines 69 thru 73 check the value of the SQLCA.SQLERRD[3] register, which contains the number of processed SQL table rows. Here we expect 1 rpw to be updated. If the number is zero, it means that the row has been deleted by another user.
• Line 76 returns zero to indicate to the caller that the row creation or modification has succeeded, and needs a new QBE query to browser again in the list of customers.