#include %occInclude
#include Prod.Product
 
 
Ninka
	Set Dev=0
	
	S PRNr=""
	For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
	. Quit:$$$PRGet($$$NONAktief)=1
	. Quit:'$D(^KPR(PRNr,"J6118"))
	. Set KortT=$P(^KPR(PRNr,0),"\")
	. Set Prijs=$$$PRGet($$$SchaduwPPL)
	. Set Rec=^|"REM-ADMIN1"|KPR(PRNr,2)
	. Write PRNr," ",$P(^KPR(PRNr,0),"\"),"   ",$P(Rec,"\",3),"->",Prijs,! 
	. Set $P(Rec,"\",3)=Prijs
	. Set ^|"REM-ADMIN1"|KPR(PRNr,2)=Rec
	. ;Do $$$PRSet($$$SchaduwPPL,SPrijs)
	Quit
 
 
 
 
AYA(Server)
	Set wsOptimizer=##class(WS.Prod.PanOpti.OptimizerBindingPanOptimizerWS).%New()
 
	Set lbLocs=$LB("http://Optibox/PanOptimizerWS","http://OptiboxBig/PanOptimizerWS")
    Do wsOptimizer.SetLocation($LI(lbLocs,Server))
    Write wsOptimizer.AreYouAlive()
	Q
 
 
 
TBX
	Do ##class(BL.Prod.OptiBox.Optimize).Instantiate()
	Do ##class(BL.PPS.TBX.OptiBox).Instantiate()
	d %blPPSTBXOptiBox.GetV1Params(350615,1,.Params)
	zw Params
	q
 
 
  
	Set String="Hoogte+10"
	w !,"result:"_$$Parser(String)
 
	q
Test
	Set %blOptiData=##class(BL.Prod.OptiBox.BoxData).%New()
	Set pxData=##class(BL.Prod.OptiBox.pxBoxData).%New()
	Set pxData.ObjType="TEST"
	Set pxData.ObjRef="PV"
	Set pxData.CutOrder=1
	Set pxData.Positie=""
	Set pxData.Rotatie=""
	Set pxData.Plaatsing=""
	Set pxData.PassThrough=""
	Set pxData.Hoogte="Breedte+4"
	Set pxData.Breedte="Hoogte+10"
	Set pxData.Diepte=6
	Set pxData.Aantal=5
	Set pxData.MaxCombinAantal=4
 
	;Param list proxy
	Set pxParam=##class(BL.Prod.OptiBox.pxemDataParam).%New()
	Set pxParam.ID=1
	Set pxParam.Waarde="Hoogte+(Aantal*4)"
	Do pxData.Params.Insert(pxParam)
 	
 	Set %blOptiData.oData=##class(Prod.OptiBox.BoxData).%New()
 	Do %blOptiData.ProxyToData(pxData)
 	
 	Set Params("Hoogte")=15
 	Set Params("Breedte")=30
 	Set Params("Diepte")=60
 	Set Params("Aantal")=2
 	
 	Do DumpObject^%apiOBJ(%blOptiData.oData)
 	zw Params
 
	Set pxData2=%blOptiData.DataToProxy(.Params)
 	
  	Do DumpObject^%apiOBJ(pxData2)
 
	Q
Parser(String)
	New Point,Result,Label,Start,End,LastPoint
	Set Point=1
	Set Result=""
	Set LastPoint=1
	For  Do  Quit:$E(String,Point)=""
	. If $E(String,Point)=""""  For  Quit:$E(String,$I(Point))=""""  Quit:$E(String,Point)="" ; String
	. Else  If $E(String,Point)="$"  Set:$E(String,Point+1)="$" Point=Point+1 For  Quit:$E(String,$I(Point))'?1(1A,1N)  Quit:$E(String,Point)="" ; Function
	. Else  If $E(String,Point)?1A Do ; variable
	. . Set Start=Point
	. . For  Quit:$E(String,$I(Point))'?1(1A,1N)  Quit:$E(String,Point)="" ; String
	. . Set End=Point-$S($E(String,Point)="":0,1:1)
	. . Set Label=$E(String,Start,End)
	. . ;w !,LastPoint," ",Start," ",End," ",Label," ",Result
	. . Set:LastPoint'>(Start-1) Result=Result_$E(String,LastPoint,Start-1)
	. . Set Result=Result_"Locals("""_Label_""")"
	. . Set LastPoint=Point
	. Else  Set Point=Point+1
	. ;w !,Result," ",LastPoint," ",Point
	Set:LastPoint'>(Point-1) Result=Result_$E(String,LastPoint,Point-1)
	Quit Result
 
 
SAX
	s String="<TXT>Eerste &lt;deel<br/>tweede <b>deel</b>nog iets</TXT>"
	
	Set sc=##class(%XML.TextReader).ParseString(String,.Reader)
	
	Set writer=##class(%XML.Writer).%New()
	Set writer.NoXMLDeclaration=1
	Set writer.Indent=1
	Set sc=writer.OutputToDevice() w $$ParseStatus^vhLib(sc) ; ;Quit:$$$ISERR(sc) sc
	Set writer.Charset="UTF-8"
	
	Do Reader.Read()
	Set RootElement=Reader.Name
	set sc=writer.RootElement("MEMO")
	For  Quit:'Reader.Read()  Do  Quit:Reader.Name=RootElement  Quit:$$$ISERR(sc)
 	. ;W !,"Name:"_Reader.Name," Value:",Reader.Value," Path:",Reader.Path," NodeType:",Reader.NodeType," EmptyElement:",Reader.IsEmptyElement,"->"
	. If (Reader.NodeType="endelement")&&(Reader.Name=RootElement)  
 	. Else  If Reader.NodeType="element" set sc=writer.Element(Reader.Name)
 	. Else  If Reader.NodeType="endelement" set sc=writer.EndElement()
 	. Else  If Reader.NodeType="chars" set sc=writer.WriteChars(Reader.Value)
	set sc=writer.EndRootElement()
	 w $$ParseStatus^vhLib(sc)
	 ;Quit:$$$ISERR(sc) sc
	 ;Quit $$$OK ;string
	Q
 
 
Vertaling2XML(Grp)
	Set Grp="DOC"
	
	&sql(DECLARE Vert2XML CURSOR FOR
	Select Intern,Taal,Vertaling 
	into :Intern,:Taal,:Vertaling 
	from Res.Vertaling 
	where Groep=:Grp)
 
	set writer=##class(%XML.Writer).%New()
	set writer.Charset="UTF-8"
	set sc=writer.OutputToFile("\\Notes01\shared\P V\Vertaling"_Grp_".xml")
	Write sc	
	s sc=writer.RootElement("textresources")
	Set InternMem=""
	
	&sql(OPEN Vert2XML)
 
 
 	For  &sql(FETCH Vert2XML) Quit:SQLCODE  Do
 	. If InternMem'=Intern Do
 	. . If InternMem'="" Do
 	. . . s sc=writer.EndElement()
	. . s sc=writer.Element("text")
	. . s sc=writer.WriteAttribute("id",Intern)
	. . s InternMem=Intern
	. s sc=writer.Element(Taal)
	. s sc=writer.Write(Vertaling)
	. s sc=writer.EndElement()	
 
	s:InternMem'="" sc=writer.EndElement()
	
	&sql(CLOSE Vert2XML)
	
	 s sc=writer.EndRootElement()
	 s sc=writer.EndDocument()
	Quit
 
#include Prod.Product
 q
Agenda
	For Dat=60395:1:60395 Do
	. Kill ^|"REM-ADMIN1"|Derde.Agenda.AgendaD(22,Dat)
	. M ^|"REM-ADMIN1"|Derde.Agenda.AgendaD(22,Dat)=^|"TEMPPV"|Derde.Agenda.AgendaD(22,Dat)
 q
 
#include Prod.Product
 
	;Set Dev=$$OPEN^vhDEV(,"CCEMPTY.TXT","W")
	;use Dev
	Set BeginDatum=$$INTDATE^vhDTyp("01/07/05")
	Set EndDatum=999999999 ;$$INTDATE^vhDTyp("15/11/05")
	Set PRNr=""
	Set MemDatum=""
	Set DagEmpty=0
	Set ManUpdate=0
	Set InsCnt=0
	Set MaxCnt=0
	For  Set PRNr=$O(^PRHIST(PRNr)) Quit:PRNr=""  Do
	. Lock +^PRHIST(PRNr) Write "."
	. Set VolgNr=""
	. For  Set VolgNr=$O(^PRHIST(PRNr,VolgNr)) Quit:VolgNr=""  Do
	. .  Set RecH=^PRHIST(PRNr,VolgNr)
	. .  Set Datum=+RecH
	. .  If Datum'=MemDatum Do
	. .  . ;Write MemDatum," ",PRNr," ",DagEmpty," ",ManUpdate,!
	. .  . If DagEmpty>ManUpdate Set InsCnt=InsCnt+DagEmpty-ManUpdate
	. .  . Set MaxCnt=MaxCnt+DagEmpty
	. .  . Do:DagEmpty>ManUpdate InsertEmpty(MemDatum, PRNr,DagEmpty-ManUpdate,MemVolgNr,.VolgNr)
	. .  . Set MemDatum=Datum
	. .  . Set DagEmpty=0
	. .  . Set ManUpdate=0
	. .  Set MemVolgNr=VolgNr
	. .  Quit:Datum<BeginDatum
	. .  Quit:Datum>EndDatum
	. .  Quit:$P(RecH,D,5)'="M" ; magazijn
	. .  Set:$P(RecH,D,4)="M"||($P(RecH,D,4)="E") ManUpdate=ManUpdate+1
	. .  Quit:$P(RecH,D,4)'="U" ; picking
	. .  Set Picking=0
	. .  Set SubLijn=""
	. .  For  Set SubLijn=$O(^PRHIST(PRNr,VolgNr,SubLijn)) Quit:SubLijn=""  Do
	. .  . Set SubRec=^PRHIST(PRNr,VolgNr,SubLijn)
	. .  . Set:$P(SubRec,D,5)>15000000&&($P(SubRec,D,5)<20000000) Picking=Picking+1
	. .  Set:Picking>1 DagEmpty=DagEmpty+Picking-1
	. ;Write MemDatum," ",PRNr," ",DagEmpty," ",ManUpdate,!
	. Do:DagEmpty>ManUpdate InsertEmpty(MemDatum, PRNr,DagEmpty-ManUpdate,MemVolgNr,.VolgNr)
	. Set MemDatum=""
	. Set DagEmpty=0
	. Set ManUpdate=0
	. Lock -^PRHIST(PRNr)
 
 	;close Dev
 	
InsertEmpty(Datum,Product,Aantal,MemVolgNr,VolgNr)
	New J,NewNr,Rec
	Write $$EXTDATE^vhDTyp(Datum),*9,PRNr,*9,$P($G(^KPR(PRNr,0)),D),*9,Aantal,*9,MemVolgNr,*9,VolgNr,!
	
	Quit:Aantal<1
	; Gap
	Set J=""
	For  Set J=$O(^PRHIST(PRNr,J),-1) Quit:J<MemVolgNr  Do
	. Merge ^PRHIST(PRNr,J+Aantal)=^PRHIST(PRNr,J)
	. Kill ^PRHIST(PRNr,J)
	For J=1:1:Aantal Do
	. Set NewNr=MemVolgNr+J-1
	. Set Rec=Datum_",0)\0\\E\M\\\\"_Datum_"\\C/C empty\\\\\"
	. Set ^PRHIST(PRNr,NewNr)=Rec
	Set:VolgNr VolgNr=VolgNr+Aantal
	Quit
		
Geo
	Set BL=##class(BL.Derde.Agenda.GeoMobile).%New()
	D BL.Initialize(11)
	d BL.BLAgenda.DeleteVanafDag(60037)
	r "wait",K
	d BL.GeoData2Agenda(60037)
	Quit
 
 
 
 
 
GetStock(PRNr,Type)
	Quit:PRNr'?4.7N "N/A"
	Quit $P($G(^PRSTOCK("D",PRNr)),"\",$S(Type?.2N:Type,Type="W":5,Type="HF":10,1:1))
	Q
WVOpNul
	Set PRNr=0
	s K=""
	s CUserId=17
	For  Set PRNr=$O(^PRSTOCK("D",PRNr)) Quit:PRNr=""  Do  Quit:K="-"
	. If '$D(^KPR(PRNr)) Do  Quit
	. . Write PRNr," stock verwijderen product bestaat niet meer (druk op enter)" R K
	. . Kill ^PRSTOCK("D",PRNr)
	. Quit:'+$P(^PRSTOCK("D",PRNr),D,5)
	. w PRNr,! ;r K Q:K="-"
	. Do STORE^PRSTOCK("W","M",PRNr,-$P(^PRSTOCK("D",PRNr),D,5),"INV 2004")
	. ;W PRNr,! r K
	Q
		
KOFKL
	Set BeginDat=$$CALCDATE^vhDTyp($H,"M",-2,"FD")
	Set KLNr=0
	Set OFFNr=""
	For  Set KLNr=$O(^KOFKL(KLNr)) Quit:KLNr=""  Do
	. For  Set OFFNr=$O(^KOFKL(KLNr,"F",OFFNr)) Quit:OFFNr=""  Do
	. . Set Date=$$INTDATE^vhDTyp($P(^KOFKL(KLNr,"F",OFFNr,1),D,2))
	. . W KLNr," ",OFFNr," ",$P(^KOFKL(KLNr,"F",OFFNr,1),D,2),!
	. . If Date<BeginDat Do 
	. . . ;r K
	. . . Set $P(^KOFKL(KLNr,"F",OFFNr,1),D,28)="Z"
	. . . Set $P(^KOFKL(KLNr,"F",OFFNr,1),D,29)=$H
	Quit
	
DELTBXUITZ
	Set NoSa="S"
	Set KLNr=0
	Set (HG,GR,SG,PRNr,VolgNr)="" 
	For  Set KLNr=$O(^KLPUTZ(NoSa,KLNr)) Quit:KLNr=""  Do:KLNr'=1239
	. For  Set HG=$O(^KLPUTZ(NoSa,KLNr,HG)) Quit:HG=""  Do
	. . For  Set GR=$O(^KLPUTZ(NoSa,KLNr,HG,GR)) Quit:GR=""  Do
	. . . For  Set SG=$O(^KLPUTZ(NoSa,KLNr,HG,GR,SG)) Quit:SG=""  Do
	. . . . For  Set PRNr=$O(^KLPUTZ(NoSa,KLNr,HG,GR,SG,PRNr)) Quit:PRNr=""  Do
	. . . . . For  Set VolgNr=$O(^KLPUTZ(NoSa,KLNr,HG,GR,SG,PRNr,VolgNr)) Quit:VolgNr=""  Do
	. . . . . . Set Rec=^(VolgNr)
	. . . . . . ;W Rec,! r K
	. . . . . . If $P(Rec,D,3)="TBX corr" Do
	. . . . . . . Kill ^KLPUTZ(NoSa,KLNr,HG,GR,SG,PRNr,VolgNr)
	. . . . . . . Kill ^KLPUTZ("I"_NoSa,HG,GR,SG,PRNr,KLNr)
	Quit
 
LIJSTVORK
 Set Dev=0 
 Set Dev=$$OPEN^vhDEV(,"VORKLIJST.TXT","W")
 Use Dev
 Write $TR("Sort;PRNr;KortTekst;CifPPL;DB;Vork;CifPPLS;DBS;VorkS",";",$C(9)),!
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 . Set RecJ=$O(^KPR(PRNr,"J"))
 . Quit:$E(RecJ)'="J"
 . Set RecJ=^KPR(PRNr,RecJ)
 . Set Vork=$P(RecJ,D,27)
 . If (+Vork=20)!(+Vork=30)  Quit
 . Set RecN=$$PRIJSGEG^KPRIJS(PRNr)
 . Set CifPPL=$P(RecN,D,6)
 . Set DB=$P(RecN,D,12)
 . Set Vork=$P(RecN,D,14)
 . Set RecS=$$PRIJSGEG^KPRIJS(PRNr,"S")
 . Set CifPPLS=$P(RecS,D,6)
 . Set DBS=$P(RecS,D,12)
 . Set VorkS=$P(RecS,D,14)
 . Write $$SORTKEY^PRODUKT(PRNr),*9,PRNr,*9,$P(^KPR(PRNr,0),D),*9,$TR(CifPPL,".",","),*9,$TR(DB,".",","),*9,$TR(Vork,".",","),*9,$TR(CifPPLS,".",","),*9,$TR(DBS,".",","),*9,$TR(VorkS,".",","),!
 Close:0'[Dev Dev
 Q
 
LIJSTPROD
 Set Dev=0 
 Set Dev=$$OPEN^vhDEV(,"ProductControleLijst.TXT","W")
 Use Dev
 Write $TR("Sort;PRNr;KortTekst;PPL;aankoopmunt;aankoopeenheid;aankoopeenheid;korting;CifPPL;firmamunt;verkoopeenheid;verkoopeenheid ;Cif%;DB;DB%;vork;vork%;lijstprijs;katprod industrie;katprod;katprod KS;LEVNr;PPL;aankoopmunt;aankoopeenheid;aankoopeenheid;korting;CifPPL;firmamunt;verkoopeenheid;verkoopeenheid ;Cif%;DB;DB%;vork;vork%;lijstprijs;katprod industrie;katprod;katprod KS;LEVNr",";",$C(9)),!
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 . Quit:$P(^KPR(PRNr,0),D,3)?4.7N
 . Set RecN=$$PRIJSGEG^KPRIJS(PRNr)
 . Set KATInd=$P(RecN,D,16)
 . Set KATHan=$P(RecN,D,17)
 . Set KATKS=$P(RecN,D,18)
 . Set RecS=$$PRIJSGEG^KPRIJS(PRNr,"S")
 . Set KATIndS=$P(RecS,D,16)
 . Set KATHanS=$P(RecS,D,17)
 . Write $$SORTKEY^PRODUKT(PRNr),*9,PRNr,*9,$P(^KPR(PRNr,0),D),*9
 . Write $TR($P(RecN,D,1,19),"\.",$C(9)_","),*9
 . Write $TR($P(RecS,D,1,18),"\.",$C(9)_","),!
 Close:0'[Dev Dev
 Q
 
LIJSTKAT
 Set Dev=0 
 Set Dev=$$OPEN^vhDEV(,"KATLIJST.TXT","W")
 Use Dev
 Write $TR("Sort;PRNr;KortTekst;Ind;Han;KS;IndS;HanS",";",$C(9)),!
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 . Set RecN=$$PRIJSGEG^KPRIJS(PRNr)
 . Set KATInd=$P(RecN,D,16)
 . Set KATHan=$P(RecN,D,17)
 . Set KATKS=$P(RecN,D,18)
 . Quit:(KATInd="")&&(KATHan="")&&(KATKS="")
 . Set RecS=$$PRIJSGEG^KPRIJS(PRNr,"S")
 . Set KATIndS=$P(RecS,D,16)
 . Set KATHanS=$P(RecS,D,17)
 . Write $$SORTKEY^PRODUKT(PRNr),*9,PRNr,*9,$P(^KPR(PRNr,0),D),*9,KATInd,*9,KATHan,*9,KATKS,*9,KATIndS,*9,KATHanS,!
 Close:0'[Dev Dev
 Q
LIJSTSOPR
 Set Dev=0 
 Set Dev=$$OPEN^vhDEV(,"SOPRLIJST.TXT","W")
 Use Dev
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 . Set IDNr=$P(^KPR(PRNr,2),D,25)
 . Set IDNr2=$E($TR(IDNr,".","")_" ",2,99)
 . Set SOPR=0
 . If ($E(IDNr)>0)&&($E(IDNr)<8) Set SOPR=1
 . Else  For I=1:1:7 If $D(^KPR2(I_IDNr2)) Set SOPR=1
 . Quit:'SOPR
 . Set Rec2=^KPR(PRNr,2)
 . Set SPPL=$P(Rec2,D,3)
 . Set SDB=$P(Rec2,D,4)
 . Set SCif=$P(Rec2,D,7)
 . Set RecS=$$PRIJSGEG^KPRIJS(PRNr,"S")
 . Set LijstPS=$P(RecS,D,15)
 . Write PRNr,*9,$P(^KPR(PRNr,0),D),*9,IDNr,*9,IDNr2,*9,$TR(SPPL,".",","),*9,$TR(SDB,".",","),*9,$TR(SCif,".",","),*9,$TR(LijstPS,".",","),!
 Close:0'[Dev Dev
 Q
LIJSTKlantNoSchaduw
	Set Dev=0 
 	Set Dev=$$OPEN^vhDEV(,"KlantNoSchaduw.txt","W")
	Use Dev
	Set KLId=0
	For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
	. Set KLNr=$P(^KKL(KLId,0),D)
	. Set KLNm=$P(^KKL(KLId,0),D,2)
	. Set PrijsKl=$P(^KKL(KLId,2),D,3)
 	. Set PrijsKlS=$P(^KKL(KLId,2),D,25)
 	. Set NonAkt=""
    . Set:$P(^KKL(KLId,2),D,10) NonAkt=1 ; non akt
    . Set:$L($P(^KKL(KLId,0),D,30)) NonAkt=1 ; non akt of verwijderd
	. Quit:PrijsKlS'=""
	. Set Omzet=$$KLANT^STAT(KLNr,0,"2003.07 ","2004.06 ",1)
	. Set Regio=$P(^KKL(KLId,0),D,20)
 
	. Write KLNr,*9,KLNm,*9,Regio,*9,NonAkt,*9,PrijsKl,*9,PrijsKlS,*9,$J(Omzet,0,0),!
	.
	Close:0'[Dev Dev
	Quit
CHANGEAllKlant
	Set KLId=0
	For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
	. Set KLNr=$P(^KKL(KLId,0),D)
	. Set PrijsKl=$P(^KKL(KLId,2),D,3)
 	. Set PrijsKlS=$P(^KKL(KLId,2),D,25)
	. If PrijsKlS="" Do
	. . Set PrijsKlS=$S(PrijsKl="P":"L",PrijsKl="L":"S",PrijsKl="S":"B",1:PrijsKl)
	. . Quit:PrijsKlS=""
	. . Write KLId," BSL ",PrijsKl,"->",PrijsKlS,!
	. . D MODFIELD^KLANT(KLNr,325,PrijsKlS) ; Schaduwprijsklasse BESLAG
	. ;
	. Set PrijsKlOL=$P(^KKL(KLId,2),D,4)
 	. Set PrijsKlOLS=$P(^KKL(KLId,2),D,24)
	. If PrijsKlOLS="",PrijsKlOL'="" Do
	. . Set PrijsKlOLS=$S(PrijsKlOL="P":"L",PrijsKlOL="L":"S",PrijsKlOL="S":"B",1:PrijsKlOL)
	. . Quit:PrijsKlOLS=""
	. . Write KLId," OL ",PrijsKlOL,"->",PrijsKlOLS,!
	. . D MODFIELD^KLANT(KLNr,324,PrijsKlOLS) ; Schaduwprijsklasse ORGALUX
	. . ;Read K
	Quit
 
CHANGEKL(KLNr,PrijsKlasse)
	New (KLNr,PrijsKlasse)
	Do 
	.New KLNr,PrijsKlasse
	.Set Q="K" D ^cA604
	.Set QU="SYS"
	Set Txt=$$UPCASE^vhRtn1(PrijsKlasse)
	If $E(Txt,1,4)'="AUTO"  Quit "N/A"
	Set PrijsKlasBSL=$E($P(PrijsKlasse," ",2))
	Set PrijsKlasOL=$E($P(PrijsKlasse,"/",2))
	If "CPLRSBG"'[PrijsKlasBSL Quit "Fout BSL"
	If "CPLRSBG"'[PrijsKlasOL Quit "Fout OL"
	If PrijsKlasOL=""!(PrijsKlasBSL="") Quit "Fout EMPTY"
	Do DELOBJ^KLPUTZ2(KLNr,"S")
	;Set ResultBSL=$$CHANGEBSL(KLNr,PrijsKlasBSL)
	;Set ResultOL=$$CHANGEOL(KLNr,PrijsKlasOL)
	Quit "DELETE" ;ResultBSL_" / "_ResultOL
		
CHANGEPRIJSLIJST(PRNr,SetReset) ; opgeroepen vanuit Excel via de Excuter
	New (PRNr,SetReset)
	Do 
	.New PRNr,SetReset
	.Set Q="K" D ^cA604
	.Set QU="SYS"
	Quit:'$D(^KPR(PRNr)) "N/A"
	Set:SetReset="S" Value=1
	Set:SetReset="R" Value=""
	Quit:'$D(Value) "ERROR"
	D MODFIELD^PRODUKT(PRNr,403,Value,1) ; PrijsLijst
	Q "Done"
	
CHANGEBSL(KLNr,PrijsKlasse) ; opgeroepen vanuit Excel via de Excuter.xla
	;Quit "Done"
	New (KLNr,PrijsKlasse)
	Do 
	.New KLNr,PrijsKlasse
	.Set Q="K" D ^cA604
	.Set QU="SYS"
	Set KLId=^KK1(KLNr)
	;Quit:$P(^KKL(KLId,2),D,10) "NONAKT" ; nonakt
	;Quit:$P(^KKL(KLId,0),D,30) "NONAKT" ; nonakt
	D MODFIELD^KLANT(KLNr,325,PrijsKlasse) ; Schaduwprijsklasse BESLAG
	Q PrijsKlasse
	
CHANGEOL(KLNr,PrijsKlasse) ; opgeroepen vanuit Excel via de Excuter.xla
	;Quit "Done"
	New (KLNr,PrijsKlasse)
	Do 
	.New KLNr,PrijsKlasse
	.Set Q="K" D ^cA604
	.Set QU="SYS"
	Set KLId=^KK1(KLNr)
	;Quit:$P(^KKL(KLId,2),D,10) "NONAKT" ; nonakt
	;Quit:$P(^KKL(KLId,0),D,30) "NONAKT" ; nonakt
	D MODFIELD^KLANT(KLNr,324,PrijsKlasse) ; Schaduwprijsklasse ORGALUX
	Q PrijsKlasse
	
ZAAD
	Set PRNr=0
	For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
	. Set KortT=$P(^KPR(PRNr,0),D) 
	. Quit:$E(KortT,1,4)'="ZAAD"
	. Set Qty=$$PROD^STAT(PRNr,0,"2003.06 ","2004.05 ",1)
	. Quit:'Qty
	. Write PRNr,*9,KortT,*9,Qty,!
	Q
 
CHANGEHALUX
	s QU="SYS"
	Set PRNr=0
	For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
	. Set KortT=$P(^KPR(PRNr,0),D) 
	. Quit:'$D(^KPR(PRNr,"J6332"))
	. ; Ophalen cif van gen. product
	. Set GenPRNr=$P(^KPR(PRNr,0),D,3)
	. Quit:GenPRNr'?4.7N
	. Quit:'$D(^KPR(GenPRNr))
	. Set Rec2=^KPR(GenPRNr,2)
	. Set DB=$P(Rec2,D,6)
	. Set Cif=$P(Rec2,D,7)
	. Set Vork=$P(Rec2,D,5)
	. If Cif="" Set Cif=$P(^KPR(GenPRNr,"J6332"),D,21)
	. ;D MODFIELD^PRODUKT(PRNr,306,DB,1) ; Schaduw DB
	. ;D MODFIELD^PRODUKT(PRNr,307,Cif,1) ; Schaduw Cif
	. D MODFIELD^PRODUKT(PRNr,305,Vork,1) ; Schaduw Vork
	. Write GenPRNr,"->",PRNr," ",KortT," DB=",DB," Cif=",Cif,!
	. ;r K
	Q
 
CHANGEPROD
	s QU="SYS"
	Set PRNr=0
	For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
	. Set KortT=$P(^KPR(PRNr,0),D) 
	. Set RecJ=$O(^KPR(PRNr,"J"))
	. Quit:$E(RecJ)'="J"
	. Set RecJ=^KPR(PRNr,RecJ)
	. Set Vork=$P(RecJ,D,27)
	. Set Rec2=^KPR(PRNr,2)
	. Set VorkS=$P(Rec2,D,5)
	. If '$$ISORGAL^ORGALUX(PRNr) Quit
	. ;If +VorkS'=36 Do  Quit
	. . Write PRNr," ",KortT, " foutieve vork ",+VorkS,!
	. Set Vork="?",DB=58
	. D MODFIELD^PRODUKT(PRNr,306,DB,1) ; Schaduw DB
	. ;D MODFIELD^PRODUKT(PRNr,305,Vork,1) ; Schaduw Vork
	. Write PRNr," ",KortT," DB=",DB," Vork=",VorkS,!
	. ;r K
	Q
	
BouwSteenRecalc
	s QU="SYS" 
	Do CTRALL^PRBSC("S","S",1) ; Schaduw prijsberekening en stockeren in schaduw PPL
	Quit
		
POM	Set PRNr=0
	For  Set PRNr=$O(^KPR(PRNr)) quit:PRNr=""  Do
	. Quit:'$D(^KPR(PRNr,"J6332"))
	. Quit:$P(^KPR(PRNr,"J6332"),D,7)'=1
	. Quit:$P($$GENTYP^HAD(PRNr),D)="PRF"
	. Quit:$P($$GENTYP^HAD(PRNr),D,1,2)'="DIV\POM"
	. Write $P(^KPR(PRNr,0),D,1), " ", $$GENTYP^HAD(PRNr),!
	. Set $P(^KPR(PRNr,"J6332"),D,7)=0
	Q
 
KFAP Set FAKNr=0
	For  Set FAKNr=$O(^KFAP("F",FAKNr)) Quit:FAKNr=""  Do
	. Set ULRef="U"
	. For  Set ULRef=$O(^KFAP("F",FAKNr,ULRef)) Quit:$E(ULRef)'="U"  Do
	. . Set ULRec=^KFAP("F",FAKNr,ULRef,1)
	. . Set FactuurType=$P(ULRec,D,25)
	. . Quit:FactuurType'="M"
	. . Set ULNr=$E(ULRef,2,99)
	. . Set LNr=99
	. . For  Set LNr=$O(^KFAP("F",FAKNr,ULRef,LNr)) Quit:LNr=""  Do
	. . . Set LRec=^KFAP("F",FAKNr,ULRef,LNr)
	. . . Set PRNr=$P(LRec,D,2)
	. . . Quit:PRNr'?4.7N
	. . . Set Qty=$P(LRec,D,3)
	. . . Set KeyJ=$O(^KPR(PRNr,"J"))
	. . . Set CifPPL=0
	. . . If $E(KeyJ)'="J" Do  ; KPRO
	. . . . Set KeyJ=$O(^KPRO(PRNr,"J"))
	. . . . Quit:$E(KeyJ)'="J"   ; KPRO
	. . . . Set CifPPL=$P(^KPRO(PRNr,KeyJ),D,23)
	. . . Else  Set CifPPL=$P(^KPR(PRNr,KeyJ),D,23)
	. . . Set Aankoop=Qty*CifPPL
	. . . Set $P(LRec,D,32)=""
	. . . Set $P(LRec,D,33)=""
	. . . Set $P(LRec,D,34)=""
	. . . If FactuurType="M" Do
	. . . . Set $P(LRec,D,33)=Aankoop
	. . . . ;Write FAKNr," ",ULRef," ",LNr," ",CifPPL," ",Qty,!,LRec,!
	. . . Set ^KFAP("F",FAKNr,ULRef,LNr)=LRec
	Q
 
 
	s Dev=$$OPEN^vhDEV(,"PVTemp.txt","W")
	 u Dev
	s p = ""
	f  s p=$o(^PVTemp(p)) q:p=""  w p,*9,$tr($P(^PVTemp(p),D,1),".",","),*9,$tr($P(^PVTemp(p),D,2),".",","),!
	c Dev
	q
MOD	s p=$$SELECT^PRODUKT6() q:'p  w p," ",$p(^KPR(p,0),"\") s $p(^KPR(p,"G"),"\",3)="PR+"
	Q
 
 
 
 
MAIL  ;(TaalSel,LandSel,ExclTyp,LimGlobRef) Set Dev=0
 ; TaalSel = N of F
 ; LandSel = "NL;BE"
 ; ExclTyp = "BH;XX" (boekhouding;diverse)
 ; LimGlobRef wordt gebruikt om te testen of een klant mag opgenomen worden in de maillijst - $D(@LimGlobRef@(KLNr))
 New %J,Dev,KLId,KLNr,KLNm,Taal,Land,Pers,Nr,Found,I,connect,Typconnect,email,Naam,Voornaam,elink
 Set Dev=0
 Set Dev=$$OPEN^vhDEV("\\notes01\shared\p v\","MailCheck.TXT","W")
 Use Dev
 Set KLId=""
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 s TCnt=0,Cnt=0
 For  Set KLId=$O(^KKL(KLId)) Quit:KLId=""  Do
 . Set KLNr=$P(^KKL(KLId,0),D)
 . If $L($G(LimGlobRef)) Quit:'$D(@LimGlobRef@(KLNr))
 . Set TCnt=TCnt+1 
 . Quit:$L($P(^KKL(KLId,0),D,30)) ; non akt of verwijderd
 . Quit:$P(^KKL(KLId,1),D,25)="Z" ; Non akt
 . Quit:$P(^KKL(KLId,1),D,25)=0 ; Non akt
 . Set Regio=$P(^KKL(KLId,0),D,20)
 . Quit:'Regio ; geen regio
 . Set KlantType=$P(^KKL(KLId,1),D,25)
 . Set Cnt=Cnt+1
 .; Quit:$P(^KKL(KLId,0),D,20)'=2 ; geen regio 2 
 .
 . Set KLNm=$P(^KKL(KLId,0),D,2)
 . Set Taal=$P(^KKL(KLId,0),D,9)
 . Set Land=$$LAND^vhRtn1(KLNr,"K",1,1)
 . Set email=$P(^KKL(KLId,2),D,19)
 . Write KLNr,*9,KLNm,*9,KlantType,*9,Regio,*9,"GEN",*9,*9,*9,email,!
 . 
 . Set Nr=""
 . For  Set Nr=$O(^PERS("K",KLNr,Nr)) Quit:Nr=""  Do
 .. Set Pers=^PERS("K",KLNr,Nr)
 .. ;Controleren of het één van de VerantwType NIET tot de ExclTyp behoort
 .. Set Typ=$P(Pers,D,5)
 .. Set email=""
 .. For I=15:1:19 Do
 ... Quit:$P(Pers,D,6) ; mail non aktief
 ... Set connect=$P(Pers,D,I)
 ... Quit:$P(connect,";")'="E"
 ... Set email=$P(connect,";",2)
 ... ;Quit:$E(email)="#" ; NOOIT versturen
 ... ;Quit:$E(email)="~" ; PROBLEEM GEVAL  niet versturen
 .. Set Naam=$P(Pers,D,2)
 .. Set VoorNaam=$P(Pers,D,3)
 .. Write KLNr,*9,KLNm,*9,KlantType,*9,Regio,*9,Typ,*9,Naam,*9,VoorNaam,*9,email,!
 Close:Dev'=0 Dev
 zw TCnt,Cnt
 Quit
 
PROFORMA
	Set Dev=$$OPEN^vhDEV(,"ProformaMachines.txt","W")
	Use Dev	
	Set List="M51P1000,MZK1000,MZK8000,MZK5000,ZMM6300,M571000"
	S PNr=0
	f  s PNr=$O(^KFAP("F",PNr)) Quit:PNr=""  Do
	. Set BONNr="U"
	. For  S BONNr=$O(^KFAP("F",PNr,BONNr)) Quit:$E(BONNr)'="U"  Do
	. . Set LNr=100
	. . For  Set LNr=$O(^KFAP("F",PNr,BONNr,LNr)) Quit:LNr=""  Do
    . . . Set Rec=^KFAP("F",PNr,BONNr,LNr)
    . . . Set PRNr=$P(Rec,D,2)
    . . . Quit:PRNr'?4.7N
    . . . Set KortTxt=$P($G(^KPR(PRNr,0)),D)
    . . . Set:KortTxt="" KortTxt=$P($G(^KPRO(PRNr,0)),D)
    . . . Quit:KortTxt=""
    . . . Set KT=$$UPTRIMAN^vhRtn1(KortTxt)
    . . . Set Found=0
    . . . For I=1:1:$L(List,",") Do  Quit:Found
    . . . . Set Key=$P(List,",",I)
    . . . . Set Found=Key=$E(KT,1,$L(Key))
	. . . Quit:'Found
	. . . Set Qty=$P(Rec,D,3)
	. . . Set PRec=^KFAP("F",PNr,0,0)
	. . . Set KLNr=$P(PRec,D,1)
	. . . Set KLId=$G(^KK1(KLNr))
	. . . Set KLNm=""
	. . . Set:$L(KLId) KLNm=$P($G(^KKL(KLId,0)),D,2)
	. . . Set Datum=$P(PRec,D,6)
	. . . Write KLNr,*9,KLNm,*9,Datum,*9,PNr,*9,KortTxt,*9,Qty,!
	close Dev
	Quit
 
 
AFDEKKAP()
	Set PRNr=0
	For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
	. Set IDNr=$P(^KPR(PRNr,2),D,25)
	. Set KortT=$P(^KPR(PRNr,0),D,1)
	. Quit:'$D(^KPR(PRNr,"J5005"))
	. Quit:KortT["*DO*"
	. Quit:KortT["*KP*"
	. s X=" 70.1503; 70.1513; 70.1563; 70.1663; 90M2103; 90M2603; 94M3603; 80.6507; 90M2103; 90M2203; 94M3203; 80.6107; 79M8103;ZAA.230N;ZAA.330C;ZAA.430C;ZAA.3500;ZAA.3700"
	. Set Found=0
	. For I=1:1:$L(X,";") Do  Quit:Found
	. .Set BeginKT=$P(X,";",I)
	. .Quit:BeginKT=""
	. .Set Found=$E(KortT,1,$L(BeginKT))=BeginKT
	. Quit:'Found
	. Write PRNr," ",KortT ,!
	. Read K
	. Quit:K'="J"
	. Do PinE24^BLPUTZ(PRNr)
	Q
 
 
 
 
PV(ELijst)   ; aanpassen van een rubriek van een product
	Set:'$G(ELijst) ELijst=12
	Set:ELijst=12 BLKLNr=212250 ; E12
	Set:ELijst=24 BLKLNr=212250 ; E24
	Set File=0
	Set File=$$OPEN^vhDEV("\\notes01\shared\p v","BLUME"_ELijst_"x.txt","W")
	Use File
	Kill Cnt
	Write $TR("SortKey;HG;GR;SG;IdentNr;KortTekst;Aantal;HPPL;HKrt;HGO;HOmzet;IC;E12PPL;E12Krt;E12GO;E12Omzet;E12Mark",";",$C(9)),!
	Set PRNr=0
	For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
	. Set IDNr=$P(^KPR(PRNr,2),D,25)
	. Set KortT=$P(^KPR(PRNr,0),D,1)
	. Quit:'$D(^KPR(PRNr,"J5005"))
	. Quit:KortT["*DO*"
	. Quit:KortT["*KP*"
	. ;use 0 write PRNr," "
	. Set BLID=0_$TR($E(IDNr,2,99),".","")
	. Set BLRec=$G(^BLProd("D",BLID))
	. Set IC=$P(BLRec,D,2)
	. Set:IC="" IC="*"
	. Set RecI=$O(^KPR(PRNr,"I"))
	. Set RecI=^KPR(PRNr,RecI)
	. Set BPrijs=$$BLPRIJS^BLPRGEG(PRNr,BLKLNr)
 	. ;Set Stat=$$PROD^STAT(PRNr,0,"2003.04 ","2004.03",1)
 	. Set Stat=$P($G(^AKANAL(PRNr)),D,1)
    . Set BVPA=$J($P(BPrijs,D,1),0,2)
    . Set BKrt=$J($P(BPrijs,D,3)*100,0,2)
    . Set BGO=$P(BPrijs,D,2)
    . Set BMark=""
    . Set RecJ=^KPR(PRNr,"J5005")
	. Set HVPA=$P(RecJ,D,19)
	. Set HKrt=$P(RecJ,D,9)
	. Set HGO=$P(RecJ,D,28)
	. If 'BVPA,'BKrt Set BVPA=HVPA,BKrt=HKrt,BGO=HGO,BMark=1
    . Set BOmzet=BVPA*(1-(BKrt/100))/$S(BGO="M":1000,BGO="H":100,1:1)*Stat
    . Set HOmzet=HVPA*(1-(HKrt/100))/$S(HGO="M":1000,HGO="H":100,1:1)*Stat
	. Use File
	. Write $$SORTKEY^PRODUKT(PRNr)
	. Write *9,$P(RecI,D,1),*9,$P(RecI,D,2),*9,$P(RecI,D,3)
	. Write *9,IDNr
	. Write *9,KortT
	. Write *9,$TR(Stat,".",",")
	. Write *9,$TR(HVPA,".",","),*9,$TR(HKrt,".",","),*9,HGO,*9,$TR(HOmzet,".",",")
	. Write *9,IC
	. Write *9,$TR(BVPA,".",","),*9,$TR(BKrt,".",","),*9,BGO,*9,$TR(BOmzet,".",","),*9,BMark
	. Write !
	Close:0'[File File
	Q
 
 
	Set PRNr=""
	For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
	.Quit:$P(^KPR(PRNr,0),D,3)'=89322 ; GENTYPE TBX\STD
	.Quit:$D(^PRBS("BS",PRNr,"PRVPOD.001")) ; V1 verpakt 
	.Write PRNr," ",$P(^KPR(PRNr,0),D,1),!
	. Set GenPRNr=89325
	. Set $P(^KPR(PRNr,0),D,3)=GenPRNr
	q
 
 
 
 
 
 
 
 
 
 
 
UPDATE 
 q
 Write "Bent u zeker dat de dataoverdracht afgewerkt is?"
 Write "Bent u zeker dat de UPDATE nog niet gadaan is? <Neen>? "
 s Update="Ja"
 w "test"_Update
 Quit:Update'="Ja" 
 ; Conversie van de "RES" global "%" indexen
 Write "Update ^RES (""%""-indexen)"
 ; Copieren van de opzoekindexen voor klanten, leveranciers, ...
 Write "Update ^INDEX(""K"") (opzoekindexen voor klanten, leveranciers, ...)"
 Kill ^INDEX("K")
 ;Merge ^INDEX("K")=^|"MSMADM"|INDEX("K")
 Write "Update ^INDEX(0,""PN"") (indexen op postcode)"
 Kill ^INDEX(0,"PN")
 ;Merge ^INDEX(0,"PN")=^|"MSMADM"|INDEX(0,"PN")
 Write "Update ^DATA(0,""PN"") (de postcodes)"
 Kill ^DATA(0,"PN")
 ;Merge ^DATA(0,"PN")=^|"MSMADM"|DATA(0,"PN")
 Quit