VERSION 5.00 Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx" Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx" Begin VB.Form frmPayHead Caption = "Payroll Summary Information" ClientHeight = 5850 ClientLeft = 165 ClientTop = 450 ClientWidth = 12390 KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 5850 ScaleWidth = 12390 StartUpPosition = 3 'Windows Default Begin VB.CommandButton cmdMoveHouse Caption = "Move Amt To House" 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 = 2475 TabIndex = 86 Top = 5265 Width = 1155 End Begin VB.CommandButton cmdAllCrew Caption = "Get Crew Pay" 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 = 5400 TabIndex = 85 Top = 5265 Width = 1155 End Begin VB.CommandButton cmd1Emp Caption = "Get 1 Emp Pay" 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 = 3855 TabIndex = 84 Top = 5265 Width = 1155 End Begin LpLib.fpList lstPaySheets Height = 1080 Left = 3780 TabIndex = 77 Top = 1785 Visible = 0 'False Width = 4335 _Version = 196608 _ExtentX = 7646 _ExtentY = 1905 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = 0 'False BackColor = -2147483643 ForeColor = -2147483640 Columns = 8 Sorted = 1 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = -1 ColumnWidthScale= 2 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 1 SearchMethod = 0 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= 240 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmPayHead.frx":0000 End Begin VB.CommandButton cmdCalc Caption = "Calc" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 330 Left = 11775 TabIndex = 75 TabStop = 0 'False Top = 3765 Width = 615 End Begin VB.TextBox txtTTLPay Alignment = 1 'Right Justify Height = 315 Left = 11355 TabIndex = 72 Top = 5370 Width = 990 End Begin VB.TextBox txtTTLHrs Alignment = 1 'Right Justify Height = 315 Left = 11370 TabIndex = 71 Top = 4575 Width = 990 End Begin VB.CommandButton cmdCertPR Caption = "Cert. Pay Rates" BeginProperty Font Name = "Arial" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 8220 TabIndex = 70 Top = 4095 Visible = 0 'False Width = 1035 End Begin VB.TextBox txtOTAmt Alignment = 1 'Right Justify Height = 315 Left = 10365 TabIndex = 14 Top = 5025 Width = 990 End Begin VB.TextBox txtGross Alignment = 1 'Right Justify BeginProperty DataFormat Type = 1 Format = "0" HaveTrueFalseNull= 0 FirstDayOfWeek = 0 FirstWeekOfYear = 0 LCID = 1033 SubFormatType = 1 EndProperty Height = 315 Left = 9300 MaxLength = 10 TabIndex = 13 Top = 5025 Width = 990 End Begin VB.TextBox txtTTLAmt Alignment = 1 'Right Justify Height = 315 Left = 9300 TabIndex = 15 Top = 5385 Width = 990 End Begin VB.TextBox txtOTRate Alignment = 1 'Right Justify Height = 315 Left = 10365 TabIndex = 12 Top = 4725 Width = 990 End Begin VB.TextBox txtOTHrs Alignment = 1 'Right Justify Height = 315 Left = 10365 TabIndex = 10 Top = 4425 Width = 990 End Begin LpLib.fpList lstHouses Height = 2400 Left = 60 TabIndex = 62 Top = 1185 Width = 3615 _Version = 196608 _ExtentX = 6376 _ExtentY = 4233 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = 0 'False BackColor = -2147483643 ForeColor = -2147483640 Columns = 4 Sorted = 0 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = -1 ColumnWidthScale= 2 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 1 SearchMethod = 0 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= -1 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmPayHead.frx":065E End Begin VB.TextBox txtPaint BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 11025 TabIndex = 60 Top = 420 Width = 690 End Begin VB.CheckBox chkBiWeekly BackColor = &H00C0FFFF& Caption = "BiWeekly PR" 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 = 285 Left = 1935 TabIndex = 58 Top = 840 Visible = 0 'False Width = 1575 End Begin VB.TextBox txtStone BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 9240 TabIndex = 54 TabStop = 0 'False Top = 420 Width = 690 End Begin VB.CheckBox chkReady Caption = "Ready to Process" Height = 255 Left = 3825 TabIndex = 42 Top = 3585 Width = 1995 End Begin VB.CheckBox chkDeduct Caption = "Deductions" Height = 255 Left = 150 TabIndex = 39 TabStop = 0 'False Top = 5550 Visible = 0 'False Width = 1155 End Begin VB.CommandButton cmdDivide Caption = "Divide Equally" 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 = 5400 TabIndex = 38 TabStop = 0 'False Top = 4080 Width = 1155 End Begin VB.CommandButton cmdSavePay Caption = "&Save Emp. Pay" 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 = 5400 TabIndex = 16 Top = 4665 Width = 1155 End Begin VB.CommandButton cmdTotal Caption = "Update &Totals" 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 = 6930 TabIndex = 27 TabStop = 0 'False Top = 4665 Width = 1155 End Begin VB.CommandButton cmdGetCrew Caption = "Get &Crew 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 = 6930 TabIndex = 26 TabStop = 0 'False Top = 4080 Width = 1155 End Begin VB.CommandButton cmdExit Caption = "&Exit" 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 = 3855 TabIndex = 25 TabStop = 0 'False Top = 4665 Width = 1155 End Begin VB.CommandButton cmdAddLot Caption = "Add &House/PO" 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 = 3855 TabIndex = 17 TabStop = 0 'False Top = 4080 Width = 1155 End Begin VB.TextBox txtHRate Alignment = 1 'Right Justify Height = 315 Left = 9300 MaxLength = 10 TabIndex = 11 Top = 4725 Width = 990 End Begin VB.TextBox txtHours Alignment = 1 'Right Justify Height = 315 Left = 9300 MaxLength = 10 TabIndex = 9 Top = 4425 Width = 990 End Begin VB.TextBox txtPayDate BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 1200 TabIndex = 8 TabStop = 0 'False Top = 60 Width = 1275 End Begin VB.TextBox txtSumCrew Alignment = 1 'Right Justify BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 9600 TabIndex = 2 TabStop = 0 'False Top = 60 Width = 975 End Begin VB.TextBox txtSumHouse Alignment = 1 'Right Justify BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 7500 TabIndex = 1 TabStop = 0 'False Top = 60 Width = 975 End Begin VB.TextBox txtCrewID BackColor = &H00C0FFFF& Enabled = 0 'False Height = 315 Left = 3180 TabIndex = 0 TabStop = 0 'False Top = 60 Width = 615 End Begin VB.ListBox lstLots Height = 1620 Left = 3780 Sorted = -1 'True TabIndex = 28 TabStop = 0 'False Top = 1200 Visible = 0 'False Width = 4335 End Begin LpLib.fpList lstCrew Height = 2415 Left = 8220 TabIndex = 61 Top = 1170 Width = 3900 _Version = 196608 _ExtentX = 6879 _ExtentY = 4260 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Enabled = -1 'True MousePointer = 0 Object.TabStop = 0 'False BackColor = -2147483643 ForeColor = -2147483640 Columns = 4 Sorted = 0 LineWidth = 1 SelDrawFocusRect= -1 'True ColumnSeparatorChar= 9 ColumnSearch = -1 ColumnWidthScale= 2 RowHeight = -1 MultiSelect = 0 WrapList = 0 'False WrapWidth = 0 SelMax = -1 AutoSearch = 1 SearchMethod = 0 VirtualMode = 0 'False VRowCount = 0 DataSync = 3 ThreeDInsideStyle= 1 ThreeDInsideHighlightColor= -2147483633 ThreeDInsideShadowColor= -2147483627 ThreeDInsideWidth= 1 ThreeDOutsideStyle= 1 ThreeDOutsideHighlightColor= -2147483628 ThreeDOutsideShadowColor= -2147483632 ThreeDOutsideWidth= 1 ThreeDFrameWidth= 0 BorderStyle = 0 BorderColor = -2147483642 BorderWidth = 1 ThreeDOnFocusInvert= 0 'False ThreeDFrameColor= -2147483633 Appearance = 2 BorderDropShadow= 0 BorderDropShadowColor= -2147483632 BorderDropShadowWidth= 3 ScrollHScale = 2 ScrollHInc = 0 ColsFrozen = 0 ScrollBarV = 1 NoIntegralHeight= 0 'False HighestPrecedence= 0 AllowColResize = 0 AllowColDragDrop= 0 ReadOnly = 0 'False VScrollSpecial = 0 'False VScrollSpecialType= 0 EnableKeyEvents = -1 'True EnableTopChangeEvent= -1 'True DataAutoHeadings= -1 'True DataAutoSizeCols= 2 SearchIgnoreCase= -1 'True ScrollBarH = 1 VirtualPageSize = 0 VirtualPagesAhead= 0 ExtendCol = 0 ColumnLevels = 1 ListGrayAreaColor= -2147483637 GroupHeaderHeight= -1 GroupHeaderShow = 0 'False AllowGrpResize = 0 AllowGrpDragDrop= 0 MergeAdjustView = 0 'False ColumnHeaderShow= -1 'True ColumnHeaderHeight= 210 GrpsFrozen = 0 BorderGrayAreaColor= -2147483637 ExtendRow = 0 DataField = "" OLEDragMode = 0 OLEDropMode = 0 EnableClickEvent= -1 'True Redraw = -1 'True ResizeRowToFont = 0 'False TextTipMultiLine= 0 ColDesigner = "frmPayHead.frx":0BC8 End Begin MSComCtl2.DTPicker dtpPayDate Height = 315 Left = 6900 TabIndex = 83 Top = 5265 Width = 1215 _ExtentX = 2143 _ExtentY = 556 _Version = 393216 Format = 89915393 CurrentDate = 43678 MaxDate = 55153 MinDate = 36892 End Begin VB.Label lblTEST Height = 285 Left = 6915 TabIndex = 87 Top = 5580 Width = 1170 End Begin VB.Label lblTYPE3 Caption = "TYPE FROM PayList" Height = 435 Left = 30 TabIndex = 82 Top = 4950 Visible = 0 'False Width = 555 End Begin VB.Label lblWorkDone Caption = "WORKDONE" Height = 195 Left = 3915 TabIndex = 81 Top = 2925 Visible = 0 'False Width = 255 End Begin VB.Label lblTYPE2 Caption = "CrewTYpe" Height = 225 Left = 3015 TabIndex = 80 Top = 3705 Visible = 0 'False Width = 435 End Begin VB.Label lblLOTID Caption = "LOT" Height = 195 Left = 7500 TabIndex = 79 Top = 3240 Visible = 0 'False Width = 615 End Begin VB.Label lblPROJID Caption = "PRJ" Height = 225 Left = 7470 TabIndex = 78 Top = 2940 Visible = 0 'False Width = 585 End Begin VB.Label lblCalcHrs Height = 270 Left = 11400 TabIndex = 76 Top = 4200 Visible = 0 'False Width = 225 End Begin VB.Label lblTTLDlrs Alignment = 2 'Center Caption = "Total Pay" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 450 Left = 11715 TabIndex = 74 Top = 4905 Width = 555 End Begin VB.Label lblTTLHrs Alignment = 2 'Center Caption = "Total Hours" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 420 Left = 11580 TabIndex = 73 Top = 4185 Width = 690 End Begin VB.Label lblCertPR Alignment = 2 'Center BackColor = &H0080FFFF& Caption = "CERTIFIED" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 300 Left = 9615 TabIndex = 69 Top = 825 Visible = 0 'False Width = 2505 End Begin VB.Label lblNoCalc BackColor = &H0080FFFF& Caption = "NO CALC" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800080& Height = 180 Left = 8280 TabIndex = 68 Top = 3600 Visible = 0 'False Width = 855 End Begin VB.Label lblTIE Caption = "TIEBREAKER" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 180 Left = 9255 TabIndex = 67 Top = 3600 Visible = 0 'False Width = 1320 End Begin VB.Label lblTTLWage AutoSize = -1 'True Caption = "Total Wages:" Height = 195 Left = 8235 TabIndex = 66 Top = 5490 Width = 960 End Begin VB.Label lblRegTime Alignment = 2 'Center Caption = "Reg Time" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 9330 TabIndex = 65 Top = 4170 Width = 945 End Begin VB.Label lblOTTime Alignment = 2 'Center Caption = "OT Time" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 10365 TabIndex = 64 Top = 4185 Width = 945 End Begin VB.Label lblCtrl Alignment = 2 'Center Caption = "CTRL-K to LOOK" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 255 Left = 45 TabIndex = 63 Top = 3600 Visible = 0 'False Width = 2610 End Begin VB.Label lblPaint AutoSize = -1 'True Caption = "Paint SqFt:" Height = 195 Left = 10110 TabIndex = 59 Top = 480 Width = 780 End Begin VB.Label lblFrameCnt BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1740 TabIndex = 57 Top = 5310 Width = 675 End Begin VB.Label lblFrames Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Frames:" Height = 195 Left = 1125 TabIndex = 56 Top = 5310 Width = 555 End Begin VB.Label lblWCCode Alignment = 2 'Center BorderStyle = 1 'Fixed Single Height = 315 Left = 10365 TabIndex = 55 Top = 5370 Width = 990 End Begin VB.Label lblStone Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Stone SqFt:" Height = 195 Left = 8355 TabIndex = 53 Top = 480 Width = 840 End Begin VB.Label lblMRate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal Rate:" Height = 195 Left = 6705 TabIndex = 52 Top = 480 Width = 825 End Begin VB.Label lblDMRate BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 7605 TabIndex = 51 Top = 420 Width = 690 End Begin VB.Label lblDRate2 Alignment = 1 'Right Justify BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 5925 TabIndex = 50 Top = 420 Width = 690 End Begin VB.Label lblDRate Alignment = 1 'Right Justify BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 5220 TabIndex = 49 Top = 420 Width = 690 End Begin VB.Label lblRate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Pay Rates:" Height = 195 Left = 4320 TabIndex = 48 Top = 480 Width = 780 End Begin VB.Label lblDMetal BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 3180 TabIndex = 47 Top = 420 Width = 1035 End Begin VB.Label lblMetal Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Metal:" Height = 195 Left = 2670 TabIndex = 46 Top = 480 Width = 435 End Begin VB.Label lblDFin2 BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 1680 TabIndex = 45 Top = 420 Width = 795 End Begin VB.Label lblDYds BackColor = &H00C0FFFF& BorderStyle = 1 'Fixed Single Height = 315 Left = 600 TabIndex = 44 Top = 420 Width = 1035 End Begin VB.Label lblYds Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Yds:" Height = 195 Left = 240 TabIndex = 43 Top = 480 Width = 315 End Begin VB.Label lblSelect Alignment = 2 'Center Caption = "CTRL-S to Select Lot" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 195 Left = 6240 TabIndex = 41 Top = 3720 Visible = 0 'False Width = 1935 End Begin VB.Label lblTerm Caption = "TERMINATED" 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 = 180 Left = 10590 TabIndex = 40 Top = 3600 Visible = 0 'False Width = 1320 End Begin VB.Label lblBalance Alignment = 2 'Center BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 3780 TabIndex = 37 Top = 840 Width = 4335 End Begin VB.Label lblDelete Caption = "CTRL R to Delete Crews CTRL H to Delete Houses" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 480 Left = 4950 TabIndex = 36 Top = 2985 Width = 2295 End Begin VB.Label lblDifference Alignment = 1 'Right Justify BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 315 Left = 10680 TabIndex = 35 Top = 60 Width = 1155 End Begin VB.Label lblBC BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2700 TabIndex = 34 Top = 4110 Width = 915 End Begin VB.Label lblPayAmt Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Pay Amount:" Height = 195 Left = 780 TabIndex = 33 Top = 4950 Width = 900 End Begin VB.Label lblType BorderStyle = 1 'Fixed Single Height = 315 Left = 960 TabIndex = 32 Top = 4080 Width = 1695 End Begin VB.Label lblCrewType Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew Type:" Height = 195 Left = 120 TabIndex = 31 Top = 4155 Width = 810 End Begin VB.Label lblPay BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1740 TabIndex = 30 Top = 4950 Width = 1875 End Begin VB.Label lblAddress BorderStyle = 1 'Fixed Single BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 0 TabIndex = 29 Top = 4470 Width = 3615 End Begin VB.Label lblGross Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Pay Amount:" Height = 195 Left = 8295 TabIndex = 24 Top = 5145 Width = 900 End Begin VB.Label lblHRate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Hourly Rate:" Height = 195 Left = 8310 TabIndex = 23 Top = 4845 Width = 885 End Begin VB.Label lblHours Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "# of Hours:" Height = 195 Left = 8400 TabIndex = 22 Top = 4545 Width = 795 End Begin VB.Label lblEmpName BorderStyle = 1 'Fixed Single Height = 315 Left = 9165 TabIndex = 21 Top = 3780 Width = 2505 End Begin VB.Label lblEmpId BorderStyle = 1 'Fixed Single Height = 315 Left = 8220 TabIndex = 20 Top = 3780 Width = 915 End Begin VB.Label lblCrewMember AutoSize = -1 'True Caption = "Crew Workers" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 8280 TabIndex = 19 Top = 900 Width = 1200 End Begin VB.Label lblHouse AutoSize = -1 'True Caption = "Houses && POs" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 120 TabIndex = 18 Top = 900 Width = 1215 End Begin VB.Line Line1 BorderWidth = 2 X1 = 0 X2 = 11880 Y1 = 780 Y2 = 780 End Begin VB.Label lblPayDate Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Payroll Date:" Height = 195 Left = 225 TabIndex = 7 Top = 120 Width = 900 End Begin VB.Label lblCrewName BorderStyle = 1 'Fixed Single Height = 315 Left = 3840 TabIndex = 6 Top = 60 Width = 2595 End Begin VB.Label lblSumCrew Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Workers Sum:" Height = 195 Left = 8520 TabIndex = 5 Top = 120 Width = 1005 End Begin VB.Label lblSumHouse Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Houses Sum:" Height = 195 Left = 6480 TabIndex = 4 Top = 120 Width = 945 End Begin VB.Label lblCrew Alignment = 1 'Right Justify AutoSize = -1 'True Caption = "Crew:" Height = 195 Left = 2700 TabIndex = 3 Top = 120 Width = 405 End End Attribute VB_Name = "frmPayHead" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim mboolDelete As Boolean, mboolCERTIFIED As Boolean, mboolAdding As Boolean Dim moRSPay As Recordset, moRSTIME As Recordset, mboolNOYDS As Boolean Dim moRSCREW As Recordset, moRS As Recordset, moRSSPS As Recordset Dim moRSHEAD As Recordset, moRSPS As Recordset, mintYDS As Integer Dim mdblHours As Double, mdblRate As Double, mdblGROSS As Double Dim mdblOTHours As Double, mdblOTRate As Double, mdblOTGROSS As Double Dim mbytCOUNT As Byte, mlngPSPAYID As Long, mstrTexture As String Dim mstrWTYPE As String, mstrWDone As String Private Sub cmdAddLot2_Click() Dim strProj As String, strSQL As String, intPROJ As Integer Dim strLine As String, intYN As Integer Dim oRS As Recordset, oRSS As Recordset, oRS2 As Recordset Dim strPSheet As String, oRSPS As Recordset, lngLOTID As Long Dim strPCODE As String, strLOTNO As String, strPRJLOT As String, lngPROJID As Long Dim sglMETAL As Single, sglPAMT As Single, strPROJCODE As String intYN = MsgBox("Do You Want To See A List Of Pay Sheets For This Crew?", vbYesNo, "Pay Sheet List?") If intYN = vbYes Then strPSheet = "SELECT * FROM tblPAYSHEET WHERE Not PAID and CrewID = " & gintCREWID Set oRSPS = New Recordset oRSPS.Open strPSheet, goConn, adOpenDynamic, adLockOptimistic If oRSPS.EOF Then MsgBox "No Pay Sheets Were Found For This Crew.", vbOKOnly, "No Paysheets" Exit Sub Else Do Until oRSPS.EOF lstPaySheets.Clear lstPaySheets.Top = 1200 lstPaySheets.Left = 3780 lstPaySheets.Height = 2400 lstPaySheets.Width = 4335 lstPaySheets.Visible = True lngLOTID = Field2Str2(oRSPS!lotid) strSQL = "SELECT PROJ_ID, LOT_NO FROM tblLOTINFO WHERE Lot_ID = " & lngLOTID Set oRS2 = New Recordset oRS2.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS2.EOF Then lngPROJID = Field2Str(oRS2!PROJ_ID) strLOTNO = Field2Str(oRS2!lot_no) oRS2.Close Else MsgBox "No Lot Information Found", vbOKOnly, "No Lot" End If strSQL = "SELECT Proj_Code FROM tblPROJECT WHERE Proj_ID = " & lngPROJID Set oRS2 = New Recordset oRS2.Open strSQL, goConn, adOpenDynamic, adLockBatchOptimistic If Not oRS2.EOF Then strPROJCODE = Field2Str(oRS2!Proj_Code) oRS.Close Else MsgBox "No Project Found", vbOKOnly, "No Project" Exit Sub End If strPRJLOT = Trim(strPROJCODE) & " - " & Trim(strLOTNO) strLine = Field2Str2(oRSPS!pay_id) & vbTab & strPRJLOT & vbTab & Field2Str(oRSPS!Type) strLine = strLine & vbTab & Field2Str(oRSPS!WorkDone) & vbTab & Field2Str2(oRSPS!pay_ydge) & vbTab & Field2Str2(oRSPS!GROSSPAY) lstPaySheets.AddItem strLine Loop End If ElseIf intYN = vbNo Then strProj = InputBox("Enter the Project Code 'JPAR' for the Lot Your Want To Add", "Enter Project Code") If Len(strProj) > 0 Then strProj = UCase(strProj) strSQL = "SELECT proj_id FROM tblProject WHERE proj_code = '" & Field2Str(strProj) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If oRS.EOF Then frmProjList.txtSearch = strProj frmProjList.Show 1 Else gintPROJID = Field2Long(oRS!PROJ_ID) End If strSQL = "SELECT Lot_No, Lot_id, Address FROM tblLotInfo where proj_id = " & gintPROJID Set oRSS = New Recordset oRSS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lstLots.Clear lstLots.Top = 1200 lstLots.Left = 3780 lstLots.Height = 2400 lstLots.Width = 4335 lstLots.Visible = True Do Until oRSS.EOF With lstLots strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRSS!address) .AddItem strLine .ItemData(.NewIndex) = oRSS!Lot_ID End With oRSS.MoveNext Loop If lstLots.ListCount Then lblSelect.Visible = True lblCtrl.Visible = True lstLots.ListIndex = 0 End If lstLots.SetFocus Else MsgBox "You Must Enter A Project Code", vbOKOnly, "No Project Code" cmdAddLot.SetFocus Exit Sub End If End If End Sub Private Sub cmd1Emp_Click() Dim strSQL As String, strEMPID As String, dtPAYDT As String Dim oRS As Recordset Dim sglRTWages, sglOTWages As Single, strCODES As String On Error GoTo Error_EH lstCrew.col = 1 strEMPID = lstCrew.ColText ' strSQL = "SELECT * FROM tblHOURLIST WHERE PAY_DATE = #" & dtpPayDate.Value & "#" strSQL = "SELECT * FROM tblHOURLIST WHERE EMP_ID = '" & strEMPID & "' AND PAY_DATE = #" & dtpPayDate.Value & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then strCODES = Field2Str(oRS!CODES) If strCODES = "1" Then txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2)) txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2)) txtHRate = Format(CSng(Field2Str(oRS!Rate)), "#,#.00") '+ CSng(Field2Str(oRS!Reg_RT2))) / 2 txtOTRate = Format(CSng(Field2Str(oRS!OT_Rate)), "#,#.00") ' + CSng(Field2Str(oRS!OT_RT2))) / 2 sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate)))) ' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2))))) sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate)))) ' sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2))))) txtGross = Format(sglRTWages, "#,#.00") txtOTAmt = Format(sglOTWages, "#,#.00") txtTTLAmt = sglOTWages + sglRTWages txtTTLAmt = Format(txtTTLAmt, "#,#.00") ElseIf strCODES = "2" Then txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2)) txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2)) If Field2Str2(oRS!Reg_RT2) > 0 Then txtHRate = (CSng(Field2Str(oRS!Rate)) + CSng(Field2Str(oRS!Reg_RT2))) / 2 sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate)))) sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_HRS2)) * (CSng(Field2Str(oRS!Reg_RT2))))) Else txtHRate = CSng(Field2Str(oRS!Rate)) ' + CSng(Field2Str(oRS!Reg_RT2))) / 2 sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate)))) End If If Field2Str2(oRS!OT_RT2) > 0 Then txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2 sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate)))) sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2))))) Else txtOTRate = CSng(Field2Str(oRS!OT_Rate)) ' + CSng(Field2Str(oRS!OT_RT2))) / 2 sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate)))) End If ' txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2 ' sglRTWages = (CSng(Field2Str(oRS!Reg_Hrs)) * (CSng(Field2Str(oRS!Rate)))) ' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2))))) txtGross = Format(sglRTWages, "#,#.00") txtOTAmt = Format(sglOTWages, "#,#.00") txtTTLAmt = sglOTWages + sglRTWages txtTTLAmt = Format(txtTTLAmt, "#,#.00") End If Else MsgBox "No Employee Time Information Found", vbOKOnly, "No Time" End If Call CrewSave cmdSavePay.Enabled = False Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module cmd1Emp_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdAddLot_Click() Dim strProj As String, strSQL As String, intPROJ As Integer Dim strLine As String, intYN As Integer Dim oRS As Recordset, oRSS As Recordset, oRS2 As Recordset Dim strPSheet As String, oRSPS As Recordset, lngLOTID As Long, dblGPAY As Double Dim strPCODE As String, strLOTNO As String, strPRJLOT As String, lngPROJID As Long intYN = MsgBox("Do You Want To See A List Of Pay Sheets For This Crew?", vbYesNo, "Pay Sheet List?") ' intYN = vbNo If intYN = vbYes Then strPSheet = "SELECT * FROM tblPAYSHEET WHERE Not PAID and not MOVEPAY and CrewID = " & gintCREWID Set oRSPS = New Recordset oRSPS.Open strPSheet, goConn, adOpenDynamic, adLockOptimistic If oRSPS.EOF Then MsgBox "No Pay Sheets Were Found For This Crew.", vbOKOnly, "No Paysheets" Exit Sub Else ' Do Until oRSPS.EOF '*** This when testing lstPaySheets.Clear lstPaySheets.Top = 1200 lstPaySheets.Left = 3780 lstPaySheets.Height = 2400 lstPaySheets.Width = 4335 lstPaySheets.Visible = True Do Until oRSPS.EOF lngLOTID = Field2Str2(oRSPS!lotid) strSQL = "SELECT PROJ_ID, LOT_NO FROM tblLOTINFO WHERE Lot_ID = " & lngLOTID Set oRS2 = New Recordset oRS2.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS2.EOF Then lngPROJID = Field2Str(oRS2!PROJ_ID) strLOTNO = Field2Str(oRS2!lot_no) oRS2.Close Else MsgBox "No Lot Information Found", vbOKOnly, "No Lot" End If strSQL = "SELECT Proj_Code FROM tblPROJECT WHERE Proj_ID = " & lngPROJID Set oRS2 = New Recordset oRS2.Open strSQL, goConn, adOpenDynamic, adLockBatchOptimistic If Not oRS2.EOF Then strPCODE = Field2Str(oRS2!Proj_Code) '************ Check this to make sure it works oRS2.Close Else MsgBox "No Project Found", vbOKOnly, "No Project" Exit Sub End If If oRSPS!Amt = 0 Then dblGPAY = (oRSPS!pay_ydge * oRSPS!Y_Rate) + (oRSPS!METAL * oRSPS!M_Rate) If dblGPAY > 0 Then oRSPS!Amt = dblGPAY oRSPS!GROSSPAY = dblGPAY oRSPS.Update End If End If strPRJLOT = Trim(strPCODE) & " - " & Trim(strLOTNO) strLine = Field2Str2(oRSPS!payid) & vbTab & strPRJLOT & vbTab & Field2Str(oRSPS!Type) strLine = strLine & vbTab & Field2Str(oRSPS!worktype) & vbTab & Field2Str(oRSPS!pay_ydge) strLine = strLine & vbTab & Format(Field2Str2(oRSPS!GROSSPAY), "#,#.00") 'Change to GrossPay when for Final strLine = strLine & vbTab & Field2Str(lngPROJID) & vbTab & Field2Str(lngLOTID) ' strLine = strLine & vbTab & Field2Str(oRSPS!worktype) & vbTab & Field2Str(oRSPS!pay_ydge) & vbTab & Field2Str2(oRSPS!Amt) 'Change to GrossPay when for Final lstPaySheets.AddItem strLine oRSPS.MoveNext Loop End If ElseIf intYN = vbNo Then strProj = InputBox("Enter the Project Code 'JPAR' for the Lot Your Want To Add", "Enter Project Code") If Len(strProj) > 0 Then strProj = UCase(strProj) strSQL = "SELECT proj_id FROM tblProject WHERE proj_code = '" & Field2Str(strProj) & "'" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If oRS.EOF Then frmProjList.txtSearch = strProj frmProjList.Show 1 Else gintPROJID = Field2Long(oRS!PROJ_ID) End If strSQL = "SELECT Lot_No, Lot_id, Address FROM tblLotInfo where proj_id = " & gintPROJID Set oRSS = New Recordset oRSS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic lstLots.Clear lstLots.Top = 1200 lstLots.Left = 3780 lstLots.Height = 2400 lstLots.Width = 4335 lstLots.Visible = True Do Until oRSS.EOF With lstLots strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRSS!address) .AddItem strLine .ItemData(.NewIndex) = oRSS!Lot_ID End With oRSS.MoveNext Loop If lstLots.ListCount Then lblSelect.Visible = True lblCtrl.Visible = True lstLots.ListIndex = 0 End If lstLots.SetFocus Else MsgBox "You Must Enter A Project Code", vbOKOnly, "No Project Code" cmdAddLot.SetFocus Exit Sub End If End If End Sub Private Sub cmdDetail_Click() ' Not Used gintPROJID = moRSPay!PROJ_ID gintLOTID = moRSPay!Lot_ID Call ViewPayInfo End Sub Private Sub cmdAllCrew_Click() Dim strSQL As String, strEMPID As String, dtPAYDT As String Dim oRS As Recordset Dim intCREWCNT As Integer, intCOUNT As Integer Dim sglRTWages, sglOTWages As Single, strCODES As String On Error GoTo Error_EH intCOUNT = 0 intCREWCNT = lstCrew.ListCount Do Until intCOUNT = intCREWCNT ' - 1 lstCrew.col = 1 strEMPID = lstCrew.ColText ' strSQL = "SELECT * FROM tblHOURLIST WHERE PAY_DATE = #" & dtpPayDate.Value & "#" strSQL = "SELECT * FROM tblHOURLIST WHERE EMP_ID = '" & strEMPID & "' AND PAY_DATE = #" & dtpPayDate.Value & "#" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then strCODES = Field2Str(oRS!CODES) If strCODES = "1" Then txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2)) txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2)) txtHRate = Format(CSng(Field2Str(oRS!Rate)), "#,#.00") '+ CSng(Field2Str(oRS!Reg_RT2))) / 2 txtOTRate = Format(CSng(Field2Str(oRS!OT_Rate)), "#,#.00") ' + CSng(Field2Str(oRS!OT_RT2))) / 2 sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate)))) ' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2))))) sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate)))) ' sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2))))) txtGross = Format(sglRTWages, "#,#.00") txtOTAmt = Format(sglOTWages, "#,#.00") txtTTLAmt = sglOTWages + sglRTWages txtTTLAmt = Format(txtTTLAmt, "#,#.00") ElseIf strCODES = "2" Then txtHours = CSng(Field2Str(oRS!RTHours)) '+ CSng(Field2Str(oRS!Reg_HRS2)) txtOTHrs = CSng(Field2Str(oRS!OTHours)) ' + CSng(Field2Str(oRS!OT_HRS2)) If Field2Str2(oRS!Reg_RT2) > 0 Then txtHRate = (CSng(Field2Str(oRS!Rate)) + CSng(Field2Str(oRS!Reg_RT2))) / 2 sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate)))) sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_HRS2)) * (CSng(Field2Str(oRS!Reg_RT2))))) Else txtHRate = CSng(Field2Str(oRS!Rate)) ' + CSng(Field2Str(oRS!Reg_RT2))) / 2 sglRTWages = (CSng(Field2Str(oRS!reg_hrs)) * (CSng(Field2Str(oRS!Rate)))) End If If Field2Str2(oRS!OT_RT2) > 0 Then txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2 sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate)))) sglOTWages = sglOTWages + ((CSng(Field2Str(oRS!OT_Hrs2)) * (CSng(Field2Str(oRS!OT_RT2))))) Else txtOTRate = CSng(Field2Str(oRS!OT_Rate)) ' + CSng(Field2Str(oRS!OT_RT2))) / 2 sglOTWages = (CSng(Field2Str(oRS!OT_Hrs)) * (CSng(Field2Str(oRS!OT_Rate)))) End If ' txtOTRate = (CSng(Field2Str(oRS!OT_Rate)) + CSng(Field2Str(oRS!OT_RT2))) / 2 ' sglRTWages = (CSng(Field2Str(oRS!Reg_Hrs)) * (CSng(Field2Str(oRS!Rate)))) ' sglRTWages = sglRTWages + ((CSng(Field2Str(oRS!Reg_Hrs2)) * (CSng(Field2Str(oRS!Reg_RT2))))) txtGross = Format(sglRTWages, "#,#.00") txtOTAmt = Format(sglOTWages, "#,#.00") txtTTLAmt = sglOTWages + sglRTWages txtTTLAmt = Format(txtTTLAmt, "#,#.00") End If Else MsgBox "No Employee Time Information Found", vbOKOnly, "No Time" End If Call CrewSave lstCrew.ListIndex = lstCrew.ListIndex + 1 intCOUNT = intCOUNT + 1 Loop cmdSavePay.Enabled = False Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module cmd1Emp_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdCalc_Click() Call CalcWages End Sub Private Sub cmdCertPR_Click() frmCertified.Show 1 End Sub Private Sub cmdDivide_Click() Dim dblPay As Double, intCOUNT As Integer, intZERO As Integer Dim strSQL As String, strMSG As String, strSELECT As String Dim oRS As Recordset, strPCID As String On Error GoTo Error_EH If mbytCOUNT = 0 Then strMSG = "There Are No Crew Workers Shown, This Will Cause An Error" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Exit Payroll and Add The Workers For This Crew!" MsgBox strMSG, vbOKOnly, "Enter Crew Members" Exit Sub End If strSELECT = "SELECT COUNT(pay_id) as cntPAY FROM tblPAYCREW WHERE gross = 0 and pay_id = " & gintPAYID Set oRS = New Recordset oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly intZERO = Field2Integer(oRS!cntpay) If intZERO > 0 Then dblPay = Round((Field2Str2(lblDifference.Caption) / intZERO), 2) intCOUNT = 1 Do Until intCOUNT > mbytCOUNT lstCrew.ListIndex = intCOUNT - 1 lstCrew.col = 0 strPCID = lstCrew.ColText strSQL = "SELECT * FROM tblPayCrew WHERE pc_Id = " & strPCID 'lstCrew.ItemData(lstCrew.ListIndex) Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Field2Str2(moRSCREW!gross) = 0 Then If Field2Str2(moRSCREW!hours) = 0 Then If Field2Str2(dblPay) < 120 Then moRSCREW!hours = 10 ElseIf Field2Str2(dblPay) < 240 Then moRSCREW!hours = 20 ElseIf Field2Str2(dblPay) < 360 Then moRSCREW!hours = 30 ' ElseIf Field2Str2(dblPay) < 480 Then ' moRSCREW!hours = 60 Else moRSCREW!hours = 40 End If End If moRSCREW!gross = Field2Str2(dblPay) moRSCREW!REG_WAGE = Field2Str2(dblPay) moRSCREW!Rate = Format((Field2Str2(moRSCREW!gross) / Field2Str2(moRSCREW!hours)), "#0.00##") moRSCREW.Update End If intCOUNT = intCOUNT + 1 Loop End If Call CrewLoad Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module cmdDivide_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdGetCrew_Click() Call GetCrew End Sub Private Sub ClearCrew() Dim strSQL As String, oRS As Recordset, intCNTC As Integer, intALLC As Integer Dim lngCrewID As Integer, boolDONE As Boolean, strCrewID As String boolDONE = False intCNTC = 1 intALLC = lstCrew.ListCount lstCrew.ListIndex = 0 Do Until boolDONE lstCrew.col = 0 strCrewID = Format(Field2Str2(lstCrew.ColText), "######") strSQL = "SELECT * FROM tblPAYCREW WHERE PC_ID = " & strCrewID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then oRS!INCLUDE = vbFalse oRS.Update oRS.Close End If If intCNTC = intALLC Then boolDONE = True intCNTC = 1 lstCrew.ListIndex = 0 Else lstCrew.ListIndex = intCNTC intCNTC = intCNTC + 1 End If Loop Call CrewLoad End Sub Private Sub ClearHouse() Dim strSQL As String, oRS As Recordset, intCNTH As Integer, intALLH As Integer Dim lngPAYID As Integer, boolDONE As Boolean, strPAYID As String boolDONE = False intCNTH = 1 intALLH = lstHouses.ListCount lstHouses.ListIndex = 0 Do Until boolDONE lstHouses.col = 0 strPAYID = Format(Field2Str2(lstHouses.ColText), "######") strSQL = "SELECT * FROM tbltime WHERE IDNUM = " & strPAYID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then oRS!INCLUDE = vbFalse oRS.Update oRS.Close End If If intCNTH = intALLH Then boolDONE = True intCNTH = 1 lstHouses.ListIndex = 0 Else lstHouses.ListIndex = intCNTH intCNTH = intCNTH + 1 End If Loop Call PayLoad End Sub Private Sub cmdMoveHouse_Click() Dim bytCOUNT As Byte, sglPerHouse As Single, strID As String Dim intCOUNT As Integer, oRS As Recordset, strSQL As String intCOUNT = 0 bytCOUNT = lstHouses.ListCount sglPerHouse = CSng(txtSumCrew) / bytCOUNT lstHouses.ListIndex = 0 Do Until intCOUNT = lstHouses.ListCount lstHouses.col = 0 strID = lstHouses.ColText strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If Not oRS.EOF Then oRS!pay_amt = sglPerHouse oRS.Update End If lstHouses.ListIndex = lstHouses.ListIndex + 1 intCOUNT = intCOUNT + 1 Loop Call cmdTotal_Click End Sub Private Sub cmdPaySheet_Click() End Sub Private Sub cmdSavePay_Click() Call CrewSave cmdSavePay.Enabled = False Call cmdTotal_Click lstCrew.SetFocus End Sub Private Sub cmdTest_Click() frmProjList.Show 1 End Sub Private Sub cmdTotal_Click() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH strSQL = "SELECT sum(pay_amt) as SumHouse FROM tblTime where pay_id = " & gintPAYID & " and crew = " & gintCREWID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then txtSumHouse = Format(Field2Str2(oRS!SumHouse), "##,###.00") End If strSQL = "SELECT sum(gross) as SumWorker FROM tblpaycrew where pay_id = " & gintPAYID & " and crew_id = " & gintCREWID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then txtSumCrew = Format(Field2Str2(oRS!SumWorker), "##,###.00") End If lblDifference.Caption = Format(Field2Str2(txtSumHouse) - Field2Str2(txtSumCrew), "##,##0.00;(##,##0.00)") If Field2Str2(lblDifference.Caption) < 0 Then lblDifference.ForeColor = &HFF& lblBalance.Caption = "Crew Greater Than Houses" ElseIf Field2Str2(lblDifference.Caption) > 0 Then lblDifference.ForeColor = &H0& lblBalance.Caption = "Houses Greater Than Crew" Else lblDifference.ForeColor = &H0& lblBalance.Caption = "Payroll is Balanced" End If Call UpCrewPS Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module cmdTotal_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub UpCrewPS() Dim strSQL As String, oRS As Recordset, lngTIMEID As Long Dim strSQL1 As String, strSql2 As String, strSQL3 As String Dim strFIXTYPE As String, strFIXWORKDONE As String lstHouses.col = 0 lngTIMEID = Field2Long(lstHouses.ColText) If lblWorkDone = "A" Then strFIXTYPE = "W" strFIXWORKDONE = "C" lblWorkDone = strFIXWORKDONE lblTYPE2 = strFIXTYPE If lblTYPE2 = "" Then lblTYPE2 = lblTYPE3 End If End If If txtCrewId <> "" Then strSQL = "SELECT * FROM tblPaySheet WHERE LotID = " & Field2Long(lblLotId) ' strSQL1 = " AND CrewID = " & Field2Long(txtCrewId) ' strSQL = strSQL & " and TYPE = '" & strFIXTYPE & "' AND WORKTYPE = '" & strFIXWORKDONE & "'" strSQL = strSQL & " and TYPE = '" & lblTYPE2 & "' AND WORKTYPE = '" & lblWorkDone & "'" ' strSQL = "SELECT * FROM tblPaySheet WHERE LotID = 42471" '& Field2Long(lblLOTID) ' strSQL1 = " AND CrewID = 419" ' & Field2Long(txtCrewId) ' strSQL2 = " and TYPE = 'W' AND WORKTYPE = 'C'" ' strSQL3 = strSQL & strSQL2 ' strSQL3 = strSQL & strSQL1 & strSQL2 Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not mboolDelete Then If Not oRS.EOF Then oRS!timeid = lngTIMEID oRS!crewID = Field2Long(txtCrewId) oRS!paid = vbTrue oRS.Update End If Else mboolDelete = False End If End If End Sub Private Sub cmdLook_Click() gintPROJID = moRSPay!PROJ_ID gintLOTID = moRSPay!Lot_ID Load frmPayroll ' frmPayroll.mboolLOOK = vbTrue frmPayroll.chkLOOK = vbChecked ' cmdLook.Visible = False ' cmdDetail.Visible = False frmPayroll.Show 1 End Sub Private Sub Form_Activate() Dim intResponse As Integer Dim strSQL As String On Error GoTo Error_EH mboolDelete = False ' If chkBiWeekly = True Then ' chkBiWeekly.Visible = True ' Else ' chkBiWeekly.Visible = False ' End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module Form_Activate" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim ShiftDown, AltDown, CtrlDown Dim intLOC As Integer, strWCCODE As String, lngID As Long Dim oRS As Recordset, strSQL As String ' *** CtrlA - Set record for NoCalcuations - All calculations will have be be done manually ' *** CtrlH - Delete the highlighted house ' *** CtrlR - Delete the highlighted crew ' *** CtrlS - Select The Higlighted Lot in lstLots ' *** CtrlT - Add the Out of Balance Amount to the Highlighted Crew Member ' *** CtrlK - View the payroll information for the Highlighted House ' *** CtrlQ - Fix the WC code for the highlighted crew member ' *** CtrlD - Mark The Highlighted Pay Sheet as Paid ' *** CtrlY - Fix TIME yardage for hi-lited house 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 = vbKeyH Then ' Display key combinations. If CtrlDown Then Call HouseDelete Call PayLoad Call cmdTotal_Click ' txtHours.SetFocus If txtHours = "" Or IsNull(txtHours) Then txtHours = 0 End If End If Exit Sub End If If KeyCode = vbKeyR Then ' Display key combinations. If CtrlDown Then Call CrewDelete Call CrewLoad Call cmdTotal_Click End If Exit Sub End If If KeyCode = vbKeyS Then ' Display key combinations. If CtrlDown Then Call lstLots_DblClick End If Exit Sub End If If KeyCode = vbKeyY Then If CtrlDown Then End If Exit Sub End If If KeyCode = vbKeyT Then ' Put the out of balance amount to this employee If CtrlDown Then Call BalancePay End If Exit Sub End If If KeyCode = vbKeyA Then ' Display key combinations. If CtrlDown Then Call NoCalc End If Exit Sub End If ' If KeyCode = vbKeyF Then ' Display key combinations. ' If CtrlDown Then ' Call ViewPayInfo ' End If ' Exit Sub ' End If If KeyCode = vbKeyK Then ' Display key combinations. If CtrlDown Then Call cmdLook_Click End If Exit Sub End If If KeyCode = vbKeyQ Then ' Fix The Project Code (WC Code) for the highlighted employee If CtrlDown Then intLOC = lstCrew.ListIndex strWCCODE = InputBox("Enter The Correct WC Code", "WC Code", moRSCREW!wc_code) moRSCREW!wc_code = strWCCODE moRSCREW.Update End If Exit Sub End If ' If KeyCode = vbKeyW Then ' Clear Marked Crew Members in lstCrew ' If CtrlDown Then ' Call ClearCrew ' End If ' Exit Sub ' End If If KeyCode = vbKeyD Then ' Clear Marked Crew Members in lstCrew If CtrlDown Then If lstPaySheets.ListIndex > -1 Then lstPaySheets.col = 0 lngID = Field2Long(lstPaySheets.ColText) strSQL = "SELECT * FROM tblPaySheet WHERE PAYID = " & lngID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then oRS!paid = vbChecked oRS.Update End If End If End If Exit Sub End If If KeyCode = vbKeyE Then ' Clear Marked Houses in lstHouses If CtrlDown Then If lstPaySheets.ListIndex > -1 Then lstPaySheets.col = 0 lngID = Field2Long(lstPaySheets.ColText) strSQL = "SELECT * FROM tblPaySheet WHERE PAYID = " & lngID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then oRS!invalid = vbChecked oRS!movepay = vbChecked oRS.Update End If End If End If Exit Sub End If End Sub Private Sub NoCalc() Dim strSQL As String Dim oRS As Recordset ' On Error GoTo Error_EH strSQL = "SELECT * FROM tblpayheader WHERE pay_id = " & gintPAYID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then oRS!NoCalc = vbTrue Else oRS!NoCalc = vbFalse End If End Sub Private Sub BalancePay() Dim dblGROSS As Double, dblDIFF As Double dblDIFF = CDbl(lblDifference) dblGROSS = Field2Str2(moRSCREW!gross) If lblBalance.Caption = "Payroll is Balanced" Then moRSCREW!tiebreak = vbFalse moRSCREW.Update Call CrewLoad ElseIf lblBalance.Caption = "Crew Greater Than Houses" Then dblGROSS = dblGROSS + dblDIFF ' dblGROSS = dblGROSS - dblDIFF moRSCREW!REG_WAGE = dblGROSS moRSCREW!gross = dblGROSS ' moRSCREW!Gross = Field2Str2(moRSCREW!Gross) - Field2Str2(lblDifference) moRSCREW!tiebreak = vbTrue moRSCREW.Update Call cmdTotal_Click Call CrewLoad ElseIf lblBalance.Caption = "Houses Greater Than Crew" Then dblGROSS = dblGROSS + dblDIFF ' moRSCREW!Gross = Field2Str2(moRSCREW!Gross) + Field2Str2(lblDifference) moRSCREW!gross = dblGROSS moRSCREW!REG_WAGE = dblGROSS moRSCREW!tiebreak = vbTrue moRSCREW.Update Call cmdTotal_Click Call CrewLoad End If End Sub Private Sub ViewPayInfo() Load frmPayInput frmPayInput.chkLOOK = vbChecked ' cmdLook.Visible = False ' cmdDetail.Visible = False frmPayInput.Show 1 End Sub Private Sub CrewDelete() Dim strSQL As String, strPCID As String lstCrew.col = 0 strPCID = lstCrew.ColText strSQL = "DELETE * FROM tblPayCrew where Pc_id = " & strPCID 'lstCrew.ItemData(lstCrew.ListIndex) goConn.Execute strSQL End Sub Private Sub HouseDelete() Dim strSQL As String, strID As String Call CheckScaf mboolDelete = True Call PaySheetUpdate lstHouses.col = 0 strID = lstHouses.ColText strSQL = "DELETE * FROM tblTime where idnum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) goConn.Execute strSQL ' mboolDelete = False End Sub Private Sub PaySheetUpdate() Dim strSQL As String, strID As String Dim oRS As Recordset lstHouses.col = 0 strID = lstHouses.ColText strSQL = "SELECT * FROM tblPaySheet WHERE timeid = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then ' oRS!crewID = 0 oRS!paid = False ' oRS!paid = vbUnchecked oRS!timeid = 0 oRS!movepay = False ' oRS!movepay = vbNo ' oRS!Amt = 0 ' oRS!Y_Rate = 0 ' oRS!m_Rate = 0 oRS.Update oRS.Close End If End Sub Private Sub CheckScaf() Dim strSQL As String, oRS As Recordset, strID As String Dim strSQLL As String, oRSS As Recordset lstHouses.col = 0 strID = lstHouses.ColText strSQL = "SELECT * FROM tblTIME WHERE idnum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then If oRS!scafid Then strSQLL = "SELECT * FROM tblSCAFFOLD WHERE scaf_id = " & Field2Long(oRS!scafid) Set oRSS = New Recordset oRSS.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic If Not oRSS.EOF Then oRSS!paid = vbUnchecked oRSS!pdamt = 0 ' oRSS!prcrew = 0 oRSS.Update oRSS.Close End If End If End If If oRS.State = adStateOpen Then oRS.Close End If End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{TAB}" KeyAscii = 0 End If End Sub Private Sub Form_Load() On Error GoTo Error_EH lblCertPR.Visible = False cmdCertPR.Visible = False txtHours = 0 txtOTHrs = 0 txtHRate = 0 txtOTRate = 0 txtGross = 0 txtOTAmt = 0 txtTTLAmt = 0 mboolNOYDS = False mintYDS = 0 frmPayHead.Width = 12495 ' frmPayHead.Width = 12315 lstCrew.Width = 3900 Call GetWage Call GetHeader Call PayLoad Call CrewLoad If lstCrew.ListIndex <> -1 Then If FormFindCrew() Then ' If gboolMAS90 Then ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If Call FormShowCrew End If End If Call cmdTotal_Click Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module Form_Load" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Function FormFindPay() As Boolean Dim strSQL As String, strID As String On Error GoTo Error_EH lstHouses.col = 0 strID = lstHouses.ColText strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) ' strSQL = strSQL & "FROM tblTIME " ' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex) Set moRSPay = New Recordset moRSPay.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If moRSPay.EOF Then FormFindPay = False Else FormFindPay = True lblProjId = Field2Str2(moRSPay!PROJ_ID) lblLotId = Field2Str2(moRSPay!Lot_ID) lblWorkDone = Field2Str(moRSPay!WorkDone) ' If moRSPay!certpr Then ' mboolCERTIFIED = True ' End If End If Exit Function Error_EH: gstrMODULE = "Form PayHead - Module FormFindPay" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindCrew() As Boolean Dim strSQL As String, strPCID As String On Error GoTo Error_EH lstCrew.col = 0 strPCID = lstCrew.ColText strSQL = "SELECT * " strSQL = strSQL & "FROM tblPayCrew " strSQL = strSQL & "WHERE Pc_Id = " & Field2Str2(strPCID) ' strSQL = strSQL & "WHERE Pc_Id = " & lstCrew.ItemData(lstCrew.ListIndex) Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If moRSCREW.EOF Then FormFindCrew = False Else FormFindCrew = True End If Exit Function Error_EH: gstrMODULE = "Form PayHead - Module FormFindCrew" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Function FormFindPS() Dim strSQL As String, strPCID As String On Error GoTo Error_EH lstPaySheets.col = 0 mlngPSPAYID = Field2Long(lstPaySheets.ColText) ' strPCID = lstCrew.ColText strSQL = "SELECT * FROM tblPaySheet WHERE PayId = " & mlngPSPAYID ' strSQL = strSQL & "WHERE Pc_Id = " & lstCrew.ItemData(lstCrew.ListIndex) Set moRSPS = New Recordset moRSPS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If moRSCREW.EOF Then FormFindPS = False Else FormFindPS = True End If Exit Function Error_EH: gstrMODULE = "Form PayHead - Module FormFindCrew" Call ErrorHandler2 gstrMODULE = "" Exit Function End Function Private Sub FormShowPay() Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSC As Recordset On Error GoTo Error_EH With moRSPay strSQL = "SELECT * FROM tblLotInfo WHERE Lot_id = " & Field2Str(!Lot_ID) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then lblAddress.Caption = Field2Str(oRS!address) If !pay_type = "S" Then lblDYds.Caption = Field2Str(oRS!s_yds) lblDMetal.Caption = "" lblDFin2.Caption = Field2Str2(oRS!fin2) ElseIf !pay_type = "L" Or !pay_type = "W" Then lblDYds.Caption = Field2Str(oRS!l_yds) lblDMetal.Caption = Field2Str2(oRS!METAL) lblDFin2.Caption = "" ElseIf !pay_type = "V" Then txtStone = Field2Str(oRS!ST_SQFT) lblDYds.Caption = "" lblDMetal.Caption = "" lblDFin2.Caption = "" ElseIf !pay_type = "C" Then lblYds = "Frames:" lblDYds.Caption = Field2Str2(oRS!Scaf6) lblDMetal.Caption = "" ' End If lblDFin2.Caption = Field2Str2(oRS!scaf10) lblFrames.Visible = True lblFrameCnt.Visible = True ElseIf !pay_type = "X" Then txtPaint = Field2Str(oRS!PNT_SQFT) lblDYds.Caption = "" lblDMetal.Caption = "" lblDFin2.Caption = "" Else lblDYds.Caption = "" lblDMetal.Caption = "" lblDFin2.Caption = "" End If End If If mboolCERTIFIED Then lblCertPR.Visible = True cmdCertPR.Visible = True ' Else ' lblCertPR.Visible = False End If If Field2Str(!pay_type) = "S" Then lblType.Caption = "STUCCO" lblTYPE2 = Field2Str(!pay_type) ElseIf Field2Str(!pay_type) = "L" Then lblType.Caption = "LATH" lblTYPE2 = Field2Str(!pay_type) ElseIf Field2Str(!pay_type) = "V" Then lblType.Caption = "V_STONE" lblTYPE2 = Field2Str(!pay_type) ElseIf Field2Str(!pay_type) = "R" Then lblType.Caption = "REPAIR/PO" lblTYPE2 = Field2Str(!pay_type) ElseIf Field2Str(!pay_type) = "C" Then lblType.Caption = "SCAFFOLD" lblTYPE2 = Field2Str(!pay_type) ElseIf Field2Str(!pay_type) = "X" Then lblType.Caption = "PAINT" lblTYPE2 = Field2Str(!pay_type) ElseIf Field2Str(!pay_type) = "W" Then lblType.Caption = "WRAP" lblTYPE2 = Field2Str(!pay_type) ElseIf Field2Str(!pay_type) = "Q" Then lblType.Caption = "MISC" lblTYPE2 = Field2Str(!pay_type) End If If lblTYPE2 = "" Then lblTYPE2 = lblTYPE3 End If If !bc Then lblBC.Caption = "Back Chg" ElseIf Field2Str(!WorkDone) = "W" Then lblBC.Caption = "PO Work" ElseIf Field2Str(!WorkDone) = "F" Then lblBC.Caption = "Fence" ElseIf Field2Str(!WorkDone) = "U" Then lblBC.Caption = "CMU" Else lblBC.Caption = "" End If lblPay.Caption = Format(Field2Str2(!pay_amt), "##,##0.00;(##,##0.00)") lblDRate.Caption = Field2Str2(!yd_rate) lblDRate2.Caption = Field2Str2(!fin2_Rate) lblDMRate.Caption = Field2Str2(!mtl_Rate) lblFrameCnt = Field2Str2(!frames) End With Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module FormShowPay" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub FormShowCrew() Dim strSQL As String, strSql2 As String Dim oRS As Recordset, oRSS As Recordset On Error GoTo Error_EH With moRSCREW lblEmpId.Caption = Field2Str(!Emp_ID) lblEmpName.Caption = Field2Str(!EmpName) lblWCCode = Field2Str(!wc_code) strSql2 = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & Field2Str2(!Emp_ID) & "'" Set oRSS = New Recordset oRSS.Open strSql2, goConn, adOpenDynamic, adLockPessimistic ' oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic If Not oRSS.EOF Then ' oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic If oRSS!Terminated <> "A" Then lblTerm.Visible = True Else lblTerm.Visible = False End If End If txtHRate = Format(Field2Str2(!Rate), "#0.00##") txtHours = Format(Field2Str2(!hours), "#0.0#") txtGross = Format(Field2Str2(!REG_WAGE), "##,##0.00") txtOTRate = Format(Field2Str2(!OT_Rate), "#0.00##") txtOTHrs = Format(Field2Str2(!OT_Hours), "#0.0#") txtOTAmt = Format(Field2Str2(!OT_Wage), "##,##0.00") txtTTLAmt = Format(Field2Str2(!gross), "##,##0.00") txtTTLHrs = Field2Str2(!TTLHrs) txtTTLPay = Format(Field2Str2(!TTLPay), "#,##0.00##") If Field2Str(!autodeduct) = "Y" Then chkDeduct = vbChecked Else chkDeduct = vbUnchecked End If If !tiebreak Then lblTIE.Visible = True Else lblTIE.Visible = False End If End With Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module FormShowCrew" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetPay() Dim strSQL As String, strID As String lstPaySheets.col = 0 strID = lstPaySheets.ColText strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) ' strSQL = strSQL & "FROM tblTIME " ' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex) Set moRSPay = New Recordset moRSPay.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If moRSPay.EOF Then End If End Sub Private Sub GetHRS() Dim strSQL As String, strID As String lstHouses.col = 0 strID = lstHouses.ColText strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) ' strSQL = strSQL & "FROM tblTIME " ' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex) Set moRSPay = New Recordset moRSPay.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If Not moRSPay.EOF Then If Field2Str2(moRSPay!pay_type) = "S" Or Field2Str2(moRSPay!pay_type) = "L" Then If Field2Str2(moRSPay!yds) = 0 Then moRSPay!yds = CInt(lblDYds) moRSPay.Update End If End If End If End Sub Private Sub GetPS() Dim strSQL As String, strID As String lstPaySheets.col = 0 strID = lstPaySheets.ColText strSQL = "SELECT * FROM tblPAYSHEET WHERE PAYID = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) ' strSQL = strSQL & "FROM tblTIME " ' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex) Set moRSSPS = New Recordset moRSSPS.Open strSQL, goConn, adOpenKeyset, adLockPessimistic If moRSSPS.EOF Then End If End Sub Private Sub GetCrew() Dim oRS As Recordset, oRSS As Recordset Dim strSQL As String, strCREW As String On Error GoTo Error_EH strCREW = "SELECT * FROM tblPayCrew WHERE pc_id = 1" Set oRSS = New Recordset oRSS.Open strCREW, goConn, adOpenForwardOnly, adLockOptimistic strSQL = "SELECT * FROM tblCrewList WHERE crew_id = " & Str2Field(txtCrewId) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If oRS.EOF Then MsgBox "No Workers Were Found For The Highlited Crew. Exit and Enter the Workers", vbOKOnly, "Workers Not Dound" Exit Sub End If Do Until oRS.EOF oRSS.AddNew oRSS!pay_id = gintPAYID oRSS!CREW_ID = Field2Str(oRS!CREW_ID) oRSS!Emp_ID = Field2Str(oRS!Emp_ID) oRSS!EmpName = Left(Field2Str(oRS!EmpName), 30) oRSS!Pay_Date = Field2Str(txtPayDate) oRSS!wc_code = Field2Str(oRS!wc_code) oRSS.Update oRS.MoveNext Loop Call CrewLoad Exit Sub Error_EH: If Err.Number = -2147467259 Then MsgBox "Duplicate Crew Member - This Member will not be saved", , "Duplicate Record" Resume Next ' Exit Sub End If gstrMODULE = "Form PayHead - Module GetCrew" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetHeader() Dim strSQL As String On Error GoTo Error_EH strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = " & gintPAYID Set moRSHEAD = New Recordset moRSHEAD.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic chkReady = Field2CheckBox(moRSHEAD!P_FLAG) ' chkReady = moRSHEAD!p_flag Exit Sub Error_EH: If Err.Number = -2147467259 Then MsgBox "Duplicate Crew List - This will not be saved", , "Duplicate Record" Exit Sub End If gstrMODULE = "Form PayHead - Module CrewSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetWage() Dim strSQL As String, oRS As Recordset strSQL = "SELECT * FROM tblSYSInfo" Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRS.EOF Then gsngWAGE = Field2Str2(oRS!WAGE) End If End Sub Private Sub CrewSave() On Error GoTo Error_EH If moRSCREW.State = adStateClosed Then Exit Sub End If With moRSCREW !Rate = Str2Field(txtHRate.Text) !hours = Str2Field(txtHours.Text) !gross = Str2Field(txtTTLAmt.Text) !OT_Wage = Str2Field(txtOTAmt.Text) !REG_WAGE = Str2Field(txtGross.Text) !OT_Hours = Str2Field(txtOTHrs.Text) !OT_Rate = Str2Field(txtOTRate) !TTLHrs = Str2Field(txtTTLHrs) !TTLPay = Str2Field(txtTTLPay) If chkDeduct Then !autodeduct = "Y" Else !autodeduct = "N" End If End With moRSCREW.Update Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module CrewSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub GetWorkType() Dim strSQL As String, oRSW As Recordset strSQL = "SELECT * FROM tblcboWorkType WHERE WTCode = '" & mstrWDone & "'" Set oRSW = New Recordset oRSW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly If Not oRSW.EOF Then mstrWTYPE = Field2Str(oRSW!worktype) End If oRSW.Close End Sub Private Sub PayLoad() Dim oRS As Recordset Dim strSQL As String, strLOT As String, strY As String Dim strLine As String, strWORK As String 'Add to New 11/15/17 On Error GoTo Error_EH lblCertPR.Visible = False cmdCertPR.Visible = False strSQL = "SELECT * from tblTime WHERE Pay_id = " & gintPAYID Set moRSPay = New Recordset moRSPay.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstHouses.Clear Do Until moRSPay.EOF If moRSPay!certpr Then lblCertPR.Visible = True cmdCertPR.Visible = True End If With lstHouses mstrWDone = Field2Str(moRSPay!WorkDone) If CInt(Field2Str2(moRSPay!yds)) > 0 Then mintYDS = mintYDS + CInt(Field2Str2(moRSPay!yds)) Else mboolNOYDS = True End If Call GetWorkType strWORK = mstrWTYPE If moRSPay!INCLUDE = vbTrue Then strY = "Y" Else strY = "" End If ' if morspay! If moRSPay!bc Then strLOT = Field2Long(moRSPay!idnum) & vbTab & Field2Str(moRSPay!proj_lot) & vbTab & "BACK CHARGE" & vbTab & strY Else strLOT = Field2Long(moRSPay!idnum) & vbTab & Field2Str(moRSPay!proj_lot) & vbTab & strWORK & vbTab & strY End If ' ElseIf Field2Str(moRSPay!workdone) = "W" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PO WORK" ' ElseIf Field2Str(moRSPay!workdone) = "U" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "CMU" ' ElseIf Field2Str(moRSPay!workdone) = "A" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "TYPAR WRAP" ' ElseIf Field2Str(moRSPay!workdone) = "C" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "COMPLETE" ' ElseIf Field2Str(moRSPay!workdone) = "P" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PARTIAL" ' ElseIf Field2Str(moRSPay!workdone) = "F" Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "FENCES" ' ElseIf Field2Str(moRSPay!workdone = "Y") Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "UP" ' ElseIf Field2Str(moRSPay!workdone = "Z") Then ' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "DOWN" ' Else ' strLOT = Field2Str(moRSPay!proj_lot) ' End If .AddItem strLOT ' .ItemData(.NewIndex) = Field2Long(moRSPay!idnum) End With moRSPay.MoveNext Loop ' moRSPay.Close If lstHouses.ListCount Then lstHouses.ListIndex = 0 Else lstHouses.ListIndex = -1 lblType.Caption = "" lblAddress.Caption = "" lblPay.Caption = "" End If lblTEST = mintYDS Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module PayLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewLoad() Dim oRS As Recordset Dim strSQL As String, strY As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT * from tblPaycrew WHERE Pay_id = " & gintPAYID Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstCrew.Clear mbytCOUNT = 0 Do Until moRSCREW.EOF With lstCrew If moRSCREW!INCLUDE = vbTrue Then strY = "Y" Else strY = "" End If strLine = Field2Str2(moRSCREW!pc_id) & vbTab & Field2Str(moRSCREW!Emp_ID) & vbTab & Field2Str(moRSCREW!EmpName) & vbTab & strY .AddItem strLine ' .ItemData(.NewIndex) = moRSCREW!pc_id End With mbytCOUNT = Field2Str2(mbytCOUNT) + 1 moRSCREW.MoveNext Loop If lstCrew.ListCount Then lstCrew.ListIndex = 0 Else lstCrew.ListIndex = -1 lblEmpId.Caption = "" lblEmpName.Caption = "" lblWCCode = "" End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module CrewLoad" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub CrewLoadOld() Dim oRS As Recordset Dim strSQL As String Dim strLine As String On Error GoTo Error_EH strSQL = "SELECT * from tblPaycrew WHERE Pay_id = " & gintPAYID Set moRSCREW = New Recordset moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly lstCrew.Clear mbytCOUNT = 0 Do Until moRSCREW.EOF With lstCrew strLine = Field2Str(moRSCREW!Emp_ID) & " " & Field2Str(moRSCREW!EmpName) .AddItem strLine .ItemData(.NewIndex) = moRSCREW!pc_id End With mbytCOUNT = Field2Str2(mbytCOUNT) + 1 moRSCREW.MoveNext Loop If lstCrew.ListCount Then lstCrew.ListIndex = 0 Else lstCrew.ListIndex = -1 lblEmpId.Caption = "" lblEmpName.Caption = "" lblWCCode = "" End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module CrewLoadOld" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub SavePay() Dim strSQL As String Dim oRS As Recordset On Error GoTo Error_EH strSQL = "SELECT * FROM tblpayheader WHERE pay_id = " & gintPAYID Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If Not oRS.EOF Then oRS!sum_houses = Field2Str2(txtSumHouse) oRS!sum_workers = Field2Str2(txtSumCrew) oRS!P_FLAG = chkReady oRS.Update End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module SavePay" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim intResponse As Integer, strMSG As String On Error GoTo Error_EH Call SavePay If cmdSavePay.Enabled Then strMSG = "Employee Pay 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 CrewSave Case vbNo Case vbCancel Cancel = True Exit Sub End Select End If If Field2Str2(lblDifference.Caption) <> 0 Then strMSG = "The Payroll Is Not Balanced" strMSG = strMSG & Chr(13) & Chr(10) strMSG = strMSG & "Are You Sure You Want To Exit ?" intResponse = MsgBox(strMSG, vbQuestion + vbYesNo, "PAYROLL UNBALANCED") Select Case intResponse Case vbYes Case vbNo Cancel = True Exit Sub End Select End If If moRSPay.State = adStateOpen Then moRSPay.Close End If If moRSCREW.State = adStateOpen Then moRSCREW.Close End If Exit Sub Error_EH: If Err = 3219 Then Resume Next End If End Sub Private Sub lblStart_Click() End Sub Private Sub lstCrew_Click() On Error GoTo Error_EH If lstCrew.ListIndex <> -1 Then If FormFindCrew() Then ' If gboolMAS90 Then '***FIX Need to remove when new tables are setup ' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90" ' Exit Sub ' End If Call FormShowCrew Else lblEmpId.Caption = "" lblEmpName.Caption = "" lblWCCode = "" txtHRate = "0" txtHours = "0" txtGross = "0" txtTTLAmt = "0" txtOTHrs = "0" txtOTRate = "0" txtOTAmt = "0" txtTTLHrs = "" txtTTLPay = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module lstCrew_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstCrew_DblClick() Dim intBOOKMARK As Integer ' frmCrewList.Show 1 ' Call CrewLoad intBOOKMARK = lstCrew.ListIndex If moRSCREW!INCLUDE = vbTrue Then moRSCREW!INCLUDE = vbFalse ElseIf moRSCREW!INCLUDE = vbFalse Then moRSCREW!INCLUDE = vbTrue End If moRSCREW.Update Call CrewLoad lstCrew.ListIndex = intBOOKMARK cmdSavePay.Enabled = True End Sub Private Sub lstHouses_Click() On Error GoTo Error_EH If lstHouses.ListIndex <> -1 Then If FormFindPay() Then Call FormShowPay Else lblType.Caption = "" lblAddress.Caption = "" lblPay.Caption = "" lblDYds.Caption = "" lblDFin2.Caption = "" lblDMetal.Caption = "" lblDRate.Caption = "" lblDRate2.Caption = "" lblDMRate.Caption = "" txtStone = "" txtPaint = "" End If End If Exit Sub Error_EH: gstrMODULE = "Form PayHead - Module lstHouses_Click" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub lstHouses_DblClick() Dim intBOOKMARK As Integer ' frmCrewList.Show 1 ' Call CrewLoad If lstHouses.ListCount > 0 Then intBOOKMARK = lstHouses.ListIndex If moRSPay!INCLUDE = vbTrue Then moRSPay!INCLUDE = vbFalse ElseIf moRSPay!INCLUDE = vbFalse Then moRSPay!INCLUDE = vbTrue End If moRSPay.Update Call PayLoad lstHouses.ListIndex = intBOOKMARK End If ' cmdSavePay.Enabled = True ' cmdDetail.Visible = True ' cmdLook.Visible = True ' gintPROJID = moRSPay!proj_id ' gintLOTID = moRSPay!Lot_id End Sub Private Sub lstLots_DblClick() Dim strPAYID As String strPAYID = gintPAYID gintLOTID = lstLots.ItemData(lstLots.ListIndex) lstLots.Visible = False Load frmPayInput frmPayInput.txtCrewNo = Field2Str(txtCrewId) frmPayInput.txtCrewName = Field2Str(lblCrewName.Caption) frmPayInput.chkADD = vbChecked frmPayInput.Show 1 lblSelect.Visible = False lblCtrl.Visible = False Call PayLoad Call cmdTotal_Click cmdAddLot.SetFocus End Sub Private Sub lstPaySheets_Click() Dim strSQL As String, strID As String Dim oRS As Recordset, strPAYID As String 'Got to find out where to get the tblTIME id or just open the tblTIME and add a new one. lstPaySheets.col = 0 strID = lstPaySheets.ColText strSQL = "SELECT * FROM tblPaySheet WHERE timeid = " & strID 'lstHouses.ItemData(lstHouses.ListIndex) Set oRS = New Recordset oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not oRS.EOF Then ' oRS!crewID = 0 oRS!paid = vbUnchecked oRS!timeid = 0 oRS!movepay = vbNo ' oRS!Amt = 0 ' oRS!Y_Rate = 0 ' oRS!m_Rate = 0 oRS.Update oRS.Close End If glngPSID = strID strPAYID = gintPAYID End Sub Private Sub lstPaySheets_DblClick() Dim strPAYID As String, lngLOTID As Long, lngPROJID As Long ' Call lstPaySheets_Click Call GetPay mboolAdding = True strPAYID = gintPAYID lstPaySheets.col = 0 glngPSID = Field2Long(lstPaySheets.ColText) lstPaySheets.col = 6 gintPROJID = Field2Long(lstPaySheets.ColText) lstPaySheets.col = 7 gintLOTID = Field2Long(lstPaySheets.ColText) Call FormSavePS ' gintLOTID = lstLots.ItemData(lstLots.ListIndex) ' lstLots.Visible = False lstPaySheets.Visible = False Load frmPayInput ' frmPayInput.lblTimeID = gintPAYID frmPayInput.txtCrewNo = Field2Str(txtCrewId) frmPayInput.txtCrewName = Field2Str(lblCrewName.Caption) frmPayInput.chkADD = vbChecked frmPayInput.chkPS = vbChecked '**????? Not sure needed frmPayInput.Show 1 lblSelect.Visible = False lblCtrl.Visible = False Call PayLoad Call cmdTotal_Click cmdAddLot.SetFocus End Sub Private Sub FormSavePS() Dim strSQL As String ' On Error GoTo Error_EH strSQL = "SELECT * FROM tblTIME" 'WHERE idnum = 1" Set moRSTIME = New Recordset moRSTIME.Open strSQL, goConn, adOpenKeyset, adLockOptimistic If mboolAdding Then moRSTIME.AddNew End If strSQL = "SELECT * FROM tblLOTINFO WHERE LOT_ID = " & gintLOTID Set moRS = New Recordset moRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic If Not moRS.EOF Then mstrTexture = Field2Str(moRS!texture) End If ' Store the controls to the recordset ' If Not moRS.EOF Then Call FieldsSavePS ' End If ' moRSMemo!payroll = Str2Field(txtLotNotes) ' moRSMemo.Update Exit Sub Error_EH: Call ErrorHandler(moRSTIME.ActiveConnection) Exit Sub End Sub Private Sub FieldsSavePS() Dim lngTIMEID As Long, strID As String, strWT As String, strDESC As String, strCrewType As String Call GetPS ' On Error GoTo Error_EH With moRSTIME !PROJ_ID = gintPROJID !Lot_ID = gintLOTID !lot_no = Str2Field(moRS!lot_no) !paydt = Date lstPaySheets.col = 2 !pay_type = Str2Field(lstPaySheets.ColText) strCrewType = Str2Field(lstPaySheets.ColText) ' cboWorkType.col = 0 ' strID = cboWorkType.ColText lstPaySheets.col = 3 strWT = lstPaySheets.ColText ' cboWorkType.col = 2 ' strDESC = cboWorkType.ColText ' !workdone = Left(Str2Field(cboWorkType.Text), 1) !WorkDone = strWT !C_USER = gstrLOGIN !pct_done = 100 ' !pct_done = Integer2Field(txtPercentDone) !pay_id = gintPAYID lstPaySheets.col = 1 !proj_lot = Field2Str(lstPaySheets.ColText) ') & " " & Trim(Field2Str(moRS!lot_no)) ' !proj_lot = Trim(Field2Str(moRSProj!Proj_Code)) & " " & Trim(Field2Str(moRS!lot_no)) !yd_rate = Field2Str(moRSSPS!Y_Rate) ' !yd_rate = Double2Field(txtYRate) If strCrewType = "S" And (mstrTexture = "DF" Or mstrTexture = "SS" Or mstrTexture = "RF" Or mstrTexture = "M2" Or mstrTexture = "M3" Or mstrTexture = "MF") Then !fin2_Rate = Field2Str(moRSSPS!Y_Rate) ' !fin2_Rate = Field2Str(moRSSPS!m_Rate) ElseIf strCrewType = "L" Then !mtl_Rate = Field2Str(moRSSPS!M_Rate) End If ' !bc = vbUnchecked !ponum = 0 !scafid = 0 !up = vbUnchecked !frames = 0 !crew = Integer2Field(txtCrewId) !notes = Field2Str(moRSSPS!notes) !StrtTM = 0 !Lunch = ".00" !EndTM = 0 !NetTime = "0.00" !WorkDay = 0 !pay_amt = Field2Str2(moRSSPS!GROSSPAY) ' !pay_amt = Str2Field(txtAmount) ' !notes = Str2Field(txtMDesc) '' If chkBC Then '' !bc = vbChecked '' !pay_amt = (Double2Field(txtAmount) * -1) ' !pay_amt = (Integer2Field(txtAmount) * -1) '' Else '' !bc = vbUnchecked '' !pay_amt = (Double2Field(txtAmount)) ' !pay_amt = (Integer2Field(txtAmount)) '' End If ' !office = Str2Field(txtNotes) !C_USER = gstrLOGIN !Create = Date !U_USER = gstrLOGIN !Update = Date End With moRSTIME.Update lngTIMEID = FindMax("tblTIME", "IDNUM") '' With moRSPay ' !pdamt = Field2Str2(txtPayAmt) '' !Amt = Field2Str2(txtAmount) '' !GROSSPAY = Field2Str2(txtAmount) '' !paid = vbChecked '' !Y_Rate = Field2Str2(txtYRate) '' !m_Rate = Field2Str2(txtMetal) '' !crewID = Field2Str2(txtCrewID) moRSSPS!timeid = lngTIMEID '' End With moRSSPS.Update If mboolAdding Then mboolAdding = False End If Exit Sub Error_EH: If Err.Number = -2147467259 Then MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record" Resume Next End If gstrMODULE = "FormScaffold - Module FieldsSave" Call ErrorHandler2 gstrMODULE = "" Exit Sub End Sub Private Sub txtGross_GotFocus() mdblGROSS = Field2Str2(txtGross) Call FieldSelect(txtGross) End Sub Private Sub txtGross_LostFocus() If Not IsNumeric(txtGross) Then ' Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtGross = 0 txtGross.SetFocus Exit Sub End If If Field2Str2(txtGross) <> mdblGROSS Then cmdSavePay.Enabled = True End If If Not moRSCREW!tiebreak Then Call CalcPay Call cmdTotal_Click End If End Sub Private Sub txtHours_GotFocus() '********** Remove comment sign after moved to keeping track of time ' If Field2Str2(txtHours) = 0 And gbool2WK Then ' txtHours = 80 ' ElseIf Field2Str2(txtHours) = 0 And gbool1WK Then ' txtHours = 40 ' End If If Field2Str2(txtHours) = 0 Then txtHours = 40 End If mdblHours = Field2Str2(txtHours) Call FieldSelect(txtHours) End Sub Private Sub txtHours_LostFocus() If Not IsNumeric(txtHours) Then ' Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtHours = 0 txtHours.SetFocus Exit Sub End If If Field2Str2(txtHours) <> mdblHours Then cmdSavePay.Enabled = True End If End Sub Private Sub txtHRate_GotFocus() mdblRate = Field2Str2(txtHRate) Call FieldSelect(txtHRate) End Sub Private Sub txtHRate_LostFocus() If txtHRate = "" Then txtHRate = 0 End If If Not IsNumeric(txtHRate) Then ' Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtHRate = 0 txtHRate.SetFocus Exit Sub End If If Field2Str2(txtHRate) <> mdblRate Then cmdSavePay.Enabled = True End If End Sub Private Sub CalcPay() If Field2Str2(txtGross) > 0 Then If Field2Str2(txtHours = 0) Then txtHours = 40 mdblHours = Field2Str2(txtHours) cmdSavePay.Enabled = True End If If Field2Str2(txtHRate) = 0 Then txtHRate = Format((Field2Str2(txtGross) / Field2Str2(txtHours)), "##.00##") mdblRate = Field2Str2(txtHRate) cmdSavePay.Enabled = True End If If Field2Str2(txtHRate) < gsngWAGE Then MsgBox "The Hourly Rate is below $" & Format(gsngWAGE, "###.00") & ", Change the Hours Worked To Correct This", vbOKOnly, "Hourly Rate Problem" txtHRate = 0 txtHours.SetFocus End If ' Exit Sub End If If Field2Str2(txtHours) > 0 And Field2Str2(txtHRate) > 0 Then If mdblHours <> Field2Str2(txtHours) Or mdblRate <> Field2Str2(txtHRate) Then txtGross = Format((Field2Str2(txtHours) * Field2Str2(txtHRate)), "##,###.00") cmdSavePay.Enabled = True End If If Field2Str2(txtGross) = 0 Then txtGross = Format((Field2Str2(txtHours) * Field2Str2(txtHRate)), "##,###.00") cmdSavePay.Enabled = True End If ' Exit Sub End If If Field2Str2(txtOTHrs) > 0 And Field2Str2(txtOTRate) > 0 Then If mdblOTHours <> Field2Str2(txtOTHrs) Or mdblOTRate <> Field2Str2(txtOTRate) Then txtOTAmt = Format((Field2Str2(txtOTHrs) * Field2Str2(txtOTRate)), "##,###.00") cmdSavePay.Enabled = True ElseIf Field2Str2(txtOTAmt) = 0 Then txtOTAmt = Format((Field2Str2(txtOTHrs) * Field2Str2(txtOTRate)), "##,###.00") cmdSavePay.Enabled = True End If ' Exit Sub End If If Field2Str2(txtGross) > 0 Or Field2Str2(txtOTAmt) > 0 Then txtTTLAmt = CDbl(Field2Str2(txtGross)) + CDbl(Field2Str2(txtOTAmt)) txtTTLAmt = Format(txtTTLAmt, "#,#,#.00") End If End Sub Private Sub txtOTAmt_GotFocus() mdblOTGROSS = Field2Str2(txtOTAmt) Call FieldSelect(txtOTAmt) End Sub Private Sub txtOTAmt_LostFocus() If Not IsNumeric(txtOTAmt) Then ' Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtOTAmt = 0 txtOTAmt.SetFocus Exit Sub End If If Field2Str2(txtOTAmt) <> mdblOTGROSS Then cmdSavePay.Enabled = True End If Call CalcPay Call cmdTotal_Click End Sub Private Sub txtOTHrs_GotFocus() txtOTHrs = Field2Str2(txtOTHrs) mdblOTHours = Field2Str2(txtOTHrs) Call FieldSelect(txtOTHrs) End Sub Private Sub txtOTHrs_LostFocus() If Not IsNumeric(txtOTHrs) Then ' Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtOTHrs = 0 txtOTHrs.SetFocus Exit Sub End If If Field2Str2(txtOTHrs) <> mdblOTHours Then cmdSavePay.Enabled = True End If End Sub Private Sub txtOTRate_GotFocus() mdblOTRate = Field2Str2(txtOTRate) Call FieldSelect(txtOTRate) End Sub Private Sub txtOTRate_LostFocus() If txtOTRate = "" Then txtOTRate = 0 End If If Not IsNumeric(txtOTRate) Then ' Beep MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid" txtOTRate = 0 txtOTRate.SetFocus Exit Sub End If If Field2Str2(txtOTRate) <> mdblOTRate Then cmdSavePay.Enabled = True End If End Sub Private Sub txtTTLAmt_GotFocus() Call FieldSelect(txtTTLAmt) End Sub Private Sub txtTTLHrs_GotFocus() Call FieldSelect(txtTTLHrs) End Sub Private Sub CalcWages() If Field2Str2(txtTTLHrs) <= 40 Then lblCalcHrs = Field2Str2(txtTTLHrs) txtHours = txtTTLHrs txtHRate = Field2Str2(txtTTLPay) / Field2Str2(lblCalcHrs) txtHRate = Format(Round(Field2Str2(txtHRate), 4), "#,0.00##") ElseIf Field2Str2(txtTTLHrs) > 40 Then lblCalcHrs = (((Field2Str2(txtTTLHrs) - 40) * 1.5) + 40) txtHours = 40 txtOTHrs = Field2Str2(txtTTLHrs) - 40 txtHRate = Field2Str2(txtTTLPay) / Field2Str2(lblCalcHrs) txtOTRate = Field2Str2(txtHRate) * 1.5 txtHRate = Format(Round(Field2Str2(txtHRate), 4), "#,0.00##") txtOTRate = Format(Round(Field2Str2(txtOTRate), 4), "#,0.00##") End If End Sub Private Sub txtTTLPay_GotFocus() Call FieldSelect(txtTTLPay) End Sub Private Sub txtTTLPay_LostFocus() txtTTLPay = Format(txtTTLPay, "#,##0.00") End Sub