pub_ct.bas

该系统为酒店日常管理提供了很大的方便

        lbk_rec.MoveLast
    End If
    If lbk_rec!YHQ <> 0 Then
       Call CT_YHQ("回收", lbk_rec!YHQ)
    End If
    If lbk_rec!MFCK <> 0 Then
        PUB_data.Execute ""
        PUB_data.Execute "INSERT INTO DT_LSZCKGD IN '" & Trim(SYS_LOCALBASE) & "' SELECT * FROM ZC" & year(kzgd1_yjsr) & " WHERE FSRQ=#" & kzgd1_yjsr & "# AND INSTR(TRIM(BZ),'" & Trim(kzgd1_yzdh) & "')<>0"
        LOCAL_data.Execute "UPDATE DT_LSZCKGD SET FSRQ=#" & kzgd1_jsrq & "#, BZ='" & Trim(kzgd1_czh) & "', CZY='" & SYS_USER & "', ZCK_HSSL=-ZCK_HSSL"
        
        PUB_data.Execute "INSERT INTO ZC" & year(kzgd1_jsrq) & " SELECT * FROM DT_LSZCKGD IN '" & Trim(SYS_LOCALBASE) & "'"
    
        LOCAL_data.Execute "DELETE FROM DT_LSZCKBZ"
    End If
    
    lbk_rec.Close
    
    LOCAL_data.Execute "UPDATE " & Trim(kzgd1_lbk) & " SET JSRQ=#" & kzgd1_jsrq & "#, JSSJ='" & Trim(kzgd1_jssj) & "', GWDM='" & SYS_GWDM & "', ZDH='" & Trim(kzgd1_czh) & "', JS_MC='" & Trim(kzgd1_yjsmc) & "', FK_MC='" & Trim(kzgd1_yfkmc) & "', DFZH='" & Trim(kzgd1_dfzh) & "', JH_FT='0', JS_FS='" & Trim(kzgd1_r2) & "', FK_FS='" & Trim(kzgd1_r5) & "', BZN='" & Trim(kzgd1_bz) & "', CZBJ='" & Trim(kzgd1_czbj) & "'"
    PUB_data.Execute "INSERT INTO " & Trim(kzgd1_yyk) & " SELECT * FROM " & Trim(kzgd1_lbk) & " IN '" & Trim(SYS_LOCALBASE) & "'"
    
    LOCAL_data.Execute "DELETE FROM " & Trim(kzgd1_lbk)
    LOCAL_data.Execute "DELETE FROM " & Trim(kzgd1_lsk)
    
End Sub



'**************************************************************************************************
'*  功    能 : 本功能为餐饮分类参数库建立时增加该库记录的子程序
'*  作    者 : 梁卫
'*  作成日期 : 1999.05.04
'*  修改日期 : 1999.05.04
'*  参数说明 : zjcs_xmmc  --  项目名称
'*             zjcs_je    --  金额
'*             zjcs_dfzh  --  对方帐号
'*             zjcs_pzh   --  凭证号
'*             zjcs_fl    --  分类表名称
'*             zjcs_yyxm  --  营业表名称
'*             zjcs_fsrq  --  发生日期
'*             zjcs_czbj  --  冲正标记
'**************************************************************************************************
Public Sub CT_ZJCS(zjcs_xmmc As String, zjcs_je As Double, zjcs_dfzh As String, zjcs_pzh As String, zjcs_fl As String, zjcs_yyxm As String, zjcs_fsrq As Date, zjcs_czbj As String)
    
    Dim yyxma_rec As Recordset
    Dim flz_rec As Recordset
    
    
    Set yyxma_rec = PUB_data.OpenRecordset("SELECT LBDMA FROM " & Trim(zjcs_yyxm) & " WHERE TRIM(LBDM_MC)='" & Trim(zjcs_xmmc) & "' AND TRIM(GWDM)='" & SYS_GWDM & "'", 4, 0, 2)
    If Not yyxma_rec.BOF Then
        yyxma_rec.MoveLast
        
        Set flz_rec = PUB_data.OpenRecordset("", 2, 0, 2)
        If Not flz_rec.BOF Then
            flz_rec.MoveLast
        End If
        
        flz_rec.AddNew
            flz_rec!GWDM = SYS_GWDM
            flz_rec!FSRQ = zjcs_fsrq
            flz_rec!ZH = Trim(zjcs_dfzh)
            flz_rec!LBDMA = yyxma_rec!LBDMA
            flz_rec!LBMC_ZW = Trim(zjcs_xmmc)
            flz_rec!XFJE = zjcs_je
            flz_rec!SJJE = zjcs_je
            flz_rec!ZKL = 1
            flz_rec!BZ = "*"
            flz_rec!CZY = SYS_USER
            flz_rec!PZH = Trim(zjcs_pzh)
            flz_rec!czbj = Trim(zjcs_czbj)
            flz_rec!JS_FT = "0"
            flz_rec!LOCK_NO = 0
            flz_rec!YZH = "*"
        flz_rec.Update
        
        flz_rec.Close
    Else
        Call MsgBox("营业项目表异常出错!", vbCritical + vbOKOnly)
        Exit Sub
    End If
    yyxma_rec.Close
    
