SUBROUTINE (OID,GEN,STATUS,RESP,PSTYLE.OVRD) ** Version# 137.0002[22] - 07/23/2013 - 02:01pm - TSMITH - eclipse *** V137.0002 Change - Custom Coding . - 07/23/2013 - TSMITH - eclipse *** V136.0004 Change - Custom Coding . - 01/28/2012 - TSMITH - eclipse *** V136.0002 Change - Custom Coding AAA000 - 12/28/2010 - BARSPA - eclipse *** V136.0001 Change - Custom Coding AAA000 - 12/27/2010 - BARSPA - eclipse ** Copied from BP SOE.MBX.ORDER.HTML Version# 136 - 12/07/2009 - 03:55pm - DOUGW - main *** Subroutine - SOE.MBX.ORDER.HTML *-------------------------------------------------------------------------* *** This routine will create an html document to send as an email *** attachment from the calling program. The document will be formatted *** to display an Eclipse order (bid, open, shipping ticket, invoiced). *-------------------------------------------------------------------------* *** OID - Order ID (IN) *** GEN - Generation of Order (IN) *** STATUS - Old Status of order (IN) *** RESP - HTML response created through this program (OUT) *-------------------------------------------------------------------------* *** Return if Email Orders as Tiff Attachments is active EMAIL.CHECK.TIFF 'INV',OID,GEN,,EMAIL.TIFF IF EMAIL.TIFF THEN RESP = '' RETURN END GOSUB INIT ;* Open web forms file and read in form GOSUB GET.BR.INFO ;* Gets branch info -- rel7 and rel8 GOSUB SET.LOGO ;* Set up logo and color GOSUB SET.HDR ;* Set up order header information GOSUB SET.LINES ;* Set up line item information GOSUB SET.TOTALS ;* Set up total information RETURN *-------------------------------------------------------------------------* INIT: *** Read in form to display order and setup neccesary variables. *** Status comes into this program as the order status, save this *** order status in ORD.STAT variable for HTML.GET.PSTYLE. ORD.STAT = STATUS *** Set the status to a email print status, email only splits *** statuses into 4 types of orders. IF STATUS # "B" AND STATUS # "I" AND STATUS # "T" AND STATUS # "O" AND STATUS # "M" THEN *** If it is not a bid, invoice, or ship ticket it's an ack. STATUS = "A" END *** Set up FORM.TYPE for FORMS.GET.LOT.PRC BEGIN CASE CASE STATUS = "A" FORM.TYPE = "ACK" CASE STATUS = "B" FORM.TYPE = "BID" CASE STATUS = "M" FORM.TYPE = "SUM" CASE STATUS = "I" FORM.TYPE = "INV" CASE STATUS = "T" OR STATUS = "O" FORM.TYPE = "SHIP" END CASE *** If this is a bid make it say "Quote To" instead of "Bill to" BEGIN CASE CASE STATUS = 'B' BILL.TITLE = 'QUOTE TO' CASE STATUS = 'I' BILL.TITLE = 'BILL TO' CASE OTHERWISE BILL.TITLE = 'SOLD TO' END CASE MODE = OID[1,1] *** determine whether the order is a transfer or not IF OID[1,1] = 'T' THEN XFER.FLAG = YES ELSE XFER.FLAG = NO MATREAD LED FROM LEDFILE,OID ELSE MAT LED = '' BT.CN = LED(1)<1,GEN> ST.CN = LED(5)<1,GEN> PRC.BR = LED(2)<1,GEN,1> SHIP.BR = LED(2)<1,GEN,2> TERMS.ID = LED(29)<1,GEN> FRGHT.ALLW = LED(69)<1,GEN,1> LOT.FLAG = LED(98)<1,GEN> LD.GEN = GEN AR.ID = OID:'.':LED(8)<1,GEN>"R%3" IF FRGHT.ALLW THEN FRGHT.ALLW = 'Yes' END ELSE FRGHT.ALLW = 'No' END OE.GET.QSIGN QSIGN,OID,GEN READV TERMS.DESC FROM TERMSFILE,TERMS.ID,1 ELSE TERMS.DESC=TERMS.ID END *** Check if user has the control record set to enable printing *** all gens on the acknowledgement READ PRT.ALL.GENS FROM CTRLFILE,'FRST.PRT.ALL.GENS' ELSE PRT.ALL.GENS = NO END *** Get the site's base currency. READV BASEC FROM CTRLFILE,'BASE.CURRENCY',1 ELSE BASEC = '' IF BASEC # "CAN$" THEN TAX.DESC = '
'
LOGO := ' | '
LOGO := '
' UT.REP.STR BID.MSG,VM:' ':VM,'
' *** convert 2 SVM's (2 returns) to a new paragraph UT.REP.STR BID.MSG,SVM:SVM,'
' UT.REP.STR BID.MSG,VM:VM,'
'
*** need to zap out any remaining SVM's before sending out
CONVERT SVM TO ' ' IN BID.MSG
CONVERT VM TO ' ' IN BID.MSG
CLAIM.MSG = ''
IF STATUS = 'I' THEN
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
CLAIM.MSG = 'All claims for shortage or errors must be made at once, returns require written authorization and are subject to handling charges. Special orders are non-returnable.
Past due invoices may be subject to ':SERV.RATE:'% late charge.'
END
*** Shipment tracking message.
TRK.MSG = ''
IF STATUS # 'B' THEN
GOSUB GET.TRACKING.INFO
END
*** Set up order type description that will be seen at the
*** header of the email
ORDNO = OID
BEGIN CASE
CASE STATUS = 'A'
TYPE.DESC = 'Acknowledgement'
DOC.TYPE = 'Order'
TOT.MSG = 'Total'
DOC.TP = 'S'
CASE STATUS = 'B'
TYPE.DESC = 'Quotation'
DOC.TYPE = 'Order'
TOT.MSG = 'Total'
DOC.TP = 'B'
CASE STATUS = 'I'
TYPE.DESC = 'Invoice'
INVN = LED(8)<1,GEN>+0
ORDNO := '.':INVN "R%3"
DOC.TYPE = 'Invoice'
TOT.MSG = 'Amount Due'
DOC.TP = 'I'
CASE STATUS = 'T'
TYPE.DESC = 'Ship Ticket'
INVN = LED(8)<1,GEN>+0
ORDNO := '.':INVN "R%3"
DOC.TYPE = 'Order'
TOT.MSG = 'Total'
DOC.TP = 'T'
CASE OTHERWISE
TYPE.DESC = 'Order'
DOC.TYPE = 'Order'
TOT.MSG = 'Total'
DOC.TP = 'S'
END CASE
BEGIN CASE
CASE CUSS(97)
*** USE SHIP TO FOR BILLING ADDRESS
BILL.NAME = CUSS(1)
IF CUSS(2)<1,1> # '' THEN BILL.ADDR1 = CUSS(2)<1,1>
IF CUSS(2)<1,2> # '' THEN BILL.ADDR2 = CUSS(2)<1,2>:'
'
BILL.CITY = TRIM(CUSS(3))
BILL.ST = CUSS(4)"L#4"
BILL.ZIP = CUSS(5)"L#14"
CASE CUSS(91)<1,1>
*** USE ALTERNATE SHIPTO IN SHIPTO RECORD
BILL.NAME = CUSS(91)<1,1>
IF CUSS(92)<1,1> # '' THEN BILL.ADDR1 = CUSS(92)<1,1>
IF CUSS(92)<1,2> # '' THEN BILL.ADDR2 = CUSS(92)<1,2>:'
'
BILL.CITY = TRIM(CUSS(93))
BILL.ST = CUSS(94)"L#4"
BILL.ZIP = CUSS(95)"L#14"
CASE CUS(91)<1,1>
*** USE BILL TO ALTERNATE ADDRESS
BILL.NAME = CUS(91)<1,1>
IF CUS(92)<1,1> # '' THEN BILL.ADDR1 = CUS(92)<1,1>
IF CUS(92)<1,2> # '' THEN BILL.ADDR2 = CUS(92)<1,2>:'
'
BILL.CITY = TRIM(CUS(93))
BILL.ST = CUS(94)"L#4"
BILL.ZIP = CUS(95)"L#14"
CASE OTHERWISE
*** USE BILLTO NORMAL METHOD
BILL.NAME = CUS(1)
IF CUS(2)<1,1> # '' THEN BILL.ADDR1 = CUS(2)<1,1>
IF CUS(2)<1,2> # '' THEN BILL.ADDR2 = CUS(2)<1,2>:'
'
BILL.CITY = TRIM(CUS(3))
BILL.ST = CUS(4)"L#4"
BILL.ZIP = CUS(5)"L#14"
END CASE
UT.REP.STR RESP,'&BT.NAME&' ,BILL.NAME ;* Bill to Name
UT.REP.STR RESP,'&BT.ADD1&' ,BILL.ADDR1 ;* Bill to Addr1
UT.REP.STR RESP,'&BT.ADD2&' ,BILL.ADDR2 ;* Bill to Addr2
UT.REP.STR RESP,'&BT.CITY&' ,BILL.CITY ;* Bill to City
UT.REP.STR RESP,'&BT.ST&' ,BILL.ST ;* Bill to State
UT.REP.STR RESP,'&BT.ZIP&' ,BILL.ZIP ;* Bill to Zip
UT.REP.STR RESP,'&ST.NAME&' ,CUSS(1) ;* Ship to Name
UT.REP.STR RESP,'&ST.ADD1&' ,LED(78)<1,GEN,1> ;* Ship to Addr1
UT.REP.STR RESP,'&ST.ADD2&' ,LED(78)<1,GEN,2> ;* Ship to Addr2
*** Allow for change between r6 and r7 format for the way
*** Ship to city and state are stored
IF LED(78)<1,GEN,3> = '' THEN
UT.REP.STR RESP,'&ST.CITY&',LED(78)<1,GEN,4>
UT.REP.STR RESP,'&ST.ST&' ,LED(78)<1,GEN,5>
END ELSE
UT.REP.STR RESP,'&ST.CITY&',FIELD(LED(78)<1,GEN,3>,',',1,1)
UT.REP.STR RESP,'&ST.ST&' ,FIELD(LED(78)<1,GEN,3>,',',2,1)
END
UT.REP.STR RESP,'&ST.ZIP&' ,LED(75)<1,GEN> ;* Ship to Zip
UT.REP.STR RESP,'&BILL.TITLE&',BILL.TITLE ;* "Bill to"
UT.REP.STR RESP,'&DOC.TYPE&' ,DOC.TYPE ;* Doc Type
UT.REP.STR RESP,'&TOT.MSG&' ,TOT.MSG ;* Total Msg
UT.REP.STR RESP,'&ORD.NO&' ,ORDNO ;* Order Number
UT.REP.STR RESP,'&INV.MSG&' ,INV.MSG ;* Invoice msg
UT.REP.STR RESP,'&BID.MSG&' ,BID.MSG ;* Bid msg
UT.REP.STR RESP,'&CLAIM.MSG&' ,CLAIM.MSG ;* Claim msg
UT.REP.STR RESP,'&TRK.MSG&' ,TRK.MSG ;* Tracking msg
UT.REP.STR RESP,'&SHIP.INS&' ,SHIP.INS ;* Ship Instrucs
*** Check for values that may be blank and add space so that
*** table fields don't look messed up
SHIPVIA = LED(70)<1,GEN>
IF SHIPVIA = '' THEN SHIPVIA = ' '
ORD.BY = LED(68)<1,GEN>
IF ORD.BY = '' THEN ORD.BY = ' '
PO.NO = LED(13)<1,GEN>
IF PO.NO = '' THEN PO.NO = ' '
REL.NO = LED(65)<1,GEN>
IF REL.NO = '' THEN REL.NO = ' '
READV SLSPERSON FROM INIFILE,LED(72)<1,GEN>,3 ELSE SLSPERSON = LED(72)<1,GEN>
IF SLSPERSON = '' THEN SLSPERSON = ' '
WRITER = LED(73)<1,GEN>
* Use the actual User Name instead of the User ID on the printout
READV WRITER FROM INIFILE,WRITER,3 ELSE NULL
IF WRITER = '' THEN WRITER = ' '
IF TERMS.DESC = '' THEN TERMS.DESC = ' '
UT.REP.STR RESP,'&SHIPVIA&' ,SHIPVIA ;* Ship Via
UT.REP.STR RESP,'&ORD.BY&' ,ORD.BY ;* Ordered By
UT.REP.STR RESP,'&CUS.NO&' ,LED(1)<1,GEN> ;* Customer
UT.REP.STR RESP,'&PO.NO&' ,PO.NO ;* PO Number
UT.REP.STR RESP,'&REL.NO&' ,REL.NO ;* Release Number
UT.REP.STR RESP,'&SLSPERSON&',SLSPERSON ;* Salesperson
UT.REP.STR RESP,'&WRITER&' ,WRITER ;* Writer
UT.REP.STR RESP,'&TERMS&' ,TERMS.DESC ;* Terms
GOSUB GET.STAT.DESC
UT.REP.STR RESP,'&STATUS&' ,STAT.DESC ;* Status Desc
IF STATUS = 'I' THEN
UT.REP.STR RESP,'&INV.DATE&',OCONV(LED(9)<1,GEN>, 'D4/')
UT.REP.STR RESP,'&DT.FRGHT.TITLE&','Order Date'
UT.REP.STR RESP,'&DT.FRGHT&' ,OCONV(LED(4)<1,GEN>, 'D4/')
END ELSE
UT.REP.STR RESP,'&INV.DATE&',OCONV(LED(4)<1,GEN>, 'D4/')
UT.REP.STR RESP,'&DT.FRGHT.TITLE&','Freight Allowed'
UT.REP.STR RESP,'&DT.FRGHT&',FRGHT.ALLW
END
UT.REP.STR RESP,'&REQ.DATE&' ,OCONV(LED(10)<1,GEN>,'D4/')
IF STATUS = 'B' THEN
*** Expiration Date for bids.
UT.REP.STR RESP,'&SHP.DT.TITLE&','Expr Date'
UT.REP.STR RESP,'&SHP.DATE&' ,OCONV(LED(31)<1,GEN>, 'D4/')
END ELSE
UT.REP.STR RESP,'&SHP.DT.TITLE&','Ship Date'
UT.REP.STR RESP,'&SHP.DATE&' ,OCONV(LED(9)<1,GEN>, 'D4/')
END
*** Check if the zip code has a defined delivery time, to check
*** for delivery time look at the Zip Code Maint screen, F1-Z.
*** If delivery time is defined, instead of displaying warehouse
*** info in the acknowledgement printout, display delivery time
DLV.TIME = ''
IF LED(75)<1,GEN> # '' THEN
READV DLVR.TM FROM ZIPFILE,LED(75)<1,GEN>,8 ELSE DLVR.TM = ''
IF DLVR.TM # '' THEN DLV.TIME = 1
END
IF DLV.TIME THEN
*** If delivery time is defined, instead of displaying warehouse
*** info in the acknowledgement printout, display delivery time
DLV.STATUS = 'Delivery Time'
DLV.TIME = OCONV(DLVR.TM,'MTH')
END ELSE
SHIP.BR = LED(2)<1,GEN,2>
DLV.STATUS = 'Warehouse'
IF XFER.FLAG THEN
DLV.TIME = 'From: ':SHIP.BR:' - To: ':LED(2)<1,GEN+1,2>
END ELSE
DLV.TIME = 'Shp: ':SHIP.BR:' - Prc: ':PRC.BR
END
END
UT.REP.STR RESP,'&DLV.STATUS&',DLV.STATUS
UT.REP.STR RESP,'&DLV.TIME&' ,DLV.TIME
RETURN
*-------------------------------------------------------------------------*
GET.STAT.DESC: *** Get Eclipse standard desc of status to display in email
OE.STATUS.CONV OID,GEN,LED(6)<1,GEN>,STAT.DESC
P.POS = INDEX(STAT.DESC,'Prt',1)
IF P.POS THEN
STAT.DESC = STAT.DESC[1,P.POS - 1]
END
RETURN
*-------------------------------------------------------------------------*
SET.LINES: *** Set up each line item on gen to display
INS.POS = 0
UT.REP.STR RESP,'&SHP.QTY.RESP&',SHP.QTY.RESP
UT.REP.STR RESP,'&SHP.QTY.HEADER&',SHP.QTY.HEADER
UT.REP.STR RESP,'&ORD.COLSPAN&',ORD.COLSPAN
START.VAR = '&PN.LOOP.BEG&'
END.VAR = '&PN.LOOP.END&'
WOE.GET.LOOP.RESP START.VAR,END.VAR,RESP,LOOP.RESP,INS.POS
SHP.BR = LED(2)<1,GEN,2>
IF LED(8)<1,GEN> = '' OR PRT.ALL.GENS THEN
*** Get the open and GEN LDIDs, we will combine them
OPN.LDIDS = RAISE(LED(49))
GEN.LDIDS = RAISE(RAISE(LED(48)<1,GEN>))
LDIDS = ''
*** Loop over the open LDIDs, adding each one to the list to
*** print if it is either on this GEN or if it is comment.
OPN.LDID.CT = DCOUNT(OPN.LDIDS,AM)
FOR LDN = 1 TO OPN.LDID.CT
LDID = OPN.LDIDS = YES
NEXT DL
END
LAST.SUBT.POS = LDN+1
END
NEXT LDN
*** Loop through each line item on gen to find description, qty,
*** price, and extended price to display in email
SHOW.TOTS = NO ;* Initializes/default to not show totals.
RUN.SUBTOT = 0.00
RUN.TOT = 0.00
LDID.CT = DCOUNT(LDIDS,AM)
FOR LDN = 1 TO LDID.CT
LDID = LDIDS
':LOT.PRC "R2#11":' '
PRC.HEADER = 'Net Price '
PSTYLE.COL.CT = 2
ALT.DESC = NO
SHOW.TOTS = YES
COL.SUB.TOT = LOT.PRC
END
* Need this hack here to fix a bug which caused this
* program to halt execution if the COL.SUB.TOT was null
* It was tracked to the ICONV (HHN202)
COL.SUB.TOT += 0
RUN.SUBTOT += ICONV(COL.SUB.TOT,'MR9')
RUN.TOT += ICONV(COL.SUB.TOT,'MR9')
IF PSTYLE.COL.CT < 2 THEN PSTYLE.COL.CT = 2
NOTES.COLSPAN = (PSTYLE.COL.CT - 2) + 3
IF NO.PRICING '
END
IF NOT(LOT.FLAG) THEN
*** Regular product description.
OE.DESC.GET DESC,ALT.DESC,'SOE Printing'
END ELSE
*** Lot billing product description.
DESC = LD(3)
END
CONVERT VM TO ' ' IN DESC
CONVERT '*' TO '
' IN DESC
* CONVERT SVM TO ' ' IN DESC
*** Check whether the product is flagged for Serial Number
*** Tracking at the Shipping Branch...
PRD.BR.GET.VAL SHP.BR,PN,25,SERIAL.TRACKING
IF SERIAL.TRACKING AND SERIAL.TRACKING # "N" THEN
SN.LIST = LD(32)<1,GEN>
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
*** Get the decription
BEGIN CASE
CASE LOT.FLAG
GOSUB GET.LOT.ITEM.DESC
CASE LD(31) AND LD(38)<1,2> = '1' AND CUS(74) # 'No'
*** This product is a kit and is set to print each comp.
DESC := '
'
KCMPS = LD(31)
KQTYS = LD(30)
KCMTS = LD(37)
GET.KIT.COMPS.LOC KCMPS,KQTYS,KCMTS,45,DESC,PRC.BR,GEN
DESC.CT = DCOUNT(DESC,VM)
FOR DESC.LN = 1 TO DESC.CT
DESC<1,DESC.LN> = TRIM(DESC<1,DESC.LN>,' ','B')
NEXT DESC.LN
UT.REP.STR DESC,VM,'
'
UT.REP.STR DESC,' ',' '
CASE OTHERWISE
UT.REP.STR DESC,VM,'
'
END CASE
UOM = LD(23)
IQ.TO.ALPHA PLNE(3),PRD(7),UOM,ORD.QTY,,,,,ORD.ALPHA
IQ.TO.ALPHA PLNE(3),PRD(7),UOM,SHP.QTY,,,,,SHP.ALPHA
DFLT.PER.GET 'S',SQTY,SUOM
*** Temp gen value, used to define the gen when printing
*** all gens in the first Print
PRT.GEN = GEN
*** If this is the First Print, gen the correct gen that
*** the LDID corresponds to in order to get the correct
*** BO.DATE and AVAIL.QTY
IF PRT.ALL.GENS THEN
FIND LDID IN LED(48) SETTING FMC,VMC THEN
PRT.GEN = VMC
END
END
*** Check for Available qty
OE.CHECK.AVAIL.NOW OID,PRT.GEN,LDID,AVAIL.QTY
*** Check to see when the back order qty will be available
*** and set BO.DATE
*** If BO.STATUS = 'X' then show **** for bo date
BO.DATE = ''
OE.CHECK.AVAIL OID,PRT.GEN,LDID,BO.DATE
BO.DATE = OCONV(BO.DATE,'D2/')
BO.STATUS = CUSS(43)
IF BO.STATUS = '' THEN BO.STATUS = CUS(43)
IF BO.STATUS = 'X' THEN BO.DATE = STR('*',8)
IF AVAIL.QTY > ORD.QTY THEN
AVAIL.QTY = ORD.QTY
BO.DATE = STR('*',8)
END
CMT = '' ;* Comment taken care of by OE.DESC.GET
END ELSE
*** PN is not a number, usually a comment.
OE.DESC.GET CMT,YES,'SOE Printing'
IF CMT = '' THEN CONTINUE
UT.REP.STR CMT,VM,'
'
DESC = ''
ORD.ALPHA = ''
SHP.ALPHA = ''
AVAIL.QTY = ''
BO.DATE = ''
PRC.RESP = ''
*** We need to get PSTYLE set if this is the first line
IF LDN = 1 THEN
TLDN = LDN
*** Loop until we find a line with a real product on it
*** We may not find one, in which case the PSTYLE is
*** unnecessary; this email only contains line comments
LOOP WHILE NOT(NUM(PN)) AND NOT(LOT.JOB) UNTIL LDN = LDID.CT
TLDN += 1
LDID = LDIDS
":LBL.DATA
'
*** Prepend a line break if this line isn't comment-only line
IF DESC THEN CMT = '
':CMT
*** Replace space with nonbreak spaces so that indents and
*** other funny formatting will be replicated correctly
UT.REP.STR CMT,' ',' '
* If this is a direct, then their is no BO possible. so
* don't show a bo.date
IF LED(33)<1,GEN> THEN BO.DATE = STR('*',8)
*** Fix empty entries so HTML is valid; no empty table cells
IF NOT(ORD.ALPHA) THEN ORD.ALPHA = ' '
IF NOT(SHP.ALPHA) THEN SHP.ALPHA = ' '
IF NOT(AVAIL.QTY) THEN AVAIL.QTY = ' '
IF NOT(BO.DATE) THEN BO.DATE = ' '
IF NOT(PRC.RESP) THEN
IF PN = 'S' THEN ;*** Check to see if this is a subtotal.
IF LD(43) = 'Top of Order' THEN
*** Show subtotal since first line item.
PRINT.SUBTOT = OCONV(RUN.TOT,'MR9') "R2#12"
END ELSE
*** Show subtotal since last subtotal.
PRINT.SUBTOT = OCONV(RUN.SUBTOT,'MR9') "R2#12"
END
PRC.RESP = '----------- '
RUN.SUBTOT = 0.00 ;* Reset the running subtotal.
END ELSE
PRC.RESP = '
':PRINT.SUBTOT:' '
END
END
** If showing qts over all gens don't show BO or avail
IF PRT.ALL.GENS THEN
AVAIL.QTY = ' '
BO.DATE = ' '
END
DESC = DESC<1,1,1>:' ':DESC<1,1,2>
NEW.RESP = LOOP.RESP
IF SHP.QTY = '' THEN SHP.QTY = ' '
UT.REP.STR NEW.RESP,'&ORD.QTY&' ,ORD.ALPHA ;* Order Qty/UOM
UT.REP.STR NEW.RESP,'&SHP.QTY&' ,SHP.ALPHA ;* Ship Qty/UOM
UT.REP.STR NEW.RESP,'&AVL&' ,AVAIL.QTY ;* Avail
UT.REP.STR NEW.RESP,'&BO.DATE&' ,BO.DATE ;* Back Order Date
UT.REP.STR NEW.RESP,'&DESC&' ,DESC ;* Product Desc
UT.REP.STR NEW.RESP,'&PRC.RESP&',PRC.RESP ;* Formt'd Extnded
UT.REP.STR NEW.RESP,'&CMT&' ,CMT ;* Line Item Cmnt
UT.REP.STR RESP,'&PRC.HEADER&' ,PRC.HEADER ;* Pricing header
RESP = INSERT(RESP,INS.POS;NEW.RESP)
INS.POS += DCOUNT(NEW.RESP,AM)
NEXT LDN
UT.REP.STR RESP,'&HDRCLR&',HDRCLR ;* header color.
RETURN
*-------------------------------------------------------------------------*
GET.TRACKING.INFO: *** Gets the response for shipment tracking.
TRK.MSG = ''
SVIA = '' ;* Shipvia (UPS,RPS,USPS...)
SVIAS.RTND = '' ;* Shipvia codes returned.
WEB.TRK.INFO = '' ;* Tracking info URL.
NOTE.TRK.INFO = '' ;* Tracking info if URL can't be used.
*** Get the order tracking information.
GET.SVIA.TRACKING OID,GEN,SVIA,SVIAS.RTND,WEB.TRK.INFO,NOTE.TRK.INFO
IF SVIAS.RTND THEN
TRK.MSG := 'Order #':OID:' has been shipped via ':SVIAS.RTND<1>:'.
'
END
TRK.CT = DCOUNT(SVIAS.RTND,VM)
IF TRK.CT <= 0 THEN RETURN
IF NOTE.TRK.INFO THEN
IF TRK.CT > 1 THEN
TRK.MSG := 'Your shipment tracking numbers are: '
END ELSE
TRK.MSG := 'Your shipment tracking number is: '
END
FOR X = 1 TO TRK.CT
TRK.MSG := '':NOTE.TRK.INFO<1,X>:'
'
NEXT X
END
IF WEB.TRK.INFO THEN
TRK.MSG := '
':'Click here to track your packages.
'
END
RETURN
*-------------------------------------------------------------------------*
GET.LOT.ITEM.DESC: *** Get the description for lot billing item.
*** Use LD.GEN instead of GEN because the lot description
*** depends on the order status, which must be taken from the
*** gen that the lot item is on (not the main gen if the Print
*** All Gens option is in effect)
LOT.DESC = ''
OBE.GET.HTML.LOT.DESC OID,LD.GEN,LDID,MODE,STATUS,PRT.ALL.GENS,LOT.DESC
DESC := LOT.DESC
RETURN
*-------------------------------------------------------------------------*
SET.TOTALS: *** Set up order totals to display in document
MATREAD AR FROM ARFILE,ORDNO ELSE MAT AR = ''
DISC.DT = AR(11)<1,1,1>
DUE.DT = AR(12)
** If first print flag is set, get totals for all gens
IF PRT.ALL.GENS THEN
SUB.TOL = OCONV(RUN.TOT,'MR7')
TOTAL = OCONV(RUN.TOT,'MR7')
FGHT = 0
HNDL = 0
TAX.TOL = 0
FET.AMT = 0
GEN.CT = DCOUNT(LED(1)<1>,VM)
FOR GX = 1 TO GEN.CT
*** Don't add if gen is invoiced, PO, or cancelled
IF LED(8)<1,GX>+0 # 0 OR LED(6)<1,GX> = 'Y' OR LED(6)<1,GX> = 'X' OR LED(6)<1,GX> = 'B' THEN CONTINUE
OE.ORDER.TOTAL OID,GX,QSIGN,TOTALX,SUB.TOLX,FGHTX,HNDLX,TAX.TOLX,FETX
* TOTAL += TOTALX
* SUB.TOL += SUB.TOLX
FGHT += FGHTX
HNDL += HNDLX
TAX.TOL += TAX.TOLX
FET.AMT += FETX
NEXT GX
END ELSE
OE.ORDER.TOTAL OID,GEN,QSIGN,,,FGHT,HNDL,TAX.TOL,FET.AMT
SUB.TOL = OCONV(RUN.TOT,'MR7')
TOTAL = OCONV(RUN.TOT,'MR7')
END
* Any freight or handling an FET amount, show it in the totals.
TOTAL += FGHT + HNDL + TAX.TOL + FET.AMT
IF PRT.ALL.GENS THEN
AMT.PAID = 0
DISC = 0
FOR GX = 1 TO GEN.CT
GSTAT = LED(6)<1,GX>
IF GSTAT # 'X' AND GSTAT # 'Y' AND GSTAT # 'B' THEN
SOE.CALC.CASH OID,GX,,AMT.PAIDX,DISCX
AMT.PAID += AMT.PAIDX
DISC += DISCX
END
NEXT GX
END ELSE
SOE.CALC.CASH OID,GEN,,AMT.PAID,DISC
END
*** If there is a negative total then show credit title desc.
ORIG.DISC.TAKEN = 0
IF STATUS = 'I' AND TOTAL < 0 THEN
TYPE.DESC = 'Credit Memo'
EMAIL.GET.ORIG.DISC OID,GEN,ORIG.DISC.TAKEN
IF ORIG.DISC.TAKEN AND NOT(AMT.PAID)THEN
SOE.CALC.DISC OID,GEN,RETURN.DISC
TOTAL += RETURN.DISC
SUB.TOL += RETURN.DISC
*** Show discount taken.
DISC.AMT = OCONV(RETURN.DISC,"MR2")
PRC.RESP = ''
PRC.RESP := DISC.AMT
PRC.RESP := ' '
TOTAL.COMMENT = 'Original Discount Taken'
NEW.RESP = LOOP.RESP
UT.REP.STR NEW.RESP,'&ORD.QTY&' ,' '
UT.REP.STR NEW.RESP,'&SHP.QTY&' ,' '
UT.REP.STR NEW.RESP,'&AVL&' ,' '
UT.REP.STR NEW.RESP,'&BO.DATE&' ,' '
UT.REP.STR NEW.RESP,'&DESC&' ,TOTAL.COMMENT
UT.REP.STR NEW.RESP,'&CMT&' ,' '
UT.REP.STR NEW.RESP,'&PRC.RESP&',PRC.RESP
RESP = INSERT(RESP,INS.POS;NEW.RESP)
INS.POS += DCOUNT(NEW.RESP,AM)
END
END
*** If any amount of our Order was paid
IF AMT.PAID THEN
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 = AMT.PAID
TOTAL += TOTAL.AMT
SUB.TOL += TOTAL.AMT
DISC.TAKEN = 0
PRC.RESP = ''
PRC.RESP := OCONV(TOTAL.AMT,'MR2')
PRC.RESP := ' '
NEW.RESP = LOOP.RESP
UT.REP.STR NEW.RESP,'&ORD.QTY&' ,' '
UT.REP.STR NEW.RESP,'&SHP.QTY&' ,' '
UT.REP.STR NEW.RESP,'&AVL&' ,' '
UT.REP.STR NEW.RESP,'&BO.DATE&' ,' '
UT.REP.STR NEW.RESP,'&DESC&' ,TOTAL.COMMENT
UT.REP.STR NEW.RESP,'&CMT&' ,' '
UT.REP.STR NEW.RESP,'&PRC.RESP&',PRC.RESP
RESP = INSERT(RESP,INS.POS;NEW.RESP)
INS.POS += DCOUNT(NEW.RESP,AM)
END ELSE
SOE.PAYMENTS.DISC AR.ID,PAY.IDS,PAY.DTS,PAY.AMTS,DISC.TAKEN
IF STATUS = 'I' AND TOTAL < 0 AND NOT(ORIG.DISC.TAKEN) THEN
DISC.TAKEN = 0
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 # ':PAY.ID
END ELSE
TOTAL.COMMENT = 'Prior Deposit on '
TOTAL.COMMENT := OCONV(PAY.DT,'D2/')"L#8"
END
IF US.FUNDS THEN
PAY.AMT = ICONV(PAY.AMT/OCONV(US.FUNDS,'MR4'),"MR0")
END
IF PAY.AMT THEN
TOTAL += PAY.AMT
SUB.TOL += PAY.AMT
END
*** Convert our Payment Amount before we add it to the
*** document
PAY.AMT = OCONV(PAY.AMT,"MR2")
PRC.RESP = ''
PRC.RESP := PAY.AMT
PRC.RESP := ' '
NEW.RESP = LOOP.RESP
UT.REP.STR NEW.RESP,'&ORD.QTY&' ,' '
UT.REP.STR NEW.RESP,'&SHP.QTY&' ,' '
UT.REP.STR NEW.RESP,'&AVL&' ,' '
UT.REP.STR NEW.RESP,'&BO.DATE&' ,' '
UT.REP.STR NEW.RESP,'&DESC&' ,TOTAL.COMMENT
UT.REP.STR NEW.RESP,'&CMT&' ,' '
UT.REP.STR NEW.RESP,'&PRC.RESP&',PRC.RESP
RESP = INSERT(RESP,INS.POS;NEW.RESP)
INS.POS += DCOUNT(NEW.RESP,AM)
NEXT PYN
END
*** If there was actually a discount already taken
IF DISC.TAKEN # 0 THEN
TOTAL.COMMENT = 'Discount Taken'
IF US.FUNDS THEN
DISC.TAKEN=ICONV(DISC.TAKEN/OCONV(US.FUNDS,'MR4'),"MR0")
END
TOTAL += DISC.TAKEN ;* Take discount from total.
SUB.TOL += DISC.TAKEN ;* Take discount from subtotal.
DISC -= DISC.TAKEN ;* Take discount from avail discount.
*** Convert our Discount Taken Amount before we add it to
*** the document
DISC.TAKEN = OCONV(DISC.TAKEN,"MR2")
PRC.RESP = ''
PRC.RESP := DISC.TAKEN
PRC.RESP := ' '
NEW.RESP = LOOP.RESP
UT.REP.STR NEW.RESP,'&ORD.QTY&' ,' '
UT.REP.STR NEW.RESP,'&SHP.QTY&' ,' '
UT.REP.STR NEW.RESP,'&AVL&' ,' '
UT.REP.STR NEW.RESP,'&BO.DATE&' ,' '
UT.REP.STR NEW.RESP,'&DESC&' ,TOTAL.COMMENT
UT.REP.STR NEW.RESP,'&CMT&' ,' '
UT.REP.STR NEW.RESP,'&PRC.RESP&',PRC.RESP
RESP = INSERT(RESP,INS.POS;NEW.RESP)
INS.POS += DCOUNT(NEW.RESP,AM)
END
END
*** Get any Remote Order Entry discount.
SOE.CALC.DISC OID,GEN,,,WOE.DISC
TOTAL += WOE.DISC
SUB.TOL += WOE.DISC
IF BASEC = "CAN$" THEN
OE.TAX.CALC.AMTS OID,GEN,QSIGN,,,,,,GST.AMT,PST.AMT
GST.AMT = OCONV(GST.AMT,'MR2')
PST.AMT = OCONV(PST.AMT,'MR2')
END
IF SHIPVIA = 'BIDTAX'
THEN TAX.TOL = TAX.TOL
** Don't display tax on bids
IF STATUS = 'B' AND SHIPVIA = 'BIDTAX' THEN
IF BASEC = "CAN$" THEN
TOTAL -= OCONV((GST.AMT*100),"MR2")
TOTAL -= (PST.AMT*100)
TOTAL -= FET.AMT
GST.AMT = '*****'
PST.AMT = '*****'
END ELSE
TOTAL -= TAX.TOL
TOTAL -= FET.AMT
TAX.TOL = '*****'
END
FET.AMT = 0 ;* Set to 0 so it doesn't show up.
END
*** Format all totals to be printed.
O.FET.AMT = ''
IF SHOW.TOTS THEN
O.SUB.TOL = OCONV(SUB.TOL ,'MR2')
IF BASEC = "CAN$" THEN
GST.TAX.TOL = OCONV(GST.AMT*100,'MR2')
PST.TAX.TOL = OCONV(PST.AMT*100,'MR2')
END ELSE
O.TAX.TOL = OCONV(TAX.TOL ,'MR2')
END
O.FGHT = OCONV(FGHT ,'MR2,')
O.HNDL = OCONV(HNDL ,'MR2,')
O.DISC = OCONV(DISC ,'MR2,')
O.WOE.DISC = OCONV(WOE.DISC,'MR2,')
IF FET.AMT # 0 THEN
O.FET.AMT = OCONV(FET.AMT ,'MR2')
END
O.TOTAL = OCONV(TOTAL ,'MR2')
END ELSE
O.SUB.TOL = '*****'
IF BASEC = "CAN$" THEN
GST.TAX.TOL = '*****'
PST.TAX.TOL = '*****'
END ELSE
O.TAX.TOL = '*****'
END
O.FGHT = '*****'
O.HNDL = '*****'
O.DISC = '*****'
O.WOE.DISC = '*****'
O.TOTAL = '*****'
IF O.FET.AMT THEN
O.FET.AMT = '*****'
END
END
IF O.FET.AMT AND STATUS # 'B' THEN
*** If there is FET tax, show it in the totals.
TAX.DESC := ' '
END
*** Set up the message for discounts other than WOE that can be
*** taken if paid by DISC.DT.
IF STATUS = 'I' AND NOT(O.TOTAL < 0) THEN
IF DISC < 0 THEN
*** If a discount is available print it.
DISC = DISC * -1
DISC = OCONV(DISC,'MR2')
IF US.FUNDS THEN
DISC = DISC/OCONV(US.FUNDS,'MR4') "MR2"
END
PRT.DATE = OCONV(DISC.DT,'D2/')
DISC.MSG ='F.E.T. '
TAX.DESC := '':O.FET.AMT:'
If paid by ':PRT.DATE:' you may deduct $':DISC
DISC.MSG := '
Invoice is due by ':OCONV(DUE.DT,"D2/")
DISC.MSG := ' net of any cash discount.
'
END ELSE
DISC.MSG = '
Invoice is due by ':OCONV(DUE.DT,"D2/"):'.
'
END
END ELSE
DISC.MSG = ''
END
UT.REP.STR RESP,'&SUBTOL&' ,O.SUB.TOL ;* Subtotal
UT.REP.STR RESP,'&TAX.DESC&' ,TAX.DESC
IF BASEC = "CAN$" THEN
UT.REP.STR RESP,'&GST.TAX&' ,GST.TAX.TOL ;* Gst Tax
UT.REP.STR RESP,'&PST.TAX&' ,PST.TAX.TOL ;* Pst Tax
END ELSE
UT.REP.STR RESP,'&TAX&' ,O.TAX.TOL ;* Tax
END
UT.REP.STR RESP,'&FGHT&' ,O.FGHT ;* Freight
UT.REP.STR RESP,'&HNDL&' ,O.HNDL ;* Handling
UT.REP.STR RESP,'&WOE.DISC&' ,O.WOE.DISC ;* WOE Discounts
UT.REP.STR RESP,'&TOTAL&' ,O.TOTAL ;* Total Amount
UT.REP.STR RESP,'&DISC.MSG&' ,DISC.MSG ;* Discount Message
UT.REP.STR RESP,'&TYPE.DESC&',TYPE.DESC ;* Doc type Desc
*** Colspan for the box to the left of totals.
UT.REP.STR RESP,'&NOTES.COLSPAN&',NOTES.COLSPAN
OE.LOG.PRINT OID,GEN,DOC.TP:VM:1,TYPE.DESC:' E-mail',REPRINT
*** Convert all AM to line feeds in resp
CONVERT AM TO CHAR(10) IN RESP
RETURN
!TSMITH~07/23/13~14:01