           SUBROUTINE (OID,GEN,STATUS,PSTYLE.OVRD,PRT.ON,DRPT,LOC.OVRD,PRT.LOC)
** Version# 0.0003[31] - 07/13/2010 - 12:19pm - SMITJR - eclipse
*** V0.0003 Change - Custom Coding . - 07/13/2010 - SMITJR - eclipse
** Copied from CBP TOE.PRINT.ORDER.LASER.B Version# 0.0004[1] - 06/04/2010 - 02:07pm - SMITJR -
** Copied from CBP TOE.PRINT.ORDER.LASER Version# 0.0003[1] - 05/20/2010 - 12:43pm - SMITJR -
*** V0.0002 Change - Custom Coding CZV696 - 02/17/2010 - JONW - UPGRADE
*** V0.0001 Change - Custom Coding FORMS.MOD - 11/29/2008 - ROYO - eclipse
*** Subroutine - TOE.PRINT.ORDER.LASER
*-------------------------------------------------------------------------*
*** Prints laser version of shipping and receiving transfer tickets
*-------------------------------------------------------------------------*
*** Variables:
***       OID         - Order ID                                      [In]
***       GEN         - Order Generation                              [In]
***       STATUS      - Print status determines which form will print [In]
***       PSTYLE.OVRD - Print style override                          [In]
***       PRT.ON      - Printer on flag                               [In]
***       DRPT        - Report Defaults                               [In]
***       LOC.OVRD    - Location Override, if this is set then the    [In]
***                     location will not be changed when printing
***                     ship tickets.
***       PRT.LOC     - Location that was used for printing          [Out]
*-------------------------------------------------------------------------*
*** Common: LED, LD, CUS, CUSS, PRD, PHANTOM.PROC, JAVA.PROC$
*-------------------------------------------------------------------------*

          DIM PSTYL(10)

          UT.OPEN.FILE "PRINT.STYLES",PSTYLFILE,ERR.MSG
          IF ERR.MSG THEN RETURN

          PG.LGTH = 66
          BOD.LINES = 31

          IF DRPT<29> THEN BOD.LINES -= 1

          FPTR   = STATUS<2>
          STATUS = STATUS<1>
          SV.LOC = LOCATION

          IF NOT(PHANTOM.PROC) AND NOT(PRT.ON) AND NOT(JAVA.PROC$) THEN
             WINDOW 15,8,50,5
             PRINT @(0,1):'Printing .... ':OID
          END

          MATREAD LED FROM LEDFILE,OID ELSE GOTO FINISH

          IF STATUS = '' THEN STATUS = LED(6)<1,GEN>

          IF GEN  = 1 THEN QSIGN = -1 ELSE QSIGN = 1

          BR = LED(2)<1,GEN,1>
          SHIP.BR = LED(2)<1,1,2>
          RECV.BR = LED(2)<1,2,2>
          BT.CN = LED(1)<1,GEN>
          ST.CN = LED(5)<1,GEN>
          GET.CUS BR,BT.CN,ST.CN,QSIGN

          IF LED(8)<1,GEN>='' THEN
             LDIDS = LED(49)
             CONVERT VM TO SVM IN LDIDS
          END ELSE
             LDIDS = LED(48)<1,GEN>
          END

          GOSUB INIT

          PRT.LOC = ''

          IF NOT(PRT.ON) THEN
             IF STATUS = 'F' AND (FPTR#'' AND FPTR# '*ANY*') THEN
                PRINTER.ON '@':FPTR,',80',RPT.DFLT=DRPT
             END ELSE
                IF STATUS # 'F' AND NOT(LOC.OVRD) THEN
                   PL.OPTS    = ''   ;* used to specify specific location
                                     ;* to be returned.
                   PL.OPTS<1> = YES  ;* get loc for shipticket branch
                   PL.OPTS<2> = YES  ;* return first match
                   PL.OPTS<4> = LED(70)<1,GEN> ;* for poss shipvia override
                   UT.GET.PTR.LOCS LED(2)<1,GEN,2>,LOCATION,PL.OPTS,ERR.MSG
                   IF LOCATION = "HERE" THEN
                      LOCATION = SV.LOC
                   END
                END
                IF LOC.OVRD THEN
                   LOCATION = LOC.OVRD
                END
                PRINTER.ON FORM
             END
          END

          PRT.LOC = LOCATION

          OE.LOG.PRINT OID,GEN,STATUS,DOC.ID,REPRINT

          LDID.CT = DCOUNT(LDIDS,SVM)
          FOR LD.NO = 1 TO LDID.CT
             LDID   = LDIDS<1,1,LD.NO>
             GOSUB PRT.LINE
          NEXT LD.NO

          PGS = INT((BLINE + BOD.LINES-1)/BOD.LINES)

          PRINT CHAR(27):"*p0y"
          PRINT CHAR(27):"&l1e6D":NORM:
          BLINE += 1
          BOD<BLINE> = ''
          BLINE += 1
          BOD<BLINE> = ''

          GOSUB HEADER
          GOSUB PRTBOD
          GOSUB FFEED

FINISH:   IF NOT(PRT.ON) THEN
             PRINTER.OFF
          END

          IF NOT(PHANTOM.PROC) AND NOT(PRT.ON) AND NOT(JAVA.PROC$) THEN
             WINDOW.CLOSE
          END

          LOCATION = SV.LOC

          RETURN
*-------------------------------------------------------------------------*
INIT:     *
          SSPC      = 20
          PAGE      = 0
          IN.FOOTER = NO
          BOD       = ''
          BLINE     = 0

          SLPI      = CHAR(27):"&l6D"
          ELPI      = CHAR(27):"&l8D"
          SMALL     = CHAR(27):'(8U':CHAR(27):'(s0p16.67h8.5v0s0b0T'
          MED       = CHAR(27):"(8U":CHAR(27):'(s0p12h0s3b3T'
          SUP.SMALL = CHAR(27):"(8U":CHAR(27):'(s0p20h0s0b0T'
          NORM      = CHAR(27):'(8U':CHAR(27):'(s0p10h12v0s0b3T'
          NORM.BOLD = CHAR(27):'(8U':CHAR(27):'(s0p10h12v0s1b3T'
          LARGE     = CHAR(27):'(8U':CHAR(27):'(s1p10h14v0s3b3T'
          XLARGE    = CHAR(27):'(8U':CHAR(27):'(s0p8h8v0s3b3T'

          INVN = LED(8)<1,GEN>
          IF INVN='' THEN
             ORD.ID = OID
          END ELSE
             ORD.ID = OID:'.':INVN"R%3"
          END

          FORM = 'PICK.TICKET'

          BEGIN CASE
          CASE STATUS = 'B'
             DOC.ID = 'Transfer Quote'
             FORM.STYLE = 'SENDER'
          CASE STATUS = 'O'
             FORM = 'SHIP.TICKET'
             DOC.ID = 'Transfer Packing Slip'
             IF GEN = 1 THEN
                FORM.STYLE = 'SENDER'
             END ELSE
                FORM.STYLE = 'PACK'
             END
             FORM = 'SHIP.TICKET'
          CASE STATUS = 'R'
             FORM = 'SHIP.TICKET'
             DOC.ID = 'Transfer Packing Slip'
             FORM.STYLE = 'PACK'
          CASE STATUS = 'S'
             READ LEDLREC FROM LEDLFILE, OID ELSE LEDLREC = ''
             LOCATE STATUS IN LEDLREC<1,GEN> SETTING POS THEN
                REPRINT = YES
             END ELSE
                REPRINT = NO
             END
             PRT.STAT = LEDLREC<9,GEN>
             IF REPRINT AND PRT.STAT # 'Y' THEN
                DOC.ID = 'Transfer Packing Slip'
                FORM = 'SHIP.TICKET'
                FORM.STYLE = 'PACK'
             END ELSE
                DOC.ID = 'Transfer Pick Ticket'
                FORM.STYLE = 'PICK'
             END
          CASE STATUS = 'T'       ;* for testing
             DOC.ID = 'Transfer Pick Ticket'
             FORM.STYLE = 'PICK'
          END CASE

          BEGIN CASE
          CASE FORM.STYLE = 'PICK'
             STYLE.ID = 'PICK'
             FORM.NAME = 'XFER.PICK.FORM'
             DESC.WIDTH = 39
          CASE FORM.STYLE = 'PACK'
             STYLE.ID = 'PACK'
             FORM.NAME = 'XFER.PACK.FORM'
             DESC.WIDTH = 35
          CASE OTHERWISE
             STYLE.ID = 'XFER'
             FORM.NAME = 'XFER.FORM'
             DESC.WIDTH = 39
          END CASE

          DOC.FORM.SPEC = ''
          READ DOC.FORM.REC FROM CTRLFILE, FORM.NAME THEN
             *GOSUB CNVRT.FORM
          END ELSE
             DOC.FORM.REC = ''
          END

          FRGHT.ALLW = LED(69)<1,GEN,1>

          SALESMAN = LED(72)<1,GEN>
          READV SALESMAN FROM INIFILE, SALESMAN, 3 ELSE NULL

          WRITER = LED(73)<1,GEN>
          READV WRITER FROM INIFILE, WRITER, 3 ELSE NULL

          ORD.BY   = LED(68)<1,GEN>
          SHIP.VIA = LED(70)<1,GEN>
          ORD.DATE = LED(4)<1,GEN>
          SHP.DATE = LED(9)<1,GEN>
          REQ.DATE = OCONV(LED(10)<1,GEN>, 'D2/')
          EXP.DATE = LED(31)<1,GEN>

          READV SHIP.ADDR FROM CUSFILE,LED(5)<1,GEN>,1 ELSE SHIP.ADDR = ''
          IF LED(78)<1,GEN,1> # '' THEN SHIP.ADDR<-1> = LED(78)<1,GEN,1>
          IF LED(78)<1,GEN,2> # '' THEN SHIP.ADDR<-1> = LED(78)<1,GEN,2>
          SHIP.ADDR<-1> = TRIM(LED(78)<1,GEN,3>):" ":LED(75)<1,GEN>"L#10"

          BEGIN CASE
          CASE GEN = 2
          BILL.ADDR = TRANS('ENTITY',LED(5)<1,2>,1,'X')<1,1,1>
          IF TRANS('ENTITY',LED(5)<1,2>,2,'X')<1,1,1> # '' THEN BILL.ADDR<-1> = TRANS('ENTITY',LED(5)<1,2>,2,'X')<1,1,1>
          IF TRANS('ENTITY',LED(5)<1,2>,2,'X')<1,1,2> # '' THEN BILL.ADDR<-1> = TRANS('ENTITY',LED(5)<1,2>,2,'X')<1,1,2>
          BILL.ADDR<-1> = TRIM(TRANS('ENTITY',LED(5)<1,2>,3,'X')<1,1,1>):", ":TRANS('ENTITY',LED(5)<1,2>,4,'X')<1,1,1>:" ":TRANS('ENTITY',LED(5)<1,2>,5,'X')<1,1,1>
          CASE GEN = 1
          BILL.ADDR = CUS(1)
          IF CUS(2)<1,1> # '' THEN BILL.ADDR<-1> = CUS(2)<1,1>
          IF CUS(2)<1,2> # '' THEN BILL.ADDR<-1> = CUS(2)<1,2>
          BILL.ADDR<-1> = TRIM(CUS(3)):", ":CUS(4):" ":CUS(5)
          END CASE



          SHP.INST = LED(74)<1,GEN>

          IF SHP.INST THEN
             LINE.WIDTH = DESC.WIDTH - 4
             BLINE     += 1
             TEXT = '_Shipping_Instructions_';   WIDTH = DESC.WIDTH;     GOSUB CENTER.TEXT
             BOD<BLINE> = SPACE(SSPC):CHANGE(CHANGE(TEXT, ' ', '*'), '_', ' ')

             FOLD.STRING RAISE(SHP.INST), LINE.WIDTH, SHP.INST
             LINE.FMT = 'L#':LINE.WIDTH
             CT = DCOUNT(SHP.INST,VM)
             FOR JJ = 1 TO CT
                BLINE += 1
                BOD<BLINE> = SPACE(SSPC):'* ':FMT(SHP.INST<1,JJ>, LINE.FMT):' *'
             NEXT JJ

             BLINE     += 1
             BOD<BLINE> = SPACE(SSPC):STR('*', DESC.WIDTH)
          END

          PRT.DATE = DATE()
          PRT.TIME = INT(TIME())

          RETURN
*-------------------------------------------------------------------------*
HEADER:   *
          PAGE = PAGE + 1

          *** Print the macro
          MACRO.ID = 'XFER~':STYLE.ID
          GOSUB SET.MACRO

          *** Print the logo
          PRINT CHAR(27):"*p25y*p50X":
          PTR.MACRO.PRINT ERR.MSG, 'MURRAY', DRPT

          PRINT CHAR(27):"*p0Y":
          PRINT NORM:SLPI:
          PRINT ; PRINT

          TEXT = DOC.ID;   WIDTH = 22;    GOSUB CENTER.TEXT
          PRINT SPACE(53):XLARGE:TEXT:NORM

          PRINT CHAR(27):"*p165Y":SLPI
          PRINT ; PRINT
          PRINT SPACE(55):OCONV(ORD.DATE,'D2/')  "L#10":
          PRINT ORD.ID                           "L#16"

          BR.ADDR = BILL.ADDR
          PRINT CHAR(27):"*p315Y"
          PRINT '' "L#55":SMALL:"REMIT TO:":NORM:ELPI
          PRINT '' "L#55":SUP.SMALL:BR.ADDR<1> "L#26":NORM
          PRINT '' "L#55":SUP.SMALL:BR.ADDR<2> "L#26":NORM
          PRINT '' "L#55":SUP.SMALL:BR.ADDR<3> "L#26":NORM:' ':(PAGE "R#3"):' of ':TRIM(PGS" R#3")
          PRINT '' "L#55":SUP.SMALL:BR.ADDR<4> "L#26":NORM
          PRINT CHAR(27):"*p490Y":SLPI

     * Header Bill To / Ship To
          SOLDTO = "SHIP FROM"
          SHIPTO = "SHIP TO"

          PRINT CHAR(27):"*p565Y":SLPI
          PRINT SPACE(9):SMALL:SOLDTO:":":NORM:
          PRINT CHAR(27):"*p565Y":SLPI
          PRINT SPACE(47):SMALL:SHIPTO:":":NORM

          FOR JJ = 1 TO 4
             PRINT SPACE(9):BILL.ADDR<JJ>'L#38':SHIP.ADDR<JJ>'L#35'
          NEXT JJ

       *------Header Info------*
          PRINT CHAR(27):"*p890Y"
          PRINT ; PRINT

          TEXT = ST.CN;        WIDTH = 12;    GOSUB CENTER.TEXT
          PRINT ' ':TEXT             'L#13':

          TEXT = 'From: ':SHIP.BR:'  To: ':RECV.BR
                               WIDTH = 21;     GOSUB CENTER.TEXT
          PRINT TEXT                 'L#22':

          TEXT = OCONV(PRT.TIME, 'MTHS'):' ':OCONV(PRT.DATE, 'D DMY[2,A3,4]')
          PRINT TEXT                 'L#24':

          TEXT = SHIP.VIA;     WIDTH = 19;    GOSUB CENTER.TEXT
          PRINT TEXT                 'L#20 '

          PRINT ; PRINT

          TEXT = WRITER;       WIDTH = 22;    GOSUB CENTER.TEXT
          PRINT ' ':TEXT             'L#23':

          TEXT = SALESMAN;     WIDTH = 35;    GOSUB CENTER.TEXT
          PRINT TEXT                 'L#36':

          TEXT = OCONV(SHP.DATE, 'D2/')
                               WIDTH = 9;     GOSUB CENTER.TEXT
          PRINT TEXT                 'L#10':

          TEXT = IFS(FRGHT.ALLW, 'Yes', 'No')
                               WIDTH = 9;     GOSUB CENTER.TEXT
          PRINT TEXT

          PRINT

          RETURN
*-------------------------------------------------------------------------*
PRTBOD:   *
          PLINE = 1
          LINEX = 0

          LOOP
             LINEX += 1
             IF LINEX > BLINE THEN EXIT
             IF PLINE > BOD.LINES THEN GOSUB TOP; PLINE=1
             PRINT BOD<LINEX>
             PLINE += 1
          REPEAT

          FOR X = PLINE TO BOD.LINES
             PRINT
          NEXT X

          GOSUB FOOTER

          RETURN
*-------------------------------------------------------------------------*
TOP:      *
          PRINT "     *** Continued on Next Page ***"
          GOSUB FFEED
          GOSUB HEADER

          RETURN
*-------------------------------------------------------------------------*
PRT.LINE: *
          LD.GET LDID
          PN = LD(1)

          BEGIN CASE
          CASE NUM(PN)
             QS = (SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)) * QSIGN
             IF QS#0 THEN GOSUB PRT.PN
          CASE PN = 'C'
             OE.DESC.GET DESC, NO, "TOE Printing"
             GOSUB PRT.XDESC
          CASE PN = 'S'
             *GOSUB PRT.SUBT
          END CASE

          RETURN
