Afspraken i.v.m. Posities van Beslag en Boringen:

• Standaard zijn posities STEEDS gemeten van Links (X), van Boven (Y) en vanaf de Rug (Z)
• AfstandRand is steeds relatief (t.o.v. de buitenrand van het profiel)
• Negatieve posities zijn gemeten van de tegenovergestelde kant:
  | PosX < 0 ==> X = KD.Breedte - PosX
  | PosY < 0 ==> Y = KD.Hoogte - PosY
  | PosZ < 0 ==> Z = KD.ProfType.Dikte - PosZ
• De negatieve posities zijn
  - te tonen als positieve waarden in de User Interface
  - op te slaan in Caché als negatieve waarden
  - in XML eveneens als negatieve waarden op te slaan met ev. een Attribute "omschrijving", bvb. "OMS=Van onderkant"
  

]]> persistent vhLib.Macro,BL.Derde.KlantSpecifiek 0 Prod.GADef.AfgeleidDef,VHSys.Library right GADataProduct wordt gebruikt voor de prijsberekening en voor de creatie van de ^PRBS nodes Transient : wordt niet bijgehouden, tenzij via KadPrijs.DetailGAData Property Type is "%String" ipv. "Prod.GAData.Product" omdat anders het GAData-object ook ge-saved wordt. %String 1

"S" : Standaard scharnier

"LB" : LadeBeslag

"VS" : Vouwdeur Vouwbeslag Scharnierdeel

"VV" : Vouwdeur Vouwbeslag Vouwdeel

"VB" : Vouwdeur ophang Boven

"VO" : Vouwdeur ophang Onder

"GA" : Glijder schuifdeur Links Boven

"GB" : Glijder schuifdeur Rechts Boven

"GC" : Glijder schuifdeur Links Onder

"GD" : Glijder schuifdeur Rechts Onder

"KC" : Klapschaar klapdeur

"KH" : Klapdeur opHanger

"HK" : Aventos HK

"HKX": Aventos HK-XS

"HKT": Aventos HK-TOP

"HZ" : Aventos HS

"HL" : Aventos HL

"HFC": Aventos HF scharnier (onderste en bovenste deel)

"HFM": Aventos HF montageplaat (voor bovenste deel)

"HFA": Aventos HF telescopische arm montage (onderste deel)

!!! Kodes moeten steeds uit 2 of 3 letters bestaan (uitz. "S"), maar mogen echter geen "S" bevatten !!!]]> Prod.GADef.emKadBeslag array Prod.GADef.emKadBoring array Breedte van de kaderdeur in mm %Library.Float %Library.Float %Library.String %Library.String %Library.String list Hoogte van de kaderdeur in mm %Library.Float Onderdelen voor Herstellingen of voor Los Profiel. Bij los profiel ("LPR") mag slechts 1 profiel aangeduid zijn. %Library.String list Bij een klapdeur met scharnier : Boven
Bij een een ladefront : Inliggend en Opliggend
Bij een schuifdeur : Inliggend, Opliggend of Voorliggend
Bij een Aventos HF : Boven
]]> Res.PI.OphangPlaats Mogelijke wwarden voor OpmType: "BPAF"]]> %Library.List Prod.GADef.BT.ProductieWijze Breedte van de kaderdeur in mm Res.PI.ProfAfw Speciale prijs voor profiel. Deze prijs wordt genomen bij het berekenen van de profielkost en niet de standaard prijs %Library.Float Breedte van de kaderdeur in mm Res.PI.ProfType Default: "Prod.GADef.TemplGeneral" (voor templates); "" (leeg voor finale objecten)]]> %Library.String Bevat code van het TemplateKader-object indien het product opgebouwd is door een template. %Library.String Res.PI.Toepas ]]> DOM.PM.enu.KADVerpakking Breedte van de kaderdeur in mm Prod.GADef.emKadVulling Speciale prijs voor vulling. Deze prijs wordt genomen bij het berekenen van de vullingskost en niet de standaard prijs. De vulling extras worden nog steeds bijgeteld. %Library.Float %Library.TimeStamp %GlobalCharacterStream 1 IsNew:%Library.Boolean=1 0 %Library.Status IsNew:%Library.Boolean=1 0 %Library.Status Deze RelPos kan een formula zijn die geanalyseerd en geevalueerd wordt.
Indien geen omrekening mogelijk, zal de waarde RelPos teruggegeven worden.
Mogelijke waarden voor sCode zijn: X, Y, Z, S]]> sCode:%Library.String,RelPos:%Library.String,PrevVal:%Library.String,NextVal:%Library.String 0 %Library.String 0) RelPos ; Return value immediatly Quit:($G(sCode)="") RelPos ; Return value immediatly New AbsPos,MaxSize,Plaats,FirstChar,RelVal ; Determine MaxSize If sCode="S" Do . ;Set Plaats=%this.ProfielPlaatsGet(emBeslag, BeslagKey, PosKey) . Set Plaats=$S(%this.Toepassing.ItemID?1(1"KLS",1"AVHFB",1"AVHFO",1"AVH".E):"PB", 1:"PL") ; temporary determination. "PL" or "PR" is not important. . Set MaxSize=$S((Plaats="PL")!(Plaats="PR"):%this.Hoogte, (Plaats="PB")!(Plaats="PO"):%this.Breedte, 1:0) Else Set MaxSize=$CASE(sCode, "X":%this.Breedte, "Y":%this.Hoogte, "Z":%this.ProfType.Dikte, :0) Set AbsPos=RelPos ; Calculate Absolute Position for RelPos; overwrite AbsPos Set FirstChar=$$$UCase($E(RelPos,1,1)) Set RelVal=$$$CNum($E(RelPos,2,999)) ;Set RelVal=(+)$TR($E(RelPos,2,999), "," , ".") If FirstChar=$$$EVALEXPR Do ; Expression : not yet implemented . ; Else If FirstChar=$$$CENTER Do ; From center . Set AbsPos=(MaxSize/2)+RelVal Else If FirstChar=$$$OPPOSITE Do ; From opposite side . Set AbsPos=MaxSize-RelVal Else If FirstChar=$$$KEEPOPPOS Do ; From opposite side, but KEEP it; . ; Make value negative, and keep it at the end, DO NOT calculate to definitive Absolute Position !!! . Set AbsPos=-$ZABS(RelVal) Else If FirstChar=$$$PREVIOUS Do ; From Previous Value: PrevVal must exit and must be numeric . Quit:($G(PrevVal)="") . Set:(PrevVal=0)!(+PrevVal'=0) AbsPos= $$$CNum(PrevVal)+RelVal Else If FirstChar=$$$NEXT Do ; From Next Value: NextVal must exit and must be numeric . Quit:($G(NextVal)="") . Set:(NextVal=0)!(+NextVal'=0) AbsPos= $$$CNum(NextVal)+RelVal Else If $$$UCase($E(RelPos,1,2))=$$$INTERNP Do ; From Interne Kant van het Profiel . Set RelVal=$$$CNum($E(RelPos,3,999)) . Set AbsPos=%this.ProfType.Breedte+RelVal Else If $$$UCase($E(RelPos,1,2))=$$$OINTERNP Do ; From OPPOSITE Interne Kant van het Profiel . Set RelVal=$$$CNum($E(RelPos,3,999)) . Set AbsPos=%this.ProfType.Breedte+RelVal . Set AbsPos=-AbsPos Else If FirstChar=$$$SYMMETRIC Do ; Symmetric distribution over the length . New Cnt,Offs,PrevV . Set Cnt=$P($E(RelPos,2,999),":",1) . Set:('+Cnt) Cnt=1 . Set Offs=$$$CNum($P($E(RelPos,2,999),":",2)) . Set PrevV=$$$CNum($G(PrevVal,0)) . Set AbsPos=PrevV+$J((MaxSize-Offs)/(Cnt+1),0,2) Else Do . ; Other codes for Beslag Special Relative Postitions . Quit Set:(AbsPos<0)&(FirstChar'=$$$KEEPOPPOS) AbsPos=MaxSize+AbsPos ; Substract = add Negative Number Quit AbsPos ]]> Is bijvoorbeeld nodig wanneer de Hoogte of Breedte van het object gewijzigd worden.]]> Opties:%Library.String 0 0)!(emPos.LengtePos' CSP-Method creëert een object via parameters (FillObjectViaParam) en berekent de Prijs ervan. 1 ObjectName:%Library.String,Aantal:%Library.Integer=1,MuntCode:%Library.String="EUR",ProfType:%Library.String,Hoogte:%Library.Float,Breedte:%Library.Float,Beslag:%Library.String,QtyBeslag:%Library.Integer=0,QtyGlasBoor:%Library.Integer=0,QtyProf1:%Library.String,QtyProf2:%Library.String,QtyProf3:%Library.String,QtyProf4:%Library.String,Vulling:%Library.String,VullingExtra:%Library.String,KlantID:%Library.String 0 0:%sVal, 1:0) Quit:($G(ObjectName)="") Quit:($G(Hoogte)="") Quit:($G(Breedte)="") Quit:($G(KlantID)="") New KadObj,Prijs,objMunt,sData,Korting,LogDate,LogTime,OK Set sData=$G(^KLDATA(KlantID),"") Set Korting=+$P(sData, "\", 5) Set Hoogte=$$$CDec(Hoogte) Set Breedte=$$$CDec(Breedte) Set Aantal=$$$CPosNum(Aantal)\1 Set:(Aantal=0) Aantal=1 Set QtyBeslag=$$$CPosNum(QtyBeslag)\1 Set QtyGlasBoor=$$$CPosNum(QtyGlasBoor)\1 Set:($G(MuntCode)'="") objMunt=##class(Res.Munt).%OpenId(MuntCode) Set KadObj=##class(Prod.GADef.KaderDeur).%New() Do KadObj.FillObjectViaParam(ProfType,Hoogte,Breedte,Beslag,QtyBeslag,QtyGlasBoor,QtyProf1,QtyProf2,QtyProf3,QtyProf4,Vulling,VullingExtra) ;Set:($G(Vulling)="") KadObj.Gemonteerd="K" Set OK=KadObj.%Save() Set Prijs=KadObj.LijstPrijs(Aantal,$G(objMunt),0,1)*(1-Korting) Set Prijs=$$RND(Prijs,$S(MuntCode="BEF":3,MuntCode="NLG":2,MuntCode="EUR":2,1:"R"),MuntCode) Set LogDate=$P($H,",",1) Set LogTime=$P($H,",",2) Set:(OK) ^LOG(LogDate, $O(^LOG(LogDate,""),-1)+1)="KL\"_KlantID_"\CSP\"_LogTime_"\"_KadObj.%Id()_"\"_Aantal_"\"_$J(Prijs,0,2)_" "_$G(MuntCode)_"\"_KadObj.KortTekst() ;&JS &JS<#(ObjectName)#=#($J(Prijs,0,2))#;> Quit ; Afronding RND(VrkPrs,Round,Munt) If "R"[Round Quit $$AUTORND(VrkPrs,Munt) If Round=1 Set VrkPrs=$J(VrkPrs*100+.499999,0,0)/100 If Round=2 Set VrkPrs=VrkPrs+.049999*100\5*5/100 If Round<3 Quit $J(VrkPrs,0,2) If Round=3 Quit VrkPrs+.99999\1 If Round=4 Quit VrkPrs+4.99999\5*5 If Round=5 Quit VrkPrs\1 ; Afronden naar beneden TIJDELIJK If Round=6 Quit $J(VrkPrs,0,2) If Round=7 Quit $J($J(VrkPrs,0,1),0,2) If Round=8 Quit $J(VrkPrs,0,0) If Round=9 Quit $J(VrkPrs/5,0,0)*5 Quit VrkPrs ; ; Automatische afronding AUTORND(VrkPrs,Munt) New ABdCfrs,FaMunt Set FaMunt="EUR",ABdCfrs=3-($L(VrkPrs*1000\1)-3) Set:ABdCfrs>$S(Munt=FaMunt:2,1:2) ABdCfrs=$S(Munt=FaMunt:2,1:2) ;Set:ABdCfrs>$S(Munt=FaMunt:1,1:2) ABdCfrs=$S(Munt=FaMunt:1,1:2) Set VrkPrs=VrkPrs*(10**ABdCfrs)+.999999\1/(10**ABdCfrs) Quit VrkPrs ]]> Mogelijke waarden voor OutputType: MSG, LOGOPM]]> OutputType:%Library.String="MSG" 0 %Library.String ]]> Beslag:Prod.GADef.emKadBeslag,BeslagKey:%String 1 %Boolean ]]> Boring:Prod.GADef.emKadBoring 1 %Boolean ]]> 0 %Library.Boolean Onmiddellijke controle op de Breedte van het profiel 0 %Library.String 0) LMin=128 Set:($G(LMax)'>0) LMax=3000-(2*20) ; 20mm marge langs beide kanten Set:(%this.BreedteLMax) OK="F;Maximale breedte kleiner dan "_LMax_"mm" Quit OK ]]> Controle van de verhouding tussen Hoogte en Breedte van de kaderdeur. ToepasID is optioneel, maar overheerst aan de property Toepassing ToepasID:%Library.String 0 %Library.String Nieuwe controles via ..ControleBeperkAfm() If $G(ToepasID)="",(..ToepassingGetObjectId()="") Quit "" Quit:(..Breedte="") "" Quit:(..Hoogte="") "" New OK,TID Set OK="" Set TID=$G(ToepasID,"") Set:(TID="") TID=..Toepassing.ItemID If TID?1(1"KD",1"VDS",1"VDV",1"VDT") Do . Set:(..Breedte>..Hoogte) OK="W;Breedte is groter dan de hoogte" Else If TID?1(1"LF",1"KLS",1"KLC",1"AVH".E) Do . Set:(..Hoogte>..Breedte) OK="W;Hoogte is groter dan de breedte" Else Do . Quit Quit OK ]]> Onmiddellijke controle op de Hoogte van het profiel 0 %Library.String 0) LMin=128 Set:($G(LMax)'>0) LMax=3000-(2*20) ; 20mm marge langs beide kanten Set:(%this.HoogteLMax) OK="F;Maximale hoogte kleiner dan "_LMax_"mm" Quit OK ]]> Mogelijke "Operations" zijn:

