HADGEN ;Produkt duplicering voor manuele produkten Halux deuren [ 02/21/2003  11:56 AM ]
 ;
 Kill
 Do BUILD^A508
 Do INIT^vhTERMINA
 Set Q="K"
 Write @F11,@F1
 Set PRNr=$$GENERATE(,33139)
 Write !,"PRNr = ",PRNr,*7 r r
 Quit
 ;
GENERATE(Ref,GenPRNr,Params,Plak) 
 New sFL,FromPRNr,NewRec,NewPRNr,KLNr,LEVNr,Taal,IsStock,KortT,PR,LT1,LT2,LT3,LT4
 Set Ref=$G(Ref),(GenPRNr,PR)=$G(GenPRNr),Params=$G(Params),Plak=$G(Plak),(KLNr,LEVNr,FromPRNr)=""
 Set:Params="K" KLNr=Ref Set:Params="L" LEVNr=Ref,IsStock=1
 If Params="",GenPRNr Do
 .Set R=$O(^KPR(GenPRNr,"J"))
 .Quit:$E(R)'="J"
 .Set R=^KPR(GenPRNr,R),LEVNr=$P(R,D)
 Set Taal=$G(KT)
 Do BUILD,NEWREC
 Do:Plak
 .Kill DefLevT
 .Quit:$G(OFFNr)
 .Set:'$G(HalTOENr) HalTOENr=$$GETNUM^FLOW("KTO","KTO1")
 Do NIEUW^vhScherm("HADGEN",,,,,,3)
 If %SC Do
 .For I=1:1 Quit:'$D(sFL(I))  Set NewRec(I-1)=sFL(I)
 .For I="I","J","G","O" Set NewRec(I)=$G(sFL(I))
 .Set KortT=$$KORTTXT(sFL("G"))
 .Do LANGTXT(sFL("G"),"N"),LANGTXT(sFL("G"),"F")
 .Do LANGTXT(sFL("G"),"D"),LANGTXT(sFL("G"),"E")
 .Set $P(NewRec(0),D,2)=LT1("N")
 .Set $P(NewRec(0),D,11)=$E(LT2("N"),1,45)
 .Set $P(NewRec(1),D,22)=LT1("F")
 .Set $P(NewRec(2),D)=LT1("E")
 .Set $P(NewRec(2),D,2)=LT1("D")
 .Set $P(NewRec(3),D,21)=$E(LT2("F"),1,45)
 .Set $P(NewRec(3),D,22)=$E(LT2("E"),1,45)
 .Set $P(NewRec(3),D,23)=$E(LT2("D"),1,45)
 .Set $P(NewRec(4),D)=$E(LT1("N"),1,44)
 .Set $P(NewRec(4),D,2)=$E(LT2("N"),1,44)
 .Set $P(NewRec(4),D,3)=$E(LT3("N"),1,44)
 .Set:$L($G(LT4("N"))) $P(NewRec(5),D)=$E(LT4("N"),1,44)
 .Set $P(NewRec(6),D)=$E(LT3("N"),1,45)
 .Set $P(NewRec(6),D,2)=$E($G(LT4("N")),1,45)
 .Set $P(NewRec(8),D)=$E(LT3("F"),1,45)
 .Set $P(NewRec(10),D)=$E(LT3("D"),1,45)
 .Set $P(NewRec(12),D)=$E(LT3("E"),1,45)
 .Set $P(NewRec(1),D,13)=$J($$GEWICHT(sFL("G")),0,0)
 .If +$P(NewRec("J"),D,24)=40 Do  ; Indien DB%=40 dan nieuwe prijszetting
 ..New Qty
 ..Set Qty=$P(NewRec("G"),D,14)
 ..Set:Qty<0 Qty=-Qty
 ..If Qty<10 Set $P(NewRec("J"),D,24)=37.0,$P(NewRec("J"),D,21)=5
 ..Else  If Qty<20 Set $P(NewRec("J"),D,24)=37.0,$P(NewRec("J"),D,21)=5
 ..Else  If Qty<30 Set $P(NewRec("J"),D,24)=37.0,$P(NewRec("J"),D,21)=5
 ..Else  If Qty<40 Set $P(NewRec("J"),D,24)=37.0,$P(NewRec("J"),D,21)=5
 ..Else  If Qty<50 Set $P(NewRec("J"),D,24)=37.0,$P(NewRec("J"),D,21)=5
 ..Else  Set $P(NewRec("J"),D,24)=37.0,$P(NewRec("J"),D,21)=5
 .Do SAVE
 .Do SAVEVUL(NewPRNr,$P($G(sFL("V")),"\"),sFL("G"))
 Quit $G(NewPRNr)
 ;
BUILD 
 If 'FromPRNr New FromPRNr Set FromPRNr=GenPRNr
 Do FETCHPR^UTILI(FromPRNr,"NewRec")
 Set LEVNr=$P(NewRec("J"),D)
 Set $P(NewRec(0),D,3)=GenPRNr
 Do CLEAN
 Quit
 ;
CLEAN New Qty
 Set $P(NewRec(0),D,6)="" ; Ligging
 Set $P(NewRec(0),D,12,14)=D_D ; Beginstock,FysStock
 Set $P(NewRec(0),D,16)="" ; Laatste beweging
 Set $P(NewRec(0),D,17)="" ; Bestelling
 Set $P(NewRec(0),D,20)="" ; Schaduwkorttekst
 Set $P(NewRec(0),D,21)="" ; Schaduw sectie
 Set $P(NewRec(1),D,9)="" ; Inventaris fysstock
 Set $P(NewRec(1),D,20)=$G(IsStock) ; Stock/niet stock
 Set $P(NewRec(1),D,21)="" ; Gem Weekverkoop
 Set $P(NewRec(1),D,23)="" ; Gewogen gem. weekverkoop
 Set $P(NewRec(2),D,3)="" ; Schad PPL
 Set $P(NewRec(2),D,4)="" ; Schad Korting
 Set $P(NewRec(2),D,5)="" ; Schad Vork
 Set $P(NewRec(2),D,6)="" ; Schad Winst
 Set $P(NewRec(2),D,7)="" ; Schad Cif
 Set $P(NewRec(2),D,9)="" ; Reservatie
 If LEVNr=5005 Set $P(NewRec(2),D,25)=8_$E($P(NewRec(2),D,25),2,99) ; Identnummer
 Else  Set $P(NewRec(2),D,25)=""
 If GenPRNr=FromPRNr Do
 .Set $P(NewRec(0),D,2)="" ; Omschrijving N1
 .Set $P(NewRec(0),D,11)="" ; Omschrijving N2
 .Set $P(NewRec(1),D,22)="" ; Omschrijving F1
 .Set $P(NewRec(2),D,25)="" ; Identnummer
 .Set $P(NewRec(3),D,21)="" ; Omschrijving F2
 .Set $P(NewRec("J"),D,3)="" ; Leveranciersref
 .;Set $P(NewRec("J"),D,24)=50 ; DB% overgeërft van gen. product
 .Set $P(NewRec("J"),D,10)=20 ; KSDB%
 .Set $P(NewRec("J"),D,19)="" ; Aankoopprijs
 .Set $P(NewRec("J"),D,25)="" ; Lijstprijs
 Quit
 ;
NEWREC 
 For I=0:1 Quit:'$D(NewRec(I))  Set sFL(I+1)=NewRec(I)
 For I="I","J" Set sFL(I)=NewRec(I)
 Quit
 ;
GEWICHT(Param)  ; In gram of KG/1000
 New Hoogte,Breedte,Gewicht,Vulling
 Set Vulling=$P(Param,D,10)
 Set ProfType=$P(Param,D,2)
 Set (MinVrGlas,Gewicht)=0
 Set Hoogte=$P(Param,D,8),Breedte=$P(Param,D,9)
 If $L(ProfType) Do
 .Set MinVrGl=$P($G(^RES("HAD","PI","PROFIEL","D",ProfType)),"`",3)
 .Set Gewicht=Gewicht+(4*$S($E(ProfType,2)="B":55,1:16))+((Hoogte+Breedte)/1000*2*320)
 If $L(Vulling) Do
 .Set Gewicht=Gewicht+((Hoogte-(MinVrGl*2))/1000*(Breedte-(MinVrGl*2))/1000*9550) ; Vulling
 .Set Gewicht=Gewicht+(Hoogte*Breedte/1000/1000) ; Verpakking
 Quit $J(Gewicht,0,0)
 
KORTTXT(Param) 
 New KortT
 Set KortT=$P(Param,D,2),$E(KortT,4)=$P(".\#",D,$P(Param,D,11)+1)
 Set $E(KortT,5)=$P(Param,D,5),$E(KortT,6,7)=$P(Param,D,6)
 Set $E(KortT,8)=$P(".\X",D,$P(Param,D,7)+1),$E(KortT,9,11)=$J($P(Param,D),3)
 Set $E(KortT,12,21)=$P(Param,D,5)_"D"_$J($P(Param,D,8)_"x"_$P(Param,D,9),8)
 Set $E(KortT,22,23)=$P(Param,D,10),$E(KortT,24,25)=$E($P(Param,D,2),5,6)
 Set $E(KortT)="K"
 Quit KortT
 ;
LANGTXT(Param,Taal) 
 New Toepas,Afm,Profiel,Vulling,DraaiR
 Set Toepas=$P(Param,D,5),Toepas=^RES("HAD","PI","TOEPAS","D",Toepas,Taal)
 Set DraaiR=$P(Param,D,4)
 If $P(Param,D,5)="K",$L(DraaiR) Do  ; Kaderdeur
 .Set Toepas=Toepas_" "_$G(^RES("HAD","PI","DRAAI","D",DraaiR,Taal))
 Set Profiel=$P(Param,D,2),Profiel=^RES("HAD","PI","PROFIEL","D",Profiel,Taal)
 Set Afm=$P(Param,D,8)_"x"_$P(Param,D,9)_"mm"
 Set Vulling=$P(Param,D,10),Vulling=$S($L(Vulling):$$GeefVullingVertaling^HADVUL(Vulling,Taal),1:"")
 Set LT1(Taal)=Toepas Set:$L(LT1(Taal)) LT1(Taal)=LT1(Taal)_", " Set LT1(Taal)=LT1(Taal)_Afm
 Set LT2(Taal)=$S($L(Profiel):$S(Taal="N":"Profiel",1:"Profil")_" : "_Profiel,1:"")
 Set LT3(Taal)=$S($L(Vulling):$S(Taal="F":"Garniture",Taal="D":"Füllung",Taal="E":"Filling",1:"Vulling")_" : "_Vulling,1:"")
 If Taal="N",$L(Vulling),$P($P($G(sFL("V")),"\"),";",2) Do
 .If $L(LT3(Taal)_",gehard")>45 Set LT4(Taal)="gehard"
 .Else  Set LT3(Taal)=LT3(Taal)_",gehard"
 If Taal="N",$L(Vulling),$P($P($G(sFL("V")),"\"),";",3) Do
 .If $D(LT4(Taal)) Set LT4(Taal)=LT4(Taal)_",gezandstraald"
 .Else  If $L(LT3(Taal)_",gezandstraald")>45 Set LT4(Taal)="gezandstraald"
 .Else  Set LT3(Taal)=LT3(Taal)_",gezandstraald"
 Quit
 ;
SAVE 
 Set NewPRNr=$$NEXTID^PRODUKT()
 Set IdentNr=$$IDENTNR^PRODUKT(NewPRNr)
 Set $P(NewRec(2),D,25)=IdentNr
 Set $P(NewRec(0),D)=KortT
 ;Write ! ZWrite NewRec r r Quit
 For I=0:1:13 Set ^KPR(NewPRNr,I)=$G(NewRec(I))
 Set:$D(NewRec("G")) ^KPR(NewPRNr,"G")=NewRec("G") ; Generische node
 Set:$G(UGL)="OD" ^HADPR("P",NewPRNr,"GK")=NewRec("G") ; Productie opvolging alleen bij orders
 Set ^KPR(NewPRNr,"I")=""
 Set ^KPR(NewPRNr,"I1")=NewRec("I")
 Set ^KPR(NewPRNr,"J")=""
 Set ^KPR(NewPRNr,"J"_$P(NewRec("J"),D))=NewRec("J")
 Do:$L($TR($G(NewRec("O")),D,"")) SAVETEXT(NewPRNr,NewRec("O"))
 ;Indexen
 Do RECALC^PRODUKT2(NewPRNr)
 Do BLDIND^PRODUKT2(NewPRNr)
 Do Gemaakt^PRODUKT2(NewPRNr)
 Do ZEND^EWPR(NewPRNr)
 Quit
 ;
SAVEVUL(PRNr,Rec,RecG) 
 New RecVul,Extra,Invers,MinGlas,X,Y,BD,I
 Quit:$G(UGL)'="OD"  ; Alleen bij orders
 Set RecVul=""
 Set RecVul=$P(Rec,";")
 Quit:RecVul=""
 Set Extra=""
 Set:$P(Rec,";",2) Extra=Extra_$S($L(Extra):";",1:"")_$S($P(Rec,";",2):"HARD",1:"")
 Set:$P(Rec,";",3) Extra=Extra_$S($L(Extra):";",1:"")_$S($P(Rec,";",3):"ZAND",1:"")
 ; Ook bij een linkse deur moet er geinverteerd worden, dit omdat in het Excel document steeds van een rechtse deur wordt begonnen.
 Set Invers=$P(Rec,";",4)&($P(RecG,D,4)'="L")!('$P(Rec,";",4)&($P(RecG,D,4)="L"))
 Set:Invers Extra=Extra_$S($L(Extra):";",1:"")_$S(Invers:"INV",1:"")
 Set $P(RecVul,D,2)=Extra
 Set MinGlas=$TR($P(Rec,";",5),",",".")
 Set $P(RecVul,D,4)=$P(Rec,";",6)-(2*MinGlas) ; Hoogte
 Set $P(RecVul,D,5)=$P(Rec,";",7)-(2*MinGlas) ; Breedte
 Set $P(RecVul,D,6)=4 ; Dikte
 Set $P(RecVul,D,7)=$S(Extra["HARD"!(Extra["ZAND"):2,1:1) ; LevTrm
 ;Write RecVul,!
 For I=0:1:5 Do
 .Set X=$TR($P(Rec,";",7+(I*3)+1),",",".")-MinGlas
 .Set Y=$TR($P(Rec,";",7+(I*3)+2),",",".")-MinGlas
 .Set BD=$TR($P(Rec,";",7+(I*3)+3),",",".")
 .;Write X," ",Y," ",BD,!
 .Quit:'X!'Y!'BD
 .Set RecVul("B",I+1)=X_D_Y_D_D_BD
 Merge ^HADPR("P",PRNr,"GV")=RecVul
 Quit
 
SAVETEXT(PRNr,Rec) 
 New Next
 Set Next=$O(^HADPR("P",PRNr,"O",""),-1)+1,^HADPR("P",PRNr,"O",Next)=Rec
 Quit
 ;
PRIJS(AKPrijs,VKPrijs) 
 New %DB,B,K,P24
 If $D(AKPrijs),$D(VKPrijs) Do
 .Set AKPrijs=AKPrijs/$S($P(sFL("J"),D,28)="H":100,$P(sFL("J"),D,28)="M":1000,1:1)
 .Set AKPrijs=AKPrijs/$$MUNTPAR^vhRtn1($P(sFL("J"),D,17),1)*(100-$P(sFL("J"),D,9)/100)*(100+$P(sFL("J"),D,21))/100
 .Set %DB=$J(1-($J(AKPrijs,0,4)/VKPrijs)*100,0,4)
 .Set $P(sFL("J"),D,24)=%DB
 Else  If $D(AKPrijs) Do
 .Set AKPrijs=AKPrijs/$S($P(sFL("J"),D,28)="H":100,$P(sFL("J"),D,28)="M":1000,1:1)
 .Set VKPrijs=AKPrijs/$$MUNTPAR^vhRtn1($P(sFL("J"),D,17),1)*(100-$P(sFL("J"),D,9)/100)
 .Set VKPrijs=VKPrijs*(100+$P(sFL("J"),D,21)/100)/(100-$P(sFL("J"),D,24)/100),VKPrijs=$J(VKPrijs,1,4)
 .Set $P(sFL("J"),D,25)=VKPrijs
 Else  If $D(VKPrijs) Do
 .Set VKPrijs=VKPrijs/(100+$P(sFL("J"),D,21)/100)*(100-$P(sFL("J"),D,24)/100)
 .Set AKPrijs=VKPrijs*$$MUNTPAR^vhRtn1($P(sFL("J"),D,17),1)/(100-$P(sFL("J"),D,9)/100)
 .Set AKPrijs=AKPrijs*$S($P(sFL("J"),D,28)="H":100,$P(sFL("J"),D,28)="M":1000,1:1)
 .Set AKPrijs=$J(AKPrijs,1,$P(^KBA(11,$P(sFL("J"),D,17)),D,7))
 .Set $P(sFL("J"),D,19)=AKPrijs
 Set B(1)=sFL("J"),P24=1
 Do ^KP0
 Set sFL("J")=B(1)
 Quit
 ;
 Quit
 ;
RECALC(Prijs,ScrnTyp) 
 New R,X
 Set ScrnTyp=$G(ScrnTyp)
 If "V"[Prijs Do
 .Do PRIJS($P(sFL("J"),D,19))
 .Do DISPLAY^vhScherm("HADGEN"_ScrnTyp,"","","","LIJSTPR")
 If "A"[Prijs Do
 .If ScrnTyp="D",$P(sFL("J"),D,19) Do
 ..Do PRIJS($P(sFL("J"),D,19),$P(sFL("J"),D,25)),DISPLAY^vhScherm("HADGEN"_ScrnTyp,"","","","DB")
 .Else  Do PRIJS(,$P(sFL("J"),D,25)),DISPLAY^vhScherm("HADGEN"_ScrnTyp,"","","","AANKPR")
 Quit
 ;
DOSNR() 
 New DosNr
 Lock +^KPR(0,"HDNR")
 Set DosNr=$G(^KPR(0,"HDNR"))+1,$P(^KPR(0,"HDNR"),D)=DosNr
 Lock -^KPR(0,"HDNR")
 Quit $$ALFAKEY^vhRtn1(DosNr,"A")
 ;
SHOWDOSN(HalTOENr,PRNr,KLNr,ORDNr,OLNr) 
 New R,DosNr
 If $G(HalTOENr),$G(PRNr)
 Else  If $G(KLNr),$G(ORDNr),$G(OLNr) Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),HalTOENr=$P(R,D,27)
 If $G(HalTOENr),$G(PRNr) Set DosNr=$P($G(^KPR(PRNr,"G")),D),R=$$^vhTXTPOP("HADGEN","SHOWDOSN","",HalTOENr,DosNr)
 Quit
 ;
LABEL ;Manueel Halux
 ;