frmcheckout.frm

hotel mnagement system

            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   3600
         TabIndex        =   25
         Top             =   2280
         Width           =   1395
      End
      Begin VB.Label lblRM 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   6.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   165
         Left            =   9450
         TabIndex        =   24
         Top             =   3030
         Width           =   45
      End
   End
   Begin VB.PictureBox bgHeader 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   555
      Left            =   0
      ScaleHeight     =   37
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   479
      TabIndex        =   18
      Top             =   0
      Width           =   7185
      Begin VB.Image Image1 
         Height          =   480
         Left            =   30
         Picture         =   "frmCheckOut.frx":0000
         Top             =   30
         Width           =   480
      End
      Begin VB.Label Label26 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Check Out"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   14.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00926747&
         Height          =   345
         Left            =   600
         TabIndex        =   20
         Top             =   30
         Width           =   1470
      End
      Begin VB.Label Label27 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Fill all fields or fields with '*' then click 'Save' button to update."
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   6.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00926747&
         Height          =   180
         Left            =   600
         TabIndex        =   19
         Top             =   360
         Width           =   3900
      End
   End
End
Attribute VB_Name = "frmCheckOut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public RoomNumber           As Integer
Public AmountPaid           As Currency 'Amount paid from frmPayment
Public OtherCharges         As Currency
Public AutoCheckOut         As Boolean

Dim RS                      As New Recordset

Private Sub cmdCancel_Click()
On Error GoTo err

    CN.BeginTrans
    
    CN.Execute "DELETE FolioNumber " & _
                "From [Rate Per Period] " & _
                "WHERE FolioNumber='" & txtGuestName.Tag & "'"
                
    CN.Execute "INSERT INTO [Rate Per Period] " & _
                "SELECT [Rate Per Period Temp].* " & _
                "FROM [Rate Per Period Temp] " & _
                "Where ((([Rate Per Period Temp].FolioNumber) = '" & txtGuestName.Tag & "')) " & _
                "ORDER BY [Rate Per Period Temp].Date;"
    
    CN.CommitTrans
    
    Unload Me

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

Private Sub cmdCheckOut_Click()
    On Error GoTo err
    
    If txtBalance.Text <> "0.00" Then
        MsgBox "There's still remaining balance for this guest.", vbExclamation
        
        Exit Sub
    End If
    
    If MsgBox("Are you sure you want to Check Out?", vbYesNo + vbInformation) = vbNo Then Exit Sub
    
    CN.BeginTrans
    
    ChangeValue CN, "Rooms", "RoomStatusID", 3, True, "WHERE RoomNumber = " & txtRoomNumber.Text

    Call frmPayment.cmdSave_Click
    Call frmOtherCharges.cmdSave_Click

    With RS
        'Delete record from Inventory
        CN.Execute "DELETE ID, Status " & _
                    "From [Inventory] " & _
                    "WHERE ID='" & .Fields("FolioNumber") & "' AND Status='Check In'"
        
        .Fields("DateOut") = dtpDateOut.Value
        .Fields("OtherCharges") = txtOtherCharges.Text
        .Fields("Discount") = txtDiscount.Text
        .Fields("AmountPaid") = txtAmountPaid.Text
        .Fields("Days") = txtDays.Text
        .Fields("Status") = "Check Out"
        .Fields("CheckOutBy") = CurrUser.USER_PK
        
        .Update
    End With
    
    CN.CommitTrans
    
    Call PrintFolio
    
    RS.Close
    Set RS = Nothing
    
    Unload Me
    
    Exit Sub

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

Private Sub PrintFolio()
    With frmReports
        .strReport = "Folio"
        
        .strWhere = "{qry_RPT_Customers.FolioNumber} = '" & txtGuestName.Tag & "' AND {qry_RPT_Customers.Status} = 'Check Out'"

        frmReports.Show vbModal
    End With
End Sub

Private Sub dtpDateOut_Change()
    txtDays.Text = dtpDateOut.Value - CDate(txtDateIn.Text)
    
    Call ComputeRate
