frmmonthfoot.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{AA0D501B-0C16-11D4-8531-00E098160F52}#4.0#0"; "COMNBUTTONS.OCX"
Begin VB.Form frmMonthFoot 
   Caption         =   "月末结帐"
   ClientHeight    =   2235
   ClientLeft      =   2205
   ClientTop       =   1530
   ClientWidth     =   5820
   Icon            =   "frmMonthFoot.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2235
   ScaleWidth      =   5820
   Begin ComnButtons.ButtonGroup btg 
      Height          =   1725
      Left            =   4620
      TabIndex        =   7
      Top             =   120
      Width           =   1245
      _ExtentX        =   2196
      _ExtentY        =   3043
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   -2147483638
      ButtonCount     =   3
      ButtonCaption   =   "&A.结帐	&C.取消	&E.关闭"
      KeyEnabled      =   "1#1#1#"
   End
   Begin VB.Frame Frame1 
      Height          =   2025
      Left            =   30
      TabIndex        =   0
      Top             =   60
      Width           =   4575
      Begin MSComCtl2.DTPicker DTPDate 
         Height          =   345
         Left            =   1020
         TabIndex        =   1
         Top             =   300
         Width           =   1905
         _ExtentX        =   3360
         _ExtentY        =   609
         _Version        =   393216
         Format          =   24641536
         CurrentDate     =   37151
      End
      Begin VB.Label lblHD 
         Caption         =   "lblHD"
         ForeColor       =   &H00C00000&
         Height          =   285
         Left            =   1020
         TabIndex        =   6
         Top             =   1410
         Width           =   1305
      End
      Begin VB.Label Label3 
         Caption         =   "操 作 员"
         Height          =   285
         Left            =   180
         TabIndex        =   5
         Top             =   1410
         Width           =   855
      End
      Begin VB.Label lblDep 
         Caption         =   "lblDep"
         ForeColor       =   &H00C00000&
         Height          =   285
         Left            =   1020
         TabIndex        =   4
         Top             =   930
         Width           =   1305
      End
      Begin VB.Label Label2 
         Caption         =   "药    房"
         Height          =   285
         Left            =   180
         TabIndex        =   3
         Top             =   930
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "结帐日期"
         Height          =   285
         Left            =   180
         TabIndex        =   2
         Top             =   390
         Width           =   855
      End
   End
End
Attribute VB_Name = "frmMonthFoot"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub MFoot()
    Dim FootYM As String
    Dim FootYM1 As String
    Dim SQL As String
    FootYM = Format(DTPDate.Value, "yyyymm")
    FootYM1 = Format(DTPDate.Value + 31, "yyyymm")
    SQL = "insert house_MonthFoot " _
        & "select '" & gtydSysConfig.DepCode & "','" & FootYM1 & "',house_DrugBus.ItemCode,m_Drug.Gprice,m_Drug.Cprice," _
        & "COALESCE(House_MonthFoot.amount,0)+COALESCE(House.amount,0)," _
        & "COALESCE(House_MonthFoot.Gmoney,0)+COALESCE(House.Gmoney,0)," _
        & "COALESCE(House_MonthFoot.Cmoney,0)+COALESCE(House.Cmoney,0) " _
        & "From house_drugBus " _
        & "LEft join house_MonthFoot on house_MonthFoot.ItemCode=house_DrugBus.itemcode " _
        & "                             and house_MonthFoot.dscode='" & gtydSysConfig.DepCode & "' and FootMonth='" & FootYM & "' " _
        & "Left Join (select ItemCode,sum(amount*direct) as amount,sum(gmoney*direct) as gmoney," _
        & "           sum(cmoney*direct) as cmoney from house_BusSub " _
        & "           inner join house_BusMain on house_Busmain.busserial=House_BusSub.Busserial " _
        & "           Where FootMonth='" & FootYM & "' and dsCode='" & gtydSysConfig.DepCode & "' " _
        & "           Group By ItemCode) House on House.ItemCode=House_DrugBus.ItemCode " _
        & "left join m_Drug on m_drug.itemcode=house_DrugBus.itemCode " _
        & "where house_drugBus.dsCode='" & gtydSysConfig.DepCode & "'"
    gDbObj.CNExe.BeginTrans
    If Not gDbObj.DBExec("delete from house_MonthFoot where dscode='" & gtydSysConfig.DepCode & "' and FootMonth='" & FootYM1 & "'") Then
        GoTo errFoot
    End If
    
    If Not gDbObj.DBExec("Update house_BusMain set FootMonth='" & FootYM & "' where dsCode='" & gtydSysConfig.DepCode & "' " _
                     & "and FootMonth is null") Then
        GoTo errFoot
    End If
    If Not gDbObj.DBExec(SQL) Then
        GoTo errFoot
    End If
    gDbObj.CNExe.CommitTrans
    MsgBox "结帐完毕！", vbInformation
    Exit Sub
errFoot:
    gDbObj.CNExe.RollbackTrans
    MsgBox gDbObj.ErrDes, vbCritical
End Sub

Private Sub cFoot()
    Dim FootYM As String
    Dim FootYM1 As String
    Dim SQL As String
    FootYM = Format(DTPDate.Value, "yyyymm")
    FootYM1 = Format(DTPDate.Value + 31, "yyyymm")
    gDbObj.CNExe.BeginTrans
    If Not gDbObj.DBExec("delete from house_MonthFoot where dscode='" & gtydSysConfig.DepCode & "' and FootMonth='" & FootYM1 & "'") Then
        GoTo errFoot
    End If
    
    If Not gDbObj.DBExec("Update house_BusMain set FootMonth=null where dsCode='" & gtydSysConfig.DepCode & "' " _
                     & "and FootMonth='" & FootYM & "'") Then
        GoTo errFoot
    End If
    gDbObj.CNExe.CommitTrans
    MsgBox "本月结帐已经取消！", vbInformation
    Exit Sub
errFoot:
    gDbObj.CNExe.RollbackTrans
    MsgBox gDbObj.ErrDes, vbCritical
End Sub

Private Sub btg_Click(ByVal WhichB As Integer)
    Select Case WhichB
    Case 0
        If Day(DTPDate.Value) < gtydSysConfig.FootDay Then
            MsgBox "结帐日期超出范围,只能在每月的 " & gtydSysConfig.FootDay & " 日以后结帐", vbCritical
            Exit Sub
        End If
       If MsgBox("本月工作是否完成？我要结帐！", vbYesNo + 32) = vbYes Then MFoot
    Case 1
       If gDbObj.GetRs("Select Max(FootMonth) from house_BusMain where dscode='" & gtydSysConfig.DepCode & "'") > 0 Then
            If Not IsNull(gDbObj.Rs(0)) Then
                If Format(DTPDate.Value, "yyyymm") <> gDbObj.Rs(0) Then
                    MsgBox "本月还没结帐!", vbCritical
                    Exit Sub
                End If
            Else
                MsgBox "本月还没结帐!", vbCritical
                Exit Sub
            End If
        End If
       If MsgBox("是否真的取消本月结帐？", vbYesNo + 32) = vbYes Then cFoot
    Case 2
        Unload Me
    End Select
End Sub

Private Sub Form_Load()
    Call hisFormToCenter(Me, frmMain)
    DTPDate.Value = gfnGetTime()
    lblDep = gtydSysConfig.DepName
    lblHD = gtydSysConfig.HdName
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmMonthFoot = Nothing
End Sub