LeftRight : OphangPlaats wisselt L-R, boringen worden gespiegeld over de lengte-as

]]> SpecialOperation:%Library.String,Opties:%Library.String 0 Copy maken van KaderDeur in een nieuw object. Verschillende CopyModes: "FullCopy" (=Default), "Empty" CopyMode:%Library.String="FullCopy" 0 Prod.GADef.KaderDeur Berekent het Aantal scharnieren in functie van het Gewicht en de Hoogte van de kaderdeur. De parameter "Gewicht" is optioneel. Gewicht:%Library.Integer 0 %Library.Integer 0) 0 ;If KdGw<0 Quit 0 ;If KdGw=0 Quit 0 ;Set AantS=$S('(%this.Hoogte>900)&'(KdGw>5):2,'(%this.Hoogte>1600)&'(KdGw>11):3,'(%this.Hoogte>2200)&'(KdGw>16):4,1:5) If (%this.Hoogte'>900)&(KdGw'>5) Set AantS=2 Else If (%this.Hoogte'>1600)&(KdGw'>11) Set AantS=3 Else If (%this.Hoogte'>2200)&(KdGw'>16) Set AantS=4 Else Set AantS=5 Quit AantS ]]> Ophalen van het dossiernr indien het nog niet bestaat dan invullen 0 Param1,..,Param5, zijn optioneel, en afhankelijk van de op te roepen routine.]]> KDTemplateID:%Library.String,Param1:%Library.String,Param2:%Library.String,Param3:%Library.String,Param4:%Library.String,Param5:%Library.String 0 Vult klantspecifieke settings in KLNr:%String 1 Creatie van een kaderdeur door het ingeven van de parameters nodig voor de prijsberekening. Deze prijsberekening kan dan gebruikt worden voor prijslijsten aan te maken in bv. Excel Params:%Library.String 0 NewViaParamList ;ProfType,Hoogte,Breedte,Beslag,QtyBeslag,QtyGlasBoor,QtyProfOnder,QtyProfBoven,QtyProfRechts,QtyProfLinks,Vulling,VullingExtra,IsGemonteerd,Verpakking,ProfPrijs,VulPrijs) Do %this.FillObjectViaParam($P(Params,"\",1),$P(Params,"\",2),$P(Params,"\",3),$P(Params,"\",4),$P(Params,"\",5),$P(Params,"\",6),$P(Params,"\",7),$P(Params,"\",8),$P(Params,"\",9),$P(Params,"\",10),$P(Params,"\",11),$P(Params,"\",12),$P(Params,"\",13),$P(Params,"\",14),$P(Params,"\",15),$P(Params,"\",16)) Quit ]]> Cratie van een kaderdeur door het ingeven van de parameters nodig voor de prijsberekening. Deze prijsberekening kan dan gebruikt worden voor prijslijsten aan te maken in bv. Excel ProfType : ProfielType-ProfielAfwerking ("PSV-EV") Mogelijke waarden parameters (zie excel file KAD.Res.PIItems) ProfType:%Library.String,Hoogte:%Library.Integer,Breedte:%Library.Integer,Beslag:%Library.String,QtyBeslag:%Library.Integer,QtyGlasBoor:%Library.Integer,QtyProfO:%Library.String,QtyProfB:%Library.String,QtyProfR:%Library.String,QtyProfL:%Library.String,Vulling:%Library.String,VullingExtra:%Library.String="",IsGemonteerd:%Library.Boolean,Verpakking:%Library.String,ProfKostSpec:%Library.Float="",VulKostSpec:%Library.Float="" 0 ObjectViaParam ;Parameters : ProfAfw,Hoogte,Breedte,Beslag,QtyBeslag,QtyGlasBoor,QtyProfO,QtyProfB,QtyProfR,QtyProfL,Vulling,VullingExtra,IsGemonteerd,Verpakking,ProfPrijs,VulPrijs New caObj,TabelProfType,TabelProfAfw,TabelVul,TabelVulExtra,TabelToepas,TabelOphang,TabelBeslag Set caObj=%this Set TabelProfType=##class(Res.PI.Definitie).IDViaNaam("ProfType") ;Kill ^Dump("NewViaParam") ;Set ^Dump("NewViaParam",$O(^Dump("NewViaParam",""),-1)+1)="Tabel ProfType" Set TabelProfAfw=##class(Res.PI.Definitie).IDViaNaam("ProfAfw") Set TabelVul=##class(Res.PI.Definitie).IDViaNaam("Vulling") Set TabelVulExtra=##class(Res.PI.Definitie).IDViaNaam("VullingExtra") Set TabelToepas=##class(Res.PI.Definitie).IDViaNaam("Toepas") Set TabelOphang=##class(Res.PI.Definitie).IDViaNaam("OphangPlaats") Set TabelBeslag=##class(Res.PI.Definitie).IDViaNaam("Beslag") ;Set ^Dump("NewViaParam",$O(^Dump("NewViaParam",""),-1)+1)="Na tabellen" ;Set caObj=##class(Prod.GADef.Kaderdeur).%New() ;Set ^Dump("NewViaParam",$O(^Dump("NewViaParam",""),-1)+1)="Na caObj *"_$G(ProfType)_"*" Do caObj.ToepassingSetObjectId(TabelToepas_"||"_"KD") ; Kaderdeur Do caObj.OphangPlaatsSetObjectId(TabelOphang_"||"_"L") ; Draairichting Do caObj.ProfTypeSetObjectId(TabelProfType_"||"_$P(ProfType,"-")) ;Set ^Dump("NewViaParam",$O(^Dump("NewViaParam",""),-1)+1)="Na invullenProfType" Do caObj.ProfAfwSetObjectId(TabelProfAfw_"||"_ProfType) ;Set ^Dump("NewViaParam",$O(^Dump("NewViaParam",""),-1)+1)="Na invullenProfafw" Set caObj.Hoogte=Hoogte Set caObj.Breedte=Breedte Set caObj.Gemonteerd=$S(($G(IsGemonteerd)'="")&&("K;KV;L"[$G(IsGemonteerd)):IsGemonteerd,$G(Vulling)'=""&(caObj.ProfType.VulCode'="A"):"KV",1:"L") Set:caObj.Gemonteerd="KV"&&($G(Vulling)="") caObj.Gemonteerd="K" ; Gemonteerd met vulling maar er is geen vulling Set:caObj.ProfType.VulCode="A" caObj.Gemonteerd="L" ; Afboordingsprofieel nooit gemonteerd Set Verpakking=$G(Verpakking) Set:Verpakking=""!("BLKE"'[Verpakking) Verpakking=$S(caObj.Gemonteerd'["K":"L",1:"K") ; Default naar LOS en KRIMP Set:caObj.ProfType.VulCode="A"&(Verpakking="K") Verpakking="L" ; Afboordingsprofiel nooit KRIMP Set caObj.Verpakking=Verpakking Set:ProfKostSpec caObj.ProfAfwKostSpecial=$TR(ProfKostSpec,",",".") Set:VulKostSpec caObj.VullingKostSpecial=$TR(VulKostSpec,";",".") ; Altijd Rodé-Poli bij Kleef-profiel Set:($E($P(caObj.ProfTypeGetObjectId(),"||",2),3)?1(1"K",1"9"))&&($L(Vulling))&&(VullingExtra'["RP") VullingExtra=VullingExtra_";RP" ;Set ^Dump("NewViaParam",$O(^Dump("NewViaParam",""),-1)+1)="NaMontagefType" Do fvpBeslag(.caObj,$G(Beslag),$G(QtyBeslag),Hoogte) Do fvpVulling(.caObj,$G(Vulling),$G(VullingExtra)) Do fvpBoringen(.caObj,$G(QtyGlasBoor),"VUL") Do fvpBoringen(.caObj,$G(QtyProfO),"PO") Do fvpBoringen(.caObj,$G(QtyProfB),"PB") Do fvpBoringen(.caObj,$G(QtyProfR),"PR") Do fvpBoringen(.caObj,$G(QtyProfL),"PL") Quit fvpBoringen(caObj,QtyBoring,BorPlaats) New I,J,BorDType,BorOne,BorDiam,BorType,BorQty For I=1:1:$L(QtyBoring,";") Do .Set BorOne=$P(QtyBoring,";",I) .Quit:BorOne="" .Set BorOne=$$UPCASE^vhRtn1(BorOne) .Set BorDType="K" .Set:BorOne["K" BorDType="K" .Set:BorOne["G" BorDType="G" .Set BorType="ON" .Set:BorOne["I" BorType="IN" .Set:BorOne["E" BorType="EX" .Set BorQty=+BorOne .Set BorDiam=$S(BorDType="K":I,1:20+I) .For J=1:1:BorQty Do fvpBoring(caObj,BorDiam,BorPlaats,BorType) Quit fvpBoring(caObj,Diam,BorPlaats,BorType) ; BorType wordt niet meer gebruikt New emBoring Set emBoring=##class(Prod.GADef.emKadBoring).%New() If BorPlaats="VUL" Do ;Glasboring . Set emBoring.XPos=caObj.Breedte/2 . Set emBoring.YPos=caObj.Hoogte/2 . Set emBoring.BoorDiameter=Diam . Set emBoring.BoringType="ON" ; Onderzijde . Set emBoring.BoorDiepte=-1 ; Doorboring . Set emBoring.BoringPlaats=BorPlaats ; Glas Else Do ; Boring kader . If caObj.ProfType.ConstructAfm.GetAt("AZG")<10 Do ;Glasprofiel .. If BorPlaats="PR" Do ... Set emBoring.XPos=caObj.Breedte-(caObj.ProfType.ConstructAfm.GetAt("AZG")+3) ... Set emBoring.YPos=caObj.Hoogte/2 .. Else If BorPlaats="PL" Do ... Set emBoring.XPos=caObj.ProfType.ConstructAfm.GetAt("AZG")+3 ... Set emBoring.YPos=caObj.Hoogte/2 .. Else If BorPlaats="PB" Do ... Set emBoring.XPos=caObj.Breedte/2 ... Set emBoring.YPos=caObj.ProfType.ConstructAfm.GetAt("AZG")+3 .. Else Do ;"PO" ... Set emBoring.XPos=caObj.Breedte/2 ... Set emBoring.YPos=caObj.Hoogte-(caObj.ProfType.ConstructAfm.GetAt("AZG")+3) .. Set emBoring.BoorDiameter=Diam .. Set emBoring.BoringType=BorType ; Doorboring .. ;Set emBoring.BoringPlaats="K" ; Kader en Glas .. Set emBoring.BoorDiepte=-1 ; Doorboring .. Set emBoring.BoringPlaats=BorPlaats ; Kader . Else Do ; .. If BorPlaats="PR" Do ... Set emBoring.XPos=caObj.Breedte-10 ... Set emBoring.YPos=caObj.Hoogte/2 .. Else If BorPlaats="PL" Do ... Set emBoring.XPos=10 ... Set emBoring.YPos=caObj.Hoogte/2 .. Else If BorPlaats="PB" Do ... Set emBoring.XPos=caObj.Breedte/2 ... Set emBoring.YPos=10 .. Else Do ;"PO" ... Set emBoring.XPos=caObj.Breedte/2 ... Set emBoring.YPos=caObj.Hoogte-10 .. Set emBoring.BoorDiameter=Diam .. Set emBoring.BoringType=BorType ; Onderzijde .. Set emBoring.BoorDiepte=-1 ; Doorboring .. Set emBoring.BoringPlaats=BorPlaats ; Kader Do caObj.Boringen.SetAt(emBoring,caObj.Boringen.Count()+1) Do emBoring.%Close() Quit fvpBeslag(caObj,Beslag,QtyBeslag,Hoogte) New emBeslag,I,emBeslagPos Quit:'QtyBeslag Set emBeslag=##class(Prod.GADef.emKadBeslag).%New() Do emBeslag.BeslagSetObjectId(TabelBeslag_"||"_Beslag) For I=1:1:QtyBeslag Do .Set emBeslagPos=##class(Prod.GADef.emKadBeslagPos).%New() .Set emBeslagPos.LengtePos=I*Hoogte\(QtyBeslag+1) .Do emBeslag.Positie.SetAt(emBeslagPos,I) .Do emBeslagPos.%Close() Do caObj.Beslag.SetAt(emBeslag,"S") Do emBeslag.%Close() Quit fvpVulling(caObj,Vulling,VullingExtra) New emVulling,I Set VullingExtra=$G(VullingExtra) Quit:Vulling="" Set emVulling=##class(Prod.GADef.emKadVulling).%New() Do emVulling.VullingSetObjectId(TabelVul_"||"_Vulling) For I=1:1:$L(VullingExtra,";") Do ; HARD, INV of ... . Quit:'$L($P(VullingExtra,";",I)) . Do emVulling.VullingExtra.InsertObjectId(TabelVulExtra_"||"_$P(VullingExtra,";",I)) Set caObj.Vulling=emVulling Do emVulling.%Close() Quit ]]> Creatie van een kaderdeur door het ingeven van de parameters nodig voor de prijsberekening. Deze prijsberekening kan dan gebruikt worden voor prijslijsten aan te maken in bv. Excel Params:%Library.String 0 KastHoogte Set KastHoogte=Hoogte If Breedte'>0 Quit If Hoogte'>0 Quit If Toepas="KD"!($E(Toepas,1,2)="VD"),OphangPl'="L",OphangPl'="R" Quit If Toepas="LF",OphangPl'="I",OphangPl'="O" Quit ; Creatie If Toepas="KD" Do DEUR^Prod.GADef.KaderDeur.TemplSVDX(%this,KastHoogte,Hoogte,Breedte,$P(Profiel,"-"),Profiel,Vulling,VulExtra,OphangPl) If Toepas="LF" Do LADE^Prod.GADef.KaderDeur.TemplSVDX(%this,Hoogte,Breedte,$P(Profiel,"-"),Profiel,Vulling,VulExtra,OphangPl) If $E(Toepas,1,2)="VD" Do VOUW^Prod.GADef.KaderDeur.TemplSVDX(%this,KastHoogte,Hoogte,Breedte,$P(Profiel,"-"),Profiel,Vulling,VulExtra,OphangPl,$E(Toepas,3)) Quit ]]> CalcMode = "SimVul" berekent het gewicht met een geSimuleerde Vulling (10 kg/m²).]]> CalcMode:%Library.String="" 0 %Library.Float 0) GVulling=10000 ; g/m² Set KdGw=0 Set:(%this.ProfType.Hoek) KdGw=KdGw+(4*%this.ProfType.Hoek.Gewicht) ; 4 verbinders ; Set KdGw=KdGw+(2*(%this.Breedte+%this.Hoogte)/1000*%this.ProfAfw.Gewicht) ; Gewicht Profiel Set KdGw=KdGw+(%this.KadOmtrek()*%this.ProfAfw.Gewicht) ; Gewicht Profiel ; Set KdGw=KdGw+((%this.Hoogte/1000*%this.Breedte/1000)*GVulling) ; Gewicht Vulling Set KdGw=KdGw+(%this.VulOpp()*GVulling) ; Gewicht Vulling Set KdGw=KdGw+(%this.KadOpp()*1000) ; Gewicht Verpakking Set KdGw=KdGw/1000 ; Omzetting g naar kg Quit KdGw ]]> Bepaalt het GenPRNr van het object. 1 Toepassing:%String,ProfType:%String,ProductieWijze:%String 1 %String Bepaalt het GenPRNr van het object. 1 1 %Status ]]> GenPRNr:%Library.Integer,QtyStaffel:%Library.String=1,MetPrijs:%Integer=1 0 Creëert de Bouwstenen in schaduw. De property GADataProduct (transient) wordt tijdelijk vervangen door de Schaduw GAData, maar wordt achteraf teruggezet. Ook de %IsModified wordt teruggezet. QtyStaffel:%String 1 Creëert voor dit product de Bouwstenen in schaduw (enkel indien GenType=KAD) Eerst wordt nog gecontroleerd of Schaduw actief is. Oproepen via s sc=##class(Prod.GADef.KaderDeur).KPRCreateSchaduwViaPRNr(PRNr) w sc,! 1 1 %Status 0) QtyStaffel=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("KAD",PRNr,"QTY"),1) Set KadObj=##class(Prod.GADef.KaderDeur).%OpenId(KadID) Quit:'$isObject(KadObj) $$$ERROR($$$GeneralError,"KadID does not exist in KaderDeur") Do KadObj.KPRCreateSchaduw(QtyStaffel) // KadObj will be unswizzled if not passed as .local (by reference) Quit $$$OK ]]> Bewaren van de nieuwe IngegevenKenmerken (via KenmerkConvertor) 1 Lopendemeter van een kaderdeur in m expression 0 %Library.Float Oppervlakte van een kaderdeur in m2 expression 0 %Library.Float Oppervlakte van een kaderdeur in m2 expression 0 %Library.Float 0 %Library.String 3:8,1:9),11)=%this.Dossier . Set Ophang=$S($L(%this.OphangPlaats):%this.OphangPlaats.KortTekst,1:"") . Set:Ophang="" Ophang=$E(%this.Toepassing.KortTekst,2) . Set $E(KortT,12,21)=$E(KortT,5)_Ophang_$J($J(%this.Hoogte,0,0)_"x"_$J(%this.Breedte,0,0),8) . Set KortT=$E(KortT,1,21) . Set:(%this.Vulling.Vulling) $E(KortT,22,23)=%this.Vulling.Vulling.KortTekst . Set $E(KortT,24,25)=%this.ProfAfw.KortTekst .; Quit $E(KortT,1,25) ]]> Bepaalt het ID van het gekoppelde GAData.Product (Opgelet: NIET het Prod.Product) 1 KadID:%String 1 %String Bepaalt het ID van het gekoppelde GAData.Product (Opgelet: NIET het Prod.Product) 1 %String Bij wijzigingen aan het GADataProd in een andere $Job, moet het Prod hier ge-Reload worden + recalculate DItems 1 Er wordt bepaald of de kostprijs moet HERberekend worden of niet.]]> QtyStaffel:%Library.Integer=1,Munt:Res.Munt="",BldDtl:%Library.Boolean=0,ForceRecalc:%Library.Boolean=0,ForceNoSa:%String 0 %Library.Float Staffel="_QtyStaffel_" BldDtl="_BldDtl_" ForceRecalc="_ForceRecalc) Set CalcID=%this.%Id() If (CalcID="") Do ; GADef Object bestaat nog niet . Set NeedToRecalc=1 Else If ##class(Prod.GADef.KadPrijs).%ExistsId(CalcID) Do ; KadPrijs bestaat nog controleren of het de goede is . ; Open KadPrijsCalcDtl object . Set CalcObj=##class(Prod.GADef.KadPrijs).%OpenId(CalcID) . Set WijzigTS=$S('%this.WijzigTijdStip:"0",1:$ZDATETIMEH(%this.WijzigTijdStip,3)) . Set CalcTS=$S('CalcObj.CalcTijdStip:"0",1:$ZDATETIMEH(CalcObj.CalcTijdStip,3)) . Set NeedToRecalc=($$$TOSECONDS(CalcTS)<$$$TOSECONDS(WijzigTS))||(CalcObj.Aantal'=QtyStaffel) . ;d WL^vhDBG("NeedToRecalc="_NeedToRecalc_" HasDetails="_(CalcObj.HasDetails())) . If BldDtl Do ; Indien het KadPrijs geen details bevat en er zijn details gevraagd dan herrekenen met details . . Set:('CalcObj.HasDetails()) NeedToRecalc=1 Else Do ; KadPrijs bestaat nog niet . ;d WL^vhDBG("Creating new KadPrijs obj ID:"_CalcID) . Set CalcObj=##class(Prod.GADef.KadPrijs).%New() . Do CalcObj.GADefProdSetObjectId(CalcID) . Set NeedToRecalc=1 Do:($D(ForceNoSa)) kprForceNoSaActivate(ForceNoSa, .PrevNoSa) Set:(ForceRecalc) NeedToRecalc=1 ;Kill %IsUserWV ;If $$CalcNewKost^Prod.GADef.KaderDeur.tmpDev(1) ; Do WLIP^vhDBG(97,"CalcNewKost %Var set to "_$G(%IsUserWV)) If NeedToRecalc Do . If CalcID Do ; Herekenen van de kostprijs en eventueel bijhouden van de details . . ;d WL^vhDBG(" Recalc KadPrijs with details...") . . Do kprResetDetails() . . Set KostPrijs=%this.KostPrijsCalc(QtyStaffel,$S(BldDtl:CalcObj,1:"")) . . Set CalcObj.TotaleKostPrijs=KostPrijs . . Set CalcObj.Aantal=QtyStaffel . . ;d WL^vhDBG(" Recalc KadPrijs: Save GADataDetail ...") . . Set Ok=CalcObj.SaveGADataDtl() ; CalcObj.DetailGAData.%Save() is not ENOUGH !!! . . ;d WL^vhDBG(" Recalc KadPrijs: Saving CalcObj ...") . . Set CalcObj.CalcTijdStip=$ZDATETIME($H,3) . . Set Ok=CalcObj.%Save() ; Set:('$$$ISERR(Ok)) ... . . ;d WL^vhDBG(" Recalc KadPrijs: Saved CalcObj") . . ;d WL^vhDBG(" Recalc KadPrijs with details finished") . Else Do ; GADef object bestaat nog niet . . Set KostPrijs=%this.KostPrijsCalc(QtyStaffel,"") Else Do . Set KostPrijs=CalcObj.TotaleKostPrijs Do:($D(ForceNoSa)) kprForceNoSaReset(.PrevNoSa) ;d WL^vhDBG("KostPrijs Kad finished "_$S(..%IsModified():"IsMod=1",1:"")_".") Set CalcObj="" ; Do:$G(CalcObj) CalcObj.%Close() Do kprConvertMunt(.KostPrijs,Munt) Quit KostPrijs kprResetDetails() ; Reset Previous DetailGAData Do CalcObj.Details.Clear() Quit:($G(%DtlRecalcOnly)=1) Quit:('$IsObject(CalcObj.DetailGAData)) ; Nothing to reset If BldDtl Do . // Data verwijderen gebeurt in KostPrijs.MAC . ;Do CalcObj.DetailGAData.ClearAllData() ; Reset all DataItems, KostItems, Lookups, Cumuls, arTree Else Do . Set tmpID=CalcObj.DetailGADataGetObjectId() . Set CalcObj.DetailGAData="" ; GAData.Product wissen --> DEFINITIEF VERWIJDEREN ??? . Set:(##class(Prod.GAData.Product).%ExistsId(tmpID)) sc=##class(Prod.GAData.Product).%DeleteId(tmpID) Quit kprConvertMunt(KostPrijs,Munt) New CalcNew Set CalcNew=1 ; $$CalcNewKost^Prod.GADef.KaderDeur.tmpDev() If $L(Munt)&&(CalcNew) Do . New MuntEur . Set MuntEur=##class(Res.Munt).%OpenId("EUR") ; Zolang de prijsberekening gebeurt in EUR . Set KostPrijs=MuntEur.NaarBasis(KostPrijs) ; Zolang de prijsberekening gebeurt in EUR . Set KostPrijs=Munt.NaarMunt(KostPrijs) If $L(Munt)&&('CalcNew) Do . New MuntBef . Set MuntBef=##class(Res.Munt).%OpenId("BEF") ; Zolang de prijsberekening gebeurt in BEF . Set KostPrijs=MuntBef.NaarBasis(KostPrijs) ; Zolang de prijsberekening gebeurt in BEF . Set KostPrijs=Munt.NaarMunt(KostPrijs) Quit // AAN- en AFzetten van de SchaduwPrijs berekening // (met onthouden van de Oorspronkelijke waarde: PrevNoSa als .local doorgeven) kprForceNoSaActivate(ForceNoSa, PrevNoSa) ; PrevNoSa als .local doorgeven Set:($D(%NoSa)) PrevNoSa=%NoSa Set %NoSa=ForceNoSa Quit kprForceNoSaReset(PrevNoSa) If $D(PrevNoSa) Set %NoSa=PrevNoSa Else Kill %NoSa Quit ]]> Berekening van de Kostprijs via GADataProduct : nieuwe implementatie sinds 01/09/2006 1. maakt gebruik van KadObj.GADataProduct indien aanwezig (transient) , anders 2. maakt gebruik van caoKadPrijs.DetailGAData indien aanwezig (saved) , anders 3. maakt een nieuw GADataProduct aan dat tevens ingevuld wordt in de property KadObj.GADateProduct De berekening kan ook in schaduw gemaakt worden, dan best vertrekken van een nieuwe GADataProduct i.e. KadObj.KostPrijsCalc() oproepen met KadObj.GADateProduct="" en caoKadPrijs="" en blnGADataSchaduw=1 Staffel:%Library.Integer,caoKadPrijs:Prod.GADef.KadPrijs="",blnGADataSchaduw:%Boolean=0 0 %Library.Float 1 %Boolean Staffel:%Library.Integer=1 0 %List 10 Do ;Groot aantal .. If ('IsLosProf)&&(..Gemonteerd["V") Do ; Groot aantal en Met vulling ... ; ORIG : If $S(Hoogte>Breedte:Hoogte,1:Breedte)<120&($S(Hoogte>Breedte:Breedte,1:Hoogte)<80) Do ; Groot aantal en Met Vulling en Past op een palet ... If ($$MaxVal^vhLib(..Hoogte,..Breedte)<1200)&&($$MinVal^vhLib(..Hoogte,..Breedte)<800) Do ; Groot aantal en Met Vulling en Past op een palet .... Set VerpakType=$LB("K") ... Else Do ; Groot aantal en Met Vulling en Groter dan een palet .... Set VerpakType=$LB("K","E") .. Else Do ; Groot aantal en Geen vulling ... Set VerpakType=$LB("B") . Else Do ; Klein aantal .. If ('IsLosProf)&&($$$IsMont) Do ; Klein aantal en Gemonteerd ... Set VerpakType=$LB("K","E") .. Else Do ; Klein aantal en ongemonteerd ... Set VerpakType=$LB("L","E") Quit VerpakType ]]> Formateer de langtekst van een product in de geselecteerde taal 0 AVEHKB en AVEHKS is HK beslag (B=Breed en S=Smal) Set sOphangPlaats="" If $L(..OphangPlaatsGetObjectId())&&(..Toepassing.ItemID'?1(1"AVHFB",1"AVHFO")) Do ; Indien ophangplaats is gedefinieerd .Set sOphangPlaats=..OphangPlaats.TaalOms.GetAt($S(..OphangPlaats.TaalOms.IsDefined(Taal):Taal,1:"N")) Set sProfType=..ProfType.ItemID_":"_..ProfType.TaalOms.GetAt($S(..ProfType.TaalOms.IsDefined(Taal):Taal,1:"N")) Set sProfAfw=..ProfAfw.TaalOms.GetAt($S(..ProfAfw.TaalOms.IsDefined(Taal):Taal,1:"N")) If ..Toepassing.ItemID="AF" Set sAfm=..Hoogte Else If ..Toepassing.ItemID="GL" Set sAfm=..VulHoogte()_"x"_..VulBreedte()_"mm" Else Set sAfm=..Hoogte_"x"_..Breedte_"mm" Set sVulling="" If $L(..Vulling.Vulling) Do . Set sVulling=..Vulling.Vulling.TaalOms.GetAt($S(..Vulling.Vulling.TaalOms.IsDefined(Taal):Taal,1:"N")) ; Opbouw Omschr If ..Toepassing.ItemID="GL" Do . Set Oms=1,Oms(Oms)=sToepas_" "_sVulling . Set Oms=Oms+1,Oms(Oms)=sAfm_$S(..Vulling.Vulling.VulCode?.N:", "_..Vulling.Vulling.VulCode_"mm",1:"") . ; Else If ..ProductieWijzeGetObjectId()="LPR" Do ; Los Profiel . New ProfPlaats . Set ProfPlaats=..Onderdelen.GetNext("") . Set Oms=1,Oms(Oms)=$S(Taal="N":"Profiel",1:"Profil")_" : "_sProfType_" "_sProfAfw . Set Oms=Oms+1,Oms(Oms)="Lengte : "_$J(..LosProfLengte(ProfPlaats),0,0)_"mm" .; Else Do . Set Oms=1,Oms(Oms)=sToepas . Set:$L(sOphangPlaats) Oms(Oms)=Oms(Oms)_" "_sOphangPlaats . If $L(sAfm),($L(Oms(Oms))+$L(sAfm)<25) Set Oms(Oms)=Oms(Oms)_", "_sAfm . Else Set Oms=Oms+1,Oms(Oms)=sAfm . Set Oms=Oms+1,Oms(Oms)=$S(Taal="N":"Profiel",1:"Profil")_" : "_sProfType_" "_sProfAfw . Set:$L(sVulling) Oms=Oms+1,Oms(Oms)=$S(Taal="F":"Garniture",Taal="D":"Füllung",Taal="E":"Filling",1:"Vulling")_" : "_sVulling If $L(sVulling) Do ; Bijvoegen van vullingextra's in langtext . New Key,ExtraObj,Txt . Set Key="" . For Set ExtraObj=..Vulling.VullingExtra.GetNext(.Key) Quit:Key="" Do .. Set Txt=ExtraObj.TaalOms.GetAt($S(ExtraObj.TaalOms.IsDefined(Taal):Taal,1:"N")) .. Quit:'$L(Txt) .. If $L(Oms(Oms)_","_Txt)>45 Set Oms=Oms+1,Oms(Oms)=Txt .. Else Set Oms(Oms)=Oms(Oms)_","_Txt ; Return Oms via .Local Quit ]]> Dit is een oproep van de method "KostPrijs" en het resultaat wordt vermenigvuldigd met vaste factor.]]> QtyStaffel:%Library.Integer=1,Munt:Res.Munt="",BldDtl:%Library.Boolean=0,ForceRecalc:%Library.Boolean=0 0 %Library.Float Geeft de lengte terug van het profiel op ProfPlaats (in mm). Kan voor LosProfiel automatisch ProfPlaats bepalen. ProfPlaats:%Library.String 0 %Library.Float Specifiek voor 'Los Profiel'. Geeft 0 als Plaats overeenkomt met de plaats van het los profiel en geeft 1 indien de plaats NIET overeenkomt. Bij volledige KaderDeur (=alles behalve 'Los Profiel') geeft steeds 0 terug. Plaats:%Library.String 0 %Library.Boolean Open van een kaderdeur object via Dossier-code 1 Dossier:%Library.String 0 Prod.GADef.KaderDeur ClearByType verwijdert alle listitems waarbij OpmType overeenkomt.]]> OpmType:%Library.String 0 Bij Boring moet het emKadBoring object mee doorgegeven worden.
Bij Scharnier moet de BeslagKey en PosKey mee doorgegeven worden.
Result : PL;PR;PB;PO]]> emObject:%Library.RegisteredObject,BeslagKey:%Library.String,PosKey:%Library.String 0 %Library.String 0) Set Plaats="PL" Else If (emObject.XPos-(..Breedte-..ProfType.Breedte)\1'<0)&(emObject.XPos'>..Breedte) Set Plaats="PR" Else If (emObject.YPos'<0)&(emObject.YPos-..ProfType.Breedte\1'>0) Set Plaats="PB" Else If (emObject.YPos-(..Hoogte-..ProfType.Breedte)\1'<0)&(emObject.YPos'>..Hoogte) Set Plaats="PO" Else Set Plaats="" If Plaats="PL" Do . Set:(emObject.YPos Creëert nieuw object: uitgaande van het huidige, vereenvoudigde object beschreven door SVEDEX KastHoogte:%Library.String,blnStdDeur:%Library.Boolean 0 Prod.GADef.KaderDeur Dit element wordt bepaald door [Plaats], [Kant] en [Diam].

Structuur van de arrays:
TelV = aantal in vulling
TelV(Diam) = aantal per diameter in vulling
TelP(Kant,Plaats) = aantal per kant (BO,ON,IN,EX) van het profiel, per plaats (PL,PR,PB,PO)
TelP(Kant,Plaats,Diam) = aantal per diameter per kant en per plaats in het profiel
]]> 1 0 "TelP,TelV" zijn arrays, doorgegeven BY REFERENCE !
Opvulling van de array(s) is beschreven in de Class Method
]]> 0 0:objBoring.BoorGlasDiameter,1:Diam) . Do ..TelBoringAdd(.TelP, .TelV, "VUL","ON",DiamG,1) If objBoring.BoringPlaats="VUL" Quit ; Boring is alleen in de Vulling ; Boring in het Profiel Set:(objBoring.AfschuinDiameter>0) Diam=Diam_"+"_objBoring.AfschuinDiameter Set Plaats=..ProfielPlaatsGet(objBoring) Set Kant=objBoring.BoringType Set:(Kant="") Kant="ON" Quit:(..NietOpProfiel(Plaats)) ; Stopt enkel voor 'Los Profiel' en verschillende Plaats Do ..TelBoringAdd(.TelP, .TelV, Plaats,Kant,Diam,1) Quit tlbBeslagTellen(TelP,TelV, BeslagKey) New emBeslag,BType,Plaats Set emBeslag=..Beslag.GetAt(BeslagKey) Set BType=emBeslag.Beslag.TekeningCode If (BType="35M")&(..ProfType.VulCode="A") Do Quit ; Afboordingsprofiel . ; Alleen de 35mm Scharnierpot in rekening brengen . Set Plaats=..ProfielPlaatsGet(emBeslag,BeslagKey,"") . Quit:(..NietOpProfiel(Plaats)) ; Stopt enkel voor 'Los Profiel' en verschillende Plaats . Do ..TelBoringAdd(.TelP, .TelV, Plaats,"ON",35,emBeslag.Positie.Count()) ; Else Do Normaal beslag en profiel: alle boringen meetellen New PosKey,AllNums Set PosKey="" For Do emBeslag.Positie.GetNext(.PosKey) Quit:(PosKey="")!(PosKey'?.N) Do Set AllNums=(PosKey="") ; If PosKey="" then For-loop has run to end and all keys are numeric If AllNums Do . Do tlbBeslagBoringenTellen(.TelP, .TelV, emBeslag, BeslagKey,1, emBeslag.Positie.Count()) Else Do . ; Loop through all keys and "Count Boringen" for each separate BeslagPos. . Set PosKey="" . For Do emBeslag.Positie.GetNext(.PosKey) Quit:PosKey="" Do .. Do tlbBeslagBoringenTellen(.TelP, .TelV, emBeslag, BeslagKey,PosKey, 1) Quit tlbBeslagBoringenTellen(TelP,TelV, emBeslag,BeslagKey,PosKey,ListCount) ; Boringen nodig voor het Beslag New objBoring New Diam,Kant,BoorKey Set Plaats=..ProfielPlaatsGet(emBeslag, BeslagKey, PosKey) Quit:(Plaats="") Quit:(..NietOpProfiel(Plaats)) ; Stopt enkel voor 'Los Profiel' en verschillende Plaats Quit:('$IsObject(emBeslag.Beslag)) Set BoorKey="" For Do emBeslag.Beslag.Boringen.GetNext(.BoorKey) Quit:BoorKey="" Do . Set objBoring=emBeslag.Beslag.Boringen.GetAt(BoorKey) . Set Kant=objBoring.BoringType . Set:(Kant="") Kant="ON" . Set Diam=objBoring.BoorDiameter . Set:(objBoring.AfschuinDiameter>0) Diam=Diam_"+"_objBoring.AfschuinDiameter . Do ..TelBoringAdd(.TelP, .TelV, Plaats,Kant,Diam,$G(ListCount,1)) Quit ]]> 0 %Integer 0 %Integer Bouwt een lijst op voor de kostberekening van de frezingen voor het GAData.Product: Opent het KadObject (via ID of ObjRef) vanuit het DItem. Returns : zie method ..BoringLoopList() 1 DItem:Prod.GAData.Item 1 %Library.List Bouwt een lijst op voor de kostberekening van de frezingen voor het GAData.Product: Volgende stappen zijn hiervoor nodig: - KadObj.TelBoringen() : positiebepaling + tellen van alle boringen in een profiel - Nuttige waarden invullen in %FRZ() array - Returns LB() met ProfKanten waarop moet gefreesd worden ProfLenMax:%String,Staffel:%String 1 %Library.List 0:ProfLenMax, 1:$$bllPLenFromKadObj()/1000) ;Set PVakQty=(PLen\$$$VakLengte)+1 ;Set ProfsPerRij=$$$VakQty\PVakQty ;Set ProfsPerKal=ProfsPerRij*$$$RowQty ;Set KaliberNew=(ProfQty*Staffel)\ProfsPerKal+1 ; ==> Set KaliberNew=(ProfQty*Staffel)\(($$$VakQty\((PLen\$$$VakLengte)+1))*$$$RowQty)+1 Set ProfsPerRij=$$$VakQty\((PLen\$$$VakLengte)+1) Set:(ProfsPerRij<1) ProfsPerRij=1 ; voor profielen groter dan de totale lengte van de Kaliber Set ProfKant="" For Set ProfKant=$O(TelProf(ProfKant)) Quit:ProfKant="" Do . Kill BoorWissel,ProfGatenQty . Set (ProfQty,ProfWisselQty)=0 . Set ProfPlaats="" . For Set ProfPlaats=$O(TelProf(ProfKant,ProfPlaats)) Quit:ProfPlaats="" Do .. Quit:(..NietOpProfiel(ProfPlaats)) .. Set ProfQty=ProfQty+1 .. Set ProfDiam="" .. For Set ProfDiam=$O(TelProf(ProfKant,ProfPlaats,ProfDiam)) Quit:ProfDiam="" Do ... Set:'$D(BoorWissel(ProfDiam)) ProfWisselQty=ProfWisselQty+1,BoorWissel(ProfDiam)="" ... Set:ProfDiam<10 GatType="K" ... Set:ProfDiam'<10 GatType="G" ... Set ProfGatenQty(GatType)=$G(ProfGatenQty(GatType))+TelProf(ProfKant,ProfPlaats,ProfDiam) . Set KaliberNew=(ProfQty*Staffel)\(ProfsPerRij*$$$RowQty)+1 ; Berekening: zie boven . Set %FRZ("KaliberNew",ProfKant)=KaliberNew . Set %FRZ("ProfQty",ProfKant)=ProfQty . Merge %FRZ("ProfGatenQty",ProfKant)=ProfGatenQty . Set %FRZ("ProfWisselQty",ProfKant)=ProfWisselQty . Set lbIDs=lbIDs_$LB(ProfKant) Set %FRZ("KaliberQty")=KaliberQty Set %FRZ("ProfCnt")=ProfCnt Quit bllPLenFromKadObj() ; PLen in mm !!! Quit $S($G(IsLosProf):..LosProfLengte(), 1:$$MaxVal^vhLib(..Hoogte,..Breedte)) ]]> bvb: TranslateMe="p+120" en RelPosPrev="c-50" resulteert in "c+70",
want "p" (in "p+120") verwijst naar "c-50" (RelPosPrev).]]> 1 TranslateMe:%Library.String,RelPosPrev:%Library.String="",RelPosNext:%Library.String="" 0 %Library.String 0) "" ; TranslateMe ; "No Transform" Quit:(RefPos?1(1"N",1"P",1"n",1"p").E) TranslateMe ; When RefPos is also a Prev/Next formula, do not translate. New Code,LenCode,RelVal,RefPosVal,TransVal Set RelVal=+$TR($E(TranslateMe,2,999), "," , ".") Set:($E(RefPos,1)="-") RefPos="ML"_RefPos ; Determine Length of Code Set LenCode=0 For Quit:($E(RefPos,LenCode+1,LenCode+1)'?1A) Do . Set LenCode=LenCode+1 Set Code=$E(RefPos,1,LenCode) Set RefPosVal=+$TR($E(RefPos,LenCode+1,999), "," , ".") Set TransVal=RefPosVal+RelVal Quit:(Code="ML") $S(TransVal<0:TransVal, 1:"-"_-TransVal) Quit Code_$S(TransVal'<0:"+", 1:"")_TransVal ]]> 1 %Boolean Breedtevan de vulling (Breedte kader - AftrekVoorGlas) in mm expression 0 %Library.Float Creëert een Prod.GADef.Vulling object vertrekkend van het kaderdeur object 0 Prod.GADef.Vulling Hoogte van de vulling (Hoogte kader - AftrekVoorGlas) in mm expression 0 %Library.Float Lopendemeter van een kaderdeur in m2 expression 0 %Library.Float Oppervlakte van de vulling in m2 expression 0 %Library.Float Oppervlakte van de vulling in m2 expression 0 %Library.Float Opties :

