need help with catalog conversion program

[Dekkerfan]

this program, written by my predecessor, converts a library catalog in one format into another format, which is then uploaded to the internet. It has been working until now. It ends with the "out of string space" error code 14, after processing 22,000 plus records. I will post it below, along with a portion of the 26 MB file that it tries to convert. Any suggestions would be appreciated. I have tried running it on a Windows 2000 pc, and on 2 different XP pro computers, with the same result.
***************************************************
'Program to massage communications-format MARC records
' for publishing on the Internet.
'This originated from "gen2.bas, written around May '98.
'History: Ver 2.5; fixes design flaw: didn't know we would get records up to
' 13K! Actually this is a workaround rather than a fix: we
' simply eliminate the records which are too long to fit in this program.
'23 Jan 2003
'Ver 2.6 Adds note that bar code shown when there's a long-record reject
' is the barcode of the previous record. Also attempts to add output of
' a counter to cover case of records w/ no barcode causing a log message.
'11 Feb 2004
'
' Initializations
'
DECLARE FUNCTION FindSubFld% (Ftag%, Sf$)
DECLARE FUNCTION FindFld% (tag$)
DECLARE FUNCTION InsertFld% (NewTag$)
DECLARE FUNCTION Zerostr$ (value%, zstringlen%)
DECLARE FUNCTION GetId$ (Fptr%, count%)
DECLARE FUNCTION CountSubs% (FldPtr%)
DECLARE SUB WriteRecord ()
DECLARE SUB MassageRecord ()
DECLARE SUB GetRecord ()
DECLARE SUB OpenFiles ()
DECLARE SUB WriteLog ()
DECLARE SUB SetMsg (i%)
DECLARE SUB AddSubfield (TagIn$, AfterField$, FieldLabel$, FieldText$)
DECLARE SUB DelSubfield (tag$, label$)
DECLARE SUB DelField (tag$)
DECLARE SUB DelChar (Cs$, deldex%)
DECLARE SUB FixUperChars (FldPtr%)
DECLARE SUB BadUper (Cs$, index%)
DECLARE SUB FixBase (Cs$, index%)
DECLARE SUB SpclCrit (Cs$, index%)

CONST TRUE = -1
CONST FALSE = 0
CONST DL = "" 'delimiter
CONST FT = "" 'field terminator
CONST RT = "" 'record terminator

TYPE fldstruc
tag AS STRING * 3
fldlen AS INTEGER 'These include the FT
fstart AS INTEGER 'Adjstd for index starting at 1 insted 0
indics AS STRING * 2
subscount AS INTEGER
END TYPE
REDIM SHARED fld(1) AS fldstruc 'Holds field-wide info on one field

REDIM SHARED dataId(1, 1) AS STRING * 1 '1st:field; 2ndubfield; holds subfld ID char
' (the char after the DL [delimiter])
REDIM SHARED MARCptr(1, 1) AS LONG 'holds ptrs to subfield txt in MARCdata
' (these point to first data char, just aftr ID char
REDIM SHARED MARClengs(1, 1) AS INTEGER 'holds subfields' txt lengths
' (these dont incl DL or ID lengths)
DIM SHARED DoMsgs%(1 TO 10) 'Flags for log messages (reset each record)
DIM SHARED Msgs$(1 TO 10) 'Place to put message constants
DIM SHARED AnselBasesConv$ 'Table for base chars conversion
DIM SHARED CombinCrit$ 'Find which alowd-base table to use
DIM SHARED CombinBase$(1 TO 8) 'Which bases are allowed for each 'crit
DIM SHARED CombinChar$(1 TO 8) 'ANSI subst's for base+diacritic units
DIM SHARED Chop245$ 'what's not allowed frm end of 245
DIM SHARED DirecLen% 'Directory length (stored in leader)
DIM SHARED DataLen& 'Length of all after directory
DIM SHARED InRecLen& 'Length of current inpt MARC rec.
DIM SHARED InFlds% 'Gets no. of fields in INPUT MARC rec.
REM DIM SHARED OutFlds% 'now unused: no. of fields in OUTPUT
DIM SHARED MaxSubs% 'Max subs in any field of curr rec
DIM SHARED holdptr% 'temp for xtra fcn return val
DIM SHARED holdleng% 'temp for xtra fcn return val
DIM SHARED stringchanged% 'flag to signal FixUperChars
DIM SHARED skipflag% 'flag to signal skip this in output
DIM SHARED CurentBar$ 'barcode if found in 852 field
DIM SHARED Leader AS STRING * 24 'Front of MARC record, fixed length
DIM SHARED Directory AS STRING 'Direc for this one record
DIM SHARED MARCdata AS STRING 'all the stuff after directory
DIM SHARED OutMARCdata AS STRING 'construct output counterpart here
DIM SHARED passctr% 'Main prog loop passes (input recs)
DIM SHARED outcount% 'Records written to output file

'Module level code starts here

CLS
OpenFiles ' Open in, out, log files.
Msgs$(1) = "no 001 field"
Msgs$(2) = "no 852"
Msgs$(3) = "no 245"
Msgs$(4) = ""
Msgs$(5) = "undefined upper-ASCII (ANSEL) character(s)"
Msgs$(6) = "diacritic has no following base character"
Msgs$(7) = ""
Msgs$(8) = ""
Msgs$(9) = ""
Msgs$(10) = "" 'Wonder if there's a better way..

