' MacroName: Transfer
' MacroDescription: Transfer selected OCLC lines into a CCS record
' Written by: Joel Hahn, Niles Public Library District

'***will now handle multiple LCCN's in a single 010***
'***should handle enhanced 505's ($t, $r, etc.) and multiple***
'***505's ([1] 505, etc.)***

sub main
  Dim CS as Session
'  Set CS = CurrentSession

  Dim CCS as Session
  Dim CCSSession as Session

  'Set up Session names
  'CurSession [also CS] is OCLC; CCSSession is the local telnet.
  'Commands may then be sent to either session by choosing the 
  'proper preface.
  CurrentSession.GetName CurSession$
  NumSessions%=GetNumSessions()
  For i=1 to NumSessions%
    Set CCS=GetSession(i)
    CCS.GetName SessionName$
'    If (SessionName$<>CurSession$) Then
'      Set CCSSession=CCS
'    End if
     If SessionName$="Telnet to OCLC" Then
       Set CS=CCS
     ElseIf SessionName$="Telnet to CCS" Then
       Set CCSSession=CCS
     End If
  Next i

'get text from OCLC
Attr=0
AttrEnd=0
i=1
j=1
Do
  Do
    CS.GetChar Testr$, Attrib%, i, j
'    MsgBox Str(Attrib%)  & "--" & i & " x " & j
    If Attr=0 Then
      If Attrib%<>NORMAL Then
        Attr=1
        StartRow%=i
        StartCol%=j
        Exit Do
      End If
    ElseIf Attr=1 Then
      If Attrib%=NORMAL Then
        EndRow%=i
        EndCol%=j-1
        AttrEnd=1
        Exit Do
      End If
    End If
    j=j+1
  Loop While j<=80
  If AttrEnd=1 Then
    Exit Do
  End If
  i=i+1
  j=1
Loop While i<=29

If EndCol%=0 Then
 EndRow%=EndRow%-1
 EndCol%=80
End If

'MsgBox StartRow% & "-" & StartCol% & "-" & EndRow% & "-" & EndCol%
CS.GetTextInRegion Buffer$, StartRow%, StartCol%, EndRow%, EndCol%, TRUE

wraps=0
For g=1 to LEN(Buffer$)
  If mid(Buffer$, g, 1)=CHR$(13) then wraps=wraps+1
Next g

crlf=CHR$(13)+CHR$(10)
for g=1 to wraps
  place=InStr(Buffer$, crlf)
  l$=Left(Buffer$, place-1)
  r$=Right(Buffer$, (Len(Buffer$)-(place+1))) '***
  Buffer$=l$+r$
next g

'***************************************************
Body:
Set CurrentSession = CCSSession
CCSSession.GetTextInRegion InsOvr$, 21, 70, 21, 75
If InsOvr$="OVERST" Then
  CCSSession.Send "\x1B[K"
  CCSSession.Receive 30, "INSERT"
End If

Lines=0
For h=1 to LEN(Buffer$)
  if mid(Buffer$, h, 1)=CHR$(221) then Lines=Lines+1
Next h

li=1 '2
Do While li<=Lines
  CCSSession.Send "\r"
  b$=GetField(Buffer$, li, CHR$(221))

GetLine:
  dim c$
  dim d$
  dim delim as String
  delim=CHR$(223)

  subf=0  '# of subfields
  subc=0  'subfield progress counter
  de=0    '0=1st subfield is $a; 1=1st subfield is not $a

  'Get tag & indicators; jump to special line handler for
  'lines not handled in the standard way
  If Mid(b$, 8, 2)="00" Then
    Goto DoubleO
  ElseIf Mid(b$, 8, 3)="010" Then 
    Goto LCCN
  ElseIf Mid(b$, 7, 1)="[" Then
    Goto FiveOhFive
  ElseIf Mid(b$, 8, 3)="910" Then
    Goto NineTen
  Else
    a$=Mid(b$, 8, 3)+Mid(b$, 12, 2)
  End If
  If Mid(b$, 16, 1)<>delim Then
    a$=a$+"a"
    de=0
  Else
    de=1
  End If

SubfieldCount:
  For i=16 to Len(b$)
    If Mid(b$, i, 1)=delim Then subf=subf+1
    If subf=0 Then subf=1
  Next i
  If de=1 then subf=subf+1

