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
04thru15define awork_custrecrecord that is modular in scope and contains the identical structure as themr_custrecprogram 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 INPUTNote:
- Line
05sets thework_custrecprogram record toNULL. - Line
10For an Add, themr_custrecprogram record is set equal to thework_custrecrecord, in effect settingmr_custrectoNULL. TheLETstatement uses less resources thanINITIALIZE. - Line
13For an Update, the values in themr_custrecprogram record are copied intowork_custrec, saving them for comparison later. - Lines
21thru24ABEFORE FIELDstore_num clause has been added to theINPUTstatement. If this is an Update, the user should not be allowed to changestore_num, and theNEXT FIELDinstruction moves the focus to thestore_namefield. - Line
26TheON CHANGEstore_numcontrol block, which will only execute if theau_flagis set to "A" (the operation is an Add) remains the same. - Line
28TheAFTER FIELDstore_namecontrol 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
02thru12define a local record,l_custrecwith the same structure as the modular program recordsmr_custrecandwork_custrec. - Line
15Thecont_okvariable will be used as a flag to determine whether the update should be committed or rolled back. - Line
17Since this will be a multiple-statement transaction, theBEGIN WORKstatement is used to start the transaction. - Lines
19thru30use thestore_numvalue in the program record to re-select the row.FOR UPDATElocks the database row until the transaction ends. - Lines
32thru34checkSQLCA.SQLCODEto make sure the record has not been deleted by another user. If so, an error message is displayed, and the variablecont_okis set toFALSE. - Lines
36thru60are to be executed if the database row was found. - Line
36compares the values in thel_custreclocal record with thework_custrecrecord that contains the original values of the database row. All the values must match for the condition to beTRUE. - Lines
37thru55are executed if the values matched. An embedded SQL statement is used toUPDATEthe row in thecustomertable using the values which the user has previously entered in themr_custrecprogram record. The SQLUPDATEstatement is surrounded byWHENEVER ERRORstatements. TheSQLCA.SQLCODEis checked after theUPDATE, and if it indicates the update was not successful the variablecont_okis set toFALSEand an error message is displayed. - Lines
57through59are executed if the values inl_custrecandwork_custrecdid not match. The variablecont_okis set toFALSE. The values in themr_custrecprogram record are set to the values in thel_custrecrecord (the current values in the database row, retrieved by theSELECT ... FORUPDATEstatement.) TheUNBUFFEREDattribute of theINPUTstatement 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
63thru67If the variablecont_okisTRUE(the update was successful) the program issues aCOMMIT WORKto end the transaction begun on Line17. If not, aROLLBACK WORKis issued. All locks placed on the database row are automatically released.