          SUBROUTINE (OID,GEN,NUM.PGS,STATUS,PSTYLE.OVRD,PRT.ON,DRPT,LOC.OVRD)
** Version# 58.0002 - 02/17/2010 - 03:02pm - JONW - UPGRADE
*** V58.0002 Change - Custom Coding CZV696 - 02/17/2010 - JONW - UPGRADE
*** V58.0001 Change - Custom Coding FORMS.MOD - 11/14/2008 - ROYO - eclipse
** Copied from BP SOE.PRINT.SHIP Version# 58 - 04/02/2007 - 12:30pm - BILLW - main

*** Subroutine: SOE.PRINT.SHIP
*-------------------------------------------------------------------------*
*** Prints ship tickets in laser form.
*** Uses page 1 of n logic.
*-------------------------------------------------------------------------*
*** Variables:
***       OID         - Order ID                                      [In]
***       GEN         - Order generation                              [In]
***       NUM.PGS     - Number of pages printed or faxed              (Out)
***       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.
*-------------------------------------------------------------------------*
*** Common: LED, LD, PRD, PRD.BR, CUS, and CUSS are read but not written.
***         JAVA.PROC$, INVOICE.COPY.CT$, and PHANTOM.PROC are used but
***         not written.
*-------------------------------------------------------------------------*
          DKIT.LDS = ''
          DIM PSTYL(10)
          FPTR   = STATUS<2>
          STATUS = STATUS<1>
          ROUTING.COPY = NO

          * Activity Triggers
          BEGIN CASE
          CASE STATUS = 'T'    ;* Pick Ticket Print
             AT.ID = 'T013'
             GOSUB ACT.TRIG
          CASE STATUS = 'O'
             AT.ID = 'T026'    ;* Ship Ticket Print
             GOSUB ACT.TRIG
          END CASE

          FTR.MSG    = "Subtotal"
          FTR.MSG<2> = "S&H CHGS"
          FTR.MSG<3> = "Sales Tax"
          FTR.MSG<4> = "Amt Due"

          UT.OPEN.FILE "PRINT.STYLES",PSTYLFILE,ERR.MSG
          IF ERR.MSG THEN RETURN
          SV.LOC = LOCATION
          PG.LGTH = 60
          FT.LGTH  = 0
          BOD.LINES = 31
          IF DRPT<29> THEN BOD.LINES -= 1
          IF NOT(PHANTOM.PROC) AND NOT(PRT.ON) AND NOT(JAVA.PROC$) THEN
             WINDOW 15,8,50,5
             IF DRPT<29> THEN
                PRINT @(0,1):'Faxing .... ':OID
             END ELSE
                PRINT @(0,1):'Printing .... ':OID
             END
          END

          MATREAD LED FROM LEDFILE,OID ELSE GOTO FINISH

*LOT
          IF LED(98)<1,GEN> THEN
             LOT.FLAG = YES
          END ELSE
             LOT.FLAG = NO
          END

          OE.GET.QSIGN QSIGN,OID,GEN
          BR       = LED(2)<1,GEN,1>
          SHIP.BR  = LED(2)<1,GEN,2>

          READV BR.EN FROM TERRFILE,BR,4 ELSE BR.EN = ''
          READ CUS.BR FROM CUSFILE,BR.EN ELSE CUS.BR=''
          PRC.PHONES = CUS.BR<17>
          PRC.BR.PHONES = PRC.PHONES<1,1>
          IF PRC.PHONES<1,2> THEN
             PRC.BR.PHONES := ' Fax ':PRC.PHONES<1,2>
          END
          *READV BR.EN FROM TERRFILE,SHIP.BR,4 ELSE BR.EN = ''
          READV BR.EN FROM TERRFILE,SHIP.BR,5 ELSE BR.EN = ''   ;* use remit-to
          READ CUS.BR FROM CUSFILE,BR.EN ELSE CUS.BR=''
          BR.ADDR = CUS.BR<1>
          IF CUS.BR<2,1> THEN BR.ADDR<-1> = CUS.BR<2,1>
          IF CUS.BR<2,2> THEN BR.ADDR<-1> = CUS.BR<2,2>
          BR.ADDR<-1> = CUS.BR<3>:' ':CUS.BR<4>:' ':CUS.BR<5>
          CONTACTS = RAISE(OCONV(CUS.BR<16>,"MCU"))
          FINDSTR "FAX" IN CONTACTS SETTING PPOS ELSE PPOS = 0
          IF PPOS THEN
             IF CUS.BR<17,PPOS> # '' THEN
                FAX.PHONE = '  Fax ':CUS.BR<17,PPOS>
             END ELSE
                FAX.PHONE = ''
             END
          END ELSE
             FAX.PHONE = ''
          END
          BR.ADDR<-1> = CUS.BR<17,1>:FAX.PHONE
          BT.CN  = LED(1)<1,GEN>
          ST.CN  = LED(5)<1,GEN>
          GET.CUS BR,BT.CN,ST.CN,QSIGN
          INVN    = LED(8)<1,GEN> + 0
          IF INVN=0 THEN
             PRT.LDIDS = LED(49)
             CONVERT VM TO AM IN PRT.LDIDS
          END ELSE
             PRT.LDIDS = LED(48)<1,GEN>
             CONVERT SVM TO AM IN PRT.LDIDS
          END

          IF NOT(PRT.ON) 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

          GOSUB INIT
