Funktion
Berufsbezeichnungen aus der SWD in die PND
Zeile 6029 - 6209
Beschreibung
Code in WinIBW2 (Makro/VBScript)Sub
Sub PND315()
'********************************************************************
'Autor: D. Horst, DNBF, Hanspeter Schneider, HEBIS, Stand: 19.01.2009
'Anforderung: B. Pfeifer, DNBF, AfS
Dim FldTmp ' Kategorie und Inhalt im Pica-Zeichensatz
Dim StrTmp ' Feldinhalt im latin1 - Zeichensatz
Dim StrLen ' Länge des Feldes
Dim StrCmd ' Such-Kommando
Dim waitTxt ' Warnungstext für 'Weiter'
Dim strStatus ' Status nach Suche
Dim strSize ' Size nach Suche
Dim deskriptor ' Deskriptor für 315
Dim PPN ' gefundene PPN
Dim winid ' id of edit screen
Dim swinid ' id of search window
Dim tmpid ' id of actual window
Dim exist_a ' true, wenn schon Deskriptor a existiert
Dim trunkiert ' "?" falls Suchbegriff trunkiert, sonst ""
on error resume next
waitTxt = Application.LatinToPica ( _
"+ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +" &vbLf & _
"+ +" &vbLf & _
"+ Sie haben keinen Datensatz zum Verknüpfen ausgewählt +" & vbLf & _
"+ +" & vbLf & _
"+ Dennoch erwartet das aufgerufenen Skript eine Fortsetzung +" & vbLf & _
"+ mit der Funktion 'Script / Weiter' +" & vbLf & _
"+ +" & vbLf & _
"+ +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +" &vbLf )
winid = Application.ActiveWindow.WindowID
Application.ActiveWindow.Title.StartOfField
Application.ActiveWindow.Title.WordRight 1
Application.ActiveWindow.Title.EndOfField True
FldTmp = Application.ActiveWindow.Title.GetTagAndSelection
if left(FldTmp,4) <> "315 " then
msgbox "Dieses Skript kann nur eine Kategorie vom Typ 315 bearbeiten", vbCritical
exit sub
end if
StrTmp = Application.ActiveWindow.Title.GetSelection()
if left(StrTmp,1) = "|" then
msgbox "Der Feldinhalt in Kategorie 315 beginnt mit einem in diesem Skript nicht erlaubten Zeichen.", vbCritical
exit sub
end if
StrTmp = Application.PicaToLatin(StrTmp)
trunkiert = ""
strlen = len(StrTmp)
if strlen > 0 then
if right(StrTmp,1) = "?" then
trunkiert = Application.GetProfileInt("PND315","allow_wild",0)
if trunkiert = 0 then
msgbox "Das Skript erlaubt keine trunkierte Suche." &vbLf & _
"Bitte suchen Sie nach vollständigen Berufsbezeichnungen", _
vbCritical
exit sub
end if
trunkiert = "?"
strlen = strlen - 1
end if
end if
if strlen = 0 then
msgbox "Kategorie 315 enthält keinen sinnvollen Inhalt.", vbCritical
exit sub
end if
Application.ActiveWindow.Title.StartOfBuffer
'exist_a = (Finde 315 |a| <> leer)
exist_a = (Application.ActiveWindow.Title.FindTag ("315 |a|", 0, false, False) <> "")
Application.ActiveWindow.Title.StartOfBuffer
Application.ActiveWindow.Title.Find FldTmp, true, false, false
Application.ActiveWindow.Title.StartOfField
Application.ActiveWindow.Title.WordRight 1
Application.ActiveWindow.Title.EndOfField True
'msgbox "exist_a:" & exist_a & " trunk:" & trunkiert & " suche:" & StrTmp
'wenn keine 315 |a| existiert und nicht trunkiert ist dann Suchkommando mit Teilbestandseinschränkung für Indikator a
if (not exist_a) or (trunkiert = "") then
StrCmd = "f sp """ & StrTmp & """ and zg b"
deskriptor = "|a|"
Application.ActiveWindow.Command StrCmd, True
strStatus = Application.ActiveWindow.Status 'Status auslesen
else
strStatus = "NOHITS"
end if
if strStatus = "NOHITS" then
StrCmd = "rec n;f sp """ & StrTmp & """"
deskriptor = "|b|"
Application.ActiveWindow.Command StrCmd, True
strStatus = Application.ActiveWindow.Status
'weitere Bedingung für erneute leere Treffermenge einfügen
if strStatus = "NOHITS" then
PND315NoLink strTmp
exit sub
end if
end if
if strStatus <> "OK" then
msgbox "Es ist ein unerwarteter Fehler aufgetreten." &vbLf &_
"Bitte wenden Sie sich an Ihren Systembetreuer.", vbCritical
exit sub
end if
' Ab hier ist strStatus = "OK", in Suchfenster
swinid = Application.ActiveWindow.WindowID
setsz = Application.ActiveWindow.Variable("P3GSZ")
if (left(setsz,1) = "%") then
setsz = mid(setsz,4)
end if
if setsz > 10 then
msgbox "Die Suche ergab insgesamt " & setsz & " Treffer." &vbLf &_
"Bitte schränken Sie den Suchbegriff ein, um die Treffermenge " &_
"zu reduzieren", vbCritical
Application.ActiveWindow.CloseWindow
exit sub
end if
if setsz > 1 then
msgbox "Die Suche ergab insgesamt " & setsz & " Treffer." &vbLf &_
"Bitte suchen Sie den entsprechenden Normdatensatz aus," & vbLf &_
"den Sie zur Verknüpfung verwenden wollen, und aktivieren" & vbLf &_
"Sie danach den Menü-Eintrag Script/Weiter." & vbLf & vbLf &_
"Sollten Sie keinen entsprechenden Normdatensatz finden," &vbLf &_
"so schließen Sie einfach das aktuelle Fenster und aktivieren" &vbLf &_
"Sie danach den Menü-Eintrag Script/Weiter."
Application.ActiveWindow.ShowMessage "Verknüpfen mit 'Script/Weiter'", 0
Application.ActivateWindow winid
Application.ActiveWindow.Title.StartOfBuffer
Application.ActiveWindow.Title.InsertText waitTxt
Application.ActivateWindow swinid
Application.Pause
tmpid = Application.ActiveWindow.WindowID
Application.ActivateWindow winid
Application.ActiveWindow.Title.StartOfBuffer
do while Application.ActiveWindow.Title.FindTag("+",0,true,false) <> ""
Application.ActiveWindow.Title.DeleteLine 1
loop
Application.ActiveWindow.Title.Find FldTmp, true, false, false
Application.ActiveWindow.Title.StartOfField
Application.ActiveWindow.Title.WordRight 1
Application.ActiveWindow.Title.EndOfField True
Application.ActivateWindow tmpid
end if
' Hier nach weiter. Zwei Möglichkeiten:
' a) Wir sind noch im Suchfenster, dann wurde eine PPN gefunden
' b) Anderenfalls kann keine Verknüpfung hergestellt werden
if swinid <> Application.ActiveWindow.WindowID then
PND315NoLink strTmp
exit sub
end if
PPN = Application.ActiveWindow.Variable("P3GPP")
Application.ActiveWindow.CloseWindow
if exist_a then deskriptor = "|b|"
'Application.ActiveWindow.Title.Find FldTmp, true, false, false
'Application.ActiveWindow.Title.StartOfField
'Application.ActiveWindow.Title.WordRight 1
'Application.ActiveWindow.Title.EndOfField True
Application.ActiveWindow.Title.InsertText deskriptor & "!" & PPN & "!"
End Sub
Code in WinIBW3 (Javascript)
Erforderliche Änderungen / Ergänzungen
Überblick
Inhalte