bos_qmchybill.cls

金蝶地磅称重插件

            m_BillInterface.SetFieldValue "FValue_Xx", rs!flowerlimitqty, i             '设置“标准下限”字段的值
            m_BillInterface.SetFieldValue "FValue_Sx", rs!fupperlimitqty, i             '设置“标准上限”字段的值

            Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_Xx", "", 0)             '取得当前“标准下限”字段的Dictionary对象
            m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“标准下限”当前行的数据精度值

            Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_Sx", "", 0)             '取得当前“标准上限”字段的Dictionary对象
            m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“标准上限”当前行的数据精度值

            Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_hx", "", 0)             '取得当前“检验值”字段的Dictionary对象
            m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“检验值”当前行的数据精度值

            If i < rs.RecordCount Then
                m_BillInterface.BillEntrys(1).BOSFields(4).Row = i + 1                  '当前行设置为下一行
                m_BillInterface.InsertNewRowAndFill 2, i + 1               '插入一个新行
            End If
            rs.MoveNext                                                                 '结果集向下移动
            i = i + 1                                                                   '当前行变量加1
       Wend
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_beforesave(ByRef bCancel As Boolean)
    ''单据保存之前
    On Error GoTo Errhandle1
    ''如果单据没有选择检斤单，则只能选择其他质检
    If m_BillInterface.GetFieldValue("FBillNo_Yd") = "" And m_BillInterface.GetFieldValue("FQmStyle", 1) <> "9" Then
       MsgBox "如果没有选择检斤单，检验类型只能为'其他质检'", , "金蝶提示"
       bCancel = True
       Exit Sub
    End If
    
    ''判断所选检斤单是否已被其他用户选取
    If Trim(m_BillInterface.GetFieldValue("FBillNo_Yd")) <> "" And m_BillInterface.BillStatus = Enu_BillStatusExt_New Then
        ''如果为收料检验则更新保密单
        If m_BillInterface.GetFieldValue("FBillNO_Yd") <> "" And (m_BillInterface.GetFieldValue("FQmStyle") = "2" Or m_BillInterface.GetFieldValue("FQmStyle") = "4" Or m_BillInterface.GetFieldValue("FQmStyle") = "7" Or m_BillInterface.GetFieldValue("FQmStyle") = "8" Or m_BillInterface.GetFieldValue("FQmStyle") = "9") Then
            Set rs = m_BillInterface.K3Lib.GetData("select count(*) as Rowc from t_ST_QM_Bmd where fstatus=1 and  finterid in (" & m_BillInterface.GetFieldValue("FBillNo_Yd") & ")")
            If rs!rowc > 0 Then
               MsgBox "所选保密单被其它单据引用，请重新进行选择！", , "金蝶提示"
               bCancel = True
               Exit Sub
            End If
        End If
        
        ''如果为其它检验则更新物理检验单（没有上游单据的除外）
        If m_BillInterface.GetFieldValue("FBillNO_Yd") <> "" And (m_BillInterface.GetFieldValue("FQmStyle") = "3" Or m_BillInterface.GetFieldValue("FQmStyle") = "5" Or m_BillInterface.GetFieldValue("FQmStyle") = "6") Then
            Set rs = m_BillInterface.K3Lib.GetData("select count(*) as Rowc from t_ST_QM_WLD where fstatus=2 and  finterid in (" & m_BillInterface.GetFieldValue("FBillNo_Yd") & ")")
            If rs!rowc > 0 Then
               MsgBox "所选物理检验单已被其它单据引用，请重新进行选择！", , "金蝶提示"
               bCancel = True
               Exit Sub
            End If
        End If
    End If
    
    ''取服务器日期时间
    Set rs = m_BillInterface.K3Lib.GetData("select getdate()")
    m_BillInterface.SetFieldValue "FBillDate", rs.Fields(0)              '单据日期为服务器时间
    Exit Sub
    
Errhandle1:
    MsgBox err.Description, vbCritical, "金蝶提示"
    bCancel = True
End Sub

