frmcheckin.frm

hotel mnagement system

Private Sub cmdCheckInOut_Click()
    Dim strCaption As String
    Dim RoomNumber As Integer
    
    strCaption = cmdCheckInOut.Caption
    RoomNumber = txtRoomNumber.Text
    
    Call SaveAdd

    If HaveAction = False Then
        Exit Sub
    End If
    
    If State = adStateAddMode Then
        MsgBox "New record has been successfully saved.", vbInformation

        Unload frmCheckIn
    Else
        MsgBox "Changes in  record has been successfully saved.", vbInformation
        
        Unload frmCheckIn
    End If

    If strCaption = "Check Out" Then
        With frmCheckOut
            .RoomNumber = RoomNumber
            .AutoCheckOut = False
            
            .Show vbModal
        End With
    End If
End Sub

Private Sub SaveAdd()
On Error GoTo err
    
    Dim rsCustomers As New Recordset
    Dim CustomerID As Integer
    Dim CompanyID As Integer
    
    If Trim(txtLastName.Text) = "" Or Trim(txtFirstName.Text) = "" Then
        MsgBox "Please complete the name of a guest.", vbInformation
        
        Exit Sub
    End If
    
    CN.BeginTrans

    'Save customer's record
    With rsCustomers
        .Open "SELECT * FROM Customers WHERE LastName = '" & txtLastName.Text & "' AND FirstName = '" & txtFirstName.Text & "'", CN, adOpenStatic, adLockOptimistic
    
        If .RecordCount > 0 Then
            txtLastName.Tag = .Fields("CustomerID")
        Else
            .AddNew
            
            CustomerID = getIndex("Customers")
            txtLastName.Tag = CustomerID
            
            .Fields("CustomerID") = CustomerID
            .Fields("LastName") = txtLastName.Text
            .Fields("FirstName") = txtFirstName.Text
            
            .Update
        End If
        
        .Close
        
        If txtCompany.Text = "" Then GoSub ContinueSave
        
        'Save company's record
        .Open "SELECT * FROM Company WHERE Company = '" & txtCompany.Text & "'", CN, adOpenStatic, adLockOptimistic
        
        If .RecordCount > 0 Then
            txtCompany.Tag = .Fields("CompanyID")
        Else
            .AddNew

            CompanyID = getIndex("Company")
            txtCompany.Tag = CompanyID
            
            .Fields("CompanyID") = CompanyID
            .Fields("Company") = txtCompany.Text
            
            .Update
        End If
        
        .Close
    End With
    