*-------------------------------------------------------------------------*
PRT.PN:   *
          GET.ALL.PRD BR,PN,QSIGN,GROUP
          OE.DESC.GET DESC,NO,"TOE Printing"

          KEYW = PRD(4)<1,1>
          CODE = FIELD(KEYW," ",2)
          SHP.TYPS = LD(7)<1,2>
          CT = DCOUNT(SHP.TYPS,SVM)

          FOR J = 1 TO CT
             IF FIELD(SHP.TYPS<1,1,J>,'~',1)='T' THEN
                QS  = LD(6)<1,2,J>
                TAG = FIELD(SHP.TYPS<1,1,J>,'~',2)
                TAG = FIELD(TAG,'^',2)
                READV CUSNO FROM LEDFILE,TAG[1,8],1 ELSE CUSNO=""
                CUSNO = FIELD(CUSNO,VM,1)
                READV CNAME FROM CUSFILE,CUSNO,1 ELSE CNAME="++++"
                TAG.LINE = '<<** ':QS:' Tagged to ':TAG[1,8]:' **>> ':CNAME
                FOLD.STRING TAG.LINE, DESC.WIDTH, TEXT
                DESC<1,-1> = TEXT
             END
          NEXT J

          SHP.TYP.LOCS = LD(7)<1,GEN>
          LOC.CT  = DCOUNT(SHP.TYP.LOCS,SVM)

          FOR LOC = 1 TO LOC.CT
             QO = LD(4)<1,GEN,LOC> * QSIGN
             QS = (LD(5)<1,GEN,LOC> + LD(6)<1,GEN,LOC>) * QSIGN
             IF QS=0 THEN GOTO NO.PTR

             IF FORM.STYLE = 'PICK' OR FORM.STYLE = 'SENDER' THEN
                *** Shipping location.
                SHP.TYP.LOC = SHP.TYP.LOCS<1,1,LOC>
                LOCA        = FIELD(SHP.TYP.LOC,'~',2)
                TYPE        = FIELD(SHP.TYP.LOC,'~',1)

                BEGIN CASE
                CASE QS<0 AND TYPE='F';  LOCA = '**DEF '
                CASE QS>0 AND TYPE='D';  LOCA = '**DIR '
                CASE QS<0;               LOCA = '**RTN '
                CASE OTHERWISE;          LOCA = LOCA"L#8"
                END CASE
             END ELSE
                *** Look up receiving branch location.
                LOCA = ''
                PRDD.BR.GET RECV.BR, PN
                RECV.LOC.LIST = PRDD.BR(8)
                RECV.LOC.CNT = DCOUNT(RECV.LOC.LIST, VM)
                FOR RECV.N = 1 TO RECV.LOC.CNT
                   TYPE.LOC = RECV.LOC.LIST<1,RECV.N>
                   IF FIELD(TYPE.LOC, '~', 1) = 'S' THEN
                      LOCA = FIELD(TYPE.LOC, '~', 2)
                      EXIT
                   END
                NEXT
             END

             IQ.TO.ALPHA PLNE(3),PRD(7),LD(23),QO,Q1,U1,Q2,U2,QO.ALPHA
             IF LOC > 1 THEN QO.ALPHA = '"'

             IQ.TO.ALPHA PLNE(3),PRD(7),LD(23),QS,Q1,U1,Q2,U2,QS.ALPHA

             PRT.STR  = ' ':LOCA              "L#11"
             PRT.STR := CODE                  "L#8"
             PRT.STR := FMT(DESC<1,1>, "L#":DESC.WIDTH):' '

             BEGIN CASE
             CASE FORM.STYLE = 'PICK'
                PRT.STR := TRIM(QS.ALPHA)     "R#9":' '
                PRT.STR := STR('_', 9)
             CASE FORM.STYLE = 'PACK'
                PRT.STR := TRIM(QO.ALPHA)     "R#7":' '
                PRT.STR := TRIM(QS.ALPHA)     "R#7":' '
                PRT.STR := STR('_', 7)
             CASE OTHERWISE
                PRT.STR := TRIM(QO.ALPHA)     "R#9":' '
                PRT.STR := TRIM(QS.ALPHA)     "R#9"
             END CASE

             PG.LINE = MOD(BLINE, BOD.LINES)
             IF PG.LINE + DCOUNT(DESC,VM) > BOD.LINES THEN
                FOR SS = PG.LINE+1 TO BOD.LINES
                   BLINE += 1
                   BOD<BLINE> = ''
                NEXT SS
             END

             BLINE     += 1
             BOD<BLINE> = PRT.STR
             DESC       = DELETE(DESC,1,1)
             GOSUB PRT.XDESC