SubfieldLoop:
  Dim subx as Integer
  Dim lenD as Integer
  subx=0
  subc=1
  Do
    c$=GetField(b$, subc, CHR$(223))
    If (subc<>1) or (de=1) Then d$=Mid(c$, 3, Len(c$)-3)
    If subc<>1 Then 
      a$=a$+Mid(c$, 1, 1)
      If Len(d$)>50 Then
        lenD=Len(d$)
        subx=lenD\50  'should be same as Int(.../50)
        If (lenD MOD 50)=0 Then
          subx=subx-1
        End If
      End If
    Else
      If de=1 Then
        Goto Looper
      Else
        d$=RTrim(Mid(c$, 16, Len(c$)-16))
        If Len(d$)>50 Then
          lenD=Len(d$)
          subx=lenD\50  'should be same as Int(.../50)
          If (lenD MOD 50)=0 Then
            subx=subx-1
          End If
        End If
      End if
    End if
    a$=a$+d$
    If subc<>subf Then a$=a$+"\r"
Looper:
    subc=subc+1
  Loop While subc<=subf
  
Retn:
  CCSSession.Send a$
  If li<=Lines Then
    If de=1 then subf=subf-1
    For i=1 to (subf+subx)
      CCSSession.Send "\x1B[A"
    Next
    CCSSession.Send "\x09"
  End If
  li=li+1
Loop
Goto Done

'***************************************************
DoubleO:
b$=RTrim(b$)
a$=Mid(b$, 8, 3)

If Mid(b$, 8, 3)="006" Then
  c$=Right(Left(b$, Len(b$)-1), Len(b$)-17)
  a$=a$+c$
  subf=1
Else

SubfieldCount2:
delim=Chr$(223)
subf=1
  For i=16 to Len(b$)
    If Mid(b$, i, 1)=delim Then subf=subf+1
  Next i

SubfieldLoop2:
subc=1
del1=0
Do
  c$=GetField(b$, subc, CHR$(223))
  If subc=1 Then
    del2=1
    d$=Mid(c$, 16, 1) ' Len(c$)-16)
  Else
    del2=ASC(Mid(c$, 1, 1))-96
    d$=Mid(c$, 3, 1)  ' Len(c$)-3)
  End if
  If del2<>del1+1 Then
    If del2=4 Then 
      a$=a$+"u"
    Else
      dash=del2-(del1+1)
        For k=1 to dash
          a$=a$+"-"
        Next k
    End If
  End If
  a$=a$+d$
  del1=del2
  subc=subc+1
Loop While subc<=subf
End If : subf=1
Goto Retn

'***************************************************
LCCN:
  dim lc$
  dim ln$

  If Mid(b$, 16, 1)<>delim Then
    a$=Mid(b$, 8, 3)+"  a" 'Get Marc tag
    de=0
  Else
    de=1
  End If

SubfieldCountLCCN:
  For i=16 to Len(b$)
    If Mid(b$, i, 1)=delim Then subf=subf+1
    If subf=0 Then subf=1
  Next i
  If de=1 then subf=subf+1

'  lc$=RTrim(Mid(b$, 16, Len(b$)-16))
'  asci=ASC(Left(lc$, 1))
'  If ASC(Left(lc$, 1))>97 and ASC(Left(lc$, 1))<123 Then
'    a$=a$+Left(lc$, 2)+" "
'    lc$=Right(lc$, Len(lc$)-2)
'  Else
'    a$=a$+"   "
'  End If
'  a$=a$+Left(lc$, 2)
'
'  lc$=Right(lc$, Len(lc$)-3)
'  j=1
'  Do While j<=Len(lc$)
'    check=ASC(Mid(lc$, j, 1)) 
'    If check<48 or check>57 Then
'        ln$=LTrim(Mid(lc$, j, Len(lc$)-(j-1)))
'        lc$=Left(lc$, j-1)
'        Exit Do
'    End If
'    j=j+1
'  Loop
'
'  If 6-Len(lc$)<>0 Then
'    For i=1 to (6-Len(lc$))
'      lc$="0"+lc$
'    Next i
'  End if
'  subf=1
'  a$=a$+lc$+" "+ln$

