VERSION 5.00 Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX" Begin VB.Form frmBilling Caption = "Project Billing Information" ClientHeight = 4380 ClientLeft = 60 ClientTop = 345 ClientWidth = 12045 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 4380 ScaleWidth = 12045 StartUpPosition = 3 'Windows Default Begin VB.TextBox txtOWDlrs Height = 315 Left = 10590 TabIndex = 50 Top = 1620 Visible = 0 'False Width = 765 End Begin VB.TextBox txtOWPctg Height = 315 Left = 10590 TabIndex = 49 Top = 1290 Width = 765 End Begin VB.CheckBox chkOWrap Caption = "Wrap Ins." Height = 225 Left = 8580 TabIndex = 46 Top = 1260 Width = 1305 End Begin VB.TextBox txtWrapDlrs Height = 315 Left = 2040 TabIndex = 45 Top = 4080 Visible = 0 'False Width = 765 End Begin VB.TextBox txtWrapPctg Height = 315 Left = 2040 TabIndex = 42 Top = 3780 Width = 765 End Begin VB.CheckBox chkWrap Caption = "Wrap Insurance" Height = 270 Left = 1395 TabIndex = 41 Top = 3540 Width = 1500 End Begin VB.TextBox txtPNTFCode Height = 315 Left = 3300 TabIndex = 12 Top = 3195 Width = 1035 End Begin VB.TextBox txtPNTFBill Alignment = 1 'Right Justify Height = 315 Left = 4380 TabIndex = 13 Top = 3195 Width = 1035 End Begin VB.CommandButton cmdUpDesc Caption = "Update Option Desc" Height = 540 Left = 4410 TabIndex = 39 Top = 3570 Width = 1035 End Begin VB.TextBox txtPNTEBill Alignment = 1 'Right Justify Height = 315 Left = 4380 TabIndex = 11 Top = 2850 Width = 1035 End Begin VB.TextBox txtPNTECode Height = 315 Left = 3300 TabIndex = 10 Top = 2850 Width = 1035 End Begin VB.TextBox txtPNTBill Alignment = 1 'Right Justify Height = 315 Left = 4380 TabIndex = 9 Top = 2505 Width = 1035 End Begin VB.TextBox txtPNTCode Height = 315 Left = 3300 TabIndex = 8 Top = 2505 Width = 1035 End Begin VB.CommandButton cmdUp Caption = "Command1" Height = 495 Left = 4245 TabIndex = 33 Top = 810 Visible = 0 'False Width = 855 End Begin VB.CommandButton cmdAddDate Caption = "New Effective Date" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 8580 TabIndex = 32 Top = 1545 Width = 1335 End Begin VB.ComboBox cboEffDate Height = 315 Left = 3240 Sorted = -1 'True Style = 2 'Dropdown List TabIndex = 30 Top = 420 Width = 1635 End Begin VB.TextBox txtSTCode Height = 315 Left = 3300 MaxLength = 6 TabIndex = 6 Top = 2160 Width = 1035 End Begin VB.TextBox txtSTBill Alignment = 1 'Right Justify Height = 315 Left = 4380 MaxLength = 10 TabIndex = 7 Top = 2160 Width = 1035 End Begin VB.CheckBox chkOption Alignment = 1 'Right Justify Caption = "Bill Options with Stucco:" Height = 255 Left = 1620 TabIndex = 28 Top = 840 Width = 2055 End Begin VB.TextBox txtOCode Height = 315 Left = 9840 MaxLength = 6 TabIndex = 21 Top = 900 Width = 1035 End Begin VB.TextBox txtSCode Height = 315 Left = 3300 MaxLength = 6 TabIndex = 4 Top = 1800 Width = 1035 End Begin VB.TextBox txtLCode Height = 315 Left = 3300 MaxLength = 6 TabIndex = 2 Top = 1440 Width = 1035 End Begin VB.CommandButton cmdPrint Caption = "Print Price List" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 8580 TabIndex = 26 TabStop = 0 'False Top = 3345 Width = 1335 End Begin VB.CommandButton cmdSaveOpt Caption = "Save &Option Information" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 8580 TabIndex = 23 Top = 2760 Width = 1335 End Begin VB.CommandButton cmdExit Caption = "E&xit" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 8580 TabIndex = 24 TabStop = 0 'False Top = 3915 Width = 1335 End Begin VB.CommandButton cmdSave Caption = "&Save Plan Information" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 555 Left = 8580 TabIndex = 14 Top = 2160 Width = 1335 End Begin VB.TextBox txtOptBill Alignment = 1 'Right Justify Height = 315 Left = 10920 MaxLength = 10 TabIndex = 22 Top = 900 Width = 1035 End Begin VB.CheckBox chkBill Alignment = 1 'Right Justify Caption = "Bill Lath && Stucco Combined:" Height = 255 Left = 1320 TabIndex = 1 Top = 1140 Width = 2355 End Begin VB.TextBox txtSBill Alignment = 1 'Right Justify Height = 315 Left = 4380 MaxLength = 10 TabIndex = 5 Top = 1800 Width = 1035 End Begin VB.TextBox txtLBill Alignment = 1 'Right Justify Height = 315 Left = 4380 MaxLength = 10 TabIndex = 3 Top = 1440 Width = 1035 End Begin VB.ListBox lstOptions Height = 3375 Left = 5505 Sorted = -1 'True TabIndex = 15 Top = 885 Width = 2895 End Begin VB.ListBox lstMod_Elv Height = 3180 Left = 60 Sorted = -1 'True TabIndex = 0 Top = 870 Width = 1155 End Begin Crystal.CrystalReport crRepair Left = 7920 Top = 420 _ExtentX = 741 _ExtentY = 741 _Version = 348160 WindowControlBox= -1 'True WindowMaxButton = -1 'True WindowMinButton = -1 'True WindowState = 2 PrintFileLinesPerPage= 60 End Begin VB.Label lblOWDlrs Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Wrap $: " Height = 195 Left = 9990 TabIndex = 48 Top = 1680 Visible = 0 'False Width = 615 End Begin VB.Label lblOWPctg Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Wrap %: " Height = 195 Left = 9915 TabIndex = 47 Top = 1350 Width = 645 End Begin VB.Label lblWrapDlrs Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Wrap $: " Height = 195 Left = 1440 TabIndex = 44 Top = 4140 Visible = 0 'False Width = 615 End Begin VB.Label lblWrapPctg Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Wrap %: " Height = 195 Left = 1410 TabIndex = 43 Top = 3840 Width = 645 End Begin VB.Label lblPaintFinal Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Paint Billing Final Code/Amt:" Height = 195 Left = 1305 TabIndex = 40 Top = 3270 Width = 1995 End Begin VB.Label lblPaintEBill Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Paint Billing Ext Code/Amt:" Height = 195 Left = 1410 TabIndex = 38 Top = 2940 Width = 1890 End Begin VB.Label lblPaintBill Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Paint Billing Int Code/Amt:" Height = 195 Left = 1455 TabIndex = 37 Top = 2565 Width = 1845 End Begin VB.Label lblPOption BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 540 Left = 9960 TabIndex = 36 Top = 2775 Width = 2100 WordWrap = -1 'True End Begin VB.Label lblOptUsed Caption = "OPTION USED" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 240 Left = 9990 TabIndex = 35 Top = 2190 Visible = 0 'False Width = 1440 End Begin VB.Label lblOptOrder Height = 240 Left = 9960 TabIndex = 34 Top = 2430 Width = 2040 End Begin VB.Label lblEffDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Price Effective Date:" Height = 195 Left = 1665 TabIndex = 31 Top = 480 Width = 1470 End Begin VB.Label lblStoneBill Alignment = 1 'Right Justify Caption = "Stone Billing Code/Amt:" Height = 195 Left = 1545 TabIndex = 29 Top = 2205 Width = 1755 End Begin VB.Label lblDesc BorderStyle = 1 'Fixed Single Height = 375 Left = 8400 TabIndex = 27 Top = 420 Width = 3435 End Begin VB.Label txtProject Alignment = 2 'Center BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 60 TabIndex = 25 Top = 0 Width = 11775 End Begin VB.Label lblOptAmt Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Option Code/Amt:" Height = 195 Left = 8520 TabIndex = 20 Top = 960 Width = 1275 End Begin VB.Label lblStuccoBill Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Stucco Billing Code/Amt:" Height = 195 Left = 1530 TabIndex = 19 Top = 1845 Width = 1770 End Begin VB.Label lblLathBill Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Lath Billing Code/Amt:" Height = 195 Left = 1725 TabIndex = 18 Top = 1485 Width = 1575 End Begin VB.Label lblOptions Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Options:" Height = 195 Left = 5580 TabIndex = 17 Top = 660 Width = 585 End Begin VB.Label lblPlans Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Plans:" Height = 195 Left = 120 TabIndex = 16 Top = 660 Width = 435 End End Attribute VB_Name = "frmBilling" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim moRS As Recordset Dim moRSOpt As Recordset Dim moRSProj As Recordset Dim mboolSHOW As Boolean, mboolOPTUSED As Boolean Dim mboolAdding As Boolean Dim mboolCopy As Boolean, mintBOOKMARK As Integer Dim mstrType As String, mstrMODEL As String Dim mintESTID As Integer, mintPROJID As Integer, mintESTID2 As Integer Dim mintOPTID As Integer, mintLOTID As Integer Dim mstrSQL As String Dim mstrNewDate As String, mstrCopyDate As String Private Sub cboEffDate_Change() Call ListLoad End Sub Private Sub cboEffDate_Click() Call ListLoad End Sub Private Sub cmdAddDate_Click() Dim strNewDate As String, strCopyDate As String, intYN As Integer Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSS As Recordset, lngPOS As Long strNewDate = InputBox("Enter the New Effective Date for this Tract (MMDDYYYY)", "New Date", Date) ' If Not IsDate(strNewDate) Then ' MsgBox "A Valid Date Must Be Entered", vbOKOnly, "InValid Date" ' Exit Sub ' End If lngPOS = InStr(1, strNewDate, "/", 1) If Not IsDate(strNewDate) Then If lngPOS = 0 Then If Len(strNewDate) > 0 Then strNewDate = Format(strNewDate, "00/00/####") If Not IsDate(strNewDate) Then MsgBox "A Valid Date Must Be Entered", vbOKOnly, "InValid Date" ' Call cmdExit_Click ' mboolBAD = True Exit Sub End If ' mstrSTARTDATE = strNewDate Else MsgBox "The Date You Entered is not Valid Now Exiting", vbOKOnly, "InValid Date" ' mboolBAD = True Exit Sub ' Call cmdExit_Click End If Else MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - Exiting" ' Call cmdExit_Click ' mboolBAD = True Exit Sub End If ' Else ' mstrSTARTDATE = strNewDate End If cboEffDate.AddItem strNewDate mstrNewDate = strNewDate strSQL = "Select * FROM tblProjDate" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then oRS.AddNew oRS!Proj_ID = gintPROJID oRS!startdate = strNewDate oRS.Update End If intYN = MsgBox("Do You Want To Copy Plans from A Previous Effective Date?", vbQuestion + vbYesNo, "Copy?") If intYN = vbYes Then strCopyDate = InputBox("What is the Old Effective Date to Use?", "Old Date", cboEffDate.Text) If Not IsDate(strCopyDate) Then MsgBox "A Valid Date Must Be Entered", vbOKOnly, "InValid Date" Exit Sub End If mstrCopyDate = strCopyDate strSQL = "SELECT * FROM tblPlanBill WHERE Proj_id = " & gintPROJID & " and effdate = #" & strCopyDate & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly strSql2 = "SELECT * FROM tblPlanBill" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF oRSS.AddNew oRSS!Proj_ID = gintPROJID oRSS!est_id = oRS!est_id mintESTID = oRS!est_id oRSS!Mod_Elv = oRS!Mod_Elv oRSS!l_bill = 0 oRSS!s_bill = 0 oRSS!Create = Date oRSS!createuser = gstrLOGIN oRSS!notes = oRS!notes oRSS!l_code = oRS!l_code oRSS!s_code = oRS!s_code oRSS!st_bill = oRS!st_bill oRSS!st_code = oRS!st_code oRSS!effdate = strNewDate oRSS!pnt_bill = oRS!pnt_bill oRSS!pnt_ebill = oRS!pnt_ebill oRSS!pnt_fbill = oRS!pnt_fbill oRSS!pnt_fcode = oRS!pnt_fcode oRSS!pnt_ecode = oRS!pnt_ecode oRSS!PNT_CODE = oRS!PNT_CODE oRSS!Wrap = oRS!Wrap oRSS!WPctg = oRS!WPctg oRSS.Update Call CopyOption oRS.MoveNext Loop Else End If End Sub Private Sub CopyOption() Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSS As Recordset strSQL = "SELECT * FROM tblPOptBill WHERE est_id = " & mintESTID & " and effdate = #" & mstrCopyDate & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then strSql2 = "SELECT * FROM tblPOptBill" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic Do Until oRS.EOF oRSS.AddNew oRSS!est_id = mintESTID oRSS!OPTID = oRS!OPTID oRSS!opt_no = oRS!opt_no oRSS!Desc = oRS!Desc oRSS!b_code = oRS!b_code oRSS!created = Date oRSS!C_USER = gstrLOGIN oRSS!Amt = 0 oRSS!Wrap = oRS!Wrap oRSS!WPctg = oRS!WPctg oRSS!effdate = mstrNewDate oRSS.Update oRS.MoveNext Loop End If End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdPrint_Click() Dim strSQL As String, strMONTH As String, strYEAR As String, strDAY As String Dim strDate As String On Error GoTo Error_EH strDate = cboEffDate.Text strMONTH = Format(Mid(strDate, 1, 2), "00") strDAY = Format(Mid(strDate, 4, 2), "00") strYEAR = Format(Mid(strDate, 7, 4), "0000") gintPRINT = 1 frmReport.Show 1 ' strSQL = "{tblPlans.Proj_id} = " & gintPROJID 'date(" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblrepair.area} = '" & Left(cboArea.Text, 1) & "'" strSQL = "{tblPlanBill.Proj_id} = " & gintPROJID & " and {tblPlanBill.EffDate} = date(" & strYEAR & "," & strMONTH & "," & strDAY & ")" ' and {tblrepair.area} = '" & Left(cboArea.Text, 1) & "'" crREPAIR.ReportFileName = App.Path & "\PriceList.rpt" crREPAIR.SelectionFormula = strSQL ' crRepair.Destination = crptToWindow crREPAIR.CopiesToPrinter = gintCOPY crREPAIR.Destination = gintDEST crREPAIR.Action = 1 Exit Sub Error_EH: gstrMODULE = "Form Billing - Module cmdPrint_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdSaveOpt_Click() Dim strSQL As String On Error GoTo Error_EH ' *********************************This does not save correctly - it creates a duplicate key - need to check this moRSOpt!est_id = gintESTID moRSOpt!Amt = Double2Field(txtOptBill) ' moRSOpt!billcode = Str2Field(txtOBillCode) ' moRSOpt!costcode = Str2Field(txtOCostCode) moRSOpt!effdate = Field2Str(cboEffDate.Text) moRSOpt!b_code = Str2Field(txtOCode) moRSOpt!Wrap = Field2CheckBox(chkWrap) moRSOpt!WPctg = Double2Field(txtOWPctg) ' moRSOpt!WDlrs = Double2Field(txtOWDlrs) moRSOpt.Update cmdSaveOpt.Enabled = False ' txtContract.Enabled = True txtLBill.Enabled = True txtSBill.Enabled = True txtLCode.Enabled = True txtSCode.Enabled = True ' txtBillCode.Enabled = True lstMod_Elv.Enabled = True lstOptions.SetFocus Exit Sub Error_EH: gstrMODULE = "Form Billing - Module cmdSaveOpt" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdUp_Click() Dim strSQL As String, oRS As Recordset Dim strSql2 As String, oRSS As Recordset ' strSQL = "Select * from tblplanbill" ' where effdate = null" ' Set oRS = New Recordset ' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic ' Do Until oRS.EOF ' If IsDate(oRS!effdate) Then ' Else ' oRS!effdate = "01/01/2005" ' oRS.Update ' End If ' oRS.MoveNext ' Loop strSQL = "SELECT * FROM tblPlanBill" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly Do Until oRS.EOF strSql2 = "SELECT * FROM tblPOptBill WHERE est_id = " & Field2Str(oRS!est_id) Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If Not oRSS.EOF Then Do Until oRSS.EOF oRSS!effdate = oRS!effdate oRSS.Update oRSS.MoveNext Loop End If oRS.MoveNext Loop MsgBox "Update is Done" End Sub Private Sub cmdUpDesc_Click() Dim strSQL As String, strDESC As String, strOPTID As String Dim strSQLL As String, strYN As String, intCNT As Integer Dim oRS As Recordset, oRSS As Recordset intCNT = 0 lstOptions.ListIndex = intCNT strSQLL = "SELECT est_id, optid, desc, effdate FROM tblPOptBill WHERE est_id = " & gintESTID & " and effdate = #" & cboEffDate.Text & "#" Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic Do Until oRSS.EOF lstOptions.ListIndex = intCNT strOPTID = Field2Str2(oRSS!OPTID) ' strOPTID = lstOptions.ItemData strSQL = "SELECT optid, Desc FROM tblPOPTION WHERE optid = " & CLng(strOPTID) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then oRSS!Desc = Field2Str(oRS!Desc) oRSS.Update Else ' strYN = MsgBox("Are You Sure You Want To Delete this Option?", vbCritical + vbYesNo, "Delete?") ' If strYN = vbNo Then ' Exit Sub ' End If ' strSQL = "SELECT * FROM tblLOption WHERE opt_id = " & gintOPTID ' Set oRS = New Recordset ' oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly ' If Not oRS.EOF Then ' MsgBox "This Option Has Been Used With A Lot - No Delete Allowed", vbCritical + vbOKOnly, "No DELETE" ' Exit Sub ' End If ' strSQL = "DELETE * FROM tblPOptBill WHERE Optid = " & oRSS!optid 'lstLOptions.ItemData(lstLOptions.ListIndex) ' goConn.Execute strSQL ' Call OptLoad ' call "" End If intCNT = intCNT + 1 oRSS.MoveNext Loop MsgBox "Option Descriptions Have Been Updated", vbOKOnly, "Done" Call OptLoad End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{TAB}" KeyAscii = 0 End If End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown Dim oRS As Recordset, strSQL As String, strYN As String Dim strOptDesc As String, intBookmark As Integer If Shift = 4 Then Exit Sub End If ShiftDown = (Shift And vbShiftMask) > 0 AltDown = (Shift And vbAltMask) > 0 CtrlDown = (Shift And vbCtrlMask) > 0 ' If KeyCode = vbKeyA And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Show The Description From tblPOption If KeyCode = vbKeyA And (gbytSECURITY < 3) Then ' Show The Description From tblPOption If CtrlDown Then strSQL = "SELECT * FROM tblPOption WHERE OPTID = " & gintOPTID & " AND EST_ID = " & Field2Str2(moRS!est_id) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then lblPOption.Visible = True lblPOption = Field2Str(oRS!Desc) strOptDesc = Field2Str(moRSOpt!Desc) If Trim(strOptDesc) <> lblPOption Then strYN = MsgBox("Do You Want To Change The Description?", vbYesNo, "Change Description?") If strYN = vbYes Then moRSOpt!Desc = lblPOption moRSOpt.Update Call OptLoad End If End If Exit Sub Else lblPOption.Visible = True lblPOption = "Not A Valid Option For This Plan" End If ' strSQL = "DELETE * FROM tblPOptBill WHERE Optid = " & gintOPTID 'lstLOptions.ItemData(lstLOptions.ListIndex) ' goConn.Execute strSQL ' Call OptLoad End If End If If KeyCode = vbKeyD And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Delete An Option Out of the Billing Grid ' If KeyCode = vbKeyD And (gbytSECURITY < 3) Then ' Delete An Option Out of the Billing Grid If CtrlDown Then strYN = MsgBox("Are You Sure You Want To Delete this Option?", vbCritical + vbYesNo, "Delete?") If strYN = vbNo Then Exit Sub End If strSQL = "SELECT * FROM tblLOption WHERE opt_id = " & gintOPTID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then MsgBox "This Option Has Been Used With A Lot - No Delete Allowed", vbCritical + vbOKOnly, "No DELETE" Exit Sub End If strSQL = "DELETE * FROM tblPOptBill WHERE Optid = " & gintOPTID 'lstLOptions.ItemData(lstLOptions.ListIndex) goConn.Execute strSQL Call OptLoad ' Call UpStart ' Call AddBill2 End If End If If KeyCode = vbKeyW And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Delete An Option Out of the Billing Grid If CtrlDown Then intBookmark = lstMod_Elv.ListIndex moRS!Wrap = moRSProj!Wrap moRS!WPctg = moRSProj!WPctg moRS.Update Call ListLoad lstMod_Elv.ListIndex = intBookmark End If End If If KeyCode = vbKeyO And (gbytSECURITY < 3 Or gbytSECURITY = 7) Then ' Delete An Option Out of the Billing Grid If CtrlDown Then intBookmark = lstOptions.ListIndex moRSOpt!Wrap = moRSProj!Wrap moRSOpt!WPctg = moRSProj!WPctg moRSOpt.Update Call OptLoad lstOptions.ListIndex = intBookmark End If End If ' If Not cmdSave.Enabled Then ' Call DataHasChanged ' End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim intResponse As Integer, strMSG As String On Error GoTo Error_EH If cmdSave.Enabled Then strMSG = "Data Has Been Changed" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Save Changes ?" intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption) Select Case intResponse Case vbYes Call FormSave Case vbNo Case vbCancel Cancel = True Exit Sub End Select End If If moRS.State = adStateOpen Then moRS.Close End If If moRSOpt.State = adStateOpen Then moRSOpt.Close End If If moRSProj.State = adStateOpen Then moRSProj.Close End If Exit Sub Error_EH: If Err = 3219 Then Resume Next Else End If End Sub Private Sub cmdSave_Click() mintBOOKMARK = lstMod_Elv.ListIndex cmdExit.Enabled = True cmdSave.Enabled = False Call FormSave lstMod_Elv.Enabled = True lstMod_Elv.ListIndex = mintBOOKMARK lstOptions.Enabled = True txtOptBill.Enabled = True txtOCode.Enabled = True ' txtOBillCode.Enabled = True ' txtOCostCode.Enabled = True mintBOOKMARK = 0 lstMod_Elv.SetFocus End Sub Private Sub Form_Load() Set moRS = New Recordset Set moRSOpt = New Recordset Set moRSProj = New Recordset Call ProjLoad Call DateLoad If cboEffDate.ListCount > 0 Then Call ListLoad End If ' Call OptLoad End Sub Private Sub DateLoad() Dim oRS As Recordset, strSQL As String strSQL = "SELECT * FROM tblPROJDATE where Proj_ID = " & gintPROJID & " Order By STARTDATE Desc" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic cboEffDate.Clear Do Until oRS.EOF cboEffDate.AddItem Format(Field2Str(oRS!startdate), "MM/DD/YYYY") oRS.MoveNext Loop If cboEffDate.ListCount > 0 Then cboEffDate.ListIndex = 0 End If End Sub Private Sub ProjLoad() Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID Set moRSProj = New Recordset moRSProj.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If moRSProj.EOF Then MsgBox "No Project Information Found - Select a Different Project", vbOKOnly, "InValid Project" Unload Me End If Exit Sub Error_EH: gstrMODULE = "Form Billing - Module ProjLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub ListLoad() Dim oRS As Recordset, intYN As Integer Dim strSQL As String, strProj As String, intResponse As Integer On Error GoTo Error_EH ' strSQL = "SELECT EST_ID, Mod_Elv, effdate from tblPLANbill WHERE Proj_ID = " & gintPROJID & " and effdate = #" & Field2Str(cboEffDate.Text) & "#" strSQL = "SELECT EST_ID, Mod_Elv from tblPLANbill WHERE Proj_ID = " & gintPROJID & " and effdate = #" & Field2Str(cboEffDate.Text) & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstMod_Elv.Clear Do Until oRS.EOF With lstMod_Elv .AddItem Field2Str(oRS!Mod_Elv) .ItemData(.NewIndex) = oRS("est_id") End With oRS.MoveNext Loop oRS.Close If lstMod_Elv.ListCount Then lstMod_Elv.ListIndex = 0 Else Call FormClear lstOptions.Clear Call OptClear gstrFLAG = "D" Beep intResponse = MsgBox("No Plan Information for the Selected Date", vbOKOnly + vbQuestion, "No Plans") intYN = MsgBox("Do You Want To Delete This Date?", vbYesNo, "Delete Date") If intYN = vbYes Then strSQL = "DELETE * FROM tblProjDate WHERE proj_id = " & gintPROJID & " and StartDate = #" & cboEffDate.Text & "#" goConn.Execute strSQL Call DateLoad End If End If Exit Sub Error_EH: gstrMODULE = "Form Billing - Module ListLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormShow() On Error GoTo Error_EH mboolSHOW = True gintESTID = moRS!est_id txtProject = Trim$(Field2Str(moRSProj!Proj_ID)) & " " & Trim$(moRSProj!Proj_Code) & " " & moRSProj!Proj_Desc chkBill = Field2CheckBox(moRSProj!bill) chkOption = Field2CheckBox(moRSProj!opt) With moRS txtLBill = Format(Field2Str2(!l_bill), "#0.00") txtSBill = Format(Field2Str2(!s_bill), "#0.00") txtSTBill = Format(Field2Str2(!st_bill), "#0.00") txtPNTBill = Format(Field2Str2(!pnt_bill), "#0.00") txtPNTEBill = Format(Field2Str2(!pnt_ebill), "#0.00") txtPNTFBill = Format(Field2Str2(!pnt_fbill), "#0.00") txtPNTFCode = Field2Str(!pnt_fcode) txtPNTECode = Field2Str(!pnt_ecode) txtPNTCode = Field2Str(!PNT_CODE) txtLCode = Field2Str(!l_code) txtSCode = Field2Str(!s_code) txtSTCode = Field2Str(!st_code) chkWrap = Field2CheckBox(!Wrap) txtWrapPctg = Format(Field2Str2(!WPctg), "#0.00##") End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Billing - Module FormShow" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormShowOpt() On Error GoTo Error_EH mboolSHOW = True gintOPTID = moRSOpt!OPTID With moRSOpt txtOptBill = Format(Field2Str2(!Amt), "#0.00") txtOWPctg = Format(Field2Str2(!WPctg), "#0.00##") chkOWrap = Field2CheckBox(!Wrap) ' txtOBillCode = Field2Str2(!billcode) ' txtOCostCode = Field2Str2(!costcode) txtOCode = Field2Str(!b_code) lblOptOrder = "Option Number " & Trim(Field2Str(gintOPTID)) If mboolOPTUSED Then lblOptUsed.Visible = True ElseIf mboolOPTUSED = False Then lblOptUsed.Visible = False End If End With mboolSHOW = False Exit Sub Error_EH: gstrMODULE = "Form Billing - Module FormShowOpt" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub OptClear() txtOptBill = "" txtOCode = "" ' txtOBillCode = "" ' txtOCostCode = "" End Sub Private Sub FormSave() Dim strName As String On Error GoTo Error_EH Call FieldsSave moRS.Update moRSProj!bill = chkBill moRSProj!opt = chkOption moRSProj.Update Call ListLoad Exit Sub Error_EH: gstrMODULE = "Form Billing - Module FormSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Function FormFind() As Boolean Dim strSQL As String, intResponse As Integer On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblPlanBill " strSQL = strSQL & "WHERE est_ID = " & lstMod_Elv.ItemData(lstMod_Elv.ListIndex) & " and effdate = #" & Field2Str(cboEffDate.Text) & "#" Set moRS = New Recordset moRS.Open strSQL, goConn, _ adOpenKeyset, adLockPessimistic If moRS.EOF Then intResponse = MsgBox("No Plan Information for The Selected Date?", vbOKOnly + vbQuestion, "No Plans") lstMod_Elv.Enabled = False FormFind = False Call FormClear Call OptClear Else FormFind = True End If Exit Function Error_EH: gstrMODULE = "Form Billing - Module FormFind" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindOpt() As Boolean Dim strSQL As String Dim strSQLL As String, oRSO As Recordset On Error GoTo Error_EH strSQL = "SELECT * " strSQL = strSQL & "FROM tblPOptBill " strSQL = strSQL & "WHERE OPTID = " & lstOptions.ItemData(lstOptions.ListIndex) strSQL = strSQL & " and EffDate = #" & cboEffDate.Text & "#" Set moRSOpt = New Recordset moRSOpt.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If moRSOpt.EOF Then FormFindOpt = False Else strSQLL = "SELECT * FROM tblLOPTION WHERE OPT_ID = " & lstOptions.ItemData(lstOptions.ListIndex) Set oRSO = New Recordset oRSO.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic If Not oRSO.EOF Then mboolOPTUSED = True Else mboolOPTUSED = False End If FormFindOpt = True End If Exit Function Error_EH: gstrMODULE = "Form Billing - Module FormFindOpt" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub lstMod_Elv_Click() If lstMod_Elv.ListIndex <> -1 Then If FormFind() Then Call FormShow Call OptLoad End If End If End Sub Private Sub FieldsSave() On Error GoTo Error_EH With moRS !l_bill = Double2Field(txtLBill) !s_bill = Double2Field(txtSBill) !st_bill = Double2Field(txtSTBill) !pnt_bill = Double2Field(txtPNTBill) !pnt_ebill = Double2Field(txtPNTEBill) !pnt_fbill = Double2Field(txtPNTFBill) !pnt_fcode = Str2Field(txtPNTFCode) !pnt_ecode = Str2Field(txtPNTECode) !PNT_CODE = Str2Field(txtPNTCode) !l_code = Str2Field(txtLCode) !s_code = Str2Field(txtSCode) !st_code = Str2Field(txtSTCode) !Wrap = Field2CheckBox(chkWrap) !WPctg = Double2Field(txtWrapPctg) ' !WDlrs = Double2Field(txtWrapDlrs) !BUpdate = Date !BUUser = gstrLOGIN End With Exit Sub Error_EH: gstrMODULE = "Form Billing - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String If lstMod_Elv.ListCount = 0 Then intResponse = MsgBox("No Plan Information, Exit and Import From Takeoff?", vbOKOnly + vbQuestion, "No Plans") Unload Me Exit Sub End If End Sub Private Sub FormClear() txtLBill = "" txtSBill = "" txtSTBill = "" txtPNTBill = "" txtPNTCode = "" txtOptBill = "" txtOCode = "" txtLCode = "" txtSCode = "" txtSTCode = "" txtPNTECode = "" txtPNTEBill = "" txtPNTFCode = "" txtPNTFBill = "" txtPNTCode = "" txtPNTBill = "" End Sub Private Sub OptLoad() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT Est_ID, OPTID, Desc, effdate from tblPOptBill WHERE EST_ID = " & gintESTID & " and effdate = #" & cboEffDate.Text & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstOptions.Clear Do Until oRS.EOF With lstOptions strLine = Field2Str(oRS!Desc) .AddItem strLine .ItemData(.NewIndex) = oRS!OPTID End With oRS.MoveNext Loop oRS.Close If lstOptions.ListCount Then lstOptions.ListIndex = 0 ' lstOptions.Sorted Else txtOCode = "" ' txtOCostCode = "" txtOptBill = 0 End If Exit Sub Error_EH: gstrMODULE = "Form Billing - Module OptLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstMod_Elv_DblClick() cmdSave.Enabled = True lstOptions.Enabled = False txtOptBill.Enabled = False ' txtOBillCode.Enabled = False ' txtOCostCode.Enabled = False txtOCode.Enabled = False txtLCode.SetFocus End Sub Private Sub lstOptions_Click() On Error GoTo Error_EH lblPOption = "" ' lblPOption.Visible = False If lstOptions.ListIndex <> -1 Then If FormFindOpt() Then Call FormShowOpt Else lstOptions.Clear txtOptBill = "0" ' txtOBillCode = "" ' txtOCostCode = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form Billing - Module lstOptions_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstOptions_DblClick() cmdSaveOpt.Enabled = True ' txtContract.Enabled = False txtLCode.Enabled = False txtSCode.Enabled = False txtLBill.Enabled = False txtSBill.Enabled = False ' txtBillCode.Enabled = False lstMod_Elv.Enabled = False txtOCode.SetFocus End Sub Private Sub txtLBill_GotFocus() Call FieldSelect(txtLBill) End Sub Private Sub txtLCode_GotFocus() Call FieldSelect(txtLCode) End Sub Private Sub txtLCode_LostFocus() txtLCode = UCase(txtLCode) End Sub Private Sub txtOCode_GotFocus() Call FieldSelect(txtOCode) End Sub Private Sub txtOCode_LostFocus() txtOCode = UCase(txtOCode) End Sub Private Sub txtOptBill_GotFocus() Call FieldSelect(txtOptBill) End Sub Private Sub txtOWPctg_GotFocus() Call FieldSelect(txtOWPctg) End Sub Private Sub txtOWPctg_LostFocus() txtOWPctg = Format(Field2Str2(txtOWPctg), "#0.00##") End Sub Private Sub txtPNTBill_GotFocus() Call FieldSelect(txtPNTBill) End Sub Private Sub txtPNTCode_GotFocus() Call FieldSelect(txtPNTCode) End Sub Private Sub txtPNTEBill_GotFocus() Call FieldSelect(txtPNTEBill) End Sub Private Sub txtPNTECode_GotFocus() Call FieldSelect(txtPNTECode) End Sub Private Sub txtPNTFBill_GotFocus() Call FieldSelect(txtPNTFBill) End Sub Private Sub txtPNTFCode_GotFocus() Call FieldSelect(txtPNTFCode) End Sub Private Sub txtSBill_GotFocus() Call FieldSelect(txtSBill) End Sub Private Sub txtSCode_GotFocus() Call FieldSelect(txtSCode) End Sub Private Sub txtSCode_LostFocus() txtSCode = UCase(txtSCode) End Sub Private Sub txtPNTCode_LostFocus() txtPNTCode = UCase(txtPNTCode) End Sub Private Sub txtPNTECode_LostFocus() txtPNTECode = UCase(txtPNTECode) End Sub Private Sub txtPNTFCode_LostFocus() txtPNTFCode = UCase(txtPNTFCode) End Sub Private Sub txtSTBill_GotFocus() Call FieldSelect(txtSTBill) End Sub Private Sub txtSTCode_GotFocus() Call FieldSelect(txtSTCode) End Sub Private Sub txtSTCode_LostFocus() txtSTCode = UCase(txtSTCode) End Sub Private Sub txtWrapPctg_GotFocus() Call FieldSelect(txtWrapPctg) End Sub Private Sub txtWrapPctg_LostFocus() 'Dim dblWDlrs As Double, dblWPctg As Double, dblBilling As Double txtWrapPctg = Format(Field2Str2(txtWrapPctg), "#0.00##") ' dblWPctg = Field2Str(txtWrapPctg) / 100 ' dblBilling = "" End Sub