VMLH : Header toevoegen

VMLC : Comment toevoegen

.]]> DevObj:%Library.Stream,Opties:%Library.String,Taal:%String="N" 0 "_NL) . Do XMLConstructVerbinders ;(%this,DevObj,$G(Opties)) . Do WRITE^XMLWRITE(DevObj,NL) ; Beslag Do:(%this.Beslag.Count()>0) WRITE^XMLWRITE(DevObj,""_NL) If %this.Toepassing.ItemID'="GL" Do . Set Key="" . For Do %this.Beslag.GetNext(.Key) Quit:Key="" Do .. Do %this.Beslag.GetAt(Key).XMLVectorWrite(DevObj,Key,%this,$G(Opties)) .. Do WRITE^XMLWRITE(DevObj,NL) ; Boringen Do:(%this.Boringen.Count()>0) WRITE^XMLWRITE(DevObj,""_NL) Set Key="" For Do %this.Boringen.GetNext(.Key) Quit:Key="" Do . Do %this.Boringen.GetAt(Key).XMLVectorWrite(DevObj,%this,$G(Opties)) Do WRITE^XMLWRITE(DevObj,NL) ; Schuine hoeken If (%this.Toepassing.ItemID'="GL")&&(%this.ProductieWijzeGetObjectId()'="LPR") Do . Do WRITE^XMLWRITE(DevObj,""_NL) . Do XMLConstructSchuineHoeken ;(%this,DevObj,$G(Opties)) . Do WRITE^XMLWRITE(DevObj,NL) ; Other elements ; End DrawObject GROUP Do ENDTAG^XMLWRITE(DevObj,"v:GROUP") Do WRITE^XMLWRITE(DevObj,NL) ; Afmetingen van de KaderDeur (TextBox) Do WRITE^XMLWRITE(DevObj,"
") Do WRITE^XMLWRITE(DevObj,NL) Do XMLTekstAfmetingen ;(%this,DevObj,$G(Opties)) Do WRITE^XMLWRITE(DevObj,NL) If Opties["VMLH" Do . Do WRITE^XMLWRITE(DevObj,NL) . Do WRITE^XMLWRITE(DevObj,NL) . Do ENDTAG^XMLWRITE(DevObj,"BODY"_NL) . ;Do WRITE^XMLWRITE(DevObj,NL) . Do WRITE^XMLWRITE(DevObj,NL) . Do ENDTAG^XMLWRITE(DevObj,"HTML"_NL) . ;Do WRITE^XMLWRITE(DevObj,NL) Quit XMLConstructKader ;(%this,DevObj,Opties) ; Example XML-Code: ; ======= ======== ; ; ; ; ; ; New Param1,Param2,Param3,Param4,Param5 New Offset1, Offset2 New BorderS, FillS ; Outer Rectangle Set Param1="style='left:0; top:0; width:"_(%this.Breedte\1)_"; height:"_(%this.Hoogte\1)_";'" Set Param2="fillcolor=""#F0F0F0""" Do TAGONLY^XMLWRITE(DevObj,"v:RECT", "ID=""KDOuter""", "CLASS=""clsHidePrint""", Param1, Param2) Do WRITE^XMLWRITE(DevObj,NL) ; Middle Rectangle Set Offset1="" Set BorderS="" Set FillS="" Do %this.ProfType.XMLVectorTussenRand(%this.Vulling.Vulling, .Offset1, .BorderS, .FillS) Set Param1="style='left:"_(0+Offset1\1)_"; top:"_(0+Offset1\1)_"; width:"_(%this.Breedte-(2*Offset1)\1)_"; height:"_(%this.Hoogte-(2*Offset1)\1)_";'" Set Param2="color=""rgb(180,209,184)""" Set Param3="opacity="""_$S(FillS="T":0, FillS="S":1, 1:FillS)_"""" Set Param4="dashstyle="""_$S(BorderS="LD":"longdash",BorderS="D":"dash",1:"solid")_"""" Do BEGINTAG^XMLWRITE(DevObj,"v:RECT", "ID=""KDMiddle""", "CLASS=""clsHidePrint""", Param1) Do TAGONLY^XMLWRITE(DevObj,"v:fill",Param2,Param3) Do TAGONLY^XMLWRITE(DevObj,"v:stroke",Param4) Do ENDTAG^XMLWRITE(DevObj,"v:RECT") Do WRITE^XMLWRITE(DevObj,NL) ; Inner Rectangle Set Offset1=%this.ProfType.Breedte Set Param1="style='left:"_(0+Offset1\1)_"; top:"_(0+Offset1\1)_"; width:"_(%this.Breedte-(2*Offset1)\1)_"; height:"_(%this.Hoogte-(2*Offset1)\1)_";'" Set Param2="fillcolor="""_$S($L(%this.Vulling.Vulling):"rgb(224,255,224)",1:"white")_"""" Do TAGONLY^XMLWRITE(DevObj,"v:RECT", "ID=""KDInner""", "CLASS=""clsHidePrint""", Param1, Param2) Do WRITE^XMLWRITE(DevObj,NL) Quit XMLConstructLosProf ;(%this,DevObj,Opties) ; Idem als XMLConstructLosProf, maar Kader is volledig in stippellijn, één Profiel wordt sterk geaccentueert New Param1,Param2,Param3,Param4,Param5,strVML New Offset1,Offset2, CX,CY,ProfL New BorderS,FillS Set Offset1=..ProfType.Breedte If ProfPlaats="PR" Set Offset1=(..Breedte\1)-((..Breedte-(2*Offset1))\1+(Offset1\1)) ; Opgelet .\1 is GEEN LINEAIRE bewerking Else If ProfPlaats="PO" Set Offset1=(..Hoogte\1)-((..Hoogte-(2*Offset1))\1+(Offset1\1)) ; Opgelet .\1 is GEEN LINEAIRE bewerking Set CX=$S(ProfPlaats="PR":..Breedte\1, 1:0) ; Rechtse profiel : Corner is Rechts-Boven Set CY=$S(ProfPlaats="PO":..Hoogte\1, 1:0) ; Onderste profiel : Corner is Links-Onder Set ProfL=..LosProfLengte(ProfPlaats) Set strVML=$$ProfONCorner^VHSys.Library.VMLLib(CX,CY,ProfL,Offset1,ProfPlaats,"#F0F0F0","black",,,$G(Opties)) Do:($L(strVML)) WRITE^XMLWRITE(DevObj,strVML_NL) ; Outer Rectangle Set Param1="style='left:0; top:0; width:"_(%this.Breedte\1)_"; height:"_(%this.Hoogte\1)_";'" Set Param3="opacity=""0""" Set Param4="dashstyle=""dash""" Do BEGINTAG^XMLWRITE(DevObj,"v:RECT", "ID=""KDOuter""", "CLASS=""clsHidePrint""", Param1) Do TAGONLY^XMLWRITE(DevObj,"v:fill",Param3) Do TAGONLY^XMLWRITE(DevObj,"v:stroke",Param4) Do ENDTAG^XMLWRITE(DevObj,"v:RECT") Do WRITE^XMLWRITE(DevObj,NL) ; Middle Rectangle Set Offset2="" Set BorderS="" Set FillS="" Do %this.ProfType.XMLVectorTussenRand(%this.Vulling.Vulling, .Offset2, .BorderS, .FillS) Set Param1="style='left:"_(0+Offset2\1)_"; top:"_(0+Offset2\1)_"; width:"_(%this.Breedte-(2*Offset2)\1)_"; height:"_(%this.Hoogte-(2*Offset2)\1)_";'" Set Param3="opacity=""0""" ;Set Param4="dashstyle=""shortdash""" Do BEGINTAG^XMLWRITE(DevObj,"v:RECT", "ID=""KDMiddle""", "CLASS=""clsHidePrint""", Param1) Do TAGONLY^XMLWRITE(DevObj,"v:fill",Param3) Do TAGONLY^XMLWRITE(DevObj,"v:stroke",Param4) Do ENDTAG^XMLWRITE(DevObj,"v:RECT") Do WRITE^XMLWRITE(DevObj,NL) ; Inner Rectangle ;Set Offset1=%this.ProfType.Breedte Set Param1="style='left:"_(0+Offset1\1)_"; top:"_(0+Offset1\1)_"; width:"_(%this.Breedte-(2*Offset1)\1)_"; height:"_(%this.Hoogte-(2*Offset1)\1)_";'" Set Param3="opacity=""0""" ;Set Param4="dashstyle=""dash""" Do BEGINTAG^XMLWRITE(DevObj,"v:RECT", "ID=""KDInner""", "CLASS=""clsHidePrint""", Param1) Do TAGONLY^XMLWRITE(DevObj,"v:fill",Param3) Do TAGONLY^XMLWRITE(DevObj,"v:stroke",Param4) Do ENDTAG^XMLWRITE(DevObj,"v:RECT") Do WRITE^XMLWRITE(DevObj,NL) Quit XMLConstructGlas ;(%this,DevObj,Opties) ; ; New Param1,Param2,Offset1 ; Outer Rectangle If %this.ProfType.ItemID'="VUL" Do . Set Param1="style='left:0; top:0; width:"_(%this.Breedte\1)_"; height:"_(%this.Hoogte\1)_";'" . Do BEGINTAG^XMLWRITE(DevObj,"v:RECT", "ID=""KDOuter""", Param1) . Do TAGONLY^XMLWRITE(DevObj,"v:fill","color=""#F0F0F0""","opacity=""0""") . Do TAGONLY^XMLWRITE(DevObj,"v:stroke","dashstyle=""dash""") . Do ENDTAG^XMLWRITE(DevObj,"v:RECT") . Do WRITE^XMLWRITE(DevObj,NL) Set Offset1=..AfstandRandVoorVulling() ; inner rect Set Param1="style='left:"_(0+Offset1\1)_"; top:"_(0+Offset1\1)_"; width:"_(%this.Breedte-(2*Offset1)\1)_"; height:"_(%this.Hoogte-(2*Offset1)\1)_";'" Set Param2="fillcolor=""rgb(224,255,224)""" ; _$S($L(%this.Vulling.Vulling):"rgb(224,255,224)",1:"white")_"""" Do TAGONLY^XMLWRITE(DevObj,"v:RECT", "ID=""KDGlas""", "CLASS=""clsHidePrint""", Param1, Param2) Do WRITE^XMLWRITE(DevObj,NL) Quit XMLConstructSchuineHoeken ;(%this,DevObj,Opties) ; Example XML-Code: ; ======= ======== ; Quit:('%this.ProfType) Quit:(%this.ProfType.Breedte'>0) New Param,Offset Set Offset=%this.ProfType.Breedte ; for each corner: from outer rectangle to inner rectangle. Set Param="from=""0,0"" to="""_(0+Offset\1)_","_(0+Offset\1)_"""" Do TAGONLY^XMLWRITE(DevObj,"v:line", Param) Set Param="from="""_(%this.Breedte\1)_",0"" to="""_(%this.Breedte-Offset\1)_","_(0+Offset\1)_"""" Do TAGONLY^XMLWRITE(DevObj,"v:line", Param) Set Param="from=""0,"_(%this.Hoogte\1)_""" to="""_(0+Offset\1)_","_(%this.Hoogte-Offset\1)_"""" Do TAGONLY^XMLWRITE(DevObj,"v:line", Param) Set Param="from="""_(%this.Breedte\1)_","_(%this.Hoogte\1)_""" to="""_(%this.Breedte-Offset\1)_","_(%this.Hoogte-Offset\1)_"""" Do TAGONLY^XMLWRITE(DevObj,"v:line", Param) Do WRITE^XMLWRITE(DevObj,NL) Quit XMLConstructVerbinders ;(%this,DevObj,Opties) ; Generates VML-code for the 4 "hoekverbinders" Quit:('%this.ProfType.Hoek) New KDVerbinder,VKey,VKeys,i,ProfP Set KDVerbinder=%this.ProfType.Hoek Set ProfP=$TR($G(ProfPlaats),"P","") ; Als ProfPlaats = "PB" , dan is ProfP = "B" Set VKeys=$LB("LB","RB","RO","LO") For i=1:1:$LL(VKeys) Do . Set VKey=$LI(VKeys,i) . If $L(ProfP) Quit:(VKey'[ProfP) . Do KDVerbinder.XMLVectorWrite(DevObj, VKey, $S($E(VKey)="R":%this.Breedte,1:0), $S($E(VKey,2)="O":%this.Hoogte,1:0), $G(Opties)) Quit XMLTekstAfmetingen ;(%this,DevObj,Opties) ; Example XML-Code: ; ======= ======== ; ; ;H:600 mm x B:1500 mm KBA-EV Float helder ; New Param1,Param2,Value1,NL Set NL=$C(13,10) Set Param1="style='position:relative; width:250pt; height:20pt;'" Set Param2="coordsize=""1000,1000"" " Do BEGINTAG^XMLWRITE(DevObj,"v:shape", "ID=""DRAWTEXT""", Param1, Param2) Do WRITE^XMLWRITE(DevObj,NL) Set Param1="style='v-text-anchor:middle;'" Set Value1=KadVertaler.Vertaal("Vooraanzicht")_": " Set Value1=Value1_KadVertaler.Vertaal("lblAfmeting_Hoogte_Kort")_":"_..Hoogte_" mm x "_KadVertaler.Vertaal("lblAfmeting_Breedte_Kort")_":"_..Breedte_" mm" Set Value1=Value1_$S(..Toepassing.ItemID="GL":"", 1:" "_..ProfAfw.ItemID) Set Value1=Value1_$S(..Vulling.Vulling="":"", 1:" "_..Vulling.Vulling.OmsGet(Taal)) Do TAGWRITE^XMLWRITE(DevObj,"v:textbox", $$ConvertToHTML^vhRtn1(Value1), Param1) Do WRITE^XMLWRITE(DevObj,NL) Do ENDTAG^XMLWRITE(DevObj, "v:shape") Do WRITE^XMLWRITE(DevObj,NL) Quit ]]> 1 1 KadBeslagItem:Prod.GADef.emKadBeslag 1 %Boolean Opties :

