CheckAantalGelegd()
#define ToOref(%v)    $S('%v:"", 1:$G(arOrefsPLM(+%v)))
#define AddOref(%v)   Set:($L(%v)) arOrefsPLM(+%v)=%v
 New PLM,Key,Qtys,DosNr,N,MaxN
 New lstVolledig,lstOngebruikt,lstOngelijkeN,lstOnvolledig
 New blnVolledig,blnOngebruikt,blnGelijkeN
 New arOrefsPLM,PLMi
 ; Fill array, sorted by (DossierNr\TULijnNr)
 Set Key=""
 For  Set PLM=%this.Profielen.GetNext(.Key) Quit:(Key="")  Do
 . $$$AddOref(PLM)
 . Set PLM.ErrorStatus=""   ; Clear the ErrorStatus previously set
 . Quit:'((PLM.Status="E")||(PLM.Status="F")||(PLM.Status="D"))
 . Set DosNr=PLM.Profiel.KaderDeur.Dossier_"\"_PLM.TULijnNr
 . Quit:(DosNr="")
 . Set:($G(Qtys(DosNr),-1)<PLM.AantalGelegd) Qtys(DosNr)=PLM.AantalGelegd   ; Find Max. AantalGelegd
 . Set Qtys(DosNr,+PLM)=PLM.AantalGelegd
 . Set:($G(Qtys(DosNr,"ST"))'[PLM.Status) Qtys(DosNr,"ST")=$G(Qtys(DosNr,"ST"))_PLM.Status_";"   ; collect different States
 
 ; Analyse Qty's grouped by (DossierNr\TULijnNr)
 Set lstVolledig=""
 Set lstOngebruikt=""
 Set lstOnvolledig=""   ; Onvolledig = (Not Volledig) && (Not Ongebruikt)
 Set lstOngelijkeN=""
 Set DosNr=""
 For  Set DosNr=$O(Qtys(DosNr)) Quit:(DosNr="")  Do
 . Quit:(Qtys(DosNr,"ST")="D")   ; All PLM's of DosNr are disabled.
 . Set MaxN=$G(Qtys(DosNr))
 . Set blnVolledig=1
 . Set blnOngebruikt=1
 . Set blnGelijkeN=1
 . Set PLMi=""
 . For  Set PLMi=$O(Qtys(DosNr,PLMi)) Quit:('PLMi)  Do
 .. Set PLM=$$$ToOref(PLMi)   ; PLM is the oref to the ProfielLijstEleMent
 .. Set blnVolledig=blnVolledig&&(PLM.AantalGelegd=PLM.AantalToelev)
 .. Set blnOngebruikt=blnOngebruikt&&(PLM.AantalGelegd=0)
 .. Set blnGelijkeN=blnGelijkeN&&(PLM.AantalGelegd=MaxN)
 . Do:(blnVolledig) cagAddLBItem(.lstVolledig,DosNr)
 . Do:(blnOngebruikt) cagAddLBItem(.lstOngebruikt,DosNr)
 . Do:('blnGelijkeN) cagAddLBItem(.lstOngelijkeN,DosNr)
 . Do:('blnVolledig)&&('blnOngebruikt) cagAddLBItem(.lstOnvolledig,DosNr)
 
 Do cagSetErrorStatus(lstOnvolledig,"NV")   ; Niet Volledig gelegd
 Do cagSetErrorStatus(lstOngelijkeN,"VA")   ; Verschillende Aantallen voor 1 DossierNr
 Kill arOrefsPLM
 Quit:($LL(lstOngelijkeN_lstOnvolledig)>0) $LB("0")_$S($LL(lstOngelijkeN)>0:$LB("VA"), 1:"")_$S($LL(lstOnvolledig)>0:$LB("NV"), 1:"")   ; _lstOngelijkeN_lstOnvolledig
 Quit $LB("1")
cagAddLBItem(lstMe,sItem)
 ; lstMe should be passed by reference
 Set lstMe=$G(lstMe)_$LB(sItem)
 Quit
cagSetErrorStatus(lstDosNrs,sErrCode)
 New i,DosNr,PLM,PLMi
 For i=1:1:$LL(lstDosNrs) Do
 . Set DosNr=$LIST(lstDosNrs,i)
 . Set PLMi=""
 . For  Set PLMi=$O(Qtys(DosNr,PLMi)) Quit:('PLMi)  Do 
 .. Set PLM=$$$ToOref(PLMi)   ; PLM is the oref to the ProfielLijstEleMent
 .. Set:(PLM.Status'="F") PLM.ErrorStatus=sErrCode
 Quit
 
BookAantalGelegd()
#define ToOref(%v)    $S('%v:"", 1:$G(arOrefsPLM(+%v)))
#define AddOref(%v)   Set:($L(%v)) arOrefsPLM(+%v)=%v
 New PLM,Key,Qtys,DosNr,MaxN,D
 New arOrefsPLM,PLMi
 Set D="\"
 ; Fill array, sorted by DossierNr\TULijnNr
 Set Key=""
 For  Set PLM=%this.Profielen.GetNext(.Key) Quit:(Key="")  Do
 . $$$AddOref(PLM)
 . Set PLM.ErrorStatus=""   ; Clear the ErrorStatus previously set
 . Quit:'((PLM.Status="E")||(PLM.Status="F")||(PLM.Status="D"))
 . Quit:(PLM.Status'?1(1"E",1"F",1"D"))
 . Set DosNr=PLM.Profiel.KaderDeur.Dossier_"\"_PLM.TULijnNr
 . Quit:(DosNr="")
 . Set:($G(Qtys(DosNr),-1)<PLM.AantalGelegd) Qtys(DosNr)=PLM.AantalGelegd   ; Find Max. AantalGelegd
 . Set Qtys(DosNr,+PLM)=PLM.AantalGelegd
 . Set:($G(Qtys(DosNr,"ST"))'[PLM.Status) Qtys(DosNr,"ST")=$G(Qtys(DosNr,"ST"))_PLM.Status_";"   ; collect different States
 ; Book Qtys in ^HADPR
 Set DosNr=""
 For  Set DosNr=$O(Qtys(DosNr)) Quit:(DosNr="")  Do
 . Quit:(Qtys(DosNr,"ST")="D")   ; All PLM's of DosNr are disabled.
 . Set PLMi=$O(Qtys(DosNr,""))
 . Set PLM=$$$ToOref(PLMi)       ; PLM is the oref to the ProfielLijstEleMent ; get first Profiel from DosNr
 . Quit:('PLM)
 . Quit:('PLM.Toelevering)
 . Quit:($E(PLM.Toelevering,1)="9")   ; for testing (simulation) purposes
 . Do bagMarkPR(PLM.Toelevering,PLM.TULijnNr,"T", $G(Qtys(DosNr)), PLM.AantalToelev, $H, )
 Kill arOrefsPLM
 Quit 1
bagMarkPR(ToeNr,TULijnNr,Node,NewQty,MaxQty,Time,Ref)
 New RecP,i,TLKey
 Set TLKey=..PRToelevKey(ToeNr,TULijnNr)
 Lock +^HADPR("F",TLKey)
 Set RecP=$G(^HADPR("F",TLKey,Node))
 If ($P(RecP,D,3)="A") Do  Quit   ; Already finished. Do not overwrite
 . Lock -^HADPR("F",TLKey)
 ; Log previous value
 For i=11:2:20 Quit:($P(RecP,D,i+1)="")
 Set $P(RecP,D,i)=$P(RecP,D)
 Set $P(RecP,D,i+1)=$G(Time)
 ; Set new values
 Set $P(RecP,D,1)=NewQty
 Set $P(RecP,D,2)=Time
 Set $P(RecP,D,3)=$S(+NewQty=0:"", NewQty=MaxQty:"A", 1:"P")   ; Status = "" / "P"artial / "A"LL 
 Set $P(RecP,D,4)=$G(Ref)
 Set ^HADPR("F",TLKey,Node)=RecP
 Lock -^HADPR("F",TLKey)
 Quit
 
 
 
ProfielPlaatsbaarID()   ; Parameters: PLIndex,KalIndex,BLOrefs,blnKoppelProfs
 ; Geeft plaatsbare PLIndex terug.  KalIndex als .local doogegeven
 Quit:(+$G(PLIndex)'>0) ""
 Quit:($G(BLOrefs)="") ""
 New PlaatsID,blnProfGekoppeld,lstGekoppelde,i
 New PLM,BL,emBed
 Set PlaatsID=""
 Set PLM=..Profielen.GetAt(PLIndex)
 Quit:('PLM) ""
 Set blnProfGekoppeld=0
 If blnKoppelProfs Do
 . Set lstGekoppelde=..GekoppeldeZoeken(PLIndex)
 . If $L(lstGekoppelde)&&($L(lstGekoppelde,";")>0) Do
 ..  Set blnProfGekoppeld=1
 ..  Set KalIndex = 1
 
 ;If 'blnProfGekoppeld Do   ; Geen gekoppelde profielen
 If 1 Do
 . For i=1:1:$L(BLOrefs,";") Do  Quit:(PlaatsID'="")
 ..  Quit:(+KalIndex>0)&&(+KalIndex'=i)
 ..  Set BL=+$P(BLOrefs,";",i)
 ..  Set:($L(BL)) BL=$G(%VHOREFS(+BL))
 ..  Quit:('BL)
 ..  Quit:(BL.%ClassName()'["BedLijst")
 ..  Set emBed=BL.FreesBed.GetPrevious("")
 ..  Quit:('emBed)
 ..  Set:(emBed.IsProfielPlaatsbaar(PLM.Profiel)) PlaatsID=PLIndex
 ..  Set:(PlaatsID'="") KalIndex=i
 
 If (blnProfGekoppeld)&&(PlaatsID="") Do   ; Zoeken welk van de gekoppelde profielen in eerste Kaliber past
 . Set KalIndex = 1
 . Set BL=+$P(BLOrefs,";",KalIndex)
 . Set:($L(BL)) BL=$G(%VHOREFS(+BL))
 . Quit:('BL)
 . Quit:(BL.%ClassName()'["BedLijst")
 . Set emBed=BL.FreesBed.GetPrevious("")
 . Quit:('emBed)
 . For i=1:1:$L(lstGekoppelde,";") Do  Quit:(PlaatsID'="")
 ..  Set PLM=..Profielen.GetAt($P(lstGekoppelde,";",i))
 ..  Quit:('PLM)
 ..  Set:(emBed.IsProfielPlaatsbaar(PLM.Profiel)) PlaatsID=$P(lstGekoppelde,";",i)
 . If PlaatsID="" Set KalIndex=""
 
 Quit PlaatsID
 
 
UpdateArraySet   ; Parameters: Node,SubNode,Value
 Quit:($G(Node)="")
 Quit:($G(Value)="")
 If +Value Do   ; Create Node(+SubNode)
 . If $G(SubNode)="" Set UpdateAr(Node)=""   ; Leeg is voldoende voor de test  $DATA()'=0
 . Else  Set UpdateAr(Node,SubNode)=""
 Else  Do   ; Kill  Node(+SubNode)
 . If Node="ALL"  Kill UpdateAr
 . Else  If $G(SubNode)=""  Kill UpdateAr(Node)
 . Else  Kill UpdateAr(Node,SubNode)
 Quit
 
UpdateArrayGet()   ; Parameters: Node,KillNode
 Quit:($G(Node)="") ""
 New LB,sNode
 Set LB=""
 If $D(UpdateAr(Node))#10 Do  ; Node has Data ==> Update ALL
 . Set LB=$LB("ALL")
 If $D(UpdateAr(Node))>1 Do  ; Node has Subnodes ==> Update subnodes
 . Set sNode=""
 . For  Set sNode=$O(UpdateAr(Node,sNode))  Quit:(sNode="")  Do
 ..  Set LB=LB_$LB(sNode)
 If (+$G(KillNode) && $D(UpdateAr(Node)))  Kill UpdateAr(Node)
 Quit LB
 
 
GekoppeldeZoeken()   ; Parameters: PLIndex
#define Sep  ";"
 Quit:($G(PLIndex)'>0) ""
 New Key,emProf,KadID,PLM,lstPL
 Set:(PLIndex>%this.Profielen.Count()) PLIndex=%this.Profielen.Count()
 Set emProf=%this.Profielen.GetAt(PLIndex).Profiel
 Set KadID=emProf.KaderDeurGetObjectId()
 Quit:(KadID="") ""
 Set lstPL=""
 Set Key=""
 For  Set PLM=%this.Profielen.GetNext(.Key) Quit:(Key="")  Do
 . ; Checken dat (PLM.BedVakAantal>1) is niet gegarandeerd om correcte resultaten te verkrijgen.
 . Quit:(Key=PLIndex)
 . If (PLM.Profiel.KaderDeurGetObjectId()=KadID)&&(PLM.Profiel.ProfPlaats=emProf.ProfPlaats) Do
 ..  Set:($$gkzIsGekoppeld(PLM.Profiel,emProf)) lstPL=lstPL_$$$Sep_Key
 Set:($E(lstPL,1)=$$$Sep) $E(lstPL,1)=""   ; Remove first ";"
 Quit lstPL
gkzIsGekoppeld(Prof1,Prof2)
 ; De combinatie P??-ON met P??-IN geldt als Gekoppeld.  Deze lijst/beperking kan later uitgebreid worden.
 ; De combinatie P??-ON met P??-EX als Gekoppeld (lijn toegevoegd op 14/04/2004 door WimV)
 New Concat
 Set Concat=Prof1.ProfZijkant_";"_Prof2.ProfZijkant
 Quit:(Concat["ON")&&(Concat["IN") 1
 Quit:(Concat["ON")&&(Concat["EX") 1
 Quit 0
 
 
XMLVectorWrite(DevObj,Opties,%this)
 ; Fabr.Frees.ProfielLijst.XMLVectorWrite(DevObj,Opties)
 New emProfLE,Key,NL
 Set NL=$C(13)_$C(10)
 Do BEGINTAG^XMLWRITE(DevObj, "PROFIELLIJST")
 Do WRITE^XMLWRITE(DevObj,NL)
 Set Key=""
 For  Set emProfLE=%this.Profielen.GetNext(.Key) Quit:Key=""  Do
 . Do:($L(emProfLE.Profiel)) emProfLE.Profiel.XMLVectorWrite(DevObj,$G(Opties)_"",1800,2800)
 . Do WRITE^XMLWRITE(DevObj,"<BR/>")
 
 Do ENDTAG^XMLWRITE(DevObj, "PROFIELLIJST")
 Do WRITE^XMLWRITE(DevObj,NL)
 Quit
 
XMLTestHTML(DevObj,Opties,XSLName,%this)
 ; Fabr.Frees.ProfielLijst.XMLTestHTML(DevObj,Opties,XSLName)
 New emProfLE,Key,NL,sHead
 Set NL=$C(13)_$C(10)
 Set sHead="<HTML xmlns:v=""urn:schemas-microsoft-com:vml"">"_NL_"<HEAD>"_NL_"<title>HALUX PROFIELLIJST</title>"_NL_"<style>v\:* {behavior:url(#default#VML);}</style>"_NL_"</HEAD>"_NL_"<BODY onclick=""alert('hoehoe');"">"
         Set sHead=sHead_NL_"<SCRIPT language=""javascript"">"_NL_"window.onclick=""alert('hoehoe')"";"_NL_"//document.body.scroll=""no"";"_NL_"</SCRIPT>"
 
 Do WRITE^XMLWRITE(DevObj,sHead_NL)
 Do WRITE^XMLWRITE(DevObj,NL)
 
 Do %this.XMLVectorWrite(DevObj,$G(Opties))
 
 Do WRITE^XMLWRITE(DevObj,NL)
 Do WRITE^XMLWRITE(DevObj,NL)
 Do ENDTAG^XMLWRITE(DevObj,"BODY"_NL)
 Do WRITE^XMLWRITE(DevObj,NL)
 Do ENDTAG^XMLWRITE(DevObj,"HTML"_NL)
 Quit
 
 
 
AddKaderDeur   ; Parameters: KadObj,Qty,ToelevNr,TULijnNr
 ; Fabr.Frees.ProfielLijst.AddKaderDeur(KadObj,Qty,ToelevNr,TULijnNr)
 New lstBor,Key,PosKey,emBeslag
 ; Boringen
 Set Key=""
 For  Do KadObj.Boringen.GetNext(.Key) Quit:Key=""  Do
 . Do akdAddBoring(KadObj.Boringen.GetAt(Key),Key)
 ; Beslag
 Set Key=""
 For  Set emBeslag=KadObj.Beslag.GetNext(.Key) Quit:Key=""  Do
 . Set PosKey=""
 . For  Do emBeslag.Positie.GetNext(.PosKey) Quit:PosKey=""  Do
 ..  Do akdAddBeslagBoringen(Key, PosKey)
 ; Summarize
 If $D(lstBor)>0 Do
 . New iKant,iPlaats
 . Set iPlaats=""
 . For  Set iPlaats=$O(lstBor(iPlaats)) Quit:(iPlaats="")  Do
 ..  Set iKant=""
 ..  For  Set iKant=$O(lstBor(iPlaats,iKant)) Quit:(iKant="")  Do
 ...   Do akdProfKDSummarize(lstBor(iPlaats,iKant))
 Quit
akdAddBoring(objBoring,BoorKey)
 ; Boringen in het Profiel
 Quit:(objBoring.BoringPlaats="VUL")      ; Boring is alleen in de Vulling
 New Plaats,Kant,ArrIndex,emProf,emFrezing
 New I,ToolIDs
 Set Plaats=KadObj.ProfielPlaatsGet(objBoring)
 Quit:(KadObj.NietOpProfiel(Plaats))
 Set Kant=objBoring.BoringType
 Set:(Kant="") Kant="ON"
 Set ArrIndex=$$akdGetIndexFromPL(Plaats,Kant)
 Set emProf=%this.Profielen.GetAt(ArrIndex).Profiel
 Quit:('emProf)
 Set I=0
 Set:(objBoring.BoringPlaats'?1(1"PL",1"PR",1"PB",1"PO").E) objBoring.CncID="!"
 Set ToolIDs=##Class(Res.PI.FreesTool).ToolsForBoring(objBoring)
 For I=1:1:$L(ToolIDs,";") Do   ; Minstens één maal uitvoeren, ook als ToolIDs=""
 . Set emFrezing=##class(Fabr.Frees.emFrezing).%New()
 . Do akdTransformBoringType(objBoring, emFrezing, $P(ToolIDs,";",I))
 . Do akdTransformBoringPos(objBoring, emFrezing)
 . Do akdFrezingAndUitloop
 . ;Do emProf.Frezingen.Insert(emFrezing)
 . Do emFrezing.%Close() 
 Quit
akdAddBeslagBoringen(BeslagKey,PosKey)
 ; Boringen nodig voor het Beslag
 New emBeslag,Plaats,Kant,TYP,LPosB,RPosB,objProf
 New objBoring,Diam,Kant,BoorKey
 New I,ToolIDs
 
 Set emBeslag=KadObj.Beslag.GetAt(BeslagKey)
 Set objProf=KadObj.ProfType
 Set Plaats=KadObj.ProfielPlaatsGet(emBeslag, BeslagKey, PosKey)
 Set TYP=emBeslag.Beslag.AfstandBoorMaat.GetAt("TYP")
 Set:(TYP="") TYP="ON+"   ; Default
 Quit:(Plaats="")
 Quit:(KadObj.NietOpProfiel(Plaats))
 
 ; Transform BeslagPos to Frezing Position
 Set LPosB=emBeslag.Positie.GetAt(PosKey).LengtePos
 Set:(LPosB<0) LPosB=$S((Plaats="PL")||(Plaats="PR"):KadObj.Hoogte, (Plaats="PB")||(Plaats="PO"):KadObj.Breedte, 1:0)+LPosB   ; calc from opposite side
 Set:(Plaats'="PL")&&(Plaats'="PO") LPosB=$CASE(Plaats, "PR":KadObj.Hoogte-LPosB, "PB":KadObj.Breedte-LPosB, :0)             ; Transform 
 Set RPosB=emBeslag.Positie.GetAt(PosKey).AfstandRand
 If TYP="ON+"       ;Set RPosB=RPosB
 Else  If TYP="ON-" Set RPosB=objProf.Breedte-RPosB
 Else  If TYP="IN+" ;Set RPosB=RPosB
 Else  If TYP="IN-" Set RPosB=objProf.Dikte-RPosB
 Else  If TYP="BO+" ;Set RPosB=RPosB
 Else  If TYP="BO-" Set RPosB=objProf.Breedte-RPosB
 Else  If TYP="EX+" ;Set RPosB=RPosB
 Else  If TYP="EX-" Set RPosB=objProf.Dikte-RPosB
 Else  ;
 
 ; Transform BeslagBoringPos to Frezing Position and add FrezingBeslagPos for each boring
 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 ArrIndex=$$akdGetIndexFromPL(Plaats,Kant)
 . Set emProf=%this.Profielen.GetAt(ArrIndex).Profiel
 . Quit:('emProf)
 . ;
 . Set I=0
 . Set ToolIDs=##Class(Res.PI.FreesTool).ToolsForBoring(objBoring)
 . For I=1:1:$L(ToolIDs,";") Do   ; Minstens één maal uitvoeren, ook als ToolIDs=""
 ..  Set emFrezing=##class(Fabr.Frees.emFrezing).%New()
 ..  Do akdTransformBoringType(objBoring, emFrezing, $P(ToolIDs,";",I))
 ..  Do akdTransformBeslagBoringPos   ; (objBoring, emFrezing, Plaats,Kant,TYP,LPosB,RPosB)
 ..  Do akdFrezingAndUitloop
 ..  ;Do emProf.Frezingen.Insert(emFrezing)   ; gebeurt in "akdFrezingAndUitloop"
 ..  Do emFrezing.%Close()
 Quit
akdFrezingAndUitloop
 ; Determine FreesUitloop and add Frezing to list if Uitloop is compatibel
 ; i.e. Uitloop equals "MID" or emProf.FreesUitloop.
 New Uitl
 Set Uitl="MID"   ; objBoring.FreesUitloop
 If (Uitl="")||(Uitl="MID"), emFrezing.FreesTool  Set:($L(emFrezing.FreesTool.Type)>2) Uitl=emFrezing.FreesTool.FreesUitloop
 If (emProf.FreesUitloop'="MID")&&("MID;"_emProf.FreesUitloop'[Uitl) Do
 . ; Disable (Prevent) the emFrezing
 . Set emFrezing.StatusFreesTool="P"
 Else  Do
 . ; Check if emProf.FreesUitloop should be changed
 . If emProf.FreesUitloop="MID" Set:(";MID"'[Uitl) emProf.FreesUitloop=Uitl
 Do emProf.Frezingen.Insert(emFrezing)
 Quit
akdTransformBoringType(objBoring,emFrezing,ID) 
 ; Transforms the data of objBoring to the emFrezing data
 ; objBoring is an object of the class  Prod.GADef.emKadBoring
#define cRUG            "RUGB"
#define cDOOR           "DOORB"
#define cAFSCHUIN       "AFSCHUIN"
#define cKAD            "KADFREES"
#define cSD30           "SD30M"
#define cSD35           "SD35M"
 
 Set emFrezing.StatusFreesTool=$S($E(ID,1)="!":"P", 1:"")
 Do:($L(ID)) emFrezing.FreesToolSetObjectId($TR(ID,"!",""))
 If emFrezing.FreesTool Do
 . If $L(emFrezing.FreesTool.Type)>2 Do
 .. Set emFrezing.CNCProg=$CASE(emFrezing.FreesTool.Type, "KAD":$$$cKAD, "SD30":$$$cSD30, "SD35H":$$$cSD35, "SD35L":$$$cSD35, :emFrezing.FreesTool.Type)
 . Else  Do
 .. Set emFrezing.CNCProg=$S(emFrezing.FreesTool.Type="S":$$$cAFSCHUIN, emFrezing.FreesTool.DiepteType="D":$$$cDOOR, 1:$$$cRUG)
 Set emFrezing.Diameter=objBoring.BoorDiameter
 Set emFrezing.AfschuinDiameter=objBoring.AfschuinDiameter
 Set:(objBoring.BoorDiepte>1) emFrezing.Diepte=objBoring.BoorDiepte
   ;s:('$D(ClientIP)) ClientIP="192.168.1.97"
   ;d WL^vhDBG("B->F: "_objBoring.CncID_"  ToolID="_ID_"  obj:"_emFrezing.FreesTool)
 Quit
akdTransformBoringPos(objBoring,emFrezing)
 ; Transforms the position of objBoring to the emFrezing position
 ; objBoring is an object of the class  Prod.GADef.emKadBoring
 New emPos
 Set emPos=##class(Fabr.Frees.emPos).%New()
 Set emPos.X=objBoring.CalcLPos(KadObj)
 Set emPos.Y=objBoring.CalcRandPos(KadObj)
 Set:(emPos.Y[":") emPos.Y=$P(emPos.Y,":", 2,99)   ; $E(emPos.Y, $F(emPos.Y,":"), 99)   ; interne/externe boringen geven "IN:7" of "EX:5" terug
 Set emPos.Z=objBoring.CalcHoogtePos(KadObj,1)
 Do akdMirrorYPosWhenEXorBO
 Do emFrezing.Positie.Insert(emPos)
 Do emPos.%Close()
 Quit
akdTransformBeslagBoringPos   ; (objBoring,emFrezing,Plaats,Kant,TYP,LPosB,RPosB)
 ; Transforms the position of objBoring to the emFrezing position
 ; objBoring is an object of the class  Prod.GADef.emKadBoring
 New emPos,TYPz,BT,TX,TY,TZ,blnRand
 Set emPos=##class(Fabr.Frees.emPos).%New()
 Set TYPz=$E(TYP,1,2)
 Set BT=objBoring.BoringType
 
   ;s:('$D(ClientIP)) ClientIP="192.168.1.97"
   ;d WL^vhDBG("TF: "_emFrezing.CNCProg_" , TYP="_TYP_"  BT="_BT_" ")
 
 ; Transform BoringPos (XPos,YPos)
 Set TX=objBoring.YPos*$S((Plaats="PR")||(Plaats="PB"):-1, 1:1)
 If BT="ON" Do               ; (TYPz="ON") is previous condition (until 31/03/2004)
 . Set TY=objBoring.XPos
 . Set TZ=0
 Else  If BT="IN" Do         ; (TYPz="IN") is previous condition (until 31/03/2004)
 . Set TY=objBoring.ZPos
 . Set TZ=0   ; objBoring.XPos*$S((Plaats="PR")||(Plaats="PB"):-1, 1:1)
 Else  If BT="EX" Do         ; (TYPz="EX") is previous condition (until 31/03/2004)
 . Set TY=objBoring.ZPos
 . Set TZ=0   ; objBoring.XPos*$S((Plaats="PR")||(Plaats="PB"):-1, 1:1)
 Else  Do
 . Set TY=0
 . Set TZ=0
 
 ; Ligt de Boring in hetzelfde vlak (X,Y)of(Z,Y) als de Definitie van AfstandRand, bepaald door Beslag.BoorMaat.GetAt("TYP") ?
 ; i.e.  Als BoringType=  (ON or BO)  , TYP moet gelijk zijn aan (ON+ or ON- or BO- or BO+)   dan O.K.
 ;       Als BoringType=  (IN or EX)  , TYP moet gelijk zijn aan (IN+ or IN- or EX- or EX+)   dan O.K.
 ;    ELSE :  [Boring]  and  [AfstandRand]  are not related to each other.
 If (BT?1(1"ON",1"BO"))&&(TYPz?1(1"ON",1"BO")) Set blnRand=1
 Else  If (BT?1(1"IN",1"EX"))&&(TYPz?1(1"IN",1"EX")) Set blnRand=1
 Else  Set blnRand=0
 
 ; Add BeslagPos (LPosB,RPosB)
 Set emPos.X=TX+LPosB
 Set emPos.Y=TY+$S(blnRand:RPosB, 1:0)
 Set emPos.Z=objBoring.CalcHoogtePos(KadObj,1)    ; +TZ  
   ;d WL^vhDBG("TF: "_emFrezing.CNCProg_" , TX="_TX_" , TY="_TY_" , TZ="_TZ_"  emPos.(X,Y,Z)="_emPos.X_" , "_emPos.Y_" , "_emPos.Z)
 Do akdMirrorYPosWhenEXorBO
 Do emFrezing.Positie.Insert(emPos)
 Do emPos.%Close()
 Quit
akdMirrorYPosWhenEXorBO
 Quit:'((Kant="BO")||(Kant="EX"))
 Set:(Kant="BO") emPos.Y=KadObj.ProfType.Breedte-emPos.Y
 Set:(Kant="EX") emPos.Y=KadObj.ProfType.Dikte-emPos.Y
 Quit
akdGetIndexFromPL(Plaats,Kant)
 ; Returns the Key(index) to array element corresponding to (Plaats,Kant) 
 Quit:($G(lstBor(Plaats,Kant))>0) lstBor(Plaats,Kant)   ;  element exists:
 ; (Else)  this element does not yet exist;  create it in lstBor AND ALSO in %this(=ProfielLijst):
 New Cnt
 Set Cnt=%this.Profielen.Count()+1
 Do akdAddProfToArray(Plaats, Kant, Cnt)
 Set lstBor(Plaats,Kant)=Cnt
 Quit Cnt
akdAddProfToArray(Plaats,Kant,ArrKey)
 New emProfLE,emProf
 Set emProfLE=##class(Fabr.Frees.emProfielLijstElement).%New()
 Set emProf=##class(Fabr.Frees.emProfiel).%New()
 Set emProfLE.Toelevering=ToelevNr
 Set emProfLE.TULijnNr=TULijnNr
 Set emProfLE.AantalToelev=Qty
 Set emProfLE.AantalGelegd=$$akdGetAantalGelegd(ToelevNr,TULijnNr,"T",Qty)
 ;Set emProfLE.AantalGelegd=$$akdGetAantalGelegdPrev(KadObj.ProductGetObjectId(),"T",ToelevNr,Qty)
 Set emProfLE.Status=$S(emProfLE.AantalGelegd=emProfLE.AantalToelev:"I", 1:"D")   ; "I"nitial disabled  OR "D"isabled
 Set emProf.KaderDeur=KadObj
 Set emProf.ProfPlaats=Plaats
 Set emProf.ProfZijkant=Kant
 Set emProf.FreesUitloop="MID"
 Set emProf.Lengte=$S((Plaats="PL")||(Plaats="PR"):KadObj.Hoogte, (Plaats="PB")||(Plaats="PO"):KadObj.Breedte, 1:0)
 Set emProfLE.Profiel=emProf
 Do emProf.%Close()
 Do %this.Profielen.SetAt(emProfLE, ArrKey)
 Do emProfLE.%Close()
 Quit 
akdGetAantalGelegd(ToeNr,TULijnNr,Node,MaxQty)
 New NewQty
 Set NewQty=+$P($G(^HADPR("F",..PRToelevKey(ToeNr,TULijnNr),Node)),"\",1)
 Quit:(NewQty>MaxQty) MaxQty
 Quit NewQty
 ;akdGetAantalGelegdPrev(PRNr,Node,ToeNr,MaxQty)
 ;Quit:($G(PRNr)="") 0
 ;Quit:($G(^HADPR("P",PRNr,"P",Node))="") 0
 ;New NewQty
 ;Set NewQty=+$P(^HADPR("P",PRNr,"P",Node),"\",1)
 ;Quit:(NewQty>MaxQty) MaxQty
 ;Quit NewQty
akdProfKDSummarize(ArrKey)
 ; Invullen van  emProfLE.BedZijkantAantal  en  emProf.FrezingenOverzicht
 New emProfLE,emProf,Plaats,Kant,Diff
 Set emProfLE=%this.Profielen.GetAt(ArrKey)
 Quit:('emProfLE)
 Quit:('emProfLE.Profiel)
 Set emProf=emProfLE.Profiel
 ; Calculate BedZijkantAantal: i.e. Count of occurences of ProfZijkant for this ProfPlaats
 Set Diff=0, Kant="", Plaats=emProf.ProfPlaats
 For  Set Kant=$O(lstBor(Plaats,Kant)) Quit:(Kant="")  Set Diff=Diff+1    ; Set x=$INCREMENT(Diff)
 Set emProfLE.BedZijkantAantal=Diff
 ; Calculate FrezingenOverzicht: i.e. Summary of all Frezingen on this ProfZijkant
 Set emProf.FrezingenOverzicht=emProf.FrezingenOverzichtCalc()
 Quit
 
 ;Oproepen via  "Do ##class(Fabr.Frees.ProfielLijst).DebugLog("ClearFREESLOG",$LB(286897))"
DebugLog   ; Parameters: (DbgCode,lbParams)
#define UCASE(%v)   $ZCVT(%v,"U")
	Set:($G(DbgCode)="") DbgCode="?"
	If (DbgCode="?")||($$$UCASE(DbgCode)="HELP") Do
	. w "dbg - SHOWFREESLOG      - $LB(ToeNr)",!
	. w "dbg - CLEARFREESLOG     - $LB(ToeNr)",!
	Else  Do
	. Do @("dbg"_$$$UCASE(DbgCode))
	Quit
dbgSHOWFREESLOG   ; Parameters: lbParams = $LB(ToeNr)
 New Key
 Set ToeNr=$LG($G(lbParams),1,"286897")
 W "voor Toelevering "_ToeNr_" :",!
 Set Key=ToeNr_";"  
 For  Set Key=$O(^HADPR("F",Key)) Quit:($E(Key,1,$L(ToeNr))'=ToeNr)  Do
 . Set TULijnNr=Key
 . W $$ArrayToText^vhLib($Name(^HADPR("F",TULijnNr,"T"))),!
 Quit
dbgCLEARFREESLOG   ; Parameters: lbParams = $LB(ToeNr)
 New Key,ToeNr,msg,YesNo
 Set ToeNr=$LG($G(lbParams),1,"286897")
 W !,"Reset Toelevering "_ToeNr_" [Y/N]? "
 Read YesNo
 Write !
 If $$$UCASE(YesNo)'="Y" Do  Quit
 . W "Toelevering is NIET ge-reset.",!
 ; Else 
 Set Key=ToeNr_";"  
 For  Set Key=$O(^HADPR("F",Key)) Quit:($E(Key,1,$L(ToeNr))'=ToeNr)  Do
 . Set TULijnNr=Key
 . Do dbgMarkPR(Key,"T",0,99,$H)
 . W "NEW: "_$$ArrayToText^vhLib($Name(^HADPR("F",TULijnNr,"T"))),!
 
 If $L($G(TULijnNr)) Do
 . W "Toelevering ge-reset.",!
 Else  Do
 . ; '$D(^HADPR("F",$O(^HADPR("F",ToeNr_";")))) 
 . W "Geen gegevens voor deze toelevering.",!
 . W "Toelevering is NIET ge-reset.",!
 
 Quit
dbgMarkPR(TLKey,Node,NewQty,MaxQty,Time,Ref)
 New RecP,i,D
 Set D="\"
 Lock +^HADPR("F",TLKey)
 Set RecP=$G(^HADPR("F",TLKey,Node))
 ;; Log previous value
 ;For i=11:2:20 Quit:($P(RecP,D,i+1)="")
 ;Set $P(RecP,D,i)=$P(RecP,D)
 ;Set $P(RecP,D,i+1)=$G(Time)
 ; Set new values
 Set $P(RecP,D,1)=NewQty
 Set $P(RecP,D,2)=Time
 Set $P(RecP,D,3)=$S(+NewQty=0:"", NewQty=MaxQty:"A", 1:"P")   ; Status = "" / "P"artial / "A"LL 
 Set $P(RecP,D,4)=$G(Ref)
 Set ^HADPR("F",TLKey,Node)=RecP
 Lock -^HADPR("F",TLKey)
 Quit