moddbuptable_open.bas

医院门诊医生工作站,vb6 SqlServer

'--           Fair ---->
'--           Rate ---->
'--           Coef ---->
'--           UpdateCondition  ----> 更新时指定的条件
'--     返回制：TRUE 成功
'--             FALSE 失败
'--     产生日期：2000年02月23日
'-----------------------------------------------------------------------
Public Function Update_Open_ReceiveSubSheet(ByVal UpdateFlag As DbOpType, _
                                          Optional RevSerial As String = "", _
                                          Optional recipeSerial As String = "", _
                                          Optional SheetID As String = "", _
                                          Optional CancelDate As String = "", _
                                          Optional CancelHdCode As String = "", _
                                          Optional UpdateCondition As String = "") As Boolean
    Dim StrSQL As String

    Set gDBFldsObj = New clsDBFields
    gDBFldsObj.TableName = "Open_ReceiveSubSheet"
    gDBFldsObj.UpdateCondition = UpdateCondition
    gDBFldsObj.Add "RevSerial", RevSerial, ""
    gDBFldsObj.Add "RecipeSerial", recipeSerial, ""
    gDBFldsObj.Add "SheetID", SheetID, ""
    gDBFldsObj.Add "CancelDate", CancelDate, ""
    gDBFldsObj.Add "Cancelhdcode", CancelHdCode, ""

    Select Case UpdateFlag
        Case HISDbInsert
            StrSQL = gDBFldsObj.MakeInsertSQL
        Case HISDBdelete
            StrSQL = gDBFldsObj.MakeDeleteSQL
        Case HISDBUpdate
            StrSQL = gDBFldsObj.MakeUpdateSQL
    End Select
    If Not gdbobj.DBExec(StrSQL) Then
        Update_Open_ReceiveSubSheet = False
    Else
        Update_Open_ReceiveSubSheet = True
    End If
    Set gDBFldsObj = Nothing
End Function

'-----------------------------------------------------------------------
'--     功能：插入、删除、更新表(Open_ActReceiveMain)
'--     参数：
'--           UpdateFlag  ----> 更新标志
'--           ActRevSerial ---->
'--           PatientID ---->
'--           RecentDate ---->
'--           HdCode ---->
'--           SheetID ---->
'--           PtID ---->
'--           UpdateCondition  ----> 更新时指定的条件
'--     返回制：TRUE 成功
'--             FALSE 失败
'--     产生日期：2000年02月23日
'-----------------------------------------------------------------------
Public Function Update_Open_ActReceiveMain(ByVal UpdateFlag As DbOpType, _
                                          Optional ActRevSerial As String = "", _
                                          Optional PatientID As String = "", _
                                          Optional RecentDate As String = "", _
                                          Optional hdCode As String = "", _
                                          Optional SheetID = "", _
                                          Optional UpdateCondition As String = "") As Boolean
    Dim StrSQL As String

    Set gDBFldsObj = New clsDBFields
    gDBFldsObj.TableName = "Open_ActReceiveMain"
    gDBFldsObj.UpdateCondition = UpdateCondition
    gDBFldsObj.Add "ActRevSerial", ActRevSerial, ""
    gDBFldsObj.Add "PatientID", PatientID, ""
    gDBFldsObj.Add "RecentDate", RecentDate, ""
    gDBFldsObj.Add "HdCode", hdCode, ""
    gDBFldsObj.Add "SheetID", SheetID, ""

    Select Case UpdateFlag
        Case HISDbInsert
            StrSQL = gDBFldsObj.MakeInsertSQL
        Case HISDBdelete
            StrSQL = gDBFldsObj.MakeDeleteSQL
        Case HISDBUpdate
            StrSQL = gDBFldsObj.MakeUpdateSQL
    End Select
    If Not gdbobj.DBExec(StrSQL) Then
        Update_Open_ActReceiveMain = False
    Else
        Update_Open_ActReceiveMain = True
    End If
    Set gDBFldsObj = Nothing