End Sub


'**************************************************************************************************
'*  功    能 : 本功能用于餐饮部门客帐结算时形成餐饮部门的消费参数库
'*  作    者 : 梁卫
'*  作成日期 : 1999.05.04
'*  修改日期 : 1999.05.04
'*  参数说明 : flcs_hzk   --  项目名称
'*             flcs_dfzh  --  对方帐号
'*             flcs_pzh   --  凭证号
'*             flcs_yyxm  --  营业表名称
'*             flcs_fwje  --  服务金额
'*             flcs_mfje1 --  免费早餐卡
'*             flcs_mfje2 --  优惠券
'*             flcs_fsrq  --  日期
'*             flcs_czbj  --  冲正标记
'**************************************************************************************************
Public Sub CT_FLCS(flcs_hzk As String, flcs_dfzh As String, flcs_pzh As String, flcs_yyxm As String, flcs_fwje As Double, flcs_mfje1 As Double, flcs_mfje2 As Double, flcs_fsrq As Date, flcs_czbj As String)

    Dim flz_rec As Recordset
    Dim hzk_rec As Recordset
    
    Set hzk_rec = LOCAL_data.OpenRecordset("SELECT * FROM " & Trim(flcs_hzk), 2, 0, 2)
    If Not hzk_rec.BOF Then
        hzk_rec.MoveLast
        hzk_rec.MoveFirst
    End If
    
    Set flz_rec = PUB_data.OpenRecordset("SELECT * FROM CT" & Trim(flcs_dfzh), 2, 0, 2)
    If Not flz_rec.BOF Then
        flz_rec.MoveLast
    End If
    
    Do While Not hzk_rec.EOF
    
        flz_rec.AddNew
            flz_rec!GWDM = SYS_GWDM
            flz_rec!FSRQ = flcs_fsrq
            flz_rec!ZH = Trim(flcs_dfzh)
            flz_rec!LBDMA = hzk_rec!LBDMA
            flz_rec!LBMC_ZW = hzk_rec!LBMC_ZW
            flz_rec!XFJE = hzk_rec!XFJE
            flz_rec!SJJE = hzk_rec!SJJE
            flz_rec!ZKL = hzk_rec!ZKL
            flz_rec!BZ = "*"
            flz_rec!CZY = SYS_USER
            flz_rec!PZH = Trim(flcs_pzh)
            flz_rec!czbj = Trim(flcs_czbj)
            flz_rec!JS_FT = "0"
            flz_rec!LOCK_NO = 0
            flz_rec!YZH = "*"
        flz_rec.Update
        
        hzk_rec.MoveNext
    Loop
    
    flz_rec.Close
    hzk_rec.Close
    
    Dim temp_lbmc_zw As String
    
    If flcs_fwje > 0 Then
        temp_lbmc_zw = "服务费"
        Call CT_ZJCS(temp_lbmc_zw, flcs_fwje, flcs_dfzh, flcs_pzh, "CT" & Trim(flcs_dfzh), "YYXMA", flcs_fsrq, flcs_czbj)
    End If
    
    If flcs_fwje > 0 Then
        temp_lbmc_zw = "免费早餐卡"
        Call CT_ZJCS(temp_lbmc_zw, 0 - flcs_mfje1, flcs_dfzh, flcs_pzh, "CT" & Trim(flcs_dfzh), "YYXMA", flcs_fsrq, flcs_czbj)
    End If
    
    If flcs_fwje > 0 Then
        temp_lbmc_zw = "优惠券"
        Call CT_ZJCS(temp_lbmc_zw, 0 - flcs_mfje2, flcs_dfzh, flcs_pzh, "CT" & Trim(flcs_dfzh), "YYXMA", flcs_fsrq, flcs_czbj)
    End If

End Sub


