ORGVERP ;Verwerking Orgalux (Verpakking) [ 10/21/2003  2:22 PM ]
 ;
VERPAK 
 Do INIT^vhTERMINA
 New R,%J,BONNr,KLNr,ORDNr
 Set (KLNr,BONNr,ORDNr)="",%J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do DISPLAY^vhScherm("ORGVERP")
 Do INIT^vhLIST("ORGALUX","VERPAK",.LD),WRITE^vhLIST(.LD)
 Do COMMAND()
 Kill ^HULP(%J)
 Quit
 ;
COMMAND(BONNr) 
 New Input,OneBon
 Set BONNr=$G(BONNr),OneBon=$L(BONNr),Input=$S(BONNr:"",1:"B")
 If OneBon Set Input="" Do SELBON
 For  Do  If Input="CANC" Set Input=$$CHECKTRANSFERT() Quit:$L(Input)
 .Do:Input="COM" CALL^vhMenu("ORGVERPAK")
 .Do EXEC^vhMenu("ORGVERPAK",.Input)
 .Quit:Input="CANC"
 .If 'BONNr Set Input="CANC" Quit
 .If 'ORDNr Set Input="B" Quit
 .Set Input=$$SCROLL^vhLIST(.LD)
 .Set:Input="-" Input="CANC"
 .Quit:Input="CANC"
 Quit
 ;
REFRESH 
 New I,R,BLNr,Count,Quit,ULUNr,UnKnown,PRNr,SortKey
 Set BLNr=100,Count=0
 If $D(^HULP(%J,"S",BONNr,"?")) For I=1:1 Set R=$G(^HULP(%J,"L",I)) Quit:R=""  If $P(R,D,15)="?" Set UnKnown=R Quit
 Kill ^HULP(%J,"L")
 For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:Quit
 .Set R=^KUL(KLNr,"F",BONNr,BLNr)
 .Set Quit=$P(R,D,17)="KF5"&($P($P(R,D,5)," - ")=ORDNr)
 Do:BLNr
 .For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:Quit
 ..Set R=^KUL(KLNr,"F",BONNr,BLNr)
 ..Set Quit=$P(R,D,17)="KF5"
 ..Set PRNr=$P(R,D,2),ULUNr=$P(R,D,15)
 ..Quit:'PRNr
 ..Set SortKey=$$SORTKEY^PRODUKT(PRNr)_ULUNr,^HULP(%J,"SK",SortKey)=R
 .Set SortKey=""
 .For  Set SortKey=$O(^HULP(%J,"SK",SortKey)) Quit:SortKey=""  Do
 ..Set R=^HULP(%J,"SK",SortKey)
 ..Set Count=$O(^HULP(%J,"L",""),-1)+1,^HULP(%J,"L",Count)=R,ULUNr=$P(R,D,15)
 ..Set ^HULP(%J,"S",BONNr,ULUNr)=$G(^HULP(%J,"S",BONNr,ULUNr))
 ..Set R=$S($D(^HULP(%J,"K",BONNr,ULUNr)):"INSKIND",1:"DELKIND")
 ..Set R=R_"("_Count_")"
 ..Do @R
 .Kill ^HULP(%J,"SK")
 If $D(UnKnown) Set Count=$O(^HULP(%J,"L",""),-1)+1,^HULP(%J,"L",Count)=UnKnown
 Do DISPLAY^vhScherm("ORGVERP")
 Do WRITE^vhLIST(.LD)
 Quit
 ;
SELBON 
 New %SC,%TC,TempBon
 Set TempBon=BONNr
 Do:BONNr REMOVE^vhLock("^KUL(KLNr,""F"",BONNr)")
 If OneBon set %SC=1,TempBon=""
 Else  Do
 .Do STORE^vhTERMINA()
 .For  Do FIELD^vhScherm("ORGVERP","BONNR") Quit:'X  Quit:%SC
 .Do REFRESH^vhTERMINA()
 If %SC,BONNr'=TempBon Do
 .Set R=^KU1(BONNr,"F"),KLNr=$P(R,D),ORDNr=""
 .Do INIT^vhLIST("ORGALUX","VERPAK",.LD),REFRESH
 If %SC Do  Goto SELBON:'%TC
 .Do ADD^vhLock("^KUL(KLNr,""F"",BONNr)")
 .If '%TC Do LDISP^vhLock("^KUL(KLNr,""F"",BONNr)","Bon") Set BONNr=TempBon Quit
 If BONNr,BONNr'=TempBon Set ORDNr="",Input="O"
 Else  If BONNr Set Input=""
 Else  Set Input="CANC"
 Do:BONNr BUILDBON^FLOWBON3(KLNr,BONNr),BUILDKUP^FLOWBON3(KLNr,BONNr)
 Quit
 ;