NO.PTR:   NEXT LOC

          RETURN
*-------------------------------------------------------------------------*
PRT.XDESC: *
          DESC.CT = DCOUNT(DESC,VM)
          FOR DLN = 1 TO DESC.CT
             PRT.STR = SPACE(SSPC):DESC<1,DLN>
             IF TRIM(PRT.STR) THEN
                BLINE     += 1
                BOD<BLINE> = PRT.STR
             END
          NEXT DLN

          RETURN
*-------------------------------------------------------------------------*
FOOTER:   *
          IF PAGE = 1 THEN
             PRINT CHAR(27):"*p2790Y":NORM.BOLD
             PRINT ELPI
             PRINT 'Filled By':STR('_', 45):
             PRINT ' Truck Units':STR('_', 13)
             PRINT
             PRINT 'Checked By':STR('_', 40):
             PRINT ' Date':STR('_', 24)
             PRINT
             PRINT 'Notes':STR('_', 74):
          END

          RETURN
*-------------------------------------------------------------------------*
FFEED:    *
          IF REPRINT THEN
             PRINT CHAR(27):"*p3050Y"
             PRINT SPACE(57):SMALL:'** Reprint ** Reprint ** Reprint **':NORM:
          END

          *** Print barcode.
          PRINT CHAR(27):"*p1750x*p3175Y":
          UT.PRINT.BARCODE ERR.CODE,'CODE128',150,25,7,ORD.ID

          PRINT CHAR(12):

          RETURN
