#include Prod.Product
 
SGREEP ;Produkt creatie voor stangengrepen [ 11/22/2003   1:21 PM ]
 Kill
 Do BUILD^A508
 Do INIT^vhTERMINA
 Set Q="K"
 Write @F11,@F1
 Set PRNr=$$GENERATE(,73121) ; Additek greep
 ;Set PRNr=$$GENERATE(,93260) ; Halux greep
 Write !,"PRNr = ",PRNr,*7 r r
 Quit
 
GENERATE(Ref,GenPRNr,Params) 
 New sFL,FromPRNr,NewRec,NewPRNr,KLNr,LEVNr,Taal,IsStock,KortT,PR,LT,Tabel
 Set Ref=$G(Ref),(GenPRNr,PR)=$G(GenPRNr),Params=$G(Params)
 Set:Params="K" KLNr=Ref Set:Params="L" LEVNr=Ref,IsStock=1
 Set Tabel=$S(GenPRNr=93260:"HGREEP",1:"SGREEP")
 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 NIEUW^vhScherm("SGREEP",,,,,,3)
 If %SC Do
 . Do FILLDATA
 . Do SAVE
 Quit $G(NewPRNr)
 
FILLDATA 
 For I=1:1 Quit:'$D(sFL(I))  Set NewRec(I-1)=sFL(I)
 For I="I","J","G" Set NewRec(I)=$G(sFL(I))
 ;DossierNr ingeven
 Set $P(NewRec("G"),D,1)=$$DOSNR()
 ;Korttekst opbouwen (gebruikt bij save)
 Set KortT=$$KORTTXT(NewRec("G"))
 ;Langteksten opbouwen
 Do LANGTXT(NewRec("G"),"N"),LANGTXT(NewRec("G"),"F")
 Do LANGTXT(NewRec("G"),"D"),LANGTXT(NewRec("G"),"E")
 Do BESTELRE(NewRec("G"))
 For Taal="N","F","D","E","R" Do
 . Set:Taal="N" List="0.2,0.11,6.1,6.2,6.3"
 . Set:Taal="F" List="1.22,3.21,8.1,8.2,8.3"
 . Set:Taal="D" List="2.2,3.23,10.1,10.2,10.3"
 . Set:Taal="E" List="2.1,3.22,12.1,12.2,12.3"
 . Set:Taal="R" List="4.1,4.2,4.3,4.4,4.5"
 . ;Huidige implementatie: langtekst 2 regels, Bestelref 3 reg
 . For I=1:1:3 Do
 ..  Set Node=$P($P(List,",",I),".",1)
 ..  Set Piece=$P($P(List,",",I),".",2)
 ..  Set:($D(LT(Taal,I))) $P(NewRec(Node),D,Piece)=LT(Taal,I)
 Set $P(NewRec(1),D,13)=$J($$GEWICHT(NewRec("G")),0,0)
 Set $P(NewRec("J"),D,19)=$$KSTPRIJS(NewRec("G"))
 ; Bij SIGMA grepen is er geen korting
 Set:$E($P(NewRec("G"),D,2))="S" $P(NewRec("J"),D,9)=0
 Quit
 
BUILD 
 If '$G(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) ;Id
 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
 
LEVRWEEK(Param) 
 New ItemID,LevrWeek
 Set ItemID=$P(Param,D,2)
 Set LevrWeek=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",9)
 Quit $E(LevrWeek,1,2)
 