Private Sub m_BillInterface_AfterSave(ByRef bCancel As Boolean)
   ''单据保存之后触发
    On Error GoTo Errhandle2
   ''如果为收料检验则更新保密单单据状态，收样人和收样日期
   If m_BillInterface.GetFieldValue("FBillNO_Yd") <> "" And (m_BillInterface.GetFieldValue("FQmStyle") = "2" Or m_BillInterface.GetFieldValue("FQmStyle") = "4" Or m_BillInterface.GetFieldValue("FQmStyle") = "7" Or m_BillInterface.GetFieldValue("FQmStyle") = "8" Or m_BillInterface.GetFieldValue("FQmStyle") = "9") Then
      m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Bmd set fstatus=1,fsyr1='" & m_BillInterface.GetFieldValue("FSyr") & "',fsydate1='" & m_BillInterface.GetFieldValue("Fsydate") & "' where finterid=" & m_BillInterface.GetFieldValue("FBillNo_Yd")
   End If
   
   ''如果为其它检验则更新物理检验单（没有上游单据的除外）,更新单据状态为2
   If m_BillInterface.GetFieldValue("FBillNO_Yd") <> "" And (m_BillInterface.GetFieldValue("FQmStyle") = "3" Or m_BillInterface.GetFieldValue("FQmStyle") = "5" Or m_BillInterface.GetFieldValue("FQmStyle") = "6") Then
      m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set fstatus=2 where finterid=" & m_BillInterface.GetFieldValue("FBillNo_Yd")
   End If
    Exit Sub