'**************************************************************************************************
'*  功    能 : 客账登记
'*  作    者 : 梁卫
'*  作成日期 : 1999.05.05
'*  修改日期 : 1999.05.05
'*  参数说明 : kzdj_jsdm  --  结算代码
'*             dj_xfxm    --  消费项目名称
'*             kzdj_zh    --  帐号
'*             kzdj_fsrq  --  发生日期
'*             dj_xfje    --  消费金额
'*             kzdj_pzh   --  凭证号
'*             kzdj_bz    --  备注
'*             dj_k1      --  帐首库名
'*             dj_czbj    --  冲正标记
'*             dj_spr     --  审批人
'*             kzdj_zkl   --  折扣率
'**************************************************************************************************
Public Function ZW_KZDJ(kzdj_jsdm As String, dj_xfxm As String, kzdj_zh As String, kzdj_fsrq As Date, dj_xfje As Double, kzdj_pzh As String, kzdj_bz As String, dj_k1 As String, dj_czbj As String, dj_spr As String, kzdj_zkl As Single) As Boolean

    Dim dj_jffse As Double
    Dim dj_dffse As Double
    
    Dim dj_yef As String        '余额方
    Dim dj_xfxh As String       '消费项目序号
        
        
    dj_yef = "1"
    Call zw_r3(dj_xfxm, dj_yef, dj_xfxh)
    
    ZW_KZDJ = False
    
    If Not Trim(dj_xfxh) = "" Then
            
        Dim kzdj_r4 As String
        
        kzdj_r4 = Mid(Trim(kzdj_jsdm), 5, 1)    '获取结算代码的 第 4 位
       
        If (Trim(kzdj_r4) = "1" And Trim(dj_yef) <> "2") Or (Trim(kzdj_r4) = "2" And Trim(dj_yef) = "2") Then
            '&& 收款-借方                        退款-贷方
            dj_jffse = dj_xfje
            dj_dffse = 0
        End If
       
        If (Trim(kzdj_r4) = "2" And Trim(dj_yef) <> "2") Or (Trim(kzdj_r4) = "1" And Trim(dj_yef) = "2") Then
            '&& 退款-借方                        收款-贷方
            dj_jffse = 0
            dj_dffse = dj_xfje
        End If
       
        dj_k1 = UCase(dj_k1)
    
        Dim zsk_rec As Recordset
        
        Set zsk_rec = PUB_data.OpenRecordset("SELECT * FROM " & Trim(dj_k1) & " WHERE TRIM(ZH)='" & Trim(kzdj_zh) & "'", 2, 0, 2)
        If Not zsk_rec.BOF Then
            zsk_rec.MoveLast
        
            Dim temp_lockno As Integer
            
            Do
                temp_lockno = Pub_lock("PUBLIC", Trim(dj_k1), zsk_rec)
            Loop Until temp_lockno <> 0
            
            zsk_rec.Edit
                If Trim(dj_yef) = "2" Then
                    zsk_rec!KR_DJ = zsk_rec!KR_DJ + (dj_dffse - dj_jffse)
                Else
                    zsk_rec!ZXFE = zsk_rec!ZXFE + (dj_jffse - dj_dffse)
                End If
                
                If Trim(dj_yef) = "2" Then
                    zsk_rec!YE = zsk_rec!ZXFE - (zsk_rec!KR_DJ + (dj_dffse - dj_jffse))
                Else
                    zsk_rec!YE = zsk_rec!ZXFE + (dj_jffse - dj_dffse) - zsk_rec!KR_DJ
                End If
                
            zsk_rec.Update
            Call Pub_UNlock(Trim(dj_k1), zsk_rec)
            
            Dim zyk_rec As Recordset
            Set zyk_rec = PUB_data.OpenRecordset("SELECT * FROM W" & Trim(kzdj_zh), 2, 0, 2)
            If Not zyk_rec.BOF Then
                zyk_rec.MoveLast
            End If
            
            zyk_rec.AddNew
                zyk_rec!FSRQ = kzdj_fsrq
                zyk_rec!FSSJ = Time
                zyk_rec!ZH = Trim(kzdj_zh)
                zyk_rec!ZY = Trim(dj_xfxm)
                zyk_rec!PZH = Trim(kzdj_pzh)
                zyk_rec!JFFSE = dj_jffse
                zyk_rec!DFFSE = dj_dffse
                zyk_rec!zdh = "*"
                zyk_rec!ZKL = kzdj_zkl
                zyk_rec!SPR = Trim(dj_spr)
                zyk_rec!yef = Trim(dj_yef)
                zyk_rec!jzy = SYS_USER
                zyk_rec!JS_FT = "0"
                zyk_rec!czbj = Trim(dj_czbj)
                zyk_rec!YZH = "*"
                zyk_rec!BZ = Trim(kzdj_bz)
                zyk_rec!CLRQ = Null
                zyk_rec!CLYDM = "*"
                zyk_rec!LOCK_NO = 0
                
                If Trim(dj_xfxm) = "转帐" Then
                    zyk_rec!ZZBJ = "1"
                End If
            zyk_rec.Update
            
            zyk_rec.Close
            ZW_KZDJ = True
        
        Else
          
            Call MsgBox("在" + dj_k1 + "中, 没有找到帐号: " + kzdj_zh + ", 请停止操作, 并通知微机室 !!")
            ZW_KZDJ = False
        
        End If
        zsk_rec.Close
        
    End If

End Function

'**************************************************************************************************
'*  功    能 : 餐饮支票信用卡登记
'*  作    者 : 梁卫
'*  作成日期 : 1999.05.05
'*  修改日期 : 1999.05.05
'*  参数说明 : zpdj_jsdm  --  结算代码
'*             zpdj_fkmc  --  付款名称
'*             zpdj_ye    --  余额
'*             zpdj_ye1   --  余额1
'*             zpdj_zdh   --  帐单号
'*             zpdj_zh    --  帐号
'*             zpdj_zy    --  摘要
'*             zpdj_rq    --  发生日期
'**************************************************************************************************
Public Sub ZW_ZPDJ(zpdj_jsdm, zpdj_fkmc, zpdj_ye, zpdj_ye1, zpdj_zdh, zpdj_zh, zpdj_zy, zpdj_rq)