AnselBasesConv$ = "LØÐÞÆŒ'·b®±OU’?‘lødþæœ" + CHR$(34) + "i£ð?ou??°lp©#¿¡"
'above is ANSEL to ANSI ("ISO") conversn table (base characters, &HA1-C6)
'In above, the '?'s are "future" and so might have to be changed.
'Also see note in FixUperChars
CombinCrit$ = "áâãäèéêð" 'grave,acute,circum,tilde,diere,hacec,angstr,cedil
'programmer CAUTION! The characters in CombinCrit$ must also be duplicated
' in a CASE stmt's expression that calls SpclCrit! (There they're in hex)

CombinBase$(1) = "AEIOUaeiou" 'these are indexed by CombinCrit$
CombinBase$(2) = "AEIOUYaeiouy"
CombinBase$(3) = "AEIOUaeiou"
CombinBase$(4) = "ANOano"
CombinBase$(5) = "AEIOUYaeiouy"
CombinBase$(6) = "Ss"
CombinBase$(7) = "Aa"
CombinBase$(8) = "Cc"

CombinChar$(1) = "ÀÈÌÒÙàèìòù" 'these must be sync'd w/ CombinBase
CombinChar$(2) = "ÁÉÍÓÚÝáéíóúý"
CombinChar$(3) = "ÂÊÎÔÛâêîôû"
CombinChar$(4) = "ÃÑÕãñõ"
CombinChar$(5) = "ÄËÏÖÜŸäëïöüÿ" 'that last one is &HFF (l.c. y-dieresis)
CombinChar$(6) = "Å Å¡"
CombinChar$(7) = "Åå"
CombinChar$(8) = "Çç"

Chop245$ = "#$%&(*+,-./:;<=>?@" 'Punct not allowed in 091 at end of what"
' comes from 245a
passctr% = 0
outcount% = 0

PRINT #3, "Beginning at time: "; TIME$
PRINT "Inetmarc: converts MARC records for Internet use. Ver. 2.6 Feb 2004"

DO ' MAIN LOOP
GetRecord ' Read a record and parse it.
IF EOF(1) THEN EXIT DO
MassageRecord ' Process it; make notes as needed in log file.
WriteRecord ' Write out the processed record
WriteLog ' Write out any accumulated messages
passctr% = passctr% + 1
IF (passctr% AND 127) = 0 THEN PRINT "Completed"; passctr%; " records"
MARCdata = "" 'CLEAR MARCdata
OutMARCdata = "" 'CLEAR OutMARCdata

LOOP
PRINT #3, "Ending at time: "; TIME$
PRINT "Total records input: "; passctr%
CLOSE 1, 2, 3 'Close files [END would do this].
SYSTEM
END

**************************************************
here is a portion of the file it uses for the conversion "INRECS"
**************************************************

00753nam 2200217 a 4500001001500000003000900015005001700024008004100041040002300082082001200105110004200117245012200159260005000281300002900331504002900360650002900389700002000418700002100438700002400459852005200483 37741100019197 TxDaGIAL 20050502123337.7 970723s1983 ilua 000 0 eng d ¬aTxDaGIAL¬cTxDaGIAL 04¬a404¬221 2 ¬aChicago Linguistic Society.¬bMeeting. 10¬aCLS 19 :¬bpapers from the nineteenth regional meeting /¬cedited by Amy Chukerman, Mitchell Marks, John F. Richardson. ¬aChicago :¬bChicago Linguistic Society,¬c1983. ¬a407 p. :¬bill. ;¬c23 cm. ¬aIncludes bibliographies. 0¬aLinguistics¬vCongresses. 10¬aChukerman, Amy. 10¬aMarks, Mitchell. 10¬aRichardson, John F. ¬aTxDaGIAL¬h410.5¬iC532¬m19 1983¬820050502¬kJOURN 00762nam 2200229 a 4500001001500000003000900015005001700024008004100041020001500082040002300097082001200120110004200132245011200174260005000286300002900336504002900365650002900394700001900423700001900442700001900461852005200480 37741100019198 TxDaGIAL 20050502123411.1 970723s1984 ilua 000 0 eng d ¬a0914203215 ¬aTxDaGIAL¬cTxDaGIAL 04¬a404¬221 2 ¬aChicago Linguistic Society.¬bMeeting. 10¬aCLS 20 :¬bpapers from the twentieth regional meeting /¬cedited by Joseph Drogo, Veena Mishra, David Testen. ¬aChicago :¬bChicago Linguistic Society,¬c1984. ¬a402 p. :¬bill. ;¬c23 cm. ¬aIncludes bibliographies. 0¬aLinguistics¬vCongresses. 10¬aDrogo, Joseph. 10¬aMishra, Veena. 10¬aTesten, David. ¬aTxDaGIAL¬h410.5¬iC532¬m20 1984¬820050502¬kJOURN 01160nam 2200241 a 4500001001500000003000900015005001700024008004100041020001500082040002300097082001200120110004200132245015900174260005000333300002900383504002900412505032800441650002900769700002400798700002100822700002300843852005200866 37741100019199 TxDaGIAL 20050502123438.4 970723s1985 ilua 000 0 eng d ¬a0914203231 ¬aTxDaGIAL¬cTxDaGIAL 04¬a404¬221 2 ¬aChicago Linguistic Society.¬bMeeting. 10¬aCLS 21 part 1 :¬bpapers from the general session at the twenty-first regional meeting /¬cedited by William H. Eilfort, Paul D. Kroeber, Karen L. Peterson. ¬aChicago :¬bChicago Linguistic Society,¬c1985. ¬a438 p. :¬bill. ;¬c23 cm. ¬aIncludes bibliographies. 2 ¬aSyllables and tones in Middle Korean / Eung-Jin Baek -- Morphology in Relational Grammar / Donald G. Frantz -- Lexical operations and unbounded dependencies / Jeffrey Goldberg -- Language-external evidence for clitics as words; Lappish particle clitics / Joel A. Nevis -- Copular constructions in Hebrew / Tova R. Rapoport. 0¬aLinguistics¬vCongresses. 10¬aEilfort, William H. 10¬aKroeber, Paul D. 10¬aPeterson, Karen L. ¬aTxDaGIAL¬h410.5¬iC532¬m21 1985¬820050502¬kJOURN 01112nam 2200229 a 4500001001500000003000900015005001700024008004100041040002300082082001200105110004200117245015900159260005000318300002900368505030700397504002900704650002900733700002000762700002100782700002700803852005200830 37741100019200 TxDaGIAL 20050502123509.9 970723s1986 ilua 000 0 eng d ¬aTxDaGIAL¬cTxDaGIAL 04¬a404¬221 2 ¬aChicago Linguistic Society.¬bMeeting. 10¬aCLS 22 part 1 :¬bpapers from the general session at the twenty-second regional meeting /¬cedited by Anne M. Farley, Peter T. Farley, Karl-Erik McCullough. ¬aChicago :¬bChicago Linguistic Society,¬c1986. ¬a360 p. :¬bill. ;¬c23 cm. 2 ¬aMorphological conditioning of epenthetic vowels in Hungarian / George Fowler -- Concatenation and liberation / Arnold M. Zwicky -- Possessor Ascension in Kinyarwanda / J. Albert Bickford -- Null valents in the expression of impersonal action in Kashmiri and Russian -- On weather verbs / Nicolas Ruwet. ¬aIncludes bibliographies. 0¬aLinguistics¬vCongresses. 10¬aFarley, Anne M. 10¬aFarley, Peter T. 10¬aMcCullough, Karl-Erik.

[Dekkerfan]

looks like the 8) were converted to smiley faces - I don't know how to keep that from happening, but wherever you see a smiley face, it should be a number 8 followed by a ")".

