4GL horror

[Andrew Carrell]

Here's one that's created in Informix 4GL (which is a horror in itself) on how to validate a from-and-to range to make sure it has no overlaps in the DB:

FUNCTION verify_location()

DECLARE c\_det\_cur CURSOR FOR 
	SELECT frerc.from\_loc\_id, frerc.to\_loc\_id
	FROM frerc
		WHERE frerc.dc\_id = m\_i\_frerc\_rec.dc\_id
		  AND frerc.whse\_id = m\_i\_frerc\_rec.whse\_id

# check if select worked correctly
IF SQLCA.SQLCODE <> 0
THEN
	#...
	RETURN TRUE, 0
END IF

OPEN c\_det\_cur 
IF SQLCA.SQLCODE <> 0
THEN
	#...
	RETURN TRUE, 0
END IF

FETCH c\_det\_cur INTO m\_from\_loc, m\_to\_loc

IF m\_modify = 0 AND m\_i\_frerc\_rec.from\_loc\_id >= m\_from\_loc
	AND m\_i\_frerc\_rec.from\_loc\_id <= m\_to\_loc 
THEN
	CALL sh\_err\_msg("S2096")
	LET m\_from = 1
	LET m\_modify = 1
END IF

IF m\_modify = 0 AND m\_i\_frerc\_rec.to\_loc\_id >= m\_from\_loc
	AND m\_i\_frerc\_rec.to\_loc\_id <= m\_to\_loc 
THEN
	CALL sh\_err\_msg("S2097")
	LET m\_from = 1
	LET m\_modify = 1
END IF

IF m\_from\_loc >= m\_i\_frerc\_rec.from\_loc\_id
	AND m\_from\_loc <= m\_i\_frerc\_rec.to\_loc\_id
THEN
	CALL sh\_err\_msg("S2097")
	LET m\_from = 1
	LET m\_modify = 1
END IF

IF m\_modify = 0 AND m\_to\_loc >= m\_i\_frerc\_rec.from\_loc\_id
	AND m\_to\_loc <= m\_i\_frerc\_rec.to\_loc\_id
THEN
	CALL sh\_err\_msg("S2096")
	LET m\_to = 1
END IF 	

IF m\_to = 0 AND 
	m\_from = 0
THEN
	WHILE SQLCA.SQLCODE = 0
		FETCH c\_det\_cur INTO m\_from\_loc, m\_to\_loc

		IF m\_i\_frerc\_rec.from\_loc\_id >= m\_from\_loc
			AND m\_i\_frerc\_rec.from\_loc\_id <= m\_to\_loc 
		THEN
			CALL sh\_err\_msg("S2096")
			LET m\_from = 1
			EXIT WHILE
		END IF

		IF m\_i\_frerc\_rec.to\_loc\_id >= m\_from\_loc
			AND m\_i\_frerc\_rec.to\_loc\_id <= m\_to\_loc 
		THEN
			CALL sh\_err\_msg("S2097")
			LET m\_from = 1
			EXIT WHILE
		END IF

		IF m\_from\_loc >= m\_i\_frerc\_rec.from\_loc\_id
			AND m\_from\_loc <= m\_i\_frerc\_rec.to\_loc\_id
		THEN
			CALL sh\_err\_msg("S2097")
			LET m\_to = 1
			EXIT WHILE
		END IF
	
		IF m\_to\_loc >= m\_i\_frerc\_rec.from\_loc\_id
			AND m\_to\_loc <= m\_i\_frerc\_rec.to\_loc\_id
		THEN
			CALL sh\_err\_msg("S2096")
			LET m\_from = 1
			EXIT WHILE
		END IF

	END WHILE
END IF

LET m\_modify = 0

END FUNCTION