PRFUSIE ;Product fusioneren (User interface) [ 05/24/2002  3:05 PM ]
 New %J ;NoDel
 Set %J=$$%J^vhRtn1()
 For  Do INIT,COMMAND,SAVE:Fusie,CLEAN Quit:'Fusie
 Quit
 
INIT If '$D(Q) Do
 .New %J
 .Set Q="K" Do ^cA604
 Kill HULP(%J)
 Write @F11,@F1
 Do INIT^PROC("PRFUSNAAR","NAAR")
 Do INIT^PROC("PRFUSVAN","VAN")
 Do ADD^vhScherm(1,24)
 Kill NoDel
 Set Fusie=0
 Set MemSel=1
 Kill PROD
 Quit
 
REFRESH 
 If sRT=1 Do
 .Write @F11,@FMTI," Fusioneren van producten - ",QN," ",@FMTi,@F2
 .Set FP=174 Write @F,@FMTB," ",DL(1)," ",@FMTb
 .Set FP=201 Write @F,@F2
 New DL
 If sRT<4,sRB>2 Set FP=301 Write @F,@FMTI," VAN",$J("",80-4),@FMTi
 If sRT<11,sRB>3 Set DL(1)="VAN",DL(2)=sRT Set DL(3)=sRB Do WL^PROC
 If sRT<12,sRB>10 Set FP=1101 Write @F,@FMTI," NAAR",$J("",80-5),@FMTi
 If sRT<20,sRB>11 Set DL(1)="NAAR",DL(2)=sRT Set DL(3)=sRB Do WL^PROC
 If sRB>18 Set FP=1901 Write @F,@F1
 Do RESET^vhScherm
 Quit
 
COMMAND Set Input=""
 For  Quit:Input="-"  Do
 .Do REFRESH,SL^PROC
 .Set Input=R
 .If Input="HELP" Do HELP
 .If Input="S" Do SWITCH
 .If Input="F",$$CHECKPAK Do ASKFUSIE
 .If Input="N" Do LNIEUW
 .If Input="P" Do RAADPL
 .If Input="V" Do LDELETE
 .If Input="ENTER" Do LWIJZIG
 .If Input="." Set Input="-"
 .If 'Fusie,Input="-",$D(PROD("I")) Set Input=$$ASK^vhINP("Werkelijk Fusie-producten verlaten : ",1,""," J[] = Exit") Set:Input="J" Input="-"
 Quit
 
SAVE Kill NAAR,VAN   
 Set Nr="" For  Set Nr=$O(PROD("VAN",Nr)) Quit:Nr=""  Set PRNr=+PROD("VAN",Nr) Set:PRNr VAN(PRNr)=$P(PROD("VAN",Nr),D,2,99),ALL(PRNr)=VAN(PRNr)
 Set Nr="" For  Set Nr=$O(PROD("NAAR",Nr)) Quit:Nr=""  Set PRNr=+PROD("NAAR",Nr) Set:PRNr NAAR(PRNr)=$P(PROD("NAAR",Nr),D,2,99),ALL(PRNr)=NAAR(PRNr)
 Goto FUSIE^PRFUSIE2
 Quit
 
CLEAN Kill VAN,NAAR,PROD
 Kill HULP(%J)
 Lock
 Quit
 
SWITCH New Temp
 Do DL^PROC
 Set Temp=MemSel
 Set MemSel=@DL(1)@(6)
 Set @DL(1)@(6)=""
 Set DL(1)=$S(DL(1)="VAN":"NAAR",1:"VAN")
 Set @DL(1)@(6)=Temp
 Do EL^PROC
 Do ADD^vhScherm(1,1)
 Quit
 
 ; Controle op pakketten