End Function
'-----------------------------------------------------------------------
'--     功能：插入、删除、更新表(Open_ActReceiveSub)
'--     参数：
'--           UpdateFlag  ----> 更新标志
'--           ActRevSerial ---->
'--           RecipeNum ---->
'--           DepCode ---->
'--           DcCode ---->
'--           DsCode ---->
'--           Fair ---->
'--           Rate ---->
'--           Status ---->
'--           RecentFetchDate ---->
'--           RecentFetchHdCode ---->
'--           UpdateCondition  ----> 更新时指定的条件
'--     返回制：TRUE 成功
'--             FALSE 失败
'--     产生日期：2000年02月23日
'-----------------------------------------------------------------------
Public Function Update_Open_ActReceiveSub(ByVal UpdateFlag As DbOpType, _
                                          Optional ActRevSerial As String = "", _
                                          Optional RecipeNum As Integer = -32767, _
                                          Optional DepCode As String = "", _
                                          Optional dccode = "", _
                                          Optional DsCode = "", _
                                          Optional fair As Currency = -0.001, _
                                          Optional rate As Double = -0.001, _
                                          Optional Status As Integer = -32767, _
                                          Optional RecentFetchDate = "", _
                                          Optional RecentFetchHdCode = "", _
                                          Optional PKCount As Integer = -32767, _
                                          Optional UpdateCondition As String = "") As Boolean
    Dim StrSQL As String

    Set gDBFldsObj = New clsDBFields
    gDBFldsObj.TableName = "Open_ActReceiveSub"
    gDBFldsObj.UpdateCondition = UpdateCondition
    gDBFldsObj.Add "ActRevSerial", ActRevSerial, ""
    gDBFldsObj.Add "RecipeNum", RecipeNum, -32767
    gDBFldsObj.Add "DepCode", DepCode, ""
    gDBFldsObj.Add "DcCode", dccode, ""
    gDBFldsObj.Add "DsCode", DsCode, ""
    gDBFldsObj.Add "Fair", fair, -0.001
    gDBFldsObj.Add "Rate", rate, -0.001
    gDBFldsObj.Add "Status", Status, -32767
    gDBFldsObj.Add "RecentFetchDate", RecentFetchDate, ""
    gDBFldsObj.Add "RecentFetchHdCode", RecentFetchHdCode, ""
    gDBFldsObj.Add "PKCount", PKCount, -32767

    Select Case UpdateFlag
        Case HISDbInsert
            StrSQL = gDBFldsObj.MakeInsertSQL
        Case HISDBdelete
            StrSQL = gDBFldsObj.MakeDeleteSQL
        Case HISDBUpdate
            StrSQL = gDBFldsObj.MakeUpdateSQL
    End Select
    If Not gdbobj.DBExec(StrSQL) Then
        Update_Open_ActReceiveSub = False
    Else
        Update_Open_ActReceiveSub = True
    End If
    Set gDBFldsObj = Nothing
End Function
'-----------------------------------------------------------------------
'--     功能：插入、删除、更新表(Open_ActReceiveSubItem)
'--     参数：
'--           UpdateFlag  ----> 更新标志
'--           ActRevSerial ---->
'--           RecipeNum ---->
'--           Num ---->
'--           ItemCode ---->
'--           Amount ---->
'--           FetchAmount ---->
'--           CPrice ---->
'--           Fair ---->
'--           FetchFair ---->
'--           Unit ---->
'--           Factor ---->
'--           RevDepCode ---->
'--           Flag ---->
'--           UpdateCondition  ----> 更新时指定的条件
'--     返回制：TRUE 成功
'--             FALSE 失败
'--     产生日期：2000年02月23日
'-----------------------------------------------------------------------
Public Function Update_Open_ActReceiveSubItem(ByVal UpdateFlag As DbOpType, _
                                          Optional ActRevSerial As String = "", _
                                          Optional RecipeNum As Integer = -32767, _
                                          Optional Num As Integer = -32767, _
                                          Optional ItemCode As String = "", _
                                          Optional amount As Integer = -32767, _
                                          Optional FetchAmount As Integer = -32767, _
                                          Optional cprice As Currency = -0.001, _
                                          Optional fair As Currency = -0.001, _
                                          Optional FetchFair As Currency = -0.001, _
                                          Optional unit = "", _
                                          Optional Factor As Integer = -32767, _
                                          Optional RevDepCode = "", _
                                          Optional Flag As Integer = -32767, _
                                          Optional batchid = "", _
                                          Optional Comment = "", _
                                          Optional UpdateCondition As String = "") As Boolean
    Dim StrSQL As String

    Set gDBFldsObj = New clsDBFields
    gDBFldsObj.TableName = "Open_ActReceiveSubItem"
    gDBFldsObj.UpdateCondition = UpdateCondition
    gDBFldsObj.Add "ActRevSerial", ActRevSerial, ""
    gDBFldsObj.Add "RecipeNum", RecipeNum, -32767
    gDBFldsObj.Add "Num", Num, -32767
    gDBFldsObj.Add "ItemCode", ItemCode, ""
    gDBFldsObj.Add "Amount", amount, -32767
    gDBFldsObj.Add "FetchAmount", FetchAmount, -32767
    gDBFldsObj.Add "CPrice", cprice, -0.001
    gDBFldsObj.Add "Fair", fair, -0.001
    gDBFldsObj.Add "FetchFair", FetchFair, -0.001
    gDBFldsObj.Add "Unit", unit, ""
    gDBFldsObj.Add "Factor", Factor, -32767
    gDBFldsObj.Add "RevDepCode", RevDepCode, ""
    gDBFldsObj.Add "Flag", Flag, -32767
    gDBFldsObj.Add "Batchid", batchid, ""
    gDBFldsObj.Add "Comment", Comment, ""

    Select Case UpdateFlag
        Case HISDbInsert
            StrSQL = gDBFldsObj.MakeInsertSQL
        Case HISDBdelete
            StrSQL = gDBFldsObj.MakeDeleteSQL
        Case HISDBUpdate
            StrSQL = gDBFldsObj.MakeUpdateSQL
    End Select
    If Not gdbobj.DBExec(StrSQL) Then
        Update_Open_ActReceiveSubItem = False
    Else
        Update_Open_ActReceiveSubItem = True
    End If
    Set gDBFldsObj = Nothing