ContinueSave:

    If State = adStateAddMode Then
        RS.AddNew
        
        RS.Fields("FolioNumber") = txtFolioNumber.Text
        RS.Fields("CheckInBy") = CurrUser.USER_PK
        RS.Fields("AddedByFK") = CurrUser.USER_PK
    Else
        RS.Fields("DateModified") = Now
        RS.Fields("LastUserFK") = CurrUser.USER_PK
    End If
    
    With RS
        .Fields("RCardNo") = txtRCardNo.Text
        .Fields("CustomerID") = txtLastName.Tag
        .Fields("Address") = txtAddress.Text
        .Fields("CountryID") = dcCountry.BoundText
        .Fields("CompanyID") = IIf(txtCompany.Tag = "", Null, txtCompany.Tag)
        .Fields("IDTypeID") = dcIDType.BoundText
        .Fields("IDNumber") = txtIDNumber.Text
        .Fields("RoomNumber") = txtRoomNumber.Text
        .Fields("DateIn") = dtpDateIn.Value
        .Fields("DateOut") = dtpDateOut.Value
        .Fields("RateType") = dcRateType.BoundText
        .Fields("Rate") = txtRate.Text
        .Fields("OtherCharges") = txtOtherCharges.Text
        .Fields("Discount") = txtDiscount.Text
        .Fields("AmountPaid") = txtAmountPaid.Text
        .Fields("Days") = txtDays.Text
        .Fields("Adults") = txtAdults.Text
        .Fields("Childrens") = txtChildrens.Text
        .Fields("Total") = txtTotal.Text
        .Fields("BusinessSourceID") = dcBusSource.BoundText
        .Fields("VehicleID") = IIf(dcVehicle.BoundText = "", Null, dcVehicle.BoundText)
        .Fields("VehicleModel") = txtVehicleModel.Text
        .Fields("PlateNo") = txtPlateNo.Text
        .Fields("Notes") = txtNotes.Text

        .Update
    End With
    
    '----------------------------
    'Delete record from Inventory and add a new check in/out date
    CN.Execute "DELETE ID, Status " & _
                "From [Inventory] " & _
                "WHERE ID='" & txtFolioNumber.Text & "' AND Status='Check In'"
                
    Dim dtpStartDate As Date
    
    dtpStartDate = dtpDateIn.Value
    
    Do Until dtpStartDate = dtpDateOut.Value
        CN.Execute "INSERT INTO [Inventory] ( ID, RoomNumber, [Date], CustomerID, Status ) " & _
                "VALUES ('" & txtFolioNumber.Text & "', " & txtRoomNumber.Text & ", #" & dtpStartDate & "#, " & txtLastName.Tag & ", 'Check In')"

        dtpStartDate = dtpStartDate + 1
    Loop
    '----------------------------
    
    ChangeValue CN, "Rooms", "RoomStatusID", 2, True, "WHERE RoomNumber = " & txtRoomNumber.Text
    
    Call frmPayment.cmdSave_Click
    Call frmOtherCharges.cmdSave_Click
    
    If txtCompany.Text <> "" Then
        Dim rsAccRec As New Recordset
        
        With rsAccRec
            .Open "SELECT * FROM [Accounts Receivable] WHERE CompanyID = " & txtCompany.Tag & " AND FolioNumber = '" & txtFolioNumber & "'", CN, adOpenStatic, adLockOptimistic
            
            If .RecordCount > 0 Then
                .Fields("Debit") = txtBalance.Text
            Else
                .AddNew
                
                .Fields("CompanyID") = txtCompany.Tag
                .Fields("FolioNumber") = txtFolioNumber.Text
                .Fields("Credit") = txtBalance.Text
            End If
            
            .Update
        End With
    ElseIf State = adStateEditMode Then
        'delete record from accounts receivable table since the company field becomes blank.
        
        CN.Execute "DELETE [Accounts Receivable].FolioNumber " & _
                    "From [Accounts Receivable] " & _
                    "WHERE FolioNumber= '" & txtFolioNumber.Text & "'"
    End If
    
    CN.CommitTrans

    HaveAction = True
    
    Exit Sub

err:
    CN.RollbackTrans
    prompt_err err, Name, "cmdSave_Click"
    Screen.MousePointer = vbDefault
End Sub

Private Sub cmdLookupComp_Click()
    With frmCompanyLookup
        Set .RefForm = Me
        
        .Show vbModal
    End With
End Sub

Private Sub cmdLookupCust_Click()
    With frmCustomerLookup
        Set .RefForm = Me
        
        .Show vbModal
    End With
End Sub

Private Sub CmdPrint_Click()
    If State = adStatePopupMode Then
        GoSub JumpHere
    End If
    
    If MsgBox("This will save the record before printing a folio. " & vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNo + vbInformation) = vbYes Then
        Call SaveAdd
    Else
        Exit Sub
    End If

JumpHere:
    With frmReports
        .strReport = "Folio"
        
        If State = adStatePopupMode Then
            .strWhere = "{qry_RPT_Customers.FolioNumber} = '" & txtFolioNumber.Text & "' AND {qry_RPT_Customers.Status} = 'Check Out'"
        Else
            .strWhere = "{qry_RPT_Customers.FolioNumber} = '" & txtFolioNumber.Text & "' AND {qry_RPT_Customers.Status} = 'Check In'"
        End If

        frmReports.Show vbModal
    End With
End Sub

Private Sub cmdUpdateDelete_Click()
    If cmdUpdateDelete.Caption = "Update" Then
        Call SaveAdd
    
        If State = adStateAddMode Then
            MsgBox "New record has been successfully saved.", vbInformation
    
'            Unload frmCheckIn
        Else
            MsgBox "Changes in  record has been successfully saved.", vbInformation
            
'            Unload frmCheckIn
        End If
    End If
End Sub