Errhandle2:
    MsgBox err.Description, vbCritical, "金蝶提示"
    bCancel = True
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
    ''选单之后触发
    On Error GoTo Errhandle
    Dim Dic_SelectTemp As KFO.Dictionary
    Set Dic_SelectTemp = Vector_SelectBill(1)
    m_BillInterface.SetFieldValue "FBillNo_Yd", Dic_SelectTemp.GetValue("FInterid") & ""                '回写原单号
    
    
    '''20050827修改，如果检验类型为“收料检验”质检方案通过保密单查找，否则直接从物理检验单中查找
    '''----------------------------------------------------------------------------------------------
    If lSelBillType = 110001311 Then    ''如果为保密单
       Set rs = m_BillInterface.K3Lib.GetData("select t4.FinterID,t4.fbillNo,t3.FQmStyle from t_ST_QM_Bmd t2 left join t_ST_QM_WLD t3 on t3.Finterid=t2.fbillno_yd left join icqcscheme t4 on t4.finterid=t3.FSCBillInterId where t2.finterid=" & Val(Dic_SelectTemp.GetValue("FInterid")))
    End If
    If lSelBillType = 110001304 Then    ''如果为物理检验单
       Set rs = m_BillInterface.K3Lib.GetData("select t4.FinterID,t4.fbillNo,t3.FQmStyle from t_ST_QM_WLD t3 left join icqcscheme t4 on t4.finterid=t3.FSCBillInterId where t3.finterid=" & Val(Dic_SelectTemp.GetValue("FInterid")))
    End If
    '''----------------------------------------------------------------------------------------------
    
    If rs.RecordCount > 0 Then
         'm_BillInterface.SetFieldValue "FSCBillInterId", Val(rs!FBillNO)                   ''质检方案赋值
         m_BillInterface.SetFieldValue "FQmStyle", rs!Fqmstyle & ""                  ''检验类型赋值
         Dim SQl_temp As String             '查询字符串变量
         Dim i As Long                      '当前行变量
         Dim F_D As Dictionary              'kfo.dictionary对象变量
         '取质检方案详细内容
         SQl_temp = "select t3.fid,t3.fnumber,t2.fqcunit,t2.flowerlimitqty,t2.fupperlimitqty,t3.fqtydecimal from icqcscheme t1 left join icqcschemeentry t2 on t1.finterid=t2.finterid left join QMCheckItem t3 on t2.fqcitemid=t3.fid inner join QMAInfo t4 on t3.Fqcmethodid=t4.fid and t4.FName='化学检验' where t1.fInterid=" & Val(m_BillInterface.GetFieldValue("FSCBillInterId"))
         Set rs = m_BillInterface.K3Lib.GetData(SQl_temp)
         
         i = 1                              '当前行变量初值为1
         
         '清空单据体数据，该句必须存在
         'm_BillInterface.DeleteEntryData 2
         
        ''根据“原单编号”是否为空来锁定字段
        ''------------------------------------------------------------------------------------------------------
        If m_BillInterface.GetFieldValue("FBillNo_Yd") <> "" Then
           m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = True         '质检方案
           m_BillInterface.BillHeads(1).BOSFields.Item("FBmNum").FieldLock = True           '保密编号
           m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = True       '物料
        Else
           m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = False        '质检方案
           m_BillInterface.BillHeads(1).BOSFields.Item("FBmNum").FieldLock = False          '保密编号
           m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = False      '物料
        End If
        ''------------------------------------------------------------------------------------------------------
         
         BillEntryRows = 0                                                          '单据体行数变量清为0
         If rs.RecordCount > 0 Then
            BillEntryRows = rs.RecordCount                                          '单据体行数变量账值
         End If
         
         If BillEntryRows = 0 Then
            m_BillInterface.SetFieldValue "FSCBillInterId", ""                      '单据体行数变量账值
         End If
         
         '开始填充数据
         While Not rs.EOF
              m_BillInterface.SetFieldValue "FId", rs!FID, i                          '设置“检验项目编号”字段的值
              m_BillInterface.SetFieldValue "FValue_Xx", rs!flowerlimitqty, i             '设置“标准下限”字段的值
              m_BillInterface.SetFieldValue "FValue_Sx", rs!fupperlimitqty, i             '设置“标准上限”字段的值
         
              Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_Xx", "", 0)             '取得当前“标准下限”字段的Dictionary对象
              m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“标准下限”当前行的数据精度值
         
              Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_Sx", "", 0)             '取得当前“标准上限”字段的Dictionary对象
              m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“标准上限”当前行的数据精度值
         
              Set F_D = m_BillInterface.GetFieldInfoByKey("Fvalue_Wl", "", 0)             '取得当前“检验值”字段的Dictionary对象
              m_BillInterface.SetDecimal F_D, i, CLng(rs!fqtydecimal)                     '设置“检验值”当前行的数据精度值
         
              If i < rs.RecordCount Then
                  m_BillInterface.BillEntrys(1).BOSFields(4).Row = i + 1                  '当前行设置为下一行
                  m_BillInterface.InsertNewRowAndFill 2, i + 1               '插入一个新行
              End If
              rs.MoveNext                                                                 '结果集向下移动
              i = i + 1                                                                   '当前行变量加1
         Wend
    End If
    
    ''根据“原单编号”是否为来锁定字段
    '''----------------------------------------------------------------------------------------------
    m_BillInterface.BillHeads(1).BOSFields.Item("FQmStyle").FieldLock = True                '质检方案
    m_BillInterface.BillHeads(1).BOSFields.Item("FBmNum").FieldLock = True                  '保密编号
    m_BillInterface.BillHeads(1).BOSFields.Item("FItemId_Ic").FieldLock = True              '物料
    '''----------------------------------------------------------------------------------------------
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_AfterMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, ByVal Success As Boolean)
    ''审核时后触发
    On Error GoTo Errhandle
    If lCheckMode = 0 And lBusinessLevel = lCheckMaxLevel And lCheckLevel = lCheckMaxLevel And lCheckStatus = GetCheckLevel(lCheckMaxLevel) Then
       Dim Wl_Index As Long
       
       ''如果为收料检验(2),委外入库（4），运输协议(7),委外出库（8），其他检验(9),通过保密单更新物理检验单化学员、化验领导
       If m_BillInterface.GetFieldValue("FBillNO_Yd") <> "" And (m_BillInterface.GetFieldValue("FQmStyle") = "2" Or m_BillInterface.GetFieldValue("FQmStyle") = "4" Or m_BillInterface.GetFieldValue("FQmStyle") = "7" Or m_BillInterface.GetFieldValue("FQmStyle") = "8" Or m_BillInterface.GetFieldValue("FQmStyle") = "9") Then
            Set rs = m_BillInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.fbillerid,t1.fcheckid,t2.FBillNo_yd,t1.FQualityerId from t_ST_QM_Hxd t1 left join t_ST_QM_Bmd t2 on t1.FBillNo_yd=t2.FInterId where t1.fInterId=" & m_BillInterface.CurBillID)
            If rs.RecordCount > 0 Then
                If rs!Fstatus = 0 Then
                    m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set FchBillerid=" & rs!FQualityerId & ",fchcheckid=" & rs!fcheckid & " where finterid=" & rs!Fbillno_yd
                End If
            End If
       End If
       
       ''如果为调拔检斤（3），工艺检斤（5），成品入库检斤（6），直接更新物理检验单化学员、化验领导
       If m_BillInterface.GetFieldValue("FBillNO_Yd") <> "" And (m_BillInterface.GetFieldValue("FQmStyle") = "3" Or m_BillInterface.GetFieldValue("FQmStyle") = "5" Or m_BillInterface.GetFieldValue("FQmStyle") = "6") Then
            Set rs = m_BillInterface.K3Lib.GetData("select t1.FResult,t1.Fstatus,t1.fbillerid,t1.fcheckid,t1.FBillNo_yd,t1.FQualityerId from t_ST_QM_Hxd t1 where t1.fInterId=" & m_BillInterface.CurBillID)
            If rs.RecordCount > 0 Then
                If rs!Fstatus = 0 Then
                    m_BillInterface.K3Lib.UpdateData "update t_ST_QM_Hxd set fstatus=2 where finterid=" & Val(m_BillInterface.CurBillID)
                    m_BillInterface.K3Lib.UpdateData "update t_ST_QM_WLD set FchBillerid=" & rs!FQualityerId & ",fchcheckid=" & rs!fcheckid & " where finterid=" & rs!Fbillno_yd