CHECKPAK()
 New R,Check,EP,Nr,PRNr,PAKKET,CheckDel,Klanten
 Set Check=1
 If $D(PROD("VAN")),$D(PROD("NAAR")),'NoDel Do
 .If '$O(PROD("VAN",1)),'$O(PROD("NAAR",1)) Quit  ; Een op een relatie, dus ok copieren van -> naar
 .Set Nr=""
 .For  Set Nr=$O(PROD("VAN",Nr)) Quit:Nr=""  Do
 ..Set PRNr=$P(PROD("VAN",Nr),D),CheckDel=$$CHECKDEL^PRODUKT2(PRNr,"P") Set:$L(CheckDel) PAKKET("VAN",$O(PAKKET("VAN",""),-1)+1)=PRNr_D_$P(CheckDel,": ",2)
 .Quit:'$D(PAKKET)
 .Do STORE^vhTERMINA()
 .Set FP=21-$O(PAKKET("VAN",""),-1)*100+2
 .Write @F,"Volgend"_$S($O(PROD("VAN",1)):"e",1:"")_" oud VAN-product"_$S($O(PROD("VAN",1)):"en",1:"")_" bevat"_$S($O(PROD("VAN",1)):"ten",1:"")_" nog pakketten."
 .Set FP=FP+100
 .For Nr=1:1 Set R=$G(PAKKET("VAN",Nr)) Quit:R=""  Do
 ..Set R=PAKKET("VAN",Nr),PRNr=$P(R,D),Klanten=$P(R,D,2)
 ..Set FP=FP+100
 ..Write @F,$P(^KPR(PRNr,0),D),?27,": ",$E(Klanten,1,50)
 .Do TXT^vhINP("Fusie onmogelijk")
 .Do REFRESH^vhTERMINA()
 .Set Check=0
 Quit Check
 
ASKFUSIE If '$D(PROD("I")) Quit
 Set Nr=$O(PROD("VAN","")) Quit:Nr=""  Quit:'PROD("VAN",Nr)
 Set Nr=$O(PROD("NAAR","")) Quit:Nr=""  Quit:'PROD("NAAR",Nr)
 If 'NoDel Do  Quit:ProdList=999999
 .Set FP=2201 Write @F,@F1,!,"Nakijken of er nog uitleveringen zijn voor de geselekteerde producten",!,"Even geduld A.U.B."
 .Set (ProdList,Nr)="" For  Set Nr=$O(PROD("VAN",Nr)) Quit:Nr=""  Set ProdList=ProdList_";"_+PROD("VAN",Nr) 
 .Set (KLNr,ULNr)=1
 .For  Set KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do
 ..For  Set ULNr=$O(^KUL(KLNr,"F",ULNr)) Quit:ULNr=""  Do
 ...Set Lijn=99
 ...For  Set Lijn=$O(^KUL(KLNr,"F",ULNr,Lijn)) Quit:'Lijn  Do
 ....Set PRNr=$P(^KUL(KLNr,"F",ULNr,Lijn),D,2) 
 ....Quit:PRNr=""
 ....If ProdList_";"[(";"_PRNr_";") Set MemULNr=ULNr,(ProdList,KLNr,ULNr,Lijn)=9999999
 .If ProdList=9999999 Do TXT^vhINP("Product "_$P(^KPR(PRNr,0),D,1)_" zit in uitlevering "_MemULNr) Quit
 Set K=$$ASK^vhINP("Uitvoeren fusie "_$S(NoDel:"ZONDER verwijderen",1:"MET verwijderen")_" : ",1,"","F[] = Uitvoeren") 
 Quit:K'="F"&(K'="f")
 Set K=$$ASK^vhINP("WERKELIJK uitvoeren van de fusie "_$S(NoDel:"ZONDER verwijderen",1:"MET verwijderen")_" : ",1,"","F[] = Uitvoeren")
 Quit:K'="F"&(K'="f")
 Set Input="-",Fusie=1
 Quit
 
