<%
'response.redirect "/maintenance.html"
function DateFormat(d)
dim rv : rv = ""
dim aTemp
dim sep
if d <> "" AND not isnull(d) then
if isDate(d) then
d = cstr(formatdatetime(d, 2))
if instr(d, "/") then sep = "/"
if instr(d, "-") then sep = "-"
aTemp = split(d, sep)
if ubound(aTemp) = 2 then
if len(aTemp(0)) = 1 then rv = "0"
rv = rv & aTemp(0) & sep
if len(aTemp(1)) = 1 then rv = rv & "0"
rv = rv & aTemp(1) & sep
rv = rv & right(aTemp(2), 2)
end if
end if
end if
DateFormat = rv
end function
function CheckDate(d, opt)
dim rv : rv = true
if d <> "" then
if not isdate(d) then rv = false
else
if not opt then rv = false
end if
CheckDate = rv
end function
Function Str2ProperCase(sValue)
dim iPos
dim sTemp
dim sTemp2
dim iSpace
iPos = 1
Do While InStr(iPos, sValue, " ", 1) <> 0
iSpace = InStr(iPos, sValue, " ", 1)
sTemp = sTemp & UCase(Mid(sValue, iPos, 1))
sTemp = sTemp & LCase(Mid(sValue, iPos + 1, iSpace - iPos))
iPos = iSpace + 1
Loop
sTemp = sTemp & UCase(Mid(sValue, iPos, 1))
sTemp = sTemp & LCase(Mid(sValue, iPos + 1))
Str2ProperCase = sTemp
End Function
function nullToBlankString(val)
if isnull(val) then
nullToBlankString = ""
else
nullToBlankString = val
end if
end function
function amIAWorker(personid, FAPconn)
dim statement
dim temprs
dim rv : rv = false
statement = "select * from FPHousehold where WorkerID = " & personid & " or SubsidyWorkerID = " & personid
set temprs = FAPconn.execute(statement)
if not temprs.eof then rv = true
temprs.close
amIAWorker = rv
end function
'pretty good email validation function
Function CheckEmailAddress(strAddress)
Dim i ' As Integer 'current character index
Dim intLen ' As Integer 'Address length
Dim strChar ' As String 'a single character from the string
Dim intPos ' As Integer 'Position of a character within a string
Dim blnPunc ' As Boolean 'Set to true when we find a punctuation mark
Dim intAtPos ' As Integer 'Postiton of the @ character
Dim intLastDotPos ' As Integer 'Position of last Dot Found in string
VALID_PUNC = "_-" 'Add any extra valid punctuation marks here if i forgot any!
AT_SYMBOL = "@"
DOT_SYMBOL = "."
UNDERSCORE_SYMBOL = "_" 'Not sure if we are allowed this after the @ symbol - anyone know??
' On Error GoTo errHandler 'Simple error handling
strAddress = trim(strAddress) 'Remove any whitespace characters
If isnull(strAddress) Then
Exit Function 'Zero length address - Bail out
End If
strAddress = LCase(strAddress) 'make address lowercase for comparison purposes
intLen = Len(strAddress) 'Save the length of the address for later use
'//// loop through each character
For i = 1 To intLen 'Loop for each character in the address
strChar = Mid(strAddress, i, 1) 'Take a character from the address
If (Not (strChar >= "a" AND strChar <= "z")) And (Not (strChar >= "0" AND strChar <= "9")) Then
'Not an alpha numeric character - check to see if it's punctuation
If InStr(1, VALID_PUNC & DOT_SYMBOL & AT_SYMBOL, strChar) > 0 Then
If blnPunc = True Then
'Second punctuation mark in succession - bail!
'Not allowed two punctuation characters in a row
Exit Function 'Bail out!
Else
blnPunc = True 'Set flag to true to show we've found punctuation
'//// Check the first and last char aren't punctuation
If i = 1 Or i = intLen Then
' Debug.Print "Not allowed punctuation as first or last character!: " & strChar
Exit Function 'Bail out!
End If
'//// Now lets look for the @ symbol - not allowed at begining or end,
'//// and must have at least one dot following it (Not directly)
If strChar = AT_SYMBOL Then
If intAtPos = 0 Then
intAtPos = i 'Save position of the '@' Character
Else
' Debug.Print "Not allowed two @ symbols!"
Exit Function 'Bail out!
End If
End If
If strChar = DOT_SYMBOL Then 'If its a dot character
intLastDotPos = i 'Save position of the last dot found
End If
'Add any extra punctuation checks here
'eg, not sure if allowed an underscore '_' after the '@' symbol anyone know??
'If strChar = UNDERSCORE_SYMBOL And intAtPos > 0 Then
' Debug.Print "Not allowed _ after @ symbol!"
' Exit Function 'Bail out!
'End If
End If
Else
' Debug.Print "BAD CHARACTER IN ADDRESS!: " & strChar
Exit Function 'Bail out!
End If
Else
blnPunc = False 'Reset the punctuation flag - we've got a character
End If
Next 'Repeat for next character
'//// There must be an @ in the address!
If intAtPos = 0 Or intLastDotPos = 0 Then
' Debug.Print "NO @ or . in address!"
Exit Function 'Bail out!
End If
'Check there is a Dot after the @
If intLastDotPos < intAtPos Then
' Debug.Print "NO DOT FOLLOWING THE @!"
Exit Function 'Bail out!
End If
'//// if we get here we've passes all the tests - its a good address!
CheckEmailAddress = True
End Function
function sendmail(host, toaddy, from, subject, body, html, attach, alt)
dim result
if isNull(from) OR len(from) < 1 then
sendmail = false
exit function
end if
if isNull(subject) OR len(subject) < 1 then
sendmail = false
exit function
end if
if isNull(body) OR len(body) < 1 then
sendmail = false
exit function
end if
if isNull(host) then
host = "ekumail.eku.edu"
end if
dim objSendMail
set objSendMail = CreateObject("Persits.MailSender")
objSendMail.Host = host
objSendMail.From = from
objSendMail.Subject = subject
objSendMail.Body = body
if isNull(html) then
objSendMail.IsHTML = false
else
objSendMail.IsHTML = true
if not isNull(alt) then
objSendMail.AltBody = alt
end if
end if
' objSendMail.ContentTransferEncoding = "quoted-printable"
objSendMail.AddAddress toaddy
' objSendMail.AddAddress "josh.reynolds@eku.edu"
' objSendMail.AddAddress "donna.turner@eku.edu"
objSendMail.AddBCC "josh.reynolds@eku.edu"
objSendMail.AddBCC "donna.turner@eku.edu"
if not isNull(attach) then
objSendMail.AddAttachment(attach)
end if
objSendMail.SendToQueue
' objSendMail.Send
result = true
set objSendMail = nothing
sendmail = result
end function
function getregionlist(personid, group, subgroup)
'returns string of comma separated regionIDs
dim statement
dim temprs
dim rv
dim first
rv = ""
statement = "select RegionID from WEBRegionPermissions where PersonID = " & personid & " AND PermGroup = '" & group & "' AND PermSubGroup = '" & subgroup & "'"
set temprs = conn.execute(statement)
first = true
do until temprs.eof
if first then first = false else rv = rv & ","
rv = rv & temprs("RegionID")
temprs.movenext
loop
temprs.close
set temprs = nothing
getregionlist = replace(rv, " ", "")
end function
function searcharray(atosearch, tofind)
dim rv
dim i
rv = -1
if isarray(atosearch) then
if ubound(atosearch) >= 0 then
for i=0 to ubound(atosearch)
if cstr(atosearch(i)) = cstr(tofind) then rv = i
next
end if
else
if atosearch = tofind then rv = i
end if
searcharray = rv
end function
function getvalfromdatabase(query, fieldname, dbconn)
'return an array
dim rv
dim temprs
dim first
dim mflag
rv = ""
' response.write "Cookie: " & request.cookies("PERSONID") & "
"
' response.write "Perms: " & request.cookies("FAPPERMS") & "
"
' response.end
'function sendmail(host, toaddy, from, subject, body, html, attach, alt)
' sendmail NULL, "josh.reynolds@eku.edu", "tris@eku.edu", "bad query", query, NULL, NULL, NULL
' response.end
set temprs = dbconn.execute(query)
first = true
if not temprs.eof then
do until temprs.eof
if first then
first = false
else
rv = rv & ","
end if
rv = rv & temprs(fieldname)
temprs.movenext
loop
end if
temprs.close
set temprs = nothing
if rv = "" then
rv = array()
else
rv = split(rv, ",")
end if
getvalfromdatabase = rv
end function
Function AddQuoteOrNULL(strInput)
If Not IsNull(strInput) Then
If Len(Trim(strInput)) = 0 Then
AddQuoteOrNULL = "NULL"
Else
AddQuoteOrNULL = "'" & Replace(Replace(Trim(strInput), "'", "''"), """", "''") & "'"
End If
Else
AddQuoteOrNULL = "NULL"
End If
End Function
Function FormatPhone(phone)
dim msg
if not isnull(phone) then
if (instr(phone,"(")>0) OR (instr(phone,"-")>0) OR (trim(phone) = "") then
msg = phone
else
msg = trim(phone)
msg = "(" & left(msg,3) & ") " & mid(msg,4,3) & "-" & right(msg,4)
end if
end if
FormatPhone = msg
end Function
function DisplayZip(zip)
zip = trim(zip)
if not isempty(zip) then
if len(zip) > 5 then
rv = mid(zip, 1, 5) & "-" & mid(zip, 6, 4)
else
rv = zip
end if
else
rv = ""
end if
DisplayZip = rv
end function
function CanIDo_old(UserPerm, TestPerm)
if (UserPerm AND all_perm) = all_perm then
rv = true
else
if (UserPerm AND TestPerm) = TestPerm then
rv = true
else
rv = false
end if
end if
CanIDo_old = rv
end function
function getPermString(personid)
dim statement
dim temprs
dim temprs2
dim strPermnames
dim aPermNames
dim objPermnames
dim first
dim i
dim rv
strPermnames = ""
set objPermnames = CreateObject("Scripting.Dictionary") 'stores "job" or "yes" or "no" keyed off the permname of perms the user has
'any permission can be denied by prepending an '-' to it
statement = "select TRPersonnel.JobClassCode, WEBPriviliges.Privs2 from TRPersonnel LEFT JOIN WEBPriviliges on TRPersonnel.JobClassCode = WEBPriviliges.JobClassCode where TRPersonnel.PersonID = " & personid
set temprs = conn.execute(statement)
objPermnames("fap_see") = "job" 'everybody can see the fap pages
objPermnames("fap_worker_view") = "job" 'everyone is considered a worker unless special/job permissions negate
objPermnames("fap_trworker_view") = "job"
if not temprs.eof then
'everyone needs to be able to see these reports
objPermnames("fap_view_approval") = "job"
objPermnames("fap_view_attendance") = "job"
objPermnames("fap_view_inquiry") = "job"
objPermnames("fap_view_labels") = "job"
objPermnames("fap_view_medically_fragile_homes") = "job"
objPermnames("fap_view_medically_fragile_attendance") = "job"
objPermnames("fap_view_family_treatment_homes") = "job"
objPermnames("fap_view_resource_homes_count") = "job"
objPermnames("fap_view_inq_numtype") = "job"
objPermnames("fap_view_TWIST_both_systems") = "job"
objPermnames("fap_view_credit") = "job"
objPermnames("fap_view_open_homes") = "job"
objPermnames("fap_view_activity") = "job"
objPermnames("fap_view_inquiry_status") = "job"
objPermnames("fap_view_length_of_time") = "job"
objPermnames("fap_view_race") = "job"
objPermnames("fap_view_closure_report") = "job"
' objPermnames("fap_view_inquiry_status") = "job"
' objPermnames("fap_view_openhomes") = "job"
' objPermnames("fap_view_family_treatment") = "job"
' objPermnames("fap_view_missing_worker") = "job"
'everyone needs to be able to submit the forms
objPermnames("fap_submit_informational") = "job"
objPermnames("fap_submit_intake") = "job"
objPermnames("fap_submit_training") = "job"
objPermnames("fap_submit_update") = "job"
objPermnames("fap_submit_verification") = "job"
objPermnames("fap_submit_withdrawl") = "job"
objPermnames("fap_view_rnc_supervisor") = "job"
end if
'process job class permissions first
'these are 'base' permissions, permissions denied cannot be overridden by later permissions
'but permissions granted can be denied by later permissions
if not temprs.eof then
if not isnull(temprs("Privs2")) then
strPermnames = temprs("Privs2")
strPermnames = replace(strPermnames, " ", "") 'no spaces
aPermnames = split(strPermnames, ",")
for i=0 to ubound(aPermnames)
' response.write aPermnames(i) & "
"
if left(aPermnames(i), 1) = "-" then 'if starts with a "-"
strpermname = right(aPermnames(i), len(aPermnames(i))-1)
objPermnames(trim(strpermname)) = "no"
else
if not objPermnames.Exists(trim(aPermnames(i))) then
objPermnames(trim(aPermnames(i))) = "job"
' response.write("setting " & aPermnames(i) & "
")
end if
end if
next
end if
end if
temprs.close
'RNC permissions, these aren't a real job class but there is an entry with RNC as the job class code
'in the WEBPriviliges table that gets pulled in if the person is in the FPRNC table
'these permissions can deny previously granted permissions but not grant previously denied ones
strPermnames = ""
statement = "select FPRNC.VendorID from FPRNC where PersonID_RNC1 = " & personid 'RNC permissions
set temprs = conn.execute(statement)
if not temprs.eof then 'they are an RNC
'not a real job class, but nowhere else to store these
statement = "select Privs2 from WEBPriviliges where JobClassCode = 'RNC'"
set temprs2 = conn.execute(statement)
if not temprs2.eof then
strPermnames = temprs2("Privs2")
strPermnames = replace(strPermnames, " ", "") 'no spaces
aPermnames = split(strPermnames, ",")
for i=0 to ubound(aPermnames)
if left(aPermnames(i), 1) = "-" then
strpermname = right(aPermnames(i), len(aPermnames(i))-1)
objPermnames(cstr(strpermname)) = "no"
' response.write("setting " & aPermnames(i) & "=no
")
else 'only grant if not denied or job previously
if not objPermnames.Exists(cstr(aPermnames(i))) then
objPermnames(cstr(aPermnames(i))) = "yes"
end if
end if
next
end if
temprs2.close
end if
temprs.close
strPermnames = ""
statement = "select SpecialPriv2 from WEBSpecial where PersonID = " & personid 'special permissions
' response.write statement & "
"
set temprs = conn.execute(statement)
if not temprs.eof then
if not isnull(temprs("SpecialPriv2")) then
' response.write temprs("SpecialPriv2") & "
"
strPermnames = temprs("SpecialPriv2")
strPermnames = replace(strPermnames, " ", "") 'no spaces
aPermnames = split(strPermnames, ",")
for i=0 to ubound(aPermnames)
' response.write aPermnames(i) & "
"
if left(aPermnames(i), 1) = "-" then
strpermname = right(aPermnames(i), len(aPermnames(i))-1)
objPermnames(cstr(strpermname)) = "no" 'set it in the dict object for the final step
' response.write("setting " & aPermnames(i) & "=no
")
else 'again, only grant if not previously denied or job, or granted
if not objPermnames.Exists(cstr(aPermnames(i))) then
objPermnames(cstr(aPermnames(i))) = "yes" 'set it in the dict object for the final step
' response.write("setting " & aPermnames(i) & "
")
end if
end if
response.write "" & vbcrlf
next
end if
end if
temprs.close
'for each nam in objPermnames
' response.write nam & " = " & objPermnames(nam) & "
"
'next
'response.end
statement = "select PermName, PermOffset from WEBPermissions where PermGroup = 'FAP' order by PermOffset" 'get all permissions
set temprs = conn.execute(statement)
if not temprs.eof then
do until temprs.eof
'if set from above, put a "1" at that spot in the string, else a "0"
if objPermnames(cstr(temprs("PermName"))) = "yes" then ' a special priv
'response.write("special perm for " & temprs("PermName") & "
")
rv = rv & "1"
elseif objPermnames(cstr(temprs("PermName"))) = "job" then ' a jobclass priv
'response.write("jobclass perm for " & temprs("PermName") & "
")
rv = rv & "2"
else
'response.write("denied perm for " & temprs("PermName") & "
")
rv = rv & "0"
end if
temprs.movenext
loop
end if
temprs.close
set temprs = nothing
' response.write "
" & rv & "
"
getPermString = rv
end function
function CanIDo(UserPerm, TestPerm)
'pass perm string and the name of the perm to check
dim statement
dim temprs
dim offset
dim rv
rv = "0"
if trim(UserPerm) <> "" AND trim(TestPerm) <> "" then
statement = "select PermOffset from WEBPermissions where PermName = '" & trim(TestPerm) & "'"
set temprs = conn.execute(statement)
if not temprs.eof then
offset = temprs("PermOffset")
rv = mid(UserPerm, offset, 1)
end if
temprs.close
set temprs = nothing
end if
CanIDo = rv
end function
function CanISee(regionid, personid, permgroup, subgroup)
'look in WEBRegionPermissions for a record indicating personid has access to this region
dim statement
dim temprs
dim rv
rv = false
if trim(regionid) <> "" AND trim(permgroup) <> "" AND trim(subgroup) <> "" AND trim(personid) <> "" then
statement = "select ID from WEBRegionPermissions where PermGroup = '" & trim(permgroup) & "' AND PermSubGroup = '" & subgroup & "' AND RegionID = '" & regionid & "' AND PersonID = " & personid
set temprs = conn.execute(statement)
if not temprs.eof then rv = true
temprs.close
set temprs = nothing
end if
CanISee = rv
end function
function GetPerms() 'no longer used
if not isnumeric(request.cookies("USERPERMS")) then
GetPerms = 0
else
GetPerms = Request.Cookies("USERPERMS")
end if
end function
function DisplayDate(dt)
dim temp
if not isnull(dt) AND not isempty(dt) then
temp = split(dt, "/")
if len(cstr(temp(0))) = 1 then temp(0) = "0" & temp(0)
if len(cstr(temp(1))) =1 then temp(1) = "0" & temp(1)
if len(cstr(temp(2)))=1 then temp(2)="0" & temp(1)
rv = temp(0) & "/" & temp(1) & "/" & temp(2)
else
rv = " "
end if
DisplayDate = rv
end function
function DisplayDecimal(val, num)
dim tempval
tempval = split(cstr(val), ".")
if ubound(tempval) = 0 then
rv = tempval(0) & "."
rv = rv & string(num, "0")
else
rv = tempval(0) & "." & tempval(1) & string(num-len(cstr(tempval(1))), "0")
end if
DisplayDecimal = rv
end function
function StripPhone(strPhone)
dim rv
dim tmp
rv=""
for i=1 to len(strPhone)
tmp = Mid(strPhone, i, 1)
if isnumeric(tmp) then
rv = rv & tmp
end if
next
StripPhone = rv
end function
const ors_calendar_view = 1 ' 2^0 - can user view ORS calendar?
const ors_modify_own = 2 ' 2^1 - can user modify own information?
const ors_modify_any = 4 ' 2^2 - can user modify any ors users information?
const ors_modify_region = 16777216 ' 2^24 - can user modify any ors users information in their region?
const ors_see = 134217728 ' 2^27 - can user see pages within the ORS section of the site?
const rtc_any_region_cal_mod = 16 ' 2^4 - can user modify any regions regional calendar?
const rtc_see_region_q = 32 ' 2^5 - can user see registration queue for their region?
const rtc_region_approve_deny = 128 ' 2^7 - can user approve and deny registrations for their region?
const rtc_approve_deny = 256 ' 2^8 - can user approve and deny registrations for any region?
const fap_see_tr = 64 ' 2^6 - can user see registration queues for all regions?
const rtc_edit_any_reg = 8192 ' 2^13 - can user edit registrations from any region?
const rtc_view_region_partlist = 16384 ' 2^14 - can user see participant lists for trainings in their region?
const rtc_view_partlist = 32768 ' 2^15 - can user see participant lists for trainings in any region?
const rtc_see = 33554432 ' 2^25 - can user can user see pages within the RTC section of the site?
const fap_view_approval = 536870912 ' 2^29 - can user view the approval report?
const fap_view_attendance = 512 ' 2^9 - can user view the attendance report?
const fap_view_inquiry = 1024 ' 2^10 - can user view the inquiry report?
const fap_view_labels = 2048 ' 2^11 - can user see labels report?
const fap_view_credit = 4096 ' 2^12 - can user view credit for learning report?
const fap_view_whole_region = 65536 ' 2^16 - can user view foster records for anyone in their region?
const fap_view_other_region = 131072 ' 2^17 - can user view foster records for only those people they are the worker for?
const fap_worker_view = 262144 ' 2^18 - can user view own record? don't know how much sense this one makes in FAP.
const fap_trview_whole_region = 32 ' 2^5 - can user see their whole region for training records?
const fap_trview_other_region = 8 ' 2^3 - can user view other regions training records?
const fap_trworker_view = 8192 ' 2^13 - can user edit registrations from any region?
const fap_submit_verification = 524288 ' 2^19 - can user use the verification form?
const fap_submit_informational = 1048576 ' 2^20 - can user use the information form?
const fap_submit_intake = 2097152 ' 2^21 - can user use the intake form?
const fap_submit_withdrawl = 4194304 ' 2^22 - can user use the withdrawal form?
const fap_submit_update = 8388608 ' 2^23 - can user use the update form?
const fap_submit_training = 1073741824 ' 2^30 - can use submit the training form?
const fap_see = 268435456 ' 2^28 - can user see pages within the FAP section of the site?
const all_perm = 67108864 ' 2^26 - can user do anything?
dim everyone_priv
everyone_priv = clng((fap_trworker_view OR fap_see OR fap_submit_update OR fap_submit_verification OR fap_submit_informational OR fap_submit_intake OR fap_submit_withdrawl OR fap_submit_training OR fap_view_approval OR fap_view_attendance OR fap_view_inquiry OR fap_view_credit))
%>
My Info
 |
|
|
 |
Coming Soon!! |
|
