HELP
Help
help
 
 w "ALFAEDIT()       : Testroutine ter vervanging van het ALPHA-EDIT programma (conversie .ANC --> .PPG)"_$C(13,10)
 W "CLEARTLOG()      : Leegmaken van de ""T""-subnode in ^HADPR"_$C(13,10)
 w "DEBUG()          : (GlobalN,HoofdNode,SubNode,Waarde,UseCounter)"_$C(13,10)
 w "                 : --> Schrijft Waarde in de opgegeven ^GlobalN(Nodes). UseCounter=1 schrijft op SubNode ^GlobalN(Nodes,LastSN+1)"_$C(13,10)
 W "FREES()          : Test voor het leggen van profielen"_$C(13,10)
 W "MODPROD()        : Modify Producten via KlantNr; ProductNrs en KADID's worden uit ^KTO en ^HADPR gehaald "_$C(13,10)
 W "ROTATE(X,Y1,Y2)  : roteert de coördinaten van een horizontale lijn naar een verticale (rotatie om het middelpunt). Geeft tevens de VML-code"_$C(13,10)
 W "TESTLEFT()       : Vergelijkende test tussen 2 methodes om het 1ste character te verwijderen : $E(txt,1)="""" - txt=$E(txt,2,99999) "_$C(13,10)
 W "WFILE()          : Test voor creëren van een bestand op een netwerkmap"_$C(13,10)
 Quit
 
 // ==========================================================================================================================================
 
 
#include %cspBuild
#include vhLib.Macro
#include %occInclude
 
 
 /*   * /
TestRQ
	Set:('$D(%ClientIP)) %ClientIP="192.168.1.97"
	New fopReq,sc
	Set:('$G(%blFOPDocBase)) %blFOPDocBase=$System.OBJ.New("BL.FOP.DocBase.TestWS")
	Set fopReq=%blFOPDocBase.NewFopRequest()
	Set fopReq.data = ""
	Set fopReq.dataRef = ""   ; "c:\Program Files\Assentis\DocBase\Data\resources\processes\TestDocBase\TestDocBase_vh2.xml"
	Set fopReq.perfTrace = 0  ; "false"
	Set fopReq.process = "RenderAndDistributeVH"
	Set fopReq.stage = "DEV"
	;Set fopReq.taskProps = ""
	Set fopReq.traceLevel = 6
	d %blFOPDocBase.AddToTaskPropt(fopReq.taskProps,"Test","TestVal")
	Set:(fopReq.data="") fopReq.data=" "
	Set:(fopReq.dataRef="") fopReq.dataRef=" "
	d $System.OBJ.Dump(fopReq)
	d WL^vhDBG("Dump fopReq "_fopReq_$$$CRLF_$$ObjToText^vhLib(fopReq))
	Set sc=fopReq.%Save()
	If $$$ISERR(sc) Do
	. w "SaveResult: "_$$ParseStatus^vhLib(sc)
	Else  Do
	. w "Save OK",!
	Quit
 
OpenRQ(ReqID)
	Set:('$D(%ClientIP)) %ClientIP="192.168.1.97"
#define WSRequestInfo   WS.FOP.WSRequestInfo
	New fopReq,sc
	Set fopReq=##class($$$WSRequestInfo).%OpenId($G(ReqID,18))
	d WL^vhDBG("Dump fopReq "_fopReq_$$$CRLF_$$ObjToText^vhLib(fopReq))
	New aval,val
	Set aval=fopReq.taskProps
	d WL^vhDBG(aval_"  CountTaskProps:"_aval.Count())  ; _$C(13,10)_$$ObjToText^vhLib(aval))
	set val=aval.GetNext("")
	d WL^vhDBG(val)
	Set sc=""
	If $$$ISERR(sc) Do
	. w "SaveResult: "_$$ParseStatus^vhLib(sc)
	Else  Do
	. w "Save OK",!
	Quit
 /*   */
 
 
StartDebug()
	New k,x,y
	w "Attach Studio to process "_$J_" and press <ENTER> to continue ... "
	r k,!
	w !,"First line in Debug mode",!
	w "Key again ... "
	r k,!
	w !,"Second line in Debug mode",!
	s y=x
	q
	
 
Rtn0()
#define ResourceName   "TestWVEvents"
	New Param,JobID1,Key,Rslt
	Do WLIP^vhDBG(97,"Begin of Rtn0.  $Job="_$J)
	Set Param=""
	Do WL^vhDBG("Starting Rtn1 via JOB")
	Job Rtn1^WV(Param)
	Set JobID1=$ZCHILD
	Do WL^vhDBG("Started Rtn1 (via JOB) --> JobID1:"_JobID1)
	
	Do:(0)
	. Quit:(JobID1=0)
	. w !,"Press any key ... "
	. r Key,!
	. Write !,"continu Rnt0"
	. Do WL^vhDBG("Send signal to Job 1")
	. Set Rslt=$SYSTEM.Event.Signal(JobID1)
	. Do WL^vhDBG("signal sent (to Job 1) --> Result:"_Rslt)
	Do:(1)
	. w !,"Press any key ... "
	. r Key,!
	. Write !,"continu Rnt0"
	. If '$SYSTEM.Event.Defined($$$ResourceName) Do  Quit
	..  Do WL^vhDBG("Resource "_$$$ResourceName_" does not exist. No need to signal!") 
	. Do WL^vhDBG("Send signal to Job 2")
	. Set Rslt=$SYSTEM.Event.Signal($$$ResourceName)
	. Do WL^vhDBG("signal sent (to Job 2) --> Result:"_Rslt)
	Do WL^vhDBG("End of Rtn0")
	Quit
Rtn1(Param)
	New ParentJob,JobID2,Rslt
	Do WLIP^vhDBG(97,"Begin of Rtn1.  $Job="_$J)
	Set ParentJob=$ZPARENT
	Do:(ParentJob>0) WL^vhDBG("Rnt1 started by process "_ParentJob)
	/*   */
	Do WL^vhDBG("Starting Rtn2 via JOB")
	Job Rtn2^WV(Param)
	Set JobID2=$ZCHILD
	Do WL^vhDBG("Started Rtn2 (via JOB) --> JobID2:"_JobID2)
	/*   */
	Do WL^vhDBG("Rtn1 Waiting for Event")
	Set Rslt=$SYSTEM.Event.Wait("",3)
	Do WL^vhDBG("Rtn1 after Wait --> Result:"_Rslt)
	Hang 3
	Do WL^vhDBG("End of Rtn1")
	Quit
 
Rtn2(Param)
	New ParentJob,JobID1,Rslt
	Do WLIP^vhDBG(97,"Begin of Rtn2.  $Job="_$J)
	Set ParentJob=$ZPARENT
	Do:(ParentJob>0) WL^vhDBG("Rnt2 started by process "_ParentJob)
	Set Rslt=$SYSTEM.Event.Create($$$ResourceName)
	Do WL^vhDBG("Rtn2 created Resource --> Result:"_Rslt)
	Do WL^vhDBG("Rtn2 Waiting for Event")
	Set Rslt=$SYSTEM.Event.Wait($$$ResourceName,10)
	Do WL^vhDBG("Rtn2 after Wait --> Result:"_Rslt)
	Hang 5
	Set Rslt=$SYSTEM.Event.Delete($$$ResourceName)
	Do WL^vhDBG("Rtn2 deleted Resource --> Result:"_Rslt)
	Set JobID1=ParentJob
	Do WL^vhDBG("Send signal to Job 1")
	Set Rslt=$SYSTEM.Event.Signal(JobID1)
	Do WL^vhDBG("signal sent (to Job 1) --> Result:"_Rslt)
	Do WL^vhDBG("End of Rtn2")
	Quit
	
GGDP
	Do GetGADataProd^Prod.GAData.Product.tmpDev(.arPR)
	Quit
CGDP
	Do CountGADataParams^Prod.GAData.Product.tmpDev()
	Quit
 
	
 /*
OLKenmXtd
	New GroepID,Kenm,lstWaarde,ArPR,PRNr,Param,sc,arLU
	Set GroepID="OL"
	Set Kenm="HoofdGroep"
	Do okmBuildLookup	
	Do ##class(Prod.Kenmerk.DataIndex).SPAlle(GroepID,"ArPR")   ; Array opbouwen van alle producten
	Set PRNr=""
	For  Set PRNr=$O(ArPR(PRNr)) Quit:(PRNr="")  Do
	.   ;q:(PRNr'=107823)
	. Set sc=##class(Prod.Kenmerk.DataDefinitie).%DeleteId(PRNr_"||"_GroepID_"||"_Kenm)
	. Set ProdType=$$okmGetProdType(PRNr)
	. Set lstWaarde=$G(arLU(ProdType))
	. If lstWaarde="" Do  Quit
	. . w PRNr_"  WAARDE IS LEEG !!!",!
	. Set Param=GroepID_"\"_Kenm_"\"_PRNr_"\"_lstWaarde
	. Set sc=##class(Prod.Kenmerk.DataDefinitie).NewObjectViaList(Param)
	. w PRNr_"  "_$S(sc=1:lstWaarde,1 :sc),!
	Quit
okmBuildLookup
	New i,PT,tmpAr,tmpLB
	Set tmpAr("HG_Laden")=$LB("Bestek & werkbestek","Messen & werkbestek","Kruiden","Folie","Deegrol","Verwarmer","Weegschaal","Combi-laden")
	Set tmpAr("HG_VLaden")=$LB("BOXSIDE","Koken","ORGALUX-tray","Voorraad","Brood","Flessen","Combi-voorraadladen","Borden","Afval")
	Set tmpAr("HG_Laden;HG_VLaden")=$LB("Antislipmatten","Nuttige producten")
	Set PT=""
	For  Set PT=$O(tmpAr(PT)) Quit:(PT="")  Do
	. Set tmpLB=tmpAr(PT)
	. For i=1:1:$LL(tmpLB) Set:($L($LG(tmpLB,i))) arLU($LI(tmpLB,i))=PT
	Quit
okmGetProdType(PRNr)
	; Ophalen van de Interne Waarde van de "Sleutel"
	Set DataID=PRNr_"||"_GroepID_"||ProductType"
	&sql(SELECT Waarden INTO :lbWaarden FROM Prod_Kenmerk.DataDefinitie WHERE (ID=:DataID))
	Quit $LG(lbWaarden,1)
 */
 
 
TM(cls,mth) 
#define IsClassMethod(%cls,%mth)       $$$METHclassmethod($$$MGINFO,%cls,%mth)
#define IsMethod(%cls,%mth)            ($$$METHid($$$MGINFO,%cls,%mth)>0)
#define IsWebMethod(%cls,%mth)         $$$METHwebmethod($$$MGINFO,%cls,%mth)
 w $$$IsClassMethod(cls,mth)_"  mth:"_$$$IsMethod(cls,mth)_"  Web mth:"_$$$IsWebMethod(cls,mth)
 Quit
 
 
MultiParam(Args...)
 w "Via ...: $D()="_$D(Args), ! , $$$ArrayTT("Args"),!,!
 Do MultiParamViaArray(.Args)
 Quit
MultiParamViaArray(arArgs)
 w "Via Array: $D()="_$D(arArgs), !, $$$ArrayTT("arArgs"),!
 Quit
 
 
 
	/// CSP-RULE : verwerken van de Child-tags
RenderElement(el)
 Quit:('$G(el))
   ;d WL^vhDBG("Tag="_el.TagName)
 New sc,i
 Set sc=el.RenderStartTag()
 If sc=$$$PROCESSCHILDREN Do
 . For i=1:1:el.Children.Count() Do RenderElement(el.Children.GetAt(i))
 Set sc=el.RenderEndTag()
 Quit 
 
 
ImportOLType(PRNr,pdlLTs,pldLTdef)
	Quit:($G(PRNr)="") ""
	Quit:('$IsValidNum(PRNr)) "PRNr expected numeric."
	Set %ClientIP="192.168.1.97"
	  ;d WL^vhDBG("test:"_$G(PRNr))
	New GroepID,Kenmerk,lstWaarde,i,Param
	Set GroepID="OL"
	Set Kenmerk="LadeType"
	// N_ZR;M_ZR;B_ER;D_ER;D_DR;D_BD;D_BC;D_BZ;K_ZR;C_ER;MZ_ZR;BZ_ER;DZ_ER;DZ_DR;DZ_BD;DZ_BC;DZ_BZ;KZ_ZR;CZ_ER
 
	Set lstWaarde=""
	For i=1:1:$L(pldLTdef,";") Do:($P(pdlLTs,";",i)'="")
	. Set lstWaarde=lstWaarde_";"_$P(pldLTdef,";",i)
	Set:($E(lstWaarde,1)=";") $E(lstWaarde,1)=""
	  d WL^vhDBG("test:"_$G(PRNr))   ; _"   lstW:"_lstWaarde)
	Set Param=GroepID_"\"_Kenmerk_"\"_PRNr_"\"_lstWaarde
	Set DDefID=PRNr_"||"_GroepID_"||"_Kenmerk
	Do ##class(Prod.Kenmerk.DataDefinitie).%DeleteId(DDefID)
	;Do ##class(Prod.Kenmerk.DataIndex).DeleteWaarden(GroepID,Kenmerk,PRNr)
	Quit ##class(Prod.Kenmerk.DataDefinitie).NewObjectViaList(Param)
	Quit 1
 
 
CoCom()
	// Conditional compilation 
	//  INT-code depends on the Server(Name) where the code is compiled.
	New ComputerName
	Set ComputerName=$ZCVT($ZUTIL(110),"U")   ; $ZCVT($G(ComputerName,$ZUTIL(110)),"U")
	Write "Computer: "_ComputerName,!
#If $ZCVT($ZUTIL(110),"U")="CACHE02"
	Write "The Develop Server is "_ComputerName
#ElseIf $ZCVT($ZUTIL(110),"U")="CACHE01"
	Write "The ""HALUX"" Server is "_ComputerName
#ElseIf $ZCVT($ZUTIL(110),"U")="WWW01"
	Write "The WebServer is "_ComputerName
#ElseIf $Get(^Country,0)="England" 
	Write "The capital is London."
#ElseIf $Get(^Country,"FR")="FR"
	Write "The capital is Paris."
#Else 
	Write "The capital Tallinn."
#EndIf
	Write "Fixed text."
	Quit
 
 
TestURL(sURL,ServName,ServPort)
	Set sURL=$G(sURL,"http://192.168.1.67/csp/hadev/TBoxCSP/TandemboxWizard.csp")
    Set ServName=$G(ServName,"192.168.1.67")
    Set ServPort=$G(ServPort,"80")
 
    Set PageURL=sURL
    Set PageDomain=$P($P(PageURL,"://",2),"/",1)
    Set SubPath=PageURL
    Set:($L(PageDomain)) SubPath=$P(PageURL,PageDomain,2)
	Set SubPath=$P(SubPath,"/",1,$L(SubPath,"/")-1)
    Set:(ServName="") ServName="res.vanhoecke.be"
    Set:(ServPort'=80) ServName=ServName_":"_ServPort
    
    w "sURL      :"_sURL,!
    w "PageDomain:"_PageDomain,!
    w "SubPath   :"_SubPath,!
    w "new       :"_"http://"_ServName_SubPath_"/"_"TandemboxOrder.csp?WSID=",!
    
	/*
    Set PageURL=%request.URL
    Set PageDomain=$P($P(PageURL,"://",2),"/",1)
    Set SubPath=$P(PageURL,PageDomain,2)
    Set ServName=$G(%request.CgiEnvs("SERVER_NAME"))
    Set ServPort=$G(%request.CgiEnvs("SERVER_PORT"),80)
    Set:(ServName="") ServName="res.vanhoecke.be"
    Set:(ServPort'=80) ServName=ServName_":"_ServPort
    
	<PRE>
	<SCRIPT language="Cache" runat="server">
		m tmpRqCgi=%request.CgiEnvs 
		zw tmpRqCgi
		Set PageURL=$G(%request.CgiEnvs("HTTP_REFERER"),"")
		Set PageURL2=%request.URL
    	Set PageDomain=$P($P(PageURL,"://",2),"/",1)   
		w "url ="_PageURL,!
		w "url2="_PageURL2,!
		w "dm  ="_PageDomain,!
	</SCRIPT>
	</PRE>
    
    */
    Quit
 
TestOref
#Include %occInclude
 Set QHandle=""
 Set QHandle=$zobjnext(QHandle)
 ;w QHandle_" -> "_$$$objOrefToInt(QHandle)
 ;w $$$ObjOref(5)
  quit	
 New QHandle,Row
 Set QHandle=""
 For  Set QHandle=$zobjnext(QHandle) Quit:(QHandle=$$$SYSFUNCNULLOREF)  Do
 . Set Row=$LB($$$objOrefToInt(QHandle),QHandle.%ClassName(1))
 Quit
 
RWSORD
	Do RepairWSOrdData
	Quit
RepairWSOrdData
	  s:('$D(ClientIP)) ClientIP="192.168.1.97"
	New sDomein,ClientHostIP,arRepair,tmpAr,i
#If $ZCVT($ZUTIL(110),"U")="WWW01"
	Set sDomein="www.tandem-box.com"
	Set ClientHostIP="192.168.1.%"
#Else 
	Set sDomein="192.168.1.67"
	Set ClientHostIP="192.168.1x.%"
#EndIf
 
 /*
  // Domain VHEPN
	(LogT.WSOrderID>0) and (LogT.Domein=:sDomein) and (not LogT.KlantNr is null) 
     			and ((LogT.Actie = 'WIZARD_CALC')or(LogT.Actie || LogT.WizardMode = 'MAINPAGECOMPLETE')) 
     			and (LogT.LogTime like '2004-%') and (not LogT.ClientHost like :ClientHostIP)
     			and (LogT.WSOrderID=OrdHfd.ID) and (OrdHfd.KLNummer is null) 
 
  // Domain HEIN
	(LogT.WSOrderID>0) and (LogT.WSOrderID=OrdHfd.ID) and (LogT.Domein='tbx.tandem-box.de') 
     			and ((LogT.Actie = 'WIZARD_CALC')or(LogT.Actie || LogT.WizardMode = 'MAINPAGECOMPLETE')) 
     			and (LogT.LogTime like '2004-%') and (not LogT.ClientHost like :ClientHostIP)
     			and (not (OrdHfd.IngaveTijdStip like '2004-%'))
 */
 
 
#If $ZCVT($ZUTIL(110),"U")'="CACHE01"
	&SQL(DECLARE crsRWS CURSOR FOR 
	      SELECT OrdHfd.ID, OrdHfd.IngaveTijdStip, OrdHfd.KLNaam, OrdHfd.KLNummer, LogT.KlantNr
		  INTO :tmpAr("wsID"), :tmpAr("OrdTime"), :tmpAr("KLNaam"), :tmpAr("KLNr"), :tmpAr("LogKLNr")
		  FROM WS_TBX.WebOrder OrdHfd, DW_WWW.SysLogTBX LogT
		  WHERE (LogT.WSOrderID>0) and (LogT.Domein=:sDomein) and (not LogT.KlantNr is null) 
     			and ((LogT.Actie = 'WIZARD_CALC')or(LogT.Actie || LogT.WizardMode = 'MAINPAGECOMPLETE')) 
     			and (LogT.LogTime like '2004-%') and (not LogT.ClientHost like :ClientHostIP)
     			and (LogT.WSOrderID=OrdHfd.ID) and (OrdHfd.KLNummer is null) 
		  GROUP BY OrdHfd.ID
		  ORDER BY OrdHfd.ID
	)
	&SQL(OPEN crsRWS)
	Set i=0
	For  &SQL(FETCH crsRWS) Quit:(SQLCODE)  Do rwsBuildRepairArray
	&SQL(CLOSE crsRWS)
	  d WL^vhDBG($$$ArrayTT("arRepair"))
	Set i=""
	For  Set i=$O(arRepair("WS",i)) Quit:(i="")  Do rwsRepairViaNode(i)	
#EndIf
	Quit
rwsBuildRepairArray
	Set i=i+1
	Merge arRepair("WS",i)=tmpAr
	Kill tmpAr
	Quit
rwsRepairViaNode(i)
#define DateZDT(%v)   $S(%v?5N1","1.5N:$ZDT(%v,3), 1:%v)
	New WSOrd,arFullDataOrig,arFullDataNew,nd,wsID,dbgMsg,sc
	Set wsID=$G(arRepair("WS",i,"wsID"))
	Quit:(wsID="")
	If ##class(WS.TBX.Order).%ExistsId(wsID) Set WSOrd=##class(WS.TBX.Order).%OpenId(wsID)
	Else  Quit
	Set arFullDataNew("KLT","IngaveTijdStip")=$$$DateZDT(arRepair("WS",i,"OrdTime"))
	Set arFullDataNew("KLT","KLNummer")=$G(arRepair("WS",i,"LogKLNr"))
	Set arFullDataNew("KLT","TotAantal")=$$rwsSumQty(WSOrd)
	Do WSOrd.DataArrayFromWS(.arFullDataOrig)
	For nd="ID","IngaveTijdStip","KLNummer","TotAantal","TotPrijs" Do
	. Merge arFullDataNew("TMP","KLT",nd)=arFullDataOrig("KLT",nd)
	Set dbgMsg="New values for ID :"_wsID
	w !,dbgMsg_$$$ArrayTT("arFullDataNew")   ; $Na(arFullDataNew("KLT"))   ; arFullDataOrig
	d WL^vhDBG(dbgMsg_$$$ArrayTT("arFullDataNew"))   ; arFullDataOrig)
	Set WSOrd.KLNummer=arFullDataNew("KLT","KLNummer")
	Set WSOrd.IngaveTijdStip=arFullDataNew("KLT","IngaveTijdStip")
	Set WSOrd.TotAantal=arFullDataNew("KLT","TotAantal")
	;Set sc=WSOrd.%Save()
	Write !,$S($D(sc):$E(sc,1)_"  "_$$ParseStatus^vhLib(sc), 1:""),!
	Quit
rwsSumQty(WSOrd)
	Quit:('$G(WSOrd)) ""
	New SomAant,WSLn
	Set SomAant=0
	Set i=""
	For  Set WSLn=WSOrd.Lijnen.GetNext(.i) Quit:(i="")  Do
	. Set:(WSLn.KostPrijs'="ERROR") SomAant=SomAant+WSLn.Qty
	Quit $S(SomAant>0:SomAant, 1:"")
 
  
StatTBXUpg(Ref)
#define TRIM(%v)   $ZSTRIP(%v,"<>w")
	New arLog,tmpAr,ProdID,KP1,KP2,MK1,MK2,Nd,Cnt
	Merge arLog=@Ref
	Kill ^wvStatTBX
	Set Cnt=""
	Set ProdID=""
	For  Set ProdID=$O(arLog(ProdID)) Quit:(ProdID="")  Do
	. Kill tmpAr
	. Merge tmpAr=arLog(ProdID)
	. Set Cnt=Cnt+1
	. Set KP1=+$$$TRIM($TR($P(tmpAr(2),"kostprijs",2),":",""))
	. Set KP2=+$$$TRIM($TR($P(tmpAr(4),"kostprijs",2),":",""))
	. Set MK1=+$$$TRIM($TR($P(tmpAr(2),"MaakKost",2),":",""))
	. Set MK2=+$$$TRIM($TR($P(tmpAr(4),"MaakKost",2),":",""))
	. Set Nd=0
	. Set:(KP1'=KP2) Nd=Nd+1
	. Set:(MK1'=MK2) Nd=Nd+2
	. Set SubNd=$S(Nd=0:"=", $$stuCalcPct(KP1,KP2)>0.01:">>", 1:"=%")
	. Set ^wvStatTBX(Nd,SubNd,ProdID,1)=$J((+$P(tmpAr(1),"Staffel=",2)),3)_" / "_$S(Nd=0:"", 1:$J(" ",25))_tmpAr(3)_$S(Nd#2=0:" / "_KP1, 1:"")_$S(Nd<2:" / "_MK1, 1:"")
	. Set:(KP1'=KP2) ^wvStatTBX(Nd,SubNd,ProdID,2)="KP: "_$J(KP1,0,4)_"  ==>  "_ $J(KP2,0,4)
	. Set:(MK1'=MK2) ^wvStatTBX(Nd,SubNd,ProdID,3)="MK: "_$J(MK1,0,4)_"  ==>  "_ $J(MK2,0,4)
	. Set:(Nd=3) ^wvStatTBX(Nd,SubNd,ProdID,4)="KPDiff: "_$ZAbs(KP2-KP1)_"   MKDiff"_$S((KP1-MK1)=(KP2-MK2):" = ", 1:":"_$ZAbs(MK2-MK1))
	. Set ^wvStatTBX(Nd,SubNd)=$G(^wvStatTBX(Nd,SubNd))+1
	. Set ^wvStatTBX(Nd)=$G(^wvStatTBX(Nd))+1
	
	Set ^wvStatTBX("I","CNT")=Cnt
	Set:($D(^wvStatTBX(0))) ^wvStatTBX(0,"I")="SAME"
	Set:($D(^wvStatTBX(1))) ^wvStatTBX(1,"I")="KPRS"
	Set:($D(^wvStatTBX(2))) ^wvStatTBX(2,"I")="MAAK"
	Set:($D(^wvStatTBX(3))) ^wvStatTBX(3,"I")="BOTH"
	Do stuAddSummary
	w "Output to ^wvStatTBX()",!
	Quit
stuCalcPct(Val1,Val2)
	Quit:(Val1=Val2) 0
	Quit:(Val1>Val2) (Val1-Val2)/Val1
	; Else 
	Quit (Val2-Val1)/Val2
stuAddSummary
	n i,j,p,tmpAr
	Merge tmpAr=^wvStatTBX  
	f i=0:1:3  s j="" f  s j=$O(tmpAr(i,j)) q:j=""  s p="" f  s p=$O(tmpAr(i,j,p)) q:p=""  k tmpAr(i,j,p)
	Merge ^wvStatTBX("I","SUMM")=tmpAr
	Quit
 
 
 
 /*
FixKPR
 New PRNr,Tm,GenType,GAProdID,GAObj,DosNr
 New D,Q,U   Set D="\",Q="K",U=";"
 ;Kill ^WVfixBS
 Set GAObj=""
 Set PRNr=210000   ; ""   ; 
 For  Set PRNr=$O(^KPR(PRNr),1) Quit:(PRNr="")  Do
 . Set Tm=$P($P($G(^KPR(PRNr,2)),"\",17),";",2)
 .  ;Quit:(PRNr\10'=21380)
 .  ;Quit:(PRNr'=213816)
 . Quit:(Tm="")||($H-Tm>3)
 . Set GenType=$$GENTYP^HAD(PRNr)
 . If GenType'?1(1"TBX",1"DIV\GRP",1"DIV\TLM").E Do  Quit
 ..  q
 ..  w !,PRNr
 . Set GAProdID=$P($G(^KPR(PRNr,"G")),"\",13)
 . w !,PRNr
 . w "  - #d:"_($H-Tm)
 . w "  - GenType:"_GenType
 . w "  - GAProdID:"_GAProdID
 . Quit:(GAProdID="")||('$D(^Prod.GAData.ProductD(GAProdID)))||(GAProdID<100)
 . Set GAObj=##class(Prod.GAData.Product).%OpenId(GAProdID)
 . ;Set GAObj=##class(Prod.GAData.Product).OpenWithCalc(GAProdID)
 . w "  - GAObj :"_GAObj
 . Quit:('$IsObject(GAObj))
 . Set %this=GAObj
 . Set DosNr=GAObj.Dossier
 . w "  - DosNr :"_DosNr   ; $LG($G(^Prod.GAData.ProductD(GAProdID)),6)
 . ;Do kpcHALFFAB^Prod.GAData.Product.tmpKPRCreate
 . Set ^WVfixBS("LOG",PRNr)=$LB(GenType,GAProdID,DosNr)
 . Kill %this
 . Set GAObj=""
 Quit
 */
 
 
 // ==========================================================================================================================================
 
 
 
ExportGA(ProdID)
 ; Converteert een Array naar Text
 New OutF,Ref,FName
 Set Ref="^Prod.GAData.ProductD("_ProdID_")"
 Set OutF=##class(%Library.File).%New("\\WV_W2K\C$\Wim\wvExport_GA"_ProdID_".txt")
 w OutF.Open("WSN"),!
 w "IsOpen:"_$S(OutF.IsOpen:"Open", 1:"Niks"),!
 ;Set FName=OutF.Directory_"\"_OutF.FileName
 Set FName=OutF.Name
 Do ArrayToTextW^vhLib(Ref,OutF) 
 Do OutF.%Close()
 w "Output geschreven naar bestand: "_FName
 
 ;Do DevObj.%Close()
 Quit
 
         
         
 /*
 Sequentie van commando's om snel te importeren via Caché-terminal:  
 !!! Uitvoeren in: Cache01 - HALUX !!!
 Set LC="N"
 Set fn="c:\tbx"_LC_".pcx" w "Importeren van bestand "_fn,!  do ImportTBX^WV(fn,.ipt)
 Merge ^IPCom("CS","TBX"_LC)=ipt  s t=""  f  s t=$O(^IPCom("CS",t)) q:(t="")  zw ^IPCom("CS",t,0)
 */
ImportTBX(FilePath,Rec)   ; Rec doorgeven als .local !
 ; Importeert een bestand (zoals *.PCX) in Binary-mode in de local of global Rec
#define NMaxLen   511
 Quit:($G(FilePath)="")
 New fbs,gbs,OK,i,RL
 Set fbs=##class(%FileBinaryStream).%New()
 Set OK=fbs.LinkToFile(FilePath)
 If 'OK Do  Quit
 . Write "Fout bij link to file: "_$$ParseStatus^vhLib(OK),!
 . Do fbs.%Close()
 ; bestand uitlezen
 Set Rec(0)=fbs.Size
 If Rec(0)=0 Do  Quit
 . Write "FileSize van "_fbs.CurrFile()_" is "_Rec(0),!
 Set RL=$$$NMaxLen
 Set i=0
 For  Set i=i+1 Do  Quit:(RL=-1)
 . Set Rec(i)=fbs.Read(.RL)
 . Write i_" --> "_$J(RL,5)_" bytes gelezen.",!
 Do fbs.%Close()
 Write "ImportTBX afgelopen.",!
 Quit    
 
 
CCA
 Set CheckArray(1,"GR","BASIS2")="BASIS+PROD+KOST"
 Set CheckArray(1,"SG","CALC")="INPUT+OPTIES+KENM+CALC2"
 Set CheckArray(1,"DI","PRKENM026")="PRBASIC*+PRKENM2*+PR1DIM*"
 Set CheckArray(1,"DI","PRKENM027")="PRBASIC*+PRKENM2*+PR1DIM*"
 Set CheckArray(2,"PR1DIM||1","PRNr")=5
 Set CheckArray(3,"T","KST009","OV13")=2
 Set CheckArray(3,"T","KST009","OV12")=2
 Set CheckArray(3,"T","KST009","OV13")=2
 Set CheckArray(4,"PRKENM004")="PRLALI"
 Set CheckArray(5,"PARAM034","ProgLabel")="VPCP"
 Set CheckArray(6,"VPKOO","KST010")=4
 Set CheckArray(7,"PR1DIM||1","Oms")="Z"
 Set CheckArray(7,"PR1DIM||1","PRLen")="Q"
 Set CheckArray(8,"Sub1")="ErrExec1"
 Set CheckArray(8,"Sub1","Sub2")="ErrExec2"
 Quit
 
 
WSTB
 Do WSTB^BL.PR.GA.TB.tmpDev2
 Quit
PRGA
 Do ^BL.PR.GA.TB.tmpDev
 Quit
TLM
 Do ^BL.PR.GA.TLM.tmpDev
 Quit
KMBM(Groep)   ;(Kenmerk -> BuildMeta)
 Do BuildMeta^Kenm.Basis.MetaDefinitie.LoadObjects(.Groep)
 Quit
KMRD(Groep)   ;(Kenmerk -> Remove Data)
 Do DeleteDataDef^Kenm.Basis.MetaDefinitie.LoadObjects(.Groep)
 Quit
PRBM(Groep)   ;(Prod.Kenmerk -> BuildMeta)
 Do BuildMeta^Prod.Kenmerk.MetaDefinitie.LoadObjects(.Groep)
 Quit
PRRD(Groep)   ;(Prod.Kenmerk -> Remove Data)
 Do DeleteDataDef^Prod.Kenmerk.MetaDefinitie.LoadObjects(.Groep)
 Quit
 
 
TESTRClear
 New clu,i,tmpLid,FindID
 Set clu=##class(Test.W.Club).%OpenId("C03")
 Quit:('clu)
 Do clu.Leden.Clear()
 w "SaveOK: "_clu.%Save(),!
 Do clu.%Close()
 Quit
         
TESTRFind
 New clu,i,tmpLid,FindID
 Set clu=##class(Test.W.Club).%OpenId("C03")
 Quit:('clu)
 w "Members before CLEAR : "_clu.Leden.Count(),!
 Do clu.Leden.Clear()
 ;w "SaveOK: "_clu.%Save(),!
 for i=1:1:3 do
 . Set oL=##class(Test.W.Lid).%New()
 . Set oL.Club=clu
 . Set oL.Naam="NTest"_$E(1000+i,2,4)
 . Set oL.Voornaam="VTest"_$E(1000+i,2,4)
 . Set oL.Code="TST"_$E(1000+i,2,4)
 . do oL.%Close()
 w "Members after FILL: "_clu.Leden.Count(),!
 w "SaveOK: "_clu.%Save(),!
 Do clu.%Close()
 Quit
         
TESTRFind2
 New clu,i,tmpLid,FindID
 Set clu=##class(Test.W.Club).%OpenId("C03")
 Quit:('clu)
 w "Juist geopend",!
 Do ListAllObjects^%apiOBJ()
 w "Aantal Leden before CLEAR : "_clu.Leden.Count(),!
 ;Do:(clu.Leden.Count()>0) clu.Leden.Clear()
 Do clu.Leden.Clear()
 w "Childs are removed. Swizzled refs:",!
 Do ListAllObjects^%apiOBJ()
 w "SaveOK: "_clu.%Save(),!
 Do ListAllObjects^%apiOBJ()
 for i=1:1:3 do
 . Set oL=##class(Test.W.Lid).%New()
 . Set oL.Club=clu
 . Set oL.Naam="Test"_$E(1000+i,2,4)
 . Set oL.Voornaam="VTest"_$E(1000+i,2,4)
 . Set oL.Code="TST"_$E(1000+i,2,4)
 . ;w "i="_i_"  Save:"_oL.%Save(),!
 . do oL.%Close()
 w "Na invullen van Leden:",!
 Do ListAllObjects^%apiOBJ()
 w "Aantal Leden after FILL: "_clu.Leden.Count(),!
 
 Set FindID="TST001"
 Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID))
 w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,!
 Set FindID="TST003"
 Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID))
 w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,!
 
 w "SaveOK: "_clu.%Save(),!
 
 Set FindID="TST001"
 Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID))
 w "SVD.FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,!
 Set FindID="TST003"
 Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID))
 w "SVD.FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,!
 
 Do clu.%Close()
 Quit
 
TESTRFindAgain
 New clu,i,tmpLid,FindID
 Set clu=##class(Test.W.Club).%OpenId("C03")
 Quit:('clu)
 w "Aantal Leden : "_clu.Leden.Count(),!
 
 Set FindID="TST001"
 Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID))
 w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,!
 
 Set FindID="TST004"
 Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID))
 w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,!
 
 w "SaveOK: "_clu.%Save(),!
 Do clu.%Close()
 Quit
 
 ;Set FindID="WVT"
 ;Set i=""
 ;Set tmpLid=clu.LedenGetChildAt(FindID,.i)
 ;w "Child : "_FindID_" -> i="_i_"  Oref="_tmpLid_"  Code="_$S(tmpLid:tmpLid.Code, 1:""),!
 ;Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID))
 ;w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,!
 
 
TESTREL(clu)
 New i,tmpLid,FindID
 Set FindID="WV01"
 Do clu.ClearLedenIndex()
 
 for i=101:1:120 do
 . Set oL=##class(Test.W.Lid).%New()
 . Set oL.Club=clu
 . Set oL.Naam="Test"_$E(1000+i,2,4)
 . Set oL.Voornaam="VTest"_$E(1000+i,2,4)
 . Set oL.Code="TST"_$E(1000+i,2,4)
 . ;Set sc=oL.%Save()
 . w "i="_i_"  Save:"_$$ParseStatus^vhLib($G(sc)),!
 . do oL.%Close()
 . Set oL=""
 
 Do Start^TRTimer
 for i=1:1:10000 Set CI=""  Set tmpLid=clu.LedenSmartGetByID(FindID,.CI)
 Do Stop^TRTimer
 Write !,"Test Relationship SmartGet  "_$$GetTime^TRTimer()
 
 ;Do Start^TRTimer
 ;for i=1:1:10000 Set CI=""  Set tmpLid=clu.LedenGetByID(FindID,.CI)
 ;Do Stop^TRTimer
 ;Write !,"Test Relationship Get  "_$$GetTime^TRTimer()
 
 Do Start^TRTimer
 for i=1:1:10000 Set CI=""  Set tmpLid=clu.LedenGetChildAt3(FindID,.CI)
 Do Stop^TRTimer
 Write !,"Test Relationship Get  "_$$GetTime^TRTimer()
 
 
 Do Start^TRTimer
 for i=1:1:10000 Set CI=""  Set tmpLid=clu.LedenGetChildAt(FindID,.CI)
 Do Stop^TRTimer
 Write !,"Test Relationship Get  "_$$GetTime^TRTimer()
 
 Quit
 
 
ExportXMLStream(Obj,msgNoObj)
	; Creates a New CharStream Object and fills it with the XML of the Object
	Quit:('$G(Obj)) $G(msgNoObj,"")
	New xs
	Set xs=##class(%GlobalCharacterStream).%New()
	Do Obj.XMLExportToStream(xs)
	Quit xs
 
ExportXML(Obj,msgNoObj)
	Quit:('$G(Obj)) $G(msgNoObj,"")
	New xs
	Set xs=""
	Do Obj.XMLExportToString(.xs)
	Quit xs
 
ExportXMLGAProd(Obj,msgNoObj)
	Quit:('$G(Obj)) $G(msgNoObj,"")
	New xs, sx
	Set xs=##class(%GlobalCharacterStream).%New()
	Do Obj.XMLWrite(xs,"N","","x.XSL")
	s sx=xs.Read(xs.Size)
	Set xs=""
	Quit sx
 
DEBUG(GlobalN,HoofdNode,SubNode,Waarde,UseCounter)
 New Ref,RetVal,XCmd,i
 Set GlobalN=$G(GlobalN,"^wvDEBUG")
 Set HoofdNode=$G(HoofdNode,"1")
 If $L($G(SubNode)) Do
 . If SubNode["," Do
 ..  Set XCmd="Set Ref=$Na("_GlobalN_"("_$$dbgQuoteNodes(HoofdNode_","_SubNode)_"))"
 ..  Xecute XCmd
 . Else  Do
 .. Set Ref=$Na(@GlobalN@(HoofdNode,SubNode))
 Else  Do
 . Set Ref=$Na(@GlobalN@(HoofdNode))
 ; Debug action at Node @Ref
 If Waarde="$KILL" Do
 . Kill @Ref
 Else  If +$G(UseCounter) Do
 . Set @Ref=$G(@Ref)+1
 . Set @Ref@(@Ref)=Waarde
 . Set RetVal=@Ref
 . ;Set @Ref@($O(@Ref@(""),-1)+1)=Waarde
 Else  Do
 . Set @Ref=Waarde
 Quit $G(RetVal)
 ;Quit $O(@Ref@(""),-1)
dbgQuoteNodes(Nodes)
 New Nd
 For i=1:1:$L(Nodes,",") Set Nd=$P(Nodes, ",", i) Do
 . Set:(Nd="") $P(Nodes, ",", i)="."
 . If '$IsValidNum(Nd), $E(Nd,1)'="""", $E(Nd,$L(Nd))'=""""  Set $P(Nodes,",",i)=""""_Nd_""""
 Quit Nodes
 
 
MODPROD
 New ToeNr,LijnNr,PRNr,KadID,Kadobj
 New KLNr
 ;Set KLNr=1239   ; Keller
 ;Set KLNr=2967   ; BurBidge
 ;Set KLNr=3479   ; Svedex
 ;Set KLNr=3711   ; Keukengroep TULP
 R "Geef KlantNr: ", KLNr
 W !
 Do mprKlantModProd(KLNr)
 Quit
mprKlantModProd(KLNr)
 ;Set ToeNr=""
 ;For  Set ToeNr=$O(^KTO(6332,ToeNr)) Quit:(ToeNr="")  Do
 ;. ;w "ToeNr: "_ToeNr_"   KLNr: "_$P($G(^KTO(6332,ToeNr,1)),"\",8),!
 ;. Quit:($P($G(^KTO(6332,ToeNr,1)),"\",8)'=KLNr)
 ;. ;zw ^KTO(6332,ToeNr)
 ;. Set LijnNr=100
 ;. For  Set LijnNr=$O(^KTO(6332,ToeNr,LijnNr)) Quit:(LijnNr="")  Do
 ;..  ;w "LijnNr: "_LijnNr,!
 ;..  Set PRNr=$P($G(^KTO(6332,ToeNr,LijnNr)),"\",2)
 ;..  Quit:(PRNr'?4.6N)
 ;..  Set KadID=$P($G(^HADPR("P",PRNr,"GK")),"\",13)
 Quit:('$D(^KOD(KLNr)))
 Quit:('$D(^KOD(KLNr,"F")))
 Set ToeNr=""
 For  Set ToeNr=$O(^KOD(KLNr,"F",ToeNr)) Quit:(ToeNr="")  Do
 . Set LijnNr=100
 . For  Set LijnNr=$O(^KOD(KLNr,"F",ToeNr,LijnNr)) Quit:(LijnNr="")  Do
 ..  Set PRNr=$P($G(^KOD(KLNr,"F",ToeNr,LijnNr)),"\",2)
 ..  Quit:(PRNr'?4.6N)
 ..  Set KadID=$P($G(^KPR(PRNr,"G")),"\",13)
 ..  ;
 ..  w "KLNr: "_KLNr_"   ToeNr: "_ToeNr_"   LijnNr: "_LijnNr_"   PRNr: "_PRNr_"   KadID: "_KadID,!
 ..  Quit:(KadID<1000)
 ..  Set Kadobj=##class(Prod.GADef.KaderDeur).%OpenId(KadID)
 ..  Quit:('Kadobj)
 ..  Do mprAdaptChanges(KLNr,Kadobj)
 ..  Do Kadobj.%Close()
 . w !
 Quit
mprAdaptChanges(KLNr,Kadobj)
 New emBeslag,BKey,emBor,i,blnSave
 Set blnSave=0
 If $G(KLNr)=1000 Do         ; TestKlant
 . ;
 Else  If $G(KLNr)=1239 Do   ; Keller
 . ; Boringen van 3mm ==> puntboring
 . Set BKey=""
 . For  Set emBor=Kadobj.Boringen.GetNext(.BKey)  Quit:(BKey="")  Do
 ..  Set:(emBor.BoorDiameter<3.2)&(emBor.BoorDiameter>0) blnSave=1
 ..  Set:(emBor.BoorDiameter<3.2)&(emBor.BoorDiameter>0) emBor.BoorDiameter=-emBor.BoorDiameter
 ..  W "Boring: diameter; (nieuwe) waarde :"_emBor.BoorDiameter,!
 . ;
 Else  If $G(KLNr)=2967 Do   ; Burbidge
 . ; Boringen CncID="HULS" ==> CncID="!BOR"
 . Set BKey=""
 . For  Set emBor=Kadobj.Boringen.GetNext(.BKey)  Quit:(BKey="")  Do
 ..  If emBor.CncID["HULS" Do
 ...   Set emBor.CncID="BOR"   ; previous: "!BOR"
 ...   Set emBor.AfschuinDiameter=""
 ...   Set:(emBor.BoorGlasDiameter="7") emBor.BoorGlasDiameter="5"
 ...   ;Set blnSave=1
 ...   W "Boring: diameter; (nieuwe) waarden:  BGD: "_emBor.BoorGlasDiameter_"  AD: "_emBor.AfschuinDiameter_"  CncID: "_emBor.CncID_"",!
 ..  If emBor.CncID="!BOR" Do
 ...   Set emBor.CncID="BOR"
 ...   Set blnSave=1
 ...   W "Boring: Automatisch frezen: BGD: "_emBor.BoorGlasDiameter_"  AD: "_emBor.AfschuinDiameter_"  CncID: "_emBor.CncID_"",!
 . ;
 Else  If $G(KLNr)=3479 Do   ; Svedex
 . ; Beslag "HETS" ==> "FERSSVD"
 . Set emBeslag=Kadobj.Beslag.GetAt("S")
 . If emBeslag,$E(emBeslag.BeslagGetObjectId()="5||HETS",1,7) Do
 ..  Do emBeslag.BeslagSetObjectId("5||FERSSVD")
 ..  Set blnSave=1
 ..  W "Beslag: ScharnierType aangepast; nieuwe waarde :"_emBeslag.BeslagGetObjectId(),!
 . If Kadobj.Toepassing.ItemID="VDS" Do
 ..  Set emBeslag=Kadobj.Beslag.GetAt("VC")
 ..  Quit:('emBeslag)
 ..  For i=1:1:emBeslag.Positie.Count()  w "AR voor:"_emBeslag.Positie.GetAt(i).AfstandRand  Set:(emBeslag.Positie.GetAt(i).AfstandRand'=8.8) blnSave=1  Set emBeslag.Positie.GetAt(i).AfstandRand=8.8  w "  AR na:"_emBeslag.Positie.GetAt(i).AfstandRand,!
 ..  ;Set blnSave=1
 . If Kadobj.Toepassing.ItemID="VDV" Do
 ..  Set emBeslag=Kadobj.Beslag.GetAt("VV")
 ..  Quit:('emBeslag)
 ..  For i=1:1:emBeslag.Positie.Count()  w "AR voor:"_emBeslag.Positie.GetAt(i).AfstandRand  Set:(emBeslag.Positie.GetAt(i).AfstandRand'=3.5) blnSave=1 Set emBeslag.Positie.GetAt(i).AfstandRand=3.5  w "  AR na:"_emBeslag.Positie.GetAt(i).AfstandRand,!
 ..  ;Set blnSave=1
 . ;
 Else  If $G(KLNr)=3711 Do   ; Keukengroep TULP
 . ; Boringen van 3mm ==> puntboring
 . If Kadobj.ProfType.ItemID="PBG" Do
 .. Set BKey=""
 .. For  Set emBor=Kadobj.Boringen.GetNext(.BKey)  Quit:(BKey="")  Do
 ...  Set:(emBor.BoorDiameter=5)&(emBor.BoorDiepte<0)&(emBor.AfschuinDiameter=7) blnSave=1
 ...  Set:(emBor.BoorDiameter=5)&(emBor.BoorDiepte<0)&(emBor.AfschuinDiameter=7) emBor.AfschuinDiameter=""
 ...  If 'Kadobj.ControleBoring(emBor)  Set $ECODE=",UFout bij controle,"
 ...  W "Boring: diameter: "_emBor.BoorDiameter_"  (nieuwe) waarde :"_emBor.AfschuinDiameter_"  "_emBor.CncID,!
 . ;
 
 ;w:(blnSave) Kadobj.%Save()
 w:(blnSave) " Kadobj.%Save()",!
 Quit
 
 
CreateHexTableStr
 Set ^VHHex2Bin(0)="0000"
 Set ^VHHex2Bin(1)="0001"
 Set ^VHHex2Bin(2)="0010"
 Set ^VHHex2Bin(3)="0011"
 Set ^VHHex2Bin(4)="0100"
 Set ^VHHex2Bin(5)="0101"
 Set ^VHHex2Bin(6)="0110"
 Set ^VHHex2Bin(7)="0111"
 Set ^VHHex2Bin(8)="1000"
 Set ^VHHex2Bin(9)="1001"
 Set ^VHHex2Bin("A")="1010"
 Set ^VHHex2Bin("B")="1011"
 Set ^VHHex2Bin("C")="1100"
 Set ^VHHex2Bin("D")="1101"
 Set ^VHHex2Bin("E")="1110"
 Set ^VHHex2Bin("F")="1111"
 Set ^VHHex2Bin("-")=""
 Quit
 
 
ROTATE(X,Y1,Y2)
 New Delta
 Set Delta=$ZABS(Y2-Y1)
 Quit "X1="_(X-(Delta/2))_"  X2="_(X+(Delta/2))_"  YMid="_((Y1+Y2)/2)_$C(13,10)_
         "<v:line from="""_(X-(Delta/2))_","_((Y1+Y2)/2)_""" to="""_(X+(Delta/2))_","_((Y1+Y2)/2)_""" style=""rotation:0;"" strokecolor=""black"" strokeweight=""0px"">"
 
 
FREES
 New BedDef,BedDefID,pl,bl,DestDir,XMLPath
 Set BedDefID=356   ; 165   ; 20 : PBR-ON   /  21 : PBG-ON
 Set BedDef=##CLASS(Fabr.Frees.BedDef).%OpenId(BedDefID)
 Read:('BedDef) !,"Geef BedDefID : ", BedDefID
 Write !
 Set:('BedDef)&(BedDefID>0) BedDef=##CLASS(Fabr.Frees.BedDef).%OpenId(BedDefID)
 Write:('BedDef) "Ongeldig BedDefID.  Routine wordt afgebroken.",!
 Quit:('BedDef)
 
 Set bl=##CLASS(Fabr.Frees.BedLijst).NewBedDef(BedDef)
 w "Opbouw ProfielLijst ...",!
 Set pl=##CLASS(Fabr.Frees.ProfielLijst).OpenKaderDeur(11087,999999)
 ;Set pl=##CLASS(Fabr.Frees.ProfielLijst).OpenToelevering(262328)
 Do frsTestQueryPL 
 ;Do frsTestLeggen
 Do pl.%Close()
 Do ##CLASS(Fabr.Frees.BedLijst).LookUpOrefRemove(bl)
 Do bl.%Close()
 Do BedDef.%Close()
 zw ^wvCNC("ALL")
 Quit
frsTestQueryPL
 w "Testen van de Query ""ProfielLijst"" ...",!
 New RS,Query
 Set Query="Fabr.Frees.ProfielLijst:ProfielLijst"
 Set RS=##class(%ResultSet).%New(Query)
 If 'RS Do  Quit
 . ;"Kan geen nieuwe instantie van de query '"_Query_"' maken."
 New tmpStatus
 Set tmpStatus=RS.Execute(pl,BedDefID)
 ; do DEBUG^%Serenji("labelDebug+1^"_$zn,"192.168.1.97")
 ;labelDebug
 For  Quit:('RS.Next())  Do 
 . w "test Qry"_$G(RS.Data("ID"))_"  "_$G(RS.Data("Lengte"))_"  "_$G(RS.Data("Zijde")),!
 Do RS.%Close()
 Quit
frsTestLeggen
 w "Leggen van Profielen ...",!
 New PLIndex,KalIndex
 Set PLIndex=1
  ;do DEBUG^%Serenji("labelDebug+1^"_$zn,"192.168.1.97")
 ;labelDebug
 Set KalIndex=""
 Set ProfielPlaatsbaarID=pl.ProfielPlaatsbaarID(PLIndex, .KalIndex, (+bl)_";", 0)
 
 ;Do bl.ProfielLeggen(pl,1,101)
 ;Do bl.ProfielLeggen(pl,2,101,,,"AP")
 ;Do bl.ProfielLeggen(pl,3,101,,,"AP")
 ;Do bl.ProfielLeggen(pl,4,101,,,"AP")
 
 ;Do bl.ProfielLeggen(pl,20,101)
 ;Do bl.ProfielLeggen(pl,19,101,,,"AP")
 ;Do bl.ProfielLeggen(pl,17,101,2,,"AP")
 
 w "Altern.leggen: Rslt="_bl.AlternerendLeggen(pl, $LB($LB(27,10,""),$LB(28,7,"")), ""),!
 Do bl.FreesBed.GetAt(1).CNCFiles.Insert("TestXML.ANC")
 ;Do bl.XMLCreateFile(.XMLPath,,bl.CNCGetDir("TestW5"))
 ;w "XMLPath="_XMLPath,!
 
 ;w "Opbouw CNC-Prog ...",!
 ;w bl.CreateAll(pl, "4682", "TestW1", .XMLPath),!
 Quit
 
ALFAEDIT()
#define SubDir          "week08P"
 New Resl,DestinDir,ProgAll
 Set Resl=##class(Fabr.Frees.BedLijst).CNCGetDir($$$SubDir)
 Quit:($E(Resl,1)="0") Resl   ; DestinDir contains the errormessage
 Set DestinDir=Resl
 Quit:($G(DestinDir)="")
 New InF,OutF,FilePath,FileName,BaseName,ToelevNr,i
 ;R "Geef naam van het ANC-bestand: ", FileName  w !
 Set FileName="266331test.ANC"   ; "266331.ANC"   ; "7851AYR.ANC"
 Set:(FileName'[".ANC") FileName=FileName_".ANC"
 Set FilePath=##class(%Library.File).NormalizeDirectory(DestinDir)_FileName
 w "Volledig path: "_FilePath,!
 Set InF=##class(%Library.File).%New(FilePath)
 Do InF.Open("RU")
 If InF.IsOpen Do
 . Do InF.Rewind()
 . Set ProgAll=InF.Read(InF.Size)
 Else  Do
 . w "0;Kan bestand niet openen om uit te lezen: "_FilePath
 Set InF=""   ; Do InF.%Close()
 Quit:$G(ProgAll)=""
 Set FilePath=$$REPLACE^vhRtn1(FilePath,".ANC",".PPW")
 w "Creatie van .PPG bestand ...",!
 Set OutF=##class(%Library.File).%New(FilePath)
 Do OutF.Open("WSN")
 If OutF.IsOpen Do
 . Do OutF.Rewind()
 . Do OutF.Write($$aleAncFilter(ProgAll))
 . ;Do:(i=1) %this.CNCFiles.Insert(FileName)
 Else  Do
 . w "0;Kan bestand niet openen: "_FilePath
 Do OutF.%Close()
 w "Einde creatie van .PPG bestand.",!
 Quit 1
aleAncFilter(Prog)
 Do ##class(Fabr.Frees.emBed).CNCFilterANC(.Prog)
 Quit Prog
 
 
 
WFILE
 New OutF
 ;Set OutF=##class(%Library.File).%New("\\Notes01\Shared\W V\wvTEST.txt")
 Set OutF=##class(%Library.File).%New("\\Notes01\C$\Data\Private\WV\wvTEST.txt")
 ;Set OutF=##class(%Library.File).%New("\\WV_W2K\C$\Wim\wvTEST.txt")
 w OutF.Open("WSN"),!
 w "IsOpen:"_$S(OutF.IsOpen:"Open", 1:"Niks"),!
 ;Do OutF.Rewind()
 Set sTxt="Test vanuit Caché voor kalibers.  Dit mag weg.  WimV."_$C(13,10)_"Tijdstip:"_$ZDATETIME($H,4)
 Do OutF.Write(sTxt)
 Do OutF.%Close()
 Quit
 
 
WFILESTREAM   ; Parameters: (geen)
 new CStream,LinkOK,SaveOK
 New arKDtl
 Set CStream=##class(%FileCharacterStream).%New()
 Set LinkOK=CStream.LinkToFile("\\Notes01\C$\Data\Private\WV\Test.txt")
 Do:('LinkOK) MApplication.MessageBox("Link mislukt: "_$$ParseStatus^vhLib(LinkOK))
 ; Write to CharacterStream:
 ;Do ..Product.XMLWrite(CStream,"N","GAF;GAO","Format GAProduct.xsl")
 Set SaveOK=CStream.SaveStream()
 Write:('SaveOK) "Save mislukt: "_$$ParseStatus^vhLib(SaveOK)
 ;Do:('SaveOK) MApplication.MessageBox("Save mislukt: "_$$ParseStatus^vhLib(SaveOK))
 Do CStream.%Close()
 Quit
 
 
DeleteKenmData(Groep)
 New PRNr,k,Kenm,CntAll,CntMissed,CntDel,DelStatus
 Set Groep=$G(Groep,"OL")
 Set (CntAll,CntMissed,CntDel)=0
 Set PRNr=""
 w !
 For  Set PRNr=$O(^Prod.Ken.DataDefinitieD(PRNr)) Quit:(PRNr="")  Do
 . w !,PRNr
 . Set Kenm=$O(^Prod.Ken.DataDefinitieD(PRNr,Groep))
 . Quit:($P(Kenm,"||",1)'=Groep)
 . w "  in groep: "_Groep
 . Set CntAll=CntAll+1
 . Quit:($D(^KPR(PRNr)))
 . Set CntMissed=CntMissed+1
 . w !,"Volgend PRNr niet gevonden in ^KPR: "_PRNr,!
 .   ;quit
 . w "Data voor dit Product verwijderen [J/N] ? "
 . r *k,!
 . Set k=$C(k)
 . Quit:(k'="J")&&(k'="j")
 . Set DelStatus=##class(Prod.Kenmerk.DataDefinitie).DeleteViaPRNr(PRNr,$LB(Groep))
 . w "Result deleting Product "_PRNr_" : "_DelStatus_"  "_$S('DelStatus:$$ParseStatus^vhLib(DelStatus), 1:""),!
 . Set:(DelStatus) CntDel=CntDel+1
 w !,"CntAll="_CntAll_"   CntMissed="_CntMissed_"   CntDel="_CntDel
 Quit
 
DeleteKenmDataIndex
 New Groep,Kenmerk,Waarde,PRNr,ArPRNr,Kenm,CntAll,CntMissed,CntDel,DelStatus,blnPresent
 Set (CntAll,CntMissed,CntDel)=0
 Set (Groep,Kenmerk,Waarde,PRNr)=""
 For  Set Groep=$O(^Prod.Ken.DataIndexD(Groep)) Quit:Groep=""  Do
 . For  Set Kenmerk=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk)) Quit:Kenmerk=""  Do
 .. For  Set Waarde=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde)) Quit:Waarde=""  Do
 ...  For  Set PRNr=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr)) Quit:PRNr=""  Do
 ....   Do dkdDeleteIfNotPresent
 ....   ;Set ArPRNr(PRNr)=$G(ArPRNr(PRNr))+1
 ....   ;Set ArPRNr(PRNr,ArPRNr(PRNr))=$LB(Groep,Kenmerk,Waarde)
 
 ; ArPRNr alfopen en van de niet-bestaande producten de DataIndexen verwijderen
 Set PRNr=""
 For  Set PRNr=$O(ArPRNr(PRNr)) Quit:PRNr=""  Do
 . Do dkdDeleteIfNotPresent
 Quit
dkdDeleteIfNotPresent
 ;w !,PRNr
 If '$D(^Prod.Ken.DataDefinitieD(PRNr)) Do
 . w !,PRNr
 . w " niet gevonden in DataDefinitie",!
 . w "Kill "_$name(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr))_"",!
 . Kill ^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr)
 . ;Do dkdDeleteAllIndexen(PRNr)
 Else  Do
 . Set blnPresent=($D(^KPR(PRNr))>0)
 . Quit:(blnPresent)   ; bestaand product met DataDefinities
 . w !,PRNr
 . w " --> eerst DataDefinities verwijderen",!
 Quit
dkdDeleteAllIndexen(PRNr)
  quit
 New Groep,Kenmerk,Waarde
 Set (Groep,Kenmerk,Waarde)=""
 For  Set Groep=$O(^Prod.Ken.DataIndexD(Groep)) Quit:Groep=""  Do
 . For  Set Kenmerk=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk)) Quit:Kenmerk=""  Do
 .. For  Set Waarde=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde)) Quit:Waarde=""  Do
 ...  Kill ^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr)
 
 
 
 /*
FixTemplateUsed()
	New KadID,PICode,tmpID,tmpCode
	&sql(DECLARE crsTP cursor for SELECT KD.ID,TP.PICode INTO :KadID, :PICode FROM Prod_GADef.KaderDeur As KD, Res_PI.TemplateKader As TP
  		WHERE (KD.ID = TP.GADefTemplate) and ((TP.PICode <> KD.TemplateUsed) or (KD.TemplateUsed is null))
  		ORDER BY KD.ID)
  	&sql(OPEN crsTP)
	For  &sql(FETCH crsTP) Quit:SQLCODE  Do:($L($G(KadID)))&&($L($G(PICode))) ftuSetTPCode(KadID,PICode)
	&sql(CLOSE crsTP)
	Quit
ftuSetTPCode(KadID,PICode)
	Quit:$G(KadID)=""
	&sql(UPDATE Prod_GADef.KaderDeur SET TemplateUsed=:PICode WHERE ID=:KadID)
	w "Updated ID"_KadID,!
	Kill tmpID,tmpCode
	&sql(SELECT ID,TemplateUsed INTO :tmpID, :tmpCode FROM Prod_GADef.KaderDeur WHERE ID=:KadID)
  	w tmpID_"  "_$G(tmpCode),!
   	Quit
  
  ; Full SQL-statement
SELECT KD.ID, TP.Sort, TP.PICode, TP.Klant, Breedte, Hoogte, KD.TemplateUsed, WijzigTijdStip, ProfType, Toepassing, OphangPlaats, Vulling_Vulling, Product, TemplateRoutine
  FROM Prod_GADef.KaderDeur As KD, Res_PI.TemplateKader As TP
  WHERE KD.ID = TP.GADefTemplate
  ORDER BY KD.ID
 */