End Sub

Private Sub dtpDateOut_LostFocus()
    If CDate(txtDateIn.Text) > dtpDateOut.Value Then
        MsgBox "Check In date must be below check out date. Please enter another check out date.", vbInformation
        
        dtpDateOut.SetFocus
    End If
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

    CN.BeginTrans

    RS.CursorLocation = adUseClient
    RS.Open "SELECT * FROM Transactions WHERE RoomNumber = " & RoomNumber & " AND Status = 'Check In'", CN, adOpenStatic, adLockOptimistic

    bind_dc "SELECT * FROM [Rate Type]", "RateType", dcRateType, "RateTypeID", True

    txtRoomNumber.Text = RoomNumber
    
    With RS
        txtGuestName.Tag = .Fields("FolioNumber")
        txtGuestName.Text = getValueAt("SELECT [Name] FROM qry_CheckIn WHERE FolioNumber = '" & .Fields("FolioNumber") & " '", "Name")
        txtDateIn.Text = .Fields("DateIn")
        If AutoCheckOut = True Then
            If .Fields("DateOut") >= Date Then
                dtpDateOut.Value = .Fields("DateOut")
            Else
                dtpDateOut.Value = Date
            End If
        Else
            dtpDateOut.Value = .Fields("DateOut")
        End If
        dcRateType.BoundText = .Fields("RateType")
        txtDays.Text = dtpDateOut.Value - CDate(txtDateIn.Text)
        txtAdults.Text = .Fields("Adults")
        txtChildrens.Text = .Fields("Childrens")
        txtRate.Text = toMoney(.Fields("Rate"))
        txtOtherCharges.Text = toMoney(.Fields("OtherCharges"))
        txtDiscount.Text = toMoney(.Fields("Discount"))
        txtAmountPaid.Text = toMoney(.Fields("AmountPaid"))
    End With
    
    dcRateType.Enabled = False
    
    Call ComputeAddRate
    Call ComputeRate

    
    CN.Execute "DELETE FolioNumber " & _
                "From [Rate Per Period Temp] " & _
                "WHERE FolioNumber='" & txtGuestName.Tag & "'"

    CN.Execute "INSERT INTO [Rate Per Period Temp] " & _
                "SELECT [Rate Per Period].* " & _
                "From [Rate Per Period] " & _
                "WHERE FolioNumber='" & txtGuestName.Tag & "'"
                
    CN.CommitTrans
    
    Exit Sub

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

Private Sub ComputeRate()
    txtTotalCharges.Text = toMoney(ComputeRatePerPeriod)
    txtSubTotal.Text = toMoney(toNumber(txtTotalCharges.Text) + toNumber(txtOtherCharges.Text))
    txtTotal.Text = toMoney(toNumber(txtSubTotal.Text) - (toNumber(txtSubTotal.Text) * toNumber(txtDiscount.Text) / 100))
    txtBalance.Text = toMoney(toNumber(txtTotal.Text) - toNumber(txtAmountPaid.Text))
End Sub

'Compute additional rate (no. of days & childrens)
Private Sub ComputeAddRate()
    Dim rsRoomRates As New ADODB.Recordset
    
    With rsRoomRates
        .Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & RoomNumber & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
    
        If .RecordCount > 0 Then
            txtRate.Text = toMoney(!RoomRate)
            txtAdults.Tag = !ExtraAdultRate
            txtChildrens.Tag = !ExtraChildRate
        End If
    End With
    
    rsRoomRates.Close
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lblRatePerPeriod.FontUnderline = False
    lblAmountPaid.FontUnderline = False
    lblOtherCharges.FontUnderline = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frmRoomsWindow.RefreshRecords
    
    Unload frmPayment
    
    Set frmPayment = Nothing
    Set frmCheckOut = Nothing
End Sub

