           SUBROUTINE (OID,GEN,STATUS,PSTYLE.OVRD,PRT.ON,DRPT,LOC.OVRD,PRT.LOC)
** Version# 0.0001[44] - 04/14/2013 - 11:10pm - TSMITH - eclipse
*** V0.0004 Change - Custom Coding . - 04/03/2013 - TSMITH - eclipse
*** V0.0001 Change - Custom Coding . - 04/14/2013 - TSMITH - eclipse
*** V0.0003 Change - Custom Coding . - 03/31/2013 - TSMITH - 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 CUSTOM - 03/05/2013 - TSMITH - 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
          XFER.FLAG=YES


          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 BT.CN = '1' THEN
                LOCATION = 'PHAN-WH'
                PRT.LOC = 'PHAN-WH'
                MSG = ORD.ID:' has printed! Get that shit pulled biotch!'
                SEND.MESSAGE 'Phantom','TOMMYO',MSG
                END ELSE
                IF BT.CN = '2' THEN
                LOCATION = 'GPS2'
                PRT.LOC = 'GPS2'
                MSG = ORD.ID:' has printed! Get that shit pulled motherfucker!'
                SEND.MESSAGE 'Phantom','JOET',MSG
                END ELSE
                IF BT.CN = '5564' THEN
                LOCATION = 'BR5.COUNTER'
                PRT.LOC = 'BR5.COUNTER'
                MSG = ORD.ID:' has printed for you to ship!'
                SEND.MESSAGE 'Phantom','GEORGEL',MSG
                END ELSE
                IF LOC.OVRD THEN
                LOCATION = LOC.OVRD
                END
                END
                END
                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
          LINE.CT = 0
          IN.FOOTER = NO
          FRST.DET   = 1
          NO.PRICING = ''

          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 Ship Ticket'
             IF GEN = 1 THEN
                FORM.STYLE = 'PICK'
                FORM = 'PICK.TICKET'
                DOC.ID = 'Transfer Pick Ticket'
             END ELSE
                FORM.STYLE = 'SHIP'
                FORM = 'SHIP.TICKET'
                DOC.ID = 'Transfer Ship Ticket'
             END
           *  FORM = 'SHIP.TICKET'
          CASE STATUS = 'R'
             FORM = 'SHIP.TICKET'
             DOC.ID = 'Transfer Ship Ticket'
             FORM.STYLE = 'SHIP'
          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 Ship Ticket'
             *   FORM = 'SHIP.TICKET'
             *   FORM.STYLE = 'SHIP'
             *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'
             DESC.WIDTH = 39
          CASE FORM.STYLE = 'SHIP'
             STYLE.ID = 'SHIP'
             FORM.NAME = 'XFER.SHIP'
             DESC.WIDTH = 35
          CASE OTHERWISE
             STYLE.ID = 'XFER'
             FORM.NAME = 'XFER.FORM'
             DESC.WIDTH = 39
          END CASE


  *        SLPI   = CHAR(27):"&l6D"
 *         ELPI   = CHAR(27):"&l8D"
 *             DOC.TYPE = LED(6)<1,GEN>


* IF DRPT<27>='HOLD' THEN
 *            USE.DOC.TYPE = DOC.TYPE:VM:1
  *        END ELSE
   **          USE.DOC.TYPE = DOC.TYPE
   *       END
   *
   *       OE.LOG.PRINT OID,GEN,USE.DOC.TYPE,DOC.ID,REPRINT
   *       IF REPRINT THEN
   *          BOD.LINES -= 1
   *       END

          * Get Print style record
          *IF XFER.FLAG = YES THEN
          *STYLE.ID = 'MFBLIND'
          *END

          BEGIN CASE
          CASE PSTYLE.OVRD#''
             STYLE.ID = PSTYLE.OVRD
          CASE LED(77)<1,GEN>
             STYLE.ID = LED(77)<1,GEN>
          CASE OTHERWISE
             STYLE.ID = 'MFBLIND'
          END CASE

          IF STYLE.ID='BLIND' THEN
          STYLE.ID='MFBLIND'
          END

          GOSUB GET.PSTYLE



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

            *** Find out if items excluded from RF picking should print
          *** in bold font.
          EXCL.BOLD = NO
          READ EXCL.BOLD FROM CTRLFILE, 'RF.EXCL.PICK.BOLD' THEN
             IF EXCL.BOLD = 'Y' THEN
                EXCL.BOLD = YES
             END
          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>



          RECV.ENT = TRANS('TERRITORY',RECV.BR,4,'X')
          IF XFER.FLAG = YES THEN
          READV SHIP.ADDR FROM CUSFILE,RECV.ENT,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"
          END ELSE


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


          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


          * let user know that they need to print Delivery labels
          ITEM.TAG.INFO  = ''
          IF STATUS = 'T' THEN
             OE.ITEM.TAG.READ OID,,,,ITEM.TAG.INFO
          END


          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 = OCONV(DATE(),'D2/')
          PRT.TIME = OCONV(INT(TIME()),'MTH')

          RETURN
