View source for HollLoad

<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>