SubfieldLoopLCCN:
'  Dim subx as Integer
'  Dim lenD as Integer
  subx=0
  subc=1
  Do
    lc$="" : ln$=""
    c$=GetField(b$, subc, CHR$(223))
    If (subc<>1) or (de=1) Then d$=Mid(c$, 3, Len(c$)-3)
    If subc<>1 Then 
      a$=a$+Mid(c$, 1, 1)
      If Len(d$)>50 Then
        lenD=Len(d$)
        subx=lenD\50  'should be same as Int(.../50)
        If (lenD MOD 50)=0 Then
          subx=subx-1
        End If
      End If
    Else
      If de=1 Then
        Goto LooperLCCN
      Else
        d$=RTrim(Mid(c$, 16, Len(c$)-16))
        If Len(d$)>50 Then
          lenD=Len(d$)
          subx=lenD\50  'should be same as Int(.../50)
          If (lenD MOD 50)=0 Then
            subx=subx-1
          End If
        End If
      End if
    End if

  lc$=d$ 'RTrim(Mid(b$, 16, Len(b$)-16))
  asci=ASC(Left(lc$, 1))
  If ASC(Left(lc$, 1))>96 and ASC(Left(lc$, 1))<123 Then
    If ASC(Mid(lc$, 2, 1))>96 and ASC(Mid(lc$, 2, 1))<123 Then
      a$=a$+Left(lc$, 2)+" "
      lc$=Right(lc$, Len(lc$)-2)
    Else
      a$=a$+Left(lc$, 1)+"  "
      lc$=Right(lc$, Len(lc$)-1)
    End If
  Else
    a$=a$+"   "
  End If
  a$=a$+Left(lc$, 2)

  lc$=Right(lc$, Len(lc$)-3)
  j=1
  Do While j<=Len(lc$)
    check=ASC(Mid(lc$, j, 1)) 
    If check<48 or check>57 Then
        ln$=LTrim(Mid(lc$, j, Len(lc$)-(j-1)))
        lc$=Left(lc$, j-1)
        Exit Do
    End If
    j=j+1
  Loop

  If 6-Len(lc$)<>0 Then
    For i=1 to (6-Len(lc$))
      lc$="0"+lc$
    Next i
  End if
  'subf=1
  a$=a$+lc$+" "+ln$

    If subc<>subf Then a$=a$+"\r"
LooperLCCN:
    subc=subc+1
  Loop While subc<=subf

Goto Retn

'***************************************************
FiveOhFive: 'Used only for "[1] 505", "[2] 505", etc.

  If Mid(b$, 20, 1)<>delim Then
    a$=Mid(b$, 12, 3)+Mid(b$, 16, 2)+"a"
    c$=Mid(b$, 20, Len(b$)-20)
    If Len(c$)>50 Then
      lenC=Len(c$)
      subx=lenC\50
      If (lenC MOD 50)=0 Then
        subx=subx-1
      End If
    End If
    a$=a$+c$
    subf=1
    de=0
  Else

SubfieldCount505:
  For i=19 to Len(b$)
    If Mid(b$, i, 1)=delim Then subf=subf+1
    If subf=0 Then subf=1
  Next i
  subf=subf+1

SubfieldLoop505:
  'Dim subx as Integer
  'Dim lenD as Integer
  subx=0
  subc=1
  Do
    c$=GetField(b$, subc, CHR$(223))
    If subc<>1 Then
      d$=Mid(c$, 3, Len(c$)-3) 
      a$=a$+Mid(c$, 1, 1)
      If Len(d$)>50 Then
        lenD=Len(d$)
        subx=lenD \ 50  'should be same as Int(.../50)
        If (lenD MOD 50)=0 Then
          subx=subx-1
        End If
      End If
    Else
      Goto Looper505
    End if
    a$=a$+d$
    If subc<>subf Then a$=a$+"\r"
Looper505:
    subc=subc+1
  Loop While subc<subf
End If

Goto Retn

'***************************************************
NineTen:
  a$=Mid(b$, 8, 3)+"00a" 'Get Marc tag
  c$=RTrim(Mid(b$, 16, Len(b$)-16))
  a$=a$+c$+"000"
  subf=1
Goto Retn

'***************************************************
'Done2:
'  If Err=102 Then Resume Next

Done:
end sub