#include BL.Derde.LevSpecifiek
 
HADVUL ;Statistiek portefeuille [ 09/24/2003  11:40 AM ]
 New %J,LD,LEVNr,Input,GVORDNr,SortType
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set LEVNr=6332 ; HALUX
 Do INIT
 Set GVORDNr=$$ORDDEF
 Do FETCH()
 Do REFRESH
 For  Do  Quit:Input="-"!(Input="CANC")
 .Set Input=$$SCROLL^vhLIST(.LD)
 .Set Select=LD("SELECT")
 .Set PRNr=$S(Select:$P(^HULP(%J,"L",Select),D,1),1:"")
 .If Input="COM"  Set Input="" Do CALL^vhMenu("HADVUL")
 .Do EXEC^vhMenu("HADVUL",.Input)
 Do CLEAN
 Quit
 
INIT Set SortType="V"
 Do INIT^vhLIST("HADVUL","OVZ",.LD)
 Quit
 
 
CLEAN If GVORDNr,'$D(^HADPR("GVO",GVORDNr)) Kill ^HADPR("GVB",GVORDNr)
 Quit
 
REFRESH 
 Write @F11,@F1
 Do INIT^vhLIST("HADVUL","OVZ",.LD)
 Do DISPLAY^vhScherm("HADVULT")
 Do WRITE^vhLIST(.LD)
 Quit
 
OPEN Set GVORDNr=$$ORDPOP()
 Do FETCH()
 Do REFRESH
 Quit
 
SORTPOP Set SortType=$$PI^vhPOPUP("C;C","BKO2","Sorteervolgorde","HADVUL","SORTPOP")
 Do FETCH()
 Do REFRESH
 Quit
 
 ; PlaniMat via .Local
FETCH(Node,SortCode,PlaniMat) 
 New RecO,VolgNr,Cnt,Key,FabKey
 If $G(Node)="" Set Node="L"
 If $G(SortCode)="" Set SortCode=SortType
 Kill ^HULP(%J,"S"),^HULP(%J,Node)
 Set (FabKey,Cnt)=""
 Set PlaniMat=0
 For  Set FabKey=$O(^HADPR("GVO",GVORDNr,FabKey)) Quit:FabKey=""  Do
 .Set RecO=^(FabKey)
 .Quit:'$D(^KPR($P(RecO,D,1)))
 .Set Cnt=Cnt+1
 .Set ^HULP(%J,"S",$$SORT(SortCode,FabKey,RecO,.PlaniMat),Cnt)=RecO
 Set Key="",VolgNr=""
 Set Cnt=0
 For  Set Key=$O(^HULP(%J,"S",Key)) Quit:Key=""  Do
 .For  Set VolgNr=$O(^HULP(%J,"S",Key,VolgNr)) Quit:VolgNr=""  Do
 ..Set Cnt=Cnt+1
 ..Set ^HULP(%J,Node,Cnt)=^HULP(%J,"S",Key,VolgNr)
 Quit
 
 ;PlaniMat via .Local