SELORD 
 New R,KLNr,ORDNrs,Count
 Do:$$ISORGAL^FLOW("L",BONNr)
 .Set KLNr=$P(^KU1(BONNr,"F"),D)
 .Set ORDNrs=$$ORDNRS(BONNr)
 .For Count=1:1:$L(ORDNrs,D) Set ORDNrs(Count)=$P(ORDNrs,D,Count)_"`"_$$REFBON^ORGALUX(BONNr,$P(ORDNrs,D,Count))
 .Set R=$$WILD^vhPOPUP("C;C","-AKO1","",.ORDNrs,ORDNr)
 .If 'R Set Input="B"
 .Else  If R=ORDNr Set Input=""
 .Else  Do
 ..Set ORDNr=R,Input="R"
 ..Do INIT^vhLIST("ORGALUX","VERPAK",.LD)
 Quit
 ;
ORDNRS(BONNr) 
 New R,KLNr,ORDNrs,BLNr
 Set ORDNrs=""
 Do:$$ISORGAL^FLOW("L",BONNr)
 .Set KLNr=$P(^KU1(BONNr,"F"),D),BLNr=100
 .For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 ..Set R=^KUL(KLNr,"F",BONNr,BLNr)
 ..Quit:$P(R,D,17)'="KF5"
 ..Set ORDNrs=ORDNrs_D_$P($P(R,D,5)," - ")
 Set $E(ORDNrs)=""
 Quit ORDNrs
 ;