*
CNVRT.FORM: * Convert the values we picked up from our Form overlay
            * Control Record AND from the Print Style Id we're using,
            * that was set up in Print Style Maintenance...

*** Get data out from the Form Overlay Control Record we're using...

          *** We should find this string in the Row where our Invoice's
          *** data columns were set up...
          FINDSTR '@PRINT.STYLE' IN DOC.FORM.REC SETTING AMC THEN
             *** Get the Print Style Width....
             FORM.STYLE.WIDTH = FIELD(DOC.FORM.REC<AMC>,',',2)
             *** Initialize our Total Width to be the Print Style Width...
             TOTAL.WIDTH      = FORM.STYLE.WIDTH

             TAMC = AMC - 1
             *** Go through each data column that's been set up in the
             *** current row...
             LOOP
             UNTIL DOC.FORM.REC<TAMC>[1,1] # '"' DO
                *** Add the width from each column to our Total Width...
                TOTAL.WIDTH += FIELD(DOC.FORM.REC<TAMC>,',',2)
                TAMC -= 1
             REPEAT

             *** Set our Start Column, where we'll be printing the values
             *** determined by our print style Id...
             COL.START    = TOTAL.WIDTH - FORM.STYLE.WIDTH
             DEL DOC.FORM.REC<AMC>

