added LSL2 stored procedures

LSL2/STPROC/PRINT_SHIP_GL.txt

@@ -0,0 +1,378 @@
+COMPILE SUBROUTINE Print_Ship_GL(Dummy)
+
+/*
+	Print Billings_Ship Report
+	10/29/2005 - John C. Henry, J.C. Henry & Co., Inc. - Initial coding
+*/
+
+
+DECLARE SUBROUTINE Utility, ErrMsg, Set_Status, Set_Printer, RList
+DECLARE FUNCTION Set_Printer, Get_Printer, Msg, Get_Status, Printer_Select, obj_Install, Dialog_Box
+
+$INSERT OIPRINT_EQUATES
+$INSERT INVOICE_EQU
+$INSERT APPCOLORS
+$INSERT MSG_EQUATES
+
+
+EQU TAB$				TO \09\
+EQU TARGET_ACTIVELIST$	TO 5
+
+
+ErrorTitle = 'Error in stored procedure Print_Ship_GL'
+
+OPEN 'COC' TO ShipmentTable ELSE
+	ErrorMsg = 'Unable to open "COC" table.'
+	ErrMsg(ErrorTitle:@SVM:ErrorMsg)
+	RETURN
+END
+
+OPEN 'DICT.COC' TO @DICT ELSE
+	ErrorMsg = 'Unable to open "COC" table.'
+	ErrMsg(ErrorTitle:@SVM:ErrorMsg)
+	RETURN
+END
+
+DateRange = Dialog_Box('DIALOG_DATE_RANGE',@WINDOW,'')
+
+StartDt = DateRange<1>
+EndDt	= DateRange<2>
+
+Set_Status(0)
+
+SelectSent  = 'SELECT COC WITH SHIP_DT FROM ':QUOTE(StartDt):' TO ':QUOTE(EndDt):' BY GL_CODE BY CUST_NAME'
+
+RList(SelectSent,TARGET_ACTIVELIST$,'','','')
+IF Get_Status(errCode) THEN
+	ErrMsg(errCode)
+	RETURN
+END
+
+* Start of printing process
+
+FileName		= 'Print Shipments by GL Code by Company Report'
+Title			= 'Printing Shipments by GL Code by Company'
+
+TopMargin		= 1.0
+BottomMargin	= 0.75
+LeftMargin		= 0.5
+RightMargin		= 0.5
+
+Margins = LeftMargin:@FM:TopMargin:@FM:RightMargin:@FM:BottomMargin
+
+PageSetup	= '0'	;* Landscape = 1
+PrintSetup	= '2'	;* Preview Normal
+PrintPath	= Printer_Select()
+
+stat = Set_Printer('INIT',FileName,Title,Margins,PageSetup,PrintSetup,PrintPath)
+IF stat < 0 THEN GOTO OIPrintErr
+
+DateRange = 'With Ship Dates From ':StartDt:' Thru ':EndDt
+
+Header = "'D'":@VM:obj_Install('Get_Prop','CompTitle'):' Shipments by GL Code by Company Report':@VM:"Page  'P'"
+Header<-1> = "'T'":@VM:DateRange
+Header<-1> = ''																;* Blank line following heading
+
+font	= 'Arial'
+font<2>	= '10'
+font<4>	= '1'		;* Bold
+
+stat = Set_Printer('FONTHEADFOOT',font)	; IF stat < 0 THEN GOTO OIPrintErr
+stat = Set_Printer('HEADER',Header)		; IF stat < 0 THEN GOTO OIPrintErr
+
+Footer = " 'D' 'T'":@VM:@VM:"Page:  'P'"
+stat = Set_Printer('FOOTER',Footer)		; IF stat < 0 THEN GOTO OIPrintErr
+
+@RECCOUNT= 0
+
+FirstPass	= 1
+LastRecord	= 0
+FirstLine	= 1
+
+* Make Column Heading
+
+colHead = ''								; colFmt = ''
+colHead<1,1> 	= 'Cust'					; colFmt<1,1>	= '^720'
+colHead<1,2>	= 'Customer Name'			; colFmt<1,2>	= '<6480'
+colHead<1,3>	= 'GL Code'					; colFmt<1,3>	= '>1080'
+colHead<1,4>	= 'Ship Amount'				; colFmt<1,4>	= '>1800'
+
+* Zero Accumulators For Each Break
+
+Ship_Amount.Cust_No.Total = 0
+Ship_Amount.Cust_No.Count = 0
+
+Ship_Amount.GL_Code.Total = 0
+Ship_Amount.GL_Code.Count = 0
+
+Ship_Amount.Grand.Total = 0
+Ship_Amount.Grand.Count = 0
+
+* Null Previous Break Buckets
+
+Prev.Cust_No		= ''
+Prev.Cust_Name		= ''
+Last.Cust_No.Break	= 1	
+Prev.GL_Code 		= ''
+Last.GL_Code.Break	= 1
+
+
+* * * * * * *
+ReadRecord:
+* * * * * * *
+
+* Zero Break Flags To False
+
+Cust_No.Break = 0
+GL_Code.Break = 0
+
+READNEXT @ID, WhichValue ELSE
+	LastRecord			= 1
+	Cust_No.Break		= 1
+	Cust_No				= Prev.Cust_No
+	Cust_Name			= Prev.Cust_Name
+	GL_Code.Break		= 1 
+	GL_Code				= Prev.GL_Code
+END
+
+S.ATID = @ID
+
+IF FirstPass AND LastRecord THEN
+ 	GOTO Bail
+END
+
+ 
+IF LastRecord THEN GOTO BREAKS
+ 
+
+READO @RECORD FROM ShipmentTable,@ID ELSE
+	GOTO ReadRecord
+END
+
+ 
+@RECCOUNT += 1
+ 
+* Calculate Value(s) For Column(s)
+ 
+S.ATID			= { @ID}
+I.ATID			= S.ATID
+S.Cust_No		= {WO_CUST_NO}
+I.Cust_No		= S.Cust_No
+S.GL_Code		= {GL_CODE}
+I.GL_Code		= S.GL_CODE
+
+
+S.Cust_Name		= {CUST_CITY}
+
+SWAP '/' WITH ' - ' IN S.Cust_Name
+
+I.Cust_Name		= S.Cust_Name
+
+S.Ship_Date		= {SHIP_DT}<1,WhichValue>
+
+IF S.Ship_Date < ICONV(StartDt,'D') OR S.Ship_Date > ICONV(EndDt,'D') THEN GOTO ReadRecord	;* Limit multivalues to date range.
+
+
+* Initialize Multivalue Break Check Variables
+
+
+M.Ship_Amount	= {ITEM_EXT_AMT}<1,WhichValue> ; P.Ship_Amount = 1 ; C.Ship_Amount = 7
+S.Ship_Amount 	= M.Ship_Amount
+
+Previous.Mark.Level= 0
+
+* Test For Control Break(s)
+
+IF (S.GL_Code NE Prev.GL_Code) OR GL_Code.Break THEN
+	GL_Code			= Prev.GL_Code
+	Prev.GL_Code	= S.GL_Code
+	GL_Code.Break  += 1
+	Cust_No.Break 	= 3
+END
+
+IF (S.Cust_No NE Prev.Cust_No) OR Cust_No.Break THEN
+	Cust_No			= Prev.Cust_No
+	Prev.Cust_No	= S.Cust_No
+	Cust_Name		= Prev.Cust_Name
+	Prev.Cust_Name	= S.Cust_Name
+	Cust_No.Break  += 1
+END
+
+ 
+IF FirstPass THEN
+	FirstPass= 0
+	GOTO Detail
+END
+
+
+* * * * * * * 
+BREAKS:
+* * * * * * *
+
+* Print Break Total(s) And Accumulate Total(s)
+
+
+
+IF Cust_No.Break THEN
+
+	colData = Cust_No
+	colData<1,2> = Cust_Name
+	colData<1,3> = ''
+	colData<1,4> = OCONV(Ship_Amount.Cust_No.Total ,"MD2,$")
+		
+	GOSUB PrintTable
+	
+	Ship_Amount.GL_Code.Total += Ship_Amount.Cust_No.Total		; Ship_Amount.Cust_No.Total = 0
+	Ship_Amount.GL_Code.Count += Ship_Amount.Cust_No.Count		; Ship_Amount.Cust_No.Count = 0
+	
+END
+
+IF GL_Code.Break THEN
+
+	colData = @VM:@VM:@VM
+	colData<2,1> = ''
+	colData<2,2> = '                    Account ':GL_Code:' Sub-Total:'
+	colData<2,3> = GL_Code
+	colData<2,4> = OCONV(Ship_Amount.GL_Code.Total ,"MD2,$")
+		
+	colData<3> = @VM:@VM:@VM	
+		
+	GOSUB PrintTable
+	
+	Ship_Amount.Grand.Total+=Ship_Amount.GL_Code.Total	; Ship_Amount.GL_Code.Total = 0
+	Ship_Amount.Grand.Count+=Ship_Amount.GL_Code.Count	; Ship_Amount.GL_Code.Count = 0
+	
+
+END
+
+
+* Perform Last Record Output If Done
+
+IF LastRecord THEN
+
+	colData = ""
+	colData<1,1> = ''
+	colData<1,2> = 'Report Totals:'
+	colData<1,3> = ''
+	colData<1,4> = OCONV(Ship_Amount.Grand.Total ,"MD2,$")
+	
+	GOSUB PrintTable
+	
+	status = Set_Printer('TEXT','')
+	status = Set_Printer('TEXT',@RECCOUNT:' Records Processed')
+	
+	GOTO Bail
+
+END
+
+* * * * * * * 
+DETAIL:
+* * * * * * *
+ 
+* Remove Appropriate Value FromMulti-Valued Column(s)
+
+New.Mark.Level = 0
+
+IF C.Ship_Amount GE PREVIOUS.MARK.LEVEL THEN
+	REMOVE I.Ship_Amount FROM M.Ship_Amount AT P.Ship_Amount SETTING C.Ship_Amount
+	S.Ship_Amount=I.Ship_Amount
+END
+IF C.Ship_Amount GT New.Mark.Level THEN New.Mark.Level=C.Ship_Amount
+
+* Do Conversions If Any
+ 
+IF S.Cust_No NE ""		THEN S.Cust_No = OCONV(S.Cust_No,"MD0")
+IF S.Ship_Amount NE "" 	THEN S.Ship_Amount=OCONV(S.Ship_Amount,"MD2,$")
+
+ 
+* Accumulate Total(s)
+ 
+
+IF NUM(I.Ship_Amount) AND I.Ship_Amount NE "" THEN
+	Ship_Amount.Cust_No.Total += I.Ship_Amount
+	Ship_Amount.Cust_No.Count += 1
+	I.Ship_Amount = ''
+END
+ 
+* Print Detail Line
+ 
+colData = ""
+colData<1,1> = S.Cust_No
+colData<1,2> = S.Cust_Name
+colData<1,3> = S.GL_Code
+colData<1,4> = S.Ship_Amount
+
+*GOSUB PrintTable
+
+IF New.Mark.Level THEN
+	S.Cust_No			= ''
+	S.Cust_Name			= ''
+	S.Ship_Qty			= ''
+	S.Misc_Qty			= ''
+	S.Ship_Amount		= ''
+	Previous.Mark.Level	= New.Mark.Level
+	GOTO Detail
+END
+
+GOTO ReadRecord
+ 
+
+* * * * * * *
+Bail:
+* * * * * * *
+
+stat = Set_Printer('TERM',1)
+
+RETURN
+
+
+* * * * * * *
+OIPrintErr:
+* * * * * * *
+
+ErrMsg(ErrorTitle:@SVM:ErrorMsg)
+ErrMsg(ErrorTitle:@SVM:'Set_Printer returned errorcode ':stat)
+stat = Set_Printer('TERM',1)
+
+RETURN
+
+
+* * * * * *
+PrintTable:
+* * * * * * 
+
+
+stat = Set_Printer('CALCTABLE',colFmt:@FM:colData)
+TableSize = Get_Printer('CALCTABLE')
+TableHeight = TableSize<2>
+Test = Get_Printer('POS')<2>
+
+IF Get_Printer('POS')<2> + TableHeight > 9.00 OR FirstLine THEN
+	IF NOT(FirstLine) THEN
+		stat = Set_Printer('PAGEBREAK')
+	END
+	FirstLine = 0
+	font<2> = 10
+	font<4> = 1		;* Bold
+	stat = Set_Printer('FONT',font,'100')
+
+	stat = Set_Printer('ADDTABLE',colFmt,colHead,'',LTGREY$,'',0,TB_ALL)
+	
+	
+	font<4> = 0
+	stat = Set_Printer('FONT',font,fontSpacing)
+	
+	stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7)
+	
+END ELSE
+	font<2> = 10
+	font<4> = 0
+	stat = Set_Printer('FONT',font,fontSpacing)
+	stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL)
+
+END
+	
+							
+RETURN	 
+
+