:	"%W% %E%"
#!/bin/sh
# shar:	Shell Archiver (v1.22)
#
#	This is a shell archive.
#	Remove everything above this line and run sh on the resulting file
#	If this archive is complete, you will see this message at the end
#	"All files extracted"
#
#	Created: Wed Apr 27 20:49:18 1994 by johnl at Sphinx Ltd.
#	Files archived in this archive:
#	  spi1.4gl
#	  spi1.per
#	  spi2.4gl
#	  spi2.per
#	  spi3.4gl
#	  spi3.per
#	  spic.4gl
#	  spig.4gl
#	  spii.4gl
#	  spim.4gl
#	  spir.4gl
#	  spiw.4gl
#
if test -f spi1.4gl; then echo "File spi1.4gl exists"; else
echo "x - spi1.4gl"
sed 's/^X//' << 'SHAR_EOF' > spi1.4gl &&
X{
X	@(#)spi1.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)Input function for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS "spig.4gl"
X
X{ Module variables -- not accessible outside this file }
XDEFINE
X	sccs		CHAR(1)	{ Identifier string }
X
X{ Input function }
XFUNCTION in1_spi()
X
X	DEFINE
X		io_status	INTEGER,
X		field_no	INTEGER,
X		n			INTEGER,
X		iucode		CHAR(1) { 'I' Insert, 'U' Update }
X
X	LET io_status = 2 { IO_DONE }
X	LET io_spi.io_currform = 1
X	LET io_spi.io_inbound  = TRUE
X	LET n = io_spi.io_currform
X	LET fc_spi.min_field = io_spi.io_fldnumlo[n]
X	LET fc_spi.max_field = io_spi.io_fldnumhi[n]
X	LET fc_spi.prev_field = 0
X
X	CALL wi1_spi(2)
X
X	INPUT i1_spi.* WITHOUT DEFAULTS FROM s_spi.* HELP 20
X
X	ON KEY (F8, CONTROL-E)
X		# Alternative exit input for FGLDB
X		LET io_status = 3 { IO_INTR }
X		EXIT INPUT
X
X	ON KEY (F7, CONTROL-F)
X		CALL hlp_spi()
X
X	ON KEY (F6, CONTROL-P)
X		CASE
X		WHEN INFIELD(tabname)
X			LET field_no = v01_spi("^P")
X		WHEN INFIELD(pkcol)
X			LET field_no = v02_spi("^P")
X		WHEN INFIELD(menuname)
X			LET field_no = v03_spi("^P")
X		WHEN INFIELD(basename)
X			LET field_no = v04_spi("^P")
X		END CASE
X		GOTO nxf_spi
X
X	ON KEY (F5, CONTROL-B)
X		CASE
X		WHEN INFIELD(tabname)
X			LET field_no = v01_spi("F5")
X		WHEN INFIELD(pkcol)
X			LET field_no = v02_spi("F5")
X		WHEN INFIELD(menuname)
X			LET field_no = v03_spi("F5")
X		WHEN INFIELD(basename)
X			LET field_no = v04_spi("F5")
X		OTHERWISE
X			ERROR "No pop-up facility is defined for this field"
X		END CASE
X		GOTO nxf_spi
X
X		BEFORE FIELD tabname
X			LET field_no = v01_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD tabname
X			LET field_no = v01_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD pkcol
X			LET field_no = v02_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD pkcol
X			LET field_no = v02_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD menuname
X			LET field_no = v03_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD menuname
X			LET field_no = v03_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD basename
X			LET field_no = v04_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD basename
X			LET field_no = v04_spi("AF")
X			GOTO nxf_spi
X
X		LABEL nxf_spi:
X			IF field_no IS NOT NULL THEN
X				CASE
X				WHEN field_no = 0
X					LET io_status = 0 { IO_CONT }
X					EXIT INPUT
X				WHEN field_no = 1
X					NEXT FIELD  tabname
X				WHEN field_no = 2
X					NEXT FIELD  pkcol
X				WHEN field_no = 3
X					NEXT FIELD  menuname
X				WHEN field_no = 4
X					NEXT FIELD  basename
X				OTHERWISE
X					CALL xfl_spi(field_no)
X					LET io_status = 0 { IO_CONT }
X					EXIT INPUT
X				END CASE
X			END IF
X	END INPUT
X
X	CASE
X	WHEN INT_FLAG = TRUE OR io_status = 3
X		LET io_status = 3 { IO_INTR }
X		LET INT_FLAG = FALSE
X	WHEN io_status = 2 OR io_status = 1
X		LET io_status = 2 { IO_DONE }
X		EXIT CASE
X	WHEN io_status = 0 { IO_CONT }
X		EXIT CASE
X	OTHERWISE
X		ERROR "Can't happen" SLEEP 1
X		LET io_status = 2 { IO_DONE }
X	END CASE
X
X	RETURN io_status
X
XEND FUNCTION {in1_spi}
X
X{
X	Validation Functions
X	********************
X	Unless a non-null value is assigned to retval,
X	the INPUT statement will continue in the default manner.
X	Do not assign a non-null value to retval without cause.
X	In general, do not set retval for BF.
X}
X
X{ Validation code for Spi.tabname }
XFUNCTION v01_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i1_spi.tabname = cp_spi.tabname
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i1_spi.tabname = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 1
X		LET pr_spi.tabname = wr_spi.tabname
X		LET retval = ffl_spi()
X		# Insert code to skip tabname here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.tabname LIKE Spi.tabname
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di1_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v01_spi}
X
X{ Validation code for Spi.pkcol }
XFUNCTION v02_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i1_spi.pkcol = cp_spi.pkcol
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i1_spi.pkcol = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 2
X		LET pr_spi.pkcol = wr_spi.pkcol
X		# Insert code to skip pkcol here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.pkcol LIKE Spi.pkcol
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di1_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v02_spi}
X
X{ Validation code for Spi.menuname }
XFUNCTION v03_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i1_spi.menuname = cp_spi.menuname
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i1_spi.menuname = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 3
X		LET pr_spi.menuname = wr_spi.menuname
X		# Insert code to skip menuname here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.menuname LIKE Spi.menuname
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di1_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v03_spi}
X
X{ Validation code for Spi.basename }
XFUNCTION v04_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i1_spi.basename = cp_spi.basename
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i1_spi.basename = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 4
X		LET pr_spi.basename = wr_spi.basename
X		LET retval = lfl_spi()
X		# Insert code to skip basename here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.basename LIKE Spi.basename
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di1_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v04_spi}
X
XFUNCTION wi1_spi(cmd)
X
X    DEFINE
X		cmd		INTEGER
X
X    CASE cmd
X	WHEN 0
X		OPEN FORM f_i1_spi FROM "spi1"
X	WHEN 1
X		CLOSE FORM f_i1_spi
X	WHEN 2
X		CALL wio_spi(2)
X		DISPLAY FORM f_i1_spi
X	WHEN 3
X		CLEAR FORM
X	OTHERWISE
X		CALL fatal_error("Invalid command passed to wi1_spi")
X    END CASE
X
XEND FUNCTION {wi1_spi}
X
XFUNCTION di1_spi()
X
X	IF ct_spi.op_mode = 'I' THEN
X		DISPLAY BY NAME
X			i1_spi.tabname,
X			i1_spi.pkcol,
X			i1_spi.menuname,
X			i1_spi.basename
X	ELSE
X		DISPLAY BY NAME
X			wr_spi.tabname,
X			wr_spi.pkcol,
X			wr_spi.menuname,
X			wr_spi.basename
X	END IF
X
XEND FUNCTION {di1_spi}
SHAR_EOF
chmod 0444 spi1.4gl || echo "$0: failed to restore spi1.4gl"
fi
if test -f spi1.per; then echo "File spi1.per exists"; else
echo "x - spi1.per"
sed 's/^X//' << 'SHAR_EOF' > spi1.per &&
X{
X    @(#)spi1.4pr	7.1 90/08/23
X    @(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X    @(#)Screen form for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XSCREEN
X{
X                    Screen I
X
Xtabname            [f000              ]
Xpkcol              [f001              ]
Xmenuname           [f002              ]
Xbasename           [f003   ]
X
X}
XEND
X
XTABLES
Xspi
X
XATTRIBUTES
Xf000 = spi.tabname;
Xf001 = spi.pkcol;
Xf002 = spi.menuname;
Xf003 = spi.basename;
X
XEND
X
XINSTRUCTIONS
XSCREEN RECORD s_spi (spi.*)
XEND
SHAR_EOF
chmod 0444 spi1.per || echo "$0: failed to restore spi1.per"
fi
if test -f spi2.4gl; then echo "File spi2.4gl exists"; else
echo "x - spi2.4gl"
sed 's/^X//' << 'SHAR_EOF' > spi2.4gl &&
X{
X	@(#)spi2.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)Input function for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS "spig.4gl"
X
X{ Module variables -- not accessible outside this file }
XDEFINE
X	sccs		CHAR(1)	{ Identifier string }
X
X{ Input function }
XFUNCTION in2_spi()
X
X	DEFINE
X		io_status	INTEGER,
X		n			INTEGER,
X		field_no	INTEGER,
X		iucode		CHAR(1) { 'I' Insert, 'U' Update }
X
X	LET io_status = 2 { IO_DONE }
X	LET io_spi.io_currform = 2
X	LET io_spi.io_inbound  = TRUE
X	LET n = io_spi.io_currform
X	LET fc_spi.min_field = io_spi.io_fldnumlo[n]
X	LET fc_spi.max_field = io_spi.io_fldnumhi[n]
X	LET fc_spi.prev_field = 0
X
X	CALL wi2_spi(2)
X
X	INPUT i2_spi.* WITHOUT DEFAULTS FROM s_spi.* HELP 20
X
X	ON KEY (F8, CONTROL-E)
X		# Alternative exit input for FGLDB
X		LET io_status = 3 { IO_INTR }
X		EXIT INPUT
X
X	ON KEY (F7, CONTROL-F)
X		CALL hlp_spi()
X
X	ON KEY (F6, CONTROL-P)
X		CASE
X		WHEN INFIELD(opt_ins)
X			LET field_no = v05_spi("^P")
X		WHEN INFIELD(afterfield)
X			LET field_no = v06_spi("^P")
X		WHEN INFIELD(beforefield)
X			LET field_no = v07_spi("^P")
X		WHEN INFIELD(controlb)
X			LET field_no = v08_spi("^P")
X		WHEN INFIELD(controlp)
X			LET field_no = v09_spi("^P")
X		END CASE
X		GOTO nxf_spi
X
X	ON KEY (F5, CONTROL-B)
X		CASE
X		WHEN INFIELD(opt_ins)
X			LET field_no = v05_spi("F5")
X		WHEN INFIELD(afterfield)
X			LET field_no = v06_spi("F5")
X		WHEN INFIELD(beforefield)
X			LET field_no = v07_spi("F5")
X		WHEN INFIELD(controlb)
X			LET field_no = v08_spi("F5")
X		WHEN INFIELD(controlp)
X			LET field_no = v09_spi("F5")
X		OTHERWISE
X			ERROR "No pop-up facility is defined for this field"
X		END CASE
X		GOTO nxf_spi
X
X		BEFORE FIELD opt_ins
X			LET field_no = v05_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD opt_ins
X			LET field_no = v05_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD afterfield
X			LET field_no = v06_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD afterfield
X			LET field_no = v06_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD beforefield
X			LET field_no = v07_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD beforefield
X			LET field_no = v07_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD controlb
X			LET field_no = v08_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD controlb
X			LET field_no = v08_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD controlp
X			LET field_no = v09_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD controlp
X			LET field_no = v09_spi("AF")
X			GOTO nxf_spi
X
X		LABEL nxf_spi:
X			IF field_no IS NOT NULL THEN
X				CASE
X				WHEN field_no = 0
X					LET io_status = 0 { IO_CONT }
X					EXIT INPUT
X				WHEN field_no = 5
X					NEXT FIELD  opt_ins
X				WHEN field_no = 6
X					NEXT FIELD  afterfield
X				WHEN field_no = 7
X					NEXT FIELD  beforefield
X				WHEN field_no = 8
X					NEXT FIELD  controlb
X				WHEN field_no = 9
X					NEXT FIELD  controlp
X				OTHERWISE
X					CALL xfl_spi(field_no)
X					LET io_status = 0 { IO_CONT }
X					EXIT INPUT
X				END CASE
X			END IF
X	END INPUT
X
X	CASE
X	WHEN INT_FLAG = TRUE OR io_status = 3
X		LET io_status = 3 { IO_INTR }
X		LET INT_FLAG = FALSE
X	WHEN io_status = 2 OR io_status = 1 { IO_NEUTRAL }
X		LET io_status = 2 { IO_DONE }
X		EXIT CASE
X	WHEN io_status = 0 { IO_CONT }
X		EXIT CASE
X	OTHERWISE
X		ERROR "Can't happen" SLEEP 1
X		LET io_status = 2 { IO_DONE }
X	END CASE
X
X	RETURN io_status
X
XEND FUNCTION {in2_spi}
X
X{ Validation code for Spi.opt_ins }
XFUNCTION v05_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i2_spi.opt_ins = cp_spi.opt_ins
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i2_spi.opt_ins = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 5
X		LET pr_spi.opt_ins = wr_spi.opt_ins
X		LET retval = ffl_spi()
X		# Insert code to skip opt_ins here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.opt_ins LIKE Spi.opt_ins
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di2_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v05_spi}
X
X{ Validation code for Spi.afterfield }
XFUNCTION v06_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i2_spi.afterfield = cp_spi.afterfield
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i2_spi.afterfield = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 6
X		LET pr_spi.afterfield = wr_spi.afterfield
X		# Insert code to skip afterfield here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.afterfield LIKE Spi.afterfield
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di2_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v06_spi}
X
X{ Validation code for Spi.beforefield }
XFUNCTION v07_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i2_spi.beforefield = cp_spi.beforefield
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i2_spi.beforefield = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 7
X		LET pr_spi.beforefield = wr_spi.beforefield
X		# Insert code to skip beforefield here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.beforefield LIKE Spi.beforefield
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di2_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v07_spi}
X
X{ Validation code for Spi.controlb }
XFUNCTION v08_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i2_spi.controlb = cp_spi.controlb
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i2_spi.controlb = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 8
X		LET pr_spi.controlb = wr_spi.controlb
X		# Insert code to skip controlb here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.controlb LIKE Spi.controlb
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di2_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v08_spi}
X
X{ Validation code for Spi.controlp }
XFUNCTION v09_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i2_spi.controlp = cp_spi.controlp
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i2_spi.controlp = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 9
X		LET pr_spi.controlp = wr_spi.controlp
X		LET retval = lfl_spi()
X		# Insert code to skip controlp here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.controlp LIKE Spi.controlp
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di2_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v09_spi}
X
XFUNCTION wi2_spi(cmd)
X
X    DEFINE
X		cmd		INTEGER
X
X    CASE cmd
X	WHEN 0
X		OPEN FORM f_i2_spi FROM "spi2"
X	WHEN 1
X		CLOSE FORM f_i2_spi
X	WHEN 2
X		CALL wio_spi(2)
X		DISPLAY FORM f_i2_spi
X	WHEN 3
X		CLEAR FORM
X	OTHERWISE
X		CALL fatal_error("Invalid command passed to wi2_spi")
X    END CASE
X
XEND FUNCTION {wi2_spi}
X
XFUNCTION di2_spi()
X
X	IF ct_spi.op_mode = 'I' THEN
X		DISPLAY BY NAME
X			i2_spi.opt_ins,
X			i2_spi.afterfield,
X			i2_spi.beforefield,
X			i2_spi.controlb,
X			i2_spi.controlp
X	ELSE
X		DISPLAY BY NAME
X			wr_spi.opt_ins,
X			wr_spi.afterfield,
X			wr_spi.beforefield,
X			wr_spi.controlb,
X			wr_spi.controlp
X	END IF
X
XEND FUNCTION {di2_spi}
SHAR_EOF
chmod 0444 spi2.4gl || echo "$0: failed to restore spi2.4gl"
fi
if test -f spi2.per; then echo "File spi2.per exists"; else
echo "x - spi2.per"
sed 's/^X//' << 'SHAR_EOF' > spi2.per &&
X{
X    @(#)spi2.4pr	7.1 90/08/23
X    @(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X    @(#)Screen form for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XSCREEN
X{
X                    Screen II
X
Xopt_ins            [a]
Xafterfield         [b]
Xbeforefield        [c]
Xcontrolb           [d]
Xcontrolp           [e]
X
X}
XEND
X
XTABLES
Xspi
X
XATTRIBUTES
X
Xa = spi.opt_ins;
Xb = spi.afterfield;
Xc = spi.beforefield;
Xd = spi.controlb;
Xe = spi.controlp;
X
XEND
X
XINSTRUCTIONS
XSCREEN RECORD s_spi (spi.*)
XEND
SHAR_EOF
chmod 0444 spi2.per || echo "$0: failed to restore spi2.per"
fi
if test -f spi3.4gl; then echo "File spi3.4gl exists"; else
echo "x - spi3.4gl"
sed 's/^X//' << 'SHAR_EOF' > spi3.4gl &&
X{
X	@(#)spi3.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)Input function for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS "spig.4gl"
X
X{ Module variables -- not accessible outside this file }
XDEFINE
X	sccs		CHAR(1)	{ Identifier string }
X
X{ Input function }
XFUNCTION in3_spi()
X
X	DEFINE
X		io_status	INTEGER,
X		n			INTEGER,
X		field_no	INTEGER
X
X	LET io_status = 2 { IO_DONE }
X	LET io_spi.io_currform = 3
X	LET io_spi.io_inbound  = TRUE
X	LET n = io_spi.io_currform
X	LET fc_spi.min_field = io_spi.io_fldnumlo[n]
X	LET fc_spi.max_field = io_spi.io_fldnumhi[n]
X	LET fc_spi.prev_field = 0
X
X	CALL wi3_spi(2)
X
X	INPUT i3_spi.* WITHOUT DEFAULTS FROM s_spi.* HELP 20
X
X	ON KEY (F8, CONTROL-E)
X		# Alternative exit input for FGLDB
X		LET io_status = 3 { IO_CONT }
X		EXIT INPUT
X
X	ON KEY (F7, CONTROL-F)
X		CALL hlp_spi()
X
X	ON KEY (F6, CONTROL-P)
X		CASE
X		WHEN INFIELD(opt_del)
X			LET field_no = v10_spi("^P")
X		WHEN INFIELD(opt_upd)
X			LET field_no = v11_spi("^P")
X		WHEN INFIELD(opt_rep)
X			LET field_no = v12_spi("^P")
X		WHEN INFIELD(opt_sh)
X			LET field_no = v13_spi("^P")
X		END CASE
X		GOTO nxf_spi
X
X	ON KEY (F5, CONTROL-B)
X		CASE
X		WHEN INFIELD(opt_del)
X			LET field_no = v10_spi("F5")
X		WHEN INFIELD(opt_upd)
X			LET field_no = v11_spi("F5")
X		WHEN INFIELD(opt_rep)
X			LET field_no = v12_spi("F5")
X		WHEN INFIELD(opt_sh)
X			LET field_no = v13_spi("F5")
X		OTHERWISE
X			ERROR "No pop-up facility is defined for this field"
X		END CASE
X		GOTO nxf_spi
X
X		BEFORE FIELD opt_del
X			LET field_no = v10_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD opt_del
X			LET field_no = v10_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD opt_upd
X			LET field_no = v11_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD opt_upd
X			LET field_no = v11_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD opt_rep
X			LET field_no = v12_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD opt_rep
X			LET field_no = v12_spi("AF")
X			GOTO nxf_spi
X
X		BEFORE FIELD opt_sh
X			LET field_no = v13_spi("BF")
X			GOTO nxf_spi
X
X		AFTER FIELD opt_sh
X			LET field_no = v13_spi("AF")
X			GOTO nxf_spi
X
X		LABEL nxf_spi:
X			IF field_no IS NOT NULL THEN
X				CASE
X				WHEN field_no = 0
X					LET io_status = 0 { IO_CONT }
X					EXIT INPUT
X				WHEN field_no = 10
X					NEXT FIELD  opt_del
X				WHEN field_no = 11
X					NEXT FIELD  opt_upd
X				WHEN field_no = 12
X					NEXT FIELD  opt_rep
X				WHEN field_no = 13
X					NEXT FIELD  opt_sh
X				OTHERWISE
X					CALL xfl_spi(field_no)
X					LET io_status = 0 { IO_CONT }
X					EXIT INPUT
X				END CASE
X			END IF
X	END INPUT
X
X	CASE
X	WHEN INT_FLAG = TRUE OR io_status = 3
X		LET io_status = 3 { IO_INTR }
X		LET INT_FLAG = FALSE
X	WHEN io_status = 2 OR io_status = 1
X		LET io_status = 2 { IO_DONE }
X		EXIT CASE
X	WHEN io_status = 0 { IO_CONT }
X		EXIT CASE
X	OTHERWISE
X		ERROR "Can't happen" SLEEP 1
X		LET io_status = 2 { IO_DONE }
X	END CASE
X
X	RETURN io_status
X
XEND FUNCTION {in3_spi}
X
X{ Validation code for Spi.opt_del }
XFUNCTION v10_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i3_spi.opt_del = cp_spi.opt_del
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i3_spi.opt_del = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 10
X		LET pr_spi.opt_del = wr_spi.opt_del
X		LET retval = ffl_spi()
X		# Insert code to skip opt_del here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.opt_del LIKE Spi.opt_del
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di3_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v10_spi}
X
X{ Validation code for Spi.opt_upd }
XFUNCTION v11_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i3_spi.opt_upd = cp_spi.opt_upd
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i3_spi.opt_upd = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 11
X		LET pr_spi.opt_upd = wr_spi.opt_upd
X		# Insert code to skip opt_upd here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.opt_upd LIKE Spi.opt_upd
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di3_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v11_spi}
X
X{ Validation code for Spi.opt_rep }
XFUNCTION v12_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i3_spi.opt_rep = cp_spi.opt_rep
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i3_spi.opt_rep = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 12
X		LET pr_spi.opt_rep = wr_spi.opt_rep
X		# Insert code to skip opt_rep here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.opt_rep LIKE Spi.opt_rep
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di3_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v12_spi}
X
X{ Validation code for Spi.opt_sh }
XFUNCTION v13_spi(vcode)
X
X	DEFINE
X		vcode	CHAR(2),	{ AF, BF, ^P or F5 }
X		retval	INTEGER		{ Next field number }
X
X	LET retval = NULL
X
X	CASE
X	WHEN vcode = "^P"
X		LET i3_spi.opt_sh = cp_spi.opt_sh
X		LET retval = next_field(fc_spi.*)
X	WHEN vcode = "F5"
X		ERROR "Sorry -- pop-up facility is not available"
X		LET retval = fc_spi.curr_field
X		# LET i3_spi.opt_sh = pop_xreftable()
X		# LET retval = next_field(fc_spi.*)
X	WHEN vcode = "BF"
X		LET fc_spi.curr_field = 13
X		LET pr_spi.opt_sh = wr_spi.opt_sh
X		LET retval = lfl_spi()
X		# Insert code to skip opt_sh here
X	# WHEN vcode = "AF"
X		# Normally there is no code needed here
X	END CASE
X
X	# Do not validate in BEFORE FIELD (normally)
X	IF vcode != "BF" THEN
X		# This validation should be normally be replaced
X		# WHENEVER ERROR CONTINUE
X		# VALIDATE wr_spi.opt_sh LIKE Spi.opt_sh
X		# WHENEVER ERROR STOP
X		# IF STATUS != 0 THEN
X			# CALL ERR_PRINT(STATUS)
X			# SLEEP 2
X			# LET retval = fc_spi.curr_field
X		# END IF
X		CALL di3_spi()
X	END IF
X
X	CALL spf_spi(vcode, retval)
X
X	RETURN retval
X
XEND FUNCTION {v13_spi}
X
XFUNCTION wi3_spi(cmd)
X
X    DEFINE
X		cmd		INTEGER
X
X    CASE cmd
X	WHEN 0
X		OPEN FORM f_i3_spi FROM "spi3"
X	WHEN 1
X		CLOSE FORM f_i3_spi
X	WHEN 2
X		CALL wio_spi(2)
X		DISPLAY FORM f_i3_spi
X	WHEN 3
X		CLEAR FORM
X	OTHERWISE
X		CALL fatal_error("Invalid command passed to wi3_spi")
X    END CASE
X
XEND FUNCTION {wi3_spi}
X
XFUNCTION di3_spi()
X
X	IF ct_spi.op_mode = 'I' THEN
X		DISPLAY BY NAME
X			i3_spi.opt_del,
X			i3_spi.opt_upd,
X			i3_spi.opt_rep,
X			i3_spi.opt_sh
X	ELSE
X		DISPLAY BY NAME
X			wr_spi.opt_del,
X			wr_spi.opt_upd,
X			wr_spi.opt_rep,
X			wr_spi.opt_sh
X	END IF
X
XEND FUNCTION {di3_spi}
SHAR_EOF
chmod 0444 spi3.4gl || echo "$0: failed to restore spi3.4gl"
fi
if test -f spi3.per; then echo "File spi3.per exists"; else
echo "x - spi3.per"
sed 's/^X//' << 'SHAR_EOF' > spi3.per &&
X{
X    @(#)spi3.4pr	7.1 90/08/23
X    @(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X    @(#)Screen form for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XSCREEN
X{
X                    Screen III
X
Xopt_del            [f]
Xopt_upd            [g]
Xopt_rep            [h]
Xopt_sh             [i]
X
X}
XEND
X
XTABLES
Xspi
X
XATTRIBUTES
X
Xf = spi.opt_del;
Xg = spi.opt_upd;
Xh = spi.opt_rep;
Xi = spi.opt_sh;
X
XEND
X
XINSTRUCTIONS
XSCREEN RECORD s_spi (spi.*)
XEND
SHAR_EOF
chmod 0444 spi3.per || echo "$0: failed to restore spi3.per"
fi
if test -f spic.4gl; then echo "File spic.4gl exists"; else
echo "x - spic.4gl"
sed 's/^X//' << 'SHAR_EOF' > spic.4gl &&
X{
X	@(#)spic.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)RDSQL Cursor Manipulation for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS "spig.4gl"
X
X{ Module variables -- not accessible outside this file }
XDEFINE
X	sccs		CHAR(1)	{ Identifier string }
X
X{ Initialize various bits and pieces }
XFUNCTION wop_spi()
X
X	DEFINE
X		braindamaged	CHAR(110)
X
X	LET sccs = "@(#)spic.4gl	7.1 90/08/23"
X
X	{ Create dlist }
X	LET ct_spi.list_number = sc_mkstr()
X	IF ct_spi.list_number <= 0 THEN
X		CALL fatal_error("Unable to create D-list in wop_spi")
X	END IF
X
X	{ Open menu and I/O windows; also open I/O forms and display first one }
X	CALL wmn_spi(0)
X	CALL wbd_spi(0)
X	CALL wio_spi(0)
X	CALL wi1_spi(0)
X	CALL wi2_spi(0)
X	CALL wi3_spi(0)
X	CALL wi1_spi(2)
X
X	{ Create null record }
X	INITIALIZE nr_spi.* TO NULL
X	LET cp_spi.* = nr_spi.*
X
X	{ Create pre-defined cursors }
X	{ Fetch current row from main database }
X	LET braindamaged =
X		" SELECT Spi.*",
X		" FROM Spi",
X		" WHERE Spi.Tabname = ?"
X	PREPARE st_current FROM braindamaged
X	DECLARE c_current CURSOR FOR st_current
X
X	{ Fetch current row from main database for update }
X	LET braindamaged =
X		" SELECT Spi.*",
X		" FROM Spi",
X		" WHERE Spi.Tabname = ?",
X		" FOR UPDATE"
X	PREPARE st_update FROM braindamaged
X	DECLARE c_update CURSOR FOR st_update
X
X	{ Initialise counts etc }
X	LET ct_spi.active_set = 0 { No rows selected }
X	LET ct_spi.active_row = 0 { No current row }
X	LET ct_spi.direction  = 0 { Query }
X	LET ct_spi.query_done = 0 { No query constructed }
X	LET ct_spi.op_mode    = 'D' { Display, not input, mode }
X	RETURN 0 { Success }
X
XEND FUNCTION {wop_spi}
X
X{ Clean up }
XFUNCTION wcl_spi()
X
X	DEFINE
X		junk	INTEGER
X
X	{ Destroy dlist }
X	LET junk =  sc_rmstr(ct_spi.list_number)
X	LET ct_spi.list_number = 0
X
X	{ Close forms and windows }
X	CALL wi3_spi(1)
X	CALL wi2_spi(1)
X	CALL wi1_spi(1)
X	CALL wio_spi(1)
X	CALL wbd_spi(1)
X	CALL wmn_spi(1)
X
XEND FUNCTION {wcl_spi}
X
X{ Create a select statement for the table }
XFUNCTION cns_spi()
X
X	DEFINE
X		wh		CHAR(300),
X		sl		CHAR(450),
X		retval	INTEGER
X
X	LET INT_FLAG = FALSE
X	MESSAGE "Enter criteria: ESC to finish"
X	CONSTRUCT wh ON 
X		Spi.Tabname,
X		Spi.Pkcol,
X		Spi.Menuname,
X		Spi.Basename
X		FROM s_spi.*
X	MESSAGE ""
X	IF INT_FLAG THEN
X		MESSAGE "Interrupt detected -- ignored"
X		LET INT_FLAG = FALSE
X		LET retval = FALSE
X	ELSE
X		LET sl =	"SELECT Spi.Tabname",
X					" FROM Spi",
X					" WHERE ", wh CLIPPED,
X					" ORDER BY 1"
X					{ Could be ORDER BY Spi.Tabname unless PK is Rowid }
X		PREPARE st_select FROM sl
X		LET retval = TRUE
X	END IF
X
X	RETURN retval
X
XEND FUNCTION {cns_spi}
X
X{ Query for set of rows }
XFUNCTION qry_spi(flag)
X
X	DEFINE
X		flag	CHAR(1)
X
X	CALL wi1_spi(2)
X
X	CLEAR FORM
X
X	CASE
X	WHEN flag = 'Q'
X		{ Create new query }
X		IF cns_spi() THEN
X			DECLARE c_generate CURSOR FOR st_select
X			LET ct_spi.query_done = TRUE
X			CALL new_spi()
X		END IF
X
X	WHEN ct_spi.query_done
X		{ Re-execute previous query }
X		CALL new_spi()
X
X	OTHERWISE
X		ERROR "No previous query to execute"
X		LET ct_spi.direction = 0 { Query }
X	END CASE
X
X	RETURN ct_spi.direction
X
XEND FUNCTION {qry_spi}
X
X{ Generate list of rows satisfied by query condition }
XFUNCTION new_spi()
X
X	DEFINE
X		pkey	CHAR(18)
X
X	{ Remove current data from active list }
X	IF sc_zapstr(ct_spi.list_number) THEN
X		ERROR "Error from sc_zapstr in new_spi"
X	END IF
X	LET ct_spi.active_set = 0
X	LET ct_spi.active_row = 0
X	LET ct_spi.direction  = 0
X
X	{ Select primary key values into temporary table }
X	FOREACH c_generate INTO pkey
X		IF INT_FLAG THEN
X			ERROR "Interrupt detected -- SELECT stopped"
X			LET INT_FLAG = FALSE
X			EXIT FOREACH
X		END IF
X		IF sc_insstr(ct_spi.list_number, pkey) THEN
X			ERROR "Error from sc_insstr in new_spi"
X		END IF
X	END FOREACH
X	LET ct_spi.active_set = sc_cntstr(ct_spi.list_number)
X
X	IF ct_spi.active_set > 0 THEN
X		LET ct_spi.direction = csr_spi('F', 0)
X	ELSE
X		MESSAGE "No rows selected"
X		SLEEP 2
X		LET ct_spi.direction = 0 { Query }
X	END IF
X
XEND FUNCTION {new_spi}
X
X{ Change data in Spi }
XFUNCTION iud_spi(flag)
X
X	DEFINE
X		flag	CHAR(1)
X
X	WHENEVER ERROR CONTINUE
X	CASE flag
X	WHEN 'I'
X		INSERT INTO Spi VALUES (wr_spi.*)
X	WHEN 'U'
X		UPDATE Spi
X			SET Spi.* = wr_spi.*
X			WHERE CURRENT OF c_update
X	WHEN 'D'
X		DELETE FROM Spi
X			WHERE CURRENT OF c_update
X	OTHERWISE
X		ERROR "Unknown flag passed to iud_spi: ", flag
X		LET STATUS = -1
X	END CASE
X
X	IF STATUS < -1 THEN
X		CALL ERR_PRINT(STATUS)
X	END IF
X
X	WHENEVER ERROR STOP
X
XEND FUNCTION {iud_spi}
X
XFUNCTION gtu_spi(pkey)
X
X	DEFINE
X		pkey	CHAR(18)
X
X	OPEN c_update USING pkey
X	IF STATUS != 0 THEN
X		RETURN STATUS
X	END IF
X	FETCH c_update INTO wr_spi.*
X	RETURN STATUS
X
XEND FUNCTION {gtu_spi}
X
XFUNCTION edu_spi()
X
X	WHENEVER ERROR CONTINUE
X	CLOSE c_update
X	WHENEVER ERROR STOP
X
XEND FUNCTION {edu_spi}
X
XFUNCTION get_spi(pkey)
X
X	DEFINE
X		pkey	CHAR(18),
X		fstatus	INTEGER
X
X	OPEN c_current USING pkey
X	LET fstatus = STATUS
X	IF STATUS = 0 THEN
X		FETCH c_current INTO wr_spi.*
X		LET fstatus = STATUS
X		CLOSE c_current
X	END IF
X	RETURN fstatus
X
XEND FUNCTION {get_spi}
SHAR_EOF
chmod 0444 spic.4gl || echo "$0: failed to restore spic.4gl"
fi
if test -f spig.4gl; then echo "File spig.4gl exists"; else
echo "x - spig.4gl"
sed 's/^X//' << 'SHAR_EOF' > spig.4gl &&
X{
X	@(#)spig.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)Global definitions for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS
X
X	DEFINE
X		wr_spi	RECORD LIKE Spi.*, { Working record }
X		nr_spi	RECORD LIKE Spi.*, { Null record }
X		cp_spi	RECORD LIKE Spi.*, { Previous record }
X		pr_spi	RECORD LIKE Spi.*, { Previous contents of fields }
X		dr_spi	RECORD LIKE Spi.*, { Default values for table }
X		fc_spi	RECORD	{ Field control information }
X					curr_field	INTEGER,	{ Current field number  }
X					prev_field	INTEGER,	{ Previous field number }
X					min_field	INTEGER,	{ Minimum field number  }
X					max_field	INTEGER		{ Maximum field number  }
X				END RECORD,
X		ct_spi	RECORD
X					op_mode		CHAR(1),	{ 'I' => input/update, else 'D' }
X					n_ioforms	INTEGER,	{ Number of forms used in input }
X					list_number	INTEGER,	{ List number }
X					active_set	INTEGER,	{ Number of rows in active set }
X					active_row	INTEGER,	{ Current row in active set }
X					direction	INTEGER,	{ Moving forwards/backwards }
X					query_done	SMALLINT	{ General query constructed? }
X				END RECORD,
X		io_spi	RECORD
X					io_nforms	INTEGER,
X					io_currform	INTEGER,
X					io_nextform	INTEGER,
X					io_inbound	SMALLINT,
X					io_jumpto	SMALLINT,
X					io_init		SMALLINT,
X					io_fldnumlo	ARRAY[3] OF INTEGER,
X					io_fldnumhi	ARRAY[3] OF INTEGER
X				END RECORD
X
X	DEFINE	{ I/O records }
X		i1_spi	RECORD
X					Tabname		LIKE Spi.Tabname,
X					Pkcol		LIKE Spi.Pkcol,
X					Menuname	LIKE Spi.Menuname,
X					Basename	LIKE Spi.Basename
X				END RECORD,
X		i2_spi	RECORD
X					Opt_ins		LIKE Spi.Opt_ins,
X					Afterfield	LIKE Spi.Afterfield,
X					Beforefield	LIKE Spi.Beforefield,
X					Controlb	LIKE Spi.Controlb,
X					Controlp	LIKE Spi.Controlp
X				END RECORD,
X		i3_spi	RECORD
X					Opt_del		LIKE Spi.Opt_del,
X					Opt_upd		LIKE Spi.Opt_upd,
X					Opt_rep		LIKE Spi.Opt_rep,
X					Opt_sh		LIKE Spi.Opt_sh
X				END RECORD
X
XEND GLOBALS
SHAR_EOF
chmod 0444 spig.4gl || echo "$0: failed to restore spig.4gl"
fi
if test -f spii.4gl; then echo "File spii.4gl exists"; else
echo "x - spii.4gl"
sed 's/^X//' << 'SHAR_EOF' > spii.4gl &&
X{
X	@(#)spii.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)Input function for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS "spig.4gl"
X
X{ Module variables -- not accessible outside this file }
XDEFINE
X	defset		INTEGER,	{ 0 => default record not set }
X	io_mode		CHAR(1),	{ I for input, U for update }
X	sccs		CHAR(1)	{ Identifier string }
X
X{ Help function }
XFUNCTION hlp_spi()
X
X	CASE
X	WHEN INFIELD(tabname)		CALL SHOWHELP(100)
X	WHEN INFIELD(pkcol)			CALL SHOWHELP(101)
X	WHEN INFIELD(menuname)		CALL SHOWHELP(102)
X	WHEN INFIELD(basename)		CALL SHOWHELP(103)
X	WHEN INFIELD(opt_ins)		CALL SHOWHELP(104)
X	WHEN INFIELD(afterfield)	CALL SHOWHELP(105)
X	WHEN INFIELD(beforefield)	CALL SHOWHELP(106)
X	WHEN INFIELD(controlb)		CALL SHOWHELP(107)
X	WHEN INFIELD(controlp)		CALL SHOWHELP(108)
X	WHEN INFIELD(opt_del)		CALL SHOWHELP(109)
X	WHEN INFIELD(opt_upd)		CALL SHOWHELP(110)
X	WHEN INFIELD(opt_rep)		CALL SHOWHELP(111)
X	WHEN INFIELD(opt_sh)		CALL SHOWHELP(112)
X	OTHERWISE
X		LET sccs = "@(#)spii.4gl	7.1 90/08/23"
X		ERROR "Sorry -- no help is defined for this field"
X		SLEEP 3
X	END CASE
X
XEND FUNCTION {hlp_spi}
X
X{ Input function }
XFUNCTION inp_spi(iucode)
X
X	DEFINE
X		io_status	INTEGER,
X		io_form		INTEGER,
X		field_no	INTEGER,
X		iucode		CHAR(1) { 'I' Insert, 'U' Update }
X
X	IF io_spi.io_init = FALSE THEN
X		LET io_spi.io_nforms = 3
X		LET io_spi.io_fldnumlo[1] = 1
X		LET io_spi.io_fldnumhi[1] = 4
X		LET io_spi.io_fldnumlo[2] = 5
X		LET io_spi.io_fldnumhi[2] = 9
X		LET io_spi.io_fldnumlo[3] = 10
X		LET io_spi.io_fldnumhi[3] = 13
X		LET io_spi.io_init = TRUE
X	END IF
X
X	LET io_status = 0 { IO_CONT }
X	LET io_mode   = iucode
X	LET io_spi.io_jumpto = NULL
X	LET io_spi.io_nextform = 1
X
X	LET ct_spi.op_mode = 'I'
X	IF io_mode = 'I' THEN
X		CALL sdf_spi()
X	END IF
X
X	{ Copy working record into I/O records }
X	CALL cpi_spi()
X
X	WHILE io_status = 0 { IO_CONT }
X		CASE io_spi.io_nextform
X		WHEN 1 LET io_status = in1_spi()
X		WHEN 2 LET io_status = in2_spi()
X		WHEN 3 LET io_status = in3_spi()
X		OTHERWISE
X			CALL fatal_error("Invalid value of io_form in inp_spi")
X		END CASE
X		CASE io_status
X		WHEN 2 { IO_DONE }
X			EXIT WHILE
X		WHEN 3 { IO_INTR }
X			EXIT WHILE
X		WHEN 0 { IO_CONT }
X			CONTINUE WHILE
X		OTHERWISE
X			ERROR "Can't happen" SLEEP 1
X			LET io_status = 3 { IO_INTR }
X		END CASE
X	END WHILE
X
X	IF io_status = 2 { IO_DONE } THEN
X		# You should MODIFY this.
X		# AFTER INPUT TYPE validation IS often easier here than IN an
X		# AFTER INPUT clause within the INPUT statement.
X		{ Copy I/O records into working record }
X		LET io_status = 1 { IO_OKAY }
X		CALL cpo_spi()
X	ELSE
X		LET INT_FLAG = FALSE
X		LET io_status = FALSE
X	END IF
X	MESSAGE ""
X
X	LET ct_spi.op_mode = 'D'
X	RETURN io_status
X
XEND FUNCTION {inp_spi}
X
X{ Set fc_spi.prev_field correctly }
XFUNCTION spf_spi(vcode, retval)
X
X	DEFINE
X		vcode	CHAR(2),
X		retval	INTEGER
X
X	IF retval = 0 THEN
X		{ Exit from multiscreen input }
X		RETURN
X	END IF
X
X	IF vcode = "BF" THEN
X		IF retval IS NOT NULL AND retval != fc_spi.curr_field THEN
X			LET fc_spi.prev_field = fc_spi.curr_field
X		END IF
X	ELSE
X		IF retval IS NULL OR retval != fc_spi.curr_field THEN
X			LET fc_spi.prev_field = fc_spi.curr_field
X		END IF
X	END IF
X
XEND FUNCTION {spf_spi}
X
X{ Set defaults }
XFUNCTION sdf_spi()
X
X	# ALL INPUT IS done WITHOUT DEFAULTS.
X	# This FUNCTION IS used TO SET DEFAULTS.
X	# Initialisation IS expensive -- do it just once.
X	IF defset = 0 THEN
X		LET defset = 1
X		INITIALIZE dr_spi.tabname LIKE Spi.tabname
X		INITIALIZE dr_spi.pkcol LIKE Spi.pkcol
X		INITIALIZE dr_spi.menuname LIKE Spi.menuname
X		INITIALIZE dr_spi.basename LIKE Spi.basename
X		INITIALIZE dr_spi.opt_ins LIKE Spi.opt_ins
X		INITIALIZE dr_spi.afterfield LIKE Spi.afterfield
X		INITIALIZE dr_spi.beforefield LIKE Spi.beforefield
X		INITIALIZE dr_spi.controlb LIKE Spi.controlb
X		INITIALIZE dr_spi.controlp LIKE Spi.controlp
X		INITIALIZE dr_spi.opt_del LIKE Spi.opt_del
X		INITIALIZE dr_spi.opt_upd LIKE Spi.opt_upd
X		INITIALIZE dr_spi.opt_rep LIKE Spi.opt_rep
X		INITIALIZE dr_spi.opt_sh LIKE Spi.opt_sh
X	END IF
X
X	LET wr_spi.* = dr_spi.*
X
XEND FUNCTION {sdf_spi}
X
X{ Copy working record into I/O records }
XFUNCTION cpi_spi()
X
X	LET i1_spi.tabname		= wr_spi.tabname
X	LET i1_spi.pkcol		= wr_spi.pkcol
X	LET i1_spi.menuname		= wr_spi.menuname
X	LET i1_spi.basename		= wr_spi.basename
X
X	LET i2_spi.opt_ins		= wr_spi.opt_ins
X	LET i2_spi.afterfield	= wr_spi.afterfield
X	LET i2_spi.beforefield	= wr_spi.beforefield
X	LET i2_spi.controlb		= wr_spi.controlb
X	LET i2_spi.controlp		= wr_spi.controlp
X
X	LET i3_spi.opt_del		= wr_spi.opt_del
X	LET i3_spi.opt_upd		= wr_spi.opt_upd
X	LET i3_spi.opt_rep		= wr_spi.opt_rep
X	LET i3_spi.opt_sh		= wr_spi.opt_sh
X
XEND FUNCTION {cpi_spi}
X
X{ Copy I/O records into working record }
XFUNCTION cpo_spi()
X
X	LET wr_spi.tabname		= i1_spi.tabname
X	LET wr_spi.pkcol		= i1_spi.pkcol
X	LET wr_spi.menuname		= i1_spi.menuname
X	LET wr_spi.basename		= i1_spi.basename
X
X	LET wr_spi.opt_ins		= i2_spi.opt_ins
X	LET wr_spi.afterfield	= i2_spi.afterfield
X	LET wr_spi.beforefield	= i2_spi.beforefield
X	LET wr_spi.controlb		= i2_spi.controlb
X	LET wr_spi.controlp		= i2_spi.controlp
X
X	LET wr_spi.opt_del		= i3_spi.opt_del
X	LET wr_spi.opt_upd		= i3_spi.opt_upd
X	LET wr_spi.opt_rep		= i3_spi.opt_rep
X	LET wr_spi.opt_sh		= i3_spi.opt_sh
X
XEND FUNCTION {cpo_spi}
X
XFUNCTION ffl_spi()
X
X	DEFINE
X		retval	INTEGER,
X		maxfld	INTEGER,
X		formno	INTEGER
X
X	LET retval = NULL
X	LET formno = io_spi.io_currform
X	LET maxfld = io_spi.io_fldnumhi[formno]
X
X	IF io_spi.io_inbound = TRUE THEN
X		IF io_spi.io_jumpto IS NOT NULL THEN
X			LET retval = io_spi.io_jumpto
X		ELSE
X			LET io_spi.io_inbound = FALSE
X		END IF
X		LET io_spi.io_jumpto = NULL
X	ELSE
X		IF fc_spi.prev_field = maxfld THEN
X			LET retval = 0
X			LET io_spi.io_nextform = inc_modulo(io_spi.io_currform,
X											io_spi.io_nforms)
X			LET io_spi.io_jumpto = NULL
X		END IF
X	END IF
X
X	RETURN retval
X
XEND FUNCTION {ffl_spi}
X
XFUNCTION lfl_spi()
X
X	DEFINE
X		retval	INTEGER,
X		minfld	INTEGER,
X		formno	INTEGER
X
X	LET retval = NULL
X	LET formno = io_spi.io_currform
X	LET minfld = io_spi.io_fldnumlo[formno]
X
X	IF io_spi.io_inbound = TRUE THEN
X		LET io_spi.io_inbound = FALSE
X	ELSE
X		IF fc_spi.prev_field = minfld THEN
X			LET retval = 0
X			LET io_spi.io_nextform = dec_modulo(io_spi.io_currform,
X										io_spi.io_nforms)
X			LET formno = io_spi.io_nextform
X			LET io_spi.io_jumpto = io_spi.io_fldnumhi[formno]
X		END IF
X	END IF
X
X	RETURN retval
X
XEND FUNCTION {lfl_spi}
X
XFUNCTION xfl_spi(field_no)
X
X	DEFINE
X		field_no	INTEGER,
X		i			INTEGER
X
X	FOR i = 1 TO io_spi.io_nforms
X		IF (field_no >= io_spi.io_fldnumlo[i] AND
X			field_no <= io_spi.io_fldnumhi[i]) THEN
X			LET io_spi.io_nextform = i
X			LET io_spi.io_jumpto = field_no
X			EXIT FOR
X		END IF
X	END FOR
X
XEND FUNCTION {xfl_spi}
SHAR_EOF
chmod 0444 spii.4gl || echo "$0: failed to restore spii.4gl"
fi
if test -f spim.4gl; then echo "File spim.4gl exists"; else
echo "x - spim.4gl"
sed 's/^X//' << 'SHAR_EOF' > spim.4gl &&
X{
X	@(#)spim.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.10 (09/02/1990)
X	@(#)Main control program for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS "spig.4gl"
X
X{ Module variables -- not accessible outside this file }
XDEFINE
X	sccs		CHAR(1)	{ Identifier string }
X
X{ Dummy main program -- does the minimum reasonable work }
XMAIN
X
X	LET sccs = "@(#)spim.4gl	7.1 90/08/23"
X
X	CALL std_options("SPI")
X	DEFER INTERRUPT
X	DEFER QUIT
X
X	{ Initialise the SPI for spi -- terminate on failure }
X	IF wop_spi() != 0 THEN
X		EXIT PROGRAM 1
X	END IF
X
X	{ Can call mnu_spi many times }
X	CALL mnu_spi()
X
X	{ Normally call wcl_spi just once }
X	CALL wcl_spi()
X
XEND MAIN
X
X{ Simplified Perform control function }
XFUNCTION mnu_spi()
X
X	DEFINE
X		offset	INTEGER,	{ Amount to jump by (next/previous) }
X		junk	INTEGER
X
X	CALL wmn_spi(2)
X
X	LET offset = 0
X
X	{ If re-entering this query screen }
X	IF ct_spi.active_set > 0 THEN
X		LET junk = csr_spi('C', offset)
X	END IF
X
X	MENU "SPI"
X
X	COMMAND "Query" "Select set of data" HELP 1
X		CASE qry_spi('Q')
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND "Next" "Show next row of data" HELP 2
X		LET ct_spi.direction = 1 { Forwards }
X		CASE csr_spi('N', offset)
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND "Previous" "Show previous row of data" HELP 3
X		LET ct_spi.direction = 2 { Backwards }
X		CASE csr_spi('P', offset)
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND "Add" "Add new row of data" HELP 4
X		CASE ins_spi()
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND "Delete" "Delete current record" HELP 5
X		CASE del_spi()
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND "Update" "Amend current record" HELP 6
X		CASE upd_spi()
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND "Exit" "Exit SPI Menu" HELP 8
X		LET INT_FLAG = FALSE
X		MESSAGE ""
X		EXIT MENU
X
X	COMMAND KEY('0') LET offset = 10 * offset + 0
X	COMMAND KEY('1') LET offset = 10 * offset + 1
X	COMMAND KEY('2') LET offset = 10 * offset + 2
X	COMMAND KEY('3') LET offset = 10 * offset + 3
X	COMMAND KEY('4') LET offset = 10 * offset + 4
X	COMMAND KEY('5') LET offset = 10 * offset + 5
X	COMMAND KEY('6') LET offset = 10 * offset + 6
X	COMMAND KEY('7') LET offset = 10 * offset + 7
X	COMMAND KEY('8') LET offset = 10 * offset + 8
X	COMMAND KEY('9') LET offset = 10 * offset + 9
X
X	COMMAND KEY(F) { "First" "Jump to first selected row" }
X		CASE csr_spi('F', offset)
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND KEY(L) { "Last" "Jump to last selected row" }
X		CASE csr_spi('L', offset)
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND KEY(G) { "Goto" "Jump to specified row" }
X		CASE csr_spi('G', offset)
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND KEY(C) { "Current" "Re-fetch current row" }
X		CASE csr_spi('C', offset)
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		WHEN 2	NEXT OPTION "Previous"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	COMMAND KEY('!')
X		CALL shell_escape()
X		{ An interrupt may have terminated the shell }
X		LET INT_FLAG = FALSE 
X		LET offset = 0
X
X	COMMAND KEY(S) { "Same Query" "Re-execute enquiry" }
X		CASE qry_spi('S')
X		WHEN 0	NEXT OPTION "Query"
X		WHEN 1	NEXT OPTION "Next"
X		END CASE
X		CALL check_interrupt()
X		LET offset = 0
X
X	END MENU
X
X	CALL wio_spi(3)
X
XEND FUNCTION {do_spi}
X
X{ Delete row }
XFUNCTION del_spi()
X
X	DEFINE
X		junk			INTEGER,
X		delete_failed	INTEGER
X
X	CALL wio_spi(2)
X
X	IF ct_spi.active_set <= 0 THEN
X		ERROR "No current row to delete"
X		LET ct_spi.direction = 0 { Query }
X	ELSE
X		{ Assume delete fails until it succeeds }
X		LET delete_failed = TRUE
X		CALL begin_work()
X		IF gtu_spi(wr_spi.tabname) != 0 THEN
X			ERROR "Current row has already been deleted"
X			IF sc_delstr(ct_spi.list_number) THEN
X				ERROR "Error from sc_delstr in del_spi"
X			END IF
X		ELSE
X			CALL di1_spi()
X
X			CALL wmn_spi(2)
X
X			MENU "DELETE"
X			COMMAND "No"
X					"No, I do not wish to delete this row"
X					HELP 10
X				EXIT MENU
X			COMMAND "Yes"
X					"Yes, I really do want to delete this row"
X					HELP 11
X				IF INT_FLAG = TRUE THEN
X					EXIT MENU
X				END IF
X				CALL iud_spi('D')
X				IF STATUS != 0 THEN
X					ERROR "Delete failed"
X				ELSE
X					MESSAGE "Row deleted"
X					LET delete_failed = FALSE
X					IF sc_delstr(ct_spi.list_number) THEN
X						ERROR "Error from sc_delstr in del_spi"
X					END IF
X				END IF
X				EXIT MENU
X			END MENU
X			CALL edu_spi()
X			CALL end_work(delete_failed)
X		END IF
X
X		LET INT_FLAG = FALSE
X		LET junk = csr_spi('D', 0)
X
X	END IF
X
X	RETURN ct_spi.direction
X
XEND FUNCTION {del_spi}
X
X{ Change row }
XFUNCTION upd_spi()
X
X	DEFINE
X		old_tabname	LIKE Spi.Tabname,
X		junk			LIKE Spi.Tabname,
X		update_failed	INTEGER
X
X	CALL wio_spi(2)
X
X	IF ct_spi.active_set <= 0 THEN
X		ERROR "No current row to update"
X	ELSE
X		{ Assume update fails until it succeeds }
X		LET update_failed = TRUE
X		CALL begin_work()
X		IF gtu_spi(wr_spi.tabname) != 0 THEN
X			ERROR "Someone else has deleted/altered this row"
X			IF sc_delstr(ct_spi.list_number) THEN
X				ERROR "Error from sc_delstr in del_spi"
X			END IF
X		ELSE
X			LET old_tabname = wr_spi.tabname
X			{
X			This call to di1_spi() is not needed if it only
X			displays the current record.  If, however, it
X			displays data from other tables, this call is
X			necessary to show the other details.  Leave it in
X			the code unless there are good reasons to remove it.
X			}
X			CALL di1_spi()
X			MESSAGE "Edit data: press ESC when done"
X
X			IF inp_spi('U') THEN
X				CALL iud_spi('U')
X				IF STATUS = 0 THEN
X					MESSAGE "Record updated"
X					LET update_failed = FALSE
X					IF wr_spi.tabname != old_tabname THEN
X						IF sc_updstr(ct_spi.list_number, wr_spi.tabname) THEN
X							ERROR "Error from sc_updstr in upd_spi"
X						END IF
X					END IF
X					LET cp_spi.* = wr_spi.*
X				ELSE
X					CALL ERR_PRINT(STATUS)
X				END IF
X			END IF
X		END IF
X
X		CALL edu_spi()
X		CALL end_work(update_failed)
X		LET junk = csr_spi('U', 0)
X
X	END IF
X
X	RETURN ct_spi.direction
X
XEND FUNCTION {upd_spi}
X
X{ Add new row(s) }
XFUNCTION ins_spi()
X
X	DEFINE
X		cpos		INTEGER,
X		junk		INTEGER,
X		iostatus	INTEGER,
X		tabname		LIKE Spi.Tabname
X
X	CALL wio_spi(2)
X
X	{ Transaction will always be committed }
X	CALL begin_work()
X
X	{ Save current position to be restored }
X	LET cpos = sc_numstr(ct_spi.list_number)
X	IF cpos = 0 THEN
X		LET cpos = 1
X	END IF
X
X	{ Loop terminates when interrupt detected }
X	LET INT_FLAG = FALSE
X	WHILE TRUE
X
X		MESSAGE "Enter data: ESC to insert, INTR to abandon"
X		LET wr_spi.* = nr_spi.*
X		IF inp_spi('I') = FALSE THEN
X			EXIT WHILE
X		END IF
X
X		CALL iud_spi('I')
X		IF STATUS = 0 THEN
X			IF sc_insstr(ct_spi.list_number, wr_spi.tabname) THEN
X				ERROR "Error from sc_insstr in ins_spi"
X			END IF
X			LET cp_spi.* = wr_spi.*
X			MESSAGE "Row inserted"
X			SLEEP 2
X		ELSE
X			CALL ERR_PRINT(STATUS)
X		END IF
X
X	END WHILE
X
X	LET INT_FLAG = FALSE
X	CALL commit_work()
X	CALL sc_getstr(ct_spi.list_number, 'A', cpos)	{ Restore current position }
X		RETURNING iostatus, tabname
X	IF iostatus < -1 THEN
X		{ -1: ENOLIST is acceptable if interrupted before first entry }
X		ERROR "Error from sc_getstr in ins_spi"
X	END IF
X	LET junk = csr_spi('I', 0)
X
X	RETURN ct_spi.direction
X
XEND FUNCTION {ins_spi}
X
X{ Move cursor in list -- does not use RDSQL cursors directly }
XFUNCTION csr_spi(action, offset)
X
X	DEFINE
X		action		CHAR(1),
X		offset		INTEGER,
X		get_code	CHAR(1),
X		get_jump	INTEGER,
X		iostatus	INTEGER,
X		fstatus		INTEGER
X
X	CALL wi1_spi(2)
X
X	LET get_code = 'R'	{ Relative move }
X	LET get_jump = 0	{ No distance }
X
X	IF offset = 0 THEN
X		LET offset = 1
X	END IF
X
X	CASE action
X	WHEN 'I'
X		IF ct_spi.active_set = 0 THEN	{ No previous active list }
X			LET get_code = 'F'
X		ELSE
X			LET get_jump = 1
X		END IF
X	WHEN 'D'
X		IF ct_spi.direction = 1 THEN	{ Forwards }
X			LET get_jump = 0
X		END IF
X		IF ct_spi.direction = 2 AND ct_spi.active_row != ct_spi.active_set THEN
X			LET get_jump = -1
X		END IF
X	WHEN 'N'
X		LET get_jump = offset
X	WHEN 'P'
X		LET get_jump = -offset
X	WHEN 'F'
X		LET get_code = 'F'
X	WHEN 'L'
X		LET get_code = 'L'
X	WHEN 'U'
X		LET get_code = 'C'
X	WHEN 'C'
X		LET get_code = 'C'
X	WHEN 'G'
X		LET get_code = 'A'
X		LET get_jump = offset
X	OTHERWISE
X		ERROR "Program error in csr_spi"
X		LET iostatus = sc_zapstr(ct_spi.list_number)
X		LET action = 'E'
X	END CASE
X
X
X	{ See if we can find the correct row }
X	{ NB: someone else may have deleted or changed it }
X	LET fstatus = TRUE
X	WHILE fstatus
X
X		LET ct_spi.active_set = sc_cntstr(ct_spi.list_number)
X		IF ct_spi.active_set <= 0 THEN
X			{ No rows left in list }
X			CASE action
X			WHEN 'D'
X				MESSAGE "All selected rows deleted"
X			WHEN 'W'
X				MESSAGE "One or more rows have been deleted by someone else"
X			WHEN 'E'
X				MESSAGE "An internal error has lost the selected data"
X			WHEN 'G'
X				MESSAGE "Report has been produced"
X			OTHERWISE
X				MESSAGE "No rows selected"
X			END CASE
X			LET ct_spi.direction = 0 { Query next }
X			EXIT WHILE
X		END IF
X
X		{ Get key for requested row }
X		CALL sc_getstr(ct_spi.list_number, get_code, get_jump)
X			RETURNING iostatus, wr_spi.tabname
X		IF iostatus < 0 THEN
X			ERROR "Error from sc_getstr in csr_spi"
X			LET iostatus = sc_zapstr(ct_spi.list_number)
X			LET action = 'E'
X			CONTINUE WHILE
X		END IF
X
X		LET ct_spi.active_row = sc_numstr(ct_spi.list_number)
X		CASE
X		WHEN ct_spi.active_row = 1 AND action = 'P'
X			MESSAGE "No more rows going backwards"
X			LET ct_spi.direction  = 1 { Forwards }
X		WHEN ct_spi.active_row = ct_spi.active_set AND action = 'N'
X			MESSAGE "No more rows going forwards"
X			LET ct_spi.direction  = 2 { Backwards }
X		OTHERWISE
X			MESSAGE ""
X		END CASE
X
X		{ Fetch the data from Spi for Tabname }
X		LET fstatus = get_spi(wr_spi.tabname)
X		IF fstatus != 0 THEN
X			{ It wasn't there -- so remove it from the list }
X			IF sc_delstr(ct_spi.list_number) THEN
X				ERROR "Error from sc_delstr in csr_spi"
X				LET iostatus = sc_zapstr(ct_spi.list_number)
X				LET action = 'E'
X			ELSE
X				{ Warn user and set up fetch of next row }
X				LET action = 'W'
X				LET get_code = 'R'
X				IF ct_spi.direction = 1 THEN
X					LET get_jump = 1
X				ELSE
X					LET get_jump = -1
X				END IF
X			END IF
X		END IF
X
X	END WHILE
X
X	IF fstatus = 0 THEN
X		CALL di1_spi()
X		LET cp_spi.* = wr_spi.*
X		IF action = 'W' THEN
X			MESSAGE "One or more rows have been deleted by someone else"
X		END IF
X	ELSE
X		CLEAR FORM
X		LET cp_spi.* = nr_spi.*
X	END IF
X
X	LET ct_spi.active_row = sc_numstr(ct_spi.list_number)
X	LET ct_spi.active_set = sc_cntstr(ct_spi.list_number)
X	IF ct_spi.active_set > 0 THEN
X		DISPLAY "--", ct_spi.active_row USING "&&&&/",
X				ct_spi.active_set USING "&&&&", "--" AT 1, 1
X	ELSE
X		DISPLAY "-------------" AT 1, 1
X	END IF
X	RETURN ct_spi.direction
X
XEND FUNCTION {csr_spi}
SHAR_EOF
chmod 0664 spim.4gl || echo "$0: failed to restore spim.4gl"
fi
if test -f spir.4gl; then echo "File spir.4gl exists"; else
echo "x - spir.4gl"
sed 's/^X//' << 'SHAR_EOF' > spir.4gl &&
X{
X	@(#)spir.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)Report code for SPI on Spi
X}
X
XDATABASE FGLBLD
X
XGLOBALS "spig.4gl"
X
X{ Module variables -- not accessible outside this file }
XDEFINE
X	sccs		CHAR(1)	{ Identifier string }
X
SHAR_EOF
chmod 0444 spir.4gl || echo "$0: failed to restore spir.4gl"
fi
if test -f spiw.4gl; then echo "File spiw.4gl exists"; else
echo "x - spiw.4gl"
sed 's/^X//' << 'SHAR_EOF' > spiw.4gl &&
X{
X	@(#)spiw.4gl	7.1 90/08/23
X	@(#)Built by: FGLBLD Version 6.08 (01/12/1989)
X	@(#)Window functions for SPI on Spi
X}
X
X{ Manipulate I/O portion of screen }
XFUNCTION wio_spi(cmd)
X
X    DEFINE
X		cmd		INTEGER
X
X    CASE cmd
X	WHEN 0     { display the border }
X		OPEN WINDOW w_io_spi AT 5,3 WITH 18 ROWS, 76 COLUMNS
X			ATTRIBUTE (FORM LINE FIRST)
X	WHEN 1     { close the screen }
X		CLOSE WINDOW w_io_spi
X	WHEN 2     { make form window current }
X		CURRENT WINDOW IS w_io_spi
X	WHEN 3		{ Clear window }
X		CLEAR WINDOW w_io_spi
X	OTHERWISE
X		CALL fatal_error("Invalid command passed to wio_spi")
X	END CASE
X
XEND FUNCTION {wio_spi}
X
X{ Manipulate border portion of screen }
XFUNCTION wbd_spi(cmd)
X
X    DEFINE
X		cmd		INTEGER
X
X    CASE cmd
X	WHEN 0     { display the border }
X		OPEN WINDOW w_bd_spi AT 2,2 WITH 21 ROWS, 78 COLUMNS
X			ATTRIBUTES ( BORDER )
X	WHEN 1     { close the screen }
X		CLOSE WINDOW w_bd_spi
X	WHEN 2     { make form window current }
X		CURRENT WINDOW IS w_bd_spi
X	WHEN 3		{ Clear window }
X		CLEAR WINDOW w_bd_spi
X	OTHERWISE
X		CALL fatal_error("Invalid command passed to wio_spi")
X	END CASE
X
XEND FUNCTION {wbd_spi}
X
X{ Manipulate menu portion of screen }
XFUNCTION wmn_spi(cmd)
X
X    DEFINE
X		cmd		INTEGER
X
X    CASE cmd
X	WHEN 0
X		OPEN WINDOW w_mn_spi AT 2,2 WITH 2 ROWS, 78 COLUMNS
X			ATTRIBUTES ( BORDER )
X	WHEN 1
X		CLOSE WINDOW w_mn_spi
X	WHEN 2
X		CURRENT WINDOW IS w_mn_spi
X	WHEN 3		{ Clear window }
X		CLEAR WINDOW w_mn_spi
X	OTHERWISE
X		CALL fatal_error("Invalid command passed to wmn_spi")
X    END CASE
X
XEND FUNCTION {wmn_spi}
SHAR_EOF
chmod 0444 spiw.4gl || echo "$0: failed to restore spiw.4gl"
fi
echo All files extracted
exit 0