*** Now we'll go through the columns that were set up for the Print
*** Style Id we're using (set up in Print Style Maintenance)...

             STYLE.WIDTH  = 0
             WIDTH.INSERT = ''

             FOR CC = 1 TO COL.CT
                TWIDTH           = FIELD(COL.FRMTS<1,CC>,'#',2)
                WIDTH.INSERT<CC> = TWIDTH
                STYLE.WIDTH     += TWIDTH
             NEXT CC

             BEGIN CASE
             *** If the actual width of our Print Style Id columns is less
             *** than the width that our Form Overlay Control Record
             *** stated that it needed to be...
             CASE STYLE.WIDTH < FORM.STYLE.WIDTH
                CC = COL.CT
                LOOP
                UNTIL STYLE.WIDTH >= FORM.STYLE.WIDTH DO
                   *** Increase a columns width...
                   WIDTH.INSERT<CC> += 1
                   NEW.FRMT  = FIELD(COL.FRMTS<1,CC>,'#',1):'#'
                   NEW.FRMT := WIDTH.INSERT<CC>
                   COL.FRMTS<1,CC> = NEW.FRMT

                   CC -= 1
                   *** If we've already increased each columns width
                   *** once, start with the first one again...
                   IF CC < 1 THEN CC = COL.CT
                   STYLE.WIDTH += 1
                REPEAT
             *** If the actual width of our Print Style Id columns is
             *** greater than the width that our Form Overlay Control
             *** Record stated that it needed to be...
             CASE STYLE.WIDTH > FORM.STYLE.WIDTH
                CC = 1
                LOOP
                UNTIL STYLE.WIDTH <= FORM.STYLE.WIDTH DO
                   *** Decrease a columns width...
                   WIDTH.INSERT<CC> -= 1
                   NEW.FRMT  = FIELD(COL.FRMTS<1,CC>,'#',1):'#'
                   NEW.FRMT := WIDTH.INSERT<CC>
                   COL.FRMTS<1,CC> = NEW.FRMT

                   CC += 1
                   *** If we've already decreased each columns width
                   *** once, start with the first one again...
                   IF CC > COL.CT THEN CC = 1
                   STYLE.WIDTH -= 1
                REPEAT
             END CASE

             FOR CC = 1 TO COL.CT
                TINSERT  = '"':COL.HEADS<1,CC>:'",'
                TINSERT := WIDTH.INSERT<CC>

                INS TINSERT BEFORE DOC.FORM.REC<AMC+CC-1>
             NEXT CC

             FTR.TEXT.LGTH = 79-WIDTH.INSERT<COL.CT>
             FTR.FMT       = 'R2#':WIDTH.INSERT<COL.CT>
          END

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

          *** Print the macro
          IF FORM.STYLE = 'PICK' THEN
          MACRO.ID = 'XFER~PICK~':STYLE.ID
          END ELSE
          IF FORM.STYLE = 'SHIP' THEN
          MACRO.ID = 'XFER~SHIP~':STYLE.ID
          END ELSE
          MACRO.ID = 'XFER~':STYLE.ID
          END
          END
          GOSUB SET.MACRO

          *** Print the logo
          PRINT CHAR(27):"*p25y*p50X":
          PTR.MACRO.PRINT ERR.MSG, 'GPS', 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
          IF XFER.FLAG THEN
          SOLDTO = "TRANSFER FROM"
          SHIPTO = "TRANSFER TO"
          END ELSE
          SOLDTO = "SHIP FROM"
          SHIPTO = "SHIP TO"
          END
          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 = RECV.BR;        WIDTH = 6;    GOSUB CENTER.TEXT
          *TEXT = ST.CN;        WIDTH = 12;    GOSUB CENTER.TEXT
          PRINT ' ':TEXT             'L#7':

          TEXT = TRIM(OCONV(FIELD(BR.ADDR<3>,',',1),'MCT'):' to ':OCONV(FIELD(TRIM(LED(78)<1,GEN,3>),',',1),'MCT'))
          *TEXT = 'From: ':SHIP.BR:'  To: ':RECV.BR
                               WIDTH = 28;     GOSUB CENTER.TEXT
          PRINT TEXT                 'L#29':

          TEXT = OCONV(PRT.TIME, 'MTHS'):' ':OCONV(PRT.DATE, 'D DMY[2,A3,4]'); WIDTH=23; GOSUB CENTER.TEXT


          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')
          TEXT  = STYLE.ID;  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,ALT.DESC,"SOE Printing"
             GOSUB PRT.XDESC
             IF REM(BLINE,BOD.LINES) AND (STATUS = 'T' OR STATUS = 'F' OR XFER.FLAG) THEN
                BLINE += 1
                BOD<BLINE> = ''
             END
*         END
*          CASE PN='S'
*             IF NOT(LOT.FLAG) THEN
*                GOSUB PRT.SUBT
*             END
          END CASE

          RETURN
