added LSL2 stored procedures

LSL2/STPROC/PRINT_PSN_CONV.txt

@@ -0,0 +1,187 @@
+COMPILE SUBROUTINE Print_PSN_Conv(Dummy)
+
+DECLARE FUNCTION Msg, set_property, send_event, dialog_box, Utility, get_property
+DECLARE FUNCTION Set_Printer, FieldCount, Printer_Select, Get_Printer, obj_RDS2, obj_WM_In, obj_WM_Out
+DECLARE SUBROUTINE RList, ErrMsg, Msg
+
+/*
+	Report rewritten 07/08/2005 John C. Henry, J.C. Henry & Co., Inc.
+*/
+
+
+$INSERT RLIST_EQUATES
+$INSERT LOGICAL
+$INSERT MSG_EQUATES
+$INSERT OIPRINT_EQUATES
+$INSERT DICT_EQUATES
+
+$INSERT APPCOLORS
+
+
+
+OPEN 'DICT.PROD_SPEC' TO FileIn ELSE
+	GOTO Bail
+END
+
+SELECT FileIn
+
+OrgFieldNames = ''
+Destinations = ''
+ColData = ''
+
+
+
+RecCnt = 0
+FixCnt = 0
+Done = 0
+
+LOOP
+	READNEXT DictID ELSE Done = 1
+UNTIL Done
+	RecCnt += 1
+	
+	READ DictRec FROM FileIn,DictID THEN
+	
+		a = DictRec<DICT_DESC$>
+		 
+	
+		IF DictRec<DICT_DESC$>[1,4] _EQC 'MOVE' THEN
+			Destination = DictRec<DICT_DESC$>
+			SWAP 'Move ' WITH '' IN Destination
+			LOCATE Destination IN Destinations BY 'AL' SETTING Pos THEN
+				OrgFieldNames = INSERT(OrgFieldNames,1,Pos,-1,DictID)
+			
+			END ELSE
+			
+				OrgFieldNames	= INSERT(OrgFieldNames,1,Pos,0,DictID)
+				Destinations	= INSERT(Destinations,1,Pos,0,Destination)
+				
+				
+			END
+			*Send_Dyn(DictID:TAB$:TAB$:TAB$:TAB$:DictRec<DICT_DESC$>)
+			
+		END
+	END
+	
+REPEAT
+
+SWAP @SVM WITH CRLF$ IN OrgFieldNames
+
+ofnCnt = COUNT(OrgFieldNames,@VM) + (OrgFieldNames NE '')
+
+FOR I = 1 TO ofnCnt
+	colData<I,1> = OrgFieldNames<1,I>
+	colData<I,2> = FIELD(Destinations<1,I>,'*',1)
+	colData<I,3> = FIELD(Destinations<1,I>,'*',2)
+NEXT I
+
+
+
+
+colHdr = ''							; colFmt = ''
+colHdr<1,1> = 'PROD_SPEC field'		; colFmt<1,1> = '<+3600'
+colHdr<1,2> = 'New Table'			; colFmt<1,2> = '<+3600'
+colHdr<1,3> = 'New Field'			; colFmt<1,3> = '<+3600'
+
+
+
+PrintPath = Printer_Select('',1)	;* Get default printer path                                                              
+Void = Set_Printer( 'INIT', '', '', .38:@fm:.75:@fm:.38:@fm:.75, 1, 3:@vm:'':@vm:'':@vm:2:@fm:96, PrintPath )
+
+Void = Utility( 'CURSOR', 'H' )
+
+Font = "Courier New,8,L,1"
+convert ',' to @fm in Font
+TFont = font
+TFont<2> = 12
+Void = Set_Printer( 'FONTHEADFOOT', TFont )
+
+SpaceOut = STR(' ',10)
+
+Header		= "Page 'P'":@VM:"'PROD_SPEC'"
+Header<2>	= "'D' 'T'":SpaceOut:"Conversion Report"
+
+Void = Set_Printer( 'HEADER',Header)
+
+TFont<2> = 8
+TFont<4> = 0
+Void = Set_Printer( 'FONT', TFont )
+
+
+TFont<4> = 1
+Void = Set_Printer( 'FONT', TFont )
+
+FirstLine = 1
+
+GOSUB PrintTable
+
+Void = Utility( 'CURSOR', 'A' )
+Void = Set_Printer( 'TERM', 1 ) 
+
+RETURN
+
+
+
+
+
+
+* * * * * * *
+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>
+fontSpacing		= 150
+
+IF Get_Printer('POS')<2> + TableHeight > 7.0 OR FirstLine THEN
+	IF NOT(FirstLine) THEN
+		stat = Set_Printer('PAGEBREAK')
+	END
+	FirstLine = 0
+	font<2> = 8
+	font<4> = 1		;* Bold
+	stat = Set_Printer('FONT',font,'100')
+
+	stat = Set_Printer('ADDTABLE',colFmt,colHdr,'',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> = 8
+	font<4> = 0
+	stat = Set_Printer('FONT',font,fontSpacing)
+	stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL)
+
+END
+	
+							
+RETURN	 
+
+
+