[whitetiger0990]

1)

Code:

[code][/code]

Code tags. Put the code in between them.

2)
That's not the whole program. All of the functions and subs aren't there.

3)
Ahhh.. good old out of string space... I recommend trying to compile it with FreeBASIC. Then you won't have memory problems. Note.. this is compiling. Not running from the Qbasic IDE. FreeBASIC is a command line compiler. You either have to use one of the 3rd party IDEs or compile it from command line.

http://www.freebasic.net/

Just ask questions.. Unless someone else here can make your program work.. but that's a pretty large file for Qbasic to be handling.

[Dio]

also:

[Dekkerfan]

Code:

'Program to massage communications-format MARC records
' for publishing on the Internet.
'This originated from "gen2.bas, written around May '98.
'History: Ver 2.5; fixes design flaw: didn't know we would get records up to
'  13K! Actually this is a workaround rather than a fix: we
'  simply eliminate the records which are too long to fit in this program.
'23 Jan 2003  
'Ver 2.6 Adds note that bar code shown when there's a long-record reject
'  is the barcode of the previous record. Also attempts to add output of
'   a counter to cover case of records w/ no barcode causing a log message.
'11 Feb 2004  
'
' Initializations
'
DECLARE FUNCTION FindSubFld% (Ftag%, Sf$)
DECLARE FUNCTION FindFld% (tag$)
DECLARE FUNCTION InsertFld% (NewTag$)
DECLARE FUNCTION Zerostr$ (value%, zstringlen%)
DECLARE FUNCTION GetId$ (Fptr%, count%)
DECLARE FUNCTION CountSubs% (FldPtr%)
DECLARE SUB WriteRecord ()
DECLARE SUB MassageRecord ()
DECLARE SUB GetRecord ()
DECLARE SUB OpenFiles ()
DECLARE SUB WriteLog ()
DECLARE SUB SetMsg (i%)
DECLARE SUB AddSubfield (TagIn$, AfterField$, FieldLabel$, FieldText$)
DECLARE SUB DelSubfield (tag$, label$)
DECLARE SUB DelField (tag$)
DECLARE SUB DelChar (Cs$, deldex%)
DECLARE SUB FixUperChars (FldPtr%)
DECLARE SUB BadUper (Cs$, index%)
DECLARE SUB FixBase (Cs$, index%)
DECLARE SUB SpclCrit (Cs$, index%)

CONST TRUE = -1
CONST FALSE = 0
CONST DL = ""                                  'delimiter
CONST FT = ""                                  'field terminator
CONST RT = ""                                  'record terminator

TYPE fldstruc
  tag AS STRING * 3
  fldlen AS INTEGER                     'These include the FT
  fstart AS INTEGER                     'Adjstd for index starting at 1 insted 0
  indics AS STRING * 2
  subscount AS INTEGER
END TYPE
REDIM SHARED fld(1) AS fldstruc         'Holds field-wide info on one field

REDIM SHARED dataId(1, 1) AS STRING * 1 '1st:field; 2nd:subfield; holds subfld ID char
                    ' (the char after the DL [delimiter])
REDIM SHARED MARCptr(1, 1) AS LONG      'holds ptrs to subfield txt in MARCdata
                    ' (these point to first data char, just aftr ID

char
REDIM SHARED MARClengs(1, 1) AS INTEGER 'holds subfields' txt lengths
                    ' (these dont incl DL or ID lengths)
DIM SHARED DoMsgs%(1 TO 10)             'Flags for log messages (reset each record)
DIM SHARED Msgs$(1 TO 10)               'Place to put message constants
DIM SHARED AnselBasesConv$              'Table for base chars conversion
DIM SHARED CombinCrit$                  'Find which alowd-base table to use
DIM SHARED CombinBase$(1 TO 8)        'Which bases are allowed for each 'crit
DIM SHARED CombinChar$(1 TO 8)        'ANSI subst's for base+diacritic units
DIM SHARED Chop245$                     'what's not allowed frm end of 245
DIM SHARED DirecLen%                    'Directory length (stored in leader)
DIM SHARED DataLen&                     'Length of all after directory
DIM SHARED InRecLen&                    'Length of current inpt MARC rec.
DIM SHARED InFlds%                      'Gets no. of fields in INPUT MARC rec.
REM DIM SHARED OutFlds%                 'now unused: no. of fields in OUTPUT
DIM SHARED MaxSubs%                     'Max subs in any field of curr rec
DIM SHARED holdptr%                     'temp for xtra fcn return val
DIM SHARED holdleng%                    'temp for xtra fcn return val
DIM SHARED stringchanged%               'flag to signal FixUperChars
DIM SHARED skipflag%                    'flag to signal skip this in output
DIM SHARED CurentBar$                   'barcode if found in 852 field
DIM SHARED Leader AS STRING * 24        'Front of MARC record, fixed length
DIM SHARED Directory AS STRING          'Direc for this one record
DIM SHARED MARCdata AS STRING           'all the stuff after directory
DIM SHARED OutMARCdata AS STRING        'construct output counterpart here
DIM SHARED passctr%                     'Main prog loop passes (input recs)
DIM SHARED outcount%                    'Records written to output file

'Module level code starts here

CLS
OpenFiles               ' Open in, out, log files.
Msgs$(1) = "no 001 field"
Msgs$(2) = "no 852"
Msgs$(3) = "no 245"
Msgs$(4) = ""
Msgs$(5) = "undefined upper-ASCII (ANSEL) character(s)"
Msgs$(6) = "diacritic has no following base character"
Msgs$(7) = ""
Msgs$(8) = ""
Msgs$(9) = ""
Msgs$(10) = ""          'Wonder if there's a better way..