Private Sub cmdUsrHistory_Click()
    On Error Resume Next
    Dim tDate1 As String
    Dim tDate2 As String
    Dim tUser1 As String
    Dim tUser2 As String
    
    tDate1 = Format$(RS.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
    tDate2 = Format$(RS.Fields("DateModified"), "MMM-dd-yyyy HH:MM AMPM")
    
    tUser1 = getValueAt("SELECT PK,CompleteName FROM Users WHERE PK = " & RS.Fields("AddedByFK"), "CompleteName")
    tUser2 = getValueAt("SELECT PK,CompleteName FROM Users WHERE PK = " & RS.Fields("LastUserFK"), "CompleteName")
    
    MsgBox "Date Added: " & tDate1 & vbCrLf & _
           "Added By: " & tUser1 & vbCrLf & _
           "" & vbCrLf & _
           "Last Modified: " & tDate2 & vbCrLf & _
           "Modified By: " & tUser2, vbInformation, "Modification History"
           
    tDate1 = vbNullString
    tDate2 = vbNullString
    tUser1 = vbNullString
    tUser2 = vbNullString
End Sub

Private Sub dcRateType_Click(Area As Integer)
On Error GoTo err

    Dim rsRoomRates As New ADODB.Recordset
    
    With rsRoomRates
        .Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & txtRoomNumber.Text & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
    
        If .RecordCount > 0 Then
            txtRate.Text = toMoney(!RoomRate)
            txtAdults.Text = !NoofPerson
            hsAdults.Min = !NoofPerson
            hsAdults.Value = !NoofPerson
            txtAdults.Tag = !ExtraAdultRate
            txtChildrens.Tag = !ExtraChildRate
        End If
    End With
    
    rsRoomRates.Close
    
    Call ComputeRate
    
    Exit Sub
    
err:
    CN.RollbackTrans
    prompt_err err, Name, "dcRateType_Click"
    Screen.MousePointer = vbDefault
End Sub

Public Sub dtpDateOut_Change()
    If dtpDateOut.Value < dtpDateIn.Value Then Exit Sub
    
    txtDays.Text = dtpDateOut.Value - dtpDateIn.Value
    hsDays.Value = txtDays.Text
    
    Call ComputeRate
End Sub

Private Sub dtpDateOut_LostFocus()
    If dtpDateOut.Value < dtpDateIn.Value Then MsgBox "Date Out must be greater than Date In.", vbExclamation:  dtpDateOut.SetFocus
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub Form_Load()
On Error GoTo err

    RS.CursorLocation = adUseClient

    CN.BeginTrans

    bind_dc "SELECT * FROM Countries", "Country", dcCountry, "CountryID", True
    bind_dc "SELECT * FROM [ID Type]", "IDType", dcIDType, "IDTypeID", True
    bind_dc "SELECT * FROM [Rate Type]", "RateType", dcRateType, "RateTypeID", True
    bind_dc "SELECT * FROM [Business Source]", "BusinessSource", dcBusSource, "BusinessSourceID", True
    bind_dc "SELECT * FROM [Vehicles]", "Vehicle", dcVehicle, "VehicleID", False
    
    dcCountry.Text = "Philippines"
    
    Dim rsRoomRates As New ADODB.Recordset
    
    'Check the form state
    If State = adStateAddMode Then
        RS.Open "SELECT * FROM Transactions WHERE FolioNumber = '" & PK & "'", CN, adOpenStatic, adLockOptimistic
        
        cmdUsrHistory.Enabled = False
        
        txtRoomNumber.Text = Room
        dtpDateIn.Value = Date
        dtpDateOut.Value = dtpDateIn.Value + 1
        
        GeneratePK
        
        rsRoomRates.Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & txtRoomNumber.Text & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
        
        With rsRoomRates
            If .RecordCount > 0 Then
                txtRate.Text = toMoney(!RoomRate)
                txtAdults.Text = !NoofPerson
                hsAdults.Min = !NoofPerson
                hsAdults.Value = !NoofPerson
                txtAdults.Tag = !ExtraAdultRate
                txtChildrens.Tag = !ExtraChildRate
            End If
        End With

        Call txtDays_Change
        
        Call ComputeRate
    ElseIf State = adStateEditMode Then
        RS.Open "SELECT * FROM Transactions WHERE RoomNumber = " & PK & " AND Status = 'Check In'", CN, adOpenStatic, adLockOptimistic
        
        rsRoomRates.Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & PK & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
        
        With rsRoomRates