Index: vhLib/Math.mac.rou =================================================================== diff -u -r17 -r97 --- vhLib/Math.mac.rou (.../Math.mac.rou) (revision 17) +++ vhLib/Math.mac.rou (.../Math.mac.rou) (revision 97) @@ -1,7 +1,7 @@ - - -Afronden(Getal,Op) - - Quit - - \ No newline at end of file + + +Afronden(Getal,Op) + + Quit + + Index: vhLib/Array.mac.rou =================================================================== diff -u -r17 -r97 --- vhLib/Array.mac.rou (.../Array.mac.rou) (revision 17) +++ vhLib/Array.mac.rou (.../Array.mac.rou) (revision 97) @@ -1,17 +1,17 @@ - - - - -Append(arMain,arItems) - - New IdxItems Set IdxItems="" - For Set IdxItems = $O(arItems(IdxItems)) Quit:IdxItems="" Do - . Set NewIdx = $O(arMain(""),-1)+1 - . Set arMain=NewIdx - . Set arMain(NewIdx)=arItems(IdxItems) - Quit - - - - - \ No newline at end of file + + + + +Append(arMain,arItems) + + New IdxItems Set IdxItems="" + For Set IdxItems = $O(arItems(IdxItems)) Quit:IdxItems="" Do + . Set NewIdx = $O(arMain(""),-1)+1 + . Set arMain=NewIdx + . Set arMain(NewIdx)=arItems(IdxItems) + Quit + + + + + Index: vhLib/cspError.inc.rou =================================================================== diff -u -r17 -r97 --- vhLib/cspError.inc.rou (.../cspError.inc.rou) (revision 17) +++ vhLib/cspError.inc.rou (.../cspError.inc.rou) (revision 97) @@ -1,11 +1,11 @@ - - // From Method keywords -#define fmOnPreHTTP "OnPreHTTP" -#define fmHyperEventError "HyperEventError" - - // Error Type keywords (main categories to be distinguish when a CSP error occured) -#define etPageLoadError "PageLoadError" -#define etPreHTTPTimeOut "PreHTTPTimeOut" -#define etHyperEventError "HyperEventError" -#define etHyperEventTimeOut "HyperEventTimeOut" - \ No newline at end of file + + // From Method keywords +#define fmOnPreHTTP "OnPreHTTP" +#define fmHyperEventError "HyperEventError" + + // Error Type keywords (main categories to be distinguish when a CSP error occured) +#define etPageLoadError "PageLoadError" +#define etPreHTTPTimeOut "PreHTTPTimeOut" +#define etHyperEventError "HyperEventError" +#define etHyperEventTimeOut "HyperEventTimeOut" + Index: vhLib/System.mac.rou =================================================================== diff -u -r17 -r97 --- vhLib/System.mac.rou (.../System.mac.rou) (revision 17) +++ vhLib/System.mac.rou (.../System.mac.rou) (revision 97) @@ -1,36 +1,36 @@ -#Include vhLib.Macro - - // ========================================================================================================================================== - // Name : ParseStatus - // Author : TOM ROMBAUT - // Function: Opdrachten zoals %Save & %Delete geven een resultaat terug van het type %Status. Deze status is echter 'gecodeerd' en kan - // via deze functie leesbaar gemaakt worden naar de gebruiker toe - // ========================================================================================================================================== - -#Include %occStatus - -ParseStatus(Status,IgnoreFirstLine) - Quit:('('Status)) "" //sluit wanneer geen error! - Set IgnoreFirstLine=$G(IgnoreFirstLine) - New ParsedStatus - Set ParsedStatus="" - New Error,Loop - Do DecomposeStatus^%apiOBJ(Status,.Error,"") - New Start - Set Start=$S(IgnoreFirstLine && (Error>1):2,1:1) - For Loop=Start:1:Error Do - . Set ParsedStatus=ParsedStatus_$S(ParsedStatus="":"",1:$C(13,10))_Error(Loop) - Quit ParsedStatus - - - // ========================================================================================================================================== - // Name : GetJobInfo - // Author : Wim Vermeulen - // Function: Geeft informatie over de huidige job. - // Handig bij het versturen van bvb. mails met een error-melding - // ========================================================================================================================================== -GetJobInfo(blnMultiLine,Indent) - Set Indent=$G(Indent),blnMultiLine=$G(blnMultiLine,1) - Set Txt=Indent_"Device: "_$I_" Job: "_$J - Set Txt=Txt_$S(blnMultiLine:$$$CRLF_Indent, 1:" ")_"Server: "_$$$Server_" NameSpace: "_$$$NSpace_$S(blnMultiLine:$$$CRLF, 1:"") - Quit Txt \ No newline at end of file +#Include vhLib.Macro + + // ========================================================================================================================================== + // Name : ParseStatus + // Author : TOM ROMBAUT + // Function: Opdrachten zoals %Save & %Delete geven een resultaat terug van het type %Status. Deze status is echter 'gecodeerd' en kan + // via deze functie leesbaar gemaakt worden naar de gebruiker toe + // ========================================================================================================================================== + +#Include %occStatus + +ParseStatus(Status,IgnoreFirstLine) + Quit:('('Status)) "" //sluit wanneer geen error! + Set IgnoreFirstLine=$G(IgnoreFirstLine) + New ParsedStatus + Set ParsedStatus="" + New Error,Loop + Do DecomposeStatus^%apiOBJ(Status,.Error,"") + New Start + Set Start=$S(IgnoreFirstLine && (Error>1):2,1:1) + For Loop=Start:1:Error Do + . Set ParsedStatus=ParsedStatus_$S(ParsedStatus="":"",1:$C(13,10))_Error(Loop) + Quit ParsedStatus + + + // ========================================================================================================================================== + // Name : GetJobInfo + // Author : Wim Vermeulen + // Function: Geeft informatie over de huidige job. + // Handig bij het versturen van bvb. mails met een error-melding + // ========================================================================================================================================== +GetJobInfo(blnMultiLine,Indent) + Set Indent=$G(Indent),blnMultiLine=$G(blnMultiLine,1) + Set Txt=Indent_"Device: "_$I_" Job: "_$J + Set Txt=Txt_$S(blnMultiLine:$$$CRLF_Indent, 1:" ")_"Server: "_$$$Server_" NameSpace: "_$$$NSpace_$S(blnMultiLine:$$$CRLF, 1:"") + Quit Txt Index: vhLib/Class.inc.rou =================================================================== diff -u -r17 -r97 --- vhLib/Class.inc.rou (.../Class.inc.rou) (revision 17) +++ vhLib/Class.inc.rou (.../Class.inc.rou) (revision 97) @@ -1,3 +1,3 @@ -#define fldClassName 1 -#define fldIsPersistent 2 -#define fldCollection 3 \ No newline at end of file +#define fldClassName 1 +#define fldIsPersistent 2 +#define fldCollection 3 Index: vhLib/Class.mac.rou =================================================================== diff -u -r17 -r97 --- vhLib/Class.mac.rou (.../Class.mac.rou) (revision 17) +++ vhLib/Class.mac.rou (.../Class.mac.rou) (revision 97) @@ -1,235 +1,235 @@ -#Include vhLib.Class -#include vhLib.Macro - - - -ConstructClone(oRef,NewClass,ConstructMethod,lbSkip) - - new arrFrom , arrTo , arrHULP - - set NewClass = $get(NewClass) - set:'$Length(NewClass) NewClass = oRef.%ClassName(1) - - do arrProperties^vhLib.Class(oRef.%ClassName(1),.arrFrom,"A","A","A") - do arrProperties^vhLib.Class(NewClass,.arrTo,"A","A","A") - - new Property set Property = "" - for set Property = $order(arrFrom(Property)) quit:Property="" do - . if arrFrom(Property)'=$get(arrTo(Property)) Kill arrFrom(Property) - for set Property = $order(arrTo(Property)) quit:Property="" do - . if arrTo(Property)'=$get(arrFrom(Property)) Kill arrFrom(Property) - - new i - set lbSkip=$get(lbSkip) - for i = 1 :1 : $listlength(lbSkip) { - set Property = $listget(lbSkip,i) - kill:$length(Property) arrFrom(Property) - } - new oRefClone - set oRefClone = $zobjClassMethod(NewClass,$get(ConstructMethod,"%New")) - Do CopyProperties(oRef,oRefClone,.arrFrom) - quit oRefClone - - ; - ;---------------------------------------------------------------------------------------------------- -arrProperties(ClassName,arrProperties,flagRequired,flagCalculated,flagEmbeddedOnly) - set flagRequired = $get(flagRequired , "A") - set flagCalculated = $get(flagCalculated , "A" ) - set flagEmbeddedOnly = $get(flagEmbeddedOnly, 0 ) - - kill arrHULP($job) - kill arrProperties - - do BuildarrProperties(ClassName,.arrProperties,flagRequired,flagCalculated,flagEmbeddedOnly) - quit - - // returns arr(Property) = $listbuild( items ) .. volgorde van items kan je vinden in vhLib.Class.inc - ; ps : vraag mij niede wat er hier allemaal gebeurd , snap het ondertussen zelf al niet meer maar blijkbaar werkt het toch -BuildarrProperties(ClassName,arrProperties,flagRequired,flagCalculated,flagEmbeddedOnly) - new IdxProperty set IdxProperty = "" - new objCompiledClass , Counter - - new PropertyName , PropertyType , flagCanSave , flagDeeperLevel - - set flagRequired = $get(flagRequired , "A") - set flagCalculated = $get(flagCalculated , "A" ) - //set flagEmbeddedOnly = $get(flagEmbeddedOnly, 0 ) - - set arrHULP($job,"ClassName") = $get(arrHULP($job,"ClassName")) - - set objCompiledClass = ##class(%Library.CompiledClass).%OpenId(ClassName) - if $length(objCompiledClass) - { for Counter = 1 : 1 : objCompiledClass.Properties.Count() - { set flagCanSave = 1 - set PropertyName = objCompiledClass.Properties.GetAt(Counter).Name - set PropertyType = $$Type(ClassName,PropertyName) - if flagRequired '= "A" set flagCanSave = ( flagRequired = $$IsRequired(ClassName,PropertyName)) - if flagCanSave set flagCanSave = $extract(PropertyName)'="%" - if flagCanSave - { if PropertyType [ "Library" - { if flagCalculated '= "A" set flagCanSave = ( flagCalculated = $$IsCalculated(ClassName,PropertyName)) - set PropertyName = $select($length(arrHULP($job,"ClassName")):arrHULP($job,"ClassName")_".",1:"")_PropertyName - if flagCanSave set arrProperties(PropertyName) = $$BuildarrPropertiesListBuild(ClassName,PropertyName) } - else - { set flagDeeperLevel = ( $$IsEmbedded(PropertyType) && '$length($$Collection(ClassName,PropertyName))) - if 'flagDeeperLevel set arrProperties(PropertyName) = $$BuildarrPropertiesListBuild(ClassName,PropertyName) - if flagDeeperLevel,'$$IsSwizzled(ClassName,PropertyName) - { set arrHULP($job,"ClassName") = $select($length(arrHULP($job,"ClassName")):arrHULP($job,"ClassName")_".",1:"") _ PropertyName - do BuildarrProperties(PropertyType,.arrProperties,flagRequired,flagCalculated) } - } - } - } - } - set arrHULP($job,"ClassName") = $piece(arrHULP($job,"ClassName"),".",1,$length(arrHULP($job,"ClassName"),".")-1) - quit - - ;---------------------------------------------------------------------------------------------------- -BuildarrPropertiesListBuild(ClassName,Property) - new result set result = "" - - set:Property["." Property = $piece(Property,".",$length(Property,".")) - new Type set Type = $$Type(ClassName,Property) - - set $list(result,$$$fldClassName) = Type - set $list(result,$$$fldIsPersistent) = $$IsPersistent(Type) - set $list(result,$$$fldCollection) = $$Collection(ClassName,Property) - - quit result - - ;---------------------------------------------------------------------------------------------------- -Type(CacheObject,PropertyName) - new result set result = $$ParameterValue(CacheObject,PropertyName,"Type",1) - quit result - - ;---------------------------------------------------------------------------------------------------- -IsRequired(CacheObject,PropertyName) - quit $$ParameterValue(CacheObject,PropertyName,"Required",1) - - ;---------------------------------------------------------------------------------------------------- -IsCalculated(ClassName,Property) - quit $$ParameterValue(ClassName,Property,"Calculated",0) - - ;---------------------------------------------------------------------------------------------------- -Collection(ClassName,Property) - quit $$ParameterValue(ClassName,Property,"Collection",0) - - ;---------------------------------------------------------------------------------------------------- -IsMultiDimensional(ClassName,Property) - quit $$ParameterValue(ClassName,Property,"MultiDimensional",0) - - ;---------------------------------------------------------------------------------------------------- -IsTransient(ClassName,Property) - quit +$$ParameterValue(ClassName,Property,"Transient",1) - - ;---------------------------------------------------------------------------------------------------- -Collation(CacheObject,PropertyName) - quit $$ParameterValue(CacheObject,PropertyName,"COLLATION",0) - - ;---------------------------------------------------------------------------------------------------- -IsSwizzled(CacheObject,PropertyName) - new result set result = 0 - new PropertyClass set PropertyClass = $$Type(CacheObject,PropertyName) - if PropertyClass '[ "Library" && $length(PropertyClass) && $$IsPersistent(PropertyClass) set result = 1 - quit result - - ;---------------------------------------------------------------------------------------------------- -IsPersistent(ClassName) - quit ##class(%Library.CompiledClass).%OpenId(ClassName).Persistent - - ;---------------------------------------------------------------------------------------------------- -IsEmbedded(ClassName) - quit ##class(%Library.CompiledClass).%OpenId(ClassName).Serial - - ;---------------------------------------------------------------------------------------------------- -MaxLength(CacheObject,PropertyName) - new result - set result = $$ParameterValue(CacheObject,PropertyName,"MAXLEN",1,0) - quit result - - ;---------------------------------------------------------------------------------------------------- -ParameterValue(ClassName,Property,Parameter,flagFirstOccuredPositif) - new arrEmbeddedProperties , oRef, IdxEmbeddedProperty set IdxEmbeddedProperty = "" - new result , QuitFlag set QuitFlag = 0, result = "" - - set flagFirstOccuredPositif = $get(flagFirstOccuredPositif,0) - - do arrEmbeddedProperties(ClassName,Property,.arrEmbeddedProperties) - - for set IdxEmbeddedProperty = $order(arrEmbeddedProperties(IdxEmbeddedProperty)) quit:IdxEmbeddedProperty="" quit:QuitFlag do - . set ClassName = $piece(arrEmbeddedProperties(IdxEmbeddedProperty),"#",1) - . set Property = $piece(arrEmbeddedProperties(IdxEmbeddedProperty),"#",2) - . set oRef = ##class(%Library.CompiledProperty).%OpenId(ClassName_"."_Property) - . set result = $zobjProperty(oRef,Parameter) - . if flagFirstOccuredPositif, result = 1 set QuitFlag = 1 - . set oRef = "" - - quit result - - - ;---------------------------------------------------------------------------------------------------- -arrEmbeddedProperties(ClassName,Property,arrEmbeddedProperties) - do BuildarrEmbeddedProperties(ClassName,Property,.arrEmbeddedProperties) - quit - -BuildarrEmbeddedProperties(ClassName,Property,arrEmbeddedProperties) - new QuitFlag set QuitFlag = 0 - new Counter set Counter = 1 - new objClass - - while 'QuitFlag - { if ##class(%Library.CompiledProperty).%ExistsId(ClassName_"."_$piece(Property,".",Counter)) - { set objClass = ##class(%Library.CompiledProperty).%OpenId(ClassName_"."_$piece(Property,".",Counter)) - do add2arrEmbeddedProperties(ClassName,$piece(Property,".",Counter),.arrEmbeddedProperties) - if objClass.Type [ "Library" - { set QuitFlag = 1 } - else - { set ClassName = objClass.Type - set Counter = Counter + 1 - if $piece(Property,".",Counter)="" set QuitFlag = 1 - if $length(Property,".") = 1 set QuitFlag = 1 - } - } - else { set QuitFlag = 1 } - } - quit - - ;---------------------------------------------------------------------------------------------------- -add2arrEmbeddedProperties(ClassName,Property,arrEmbeddedProperties) - new ItemIndex set ItemIndex = $order(arrEmbeddedProperties(""),-1) + 1 - set arrEmbeddedProperties(ItemIndex) = ClassName _ "#" _ Property - quit - - ;---------------------------------------------------------------------------------------------------- -CopyProperties(oRefFrom,oRefTo,arrProperties) - new IdxProperty set Property = "" - for set Property = $order(arrProperties(Property)) quit:Property="" do - . quit:$length($listget(arrProperties(Property),$$$fldCollection)) // voorlopig stoppen indien het gaat over een list of nen array - . do SetValueInMem(oRefTo,Property,$$ValueInMem(oRefFrom,Property)) - quit - - ;---------------------------------------------------------------------------------------------------- - -SetValueInMem(oRef,Property,Value) - if $length(oRef) - { if $$IsSwizzled(oRef.%ClassName(1),Property) { do $zobjMethod(oRef,Property_"SetObjectId",Value) } - else { xecute "set oRef."_Property_" = Value" } } - quit - - ; ------------------------------------------------------------------------------------------------ -ValueInMem(oRef,Property) - new result set result = "" - - if $$IsSwizzled(oRef.%ClassName(1),Property) { set result = $zobjMethod(oRef,Property_"GetObjectId") } - else { if $length(Property,".") > 0 { xecute "set result = oRef."_Property } - else { set result = $zobjProperty(oRef,Property) } } - - quit result - - -arrDerivedClasses(ClassName,arrClasses) - Kill arrClasses - - set qHandler = ##class(%ResultSet).%New("%Dictionary.ClassDefinitionQuery:SubclassOf") - do qHandler.Execute(ClassName) - while qHandler.Next() { set arrClasses(qHandler.GetData(1))=qHandler.GetData(1) } - quit \ No newline at end of file +#Include vhLib.Class +#include vhLib.Macro + + + +ConstructClone(oRef,NewClass,ConstructMethod,lbSkip) + + new arrFrom , arrTo , arrHULP + + set NewClass = $get(NewClass) + set:'$Length(NewClass) NewClass = oRef.%ClassName(1) + + do arrProperties^vhLib.Class(oRef.%ClassName(1),.arrFrom,"A","A","A") + do arrProperties^vhLib.Class(NewClass,.arrTo,"A","A","A") + + new Property set Property = "" + for set Property = $order(arrFrom(Property)) quit:Property="" do + . if arrFrom(Property)'=$get(arrTo(Property)) Kill arrFrom(Property) + for set Property = $order(arrTo(Property)) quit:Property="" do + . if arrTo(Property)'=$get(arrFrom(Property)) Kill arrFrom(Property) + + new i + set lbSkip=$get(lbSkip) + for i = 1 :1 : $listlength(lbSkip) { + set Property = $listget(lbSkip,i) + kill:$length(Property) arrFrom(Property) + } + new oRefClone + set oRefClone = $zobjClassMethod(NewClass,$get(ConstructMethod,"%New")) + Do CopyProperties(oRef,oRefClone,.arrFrom) + quit oRefClone + + ; + ;---------------------------------------------------------------------------------------------------- +arrProperties(ClassName,arrProperties,flagRequired,flagCalculated,flagEmbeddedOnly) + set flagRequired = $get(flagRequired , "A") + set flagCalculated = $get(flagCalculated , "A" ) + set flagEmbeddedOnly = $get(flagEmbeddedOnly, 0 ) + + kill arrHULP($job) + kill arrProperties + + do BuildarrProperties(ClassName,.arrProperties,flagRequired,flagCalculated,flagEmbeddedOnly) + quit + + // returns arr(Property) = $listbuild( items ) .. volgorde van items kan je vinden in vhLib.Class.inc + ; ps : vraag mij niede wat er hier allemaal gebeurd , snap het ondertussen zelf al niet meer maar blijkbaar werkt het toch +BuildarrProperties(ClassName,arrProperties,flagRequired,flagCalculated,flagEmbeddedOnly) + new IdxProperty set IdxProperty = "" + new objCompiledClass , Counter + + new PropertyName , PropertyType , flagCanSave , flagDeeperLevel + + set flagRequired = $get(flagRequired , "A") + set flagCalculated = $get(flagCalculated , "A" ) + //set flagEmbeddedOnly = $get(flagEmbeddedOnly, 0 ) + + set arrHULP($job,"ClassName") = $get(arrHULP($job,"ClassName")) + + set objCompiledClass = ##class(%Library.CompiledClass).%OpenId(ClassName) + if $length(objCompiledClass) + { for Counter = 1 : 1 : objCompiledClass.Properties.Count() + { set flagCanSave = 1 + set PropertyName = objCompiledClass.Properties.GetAt(Counter).Name + set PropertyType = $$Type(ClassName,PropertyName) + if flagRequired '= "A" set flagCanSave = ( flagRequired = $$IsRequired(ClassName,PropertyName)) + if flagCanSave set flagCanSave = $extract(PropertyName)'="%" + if flagCanSave + { if PropertyType [ "Library" + { if flagCalculated '= "A" set flagCanSave = ( flagCalculated = $$IsCalculated(ClassName,PropertyName)) + set PropertyName = $select($length(arrHULP($job,"ClassName")):arrHULP($job,"ClassName")_".",1:"")_PropertyName + if flagCanSave set arrProperties(PropertyName) = $$BuildarrPropertiesListBuild(ClassName,PropertyName) } + else + { set flagDeeperLevel = ( $$IsEmbedded(PropertyType) && '$length($$Collection(ClassName,PropertyName))) + if 'flagDeeperLevel set arrProperties(PropertyName) = $$BuildarrPropertiesListBuild(ClassName,PropertyName) + if flagDeeperLevel,'$$IsSwizzled(ClassName,PropertyName) + { set arrHULP($job,"ClassName") = $select($length(arrHULP($job,"ClassName")):arrHULP($job,"ClassName")_".",1:"") _ PropertyName + do BuildarrProperties(PropertyType,.arrProperties,flagRequired,flagCalculated) } + } + } + } + } + set arrHULP($job,"ClassName") = $piece(arrHULP($job,"ClassName"),".",1,$length(arrHULP($job,"ClassName"),".")-1) + quit + + ;---------------------------------------------------------------------------------------------------- +BuildarrPropertiesListBuild(ClassName,Property) + new result set result = "" + + set:Property["." Property = $piece(Property,".",$length(Property,".")) + new Type set Type = $$Type(ClassName,Property) + + set $list(result,$$$fldClassName) = Type + set $list(result,$$$fldIsPersistent) = $$IsPersistent(Type) + set $list(result,$$$fldCollection) = $$Collection(ClassName,Property) + + quit result + + ;---------------------------------------------------------------------------------------------------- +Type(CacheObject,PropertyName) + new result set result = $$ParameterValue(CacheObject,PropertyName,"Type",1) + quit result + + ;---------------------------------------------------------------------------------------------------- +IsRequired(CacheObject,PropertyName) + quit $$ParameterValue(CacheObject,PropertyName,"Required",1) + + ;---------------------------------------------------------------------------------------------------- +IsCalculated(ClassName,Property) + quit $$ParameterValue(ClassName,Property,"Calculated",0) + + ;---------------------------------------------------------------------------------------------------- +Collection(ClassName,Property) + quit $$ParameterValue(ClassName,Property,"Collection",0) + + ;---------------------------------------------------------------------------------------------------- +IsMultiDimensional(ClassName,Property) + quit $$ParameterValue(ClassName,Property,"MultiDimensional",0) + + ;---------------------------------------------------------------------------------------------------- +IsTransient(ClassName,Property) + quit +$$ParameterValue(ClassName,Property,"Transient",1) + + ;---------------------------------------------------------------------------------------------------- +Collation(CacheObject,PropertyName) + quit $$ParameterValue(CacheObject,PropertyName,"COLLATION",0) + + ;---------------------------------------------------------------------------------------------------- +IsSwizzled(CacheObject,PropertyName) + new result set result = 0 + new PropertyClass set PropertyClass = $$Type(CacheObject,PropertyName) + if PropertyClass '[ "Library" && $length(PropertyClass) && $$IsPersistent(PropertyClass) set result = 1 + quit result + + ;---------------------------------------------------------------------------------------------------- +IsPersistent(ClassName) + quit ##class(%Library.CompiledClass).%OpenId(ClassName).Persistent + + ;---------------------------------------------------------------------------------------------------- +IsEmbedded(ClassName) + quit ##class(%Library.CompiledClass).%OpenId(ClassName).Serial + + ;---------------------------------------------------------------------------------------------------- +MaxLength(CacheObject,PropertyName) + new result + set result = $$ParameterValue(CacheObject,PropertyName,"MAXLEN",1,0) + quit result + + ;---------------------------------------------------------------------------------------------------- +ParameterValue(ClassName,Property,Parameter,flagFirstOccuredPositif) + new arrEmbeddedProperties , oRef, IdxEmbeddedProperty set IdxEmbeddedProperty = "" + new result , QuitFlag set QuitFlag = 0, result = "" + + set flagFirstOccuredPositif = $get(flagFirstOccuredPositif,0) + + do arrEmbeddedProperties(ClassName,Property,.arrEmbeddedProperties) + + for set IdxEmbeddedProperty = $order(arrEmbeddedProperties(IdxEmbeddedProperty)) quit:IdxEmbeddedProperty="" quit:QuitFlag do + . set ClassName = $piece(arrEmbeddedProperties(IdxEmbeddedProperty),"#",1) + . set Property = $piece(arrEmbeddedProperties(IdxEmbeddedProperty),"#",2) + . set oRef = ##class(%Library.CompiledProperty).%OpenId(ClassName_"."_Property) + . set result = $zobjProperty(oRef,Parameter) + . if flagFirstOccuredPositif, result = 1 set QuitFlag = 1 + . set oRef = "" + + quit result + + + ;---------------------------------------------------------------------------------------------------- +arrEmbeddedProperties(ClassName,Property,arrEmbeddedProperties) + do BuildarrEmbeddedProperties(ClassName,Property,.arrEmbeddedProperties) + quit + +BuildarrEmbeddedProperties(ClassName,Property,arrEmbeddedProperties) + new QuitFlag set QuitFlag = 0 + new Counter set Counter = 1 + new objClass + + while 'QuitFlag + { if ##class(%Library.CompiledProperty).%ExistsId(ClassName_"."_$piece(Property,".",Counter)) + { set objClass = ##class(%Library.CompiledProperty).%OpenId(ClassName_"."_$piece(Property,".",Counter)) + do add2arrEmbeddedProperties(ClassName,$piece(Property,".",Counter),.arrEmbeddedProperties) + if objClass.Type [ "Library" + { set QuitFlag = 1 } + else + { set ClassName = objClass.Type + set Counter = Counter + 1 + if $piece(Property,".",Counter)="" set QuitFlag = 1 + if $length(Property,".") = 1 set QuitFlag = 1 + } + } + else { set QuitFlag = 1 } + } + quit + + ;---------------------------------------------------------------------------------------------------- +add2arrEmbeddedProperties(ClassName,Property,arrEmbeddedProperties) + new ItemIndex set ItemIndex = $order(arrEmbeddedProperties(""),-1) + 1 + set arrEmbeddedProperties(ItemIndex) = ClassName _ "#" _ Property + quit + + ;---------------------------------------------------------------------------------------------------- +CopyProperties(oRefFrom,oRefTo,arrProperties) + new IdxProperty set Property = "" + for set Property = $order(arrProperties(Property)) quit:Property="" do + . quit:$length($listget(arrProperties(Property),$$$fldCollection)) // voorlopig stoppen indien het gaat over een list of nen array + . do SetValueInMem(oRefTo,Property,$$ValueInMem(oRefFrom,Property)) + quit + + ;---------------------------------------------------------------------------------------------------- + +SetValueInMem(oRef,Property,Value) + if $length(oRef) + { if $$IsSwizzled(oRef.%ClassName(1),Property) { do $zobjMethod(oRef,Property_"SetObjectId",Value) } + else { xecute "set oRef."_Property_" = Value" } } + quit + + ; ------------------------------------------------------------------------------------------------ +ValueInMem(oRef,Property) + new result set result = "" + + if $$IsSwizzled(oRef.%ClassName(1),Property) { set result = $zobjMethod(oRef,Property_"GetObjectId") } + else { if $length(Property,".") > 0 { xecute "set result = oRef."_Property } + else { set result = $zobjProperty(oRef,Property) } } + + quit result + + +arrDerivedClasses(ClassName,arrClasses) + Kill arrClasses + + set qHandler = ##class(%ResultSet).%New("%Dictionary.ClassDefinitionQuery:SubclassOf") + do qHandler.Execute(ClassName) + while qHandler.Next() { set arrClasses(qHandler.GetData(1))=qHandler.GetData(1) } + quit Index: vhLib/Listbuild.mac.rou =================================================================== diff -u -r17 -r97 --- vhLib/Listbuild.mac.rou (.../Listbuild.mac.rou) (revision 17) +++ vhLib/Listbuild.mac.rou (.../Listbuild.mac.rou) (revision 97) @@ -1,30 +1,30 @@ -#include vhLib.Macro - - - #define InList(%lb,%li) ($listfind(%lb,%li)>0) - - -RemoveValue(Listbuild, Value) - new Pos - set Pos = $listfind(Listbuild,Value) - if Pos > 0 set $List(Listbuild,Pos,Pos)="" - quit Listbuild - - -RemoveDoubles(Listbuild) - new ctrList - new Result set Result = "" - For ctrList = 1 : 1 : $listlength(Listbuild) Do - . if $$$Not($listfind(Result,$list(Listbuild,ctrList))) set Result = Result _ $listbuild($list(Listbuild,ctrList)) - Quit Result - - -CommonItems(Listbuild1,Listbuild2) - set resListbuild = "" - for ctrListbuild = 1 : 1 : $listlength(Listbuild1) - { set ListItem = $listget(Listbuild1,ctrListbuild) - if $$$InList(Listbuild2,ListItem) set resListbuild = resListbuild _ $listbuild(ListItem) - } - quit resListbuild - - \ No newline at end of file +#include vhLib.Macro + + + #define InList(%lb,%li) ($listfind(%lb,%li)>0) + + +RemoveValue(Listbuild, Value) + new Pos + set Pos = $listfind(Listbuild,Value) + if Pos > 0 set $List(Listbuild,Pos,Pos)="" + quit Listbuild + + +RemoveDoubles(Listbuild) + new ctrList + new Result set Result = "" + For ctrList = 1 : 1 : $listlength(Listbuild) Do + . if $$$Not($listfind(Result,$list(Listbuild,ctrList))) set Result = Result _ $listbuild($list(Listbuild,ctrList)) + Quit Result + + +CommonItems(Listbuild1,Listbuild2) + set resListbuild = "" + for ctrListbuild = 1 : 1 : $listlength(Listbuild1) + { set ListItem = $listget(Listbuild1,ctrListbuild) + if $$$InList(Listbuild2,ListItem) set resListbuild = resListbuild _ $listbuild(ListItem) + } + quit resListbuild + + Index: vhLib/String.mac.rou =================================================================== diff -u -r17 -r97 --- vhLib/String.mac.rou (.../String.mac.rou) (revision 17) +++ vhLib/String.mac.rou (.../String.mac.rou) (revision 97) @@ -1,13 +1,13 @@ - - -Replace(String,F,T,From,Cnt) - New P,I - Set P=1 - For I=1:1:$G(From) Set P=$F(String,F,P) Quit:'P - Quit:'P - Set:'$G(Cnt) Cnt=9999 - For Quit:'Cnt Set P=$F(String,F,P) Quit:'P Do - .Set $E(String,P-$L(F),P-1)=T - .Set P=P-$L(F)+$L(T) - .Set Cnt=Cnt-1 - Quit String \ No newline at end of file + + +Replace(String,F,T,From,Cnt) + New P,I + Set P=1 + For I=1:1:$G(From) Set P=$F(String,F,P) Quit:'P + Quit:'P + Set:'$G(Cnt) Cnt=9999 + For Quit:'Cnt Set P=$F(String,F,P) Quit:'P Do + .Set $E(String,P-$L(F),P-1)=T + .Set P=P-$L(F)+$L(T) + .Set Cnt=Cnt-1 + Quit String