Private Sub lblAmountPaid_Click()
    With frmPayment
        .FolioNumber = txtGuestName.Tag
        .GuestName = txtGuestName.Text
        .Balance = txtBalance.Text
        .RefreshBalance
        Set .RefForm = Me
        
        .Show vbModal
        
        txtAmountPaid.Text = toMoney(AmountPaid)
    End With
End Sub

Private Sub lblAmountPaid_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetHandCur True
    lblAmountPaid.FontUnderline = True
End Sub

Private Function ComputeRatePerPeriod() As Currency
    Dim rsRoomRates As New ADODB.Recordset
    
    With rsRoomRates
        .Open "SELECT * FROM [Rate Per Period] WHERE FolioNumber = '" & txtGuestName.Tag & "'", CN, adOpenStatic, adLockOptimistic
    
        Do Until .EOF
            ComputeRatePerPeriod = ComputeRatePerPeriod + toMoney(!Rate) + toMoney(!Adults) + toMoney(!Childrens)
            
            .MoveNext
        Loop
    End With
    
    rsRoomRates.Close
End Function

Private Sub lblOtherCharges_Click()
    With frmOtherCharges
        .FolioNumber = txtGuestName.Tag
        .GuestName = txtGuestName.Text
        
        Set .RefForm = Me
        
        .Show vbModal
        
        txtOtherCharges.Text = toMoney(OtherCharges)
    End With
End Sub

Private Sub lblOtherCharges_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetHandCur True
    lblOtherCharges.FontUnderline = True
End Sub

Private Sub lblRatePerPeriod_Click()
    With frmRatePerPeriod
        .FolioNumber = txtGuestName.Tag
        
        .Show vbModal
        
        Call ComputeRate
    End With
End Sub

Private Sub lblRatePerPeriod_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetHandCur True
    lblRatePerPeriod.FontUnderline = True
End Sub

Private Sub txtAmountPaid_Change()
    txtBalance.Text = toMoney(toNumber(txtTotal.Text) - toNumber(txtAmountPaid.Text))
End Sub

Private Sub txtDays_Change()
On Error GoTo err
    
    Dim rsRatePerPeriod As New ADODB.Recordset
    Dim tmpDate As Date
    Dim minNoofPerson As Integer
    
    tmpDate = txtDateIn.Text
    
    If txtAdults.Tag = "" Then Exit Sub
    
    CN.BeginTrans
    
    CN.Execute "DELETE [Date] " & _
                "FROM [Rate Per Period] " & _
                "WHERE [Date]>#" & dtpDateOut - 1 & "#"

    Dim intAdults As Integer
    
    minNoofPerson = getValueAt("SELECT * FROM [Room Rates] WHERE RoomNumber = " & RoomNumber & " AND RateTypeID = " & dcRateType.BoundText, "NoofPerson")
    
    If txtAdults.Text = minNoofPerson Then
        intAdults = 0
    Else
        intAdults = CInt(txtAdults.Text) - minNoofPerson
    End If

    With rsRatePerPeriod
        .Open "SELECT * FROM [Rate Per Period] WHERE FolioNumber = '" & txtGuestName.Tag & "' ORDER BY [Date]", CN, adOpenStatic, adLockOptimistic

        Do Until tmpDate > dtpDateOut.Value - 1
            .Filter = "[Date] = #" & tmpDate & "#"
            
            If .RecordCount = 0 Then
                .AddNew
                
                .Fields("FolioNumber") = txtGuestName.Tag
                .Fields("Date") = tmpDate
                .Fields("RoomNumber") = txtRoomNumber.Text
                .Fields("RateTypeID") = dcRateType.BoundText
                .Fields("Rate") = txtRate.Text
                .Fields("Adults") = txtAdults.Tag * intAdults
                .Fields("Childrens") = toMoney(txtChildrens.Tag) * toNumber(txtChildrens.Text)
                
                .Update
            End If
            tmpDate = tmpDate + 1
        Loop
    End With
    
    CN.CommitTrans
    
    rsRatePerPeriod.Close

    Exit Sub

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