* Sort Items in location order -------------------------------------------*
*         SRT.LOCS  = ''
*         SRT.LDIDS = ''
*         LD.CT = DCOUNT(PRT.LDIDS,AM)
*         FOR J = 1 TO LD.CT
*         LDID  = PRT.LDIDS<J>
*         LD.GET LDID
*         PN = LD(1)
*         IF PN#'' AND (NUM(PN) OR PN='C') THEN
*            IF PN = 'C' THEN LOC = '*' ELSE
*               LOC = LD(7)<1,GEN,1>
*               LOC = FIELD(LOC,'~',2)
*               IF LOC = '' THEN
*                  PRD.LOCATION.GET PRI.LOC,PN,SHIP.BR
*                  LOC = PRI.LOC
*               END
*            END
*            IF LOC = '' THEN LOC = 'ZZZ'
*            LOC := J "R%4"
*            LOCATE LOC IN SRT.LOCS BY 'AL' SETTING POS ELSE NULL
*            SRT.LOCS  = INSERT(SRT.LOCS,POS;LOC)
*            SRT.LDIDS = INSERT(SRT.LDIDS,POS;LDID)
*         END
*         NEXT J
*         PRT.LDIDS = SRT.LDIDS
*-------------------------------------------------------------------------*

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

          RUNNING.TOTAL = COL.TOTAL<1,COL.CT,1>
          IF NOT(NO.TOLS) THEN
             GOSUB PRINT.TOTALS
          END
          *** If they are using Credit Card check order to print receipt
          *** Check if site is authorized
          UT.SEC3 9,AUTH.OK,,NO
          CC.AMT = OCONV(TOTAL,'MR2')
          IF AUTH.OK THEN GOSUB CHKCC

          ** Print Order Summary
          IF NOT(NO.TOLS) THEN GOSUB PRT.OS

          BLINE += 1
          BOD<BLINE> = ''
          BLINE += 1
          BOD<BLINE> = ''
          GOSUB PRINT.TOTE.INFO
          IF BO.FLAG THEN GOSUB PRT.BO

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

          SUB.TOTAL = RUNNING.TOTAL
          FOR COPY.N = 1 TO COPY.CNT
             IF NOT(PRT.ON) THEN
                IF ROUTING.COPY THEN
                   PRINTER.ON 'ROUTING.TICKET',RPT.DFLT=DRPT
                END ELSE
                   IF COPY.N = 1 THEN
                      PRINTER.ON "SHIP.TICKET",RPT.DFLT=DRPT
                   END ELSE
                      PRINTER.ON "PICK.TICKET",RPT.DFLT=DRPT
                   END
                END
             END

             PRINT CHAR(27):"*p0y"
             PRINT CHAR(27):"&l1e6D":NORM:

             PAGE = 0
             RUNNING.TOTAL = SUB.TOTAL
             GOSUB HEADER
             GOSUB PRTBOD
             GOSUB FFEED

             IF DKIT.LDS # '' THEN
                SOE.PRINT.DKITS OID,GEN,DKIT.LDS
             END

             IF PRINT.HAZ THEN
                SOE.PRINT.HAZMAT OID,GEN,DRPT
             END

             IF NOT(PRT.ON) THEN
                PRINTER.OFF
             END
          NEXT

          IF NOT(REPRINT) THEN
             GET.USER.DOCS OID,GEN,QSIGN,USER.DOCS
             IF USER.DOCS # '' THEN
                L.CT = DCOUNT(USER.DOCS,VM)
                FOR L = 1 TO L.CT
                UD.DOC.PRINT OID,GEN,,USER.DOCS<1,L>
                NEXT L
             END
          END

          GOTO FINISH
*-------------------------------------------------------------------------*
ACT.TRIG: *** Calls ACTIVITY.TRIGGER to see if trigger is setup for this
          *** entity and performs the appropriate response activity if
          *** it is.

          * Don't call the trigger if we are coming in from a VSIFax email
          IF DRPT<27> = 'HOLD' THEN RETURN

          AT.DATA    = ''
          AT.DATA<2> = LED(5)<1,GEN>:VM:LED(1)<1,GEN>
          AT.DATA<3> = LED(2)<1,GEN,2>
          AT.DATA<4> = OID
          AT.DATA<5> = GEN
          AT.DATA<7> = LED(6)<1,GEN>

          DOCS.PRDCD = ''
          ACTIVITY.TRIGGER AT.ID,AT.DATA,DOCS.PRDCD

          RETURN
*-------------------------------------------------------------------------*
INIT:     *
          PAGE    = 0
          BO.CT   = 0
          LINE.CT = 0
* Prepass for subtotal pricing detail Y/N
          NO.PRICING  = ''
          FRST.DET    = 1
          LD.CT       = DCOUNT(PRT.LDIDS,AM)
          PRINT.HAZ  = NO
          HAZMAT.INFO = ''

          FOR LD.NO = 1 TO LD.CT
             LDID  = PRT.LDIDS<LD.NO>
             LD.GET LDID
             IF LD(1)='S' THEN
                IF LD(21) = '' THEN
* NO PRICING
                   FOR DL = FRST.DET TO LD.NO
                      NO.PRICING<DL> = YES
                   NEXT DL
                END
                FRST.DET = LD.NO + 1
             END
          NEXT LD.NO

          *** Check the customer level flag for back order printing...
          BEGIN CASE
          CASE CUS(143)[1,2] = 'No'           ;* No Back Order Printing
             BO.PRT.OPT = 1
          CASE CUS(143)[1,8] = 'Print on'     ;* Print on First Gen Only
             BO.PRT.OPT = 2
          CASE OTHERWISE                      ;* Print Back Orders
             BO.PRT.OPT = 3
          END CASE

          INV.AMT    = LED(15)<1,GEN>
          BOD        = ''
          BLINE      = 0
          PRINT.PICK = NO
          CASH.SALE  = NO

          SSPC       = 19

          FT.LGTH  += 8
          INVN    = LED(8)<1,GEN>
          ORD.ID  = OID:'.':INVN"R%3"
          DOC.ID    = 'Ship Ticket'
          DOC.TYPE = 'O'

          SOE.CREDIT.CHECK ST.CN,,COD,PRT.MSG,NO.SHIP,,,OID,GEN

          IF COD THEN
             COD.MSG = ' ** C.O.D. ** C.O.D. ** C.O.D. **'
          END ELSE
             COD.MSG = ''
          END

          SLPI   = CHAR(27):"&l6D"
          ELPI   = CHAR(27):"&l8D"

          *** Set up some variables to use for setting text fonts...
          SMALL      = CHAR(27):'(8U'
          SMALL     := CHAR(27):'(s0p16.67h8.5v0s0b0T'
          MED        = CHAR(27):"(8U":CHAR(27):'(s0p12h0s3b3T'
          SUP.SMALL  = CHAR(27):"(8U":CHAR(27):'(s0p20h0s0b0T'
          NORM       = CHAR(27):'(8U'
          NORM      := CHAR(27):'(s0p10h12v0s0b3T'
          NORM.BOLD  = CHAR(27):'(8U'
          NORM.BOLD := CHAR(27):'(s0p10h12v0s1b3T'
          LARGE      = CHAR(27):'(8U'
          LARGE     := CHAR(27):'(s1p10h14v0s3b3T'
          XLARGE     = CHAR(27):'(8U'
          XLARGE    := CHAR(27):'(s0p8h8v0s3b3T'

          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
          BEGIN CASE
          CASE PSTYLE.OVRD#''
             STYLE.ID = PSTYLE.OVRD
          CASE LED(77)<1,GEN>
             STYLE.ID = LED(77)<1,GEN>
          CASE OTHERWISE
             STYLE.ID = 'NET'
          END CASE

          GOSUB GET.PSTYLE

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

    * Compile column heading line from print style record
          TOTAL.SPACES = COL.START
          FMT          = 'L#':COL.START

          FOR COL = 1 TO COL.CT
             LGTH = FIELD(COL.FRMTS<1,COL>,'#',2)+0
             FRMT = 'L#':LGTH
             IF COL=COL.CT THEN
                TOTAL.FRMT = COL.FRMTS<1,COL>
             END ELSE
                TOTAL.SPACES = TOTAL.SPACES + LGTH
             END
          NEXT COL

          NO.TOLS   = NOT(COL.EXTDS<1,COL.CT>)
          NET.TOLS  = (COL.BASIS<1,COL.CT>=1 OR COL.BASIS<1,COL.CT>=2)
          TOTAL.FMT = 'L#':TOTAL.SPACES

          GOSUB GET.TOTALS

          PRINT.CREDIT.MSG = (PRT.MSG AND STATUS = 'O')

          IF PRINT.CREDIT.MSG THEN
             FT.LGTH  += 3
          END

          CUS.PO     = LED(13)<1,GEN>
          REL.NO     = LED(65)<1,GEN>
          FRGHT.ALLW = LED(69)<1,GEN,1>

          IF FRGHT.ALLW THEN
             FRGT = 'Yes'
          END ELSE
             FRGT = 'No'
          END

          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>