*-------------------------------------------------------------------------*
PRT.PN:   *
          GET.ALL.PRD BR,PN,QSIGN,GROUP
          OE.DESC.GET DESC,NO,"TOE Printing"
           TOT.QS       = QS
          LINE.CT     += 1
          GET.ALL.PRD BR,PN,QSIGN,GROUP
          SHP.TYP.LOCS = LD(7)<1,GEN>
          LOC.CT       = DCOUNT(SHP.TYP.LOCS,SVM)
          LN.MSG       = LINE.CT
          PRT.OK       = NO

            GOSUB CHK.DKIT

              IF XFER.FLAG THEN
                QOPEN  = TOT.QS
                DQS    = QS
             END ELSE
                IF NOT(LED(8)<1,GEN>) THEN
                   QOPEN = TOT.QS
                   DQS   = ''
                END ELSE
                   OE.CALC.QOPEN OID,QSIGN,QOPEN
                   IF LED(8)<1,GEN> THEN
                      QOPEN += (SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)) * QSIGN
                   END
                   DQS = QS
                END
             END


      *       IF LOCA = 'WHSE' THEN PRINT.PICK = YES
      *       IF LOCA = '' THEN
      *          PRD.LOCATION.GET PRD.LOC,PN,SHIP.BR
      *       END ELSE
      *          PRD.LOC = LOCA
      *       END

       *      PRD.ZONE.GET ,,PRD.LOC,SHIP.BR,SHP.TYP.LOC,EXCL.QUEUE,,WRK.TKT

             IF DKIT THEN
                IF LD(71)<1,GEN,LOC> = '' THEN
                   * Remove @ notations from dynamic locations
                   LOCA = FIELD(LOCA,'@',1)
                END ELSE
                   * Do not display dynamic base componant locations
                   LOCA = ''
                END
             END

             *IF STATUS = 'F' AND FPTR THEN
             *   IF NOT(EXCL.QUEUE) OR FPTR#EXCL.QUEUE<2> THEN GOTO NO.PTR
             *END

             * Do not print if product is printing on a Yard Ticket
             *IF WRK.TKT THEN GOTO NO.PTR

             PRT.OK = YES


                   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
                 SHP.TYP.LOCS = LD(7)<1,GEN>
          LOC.CT  = DCOUNT(SHP.TYP.LOCS,SVM)



             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)
              IF TYPE = 'T' THEN
                TAG = FIELD(SHP.TYP.LOC,'^',2)
                TAG = FIELD(TAG,'.',1)
                DESC<1,-1> = '<<** ':QS:' Tagged to ':TAG[1,OID.LGTH$]:' **>>'
             END
                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):' '
             IQ.TO.ALPHA PLNE(3),PRD(7),LD(23),DQS,Q1,U1,Q2,U2,DQS.ALPHA
             BEGIN CASE
             CASE FORM.STYLE = 'PICK'
                LOCA        = FIELD(SHP.TYP.LOC,'~',2)
                PRT.STR  = TRIM(QO.ALPHA)          "R#8"
                PRT.STR := TRIM(DQS.ALPHA)         "R#8":' ____ '
                PRT.STR := DESC<1,1>               "L#35":NORM
             DESC<1,-1> = '  Loc: ':LOCA'L#18':' Pn: ':PN'L#6'
             CASE FORM.STYLE = 'SHIP'
             IQ.TO.ALPHA PLNE(3),PRD(7),LD(23),DQS,Q1,U1,Q2,U2,DQS.ALPHA
                LOCA = FIELD(TYPE.LOC, '~', 2)
                PRT.STR  = TRIM(QO.ALPHA)          "R#8"
                PRT.STR := TRIM(DQS.ALPHA)         "R#8":' ____ '
                PRT.STR := DESC<1,1>               "L#35":NORM
             DESC<1,-1> = '  Loc: ':LOCA'L#18':' Pn: ':PN'L#6'
             CASE OTHERWISE

                PRT.STR := TRIM(QO.ALPHA)     "R#8":' '
                PRT.STR := TRIM(QS.ALPHA)     "R#8"
             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
*-------------------------------------------------------------------------*
CHK.DKIT: *** Check if this is a dynamic kit
          IF TRIM(LD(71)<1,GEN>,SVM) # '' THEN DKIT= YES ELSE DKIT = NO
          IF DKIT THEN DKIT.LDS<-1> = LDID
          RETURN
*-------------------------------------------------------------------------*
PRT.XDESC: *
          DESC.CT = DCOUNT(DESC,VM)
          FOR DLN = 1 TO DESC.CT
             *** If an item is excluded from RF Picking and the user
             *** is configured to print in bold. Print the data in bold
             *IF EXCL.QUEUE AND EXCL.BOLD THEN
             *   PRT.STR = SPACE(SSPC):NORM.BOLD:DESC<1,DLN>:NORM
             *END ELSE
                    SSPC1 = 22
                PRT.STR = SPACE(SSPC1):DESC<1,DLN>
             *END
             IF TRIM(PRT.STR) THEN
                BLINE += 1
                BOD<BLINE> = PRT.STR
             END
          NEXT DLN
          RETURN

*-------------------------------------------------------------------------*
FOOTER:  *
          PRINT CHAR(27):"*p2790Y":NORM.BOLD

          *** Print Subtotal
          TFTR = SPACE(79)
*          TFTR[79-WIDTH.INSERT<COL.CT>-LEN(FTR.MSG<1>)+1,LEN(FTR.MSG<1>)] = FTR.MSG<1>
*          TFTR[79-WIDTH.INSERT<COL.CT>+1,WIDTH.INSERT<COL.CT>] = RUNNING.TOTAL FTR.FMT
          PRINT TFTR


          *** Print Freight and Handling charges
