*CrossTab.prg
Lparameters tcSource,tcTarget,tcRowFields,tcColumnField, tcDataField
LOCAL ix,lcConnect
LOCAL ARRAY aCols[1]
SELECT distinct &tcRowFields, SPACE(10) as uid ;
FROM (m.tcSource) ;
INTO CURSOR __crsUID ;
readwrite
replace ALL uid WITH SYS(2015)
SET TEXTMERGE TO memvar m.lcConnect noshow
SET TEXTMERGE on
FOR ix = 1 TO ALINES(aCols,m.tcRowFields,.t.,',')
\\<<IIF(m.ix > 1,' and ','')>>lft.<<aCols[m.ix]>> == rgt.<<aCols[m.ix]>>
endfor
SET TEXTMERGE to
SET TEXTMERGE off
SELECT lft.*, rgt.uid ;
FROM (m.tcSource) lft ;
INNER JOIN __crsUID rgt ON &lcConnect ;
INTO CURSOR __crsTemp ;
nofilter
* Cross tab data
* tcSource,tcTarget,tcRowField,tcColumnField, tcDataField
CreateCrossTab('__crsTemp','__crsXTab','uID',m.tcColumnField, m.tcDataField)
SET TEXTMERGE TO memvar m.lcFields noshow
SET TEXTMERGE on
FOR ix = 1 TO ALINES(aCols,m.tcRowFields,.t.,',')
\\<<IIF(m.ix > 1,',','')>>t1.<<aCols[m.ix]>>
endfor
SET TEXTMERGE to
SET TEXTMERGE off
IF USED(m.tcTarget)
USE IN (m.tcTarget)
endif
SELECT DISTINCT &lcFields,t2.* ;
FROM __crsTemp t1 ;
INNER JOIN __crsXtab t2 ;
ON t1.UID == t2.UID ;
INTO CURSOR (m.tcTarget) ;
readwrite
ALTER table (m.tcTarget) drop COLUMN uid
USE IN '__crsUID'
USE IN '__crsXTab'
USE IN '__crsTemp'
Function CreateCrossTab
Lparameters tcSource,tcTarget,tcRowField,tcColumnField, tcDataField
Local ix,lcType,lnLen,lnDec,lcType1,lnLen1,lnDec1,lcLeft,lcRight
Local Array aStruct[1],aCols[1], aXTab[1]
For ix=1 To Afields(aStruct,m.tcSource)
If Upper(Trim(m.tcRowField)) == Upper(Trim(aStruct[m.ix,1]))
lcType1 = aStruct[m.ix,2]
lnLen1 = aStruct[m.ix,3]
lnDec1 = aStruct[m.ix,4]
Endif
If Upper(Trim(m.tcDataField)) == Upper(Trim(aStruct[m.ix,1]))
lcType = aStruct[m.ix,2]
lnLen = aStruct[m.ix,3]
lnDec = aStruct[m.ix,4]
Endif
Endfor
SELECT &tcColumnField,SYS(2015) as orderby ;
FROM (m.tcSOurce) ;
INTO CURSOR __xorder__ ;
nofilter
lcLeft = 't1.'+m.tcColumnField
lcRight = 't2.'+m.tcColumnField
SELECT t1.orderby,&tcColumnField ;
FROM __xorder__ t1 ;
WHERE t1.orderby == ;
(select MIN(orderby) FROM __xorder__ t2 ;
WHERE &lcLeft == &lcRight ) ;
ORDER BY 1 ;
INTO cursor __sortCols__
SELECT &tcColumnField ;
FROM __sortCols__ ;
INTO ARRAY aCols
USE IN '__xorder__'
USE IN '__sortCols__'
Dimension aXTab[Alen(aCols)+1,5]
aXTab[1,1] = m.tcRowField
aXTab[1,2] = m.lcType1
aXTab[1,3] = m.lnLen1
aXTab[1,4] = m.lnDec1
aXTab[1,5] = .f.
For ix=1 To Alen(aCols)
aXTab[m.ix+1,1] = Chrtran(Trim(aCols[m.ix]),' ','_')
aXTab[m.ix+1,2] = m.lcType
aXTab[m.ix+1,3] = m.lnLen
aXTab[m.ix+1,4] = m.lnDec
aXTab[m.ix+1,5] = .t.
Endfor
Create Cursor (m.tcTarget) From Array aXTab
Local Array arrRec[Floor(65000/Fcount()),Fcount()]
arrRec = .null.
Select Distinct &tcRowField As _RowData ;
from (m.tcSource) ;
into Cursor _DRows
lnRec = 0
Scan
If m.lnRec = 65000
Insert Into (m.tcTarget) From Array arrRec
arrRec = .F.
lnRec = 0
Endif
lnRec = m.lnRec + 1
arrRec[m.lnRec,1] = _DRows._RowData
Select (m.tcSource)
Scan For Evaluate(m.tcRowField) = arrRec[m.lnRec,1]
arrRec[m.lnRec, ;
Asubscript(aXTab, ;
Ascan(aXTab,;
Chrtran(Trim(;
Evaluate(m.tcSource+'.'+m.tcColumnField)),' ','_')),1)] = ;
Evaluate(m.tcSource+'.'+m.tcDataField)
Endscan
Select (m.tcSource)
Endscan
Use In '_DRows'
Dimension arrRec[m.lnRec,Alen(arrRec,2)]
Insert Into (m.tcTarget) From Array arrRec
Select (m.tcTarget)
Locate
Endfunc