Files
claudetools/clients/valleywide/app-modernization/source-code/Orders-VWP_Current-2020/frmPayList1015.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

1456 lines
44 KiB
Plaintext

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
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 frmPayList
Caption = "Payroll List"
ClientHeight = 7995
ClientLeft = 60
ClientTop = 345
ClientWidth = 9030
ControlBox = 0 'False
Enabled = 0 'False
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7995
ScaleWidth = 9030
StartUpPosition = 3 'Windows Default
Begin LpLib.fpList lstCrew
Height = 3765
Left = 4680
TabIndex = 25
Top = 1560
Width = 4215
_Version = 196608
_ExtentX = 7435
_ExtentY = 6641
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 = 3
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 = "frmPayList.frx":0000
End
Begin VB.CheckBox chkBiWeekly
Caption = "Paid BiWeekly"
Height = 330
Left = 5160
TabIndex = 24
Top = 6105
Width = 1590
End
Begin VB.CommandButton cmdPrDetail
Caption = "Print Pay Detail"
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 = 2400
TabIndex = 23
Top = 7380
Width = 1035
End
Begin VB.CommandButton cmdUpEmpMaster
Caption = "Up Emp Master"
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 = 1260
TabIndex = 22
Top = 7380
Width = 1035
End
Begin VB.CommandButton cmdMoveMAS90
Caption = "Move PR to MAS90"
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 = 3540
TabIndex = 21
Top = 7380
Width = 1035
End
Begin VB.CommandButton cmdPRProcess
Caption = "Setup PR for MAS90"
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 = 120
TabIndex = 20
Top = 7380
Width = 1035
End
Begin VB.CommandButton cmd1TimeSheet
Caption = "1 Time Sheet"
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 = 2400
TabIndex = 19
TabStop = 0 'False
Top = 6720
Width = 1035
End
Begin VB.CommandButton cmdPrintPayLog
Caption = "Payroll Log"
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 = 1260
TabIndex = 18
TabStop = 0 'False
Top = 6720
Width = 1035
End
Begin VB.CommandButton cmdPrint1Crew
Caption = "1 Crew Summary"
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 = 3540
TabIndex = 17
TabStop = 0 'False
Top = 6720
Width = 1035
End
Begin VB.CommandButton cmdPrint1
Caption = "1 VWP Summary"
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 = 120
TabIndex = 16
TabStop = 0 'False
Top = 6720
Width = 1035
End
Begin VB.CommandButton cmdPrintTimeSheets
Caption = "Time Sheets"
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 = 2400
TabIndex = 15
TabStop = 0 'False
Top = 6060
Width = 1035
End
Begin VB.CommandButton cmdPrintData
Caption = "Data Input Sheet"
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 = 1260
TabIndex = 14
TabStop = 0 'False
Top = 6060
Width = 1035
End
Begin VB.CommandButton cmdPrintCrew
Caption = "Print Crew Summary"
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 = 3540
TabIndex = 13
TabStop = 0 'False
Top = 6060
Width = 1035
End
Begin Crystal.CrystalReport crPay
Left = 6900
Top = 5520
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "Print VWP Summary"
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 = 120
TabIndex = 12
TabStop = 0 'False
Top = 6060
Width = 1035
End
Begin VB.CommandButton cmdAddMember
Caption = "Add &Members"
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 = 1260
TabIndex = 5
TabStop = 0 'False
Top = 5400
Width = 1035
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 = 2400
TabIndex = 6
TabStop = 0 'False
Top = 5400
Width = 1035
End
Begin VB.TextBox txtCrewID
Height = 375
Left = 5160
TabIndex = 11
TabStop = 0 'False
Top = 5580
Visible = 0 'False
Width = 1215
End
Begin VB.ListBox lstCrew5
Height = 645
ItemData = "frmPayList.frx":02BD
Left = 4680
List = "frmPayList.frx":02C4
Sorted = -1 'True
TabIndex = 8
TabStop = 0 'False
Top = 6600
Width = 4215
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete Crew"
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 = 3540
TabIndex = 7
TabStop = 0 'False
Top = 5400
Width = 1035
End
Begin VB.CommandButton cmdAdd
Caption = "&Add Crew"
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 = 120
TabIndex = 4
TabStop = 0 'False
Top = 5400
Width = 1035
End
Begin VB.ListBox lstPayCrews
Height = 3765
Left = 120
TabIndex = 2
Top = 1560
Width = 4455
End
Begin MSComCtl2.DTPicker dtpPayDate
Height = 315
Left = 1320
TabIndex = 0
Top = 180
Width = 1215
_ExtentX = 2143
_ExtentY = 556
_Version = 393216
Format = 49086465
CurrentDate = 36942
MaxDate = 55153
MinDate = 36892
End
Begin VB.Label lblCrewInstruct
Caption = "Double Click or CTRL S on the desired crew listed below to add the crew to the current payroll 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 = 5340
TabIndex = 10
Top = 660
Width = 2955
End
Begin VB.Label lblInstruct
Caption = "Double Click or CTRL P on the desired crew to view payroll informaton for that crew for the payroll date shown."
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 = 9
Top = 600
Width = 4395
End
Begin VB.Label lblCrew
AutoSize = -1 'True
Caption = "Crews for this payroll:"
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 = 180
TabIndex = 3
Top = 1320
Width = 1845
End
Begin VB.Label lblPRDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Payroll Date:"
Height = 195
Left = 360
TabIndex = 1
Top = 240
Width = 900
End
End
Attribute VB_Name = "frmPayList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSPay As Recordset
Dim moRSCREW As Recordset
Dim mboolAdding As Boolean
Private Sub cmd1TimeSheet_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
strSQL = "{tblcrew.crew_id} = " & Left$(lstPayCrews.Text, 3)
crPay.ReportFileName = App.Path & "\timesheet.rpt"
crPay.SelectionFormula = strSQL
crPay.Destination = crptToPrinter
crPay.CopiesToPrinter = 1
crPay.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmd1TimeSheet_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAdd_Click()
Dim intID As Integer, strSQL As String, lngINDEX As Long, lngFind As Long
Dim oRS As Recordset
On Error GoTo Error_EH
cmdAdd.Enabled = False
cmdDelete.Enabled = False
'Code to Add a Crew
mboolAdding = True
intID = InputBox("Enter The Crew Number To Add", "Crew Number", 999)
If intID > 0 Then
strSQL = "SELECT Crew_id, Crew_Boss, Type, Inactive, BiWeekly FROM tblCREW WHERE crew_id = " & intID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
If oRS!inactive Then
MsgBox "This Crew - " & oRS!crew_boss & " - Is Inactive - Select an Active Crew", vbOKOnly, "Inactive Crew"
cmdAdd.Enabled = True
Exit Sub
End If
End If
If oRS.EOF Then
Call CrewLoad
Else
txtCrewID = oRS!crew_id
chkBiWeekly = Field2CheckBox(oRS!BiWeekly)
Call FormSave
cmdAdd.Enabled = True
If lstPayCrews.ListCount Then
cmdDelete.Enabled = True
End If
cmdAdd.SetFocus
End If
Else
cmdAdd.Enabled = True
If lstPayCrews.ListCount Then
cmdDelete.Enabled = True
End If
cmdAdd.SetFocus
Exit Sub
End If
lngFind = Field2Long(intID)
Call CBFindString2(lstPayCrews, Field2Str(intID))
' lstPayCrews.SetFocus
' lngINDEX = ListFindItem(lstPayCrews, lngFind)
' Call ListFindItem3(lstPayCrews, lngFind)
' lstPayCrews.ListIndex = lngINDEX
Exit Sub
Error_EH:
If Err.Number = 13 Then
cmdAdd.Enabled = True
If lstPayCrews.ListCount Then
cmdDelete.Enabled = True
End If
Resume Next
End If
gstrMODULE = "Form PayList - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSave()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = 1"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If mboolAdding Then
oRS.AddNew
oRS!C_USER = gstrLOGIN
End If
With oRS
!U_USER = gstrLOGIN
!Updated = Date
!crew_id = txtCrewID
!Pay_Date = dtpPayDate.Value
!BiWeekly = chkBiWeekly
End With
oRS.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 PayList - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
' Store the controls to the recordset
Call FieldsSave
' moRSPay.Update
If mboolAdding Then
mboolAdding = False
End If
Call PayLoad
Exit Sub
Error_EH:
' Call ErrorHandler(moRSPay.ActiveConnection)
gstrMODULE = "Form PayList - Module FieldsSave"
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 tblPayHeader WHERE Pay_Date = #" & dtpPayDate.Value & "# ORDER BY crew_id"
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstPayCrews.Clear
Do Until moRSCREW.EOF
With lstPayCrews
strCREW = "SELECT * FROM tblCrew where CREW_id = " & moRSCREW!crew_id
Set oRS = New Recordset
oRS.Open strCREW, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
strLine = Field2Str(moRSCREW!crew_id) & " " & Field2Str(oRS!Type) & vbTab & Field2Str(oRS!crew_boss)
.AddItem strLine
.ItemData(.NewIndex) = moRSCREW!pay_id
End If
End With
moRSCREW.MoveNext
Loop
moRSCREW.Close
If lstPayCrews.ListCount Then
lstPayCrews.ListIndex = 0
cmdAddMember.Enabled = True
cmdDelete.Enabled = True
cmdPrint.Enabled = True
cmdPrintCrew.Enabled = True
cmdPrintData.Enabled = True
cmdPrintTimeSheets.Enabled = True
cmdPrint1.Enabled = True
cmdPrint1Crew.Enabled = True
cmdPrintPayLog.Enabled = True
cmd1TimeSheet.Enabled = True
cmdPRProcess.Enabled = True
cmdUpEmpMaster.Enabled = True
cmdMoveMAS90.Enabled = True
cmdPrDetail.Enabled = True
gintPAYID = lstPayCrews.ItemData(lstPayCrews.ListIndex)
Else
cmdAddMember.Enabled = False
cmdDelete.Enabled = False
cmdPrint.Enabled = False
cmdPrintCrew.Enabled = False
cmdPrintData.Enabled = False
cmdPrintTimeSheets.Enabled = False
cmdPrint1.Enabled = False
cmdPrint1Crew.Enabled = False
cmdPrintPayLog.Enabled = False
cmd1TimeSheet.Enabled = False
cmdPRProcess.Enabled = False
cmdUpEmpMaster.Enabled = False
cmdMoveMAS90.Enabled = False
cmdPrDetail.Enabled = False
' Call ChangeButton
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module PayLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdAddMember_Click()
Dim intINDEX As Integer
If lstPayCrews.ListIndex <> -1 Then
intINDEX = lstPayCrews.ListIndex
gintCREWID = Left$(Field2Str2(lstPayCrews.Text), 3)
frmCrewList.Show 1
Call PayLoad
lstPayCrews.ListIndex = intINDEX
Else
MsgBox "You Must Select A Crew", vbOKOnly, "Select Crew"
Exit Sub
End If
End Sub
Private Sub cmdDelete_Click()
Dim strSQL As String, strYN As String
strYN = MsgBox("Are You Sure You Want To Delete This Crew?", vbCritical + vbYesNo, "Delete?")
If strYN <> vbYes Then
Exit Sub
End If
strSQL = "DELETE * FROM tblTIME where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
goConn.Execute strSQL
strSQL = "DELETE * FROM tblPayCrew where pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
goConn.Execute strSQL
strSQL = "DELETE * FROM tblPayHeader WHERE pay_id = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
goConn.Execute strSQL
Call PayLoad
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPrintVWP_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
crPay.ReportFileName = App.Path & "\payinfo.rpt"
crPay.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPay.Destination = gintDEST
crPay.CopiesToPrinter = gintCOPY
crPay.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintVWP_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdMoveMAS90_Click()
MsgBox "Go to MAS90 and Import the Payroll", vbOKOnly, "Goto MAS90"
End Sub
Private Sub cmdPrDetail_Click()
Dim strDate As String, strSQL As String, intSUP As Integer
Dim oRS As Recordset, intYN As Integer
Dim strSELECT As String
Dim strBegDate As String, strEndDate As String
Dim intBYear As String, intBMonth As String, intBDay As String
Dim intEYear As String, intEMonth As String, intEDay As String
On Error GoTo Error_EH
gboolPRINT = True
intYN = MsgBox("Remember to Update Check Information Before Printing - Are You Ready?", vbYesNo, "Ready to Print")
If intYN = vbNo Then
Exit Sub
End If
intYN = MsgBox("Do You Want To Print to the Printer?", vbYesNo, "Window or Printer")
If gboolPRINT Then
strDate = dtpPayDate.Value
intBYear = Mid(strDate, 7, 4)
intBDay = Format(Mid(strDate, 4, 2), "00")
intBMonth = Format(Mid(strDate, 1, 2), "00")
' intEYear = Mid(txtEndDate, 7, 4)
' intEDay = Format(Mid(txtEndDate, 4, 2), "00")
' intEMonth = Format(Mid(txtEndDate, 1, 2), "00")
crPay.ReportFileName = App.Path & "\PayDetail.rpt"
crPay.Formulas(3) = "ZZ_Date = Date(" & intBYear & "," & intBMonth & "," & intBDay & ")"
' crpay.Formulas(4) = "Z_Crew = " & mintCREW
' crpay.Formulas(5) = "Z_EndDate = Date(" & intEYear & "," & intEMonth & "," & intEDay & ")"
If intYN = vbYes Then
crPay.Destination = crptToPrinter
Else
crPay.Destination = crptToWindow
End If
crPay.Action = 1
gboolPRINT = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrDetail_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
crPay.ReportFileName = App.Path & "\payinfo.rpt"
crPay.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPay.Destination = gintDEST
crPay.CopiesToPrinter = gintCOPY
crPay.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint1_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
' Set oRS = New Recordset
' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic
' oRS.MoveFirst
' Do Until oRS.EOF
strSQL = "{tblpayheader.pay_id} = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
crPay.ReportFileName = App.Path & "\payinfo.rpt"
crPay.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPay.Destination = gintDEST
crPay.CopiesToPrinter = gintCOPY
crPay.Action = 1
' oRS.MoveNext
' Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint1_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrint1Crew_Click()
Dim strSQL As String ', strSQL2 As String
'Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
strSQL = "{tblpayheader.pay_id} = " & lstPayCrews.ItemData(lstPayCrews.ListIndex)
crPay.ReportFileName = App.Path & "\payinfo2.rpt"
crPay.SelectionFormula = strSQL
crPay.Destination = gintDEST
crPay.CopiesToPrinter = gintCOPY
crPay.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint1Crew_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintCrew_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
strSql2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblpayheader.pay_id} = " & Field2Str2(oRS!pay_id)
crPay.ReportFileName = App.Path & "\payinfo2.rpt"
crPay.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPay.Destination = gintDEST
crPay.CopiesToPrinter = gintCOPY
crPay.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintCrew_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintData_Click()
Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
intMonth = Month(dtpPayDate.Value)
intDay = Day(dtpPayDate.Value)
intYear = Year(dtpPayDate.Value)
' Do Until oRS.EOF
strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
crPay.ReportFileName = App.Path & "\paylist.rpt"
crPay.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPay.Destination = gintDEST
crPay.CopiesToPrinter = gintCOPY
crPay.Action = 1
' oRS.MoveNext
' Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintData_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintPayLog_Click()
Dim strSQL As String, intMonth As Integer, intDay As Integer, intYear As Integer
On Error GoTo Error_EH
gintPRINT = 1
frmReport.Show 1
intMonth = Month(dtpPayDate)
intDay = Day(dtpPayDate)
intYear = Year(dtpPayDate)
' Do Until oRS.EOF
' strSQL = "{tblpaycrew.pay_date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
' strSQL2 = "SELECT pay_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
' Set oRS = New Recordset
' oRS.Open strSQL2, goConn, adOpenKeyset, adLockOptimistic
' oRS.MoveFirst
' Do Until oRS.EOF
strSQL = "{tblpayheader.pay_Date} = Date(" & intYear & "," & intMonth & "," & intDay & ")"
crPay.ReportFileName = App.Path & "\paylog.rpt"
crPay.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPay.Destination = gintDEST
crPay.CopiesToPrinter = gintCOPY
crPay.Action = 1
' oRS.MoveNext
' Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPrintTimeSheets_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset
On Error GoTo Error_EH
gintPRINT = 1
' frmReport.Show 1
strSql2 = "SELECT crew_id, Pay_Date FROM tblPayHeader WHERE pay_date = #" & dtpPayDate & "# ORDER BY Crew_Id"
Set oRS = New Recordset
oRS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
oRS.MoveFirst
Do Until oRS.EOF
strSQL = "{tblcrew.crew_id} = " & Field2Str2(oRS!crew_id)
crPay.ReportFileName = App.Path & "\timesheet.rpt"
crPay.SelectionFormula = strSQL
' crPay.Destination = crptToWindow
crPay.Destination = crptToPrinter
' crPay.Destination = gintDEST
crPay.CopiesToPrinter = 1
crPay.Action = 1
oRS.MoveNext
Loop
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPrintTimeSheet_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdPRProcess_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 tblPayHeader 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 = Field2Str(!gross)
oRSS!Rate = Field2Str(!Rate)
oRSS!wc_code = Field2Str(!wc_code)
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 MAS90"
cmdExit.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPRProcess_Click"
Call ErrorHandler2
gstrMODULE = ""
Screen.MousePointer = vbDefault
Exit Sub
End Sub
Private Sub cmdUpEmpMaster_Click()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
Screen.MousePointer = vbHourglass
On Error GoTo Error_EH
If gboolMAS90 Then
MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
Exit Sub
End If
strSql2 = "DELETE * FROM PR1_EmployeeMaster"
goConn.Execute strSql2
strSql2 = "SELECT department, employeenumber, lastname, firstname, socialsecuritynumber, DefaultWCCode, employeestatus_AIT FROM PR1_EmployeeMaster"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
Do Until oRSS.EOF
strSQL = "SELECT * FROM PR1_EmployeeMaster WHERE employeenumber = '" & Field2Str(oRSS!employeenumber) & "' and department = '" & Field2Str(oRSS!department) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
oRS.AddNew
oRS!department = Field2Str(oRSS!department)
oRS!employeenumber = Field2Str(oRSS!employeenumber)
oRS!lastname = Field2Str(Trim$(oRSS!lastname))
oRS!firstname = Field2Str(Trim$(oRSS!firstname))
oRS!socialsecuritynumber = Field2Str(oRSS!socialsecuritynumber)
If Field2Str(oRSS!defaultwccode) = "" Then
If oRS!department = "53" Then
oRS!wc_code = "0005022"
ElseIf oRS!department = "52" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "54" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "55" Then
oRS!wc_code = "0005606"
ElseIf oRS!department = "50" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "62" Then
oRS!wc_code = "0008810"
ElseIf oRS!department = "61" Then
oRS!wc_code = "0008810"
End If
Else
oRS!wc_code = Field2Str(oRSS!defaultwccode)
End If
oRS!terminated = Field2Str(oRSS!employeestatus_AIT)
oRS.Update
ElseIf Field2Str(oRSS!department) <> Field2Str(oRS!department) Then
oRS.Delete
oRS.AddNew
oRS!department = Field2Str(oRSS!department)
oRS!employeenumber = Field2Str(oRSS!employeenumber)
oRS!lastname = Field2Str(Trim$(oRSS!lastname))
oRS!firstname = Field2Str(Trim$(oRSS!firstname))
oRS!socialsecuritynumber = Field2Str(oRSS!socialsecuritynumber)
If Field2Str(oRSS!defaultwccode) = "" Then
If oRS!department = "53" Then
oRS!wc_code = "0005022"
ElseIf oRS!department = "52" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "54" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "55" Then
oRS!wc_code = "0005606"
ElseIf oRS!department = "50" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "62" Then
oRS!wc_code = "0008810"
ElseIf oRS!department = "61" Then
oRS!wc_code = "0008810"
End If
Else
oRS!wc_code = Field2Str(oRSS!defaultwccode)
End If
oRS!terminated = Field2Str(oRSS!employeestatus_AIT)
oRS.Update
' End If
Else
If Field2Str(oRSS!defaultwccode) = "" Then
If oRS!department = "53" Then
oRS!wc_code = "0005022"
ElseIf oRS!department = "52" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "54" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "55" Then
oRS!wc_code = "0005606"
ElseIf oRS!department = "50" Then
oRS!wc_code = "0005443"
ElseIf oRS!department = "62" Then
oRS!wc_code = "0008810"
ElseIf oRS!department = "61" Then
oRS!wc_code = "0008810"
End If
Else
oRS!wc_code = Field2Str(oRSS!defaultwccode)
End If
oRS!terminated = Field2Str(oRSS!employeestatus_AIT)
oRS.Update
End If
oRSS.MoveNext
Loop
Screen.MousePointer = vbDefault
MsgBox "Employee Master Information Has Been Updated"
cmdExit.SetFocus
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module cmdPRProcess_Click"
Call ErrorHandler2
gstrMODULE = ""
Screen.MousePointer = vbDefault
Exit Sub
End Sub
Private Sub dtpPayDate_Change()
Call PayLoad
cmdAdd.SetFocus
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
' mboolSETUP = False
' mboolENTER = False
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - 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 = vbKeyP Then ' Display key combinations.
If CtrlDown Then
Call lstPayCrews_DblClick
' Call PayLoad
' Call cmdTotal_Click
End If
Exit Sub
End If
If KeyCode = vbKeyA Then ' Display key combinations.
If CtrlDown Then
Call cmdAdd_Click
' Call CrewLoad
' Call cmdTotal_Click
End If
Exit Sub
End If
If KeyCode = vbKeyM Then ' Display key combinations.
If CtrlDown Then
Call cmdAddMember_Click
' Call CrewLoad
' Call cmdTotal_Click
' Call lstLots_DblClick
End If
Exit Sub
End If
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
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
frmPayList.Width = 4725
dtpPayDate.Value = Date
Call PayLoad
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoad()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblCrew Order BY Crew_Boss"
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
lstCrew.Clear
Do Until moRSCREW.EOF
With lstCrew
.AddItem Field2Str(moRSCREW!crew_id) & vbTab & Field2Str(moRSCREW!crew_boss) & vbTab & Field2Str(moRSCREW!BiWeekly)
' .ItemData(.NewIndex) = moRSCREW!crew_id
End With
moRSCREW.MoveNext
Loop
' moRSCrew.Close
frmPayList.Width = 9150
Exit Sub
Error_EH:
gstrMODULE = "Form PayList - Module ProjLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstCrew_Click()
lstCrew.col = 0
txtCrewID = lstCrew.ColText
lstCrew.col = 2
chkBiWeekly = Field2CheckBox(lstCrew.ColText)
End Sub
Private Sub lstCrew_DblClick()
lstCrew.col = 0
txtCrewID = lstCrew.ColText
lstCrew.col = 2
chkBiWeekly = Field2CheckBox(lstCrew.ColText)
'' txtCrewID = lstCrew.ItemData(lstCrew.ListIndex)
frmPayList.Width = 4725
cmdAdd.Enabled = True
cmdDelete.Enabled = True
Call FormSave
End Sub
Private Sub lstPayCrews_DblClick()
gintPAYID = lstPayCrews.ItemData(lstPayCrews.ListIndex)
gintCREWID = CInt(Left(lstPayCrews.Text, 3))
Load frmPayHead
frmPayHead.lblCrewName = Trim$(Mid$(lstPayCrews.Text, InStr(lstPayCrews.Text, vbTab) + 1))
frmPayHead.txtPayDate = dtpPayDate.Value
frmPayHead.txtCrewID = gintCREWID
frmPayHead.chkBiWeekly = chkBiWeekly
frmPayHead.Show 1
End Sub