Module custquery.4gl

The module has been modified to define a work_custrec record that can be used as working storage when a row is being updated.

Module custquery.4gl:

01
02 SCHEMA custdemo 
03
04 DEFINE  mr_custrec, work_custrec RECORD
05     store_num    LIKE customer.store_num,
06     store_name   LIKE customer.store_name,
07     addr         LIKE customer.addr,
08     addr2        LIKE customer.addr2,
09     city         LIKE customer.city,
10     state        LIKE customer.state,
11     zip_code      LIKE customer.zip_code,
12     contact_name LIKE customer.contact_name,
13     phone        LIKE customer.phone
14    END RECORD
...

Note:

Lines 04 thru 15 define a work_custrec record that is modular in scope and contains the identical structure as the mr_custrec program record.

The function inpupd_cust in the custquery.4gl module has been modified so it can also be used to obtain values for the Update of existing rows in the customer table.

Function inpupd_cust (custquery.4gl)

01 FUNCTION inpupd_cust(au_flag)  
02   DEFINE au_flag CHAR(1),
03          cont_ok SMALLINT
04
05   INITIALIZE work_custrec.* TO NULL
06   LET cont_ok = TRUE
07       
08   IF (au_flag = "A") THEN
09     MESSAGE "Add a new customer"
10     LET mr_custrec.* = work_custrec.*
11   ELSE
12     MESSAGE "Update customer"
13     LET work_custrec.* = mr_custrec.*
14   END IF
15 
16   LET INT_FLAG = FALSE
17 
18   INPUT BY NAME mr_custrec.*
19     WITHOUT DEFAULTS ATTRIBUTES(UNBUFFERED)
20 
21     BEFORE FIELD store_num
22       IF (au_flag = "U") THEN
23         NEXT FIELD store_name
24       END IF
25
26     ON CHANGE store_num
27       IF (au_flag = "A") THEN
...
28     AFTER FIELD store_name
29       IF (mr_custrec.store_name IS NULL) THEN
...
30
31   END INPUT

Note:

Line 05 sets the work_custrec program record to NULL.
Line 10 For an Add, the mr_custrec program record is set equal to the work_custrec record, in effect setting mr_custrec to NULL. The LET statement uses less resources than INITIALIZE.
Line 13 For an Update, the values in the mr_custrec program record are copied into work_custrec, saving them for comparison later.
Lines 21 thru 24 A BEFORE FIELDstore_num clause has been added to the INPUT statement. If this is an Update, the user should not be allowed to change store_num, and the NEXT FIELD instruction moves the focus to the store_name field.
Line 26 The ON CHANGE store_num control block, which will only execute if the au_flag is set to "A" (the operation is an Add) remains the same.
Line 28 The AFTER FIELD store_name control block remains the same, and will execute if the operation is an Add or an Update.

A new function update_cust in the custquery.4gl module updates the row in the customer table.

Function update_cust (custquery.4gl)

01 FUNCTION update_cust()
02   DEFINE l_custrec RECORD
03     store_num    LIKE customer.store_num,
04     store_name   LIKE customer.store_name,
05     addr         LIKE customer.addr,
06     addr2        LIKE customer.addr2,
07     city         LIKE customer.city,
08     state        LIKE customer.state,
09     zip_code     LIKE customer.zip_code,
10     contact_name LIKE customer.contact_name,
11     phone        LIKE customer.phone 
12     END RECORD,
13     cont_ok INTEGER
14
15   LET cont_ok = FALSE
16
17   BEGIN WORK
18
19   SELECT store_num,     
20         store_name, 
21         addr, 
22         addr2, 
23         city, 
24         state, 
25         zip_code, 
26         contact_name, 
27         phone
28    INTO l_custrec.* FROM customer 
29    WHERE store_num = mr_custrec.store_num 
30    FOR UPDATE
31
32   IF (SQLCA.SQLCODE = NOTFOUND) THEN       
33     ERROR "Store has been deleted"
34     LET cont_ok = FALSE
35   ELSE                   
36     IF (l_custrec.* = work_custrec.*) THEN
37       WHENEVER ERROR CONTINUE
38       UPDATE customer SET
39         store_name = mr_custrec.store_name,
40         addr = mr_custrec.addr,
41         addr2 = mr_custrec.addr2,
42         city = mr_custrec.city,
43         state = mr_custrec.state,
44         zip_code = mr_custrec.zip_code,
45         contact_name = mr_custrec.contact_name,
46         phone = mr_custrec.phone 
47         WHERE store_num = mr_custrec.store_num 
48       WHENEVER ERROR STOP  
49       IF (SQLCA.SQLCODE = 0) THEN
50         LET cont_ok = TRUE
51         MESSAGE "Row updated"
52       ELSE
53         LET cont_ok = FALSE
54         ERROR SQLERRMESSAGE
55       END IF 
56     ELSE
57       LET cont_ok = FALSE
58       LET mr_custrec.* = l_custrec.*      
59       MESSAGE "Row updated by another user."
60     END IF
61   END IF
62
63   IF (cont_ok = TRUE) THEN
64     COMMIT WORK
65   ELSE
66     ROLLBACK WORK
67   END IF
68
69 END FUNCTION

Lines 02 thru 12 define a local record, l_custrec with the same structure as the modular program records mr_custrec and work_custrec.
Line 15 The cont_ok variable will be used as a flag to determine whether the update should be committed or rolled back.
Line 17 Since this will be a multiple-statement transaction, the BEGIN WORK statement is used to start the transaction.
Lines 19 thru 30 use the store_num value in the program record to re-select the row. FOR UPDATE locks the database row until the transaction ends.
Lines 32 thru 34 check SQLCA.SQLCODE to make sure the record has not been deleted by another user. If so, an error message is displayed, and the variable cont_ok is set to FALSE.
Lines 36 thru 60 are to be executed if the database row was found.
Line 36 compares the values in the l_custrec local record with the work_custrec record that contains the original values of the database row. All the values must match for the condition to be TRUE.
Lines 37 thru 55 are executed if the values matched. An embedded SQL statement is used to UPDATE the row in the customer table using the values which the user has previously entered in the mr_custrec program record. The SQL UPDATE statement is surrounded by WHENEVER ERROR statements. The SQLCA.SQLCODE is checked after the UPDATE, and if it indicates the update was not successful the variable cont_ok is set to FALSE and an error message is displayed.
Lines 57 through 59 are executed if the values in l_custrec and work_custrec did not match. The variable cont_ok is set to FALSE. The values in the mr_custrec program record are set to the values in the l_custrec record (the current values in the database row, retrieved by the SELECT ... FOR UPDATE statement.) The UNBUFFERED attribute of the INPUT statement assures that the values will be automatically displayed in the form. A message is displayed indicating the row had been changed by another user.
Lines 63 thru 67 If the variable cont_ok is TRUE (the update was successful) the program issues a COMMIT WORK to end the transaction begun on Line 17. If not, a ROLLBACK WORK is issued. All locks placed on the database row are automatically released.