*-------------------------------------------------------------------------*
CENTER.TEXT:    *** Center text in a field of the specified width.
          LMARGIN = INT((WIDTH - LEN(TEXT)) / 2)
          RMARGIN = WIDTH - LMARGIN - LEN(TEXT)
          TEXT = SPACE(LMARGIN):TEXT:SPACE(RMARGIN)

          RETURN
*-------------------------------------------------------------------------*
DRAWSHADING: *** Draw shaded boxes to fill in headers

          PERC = 11   ;* Shade at 11%
          REST = 100  ;* Restore to 100%
          HGHT = 1    ;* All boxes are 1 char height

          FORMS.PRINT.SHADE PERC,1621, 190,2.5,HGHT,REST  ;* Inv Dt/Number
          FORMS.PRINT.SHADE PERC,2045, 340,1.1,HGHT,REST  ;* Page Number
          FORMS.PRINT.SHADE PERC,   0, 910,7.9,HGHT,REST  ;* 1st full line
          FORMS.PRINT.SHADE PERC,   0,1060,7.9,HGHT,REST  ;* 2nd full line
          FORMS.PRINT.SHADE PERC,   0,1210,7.9,HGHT,REST  ;* 3rd full line

          RETURN
*-------------------------------------------------------------------------*
SET.MACRO: *** Print macro or create if necessary

          MACRO.OK = ''

          *** Check to see if this macro is already loaded
          PTR.MACRO.ACTIVE MACRO.ID,PRT.SEQ

          *** If a sequence is returned, use to print macro immediately
          IF PRT.SEQ THEN GOTO PRT.MACRO

          *** Begin saving macro (suspend physical printing)
          PTR.MACRO.SAVE.ON MACRO.ID,MACRO.OK

          *** 'Print' the overlay - this does NOT physically print,
          *** anything between SAVE statements is only saved to macro
          DOC.FORM.CONVERT DOC.FORM.REC,DOC.FORM.SPEC
          DOC.FORM.PRINT DOC.FORM.SPEC,"1"
          GOSUB DRAWSHADING

          *** Stop saving macro (resume physical printing)
          PTR.MACRO.SAVE.OFF MACRO.ID,MACRO.OK,PRT.SEQ

PRT.MACRO: *** Print the macro with saved or newly created sequence

          IF PRT.SEQ THEN
             *** For each !, print CHAR(27) and the following characters
             CONVERT '!' TO AM IN PRT.SEQ
             ESC.CT = DCOUNT(PRT.SEQ,AM)
             FOR XX = 2 TO ESC.CT
                PRINT CHAR(27):PRT.SEQ<XX>:
             NEXT XX
             PRINT
          END

          RETURN
*-------------------------------------------------------------------------*
!SMITJR~07/13/10~12:19