End Function
'-----------------------------------------------------------------------
'--     功能：插入、删除、更新表(Open_m_Group)
'--     参数：
'--           UpdateFlag  ----> 更新标志
'--           GroupID ---->
'--           GroupName ---->
'--           Brief ---->
'--           Status ---->
'--           UpdateCondition  ----> 更新时指定的条件
'--     返回制：TRUE 成功
'--             FALSE 失败
'--     产生日期：2000年05月15日
'-----------------------------------------------------------------------
Public Function Update_Open_m_Group(ByVal UpdateFlag As DbOpType, _
                                          Optional GroupID As String = "", _
                                          Optional GroupName As String = "", _
                                          Optional Brief As String = "", _
                                          Optional Status As Integer = -32767, _
                                          Optional UpdateCondition As String = "") As Boolean
    Dim StrSQL As String

    Set gDBFldsObj = New clsDBFields
    gDBFldsObj.TableName = "Open_m_Group"
    gDBFldsObj.UpdateCondition = UpdateCondition
    gDBFldsObj.Add "GroupID", GroupID, ""
    gDBFldsObj.Add "GroupName", GroupName, ""
    gDBFldsObj.Add "Brief", Brief, ""
    gDBFldsObj.Add "Status", Status, -32767

    Select Case UpdateFlag
        Case HISDbInsert
            StrSQL = gDBFldsObj.MakeInsertSQL
        Case HISDBdelete
            StrSQL = gDBFldsObj.MakeDeleteSQL
        Case HISDBUpdate
            StrSQL = gDBFldsObj.MakeUpdateSQL
    End Select
    If Not gdbobj.DBExec(StrSQL) Then
        Update_Open_m_Group = False
    Else
        Update_Open_m_Group = True
    End If
    Set gDBFldsObj = Nothing
End Function
'-----------------------------------------------------------------------
'--     功能：插入、删除、更新表(Open_m_GroupItem)
'--     参数：
'--           UpdateFlag  ----> 更新标志
'--           GroupID ---->
'--           ItemCode ---->
'--           DepCode ---->
'--           Amount ---->
'--           Factor ---->
'--           Status ---->
'--           Unit ---->
'--           UpdateCondition  ----> 更新时指定的条件
'--     返回制：TRUE 成功
'--             FALSE 失败
'--     产生日期：2000年05月15日
'-----------------------------------------------------------------------
Public Function Update_Open_m_GroupItem(ByVal UpdateFlag As DbOpType, _
                                          Optional GroupID As String = "", _
                                          Optional ItemCode As String = "", _
                                          Optional DepCode = "", _
                                          Optional amount As Double = -0.001, _
                                          Optional Factor As Integer = -32767, _
                                          Optional Status As Integer = -32767, _
                                          Optional unit As String = "", _
                                          Optional UpdateCondition As String = "") As Boolean
    Dim StrSQL As String

    Set gDBFldsObj = New clsDBFields
    gDBFldsObj.TableName = "Open_m_GroupItem"
    gDBFldsObj.UpdateCondition = UpdateCondition
    gDBFldsObj.Add "GroupID", GroupID, ""
    gDBFldsObj.Add "ItemCode", ItemCode, ""
    gDBFldsObj.Add "DepCode", DepCode, ""
    gDBFldsObj.Add "Amount", amount, -0.001
    gDBFldsObj.Add "Factor", Factor, -32767
    gDBFldsObj.Add "Status", Status, -32767
    gDBFldsObj.Add "Unit", unit, ""

    Select Case UpdateFlag
        Case HISDbInsert
            StrSQL = gDBFldsObj.MakeInsertSQL
        Case HISDBdelete
            StrSQL = gDBFldsObj.MakeDeleteSQL
        Case HISDBUpdate
            StrSQL = gDBFldsObj.MakeUpdateSQL
    End Select
    If Not gdbobj.DBExec(StrSQL) Then
        Update_Open_m_GroupItem = False
    Else
        Update_Open_m_GroupItem = True
    End If
    Set gDBFldsObj = Nothing
End Function