AnselBasesConv$ = "LØÐÞÆŒ'·b®±OU’?‘lødþæœ" + CHR$(34) + "i£ð?ou??°lp©#¿¡"
'above is ANSEL to ANSI ("ISO") conversn table (base characters, &HA1-C6)
'In above, the '?'s are "future" and so might have to be changed.
'Also see note in FixUperChars
CombinCrit$ = "áâãäèéêð"   'grave,acute,circum,tilde,diere,hacec,angstr,cedil
'programmer CAUTION! The characters in CombinCrit$ must also be duplicated
'  in a CASE stmt's expression that calls SpclCrit! (There they're in hex)

CombinBase$(1) = "AEIOUaeiou"         'these are indexed by CombinCrit$
CombinBase$(2) = "AEIOUYaeiouy"
CombinBase$(3) = "AEIOUaeiou"
CombinBase$(4) = "ANOano"
CombinBase$(5) = "AEIOUYaeiouy"
CombinBase$(6) = "Ss"
CombinBase$(7) = "Aa"
CombinBase$(8) = "Cc"

CombinChar$(1) = "ÀÈÌÒÙàèìòù"         'these must be sync'd w/ CombinBase
CombinChar$(2) = "ÁÉÍÓÚÝáéíóúý"
CombinChar$(3) = "ÂÊÎÔÛâêîôû"
CombinChar$(4) = "ÃÑÕãñõ"
CombinChar$(5) = "ÄËÏÖÜŸäëïöüÿ"      'that last one is &HFF (l.c. y-dieresis)
CombinChar$(6) = "Å Å¡"
CombinChar$(7) = "Åå"
CombinChar$(8) = "Çç"

Chop245$ = "#$%&(*+,-./:;<=>?@"      'Punct not allowed in 091 at end of what"
                     '   comes from 245a
passctr% = 0
outcount% = 0

PRINT #3, "Beginning at time: "; TIME$
PRINT "Inetmarc: converts MARC records for Internet use. Ver. 2.6 Feb 2004"

DO                      ' MAIN LOOP
GetRecord              ' Read a record and parse it.
IF EOF(1) THEN EXIT DO
MassageRecord          ' Process it; make notes as needed in log file.
WriteRecord            ' Write out the processed record
WriteLog               ' Write out any accumulated messages
passctr% = passctr% + 1
IF (passctr% AND 127) = 0 THEN PRINT "Completed"; passctr%; " records"
MARCdata = ""                         'CLEAR MARCdata
OutMARCdata = ""                      'CLEAR OutMARCdata

LOOP
PRINT #3, "Ending at time: "; TIME$
PRINT "Total records input: "; passctr%
CLOSE 1, 2, 3           'Close files [END would do this].
SYSTEM
END

SUB AddSubfield (TagIn$, AfterField$, FieldLabel$, FieldText$)
'AddSubfield inserts a subfield labeled FieldLabel$ in field with tag
' TagIn$ after subfield AfterField$ if it exists.
'The new subfield has text FieldText$.
FldPtr% = 0             'Sequence through the fields
DO
FldPtr% = FldPtr% + 1                   'Search for the specified tag
IF fld(FldPtr%).tag = TagIn$ THEN      'We will add the subfield
count% = 0
   DO                                    'See if AfterSubfield$ is present
     count% = count% + 1
     IF dataId(FldPtr%, count%) = AfterField$ THEN EXIT DO
   LOOP UNTIL count% = fld(FldPtr%).subscount
  
   'Since the field exists, we know we will add a subfld. Bump max if needed.
   IF fld(FldPtr%).subscount = MaxSubs% THEN   'Make more room
     MaxSubs% = MaxSubs% + 1    'at the moment this is of no use elsewhere
   END IF
   fld(FldPtr%).subscount = fld(FldPtr%).subscount + 1
   'Now add the new subfield. Put it after where Count% points.
   'Unless AfterSubfield is missing or is last one, move following subfields
   IF count% < (fld(FldPtr%).subscount - 1) THEN        'to make room.
    Cnt% = fld(FldPtr%).subscount - 1              'prepare to move down 1
    DO
     dataId(FldPtr%, Cnt% + 1) = dataId(FldPtr%, Cnt%)
     MARCptr(FldPtr%, Cnt% + 1) = MARCptr(FldPtr%, Cnt%)
     MARClengs(FldPtr%, Cnt% + 1) = MARClengs(FldPtr%, Cnt%)
     Cnt% = Cnt% - 1
    LOOP UNTIL Cnt% = count%
   END IF
   'If AfterSubfield doesn't exist or is last, we put the new sbfld at end of field.
   count% = count% + 1                          'set to spot for new subfld
   dataId(FldPtr%, count%) = FieldLabel$
   MARClengs(FldPtr%, count%) = LEN(FieldText$)
   MARCptr(FldPtr%, count%) = LEN(MARCdata) + 1
   MARCdata = MARCdata + FieldText$
END IF                         'goes with fld(FldPtr%).Tag = TagIn$
LOOP UNTIL FldPtr% = InFlds%    'We assume/allow multiple instances of tags
END SUB

SUB BadUper (Cs$, index%)
MID$(Cs$, index%, 1) = "?"      'replace reserved or not allowed w/ '?'
stringchanged% = TRUE
SetMsg (5)
END SUB

FUNCTION CountSubs% (FldPtr%)
'Find out how many subfields are in the field pointed to by FldPtr%
'If this field is a control field (its tag is within 000-009), return -1
' (this is a special case; control fields never have subfields)
  IF LEFT$(fld(FldPtr%).tag, 2) = "00" THEN
    CountSubs% = -1                           'mark spcl case
    EXIT FUNCTION
  END IF
  count% = 1                                  'we know there's one
  'Compute the following to speed up
  txtptrA% = fld(FldPtr%).fstart + 4          'skip over it, delim, 2 indicators char
  limitA% = fld(FldPtr%).fstart + fld(FldPtr%).fldlen

  DO
  IF MID$(MARCdata, txtptrA%, 1) = DL THEN
    count% = count% + 1
  END IF
  txtptrA% = txtptrA% + 1
  LOOP UNTIL txtptrA% >= limitA%
  CountSubs% = count%
END FUNCTION

SUB DelChar (Cs$, deldex%)  'Remove character in Cs$ pointed to by deldex%
'If a change is made (which it will be) set flag stringchanged% = TRUE
'calling routine must check new length & deal with

Cstemp$ = RIGHT$(Cs$, LEN(Cs$) - deldex%)
Cs$ = LEFT$(Cs$, deldex% - 1) + Cstemp$
deldex% = deldex% - 1           'calling routine is expected to increment
stringchanged% = TRUE
END SUB

SUB DelField (TagIn$) 'DelField removes field(s) TagIn$, if present.

'We assume there may be duplicated field tags; all will be removed.
'Find the fields which have the tag in the call.

FldPtr% = 0             'Sequence through the fields
DO
  FldPtr% = FldPtr% + 1   'Search for the specified tag
  IF fld(FldPtr%).tag = TagIn$ THEN
  'Remove this field - by moving up all following fields
    FldCnt% = FldPtr%
    DO UNTIL FldCnt% = InFlds%  'if fld to del is last one, skip this
      count% = 0
      SubsCnt% = fld(FldCnt% + 1).subscount  'varbl used to speed up
      DO                 'move the subfields data
    count% = count% + 1
    dataId(FldCnt%, count%) = dataId(FldCnt% + 1, count%)
    MARCptr(FldCnt%, count%) = MARCptr(FldCnt% + 1, count%)
    MARClengs(FldCnt%, count%) = MARClengs(FldCnt% + 1, count%)
      LOOP UNTIL count% = SubsCnt%
      fld(FldCnt%) = fld(FldCnt% + 1)  'move the field data struc
      FldCnt% = FldCnt% + 1
    LOOP                'goes with DO UNTIL FldCnt% = InFlds%
    InFlds% = InFlds% - 1  'delete from count of fields
    FldPtr% = FldPtr% - 1  'cause test of first moved-up field, if not last field
  END IF                'goes with IF fld(FldPtr%).Tag = TagIn$ THEN
LOOP UNTIL FldPtr% = InFlds%                  'goes with DO (1st)
END SUB

SUB DelSubfield (TagIn$, SField$)  'DelSubfield removes subfield SField$ from fields with tag TagIn$
'We assume there may be duplicated field tags but no duplicate subfields
'  within a particular field.
'Find the fields which have the tag in the call.

FldPtr% = 0             'Sequence through the fields
DO
FldPtr% = FldPtr% + 1   'Search for the specified tag
IF fld(FldPtr%).tag = TagIn$ THEN
   'See if the specified subfield is present
   count% = 0
   DO
     count% = count% + 1
     IF dataId(FldPtr%, count%) = SField$ THEN
     'Move up all the following subfields and decrease the count
       Cnt% = count%
       DO UNTIL Cnt% = fld(FldPtr%).subscount
     dataId(FldPtr%, Cnt%) = dataId(FldPtr%, Cnt% + 1)
     MARCptr(FldPtr%, Cnt%) = MARCptr(FldPtr%, Cnt% + 1)
     MARClengs(FldPtr%, Cnt%) = MARClengs(FldPtr%, Cnt% + 1)
     Cnt% = Cnt% + 1
       LOOP
       fld(FldPtr%).subscount = fld(FldPtr%).subscount - 1
       EXIT DO          'Assumed: no duplicate subfields
     END IF
   LOOP UNTIL count% = fld(FldPtr%).subscount
END IF
LOOP UNTIL FldPtr% = InFlds%
END SUB

FUNCTION FindFld% (Atag$)
'Return the sequence number of the field with tag Atag$

FldPtr2% = 0             'Sequence through the fields
DO                      'Search for just past the specified tag
FldPtr2% = FldPtr2% + 1
  IF fld(FldPtr2%).tag = Atag$ THEN
    FindFld% = FldPtr2%
    EXIT FUNCTION  'Now we've found the spot
  END IF
LOOP UNTIL FldPtr2% = InFlds%
FindFld% = 0
END FUNCTION

FUNCTION FindSubFld% (Ftag%, Sf$)
'Return the subfield sequence number of the sbfld in field Ftag% with id Sf$

SfCount% = 0
DO
SfCount% = SfCount% + 1
  IF dataId(Ftag%, SfCount%) = Sf$ THEN
    FindSubFld% = SfCount%
    EXIT FUNCTION  'Now we've found the sequence number
  END IF
LOOP UNTIL SfCount% = fld(Ftag%).subscount
FindSubFld% = 0
END FUNCTION

SUB FixBase (Cs$, index%)
t1% = ASC(MID$(Cs$, index%, 1))
t2$ = MID$(AnselBasesConv$, t1% - &HA0, 1)
MID$(Cs$, index%, 1) = t2$
stringchanged% = TRUE
'If table output is '?' there's some problem ('?' is output). Flag this fact.
IF t2$ = "?" THEN SetMsg (5)
END SUB

SUB FixUperChars (FldPtr%)
'Convert characters of codes > &HA0 from ANSEL (MARC's choice) to ANSI/ISO
'Base characters are converted to something even if not too close.
'If a diacritic (>&HDF) and/or it + following base char has no ANSI/ISO
' equivalent the diacritic is deleted (and base is kept).
'If we find a character that needs to be changed or deleted we modify the
'  current subfield (string) and put it in place of the current one.

