Function CheckForm(param as notesDocument) as Boolean
	
		Select Case param.GetItemvalue("Form")(0)
			Case "Task":
				If (param.Getitemvalue("TaskStatus")(0) <> "На исполнении") Then
					MsgBox "Поручение можно создать только для поручений со статусом [На исполнении]",16
					Exit Sub
				End If
			Case "Execution": 'документ исполнения приказа
				If (param.Getitemvalue("DocStatus")(0) <> "На исполнении") Then
					MsgBox "Поручение можно создать только для документов со статусом [На исполнении]",16
					Exit Sub
				End If
			Case "Act", "Agreement", "CopyOrderAgreement" ,"CopyOrderExecution", "Order","Protocol", "Signing":
				MsgBox "К данному типу документов нельзя создавать поручения",16
				Exit Sub
			Case Else
				MsgBox "Добавьте документ в метод createTaskDoc",16
				Exit Sub
		End Select
		
		CheckForm = True
End Function

Public Sub createTaskDoc () 'универсальный
		On Error GoTo ERROR_HANDLER
		GoTo START
ERROR_HANDLER:
		On Error GoTo 0
		Error Err, Error$ & Chr(10) & GetThreadInfo(1) & " (" & Erl & ")"
		Exit Sub
START:	
		Dim ws As New NotesUIWorkspace
		Dim ses as new Notessession
		Dim view As NotesView
		Dim s As New NotesSession
		Dim taskdb As NotesDatabase
		Dim newDoc As NotesDocument    
		Dim tmpdoc As NotesDocument
		Dim col As NotesDocumentCollection   
		Dim form As String
		Set taskdb = getsettingmanager().crossGetDB("tasks")
		Dim flag As Integer
		Dim nam As NotesName
		Dim staffDB As NotesDatabase
		Dim staffdoc As NotesDocument
		Dim pickDoc As NotesDocument
		Dim db As NotesDatabase
		
		Set newDoc = taskdb.Createdocument
		newDoc.Form = "Task"
		newDoc.TaskAuthor = getstaffmanager().getName(False)
		newDoc.TaskAuthorNotes = getstaffmanager().getNotesName(False)
		newDoc.TaskStatus = "Черновик"
					
		If not getstaffmanager().isUser(True) Then  Exit Sub
		
		If ws.Currentdocument Is Nothing Then
			If Not ws.Currentview Is Nothing Then
				If ws.Currentview.View.EntryCount > 0 then
					Set db = ses.CurrentDatabase
					Dim doc As NotesDocument
					Set doc = db.GetDocumentByID(ws.CurrentView.CaretNoteID)
					
					flag = MessageBox ("Хотите связать поручение с выделенным документом?", 4 , "")
					If flag = 6 Then
						if Not CheckForm(doc) then Exit Sub
						
						newDoc.TaskRegNumber = doc.Getitemvalue("TaskNum")(0)
						newDoc.DocRegNumber = doc.Getitemvalue("DocRegNumber")(0)
						newDoc.DocUNID = doc.getitemvalue("DocUNID")(0)
						
						if doc.GetItemvalue("Form")(0) = "Execution" then
							newDoc.DocRegNumber = doc.Getitemvalue("ExecutionDocRegNumber")(0)
							newDoc.DocDB = Mid(db.Filename, 1, (Len(db.Filename) - 4)) 
							' зачем в одном случае это поле есть, а в друго нет?
							' Если это важно, то надо будет подумать...
							' сделал через условие, на всякий случай
						Else
							Call newDoc.MakeResponse( doc )
						end if
					End if					
				End if
			End if
		Else
			Set doc = ws.Currentdocument.Document
			If ( (doc.Getitemvalue("DocDB")(0) = "docs") Or (doc.Getitemvalue("DocDB")(0) = "office")) Then
				Set db = getsettingmanager().crossGetDB(doc.Getitemvalue("DocDB")(0))
			Else
				Set db = ses.CurrentDatabase
			End If
			
			if Not CheckForm(doc) then Exit Sub
			
			if doc.GetItemvalue("Form")(0) = "Execution" then
				newDoc.DocRegNumber = doc.Getitemvalue("ExecutionDocRegNumber")(0)
				newDoc.DocDB = Mid(db.Filename, 1, (Len(db.Filename) - 4)) 
				newDoc.DocUNID = doc.universalid
				' зачем в одном случае это поле есть, а в друго нет?
				' Если это важно, то надо будет подумать...
				' сделал через условие, на всякий случай
			Else
				newDoc.TaskRegNumber = doc.Getitemvalue("TaskNum")(0)
				newDoc.DocRegNumber = doc.Getitemvalue("DocRegNumber")(0)
				newDoc.DocUNID = doc.getitemvalue("DocUNID")(0)
				Call newDoc.MakeResponse( doc )
			End if
			
			newDoc.DocUNID = doc.getitemvalue("DocUNID")(0)
			newDoc.DocDB = Mid(db.Filename, 1, (Len(db.Filename) - 4)) ' зачем в одном случае это поле есть, а в друго нет?
		End if
	
		Call newDoc.Save(True, True)
		Call ws.Editdocument(True, newDoc)
	
	End Sub