*         READV ORD.BY FROM INIFILE,ORD.BY,3 ELSE NULL
          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>
          PHONE.NO = CUS(17)<1,1>
          TERMS.ID = LED(29)<1,GEN>
          READV TERMS.DESC FROM TERMSFILE,TERMS.ID,1 ELSE TERMS.DESC=''

*B2B
          SHIP.ADDR = LED(78)<1,GEN,6>
          IF NOT(SHIP.ADDR) THEN SHIP.ADDR = CUSS(1)
          SHIP.ADDR<-1> = LED(78)<1,GEN,1>
          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 CUSS(97)
* USE SHIP TO FOR BILLING ADDRESS
             BILL.ADDR = SHIP.ADDR<1>
             IF CUSS(2)<1,1> # '' THEN BILL.ADDR<-1> = CUSS(2)<1,1>
             IF CUSS(2)<1,2> # '' THEN BILL.ADDR<-1> = CUSS(2)<1,2>
             BILL.ADDR<-1> = TRIM(CUSS(3)):', ':CUSS(4)"L#4":CUSS(5)"L#14"
          CASE CUSS(91)<1,1>
* USE ALTERNATE SHIPTO IN SHIPTO RECORD
             BILL.ADDR = CUSS(91)<1,1>
             IF CUSS(92)<1,1> # '' THEN BILL.ADDR<-1> = CUSS(92)<1,1>
             IF CUSS(92)<1,2> # '' THEN BILL.ADDR<-1> = CUSS(92)<1,2>
             BILL.ADDR<-1> = TRIM(CUSS(93)):', ':CUSS(94)"L#4":CUSS(95)"L#14"
          CASE CUS(91)<1,1>
* USE BILL TO ALTERNATE ADDRESS
             BILL.ADDR = CUS(91)<1,1>
             IF CUS(92)<1,1> # '' THEN BILL.ADDR<-1> = CUS(92)<1,1>
             IF CUS(92)<1,2> # '' THEN BILL.ADDR<-1> = CUS(92)<1,2>
             BILL.ADDR<-1> = TRIM(CUS(93)):', ':CUS(94)"L#4":CUS(95)"L#14"
          CASE OTHERWISE
* USE BILLTO NORMAL METHOD
             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)"L#4":CUS(5)"L#14"
          END CASE

          COPY.CNT = 1
          IF INDEX(CUS(129), 'SHIP-ONLY', 1) THEN
             COPY.CNT = 2
          END

          BO.FLAG  = YES
          SHP.INST = LED(74)<1,GEN>
          SHIP.INST = SHP.INST<1,1,1>
          SHIP.INST = UPCASE(SHIP.INST)

          IF SHIP.INST = "!NOBO" OR BO.PRT.OPT = 1 THEN
             BO.FLAG  = NO
             SHP.INST = DELETE(SHP.INST,1,1,1)
          END

          * let user know that they need to print item tag labels
          ITEM.TAG.INFO  = '' ;* Item tag info
          OE.ITEM.TAG.READ OID,,,,ITEM.TAG.INFO

          IF SHP.INST#''  OR ITEM.TAG.INFO THEN
             BLINE     += 1
             BOD<BLINE> = SPACE(SSPC):'******* Shipping Instructions *******'
             FOLD.STRING RAISE(SHP.INST),33,SHP.INST

             CT = DCOUNT(SHP.INST,VM)
             FOR JJ = 1 TO CT
                BLINE += 1
                BOD<BLINE> = SPACE(SSPC):'* ':SHP.INST<1,JJ>"L#33":' *'
             NEXT JJ

             IF ITEM.TAG.INFO THEN
                BLINE += 1
                MSG = '* Delivery labels exist for order.'"L#35"
                BOD<BLINE> = SPACE(SSPC):MSG:' *'
             END

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

          WHSE.MSG = 'Shp ':SHIP.BR  "L#4 ":'Prc ':BR               "L#4"

          ORD.MSG = 'ORDER'

          IF LED(61)<1,GEN> THEN
             TAX.MSG = 'N'
          END ELSE
             TAX.MSG = 'Y'
          END

          PRT.TIME =  TIMEDATE()
          BO.PNS   = ''

          US.FUNDS = LED(92)<1,GEN,2>
          IF US.FUNDS # '' AND NOT(NUM(US.FUNDS)) THEN US.FUNDS = ''

          READ CTRL.FTR FROM CTRLFILE, 'SOE.FOOTER.MSG' ELSE CTRL.FTR = ''
          READV SERV.RATE FROM CTRLFILE,'DEFAULT.SERVICE.CHG.PCT',1 ELSE SERV.RATE = '150'
          SERV.RATE = OCONV(SERV.RATE,'MR2')
          SERV1     = FIELD(SERV.RATE,'.',1)-0
          SERV2     = FIELD(SERV.RATE,'.',2)-0
          IF SERV2  = 0 THEN SERV.RATE = SERV1

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