count% = 0                      'Scan through the subfields
DO                              'once per subfield
  count% = count% + 1
  IF MARClengs(FldPtr%, count%) > 0 THEN
    Cs$ = MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%, count%))
      'current string
    index% = 0
    stringchanged% = FALSE
    DO                            'once per character
      index% = index% + 1
      SELECT CASE ASC(MID$(Cs$, index%, 1))
    CASE &HE0, &HE5 TO &HE7, &HEB TO &HEF, &HF1 TO &HFB, &HFE
      DelChar Cs$, index%    'always delet (legl ANSEL/no ANSI(ISO) equiv
    CASE &HA1 TO &HC6      'note: many in &H80-&HDF are "reserved";
         'might have to change this. Also: def AnselBasesConv$
      FixBase Cs$, index%                 'xlate a base to something
    CASE &HE1 TO &HE4, &HE8, &HE9, &HEA, &HF0  'diacrit might combine
      SpclCrit Cs$, index%
    CASE &HA0 TO &HFF                     'something unexpected >= &HA0
      BadUper Cs$, index%
      END SELECT
    LOOP UNTIL index% = LEN(Cs$)              'one string completed
    IF stringchanged% = TRUE THEN             'copy new string in place of old
      MID$(MARCdata, MARCptr(FldPtr%, count%), LEN(Cs$)) = Cs$
      MARClengs(FldPtr%, count%) = LEN(Cs$)
    END IF
  END IF
LOOP UNTIL count% = fld(FldPtr%).subscount
END SUB

FUNCTION GetId$ (Fptr%, count%)    ' Get subfield id, start adr, length
STATIC scanptr%                                 'keep startpoint for next call
IF count% = 1 THEN                            'initialize on first call
    scanptr% = fld(Fptr%).fstart + 2            'point to first delimiter
END IF
  scanptr% = scanptr% + 1                       'point just past delimiter
  GetId$ = MID$(MARCdata, scanptr%, 1)          'return subfield id
  holdptr% = scanptr% + 1                       '"return" point just past subfld id

DO                                            'main loop
  scanptr% = scanptr% + 1                       'move text pointer in MARCdata
  tmpchar$ = MID$(MARCdata, scanptr%, 1)        'get next char in MARCdata (speed up)
LOOP UNTIL tmpchar$ = DL OR tmpchar$ = FT

holdleng% = scanptr% - holdptr%

END FUNCTION

SUB GetRecord