*          TFTR = SPACE(79)
*          TFTR[79-WIDTH.INSERT<COL.CT>-LEN(FTR.MSG<2>)+1,LEN(FTR.MSG<2>)] = FTR.MSG<2>
*          TFTR[79-WIDTH.INSERT<COL.CT>+1,WIDTH.INSERT<COL.CT>] = (FREIGHT + HANDLING) FTR.FMT
*          PRINT TFTR

*          RUNNING.TOTAL += FREIGHT + HANDLING

          *** Print Tax Amount
 *         TFTR = SPACE(79)
 *         TFTR[79-WIDTH.INSERT<COL.CT>-LEN(FTR.MSG<3>)+1,LEN(FTR.MSG<3>)] = FTR.MSG<3>
 *         TFTR[79-WIDTH.INSERT<COL.CT>+1,WIDTH.INSERT<COL.CT>] = TAX.AMT FTR.FMT
 *         PRINT TFTR
*
 *         RUNNING.TOTAL += TAX.AMT

 *         PRINT

          *** Print Amount Due
 *         TFTR = SPACE(79)
  *        TFTR[79-WIDTH.INSERT<COL.CT>-LEN(FTR.MSG<4>)+1,LEN(FTR.MSG<4>)] = FTR.MSG<4>
   *       TFTR[79-WIDTH.INSERT<COL.CT>+1,WIDTH.INSERT<COL.CT>] = RUNNING.TOTAL FTR.FMT
  *        PRINT TFTR

   *       IF STATUS = 'T' AND BO.FLAG THEN GOSUB PRT.BO

*         IF PRINT.CREDIT.MSG THEN
*            PRINT STR('+ ',35)
*            PRINT '+   Thank You For Your Business __________'
*            PRINT STR('+ ',35)
*         END

          PRINT CHAR(27):"*p2790Y"
          PRINT
          PRINT MED:'Filled by________________ Checked by________________ Pieces______'
          IF NOT(XFER.FLAG) THEN
             PRINT "Customer Signature: ___________________________ Date: ___/___/___ "

             *** Have to concatenate overdue msg w/CTRL.FTR because we only
             *** have 4 lines to work with.
   *          SOE.FTR = 'Overdue accounts will be charged ':SERV.RATE:'% per month finance charge. ':CTRL.FTR
             OLD.STR = SOE.FTR
             FOLD.STRING OLD.STR,110,SOE.FTR
             PRINT ELPI:SUP.SMALL:
             IF SOE.FTR # '' THEN
                FTR.MAX = DCOUNT(SOE.FTR,VM)
                *** Limit footer to 4 lines so it doesn't go beyond the
                *** page.
                IF FTR.MAX > 4 THEN FTR.MAX = 4
                FOR FTR.CT = 1 TO FTR.MAX
                   IF FTR.CT < FTR.MAX THEN
                      PRINT SOE.FTR<1,FTR.CT>
                   END ELSE
                      PRINT SOE.FTR<1,FTR.CT>:NORM:SLPI:
                   END
                NEXT FTR.CT
             END
          END

          RETURN
*-------------------------------------------------------------------------*
FFEED:    *
          PRT.STAT = LEDLREC<9,GEN>
          IF PRT.STAT = 'N' THEN
          REPRINT = YES
          END
          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,2101, 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
*-------------------------------------------------------------------------*
GET.PSTYLE: *
          * Get Print style record
          MATREAD PSTYL FROM PSTYLFILE,STYLE.ID ELSE
             MATREAD PSTYL FROM PSTYLFILE,'DEFAULT' ELSE
                MAT PSTYL = ''
                PSTYL(3) = 69
                PSTYL(4) = 'R2#10'
                PSTYL(5) = 1
                PSTYL(6) = 1
                PSTYL(7) = 'Net Price'
             END
          END
          COL.START = PSTYL(3)
          COL.FRMTS = PSTYL(4)
          COL.BASIS = PSTYL(5)
          COL.EXTDS = PSTYL(6)
          COL.HEADS = PSTYL(7)
          ALT.DESC  = PSTYL(8)
          COL.CT    = DCOUNT(COL.BASIS,VM)
          COL.TOTAL = ''
          SUB.TOTAL = ''
          SUBT.SW   = NO

          RETURN
*-------------------------------------------------------------------------*
!TSMITH~04/14/13~23:10
