We had a little program that would let any user create one specific type of mailing label, with one dictionary item (field) of their choice per line. I generalized this to any kind of label, multiple dictionary items or constant literals per line. Since it takes a form, plus a format, and generates stuff, I called the program “FORMATION.” (Also the platform was Prime INFORMATION.) Here’s one routine from it: 

*
* Format a single label
*

FORM.LABEL:
      MAT LABEL = ""
      NEXT.PRINT.LINE = 1
      PRINTED.LINES = 1

* Changed "TO FORM.HEIGHT" to "TO LINES.USED" to skip blank lines faster
      FOR LINE = 1 TO LINES.USED

         ITEM.NO = 1
         MAX.PARTS = 1
         LOOP

            THISJOIN = JOINS(LINE,ITEM.NO)
            THISDICT = IDATA(LINE,ITEM.NO)
            FIRST.BYTE = THISDICT[1,1]
            THISF2 = THISDICT<2>
            BEGIN CASE

* If this isn't a literal, it must be a dictionary item
               CASE FIRST.BYTE # "'" AND FIRST.BYTE # '"'
* Either an I-type..
                  IF FIRST.BYTE = "I" THEN
                     TEXT = ITYPE(THISDICT)
                  END ELSE
* ...or a D-type (0 is the record ID, non-zero is a field location)
                     IF THISF2 THEN TEXT = @RECORD
                        ELSE TEXT = @ID
                  END
* Convert to upper if user wanted that
                  IF UPPER THEN CONVERT LOWERCASE TO UPPERCASE IN TEXT
* Do any output conversion (multivalued if necessary)
                  IF THISDICT<3> # "" THEN
                     CALL @OCONVS(RESULT,TEXT,THISDICT<3>)
                     TEXT = RESULT
                  END
                  IF THISJOIN = "," THEN
                     CALL @FMTS(RESULT,TEXT,THISDICT<5>)
                     TEXT = RESULT
                     CONVERT @TM TO @VM IN TEXT
                  END

* If this starts with a quote, it must be a literal
               CASE FIRST.BYTE = "'" OR FIRST.BYTE = '"'
                  TEXT = THISDICT[2,999]

* Not a dict, not a literal?  Oops!
               CASE 1
                  STOP "IDATA error -- call a programmer!"

            END CASE

* Now build all of that into the label!

            PARTS = COUNT(TEXT,@VM)+1
            IF PARTS > MAX.PARTS THEN MAX.PARTS = PARTS
            MAT STARTPOS = ""
            FOR PART = 1 TO PARTS
               IF THISJOIN = ";"
                  THEN TEXT<1,PART> = TEXT<1,PART>: " "
               PRINTED.LINES = NEXT.PRINT.LINE + PART - 1
* Handle mixed single- and multi-valued items
               IF THISDICT<6> = "M" AND ITEM.NO > 1 AND PART = 1 THEN
                  STARTPOS(ITEM.NO) = LEN(LABEL(PRINTED.LINES))
               END
               IF THISDICT<6> = "M" AND ITEM.NO > 1 AND PART > 1 THEN
                  LABEL(PRINTED.LINES) := SPACE(STARTPOS(ITEM.NO)-LEN(LABEL(PRINTED.LINES)))
               END
               LABEL(PRINTED.LINES) := TEXT<1,PART>
            NEXT PART

         UNTIL JOINS(LINE,ITEM.NO) = "" DO
            ITEM.NO += 1
         REPEAT

         IF LEN(LABEL(NEXT.PRINT.LINE)) > FORM.WIDTH THEN OVERRUN = TRUE
* We printed at least one line, so bump "next-print-line"
         NEXT.PRINT.LINE += MAX.PARTS
      NEXT LINE

NEXT.LABEL:
* Save original label and call ONE.LABEL once per copy needed.
* Previously we re-created the label for each copy.
      MAT ORIG.LABEL = MAT LABEL
      FOR COPY.I = 1 TO COPIES
         MAT LABEL = MAT ORIG.LABEL
         GOSUB ONE.LABEL
      NEXT COPY.I
      IF SAMPLE AND USERLABELS >= SAMPLESIZE THEN DONE = TRUE
      RETURN


[Back to home page]