SORT(Type,FabKey,RecO,PlaniMat) 
 New Key,PRNr,TOENr,KLNr,Vulling
 Set Key=""
 Set PRNr=$P(RecO,D,1)
 Set TOENr=$P(RecO,D,4)
 Set Vulling=$P($G(^HADPR("P",PRNr,"GV")),D,1)
 ;s:$L(Vulling)="" ^PVHADVUL=PRNr_","_TOENr
 Set:$L(Vulling)&&$ZCVT($P($G(^RES("HAD","PI","VULLING","D",Vulling)),"`",2),"U")["PLANILAK MAT" PlaniMat=$G(PlaniMat)+1
 If Type="K" Do  ; Klantnaam
 .Set KLNr=$P($G(^KTO(6332,TOENr,1)),D,8)
 .Set:'KLNr KLNr=$P(RecO,D,6)
 .Set Key=$P($S(KLNr="":"*****",1:$G(^KK1(KLNr),"*")),D)
 .Set Key=Key_";"_TOENr
 Else  If Type="B" Do  ; Batch
 .Set Key=$P($G(^HADPR("F",FabKey)),D,1)_";"_TOENr
 Else  If Type="V" Do  ; Vulling
 .Set Key=$P($G(^HADPR("P",PRNr,"GV")),D,1,2)_";"_TOENr
 Else  If Type="D" Do  ; Dossiernr
 .Set Key=$P($G(^KPR(PRNr,"G")),D,1)
 Else  If Type="T" Do  ; Toelevering
 .Set Key=$P(RecO,D,4)
 Set:Key="" Key="*"
 Quit Key
 
CBOVZ(Select,Rec) 
 Do CBFETCH($P(Rec,D,1),$P(Rec,D,4),$P(Rec,D,5),$P(Rec,D,6))
 Quit
 
CBFETCH(PRNr,TOENr,TULNr,KLNr2) 
 New KLNr,VulExtra,VolgNr,Cnt,ORDRef,GVORDNr,FabKey
 Set FabKey=$$FABKEYT^HADOPV(TOENr,TULNr)
 Set sFL(0)=^KPR(PRNr,0)
 Set KLNr=$P($G(^KTO(6332,TOENr,1)),D,8)
 Set:'KLNr KLNr=KLNr2
 Set:'KLNr KLNr="*"
 Set ORDRef=""
 If KLNr=3479 Do  ;Svedex
 . Set ORDNr=$P($G(^KTO(6332,TOENr,1)),D,7)
 . Quit:'ORDNr
 . Set ORDRef="Svedex "_$E($P($G(^KOD(KLNr,"F",ORDNr,1)),D,3),10,99)
 Else  Do
 . Set ORDRef=$S(KLNr="":"*****",1:$P($G(^KKL($G(^KK1(KLNr),"*"),0)),D,2))
 Set sFL("K")=D_ORDRef ; Klantreferentie 
 Set sFL("G")=$G(^KPR(PRNr,"G"))
 Set sFL("P")=$G(^HADPR("F",FabKey))
 Set sFL("B")=$G(^HADPR("F",FabKey,"B"))
 Set sFL("V")=$G(^HADPR("P",PRNr,"GV"))
 Set VulExtra=$P(sFL("V"),D,2)
 For  Quit:$E(VulExtra)'=";"  Set $E(VulExtra)=""
 For  Quit:$E(VulExtra,$L(VulExtra))'=";"  Set $E(VulExtra,$L(VulExtra))=""
 ;Set:$E($P(sFL("G"),D,2),1,3)="PBA" VulExtra="PBA" ; temp profiel kennnen
 Set $P(sFL("V"),D,2)=VulExtra
 Set (VolgNr,Cnt)=""
 For  Set VolgNr=$O(^HADPR("P",PRNr,"GV","B",VolgNr)) Quit:VolgNr=""  Set Cnt=Cnt+1
 Set $P(sFL("V"),D,10)=Cnt
 Quit
 
ORDDEF() New GVORDNr
 Set GVORDNr=""
 If '$D(^HADPR("GVB")) Quit "*" 
 For  Set GVORDNr=$O(^HADPR("GVB",GVORDNr),-1) Quit:GVORDNr=""  Quit:'$P(^HADPR("GVB",GVORDNr),D,3)
 Set:GVORDNr GVORDNr=$$ORDPOP("A")
 Set:'GVORDNr GVORDNr=$$ORDPOP()
 Quit GVORDNr
 
ORDPOP(Optie) 
 ; Optie : A : Afgesloten NIET opnemen in de lijst
 ;         N : bovenaan de lijst optie "Nieuw"
 ;         M : Multiple select
 New X,Y,GVORDNr2,LevNr,Sort,Ref,Rec
 Set GVORDNr2=""
 Set Y=0
 Set Optie=$G(Optie)
 If Optie["N" Do
 . Set LevNr=""
 . For  Set LevNr=$O(^RES("HADVUL","PI","GLASLEV","D",LevNr)) Quit:LevNr=""  Do
 .. Set:LevNr=6831 Sort($P(^RES("HADVUL","PI","GLASLEV","D",LevNr),"`"))="N"_LevNr_D_$P(^RES("HADVUL","PI","GLASLEV","D",LevNr),"`",2)
 . Set Sort=""
 . For  Set Sort=$O(Sort(Sort)) Quit:Sort=""  Do
 .. Set Y=Y+1,Y(Y)=Sort(Sort)
 . Set Y=Y+1,Y(Y)="&S&C Bestaande "
 For  Set GVORDNr2=$O(^HADPR("GVB",GVORDNr2)) Quit:GVORDNr2=""  Do
 . If Optie["A" Quit:$P(^HADPR("GVB",GVORDNr2),D,3)
 . If Optie["N",GVORDNr2'=150 Quit
 . Set Rec=^HADPR("GVB",GVORDNr2)
 . Set Ref=$P($G(^RES("HADVUL","PI","GLASLEV","D",$P(Rec,D))),"`",2)
 . Set Ref=$E(Ref_$J("",15-$L(Ref)),1,15)_"| "_$$EXTDATE^vhDTyp($P(Rec,D,2),"DK")_" "_$S($P(Rec,D,4):"B",1:"")
 . Set Y=Y+1,Y(Y)=GVORDNr2_D_Ref
 Set X=$$WILD^vhPOPUP("C;C","KO2-"_$S(Optie["M":"M",1:""),"Glasbestelling",.Y,$S(Optie["N":"",1:GVORDNr))
 If $E(X)="N" Do  ; Nieuw
 .Set Rec=$E(X,2,99)_D_$H
 .Set X=$O(^HADPR("GVB",""),-1)+1
 .Set:X<100 X=101
 .Set ^HADPR("GVB",X)=Rec
 Else  If Optie["N" Do  ;Bestaande batch bij nieuw
 .Set Ok=$$^vhTXTPOP("HADVUL","NEWBATCH",,X)
 .Set:'Ok X=""
 Quit X
 
FETCHDTL(Batch,Som) 
 New VolgNr,RecB,PRNr,Qty,Type,Code,RecS,Som,Piece,Type,PRNr,FabKey
 S X=X/0 ; Test of wordt gebruikt
 Set VolgNr=""
 For  Set VolgNr=$O(^HADPR("O",Batch,VolgNr)) Quit:VolgNr=""  Do
 .Set RecB=^HADPR("O",Batch,VolgNr)
 .Set FabKey=$$FABKEYB^HADOPV(RecB)
 .Set PRNr=$P(RecB,D,3)
 .Set Qty=$P(RecB,D,7)
 .Set Type=$P(RecB,D)
 .Quit:Type="DV"
 .For Code="B","H","G","T","L","Z","F" Do
 ..Set RecS=$G(^HADPR("F",FabKey,Code))
 ..Set Som(Code)=$G(Som(Code))
 ..Quit:$P(RecS,D,3)="-"  ; Niet van toepassing
 ..Set Piece=$S(Type="KM":1,1:3)+$S($P(RecS,D,3)="A":0,1:1)
 ..Set $P(Som(Code),D,Piece)=$P(Som(Code),D,Piece)+Qty
 .Set $P(Som,D,$S(Type="KM":1,1:3))=$P($G(Som),D,$S(Type="KM":1,1:3))+Qty
 Quit
 
DISPDTL(Select) 
 New sFL
 Set sFL("O")=^HULP(%J,"L",Select)
 Do CBOVZ(Select,sFL("O"))
 Merge sFL=^HADPR("P",PRNr,"GV","B")
 Do DISPLAY^vhScherm("HADVUL",,,,,,3)
 Quit
 
DISPGLAS(PRNr,TOENr,TULNr,KLNr,Opties) ; Wordt opgeroepen vanuit HADOPV
 New sFL
 Set sFL("O")=D_D_D_TOENr_D_TULNr
 Do CBFETCH(PRNr,TOENr,TULNr,KLNr)
 Merge sFL=^HADPR("P",PRNr,"GV","B")
 Do:$G(Opties)["W" DISPLAY^vhScherm("HADVUL",,,,,,3)
 Do:$G(Opties)'["W" DISPLAY^vhScherm("HADVUL")
 Quit
 
GETGLAS(Batches,GVORDNr2,BestelWk,Opties) 
 ;Ophalen van de vulling voor een bepaalde leverweek rekening houdend met de levertermijn
 New LevNr,AddCnt,I,VolgNr,ORec,PRNr,GVRec,TOENr,TULNr,TLNr,LevTrm,Batch,LevWk,Qty,FabKey,ProfSel,ProfType,ProdDatum
 Do REFRESH^HADSTAT2(LEVNr,"T") ;; Vooralleer op te halen eerst opnemen van nieuwe toelevering in ^HADPR
 Set LevNr=6332
 If '$L($G(GVORDNr2)) Set GVORDNr2=$$ORDPOP("AN")
 Quit:'$L(GVORDNr2)
 If '$L($G(Batches)) Set Batches=$$BATCHALL^HADBATCH()
 ;Set ProfSel=$$PI^vhPOPUP("C;C","OK1B","Profiel selectie","HADVUL","PROFSEL")
 Set:'$G(BestelWk) BestelWk=$H
 If $G(Opties)["W" Do FIELD^vhScherm("HADVULS","BESTELWK")
 Set BestelWk=$$CALCDATE^vhDTyp(BestelWk,"W","LD")
 Quit:'BestelWk
 Set AddCnt=0
 Set PlaniMat=0
 ;Write @F11,@F1
 For I=1:1:$L(Batches,";") Set Batch=$P(Batches,";",I) Do:$L(Batch)
 . Set VolgNr=""
 . For  Set VolgNr=$O(^HADPR("O",Batch,VolgNr)) Quit:VolgNr=""  Do
 .. Set ORec=^HADPR("O",Batch,VolgNr)
 .. Set FabKey=$$FABKEYB^HADOPV(ORec)
 .. Set PRNr=$P(ORec,D,3)
 .. Set ProfType=$P($G(^HADPR("P",PRNr,"GK")),D,2)
 .. ;If ProfSel'="R",$E(ProfType,2)'=ProfSel Quit
 .. Set GVRec=$G(^HADPR("P",PRNr,"GV"))
 .. Quit:'$L(GVRec)
 .. Set TOENr=$P(ORec,D,6)
 .. Set TULNr=$P(ORec,D,5)
 .. Set TLNr=$G(^TO("IU",TOENr,TULNr))
 .. Quit:TLNr=""
 .. Set LevTrm=$P(GVRec,D,7)
 .. Set LevWk=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp($P(^KTO(LevNr,TOENr,TLNr),D,25),"DW"),"W",-LevTrm-1,"LD") ; Het glas moet toekomen 1 week voor de toeleveringsdatum
 .. Quit:$P($G(^HADPR("F",FabKey,"B")),D,3)="-"
 .. Quit:$P($G(^HADPR("F",FabKey,"B")),D,3)="A"  ; Reeds besteld
 .. Quit:$P($G(^HADPR("F",FabKey,"G")),D,3)="A"  ; Reeds geleverd
 .. ;Write PRNr," ",$P(^KTO(LevNr,TOENr,TLNr),D,25),"=",LevWk,">",BestelWk,"=",$$EXTDATE^vhDTyp(BestelWk,"DW"),!
 .. Quit:LevWk>BestelWk
 .. Set Qty=$P(ORec,D,7)
 .. ;Set LevWk=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp($P(^KTO(LevNr,TOENr,TLNr),D,25),"DW"),"W",-1,"LD") ; Het glas moet toekomen 1 week voor de toeleveringsdatum
 .. Set ProdDatum=$$ProductieDatum(LevNr,TOENr,TLNr)
 .. Set LevWk=$$CalcGlasLevDatum(PRNr,ProdDatum) ; Het glas moet toekomen 1 week voor de toeleveringsdatum
 .. Set AddCnt=AddCnt+1
 .. ;Write PRNr," ",TOENr," ",TULNr," ",Qty,!
 .. Do ADDGLAS(GVORDNr2,PRNr,TOENr,TULNr,LevWk,Qty,Qty,,,.PlaniMat)
 Set GVORDNr=GVORDNr2
 Do FETCH(),REFRESH
 Do WARN^vhTXTPOP(AddCnt_" lijn(en) bijgevoegd","Glasref : "_GVORDNr)
 Quit
 
ProductieDatum(LevNr,TOENr,TLNr)
	New ProdDatum
	Set ProdDatum=+$P(^KTO(LevNr,TOENr,1),D,19) ; dueout productie ingevuld in de toeleveringshoofding
	If 'ProdDatum   { ; leveringsdatum van het order en daarvan terugrekenen 
		Set KLNr=$P($G(^KTO($$$LevHalux,TOENr,1)),"\",8) ; klant
		Set ORDNr=$P($G(^KTO($$$LevHalux,TOENr,$G(^TO("IU",TOENr,TLUNr),"*"))),"\",27) ; KOMLink
		Set OLNr=$P($G(^KTO($$$LevHalux,TOENr,$G(^TO("IU",TOENr,TLUNr),"*"))),"\",28) ; KOMLink
		Set LevDatum=$P($G(^KOD(KLNr,"F",ORDNr,OLNr),"*"),"\",25) ; Orderdatum
		Do INITDOMVKP^FLOWORD2(KLNr,ORDNr)
		Set ProdDatum=+blLeveringsTermijn.GetLaatsteProductieTijdstip(LevDatum)
	}
	If 'ProdDatum { ; datum van de toelevering
		Set ProdDatum=$$CALCDATE^vhDTyp($$INTDATE^vhDTyp($P(^KTO(LevNr,TOENr,TLNr),D,25),"DW"),"W","MD")
	}
 	Quit ProdDatum
 
CalcGlasLevDatum(PRNr,ProdDatum)
	Quit ##class(DOM.VKP.LeveringsTermijn).GlasLeveringsDatum(PRNr,ProdDatum) 
 
 ;MatGlas via .Local
ADDGLAS(GVORDNr,PRNr,TOENr,TULNr,LevWk,Qty,MaxQty,Rede,RedeOms,PlaniMat) 
 New KLNr,FabKey,VulRec
 If '$L($G(GVORDNr)) Set GVORDNr=$$ORDPOP("AN")
 Quit:GVORDNr=""
 Quit:Qty=0
 Set Vulling=$P($G(^HADPR("P",PRNr,"GV")),D,1)
 Quit:Vulling="ZZ"
 Quit:Vulling="ZP"
 Quit:Vulling=""
 Set:$ZCVT($P($G(^RES("HAD","PI","VULLING","D",Vulling)),"`",2),"U")["PLANILAK MAT" PlaniMat=$G(PlaniMat)+1
 Set KLNr=$P($G(^KTO(6332,TOENr,1)),D,8)
 Set FabKey=$$FABKEYT^HADOPV(TOENr,TULNr)
 If $D(^HADPR("GVO",GVORDNr,FabKey))!(Qty<1) Do
 . Set VulRec=$G(^HADPR("GVO",GVORDNr,FabKey))
 . If $P(VulRec,D,2)+Qty<1 Do  ;Verwijderen
 .. Kill ^HADPR("GVO",GVORDNr,FabKey)
 . Else  Do  ; Wijziging
 .. Set $P(VulRec,D,2)=$P(VulRec,D,2)+Qty
 .. Set ^HADPR("GVO",GVORDNr,FabKey)=VulRec
 Else  Do  ; Nieuwe
 . Set ^HADPR("GVO",GVORDNr,FabKey)=PRNr_D_Qty_D_LevWk_D_TOENr_D_TULNr_D_KLNr_D_$G(Rede)_D_$G(RedeOms)
 Do MARKGLAS^HADOPV(PRNr,TOENr,TULNr,Qty,MaxQty,$G(Rede),GVORDNr)
 Quit
 
DELGLAS ; Verwijderen van het glas
 Set Rec=^HULP(%J,"L",Select)
 Quit:Rec=""
 Do ADDGLAS(GVORDNr,$P(Rec,D,1),$P(Rec,D,4),$P(Rec,D,5),,-$P(Rec,D,2),$P(Rec,D,2),$P(Rec,D,7)) 
 Do FETCH(),REFRESH 
 Quit
 
MARKDAT(GVORDNr,FromGlob)  ; Markeren van de besteldatum in de fabricage status
 New VolgNr,RecO,PRNr,Rede,FabKey
 Set VolgNr=""
 For  Set VolgNr=$O(@FromGlob@(VolgNr)) Quit:VolgNr=""  Do 
 . Set RecO=@FromGlob@(VolgNr)
 . Set FabKey=$$FABKEYT^HADOPV($P(RecO,D,4),$P(RecO,D,5))
 . Set PRNr=$P(RecO,D,1)
 . Quit:PRNr=""
 . Set Rede=$P(RecO,D,7)
 . Set Rede=$S(Rede="L":"H",Rede="":"B",1:Rede)
 . Lock +^HADPR("F",FabKey,Rede)
 . Set $P(^HADPR("F",FabKey,Rede),D,5)=+$H
 . Lock -^HADPR("F",FabKey,Rede)
 Quit
 
 
PRINTASK New Opties,Type,LevNr,SortCode,Titel,X,PlaniMat
 Set Opties=""
 Set Type=$$PI^vhPOPUP("C;C","2BKO-","Print keuze","HADVUL","PRINT")
 If Type="" Quit
 Set LevNr=$P(^HADPR("GVB",GVORDNr),D)
 Set:Type="O" Opties=Opties_";O"
 Set:Type="B"!(Type="T") Opties=Opties_";"_$S(LevNr=6831:"TM",1:"INV")
 Set SortCode=$$PI^vhPOPUP("C;C","BKO2-","Sorteervolgorde","HADVUL","SORTPOP",SortType)
 Quit:SortCode=""
 Set Titel=$P(^RES("HADVUL","PI","PRINT","D",Type),"`",2)_" "_GVORDNr
 Set $P(Titel,"\",2)=$P(^RES("HADVUL","PI","GLASLEV","D",LevNr),"`",2)
 Do FETCH("PT",SortCode,.PlaniMat)
 Do:PlaniMat WARN^vhTXTPOP("Gelieve te controleren of dit de juiste leverancier is !~~Bevat "_PlaniMat_" lijn(en) met Planilak MAT.","Planilak MAT")
 If Type="T" Do
 . Do TRANSFER($NA(^HULP(%J,"PT")),Opties,Titel)
 Else  Do
 . Do PRINT($NA(^HULP(%J,"PT")),Opties,Titel)
 If Type="B"!(Type="T"),'$P(^HADPR("GVB",GVORDNr),D,3) Do  ; markeren van besteldatum
 . Set X=$$^vhTXTPOP("HADVUL","MARKBESTELD")
 . If X Do
 .. Do MARKDAT(GVORDNr,$NA(^HULP(%J,"PT")))
 .. Set $P(^HADPR("GVB",GVORDNr),D,3)=$H
 Do REFRESH
 Quit
 
PRINT(FromGlob,Opties,Titel) 
 ; Opties met ";"gescheiden
 ;     "TM" : Transpose MirorLux
 ;     "INV" : Wegwerken van INVERS   
 ;     "O" ; Overzicht zonder detail boringen
 New PL,LCnt,VolgNr,RecO,PRNr,BorNr,BorCnt,TransRec
 Kill ^HULP(%J,"P")
 Set Opties=$G(Opties)
 If ";"_Opties_";"[";O;" Do
 . Merge ^HULP(%J,"P")=@FromGlob
 Else  Do  ; Boringen allen op de volgende lijn zetten
 . Set LCnt=0
 . Set VolgNr=""
 . For  Set VolgNr=$O(@FromGlob@(VolgNr)) Quit:VolgNr=""  Do 
 .. Set RecO=@FromGlob@(VolgNr)
 .. Set PRNr=$P(RecO,D,1)
 .. Set LCnt=LCnt+1,^HULP(%J,"P",LCnt)=RecO
 .. Set BorCnt=$O(^HADPR("P",PRNr,"GV","B",""),-1)
 .. Set:+BorCnt=0 BorCnt=1
 .. For BorNr=1:1:BorCnt Do
 ... Set LCnt=LCnt+1,$P(^HULP(%J,"P",LCnt),D,11)=$G(^HADPR("P",PRNr,"GV","B",BorNr))
 Set (GlasOms,TxtBor)=""
 Do INIT^vhLISTO("HADVUL","PRINT",.PL)
 Set PL(11)=$G(Titel,"Glas")
 Do STORE^vhTERMINA()
 
 Do PRINT^OUTPUT(.PL,"P")
 Do REFRESH^vhTERMINA()
 Quit
 
TRANSFER(FromGlob,Opties,Titel) 
 New FileNm,Dev,LCNt,VolgNr,sFL,Fmt,PRNr,VulExtra,FL,BorCnt,BorNr,RecB,GlasOms,Gehard,MailList
 Set FileNm=$P(Titel,"\",2)_GVORDNr_".txt"
 Set Dev=0
 Set Dev=$$OPEN^vhDEV(,FileNm,"W")
 Use Dev
 Set LCnt=0
 Set (GlasOms,TxtBor)=""
 Set VolgNr=""
 For  Set VolgNr=$O(@FromGlob@(VolgNr)) Quit:VolgNr=""  Do 
 . Set Fmt=$$CBPRINT($NAME(@FromGlob@(VolgNr)))
 . Set PRNr=$P(FL(3),D,1)
 . Set VulExtra=$P(FL(3,"V"),D,2)
 . Set Gehard=$S(VulExtra["HARD":"Ja",1:"Neen")
 . Set VulExtra=$$REMLIST^vhRtn1(VulExtra,"HARD",";") 
 . Set:$L($TR(VulExtra,";","")) GlasOms=GlasOms_" - "_VulExtra
 . ;Set VulExtra=""
 . Set BorCnt=$O(^HADPR("P",PRNr,"GV","B",""),-1)
 . Set LevDatum=$P(FL(3),D,3)
 . ;Write $P(FL(3,"K"),D,2),$C(9),$P(FL(3),D,4),".",$P(FL(3,"G"),D,1),$C(9),$P(FL(3),D,7),$C(9),$$EXTDATE^vhDTyp(LevDatum,"W"),$C(9),GlasOms,$C(9),Gehard,$C(9),VulExtra,$C(9),$P(FL(3),D,2),$C(9),BorCnt,$C(9),$$MOD($P(FL(3,"V"),D,4)),$C(9),-$$MOD($P(FL(3,"V"),D,5))
 . Write $P(FL(3,"K"),D,2),$C(9),$P(FL(3),D,4),".",$P(FL(3,"G"),D,1),$C(9),$P(FL(3),D,7),$C(9),$TR($$EXTDATE^vhDTyp(LevDatum,"DKP"),".","/"),$C(9),GlasOms,$C(9),Gehard,$C(9),VulExtra,$C(9),$P(FL(3),D,2),$C(9),BorCnt,$C(9),$$MOD($P(FL(3,"V"),D,4)),$C(9),-$$MOD($P(FL(3,"V"),D,5))
 . For BorNr=1:1:BorCnt Do
 .. Set RecB=$G(^HADPR("P",PRNr,"GV","B",BorNr))
 .. Set $P(RecB,D,1,2)=$$TRANS($P(RecB,D,1,2),TransRec)
 .. Write $C(9),$$MOD($P(RecB,D,1)),$C(9),-$$MOD($P(RecB,D,2)),$C(9),$P(RecB,D,4)
 . Write !
 . If ($P(FL(3),D,7)'="") Do ; herstelling
 .. ; $LB(KlantNaam, TOENr, DOSNr, HerstellingsRede, Datum, GlasOms, Gehard, Hoogte, Breedte)
 .. Set MailList($I(MailList))=$LB($P(FL(3,"K"),D,2),$P(FL(3),D,4),$P(FL(3,"G"),D,1),$P(FL(3),D,7)_$S($L($P(FL(3),D,8)):": "_$P(FL(3),D,8),1:""),$TR($$EXTDATE^vhDTyp(LevDatum,"DKP"),".","/"),GlasOms,Gehard,$P(FL(3,"V"),D,4),$C(9),$P(FL(3,"V"),D,5))
 Close:0'[Dev Dev
 Do WARN^vhTXTPOP("Bestand "_FileNm_" weggeschreven")
 Do:$D(MailList) InfoMailHerstelling(.MailList)
 Quit
 
 
 	#define fmtBeginHtml "<html><body style=""font-family:arial,helvetica;""><p/>"
	#define fmtBeginTable() $C(10,13)_"<table width=""800px"" bordercolor=""#777777""  border=""1""  cellspacing=""0""  cellpadding=""2""  style=""border-collapse:collapse;"">"
	#define fmtHeader $C(10,13)_"<tr bgcolor=""#F5F5F5""><td>Klant</td><td>TOENr</td><td>DOSNr</td><td>Oorzaak</td><td>Datum</td><td>Glas</td><td>Gehard</td><td>Afm1</td><td>Afm2</td></tr>"
	#define fmtBeginRow $C(10,13)_"<tr>"
	#define fmtCel(%Val) "<td>"_$zcvt(%Val,"O","HTML")_"</td>"
	#define fmtEndRow "</tr>"
	#define fmtEndTable $C(10,13)_"</table>"
	#define fmtEndHtml $C(10,13)_"</body></html>"
 
InfoMailHerstelling(MailList)
	Set Key=""
	Set Body=$$$fmtBeginHtml
	Set Body=Body_$$$fmtBeginTable
	Set Body=Body_$$$fmtHeader
	For  Set Key=$O(MailList(Key)) Quit:Key=""  Do
	. Set lbRow=MailList(Key)
	. Set Body=Body_$$$fmtBeginRow
	. Set Body=Body_$$$fmtCel($LG(lbRow,1))
	. Set Body=Body_$$$fmtCel($LG(lbRow,2))
	. Set Body=Body_$$$fmtCel($LG(lbRow,3))
	. Set Body=Body_$$$fmtCel($LG(lbRow,4))
	. Set Body=Body_$$$fmtCel($LG(lbRow,5))
	. Set Body=Body_$$$fmtCel($LG(lbRow,6))
	. Set Body=Body_$$$fmtCel($LG(lbRow,7))
	. Set Body=Body_$$$fmtCel($LG(lbRow,8))
	. Set Body=Body_$$$fmtCel($LG(lbRow,9))
	. Set Body=Body_$$$fmtEndRow
	Set Body=Body_$$$fmtEndTable
	Set Body=Body_$$$fmtEndHtml
 
	Set Subject="Herbestelling glas"
	Set EmailAdres=$$USERNAME^vhUSER(##class(TECH.Config.ConfigMgr).Instance().GetString("Mail_HerbestelGlas"),"@",1)
	Set sc=$$SendMiniMail^vhLib("system@vanhoecke.be",EmailAdres,Subject,Body,,1)
 
 Quit 
 
 
LevDatum(Datum)
	Quit Datum
 
 
CBPRINT(Ref) 
 New sFL,Fmt,Extra
 Quit:Ref?1.2A ""
 Set sFL=@Ref
 If $P(sFL,D,1) Do
 .Do CBOVZ("",sFL)
 .Set BorCnt=$P(sFL("V"),D,10)
 .Set TxtBor=""
 .Set:BorCnt TxtBor="Boringen"
 .Set:";"_Opties_";"'[";O;"&'BorCnt BorCnt=1 
 .Set GlasOms=$G(^RES("HAD","PI","VULLING","D",$P(sFL("V"),D,1),"T")) ; Sommige leveranciers spreken een andere taal, daarom specifieke omschrijving voor de leverancier !
 .Set:'$L(GlasOms) GlasOms=$P($G(^RES("HAD","PI","VULLING","D",$P(sFL("V"),D,1))),"`",2)
 .Set Fmt=";VUL"
 .;Set:(";"_Opties_";"'[";O;") Fmt=";VUL\BR;VUL"
 .Set TransRec=$$CHKTRANS(sFL("V"),Opties)
 .Set $P(sFL("V"),D,4,5)=$$TRANS($P(sFL("V"),D,4,5),D_D_$P(TransRec,D,3))
 .If Opties["TM"!(Opties["INV") Do  ; Wegwerken van INV
 .. Set Extra=$P(sFL("V"),D,2)
 .. Set:Extra["INV" Extra=$$REMLIST^vhRtn1(Extra,"INV",";") 
 .. Set $P(sFL("V"),D,2)=Extra
 Else  Do  ; Boring
 .Set BorCnt=BorCnt-1
 .Set Fmt=";BOR"
 .Set:'BorCnt&$L($O(@Ref)) Fmt=";BOR\BR;BOR"
 .Set $P(sFL,D,10)=TxtBor,TxtBor=""
 .Set $P(sFL,D,9)=GlasOms,GlasOms=""
 .Set $P(sFL,D,11,12)=$$TRANS($P(sFL,D,11,12),TransRec)
 Merge FL(3)=sFL
 Quit Fmt 
 
CHKTRANS(RecVul,Opties) ; Controle welke transformatie er moet uitgevoerd worden
 Quit:Opties'["TM"&(Opties'["INV") ""
 Set Invert=1
 Set:$P(RecVul,D,2)["INV" Invert=0
 Set Draai=0
 Set:$P(RecVul,D,5)>$P(RecVul,D,4)&(Opties["TM") Draai=1,Invert='Invert
 Quit $S(Invert:$P(RecVul,D,5),1:"")_D_D_Draai
 ; Inverteer horizontale as / Inverteer vertikale as / Draaiing 90gr
 
 
TRANS(Rec,TransRec) ;Inverteer en/of draaiing
 ; De glasfabrikanten werken op 1mm nauwkeurig, daarom afronding naar geheel getal en wel het eerste kleinste
 ;Set $P(Rec,D,1)=$P(Rec,D,1)\1 ; integer deling aangepast naar wiskundige afronding - PV - 23-05-05
 ;Set $P(Rec,D,2)=$P(Rec,D,2)\1 ; integer deling aangepast naar wiskundige afronding - PV - 23-05-05
 If $P(TransRec,D,1) Do  ; Invert horizontaal
 . Set $P(Rec,D,2)=$P(TransRec,D,1)-$P(Rec,D,2)
 If $P(TransRec,D,2) Do  ; Invert vertikaal
 . Set $P(Rec,D,1)=$P(TransRec,D,2)-$P(Rec,D,1)
 If $P(TransRec,D,3) Do  ; Draaiing van 90°
 . Set Swap=$P(Rec,D,1)
 . Set $P(Rec,D,1)=$P(Rec,D,2)
 . Set $P(Rec,D,2)=Swap
 Quit Rec
 
 ; Quit X\1 integer deling aangepast naar wiskundige afronding - PV - 17-03-05
MOD(X) Quit +$J(X,0,0)  
 
RPLKL New Actie
 Set KLNr=$S(Select:$P(^HULP(%J,"L",Select),D,6),1:"")
 Quit:'KLNr
 Set Actie=$$RAADPL^KLANT(KLNr,"O")
 Do REFRESH
 Quit
 
RPLPR New Actie
 Quit:'PRNr
 Set Actie=$$RAADPL^PRODUKT(PRNr,"1")
 Do REFRESH
 Quit