590 lines
18 KiB
Plaintext
590 lines
18 KiB
Plaintext
COMPILE Subroutine PrintQuote( QuoteNos,Confirmation )
|
|
|
|
DECLARE SUBROUTINE Set_Status
|
|
DECLARE FUNCTION Security_Check, Set_Printer, Get_Printer, Msg, entid, obj_Prod_Spec
|
|
DECLARE FUNCTION obj_Install, Printer_Select
|
|
|
|
|
|
$INSERT OIPRINT_EQUATES
|
|
$INSERT MSG_EQUATES
|
|
$INSERT APPCOLORS
|
|
$INSERT COMPANY_EQU
|
|
$INSERT NAMES_EQU
|
|
$INSERT QUOTE_EQU
|
|
$INSERT PROD_SPEC_EQU
|
|
$INSERT QUOTE_SPEC_EQU
|
|
$INSERT LSL_USERS_EQU
|
|
$INSERT PRS_LAYER_EQU
|
|
|
|
EQU F_NAME$ TO 1
|
|
EQU F_POINTSIZE$ TO 2
|
|
EQU F_JUST$ TO 3
|
|
EQU F_BOLD$ TO 4
|
|
|
|
|
|
EQU TAB$ TO CHAR(9)
|
|
|
|
IF NOT(ASSIGNED(QuoteNos)) THEN RETURN
|
|
IF QuoteNos = '' THEN RETURN
|
|
|
|
IF NOT(ASSIGNED(Confirmation)) THEN Confirmation = ''
|
|
|
|
ErrorTitle = 'Error in Stored Procdure PrintQuote'
|
|
|
|
OPEN 'QUOTE' TO QuoteTable ELSE
|
|
ErrorMsg = 'Unable to open Quote Table.'
|
|
Set_Status(1,ErrorTitle:@SVM:ErrorMsg)
|
|
RETURN
|
|
END
|
|
|
|
OPEN 'DICT.QUOTE' TO @DICT ELSE
|
|
ErrorMsg = 'Unable to open Dict.Quote Table.'
|
|
Set_Status(1,ErrorTitle:@SVM:ErrorMsg)
|
|
RETURN
|
|
END
|
|
|
|
|
|
|
|
*LTRB - Margin sequence
|
|
|
|
* New Style PDF printing (OI7.1) added 1/29/04 John C. Henry, J.C. Henry & Co.
|
|
|
|
*FileNameParms = 'Printing Quote':@FM: '' :@FM: 6 :@FM: ''
|
|
PrintSetup = ''
|
|
PrintSetup<1,1> = '2' ;* Preview Normal
|
|
PrintSetup<1,2> = '5' ;* Display all buttons except Printer Setup
|
|
PrintSetup<1,3> = '0' ;* Display Printing Window
|
|
PrintSetup<1,6> = '7' ;* Preview window - keyboard and mouse support
|
|
|
|
stat = Set_Printer( 'INIT', FileNameParms, 'Quote', .5:@FM:1.2:@FM:.5:@FM:.3, 0:@fm:1 , PrintSetup)
|
|
|
|
|
|
QuoteCnt = COUNT(QuoteNos,@VM) + (QuoteNos NE '')
|
|
|
|
FOR I = 1 TO QuoteCnt
|
|
|
|
QuoteNo = QuoteNos<I>
|
|
READ QuoteRec FROM QuoteTable,QuoteNo ELSE
|
|
ErrorMsg = 'Unable to read Quote Record ':QUOTE(QuoteNo)
|
|
Set_Status(1,ErrorTitle:@SVM:ErrorMsg)
|
|
RETURN
|
|
END
|
|
|
|
Font = 'Arial'
|
|
Font<F_POINTSIZE$> = 10
|
|
Font<F_BOLD$> = 1
|
|
Stat = Set_Printer( 'FONTHEADFOOT', Font )
|
|
|
|
Header = @FM:@FM:@FM:@VM:@VM:'Quote No: ':QuoteNo
|
|
|
|
stat = Set_Printer('HEADER',Header)
|
|
|
|
Footer = "Printed: 'D' 'T'":@VM:@VM:"Page 'P'"
|
|
stat = Set_Printer('FOOTER',Footer)
|
|
|
|
TitleFont = 'Arial'
|
|
TitleFont<F_POINTSIZE$> = 17
|
|
TitleFont<F_BOLD$> = 1
|
|
|
|
IF Confirmation THEN
|
|
stat = Set_Printer('TEXTXY','Confirmation of Order',2.5:@FM:-0.9,TitleFont,1)
|
|
END ELSE
|
|
stat = Set_Printer('TEXTXY','Quotation',3.2:@FM:-0.9,TitleFont,1)
|
|
END
|
|
|
|
* Seller Information
|
|
|
|
SellerText = ''
|
|
|
|
SellerCompany = obj_Install('Get_Prop','Company')
|
|
SellerDivision = obj_Install('Get_Prop','Division')
|
|
SellerAddress = obj_Install('Get_Prop','Address')
|
|
SellerCSZ = obj_Install('Get_Prop','CSZ')
|
|
SellerPhone = obj_Install('Get_Prop','Phone')
|
|
SellerFAX = obj_Install('Get_Prop','FAX')
|
|
SellerEMail = obj_Install('Get_Prop','EMail')
|
|
|
|
* Account Rep to customer
|
|
|
|
AcctRepUserID = XLATE( 'QUOTE', QuoteNo, 'ACCT_REP', 'X' )
|
|
AcctRepRec = XLATE( 'LSL_USERS', AcctRepUserID, '', 'X' )
|
|
|
|
AcctRepDID = OCONV( AcctRepRec<LSL_USERS_DID$>, '[PHONE_FORMAT]' )
|
|
AcctRepEmail = AcctRepRec<LSL_USERS_EMAIL$>
|
|
AcctRepFax = OCONV( AcctRepRec<LSL_USERS_FAX$>, '[PHONE_FORMAT]' )
|
|
AcctRepName = OCONV( AcctRepUserID , '[XLATE_CONV,LSL_USERS*FIRST_LAST]' )
|
|
|
|
SWAP @VM WITH CRLF$ IN SellerAddress
|
|
|
|
IF SellerCompany NE '' THEN SellerText := SellerCompany:CRLF$
|
|
IF SellerDivision NE '' THEN SellerText := SellerDivision:CRLF$
|
|
IF SellerAddress NE '' THEN SellerText := SellerAddress:CRLF$
|
|
IF SellerCSZ NE '' THEN SellerText := SellerCSZ:CRLF$
|
|
IF SellerPhone NE '' THEN SellerText := 'Phone:':TAB$:SellerPhone:CRLF$
|
|
IF SellerFAX NE '' THEN SellerText := 'FAX:':TAB$:SellerFAX:CRLF$
|
|
IF SellerEMail NE '' THEN SellerText := 'EMail:':TAB$:SellerEMail:CRLF$
|
|
|
|
IF AcctRepName NE '' THEN SellerText := 'Acct Rep:':TAB$:AcctRepName:CRLF$
|
|
IF AcctRepEmail NE '' THEN SellerText := 'EMail:':TAB$:TAB$:AcctRepEmail:CRLF$
|
|
IF AcctRepDID NE '' THEN SellerText := 'Phone:':TAB$:TAB$:AcctRepDID:CRLF$
|
|
IF AcctRepFax NE '' THEN SellerText := 'FAX:':TAB$:TAB$:AcctRepFax:CRLF$
|
|
|
|
SellerText[-2,2] = ''
|
|
|
|
* Customer (Buyer) Company information
|
|
|
|
CustCompNo = QuoteRec<QUOTE_CUST_NO$>
|
|
CustRec = XLATE( 'COMPANY', CustCompNo, '', 'X' )
|
|
|
|
CustCompName = OCONV( CustCompNo, '[XLATE_CONV,COMPANY*CO_NAME]' )
|
|
|
|
CustAddress = CustRec<COMPANY_ADDRESS$>
|
|
|
|
LOOP
|
|
UNTIL CustAddress[-1,1] NE @VM OR CustAddress = '' ;* Trim Sloppy Coding left over @VM's
|
|
CustAddress[-1,1] = ''
|
|
REPEAT
|
|
|
|
SWAP @VM WITH CRLF$ IN CustAddress
|
|
|
|
CustCSZ = XLATE( 'COMPANY', CustCompNo, 'CSZ', 'X' )
|
|
|
|
FaxNumber = OCONV( QuoteRec<QUOTE_FAX$>, '[PHONE_FORMAT]' )
|
|
IF FaxNumber = '' THEN
|
|
FaxNumber = QuoteRec<QUOTE_IFAX$>
|
|
END
|
|
|
|
* Customer Contact Information
|
|
|
|
NameNo = QuoteRec<quote_name_no$>
|
|
Contact = XLATE( 'NAMES', NameNo, 'FIRST_LAST', 'X' )
|
|
NameRec = XLATE( 'NAMES', NameNo, '', 'X' )
|
|
PTypes = NameRec<names_phone_types$>
|
|
IPTypes = NameRec<names_intl_phone_types$>
|
|
Phones = NameRec<names_phone$>
|
|
IPhones = NameRec<names_intl_phone$>
|
|
ContactEmail = NameRec<names_email$>
|
|
convert @lower_case TO @upper_case in PTypes
|
|
convert @lower_case TO @upper_case in IPTypes
|
|
PhoneToUse = ''
|
|
|
|
LOCATE 'OFFICE' in PTypes using @VM setting TPos THEN
|
|
PhoneToUse = OCONV( Phones<1,TPos>, '[PHONE_FORMAT]' )
|
|
END ELSE
|
|
Pcnt = COUNT( Phones, @VM ) + (Phones NE '') ;* Basically delete all FAX numbers and THEN use the TOp one
|
|
FOR Pp = Pcnt TO 1 step -1
|
|
IF PTypes<1,Pp> = 'FAX' THEN
|
|
Phones = delete( Phones, 1, Pp, 0 )
|
|
END
|
|
NEXT Pp
|
|
PhoneToUse = OCONV( Phones<1,1>, '[PHONE_FORMAT]' ) ;* SIMPLY TAKE THE FIRST ONE
|
|
END
|
|
IF PhoneToUse = '' THEN
|
|
LOCATE 'OFFICE' in IPhones using @VM setting TPos THEN
|
|
PhoneToUse = IPhones<1,TPos>
|
|
END ELSE
|
|
* Basically delete all fax numbers and THEN use the TOp one
|
|
Pcnt = COUNT( IPhones, @VM ) + (IPhones NE '')
|
|
FOR Pp = Pcnt TO 1 step -1
|
|
IF IPTypes<1,Pp> = 'FAX' THEN
|
|
IPhones = delete( IPhones, 1, Pp, 0 )
|
|
END
|
|
NEXT Pp
|
|
PhoneToUse = IPhones<1,1>
|
|
END
|
|
END
|
|
|
|
FOBPoint = QuoteRec<QUOTE_OTHER_FOB_POINT$>
|
|
IF FOBPoint = '' THEN
|
|
FOBPoint = 'Mesa, Arizona U.S.A.'
|
|
END
|
|
|
|
BuyerText = ''
|
|
|
|
IF CustCompName NE '' THEN BuyerText := CustCompName:CRLF$
|
|
IF Contact NE '' THEN BuyerText := Contact:CRLF$
|
|
IF CustAddress NE '' THEN BuyerText := CustAddress:CRLF$
|
|
IF CustCSZ NE '' THEN BuyerText := CustCSZ:CRLF$
|
|
IF PhoneToUse NE '' THEN BuyerText := 'Phone:':TAB$:PhoneToUse:CRLF$
|
|
IF FaxNumber NE '' THEN BuyerText := 'FAX:':TAB$:FaxNumber:CRLF$
|
|
IF ContactEmail NE '' THEN BuyerText := 'EMail:':TAB$:ContactEmail:CRLF$
|
|
IF FOBPoint NE '' THEN BuyerText := 'FOB:':TAB$:FOBPoint:CRLF$
|
|
|
|
BuyerText[-2,2] = ''
|
|
|
|
* Print the Company Logo and Information
|
|
|
|
location = 0.06:@FM:-1.0:@FM:1.57:@FM:1
|
|
BitMapPath = obj_Install('Get_Prop','ColorBMP')
|
|
|
|
stat = Set_Printer('BMP',BitMapPath,location, 0,1)
|
|
|
|
Font<F_NAME$> = 'Arial'
|
|
Font<F_POINTSIZE$> = 10
|
|
Font<F_BOLD$> = 1
|
|
|
|
colHeader = 'Seller' ; colFormat = '<5400' ; colData = SellerText
|
|
colHeader<1,2> = 'Buyer' ; colFormat<1,2> = '<5400' ; colData<1,2> = BuyerText
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'',LTGREY$,'',0,6)
|
|
|
|
Font<F_POINTSIZE$> = 10
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,LTGREY$,'',1,6)
|
|
|
|
stat = Set_Printer('TEXT') ;* Blank line
|
|
|
|
* * * General Information Section * * *
|
|
|
|
Font<F_POINTSIZE$> = 10
|
|
Font<F_BOLD$> = 1
|
|
|
|
colHeader = 'Customer No' ; colFormat = '^3600'
|
|
colHeader<1,2> = 'Cust RFQ' ; colFormat<1,2> = '^3600'
|
|
colHeader<1,3> = 'Payment Terms' ; colFormat<1,3> = '<3600'
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'',LTGREY$,'',0,6)
|
|
|
|
colData = CustCompNo
|
|
colData<1,2> = QuoteRec<QUOTE_REQ_QUOTE_NUM$>
|
|
colData<1,3> = QuoteRec<QUOTE_TERMS$>
|
|
|
|
Font<F_POINTSIZE$> = 10
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,LTGREY$,'',1,6)
|
|
|
|
* Now loop through Detail Item
|
|
|
|
QuoteDetKeys = QuoteRec<QUOTE_QUOTE_DET_KEY$>
|
|
SectionHeight = 0 ;* Gets set further down
|
|
|
|
|
|
ItemDesc = QuoteRec<QUOTE_PROC_DESC$>
|
|
|
|
stat = Set_Printer('TEXT') ; * Blank Line
|
|
|
|
Font<F_BOLD$> = 1
|
|
|
|
colHeader = 'Item Description' ; colFormat = '<10800' ; colData = ItemDesc
|
|
|
|
GOSUB CheckPageBreak
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'',LTGREY$,'',0,TB_COLUMNS_TOP_BOTTOM)
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_COLUMNS_TOP_BOTTOM)
|
|
|
|
* Do each PSN first
|
|
|
|
ProcSteps = QuoteRec<QUOTE_PROC_STEP$>
|
|
ProcPSNs = QuoteRec<QUOTE_PROC_STEP_PSN$>
|
|
ProcStepDescs = QuoteRec<QUOTE_PROC_STEP_DESC$>
|
|
|
|
FOR M = 1 TO COUNT(ProcSteps,@VM) + (ProcSteps NE '')
|
|
|
|
ProcPSN = ProcPSNs<1,M>
|
|
|
|
PSNRec = XLATE('PROD_SPEC',ProcPSN,'',"X")
|
|
CustSpec = PSNRec<PROD_SPEC_SPEC_NUM$>
|
|
SWAP @VM WITH ', ' IN CustSpec
|
|
CustPartNo = PSNRec<PROD_SPEC_CUST_PART_NO$>
|
|
SWAP @VM WITH ', ' IN CustPartNo
|
|
|
|
SpecSub = PSNRec<PROD_SPEC_SPEC_SUBSTRATE$> ;* Extract Substrate Information
|
|
SubOrient = SpecSub<1,QSSubOrientation$>
|
|
SubDiam = SpecSub<1,QSSubWafersize$>
|
|
SubDopant = SpecSub<1,QSSubDopant$>
|
|
SubRest = SpecSub<1,QSSubResistivity$>
|
|
SubBL1 = SpecSub<1,QSSubBl1Dopant$>
|
|
SubBl2 = SpecSub<1,QSSubBl2Dopant$>
|
|
SubBl3 = SpecSub<1,QSSubBl3Dopant$>
|
|
SubPolish = SpecSub<1,QSSubPolish$>
|
|
SubResUnits = SpecSub<1,QSSubResUnits$>
|
|
IF SubBL1 = '' THEN SubBL1 = 'None'
|
|
IF SubBL2 = '' THEN SubBL2 = 'None'
|
|
IF SubBL3 = '' THEN SubBL3 = 'None'
|
|
|
|
* Epi Specifications
|
|
|
|
EpiSpecs = obj_Prod_Spec('GetLayerProp',ProcPSN) ;* @RM'd by layer -> Layer:@FM:Specs
|
|
|
|
SpecData = ''
|
|
FOR R = 1 TO COUNT(EpiSpecs,@RM) + (EpiSpecs NE '')
|
|
EpiSpec = FIELD(EpiSpecs,@RM,R)
|
|
SpecData<R,1> = EpiSpec<1>
|
|
EpiSpec = DELETE(EpiSpec,1,0,0) ;* Remove layer which is stuck on the front of the line
|
|
|
|
SpecData<R,2> = EpiSpec<PRS_LAYER_THICK_MIN$>:'-':EpiSpec<PRS_LAYER_THICK_MAX$>:EpiSpec<PRS_LAYER_THICK_UNITS$>
|
|
SpecData<R,3> = EpiSpec<PRS_LAYER_THICK_MEASUREMENT$,1>
|
|
ResTarget = EpiSpec<PRS_LAYER_RES_MIN$> :'-':EpiSpec<PRS_LAYER_RES_MAX$>:EpiSpec<PRS_LAYER_RES_UNITS$>
|
|
ResMeasure = EpiSpec<PRS_LAYER_RES_MEASUREMENT$,1>
|
|
ConcTarget = EpiSpec<PRS_LAYER_CONC_MIN$> :'-':EpiSpec<PRS_LAYER_CONC_MAX$>:EpiSpec<PRS_LAYER_CONC_UNITS$>
|
|
ConcMeasure = EpiSpec<PRS_LAYER_CONC_MEASUREMENT$,1>
|
|
|
|
Dopant = EpiSpec<PRS_LAYER_DOPANT$>
|
|
|
|
IF ResTarget NE '-' THEN
|
|
SpecData<R,4> = ResTarget
|
|
END ELSE
|
|
SpecData<R,4> = ConcTarget
|
|
END
|
|
|
|
IF ResMeasure NE '' THEN
|
|
SpecData<R,5> = ResMeasure
|
|
END ELSE
|
|
SpecData<R,5> = ConcMeasure
|
|
END
|
|
|
|
IF INDEX( Dopant, 'Boron', 1 ) AND NOT(INDEX( Dopant, 'Germanium', 1 )) THEN Dopant = 'Boron' ;* Remove the 1% at the front of Boron
|
|
IF INDEX( Dopant, 'Arsenic', 1 ) THEN Dopant = 'Arsenic'
|
|
|
|
SpecData<R,6> = Dopant
|
|
|
|
NEXT R
|
|
|
|
stat = Set_Printer('TEXT')
|
|
|
|
Font<F_POINTSIZE$> = 8
|
|
|
|
IF M = 1 THEN
|
|
|
|
* Substrate Info Print only on the first layer
|
|
|
|
SectionTitle = 'S u b s t r a t e' ; SectFormat = '^10800'
|
|
|
|
stat = Set_Printer('CALCTABLE',colFormat:@FM:colData)
|
|
TableSize = Get_Printer('CALCTABLE')
|
|
SectionHeight = TableSize<2>
|
|
|
|
colHeader = 'Substrate' ; colFormat = '^1440' ; colData = SubDiam
|
|
colHeader<1,2> = 'Orientation' ; colFormat<1,2> = '^1440' ; colData<1,2> = SubOrient
|
|
colHeader<1,3> = 'Dopant' ; colFormat<1,3> = '^1540' ; colData<1,3> = SubDopant
|
|
colHeader<1,4> = 'Resistivity' ; colFormat<1,4> = '^2060' ; colData<1,4> = SubRest:' ':SubResUnits
|
|
colHeader<1,5> = 'BL 1' ; colFormat<1,5> = '^1440' ; colData<1,5> = SubBL1
|
|
colHeader<1,6> = 'BL 2' ; colFormat<1,6> = '^1440' ; colData<1,6> = SubBL2
|
|
colHeader<1,7> = 'BL 3' ; colFormat<1,7> = '^1440' ; colData<1,7> = SubBL3
|
|
|
|
GOSUB CheckPageBreak
|
|
|
|
Font<F_BOLD$> = 1
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',SectFormat,SectionTitle,'',LTGREY$,'',0,TB_ALL)
|
|
Font<F_BOLD$> = 0
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'','','',0,TB_ALL)
|
|
|
|
Font<F_NAME$> = 'MS LineDraw'; Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_ALL)
|
|
|
|
Font<F_NAME$> = 'Arial'
|
|
|
|
END ;* Endo of check for first layer
|
|
|
|
stat = Set_Printer('TEXT')
|
|
|
|
* Step Information
|
|
|
|
SectionTitle = 'P r o c e s s i n g - S t e p ':M ; SectFormat = '^10800'
|
|
|
|
colHeader = 'Step' ; colFormat = '^720' ; colData = ProcSteps<1,M>
|
|
colHeader<1,2> = 'PSN' ; colFormat<1,2> = '^1440' ; colData<1,2> = ProcPSN
|
|
colHeader<1,3> = 'Step Description' ; colFormat<1,3> = '<2640' ; colData<1,3> = ProcStepDescs<1,M>
|
|
colHeader<1,4> = 'Customer Specification' ; colFormat<1,4> = '<2640' ; colData<1,4> = CustSpec
|
|
colHeader<1,5> = 'Customer Part Number' ; colFormat<1,5> = '<3360' ; colData<1,5> = CustPartNo
|
|
|
|
GOSUB CheckPageBreak
|
|
|
|
Font<F_BOLD$> = 1
|
|
stat = Set_Printer('FONT',Font)
|
|
IF M = 1 THEN
|
|
stat = Set_Printer('ADDTABLE',SectFormat,SectionTitle,'',LTGREY$,'',0,TB_ALL) ;* Background only on first one
|
|
END ELSE
|
|
stat = Set_Printer('ADDTABLE',SectFormat,SectionTitle,'','','',0,TB_ALL)
|
|
END
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'','','',0,TB_ALL)
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_ALL)
|
|
|
|
stat = Set_Printer('TEXT')
|
|
|
|
|
|
* Step Specification Information
|
|
|
|
colHeader = 'PSN Layer' ; colFormat = '^1020'
|
|
colHeader<1,2> = 'Thickness' ; colFormat<1,2> = '^2060'
|
|
colHeader<1,3> = 'Measured By' ; colFormat<1,3> = '<1440'
|
|
colHeader<1,4> = 'Resistivity' ; colFormat<1,4> = '<2060'
|
|
colHeader<1,5> = 'Measured By' ; colFormat<1,5> = '<1440'
|
|
colHeader<1,6> = 'Dopant' ; colFormat<1,6> = '<2060'
|
|
|
|
SectionTitle = 'E p i S p e c i f i c a t i o n' ; SectFormat = '^10080'
|
|
|
|
colData = SpecData
|
|
|
|
GOSUB CheckPageBreak
|
|
|
|
Font<F_BOLD$> = 1
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',SectFormat,SectionTitle,'','','',0,TB_ALL:@FM:0.5)
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'','','',0,TB_ALL:@FM:0.5)
|
|
|
|
Font<F_NAME$> = 'MS LineDraw'; Font<F_BOLD$> = 0
|
|
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_ALL:@FM:0.5)
|
|
|
|
Font<F_NAME$> = 'Arial'
|
|
|
|
NEXT M
|
|
|
|
CostData = ''
|
|
ChargeDescs = QuoteRec<QUOTE_DETAIL$>
|
|
FOR R = 1 TO COUNT(ChargeDescs,@VM) + (ChargeDescs NE '')
|
|
CostData<R,1> = R
|
|
CostData<R,2> = ChargeDescs<1,R>
|
|
CostData<R,3> = OCONV(QuoteRec<QUOTE_PRICE$,R>,'MD2,')
|
|
CostData<R,4> = OCONV(QuoteRec<QUOTE_QUANTITY$,R>,'MD0,')
|
|
|
|
ExtendedAmount = QuoteRec<QUOTE_SETUP_CHARGE$,R> + QuoteRec<QUOTE_SRP_CHARGE$,R>
|
|
ExtendedAmount += (QuoteRec<QUOTE_PRICE$,R> * QuoteRec<QUOTE_QUANTITY$,R>)
|
|
|
|
CostData<R,5> = OCONV(ExtendedAmount,'MD2,$')
|
|
|
|
NEXT R
|
|
|
|
stat = Set_Printer('TEXT')
|
|
|
|
SectionTitle = 'P r i c i n g I n f o r m a t i o n' ; SectFormat = '^10800'
|
|
|
|
Font<F_BOLD$> = 1
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',SectFormat,SectionTitle,'',LTGREY$,'',0,TB_ALL)
|
|
|
|
* Pricing Information
|
|
|
|
colHeader = 'Line' ; colFormat = '^720'
|
|
colHeader<1,2> = 'Description' ; colFormat<1,2> = '<5760'
|
|
colHeader<1,3> = 'Per Unit' ; colFormat<1,3> = '>1440'
|
|
colHeader<1,4> = 'Qty ' ; colFormat<1,4> = '>1440'
|
|
colHeader<1,5> = 'Total' ; colFormat<1,5> = '>1440'
|
|
|
|
colData = CostData
|
|
|
|
GOSUB CheckPageBreak
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'','','',0,TB_ALL)
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_ALL)
|
|
|
|
Font<F_POINTSIZE$> = 10 ;* Reset font size for item
|
|
stat = Set_Printer('FONT',Font)
|
|
|
|
|
|
Comments = QuoteRec<quote_comments$>
|
|
SWAP @TM WITH CRLF$ IN Comments
|
|
Comments = 'Processing Step 1 and PSN Layer L1 are closest to the substrate.':CRLF$:Comments
|
|
|
|
stat = Set_Printer('TEXT')
|
|
|
|
* Pricing Information
|
|
|
|
colHeader = 'Comments' ; colFormat = '<10800' ; colData = Comments
|
|
|
|
GOSUB CheckPageBreak
|
|
|
|
Font<F_BOLD$> = 1
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'',LTGREY$,'',0,TB_COLUMNS_TOP_BOTTOM)
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_COLUMNS_TOP_BOTTOM)
|
|
|
|
stat = Set_Printer('TEXT')
|
|
stat = Set_Printer('TEXT')
|
|
stat = Set_Printer('TEXT')
|
|
stat = Set_Printer('TEXT')
|
|
stat = Set_Printer('TEXT')
|
|
|
|
* Buyers Acceptance Block
|
|
|
|
SectionTitle = 'B u y e r s A c c e p t a n c e' ; SectFormat = '^10800'
|
|
|
|
colHeader = 'Signature' ; colFormat = '^3600' ; colData = CRLF$:CRLF$
|
|
colHeader<1,2> = 'Printed Name' ; colFormat<1,2> = '^3600' ; colData<1,2> = CRLF$:CRLF$
|
|
colHeader<1,3> = 'Date' ; colFormat<1,3> = '^3600' ; colData<1,2> = CRLF$:CRLF$
|
|
|
|
GOSUB CheckPageBreak
|
|
|
|
Font<F_BOLD$> = 1
|
|
stat = Set_Printer('FONT',Font)
|
|
|
|
stat = Set_Printer('ADDTABLE',SectFormat,SectionTitle,'',LTGREY$,'',0,TB_COLUMNS_TOP_BOTTOM)
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,colHeader,'',LTGREY$,'',0,TB_COLUMNS_TOP_BOTTOM)
|
|
|
|
Font<F_BOLD$> = 0
|
|
|
|
stat = Set_Printer('FONT',Font)
|
|
stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_COLUMNS_TOP_BOTTOM)
|
|
|
|
stat = Set_Printer('TEXT')
|
|
stat = Set_Printer('TEXT')
|
|
stat = Set_Printer('TEXT',"Prices Quoted are valid for Sixty(60) days. Prices subject to change without notice.")
|
|
|
|
|
|
NEXT I
|
|
|
|
stat = Set_Printer( 'TERM' )
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
CheckPageBreak:
|
|
* * * * * * *
|
|
|
|
stat = Set_Printer('CALCTABLE',colFormat:@FM:colData)
|
|
TableSize = Get_Printer('CALCTABLE')
|
|
TableHeight = TableSize<2>
|
|
IF Get_Printer('POS')<2> + TableHeight + SectionHeight > 9 THEN
|
|
stat = Set_Printer('PAGEBREAK')
|
|
END
|
|
|
|
RETURN
|
|
|
|
|