RAADPL Set Nr=@DL(1)@(6)
 Quit:'$G(PROD(DL(1),Nr))
 Set PRNr=+PROD(DL(1),Nr)
 Set Screen=$$RAADPL^PRODUKT(PRNr,$G(Screen),1)
 Do ADD^vhScherm(1,24)
 Quit
 
LWIJZIG Set Nr=@DL(1)@(6)
 Quit:'$G(PROD(DL(1),Nr))
 Do:DL(1)="VAN" EDIT^vhScherm("PRFUSVAN")
 Do:DL(1)="NAAR" EDIT^vhScherm("PRFUSNAAR")
 Do EL^PROC
 Quit 
 
LNIEUW Set:DL(1)="VAN" PRNr=$$SELECT^PRODUKT6("","","","Oud VAN-product : ","ALL")
 Set:DL(1)="NAAR" PRNr=$$SELECT^PRODUKT6("","","","Nieuw NAAR-product : ")
 If 'PRNr Quit
 Quit:$D(PROD("I",PRNr))
 Set:'$D(NoDel) NoDel=$$^vhTXTPOP("PRFUSIE","BEHOUDEN")="B"
 ;Behouden van de VAN-producten na de fusie
 If 'NoDel,DL(1)="VAN" Quit:'$$CHECKDEL(PRNr)
 Lock +^KPR(PRNr):1
 Else  Do LDISP^vhLock("^KPR(PRNr)","Product in gebruik") Quit
 Do NIEUW^PROC3
 Set PROD(DL(1),@DL(1)@(6))=PRNr_D_$S(DL(1)="VAN":"",1:D_1_D_1)
 Set PROD("I",PRNr)=""
 Do EL^PROC
 Set Key=$O(^KPR(PRNr,"I")) 
 If $E(Key)="I" Do  ; Nakijken of er prijsuiztondering op productniveau bestaan
 .Set Key=^KPR(PRNr,Key)
 .Quit:'$D(^KLPUTZ("IN",$P(Key,D,1),$P(Key,D,2),$P(Key,D,3),PRNr))
 .Do TXT^vhINP("Opgelet : Er zijn prijsuitzonderingen op productniveau voor dit product","Om de prijsuitzondering te bekijken druk eerst [] dan P")
 .Set Screen="U"
 Quit
 
LDELETE ; Verwijder producten uit lijst
 Set Nr=@DL(1)@(6)
 Quit:'$G(PROD(DL(1),Nr))
 Set PRNr=+PROD(DL(1),Nr)
 Do DELETE^PROC3
 Kill PROD("I",PRNr)
 Lock -^KPR(PRNr)
 Quit
 
HELP ; Oproep van Menu en HELP
 Set R=""
 Do POP^MN("PRFUS")
 Set Input=R
 If Input'="HELP" Do REFRESH Quit
 New HLP
 Set HLP(1)="PRFUSIE"
 Set HLP(3)=4
 Do ^HELP
 Do ADD^vhScherm(3,24)
 Quit
 