*         IF FAX.FLAG THEN
*            PRINT '@+IMAGE[INV]'
*            PRINT CHAR(27):"*p0Y":
*         END

          *** Print the macro
          MACRO.ID = 'SHIP~':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
          PRINT SPACE(60):XLARGE:'Packing Slip':NORM

*         PRINT CHAR(27):"*p50Y":SLPI
*         FOR KK = 1 TO 5
*            PRINT '' "L#1":LARGE:  BR.ADDR<KK>:NORM
*         NEXT KK

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

          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 = "SOLD TO"
          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

          PRINT COD.MSG "L#50"

*------Header Info------*
          PRINT CHAR(27):"*p890Y"
          PRINT
          PRINT
          PRINT '    ':ST.CN          'L#9 ':
          PRINT CUS.PO                'L#22 ':
          PRINT REL.NO                'L#21 ':

*         PRINT ORD.WITH              'L#19 ':
*         PRINT BR                    'R#2':'   ':

          PRINT SALESMAN              'L#20'
          PRINT
          PRINT
          PRINT ' ':WRITER            'L#22 ':
          *** Center Ship Via
          PAD = (17 - LEN(SHIP.VIA)) / 2
          IF PAD > 0 THEN
             VIA = SPACE(INT(PAD)):SHIP.VIA
          END ELSE
             VIA = SHIP.VIA
          END
          PRINT VIA                   'L#17 ':
          PRINT WHSE.MSG              'L#17 ':
          PRINT OCONV(SHP.DATE,'D2/') 'L#10 ':
          PRINT FRGT
          PRINT
          BO.HEADING = NO

          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
*-------------------------------------------------------------------------*
* NEW SUBTOTALS LOGIC 02/10/00 - FROM SG PLUMBING
*-------------------------------------------------------------------------*
SUBTOTALS: *
          PRT.STR1 = SPACE(COL.START+12)
          PRT.STR2 = SPACE(COL.START+12-LEN(SUBT.DESC)):SUBT.DESC

          *** Now find the exchange rate for the GN passed in.
          IF LED(92)<1,GEN,2> THEN
             XRATE = OCONV(LED(92)<1,GEN,2>,'MR4')
          END ELSE
             XRATE = 1
          END

          FOR COL = 1 TO COL.CT
             LGTH = FIELD(COL.FRMTS<1,COL>,'#',2)
             IF COL.EXTDS<1,COL> THEN
                PRT.STR1 = PRT.STR1:STR('-',LGTH)
                IF SUBT.SW THEN
                   PRT.STR2 = PRT.STR2:(OCONV(LD(8)<1,GEN>/XRATE,'MR2')*QSIGN) COL.FRMTS<1,COL>
                END ELSE
                   PRT.STR2 = PRT.STR2:COL.TOTAL<1,COL> COL.FRMTS<1,COL>
                END
             END ELSE
                IF COL = 2 THEN
                   PRT.STR1 = PRT.STR1:STR('-',LGTH)
                   PRT.STR2 = PRT.STR2:(OCONV(LD(8)<1,GEN>/XRATE,'MR2')*QSIGN) COL.FRMTS<1,COL>
                END ELSE
                   PRT.STR1 = PRT.STR1
                   PRT.STR2 = PRT.STR2
                END
             END
          NEXT COL

          PRINT NORM.BOLD:PRT.STR2:NORM

          RETURN
*-------------------------------------------------------------------------*
GET.TOTALS: *
          SOE.CALC.CASH OID,GEN,AMT.DUE,AMT.PAID,CASH.DISC
          OE.ORDER.TOTAL OID,GEN,QSIGN,TOTAL,SUB.TOL,FREIGHT,HANDLING,TAX.AMT,FET.AMT
          FREIGHT   = OCONV(FREIGHT,'MR2')
          HANDLING  = OCONV(HANDLING,'MR2')
          TAX.AMT   = OCONV(TAX.AMT,'MR2')
          CASH.DISC = OCONV(CASH.DISC,'MR2')

  * Find service Charges , put in OE.ORDER.TOTAL when possible
          LOCATE 'SC' IN LED(24)<1,GEN> SETTING POS THEN
             SERV.CHRG = -OCONV(LED(26)<1,GEN,POS>,'MR2')
          END ELSE
             SERV.CHRG = 0
          END

          RETURN

        ! 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
*-------------------------------------------------------------------------*
PRINT.TOTALS: *
          SUBT.DESC = '  Subtotal'
          IF TAX.AMT THEN
  *** This TAX stuff is special for Canada...They have to split it up.
