92000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! C H E C K V A L I D E N T R Y
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Given a response in ans$, it checks the rules in valid_element$
! to see if it is OK.
! Allowed validation rules are:
! "NUMBER", "ALLOW", "INTEGER", "DATE", "FULLTIME", "RANGE",
! "DIGITS", "CONTAINS", and "REQUIRED"
! (digits 2 3 means 2 digits (max) before the decimal point
! and 3 digits (max) after it, negative signs included)
!
! Expected:
! fld = the index number of the current field
! max_validation() = number of validation elements for that
! field
! valid_element$(fld,el) contains validation element el for
! field fld. Note that in the case of an "allow",
! valid_element$(fld,el+1) as the actual allowed stuff.
!
! Result :
! error = true if there is a problem (such as it violates
! one of the rules
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine check_valid_entry
92020 !if max_validation(fld) = 0 then exit routine
error = false
for valid_element = 1 to max_validation(fld)
select case valid_element$(fld,valid_element)
case 'NUMBER' : gosub do_number_check
case 'INTEGER' : gosub do_integer_check
case 'ALLOW' : gosub do_allow_check
case 'DATE' : gosub do_date_check
case 'RANGE' : gosub do_range_check
case 'REQUIRED': gosub do_required_check
case 'DIGITS' : gosub do_digit_check
case 'CONTAINS': gosub do_contains_check
case 'FULLTIME': gosub do_fulltime_check
case else
message error : "Unknown validation rule: " + &
valid_element$(fld, valid_element)
end select
if _error then exit for
next valid_element
if _error then error = true
if error then exit routine
!gosub do_format_check ++DJS++ 16-FEB-1993 not a useful check anymore
! ++DJS++ 16-FEB-1993 format$ no longer returns an error
92099 end routine
93000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O R A N G E C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Checks ans$ to see if it is in the proper range. Expects that the
! valid_element$(fld, valid_element + 1) and
! valid_element$(fld, valid_element + 2) have the allowed
! range limits. Increments valid_element
! extra times so that you do not try to interpert the
! allowed stuff as another valid check.
!
! Expected:
! ans$ = user response
! valid_element$(fld, valid_element + 1) has the low range limit
! valid_element$(fld, valid_element + 2) has the high limit
!
! Result :
! error = true if ans$ is not in the range
! valid_element is incremented.
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_range_check
93020 valid_element = valid_element + 2
if trim$(ans$) = '' then exit routine
if not(valid(ans$, 'integer')) then
message error: "Integer expected: " + ans$
exit routine
end if
low$ = trim$(valid_element$(fld, valid_element - 1))
high$ = trim$(valid_element$(fld, valid_element))
z = val(ans$)
if z < val(low$) or z > val(high$) then &
message error : "Allowed range: " + low$ + &
" to " + high$
93099 end routine
94000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O N U M B E R C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Check ans$ to see if it is a number (or blank)
!
! Expected:
! ans$ = user response
!
! Result :
! error = true if ans$ is not a number
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_number_check
94020 if trim$(ans$) = '' then exit routine
if not(valid(ans$, 'number')) then &
message error: "Number expected: " + ans$
94099 end routine
94500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O I N T E G E R C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Check ans$ to see if it is an integer or blank
!
! Expected:
! ans$ = user response
!
! Result :
! error = true if ans$ is not an integer
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_integer_check
94520 if trim$(ans$) = '' then exit routine
if not(valid(ans$, 'integer')) then &
message error: "Integer expected: " + ans$
94599 end routine
95000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O A L L O W C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Checks ans$ to see if it is allowed. Expects that the
! valid_element$(fld, valid_element + 1) has the allowed
! responses, separated by commas. Increments valid_element
! an extra time so that you do not try to interpert the
! allowed stuff as another valid check.
!
! Expected:
! ans$ = user response
! valid_element$(fld, valid_element+1) has the
! allowed strings. It shouldn't have leading/trailing
! spaces.
!
! Result :
! error = true if ans$ is not in
! valid_element$(fld, valid_element + 1)
! valid_element is incremented.
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_allow_check
95020 valid_element = valid_element + 1
if trim$(ans$) = '' then exit routine
z$ = valid_element$(fld, valid_element)
if z$ [1:1] = "'" or z$[1:1] = '"' then z$ = z$[2:len(z$)]
z= len(z$)
if z$ [z:z] = "'" or z$[z:z] = '"' then z$ = z$[1:z-1]
if fld_uppercase(fld) then z$ = ucase$(z$)
z1 = match(z$, ans$)
if z1 = 0 then &
message error : 'Allowed responses: ' + z$
95099 end routine
95100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O C O N T A I N S C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Checks ans$ to see if it has the required character. Expects
! that the valid_element$(fld, valid_element + 1) has the
! required character. Increments valid_element
! an extra time so that you do not try to interpert the
! character stuff as another valid check.
!
! this check is used to make sure that a character exists in
! the answer. For example, a code translation file is set up
! as code_prefix:code. Therefore, a : is required
!
! Expected:
! ans$ = user response
! valid_element$(fld, valid_element+1) has the
! allowed character. It shouldn't have leading/trailing
! spaces.
!
! Result :
! error = true if ans$ is not in
! valid_element$(fld, valid_element + 1)
! valid_element is incremented.
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_contains_check
95120 valid_element = valid_element + 1
if trim$(ans$) = '' then exit routine
z$ = valid_element$(fld, valid_element)
if z$ [1:1] = "'" or z$[1:1] = '"' then z$ = z$[2:len(z$)]
z= len(z$)
if z$ [z:z] = "'" or z$[z:z] = '"' then z$ = z$[1:z-1]
if fld_uppercase(fld) then z$ = ucase$(z$)
z1 = pos(ans$, z$)
if z1 = 0 then &
message error : 'Your answer must contain the character "' + z$ + &
'"'
95199 end routine
95500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O D A T E C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Checks ans$ to see if it has a valid date. Expects
! that, as the user just entered it, it is in MDY
! format.
!
! Expected:
! ans$ = user response
!
! Result :
! _error = true if ans$ is not a valid MDY date
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_date_check
95520 valid_element = valid_element + 1
ans$ = trim$(ans$)
if ans$ = '' then exit routine
if not(valid(ans$[5:8] + ans$[1:4], "DATE")) then &
message error : "Invalid data: " + ans$
! +++ RPR Debug - Intouch cannot handle 8-character DATE:MDY
95599 end routine
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O F U L L T I M E C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Brief description:
!
! Expected:
!
! Locals:
!
! Results:
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_fulltime_check
95600 valid_element = valid_element +1
ans$ = trim$(ans$)
if ans$ = '' then exit routine
if len(ans$) = 15 then ans_new$ = ans$[5:8] +ans$[1:4]+ans$[9:15]
if len(ans$) = 13 then ans_new$ = ans$[3:6] +ans$[1:2]+ans$[7:13]
if not(valid(ans_new$, "FULLTIME")) then &
message error : "Invalid fullltime: " + ans$
end routine
96000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O R E Q U I R E D C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! checks to see if response is required
!
! Expected:
! ans$ = user response
!
! Result :
! error = true if no user response
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_required_check
96020 if trim$(ans$) = '' then &
message error: "Response required"
96099 end routine
96500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O D I G I T C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Check that there are the proper number of digits before and
! after the decimal point in ans$. Expects that
! valid_element$(fld, valid_element + 1) and
! valid_element$(fld, valid_element + 2) have the number
! of digits (maximum) before and after the decimal point.
! Negative numbers ARE allowed (the behavior will be described
! momentarily)
! Also increments valid_element twice so that you don't try to
! use the numeric parameters as things to check.
!
! The convolutions for negative numbers are actually logical
! extensions of negative scaling factors in limited-length
! fields and scaling factors which are larger than the field
! length.
!
! IF the first parameter is negative, it checks that there
! are only negative signs and zeros before the decimal point
! and there are abs(first parameter) zeros after it.
! IF the second parameter is negative, it checks that there
! are only zeros after the decimal point (if there is one)
! and either the number is zero or there are abs(second
! parameter) zeros immediately prior to the decimal point.
!
! Expected:
! ans$ = user response
! valid_element$(fld, valid_element+1) has the max. number of
! digits before the decimal point
! valid_element$(fld, valid_element + 2) has the max. number of
! digits after the decimal point
!
! Result :
! error = true if ans$ is not in
! valid_element$(fld, valid_element + 1)
! valid_element is incremented.
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_digit_check
96520 valid_element = valid_element + 2
if not(valid(ans$,'NUMBER')) then exit routine
! No automatic numeric check
nbr$ = ans$
if trim$(nbr$) = '' or val(nbr$) = 0.0 then exit routine
! Zero is always O.K.
if pos(ans$,'.') = 0 then nbr$ = nbr$ + "."
dp = pos(nbr$,'.')
before = val(valid_element$(fld, valid_element - 1))
after = val(valid_element$(fld, valid_element))
gosub digit_check_before
if _error then exit routine
gosub digit_check_after
96599 end routine
96600 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D I G I T C H E C K B E F O R E
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Check the number of digits "before" the decimal point. Only
! allow a certain number of digits before the decimal point
! If the number of digits allowed < 0, then force zeros after
! the decimal point.
! Expects:
! before = # digits before the decimal point (or zeros after the
! decimal point if before is negative)
! nbr$ = the number you are checking (with a trailing decimal point
! if none was indicated)
! dp = the location of the decimal point
! Result:
! _error = true if the number has too many/too few characters
! in the proper positions.
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine digit_check_before
96620 if before > 0 then
! Check that there are not more than before digits before the decimal
if dp - 1 > before then &
message error: "Maximum digits (including negative sign) " + &
"before decimal point: " + str$(before)
else
if val(nbr$) < 0 then before = before - 1 ! Make it count
! negative signs - force another zero.
! Check that there are at least -before zeros after the decimal
if nbr$[dp + 1: dp - before] <> repeat$('0',-before) then &
message error: "Minimum zeros after decimal point: " + &
str$(-before)
end if
96699 end routine
96700 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D I G I T C H E C K A F T E R
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! Check the number of digits "after" the decimal point. Only
! allow a certain number of digits after the decimal point
! If the number of digits allowed < 0, then force zeros before
! the decimal point.
! Expects:
! after = # digits after the decimal point (or zeros before the
! decimal point if after is negative)
! nbr$ = the number you are checking (with a trailing decimal point
! if none was indicated)
! dp = the location of the decimal point
! Result:
! _error = true if the number has too many/too few characters
! in the proper positions.
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine digit_check_after
96720 if after >= 0 then
! Check that there are not more than after digits after the decimal
if len(nbr$) - dp > after then &
message error: "Maximum digits after the decimal point: " + &
str$(after)
else
! Check that there are at least -after zeros before the decimal
if ans$[dp + after:dp - 1] <> repeat$('0', -after) then &
message error: "Minimum zeros before the decimal point: " + &
str$(-after)
end if
96799 end routine
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! D O F O R M A T C H E C K
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!make sure that the data fits the mask
!
! Expected:
!
! Result :
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
routine do_format_check
if tot_fld_lines(change_field) > 1 then exit routine
dfc_numeric = false
for valid_element = 1 to max_validation(fld)
select case valid_element$(fld,valid_element)
case 'NUMBER' : dfc_numeric = true
case 'INTEGER' : dfc_numeric = true
case 'DIGITS' : dfc_numeric = true
case else
end select
next valid_element
if dfc_numeric then
display_data = val(ans$)
else
display_data = ans$
end if
when exception in
z$ = format$(display_data, str_mask$(change_field))
use
end when
if not _error then exit routine
message error : "Data doesn't fit print mask: " + str_mask$(change_field)
error = true ! To keep it from wiping out the message
default$ = ans$
gosub ask_new_data
took_default = false ! They didn't take the default, or they
! wouldn't be here in the first place.
error = (_back or _exit) ! Fixed the error unless you did one of these
end routine