CHECKDEL(PRNr) 
 New Check,Write,ES,EH,EO,ET,EP,EU,EZ,EB,EK,EW,EM
 
 Set ES=$$CHECKDEL^PRODUKT2(PRNr,"S") ; Stock
 Set EO=$$CHECKDEL^PRODUKT2(PRNr,"O") ; Orders
 Set ET=$$CHECKDEL^PRODUKT2(PRNr,"T") ; Toelevering
 Set EP=$$CHECKDEL^PRODUKT2(PRNr,"P") ; Pakketreferenties
 Set EU=$$CHECKDEL^PRODUKT2(PRNr,"U") ; Uitlevering
 Set EZ=$$CHECKDEL^PRODUKT2(PRNr,"Z") ; Uitzondering
 Set EB=$$CHECKDEL^PRODUKT2(PRNr,"B") ; Bestelimpuls
 Set EK=$$CHECKDEL^PRODUKT2(PRNr,"K") ; Kind/HalfFabr
 Set EW=$$CHECKDEL^PRODUKT2(PRNr,"W") ; Product of HalfFabr in WMS 
 Set EM=$$CHECKDEL^PRODUKT2(PRNr,"M") ; Master voor andere (Auto)-producten
 Set Check=1,FP=2102
 If $L(EO)!$L(ET)!$L(EP)!$L(EU)!$L(EZ)!$L(EB)!$L(EK)!$L(EW)!$L(EM) Set FP=2202
 For I="S","O","T","P","U","Z","B","K","W","M" If $L(@("E"_I)) Set FP=FP-100,Write=1
 If $G(Write) Do
 .Do STORE^vhTERMINA()
 .Write @F,@F1
 .For I="S","O","T","P","U","Z","B","K","W","M" If $L(@("E"_I)) Set FP=FP+100 Write @F,@("E"_I)
 .If $L(ES)!$L(EO)!$L(ET)!$L(EU)!$L(EZ)!$L(EB)!$L(EW)!$L(EM) Do
 ..Do TXT^vhINP("Fusie onmogelijk")
 ..Set Check=0
 .Else  Do
 ..If $L(EK) Do
 ...Set Moeders(PRNr)=$$CheckDelMoeders^KPE40(PRNr,.Moeders)
 ...Set:Moeders(PRNr)="A" Check=0
 ..Else  If $L(EP) Do TXT^vhINP("Fusie mogelijk onder voorwaarden")
 .Do REFRESH^vhTERMINA()
 Quit Check
 
 ; Fusie van de moeders met hun basis bij het verwijderen van een der kinderen
OnDeleteProduct(PRNr)
 New %J,MPRNr,BSMPRNr,GenPRNr,Fusie,VAN,NAAR,NoAsk,NoDel,NoPakket,Count,Max,PRCount,MaxPRCount
 Set MPRNr="",Max=500,MaxPRCount=0
 For  Set MPRNr=$O(^PRBS("IP",PRNr,MPRNr)) Quit:MPRNr=""  Do
 . Set GenPRNr=$P($G(^KPR(MPRNr,0)),D,3)
 . Set:GenPRNr Fusie(GenPRNr,MPRNr)="",MaxPRCount=MaxPRCount+1
 Do:$D(Fusie)
 . Set %J=$$%J^vhRtn1()
 . Kill ^HULP(%J)
 . Set (NoAsk,NoPakket)=1,(NoDel,Count,PRCount)=0,GenPRNr=""
 . For  Set GenPRNr=$O(Fusie(GenPRNr)) Quit:GenPRNr=""  Do
 . . Kill VAN,NAAR,^HULP(%J)
 . . Set NAAR(GenPRNr)="\1\1"
 . . Set MPRNr=""
 . . For  Set MPRNr=$O(Fusie(GenPRNr,MPRNr)) Quit:MPRNr=""  Do
 . . . Set VAN(MPRNr)="",Count=Count+1,PRCount=PRCount+1
 . . . Quit:Count'=Max
 . . . Set FP=2449
 . . . Write @F,"Producten verwerkt: ",PRCount,"/",MaxPRCount
 . . . ; Per Max uitvoeren van de fusie
 . . . Do FUSIE^PRFUSIE2
 . . . Set BSMPRNr=""
 . . . For  Set BSMPRNr=$O(VAN(BSMPRNr)) Quit:BSMPRNr=""  Do BLDIND^PRBS(BSMPRNr)
 . . . Kill VAN,^HULP(%J)
 . . . Set Count=0
 . . Do:$D(VAN)
 . . . Set FP=2449
 . . . Write @F,"Producten verwerkt: ",PRCount,"/",MaxPRCount
 . . . Do FUSIE^PRFUSIE2
 . . . Set BSMPRNr=""
 . . . For  Set BSMPRNr=$O(VAN(BSMPRNr)) Quit:BSMPRNr=""  Do BLDIND^PRBS(BSMPRNr)
 . Kill ^HULP(%J)
 Quit