'Read a record into 3 top-level strings
skipflag% = FALSE       'Will be set true if record to be omitted fm outpt

  GET 1, , Leader       'Read first element of MARC record (24 char)
  IF EOF(1) THEN EXIT SUB
  InRecLen& = VAL(LEFT$(Leader, 5))              'Curen input rec length
'    Note: this includes everything - all of leader thru rec terminator.

  DirecLen% = VAL(MID$(Leader, 13, 5)) - 24      '(Base of data)-(leader len)
'     Note! This includes the field term'r at end of directory!
  DataLen& = InRecLen& - DirecLen% - 24         'incl RT
  Directory = INPUT$(DirecLen%, 1)              'Get the directory
  MARCdata = INPUT$(DataLen&, 1)                'Get the rest of the record
'
' Set up a structure for the field-wide data and fill it from
'   Directory informaton.
'
InFlds% = (DirecLen% - 1) \ 12   'len incl term'r; each entry: 12 long; refers to INPUT!
REDIM fld(1 TO 2 * InFlds% + 12) AS fldstruc        '2 xtra to insert 001,3; 10 for expans

FldPtr% = 0                                     'Initialize pointer to field struc
DirecPtr% = 0
MaxSubs% = 1                                    'Will find max no. of subfields

DO
  DirecPtr% = DirecPtr% + 1
  
  FldPtr% = FldPtr% + 1
  fld(FldPtr%).tag = MID$(Directory, 1 + 12 * (DirecPtr% - 1), 3)
  fld(FldPtr%).fldlen = VAL(MID$(Directory, 4 + 12 * (DirecPtr% - 1), 4))
  fld(FldPtr%).fstart = VAL(MID$(Directory, 8 + 12 * (DirecPtr% - 1), 5)) + 1   '+1 to accom

BASIC's ind's
  IF LEFT$(fld(FldPtr%).tag, 2) <> "00" THEN
    fld(FldPtr%).indics = MID$(MARCdata, fld(FldPtr%).fstart, 2)
  END IF
  fld(FldPtr%).subscount = CountSubs%(FldPtr%)      'tags 00x get -1
  IF fld(FldPtr%).subscount > MaxSubs% THEN
      MaxSubs% = fld(FldPtr%).subscount
  END IF
LOOP UNTIL DirecPtr% = InFlds%

'For each field, find & store the subfield codes and pointers to assoc. text

REDIM dataId(1 TO 2 * FldPtr% + 10, 1 TO MaxSubs% + 10) AS STRING * 1
REDIM MARCptr(1 TO 2 * FldPtr% + 10, 1 TO MaxSubs% + 10) AS LONG   'extra 2x+10, 10

for expansion
REDIM MARClengs(1 TO 2 * FldPtr% + 10, 1 TO MaxSubs% + 10) AS INTEGER 'holds

subfields' txt lengths
FldPtr% = 0                                     'Initialize pointer to fields

DO
  FldPtr% = FldPtr% + 1
  IF LEFT$(fld(FldPtr%).tag, 2) <> "00" THEN    'these ctrl flds have no subfields
    count% = 0
    DO
      count% = count% + 1
      dataId(FldPtr%, count%) = GetId$(FldPtr%, count%)
      MARCptr(FldPtr%, count%) = holdptr%
      MARClengs(FldPtr%, count%) = holdleng%
    LOOP UNTIL count% = fld(FldPtr%).subscount
  END IF

LOOP UNTIL FldPtr% = InFlds%
IF InRecLen& > 6000 THEN            'Reject record to avoid overload of mem!
  skipflag% = TRUE
  PRINT "Input rec length"; InRecLen&; " Previous Barcode "; CurentBar$; "  Input recno."; passctr%
  PRINT #3, "Input rec length"; InRecLen&; " Previous Barcode "; CurentBar$; "  Input recno.";

passctr%
END IF
END SUB

FUNCTION InsertFld% (NewTag$)
'Makes space in the fld() structure and in the subfield info arrays
' for one field. Location is after the field(s) with tag the same as
' NewTag$ or after a lesser tag value if the same-as tag doesn't exist.
' Returns the "pointer" (sequence number) of the space.
'DON'T FORGET TO CHECK AND INCREASE MaxSubs% IF NECESSARY, at the point
' where the subfields are put into this inserted space (likely MassageRecord)
FoundIt% = 0            'So we can tell if new tag goes at end
FldPtr% = 0             'Sequence through the fields
DO                      'Search for just past the specified tag
FldPtr% = FldPtr% + 1
  IF fld(FldPtr%).tag > NewTag$ THEN   'Now we've found the spot
    FoundIt% = 1
    'Move down the remaining fields and data
    FldCnt% = InFlds%   'max fld # before insertion
    DO UNTIL FldCnt% = FldPtr% - 1
      SubsCnt% = fld(FldCnt%).subscount  'varbl used to speed up
      IF SubsCnt% >= 0 THEN  'omit if ctrl fld (no subflds): tag < 010
    count% = 0
    DO                 'move the subfields data
      count% = count% + 1
      dataId(FldCnt% + 1, count%) = dataId(FldCnt%, count%)
      MARCptr(FldCnt% + 1, count%) = MARCptr(FldCnt%, count%)
      MARClengs(FldCnt% + 1, count%) = MARClengs(FldCnt%, count%)
    LOOP UNTIL count% = SubsCnt%
      END IF
      fld(FldCnt% + 1) = fld(FldCnt%) 'move the field data struc
      FldCnt% = FldCnt% - 1
    LOOP
    EXIT DO
  END IF
LOOP UNTIL FldPtr% = InFlds%
IF FoundIt% = 0 THEN FldPtr% = InFlds% + 1    'case: annex to end
InsertFld% = FldPtr%               'Return sequence number of the insert
InFlds% = InFlds% + 1
END FUNCTION

SUB MassageRecord
'Capture the record ID (fld 001) in Curentbar$
'Take care of the modifications needed
'NOTE: we update MaxSubs$; since the present plan allows for
'  addition of (2x + 10) subfields beyond what the incoming record contains,
'  we should not overflow.
IF skipflag% = TRUE THEN EXIT SUB            'This one to be excluded
IF fld(1).tag = "001" THEN
  CurentBar$ = MID$(MARCdata, fld(1).fstart, fld(1).fldlen - 1)
ELSE
CurentBar$ = "unknown"
SetMsg (1)
END IF

'In all data fields (non-control, tag > 009) prepare for ANSI char set
'Also discard all records which contain a 999 field (temporary records)
'  unless it's a journal (852p has 377413xx).

