#include %cspBuild
#include vhLib.Macro
#include %occInclude
#include Prod.Product
#include BL.Derde.KlantSpecifiek
 
 #define NewRelease   0
 #define MaxDiffPRS   2.00
 
 
	// Oproepen via 
	//   d KSB^WV3(1) 
KSB(blnCheckOnly)
	New k
	Do KADCreateSchaduwBS(.blnCheckOnly)
	w !,!,"Merge array arLOG into a global (Y/N) ? "
	r k,!
	If $$$UCase(k)?1(1"Y",1"J") Do
	. Kill ^wvLogKADcalcSchaduwBS
	. Merge ^wvLogKADcalcSchaduwBS=arLOG
	. w "the array arLOG is merged to global  ^wvLogKADcalcSchaduwBS ",!
	w !,!,"Show array arLOG in this terminal (Y/N) ? "
	r k,!
	If $$$UCase(k)'="N" Do
	. w $$ArrayToText^vhLib("arLOG(""I-ID"")",.arLOG),!
	. w $$ArrayToText^vhLib("arLOG(""PRS"")",.arLOG),!
	Quit
 
	// Oproepen via 
	//   d KSS^WV3() 
KSS(blnCheckOnly)
	New k
	Do KADStatsSchaduwBS()
	w !,!,"Merge array arSTAT into a global (Y/N) ? "
	r k,!
	If $$$UCase(k)?1(1"Y",1"J") Do
	. Kill ^wvLogKADstatSchaduwBS
	. Merge ^wvLogKADstatSchaduwBS=arSTAT
	. w "the array arSTAT is merged to global  ^wvLogKADstatSchaduwBS ",!
	w !,!,"Show array arSTAT in this terminal (Y/N) ? "
	r k,!
	If $$$UCase(k)'="N" Do
	. w $$ArrayToText^vhLib("arSTAT(""I-ID"")",.arLOG),!
	. w $$ArrayToText^vhLib("arSTAT(""RAW"")",.arLOG),!
	. w $$ArrayToText^vhLib("arSTAT(""PRS"")",.arLOG),!
	
	
	Set Dev=$$OPEN^vhDEV(,"KAD_Stats_BSS.txt","W","T")
	Use Dev
	Set PRNr=""
	Write $tr("PRNr,KortTekst,KadID,blnNonAkt,blnKadExistsID,blnBSFixed,blnBS,blnBSS,blnKostSpeciaal,StatQty,VersieNrPRBS",",",$C(9)),!
	For  Set PRNr=$O(arSTAT("RAW",PRNr)) Quit:PRNr=""  Do
	. Write PRNr,*9,$P(^KPR(PRNr,0),"\")
	. Write *9,$$ListToPieces^vhLib(arSTAT("RAW",PRNr),$C(9))
	. Write !
	
	Do CLOSE^vhDEV(Dev)
	W !,"File "_"KAD_Stats_BSS.txt"_" written to disk",!
	Quit
 
 
 
KADStatsSchaduwBS()
	// Routine kan best opgeroepen worden NA het uitvoeren van KADCreateSchaduwBS() 
	// Loopt ^KPR af en maakt een lijst van alle Kaderdeuren die geen schaduwBouwstenen hebben of die speciale bouwstenen (bvb. VullingKostSpecial) bevatten 
	New PRNr,KadID,GENTYP,CntProd,CntCalc
	New blnNonAkt,blnKadExistsID,blnBSFixed,blnBSS,blnKostSpeciaal,blnHist,VersieNrPRBS,StatQty
	Kill arSTAT
	Set (CntProd,CntCalc)=0
	Set PRNr=""
	For  Set PRNr=$O(^KPR(PRNr)) Quit:(PRNr="")  Do:PRNr
	. Set KadID=$P($G(^KPR(PRNr,"G")),"\",13)
	. Quit:(+KadID'>0)
	. Set GENTYP=$P(##class(Prod.Product).GetPropViaNr(PRNr,"GENTYP"),"\",1)   ; Geeft TBX, KAD, BAN, ... terug naargelang het product 
	. Quit:(GENTYP'?1(1"KAD"))
	. Do kssStatSchaduwBS()   ; (PRNr,KadID) 
	w !,"Total Products: "_CntProd_"   #Calc: "_CntCalc,!
	Quit
	
kssStatSchaduwBS()   ; (PRNr,KadID) 
	Quit:($G(PRNr)'?4.7N)
 
	Quit:(($I(CntProd)#1)'=0)
	Do:$I(CntCalc)   ; Increment CntCalc 
	Do kssWriteOutput
	Set blnNonAkt=($$$PRGet($$$NONAktief)=1)
	Set blnKadExistsID=##class(Prod.GADef.KaderDeur).%ExistsId(KadID)
	Set VersieNrPRBS=$P($G(^PRBS("BS",PRNr),"\\1.0.0"),"\",3)
	Set blnBSFixed=(VersieNrPRBS="")
	Set blnBSS=($D(^PRBS("BSS",PRNr))=11)
	Set blnBS=($D(^PRBS("BS",PRNr))=11)
	Set blnKostSpeciaal=0
	Set blnKostSpeciaal=(blnKostSpeciaal)||($LG(##class(Prod.Kenmerk.DataDefinitie).Get("KAD",PRNr,"PROFKS"),1)>0)   ; Profiel KostSpeciaal 
	Set blnKostSpeciaal=(blnKostSpeciaal)||($LG(##class(Prod.Kenmerk.DataDefinitie).Get("KAD",PRNr,"VULKS"),1)>0)    ; Vulling KostSpeciaal 
	Set blnKostSpeciaal=(blnKostSpeciaal)||($LG(##class(Prod.Kenmerk.DataDefinitie).Get("KAD",PRNr,"CONSKS"),1)>0)   ; Constructie KostSpeciaal 
	Set StatQty=$$PROD^STAT(PRNr,0,"2009.03 ","2010.03 ",1)
	
	Set arSTAT("I-ID",PRNr)=KadID
	Set arSTAT("RAW",PRNr)=$LB(KadID,blnNonAkt,blnKadExistsID,blnBSFixed,blnBS,blnBSS,blnKostSpeciaal,StatQty,VersieNrPRBS)
	;Set arSTAT("PRS",PRNr)=$S($G(DummyPrice,0):$LB(999.99), 1:$LB($$$PRGet($$$PPLMTL)))
	;Set $LI(arSTAT("PRS",PRNr),10)="KadID: "_KadID
	Quit
kssWriteOutput
	// Write output to device 
	Quit:(CntCalc#100'=0)   ; Only write once every ? to device 
	w "Product : "_$G(PRNr)_" - "_$G(KadID)
	w "  - Calc..."_$G(CntProd)_"  :"_$G(CntCalc),!
 	Quit
 
 
KADCreateSchaduwBS(blnCheckOnly)
	// Loopt alle KaderDeur objecten af en creëert de schaduw bouwstenen voor de bestaande KPR-producten 
	New PRNr,KadID,CntProd,CntCalc
	New CheckKadID,KadObj,GADataProd,DummyPrice,MaxDiffPRS
 
 	Set blnCheckOnly=$G(blnCheckOnly,1)
 	Set MaxDiffPRS=100
 	Set (CntProd,CntCalc)=0
 	Quit:('$$kcsCheckSchaduwActief())
	Kill arLOG
	w "Preparing SQL ... ",!
	&sql(DECLARE crsKadALL cursor for SELECT Product, ID INTO :PRNr, :KadID
			FROM Prod_GADef.KaderDeur
			WHERE (ID > 1000)
			ORDER BY Product)
  	&sql(OPEN crsKadALL)
	w "Fetching SQL records ... ",!
	For  &sql(FETCH crsKadALL) Quit:SQLCODE  Do kcsCreateViaPRNr(.PRNr,.KadID,blnCheckOnly)
	&sql(CLOSE crsKadALL)
	w !,"Total Products: "_CntProd_"   #Calc: "_CntCalc,!
	Quit
kcsCheckSchaduwActief()
	#define KADBasis   "KADBasis"
	Set Templ=##class(Prod.GAData.Template).TemplateViaCode($$$KADBasis)
	Quit:('$IsObject(Templ)) 0                  ; "No Template object" 
	Quit:('$IsObject(Templ.SchaduwProduct)) 0   ; "Geen schaduwproduct in de template aanwezig" 
	Quit 1
kcsCreateViaPRNr(PRNr,KadID,blnCheckOnly)
	w:(blnCheckOnly) "Product : "_$G(PRNr)_" - "_$G(KadID)
	Quit:($G(PRNr)'?4.7N)||(+$G(KadID)'>0)
	Quit:('$D(^KPR(PRNr)))||($$$PRGet($$$NONAktief)=1)
	Set VersieNrPRBS=$P($G(^PRBS("BS",PRNr),"\\1.0.0"),"\",3)
	Quit:(VersieNrPRBS="")
 
	// Check Valid PRNr/KadID 
	Set CheckKadID=$P($G(^KPR(PRNr,"G")),"\",13)   ; Moet zelfde zijn als KadID 
	Quit:('CheckKadID)||(KadID'=CheckKadID)
	Set GENTYP=$P(##class(Prod.Product).GetPropViaNr(PRNr,"GENTYP"),"\",1)   ; Geeft TBX, KAD, BAN, ... terug naargelang het product 
	Quit:(GENTYP'?1(1"KAD"))
 
#if ($$$Server="CACHE01")||($$$NSpace="TST-ADMIN1")
	Quit:(($I(CntProd)#1)'=0)
#else
	Quit:(($I(CntProd)#100)'=0)
#endif
 
	w:(blnCheckOnly=0) "Product : "_$G(PRNr)_" - "_$G(KadID)
	w "  - Calc..."_CntProd_"  :"_$I(CntCalc),!
 
	Set arLOG("I-ID",PRNr)=KadID
	Set arLOG("PRS",PRNr)=$S($G(DummyPrice,0):$LB(999.99), 1:$LB($$$PRGet($$$PPLMTL)))
	Set $LI(arLOG("PRS",PRNr),10)="KadID: "_KadID
	
	Quit:(blnCheckOnly)   ; Testcase - do not create schaduw Bouwstenen YET 
	
	Set KadObj=""
	Set sc=##class(Prod.GADef.KaderDeur).KPRCreateSchaduwViaPRNr(PRNr, .KadObj)  w sc,! 
	/*   * /
	//
	// !!! NOT TESTED YET !!!
	// 
	If ($IsObject(KadObj))&&($IsObject(KadObj.GADataProd)) Do
	. // Get price from GADataProd 
	. Set GADataProd=KadObj.GADataProd
	. Set $LI(arLOG("PRS",PRNr),3)=$J(GADataProd.Cumuls("KPrijs"),0,4)
	. Set $LI(arLOG("PRS",PRNr),5)=+$J($LI(arLOG("PRS",PRNr),3)-$LI(arLOG("PRS",PRNr),1),0,2)
	. ;Do:(MaxDiffPRS>0) TBXCheckMaxDiffPRS(PRNr, MaxDiffPRS, $LI(arLOG("PRS",PRNr),1), $LI(arLOG("PRS",PRNr),3), 0)
	/*   */
	Set KadObj=""
	Quit	
 
 
TBXCheckMaxDiffPRS(PRNr,MaxDiffPRS,Prs1,Prs2,SetNonAkt)
	Quit:(MaxDiffPRS'>0)
	If ($ZAbs(Prs2-Prs1)>MaxDiffPRS)&&(Prs1>0)&&(Prs2>0) Do
	. Do:($G(SetNonAkt)) $$$PRSet($$$NONAktief,1)
	. Set arLOG("ERR",PRNr,$I(arLOG("ERR",PRNr)))="Prijs Diff > "_$G(MaxDiffPRS)_" EUR : Product op NonAktief ("_($$$PRGet($$$NONAktief))_")"
	. Set $LI(arLOG("AKT",PRNr),1)="NonAkt="_$$$PRGet($$$NONAktief)
	Quit
 
 
 
 
 
	
TestVBA
	  ;d WLIP^vhDBG(97,"test VBA - DisplayImg") 
	  ;d TestExecVBA("Session.RunMacro(""TEventVBA2011"")",$io)
	  ;d TestExecVBA("Application.RunMacro(""TEventVBA2011"")",$io)
	  ;d TestExecVBA("modReflection2011.EventVBA2011",$io)
 
	New cmd
	Set cmd=""
	;Set cmd=cmd_"Dim App As Attachmate_Reflection_Objects_Framework.ApplicationObject"_$$$CRLF
	Set cmd=cmd_"Dim App As Variant"_$$$CRLF
	Set cmd=cmd_"Set App = GetObject(, ""Attachmate_Reflection_Objects_Framework.ApplicationObject"")"_$$$CRLF
	Set cmd=cmd_"msgbox(""test27_002"")"_$$$CRLF
	;Set cmd=cmd_"msgbox(""t:"" & Application.Caption & CacheIP)"_$$$CRLF
	;Set cmd=cmd_"msgbox(""t:"" & Application.AutomationServerName)"_$$$CRLF
	;Set cmd=cmd_"msgbox(Application.GetObject(""ThisTerminal"").Version)"_$$$CRLF
	;Set cmd=cmd_"Application.RunMacro(""EventVBA""))"_$$$CRLF
	;Set cmd=cmd_"modReflection2011.EventVBA2011"_$$$CRLF
	d TestExecVBA(cmd,$io)
 
	Quit
 
TestExecVBA(VBAcommand,DeviceName)
	Set DeviceName=$$$LCase(DeviceName)
	Set ExecVBAVanuitCache=(DeviceName["localhost") || (DeviceName["testw7_w7") || (DeviceName["gpi_w7")
	If ExecVBAVanuitCache {
		d WLIP^vhDBG(97,"execute "_VBAcommand_" on "_DeviceName)
		Do ##class(TCHUI.TApplication).ExecVBA(VBAcommand)
	}
	Quit 
 
 
 
 
 ;