Forums
This topic is locked
Type mismatch 'Cint' Runtime error....
Posted 28 Feb 2006 13:38:39
1
has voted
28 Feb 2006 13:38:39 Stephen Miller posted:
I'd really appreciate some help with this.The error occurs on submitting a new record. I checked to see the variable 'record' is numeric and it is, here is the code in question:
record = 0 + cInt(Request.QueryString("rec")
Any ideas?
Thanks
Stephen
Replies
Replied 23 Mar 2006 01:50:00
23 Mar 2006 01:50:00 micah santos replied:
there's nothing wrong with the code...
though... what are you really trying to do with that code?
though... what are you really trying to do with that code?
Replied 23 Mar 2006 20:01:11
23 Mar 2006 20:01:11 John Shipp replied:
if request.querystring("rec" is not numeric (even if the variable 'record' is declared as numeric), you will get an error... try this:
<pre id=code><font face=courier size=2 id=code>
if isNumeric(request.querystring("rec") = "True" then
record = cint(request.querystring("rec")
else
' do error handle here
end if
</font id=code></pre id=code>
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
I'd really appreciate some help with this.
The error occurs on submitting a new record. I checked to see the variable 'record' is numeric and it is, here is the code in question:
record = 0 + cInt(Request.QueryString("rec")
Any ideas?
Thanks
Stephen
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
<pre id=code><font face=courier size=2 id=code>
if isNumeric(request.querystring("rec") = "True" then
record = cint(request.querystring("rec")
else
' do error handle here
end if
</font id=code></pre id=code>
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
I'd really appreciate some help with this.
The error occurs on submitting a new record. I checked to see the variable 'record' is numeric and it is, here is the code in question:
record = 0 + cInt(Request.QueryString("rec")
Any ideas?
Thanks
Stephen
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
Replied 06 Apr 2006 14:09:58
06 Apr 2006 14:09:58 Stephen Miller replied:
Its when the record is logged/submitted when the error happens. Everything is numeric...... here's all the code..
<%@LANGUAGE="VBSCRIPT"%>
<% Response.Expires = 0%>
<html><head>
<meta full_name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta full_name="ProgId" content="FrontPage.Editor.Document">
<title>Replies Log</title>
<style>
<!--
.caption { font-family:Tahoma; font-size:12; color:#333399; text-align:Left; font-weight:bold;
margin-top:0; margin-bottom:5 }
.prompt { font-family:Tahoma; font-size:11; color:#333399; text-align:Left; font-weight:bold;
margin-top:0; margin-bottom:5 }
.note { font-family:Tahoma; font-size:9; color:#000080; text-align:Left;
margin-top:20; margin-bottom:0 }
TextArea { font-family:Tahoma; font-size:10pt; color:#333399; height:17; padding-left:5; padding-right:4 }
Select { font-family:Tahoma; font-size:10pt; color:#333399; height:17; padding-left:5; padding-right:4 }
body { font-family:Tahoma; font-size:10pt; height:17 }
-->
</style>
<base target="_self">
</head>
<body topmargin=0 leftmargin=10 bgcolor="#FFFFFF" link="#FF0066" vlink="#FF0066" alink="#FF0066">
<!--#include file="../Shared_Code/Sum.txt"-->
<!--#include file="../Shared_Code/LeapYear.txt"-->
<!--#include file="../Shared_Code/GetNumber.txt"-->
<!--#include file="../CorpGovNHS/SABS/Notices_ReadWrite.txt"-->
<!--#include file="../CorpGovNHS/SABS/Log_Email.txt"-->
<%
Dim replies, repsToDate, noReplies, current, reminders
Dim cr_lf
cr_lf = Chr(13) & Chr(10)
Sub DisplayNavigation
Response.Write "<Span style='font-family:Arial; font-size:11pt; font-weight:bold; overflow:visible; position: absolute; top:10; " & _
"left:6; width:310'>HAZARD NOTICES REPLIES LOG</Span>"
Response.Write "<Span style='overflow:visible; position:absolute; left:270; top:11; width:120; height:16'><b>" & _
"<a href='Emails_log.asp?rec=" & record &"' style='text-decoration:none' target='contents'>(Email Log)" & _
"</a></b></Span>"
Response.Write "<Input type='button' value='View Replies' name='B8' style='font-family:Tahoma; font-size:10pt; " & _
"background-color:#cccccc; color:#333399; position:absolute; top:8; left:348; width:90; height:23'>"
Response.Write "<Input type='button' value='|<<' name='B1' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:442; width:33'>"
Response.Write "<Input type='button' value='<<' name='B2' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:477; width:33'>"
Response.Write "<Input type='button' value='>>' name='B3' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:512; width:33'>"
Response.Write "<Input type='button' value='>>|' name='B4' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:547; width:33'>"
Response.Write "<Span style='overflow:visible; position:absolute; top:43; left:6; width:74'>Record No.</Span>"
Response.Write "<TextArea style='overflow:visible; position:absolute; top:40; left:80; height:23; width:41; " & _
"background-color:#cccccc'>" & record & "</TextArea>"
Response.Write "<Span style='overflow:visible; position:absolute; top:43; left:127; width:50'> out of </Span>"
Response.Write "<TextArea style='overflow:visible; position:absolute; top:40; left:166; height:23; width:41; " & _
"background-color:#cccccc'>" & maximum & "</TextArea>"
Response.Write "<Input type='button' value='Find Record' name='B5' style='font-family:Tahoma; font-size:10pt; " & _
"background-color:#cccccc; color:#333399; heigth:23; position:absolute; top:41; left:225; width:80'>"
Response.Write "<Input name=nextrec style='overflow:hidden; position:absolute; height:23; padding-left:4; top:41; left:306; " & _
"width:45' size='20'>"
Response.Write "<Input type='button' value='Find Reference' name='B6' style='font-family:Tahoma; font-size:10pt; " & _
"background-color:#cccccc; color:#333399; heigth:23; position:absolute; top:41; left:355; width:100'>"
Response.Write "<Input name=nextref style='overflow:hidden; position:absolute; height:23; padding-left:4; top:41; left:456; " & _
"width:124' size='20'>"
Response.Write "<Input name=lastrec style='font-family:Tahoma; font-size:9; background-color:#cccccc; color:#cccccc; " & _
"position:absolute; top:100; left:100; width:50' size='20'>"
Response.Write "<Input name=maxrec style='font-family:Tahoma; font-size:9; background-color:#cccccc; color:#cccccc; " & _
"position:absolute; top:100; left:150; width:50' size='20'>" & Chr(13) & Chr(10)
End Sub 'DisplayNavigation
Sub SendReminder (distRec, noteRec)
Dim objMail, text
Set records = DBconnect.Execute("SELECT FullName, Email FROM DistributionList WHERE Record = " & distRec & ";"
text = "Dear " & records("FullName" & "," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(9) & Chr(9) & Chr(9) & _
"this is to remind you that a Hazard Notice has been posted: " & Chr(13) & Chr(10) & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Title:" & Chr(9) & title & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Reference:" & Chr(9) & noticeRef & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Agency:" & Chr(9) & noticeFrom & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Category:" & Chr(9) & noticeType & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Action:" & Chr(9) & noticeFor & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Device:" & Chr(9) & device & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Problem:" & Chr(9) & problem & Chr(13) & Chr(10) & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & "This notice was posted at " & Right(notifiedOn,8) & " on " & Left(notifiedOn,8) & ", by " & _
notifiedBy & ". Replies were expected by " & respDate & "." & Chr(13) & Chr(10)& Chr(13) & Chr(10)
If ((location & "" <> "" Then
text = text & "Please click on the link below to view the full text:" & Chr(13) & Chr(10) & Chr(13) & Chr(9) & Chr(9) & Chr(9) & _
"mewsweb/sabs/CorpGovNHS/" & folderName & location & Chr(13) & Chr(10) & Chr(13) & Chr(10)& Chr(13) & Chr(10)
Else
text = text & Chr(13) & Chr(10)
End If
text = text & "If you wish, click on the link below to view the circulation list for the original notification:" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(9) & Chr(9) & _
"mewsweb/sabs/CorpGovNHS/SABS/Circulation.asp?rec=" & noteRec & Chr(13) & Chr(10) & Chr(13) & Chr(10)& Chr(13) & Chr(10)
text = text & "We would appreciate a response from your department as soon as possible." & Chr(13) & Chr(10)
text = text & "When you are ready to reply, please click on the link below to access the Online Reply Form:" & Chr(13) & _
Chr(10) & Chr(13) & Chr(9) & Chr(9) & Chr(9) & "mewsweb/sabs/CorpGovNHS/SABS/Reply.asp?flg=0&dis=" & _
distRec & "&rep=0&rec=" & record & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & Chr(10)
text = text & "Yours sincerely," & Chr(13) & Chr(10) & Chr(9) & Chr(9) & Chr(9) & "Mr John Mitchell" & Chr(13) & Chr(10) & Chr(13) & _
Chr(10) & Chr(13) & Chr(10) & "Health & Safety Manager," & Chr(13) & Chr(10) & _
"South of Tyne & Wearside Hospitals," & Chr(13) & Chr(10) & _
"Cherry Knowle Hospital, Ryhope, Sunderland SR2 0NB" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Telephone" & Chr(9) & "0191 5656256" & _
Chr(13) & Chr(10) & "Email" & Chr(9) & Chr(9) & " "
Set objMail = CreateObject("CDONTS.NewMail"
objMail.From = " "
objMail.To = records("Email"
objMail.Subject = "Hazard Notice (ref. " & noticeRef & " - REMINDER"
objMail.Body = text
objMail.Send
Set ObjMail = Nothing
Set records = Nothing
End Sub 'SendReminder
Sub SendReminders (reminders)
Dim nextRec, i, x
nextRec = ""
For i = 1 To Len(reminders)
x = Mid(reminders,i,1)
If (x <> Chr(44)) Then
nextRec = nextRec & x
Else
SendReminder nextRec, record
LogEmail record, respDate, nextRec, 0
nextRec = ""
End If
Next
Dim sueCoulson
sueCoulson = 12
SendReminder sueCoulson, record
update = "UPDATE Notices SET LastReminder = '" & Date & "', WriteName = '" & Request.ServerVariables("LOGON_USER" & "', WriteTime = '" & Now & "' WHERE Record =" & record & ";"
DBconnect.Execute(update)
End Sub 'SendReminders
Sub WriteDisplayHTML
Response.Write "<TextArea name='rec' style='overflow:hidden; position:absolute; left:105; top:73; height:10; width:10'>" & rec & _
"</TextArea>" & cr_lf
Response.Write "<TextArea name='max' style='overflow:hidden; position:absolute; left:110; top:73; height:10; width:10'>" & max & _
"</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:75; width:70'>Title</Span>" & cr_lf
Response.Write "<TextArea style='overflow:visible; position:absolute; left:80; top:72; width:500; height:58; background-color: " & _
"#cccccc'>" & title & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:134; width:70'>Agency</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:131; width:260; height:23; background-color: " & _
"#cccccc'>" & noticeFrom & "</TextArea>" & cr_lf
Response.Write "<Span style='overflow:visible; position:absolute; left:360; top:134; width:90'>Category</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:420; top:131; width:160; height:23; background-color: " & _
"#cccccc'>" & noticeType & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:158; width:75'>Reference</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:155; width:150; height:23; background-color: " & _
"#cccccc'>" & noticeRef & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:254; top:158; width:60'>Year</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:290; top:155; width:50; height:23; background-color: " & _
"#cccccc'>" & noticeYear & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:375; top:158; width:60'>Action</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:420; top:155; width:160; height:23; background-color: " & _
"#cccccc'>" & noticeFor & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:182; width:70'>Notified By</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:179; width:150; height:23; background-color: " & _
"#cccccc'>" & notifiedBy & "</TextArea>" & cr_lf
Response.Write "<Span style='overflow:visible; position:absolute; left:245; top:182; width:90'>At</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:270; top:179; width:125; height:23; background-color: " & _
"#cccccc'>" & notifiedOn & "</TextArea>" & cr_lf
Response.Write "<Span style='overflow:visible; position:absolute; left:430; top:182; width:90'>Response by</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:510; top:179; width:70; height:23; background-color: " & _
"#cccccc'>" & respDate & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:206; width:70'>/Folder/File</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:203; width:140; height:23; background-color: " & _
"#cccccc'>" & folderName & "</TextArea>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:220; top:203; width:210; height:23; background-color: " & _
"#cccccc'>" & location & "</TextArea>" & cr_lf
If (lastReminder <> "" ) Then
Response.Write "<Span style='overflow:visible; position:absolute; left:440; top:206; width:130'>Reminders</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:510; top:203; width:70; height:23; background-color: " & _
"#cccccc'>" & lastReminder & "</TextArea>" & cr_lf
Else
Response.Write "<Span style='overflow:visible; position:absolute; left:440; top:206; width:130'>Completed</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:510; top:203; width:70; height:23; background-color: " & _
"#cccccc'>" & compDate & "</TextArea>" & cr_lf
End If
End Sub 'WriteDisplayHTML
Function MakeOption (dy, mn, yr, name)
If (dy < 10) Then
MakeOption = "0" & dy & "/"
Else
MakeOption = dy & "/"
End If
If (mn < 10) Then
MakeOption = MakeOption & "0" & mn & "/"
Else
MakeOption = MakeOption & mn & "/"
End If
If (yr < 10) Then
MakeOption = MakeOption & "0" & yr & ", " & name
Else
MakeOption = MakeOption & yr & ", " & name
End If
End Function
Sub ReplyReceived (dateStr)
Dim dy_no, mn_no, yr_no, months(13), days(7), opt_str, d, i, list, options(100), opt_ind
days(0) = "Monday"
days(1) = "Tuesday"
days(2) = "Wednesday"
days(3) = "Thursday"
days(4) = "Friday"
days(5) = "Saturday"
days(6) = "Sunday"
mn_no = Month(dateStr)
If (Len(dateStr) = 8) Then
yr_no = Sum(Mid(dateStr,7,2))
ElseIf (Len(dateStr) = 10) Then
yr_no = Sum(Right(dateStr,2))
End If
dy_no = 1
mn_no = mn_no - 2
If (mn_no < 1) Then
If (mn_no = 0) Then mn_no = 12
If (mn_no < 0) Then mn_no = 11
yr_no = yr_no - 1
End If
months(1) = 31
months(2) = 28 + LeapYear(yr_no)
months(3) = 31
months(4) = 30
months(5) = 31
months(6) = 30
months(7) = 31
months(8) = 31
months(9) = 30
months(10) = 31
months(11) = 30
months(12) = 31
list = Sum(Left(dateStr,2))
list = list + months (mn_no)
If (mn_no <> 12) Then
list = list + months(mn_no + 1)
Else
list = list + months(1)
End If
d = dy_no + (365 * (yr_no - 2))
If (yr_no - 2 > 2) Then d = d + 1
If (yr_no - 2 > 6) Then d = d + 1
If (yr_no - 2 > 10) Then d = d + 1
For i = 1 To (mn_no - 1)
d = d + months(i)
Next
d = d - (7 * Int(d / 7))
opt_ind = 1
For i = 1 To list
opt_str = MakeOption (dy_no, mn_no, yr_no, days(d))
options(opt_ind) = "<Option value=" & chr(34) & opt_str & chr(34) & ">" & opt_str & "</Option>"
opt_ind = opt_ind + 1
dy_no = dy_no + 1
If (dy_no > months(mn_no)) Then
dy_no = 1
mn_no = mn_no + 1
If (mn_no > 12) Then
mn_no = 1
yr_no = yr_no + 1
months(2)= 28 + LeapYear(yr_no)
End If
End If
d = d + 1
If (d > 6) Then d = 0
Next
opt_ind = list
Response.Write "<td width=150 height=200><Select name='DateReceived' size=10 style='overflow:hidden; width:150; height:200' " & _
"onClick='GetDate(DateReceived.value)'>" & cr_lf
For i = 1 To (list)
Response.Write options(opt_ind)
opt_ind = opt_ind - 1
Next
Response.Write "</Select></td>" & cr_lf
End Sub 'ReplyReceived
Function Overdue
Overdue = 0
If (respDate <> "" And (Len(respDate) = 8) Then If (DateValue(respDate) < Date) Then Overdue = -1
End Function 'Overdue
Sub DisplayDistribution (record)
Dim respond(100), replies(100), txt_col(100), colour, i, j, res_no, rep_no, x, nxt_nme
If OverDue Then
colour = "#FF0066"
Else
colour = "#333399"
End If
For i = 0 To 99
respond(i) = ""
replies(i) = ""
txt_col(i) = colour
Next
Response.Write "<tr><td width=190 height=246 valign=top style='background-color: #FFFFFF'>"
res_no = 0
If ((responsesSought & "" <> "" Then
nxt_nme = ""
If ((repliesReceived & "" <> "" Then
For i = 1 To Len(repliesReceived)
x = Mid(repliesReceived,i,1)
If (x <> Chr(44)) Then
nxt_nme = nxt_nme & x
Else
replies(rep_no) = Sum(nxt_nme)
rep_no = rep_no + 1
nxt_nme = ""
End If
Next
End If
For i = 1 To Len(responsesSought)
x = Mid(responsesSought,i,1)
If (x <> Chr(44)) Then
nxt_nme = nxt_nme & x
Else
respond(res_no) = Sum(nxt_nme)
For j = 0 To (rep_no - 1)
If (replies(j) = respond(res_no)) Then
txt_col(res_no) = "#333399"
Exit For
End If
Next
res_no = res_no + 1
nxt_nme = ""
End If
Next
Set records = Nothing
Response.Write "<Select name='Selected' size=10 style='width:190; height:246' onClick='SelectName(Selected.value)'>"
For i = 0 To (res_no - 1)
Set records = DBconnect.Execute("SELECT FullName, Email FROM DistributionList WHERE Record = " & respond(i) & ";"
Response.Write "<Option value='" & records("FullName" & "' style='color:" & txt_col(i) & "'>" & records("FullName" & _
"</option>" & cr_lf
Set records = Nothing
If txt_col(i) = "#FF0066" Then reminders = reminders & respond(i) & Chr(44)
Next
Response.Write "</Select>" & cr_lf
Else
Response.Write "<TextArea style='overflow:hidden; width:190; height:245'>No respondents are listed</TextArea>" & cr_lf
noReplies = -1
End If
Response.Write "</td></tr>" & cr_lf
End Sub 'DisplayDistribution
Sub WriteSelectHTML
Response.Write "<Table border=0 cellpadding=0 cellspacing=0 width=580 style='position:absolute; left:10; top:230'><tr>" & _
"<td colspan=5 height=10>"
Response.Write "<Input name=logData style='visibility:hidden; height:3; width:5'>"
Response.Write "<Input name=noteRec style='visibility:hidden; height:3; width:5'>"
Response.Write "<Input name=maxiRec style='visibility:hidden; height:3; width:5'>"
Response.Write "</td></tr>" & cr_lf
Response.Write "<tr><td><Table border=0 width=190 height=246 cellspacing=0 cellpadding=0 style='margin-left:0'>"
Response.Write "<tr><td width=190 align=left><p class=prompt>Click name to select respondent</p></td></tr>" & Chr(13) & Chr(10)
DisplayDistribution (record)
Response.Write "</table></td>" & cr_lf
Response.Write "<td><Table border=0 width=210 height=246 cellspacing=0 cellpadding=0 style='margin-top:0; margin-bottom:0; " & _
"margin-left:0'>"
Response.Write "<tr><td width=210 align=left><p class=prompt>Respondents so far:</p></td></tr><tr><td width=210 height=246>"
If Not noReplies Then
Response.Write "<TextArea type=text id='respondents' style='width:210; height:246'></TextArea>"
Else
Response.Write "<TextArea type=text style='overflow:hidden; width:210; height:246'></TextArea>"
End If
Response.Write "</td></tr></table></td>" & cr_lf
Response.Write "<td valign=top><Table border=0 width=150 height=246 cellspacing=0 cellpadding=0 style='margin-top:0; " & _
"margin-bottom:0; margin-left:0'>"
Response.Write "<tr><td><p class=prompt>Click date reply received</p></td></tr><tr>" & cr_lf
If current And (Not noReplies) Then
ReplyReceived (Date)
Else
Response.Write "<td width=150 height=200><TextArea style='overflow:hidden; width:150; height:200'></TextArea></td>"
End If
Response.Write "</tr>"
Response.Write "<tr><td height=23 align=right valign=bottom>"
If (reminders <> "" Then Response.Write "<Input type='button' value='SEND REMINDER' name='Reminders' style='width:147; " & _
"height:23; color:#FF0066; font-weight:bold'>"
Response.Write "</td></tr>"
Response.Write "<tr><td height=23 align=right valign=bottom>"
If current Then
Response.Write "<Input type='submit' value='LOG RESPONSE' style='width:147; height:23; color:#333399; font-weight:bold'>"
Else
Response.Write "<p class=prompt>Correspondence Complete</p>"
End If
Response.Write "</td></tr></table>" & Chr(13) & Chr(10)
Response.Write "</td></tr></table>" & Chr(13) & Chr(10)
End Sub 'WriteSelectHTML
Sub LogItem (item)
Dim items, nextItem, itemName, itemDate
itemDate = Mid(item, (len(item)-8), 8)
itemName = Left(item, (len(item)-12))
Set items = Server.CreateObject("ADODB.RecordSet"
items.Open "RepliesLog", DBconnect, 1, 3
If items.EOF Then
nextItem = 1
Else
items.MoveLast
nextItem = items("Record" + 1
End If
items.AddNew
items("Record" = nextItem
items("NoticeRec" = record
items("Respondent" = itemName
items("ReplyDate" = itemDate
items("WriteName" = Request.ServerVariables("LOGON_USER"
items("WriteTime" = Now
items.Update
items.Requery
items.Close
Set items = Nothing
End Sub 'LogItem
Sub LogItems (strng)
Dim i, x, item
record = Sum(Request.QueryString("noteRec")
maximum = Sum(Request.QueryString("maxiRec")
item = ""
For i = 1 To Len(strng)
x = Mid(strng,i,1)
If (x <> Chr(59)) Then
item = item & x
Else
If ((Left(item,1) <> Chr(42)) And (Right(item,1) = Chr(93))) Then LogItem item
item = ""
End If
Next
End Sub 'LogItems
Function GetReplies (record)
GetReplies = ""
Set records = DBconnect.Execute("SELECT Respondent, ReplyDate FROM RepliesLog WHERE NoticeRec = " & record & " AND DistribRec <> 0 ORDER BY Record DESC;"
Do Until records.EOF
GetReplies = GetReplies & Chr(42) & records("Respondent" & " " & "[" & records("ReplyDate" & "];"
records.MoveNext
Loop
Set records = Nothing
End Function 'GetReplies
'--------------------------------------------------------------------------------------------------------
refer = Trim("" & Request.QueryString("ref")
record = 0 + cInt(Request.QueryString("rec")
maximum = 0 + cInt(Request.QueryString("max")
replies = Trim("" & Request.QueryString("logData")
reminders = Trim("" & Request.QueryString("rem")
If (replies <> "" Then LogItems (replies)
If (refer <> "" Then record = GetRecNumber ("Notices", "NoticeRef", refer)
If (maximum = 0) Then maximum = GetNumber("Notices"
If (record > maximum) Then record = maximum
repsToDate = GetReplies (record)
GetNotice record
'# OUT FOR DEBUG
If (reminders <> "" Then SendReminders (reminders)
'# IN FOR DEBUG If (reminders <> "" Then SendReminder 27, record
reminders = ""
If (comp_date = "" Then
current = -1
Else
current = 0
End If
Response.Write "<Div style='background-color:#cccccc; border-bottom-color:#cccccc; border-left-color:#cccccc; " & _
"border-right-color:#cccccc; border-top-color:#cccccc; color:#333399; font-size:10pt; position:relative; height:520; width:590'>"
DisplayNavigation
Response.Write "<Form name='Log_Form' action='Replies_Log.asp' method='get'>"
WriteDisplayHTML
WriteSelectHTML
Response.Write "</Form>"
Response.Write "</Div>" & Chr(13) & Chr(10)
DBconnect.Close
%>
<SCRIPT LANGUAGE=VBS>
Dim names(500), nameIndex, dateFlag
Sub ShowData (data)
msgbox ("[" & data & "]"
End Sub
If Not <% =noReplies %> Then
MakeNames (<% =(Chr(34) & repsToDate & Chr(34)) %><img src=../images/dmxzone/forum/icon_smile_wink.gif border=0 align=middle>
window.document.Log_Form.noteRec.value = (<% =(Chr(34) & record & Chr(34)) %><img src=../images/dmxzone/forum/icon_smile_wink.gif border=0 align=middle>
window.document.Log_Form.maxiRec.value = (<% =(Chr(34) & maximum & Chr(34)) %><img src=../images/dmxzone/forum/icon_smile_wink.gif border=0 align=middle>
window.document.Log_Form.logData.value = MakeNameStr (names)
window.document.Log_Form.respondents.value = MakeNameView (names)
End If
lastrec.value = <% =record %>
maxrec.value = <% =maximum %>
dateFlag = 0
Sub MakeNames (strng)
Dim i, x
nameIndex = 0
If strng = "" Then
For i = 0 To 499
names(i) = ""
Next
Else
names(nameIndex) = ""
For i = 1 to Len(strng)
x = Mid(strng,i,1)
If (x <> ";" Then
names(nameIndex) = names(nameIndex) & x
Else
nameIndex = nameIndex + 1
names(nameIndex) = ""
End If
Next
For i = (nameIndex + 1) To 499
names(i) = ""
Next
End If
End Sub 'MakeNames
Function AddToList (name, nameIndex)
Dim t, j, match
j = 0
For t = 0 To nameIndex
match = names(t)
If (Left(match,Len(name)) = name) Then
For j = t To (nameIndex + 1)
names(j) = names(j+1)
Next
t = nameIndex
If dateFlag Then dateFlag = 0
End If
Next
AddToList = j
End Function 'AddToList
Sub SelectName (name)
If name & "" <> "" Then
MakeNames (window.document.Log_Form.logData.value)
If (nameIndex = 0) Or (AddToList(name, nameIndex) = 0) Then
If Not dateFlag Then
names(nameIndex) = name
nameIndex = nameIndex + 1
dateFlag = -1
Else
msgbox ("you must record a date for your last selected respondent"
End If
Else
nameIndex = nameIndex - 1
End If
window.document.Log_Form.respondents.value = MakeNameView (names)
window.document.Log_Form.logData.value = MakeNameStr (names)
End If
End Sub 'SelectName
Function MakeNameView (names)
Dim i, name
MakeNameView = ""
For i = 0 To (nameIndex - 1)
If (Left(names(i),1) <> "*" Then
MakeNameView = MakeNameView & names(i) & Chr(13) & Chr(10)
Else
name = names(i)
name = Right(name, (Len(name) - 1))
MakeNameView = MakeNameView & name & Chr(13) & Chr(10)
End If
Next
End Function
Function MakeNameStr (names)
Dim strng, i, c
strng = ""
For i = 0 To (nameIndex - 1)
strng = strng & names(i) & Chr(59)
Next
For i = 1 To Len(strng)
c = Mid(strng,i,1)
MakeNameStr = MakeNameStr & c
Next
End Function
Sub GetDate (dateStr)
If dateFlag Then
names(nameIndex - 1) = names(nameIndex - 1) & " [" & Left(dateStr,8) & "]"
window.document.Log_Form.respondents.value = MakeNameView (names)
window.document.Log_Form.logData.value = MakeNameStr (names)
dateFlag = 0
Else
msgbox ("you must first select a respondent"
End If
End Sub
Sub MakeLink(nr, mr)
pagelink = "Replies_Log.asp?rec=" & nr & "&max=" & mr
window.navigate(pagelink)
End Sub
Function CheckString(strng)
Dim i, c
If strng = "0" Then
CheckString = "False"
Else
CheckString = "True"
For i = 1 to Len(strng)
c = Mid(strng, i, 1)
If ((c < chr(48)) Or (c > chr(57))) Then
CheckString = "False"
Exit For
End If
Next
End If
End Function
Sub Reminders_OnClick
'msg = "REMINDERS: [" & <% =(Chr(34) & reminders & Chr(34)) %> & "]"
'msgbox (msg)
pagelink = "Replies_Log.asp?rem=" & <% =(Chr(34) & reminders & Chr(34)) %> & "&rec=" & lastrec.value & "&max=" & maxrec.value
window.navigate(pagelink)
End Sub ' trigger email of reminders
Sub B1_OnClick
lastrec.value = 1
MakeLink lastrec.value, maxrec.value
End Sub ' first record
Sub B2_OnClick
lastrec.value = lastrec.value - 1
If (lastrec.value < 1) Then
lastrec.value = maxrec.value
End If
MakeLink lastrec.value, maxrec.value
End Sub ' previous record
Sub B3_OnClick
lastrec.value = lastrec.value + 1
If (cInt(lastrec.value) > cInt(maxrec.value)) Then
lastrec.value = 1
End If
MakeLink lastrec.value, maxrec.value
End Sub ' next record
Sub B4_OnClick
lastrec.value = maxrec.value
MakeLink lastrec.value, maxrec.value
End Sub ' last record
Sub B5_OnClick
If (CheckString (nextrec.value) = "True" Then
If (cInt(nextrec.value) > cInt(maxrec.value)) Then
nextrec.value = 1
End If
MakeLink nextrec.value, maxrec.value
Else
nextrec.value = "error"
End If
End Sub ' find selected record
Sub B6_OnClick
pagelink = "Replies_Log.asp?ref=" & nextref.value & "&max=" & maxrec.value
window.navigate(pagelink)
End Sub ' find selected reference
Sub B8_OnClick
pagelink = "View_Replies.asp?rec=" & lastrec.value
window.navigate(pagelink)
End Sub ' view Replies
</SCRIPT>
<p class="note">Copyright © 2003-4 Sheffield Teaching Hospitals NHS Trust. All rights reserved --- Revised:
<!--webbot bot="Timestamp" s-type="EDITED" s-format="%A %B %d, %Y %H:%M" startspan -->Saturday April 30, 2005 14:37<!--webbot bot="Timestamp" i-checksum="55760" endspan --> (GP)</p>
<span style="visibility:hidden"><b>
<font face="Arial Black" size="1" color="#FF0000">DO NOT MODIFY THIS PAGE </font>
</b></span>
</body>
</htm>
<%@LANGUAGE="VBSCRIPT"%>
<% Response.Expires = 0%>
<html><head>
<meta full_name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta full_name="ProgId" content="FrontPage.Editor.Document">
<title>Replies Log</title>
<style>
<!--
.caption { font-family:Tahoma; font-size:12; color:#333399; text-align:Left; font-weight:bold;
margin-top:0; margin-bottom:5 }
.prompt { font-family:Tahoma; font-size:11; color:#333399; text-align:Left; font-weight:bold;
margin-top:0; margin-bottom:5 }
.note { font-family:Tahoma; font-size:9; color:#000080; text-align:Left;
margin-top:20; margin-bottom:0 }
TextArea { font-family:Tahoma; font-size:10pt; color:#333399; height:17; padding-left:5; padding-right:4 }
Select { font-family:Tahoma; font-size:10pt; color:#333399; height:17; padding-left:5; padding-right:4 }
body { font-family:Tahoma; font-size:10pt; height:17 }
-->
</style>
<base target="_self">
</head>
<body topmargin=0 leftmargin=10 bgcolor="#FFFFFF" link="#FF0066" vlink="#FF0066" alink="#FF0066">
<!--#include file="../Shared_Code/Sum.txt"-->
<!--#include file="../Shared_Code/LeapYear.txt"-->
<!--#include file="../Shared_Code/GetNumber.txt"-->
<!--#include file="../CorpGovNHS/SABS/Notices_ReadWrite.txt"-->
<!--#include file="../CorpGovNHS/SABS/Log_Email.txt"-->
<%
Dim replies, repsToDate, noReplies, current, reminders
Dim cr_lf
cr_lf = Chr(13) & Chr(10)
Sub DisplayNavigation
Response.Write "<Span style='font-family:Arial; font-size:11pt; font-weight:bold; overflow:visible; position: absolute; top:10; " & _
"left:6; width:310'>HAZARD NOTICES REPLIES LOG</Span>"
Response.Write "<Span style='overflow:visible; position:absolute; left:270; top:11; width:120; height:16'><b>" & _
"<a href='Emails_log.asp?rec=" & record &"' style='text-decoration:none' target='contents'>(Email Log)" & _
"</a></b></Span>"
Response.Write "<Input type='button' value='View Replies' name='B8' style='font-family:Tahoma; font-size:10pt; " & _
"background-color:#cccccc; color:#333399; position:absolute; top:8; left:348; width:90; height:23'>"
Response.Write "<Input type='button' value='|<<' name='B1' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:442; width:33'>"
Response.Write "<Input type='button' value='<<' name='B2' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:477; width:33'>"
Response.Write "<Input type='button' value='>>' name='B3' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:512; width:33'>"
Response.Write "<Input type='button' value='>>|' name='B4' style='font-family:Tahoma; font-size:10pt; background-color:#cccccc; " & _
"color:#333399; height:23; position:absolute; top:8; left:547; width:33'>"
Response.Write "<Span style='overflow:visible; position:absolute; top:43; left:6; width:74'>Record No.</Span>"
Response.Write "<TextArea style='overflow:visible; position:absolute; top:40; left:80; height:23; width:41; " & _
"background-color:#cccccc'>" & record & "</TextArea>"
Response.Write "<Span style='overflow:visible; position:absolute; top:43; left:127; width:50'> out of </Span>"
Response.Write "<TextArea style='overflow:visible; position:absolute; top:40; left:166; height:23; width:41; " & _
"background-color:#cccccc'>" & maximum & "</TextArea>"
Response.Write "<Input type='button' value='Find Record' name='B5' style='font-family:Tahoma; font-size:10pt; " & _
"background-color:#cccccc; color:#333399; heigth:23; position:absolute; top:41; left:225; width:80'>"
Response.Write "<Input name=nextrec style='overflow:hidden; position:absolute; height:23; padding-left:4; top:41; left:306; " & _
"width:45' size='20'>"
Response.Write "<Input type='button' value='Find Reference' name='B6' style='font-family:Tahoma; font-size:10pt; " & _
"background-color:#cccccc; color:#333399; heigth:23; position:absolute; top:41; left:355; width:100'>"
Response.Write "<Input name=nextref style='overflow:hidden; position:absolute; height:23; padding-left:4; top:41; left:456; " & _
"width:124' size='20'>"
Response.Write "<Input name=lastrec style='font-family:Tahoma; font-size:9; background-color:#cccccc; color:#cccccc; " & _
"position:absolute; top:100; left:100; width:50' size='20'>"
Response.Write "<Input name=maxrec style='font-family:Tahoma; font-size:9; background-color:#cccccc; color:#cccccc; " & _
"position:absolute; top:100; left:150; width:50' size='20'>" & Chr(13) & Chr(10)
End Sub 'DisplayNavigation
Sub SendReminder (distRec, noteRec)
Dim objMail, text
Set records = DBconnect.Execute("SELECT FullName, Email FROM DistributionList WHERE Record = " & distRec & ";"
text = "Dear " & records("FullName" & "," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(9) & Chr(9) & Chr(9) & _
"this is to remind you that a Hazard Notice has been posted: " & Chr(13) & Chr(10) & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Title:" & Chr(9) & title & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Reference:" & Chr(9) & noticeRef & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Agency:" & Chr(9) & noticeFrom & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Category:" & Chr(9) & noticeType & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Action:" & Chr(9) & noticeFor & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Device:" & Chr(9) & device & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & Chr(9) & "Problem:" & Chr(9) & problem & Chr(13) & Chr(10) & Chr(13) & Chr(10)
text = text & Chr(9) & Chr(9) & "This notice was posted at " & Right(notifiedOn,8) & " on " & Left(notifiedOn,8) & ", by " & _
notifiedBy & ". Replies were expected by " & respDate & "." & Chr(13) & Chr(10)& Chr(13) & Chr(10)
If ((location & "" <> "" Then
text = text & "Please click on the link below to view the full text:" & Chr(13) & Chr(10) & Chr(13) & Chr(9) & Chr(9) & Chr(9) & _
"mewsweb/sabs/CorpGovNHS/" & folderName & location & Chr(13) & Chr(10) & Chr(13) & Chr(10)& Chr(13) & Chr(10)
Else
text = text & Chr(13) & Chr(10)
End If
text = text & "If you wish, click on the link below to view the circulation list for the original notification:" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(9) & Chr(9) & _
"mewsweb/sabs/CorpGovNHS/SABS/Circulation.asp?rec=" & noteRec & Chr(13) & Chr(10) & Chr(13) & Chr(10)& Chr(13) & Chr(10)
text = text & "We would appreciate a response from your department as soon as possible." & Chr(13) & Chr(10)
text = text & "When you are ready to reply, please click on the link below to access the Online Reply Form:" & Chr(13) & _
Chr(10) & Chr(13) & Chr(9) & Chr(9) & Chr(9) & "mewsweb/sabs/CorpGovNHS/SABS/Reply.asp?flg=0&dis=" & _
distRec & "&rep=0&rec=" & record & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & Chr(10)
text = text & "Yours sincerely," & Chr(13) & Chr(10) & Chr(9) & Chr(9) & Chr(9) & "Mr John Mitchell" & Chr(13) & Chr(10) & Chr(13) & _
Chr(10) & Chr(13) & Chr(10) & "Health & Safety Manager," & Chr(13) & Chr(10) & _
"South of Tyne & Wearside Hospitals," & Chr(13) & Chr(10) & _
"Cherry Knowle Hospital, Ryhope, Sunderland SR2 0NB" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Telephone" & Chr(9) & "0191 5656256" & _
Chr(13) & Chr(10) & "Email" & Chr(9) & Chr(9) & " "
Set objMail = CreateObject("CDONTS.NewMail"
objMail.From = " "
objMail.To = records("Email"
objMail.Subject = "Hazard Notice (ref. " & noticeRef & " - REMINDER"
objMail.Body = text
objMail.Send
Set ObjMail = Nothing
Set records = Nothing
End Sub 'SendReminder
Sub SendReminders (reminders)
Dim nextRec, i, x
nextRec = ""
For i = 1 To Len(reminders)
x = Mid(reminders,i,1)
If (x <> Chr(44)) Then
nextRec = nextRec & x
Else
SendReminder nextRec, record
LogEmail record, respDate, nextRec, 0
nextRec = ""
End If
Next
Dim sueCoulson
sueCoulson = 12
SendReminder sueCoulson, record
update = "UPDATE Notices SET LastReminder = '" & Date & "', WriteName = '" & Request.ServerVariables("LOGON_USER" & "', WriteTime = '" & Now & "' WHERE Record =" & record & ";"
DBconnect.Execute(update)
End Sub 'SendReminders
Sub WriteDisplayHTML
Response.Write "<TextArea name='rec' style='overflow:hidden; position:absolute; left:105; top:73; height:10; width:10'>" & rec & _
"</TextArea>" & cr_lf
Response.Write "<TextArea name='max' style='overflow:hidden; position:absolute; left:110; top:73; height:10; width:10'>" & max & _
"</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:75; width:70'>Title</Span>" & cr_lf
Response.Write "<TextArea style='overflow:visible; position:absolute; left:80; top:72; width:500; height:58; background-color: " & _
"#cccccc'>" & title & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:134; width:70'>Agency</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:131; width:260; height:23; background-color: " & _
"#cccccc'>" & noticeFrom & "</TextArea>" & cr_lf
Response.Write "<Span style='overflow:visible; position:absolute; left:360; top:134; width:90'>Category</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:420; top:131; width:160; height:23; background-color: " & _
"#cccccc'>" & noticeType & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:158; width:75'>Reference</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:155; width:150; height:23; background-color: " & _
"#cccccc'>" & noticeRef & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:254; top:158; width:60'>Year</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:290; top:155; width:50; height:23; background-color: " & _
"#cccccc'>" & noticeYear & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:375; top:158; width:60'>Action</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:420; top:155; width:160; height:23; background-color: " & _
"#cccccc'>" & noticeFor & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:182; width:70'>Notified By</Span>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:179; width:150; height:23; background-color: " & _
"#cccccc'>" & notifiedBy & "</TextArea>" & cr_lf
Response.Write "<Span style='overflow:visible; position:absolute; left:245; top:182; width:90'>At</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:270; top:179; width:125; height:23; background-color: " & _
"#cccccc'>" & notifiedOn & "</TextArea>" & cr_lf
Response.Write "<Span style='overflow:visible; position:absolute; left:430; top:182; width:90'>Response by</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:510; top:179; width:70; height:23; background-color: " & _
"#cccccc'>" & respDate & "</TextArea>" & cr_lf
Response.Write "<Span style='position:absolute; left:6; top:206; width:70'>/Folder/File</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:80; top:203; width:140; height:23; background-color: " & _
"#cccccc'>" & folderName & "</TextArea>" & cr_lf
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:220; top:203; width:210; height:23; background-color: " & _
"#cccccc'>" & location & "</TextArea>" & cr_lf
If (lastReminder <> "" ) Then
Response.Write "<Span style='overflow:visible; position:absolute; left:440; top:206; width:130'>Reminders</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:510; top:203; width:70; height:23; background-color: " & _
"#cccccc'>" & lastReminder & "</TextArea>" & cr_lf
Else
Response.Write "<Span style='overflow:visible; position:absolute; left:440; top:206; width:130'>Completed</Span>"
Response.Write "<TextArea style='overflow:hidden; position:absolute; left:510; top:203; width:70; height:23; background-color: " & _
"#cccccc'>" & compDate & "</TextArea>" & cr_lf
End If
End Sub 'WriteDisplayHTML
Function MakeOption (dy, mn, yr, name)
If (dy < 10) Then
MakeOption = "0" & dy & "/"
Else
MakeOption = dy & "/"
End If
If (mn < 10) Then
MakeOption = MakeOption & "0" & mn & "/"
Else
MakeOption = MakeOption & mn & "/"
End If
If (yr < 10) Then
MakeOption = MakeOption & "0" & yr & ", " & name
Else
MakeOption = MakeOption & yr & ", " & name
End If
End Function
Sub ReplyReceived (dateStr)
Dim dy_no, mn_no, yr_no, months(13), days(7), opt_str, d, i, list, options(100), opt_ind
days(0) = "Monday"
days(1) = "Tuesday"
days(2) = "Wednesday"
days(3) = "Thursday"
days(4) = "Friday"
days(5) = "Saturday"
days(6) = "Sunday"
mn_no = Month(dateStr)
If (Len(dateStr) = 8) Then
yr_no = Sum(Mid(dateStr,7,2))
ElseIf (Len(dateStr) = 10) Then
yr_no = Sum(Right(dateStr,2))
End If
dy_no = 1
mn_no = mn_no - 2
If (mn_no < 1) Then
If (mn_no = 0) Then mn_no = 12
If (mn_no < 0) Then mn_no = 11
yr_no = yr_no - 1
End If
months(1) = 31
months(2) = 28 + LeapYear(yr_no)
months(3) = 31
months(4) = 30
months(5) = 31
months(6) = 30
months(7) = 31
months(8) = 31
months(9) = 30
months(10) = 31
months(11) = 30
months(12) = 31
list = Sum(Left(dateStr,2))
list = list + months (mn_no)
If (mn_no <> 12) Then
list = list + months(mn_no + 1)
Else
list = list + months(1)
End If
d = dy_no + (365 * (yr_no - 2))
If (yr_no - 2 > 2) Then d = d + 1
If (yr_no - 2 > 6) Then d = d + 1
If (yr_no - 2 > 10) Then d = d + 1
For i = 1 To (mn_no - 1)
d = d + months(i)
Next
d = d - (7 * Int(d / 7))
opt_ind = 1
For i = 1 To list
opt_str = MakeOption (dy_no, mn_no, yr_no, days(d))
options(opt_ind) = "<Option value=" & chr(34) & opt_str & chr(34) & ">" & opt_str & "</Option>"
opt_ind = opt_ind + 1
dy_no = dy_no + 1
If (dy_no > months(mn_no)) Then
dy_no = 1
mn_no = mn_no + 1
If (mn_no > 12) Then
mn_no = 1
yr_no = yr_no + 1
months(2)= 28 + LeapYear(yr_no)
End If
End If
d = d + 1
If (d > 6) Then d = 0
Next
opt_ind = list
Response.Write "<td width=150 height=200><Select name='DateReceived' size=10 style='overflow:hidden; width:150; height:200' " & _
"onClick='GetDate(DateReceived.value)'>" & cr_lf
For i = 1 To (list)
Response.Write options(opt_ind)
opt_ind = opt_ind - 1
Next
Response.Write "</Select></td>" & cr_lf
End Sub 'ReplyReceived
Function Overdue
Overdue = 0
If (respDate <> "" And (Len(respDate) = 8) Then If (DateValue(respDate) < Date) Then Overdue = -1
End Function 'Overdue
Sub DisplayDistribution (record)
Dim respond(100), replies(100), txt_col(100), colour, i, j, res_no, rep_no, x, nxt_nme
If OverDue Then
colour = "#FF0066"
Else
colour = "#333399"
End If
For i = 0 To 99
respond(i) = ""
replies(i) = ""
txt_col(i) = colour
Next
Response.Write "<tr><td width=190 height=246 valign=top style='background-color: #FFFFFF'>"
res_no = 0
If ((responsesSought & "" <> "" Then
nxt_nme = ""
If ((repliesReceived & "" <> "" Then
For i = 1 To Len(repliesReceived)
x = Mid(repliesReceived,i,1)
If (x <> Chr(44)) Then
nxt_nme = nxt_nme & x
Else
replies(rep_no) = Sum(nxt_nme)
rep_no = rep_no + 1
nxt_nme = ""
End If
Next
End If
For i = 1 To Len(responsesSought)
x = Mid(responsesSought,i,1)
If (x <> Chr(44)) Then
nxt_nme = nxt_nme & x
Else
respond(res_no) = Sum(nxt_nme)
For j = 0 To (rep_no - 1)
If (replies(j) = respond(res_no)) Then
txt_col(res_no) = "#333399"
Exit For
End If
Next
res_no = res_no + 1
nxt_nme = ""
End If
Next
Set records = Nothing
Response.Write "<Select name='Selected' size=10 style='width:190; height:246' onClick='SelectName(Selected.value)'>"
For i = 0 To (res_no - 1)
Set records = DBconnect.Execute("SELECT FullName, Email FROM DistributionList WHERE Record = " & respond(i) & ";"
Response.Write "<Option value='" & records("FullName" & "' style='color:" & txt_col(i) & "'>" & records("FullName" & _
"</option>" & cr_lf
Set records = Nothing
If txt_col(i) = "#FF0066" Then reminders = reminders & respond(i) & Chr(44)
Next
Response.Write "</Select>" & cr_lf
Else
Response.Write "<TextArea style='overflow:hidden; width:190; height:245'>No respondents are listed</TextArea>" & cr_lf
noReplies = -1
End If
Response.Write "</td></tr>" & cr_lf
End Sub 'DisplayDistribution
Sub WriteSelectHTML
Response.Write "<Table border=0 cellpadding=0 cellspacing=0 width=580 style='position:absolute; left:10; top:230'><tr>" & _
"<td colspan=5 height=10>"
Response.Write "<Input name=logData style='visibility:hidden; height:3; width:5'>"
Response.Write "<Input name=noteRec style='visibility:hidden; height:3; width:5'>"
Response.Write "<Input name=maxiRec style='visibility:hidden; height:3; width:5'>"
Response.Write "</td></tr>" & cr_lf
Response.Write "<tr><td><Table border=0 width=190 height=246 cellspacing=0 cellpadding=0 style='margin-left:0'>"
Response.Write "<tr><td width=190 align=left><p class=prompt>Click name to select respondent</p></td></tr>" & Chr(13) & Chr(10)
DisplayDistribution (record)
Response.Write "</table></td>" & cr_lf
Response.Write "<td><Table border=0 width=210 height=246 cellspacing=0 cellpadding=0 style='margin-top:0; margin-bottom:0; " & _
"margin-left:0'>"
Response.Write "<tr><td width=210 align=left><p class=prompt>Respondents so far:</p></td></tr><tr><td width=210 height=246>"
If Not noReplies Then
Response.Write "<TextArea type=text id='respondents' style='width:210; height:246'></TextArea>"
Else
Response.Write "<TextArea type=text style='overflow:hidden; width:210; height:246'></TextArea>"
End If
Response.Write "</td></tr></table></td>" & cr_lf
Response.Write "<td valign=top><Table border=0 width=150 height=246 cellspacing=0 cellpadding=0 style='margin-top:0; " & _
"margin-bottom:0; margin-left:0'>"
Response.Write "<tr><td><p class=prompt>Click date reply received</p></td></tr><tr>" & cr_lf
If current And (Not noReplies) Then
ReplyReceived (Date)
Else
Response.Write "<td width=150 height=200><TextArea style='overflow:hidden; width:150; height:200'></TextArea></td>"
End If
Response.Write "</tr>"
Response.Write "<tr><td height=23 align=right valign=bottom>"
If (reminders <> "" Then Response.Write "<Input type='button' value='SEND REMINDER' name='Reminders' style='width:147; " & _
"height:23; color:#FF0066; font-weight:bold'>"
Response.Write "</td></tr>"
Response.Write "<tr><td height=23 align=right valign=bottom>"
If current Then
Response.Write "<Input type='submit' value='LOG RESPONSE' style='width:147; height:23; color:#333399; font-weight:bold'>"
Else
Response.Write "<p class=prompt>Correspondence Complete</p>"
End If
Response.Write "</td></tr></table>" & Chr(13) & Chr(10)
Response.Write "</td></tr></table>" & Chr(13) & Chr(10)
End Sub 'WriteSelectHTML
Sub LogItem (item)
Dim items, nextItem, itemName, itemDate
itemDate = Mid(item, (len(item)-8), 8)
itemName = Left(item, (len(item)-12))
Set items = Server.CreateObject("ADODB.RecordSet"
items.Open "RepliesLog", DBconnect, 1, 3
If items.EOF Then
nextItem = 1
Else
items.MoveLast
nextItem = items("Record" + 1
End If
items.AddNew
items("Record" = nextItem
items("NoticeRec" = record
items("Respondent" = itemName
items("ReplyDate" = itemDate
items("WriteName" = Request.ServerVariables("LOGON_USER"
items("WriteTime" = Now
items.Update
items.Requery
items.Close
Set items = Nothing
End Sub 'LogItem
Sub LogItems (strng)
Dim i, x, item
record = Sum(Request.QueryString("noteRec")
maximum = Sum(Request.QueryString("maxiRec")
item = ""
For i = 1 To Len(strng)
x = Mid(strng,i,1)
If (x <> Chr(59)) Then
item = item & x
Else
If ((Left(item,1) <> Chr(42)) And (Right(item,1) = Chr(93))) Then LogItem item
item = ""
End If
Next
End Sub 'LogItems
Function GetReplies (record)
GetReplies = ""
Set records = DBconnect.Execute("SELECT Respondent, ReplyDate FROM RepliesLog WHERE NoticeRec = " & record & " AND DistribRec <> 0 ORDER BY Record DESC;"
Do Until records.EOF
GetReplies = GetReplies & Chr(42) & records("Respondent" & " " & "[" & records("ReplyDate" & "];"
records.MoveNext
Loop
Set records = Nothing
End Function 'GetReplies
'--------------------------------------------------------------------------------------------------------
refer = Trim("" & Request.QueryString("ref")
record = 0 + cInt(Request.QueryString("rec")
maximum = 0 + cInt(Request.QueryString("max")
replies = Trim("" & Request.QueryString("logData")
reminders = Trim("" & Request.QueryString("rem")
If (replies <> "" Then LogItems (replies)
If (refer <> "" Then record = GetRecNumber ("Notices", "NoticeRef", refer)
If (maximum = 0) Then maximum = GetNumber("Notices"
If (record > maximum) Then record = maximum
repsToDate = GetReplies (record)
GetNotice record
'# OUT FOR DEBUG
If (reminders <> "" Then SendReminders (reminders)
'# IN FOR DEBUG If (reminders <> "" Then SendReminder 27, record
reminders = ""
If (comp_date = "" Then
current = -1
Else
current = 0
End If
Response.Write "<Div style='background-color:#cccccc; border-bottom-color:#cccccc; border-left-color:#cccccc; " & _
"border-right-color:#cccccc; border-top-color:#cccccc; color:#333399; font-size:10pt; position:relative; height:520; width:590'>"
DisplayNavigation
Response.Write "<Form name='Log_Form' action='Replies_Log.asp' method='get'>"
WriteDisplayHTML
WriteSelectHTML
Response.Write "</Form>"
Response.Write "</Div>" & Chr(13) & Chr(10)
DBconnect.Close
%>
<SCRIPT LANGUAGE=VBS>
Dim names(500), nameIndex, dateFlag
Sub ShowData (data)
msgbox ("[" & data & "]"
End Sub
If Not <% =noReplies %> Then
MakeNames (<% =(Chr(34) & repsToDate & Chr(34)) %><img src=../images/dmxzone/forum/icon_smile_wink.gif border=0 align=middle>
window.document.Log_Form.noteRec.value = (<% =(Chr(34) & record & Chr(34)) %><img src=../images/dmxzone/forum/icon_smile_wink.gif border=0 align=middle>
window.document.Log_Form.maxiRec.value = (<% =(Chr(34) & maximum & Chr(34)) %><img src=../images/dmxzone/forum/icon_smile_wink.gif border=0 align=middle>
window.document.Log_Form.logData.value = MakeNameStr (names)
window.document.Log_Form.respondents.value = MakeNameView (names)
End If
lastrec.value = <% =record %>
maxrec.value = <% =maximum %>
dateFlag = 0
Sub MakeNames (strng)
Dim i, x
nameIndex = 0
If strng = "" Then
For i = 0 To 499
names(i) = ""
Next
Else
names(nameIndex) = ""
For i = 1 to Len(strng)
x = Mid(strng,i,1)
If (x <> ";" Then
names(nameIndex) = names(nameIndex) & x
Else
nameIndex = nameIndex + 1
names(nameIndex) = ""
End If
Next
For i = (nameIndex + 1) To 499
names(i) = ""
Next
End If
End Sub 'MakeNames
Function AddToList (name, nameIndex)
Dim t, j, match
j = 0
For t = 0 To nameIndex
match = names(t)
If (Left(match,Len(name)) = name) Then
For j = t To (nameIndex + 1)
names(j) = names(j+1)
Next
t = nameIndex
If dateFlag Then dateFlag = 0
End If
Next
AddToList = j
End Function 'AddToList
Sub SelectName (name)
If name & "" <> "" Then
MakeNames (window.document.Log_Form.logData.value)
If (nameIndex = 0) Or (AddToList(name, nameIndex) = 0) Then
If Not dateFlag Then
names(nameIndex) = name
nameIndex = nameIndex + 1
dateFlag = -1
Else
msgbox ("you must record a date for your last selected respondent"
End If
Else
nameIndex = nameIndex - 1
End If
window.document.Log_Form.respondents.value = MakeNameView (names)
window.document.Log_Form.logData.value = MakeNameStr (names)
End If
End Sub 'SelectName
Function MakeNameView (names)
Dim i, name
MakeNameView = ""
For i = 0 To (nameIndex - 1)
If (Left(names(i),1) <> "*" Then
MakeNameView = MakeNameView & names(i) & Chr(13) & Chr(10)
Else
name = names(i)
name = Right(name, (Len(name) - 1))
MakeNameView = MakeNameView & name & Chr(13) & Chr(10)
End If
Next
End Function
Function MakeNameStr (names)
Dim strng, i, c
strng = ""
For i = 0 To (nameIndex - 1)
strng = strng & names(i) & Chr(59)
Next
For i = 1 To Len(strng)
c = Mid(strng,i,1)
MakeNameStr = MakeNameStr & c
Next
End Function
Sub GetDate (dateStr)
If dateFlag Then
names(nameIndex - 1) = names(nameIndex - 1) & " [" & Left(dateStr,8) & "]"
window.document.Log_Form.respondents.value = MakeNameView (names)
window.document.Log_Form.logData.value = MakeNameStr (names)
dateFlag = 0
Else
msgbox ("you must first select a respondent"
End If
End Sub
Sub MakeLink(nr, mr)
pagelink = "Replies_Log.asp?rec=" & nr & "&max=" & mr
window.navigate(pagelink)
End Sub
Function CheckString(strng)
Dim i, c
If strng = "0" Then
CheckString = "False"
Else
CheckString = "True"
For i = 1 to Len(strng)
c = Mid(strng, i, 1)
If ((c < chr(48)) Or (c > chr(57))) Then
CheckString = "False"
Exit For
End If
Next
End If
End Function
Sub Reminders_OnClick
'msg = "REMINDERS: [" & <% =(Chr(34) & reminders & Chr(34)) %> & "]"
'msgbox (msg)
pagelink = "Replies_Log.asp?rem=" & <% =(Chr(34) & reminders & Chr(34)) %> & "&rec=" & lastrec.value & "&max=" & maxrec.value
window.navigate(pagelink)
End Sub ' trigger email of reminders
Sub B1_OnClick
lastrec.value = 1
MakeLink lastrec.value, maxrec.value
End Sub ' first record
Sub B2_OnClick
lastrec.value = lastrec.value - 1
If (lastrec.value < 1) Then
lastrec.value = maxrec.value
End If
MakeLink lastrec.value, maxrec.value
End Sub ' previous record
Sub B3_OnClick
lastrec.value = lastrec.value + 1
If (cInt(lastrec.value) > cInt(maxrec.value)) Then
lastrec.value = 1
End If
MakeLink lastrec.value, maxrec.value
End Sub ' next record
Sub B4_OnClick
lastrec.value = maxrec.value
MakeLink lastrec.value, maxrec.value
End Sub ' last record
Sub B5_OnClick
If (CheckString (nextrec.value) = "True" Then
If (cInt(nextrec.value) > cInt(maxrec.value)) Then
nextrec.value = 1
End If
MakeLink nextrec.value, maxrec.value
Else
nextrec.value = "error"
End If
End Sub ' find selected record
Sub B6_OnClick
pagelink = "Replies_Log.asp?ref=" & nextref.value & "&max=" & maxrec.value
window.navigate(pagelink)
End Sub ' find selected reference
Sub B8_OnClick
pagelink = "View_Replies.asp?rec=" & lastrec.value
window.navigate(pagelink)
End Sub ' view Replies
</SCRIPT>
<p class="note">Copyright © 2003-4 Sheffield Teaching Hospitals NHS Trust. All rights reserved --- Revised:
<!--webbot bot="Timestamp" s-type="EDITED" s-format="%A %B %d, %Y %H:%M" startspan -->Saturday April 30, 2005 14:37<!--webbot bot="Timestamp" i-checksum="55760" endspan --> (GP)</p>
<span style="visibility:hidden"><b>
<font face="Arial Black" size="1" color="#FF0000">DO NOT MODIFY THIS PAGE </font>
</b></span>
</body>
</htm>
Replied 06 Apr 2006 17:34:09
06 Apr 2006 17:34:09 John Shipp replied:
What about empty... is request.querystring("rec" empty? If it is, you will get this error also. The code I provded before would return false if request.querystring("rec" is empty.
Replied 06 Apr 2006 17:41:45
06 Apr 2006 17:41:45 Stephen Miller replied:
It returns true, so it must be numeric and not empty.
This is so frustrating....
This is so frustrating....
Replied 06 Apr 2006 17:48:53
06 Apr 2006 17:48:53 John Shipp replied:
Try putting this line in the code and see what displays...
response.write( isNumeric(request.querystring("rec"))
... if you have not tried this already. Also, when you get the error, do you see the text
rec=12345 (or whatever number is supposed to be there) within the querystring in the address bar?
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
It returns true, so it must be numeric and not empty.
This is so frustrating....
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
response.write( isNumeric(request.querystring("rec"))
... if you have not tried this already. Also, when you get the error, do you see the text
rec=12345 (or whatever number is supposed to be there) within the querystring in the address bar?
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
It returns true, so it must be numeric and not empty.
This is so frustrating....
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
Replied 06 Apr 2006 17:54:04
06 Apr 2006 17:54:04 Stephen Miller replied:
It returns 'true'
and this is what is in the address bar on the error page:
intranet-test/sabs/root_CorpGov_prv_/Replies_Log.asp?rec=&max=&logData=¬eRec=&maxiRec=
and this is what is in the address bar on the error page:
intranet-test/sabs/root_CorpGov_prv_/Replies_Log.asp?rec=&max=&logData=¬eRec=&maxiRec=
Replied 06 Apr 2006 18:11:32
06 Apr 2006 18:11:32 John Shipp replied:
Ok, couple of things...
First, the "¬" character is probably supposed to be an "&". Although this does not directly effect your question, it still should be looked at becuase, right now, the variable logData equals all of the following:
"¬eRec=" without the quotes.
Second, becuase rec= is in the querystring, it has sort of declared itself... however, if you add one more line of code, you can check for this...
if isempty(request.querystring("rec") = "True" then
if isnumeric(request.querystring("rec") = "True" then
record = request.querystring("rec"
else
' error handle
end if
else
' error handle
end if
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
It returns 'true'
and this is what is in the address bar on the error page:
intranet-test/sabs/root_CorpGov_prv_/Replies_Log.asp?rec=&max=&logData=¬eRec=&maxiRec=
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
First, the "¬" character is probably supposed to be an "&". Although this does not directly effect your question, it still should be looked at becuase, right now, the variable logData equals all of the following:
"¬eRec=" without the quotes.
Second, becuase rec= is in the querystring, it has sort of declared itself... however, if you add one more line of code, you can check for this...
if isempty(request.querystring("rec") = "True" then
if isnumeric(request.querystring("rec") = "True" then
record = request.querystring("rec"
else
' error handle
end if
else
' error handle
end if
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
It returns 'true'
and this is what is in the address bar on the error page:
intranet-test/sabs/root_CorpGov_prv_/Replies_Log.asp?rec=&max=&logData=¬eRec=&maxiRec=
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
Replied 06 Apr 2006 18:26:17
06 Apr 2006 18:26:17 Stephen Miller replied:
the ¬ isnt actually there, must've happened when I pasted the txt...
That code returns the 2nd error handle because ("rec" is not empty, it equals 1 actually
That code returns the 2nd error handle because ("rec" is not empty, it equals 1 actually
Replied 06 Apr 2006 18:37:27
06 Apr 2006 18:37:27 John Shipp replied:
I guess what I'm questioning is that the address bar shows that rec = nothing, however, your code shows that request.querystring("rec" = 1... something is not matching up... i'll look at your code posted above (the full code) more closely. Again, according to your address bar posting, rec IS empty... but what you are saying is that request.querystring("rec" is returning the number 1?
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
the ¬ isnt actually there, must've happened when I pasted the txt...
That code returns the 2nd error handle because ("rec" is not empty, it equals 1 actually
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
<BLOCKQUOTE id=quote><font size=1 face="Verdana, Arial, Helvetica" id=quote>quote:<hr height=1 noshade id=quote>
the ¬ isnt actually there, must've happened when I pasted the txt...
That code returns the 2nd error handle because ("rec" is not empty, it equals 1 actually
<hr height=1 noshade id=quote></BLOCKQUOTE id=quote></font id=quote><font face="Verdana, Arial, Helvetica" size=2 id=quote>
Replied 06 Apr 2006 18:43:23
06 Apr 2006 18:43:23 Stephen Miller replied:
Yes the problem seem to be that before the form is submitted, ("rec"=1, but when submitted it is empty.
But i can't find the code that is linked to submitting the form....
thanks for your help so far.
But i can't find the code that is linked to submitting the form....
thanks for your help so far.