· 4 years ago · Apr 27, 2021, 01:52 AM
1Attribute VB_Name = "modCGI4VB"
2'====================================
3' CGI4VB.BAS
4'====================================
5Option Explicit
6Public db As New ADODB.Connection
7Public rst As New ADODB.Recordset
8Public rstSecurity As New ADODB.Recordset
9Public cmd As New ADODB.Command
10Public strUserName As String
11Public strConnectionString As String
12Public colSecurityGroups As New Collection
13Public strState
14Public arrState
15
16Public Const DB_WEALTHBUILDER = "6472697665723d7b53514c205365727665727d3b7365727665723d504541523b64617461626173653d5765616c74684275696c6465723b"
17'point to OAK
18'Public Const DB_WEALTHBUILDER = "6472697665723d7b53514c205365727665727d3b7365727665723d4f414b3b64617461626173653d5765616c74684275696c6465723b"
19
20Public Const UID_WEBSERVER As String = "5549443d5765627365727665723b5057443d736e6565643b"
21'
22' CGI routines used with VB (32bit) using STDIN / STDOUT.
23'
24' Version: 1.5 (September 1997)
25
26Declare Function GetStdHandle Lib "kernel32" _
27 (ByVal nStdHandle As Long) As Long
28Declare Function ReadFile Lib "kernel32" _
29 (ByVal hFile As Long, _
30 lpBuffer As Any, _
31 ByVal nNumberOfBytesToRead As Long, _
32 lpNumberOfBytesRead As Long, _
33 lpOverlapped As Any) As Long
34Declare Function WriteFile Lib "kernel32" _
35 (ByVal hFile As Long, _
36 ByVal lpBuffer As String, _
37 ByVal nNumberOfBytesToWrite As Long, _
38 lpNumberOfBytesWritten As Long, _
39 lpOverlapped As Any) As Long
40Declare Function SetFilePointer Lib "kernel32" _
41 (ByVal hFile As Long, _
42 ByVal lDistanceToMove As Long, _
43 lpDistanceToMoveHigh As Long, _
44 ByVal dwMoveMethod As Long) As Long
45Declare Function SetEndOfFile Lib "kernel32" _
46 (ByVal hFile As Long) As Long
47
48Public Const STD_INPUT_HANDLE = -10&
49Public Const STD_OUTPUT_HANDLE = -11&
50Public Const FILE_BEGIN = 0&
51
52' environment variables
53'
54Public CGI_Accept As String
55Public CGI_AuthType As String
56Public CGI_ContentLength As String
57Public CGI_ContentType As String
58Public CGI_Cookie As String
59Public CGI_GatewayInterface As String
60Public CGI_PathInfo As String
61Public CGI_PathTranslated As String
62Public CGI_QueryString As String
63Public CGI_Referer As String
64Public CGI_RemoteAddr As String
65Public CGI_RemoteHost As String
66Public CGI_RemoteIdent As String
67Public CGI_RemoteUser As String
68Public CGI_RequestMethod As String
69Public CGI_ScriptName As String
70Public CGI_ServerSoftware As String
71Public CGI_ServerName As String
72Public CGI_ServerPort As String
73Public CGI_ServerProtocol As String
74Public CGI_UserAgent As String
75
76Public lContentLength As Long ' CGI_ContentLength converted to Long
77Public hStdIn As Long ' handle of Standard Input
78Public hStdOut As Long ' handle of Standard Output
79Public sErrorDesc As String ' constructed error message
80Public sEmail As String ' webmaster's/your email address
81Public sFormData As String ' url-encoded data sent by the server
82
83Public CGIColl As New Collection
84
85Sub Main()
86
87On Error GoTo ErrorRoutine
88InitCgi ' Load environment vars and perform other initialization
89GetFormData ' Read data sent by the server
90CGI_Main ' Process and return data to server
91
92EndPgm:
93 End ' end program
94
95ErrorRoutine:
96 sErrorDesc = Err.Description & " " & Err.Number
97 ErrorHandler
98 Resume EndPgm
99End Sub
100
101Sub ErrorHandler()
102Dim rc As Long
103Dim adocommand As New ADODB.Command
104Dim strTemp As String
105On Error Resume Next
106Dim CGIPair As CGIPair
107' use SetFilePointer API to reset stdOut to BOF
108' and SetEndOfFile to reset EOF
109
110rc = SetFilePointer(hStdOut, 0&, 0&, FILE_BEGIN)
111
112SendHeader "Error"
113Send "<H1>An Error Has Occurred</H1>"
114
115Send "<Table><tr><td><IMG SRC='../COLORWizardBig.jpg' alt='Woe, I say WOE unto thee who incurs the wrath of the Server Administrator'></td><td valign='top'>"
116Send "<b>You! Yeah, the one who just caused this. Stop breaking things!</b><p>"
117Send "Ok, here's what you do. Call Cassandra (extension 1416) or Mike (extension 1411) and tell him the following error has occurred:<P>"
118Send "<font color='red'>" & Replace(sErrorDesc, vbCrLf, "<br>") & "</font><P>"
119Send "If he asks, you should also supply the following information:<P>"
120Send "Page:" & App.Title & "<br>"
121strTemp = "Page" & vbTab & App.Title & vbCrLf
122For Each CGIPair In CGIColl
123 Send CGIPair.Name & ":" & CGIPair.Variable & "<br>"
124 strTemp = strTemp & CGIPair.Name & vbTab & CGIPair.Variable & vbCrLf
125Next
126
127Send "</td></tr></table>"
128SendFooter
129
130With adocommand
131 .ActiveConnection = strConnectionString
132 .CommandType = adCmdText
133 .CommandText = "EXEC master.dbo.xp_sendmail " & _
134 "@recipients = 'afaraca'," & _
135 "@message = 'Error from " & Initials & vbCrLf & vbCrLf & sErrorDesc & vbCrLf & vbCrLf & strTemp & "'," & _
136 "@Subject = 'Error in WBServicing DB'"
137 .Execute
138End With
139
140End
141End Sub
142
143Sub InitCgi()
144
145hStdIn = GetStdHandle(STD_INPUT_HANDLE)
146hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
147
148sEmail = "YourEmailAddress@Here"
149
150'==============================
151' Get the environment variables
152'==============================
153'
154' Environment variables will vary depending on the server.
155' Replace any variables below with the ones used by your server.
156'
157CGI_Accept = Environ("HTTP_ACCEPT")
158CGI_AuthType = Environ("AUTH_TYPE")
159CGI_ContentLength = Environ("CONTENT_LENGTH")
160CGI_ContentType = Environ("CONTENT_TYPE")
161CGI_Cookie = Environ("HTTP_COOKIE")
162CGI_GatewayInterface = Environ("GATEWAY_INTERFACE")
163CGI_PathInfo = Environ("PATH_INFO")
164CGI_PathTranslated = Environ("PATH_TRANSLATED")
165CGI_QueryString = Environ("QUERY_STRING")
166CGI_Referer = Environ("HTTP_REFERER")
167CGI_RemoteAddr = Environ("REMOTE_ADDR")
168CGI_RemoteHost = Environ("REMOTE_HOST")
169CGI_RemoteIdent = Environ("REMOTE_IDENT")
170CGI_RemoteUser = Environ("REMOTE_USER")
171CGI_RequestMethod = Environ("REQUEST_METHOD")
172CGI_ScriptName = Environ("SCRIPT_NAME")
173CGI_ServerSoftware = Environ("SERVER_SOFTWARE")
174CGI_ServerName = Environ("SERVER_NAME")
175CGI_ServerPort = Environ("SERVER_PORT")
176CGI_ServerProtocol = Environ("SERVER_PROTOCOL")
177CGI_UserAgent = Environ("HTTP_USER_AGENT")
178
179lContentLength = Val(CGI_ContentLength) 'convert to long
180ReDim tPair(0) 'initialize name/value array
181
182End Sub
183
184Sub GetFormData()
185'====================================================
186' Get the CGI data from STDIN and/or from QueryString
187' Store name/value pairs
188'====================================================
189Dim sBuff As String ' buffer to receive POST method data
190Dim lBytesRead As Long ' actual bytes read by ReadFile()
191Dim rc As Long ' return code
192
193' Method POST - get CGI data from STDIN
194' Method GET - get CGI data from QueryString environment variable
195'
196If CGI_RequestMethod = "POST" Then
197 sBuff = String(lContentLength, Chr$(0))
198 Do While Len(sFormData) < lContentLength
199 rc = ReadFile(hStdIn, ByVal sBuff, lContentLength, lBytesRead, ByVal 0&)
200 sFormData = sFormData & Left$(sBuff, lBytesRead)
201 Loop
202
203 ' Make sure posted data is url-encoded
204 ' Multipart content types, for example, are not necessarily encoded.
205 '
206 If InStr(1, CGI_ContentType, "www-form-urlencoded", 1) Then
207 StorePairs sFormData
208 End If
209End If
210StorePairs CGI_QueryString
211End Sub
212
213Sub StorePairs(sData As String)
214'=====================================================================
215' Parse and decode form data and/or query string
216' Data is received from server as "name=value&name=value&...name=value"
217' Names and values are URL-encoded
218'
219' Store name/value pairs in collection CGIColl as CGIPair objects, and decode them
220'
221' Note: if an element in the query string does not contain an "=",
222' then it will not be stored.
223'
224' /cgi-bin/pgm.exe?parm=1 "1" gets stored and can be
225' retrieved with getCgiValue("parm")
226' /cgi-bin/pgm.exe?1 "1" does not get stored, but can be
227' retrieved with urlDecode(CGI_QueryString)
228'
229'======================================================================
230Dim lngStart As Long
231Dim lngDataLength As Long
232Dim CGIPair As CGIPair
233Dim lngEnd As Long
234
235lngStart = 1
236lngEnd = Len(sData)
237
238If lngEnd = 0 Then Exit Sub
239
240lngEnd = InStr(1, sData, "=")
241
242If lngEnd = 0 Then Exit Sub
243
244Do
245 Set CGIPair = New CGIPair
246
247 CGIPair.Name = UrlDecode(Mid(sData, lngStart, lngEnd - lngStart))
248
249 lngStart = lngEnd + 1
250 lngEnd = InStr(lngStart, sData, "&")
251
252 If lngEnd = 0 Then
253 CGIPair.Variable = UrlDecode(Mid(sData, lngStart))
254 Else
255 CGIPair.Variable = UrlDecode(Mid(sData, lngStart, lngEnd - lngStart))
256 End If
257
258 On Error GoTo Err_Handler
259 CGIColl.Add CGIPair, CGIPair.Name
260 On Error GoTo 0
261
262 If lngEnd = 0 Then Exit Sub
263
264 lngStart = lngEnd + 1
265 lngEnd = InStr(lngStart, sData, "=")
266Loop Until lngEnd = 0
267
268Exit Sub
269
270Err_Handler:
271
272CGIColl(CGIPair.Name).Variable = CGIColl(CGIPair.Name).Variable & ";" & CGIPair.Variable
273Resume Next
274
275End Sub
276
277Public Function UrlDecode(ByVal sEncoded As String) As String
278'========================================================
279' Accept url-encoded string
280' Return decoded string
281'========================================================
282
283Dim pos As Long ' position of InStr target
284
285If sEncoded = "" Then Exit Function
286
287' convert "+" to space
288pos = 0
289Do
290 pos = InStr(pos + 1, sEncoded, "+")
291 If pos = 0 Then Exit Do
292 Mid$(sEncoded, pos, 1) = " "
293Loop
294
295' convert "%xx" to character
296pos = 0
297
298On Error GoTo errorUrlDecode
299
300Do
301 pos = InStr(pos + 1, sEncoded, "%")
302 If pos = 0 Then Exit Do
303
304 Mid$(sEncoded, pos, 1) = Chr$("&H" & (Mid$(sEncoded, pos + 1, 2)))
305 sEncoded = Left$(sEncoded, pos) _
306 & Mid$(sEncoded, pos + 3)
307Loop
308On Error GoTo 0 'reset error handling
309UrlDecode = sEncoded
310Exit Function
311
312errorUrlDecode:
313'--------------------------------------------------------------------
314' If this function was mistakenly called with the following:
315' UrlDecode("100% natural")
316' a type mismatch error would be raised when trying to convert
317' the 2 characters after "%" from hex to character.
318' Instead, a more descriptive error message will be generated.
319'--------------------------------------------------------------------
320If Err.Number = 13 Then 'Type Mismatch error
321 Err.Clear
322 Err.Raise 65001, , "Invalid data passed to UrlDecode() function."
323Else
324 Err.Raise Err.Number
325End If
326Resume Next
327End Function
328
329
330Function GetCgiValue(ByVal cgiName As String) As String
331'====================================================================
332' Accept the name of a pair
333' Return the value matching the name
334'
335' tPair(0) is always empty.
336' An empty string will be returned
337' if cgiName is not defined in the form (programmer error)
338' or, a select type form item was used, but no item was selected.
339'
340' Multiple values, separated by a semi-colon, will be returned
341' if the form item uses the "multiple" option
342' and, more than one selection was chosen.
343' The calling procedure must parse this string as needed.
344'====================================================================
345On Error GoTo Err_Handler
346GetCgiValue = CGIColl(cgiName).Variable
347Exit Function
348
349Err_Handler:
350GetCgiValue = ""
351Resume Next
352
353End Function
354
355'Sub SendHeader(sTitle As String, Optional strStyle As String = "")
356Sub SendHeader(sTitle As String, Optional strStyle As String = "", Optional strScript As String = "")
357Send "Status: 200 OK"
358Send "Expires: 0"
359Send "Content-type: text/html" & vbCrLf
360Send "<HTML><HEAD><TITLE>" & sTitle & "</TITLE>"
361Send "<LINK REL='icon' HREF='http://www.wealthbuilder.com/WBServicing.ico' TYPE='image/ico'>"
362Send "<LINK REL='SHORTCUT ICON' HREF='http://www.wealthbuilder.com/WBServicing.ico'>"
363Send strStyle
364Send strScript
365
366Send "<SCRIPT LANGUAGE='JavaScript'>"
367 Send "function formSubmit(frm) {"
368 Send "var key = frm.Key.value;"
369 Send "var search = frm.Search.value;"
370 Send "var strPosition;"
371
372 Send "if (frm.Position[0].checked) {strPosition = 'StartWith'};"
373 Send "else {strPosition = 'Contain'};"
374
375 Send "if (key == 'CourtOrder') {"
376 'Send "window.open('CourtOrder.exe?CO_list=true&Search=' + search.replace(\',\'') + '&Position=' + strPosition,'CourtOrder','resizable=yes,scrollbars=1,copyhistory=0,width=515,height=460');"
377 Send "window.open('CourtOrder.exe?CO_list=true&Search=' + search + '&Position=' + strPosition,'CourtOrder','resizable=yes,scrollbars=1,copyhistory=0,width=515,height=460');"
378 Send "};"
379 Send "else if (key == 'IssuerGuarantor') {"
380 Send "window.open('IssuerGuarantor.exe?IssGua_list=true&Search=' + search + '&Position=' + strPosition,'IssuerGuarantor','resizable=yes,scrollbars=1,copyhistory=0,width=350,height=450');"
381 Send "};"
382
383 Send "else if (key == 'Attorney') {"
384 Send "window.open('Attorney.exe?Attorney_list=true&Search=' + search + '&Position=' + strPosition,'Attorney','resizable=yes,scrollbars=1,copyhistory=0,width=350,height=400');"
385 Send "};"
386 Send "else if (key != '') {"
387 'Send "var strAction = key + '?' + search;"
388 Send "var strAction = key + '?';"
389 Send "document.Search.action = strAction;"
390 Send "document.Search.submit();"
391 Send "};"
392
393 Send "};"
394Send "</SCRIPT>"
395
396Send "</HEAD>"
397'Send "<BODY" & strBodyAttributes & ">"
398
399End Sub
400
401Sub SendFooter()
402'==================================
403' standardized footers can be added
404'==================================
405Send "</BODY></HTML>"
406End Sub
407
408Sub Send(s As String)
409'======================
410' Send output to STDOUT
411'======================
412Dim rc As Long
413Dim lBytesWritten As Long
414
415s = s & vbCrLf
416rc = WriteFile(hStdOut, s, Len(s), lBytesWritten, ByVal 0&)
417End Sub
418
419Sub SendB(s As String)
420'============================================
421' Send output to STDOUT without vbCrLf.
422' Use when sending binary data. For example,
423' images sent with "Content-type image/jpeg".
424'============================================
425Dim rc As Long
426Dim lBytesWritten As Long
427
428rc = WriteFile(hStdOut, s, Len(s), lBytesWritten, ByVal 0&)
429End Sub
430Function DecodeConnectionString(ByVal strHex As String) As String
431Dim i As Integer
432Dim strTemp As String
433
434For i = 1 To Len(strHex) Step 2
435 strTemp = strTemp & Chr((Val("&H" & Mid(strHex, i, 2))))
436Next i
437
438DecodeConnectionString = strTemp
439
440End Function
441
442
443Sub DisplayCGIVariables()
444Dim CGIPair As CGIPair
445
446SendHeader "Test"
447
448For Each CGIPair In CGIColl
449 Send CGIPair.Name & ":" & CGIPair.Variable & "<P>"
450Next
451
452SendFooter
453End
454End Sub
455Function PercentToNumber(strValue As String) As Double
456
457PercentToNumber = CDbl(Left(strValue, IIf(Right(strValue, 1) = "%", InStr(strValue, "%") - 1, Len(strValue)))) / 100
458
459End Function
460
461Sub SendToLogin()
462
463SendHeader ("Please Login")
464Send ("<BODY>You are not currently logged into the system. Please <A href=""LoginPage.exe"">log in</a> before continuing.<p>")
465Send ("<b>Note:</b> If you have just logged in and have received this, please press the refresh button on your browser.")
466SendFooter
467
468End Sub
469
470Function zls2null(ByVal varName As Variant, Optional varNull As Variant = Null) As Variant
471
472If Trim(GetCgiValue(varName)) = "" Then
473 zls2null = varNull
474Else
475 zls2null = Trim(GetCgiValue(varName))
476End If
477
478End Function
479
480Function SendIfZLS(ByVal varData As Variant, Optional varSend As Variant = 0) As Variant
481
482If varData = "" Then SendIfZLS = varSend Else SendIfZLS = varData
483
484End Function
485
486Function SendIfEmpty(ByVal varData As Variant, Optional varSend As Variant) As Variant
487
488If varData = "" Then SendIfEmpty = Null Else SendIfEmpty = varData
489
490End Function
491
492Function SendIfNull(ByVal varData As Variant, Optional varSend As Variant = "") As Variant
493
494If IsNull(varData) Then SendIfNull = varSend Else SendIfNull = varData
495
496End Function
497
498Function Nz(ByVal varName As Variant, Optional varNull As Variant = Null) As Variant
499
500If Trim(GetCgiValue(varName)) = "" Then
501 Nz = varNull
502Else
503 Nz = Trim(GetCgiValue(varName))
504End If
505
506End Function
507
508Sub PageIsNotViewable()
509
510SendHeader ("IFR Calls")
511Send ("<BODY BACKGROUND=""../PSF_Background.gif"">")
512Send "You do not have permission to view this page."
513SendFooter
514
515End Sub
516
517Function Initials() As String
518'Dim rst2 As New ADODB.Recordset
519
520Initials = strUserName
521
522'With rst2
523' .Open "SELECT UserName FROM Employee WHERE Random = '" & Mid(CGI_Cookie, 15) & "'", db, adOpenStatic
524' Initials = rst2!UserName
525'.Close
526'End With
527
528End Function
529
530Function InitialsID() As Integer
531Dim rst As New ADODB.Recordset
532
533With rst
534 .Open "SELECT Employee_ID FROM Employee WHERE Username = '" & Initials() & "'", db, adOpenForwardOnly
535 InitialsID = rst!Employee_ID
536.Close
537End With
538
539End Function
540
541Sub CheckSecurity()
542
543rstSecurity.Open "EXEC CheckSecurity @CookieID = " & Mid(CGI_Cookie, 11), db, adOpenKeyset
544
545End Sub
546
547Function ThreeLetterInitials() As String
548Dim rst2 As New ADODB.Recordset
549
550rst2.Open "SELECT Initials from tblSecurityLevels WHERE Random = '" & Mid(CGI_Cookie, 11) & "'", db, adOpenKeyset
551
552With rst2
553 .MoveFirst
554 ThreeLetterInitials = rst2!Initials
555 .Close
556End With
557End Function
558
559Function DoubleApostrophes(strInput As String) As String
560
561DoubleApostrophes = Replace(strInput, "'", "''")
562
563End Function
564
565Function UrlEncode(ByVal Unencoded As String) As String
566Dim i As Integer
567Dim a As Byte
568
569For i = 1 To Len(Unencoded)
570 a = Asc(Mid(Unencoded, i, 1))
571 If (a >= 48 And a <= 57) Or (a >= 65 And a <= 90) Or (a >= 97 And a <= 122) Then
572 UrlEncode = UrlEncode & Chr(a)
573 Else
574 UrlEncode = UrlEncode & "%" & Hex(a)
575 End If
576Next i
577
578End Function
579
580Function FormatPhoneNumber(varNumber As Variant) As String
581
582'Function FormatPhoneNumber(PhoneNumber As String) As String
583'PhoneNumber = Replace(PhoneNumber, "(", "")
584'PhoneNumber = Replace(PhoneNumber, ")", "")
585'PhoneNumber = Replace(PhoneNumber, " ", "")
586'PhoneNumber = Replace(PhoneNumber, "-", "")
587'
588'FormatPhoneNumber = PhoneNumber
589
590If IsNull(varNumber) Then
591 FormatPhoneNumber = ""
592ElseIf varNumber = "" Then
593 FormatPhoneNumber = ""
594Else
595 FormatPhoneNumber = "(" & Left(varNumber, 3) & ") " & Mid(varNumber, 4, 3) & "-" & Mid(varNumber, 7)
596End If
597
598End Function
599
600Function FormatSSN(SSN As String) As String
601
602SSN = Replace(SSN, "-", "")
603SSN = Replace(SSN, " ", "")
604
605FormatSSN = SSN
606
607End Function
608
609
610Function EncodeConnectionString(Login As String, Password As String) As String
611Dim i As Integer
612Dim strASCII As String
613Dim strTemp As String
614Dim strHex As String
615
616strASCII = "driver={SQL Server};server=PEAR;UID=" & Login & ";Pwd=" & Password & ";database=WBServicing"
617'strASCII = "driver={SQL Server};server=OAK;UID=" & Login & ";Pwd=" & Password & ";database=WBServicing"
618
619For i = 1 To Len(strASCII)
620 strHex = LCase(Hex(Asc(Mid(strASCII, i, 1))))
621 If Len(strHex) = 1 Then strHex = "0" & strHex
622 strTemp = strTemp & strHex
623Next
624
625EncodeConnectionString = strTemp
626End Function
627
628
629Function InSecurityGroup(GroupName As String) As Boolean
630Dim rst As New ADODB.Recordset
631Dim SecurityGroup As New SecurityGroup
632
633On Error GoTo Err_Handler
634InSecurityGroup = colSecurityGroups.Item(GroupName).Member
635
636Exit Function
637Err_Handler:
638
639rst.Open "SELECT Is_Member('" & GroupName & "') AS Security", db, adOpenKeyset
640
641SecurityGroup.Name = GroupName
642If rst!Security = 1 Then
643 SecurityGroup.Member = True
644Else
645 SecurityGroup.Member = False
646End If
647
648colSecurityGroups.Add SecurityGroup, SecurityGroup.Name
649InSecurityGroup = SecurityGroup.Member
650
651End Function
652
653Sub InitializeConnection()
654Dim cmdAddLog As New ADODB.Command
655
656''strConnectionString = DecodeConnectionString(Mid(CGI_Cookie, 15))
657'
658''If Left(strConnectionString, 16) <> "driver={SQL Server}" Then
659'' SendHeader "Redirect"
660'' Send "<script language='Javascript'>self.location='LoginPage';</script>"
661'' SendFooter
662'' Exit Sub
663''End If
664'
665'If IsNull(Mid(CGI_Cookie, 15)) Or Mid(CGI_Cookie, 15) = "" Then
666' 'If no cookie, see if they're in the middle of logging in
667' If App.Title = "LoginProcessed" Then
668' 'LoginProcessed
669' SendHeader "Redirect"
670' Send "<script language='Javascript'>self.location='LoginProcessed';</script>"
671' SendFooter
672' Exit Sub
673' Else 'send them to the login page
674' 'LoginPage
675' SendHeader "Redirect"
676' Send "<script language='Javascript'>self.location='LoginPage';</script>"
677' SendFooter
678' Exit Sub
679' End If
680'End If
681'
682'If LoginName <> "clim" Then
683'With cmdAddLog
684' .CommandText = "INSERT tblLog (Page, QueryString, Username) VALUES ('" & App.Title & "', '" & Left(CGI_QueryString, 6000) & "', '" & LoginName & "')"
685' .ActiveConnection = db
686' .CommandType = adCmdText
687' .Execute
688'End With
689'End If
690
691
692strConnectionString = DecodeConnectionString(Mid(CGI_Cookie, 15))
693
694If Left(strConnectionString, 19) <> "driver={SQL Server}" Then
695 SendHeader "Redirect"
696 Send "<script language='Javascript'>self.location='LoginPage.exe';</script>"
697 SendFooter
698 Exit Sub
699End If
700
701'db.ConnectionString = "driver={SQL Server};server=Oak;database=WBServicing" &
702db.ConnectionString = strConnectionString
703db.ConnectionTimeout = 30
704db.CommandTimeout = 120
705db.Open
706
707strUserName = Left(Mid(strConnectionString, 37), InStr(Mid(strConnectionString, 37), ";") - 1) 'PEAR
708
709
710'If Initials() <> "clim" Then
711'With cmdAddLog
712' .CommandText = "INSERT tblLog (Page, QueryString, Username) VALUES ('" & App.Title & "', '" & Left(CGI_QueryString, 6000) & "', User)"
713' .ActiveConnection = db
714' .CommandType = adCmdText
715' .Execute
716'End With
717'End If
718
719End Sub
720
721Public Function AppDetailStyleSheet() As String
722
723
724AppDetailStyleSheet = AppDetailStyleSheet & "<style>" & vbCrLf
725AppDetailStyleSheet = AppDetailStyleSheet & "body {font-family : Arial, Helvetica, sans-serif;}" & vbCrLf
726AppDetailStyleSheet = AppDetailStyleSheet & "table {font-family : Arial, Helvetica, sans-serif; font-size : 10px;}" & vbCrLf
727AppDetailStyleSheet = AppDetailStyleSheet & "input {font-family : Arial, Helvetica, sans-serif; font-size : 10px;}" & vbCrLf
728AppDetailStyleSheet = AppDetailStyleSheet & "select {font-family : Arial, Helvetica, sans-serif; font-size : 10px;}" & vbCrLf
729AppDetailStyleSheet = AppDetailStyleSheet & "option {font-family : Arial, Helvetica, sans-serif; font-size : 10px;}" & vbCrLf
730AppDetailStyleSheet = AppDetailStyleSheet & "textarea {font-family : Arial, Helvetica, sans-serif; font-size : 11px;}" & vbCrLf
731AppDetailStyleSheet = AppDetailStyleSheet & ".MediumFont {font-family : Arial, Helvetica, sans-serif; font-size : 11px;}" & vbCrLf
732AppDetailStyleSheet = AppDetailStyleSheet & ".details{font-size : 10px; color : #000000; text-decoration : none;}" & vbCrLf
733AppDetailStyleSheet = AppDetailStyleSheet & ".detailssub{font-size : 10px; color : #696969; text-decoration : none;}" & vbCrLf
734AppDetailStyleSheet = AppDetailStyleSheet & ".detailssub:hover{font-size : 10px; color :#bc8f8f; text-decoration : none;}" & vbCrLf
735AppDetailStyleSheet = AppDetailStyleSheet & ".grid{font-size : 10px; color : #000000; text-decoration : none;}" & vbCrLf
736'AppDetailStyleSheet = AppDetailStyleSheet & ".gridsub{font-size : 10px; color : #483d8b; text-decoration : none;}" & vbCrLf
737AppDetailStyleSheet = AppDetailStyleSheet & ".gridsub{font-size : 10px; font-weight : bold; color : #003399; text-decoration : none;}" & vbCrLf
738AppDetailStyleSheet = AppDetailStyleSheet & ".gridsub:hover{font-size : 10px; color :#dcdcdc; text-decoration : none;}" & vbCrLf
739AppDetailStyleSheet = AppDetailStyleSheet & ".PageTitle{font-size : 15px; font-weight : bold;}" & vbCrLf
740AppDetailStyleSheet = AppDetailStyleSheet & ".tblhdrfnt{font-size : 11px; font-weight : bold;}" & vbCrLf
741AppDetailStyleSheet = AppDetailStyleSheet & ".Required{font-size : 11px; color : #DC143C ; font-weight : bold;}" & vbCrLf
742AppDetailStyleSheet = AppDetailStyleSheet & ".tblhdrclr{background-color : Silver;}" & vbCrLf
743AppDetailStyleSheet = AppDetailStyleSheet & ".detailbgclr{background-color : #d3d3d3;}" & vbCrLf
744AppDetailStyleSheet = AppDetailStyleSheet & ".detailtblbg{background-color : #dcdcdc;}" & vbCrLf
745AppDetailStyleSheet = AppDetailStyleSheet & ".lnavhdrbg{background-color :#bc8f8f;}" & vbCrLf
746AppDetailStyleSheet = AppDetailStyleSheet & ".tblgridhdrbg{background-color :#778899;}" & vbCrLf
747AppDetailStyleSheet = AppDetailStyleSheet & ".tblgridbg{background-color :#b0c4de;}" & vbCrLf
748AppDetailStyleSheet = AppDetailStyleSheet & ".moneyhdrclr{background-color :#8fbc8f;}" & vbCrLf
749AppDetailStyleSheet = AppDetailStyleSheet & ".moneytblbg{background-color :#f0fff0;}" & vbCrLf
750AppDetailStyleSheet = AppDetailStyleSheet & ".rowbgcolor{background-color : #EEEEEE;}" & vbCrLf
751AppDetailStyleSheet = AppDetailStyleSheet & "</style>" & vbCrLf
752
753End Function
754
755
756Sub PageTitle(strPage As String)
757Send "<table width='100%' border='0' cellspacing='5' cellpadding='0'>"
758Send "<tr>"
759Send "<td width='130' valign='top'>" ' bgcolor='#ffe4e1'>"
760Send " <table width='100%' border='0' cellspacing='0' cellpadding='2'>"
761Send " <tr>"
762Send " <td class='tblhdrfnt'><a href='MainMenu.exe'>Main Menu</a></td>"
763Send " </tr>"
764Send " </table>"
765Send "</td>"
766
767Send "<td class='PageTitle'>" & strPage & "</td>"
768Send "</tr>"
769Send "</table>"
770
771End Sub
772
773Sub PageTopNavigation()
774
775Send "<TABLE width='100%' border='0' style='border-top: medium double #AD8F8F;' cellpadding='0' cellspacing='0'>"
776Send "<TR><td>"
777Send "<table>"
778Send "<tr>"
779If InSecurityGroup("ViewClaimantProspectingPage") Then
780 Send "<td align='center'><a href='Prospecting.exe'><img src='/Structured/prospecting.jpg' border=0 alt='Claimant Prospecting' align='center' width=31 height=28></a><br>Claimant Prospecting</td>"
781End If
782
783Send "<TD align='center' valign='top'><a href='ClaimantList.exe?list=all'><img src='/Structured/Claimant.jpg' border=0 alt='Claimant List' align='center' width=31 height=28></a><br>Claimant</td>" 'width=31 height=28
784
785If InSecurityGroup("grp_AE") Then
786 Send "<td align='center'><a href='ClaimantList.exe?list=my'><img src='/Structured/Claimant.jpg' border=0 alt='My Claimant List' align='center' width=31 height=28></a><br>My Claimant</td>"
787End If
788
789Send "<td align='center' valign='top'><a href='AnnuitiesList.exe'><img src='/Structured/Annuity.jpg' border=0 alt='Annuity List' align='center' width=31 height=28></a><br>Annuity</td>"
790
791Send "<td align='center' valign='top'><a href='DealList.exe'><img src='/Structured/Deal.jpg' border=0 alt='Deal List' align='center' width=31 height=28></a><br>Deal</td>"
792
793Send "<td align='center' valign='top'><a href='javascript: " & SmallWindow("CourtOrder", "CourtOrder", "CourtOrder.exe?CO_list=true", False, True, False, 515, 460) & "'><img src='/Structured/CourtOrder.jpg' border=0 alt='Court Order List' align='center' width=31 height=28></a><br>Court Order</td>"
794
795If InSecurityGroup("grp_SalesCoordinator") Or InSecurityGroup("grp_SuperAdmin") Then
796 Send "<td align='center' valign='top'><a href='AssignAE.exe'><img src='/Structured/Agent.jpg' border=0 alt='Re-assign AE' align='center' width=31 height=28></a><br>Re-assign AE</td>"
797End If
798
799Send "<td align='center' valign='top'><a href='javascript: " & SmallWindow("AnswerCalls", "AnswerCalls", "AnswerCalls.exe", False, True, False, 440, 400) & "'><img src='/Structured/Agent.jpg' border=0 alt='Answer Call' align='center' width=31 height=28></a><br>Answer Call</td>"
800
801If InSecurityGroup("grp_AE") = False Then
802 Send "<td align='center' valign='top'><a href='QueryList.exe'><img src='/Structured/Query.jpg' border=0 alt='Query' align='center' width=31 height=28></a><br>Query</td>"
803End If
804
805Send "<td align='center' valign='top'><a href='ReportMenu.exe'><img src='/Structured/Report.jpg' border=0 alt='Report' align='center' width=31 height=28></a><br>Report</td>"
806
807If InSecurityGroup("grp_SuperAdmin") Then
808 Send "<td align='center' valign='top'><a href='http://webserv3/StructuredSettlement/EditMerges.exe' target='" & App.Title & "'><img src='/Structured/LetterExpress.jpg' border=0 alt='Letter Express' align='center' width=31 height=28></a><br>Merges</td>"
809' Send "<td align='center' valign='top'><a href='EditMerges.exe'><img src='/Structured/LetterExpress.jpg' border=0 alt='Letter Express' align='center' width=31 height=28></a><br>Merges</td>"
810End If
811
812Send "<td align='center' valign='top'><a href='javascript: " & SmallWindow("IssuerGuarantor", "IssuerGuarantor", "IssuerGuarantor.exe?IssGua_list=true", False, True, False, 350, 450) & "'><img src='/Structured/IssuerGuarantor.jpg' border=0 alt='Issuer / Owner' align='center' width=31 height=28></a><br>Issuer/Owner</td>"
813
814If InSecurityGroup("grp_SuperAdmin") Or InSecurityGroup("grp_Executive") Or InSecurityGroup("grp_Legal") Or InSecurityGroup("grp_ComplianceAnalyst") Then
815 Send "<td align='center' valign='top'><a href='javascript: " & SmallWindow("IssuerGuarantor", "IssuerGuarantor", "IssuerGuarantor.exe", False, False, False, 350, 450) & "'><img src='/Structured/IssuerGuarantor.jpg' border=0 alt='Issuer / Owner Entry Form' align='center' width=31 height=28></a><br>New Issuer/Owner</td>"
816End If
817
818Send "<td align='center' valign='top'><a href='javascript: " & SmallWindow("Attorney", "Attorney", "Attorney.exe?Attorney_list=true", False, True, False, 350, 400) & "'><img src='/Structured/Attorney.jpg' border=0 alt='Attorney' align='center' width=31 height=28></a><br>Attorney</td>"
819
820If InSecurityGroup("grp_SuperAdmin") Or InSecurityGroup("grp_Executive") Or InSecurityGroup("grp_Legal") Or InSecurityGroup("grp_ComplianceAnalyst") Then
821 Send "<td align='center' valign='top'><a href='javascript: " & SmallWindow("Attorney", "Attorney", "Attorney.exe", False, False, False, 350, 400) & "'><img src='/Structured/Attorney.jpg' border=0 alt='Attorney Entry Form' align='center' width=31 height=28></a><br>New Attorney</td>"
822End If
823
824Send "<td align='center' valign='top'><a href='javascript: " & SmallWindow("StaticList", "StaticList", "StaticList.exe", False, True, False, 350, 400) & "'><img src='/Structured/StaticList.jpg' border=0 alt='Static List' align='center' width=31 height=28></a><br>Static List</td>"
825
826If InSecurityGroup("grp_SuperAdmin") Or InSecurityGroup("grp_Research") Then
827 Send "<td align='center' valign='top'><a href='ResearchMenu.exe'><img src='/Structured/Research.jpg' border=0 alt='Research Menu' align='center' width=31 height=28></a><br>Research</td>"
828End If
829
830Send "</TR>"
831Send "</table>"
832
833Send "</td></TR>"
834Send "</TABLE>"
835
836End Sub
837
838Function SmallWindow(ByVal strWindowName As String, strWindowTitle As String, strURL As String, Optional bolResizable As Boolean = True, Optional bolScrollBars As Boolean = False, Optional bolCopyHistory As Boolean = False, Optional intWidth As Integer = 335, Optional intHeight As Integer = 255) As String
839
840SmallWindow = strWindowName & "=window.open(""" & strURL & """,""" & strWindowTitle & """,""" & IIf(bolResizable, "resizable=yes,", "resizable=no,") & IIf(bolScrollBars, "scrollbars=1,", "scrollbars=0,") & IIf(bolCopyHistory, "copyhistory=1,", "copyhistory=0,") & "width=" & intWidth & ",height=" & intHeight & """);" & strWindowName & ".focus();"
841
842End Function
843
844Sub StateList()
845strState = "AK,AL,AR,AZ,CA,CO,CT,DC,DE,FL,GA,GU,HI,IA,ID,IL,IN,KS,KY,LA,MA,MD,ME,MI,MN,MO,MS,MT,NC,ND,NE,NH,NJ,NM,NV,NY,OH,OK,OR,PA,PR,RI,SC,SD,TN,TX,UT,VA,VT,WA,WI,WV,WY"
846arrState = Split(strState, ",")
847End Sub
848
849Sub LeftMenu()
850
851'<!-- BEGIN Left Column -->
852Send "<td width=130 rowspan='3' valign='top' bgcolor='#ffe4e1'>"
853Send " <table width='100%' border='0' cellspacing='0' cellpadding='2' style='border: 1px solid #bc8f8f;'>"
854
855'*********
856SearchTool
857'UserInfo
858RecallList
859TaskList
860'*********
861
862Send " </table>"
863Send "</td>"
864'<!-- END Left Column -->
865
866End Sub
867
868Sub SearchTool()
869
870Send " <tr class='lnavhdrbg'>"
871Send " <td class='tblhdrfnt'>SEARCH</td>"
872Send " </tr>"
873Send " <tr>"
874Send " <td>Type in the name and press GO to search. Leave empty to view all. "
875
876Send "<SCRIPT Language='JavaScript'>"
877Send "// When the enter key is hit it will automatically click the button"
878Send "function clickGoBtnForSearch()"
879Send "{"
880 Send "if (event.keyCode == 13)"
881 Send "{"
882 Send "//document.F.Name.value='Andrew'"
883 Send "document.Search.searchSubmit.click();"
884 Send "}"
885Send "}"
886Send "//document.onkeydown = keyDown"
887Send "</SCRIPT>"
888
889 Send "<FORM NAME='Search' ACTION='" & App.Title & ".exe?" & Left(CGI_QueryString, 6000) & "' METHOD='Post'>"
890 Send "<SELECT NAME='Key'>"
891 Send "<option value='ClaimantList.exe' " & IIf(App.Title = "ClaimantInfo" Or App.Title = "ClaimantList", "SELECTED", "") & ">Claimant</option>"
892 Send "<option value='AnnuitiesList.exe' " & IIf(App.Title = "AnnuityInfo" Or App.Title = "AnnuitiesList", "SELECTED", "") & ">Annuity</option>"
893 Send "<option value='DealList.exe' " & IIf(App.Title = "DealInfo" Or App.Title = "DealList", "SELECTED", "") & ">Deal</option>"
894 Send "<option value='CourtOrder'>Court Order</option>"
895 Send "<option value='IssuerGuarantor'>Issuer/Owner</option>"
896 Send "<option value='Attorney'>Attorney</option>"
897 If InSecurityGroup("grp_SuperAdmin") Then
898 Send "<option value='Employee'>Employee</option>"
899 End If
900 Send "</SELECT><br>"
901
902 Send "<input type='text' name='Search' size='17' maxlength='50' value='" & GetCgiValue("Search") & "' onkeydown='clickGoBtnForSearch();'>"
903 Send "<input type='Button' name='searchSubmit' value='GO' onClick='return formSubmit(this.form);'><br>" 'refer to SendHeader
904 Send "<Input type='radio' name='Position' value='StartWith' checked> Starts with<Br>"
905 Send "<Input type='radio' name='Position' value='Contain'> Contains"
906 'LookInFields
907
908 Send "</FORM>"
909
910Send " </td>"
911Send " </tr>"
912
913End Sub
914
915Sub LookInFields()
916Dim Field As Field
917Dim rst As New ADODB.Recordset
918
919Send "<select name='Fields'>"
920' Select Case GetCgiValue("Key")
921' Case "Claimant"
922
923 With rst
924 .Open "Claimant", db, adOpenForwardOnly
925 End With
926
927 For Each Field In rst.Fields
928 If Field.Type = adVarChar Then
929 Send "<option value='" & Field.Name & "'>" & Field.Name & "</option>"
930 End If
931 Next
932
933 rst.Close
934
935' Send "<option value='Claimant_Name'>Claimant_Name</option>"
936' Case Else
937'
938' End Select
939
940Send "</select>"
941End Sub
942
943Sub UserInfo()
944Dim rstCalls As New ADODB.Recordset
945
946Send "<tr class='lnavhdrbg'>"
947 Send "<td class='tblhdrfnt'>User Info</td>"
948Send "</tr>"
949
950If GetCgiValue("UserInfo") = "true" Then
951 With rstCalls
952 .Open "SELECT UserName, Extension, Calls=Count(*) " & _
953 "FROM Employee " & _
954 "INNER JOIN POPLAR.CallData.dbo.tblEstablished ON Extension = InternalCallingExt " & _
955 "WHERE AnsweringDeviceType = 'E' " & _
956 "AND Timestamp >= DateAdd(Day, -1, GetDate()) " & _
957 "AND UserName = '" & Initials() & "' " & _
958 "GROUP BY UserName, Extension", db, adOpenForwardOnly
959
960 Send "<tr>"
961 Send "<td>"
962 Send "<table>"
963 Send "<tr>"
964 Send "<td>User Name: </td>"
965 Send "<td>" & Initials() & "</td>"
966 Send "</tr>"
967' Send "<tr>"
968' Send "<td>Extension: </td>"
969' Send "<td>" & !Extension & "</td>"
970' Send "</tr>"
971 Send "<tr>"
972 Send "<td>Outbound Calls: </td>"
973 Send "<td class='Required'>" & IIf(.EOF, 0, !Calls) & "</td>"
974 Send "</tr>"
975 Send "</table>"
976 Send "</td>"
977 Send "</tr>"
978 End With
979
980Else
981 Send "<tr>"
982 Send "<td>"
983 Send "<a href=" & App.Title & ".exe?ID=" & GetCgiValue("ID") & "&UserInfo=true>show info</a>"
984 Send "</td>"
985 Send "</tr>"
986End If
987
988
989End Sub
990
991Sub RecallList()
992Dim i As Integer
993Dim rstRecall As New ADODB.Recordset
994
995With rstRecall
996'If Initials() = "clim" Then
997 .Open "SELECT ID, Descriptor, DateDue " & _
998 "FROM tblTask " & _
999 "WHERE (Completed IS NULL OR Completed = 0) " & _
1000 "AND DateAppear <= '" & Now() & "' " & _
1001 "AND Function IN ('Recall', 'Call') " & _
1002 "AND TaskFor = '" & Initials() & "' " & _
1003 "ORDER BY DateDue Desc", db, adOpenStatic
1004
1005 If .RecordCount > 0 Then
1006 Send " <tr class='lnavhdrbg'>"
1007 Send " <td class='tblhdrfnt'>Recalls List</td>"
1008 Send " </tr>"
1009
1010 If GetCgiValue("RecallList") = "all" Then 'If this is true, display tasks as a separate page, else diplay them in a included list
1011 Do Until .EOF
1012 Send "<tr><td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td></tr>"
1013 .MoveNext
1014 Loop
1015 'Send "<td><A HREF='" & App.Title & ".exe?" & Left(CGI_QueryString, 6000 - Len(Right(CGI_QueryString, 15))) & "'>--- close ---</a></font></td>"
1016 'Send "<td><A HREF='" & App.Title & ".exe?" & Left(CGI_QueryString, Len(CGI_QueryString) - Len(Right(CGI_QueryString, 15))) & "'>--- close ---</a></font></td>"
1017 Else
1018 If .RecordCount > 5 Then
1019 For i = 1 To 5
1020 Send "<tr><td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td></tr>"
1021 .MoveNext
1022 Next
1023
1024 'Send "<td><A HREF='" & App.Title & ".exe?" & Left(CGI_QueryString, 6000) & "&RecallList=all'>--- view all ---</a></font></td>"
1025 Send "<td><A HREF='JavaScript:" & SmallWindow("Task", "Task", "Task.exe?Submit=AllRecall", True, True, False, 420, 400) & "'>--- view all ---</a></font>"
1026
1027 Else
1028 Do Until .EOF
1029 Send "<tr><td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td></tr>"
1030 .MoveNext
1031 Loop
1032 End If
1033 End If
1034 End If
1035
1036'Else
1037' .Open "SELECT ID, Descriptor, DateDue " & _
1038' "FROM tblTask " & _
1039' "WHERE (Completed IS NULL OR Completed = 0) " & _
1040' "AND DateAppear <= '" & Now() & "' " & _
1041' "AND Function IN ('Recall', 'Call') " & _
1042' "AND TaskFor = '" & Initials() & "' " & _
1043' "ORDER BY DateDue Desc", db, adOpenForwardOnly
1044' If Not .EOF Then
1045' Send " <tr class='lnavhdrbg'>"
1046' Send " <td class='tblhdrfnt'>Recalls List</td>"
1047' 'Send "<a href='javascript: " & SmallWindow("Report", "Report", "http://K27/cgi-bin/crweb.exe/Reports/Structured/TaskReport.rpt?init=actx&user0=WebLogin&password0=web&prompt0=" & Initials() & "", True, True, , 680, 520) & "'><img src='/Structured/smbtn_Report.gif' border=0 alt='Report' align='absmiddle'></a></td>"
1048' Send " </tr>"
1049'
1050'' If GetCgiValue("TurnRecallOn") = "true" Then
1051' Do While Not .EOF
1052' Send " <tr>"
1053' 'Send " <td><a href='javascript:" & SmallWindow("frmNotes", "frmNotes", "Notes.exe?ID=" & !Claimant_ID & "&Appointments_ID=" & !Rn_Appointments_ID & "&Type=Set+Recall", True, True, False, 400, 400) & "'>" & SendIfNull(!Claimant_First_Name) & " " & SendIfNull(!Claimant_Last_Name) & " " & FormatDateTime(!Appt_Date, 2) & " " & FormatDateTime(!Start_Time, 4) & "</a></td>"
1054' Send " <td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td>"
1055' Send " </tr>"
1056' .MoveNext
1057' Loop
1058'' Else
1059'' Send "<tr><td><a href='" & App.Title & ".exe?" & Left(CGI_QueryString, 6000) & "&TurnRecallOn=true'>Turn Recall List On</a></td></tr>"
1060'' End If
1061'
1062' End If
1063'
1064'End If
1065
1066
1067End With
1068
1069End Sub
1070
1071Sub TaskList()
1072Dim i As Integer
1073Dim rstTask As New ADODB.Recordset
1074
1075With rstTask
1076'If Initials() = "clim" Then
1077 .Open "SELECT ID, Descriptor, DateDue, Function " & _
1078 "FROM tblTask " & _
1079 "WHERE (Completed IS NULL OR Completed = 0) " & _
1080 "AND DateAppear <= '" & Now() & "' " & _
1081 "AND Function IN ('Cash Advance', 'Document Fulfillment', 'Meeting', 'Other', 'To-Do') " & _
1082 "AND TaskFor = '" & Initials() & "' " & _
1083 "ORDER BY DateDue Desc", db, adOpenStatic
1084
1085 If .RecordCount > 0 Then
1086 Send " <tr class='lnavhdrbg'>"
1087 Send " <td class='tblhdrfnt'>Task List</td>"
1088 Send " </tr>"
1089
1090' If GetCgiValue("TaskList") = "quicksheet" Then
1091' SendHeader ("My Task List")
1092' Send "<BODY bgcolor=#F7EFDE>"
1093' Send ("<SCRIPT Language='javascript'>")
1094' Send ("self.focus();")
1095' Send ("</SCRIPT>")
1096' Send ("<h2 ALIGN=CENTER>My Task List</h2>")
1097' Do Until .EOF
1098' Send ("<A HREF='JavaScript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, , , , 300, 370) & "' class='LeftSideNavigation'>" & FormatDateTime(!DateDue, 2) & " " & !Function & "-" & !Descriptor & "</a></font><br>")
1099' .MoveNext
1100' Loop
1101' Send "<p>"
1102' Send "<a href='Javascript: self.close();'>Close Window</a>"
1103' SendFooter
1104
1105 If GetCgiValue("TaskList") = "all" Then 'If this is true, display tasks as a separate page, else diplay them in a included list
1106 Do Until .EOF
1107 Send "<tr><td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td></tr>"
1108 .MoveNext
1109 Loop
1110 'Send "<td><A HREF='" & App.Title & ".exe?" & Left(CGI_QueryString, 6000 - Len(Right(CGI_QueryString, 15))) & "'>--- close ---</a></font></td>"
1111 'Send "<td><A HREF='" & App.Title & ".exe?" & Left(CGI_QueryString, Len(CGI_QueryString) - Len(Right(CGI_QueryString, 15))) & "'>--- close ---</a></font></td>"
1112 Else
1113 If .RecordCount > 5 Then
1114 For i = 1 To 5
1115 'Send ("<A HREF='JavaScript:" & SmallWindow("SetTask", "SetTask", "SetTask?Action=" & IIf(!TableName = "tblClient", "EditClientTask", IIf(!TableName = "tblBrokerRepresentative", "EditRepTask", "EditCompanyTask")) & "&ID=" & !ID, , , , 300, 370) & "' class='LeftSideNavigation'>" & FormatDateTime(!DateDue, 2) & " " & !Function & "-" & !Descriptor & "</a></font><br>")
1116 Send "<tr><td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td></tr>"
1117 .MoveNext
1118 Next
1119 Send "<td>"
1120' Send "<A HREF='" & App.Title & ".exe?" & Left(CGI_QueryString, 6000) & "&TaskList=all'>- view all -</a></font> "
1121 Send "<A HREF='JavaScript:" & SmallWindow("Task", "Task", "Task.exe?Submit=AllTask", True, True, False, 400, 400) & "'>--- view all ---</a></font>"
1122 Send "</td>"
1123 Else
1124 Do Until .EOF
1125 Send "<tr><td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td></tr>"
1126 .MoveNext
1127 Loop
1128 End If
1129 End If
1130 End If
1131
1132'Else
1133' .Open "SELECT ID, Descriptor, DateDue " & _
1134' "FROM tblTask " & _
1135' "WHERE (Completed IS NULL OR Completed = 0) " & _
1136' "AND DateAppear <= '" & Now() & "' " & _
1137' "AND Function IN ('Cash Advance', 'Document Fulfillment', 'Meeting', 'Other', 'To-Do') " & _
1138' "AND TaskFor = '" & Initials() & "' " & _
1139' "ORDER BY DateDue Desc", db, adOpenForwardOnly
1140'
1141' If Not .EOF Then
1142' Send " <tr class='lnavhdrbg'>"
1143' Send " <td class='tblhdrfnt'>Task List</td>"
1144' Send " </tr>"
1145'
1146'' If GetCgiValue("TurnRecallOn") = "true" Then
1147' Do While Not .EOF
1148' Send " <tr>"
1149' 'Send " <td><a href='javascript:" & SmallWindow("frmNotes", "frmNotes", "Notes.exe?ID=" & !Claimant_ID & "&Appointments_ID=" & !Rn_Appointments_ID & "&Type=Set+Recall", True, True, False, 400, 400) & "'>" & SendIfNull(!Claimant_First_Name) & " " & SendIfNull(!Claimant_Last_Name) & " " & FormatDateTime(!Appt_Date, 2) & " " & FormatDateTime(!Start_Time, 4) & "</a></td>"
1150' 'Send " <td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?ID=" & !Claimant_ID & "&Appointments_ID=" & !Rn_Appointments_ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!Appt_Date, 2) & " " & SendIfNull(!Claimant_First_Name) & " " & SendIfNull(!Claimant_Last_Name) & "</a></td>"
1151' Send " <td><a href='javascript:" & SmallWindow("Task", "Task", "Task.exe?Submit=Edit&ID=" & !ID, True, True, False, 400, 400) & "'>" & FormatDateTime(!DateDue, 2) & " " & !Descriptor & "</a></td>"
1152' Send " </tr>"
1153' .MoveNext
1154' Loop
1155'' Else
1156'' Send "<tr><td><a href='" & App.Title & ".exe?" & Left(CGI_QueryString, 6000) & "&TurnRecallOn=true'>Turn Recall List On</a></td></tr>"
1157'' End If
1158'
1159' End If
1160'
1161'
1162'End If
1163
1164End With
1165
1166End Sub
1167
1168
1169Sub SubmitOnceScript()
1170Send "var submitcount=0;"
1171Send "function disableForm(submitButtonName)"
1172Send "{"
1173 Send "if (submitcount > 0)"
1174 Send "{"
1175 Send "submitButtonName.disabled = true;"
1176' Send "alert('This form has already been submitted. Thanks!');"
1177 Send "return false;"
1178 Send "}"
1179
1180 Send "else"
1181
1182 Send "{"
1183 Send "submitcount++;"
1184 Send "return true;"
1185 Send "}"
1186Send "}"
1187End Sub
1188Sub ValidateDateScript()
1189
1190Send "// Check browser version"
1191Send "var isNav4 = false, isNav5 = false, isIE4 = false"
1192Send "var strSeperator = ""/""; "
1193Send "// If you are using any Java validation on the back side you will want to use the / because "
1194Send "// Java date validations do not recognize the dash as a valid date separator."
1195Send "var vDateType = 1; // Global value for type of date format"
1196Send "var vYearType = 4; //Set to 2 or 4 for number of digits in the year for Netscape"
1197Send "var vYearLength = 2; // Set to 4 if you want to force the user to enter 4 digits for the year before "
1198Send "var err = 0; // Set the error code to a default of zero"
1199Send "if(navigator.appName == ""Netscape"") "
1200Send " {"
1201Send " if (navigator.appVersion < ""5"") "
1202Send " {"
1203Send " isNav4 = true;"
1204Send " isNav5 = false;"
1205Send " }"
1206Send " else"
1207Send " if (navigator.appVersion > ""4"") "
1208Send " {"
1209Send " isNav4 = false;"
1210Send " isNav5 = true;"
1211Send " }"
1212Send " }"
1213Send "else "
1214Send " {"
1215Send " isIE4 = true;"
1216Send " }"
1217Send " "
1218Send "function DateFormat(vDateName, vDateValue, e, dateCheck) "
1219Send "{"
1220Send "// vDateName = object name"
1221Send "// vDateValue = value in the field being checked"
1222Send "// e = event"
1223Send "// dateCheck "
1224Send "// True = Verify that the vDateValue is a valid date"
1225Send "// False = Format values being entered into vDateValue only"
1226Send "// vDateType"
1227Send "// 1 = mm/dd/yyyy"
1228Send "// 2 = yyyy/mm/dd"
1229Send "// 3 = dd/mm/yyyy"
1230Send "vDateType =1;"
1231Send "//Enter a tilde sign for the first number and you can check the variable information."
1232Send "if (vDateValue == ""~"") "
1233Send " {"
1234Send " alert(""AppVersion = ""+navigator.appVersion+"" \nNav. 4 Version = ""+isNav4+"" \nNav. 5 Version = ""+isNav5+"" \nIE Version = ""+isIE4+"" \nYear Type = ""+vYearType+"" \nDate Type = ""+vDateType+"" \nSeparator = ""+strSeperator);"
1235Send " vDateName.value = """";"
1236Send " vDateName.focus();"
1237Send " return true;"
1238Send " }"
1239Send " "
1240Send "var whichCode = (window.Event) ? e.which : e.keyCode;"
1241Send "// Check to see if a seperator is already present."
1242Send "// bypass the date if a seperator is present and the length greater than 8"
1243Send "if (vDateValue.length > 8 && isNav4) "
1244Send " {"
1245Send " if ((vDateValue.indexOf(""-"") >= 1) || (vDateValue.indexOf(""/"") >= 1))"
1246Send " return true;"
1247Send " }"
1248Send " "
1249Send "//Eliminate all the ASCII codes that are not valid"
1250Send "var alphaCheck = "" abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ/-"";"
1251Send "if (alphaCheck.indexOf(vDateValue) >= 1) "
1252Send " {"
1253Send " if (isNav4) "
1254Send " {"
1255Send " vDateName.value = """";"
1256Send " vDateName.focus();"
1257Send " vDateName.select();"
1258Send " return false;"
1259Send " }"
1260Send " else "
1261Send " {"
1262Send " vDateName.value = vDateName.value.substr(0, (vDateValue.length-1));"
1263Send " return false;"
1264Send " }"
1265Send " }"
1266Send " "
1267Send "//Ignore the Netscape value for backspace. IE has no value "
1268Send "if (whichCode == 8) "
1269Send "return false;"
1270Send "else "
1271Send " { "
1272Send " //Create numeric string values for 0123456789/"
1273Send " //The codes provided include both keyboard and keypad values"
1274Send " var strCheck = '47,48,49,50,51,52,53,54,55,56,57,58,59,95,96,97,98,99,100,101,102,103,104,105';"
1275Send " if (strCheck.indexOf(whichCode) != -1) "
1276Send " {"
1277Send " if (isNav4) "
1278Send " {"
1279Send " if (((vDateValue.length < 6 && dateCheck) || (vDateValue.length == 7 && dateCheck)) && (vDateValue.length >=1)) "
1280Send " {"
1281Send " alert(""Invalid Date\nPlease Re-Enter"");"
1282Send " vDateName.value = """";"
1283Send " vDateName.focus();"
1284Send " vDateName.select();"
1285Send " return false;"
1286Send " } "
1287Send " if (vDateValue.length == 6 && dateCheck) "
1288Send " {"
1289Send " var mDay = vDateName.value.substr(2,2);"
1290Send " var mMonth = vDateName.value.substr(0,2);"
1291Send " var mYear = vDateName.value.substr(4,4)"
1292Send " "
1293Send " //Turn a two digit year into a 4 digit year"
1294Send " if (mYear.length == 2 && vYearType == 4) "
1295Send " {"
1296Send " var mToday = new Date();"
1297Send " //If the year is greater than 30 years from now use 19, otherwise use 20"
1298Send " var checkYear = mToday.getFullYear() + 30; "
1299Send " var mCheckYear = '20' + mYear;"
1300Send " if (mCheckYear >= checkYear)"
1301Send " mYear = '19' + mYear;"
1302Send " else"
1303Send " mYear = '20' + mYear;"
1304Send " }"
1305Send " var vDateValueCheck = mMonth+strSeperator+mDay+strSeperator+mYear;"
1306Send " if (!dateValid(vDateValueCheck)) "
1307Send " {"
1308Send " alert(""Invalid Date\nPlease Re-Enter"");"
1309Send " vDateName.value = """";"
1310Send " vDateName.focus();"
1311Send " vDateName.select();"
1312Send " return false;"
1313Send " }"
1314Send " return true;"
1315Send " }"
1316Send " else "
1317Send " {"
1318Send " // Reformat the date for validation and set date type to a 1"
1319Send " if (vDateValue.length >= 8 && dateCheck) "
1320Send " {"
1321Send " var mDay = vDateName.value.substr(2,2);"
1322Send " var mMonth = vDateName.value.substr(0,2);"
1323Send " var mYear = vDateName.value.substr(4,4)"
1324Send " vDateName.value = mMonth+strSeperator+mDay+strSeperator+mYear;"
1325Send " "
1326Send " var vDateValueCheck = mMonth+strSeperator+mDay+strSeperator+mYear;"
1327Send " if (!dateValid(vDateValueCheck)) "
1328Send " {"
1329Send " alert(""Invalid Date\nPlease Re-Enter"");"
1330Send " vDateName.value = """";"
1331Send " vDateName.focus();"
1332Send " vDateName.select();"
1333Send " return false;"
1334Send " }"
1335Send " vDateType "
1336Send " return true;"
1337Send " }"
1338Send " else "
1339Send " {"
1340Send " if (((vDateValue.length < 8 && dateCheck) || (vDateValue.length == 9 && dateCheck)) && (vDateValue.length >=1)) "
1341Send " {"
1342Send " alert(""Invalid Date\nPlease Re-Enter"");"
1343Send " vDateName.value = """";"
1344Send " vDateName.focus();"
1345Send " vDateName.select();"
1346Send " return false;"
1347Send " }"
1348Send " }"
1349Send " }"
1350Send " }"
1351Send " else "
1352Send " {"
1353Send " "
1354Send " // Non isNav Check"
1355Send " if (((vDateValue.length < 8 && dateCheck) || (vDateValue.length == 9 && dateCheck)) && (vDateValue.length >=1)) "
1356Send " {"
1357Send " alert(""Invalid Date\nPlease Re-Enter"");"
1358Send " vDateName.value = """";"
1359Send " vDateName.focus();"
1360Send " return true;"
1361Send " }"
1362Send " // Reformat date to format that can be validated. mm/dd/yyyy"
1363Send " if (vDateValue.length >= 8 && dateCheck) "
1364Send " { "
1365Send " var mMonth = vDateName.value.substr(0,2);"
1366Send " var mDay = vDateName.value.substr(3,2);"
1367Send " var mYear = vDateName.value.substr(6,4)"
1368Send " if (vYearLength == 4) "
1369Send " {"
1370Send " if (mYear.length < 4) "
1371Send " {"
1372Send " alert(""Invalid Date\nPlease Re-Enter"");"
1373Send " vDateName.value = """";"
1374Send " vDateName.focus();"
1375Send " return true;"
1376Send " }"
1377Send " }"
1378Send " // Store reformatted date to new variable for validation."
1379Send " var vDateValueCheck = mMonth+strSeperator+mDay+strSeperator+mYear;"
1380Send " "
1381Send " if (mYear.length == 2 && vYearType == 4 && dateCheck) "
1382Send " {"
1383Send " "
1384Send " //Turn a two digit year into a 4 digit year"
1385Send " var mToday = new Date();"
1386Send " "
1387Send " //If the year is greater than 36 years from now use 19, otherwise use 20"
1388Send " var checkYear = mToday.getFullYear() + 36; "
1389Send " var mCheckYear = '20' + mYear;"
1390Send " "
1391Send " if (mCheckYear >= checkYear) "
1392Send " mYear = '19' + mYear;"
1393Send " else"
1394Send " mYear = '20' + mYear;"
1395Send " "
1396Send " vDateValueCheck = mMonth+strSeperator+mDay+strSeperator+mYear;"
1397Send " vDateName.value = mMonth+strSeperator+mDay+strSeperator+mYear;"
1398Send " } "
1399Send " if (!dateValid(vDateValueCheck)) "
1400Send " {"
1401Send " alert(""Invalid Date\nPlease Re-Enter"");"
1402Send " vDateName.value = """";"
1403Send " vDateName.focus();"
1404Send " return true;"
1405Send " }"
1406Send " return true;"
1407Send " }"
1408Send " else"
1409Send " {"
1410Send " if (vDateValue.length == 2) "
1411Send " {"
1412Send " vDateName.value = vDateValue+strSeperator;"
1413Send " }"
1414Send " if (vDateValue.length == 5) "
1415Send " {"
1416Send " vDateName.value = vDateValue+strSeperator;"
1417Send " }"
1418Send " return true;"
1419Send " }"
1420Send " }"
1421Send " "
1422Send " if (vDateValue.length == 10&& dateCheck) "
1423Send " {"
1424Send " if (!dateValid(vDateName)) "
1425Send " {"
1426Send " // Un-comment the next line of code for debugging the dateValid() function error"
1427Send " //messages"
1428Send " //alert(err); "
1429Send " alert(""Invalid Date\nPlease Re-Enter"");"
1430Send " vDateName.focus();"
1431Send " vDateName.select();"
1432Send " }"
1433Send " }"
1434Send " return false;"
1435Send " }"
1436Send " else "
1437Send " {"
1438Send " "
1439Send " // If the value is not in the string return the string minus the last"
1440Send " // key entered."
1441Send " if (isNav4) "
1442Send " {"
1443Send " vDateName.value = """";"
1444Send " vDateName.focus();"
1445Send " vDateName.select();"
1446Send " return false;"
1447Send " }"
1448Send " else"
1449Send " {"
1450Send " vDateName.value = vDateName.value.substr(0, (vDateValue.length-1));"
1451Send " return false;"
1452Send " }"
1453Send " }"
1454Send " }"
1455Send " }"
1456Send " function dateValid(objName) "
1457Send " {"
1458Send " var strDate;"
1459Send " var strDateArray;"
1460Send " var strDay;"
1461Send " var strMonth;"
1462Send " var strYear;"
1463Send " var intday;"
1464Send " var intMonth;"
1465Send " var intYear;"
1466Send " var booFound = false;"
1467Send " var datefield = objName;"
1468Send " var strSeparatorArray = new Array(""-"","" "",""/"",""."");"
1469Send " var intElementNr;"
1470Send " // var err = 0;"
1471Send " var strMonthArray = new Array(12);"
1472Send " strMonthArray[0] = ""Jan"";"
1473Send " strMonthArray[1] = ""Feb"";"
1474Send " strMonthArray[2] = ""Mar"";"
1475Send " strMonthArray[3] = ""Apr"";"
1476Send " strMonthArray[4] = ""May"";"
1477Send " strMonthArray[5] = ""Jun"";"
1478Send " strMonthArray[6] = ""Jul"";"
1479Send " strMonthArray[7] = ""Aug"";"
1480Send " strMonthArray[8] = ""Sep"";"
1481Send " strMonthArray[9] = ""Oct"";"
1482Send " strMonthArray[10] = ""Nov"";"
1483Send " strMonthArray[11] = ""Dec"";"
1484Send " //strDate = datefield.value;"
1485Send " strDate = objName;"
1486Send " if (strDate.length < 1) "
1487Send " {"
1488Send " return true;"
1489Send " }"
1490Send " for (intElementNr = 0; intElementNr < strSeparatorArray.length; intElementNr++) "
1491Send " {"
1492Send " if (strDate.indexOf(strSeparatorArray[intElementNr]) != -1) "
1493Send " {"
1494Send " strDateArray = strDate.split(strSeparatorArray[intElementNr]);"
1495Send " if (strDateArray.length != 3) "
1496Send " {"
1497Send " err = 1;"
1498Send " return false;"
1499Send " }"
1500Send " else "
1501Send " {"
1502Send " strDay = strDateArray[0];"
1503Send " strMonth = strDateArray[1];"
1504Send " strYear = strDateArray[2];"
1505Send " }"
1506Send " booFound = true;"
1507Send " }"
1508Send " }"
1509Send " if (booFound == false) "
1510Send " {"
1511Send " if (strDate.length>5) "
1512Send " {"
1513Send " strDay = strDate.substr(0, 2);"
1514Send " strMonth = strDate.substr(2, 2);"
1515Send " strYear = strDate.substr(4);"
1516Send " }"
1517Send " }"
1518Send " //Adjustment for short years entered"
1519Send " if (strYear.length == 2) "
1520Send " {"
1521Send " strYear = '20' + strYear;"
1522Send " }"
1523Send " "
1524Send " strTemp = strDay;"
1525Send " strDay = strMonth;"
1526Send " strMonth = strTemp;"
1527Send " intday = parseInt(strDay, 10);"
1528Send " "
1529Send " if (isNaN(intday)) "
1530Send " {"
1531Send " err = 2;"
1532Send " return false;"
1533Send " }"
1534Send " "
1535Send " intMonth = parseInt(strMonth, 10);"
1536Send " if (isNaN(intMonth)) "
1537Send " {"
1538Send " for (i = 0;i<12;i++) "
1539Send " {"
1540Send " if (strMonth.toUpperCase() == strMonthArray[i].toUpperCase()) "
1541Send " {"
1542Send " intMonth = i+1;"
1543Send " strMonth = strMonthArray[i];"
1544Send " i = 12;"
1545Send " }"
1546Send " }"
1547Send " if (isNaN(intMonth)) "
1548Send " {"
1549Send " err = 3;"
1550Send " return false;"
1551Send " }"
1552Send " }"
1553Send " intYear = parseInt(strYear, 10);"
1554Send " "
1555Send " if (isNaN(intYear)) "
1556Send " {"
1557Send " err = 4;"
1558Send " return false;"
1559Send " }"
1560Send " if (intMonth>12 || intMonth<1) "
1561Send " {"
1562Send " err = 5;"
1563Send " return false;"
1564Send " }"
1565Send " "
1566Send " if ((intMonth == 1 || intMonth == 3 || intMonth == 5 || intMonth == 7 || intMonth == 8 || intMonth == 10 || intMonth == 12) && (intday > 31 || intday < 1)) "
1567Send " {"
1568Send " err = 6;"
1569Send " return false;"
1570Send " }"
1571Send " "
1572Send " if ((intMonth == 4 || intMonth == 6 || intMonth == 9 || intMonth == 11) && (intday > 30 || intday < 1)) "
1573Send " {"
1574Send " err = 7;"
1575Send " return false;"
1576Send " }"
1577Send " if (intMonth == 2) "
1578Send " {"
1579Send " if (intday < 1) "
1580Send " {"
1581Send " err = 8;"
1582Send " return false;"
1583Send " }"
1584Send " if (LeapYear(intYear) == true) "
1585Send " {"
1586Send " if (intday > 29) "
1587Send " {"
1588Send " err = 9;"
1589Send " return false;"
1590Send " }"
1591Send " }"
1592Send " else"
1593Send " {"
1594Send " if (intday > 28) "
1595Send " {"
1596Send " err = 10; "
1597Send " return false;"
1598Send " }"
1599Send " }"
1600Send " }"
1601Send " "
1602Send " return true;"
1603Send " }"
1604Send " "
1605Send "function LeapYear(intYear) "
1606Send " {"
1607Send " if (intYear % 100 == 0) "
1608Send " {"
1609Send " if (intYear % 400 == 0) "
1610Send " {"
1611Send " return true; "
1612Send " }"
1613Send " }"
1614Send " else "
1615Send " {"
1616Send " if ((intYear % 4) == 0) "
1617Send " {"
1618Send " return true; "
1619Send " }"
1620Send " }"
1621Send " return false;"
1622Send " }"
1623
1624End Sub
1625
1626Function CalcEndDate(dtStartDate As Date, intPeriod As Integer, intPayments As Integer) As Date
1627Dim intPeriodToAdd As Integer
1628Dim Iteration As Integer
1629Dim dtCurrentMonth As Date
1630
1631Select Case intPeriod
1632 Case "0" 'Annual
1633 intPeriodToAdd = 12
1634 Case "1" 'Monthly
1635 intPeriodToAdd = 1
1636 Case "2" 'Quarterly
1637 intPeriodToAdd = 3
1638 Case "3" 'Semi-Annual
1639 intPeriodToAdd = 6
1640 Case "4" 'Lump Sum
1641 intPeriodToAdd = 0
1642 Case "5" 'Weekly
1643 intPeriodToAdd = 7
1644End Select
1645
1646Iteration = 0
1647
1648If intPeriodToAdd = 7 Then
1649 dtCurrentMonth = DateAdd("ww", intPayments - 1, dtStartDate)
1650Else
1651
1652 While Iteration < intPayments
1653
1654 dtCurrentMonth = DateAdd("m", Iteration * intPeriodToAdd, dtStartDate)
1655
1656 Iteration = Iteration + 1
1657
1658 Wend
1659
1660End If
1661
1662CalcEndDate = dtCurrentMonth
1663
1664End Function
1665
1666Function ParseTextField(strNotes As String) As String
1667Dim strTmp As String
1668
1669strTmp = strNotes
1670
1671If InStr(1, strTmp, vbCrLf & vbCrLf) > 0 Then
1672 strTmp = Mid(strTmp, InStr(1, strTmp, vbCrLf & vbCrLf) + 4)
1673End If
1674
1675strTmp = Replace(strTmp, "<", "<")
1676strTmp = Replace(strTmp, ">", ">")
1677
1678strTmp = Replace(strTmp, vbCrLf & vbCrLf, "<p>")
1679strTmp = Replace(strTmp, vbCrLf & vbTab, "<p>")
1680strTmp = Replace(strTmp, vbCrLf & " ", "<p>")
1681strTmp = Replace(strTmp, vbCrLf, "<br>")
1682
1683strTmp = Replace(strTmp, vbLf & vbLf, "<p>")
1684strTmp = Replace(strTmp, vbLf & vbTab, "<p>")
1685strTmp = Replace(strTmp, vbLf & " ", "<p>")
1686strTmp = Replace(strTmp, vbLf, "<br>")
1687
1688strTmp = Replace(strTmp, vbCr & vbCr, "<p>")
1689strTmp = Replace(strTmp, vbCr & vbTab, "<p>")
1690strTmp = Replace(strTmp, vbCr & " ", "<p>")
1691strTmp = Replace(strTmp, vbCr, "<br>")
1692
1693ParseTextField = strTmp
1694
1695End Function
1696
1697
1698Sub ConvertLogins()
1699'Add a new user to the SQL Server
1700
1701Dim rst As New ADODB.Recordset
1702Dim db As New ADODB.Connection
1703Dim adocommand As New ADODB.Command
1704
1705rst.Open "SELECT * FROM Users", "driver={SQL Server};server=PEAR;UID=sa;Pwd=8hw5qoo;database=Pivotal_ProductionED", adOpenKeyset
1706
1707Do Until rst.EOF
1708 With adocommand
1709' .ActiveConnection = "driver={SQL Server};server=ATH03;UID=sa;Pwd=Don'TbreaK;database=StructuredSettlement"
1710 .ActiveConnection = "driver={SQL Server};server=PEAR;UID=sa;Pwd=8hw5qoo;database=StructuredSettlement"
1711 .CommandType = adCmdText
1712 .CommandText = "EXEC sp_addlogin '" & rst!Login_Name & "', '" & rst!Login_Name & "', 'StructuredSettlement'"
1713On Error Resume Next
1714 .Execute
1715On Error GoTo 0
1716 End With
1717 rst.MoveNext
1718Loop
1719
1720End Sub
1721
1722Sub AddLoginsToDB()
1723'Grant the added user the right to access specific database
1724
1725Dim rst As New ADODB.Recordset
1726Dim db As New ADODB.Connection
1727Dim adocommand As New ADODB.Command
1728
1729'rst.Open "SELECT * FROM master..syslogins WHERE dbname = 'StructuredSettlement'", "driver={SQL Server};server=ATH03;UID=sa;Pwd=Don'TbreaK;database=StructuredSettlement", adOpenKeyset
1730rst.Open "SELECT * FROM master..syslogins WHERE dbname = 'StructuredSettlement'", "driver={SQL Server};server=PEAR;UID=sa;Pwd=8hw5qoo;database=StructuredSettlement", adOpenKeyset
1731Do Until rst.EOF
1732 With adocommand
1733' .ActiveConnection = "driver={SQL Server};server=ATH03;UID=sa;Pwd=Don'TbreaK;database=StructuredSettlement"
1734 .ActiveConnection = "driver={SQL Server};server=PEAR;UID=sa;Pwd=8hw5qoo;database=StructuredSettlement"
1735 .CommandType = adCmdText
1736 .CommandText = "EXEC sp_grantdbaccess '" & rst!Name & "','" & rst!Name & "'"
1737 On Error Resume Next
1738 .Execute
1739 On Error GoTo 0
1740
1741 End With
1742rst.MoveNext
1743Loop
1744
1745
1746End Sub
1747
1748Function CheckDate(DateEntered As String) As Variant
1749
1750If IsNumeric(DateEntered) Then
1751 CheckDate = Left(DateEntered, 2) & "/" & Mid(DateEntered, 3, 2) & "/" & Mid(DateEntered, 5, 4)
1752Else
1753 CheckDate = DateEntered
1754End If
1755
1756If Not IsDate(CheckDate) Then CheckDate = Null
1757
1758End Function
1759Function CapitalizeFirstLetterOfWord(strToParse As String) As String
1760
1761Dim i As Long
1762Dim a As Long
1763Dim c As Long
1764Dim w As Long
1765Dim l As Long
1766Dim p As Long
1767Dim strTmpStrL As String
1768Dim strTmpStrR As String
1769Dim strTmpStrRT As String
1770Dim bolDblCaps As Boolean
1771Dim arrAlpha
1772
1773strToParse = " " & strToParse & " "
1774
1775For i = 2 To Len(strToParse)
1776
1777 If IsNumeric(Right(Left(strToParse, i), 1)) = False And Right(Left(strToParse, i - 1), 1) = " " Then
1778
1779 strTmpStrL = Left(strToParse, i - 1)
1780 strTmpStrR = Replace(strToParse, Right(Left(strToParse, i), 1), UCase(Right(Left(strToParse, i), 1)), i, 1)
1781
1782 strToParse = strTmpStrL & strTmpStrR
1783
1784 ElseIf IsNumeric(Right(Left(strToParse, i), 1)) = False Then
1785 strTmpStrL = Left(strToParse, i - 1)
1786 strTmpStrR = Replace(strToParse, Right(Left(strToParse, i), 1), LCase(Right(Left(strToParse, i), 1)), i, 1)
1787
1788 strToParse = strTmpStrL & strTmpStrR
1789
1790 Else
1791 i = InStr(i, strToParse, " ") - 1
1792
1793 End If
1794
1795Next i
1796
1797CapitalizeFirstLetterOfWord = Trim(strToParse)
1798
1799
1800End Function
1801
1802Function PosNum(ByVal varData As Variant, Optional varSend As Variant = 0) As Variant
1803If varData = "" Then
1804 varData = varSend
1805End If
1806If varData < 0 Then
1807 varData = varData * -1
1808End If
1809PosNum = varData
1810
1811End Function
1812
1813