FldPtr% = 0
DO
  FldPtr% = FldPtr% + 1
  IF fld(FldPtr%).tag = "999" THEN     'keep only if journal; check 852p
    a1% = FindFld%("852")
    IF a1% = 0 THEN
      skipflag% = TRUE
      EXIT SUB
    END IF
    a2% = FindSubFld%(a1%, "p")       'get the 852p string so can examine
    IF a2% = 0 THEN
      skipflag% = TRUE
      EXIT SUB
    END IF
    a3$ = MID$(MARCdata, MARCptr(a1%, a2%), 6)
    IF INSTR(1, a3$, "377413") = 0 THEN
      skipflag% = TRUE
      EXIT SUB
    END IF
  END IF                         'goes with fld(FldPtr%).Tag="999"

  IF fld(FldPtr%).tag >= "010" THEN FixUperChars (FldPtr%)
        'non-ctrl fld so massage upper chars
LOOP UNTIL FldPtr% = InFlds%

'Find each 852, save its k,h,i,m; make a new field 092 for each 852
  'with only k,h,i,m
FldPtr% = 0
Got852% = FALSE
DO
  FldPtr% = FldPtr% + 1
  IF fld(FldPtr%).tag = "852" THEN
    Got852% = TRUE
    sk$ = ""            'initialize in case data missing
    sh$ = ""
    si$ = ""
    sm$ = ""
    count% = 0          'count how many sought excerpts are found
    DO                  'capture the 852 strings to be excerpted
      count% = count% + 1
      SELECT CASE dataId(FldPtr%, count%)
      CASE "k"
    sk$ = MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%, count%))
      CASE "h"
    sh$ = MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%, count%))
      CASE "i"
    si$ = MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%, count%))
      CASE "m"
    sm$ = MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%, count%))
      END SELECT
    LOOP UNTIL count% = fld(FldPtr%).subscount

'Put excrpts frm 852s in 092s
    substot% = 0
    Fld92Ptr% = InsertFld%("092")   'make a new one w/ only k, h, i, m sbflds
    FldPtr% = FldPtr% + 1           'compensate for the insertion
    fld(Fld92Ptr%).tag = ("092")
    fld(Fld92Ptr%).indics = "  "    'exactly two spaces
    IF sk$ <> "" THEN
      substot% = substot% + 1
      dataId(Fld92Ptr%, substot%) = "k"
      MARCptr(Fld92Ptr%, substot%) = LEN(MARCdata) + 1
      MARClengs(Fld92Ptr%, substot%) = LEN(sk$)
      MARCdata = MARCdata + sk$
    END IF
    IF sh$ <> "" THEN
      substot% = substot% + 1
      dataId(Fld92Ptr%, substot%) = "h"
      MARCptr(Fld92Ptr%, substot%) = LEN(MARCdata) + 1
      MARClengs(Fld92Ptr%, substot%) = LEN(sh$)
      MARCdata = MARCdata + sh$
    END IF
    IF si$ <> "" THEN
      substot% = substot% + 1
      dataId(Fld92Ptr%, substot%) = "i"
      MARCptr(Fld92Ptr%, substot%) = LEN(MARCdata) + 1
      MARClengs(Fld92Ptr%, substot%) = LEN(si$)
      MARCdata = MARCdata + si$
    END IF
    IF sm$ <> "" THEN
      substot% = substot% + 1
      dataId(Fld92Ptr%, substot%) = "m"
      MARCptr(Fld92Ptr%, substot%) = LEN(MARCdata) + 1
      MARClengs(Fld92Ptr%, substot%) = LEN(sm$)
      MARCdata = MARCdata + sm$
    END IF
    fld(Fld92Ptr%).subscount = substot%
    IF substot% > MaxSubs% THEN MaxSubs% = substot%
  END IF
LOOP UNTIL FldPtr% = InFlds%
IF Got852% = FALSE THEN SetMsg (2)

'Now we compose a new field, 091, using 245; 100|110|111|130 (parts); 260c
Ptr245% = FindFld%("245")
IF Ptr245% = 0 THEN
  SetMsg (3)
ELSE
  count% = FindSubFld%(Ptr245%, "a")
  IF count% > 0 THEN
    build$ = MID$(MARCdata, MARCptr(Ptr245%, count%), MARClengs(Ptr245%, count%))
    z$ = RIGHT$(build$, 1)
    DO WHILE z$ <= "!" OR INSTR(1, Chop245$, z$)
      build$ = LEFT$(build$, LEN(build$) - 1)
      z$ = RIGHT$(build$, 1)
    LOOP
  END IF
END IF                           'We've finished 245a

build$ = build$ + " / "

IF FindFld%("100") > 0 THEN     'add from 100,110,111,or 130
  FldPtr% = FindFld%("100")
  count% = FindSubFld%(FldPtr%, "a")
  IF count% > 0 THEN       'avoid missing-data case; just skip (when = 0)
    build$ = build$ + MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%,

count%))
  END IF
ELSEIF FindFld%("110") > 0 THEN
  FldPtr% = FindFld%("110")
  count% = FindSubFld%(FldPtr%, "a")
  IF count% > 0 THEN
    build$ = build$ + MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%,

count%))
  END IF
ELSEIF FindFld%("111") > 0 THEN
  FldPtr% = FindFld%("111")
  count% = FindSubFld%(FldPtr%, "a")
  IF count% > 0 THEN
    build$ = build$ + MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%,

count%))
  END IF
ELSEIF FindFld%("130") > 0 THEN
  FldPtr% = FindFld%("130")
  count% = FindSubFld%(FldPtr%, "a")
  IF count% > 0 THEN
    build$ = build$ + MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%,

count%))
  END IF
  count% = FindSubFld%(FldPtr%, "l")
  IF count% > 0 THEN
    build$ = build$ + MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%,

count%))
  END IF
  count% = FindSubFld%(FldPtr%, "s")
  IF count% > 0 THEN
    build$ = build$ + MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%,

count%))
  END IF
END IF
build$ = build$ + " "               'exactly one space
IF FindFld%("260") > 0 THEN
  FldPtr% = FindFld%("260")
  count% = FindSubFld%(FldPtr%, "c")
  IF count% > 0 THEN
    build$ = build$ + MID$(MARCdata, MARCptr(FldPtr%, count%), MARClengs(FldPtr%,

count%))
  END IF
END IF
FldPtr% = InsertFld%("091")   'make a place to insert the new field data
fld(FldPtr%).tag = ("091")
fld(FldPtr%).subscount = 1
fld(FldPtr%).indics = "  "    'exactly two spaces
dataId(FldPtr%, 1) = "a"
MARCptr(FldPtr%, 1) = LEN(MARCdata) + 1
MARClengs(FldPtr%, 1) = LEN(build$)
MARCdata = MARCdata + build$