*            GL.IDS   = LED(63)<1,GEN>
*            TAX.AMTS = LED(64)<1,GEN>
*            TAX.CT   = DCOUNT(TAX.AMTS,SVM)
*            TAX.AMT1 = 0; TAX.AMT2 = 0
*            FOR TAX.INDX = 1 TO TAX.CT
*               IF GL.IDS<1,1,TAX.INDX> = "76" THEN
*                  TAX.AMT1  = OCONV(TAX.AMTS<1,1,TAX.INDX>,'MR2')
*               END ELSE
*                  TAX.AMT2  = OCONV(TAX.AMTS<1,1,TAX.INDX>,'MR2')
*               END
*            NEXT TAX.INDX
*            TOTAL.COMMENT = 'GST'
*            TOTAL.AMT     = TAX.AMT1
*            GOSUB PRINT.TOTAL
*            RUNNING.TOTAL += TOTAL.AMT
*            TOTAL.COMMENT = 'PST'
          END
          IF SERV.CHRG THEN
             TOTAL.COMMENT = 'Service Charge'
             TOTAL.AMT     = SERV.CHRG
             GOSUB PRINT.TOTAL
             RUNNING.TOTAL += TOTAL.AMT
          END

          PRINT.AMT.DUE = NO

          IF AMT.PAID THEN
             PRINT.AMT.DUE = YES
             IF LED(8)<1,GEN>='' THEN
                TOTAL.COMMENT = 'Less cash paid'
                IF US.FUNDS THEN
                   AMT.PAID =ICONV(AMT.PAID/OCONV(US.FUNDS,'MR4'),"MR0")
                END
                TOTAL.AMT  = OCONV(AMT.PAID,'MR2')
                GOSUB PRINT.TOTAL
                RUNNING.TOTAL = RUNNING.TOTAL + TOTAL.AMT
             END ELSE
                AR.ID = OID:'.':LED(8)<1,GEN>"R%3"
                SOE.PAYMENTS.DISC AR.ID,PAY.IDS,PAY.DTS,PAY.AMTS,DISC.TAKEN
                IF DISC.TAKEN THEN
                   TOTAL.COMMENT = 'Less discount taken'
                   IF US.FUNDS THEN
                      DISC.TAKEN =ICONV(DISC.TAKEN/OCONV(US.FUNDS,'MR4'),"MR0")
                   END
                   TOTAL.AMT     = OCONV(DISC.TAKEN,"MR2")
                   CASH.DISC     = 0
                   GOSUB PRINT.TOTAL
                   RUNNING.TOTAL = RUNNING.TOTAL + TOTAL.AMT
                END
                PCT = DCOUNT(PAY.IDS,VM)
                FOR PYN = 1 TO PCT
                   PAY.ID  = PAY.IDS<1,PYN>
                   PAY.DT  = PAY.DTS<1,PYN>
                   PAY.AMT = PAY.AMTS<1,PYN>
                   IF PAY.DT=DATE() THEN
                      TOTAL.COMMENT = 'Amount paid today - Payment # ':PAY.ID"L#12"
                   END ELSE
                      TOTAL.COMMENT = 'Prior Deposit on ':OCONV(PAY.DT,'D2/')"L#8"
                   END
                   IF US.FUNDS THEN
                      PAY.AMT =ICONV(PAY.AMT/OCONV(US.FUNDS,'MR4'),"MR0")
                   END
                   TOTAL.AMT = OCONV(PAY.AMT,"MR2")
                   GOSUB PRINT.TOTAL
                   RUNNING.TOTAL = RUNNING.TOTAL + TOTAL.AMT
                NEXT PYN
             END
          END

          RETURN
*-------------------------------------------------------------------------*
PRINT.TOTAL: *
          PRT.STR    = TOTAL.COMMENT"R#56" TOTAL.FMT
          PRT.STR    = PRT.STR:TOTAL.AMT TOTAL.FRMT
          BLINE     += 1
          BOD<BLINE> = PRT.STR

          RETURN
*-------------------------------------------------------------------------*
PRINT.TOTAL.LINE: *
          LGTH       = FIELD(TOTAL.FRMT,"#",2)
          PRT.STR    = SPACE(TOTAL.SPACES):STR('-',LGTH)
          BLINE     += 1
          BOD<BLINE> = PRT.STR

          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
          CASE PN='S'
             IF NOT(LOT.FLAG) THEN
                GOSUB PRT.SUBT
             END
          END CASE

          RETURN
*-------------------------------------------------------------------------*
PRT.PN:   *
          TOT.QS       = QS
          LINE.CT     += 1
          GET.ALL.PRD BR,PN,QSIGN,GROUP

          * If there is anything in PRD(80) we need to print the Hazardous
          * information.  PRD(80) is multivalued so converting VM to '' to
          * correctly determine if anything exists in this record.
          HAZMAT.INFO = PRD(80)
          CONVERT VM TO '' IN HAZMAT.INFO
          IF HAZMAT.INFO THEN PRINT.HAZ = YES

          SHP.TYP.LOCS = LD(7)<1,GEN>
          LOC.CT       = DCOUNT(SHP.TYP.LOCS,SVM)
          LN.MSG       = LINE.CT
          PRT.OK       = NO

          GOSUB CHK.DKIT

          *** Check whether the product is flagged for Serial Number
          *** Tracking at the Shipping Branch...
          PRD.BR.GET.VAL SHIP.BR,PN,25,SERIAL.TRACKING

          FOR LOC = 1 TO LOC.CT

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

             OE.DESC.GET DESC,ALT.DESC,"SOE Printing"
             IF DKIT THEN DESC = INSERT(DESC,1,1;'*** Dynamic Kit ***')
             IF LD(36)<1,GEN,1>#'' THEN DESC<1,-1> = LD(36)<1,GEN,1>

*** Serial number logic
             *** As long as our product is flagged for Serial Number
             *** Tracking, but not as 'N' - None...
             IF SERIAL.TRACKING AND SERIAL.TRACKING # 'N' THEN
                *** Check whether Serial Numbers have already been
                *** entered...
                SN.LIST = LD(32)<1,GEN>
                IF SN.LIST # '' THEN
                SN.CT   = DCOUNT(SN.LIST,SVM)
                FOR SN  = 1 TO SN.CT
                   IF SN.LIST<1,1,SN> THEN
                      DESC<1,-1> = 'Serial#: ':SN.LIST<1,1,SN>
                   END
                NEXT SN
             END ELSE
                FOR XX = 1 TO QS
                   DESC<1,-1> = 'Serial#____________________________'
                NEXT XX
             END
          END

*----Kits
          BEGIN CASE
          CASE CUS(74) = "Yes"
             IF LD(31)#'' THEN
                KCMPS = LD(31)
                KQTYS = LD(30)
                KCMTS = LD(37)
                GET.KIT.COMPS.LOC.ALT KCMPS,KQTYS,KCMTS,45,DESC,SHIP.BR,ALT.DESC,GEN,QS
             END
          CASE CUS(74) = "Default" OR CUS(74) = ''
             IF LD(31)#'' AND LD(38)<1,2> = '1' THEN
                KCMPS = LD(31)
                KQTYS = LD(30)
                KCMTS = LD(37)
                GET.KIT.COMPS.LOC.ALT KCMPS,KQTYS,KCMTS,45,DESC,SHIP.BR,ALT.DESC,GEN,QS
             END
          CASE OTHERWISE
          END CASE

          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

          SHP.TYP.LOC = SHP.TYP.LOCS<1,1,LOC>
          LOCA        = FIELD(FIELD(SHP.TYP.LOC,'~',2),'^',1)
          TYPE        = FIELD(SHP.TYP.LOC,'~',1)
          IF LOCA = 'WHSE' THEN PRINT.PICK = YES
          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
