azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
65f20453859f3ce0e9286cf4df0a428cf3ddc199
claudetools/clients/valleywide/app-modernization/source-code/Orders-VWP_Current-2020/frmHourList.frm
Mike Swanson fccf9f9468 sync: auto-sync from GURU-5070 at 2026-06-14 05:33:01 
Author: Mike Swanson
Machine: GURU-5070
Timestamp: 2026-06-14 05:33:01
2026-06-14 05:34:46 -07:00

2515 lines
81 KiB
Plaintext
Raw Blame History

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 frmHourList
Caption = "Daily Payroll for Hourly Employees"
ClientHeight = 7080
ClientLeft = 60
ClientTop = 345
ClientWidth = 8295
ControlBox = 0 'False
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7080
ScaleWidth = 8295
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtCombOTHrs
Alignment = 1 'Right Justify
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 6090
TabIndex = 60
Top = 5070
Width = 615
End
Begin VB.TextBox txtCombRTHrs
Alignment = 1 'Right Justify
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5385
TabIndex = 58
Top = 5070
Width = 615
End
Begin LpLib.fpList lstPayCrews
Height = 3960
Left = 165
TabIndex = 57
Top = 720
Width = 3765
_Version = 196608
_ExtentX = 6641
_ExtentY = 6985
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 = 10
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= 0 'False
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 = "frmHourList.frx":0000
End
Begin VB.TextBox txtPC2
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 2445
TabIndex = 54
Top = 6780
Width = 615
End
Begin VB.TextBox txtPayCD
Alignment = 2 'Center
Height = 285
Left = 6330
TabIndex = 20
Top = 5835
Width = 570
End
Begin VB.TextBox txtPC1
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1770
TabIndex = 53
Top = 6780
Width = 615
End
Begin VB.TextBox txtOTRate2
Alignment = 1 'Right Justify
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 6735
TabIndex = 49
Top = 4515
Width = 615
End
Begin VB.TextBox txtOT2
Alignment = 1 'Right Justify
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 6090
TabIndex = 48
Top = 4515
Width = 615
End
Begin VB.TextBox txtRT2
Alignment = 1 'Right Justify
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5355
TabIndex = 47
Top = 4515
Width = 615
End
Begin VB.TextBox txtPayRate2
Alignment = 1 'Right Justify
BackColor = &H8000000F&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 4725
TabIndex = 46
Top = 4515
Width = 615
End
Begin VB.TextBox txtCMSCD2
Alignment = 2 'Center
BackColor = &H8000000F&
Height = 285
Left = 4110
TabIndex = 45
Top = 4515
Width = 570
End
Begin VB.TextBox txtCMSCD1
Alignment = 2 'Center
BackColor = &H8000000F&
Height = 285
Left = 4110
TabIndex = 44
Top = 4785
Width = 570
End
Begin VB.TextBox txtOTR
Height = 285
Left = 3690
TabIndex = 38
Top = 60
Visible = 0 'False
Width = 225
End
Begin VB.TextBox txtWCCODE
Height = 285
Left = 3300
TabIndex = 36
Top = 435
Visible = 0 'False
Width = 240
End
Begin VB.CommandButton cmdDelDaily
Caption = "Delete Daily 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 = 1410
TabIndex = 35
Top = 6180
Width = 1170
End
Begin VB.TextBox txtNotes
Height = 825
Left = 4050
MultiLine = -1 'True
TabIndex = 21
Top = 6165
Width = 4170
End
Begin VB.CheckBox chkDeduct
Caption = "Automatic Deductions"
Height = 255
Left = 6240
TabIndex = 33
TabStop = 0 'False
Top = 345
Visible = 0 'False
Width = 2025
End
Begin VB.CheckBox chkDone
Caption = "Sent to CMS"
Height = 210
Left = 6345
TabIndex = 32
TabStop = 0 'False
Top = 5625
Width = 1680
End
Begin VB.CheckBox chkReady
Caption = "Ready to Process"
Height = 255
Left = 6345
TabIndex = 31
TabStop = 0 'False
Top = 5385
Width = 1650
End
Begin VB.TextBox txtRate
Height = 225
Left = 3345
TabIndex = 30
Top = 180
Visible = 0 'False
Width = 195
End
Begin VB.CommandButton cmdMAS90
Caption = "Setup Hrly for CMS"
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 = 180
TabIndex = 29
Top = 6180
Width = 1170
End
Begin VB.ListBox lstCrew
Height = 2985
Left = 4005
Sorted = -1 'True
TabIndex = 4
TabStop = 0 'False
Top = 735
Visible = 0 'False
Width = 4200
End
Begin VB.ListBox lstHours
Height = 3180
Left = 3990
Sorted = -1 'True
TabIndex = 22
Top = 735
Width = 4215
End
Begin VB.TextBox txtHrsWorked
Alignment = 1 'Right Justify
Height = 285
Left = 5145
TabIndex = 19
Top = 5850
Width = 1110
End
Begin VB.CommandButton cmdAddDaily
Caption = "Add Daily Information"
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 = 1410
TabIndex = 18
Top = 5025
Width = 1170
End
Begin VB.CommandButton cmdSave
Caption = "Save Daily Information"
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 = 1410
TabIndex = 23
Top = 5610
Width = 1170
End
Begin MSComCtl2.DTPicker dtpWorkDate
Height = 300
Left = 4950
TabIndex = 15
Top = 5475
Width = 1290
_ExtentX = 2275
_ExtentY = 529
_Version = 393216
Format = 94830593
CurrentDate = 43396
End
Begin MSComCtl2.DTPicker dtpPayDate
Height = 345
Left = 1155
TabIndex = 10
Top = 90
Width = 1335
_ExtentX = 2355
_ExtentY = 609
_Version = 393216
Format = 94830593
CurrentDate = 43396
End
Begin VB.TextBox txtDept
Height = 225
Left = 2610
TabIndex = 9
TabStop = 0 'False
Top = 435
Visible = 0 'False
Width = 330
End
Begin VB.TextBox txtEmpName
Height = 225
Left = 2580
TabIndex = 8
TabStop = 0 'False
Top = -15
Visible = 0 'False
Width = 540
End
Begin VB.CommandButton cmdAddName
Caption = "Add by Emp Last Name"
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 = 180
TabIndex = 7
TabStop = 0 'False
Top = 5610
Width = 1170
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 = 2610
TabIndex = 3
Top = 5025
Width = 1170
End
Begin VB.TextBox txtEmpId
Height = 225
Left = 2580
TabIndex = 6
TabStop = 0 'False
Top = 195
Visible = 0 'False
Width = 585
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete Employee"
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 = 2610
TabIndex = 2
Top = 5610
Width = 1170
End
Begin VB.CommandButton cmdAdd
Caption = "&Add by Emp Number"
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 = 180
TabIndex = 1
Top = 5025
Width = 1170
End
Begin VB.Label txtTtlCD1
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
Height = 285
Left = 7365
TabIndex = 62
Top = 4785
Width = 870
End
Begin VB.Label txtTtlCD2
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
Height = 285
Left = 7365
TabIndex = 61
Top = 4515
Width = 870
End
Begin VB.Label lblComb
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Combined"
Height = 195
Left = 4560
TabIndex = 59
Top = 5145
Width = 705
End
Begin VB.Label lblSlsh2
AutoSize = -1 'True
Caption = "/"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 5985
TabIndex = 56
Top = 4485
Width = 90
End
Begin VB.Label lblSlach
AutoSize = -1 'True
Caption = "/"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 5985
TabIndex = 55
Top = 4740
Width = 90
End
Begin VB.Label lblVALIDCD
AutoSize = -1 'True
Caption = "Valid CMS Pay Codes: "
Height = 195
Left = 135
TabIndex = 52
Top = 6825
Width = 1635
End
Begin VB.Label lblCMSRTCD
AutoSize = -1 'True
Caption = "CMS Pay Code: "
Height = 195
Left = 6930
TabIndex = 51
Top = 5880
Width = 1170
End
Begin VB.Label lblCMS
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "CMS Cd"
Height = 195
Left = 4080
TabIndex = 50
Top = 4275
Width = 600
End
Begin VB.Label lblRTRate
Caption = "R Rate"
Height = 195
Left = 4740
TabIndex = 43
Top = 4275
Width = 585
End
Begin VB.Label lblRTHrs
Alignment = 1 'Right Justify
Caption = "R Hrs"
Height = 180
Left = 5370
TabIndex = 42
Top = 4275
Width = 555
End
Begin VB.Label lblOTHrs
Alignment = 1 'Right Justify
Caption = "OT Hrs"
Height = 195
Left = 6015
TabIndex = 41
Top = 4275
Width = 615
End
Begin VB.Label lblOTRate
AutoSize = -1 'True
Caption = "OT Rate"
Height = 195
Left = 6720
TabIndex = 40
Top = 4275
Width = 615
End
Begin VB.Label lblTTL
AutoSize = -1 'True
Caption = "WK Total"
Height = 195
Left = 7485
TabIndex = 39
Top = 4275
Width = 675
End
Begin VB.Label txtOTRate
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
Height = 285
Left = 6735
TabIndex = 37
Top = 4785
Width = 615
End
Begin VB.Label lblNotes
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Notes:"
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 = 3480
TabIndex = 34
Top = 6690
Width = 570
End
Begin VB.Label txtOT
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
Height = 285
Left = 6090
TabIndex = 28
Top = 4785
Width = 615
End
Begin VB.Label txtTtlWage
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
Height = 285
Left = 7365
TabIndex = 27
Top = 5070
Width = 870
End
Begin VB.Label txtRT
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
Height = 285
Left = 5370
TabIndex = 26
Top = 4785
Width = 615
End
Begin VB.Label txtPayRate
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
Height = 285
Left = 4725
TabIndex = 25
Top = 4785
Width = 615
End
Begin VB.Label lblTotal
AutoSize = -1 'True
Caption = "Pay Period Totals:"
Height = 195
Left = 2745
TabIndex = 24
Top = 4755
Width = 1290
End
Begin VB.Label lblHrsWrk
AutoSize = -1 'True
Caption = "Hours Worked:"
Height = 195
Left = 4005
TabIndex = 17
Top = 5865
Width = 1080
End
Begin VB.Label lblWorkDate
AutoSize = -1 'True
Caption = "Work Date:"
Height = 195
Left = 4065
TabIndex = 16
Top = 5520
Width = 825
End
Begin VB.Label lblDept
BorderStyle = 1 'Fixed Single
Height = 315
Left = 4035
TabIndex = 14
Top = 3945
Width = 585
End
Begin VB.Label lblEmpName
BorderStyle = 1 'Fixed Single
Height = 315
Left = 5565
TabIndex = 13
Top = 3960
Width = 2655
End
Begin VB.Label lblEmpId
BorderStyle = 1 'Fixed Single
Height = 315
Left = 4665
TabIndex = 12
Top = 3960
Width = 870
End
Begin VB.Label lblPayDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Payroll Date:"
Height = 195
Left = 195
TabIndex = 11
Top = 180
Width = 900
End
Begin VB.Label lblCrewInstruct
Caption = "Double Click or CTRL S on the desired Employee listed below to add the Employee to the Hourly 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 = 615
Left = 3960
TabIndex = 5
Top = 90
Visible = 0 'False
Width = 3435
End
Begin VB.Label lblCrew
AutoSize = -1 'True
Caption = "Hourly Employee 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 = 195
Left = 240
TabIndex = 0
Top = 540
Width = 1785
End
End
Attribute VB_Name = "frmHourList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mintBOOKMARK1 As Integer, mintBOOKMARK2 As Integer
Dim moRSCREW As Recordset
Dim moRSMember As Recordset
Dim moRSHour As Recordset, moRSDaily As Recordset
Dim mstrNUMCDS As String, msglGRS, msglTGS1, msglTGS2, msglTOHR As Single
Dim msglTRHR As Single, msglOHR2, msglRHR2, msglOHR1, msglRHR1 As Single
Dim mstrCCD2, mstrCCD1 As String, msgl1HR, msgl2HR, msglTHR As Single
Dim msglORT2, msglRRT2, msglORT1, msglRRT1 As Single
Dim mlngPCID2 As Long, mstrEMPID As String
Dim msglRTHRS As Single, msglOTHRS As Single
Dim mboolAdding As Boolean, mlngPCID As Long, mboolSHOW As Boolean
Dim mlngDAYID As Long, mdblSUMHRS As Double, mdblGROSS As Double
Private Sub FormClearHrs()
dtpWorkDate.Value = dtpPayDate.Value
' dtpWorkDate.Value = Date
txtHrsWorked = ""
txtNotes = ""
' chkDeduct = vbUnchecked
chkDone = vbUnchecked
chkReady = vbUnchecked
End Sub
Private Sub FormClearEmp()
lblDept = ""
lblEmpId = ""
lblEmpName = ""
txtTtlWage = ""
txtPayRate = ""
txtOTRate = ""
txtOT = ""
txtRT = ""
txtPayRate2 = ""
txtOTRate2 = ""
txtOT2 = ""
txtRT2 = ""
txtCombRTHrs = ""
txtCombOTHrs = ""
txtCMSCD1 = ""
txtCMSCD2 = ""
txtPC1 = ""
txtPC2 = ""
End Sub
Private Sub UpPayRate()
Dim strEMPID As String, strPAYDT As String
Dim oRS As Recordset, strSQL As String, oRSS As Recordset, strSQLL As String
lstPayCrews.col = 1
strEMPID = lstPayCrews.ColText
strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strEMPID & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
strPAYDT = dtpPayDate.Value
strSQLL = "SELECT EMP_ID, PAY_DATE, RATE, Reg_RT2, OT_Rate, OT_RT2 FROM tblHOURLIST WHERE EMP_ID = '" & strEMPID & "' AND PAY_DATE = #" & strPAYDT & "#"
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenDynamic, adLockOptimistic
If Not oRSS.EOF Then
oRSS!Rate = Field2Str2(oRS!Rate)
oRSS!Reg_RT2 = Field2Str2(oRS!RegRate2)
oRSS!OT_Rate = Field2Str2(oRS!OTRate)
oRSS!OT_RT2 = Field2Str2(oRS!OTRate2)
oRSS.Update
Exit Sub
End If
End If
End Sub
Private Sub GetMember()
Dim strCREW As String, strName As String
' If gboolMAS90 Then
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
strName = Format(Field2Str(lstCrew.ItemData(lstCrew.ListIndex)), "0000000")
strCREW = "SELECT * FROM PR1_EmployeeMaster where EmployeeNumber = '" & strName & "'"
' strCREW = "SELECT Department, employeenumber, firstname, lastname, Rate, Terminated FROM PR1_EmployeeMaster where EmployeeNumber = '" & strName & "'"
' strCREW = "SELECT Department, employeenumber, firstname, lastname, Terminated FROM PR1_EmployeeMaster where department = '52' and EmployeeNumber = '0004107'" '& strName & "'"
Set moRSMember = New Recordset
' moRSMember.Open strCREW, goConn2, adOpenKeyset, adLockOptimistic
moRSMember.Open strCREW, goConn, adOpenKeyset, adLockOptimistic
If moRSMember!Terminated <> "A" Then
MsgBox "This Employee is Terminated - Be Sure To Correct Before Entering Payroll", vbOKOnly, "Terminated Employee"
End If
If moRSMember.EOF Then
MsgBox "Critial Error - No Crew Member Found - Call Darv", vbCritical + vbOKOnly, "Critical Error"
Unload Me
End If
End Sub
Private Sub cmdAdd_Click()
Dim intID As Double, strSQL As String, strID As String
Dim oRS As Recordset
cmdAdd.Enabled = False
cmdAddName.Enabled = False
cmdDelete.Enabled = False
cmdMAS90.Enabled = False
cmdAddDaily.Enabled = False
cmdSave.Enabled = False
cmdDelDaily.Enabled = False
'Code to Add a Crew
mboolAdding = True
intID = Field2Double(InputBox("Enter The Employee Number To Add", "Employee Number", 9999))
If intID = 0 Then
cmdAdd.Enabled = True
cmdAddName.Enabled = True
cmdDelete.Enabled = True
cmdMAS90.Enabled = True
cmdAddDaily.Enabled = True
cmdSave.Enabled = True
cmdDelDaily.Enabled = True
cmdAdd.SetFocus
Exit Sub
End If
If Len(intID) > 0 Then
' If Not gboolMAS90 Then
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
strID = Format(intID, "0000000")
strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strID & "'"
' strSQL = "SELECT Department, EmployeeNumber, LastName, DefaultWCCode, FirstName, PayRate1, Terminated FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & strID & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
Call CrewLoad
Else
txtRate = Format(Field2Str2(oRS!Rate), "#,#.00")
' txtRate = "0"
If txtRate > 50 Then
MsgBox "This Employee Appears to be Salaried", vbOKOnly, "Salaried Employee"
cmdAdd.Enabled = True
cmdAddName.Enabled = True
cmdDelete.Enabled = True
cmdMAS90.Enabled = True
cmdAddDaily.Enabled = True
cmdSave.Enabled = True
cmdDelDaily.Enabled = True
cmdAdd.SetFocus
Exit Sub
End If
txtEmpId = Field2Str(oRS!EmployeeNumber)
txtDept = Field2Str(oRS!department)
txtEmpName = Trim$(Field2Str(oRS!FirstName)) & " " & Trim$(Field2Str(oRS!LastName))
txtWCCode = Field2Str(oRS!wc_code)
txtRate = Field2Str2(oRS!Rate)
txtOTR = Field2Str2(oRS!OTRate)
If oRS!Terminated <> "A" Then
MsgBox "This Employee is Terminated - Be Sure To Correct Before Entering Payroll", vbOKOnly, "Terminated Employee"
End If
txtWCCode = Field2Str(oRS!wc_code)
chkReady = vbUnchecked
chkDone = vbUnchecked
Call FormSaveEmp
cmdAdd.Enabled = True
cmdAddName.Enabled = True
cmdDelete.Enabled = True
cmdMAS90.Enabled = True
cmdAddDaily.Enabled = True
cmdSave.Enabled = False
cmdDelDaily.Enabled = True
cmdAdd.SetFocus
End If
End If
End Sub
Private Sub cmdAddDaily_Click()
cmdAdd.Enabled = False
cmdDelete.Enabled = False
cmdAddDaily.Enabled = False
cmdMAS90.Enabled = False
cmdDelDaily.Enabled = False
cmdAddName.Enabled = False
cmdSave.Enabled = True
lstHours.Enabled = False
lstPayCrews.Enabled = False
cmdMAS90.Enabled = False
mboolAdding = True
Call FormClearHrs
End Sub
Private Sub cmdAddName_Click()
Dim strName As String, strSQL As String, strLine As String
Dim strSql2 As String, strSQL3 As String
Dim oRS As Recordset
' If gboolMAS90 Then
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
cmdAdd.Enabled = False
cmdAddName.Enabled = False
cmdDelete.Enabled = False
cmdAddDaily.Enabled = False
cmdDelDaily.Enabled = False
cmdSave.Enabled = False
cmdMAS90.Enabled = False
'Code to Add a Crew
mboolAdding = True
strName = InputBox("Enter The Employee Last Name To Add", "Employee Last Name")
If Len(strName) > 0 Then
strName = "lastname LIKE '" & Trim$(UCase(strName)) & "*'"
strSQL = "SELECT * FROM PR1_EmployeeMaster"
' strSQL = "SELECT Department, EmployeeNumber, LastName, FirstName, PayRate1, Terminated FROM PR1_EmployeeMaster"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' oRS.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
oRS.Filter = strName
lstCrew.Clear
Do Until oRS.EOF
With lstCrew
strLine = Trim$(Field2Str(oRS!FirstName)) & " " & Trim$(Field2Str(oRS!LastName))
.AddItem strLine
.ItemData(.NewIndex) = oRS!EmployeeNumber
End With
oRS.MoveNext
Loop
lstHours.Visible = False
lstCrew.Visible = True
lblCrewInstruct.Visible = True
Else
cmdAdd.Enabled = True
cmdAddName.Enabled = True
cmdDelete.Enabled = True
End If
End Sub
Private Sub FieldsSaveEmp()
Dim strSQL As String, strSQLM As String
Dim oRS As Recordset, oRSM As Recordset, strName As String
On Error GoTo Error_EH
' strSQL = "SELECT * FROM tblHourList" ' WHERE Crew_Id = 1"
' Set oRS = New Recordset
' oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSQLM = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & txtEmpId & "'"
Set oRSM = New Recordset
oRSM.Open strSQLM, goConn, adOpenForwardOnly, adLockReadOnly
strSQL = "SELECT * FROM tblHourList" ' WHERE Crew_Id = 1"
Set moRSHour = New Recordset
moRSHour.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If mboolAdding Then
moRSHour.AddNew
End If
With moRSHour
!Pay_Date = Field2Str(dtpPayDate.Value)
!emp_dept = Field2Str(txtDept)
!Emp_ID = Field2Str(txtEmpId)
strName = Mid(Field2Str2(txtEmpName), 1, 30)
!EmpName = strName
' !EmpName = Field2Str(txtEmpName)
!Rate = Field2Str2(txtRate)
!wc_code = Field2Str(txtWCCode)
!OT_Rate = Field2Str2(txtOTR)
!OT_RT2 = oRSM!OTRate2
!Reg_RT2 = oRSM!RegRate2
!RATECD1 = oRSM!RATECD1
!RATECD2 = oRSM!RATECD2
!ready = chkReady
!done = chkDone
' If chkDeduct Then
' !autodeduct = "Y"
' End If
End With
moRSHour.Update
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 = "Form HourList - Module FieldsSaveEmp"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSaveHrs()
Dim strSQL As String, lngPCID As Long
Dim oRS As Recordset
Dim intTEST As Integer
On Error GoTo Error_EH
lstPayCrews.col = 0
lngPCID = Field2Str2(lstPayCrews.ColText)
intTEST = moRSDaily.State
If mboolAdding Then
moRSDaily.AddNew
End If
With moRSDaily
!Date = Field2Str(dtpWorkDate.Value)
!emp_no = Field2Str(lblEmpId)
!hours = Field2Str2(txtHrsWorked)
!notes = Field2Str(txtNotes)
!pc_id = lngPCID
!PAYCD = txtPayCD
' !pc_id = lstPayCrews.ItemData(lstPayCrews.ListIndex)
End With
moRSDaily.Update
moRSHour!ready = chkReady
moRSHour!done = chkDone
moRSHour.Update
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 = "Form HourList - Module FieldsSaveHrs"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSaveEmp()
Dim strName As String
On Error GoTo Error_EH
' Store the controls to the recordset
Call FieldsSaveEmp
If mboolAdding Then
mboolAdding = False
End If
Call PayLoad
txtEmpId = ""
txtDept = ""
txtEmpName = ""
txtRate = 0
txtWCCode = ""
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module FormSaveEmp"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSaveHrs()
Dim strName As String
On Error GoTo Error_EH
' Store the controls to the recordset
Call FieldsSaveHrs
Call GetEmpHours
Call SumHours
' moRSHour!hours = mdblSUMHRS
' moRSHour!GROSS = mdblGROSS
' If Field2Str2(moRSHour!hours) > 40 Then
' txtRT = "40.00"
' txtOT = Format((Field2Str2(moRSHour!hours) - 40), "#.00")
' Else
' txtRT = Format(Field2Str2(moRSHour!hours), "#.00")
' txtOT = ".00"
' End If
' moRSHour!Reg_HRS = Field2Str2(txtRT)
' moRSHour!OT_HRS = Field2Str2(txtOT)
' moRSHour.Update
If mboolAdding Then
mboolAdding = False
End If
Call PayLoad
' txtEmpId = ""
' txtDept = ""
' txtEmpName = ""
' txtRate = 0
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module FormSaveHrs"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub PayLoad()
Dim oRS As Recordset
Dim strSQL As String, strCREW As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblHourList WHERE Pay_Date = #" & dtpPayDate.Value & "# ORDER BY emp_id"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPayCrews.Clear
Do Until oRS.EOF
With lstPayCrews
strLine = Field2Str(oRS!pc_id) & vbTab & Field2Str(oRS!Emp_ID) & vbTab & Field2Str(oRS!EmpName)
strLine = strLine & vbTab & Field2Str(oRS!RATECD1) & vbTab & Field2Str(oRS!RATECD2) & vbTab
strLine = strLine & Field2Str(oRS!Rate) & vbTab & Field2Str(oRS!Reg_RT2) & vbTab & Field2Str(oRS!OT_Rate) & vbTab
strLine = strLine & Field2Str(oRS!OT_RT2) & vbTab & Field2Str(oRS!gross)
.AddItem strLine
' .ItemData(.NewIndex) = oRS!pc_id
End With
oRS.MoveNext
Loop
oRS.Close
If lstPayCrews.ListCount Then
lstPayCrews.ListIndex = 0
Else
lstPayCrews.ListIndex = -1
lstHours.Clear
Call FormClearHrs
Call FormClearEmp
cmdDelete.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module PayLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub HoursLoad()
Dim oRS As Recordset
Dim strSQL As String, strCREW As String
Dim strLine As String
On Error GoTo Error_EH
' strSQL = "SELECT * from tblHrDaily WHERE PC_ID = " & lstPayCrews.ItemData(lstPayCrews.ListIndex) & " ORDER BY DATE"
strSQL = "SELECT * from tblHrDaily WHERE PC_ID = " & mlngPCID & " ORDER BY DATE"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstHours.Clear
Do Until oRS.EOF
With lstHours
strLine = Field2Str(oRS!Date) & vbTab & Format(Field2Str(oRS!hours), "#.00") & vbTab & oRS!PAYCD
.AddItem strLine
.ItemData(.NewIndex) = oRS!DAY_ID
End With
oRS.MoveNext
Loop
oRS.Close
If lstHours.ListCount Then
lstHours.ListIndex = 0
Else
strSQL = "SELECT * FROM tblHRDaily"
Set moRSDaily = New Recordset
moRSDaily.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lstHours.ListIndex = -1
cmdDelete.Enabled = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module HoursLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdDelete_Click()
Dim strSQL As String, strYN As String
strYN = MsgBox("Are You Sure You Want To Delete This Crew Member?", vbCritical + vbYesNo, "Delete?")
If strYN <> vbYes Then
Exit Sub
End If
strSQL = "DELETE * FROM tblHRDaily where PC_ID = " & mlngPCID
goConn.Execute strSQL
strSQL = "DELETE * FROM tblhourlist where PC_id = " & mlngPCID '& "' and Pay_Date = #" & dtpPayDate & "#"
goConn.Execute strSQL
Call PayLoad
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
If (txtPayCD = "" Or IsNull(txtPayCD)) Then
If txtHrsWorked = "" Or txtHrsWorked = "0" Or IsNull(txtHrsWorked) Then
Else
MsgBox "CMS Pay Code Is Required", vbOKOnly, "Need Pay Code"
txtPayCD.SetFocus
Exit Sub
End If
End If
mintBOOKMARK1 = lstPayCrews.ListIndex
mintBOOKMARK2 = lstHours.ListIndex
cmdAdd.Enabled = True
cmdAddDaily.Enabled = True
cmdDelete.Enabled = True
lstPayCrews.Enabled = True
cmdMAS90.Enabled = True
lstHours.Enabled = True
cmdSave.Enabled = False
Call FormSaveHrs
lstPayCrews.ListIndex = mintBOOKMARK1
lstHours.ListIndex = mintBOOKMARK2
End Sub
Private Sub cmdDelDaily_Click()
Dim strSQL As String
strSQL = "DELETE * FROM tblHRDAILY WHERE DAY_ID = " & mlngDAYID
goConn.Execute strSQL
Call HoursLoad
Call GetEmpHours
Call SumHours
moRSHour!hours = mdblSUMHRS
moRSHour!gross = mdblGROSS
If Field2Str2(moRSHour!hours) > 40 Then
txtRT = "40.00"
txtOT = Format((Field2Str2(moRSHour!hours) - 40), "#.00")
Else
txtRT = Format(Field2Str2(moRSHour!hours), "#.00")
txtOT = ".00"
End If
moRSHour!reg_hrs = Field2Str2(txtRT)
moRSHour!OT_Hrs = Field2Str2(txtOT)
moRSHour.Update
cmdDelDaily.Enabled = False
cmdAddDaily.Enabled = True
cmdSave.Enabled = False
End Sub
Private Sub dtpPayDate_Change()
Call PayLoad
End Sub
Private Sub dtpPayDate_Click()
Call PayLoad
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
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 = vbKeyS Then ' Display key combinations.
If CtrlDown Then
Call lstCrew_DblClick
' Call CrewLoad
' Call cmdTotal_Click
' Call lstLots_DblClick
End If
Exit Sub
End If
If KeyCode = vbKeyU Then ' Update Pay Rates
If CtrlDown Then
Call UpPayRate
End If
Exit Sub
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
dtpPayDate = Date
dtpWorkDate = Date
' frmHourList.Width = 4140
' frmHourList.Width = 4725
' Call GetCrew
Call PayLoad
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindEmp()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblHourList WHERE PC_ID = " & mlngPCID
Set moRSHour = New Recordset
moRSHour.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSHour.EOF Then
FormFindEmp = False
Else
FormFindEmp = True
'**** Load Module storage
With moRSHour
mlngPCID2 = Field2Str2(!pc_id)
mstrEMPID = Field2Str(!Emp_ID)
msglRRT1 = Field2Str2(!Rate)
msglORT1 = Field2Str2(!OT_Rate)
msglRRT2 = Field2Str2(!Reg_RT2)
msglORT2 = Field2Str2(!OT_RT2)
msglTHR = Field2Str2(!hours)
mstrCCD1 = Field2Str2(!RATECD1)
mstrCCD2 = Field2Str2(!RATECD2)
msglRHR1 = Field2Str2(!reg_hrs)
msglOHR1 = Field2Str2(!OT_Hrs)
msglRHR2 = Field2Str2(!Reg_HRS2)
msglOHR2 = Field2Str2(!OT_Hrs2)
msglTRHR = Field2Str2(!RTHours)
msglTRHR = Field2Str2(!OTHours)
msglTGS1 = Field2Str2(!GROSS_CD1)
msglTGS2 = Field2Str2(!GROSS_CD2)
msglGRS = Field2Str2(!gross)
mstrNUMCDS = Field2Str(!CODES)
End With
End If
Exit Function
Error_EH:
gstrMODULE = "Form HourList - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindHrs()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblHrDaily WHERE DAY_ID = " & mlngDAYID
Set moRSDaily = New Recordset
moRSDaily.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSDaily.EOF Then
FormFindHrs = False
Else
FormFindHrs = True
' mlngDAYID = moRSDaily!DAY_ID
End If
Exit Function
Error_EH:
gstrMODULE = "Form HourList - Module FormFindHrs"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub ClearEmp()
lblDept = ""
lblEmpId = ""
lblEmpName = ""
txtPayRate = 0
txtPayRate2 = 0
txtOTRate = 0
txtOTRate2 = 0
txtTtlWage = 0
txtPC1 = ""
txtPC2 = ""
txtCMSCD1 = ""
txtCMSCD2 = ""
txtRT = ".00"
txtOT = ".00"
txtRT2 = ".00"
txtOT2 = ".00"
txtCombRTHrs = 0
txtCombOTHrs = 0
txtTtlCD1 = ""
txtTtlCD2 = ""
chkReady = vbUnchecked
chkDone = vbUnchecked
End Sub
Private Sub FormShowEmp()
On Error GoTo Error_EH
mboolSHOW = True
With moRSHour
lblDept = Field2Str(!emp_dept)
lblEmpId = Field2Str(!Emp_ID)
lblEmpName = Field2Str(!EmpName)
txtPayRate = Format(Field2Str(!Rate), "#.00")
txtPayRate2 = Format(Field2Str(!Reg_RT2), "#.00")
txtOTRate = Format(Field2Str(!OT_Rate), "#.00")
txtOTRate2 = Format(Field2Str(!OT_RT2), "#.00")
' If Field2Str2(!hours) > 40 Then
' txtRT = "40.00"
' txtOT = Format((Field2Str2(!hours) - 40), "#.00")
' Else
' txtRT = Format(Field2Str2(!hours), "#.00")
' txtOT = ".00"
' End If
txtTtlWage = Format(Field2Str2(!gross), "#,#.00")
txtPC1 = Field2Str(!RATECD1)
If txtPC1 = "0" Then
txtPC1 = ""
End If
txtCMSCD1 = Field2Str(!RATECD1)
txtPC2 = Field2Str(!RATECD2)
If txtPC2 = "0" Then
txtPC2 = ""
End If
txtRT = Format(Field2Str2(!reg_hrs), "#,#.00")
txtOT = Format(Field2Str2(!OT_Hrs), "#,#.00")
If txtPC2 = "" Then
txtCMSCD2 = "NONE"
txtRT2 = ".00"
txtOT2 = ".00"
Else
txtCMSCD2 = Field2Str(!RATECD2)
txtRT2 = Format(Field2Str2(!Reg_HRS2), "#,#.00")
txtOT2 = Format(Field2Str2(!OT_Hrs2), "#,#.00")
End If
' If Len(txtPC1) >= 1 Then
' !Codes = 1
' .Update
If Len(txtPC1) >= 1 And Len(txtPC2) >= 1 Then
!CODES = 2
.Update
ElseIf Len(txtPC1) >= 1 Then
!CODES = 1
.Update
End If
txtCombRTHrs = Format(Field2Str2(!RTHours), "#,#.00")
txtCombOTHrs = Format(Field2Str2(!OTHours), "#,#.00")
txtTtlCD1 = Format(Field2Str2(!GROSS_CD1), "#,#.00")
txtTtlCD2 = Format(Field2Str2(!GROSS_CD2), "#,#.00")
chkReady = Field2CheckBox(!ready)
chkDone = Field2CheckBox(!done)
' If !autodeduct = "Y" Then
' chkDeduct = vbChecked
' Else
' chkDeduct = vbUnchecked
' End If
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module FormShowEmp"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowHrs()
Dim strRate_CD As String
On Error GoTo Error_EH
mboolSHOW = True
With moRSDaily
strRate_CD = Field2Str(!PAYCD)
If strRate_CD = 1 Then
txtHrsWorked = Format(Field2Str(!hours), "#.00")
txtPayCD = strRate_CD
ElseIf strRate_CD > 2 Then
txtHrsWorked = Format(Field2Str(!hours), "#.00")
txtPayCD = strRate_CD
End If
' txtHrsWorked = Format(Field2Str(!hours), "#.00")
dtpWorkDate.Value = Field2Str(!Date)
txtNotes = Field2Str(!notes)
End With
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module FormShowHrs"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoad()
Dim strSQL As String, strLine As String
On Error GoTo Error_EH
' If gboolMAS90 Then
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
lblCrewInstruct.Visible = True
strSQL = "SELECT * FROM PR1_EmployeeMaster"
' strSQL = "SELECT Department, EmployeeNumber, LastName, FirstName FROM PR1_EmployeeMaster"
'' strSQL = "SELECT Department, EmployeeNumber, LastName, FirstName FROM PR1_EmployeeMaster Order BY LastName"
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' moRSCREW.Open strSQL, goConn2, adOpenKeyset, adLockOptimistic
'adOpenForwardOnly , adLockReadOnly
lstCrew.Clear
Do Until moRSCREW.EOF
With lstCrew
strLine = Trim$(Field2Str(moRSCREW!FirstName)) & " " & Trim$(Field2Str(moRSCREW!LastName))
.AddItem strLine
.ItemData(.NewIndex) = moRSCREW!EmployeeNumber
End With
moRSCREW.MoveNext
Loop
' moRSCrew.Close
frmHourList.Width = 9150
frmHourList.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstCrew_DblClick()
Call GetMember '******Need to modify PR1_EmployeeMaster to include Type of pay (Hourly or Salary)
txtEmpId = Field2Str(moRSMember!EmployeeNumber)
txtDept = Field2Str(moRSMember!department)
txtEmpName = Trim$(Field2Str(moRSMember!FirstName)) & " " & Trim$(Field2Str(moRSMember!LastName))
txtRate = Format(Field2Str2(moRSMember!Rate), "#,#.00")
txtWCCode = Field2Str(moRSMember!wc_code)
txtOTR = Format(Field2Str2(moRSMember!OTRate), "#.00")
If txtRate > 50 Then
MsgBox "This Employee Appears to be Salaried", vbOKOnly, "Salaried Employee"
cmdAdd.Enabled = True
cmdAddName.Enabled = True
cmdDelete.Enabled = True
cmdAddDaily.Enabled = True
cmdSave.Enabled = False
cmdMAS90.Enabled = True
lstCrew.Visible = False
lstHours.Visible = True
lblCrewInstruct.Visible = False
Exit Sub
End If
' frmHourList.Width = 4140
' frmHourList.Width = 4725
cmdAdd.Enabled = True
cmdAddName.Enabled = True
cmdDelete.Enabled = True
cmdAddDaily.Enabled = True
cmdSave.Enabled = False
cmdMAS90.Enabled = True
lstCrew.Visible = False
lstHours.Visible = True
lblCrewInstruct.Visible = False
Call FormSaveEmp
End Sub
Private Sub lstHours_Click()
If lstHours.ListIndex > -1 Then
mlngDAYID = lstHours.ItemData(lstHours.ListIndex)
Else
mlngDAYID = 0
End If
If FormFindHrs() Then
Call FormShowHrs
' Call HoursLoad
End If
End Sub
Private Sub lstHours_DblClick()
cmdSave.Enabled = True
cmdDelDaily.Enabled = True
cmdAddDaily.Enabled = False
End Sub
Private Sub lstPayCrews_Click()
lstPayCrews.col = 0
If lstPayCrews.ListIndex > -1 Then
mlngPCID = Field2Str2(lstPayCrews.ColText)
Else
mlngPCID = 0
End If
If FormFindEmp() Then
Call FormShowEmp
Call HoursLoad
End If
End Sub
Private Sub lstPayCrews_DblClick()
cmdSave.Enabled = True
cmdDelete.Enabled = True
End Sub
Private Sub txtHrsWorked_GotFocus()
Call FieldSelect(txtHrsWorked)
End Sub
Private Sub txtNotes_GotFocus()
Call FieldSelect(txtNotes)
End Sub
Private Sub txtNotes_LostFocus()
txtNotes = UCase(txtNotes)
End Sub
Private Sub GetEmpHours()
Dim a
End Sub
Private Sub SumHours()
Dim oRSH As Recordset, strSQLH As String ', oRSHL As Recordset, strSQLHL As String
Dim oRS As Recordset, oRSS As Recordset, dblRT As Double, dblOTRATE As Double
Dim strSQL As String, dblOT As Double, dblRTHours As Double
Dim dblRT2 As Double, dblOT2 As Double, dblOTRATE2 As Double, dblREGRATE2 As Double
Dim dblHOURS1 As Double, dblHOURS2 As Double, dblOTHours As Double
On Error GoTo Error_EH
strSQL = "SELECT SUM(Hours) as SUMHRS FROM tblHRDaily WHERE PC_ID = " & mlngPCID
' strSQL = "SELECT SUMHRS as SUM(Hours) FROM tblHRDaily where PC_ID = " & mlngPCID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
mdblSUMHRS = Field2Str2(oRS!SUMHRS)
Else
mdblSUMHRS = 0
End If
strSQL = "SELECT SUM(Hours) as SUMHRS1 FROM tblHRDaily WHERE PAYCD = 1 and PC_ID = " & mlngPCID
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSS.EOF Then
dblHOURS1 = Field2Str2(oRSS!SUMHRS1)
Else
dblHOURS1 = 0
End If
strSQL = "SELECT SUM(Hours) as SUMHRS2 FROM tblHRDaily WHERE PAYCD > 1 and PC_ID = " & mlngPCID
Set oRSH = New Recordset
oRSH.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSH.EOF Then
dblHOURS2 = Field2Str2(oRSH!sumhrs2)
Else
dblHOURS2 = 0
End If
If mstrNUMCDS = 1 Then
If mdblSUMHRS <= 40 Then
moRSHour!OTHours = 0
moRSHour!OT_Hrs = 0
moRSHour!OT_Hrs2 = 0
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = Field2Str2(oRS!SUMHRS)
moRSHour!reg_hrs = Field2Str2(oRSS!SUMHRS1)
moRSHour!Reg_HRS2 = 0
' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2)
moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate)
moRSHour!GROSS_CD2 = 0
' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2))
' moRSHour!gross = Field2Single(moRSHour!GROSS_CD1) + Field2Single(moRSHour!GROSS_CD2)
' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2)
moRSHour.Update
' Exit Sub
ElseIf mdblSUMHRS > 40 Then
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = 40
moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40
dblOTHours = Field2Str2(oRS!SUMHRS) - 40
moRSHour!reg_hrs = 40
moRSHour!OT_Hrs = dblOTHours
moRSHour!Reg_HRS2 = 0
moRSHour!OT_Hrs2 = 0
moRSHour!GROSS_CD1 = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1)
' moRSHour!Gross_CD1 = (dblHOURS1 * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!Rate))
moRSHour!GROSS_CD2 = 0
moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1)
moRSHour.Update
''' If dblHOURS2 > dblOTHours Then
''' moRSHour!Reg_HRS2 = dblHOURS2
''' moRSHour!OT_HRS = dblOTHours
''' moRSHour!Reg_HRS = dblHOURS1 - dblOTHours
End If
ElseIf mstrNUMCDS = 2 Then
If dblHOURS1 > 0 And dblHOURS2 = 0 Then
If mdblSUMHRS <= 40 Then
moRSHour!OTHours = 0
moRSHour!OT_Hrs = 0
moRSHour!OT_Hrs2 = 0
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = Field2Str2(oRS!SUMHRS)
moRSHour!reg_hrs = CSng(Field2Str2(oRSS!SUMHRS1))
moRSHour!Reg_HRS2 = 0
' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2)
moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate)
moRSHour!GROSS_CD2 = 0
' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2))
' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2)
moRSHour.Update
' Exit Sub
ElseIf mdblSUMHRS > 40 Then
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = 40
moRSHour!reg_hrs = 40
txtRT = 40
moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40
dblOTHours = Field2Str2(oRS!SUMHRS) - 40
moRSHour!OT_Hrs = dblOTHours
moRSHour!Reg_HRS2 = 0
moRSHour!OT_Hrs2 = 0
moRSHour!GROSS_CD1 = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1)
' moRSHour!Gross_CD1 = (dblHOURS1 * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!Rate))
moRSHour!GROSS_CD2 = 0
moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT1)) + (dblOTHours * msglORT1)
moRSHour.Update
End If
ElseIf dblHOURS1 = 0 And dblHOURS2 > 0 Then
If mdblSUMHRS <= 40 Then
moRSHour!OTHours = 0
moRSHour!OT_Hrs = 0
moRSHour!OT_Hrs2 = 0
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = Field2Str2(oRS!SUMHRS)
moRSHour!Reg_HRS2 = Field2Str2(oRSH!sumhrs2)
' moRSHour!Reg_HRS2 = Field2Str2(oRSS!SUMHRS1)
moRSHour!reg_hrs = 0
' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2)
moRSHour!GROSS_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
moRSHour!GROSS_CD1 = 0
' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2))
' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2)
moRSHour.Update
' Exit Sub
ElseIf mdblSUMHRS > 40 Then
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = 40
moRSHour!Reg_HRS2 = 40
txtRT2 = 40
moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40
dblOTHours = Field2Str2(oRS!SUMHRS) - 40
moRSHour!OT_Hrs2 = dblOTHours
moRSHour!reg_hrs = 0
moRSHour!OT_Hrs = 0
moRSHour!GROSS_CD2 = Field2Str2((moRSHour!RTHours * msglRRT2)) + (dblOTHours * msglORT2)
' moRSHour!Gross_CD1 = (dblHOURS1 * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!Rate))
moRSHour!GROSS_CD1 = 0
moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT2)) + (dblOTHours * msglORT2)
moRSHour.Update
End If
' End If
ElseIf dblHOURS1 > 0 And dblHOURS2 > 0 Then
If mdblSUMHRS <= 40 Then
moRSHour!OTHours = 0
moRSHour!OT_Hrs = 0
moRSHour!OT_Hrs2 = 0
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = dblHOURS1 + dblHOURS2
moRSHour!Reg_HRS2 = Field2Str2(oRSH!sumhrs2)
' moRSHour!Reg_HRS2 = Field2Str2(oRSS!SUMHRS1)
moRSHour!reg_hrs = Field2Str2(oRSS!SUMHRS1)
' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2)
moRSHour!GROSS_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate)
' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2))
' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2)
moRSHour.Update
' Exit Sub
ElseIf mdblSUMHRS > 40 Then
moRSHour!hours = Field2Str2(oRS!SUMHRS)
moRSHour!RTHours = 40
moRSHour!OTHours = mdblSUMHRS - 40 ' - dblHOURS2
dblOTHours = Field2Str2(oRS!SUMHRS) - 40
moRSHour!reg_hrs = dblHOURS1 - (dblOTHours)
' moRSHour!Reg_HRS2 = dblHOURS2 - (mdblSUMHRS - 40)
' moRSHour!Reg_HRS2 = 40
' txtRT2 = 40
' moRSHour!OTHours = Field2Str2(oRS!SUMHRS) - 40
moRSHour!OT_Hrs = dblOTHours
moRSHour!Reg_HRS2 = dblHOURS2
moRSHour!OT_Hrs2 = 0
moRSHour!GROSS_CD2 = ((dblHOURS2 * msglRRT2)) + (Field2Str2(moRSHour!OT_Hrs2) * msglORT2)
moRSHour!GROSS_CD1 = ((dblHOURS1 - dblOTHours) * Field2Str2(moRSHour!Rate)) + (dblOTHours * Field2Str2(moRSHour!OT_Rate))
' moRSHour!Gross_CD1 = 0
' moRSHour!gross = Field2Str2((moRSHour!RTHours * msglRRT2)) + (dblOTHours * msglORT2)
moRSHour!gross = CSng(Field2Str2(moRSHour!GROSS_CD1)) + CSng(Field2Str2(moRSHour!GROSS_CD2))
moRSHour.Update
End If
End If
End If
''' moRSHour!Gross_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate)
''' moRSHour!Gross_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
''' moRSHour!GROSS = Field2Single(moRSHour!Gross_CD1) + Field2Single(moRSHour!Gross_CD2)
''' moRSHour.Update
' Exit Sub
' moRSHour!Reg_HRS = ""
' dblRTHours
'' If dblHOURS1 > dblOTHours Then
'' moRSHour!OT_HRS = dblOTHours
'' moRSHour!Reg_HRS = dblHOURS1 - dblOTHours
' moRSHour!Reg_HRS2 = dblHOURS1 - dblOTHours
'' End If
' moRSHour!OT_HRS = 0
' moRSHour!OT_HRS2 = 0
' moRSHour!hours = Field2Str2(oRS!SUMHRS)
' moRSHour!RTHours = Field2Str2(oRS!SUMHRS)
'' moRSHour!Reg_HRS = Field2Str2(oRSS!SUMHRS1)
' moRSHour!Reg_HRS2 = Field2Str2(oRSH!SUMHRS2)
'' moRSHour!GROSS_CD1 = dblHOURS1 * Field2Str2(moRSHour!Rate)
'' moRSHour!GROSS_CD2 = dblHOURS2 * Field2Str2(moRSHour!Reg_RT2)
'' moRSHour!GROSS = Field2Single(moRSHour!GROSS_CD1) + Field2Single(moRSHour!GROSS_CD2)
' morshours!GROSS = Field2Str2(oRSHL!GROSS_CD1) + Field2Str2(oRSHL!GROSS_CD2)
'' moRSHour.Update
' Else
''' dblRT = 40 * txtPayRate
''' dblOTRATE = (1.5 * txtPayRate)
''' dblOT = (mdblSUMHRS - 40) * dblOTRATE
''' mdblGROSS = Format((dblRT + dblOT), "#,#.00")
' End If
' 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 = "Form HourList - Module SumHours"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdMAS90XX_Click()
Dim strSQL As String, strSql2 As String, strSELECT As String
Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset
Dim dblOT As Double, dblOTRATE As Double, dblOTWAGE As Double
Dim dblRT As Double, dblRTRATE As Double, dblRTWAGE As Double
Screen.MousePointer = vbHourglass
On Error GoTo Error_EH
strSql2 = "DELETE * FROM tblPayroll"
goConn.Execute strSql2
strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and ready"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblPayroll"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
' strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id)
' Set oRT = New Recordset
' oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
' Do Until oRT.EOF
With oRS
' If !hours > 80 Then
' dblRT = 80
' dblOT = !hours - 80
If !hours > 40 Then
dblRT = 40
dblOT = !hours - 40
dblRTRATE = !Rate
dblOTRATE = !Rate * 1.5
dblRTWAGE = Format(Round((dblRT * dblRTRATE), 2), "#,#.00")
dblOTWAGE = Format(Round((dblOT * dblOTRATE), 2), "#,#.00")
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = dblRT
oRSS!amount = dblRTWAGE
oRSS!Rate = Field2Str(!Rate)
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS!earncode = "01"
oRSS!wc_code = !wc_code
oRSS.Update
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = dblOT
oRSS!amount = dblOTWAGE
oRSS!Rate = dblOTRATE
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS!earncode = "OT"
oRSS.Update
Else
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = Field2Str(!hours)
oRSS!amount = Field2Str(!gross)
oRSS!Rate = Field2Str(!Rate)
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS!earncode = "01"
oRSS!wc_code = !wc_code
oRSS.Update
End If
End With
' oRT.MoveNext
' Loop
oRS!ready = vbUnchecked
oRS!done = vbChecked
oRS.Update
oRS.MoveNext
Loop
Screen.MousePointer = vbDefault
MsgBox "Payroll Is Ready To Be Imported Into MAS90"
cmdExit.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module cmdPRProcess_Click"
Call ErrorHandler2
gstrMODULE = ""
Screen.MousePointer = vbDefault
Exit Sub
End Sub
Private Sub cmdPRProcess2_Click()
Dim strSQL As String, strSql2 As String, strSELECT As String
Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset
Screen.MousePointer = vbHourglass
On Error GoTo Error_EH
strSql2 = "DELETE * FROM tblPayroll"
goConn.Execute strSql2
strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and p_flag"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblPayroll"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id)
Set oRT = New Recordset
oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
Do Until oRT.EOF
With oRT
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = Field2Str(!hours)
oRSS!amount = Field2Str2(!gross)
' oRSS!amount = Field2Str2(!Reg_Wage)
oRSS!Rate = Field2Str2(!Rate)
oRSS!wc_code = Field2Str(!wc_code)
oRSS!earncode = "1"
' oRSS!earncode = "11"
oRSS!OT_Hours = Field2Str2(!OT_Hours)
oRSS!OT_Amt = Field2Str2(!OT_Wage)
oRSS!OT_TRANS = Field2Str2(!OT_Wage) / 1.5
oRSS!REG_TRANS = Field2Str2(!REG_WAGE)
' oRSS!earncode = "01"
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS.Update
End With
oRT.MoveNext
Loop
oRS!P_FLAG = vbUnchecked
oRS.Update
oRS.MoveNext
Loop
Screen.MousePointer = vbDefault
MsgBox "Payroll Is Ready To Be Imported Into CMS - Click On 'Move PR To CMS' to Setup Transfer File"
'' cmdMoveMAS90.SetFocus
' cmdExit.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPRProcess2_Click"
Call ErrorHandler2
gstrMODULE = ""
Screen.MousePointer = vbDefault
Exit Sub
End Sub
Private Sub CMSPRTransfer()
Dim strFile As String, strLINE1 As String, strLINE2 As String
Dim strHeadID, strCUSTNo, strSHIPADD, strCHG, strTType, strINVNO As String
Dim strREGWAGE, strOTWAGE, strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strREGHOUR, strOTHOUR ', strTaxCode, strINVDATE, strShipDate, strUDF1, strUDF2 As String
Dim strDetID, strSTOCK, strDESC, strTXABLE, strOQty, strSQty, strPRICE, strLType As String
Dim FSys As FileSystemObject, oRSSS As Recordset, strSQLLL As String, strEXT As String
Dim dblCHANGE As Double, lngDIF As Long, strMSG As String, strINV_DUE_Date As String, strDISC_Date As String
Dim lngCount As Long, lngSALES As Long, lngPO As Long, strHR As String
Dim strMONTH As String, strDAY As String, strSEC As String, strWCCODE As String
Dim strSTORE As String, strRate2 As String, strRate3 As String ', strRate3 As String
Dim strHEADER As String, strDETAIL As String, strLastInvNo As String
Dim TStream As TextStream, strMIN As String, strDISC_PCT As String, strDISCYN As String
strDAY = Format(Day(Date), "00")
strMONTH = Format(Month(Date), "00")
' strMIN = Format(Minute(Date), "00")
strMIN = Format(Minute(Now), "00")
strHR = Format(Hour(Now), "00")
strFile = "PREXT" & strMONTH & strDAY & strHR & strMIN
strSQLLL = "SELECT * FROM tblPAYROLL ORDER BY EMPLOYEE_NO"
Set oRSSS = New Recordset
oRSSS.Open strSQLLL, goConn, adOpenDynamic, adLockOptimistic
strEXT = "G:\CMSTrans\" & strFile & ".csv" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
' strEXT = "G:\CMSTrans\" & strFile & ".VWP018" ' & gstrCOMPANY '& "Count\" & Trim$(strMONTH) & Trim$(strDAY) & Trim$(gstrCOMPANY) & Trim$(strSEC) & ".TXT" 'invXport.txt" 'Field2Str(oRSSS!companycode)"
Set FSys = New FileSystemObject
Set TStream = FSys.CreateTextFile(strEXT, True)
Do Until oRSSS.EOF
strCUSTNo = oRSSS!employee_no
strINVDATE = dtpPayDate.Value
' strTType = "1"
' strTType = "11"
strTType = oRSSS!earncode
strWCCODE = oRSSS!wc_code
strREGWAGE = oRSSS!REG_TRANS
' strREGWAGE = oRSSS!amount
strOTWAGE = oRSSS!OT_TRANS
' strOTWAGE = oRSSS!OT_Amt
strREGHOUR = oRSSS!HOURS_WAGES
' strOTHOUR = "2"
strOTHOUR = oRSSS!OT_Hours
strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & strREGWAGE & "," & strOTWAGE & "," & "," & "," & "," & ","
strHEADER = strHEADER & "," & "," ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
' strHEADER = strCUSTNo & vbTab & strINVDATE & vbTab & strTType & vbTab & strWCCODE & vbTab & strREGWAGE & vbTab & strOTWAGE & vbTab & vbTab & vbTab & vbTab & vbTab
' strHEADER = strHEADER & vbTab & vbTab ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
TStream.WriteLine (strHEADER)
' strTType = "9"
' strHEADER = strCUSTNo & "," & strINVDATE & "," & strTType & "," & strWCCODE & "," & "," & "," & "," & "," & "," & strREGHOUR & ","
' strHEADER = strHEADER & "," & "," & strOTHOUR ' & strINVDATE & vbTab & strINV_DUE_Date & vbTab & strDISC_Date & vbTab & vbTab & strINV_DUE_Date & vbTab & strDISCYN & vbTab
' TStream.WriteLine (strHEADER)
oRSSS.MoveNext
Loop
strMSG = "Export Complete - Go To CMS Payroll and IMPORT DAILY using an External File" ', vbInformation + vbOKOnly, "Export Complete")
strMSG = strMSG & vbCrLf & vbCrLf & "File Name: " & strEXT
MsgBox strMSG, vbInformation + vbOKOnly, "Export Complete"
Close #1
cmdExit.SetFocus
End Sub
Private Sub txtPayCD_GotFocus()
Call FieldSelect(txtPayCD)
End Sub
'Private Sub cmdPRProcess_Click()
Private Sub cmdMAS90_Click()
Dim strSQL As String, strSql2 As String, strSELECT As String
Dim oRS As Recordset, oRSS As Recordset, oRT As Recordset
Dim strCODE As String, intYN As Integer
Screen.MousePointer = vbHourglass
On Error GoTo Error_EH
strSql2 = "DELETE * FROM tblPayroll"
goConn.Execute strSql2
strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and READY"
' strSQL = "SELECT * FROM tblHourList where Pay_Date = #" & dtpPayDate.Value & "# and p_flag"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
strSql2 = "SELECT * FROM tblPayroll"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
Do Until oRS.EOF
' strSELECT = "SELECT * FROM tblPayCrew where Pay_Id = " & Field2Str2(oRS!pay_id)
' Set oRT = New Recordset
' oRT.Open strSELECT, goConn, adOpenKeyset, adLockOptimistic
' Do Until oRT.EOF
strCODE = Field2Str(oRS!CODES)
With oRS
' oRSS.AddNew
If strCODE = 1 Then
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = Field2Str(!reg_hrs)
oRSS!amount = Field2Str2(!GROSS_CD1)
' oRSS!amount = Field2Str2(!Reg_Wage)
oRSS!Rate = Field2Str2(!Rate)
oRSS!wc_code = Field2Str(!wc_code)
oRSS!earncode = Field2Str(!RATECD1)
' oRSS!earncode = "1"
' oRSS!earncode = "11"
oRSS!OT_Hours = Field2Str2(!OT_Hrs)
oRSS!OT_Amt = CSng(Field2Str2(!OT_Rate)) * CSng(Field2Str2(!OT_Hrs))
oRSS!OT_TRANS = Field2Str2(!OT_Hrs)
oRSS!REG_TRANS = Field2Str(!reg_hrs)
' oRSS!earncode = "01"
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS.Update
ElseIf strCODE = 2 Then
If Field2Str2(oRS!GROSS_CD1) > 0 Then
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = Field2Str(!reg_hrs)
oRSS!amount = Field2Str2(!GROSS_CD1)
' oRSS!amount = Field2Str2(!Reg_Wage)
oRSS!Rate = Field2Str2(!Rate)
oRSS!wc_code = Field2Str(!wc_code)
oRSS!earncode = Field2Str(!RATECD1)
' oRSS!earncode = "1"
' oRSS!earncode = "11"
oRSS!OT_Hours = Field2Str2(!OT_Hrs)
oRSS!OT_Amt = CSng(Field2Str2(!OT_Rate)) * CSng(Field2Str2(!OT_Hrs))
oRSS!OT_TRANS = Field2Str2(!OT_Hrs)
oRSS!REG_TRANS = Field2Str(!reg_hrs)
' oRSS!earncode = "01"
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS.Update
End If
If Field2Str2(oRS!GROSS_CD2) > 0 Then
oRSS.AddNew
oRSS!employee_no = Field2Str(!Emp_ID)
oRSS!HOURS_WAGES = Field2Str(!Reg_HRS2)
oRSS!amount = Field2Str2(!GROSS_CD2)
' oRSS!amount = Field2Str2(!Reg_Wage)
oRSS!Rate = Field2Str2(!Reg_RT2)
oRSS!wc_code = Field2Str(!wc_code)
oRSS!earncode = Field2Str(!RATECD2)
' oRSS!earncode = "1"
' oRSS!earncode = "11"
oRSS!OT_Hours = Field2Str2(!OT_Hrs2)
oRSS!OT_Amt = CSng(Field2Str2(!OT_RT2)) * CSng(Field2Str2(!OT_Hrs))
oRSS!OT_TRANS = Field2Str2(!OT_Hrs2)
oRSS!REG_TRANS = Field2Str(!Reg_HRS2)
' oRSS!earncode = "01"
If Field2Str(!autodeduct) = "" Then
oRSS!auto_deduction = "N"
Else
oRSS!auto_deduction = Field2Str(!autodeduct)
End If
oRSS.Update
End If
End If
End With
oRS!ready = vbUnchecked
oRS!done = vbChecked
oRS.Update
oRS.MoveNext
Loop
' oRS!P_FLAG = vbUnchecked
' oRS.Update
' oRS.MoveNext
' Loop
Screen.MousePointer = vbDefault
intYN = MsgBox("Payroll Is Ready To Be Imported Into CMS - Select YES to Setup Transfer File", vbYesNo, "Transfer Setup")
If intYN = vbYes Then
Call CMSPRTransfer
ElseIf intYN = vbNo Then
End If
' cmdMoveMAS90.SetFocus
' cmdExit.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form HourList - Module cmdPRProcess_Click"
Call ErrorHandler2
gstrMODULE = ""
Screen.MousePointer = vbDefault
Exit Sub
End Sub
Reference in New Issue View Git Blame Copy Permalink