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
thru15
define awork_custrec
record that is modular in scope and contains the identical structure as themr_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 thework_custrec
program record toNULL
. - Line
10
For an Add, themr_custrec
program record is set equal to thework_custrec
record, in effect settingmr_custrec
toNULL
. TheLET
statement uses less resources thanINITIALIZE
. - Line
13
For an Update, the values in themr_custrec
program record are copied intowork_custrec
, saving them for comparison later. - Lines
21
thru24
ABEFORE FIELD
store_num clause has been added to theINPUT
statement. If this is an Update, the user should not be allowed to changestore_num
, and theNEXT FIELD
instruction moves the focus to thestore_name
field. - Line
26
TheON CHANGE
store_num
control block, which will only execute if theau_flag
is set to "A" (the operation is an Add) remains the same. - Line
28
TheAFTER 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
thru12
define a local record,l_custrec
with the same structure as the modular program recordsmr_custrec
andwork_custrec
. - Line
15
Thecont_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, theBEGIN WORK
statement is used to start the transaction. - Lines
19
thru30
use thestore_num
value in the program record to re-select the row.FOR UPDATE
locks the database row until the transaction ends. - Lines
32
thru34
checkSQLCA.SQLCODE
to make sure the record has not been deleted by another user. If so, an error message is displayed, and the variablecont_ok
is set toFALSE
. - Lines
36
thru60
are to be executed if the database row was found. - Line
36
compares the values in thel_custrec
local record with thework_custrec
record that contains the original values of the database row. All the values must match for the condition to beTRUE
. - Lines
37
thru55
are executed if the values matched. An embedded SQL statement is used toUPDATE
the row in thecustomer
table using the values which the user has previously entered in themr_custrec
program record. The SQLUPDATE
statement is surrounded byWHENEVER ERROR
statements. TheSQLCA.SQLCODE
is checked after theUPDATE
, and if it indicates the update was not successful the variablecont_ok
is set toFALSE
and an error message is displayed. - Lines
57
through59
are executed if the values inl_custrec
andwork_custrec
did not match. The variablecont_ok
is set toFALSE
. The values in themr_custrec
program record are set to the values in thel_custrec
record (the current values in the database row, retrieved by theSELECT ... FOR
UPDATE
statement.) TheUNBUFFERED
attribute of theINPUT
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
thru67
If the variablecont_ok
isTRUE
(the update was successful) the program issues aCOMMIT WORK
to end the transaction begun on Line17
. If not, aROLLBACK WORK
is issued. All locks placed on the database row are automatically released.