*LOT
          IF LOT.FLAG THEN
             DQS   = 1
             QS    = 1
             QOPEN = 1
          END

          BEGIN CASE
          CASE QS < 0 AND TYPE = 'F';  LOCA = '**DEF '
          CASE QS > 0 AND TYPE = 'D';  LOCA = '**DIR '
          CASE QS < 0;                 LOCA = '**RTN '
          END CASE

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

          IQ.TO.ALPHA PLNE(3),PRD(7),LD(23),DQS,Q1,U1,Q2,U2,DQS.ALPHA
          PRT.STR  = TRIM(QO.ALPHA)          "R#9"
          PRT.STR := TRIM(DQS.ALPHA)         "R#9":' '
          PRT.STR := DESC<1,1>               "L#35"
          *DESC<1,-1> = 'Loc: ':LOCA'L#18':' Pn: ':PN'L#6'
          SKU = FIELD(PRD(4)<1,1>, ' ', 2)[1,7]       ;* keyword #2
          DESC<1,-1> = 'SKU: ':SKU'L#7':'  GL Code: ':PRD(19)[1,16]'L#16'

          IF ITEM.TAG.INFO THEN
             * Let user know how many labels go with this line
             OE.ITEM.TAG.GET.FORM.CMT OID,GEN,LDID,LBL.DATA
             LBL.CT = DCOUNT(LBL.DATA,AM)
             FOR QQ = 1 TO LBL.CT
                DESC<1,-1> = LBL.DATA<QQ>
             NEXT QQ
          END

          SAVE.LINE = PRT.STR