END SUB

SUB OpenFiles 'Open files; fixed-name until develop more user i/f.

OPEN "inrecs." FOR BINARY ACCESS READ AS 1
SHELL "if exist outrecs. del outrecs"
OPEN "outrecs." FOR BINARY ACCESS WRITE AS 2
OPEN "recslog." FOR OUTPUT AS 3
END SUB

SUB SetMsg (i%)
DoMsgs%(i%) = 1
END SUB

SUB SpclCrit (Cs$, index%)
'A possibly-combinable diacritic has been found (at index%). The following
'character could be either a base or a diacritic.
'If the diacritic and the subseq. base are combinable, delete any inter-
'vening diacritics and replace the (first) diacritic+base with the com-
'bined form.
'If the diacritic and the subseq. base are not combinable, delete the
'diacritic and return (if there are intervening diacritics they will
'automatically be tried next).

'Find the next base
Crit$ = MID$(Cs$, index%, 1)            'the diacritic of the call
index2% = index% + 1
DO WHILE index2% <= LEN(Cs$)
  basechar$ = MID$(Cs$, index2%, 1)             'tentatively
  IF ASC(basechar$) < &HC7 THEN EXIT DO         'found a base char
  index2% = index2% + 1
LOOP
IF index2% > LEN(Cs$) THEN                 'error condition
  SetMsg (6)                'We'll delete the diacritic since no base for it
  DelChar Cs$, index%           'stringchanged% will be set true, ind. fixed
  EXIT SUB
END IF

'now index2% points to base; is it combinable?
baselist% = INSTR(1, CombinCrit$, Crit$)    'find list of allowed bases
    'Programmer CAUTION! see at defin of CombinCrit$
basedex% = INSTR(1, CombinBase$(baselist%), basechar$)
IF basedex% = 0 THEN            'not combinable
  DelChar Cs$, index%           'stringchanged% will be set true, ind. fixed
  EXIT SUB
END IF

'combinable base (see prose at top); delete any intervening diacritics
index2% = index2% - 1         'point index2% to 'critic just before the base
DO WHILE index2% > index%
  DelChar Cs$, index2%          'index2% will be decremented
LOOP
'find and substitute the combination
MID$(Cs$, index%, 1) = MID$(CombinChar$(baselist%), basedex%, 1)
index% = index% + 1             'point to the (old) base char
DelChar Cs$, index%             'delete the (old) base char
END SUB

SUB WriteLog
FOR i% = 1 TO 10
IF DoMsgs%(i%) > 0 THEN
  PRINT #3, "Bar code "; CurentBar$; " "; Msgs$(i%); " Input recno."; passctr%; "Output recno.";

outcount%
  DoMsgs%(i%) = 0                        'reset
END IF
NEXT i%
END SUB

SUB WriteRecord
'Create the new record and write it out.
' Make new variable-fields string (OutMARCdata)
' Make new directory (recall: it has tag, length, start adr rel base adr of data)
' Put new record length and base address of data (=direclen+1) into leader
' Write out leader, directory, variable-fields string.
'
IF skipflag% = TRUE THEN EXIT SUB       'current record not wanted in output

Directory = ""                          'clear out the old directory
OutMARCdata = ""
FldPtr% = 0
OutMARCptr% = 0

DO
  FldPtr% = FldPtr% + 1
  Directory = Directory + fld(FldPtr%).tag

'Handle control fields here, w/ code separate from variable (data) fields
  IF LEFT$(fld(FldPtr%).tag, 2) = "00" THEN    'these flds have no subfields
    Directory = Directory + Zerostr$(fld(FldPtr%).fldlen, 4)  '4-char, zero-padded string
    Directory = Directory + Zerostr$(LEN(OutMARCdata), 5)  '5-char, zero-padded string
      'Actually a PTR, is automagicly adj for zero-based offsets req'd by MARC
    OutMARCdata = OutMARCdata + MID$(MARCdata, fld(FldPtr%).fstart, fld(FldPtr%).fldlen)
      'Abov concat'ed string includes an FT
  ELSE

'Here handle the data fields
    count% = 0
    OutMARCptr% = LEN(OutMARCdata)              'field strt loc, 0-based
    OutMARCdata = OutMARCdata + fld(FldPtr%).indics   'indicator 2-char, once per field
    Flen% = 2                                   'takes care of the indicators
  
    DO
      count% = count% + 1
      Flen% = Flen% + MARClengs(FldPtr%, count%) + 2   '+2 for DL, ID

      OutMARCdata = OutMARCdata + DL + dataId(FldPtr%, count%) + MID$(MARCdata,

MARCptr(FldPtr%, count%), MARClengs(FldPtr%, count%))
    LOOP UNTIL count% = fld(FldPtr%).subscount

  'End-of-field stuff follows
    OutMARCdata = OutMARCdata + FT              'Add the terminator
    Flen% = Flen% + 1                           'And count it
    Directory = Directory + Zerostr$(Flen%, 4)  '4-char, zero-padded string
    Directory = Directory + Zerostr$(OutMARCptr%, 5)  '5-char, zero-padded string

  END IF
LOOP UNTIL FldPtr% = InFlds%

'End-of-record stuff follows
Directory = Directory + FT
OutMARCdata = OutMARCdata + RT                  'Add the terminator
MID$(Leader, 13, 5) = Zerostr$(LEN(Directory) + 24, 5)  '("Base adr of data")
MID$(Leader, 1, 5) = Zerostr$(LEN(OutMARCdata) + LEN(Directory) + 24, 5)

'Write it all out!!
PUT 2, , Leader
PUT 2, , Directory
PUT 2, , OutMARCdata
outcount% = outcount% + 1                  'count one record output

END SUB

FUNCTION Zerostr$ (value%, zstringlen%)
Zerostr$ = STRING$(zstringlen% - LEN(LTRIM$(STR$(value%))), "0") +

(LTRIM$(STR$(value%)))
END FUNCTION

[Dekkerfan]

above is the whole code for the program, sorry, I haven't programmed since college, many years ago. we had people walking on the moon back then!

[Dekkerfan]

thanks whitetiger0990 - I just downloaded the freebasic program, compiled and ran the program, it finished with no errors!
now to check to see if I got what I should have.

edit update: it looks good! thanks for the help!

[Anonymous]

hell yea, good to hear freebasic did the job

[Dr_Davenstein]

hell yea, good to hear freebasic did the job

WooHoo!!!