Conversion script: link fix

2015-02-26T23:48:55Z

link fix

New page

<pre>
* HOLLLOAD - Does a hollerith load of a data file
************************************************************************

PROGRAM HOLLLOAD

* takes the file name and a list of field names, retrieving them into the
* &HOLD& file as a fixed-width dump. The width is recovered from the dict.
* Sub-values are not handled.

* !!! WARNING - This routine will destroy any existing data in records it
* overwrites.

************************************************************************

ARGS = CONVERT( " ", @FM, TRIM( UPCASE( @SENTENCE)))
LOCATE "HOLLLOAD" IN ARGS<1> SETTING NAMEPOSN ELSE GOTO SYNTAX:

FILENAME = ARGS<NAMEPOSN+1>
IF FILENAME EQ "" THEN GOTO SYNTAX:
HOLDFILENAME = ARGS<NAMEPOSN+2>
FIELDCOUNT = DCOUNT( ARGS, @FM) - (NAMEPOSN+2)

DIM DICTENTRIES( FIELDCOUNT)

OPEN "", FILENAME TO FILEPTR ELSE STOP "Unable to open ":FILENAME
OPEN "DICT", FILENAME TO DICTPTR ELSE STOP "Unable to open DICT ":FILENAME
OPEN "", "&HOLD&" TO HOLD ELSE STOP "Unable to open the &HOLD& file"

MAXFIELD = 0
FOR II = 1 TO FIELDCOUNT
IF ARGS<NAMEPOSN+2+II> EQ "FMT" THEN
* need to strip LRT here because it's last entry not current entry ...
DICTENTRIES(II-1)<5> = CONVERT( \'"LRT\ , "", ARGS<NAMEPOSN+3+II>)
DEL ARGS<NAMEPOSN+2+II>; DEL ARGS<NAMEPOSN+2+II>
FIELDCOUNT -= 2
IF II GT FIELDCOUNT THEN EXIT
END

READ DICTENTRIES(II) FROM DICTPTR, ARGS<NAMEPOSN+2+II> ELSE STOP "Unable to read ":ARGS(NAMEPOSN+2+II):" from dictionary"
IF DICTENTRIES(II)[1,1] NE "D" THEN STOP "Fields for loading must be D-type"
IF DICTENTRIES(II)<2> GT MAXFIELD THEN MAXFIELD = DICTENTRIES(II)<2>
DICTENTRIES(II)<5> = CONVERT( "LRT", "", DICTENTRIES(II)<5>)
IF NUM( DICTENTRIES(II)<5> ) ELSE STOP "Dict entry for ":ARGS<NAMEPOSN+2+II>:" format is illegible"
NEXT
IF DICTENTRIES(1)<2> NE 0 THEN STOP "First field to load must be @ID or equivalent"

OPENSEQ "&HOLD&", HOLDFILENAME TO SEQPTR ELSE STOP "Unable to open ":HOLDFILENAME:" in &HOLD&"

DIM DATAREC( MAXFIELD)
OLDKEY = ""
LOOP

READSEQ LINE FROM SEQPTR ELSE LINE = ""
LINEPOS = 1
FIELDLEN = DICTENTRIES(1)<5> ;* note this has had L[[/R/T]] stripped ...
KEY = TRIM( LINE[1, DICTENTRIES(1)<5>])
LINEPOS += FIELDLEN

IF KEY NE OLDKEY THEN
IF OLDKEY NE "" THEN
MATWRITE DATAREC TO FILEPTR, OLDKEY
RELEASE
END
OLDKEY = KEY
MAT DATAREC = ""
VALUENO = 1
END ELSE VALUENO += 1

WHILE LINE

FOR II = 2 TO FIELDCOUNT
FIELDLEN = DICTENTRIES(II)<5>
IF VALUENO EQ 1 OR DICTENTRIES(II)<6> EQ "M" THEN
VALUE = TRIM( LINE[LINEPOS, FIELDLEN])
LINEPOS += FIELDLEN
IF VALUE NE "" THEN DATAREC(DICTENTRIES(II)<2>)<1,VALUENO> = VALUE
END
NEXT

REPEAT

RETURN

********************************
SYNTAX:
PRINT "Syntax is:"
PRINT "RUN GBP HOLLLOAD filename holdfilename id-field [fieldname [fieldname...]]"
RETURN
END
</pre>

HollLoad - Revision history

Conversion script: link fix