GAF : Full XML-beschrijving; i.e. met tag < PRODUCTEN >

GAV : VML-code toevoegen

GA0 : met Omschrijving van de data in de XML-tags

VMLH,VMLC : Opties voor VML-gedeelte: zie KaderDeur.XMLVectorWrite

.

XSLURL : Toevoegen van de reference naar de XSL. Indien Leeg (""), tags worden weggelaten.]]> DevObj:%Library.String,Taal:%Library.String,Opties:%Library.String,XSLURL:%Library.String 0 ") . Do WRITE^XMLWRITE(DevObj,"") . Do WRITELN^XMLWRITE(DevObj) Do:($G(Opties)["GAF") BEGINTAG^XMLWRITE(DevObj,"PRODUCTEN") Do WRITELN^XMLWRITE(DevObj) Set blnLosProf=(..ProductieWijzeGetObjectId()="LPR") Set Tag="PROD_"_..Toepassing.ItemID_"_STD" If ..ProductieWijze Set Toepas=$CASE(..ProductieWijze.ItemID, "LPR":KadVertaler.Vertaal("Toepassing_LosProfiel"), :"") ; "Profiel" Set:($G(Toepas)="") Toepas=..Toepassing.OmsGet(Taal) ;Do BEGINTAG^XMLWRITE(DevObj,Tag,$S($G(Opties)["GAO":$$PARAMFILL^XMLWRITE("OMS",$ZCVT(Toepas,"O","HTML")),1:"")) Do BEGINTAG^XMLWRITE(DevObj,Tag,$S($G(Opties)["GAO":$$$Attrib("OMS",Toepas),1:"")) Do WRITELN^XMLWRITE(DevObj) Do TAGWRITE^XMLWRITE(DevObj,"DOSSIERNR",..Dossier,$$$Attrib("label","Dossiernr")) Do WRITELN^XMLWRITE(DevObj) If $L(..TemplateUsed) Do . Do TAGWRITE^XMLWRITE(DevObj,"TEMPLATECODE",..TemplateUsed) . Do WRITELN^XMLWRITE(DevObj) If ..Toepassing.ItemID'="GL" Do . Do xmlwPROFIEL(DevObj,%this) . Do WRITELN^XMLWRITE(DevObj) If 'blnLosProf Do . Do ..Vulling.XMLWrite(DevObj,Taal,$G(Opties),%this) . Do WRITELN^XMLWRITE(DevObj) Set Key="" For Set emObj=..Beslag.GetNext(.Key) Quit:Key="" Do . If $$$Not(..IsSchuifdeurBeslagDummy(emObj)) Do . . Do emObj.XMLWrite(DevObj,Taal,$G(Opties),Key,%this) . . Do WRITELN^XMLWRITE(DevObj) If ..Boringen.Count() { Do BEGINTAG^XMLWRITE(DevObj,"BORINGEN",KadVertaler.VertaalXmlLabelAttribute("Boringen")) Do WRITELN^XMLWRITE(DevObj) Do BEGINTAG^XMLWRITE(DevObj,"VERTALINGEN") Do TAGONLY^XMLWRITE(DevObj,"HDR_BOORPLAATS",KadVertaler.VertaalXmlLabelAttribute("lblBoring_Plaats_Kort")) ;Do TAGONLY^XMLWRITE(DevObj,"HDR_XPOS",$$$Attrib("label","X (mm)")) ;Do TAGONLY^XMLWRITE(DevObj,"HDR_YPOS",$$$Attrib("label","Y (mm)")) Do TAGONLY^XMLWRITE(DevObj,"HDR_ANDEREGGVS",KadVertaler.VertaalXmlLabelAttribute("lblBoring_AndereGgvs")) Do TAGONLY^XMLWRITE(DevObj,"HDR_LPOS",KadVertaler.VertaalXmlLabelAttribute("lblBoring_LengtePos_Kort")) Do TAGONLY^XMLWRITE(DevObj,"HDR_RANDPOS",KadVertaler.VertaalXmlLabelAttribute("lblBoring_AfstandRand_Kort")) Do ENDTAG^XMLWRITE(DevObj,"VERTALINGEN",1) Do ENDTAG^XMLWRITE(DevObj,"BORINGEN",1) } Set Key="" For Set emObj=..Boringen.GetNext(.Key) Quit:Key="" Do . Do emObj.XMLWrite(DevObj,Taal,$G(Opties),%this) . Do WRITELN^XMLWRITE(DevObj) If $IsObject(..OphangPlaats) { New VertaalKey Set VertaalKey=$S(..OphangPlaats.ItemID?1(1"L",1"R",1"B"):"lblBeslag_Draairichting", 1:"lblBeslag_OphangPlaats") Do TAGWRITE^XMLWRITE(DevObj,"OPHANGPLAATS",..OphangPlaats.ItemID,KadVertaler.VertaalXmlLabelAttribute(VertaalKey),$S($G(Opties)["GAO":$$$Attrib("OMS",..OphangPlaats.OmsGet(Taal)),1:"")) } Do TAGONLY^XMLWRITE(DevObj,"AFMETINGEN",KadVertaler.VertaalXmlLabelAttribute("Afmeting")) Do TAGWRITE^XMLWRITE(DevObj,"HOOGTE",..Hoogte,"UNIT=""mm""",KadVertaler.VertaalXmlLabelAttribute("lblAfmeting_Hoogte"),$$$Attrib("labelkort",KadVertaler.Vertaal("lblAfmeting_Hoogte_Kort"))) Do TAGWRITE^XMLWRITE(DevObj,"BREEDTE",..Breedte,"UNIT=""mm""",KadVertaler.VertaalXmlLabelAttribute("lblAfmeting_Breedte"),$$$Attrib("labelkort",KadVertaler.Vertaal("lblAfmeting_Breedte_Kort"))) Do WRITELN^XMLWRITE(DevObj) Do xmlwKaderOpties(DevObj,%this) Do TAGONLY^XMLWRITE(DevObj,"OPTIES",KadVertaler.VertaalXmlLabelAttribute("Opties")) If $G(Opties)["GAV" Do ; Tekening opnemen . Do BEGINTAG^XMLWRITE(DevObj,"DRAW", "xmlns:v=""urn:schemas-microsoft-com:vml""") . Do ..XMLVectorWrite(DevObj,$G(Opties),Taal) . Do ENDTAG^XMLWRITE(DevObj,"DRAW") . Do WRITELN^XMLWRITE(DevObj) Do ENDTAG^XMLWRITE(DevObj,Tag) Do WRITELN^XMLWRITE(DevObj) Do:($G(Opties)["GAF") ENDTAG^XMLWRITE(DevObj,"PRODUCTEN") Do:($G(Opties)["GAF") WRITE^XMLWRITE(DevObj,NL) Quit xmlwPROFIEL(DevObj,Obj) Do BEGINTAG^XMLWRITE(DevObj,"PROFIEL",KadVertaler.VertaalXmlLabelAttribute("Profiel")) Do TAGWRITE^XMLWRITE(DevObj,"PROFTYPE",Obj.ProfType.ItemID,$S($G(Opties)["GAO":$$$Attrib("OMS",..ProfType.OmsGet(Taal)),1:"")) Do TAGWRITE^XMLWRITE(DevObj,"PROFAFW",Obj.ProfAfw.KortTekst,$S($G(Opties)["GAO":$$$Attrib("OMS",..ProfAfw.OmsGet(Taal)),1:"")) Do ENDTAG^XMLWRITE(DevObj,"PROFIEL") Quit xmlwKaderOpties(DevObj,Obj) New Param,HList,Key,HVal,tmpOpm,i ; Montage Set Param="" If Obj.Toepassing.ItemID="GL" Do ; "Alleen Glas" is altijd Los/niet gemonteerd . Set Param="" Else If Obj.Gemonteerd="KV" Do ; Kader en Vulling gemonteerd . Set Param="" Else If Obj.Gemonteerd="K" Do ; alleen Kader gemonteerd . Set Param=KadVertaler.Vertaal("Montage_Kader")_$S(Obj.Vulling.Vulling'="":", "_KadVertaler.Vertaal("Montage_VullingLos"), 1:", "_KadVertaler.Vertaal("Montage_GeenVulling")) Else If Obj.Gemonteerd="L" Do ; Los geleverd, niet gemonteerd . Set Param=$S(blnLosProf:"", Obj.Vulling.Vulling'="":KadVertaler.Vertaal("Montage_LosseOnderdelen"), 1:"") Else Set Param="fout: gemonteerd code="_Obj.Gemonteerd Do TAGWRITE^XMLWRITE(DevObj,"MONTAGE",Obj.Gemonteerd,$S(($G(Opties)["GAO")&(Param'=""):$$PARAMFILL^XMLWRITE("OMS",Param),1:"")) ; Verpakking Set Param="" If Obj.Toepassing.ItemID="GL" Do ; "Alleen Glas" is Krimp verpakt . Set Param="" Else If Obj.Verpakking="K" Do ; Krimp verpakking . Set Param="" Else If Obj.Verpakking="B" Do ; Bulk verpakt . Set Param=KadVertaler.Vertaal("VerpakkingBulk") Else If Obj.Verpakking="E" Do ; Verpakking voor Export . Set Param=KadVertaler.Vertaal("VerpakkingExport") Else If Obj.Verpakking="L" Do ; Los verpakt . Set Param=$S(blnLosProf:"", 1:KadVertaler.Vertaal("VerpakkingLosseOnderdelen")) Else If Obj.Verpakking="" Do ; Los verpakt . Set Param="" Else Set Param="fout: verpakking code="_Obj.Verpakking Do TAGWRITE^XMLWRITE(DevObj,"VERPAKKING",Obj.Verpakking,$S(($G(Opties)["GAO")&(Param'=""):$$PARAMFILL^XMLWRITE("OMS",Param),1:"")) ; ProductieWijze If ..ProductieWijze Do . New Param2 . Set Param=$CASE(..ProductieWijze.ItemID, "LPR":KadVertaler.Vertaal("Productie_LosProfiel"), "HHA":KadVertaler.Vertaal("ProductieHerstellingHalux"), "HKL":KadVertaler.Vertaal("Productie_HerstellingKlantMonteert"), :..ProductieWijze.Omschrijving) . Set Param2=$$$HTML(..ProductieWijze.OmsGet(Taal)) . Do TAGWRITE^XMLWRITE(DevObj,"PRODUCTIEWIJZE",..ProductieWijze.ItemID,$S($G(Opties)["GAO":$$PARAMFILL^XMLWRITE("OMS",Param),1:""),$S($G(Opties)["GAO":$$PARAMFILL^XMLWRITE("OMSK",Param2),1:"")) If Obj.Onderdelen.Count() Do . Set Param="" . Set HList="" . Set Key="" . For Set HVal=Obj.Onderdelen.GetNext(.Key) Quit:Key="" Do .. Set:($L(HList)) HList=HList_";" ; Skip first time .. Set:($L(Param)) Param=Param_" + " ; Skip first time .. Set HList=HList_HVal .. Set Param=Param_KadVertaler.Vertaal($Case(HVal, "PL":"Profiel_Links", "PR":"Profiel_Rechts", "PB":"Profiel_Boven", "PO":"Profiel_Onder", "GL":"Vulling", :HVal)) . Set:(Param'="") Param=$$$Replace(KadVertaler.Vertaal("Productie_LosseOnderdelen"),"::OnderdelenLijst",Param) . Do TAGWRITE^XMLWRITE(DevObj,"ONDERDELEN",HList,$S(($G(Opties)["GAO")&(Param'=""):$$PARAMFILL^XMLWRITE("OMS",Param),1:"")) Set tmpOpm=..Opmerking For i=1:1:$LL(tmpOpm) Do . If $$IsList^vhLib($LG(tmpOpm,i)) Do .. Do xmlwAddOpmerking($$$HTML($LG($LG(tmpOpm,i),2))) . Else Do xmlwAddOpmerking($$$HTML($LG(tmpOpm,i))) Do:(Obj.Beslag.GetAt("GA") && (Obj.Beslag.GetAt("GA").BeslagGetObjectId()="5||VFR843")) xmlwAddOpmerking(KadVertaler.Vertaal("MontageHandleiding")) If Obj.Toepassing.ItemID="GL" Do ; "Alleen Glas" is altijd Los/niet gemonteerd . Set:($IsObject(Obj.ProfType)) Param=$$$Replace($$$Replace(KadVertaler.Vertaal("VullingInfoAfstandRand"),"::ParamAG",Obj.AfstandRandVoorVulling()),"::ProfielID",Obj.ProfType.ItemID) ; "Afstand rand - glas: ::ParamAGmm (profiel=::ProfielID)" . Set:('$IsObject(Obj.ProfType)) Param=KadVertaler.Vertaal("VullingInfoGeenProfiel") . Do xmlwAddOpmerking(Param) Quit xmlwAddOpmerking(sOpm) Do:($L($G(sOpm))) TAGWRITE^XMLWRITE(DevObj,"OPMERKING",sOpm,KadVertaler.VertaalXmlLabelAttribute("Opmerking_CAPS")) Quit ]]> %CacheStorage PSKaderdeurDefaultData Beslag subnode "BSL" Boringen subnode "BOR" "KAD" Breedte Hoogte Vulling ProfAfw ProfType Gemonteerd Herstelling Toepassing DraaiRicht OphangPlaats Dossier XMLStreamC Verpakking KostPrijs WijzigTijdStip ProfAfwKostSpecial VullingKostSpecial TemplateRoutine TemplateUsed ConstructKostSpecial Opmerking "KaderDeur" Onderdelen ProductieWijze HerstellingOLD CStream