MARKLINE(Input) 
 New %SC,I,R,ULUNr,Mark,AantEt,Aantal,PRNr,IsGroep
 Set Input=$G(Input)
 Set R=^HULP(%J,"L",LD("SELECT")),PRNr=$P(R,D,2),(AantEt,Aantal)=$P(R,D,3),ULUNr=$P(R,D,15)
 Set Mark=^HULP(%J,"S",BONNr,ULUNr)
 Do:"M"[$P(Mark,D)
 .If $P(Mark,D)=""!(Input="+") Do
 ..Set IsGroep=$$ISGROEP(PRNr)
 ..If Input'="+",AantEt=Aantal,'IsGroep
 ..Else  Do  Quit:'%SC
 ...If IsGroep,AantEt'[";" Set AantEt=AantEt_";"
 ...Set:$L($P(Mark,D,2)) AantEt=$P(Mark,D,2)
 ...If IsGroep,Input'="+",Aantal=1 Set %SC=1
 ...Else  If IsGroep,Input'="+",Aantal'=$E(AantEt,1,$L(AantEt)-1) Set %SC=1
 ...Else  Do FIELD^vhScherm("ORGVERP"_$S($$ISOVP^ORGALUX(PRNr):"OVP",1:""),"AANTET")
 ...If AantEt[";",$E(AantEt,$L(AantEt))'=";" Do
 ....For I=1:1:$L(AantEt,";") Set Aantal=Aantal-$P(AantEt,";",I)
 ....Set AantEt=AantEt_";" Set:Aantal>0 AantEt=AantEt_Aantal_";"
 ..Set $P(Mark,D)="M",$P(Mark,D,2)=AantEt
 ..Quit:$D(^HULP(%J,"K",BONNr,ULUNr))
 ..Do INSKIND(LD("SELECT"))
 .Else  Do DELKIND(LD("SELECT")) Set $P(Mark,D)=""
 .Set ^HULP(%J,"S",BONNr,ULUNr)=Mark
 .Kill LD("MAX")
 .Do WRITE^vhLIST(.LD)
 Quit
 ;
MARKALL 
 New I,R,Quit,PRNr
 Set Quit=0
 Do MOVE^vhLIST(.LD,"HO",0)
 If LD("SELECT"),$D(^HULP(%J,"L",LD("SELECT"))) For  Do  Quit:Quit
 .Set R=^HULP(%J,"L",LD("SELECT")),PRNr=$P(R,D,2),ULUNr=$P(R,D,15)
 .Quit:'ULUNr
 .Set R=$G(^HULP(%J,"S",BONNr,ULUNr))
 .If $P(R,D)="",'$$ISOVP^ORGALUX(PRNr) Do MARKLINE()
 .For I=LD("SELECT")+1:1 Set R=$G(^HULP(%J,"L",I)),Quit=R="" If $P(R,D,15)'="K" Quit
 .Quit:Quit
 .Do MOVE^vhLIST(.LD,"DO",0)
 Quit
 ; Inputkontrole aantal
CHKAANT(AantEt,Aantal) 
 New Check,TotAant
 Set Check="",TotAant=0
 If $l($TR(AantEt,"0123456789;","")) Set Check="Foutief aantal"
 If AantEt[";" For I=1:1:$L(AantEt,";") Do  Quit:$L(Check)
 .If '$P(AantEt,";",I),I'=$L(AantEt,";") Set Check="Het aantal mag geen nul bevatten"
 .Set TotAant=TotAant+$P(AantEt,";",I)
 If Check="",TotAant>Aantal Set Check="Het totale aantal mag niet groter zijn dan "_Aantal
 Quit Check
 ;
KINDEREN 
 New R
 Set R=^HULP(%J,"L",LD("SELECT")),ULUNr=$P(R,D,15)
 Set R=$S($D(^HULP(%J,"K",BONNr,ULUNr)):"DELKIND",1:"INSKIND")
 Set R=R_"("_LD("SELECT")_")"
 Do @R
 Kill LD("MAX")
 Do WRITE^vhLIST(.LD)
 Quit
 ;
INSKIND(MLine) 
 New I,R,ULUNr,MPRNr,KPRNr,SortKey,MAantal,KAantal
 Set R=^HULP(%J,"L",MLine),MPRNr=$P(R,D,2),MAantal=$P(R,D,3),ULUNr=$P(R,D,15),KPRNr=""
 Set ^HULP(%J,"K",BONNr,ULUNr)=""
 For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Do
 .Set R=^PRLINK("D",MPRNr,KPRNr),KAantal=$P(R,D)
 .Set SortKey=$$SORTKEY^PRODUKT(KPRNr),KPRNr(SortKey)=KPRNr_D_KAantal
 Set SortKey=""
 For  Set SortKey=$O(KPRNr(SortKey)) Quit:SortKey=""  Do
 .Set I=$O(^HULP(%J,"L",""),-1)
 .Do:I'=MLine
 ..For I=I:-1:MLine+1 Set ^HULP(%J,"L",I+1)=^HULP(%J,"L",I)
 .Set R=KPRNr(SortKey),KPRNr=$P(R,D),KAantal=$P(R,D,2)
 .Set R="",$P(R,D,2)=KPRNr,$P(R,D,3)=MAantal*KAantal,$P(R,D,15)="K",^HULP(%J,"L",MLine+1)=R
 Quit
 ;
DELKIND(MLine) 
 New I,R,ULUNr
 Set R=^HULP(%J,"L",MLine),ULUNr=$P(R,D,15)
 Kill ^HULP(%J,"K",BONNr,ULUNr)
 For  Set I=$O(^HULP(%J,"L",MLine)) Quit:I=""  Set R=^HULP(%J,"L",I) Quit:$P(R,D,15)  Do
 .Kill ^HULP(%J,"L",I)
 .For I=I+1:1 Quit:'$D(^HULP(%J,"L",I))  Do
 ..Set ^HULP(%J,"L",I-1)=^HULP(%J,"L",I)
 ..Kill ^HULP(%J,"L",I)
 Quit
 ;
PRINT 
 New I,R,Marked,ULUNr,BLNr,PRNr,Aantal,BONNrs,SortKey
 Set Marked=""
 For I=1:1 Quit:'$D(^HULP(%J,"L",I))  Do  Quit:$L(Marked)
 .Set R=^HULP(%J,"L",I),ULUNr=$P(R,D,15)
 .If ULUNr'="?" Quit:'ULUNr
 .Set Marked=$P(^HULP(%J,"S",BONNr,ULUNr),D)
 Do:Marked="" MARKALL ; Druk alle etiketten zonder eerst te markeren
 For I=1:1 Quit:'$D(^HULP(%J,"L",I))  Do
 .Set R=^HULP(%J,"L",I),PRNr=$P(R,D,2),ULUNr=$P(R,D,15)
 .If ULUNr'="?" Quit:'ULUNr
 .Set R=^HULP(%J,"S",BONNr,ULUNr),Marked=$P(R,D),Aantal=$P(R,D,2)
 .Quit:Marked'="M"
 .Set BLNr=$S(ULUNr:^BON("IU",BONNr,ULUNr),1:ULUNr)
 .Set SortKey=$$SORTKEY^PRODUKT(PRNr)_BLNr
 .Set BONNrs(BONNr,SortKey)=Aantal_D_PRNr_D_BLNr
 .Set $P(^HULP(%J,"S",BONNr,ULUNr),D)="P"
 r "?",r
 Do:$D(BONNrs) EXTERN^cwFLOWBON6(.BONNrs,,,$S($G(Transfert):%J,1:""))
 Do REFRESH
 Quit
 ;
 ; Transfereren naar een bestand
TRANSFERT
 New %SC,Dev,TCount,Rec,SkipLabel
 Set SkipLabel=0
 Do STORE^vhTERMINA(),FIELD^vhScherm("ORGVERP","SKIPLABEL")
 Do:%SC
 .Set FP=2001
 .Write @F,@F1,!?2,"Transfert ..."
 .Set:$G(io)'=1027 Dev=$$OPEN^vhDEV("\\TERMSERV\C$\ORGALUX\","ORGALUX.LBL","W","M")
 .Set:$G(io)=1027 Dev=$$OPEN^vhDEV(,"ORGALUX.LBL","W","M") ; Naar de shared indien CW
 .Do:$L(Dev)
 ..Write $TR("KortTekst;VanTot;Oms1;Oms2;Oms3;Ref;OrgRef;KlantNaam;BonNr;BonRef",";",$C(9)),!
 ..Do:SkipLabel  ; Aantal blanco etiketten om eventueel het laatst afgedrukte blad terug te gebruiken
 ...Set Rec="",$P(Rec,$C(9),10)=""
 ...For SkipLabel=1:1:SkipLabel Write Rec,!
 ..For TCount=1:1 Set Rec=$G(^HULP(%J,"T",TCount)) Quit:Rec=""  Write Rec,!
 ..Close Dev
 ..Kill ^HULP(%J,"T")
 Do REFRESH^vhTERMINA()
 Quit
 ;
 ; Controle bij afsluiten of er nog te tranfereren is
CHECKTRANSFERT()
 New Check
 Set Check=$D(^HULP(%J,"T"))
 If Check Set Check=$$^vhTXTPOP("ORGVERP","TRANSLABEL") Do:Check TRANSFERT
 Quit Check
 ;
OVERVERP 
 New %SC,I,R,Marked,KLNr,ULUNr,PRNr,AantEt,BLNr,Count
 Set R=^KU1(BONNr,"F"),KLNr=$P(R,D),Marked=""
 Set (PRNr,AantEt)=""
 Do STORE^vhTERMINA(),FIELD^vhScherm("ORGVERPOVP","AANTET"),REFRESH^vhTERMINA() Do:%SC
 .Set PRNr="V"
 .Set R="",$P(R,D,2)=PRNr,($P(R,D,15),ULUNr)="?"
 .Set Count=$O(^HULP(%J,"L",""),-1)+1
 .Set ^HULP(%J,"L",Count)=R,^HULP(%J,"S",BONNr,ULUNr)=""
 .For Count=1:1 Quit:'$D(^HULP(%J,"L",Count))  Do  Quit:$L(Marked)
 ..Set R=^HULP(%J,"L",Count),PRNr=$P(R,D,2),ULUNr=$P(R,D,15)
 ..If ULUNr'="?" Quit:'ULUNr  Quit:'$$ISOVP^ORGALUX(PRNr)
 ..Set Marked=^HULP(%J,"S",BONNr,ULUNr)
 ..Quit:Marked'=""
 ..Set Marked="M"_D_AantEt,^HULP(%J,"S",BONNr,ULUNr)=Marked
 .Do PRINT
 .If $L(Marked) Do
 ..Do:AantEt=0
 ...Kill ^HULP(%J,"L",Count),^HULP(%J,"S",BONNr,ULUNr)
 ...For Count=Count+1:1 Quit:'$D(^HULP(%J,"L",Count))  Set ^HULP(%J,"L",Count-1)=^HULP(%J,"L",Count)
 ..Set LD("MAX")=$O(^HULP(%J,"L",""),-1)
 ..Quit:LD("MAX")'<LD("SELECT")
 ..Set LD("SELECT")=LD("MAX")
 ..Kill LD("OFFSET")
 .Do WRITE^vhLIST(.LD)
 Quit
 ;
 ; Kijken of de oververpakking reeds gedrukt is
OVPPRINT() 
 ;Quit 1 ; Geen oververpakking meer
 New I,R,Printed,PRNr,ULUNr
 Set Printed=""
 For I=1:1 Quit:'$D(^HULP(%J,"L",I))  Do  Quit:Printed
 .Set R=^HULP(%J,"L",I),PRNr=$P(R,D,2),ULUNr=$P(R,D,15)
 .Quit:'$$ISOVP^ORGALUX(PRNr)
 .Set R=^HULP(%J,"S",BONNr,ULUNr),Printed=$P(R,D)="P"
 Quit Printed
 ;
 ; Kijken of een produkt gegropeerd is
ISGROEP(MPRNr) 
 New I,R,IsGroep,KPRNr
 Set KPRNr="",IsGroep=0
 For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Do  Quit:IsGroep
 .Set R=^PRLINK("D",MPRNr,KPRNr),IsGroep=$P(R,D,2)="G"
 Quit IsGroep
 ;
RPLKL New Actie
 Set Actie=$$RAADPL^KLANT(KLNr,"L")
 Do REFRESH
 Quit
 
RPLPR New PRNr,Actie
 Do:LD("SELECT")
 .Set PRNr=$P(^HULP(%J,"L",LD("SELECT")),D,2)
 .Set Actie=$$RAADPL^PRODUKT(PRNr,"1")
 .Do REFRESH
 Quit
 ;
MODBON 
 New Locals
 Set Locals("ULNr")=BONNr
 Do DO^vhPROGRAM("FUE^KF9","","",$G(NoMod)),BUILDBON^FLOWBON3(KLNr,BONNr),BUILDKUP^FLOWBON3(KLNr,BONNr),REFRESH
 Set LD("MAX")=$O(^HULP(%J,"L",""),-1)
 If LD("MAX")<LD("SELECT") Set LD("SELECT")=LD("MAX") Kill LD("OFFSET")
 Quit
 ;
EXTERN(BONNr) 
 New R,%J,KLNr,ORDNr
 Set BONNr=$G(BONNr)
 Set (KLNr,ORDNr)="",%J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Do STORE^vhTERMINA()
 If BONNr,'$$ISORGAL^FLOW("L",BONNr) Do
 .Do
 ..New BONNr
 ..Set BONNr=""
 ..Do DISPLAY^vhScherm("ORGVERP")
 .Do INIT^vhLIST("ORGALUX","VERPAK",.LD),WRITE^vhLIST(.LD)
 .Set FP=2401
 .Write @F,"Bon "_$$EXTNUM^vhDTyp(BONNr,0,".",0)_" bevat geen Orgalux!"
 .Read R
 Else  Do
 .Do:'BONNr
 ..Do DISPLAY^vhScherm("ORGVERP")
 ..Do INIT^vhLIST("ORGALUX","VERPAK",.LD),WRITE^vhLIST(.LD)
 .Do COMMAND(BONNr)
 Do REFRESH^vhTERMINA()
 Kill ^HULP(%J)
 Quit
 ;
 ; Selecteer printmode
OUTPUT
 New R,Output,zb
 Do:$$ASK^vhWACHTW("MANAGER",,,0)
 .Set Output=$$PI^vhPOPUP("C;C","-1O","Uitvoer","ORGVERP","OUTPUT",Transfert)
 .If zb'="CANC",Output'=Transfert Do
 ..If Transfert Set Check=$$CHECKTRANSFERT() Quit:Check=""  Do:Check TRANSFERT
 ..Set Transfert=Output,R=^SD("D","ORGVERP","I")
 ..If R["Transfert=" Set $E(R,$F(R,"Transfert="))=Transfert,^SD("D","ORGVERP","I")=R ; Aanpassen ^SD zodat de output permanent opgeslagen word
 ..Do DISPLAY^vhScherm("ORGVERP","","","","TRANSFERT")
 Quit