GEWICHT(Param)  
 New Gewicht,Lengte,ItemID,SGGewV,SGGewL,SGroep
 Set Lengte=$P(Param,D,3)
 Set ItemID=$P(Param,D,2)
 Set SGGewV=^RES(Tabel,"PI","STANG","G",ItemID,"V")
 Set SGGewL=^RES(Tabel,"PI","STANG","G",ItemID,"L")
 Set Gewicht=SGGewV+(SGGewL*Lengte)
 
 Set SGroep=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",3)
 If (SGroep'["SIGMA")&&(SGroep'["LG") Do
 . New Qty,VGewL,VoetLengte
 . Set Qty=$P(Param,D,10)
 . Set VoetLengte=$P(Param,D,9)
 . Set ItemID=$P(Param,D,8)
 . Set VGewL=^RES(Tabel,"PI","VOET","G",ItemID,"L") 
 . Set Gewicht=Gewicht+(VGewL*(VoetLengte+5)*Qty)
 
 Quit $J(Gewicht,0,0)
 
BESTELRE(Param) 
 New Qty,iLoop,Cnt 
 ;Lijn 1 & 2 dienen reeds ingelezen te zijn (Do LANGTXT(Param,"N")) 
 If ((LT("N",1)="")!(LT("N",2)="")) Do 
 . Do LANGTXT(Param,"N")
 
 Set LT("R",1)=LT("N",1)
 Set LT("R",2)=LT("N",2)
 
 ;Lijn 3 opbouwen voor uiteindelijke BestelRef
 Set Cnt=0
 For iLoop=1:1:11 Do
 . If $P(Param,D,10+iLoop)'="" Do
 ..  Set Cnt=Cnt+1
 ..  Set $P(LT("R",3),";",Cnt)="A"_iLoop_"="_$P(Param,D,10+iLoop) 
 Quit
 
KORTTXT(Param) 
 New KortT,ItemID,KTxt,Kleur
 Set KortT=""
 Set ItemID=$P(Param,D,2)
 Set KTxt=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",4)
 Set Kleur=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",5)
 Set $E(KortT,1)=$E(KTxt,1,7)        ;KortTekst uit resources
 Set $E(KortT,8)=$P(Param,D,1)       ;DossierNr
 Set $E(KortT,12)=$P(Param,D,3)      ;Lengte
 Set:($P(Param,D,10)'="") $E(KortT,16)="x"_$P(Param,D,10) ;Aantal
 Set $E(KortT,26-$L(Kleur))=Kleur    ;Kleur
 Quit KortT
 
LANGTXT(Param,Taal) 
 New ItemID,iLoop,Cnt
 ;3 lijnen van langtekst clearen 
 Set LT(Taal,1)="",LT(Taal,2)="",LT(Taal,3)=""
 Set ItemID=$P(Param,D,2)
 Quit:'$D(^RES(Tabel,"PI","STANG","D",ItemID,Taal))
 
 ;Taal gevonden, lijnen L1->L2 invullen
 New ResLangTxt,IsSigmaGreep
 Set ResLangTxt=^RES(Tabel,"PI","STANG","D",ItemID,Taal)
 Set IsSigmaGreep=($P($G(^RES(Tabel,"PI","STANG","D",ItemID,"N")),";")["Sigmagreep")
 Set LT(Taal,1)=$P(ResLangTxt,";",1)
 New TLen,TVoet
 If Taal="N" Set TLen="Lengte" Set TVoet="voetjes"
 Else  If Taal="F" Set TLen="Longueur" Set TVoet="pieds"
 Else  If Taal="E" Set TLen="Length" Set TVoet="feet"
 Else  If Taal="D" Set TLen="L"_$C(228)_"nge" Set TVoet="fuss"
 Else  Set TLen="(Lengte)" Set TVoet="(voetjes)"
 
 
 ;Bij SIGMAGREEP bestaat langtxt uit twee regels
 If IsSigmaGreep Do    ;SIGMA!!
 . Set LT(Taal,2)=TLen_" "_$P(Param,D,3)_"mm, "_$P(ResLangTxt,";",2)
 Else  Do
 . Set LT(Taal,2)=TLen_" "_$P(Param,D,3)_"mm, "_$P(Param,D,10)_" "_TVoet
 . ;Wanneer VoetType & VoetLengte'=Default moet L2 worden uitgebreid 
 . New ItemID,VoetType,VoetLengte,Defaults
 . Set ItemID=$P(Param,D,2)
 . Set VoetType=$P(Param,D,8)
 . Set VoetLengte=$P(Param,D,9)
 . Set Defaults=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",7,8)
 . If VoetType_"`"_VoetLengte'=Defaults Do
 . . Set LT(Taal,2)=LT(Taal,2)_", "_VoetType_" "_VoetLengte_"mm"
 . Set Cnt=0
 . For iLoop=1:1:11 Do
 . . If $P(Param,D,10+iLoop)'="" Do
 . . . Set Cnt=Cnt+1
 . . . Set $P(LT(Taal,3),";",Cnt)="A"_iLoop_"="_$P(Param,D,10+iLoop)
 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 ^KPR(NewPRNr,"I")=""
 Set ^KPR(NewPRNr,"I1")=NewRec("I")
 Set ^KPR(NewPRNr,"J")=""
 Set ^KPR(NewPRNr,"J"_$P(NewRec("J"),D))=NewRec("J")
 ;Indexen
 Do RECALC^PRODUKT2(NewPRNr)
 Do BLDIND^PRODUKT2(NewPRNr)
 Do ZEND^EWPR(NewPRNr)
 Quit
 
SetSchaduwPrijs(PRNr)
 Quit:'$D(^KPR(PRNr))
 Set Param=^KPR(PRNr,"G")
 Set KostPrijs=$$KSTPRIJS(Param)
 Do $$$PRSet($$$SchaduwPPL,KostPrijs)
 Quit
 	 
KSTPRIJS(Param) 
 New KstPrijs,ItemID,SGKstV,SGKstL,Lengte
 ;w "Params ",Param,!
 Set Lengte=$P(Param,D,3)
 Set ItemID=$P(Param,D,2)
 Quit:'$D(^RES(Tabel,"PI","STANG","D",ItemID)) ""
 Set StdVoetLengte=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",8)
 Set VoetLengte=$P(Param,D,9)
 Set SGKstV=^RES(Tabel,"PI","STANG","K",ItemID,"V") ; vaste kost incl. 2 voetjes
 Set SGKstL=^RES(Tabel,"PI","STANG","K",ItemID,"L") ; lengte afhankelijke kost
 Set SGKstT=$G(^RES(Tabel,"PI","STANG","K",ItemID,"T")) ; Toeslag indien lengte > 1500
 Set KstPrijs=SGKstV+(SGKstL*Lengte)
 ;w "KstPrijs stang ",KstPrijs,!
 If Lengte>1500 set KstPrijs=KstPrijs+SGKstT
 ;w "KstPrijs stang extra lengte ",KstPrijs,!
 
 Set SGroep=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",3)
 If (SGroep'["SIGMA") Do
 . New VKstV,Qty,VoetID,VKstT
 . Set VoetID=$P(Param,D,8)
 . Set:VoetID="" VoetID=$P(^RES(Tabel,"PI","STANG","D",ItemID),"`",7)
 . ;w VoetID
 . Quit:VoetID=""
 . Set VKstV=$G(^RES(Tabel,"PI","VOET","K",VoetID,"V")) ; vaste kost van 1 voetje vertrekkend van het derde voetje
 . Set VKstT=$G(^RES(Tabel,"PI","VOET","K",VoetID,"T")) ; toeslag indien voetlengte afwijkende van standaard maat
 . Set Qty=$P(Param,D,10)
 . Set:Qty<2 Qty=1 ;  normaal minstens 2 boringen of voetjes, soms wordt er echter geen gekozen, dan wordt er 1 voetje afgetrokken geen twee
 . Set KstPrijs=KstPrijs+(VKstV*(Qty-2))
 . ;w "KstPrijs extra voetje ",KstPrijs,!
 . Set:StdVoetLengte'=VoetLengte KstPrijs=KstPrijs+(VKstT*Qty)
 . ;w "KstPrijs extra lengte voetje ",KstPrijs,!
 
 Quit $J(KstPrijs,0,2)
 
DOSNR() 
 New DosNr
 Lock +^KPR(0,"SGNR")
 Set DosNr=$G(^KPR(0,"SGNR"))+1,$P(^KPR(0,"SGNR"),D)=DosNr
 Lock -^KPR(0,"SGNR")
 Quit $$ALFAKEY^vhRtn1(DosNr,"A")
 
VOETDEF(X) ; CB van vhScherm :Afhankelijk van de stang wordt de krijgt de voet een default waarde
 Quit:X=""
 Set Rec=$G(^RES(Tabel,"PI","STANG","D",X))
 If $P(Rec,"`",3)="SIGMA"!($P(Rec,"`",3)="INKORT") Do  ; sigma grepen alleen lengte
 .Do PUTATTR^vhScherm("HOOGTE","H","HD"),PUT^vhScherm("HOOGTE","")
 .Do PUTATTR^vhScherm("VOETTYPE","H","HD"),PUT^vhScherm("VOETTYPE","")
 .Do PUTATTR^vhScherm("QTYVOET","H","HD"),PUT^vhScherm("QTYVOET","")
 .Do PUTATTR^vhScherm("TOTAAL","H","HD")
 .For I=1:1:11 Do PUTATTR^vhScherm("A"_I,"H","HD"),PUT^vhScherm("A"_I,"")
 Else  If $P(Rec,"`",3)="LG" Do
 .Do PUTATTR^vhScherm("HOOGTE","H","HD"),PUT^vhScherm("HOOGTE","")
 .Do PUTATTR^vhScherm("VOETTYPE","H","HD"),PUT^vhScherm("VOETTYPE","")
 .Do REMATTR^vhScherm("QTYVOET","H","HD")
 .Do REMATTR^vhScherm("TOTAAL","H","HD")
 .For I=1:1:11 Do REMATTR^vhScherm("A"_I,"H","HD")
 Else  Do  ; Stangengreep
 .Do REMATTR^vhScherm("HOOGTE","H","HD")
 .Do REMATTR^vhScherm("VOETTYPE","H","HD")
 .Do REMATTR^vhScherm("QTYVOET","H","HD")
 .Do REMATTR^vhScherm("TOTAAL","H","HD")
 .For I=1:1:11 Do REMATTR^vhScherm("A"_I,"H","HD")
 Do PUT^vhScherm("VOETTYPE",$P(Rec,"`",7))
 Do PUT^vhScherm("HOOGTE",$P(Rec,"`",8))
 Do REPAINT^vhScherm("")
 Quit
 
SETVOET(Qty) 
 For Nr=1:1:11 Do
 . Do REMATTR^vhScherm("A"_Nr,"H","HD")
 For Nr=Qty+1:1:$S(+Qty=0:11,1:10) Do
 . Do PUTATTR^vhScherm("A"_Nr,"H","HD")
 Do:Qty>0 REMATTR^vhScherm("A"_11,"H","HD")
 Do:Qty>0 REMATTR^vhScherm("TOTAAL","H","HD")
 Do:+Qty=0 PUTATTR^vhScherm("TOTAAL","H","HD")
 Do REPAINT^vhScherm("")
 For Nr=Qty+1:1:$S(+Qty=0:11,1:10) Do
 . Do PUT^vhScherm("A"_Nr,"")
 Quit
 
VALIDATE(sFld,Input) ;CB van vhScherm voor validatie van de afstand tussen de voetjes
 New Control,Lengte,Val
 ; Deel 1 : HIDE en SHOW van de afstand velden afh. van het aantalvoeten
 Set sFld=$$FLDID^vhScherm(sFld)
 If sFld="LENGTE"&$G(sDir) Quit
 Do PUT^vhScherm(sFld,Input)
 Set Qty=$$GET^vhScherm("QTYVOET")
 Set Lengte=$$GET^vhScherm("LENGTE")
 Set Afstand=$$GET^vhScherm("A1")
 If (sFld="QTYVOET")!(sFld="LENGTE") Do 
 . Do SETVOET(Qty)
 . Set:'Afstand Afstand=50 ; Standaard afstand 
 
 ; Deel 2 : Vertrekkend van de randafstand worden de tussen afstanden ingevuld
 If sFld="A1"!(sFld="QTYVOET")!(sFld="LENGTE") Do  ; Defaults invullen
 . Do PUT^vhScherm("A1",Afstand)
 . Do PUT^vhScherm("A11",Afstand)
 . Set Val=+$J(Lengte-$$GET^vhScherm("A1")-$$GET^vhScherm("A11")/(Qty-1),0,1)
 . For Nr=2:1:Qty Do
 .. Do PUT^vhScherm("A"_Nr,Val)
 
 ; Deel 3 : Controle door som van de afstanden  
 If $$CONTROLE(sFL("G")) Do
 . Do REMATTR^vhScherm("TOTAAL","","KB")
 Else  Do
 . Do PUTATTR^vhScherm("TOTAAL","","KB")
 Do PUT^vhScherm("TOTAAL",$$SOMAFST(sFL("G")))
 Quit
 
CONTROLE(Rec) New Lengte,Som,RecPI
 Quit:$P(Rec,D,2)="" 1
 Set RecPI=$G(^RES(Tabel,"PI","STANG","D",$P(Rec,D,2)))
 Quit:$P(RecPI,"`",3)="SIGMA" 1  ; Sigma greep steeds true
 Set Lengte=$P(Rec,D,3)
 Set Som=$$SOMAFST(Rec)
 Quit $S(Som<Lengte:Lengte-Som,1:Som-Lengte)<.2
 
SOMAFST(Rec) 
 New Som,I
 Set Som=0
 For I=11:1:21 Set Som=Som+$P(Rec,D,I)
 Quit Som
 
LABEL ;Manueel STANGENGREEP
 
 ;---=[IMPORT]=---
IMPORT ;Importeren van ResourceTabel
 ;GlobVars Wissen
 New iLoop
 For iLoop="D","G","K" Do 
 . Kill ^RES(Tabel,"PI","STANG",iLoop)
 . Kill ^RES(Tabel,"PI","VOET",iLoop)
 ;SGREEP Lijst inlezen (TAB delimited)
 Set FileNm=$$READ^vhDEV(,"SGREEP.txt","D`CBIMPSG^SGREEP","B","P")
 ;VOET Lijst inlezen (TABs)
 Set FileNm=$$READ^vhDEV(,"VOET.txt","D`CBIMPV^SGREEP","B","P")
 Quit
 
CBIMPSG(Rec) ;CallBack Import Routine STANGGREEP
 New tmpItemID,D
 Set D="`" 
 Set Rec=$TR(Rec,$C(9),D)
 Write Rec,!
 Set tmpItemID=$P(Rec,D,1)
 Quit:(tmpItemID="")
 Set ^RES(Tabel,"PI","STANG","D",tmpItemID)=$P(Rec,D,2,10)
 
 ;Array Kost
 Set Cnt=10
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES(Tabel,"PI","STANG","K",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 ;Array Gewicht
 Set Cnt=12
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES(Tabel,"PI","STANG","G",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 
 ;Array Taal
 Set Cnt=14
 For Taal="N","F","D","E" Do
 . Set Cnt=Cnt+1
 . If $P(Rec,D,Cnt)'="" Do
 ..  Set ^RES(Tabel,"PI","STANG","D",tmpItemID,Taal)=$P(Rec,D,Cnt)
 
 Quit
 
CBIMPV(Rec) ;CallBack Import Routine VOET
 New tmpItemID,D
 Set D="`" 
 Set Rec=$TR(Rec,$C(9),D)
 Write Rec,!
 Set tmpItemID=$P(Rec,D,1)
 Quit:(tmpItemID="")
 Set tmp=$P(Rec,D,4)
 If $E(tmp)="""" Set $E(tmp)="",$E(tmp,$L(tmp))="",$P(Rec,D,4)=tmp
 Set ^RES(Tabel,"PI","VOET","D",tmpItemID)=$P(Rec,D,2,5)
 
 ;Array Kost
 Set Cnt=5
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES(Tabel,"PI","VOET","K",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 ;Array Gewicht
 Set Cnt=7
 For Key="V","L" Do
 . Set Cnt=Cnt+1
 . Set ^RES(Tabel,"PI","VOET","G",tmpItemID,Key)=$TR($P(Rec,D,Cnt),",",".")
 Quit
 
EXPORT ;Exporteren van Toeleveringen  
 Write @F11,@F1
 Write @FMTI,"VAN HOECKE nv - Opbouw export STANGENGREPEN voor ADDITEK",@FMTi,!,!
 New LevNrKey,TLevKey
 New Klant,BestelD,LeverD,RegelNr,OrderRef,KortTekst
 New PrijsSt,TypStang,Len,LenVoet,TypVoet,Qty,Afstand,Line,VQty
 New OrderNr,KlantNr,IProdNr,LnNr,Dev,ExpLine,FileName
 
 Set LevNrKey="6502"
 Set TLevKey=""
 Set FileName=$P(^KLE(^KL1(LevNrKey),0),D,2)   ;Leveranciersnaam
 Set FileName=FileName_$$EXTDATE^vhDTyp(,"DKN4")_".txt" ;Naam+datum+txt 
 Set Dev=0
 
 Lock +^KTO(LevNrKey)
 For  Set TLevKey=$O(^KTO(LevNrKey,TLevKey)) Quit:(TLevKey="")  Do
 . Do MAINITEM(LevNrKey,TLevKey)
 Lock -^KTO(LevNrKey)
 
 If $L(Dev)'>1  Do             ;INDIEN DEV=0->GEEN TOELEVERINGEN (GEEN FILE) 
 . Set Answer=$$^vhTXTPOP("SGREEP","NOEXPORT") ;Geen toeleveringen!
 Else  Do
 . Close Dev             ;Toeleveringen in bestand,dit sluiten
 . Set Answer=$$^vhTXTPOP("SGREEP","MARK") ;Toeleveringen markeren?
 . If Answer="J" Do
 ..  Do PUTMARKs
 ..  Set Answer=$$^vhTXTPOP("SGREEP","MAIL",,FileName) ; Send mail
 Quit
 
MAINITEM(LevNrKey,TLevKey)   ;MainItems:alles @1->@100 
 Set Line=^KTO(LevNrKey,TLevKey,1)
 Set Klant=$P(Line,D,3) 
 Set BestelD=$$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(Line,D,2)),"DK4")
 Set BestelD=$TR(BestelD,"-")
 Set OrderNr=$P(Line,D,7)
 Set KlantNr=$P(Line,D,8)
 Set OrderRef=$S(OrderNr=""!(KlantNr=""):"Stock",1:$P($G(^KOD(KlantNr,"F",OrderNr,1)),D,3))
 If OrderRef?2N1E2N1E2N.E Do  ;Eventuele datum verwijderen
 . Set OrderRef=$E(OrderRef,9,9999)
 . For  Quit:($E(OrderRef,1,1)'=" ")  Set $E(OrderRef,1,1)=""
 ;LIJNEN AFHANDELEN
 Set LnNr="100"
 For  Set LnNr=$O(^KTO(LevNrKey,TLevKey,LnNr)) Quit:(LnNr="")  Do 
 . Set ExpLine=""
 . Do SUBITEMS(LevNrKey,TLevKey,LnNr)
 Quit
 
SUBITEMS(LevNrKey,TLevKey,LnNr)  ;SubItems:alles waarbij @3>100 
 Quit:$P(^KTO(LevNrKey,TLevKey,LnNr),D,14)  ;Reeds gemarkeerd? Stop dan 
 Set Line=^KTO(LevNrKey,TLevKey,LnNr)       ;Data inlezen
 Set RegelNr=$P(Line,D,15)
 Set IProdNr=$P(Line,D,2)
 Quit:IProdNr'?4.7N
 Quit:$P(^KPR(IProdNr,0),D,3)'=73121  ; Additek generisch nummer
 Set LeverD=$$INTDATE^vhDTyp($P(Line,D,25),"DW")-1
 Set LeverD=$TR($$EXTDATE^vhDTyp(LeverD,"DK4"),"-")
 Set KortTekst=$P(^KPR(IProdNr,0),D,1)
 Set Qty=$P(Line,D,3)
 Set PrijsSt=$P(Line,D,6)*((100-$P(Line,D,7))/100)   ;Eenprijs & korting
 If $P(Line,D,21)="H" Set PrijsSt=PrijsSt/100  ;H:verkoop per 100
 Set TypStang=$P(^KPR(IProdNr,"G"),D,2) 
 Set Len=$P(^KPR(IProdNr,"G"),D,3)
 Set LenVoet=$P(^KPR(IProdNr,"G"),D,9)
 Set TypVoet=$P(^KPR(IProdNr,"G"),D,8)
 Set VQty=$P(^KPR(IProdNr,"G"),D,10)
 
 Do EXPLINEA("VAN HOECKE",1,10)      ;Data toevoegen aan lijn die 
 Do EXPLINEA(BestelD,11,8)           ;uiteindelijk in bestand komt 
 Do EXPLINEA(LeverD,19,8)    
 Do EXPLINEA(TLevKey,27,6,1,0)
 Do EXPLINEA(RegelNr,33,6)   
 Do EXPLINEA(OrderRef,39,30)
 Do EXPLINEA(KortTekst,69,25) 
 Do EXPLINEA(Qty,94,4,1,0)      
 Do EXPLINEA(PrijsSt,98,7,1,2) 
 Do EXPLINEA(TypStang,105,6)  
 Do EXPLINEA(Len,111,6,1,1)  
 Do EXPLINEA(TypVoet,117,6)   
 Do EXPLINEA(LenVoet,123,4,1)    
 Do EXPLINEA(VQty,127,1,0)    
 For Afst=1:1:11 Do
 .Do EXPLINEA($P(^KPR(IProdNr,"G"),D,10+Afst),122+(Afst*6),6,1,1,Afst=5)
 
 If $L(Dev)'>1 Set Dev=$$OPEN^vhDEV(,FileName,"W") Use Dev
 Write ExpLine,!   ;Wegschrijven van lijn in bestand
 Quit
 
EXPLINEA(Val,Begin,MaxLen,Numeric,Decimal,EOL)  ;lijn bijwerken ahv para's
 Set Numeric=$G(Numeric,0)
 Set EOL=$G(EOL,0)
 Set Decimal=$G(Decimal,1)  ;DEFAULT: 1 decimaal (bijv. 1,2)
 If Numeric Do   ;-NUMERIEK
 . Set $E(ExpLine,Begin)=$E($J(Val,MaxLen,Decimal),1,MaxLen)
 Else  Do        ;-NIET NUMERIEK
 . If EOL Do        ;-EINDE VAN DE REGEL
 ..  Set $E(ExpLine,Begin)=$E(Val,1,MaxLen)_$J(" ",MaxLen-$L(Val))
 . Else  Do         ;-NIET EINDE VAN REGEL
 ..  Set $E(ExpLine,Begin)=$E(Val,1,MaxLen)
 Quit
 
PUTMARKs ;Markeringen toevoegen aan KTO, ABLijnNummer(piece 14)
 New Regel,Rec,PRNr
 Set Dev=$$OPEN^vhDEV(,FileName,"R","M")
 Use Dev
 Set Regel=""
 Lock +^KTO(LevNrKey)
 For  Read Regel Quit:(Regel="")  Do 
 . Set TLevKey=$TR($E(Regel,27,32)," ")
 . Set RegelNr=$TR($E(Regel,33,38)," ")
 . Set LnNr=^TO("IU",TLevKey,RegelNr)
 . Set Rec=^KTO(LevNrKey,TLevKey,LnNr),PRNr=$P(Rec,D,2)
 . Kill:PRNr ^KTO3(TLevKey,$P(Rec,D,13,14)_D_LnNr)
 . Set $P(Rec,D,14)=1,^KTO(LevNrKey,TLevKey,LnNr)=Rec
 . Set:PRNr ^KTO3(TLevKey,$P(Rec,D,13,14)_D_LnNr)=""
 Lock -^KTO(LevNrKey)
 Close:0'[Dev Dev
 Quit
 
REMMARK(TOENr) 
 New Rec,PRNr
 Set LEVNr="6502"
 Set LNr=""
 For  Set LNr=$O(^KTO(LEVNr,TOENr,LNr)) Quit:LNr=""  Do
 . Set Rec=^KTO(LEVNr,TOENr,LNr),PRNr=$P(Rec,D,2)
 . Kill:PRNr ^KTO3(TOENr,$P(Rec,D,13,14)_D_LNr)
 . Set $P(Rec,D,14)="",^KTO(LEVNr,TOENr,LNr)=Rec
 . Set:PRNr ^KTO3(TOENr,$P(Rec,D,13,14)_D_LNr)=""
 Quit