*LOT
          IF LOT.FLAG THEN
             FORMS.GET.LOT.PRC "ACK",LDID,GEN,'',UNT.PRC
             PRT.STR := UNT.PRC "R3#11"
             PRT.STR := UNT.PRC "R2#10"
             COL.TOTAL<1,COL.CT> += UNT.PRC
          END ELSE
             OE.GET.PSTYLE OID,GEN,COL.START,COL.FRMTS,COL.BASIS,COL.EXTDS,COL.CT,QS,PRT.STR,COL.TOTAL,SUB.TOTAL
          END


          IF NO.PRICING<LD.NO> THEN PRT.STR = SAVE.LINE
          PG.LINE = REM(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
*LOT
          IF LOT.FLAG THEN
             OE.LOT.PRINT.SETUP OID,GEN,'S','A',BLINE,SSPC,BOD,,'',LDID
          END

          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
             PRT.STR = SPACE(SSPC):DESC<1,DLN>
             IF TRIM(PRT.STR) THEN
                BLINE     += 1
                BOD<BLINE> = PRT.STR
             END
          NEXT DLN

          RETURN
*-------------------------------------------------------------------------*
PRT.SUBT: *
          IF NOT(NO.TOLS) THEN
             SUBT.SW   = YES
             OE.DESC.GET DESC,ALT.DESC,"SOE Printing"
             SUBT.DESC = DESC<1,1>
             GOSUB SUBTOTALS
             DESC      = DELETE(DESC,1,1)
             GOSUB PRT.XDESC
             SUBT.SW   = NO
             SUB.TOTAL = ''
          END

          RETURN
*-------------------------------------------------------------------------*
PRT.OS:   *
          GN.CT    = DCOUNT(LED(6),VM)
          OS.MSG   = ''
* ORDER SUMMARY
          PAYMENTS = 0
          PAID.BY  = ''
          SALES    = 0
          SHIP.CT  = 0
          FOR GN = 1 TO GN.CT
             STAT   = LED(6)<1,GN>
             IF STAT#'X' AND STAT#'Y' THEN
                IF STAT = '$' THEN
                   PAYMENTS -= SUM(LED(45)<1,GN>)
                   GOSUB ADD.PAYMT
                END ELSE
                   SHIP.CT += 1
                   OE.ORDER.TOTAL OID,GN,QSIGN,GEN.TOTAL
                   SALES    += GEN.TOTAL
                END
             END
          NEXT GN
          IF PAYMENTS # 0 THEN
             BAL.AMT     = SALES+PAYMENTS
             IF SHIP.CT > 1 OR ICONV(RUNNING.TOTAL,"MR2") # BAL.AMT THEN
                OS.MSG       = STR("*",10):' ORDER SUMMARY ':STR("*",10)
                OS.MSG<1,-1> = 'Total Sales for Order'"R#21":OCONV(SALES,"MR2") "R#14"
                OS.MSG<1,-1> = 'Payments to Date'"R#21":OCONV(PAYMENTS,"MR2") "R#14"
                OS.MSG<1,-1> = SPACE(23):STR('-',12)
                OS.MSG<1,-1> = 'Balance' "R#21":OCONV(BAL.AMT,"MR2") "R#14"
                OS.MSG<1,-1> = STR("*",35)
             END
             IF OS.MSG THEN
                DESC = OS.MSG
                GOSUB PRT.XDESC
             END
             IF PAID.BY THEN
                DESC = PAID.BY
                GOSUB PRT.XDESC
             END
          END

          RETURN
*-------------------------------------------------------------------------*
ADD.PAYMT: *
          PINVN    = LED(8)<1,GN> + 0
          PAY.ID   = OID:'.':PINVN"R%3"
          READ TST FROM ARFILE,PAY.ID ELSE TST = ''
          PAY.DT  = OCONV(TST<3,1>,"D2/")
          IF LED(45)<1,GN,1> THEN
             PAID.BY<1,-1> = PAY.DT:OCONV(LED(45)<1,GN,1>,"MR2") "R#12" :' Cash'
          END
          IF LED(45)<1,GN,2> THEN
             PAID.BY<1,-1> = PAY.DT:OCONV(LED(45)<1,GN,2>,"MR2") "R#12" :' Check# ':LED(46)<1,GN,2>
          END
          IF LED(45)<1,GN,3> THEN
             PAID.BY<1,-1> = PAY.DT:OCONV(LED(45)<1,GN,3>,"MR2") "R#12":' Credit Card ': OCONV(LED(46)<1,GN,3>,"MCA")
          END

          RETURN
*-------------------------------------------------------------------------*
PRT.BO:   *** Print out our back orders if we're allowed

          *** Get out if entity is flagged to print back orders on first
          *** gen/invoice only
          IF BO.PRT.OPT = 2 THEN
             IF (INVN # 1) OR (STAT = "Y" OR STAT = "$" OR STAT = "X") THEN
                RETURN
             END
          END

          GN.CT    = DCOUNT(LED(12),VM)
          BO.CT    = 0
          BO.PNS   = ''
          BO.QTYS  = ''
          BO.LDS   = ''
          XBO.CT   = 0
          XBO.PNS  = ''
          XBO.QTYS = ''
          XBO.LDS  = ''
          FOR GN = 1 TO GN.CT
             STAT   = LED(6)<1,GN,1>
             IF GN#GEN AND LED(8)<1,GN>='' AND STAT#'$' AND STAT#'B' AND STAT#'Y' THEN
                LDIDS = LED(48)<1,GN>
                LD.CT = DCOUNT(LDIDS,SVM)
                FOR LLN = 1 TO LD.CT
                   LDID  = LDIDS<1,1,LLN>
                   LD.GET LDID
                   QTY   = (SUM(LD(5)<1,GN>) + SUM(LD(6)<1,GN>)) * QSIGN
                   IF NUM(LDID) AND LDID#'' AND QTY THEN
                      PN = LD(1)
                      IF STAT # 'X' THEN
                         LOCATE PN IN BO.PNS SETTING PLOC ELSE
                            BO.CT += 1
                            PLOC = BO.CT
                            BO.PNS<PLOC> = PN
                            BO.LDS<PLOC> = LDID
                         END
                         BO.QTYS<PLOC> += QTY
                      END ELSE
                         LOCATE PN IN XBO.PNS SETTING PLOC ELSE
                            XBO.CT += 1
                            PLOC = XBO.CT
                            XBO.PNS<PLOC> = PN
                            XBO.LDS<PLOC> = LDID
                         END
                         XBO.QTYS<PLOC> += QTY
                      END
                   END
                NEXT LLN
             END
          NEXT GN
BO.EXIT:  IF BO.CT THEN
             BLINE += 1
             BOD<BLINE> = ''
             BLINE += 1
             BOD<BLINE> = SPACE(SSPC):"**** The following are scheduled ****"
             BLINE += 1
             BOD<BLINE> = SPACE(SSPC):"**** for future shipment:        ****"
             FOR B=1 TO BO.CT
                PN   = BO.PNS<B>
                LDID = BO.LDS<B>
                LD.GET LDID
                GET.ALL.PRD BR,PN,QSIGN,GROUP
                IF PRD(15) = '' THEN UMTBL = PLNE(3) ELSE UMTBL = PRD(15)
                IQ.TO.ALPHA UMTBL,PRD(7),LD(23),BO.QTYS<B>,Q1,U1,Q2,U2,QO.ALPHA
                OE.DESC.GET DESC,ALT.DESC,"SOE Printing"
                PRT.STR    = ' ':TRIM(QO.ALPHA)              "R#8"
                PRT.STR   := ' ':"B/O"                       "R#8"
                PRT.STR   := ' ':DESC<1,1>                   "L#37"
                BLINE     += 1
                BOD<BLINE> = PRT.STR
                DESC       = DELETE(DESC,1,1)
                SKU        = FIELD(PRD(4)<1,1>, ' ', 2)[1,7]    ;* keyword #2
                DESC<1,-1> = ('SKU: ':SKU)                   "L#37"
                GOSUB PRT.XDESC
             NEXT B
          END
          IF XBO.CT THEN
             BLINE     += 1
             BOD<BLINE> = ''
             BLINE += 1
             BOD<BLINE> = SPACE(SSPC):"**** The following items  ****"
             BLINE += 1
             BOD<BLINE> = SPACE(SSPC):"**** have been cancelled. ****"
             BLINE     += 1
             BOD<BLINE> = PRT.STR
             FOR B=1 TO XBO.CT
                PN   = XBO.PNS<B>
                LDID = XBO.LDS<B>
                LD.GET LDID
                GET.ALL.PRD BR,PN,QSIGN,GROUP
                IF PRD(15) = '' THEN UMTBL = PLNE(3) ELSE UMTBL = PRD(15)
                IQ.TO.ALPHA UMTBL,PRD(7),LD(23),XBO.QTYS<B>,Q1,U1,Q2,U2,QO.ALPHA
                OE.DESC.GET DESC,ALT.DESC,"SOE Printing"
                PRT.STR    = ' ':TRIM(QO.ALPHA)              "R#8"
                PRT.STR   := ' ':"Cancel"                    "R#8"
                PRT.STR   := ' ':DESC<1,1>                   "L#37"
                BLINE     += 1
                BOD<BLINE> = PRT.STR
                DESC       = DELETE(DESC,1,1)
                SKU        = FIELD(PRD(4)<1,1>, ' ', 2)[1,7]    ;* keyword #2
                DESC<1,-1> = ('SKU: ':SKU)                   "L#37"
                GOSUB PRT.XDESC
             NEXT B
          END

          RETURN
*-------------------------------------------------------------------------*
FOOTER:  *
          IF NOT(NO.TOLS) THEN

             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 shipping 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 Sales Tax
             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

          END

          *IF BO.FLAG THEN GOSUB PRT.BO

          *** CUSTOM
          PRINT CHAR(27):"*p2790Y"
          PRINT MED:' Before material can be returned our consent must be obtained.'
          PRINT ' No goods accepted for return without this Ticket or Ticket Number.'
          PRINT ' Re-handling Charges will be made on All Returned Material.'
          PRINT
          PRINT ' Received By_______________________________________':NORM:SLPI:

          *** 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)
          *   *** Have to limit footer to 4 lines.
          *   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

          RETURN
*-------------------------------------------------------------------------*
PRINT.TOTE.INFO: *
          READ PKG.TYPES FROM CTRLFILE,'PACKAGE.TYPES' ELSE
             PKG.TYPES = ''
          END

          READ LEDL FROM LEDLFILE,OID ELSE
             LEDL = ''
          END
          PICKER.IDS = RAISE(LEDL<20,GEN>)
          TOTE.IDS   = RAISE(LEDL<21,GEN>)
          STAGE.LOCS = RAISE(LEDL<22,GEN>)
          PKG.QTYS   = RAISE(LEDL<18,GEN>)

          BEGIN CASE
          CASE TOTE.IDS
             ITEM.CNT = DCOUNT(TOTE.IDS,VM)
             ITEM.IDS = TOTE.IDS
          CASE STAGE.LOCS
             ITEM.CNT = DCOUNT(STAGE.LOCS,VM)
             ITEM.IDS = STAGE.LOCS
          CASE OTHERWISE
             ITEM.CNT = DCOUNT(PICKER.IDS,VM)
             ITEM.IDS = PICKER.IDS
          END CASE

          IF ITEM.CNT THEN
             BLINE += 1
             BOD<BLINE> = ''
             BLINE += 1
             BOD<BLINE> = ''

             FOR T = 1 TO ITEM.CNT
                NUM.ITEMS = DCOUNT(ITEM.IDS<1,T>,SVM)
                FOR N = 1 TO NUM.ITEMS
                   TOTE.ID = TOTE.IDS<1,T,N>
                   PCK.ID  = PICKER.IDS<1,T,N>
                   STG.LOC = STAGE.LOCS<1,T,N>
                   PRT.STR = " Tote: ":TOTE.ID "L#15 ":"Picker: ":PCK.ID "L#15 ":"Loc: ":STG.LOC "L#20"
                   BLINE += 1
                   BOD<BLINE> = PRT.STR
                NEXT N
             NEXT T

             BLINE += 1
             BOD<BLINE> = ''

             PKG.DATA.STR = ''
             PCNT = DCOUNT(PKG.TYPES,VM)
             FOR P = 1 TO PCNT
                PKG.DATA.STR := PKG.TYPES<1,P>:': ':PKG.QTYS<1,P> "L#5 "
             NEXT P

             PRT.STR = ' Packages:   ':PKG.DATA.STR
             BLINE += 1
             BOD<BLINE> = PRT.STR
          END
          RETURN
*-------------------------------------------------------------------------*
FFEED:    *
          IF REPRINT THEN
             PRINT CHAR(27):"*p3050Y"
             PRINT SPACE(57):SMALL:'** Reprint ** Reprint ** Reprint **':NORM:
          END
          PRINT CHAR(12):

          RETURN
*-------------------------------------------------------------------------*
CHKCC:    * Check for Credit Card information

          *** Get any Payments that apply to this order...
          SOE.FORMS.GET.CC.INFO OID,GEN,CC.AMT,PAYMENT.IDS

          IF PAYMENT.IDS THEN
             *** Open Credit Card Payment file
             UT.OPEN.FILE "CC.PAYMENTS",CCPFILE,ERR.MSG
             IF ERR.MSG THEN RETURN

             PAYMENT.CT = DCOUNT(PAYMENT.IDS,VM)

             FOR PC = 1 TO PAYMENT.CT
                READ CC FROM CCPFILE,PAYMENT.IDS<1,PC> ELSE CC = ''
                IF CC THEN GOSUB PRTCC
             NEXT PC
          END

          RETURN
*-------------------------------------------------------------------------*
PRTCC:    * Print Credit Card Information
          AUTHDT = OCONV(CC<2>, 'D4/')        ;* Date of Authorization
          AUTH   = CC<3>                      ;* Auth Code
          CHGAMT = OCONV(CC<6>,'MR2')         ;* Amount Charged
          BBATCH = CC<12>                     ;* Banks Batch Reference
          TERMID = CC<15>                     ;* Terminal ID
          MRCHID = CC<16>                     ;* Merchant ID
          REF    = CC<17>                     ;* Item Number
          SWIPE  = CC<20>                     ;* Swipe info

*** Break out swiped data
          IF SWIPE THEN
             CREDIT.CARD.READ.SWIPE SWIPE,TRACK1,TRACK2,CCARD.NO,EXP.DT,CNAME,ERR.MSG
          END ELSE
             CCARD.NO   = CC<4,1>
             EXP.DT     = CC<4,2>
             CNAME      = CC<32>                     ;* Credit Card Holder
          END

          CREDIT.CARD.GET.DEFINE CCARD.NO,TYPE

*** Mask card with X's - only display last 4 numbers
          CCARD.NO  = STR('X',LEN(CCARD.NO)-4):RIGHT(CCARD.NO,4)

*** Print the Credit Card Information on same page, need 13 lines
*** Calculate the number of lines left on page

          LNSLEFT = BOD.LINES - MOD(BLINE, BOD.LINES)
          IF LNSLEFT < 13 THEN
             FOR FILL = 1 TO LNSLEFT
                BLINE     += 1
                BOD<BLINE> = ''
             NEXT FILL
          END
          LN = BLINE

          BOD<LN+1>  = ' '
          BOD<LN+2>  = '    *********************** Credit Card Information ************************'
          BOD<LN+3>  = '    *'                            "L#75":'*'
          BOD<LN+4>  = '    * Merchant ID# : ':MRCHID     "L#20"
          BOD<LN+4> := ' Time':TIME.ZONE$:'/Date: ':TIMEDATE()          "L#22":'*'
          BOD<LN+5>  = '    * Card Number  : ':CCARD.NO   "L#20"
          BOD<LN+5> := ' Card Type: ':TYPE                "L#6"
          BOD<LN+6>  = '    * Card Holder  : ':CNAME      "L#20"
          BOD<LN+6> := ' Auth Code: ':AUTH                "L#22":'*'
          BOD<LN+7>  = '    * Charge Amount: $':CHGAMT    "L#19"
          BOD<LN+7> := ' Charge Date: ':AUTHDT            "L#20":'*'
          BOD<LN+8>  = '    *'                            "L#75":'*'
          BOD<LN+9>  = '    *'                            "L#75":'*'
          BOD<LN+10> = '    * Signature    : ':STR('_',34)"L#54":'*'
          BOD<LN+11> = '    *'                            "L#75":'*'
          BOD<LN+12> = '    * I agree to pay above total amount according to card issuer agreement.*'
          BOD<LN+13> = '    *':STR('*', 71)

          BLINE += 13

          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
*-------------------------------------------------------------------------*
FINISH:   *
          IF NOT(PHANTOM.PROC) AND NOT(PRT.ON) AND NOT(JAVA.PROC$) THEN
             WINDOW.CLOSE
          END
          LOCATION = SV.LOC

          RETURN
*-------------------------------------------------------------------------*
!JONW~02/17/10~15:02
