Index: TECH/IO.cls.xml =================================================================== diff -u --- TECH/IO.cls.xml (revision 0) +++ TECH/IO.cls.xml (revision 1552) @@ -0,0 +1,57 @@ + + + + +1 +%RegisteredObject + + +%String +1 + + + + +%String +1 + + + + +%Stream + + + + + + + + +%FileCharacterStream + + + + + + Index: vhLib.mac.rou =================================================================== diff -u --- vhLib.mac.rou (revision 0) +++ vhLib.mac.rou (revision 1552) @@ -0,0 +1,2119 @@ +#include %occInclude +#include vhLib.Macro + +#define MAXLOCALSIZE 32768 + + + // ========================================================================================================================================== + // Name : info - Info - INFO + // Author : WIM VERMEULEN + // Function: schrijft de commentaar die direct onder het label staat, naar current device + // DEPRECATED + // ========================================================================================================================================== +info(Label,RtnName) +Info(Label,RtnName) +INFO(Label,RtnName) + New txt,RtnMask,RtnLine,i + Set RtnMask=Label_"+@L"_$S($L($G(RtnName)):"^"_RtnName, 1:"") + Set i=0 + Set RtnLine=$$REPLACE^vhRtn1(RtnMask,"@L",i) + Write $TEXT(@RtnLine),! + For Do Quit:($E(txt,1,2)'="//")&&($E(txt,1)'=";") Write $E(txt,2,999),! + . Set RtnLine=$$REPLACE^vhRtn1(RtnMask,"@L",$INCREMENT(i)) + . Set txt=$ZSTRIP($TEXT(@RtnLine)," REDIRECTED to vhTools.MAC + // ========================================================================================================================================== +ArrayToText(Ref,RefArray,ProptName) + Quit $$ArrayToText^vhTools(.Ref,.RefArray,.ProptName) + +ArrayToTextW(Ref,DevObj) + Do ArrayToTextW^vhTools(.Ref,.DevObj) + Quit + +ArrayToTextProcBlockW(Ref,RefArray,DevObj) + Do ArrayToTextProcBlockW^vhTools(.Ref,.RefArray,.DevObj) + Quit + +ArrayToTextMultiDimProptW(Ref,obj,ProptName,DevObj) + Do ArrayToTextMultiDimProptW^vhTools(.Ref,.obj,.ProptName,.DevObj) + Quit + +MDToText(obj,ProptName) + Quit $$MDToText^vhTools(.obj,.ProptName) + +ArrayToTextWF(Ref,FilePath,WrAttrib) + Quit $$ArrayToTextWF^vhTools(.Ref,.FilePath,.WrAttrib) + +ArrayToTextEx(Ref,max) + Quit $$ArrayToTextEx^vhTools(.Ref,.max) + +ArrayToTabDelim(arData,FilePath,WrAttrib,arConfig) + Quit $$ArrayToTabDelim^vhTools(.arData,.FilePath,.WrAttrib,.arConfig) + +ArrayToTabDelimW(arData,DevObj,arConfig) + Do ArrayToTabDelimW^vhTools(.arData,.DevObj,.arConfig) + Quit + + // ========================================================================================================================================== + // Name : ArrayToHTMLTable + // Author : JO CLAES + // !!!!! Restored .. WV took my code .... sebiet no bollekes for him !!!!! + // + // HTMLTable ( stream ) maken vanaf een array met tab delimited info + // + // ========================================================================================================================================== +ArrayToHTMLTable(Array) + + Set Stream = ##class(%GlobalCharacterStream).%New() + + New Index + Set Index="" + Do Stream.Write(""_$$$CRLF) + + If $D(Array(0)) Do + . Do Stream.Write("") + . Do Stream.Write("") + . Do Stream.Write(""_$$$CRLF) + + Set Index=0 + For Set Index=$O(Array(Index)) Quit:Index="" Do + . Do Stream.Write( "") + . Do Stream.Write("") + . Do Stream.Write(""_$$$CRLF) + Do Stream.Write("
"_$$$Replace(Array(0),$$$TAB,"")_"
"_$$$Replace(Array(Index),$$$TAB,"")_"
"_$$$CRLF) + Quit Stream + + + // ========================================================================================================================================== + // Name : ProxyToXMLFile + // Author : WIM VERMEULEN + // Function : Zie ObjToXMLFile() --> analoge routine, maar deze gebruikt de XmlWriter en "NoXMLDeclaration" i.p.v. obj.XMLExportToStream() + // ========================================================================================================================================== +ProxyToXMLFile(pxObj,FileName,TopTag,blnIndentTags,FNSuffix,NoXMLDeclaration) ; FileName als .local doorgeven + Quit:('$IsObject($G(pxObj))) $$$ERROR($$$GeneralError,"ObjToXmlFile: NO OBJECT: "_$G(pxObj)) + New stream,sc + Do otxSetFileName + Set stream=##class(%FileCharacterStream).%New() + Set sc=stream.LinkToFile(FileName) + Quit:($$$ISERR(sc)) sc + Set sc=$$ProxyToXMLStream^vhLib(pxObj,.stream,.TopTag,.blnIndentTags,1,.NoXMLDeclaration) + Do:($$$ISERR(sc)) stream.Write("XMLExport mislukt: "_$$ParseStatus^vhLib(sc)) + Set sc=stream.SaveStream() + Set stream="" ; Do BStream.%Close() + Quit sc + + // ========================================================================================================================================== + // Name : ObjToXMLFile (+ObjToXMLFileDBG) + // Author : WIM VERMEULEN + // Function : Schrijft het gegeven object in XML-vorm naar een file. + // Geeft de status van de uitvoer (As %Status) terug. + // OPGELET: overschrijft bestaande files !!! + // Parameters : + // - obj : te converteren naar XML + // - FileName : optioneel; indien "" (leeg), dan automatische naamgeving. + // Ook mogelijkheid om enkel het path op te geven (eindigen met "\") --> naam automatisch. + // Als .local doorgeven om de EXACTE naam(+path) terug te krijgen. + // - TopTag : optioneel; RootElement van de ge-exporteerde XML + // - Format : optioneel; [Default="literal,indent"], leeg is ook toegelaten + // - FNSuffix : optioneel; bij de automatische naangeving kan een achtervoegsel nodig zijn om een unieke FileName te bekomen (bvb: "_001") + // ========================================================================================================================================== +ObjToXMLFile(obj,FileName,TopTag,Format,FNSuffix) ; FileName als .local doorgeven + Quit:('$IsObject($G(obj))) $$$ERROR($$$GeneralError,"ObjToXmlFile: NO OBJECT: "_$G(obj)) + New stream,sc,blnIndentTags + Do otxSetFileName + Set stream=##class(%FileCharacterStream).%New() + Set sc=stream.LinkToFile(FileName) + Quit:($$$ISERR(sc)) sc + Set sc=obj.XMLExportToStream(stream,.TopTag,$G(Format,"literal,indent")) + Do:($$$ISERR(sc)) stream.Write("XMLExport mislukt: "_$$ParseStatus^vhLib(sc)) + Set sc=stream.SaveStream() + Set stream="" ; Do BStream.%Close() + Quit sc +otxSetFileName +#define DefaultFN "ObjectExport_time.xml" +#define CurWorkDir $ZU(168) + New tmpPath,tmpName + Set tmpPath=##class(%File).GetDirectory($G(FileName)) Set:(tmpPath="c:") tmpPath="c:\" ; work around for bug in Cache + Set tmpName=##class(%File).GetFilename($G(FileName)) + Set:(tmpPath="") tmpPath=$$$CurWorkDir + Set:(tmpName="") tmpName=$$$Replace($$$DefaultFN,"_time.xml","_"_$TR($ZT($P($H,",",2),1),":","")_$G(FNSuffix)_".xml") + Set FileName=##class(%File).NormalizeDirectory(tmpPath)_tmpName + Quit +otxWV(FileName) + Do otxSetFileName + Quit + +ObjToXMLFileDBG(obj,FileName,TopTag,Format,FNSuffix) ; FileName als .local doorgeven + New sc + Set sc=$$ObjToXMLFile(.obj,.FileName,.TopTag,.Format,.FNSuffix) + Write "FileName: "_FileName,! + Write "Status: "_$S($$$ISERR(sc):$$ParseStatus^vhLib(sc), 1:sc),! + Quit sc + + // ========================================================================================================================================== + // Name : ObjToXML + // Author : WIM VERMEULEN + // Function: Geeft een XMLExportToStream() terug in een (tekst)variabele. + // Alternatief voor ProxyToXMLStream() + // ========================================================================================================================================== +ObjToXML(obj,TopTag,Format,MsgNoObj,CStream) ; CStream: OPTIONAL parameter (passed by reference) + New txt + Quit:('$IsObject($G(obj))) $S($G(MsgNoObj,"?")="?":"NO OBJECT: "_$G(obj), 1:MsgNoObj) + ;Do IOToStream(.CStream,$LB("OBJXML"),.obj) + Set sc=obj.XMLExportToStream(.CStream,.TopTag,$G(Format,"literal,indent")) + Quit:($$$ISERR(sc)) ""_$$ParseStatus^vhLib(sc)_"" + Set txt=CStream.Read($$$MAXLOCALSIZE) + Quit txt + + // ========================================================================================================================================== + // Name : ObjToText + // Author : WIM VERMEULEN + // Function: Geeft een DumpObject terug in een (tekst)variabele in plaats van naar de Current IO. + // Maakt gebruik van IOToStream + // ========================================================================================================================================== +ObjToText(obj,MsgNoObj,BStream) ; BStream: OPTIONAL parameter (passed by reference) + New txt + Quit:('$IsObject($G(obj))) $S($G(MsgNoObj,"?")="?":"NO OBJECT: "_$G(obj), 1:MsgNoObj) + Do IOToStream(.BStream,$LB("OBJ"),.obj) + Set txt=BStream.Read($$$MAXLOCALSIZE) + Quit txt + + // ========================================================================================================================================== + // Name : ObjListToText + // Author : WIM VERMEULEN + // Function: Geeft een ShowObjects() terug in een (tekst)variabele in plaats van naar de Current IO. + // Maakt gebruik van IOToStream + // ========================================================================================================================================== +ObjListToText(flags,BStream) ; BStream: OPTIONAL parameter passed by reference) + New txt + Do IOToStream(.BStream,$LB("OBJLIST",$G(flags))) + Set txt=BStream.Read($$$MAXLOCALSIZE) + Quit txt + + // ========================================================================================================================================== + // Name : IOToStream + // Author : WIM VERMEULEN + // Function: De output van een routine (bepaald door lbArgs) wordt naar + // een stream weggeschreven in plaats van naar de Current IO. + // De variabele als .local doorgeven. + // lbArgs: $LB("OBJ") + obj / $LB("CLASSM",classname,meth) / $LB("INDIRECT","label^routine(args)") / $LB("EXEC","executestring") / + // $LB("OBJLIST",[flags]) / $LB("OBJXML",[toptag,fmt]) / + // ========================================================================================================================================== +IOToStream(stream,lbArgs,obj) ; stream als .local doorgeven + New io,sc,file,ArgMain + Set io=$io + If ($IsObject($G(stream)))&&(stream.%Extends("%FileStreamAdaptor")) Do + . ;Do:('stream.AtEnd) stream.MoveToEnd() + Else Do + . Set stream=##class(%FileBinaryStream).%New() + Set sc=stream.Write("") ; force stream's file to open + If $$$ISERR(sc) Goto itsIOError + Set file=stream.Filename ; get filename and make current device + Use file + Do itsWriteData + Close file + Use io + If $$$ISERR(sc) Goto itsIOError + Quit +itsIOError + Set %objlasterror=sc + Quit +itsWriteData + Set ArgMain=$LG(lbArgs,1) + If ArgMain="OBJ" Do + . Set sc=$system.OBJ.Dump(obj) + Else If ArgMain="OBJXML" Do + . New toptag,fmt + . Set toptag=$LG(lbArgs,2) + . Set fmt=$LG(lbArgs,3,"literal,indent") + . Set sc=obj.XMLExport(toptag,fmt) + Else If ArgMain="OBJLIST" Do + . New flags + . Set flags=$LG(lbArgs,2) + . Set sc=$system.OBJ.ShowObjects(flags) + Else If ArgMain="XMLSCHEMA" Do + . New cls,toptag,fmt + . Set cls=$LG(lbArgs,2) + . Set toptag=$LG(lbArgs,3) + . Set fmt=$LG(lbArgs,4) + . Do $zobjclassmethod(cls,"XMLSchema",toptag,fmt) + Else If ArgMain="CLASSM" Do + . New cls,mth,ValCM + . Set cls=$LG(lbArgs,2) + . Set mth=$LG(lbArgs,3) + . Set ValCM=$$$METHclassmethod($$$MGINFO,cls,mth) + . Quit:('ValCM) ; cls_"."_mth_"() is not a classmethod + . Do $zobjclassmethod(cls,mth) + Else If ArgMain="INDIRECT" Do + . New Rtn + . Set Rtn=$LG(lbArgs,2) + . Quit:(Rtn="") + . Do @Rtn + Else If ArgMain="EXEC" Do + . New Line + . Set Line=$LG(lbArgs,2) + . Quit:(Line="") + . X Line + Quit + + // ========================================================================================================================================== + // Name : ProxyToXMLStream() + // Author : WIM VERMEULEN + // Function: Build XML-stream, using the %XML.Writer to generate from pxObj and returns %Status + // DataStream contains the resulted XML (%FileBinaryStream) + // TopTag : XML-tag of the root element + // blnIndentTags : pretty-print the output XML + // AllowEmptyProxy : if set to 0 and pxObj is not an object, then an error is returned + // NoXMLDeclaration : if set to 1, then output will not include + // ========================================================================================================================================== +ProxyToXMLStream(pxObj,DataStream,TopTag,blnIndentTags,AllowEmptyProxy,NoXMLDeclaration) ; DataStream als .local + #define ErrorEmptyProxyObject $$$ERROR($$$GeneralError,"No proxy-object supplied") + + Set AllowEmptyProxy=$G(AllowEmptyProxy,0) + + New writer,sc,ClassName + If ('$IsObject(pxObj))&&(pxObj?1"XMLSCHEMA:".E) Set ClassName=$P(pxObj,":",2) + Else Quit:('AllowEmptyProxy)&&('$IsObject(pxObj)) $$$ErrorEmptyProxyObject + + Set:('$IsObject($G(DataStream))) DataStream=##class(%FileBinaryStream).%New() + Set writer=##class(%XML.Writer).%New() + Set writer.Charset="UTF-8" + Set writer.Indent=''$G(blnIndentTags,0) + Set:($D(NoXMLDeclaration)) writer.NoXMLDeclaration=NoXMLDeclaration + Set sc=writer.OutputToStream(DataStream) + If $IsObject(pxObj) Do + . Set sc=writer.RootObject(pxObj, .TopTag) ; $G(TopTag,"DOCS")) + Else If $L(ClassName) Do + . Quit:('##class(%Dictionary.ClassDefinition).%ExistsId(ClassName)) + . Do writer.AddSchemaNamespace("s") + . Set sc=writer.RootElement("schema") + . Set sc=writer.Write($$$CRLF) + . New tmpStream + . Do IOToStream^vhLib(.tmpStream, $LB("XMLSCHEMA",ClassName,$G(TopTag),"")) + . Set sc=writer.Write(tmpStream) + . Set tmpStream="" + . Set sc=writer.EndRootElement() + Else Do + . Set sc=writer.RootElement($G(TopTag,"EMPTY")) + . Set sc=writer.EndRootElement() + Set writer="" + ; Other method: Use XMLExportToStream() , but this does not generate the initiator + ;Set sc=pxObj.XMLExportToStream(.DataStream,"DOCS","literal,indent") + Quit sc + + + // ========================================================================================================================================== + // Name : ObjectListToLB + // Author : WIM VERMEULEN + // Function: ObjectList is van het type %Library.AbstractList (of ervan afgeleid) + // ========================================================================================================================================== +ObjectListToLB(objList) +#define TRIM(%v) $ZSTRIP(%v,"<>W") + New Key,Val,LB + Set (LB,Key)="" + For Set Val=objList.GetNext(.Key) Quit:(Key="") Set LB=LB_$LB($$$TRIM(Val)) + Quit LB + + + // ========================================================================================================================================== + // Name : ObjectArrayToLB + // Author : WIM VERMEULEN + // Function: ObjectArray is van het type %Library.AbstractArray (of ervan afgeleid) + // ========================================================================================================================================== +ObjectArrayToLB(objArray) +#define TRIM(%v) $ZSTRIP(%v,"<>W") + New Key,Val,LB + Set (LB,Key)="" + For Set Val=objArray.GetNext(.Key) Quit:(Key="") Set LB=LB_$LB(Key_":"_$$$TRIM(Val)) + Quit LB + + + // ========================================================================================================================================== + // Name : CountInList + // Author : WIM VERMEULEN + // Function: geeft het aantal maal, dat een item voorkomt in de list LB, terug + // ========================================================================================================================================== +CountInList(LB,find) ; Parameters: LB,find + New cnt,pos + Set (cnt,pos)=0 + For Set pos=$LF(LB,find,pos) Quit:(pos=0) Set cnt=cnt+1 + Quit cnt + + + // ========================================================================================================================================== + // Name : ListToDelimited - ListToCRLF + // Author: WIM VERMEULEN + // ========================================================================================================================================== + + ;ListToDelimited(lbVal,Delimiter) ; Parameters: lbVal (als .local doorgeven voor betere performantie) + ; ZIE LAGER (ListToPieces) + + ;ListToCRLF(lbVal) ; Parameters: lbVal (als .local doorgeven voor betere performantie) + ; ZIE LAGER (ListToPieces) + + + // ========================================================================================================================================== + // Name : MaxVal en MinVal (+ MaxValViaArray en MinValViaArray) + // Author : WIM VERMEULEN + // Function: bepaald het Maximum (resp. Minimum) van de waarden van de array (of van Args...) terug + // arArgs bevat enkel NUMERIEKE waarden op het eerste niveau : arArgs(i) + // Niet-numerieke waarden worden genegeerd! + // ========================================================================================================================================== +MaxVal(Args...) + Quit $$MaxValViaArray(.Args) +MaxValViaArray(arArgs) + Quit:($G(arArgs)<2) +$G(arArgs(1)) ; Nul of ��n element(en) + Quit:(arArgs=2) $$$Max($G(arArgs(1)),$G(arArgs(2))) + New i,MaxVal + Set i=$O(arArgs("")) + Quit:(i="") "" + Set MaxVal=+$G(arArgs(i)) + For Set i=$O(arArgs(i)) Quit:(i="") Do + . Set:($IsValidNum($G(arArgs(i))))&&(arArgs(i)>MaxVal) MaxVal=arArgs(i) + Quit MaxVal + +MinVal(Args...) + Quit $$MinValViaArray(.Args) +MinValViaArray(arArgs) + Quit:($G(arArgs)<2) +$G(arArgs(1)) ; Nul of ��n element(en) + Quit:(arArgs=2) $$$Min($G(arArgs(1)),$G(arArgs(2))) + New i,MinVal + Set i=$O(arArgs("")) + Quit:(i="") "" + Set MinVal=+$G(arArgs(i)) + For Set i=$O(arArgs(i)) Quit:(i="") Do + . Set:($IsValidNum($G(arArgs(i))))&&(arArgs(i) en + // bvb. "test"_$C(15)_$LB("AA","GG") ==> test\015(AA,GG) + // ========================================================================================================================================== +LCVT(LB) +#define LeftPad(%v,%NC) $S($L(%v)>%NC:%v, 1:$E((10**%NC)+%v,2,99999)) + Quit:($D(LB)#10=0) "" + Quit:(LB="") """""" ; ""= empty quotes + ; Samenstelling van LB bepalen + eventueel begin van de List + New NonLB,blnList + Set NonLB="" + Set blnList=0 + For Do Quit:(blnList) Quit:(LB="") + . If $$IsList(LB) Do Quit + .. Set blnList=1 ; Start of a list detected + . ; Else : Analyseren van telkens het eerste character van LB; indien controle-karater, vertalen naar ("\"_ASCII-waarde), anders kopi�ren + . Set NonLB=NonLB_$S($E(LB,1)?1c:"\"_$$$LeftPad($A(LB,1),3), 1:$E(LB,1)) + . Set $E(LB,1)="" ; Remove first character + ; What's left is a list + Quit:(LB="") NonLB + New i,txt + Set txt="(" + For i=1:1:$LL(LB) Set txt=txt_$S(i>1:", ", 1:"")_$$lstFormatItemCHKQuoted(LB,i) + Set txt=txt_")" + Quit NonLB_txt +lstFormatItemCHK(LB,i) + Quit:('$LD(LB,i)) "" + Quit $$LCVTCHK($LI(LB,i)) +lstFormatItemCHKQuoted(LB,i) +#define item $LI(LB,i) + Quit:('$LD(LB,i)) "" + Quit $S($IsValidNum($$$item)||$$IsList($$$item):$$LCVTCHK($$$item), 1:""""_$$LCVTCHK($$$item)_"""") + +LISTCVT(LB) + Quit $$LCVT(LB) +LCVTCHK(LB) + Quit $$LCVT(LB) + + // ========================================================================================================================================== + // Name : LCVT - LCVTCHK - LISTCVT + // Author : WIM VERMEULEN + // Function: List ConVerT Quick-'N-Dirty + // Deze versie van LISTCVT converteert enkel zuivere ListBuilds en zuivere single values (string/numeric): + // bvb. $LB("AA","GG",$LB($LB("TT"),"ABC",-23.6)) ==> (AA,GG,((TT),ABC,-23.6)) + // ========================================================================================================================================== +LCVTQND(LB) + Quit:($G(LB)="") """""" + Quit:('$$IsList(LB)) LB ; LB is een zuivere single value + ; Else + New i,txt + Set txt="(" + For i=1:1:$LL(LB) Set txt=txt_$S(i>1:", ", 1:"")_$$lstFormatItemQND(LB,i) + Set txt=txt_")" + Quit txt +lstFormatItemQND(LB,i) + Quit:('$LD(LB,i)) "" + Quit $$LCVTQND($LI(LB,i)) + + + // ========================================================================================================================================== + // Name : LCVT - LCVTCHK - LISTCVT + // Author : WIM VERMEULEN + // Function: List ConVerT eXTendeD + // Formattering is parametriseerbaar + // Defaults: ChrListDef = "(, )" ; FormatIndex = "" ; UseQuotes = 1 ; ListChecking = 1 ; MaxLevels = -1 + // FormatIndex : gebruik bvb.: "[@I:@V]" als formattering, @I is Index en @V is Value/List + // ========================================================================================================================================== +LCVTXTD(LB,ChrListDef,FormatIndex,UseQuotes,ListChecking,MaxLevels) + Quit:($D(LB)#10=0) "" + ; Set Defaults + Set ChrListDef=$G(ChrListDef, "(, )") + Set FormatIndex=$G(FormatIndex,"") + Set UseQuotes=$G(UseQuotes,1) + Set ListChecking=$G(ListChecking,1) + Set MaxLevels=$G(MaxLevels,-1)\1 + ; Prepare param values + New ChrListStart,ChrListEnd,ChrListSep + Set ChrListStart=$E(ChrListDef,1) ; Eerste karakter + Set ChrListSep=$E(ChrListDef,2,$L(ChrListDef)-1) ; Tweede tot voorlaatste karakter(s) + Set ChrListEnd=$E(ChrListDef,$L(ChrListDef)) ; Laatste karakter + Set:($ZCVT(FormatIndex,"U")="DFL") FormatIndex=" @I: @V" + Set:(FormatIndex="") FormatIndex="@V" + Set:(MaxLevels<-1) MaxLevels=-1 + Quit $$lstLCVTXTD(LB,MaxLevels) +lstLCVTXTD(LB,MaxLevels) +#define LeftPad(%v,%NC) $S($L(%v)>%NC:%v, 1:$E((10**%NC)+%v,2,99999)) + Quit:($D(LB)#10=0) "" + Quit:(LB="") """""" ; ""= empty quotes + + New NonLB + If 'ListChecking Quit:('$$IsList(LB)) LB ; LB is een zuivere single value + Else Do Quit:(LB="") NonLB + . ; Samenstelling van LB bepalen + eventueel begin van de List + . Set NonLB="" + . New blnList + . Set blnList=0 + . For Do Quit:(blnList) Quit:(LB="") + .. If $$IsList(LB) Do Quit + ... Set blnList=1 ; Start of a list detected + .. ; Else : Analyseren van telkens het eerste character van LB; indien controle-karater, vertalen naar ("\"_ASCII-waarde), anders kopi�ren + .. Set NonLB=NonLB_$S($E(LB,1)?1c:"\"_$$$LeftPad($A(LB,1),3), 1:$E(LB,1)) + .. Set $E(LB,1)="" ; Remove first character + . ; What's left is a list + + New MaxLevel + Quit:(MaxLevels=0) $G(NonLB)_"$LB(...)" + Set MaxLevel=$S(MaxLevels=-1:-1, 1:MaxLevels-1) + + New i,txt + Set txt=ChrListStart + If FormatIndex="@V" For i=1:1:$LL(LB) Set txt=txt_$S(i>1:ChrListSep, 1:"")_$$lstFormatItemXTDValueOnly(LB,i) + Else For i=1:1:$LL(LB) Set txt=txt_$S(i>1:ChrListSep, 1:"")_$$lstFormatItemXTD(LB,i) + Set txt=txt_ChrListEnd + Quit $G(NonLB)_txt +lstFormatItemXTD(LB,i) +#define item $LI(LB,i) + Quit:('$LD(LB,i)) "" + New outTxt + Set outTxt=$S(UseQuotes=0 || $IsValidNum($$$item) || $$IsList($$$item) : $$lstLCVTXTD($$$item,MaxLevel), 1:""""_$$lstLCVTXTD($$$item,MaxLevel)_"""") + Quit $$REPLACE^vhRtn1($$REPLACE^vhRtn1(FormatIndex,"@I",i) ,"@V",outTxt) +lstFormatItemXTDValueOnly(LB,i) +#define item $LI(LB,i) + Quit:('$LD(LB,i)) "" + Quit $S(UseQuotes=0 || $IsValidNum($$$item) || $$IsList($$$item) : $$lstLCVTXTD($$$item,MaxLevel), 1:""""_$$lstLCVTXTD($$$item,MaxLevel)_"""") + ;Quit "["_i_":"_$$lstLCVTEXTD($$$item)_"]" + + // ========================================================================================================================================== + // Name : LCVTSimple + // Author : WIM VERMEULEN + // Function: List ConVerT Simple: + // LB is een simpele ListBuild; vb.: $LB("TestA","TestB",1,2, "", , "TestC") + // Defaults: ListSep = ", " ; SkipEmptyLI = 0 ; ListChecking = 0 ; strEmptyList = "" + // ========================================================================================================================================== +LCVTSimple(LB,ListSep,SkipEmptyLI,ListChecking,strEmptyList) + Quit:($G(LB)="") $G(strEmptyList,"") + Quit:($G(ListChecking,0))&&('$$IsList(LB)) $$LCVT(LB) + New i,txt + Set ListSep=$G(ListSep, ", ") + Set txt="" + If $G(SkipEmptyLI, 0) Do + . For i=1:1:$LL(LB) Set:($L($LG(LB,i))) txt=txt_ListSep_$LG(LB,i) + Else Do + . For i=1:1:$LL(LB) Set txt=txt_ListSep_$LG(LB,i) + Set:($P(txt,ListSep,1)="") $E(txt,1,$L(ListSep))="" + Quit txt + + // ========================================================================================================================================== + // Author: WIM VERMEULEN + // ========================================================================================================================================== +LeftPad(Val,NChar) ; Pad number to left with zeros. E.g.: LeftPad(24,5)="00024" + Quit $S($L(Val)>NChar:Val, 1:$E((10**NChar)+Val,2,99999)) + + // ========================================================================================================================================== + // Author: WIM VERMEULEN + // ========================================================================================================================================== +vmlROTATE(X,Y1,Y2) + New Delta + Set Delta=$ZABS(Y2-Y1) + Quit "X1="_(X-(Delta/2))_" X2="_(X+(Delta/2))_" YMid="_((Y1+Y2)/2)_$C(13,10)_ + "" + + + // ========================================================================================================================================== + // Name : GetFileExtension - GetFileNoExt + // Author : WIM VERMEULEN + // Function: Geeft de extensie resp. de naam zonder extensie van de gegeven FileName. + // ========================================================================================================================================== +GetFileExtension(FName) + Quit:(FName'[".") "" + Quit $$$LastPiece(FName,".") + +GetFileNoExt(FName) +#define NoLastPiece(%v,%d) $P(%v, %d, 1, $L(%v,%d)-1) + Quit:(FName'[".") FName + Quit $$$NoLastPiece(FName,".") + + // ========================================================================================================================================== + // 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 $$ParseStatus^vhLib.System(.Status,.IgnoreFirstLine) + + // ================== + // Name : GetStack + // ================== +GetStack(Short,QuitAtSource) + Do GetStack^vhTools(.Short,.QuitAtSource) + + // ========================== + // Name : GetStackToString + // ========================== +GetStackToString(Short,NoLastLevels) + Quit $$GetStackToString^vhTools(.Short,.NoLastLevels) + + // ========================================================================================================================================== + // Name : MailError + // Author : PAUL VERHULST + // Function: Verstuurt een error mail met met de stack informatie + // De To parmeter is een $LB + // De From is optioneel en wordt gedefault naar System@VanHoecke.be + // ========================================================================================================================================== +MailError(To,From) + New Body,Subject + Set Body=$$GetStackToString(,3) ;Levels MailError,GetStackToString en For-lus niet tonen in mail -> dit zijn de laatste 3 + Set From=$G(From,"ErrorTrap@VanHoecke.be") + Set:$G(To)="" To=$LB("PV@VanHoecke.be") + Set Subject="ERROR TRAP "_$ZERROR + Do SendMiniMail^vhLib(From,To,Subject,Body,,,,,) + Quit + + // ========================================================================================================================================== + // Name : ShowLocks + // Author : TOM ROMBAUT + // Function: Geeft de huidige locks weer, samen met nog andere betekenisvolle (pid,...) gegevens + // ========================================================================================================================================== +ShowLocks + N lockline + S lockline="" + FOR S lockline=$ZU(89,0,$P(lockline,"~",1)) Q:lockline="" DO + . W "pid:"_$P(lockline,"~",2)_" locking "_$P(lockline,"~",7),! + QUIT + + // ========================================================================================================================================== + // Name : StartLog & StopLog + // Author : TOM ROMBAUT + // Function: Maakt het mogelijk om via 'write' te schrijven naar bestanden (handig voor bijv. ListAllObjects in een omgegeving waar write + // geen zichtbare output genereert (Bijv. Visual Basic, Makova, ...) + // ========================================================================================================================================== +StartLog(Index) + Set Index=$G(Index," "_$TR($ZDT($H,2,1),":","_")) + Set FileName="C:\VHLogs\Log job " _ $J _ Index _ ".txt" + Open FileName:("NWS") + Use FileName + Quit + +StopLog + Close:($Get(FileName)'="") FileName + Kill FileName + Quit + +GetFileName() + Quit $G(FileName) + + // ========================================================================================================================================== + // Name : StartTimer & StopTimer + // Author : TOM ROMBAUT + // Function: Gebruik beide routines voor het berekenen van tijdsintervallen tussen bijv. 2 routines + // ========================================================================================================================================== +#define TimeNow $PIECE($ZU(188),",",2) +#define TimeDelta(%v2,%v1) $S($G(%v1)>0:%v2-%v1, 1:"") + +StartTimer + Set %StartTime=$$$TimeNow + Quit + +StopTimer + Set %StopTime=$$$TimeNow + Quit + +GetInterval() + New Time + Set Time=(%StopTime-%StartTime) + Quit Time + + // ========================================================================================================================================== + // Name : TimeFromStart & RestartTimer & ChronoStep & ChronoReset + // Author : WIM VERMEULEN + // Function: Gebruik beide routines voor het berekenen van tussentijden + // ========================================================================================================================================== +TimeFromStart() + Quit $$$TimeDelta($$$TimeNow,%StartTime) ; $S($G(%StartTime)>0:$$$TimeNow-%StartTime, 1:"") + +RestartTimer() + New Time + Set Time=$$TimeFromStart + Do StartTimer + Quit $J(Time,0,4) + +ChronoReset() ; Reset the Chrono and returns the new %StartTime + Do StartTimer + Set %LastStepTime=%StartTime + Quit %StartTime + +ChronoStep(blnReset) ; Returns $LB(TimeFromStart,TimeDelta,%LastStepTime). Param blnReset=1 resets the Chrono. + New Time,TimeFromStart,TimeDelta + Set Time=$$$TimeNow + Set TimeFromStart=$$$TimeDelta(Time,%StartTime) + Set TimeDelta=$$$TimeDelta(Time,%LastStepTime) + If $G(blnReset) Do + . Do ChronoReset() + Else Do + . Set %LastStepTime=Time + Set %LastStepTime=$$$TimeNow + Quit $LB(TimeFromStart,TimeDelta,%LastStepTime) + +ChronoStepFMT(blnReset) ; Returns "TimeFromStart (TimeDelta)" . Param blnReset=1 resets the Chrono. + New tmpLB + Set tmpLB=$$ChronoStep(.blnReset) + Quit $J($LG(tmpLB,1),6,3)_$S($L($LG(tmpLB,2)):" (D: "_$J($LI(tmpLB,2),6,3)_")", 1:"") + + + // ========================================================================================================================================== + // Name : iXecute + // Author : TOM ROMBAUT + // Function: 'Intelligente' Xecute versie, met Error Trapping, die de fout weergeeft, als er een fout in het Xecute Statement zit + // ========================================================================================================================================== +iXecute(ExeString) + Quit:(ExeString="") "" + Set Status = "" + Try{ + Xecute ExeString + }Catch(E){ + New ErrStr + Set ErrStr=$P($ZError,">",1)_ "> " _ ExeString _ " ["_$P($ZError,">",2)_"]" + Set Status = ErrStr + } + Quit Status + + // ========================================================================================================================================== + // Name : mXecute + // Author : TOM ROMBAUT + // Function: 'Multi' Xecute versie, voert meerdere lijnen uit (wel volgens de regels van Xecute!) + // ========================================================================================================================================== +mXecute(ExeString) + Quit:(ExeString="") + New mxLoop + For mxLoop=1:1:$L(ExeString,$C(13,10)) Do + . Xecute $P(ExeString,$C(13,10),mxLoop) + Quit + + // ========================================================================================================================================== + // Name : imXecute + // Author : TOM ROMBAUT + // Function: Intelligente 'Multi' Xecute versie, voert meerdere lijnen uit, geeft eventueel fout terug + // ========================================================================================================================================== +imXecute(ExeString) + Quit:($G(ExeString)="") "" + New mxLoop,ErrStr + Set ErrStr="" + For mxLoop=1:1:$L(ExeString,$C(13,10)) Quit:(ErrStr'="") Do + . Set ErrStr=$$iXecute^vhLib($P(ExeString,$C(13,10),mxLoop)) + Quit $S(ErrStr="":"",1:"LINE "_mxLoop_": "_ErrStr) + + // ========================================================================================================================================== + // Name : GetCaller + // Author : TOM ROMBAUT + // Function: Soms kan het gebeuren dat zaken worden uitgevoerd zonder uw medeweten. Denk maar aan het saven van een parent, dit resulteert + // ook in het saven van de children (bij een correcte relatie). Plaats dit op een bepaalde plaats en komt te weten wie de functie + // aanroept. + // ========================================================================================================================================== +GetCaller(Index,QuitAtSource) + Set QuitAtPlace=$G(QuitAtSource,$C(0)) + New FN + Do StartLog^vhLib(Index) + Set FN=$$GetFileName^vhLib() + Do GetStack^vhLib(0,QuitAtSource) + Do StopLog^vhLib + Quit FN + +GetStackToFile(Index) + If $D(MApplication) Do + . Do MApplication.MessageBox("Wijzig GetStackToFile->WriteStackToFile") + Else Do + . Write "Wijzig GetStackToFile->WriteStackToFile",! +WriteStackToFile(Index) + New FN + Do StartLog^vhLib(Index) + Set FN=$$GetFileName^vhLib() + + SET $ECODE="" + FOR loop=1:1:$STACK(-1)-2 DO + . WRITE !,"Context level: ",loop + . WRITE !,?5,"- Context type: ",$STACK(loop) + . WRITE !,?5,"- Current place: ",$STACK(loop,"PLACE") + . WRITE !,?5,"- Current source: ",$STACK(loop,"MCODE") + . WRITE ! + + Do StopLog^vhLib + Quit FN +WriteObjectsToFile(Index) + New FN + Do StartLog^vhLib(Index) + Set FN=$$GetFileName^vhLib() + Do $System.OBJ.ShowObjects("d") + Do StopLog^vhLib + Quit FN +WriteLocalsToFile(Index) + New FN + Do StartLog^vhLib(Index) + Set FN=$$GetFileName^vhLib() + w + Do StopLog^vhLib + Quit FN +WriteXMLDataSetToFile(DS,Index) + New FN + Do StartLog^vhLib(Index) + Set FN=$$GetFileName^vhLib() + Do DS.WriteXML(,,,,,1) + Do StopLog^vhLib + Quit FN + + + // ========================================================================================================================================== + // Name : IsPersistent + // Author : Tom Rombaut + // Function: Test of een bepaalde ORef een persistent is of niet + // ========================================================================================================================================== +IsPersistent(ORef) + Set $ZT="NotPersistent" + If ORef.%Id() //Creates error (unknown property) when non-persistent + Set $ZT="" + Quit 1 + + ; ORef is not persistent +NotPersistent + Set $ZE="" + q 0 + + // ========================================================================================================================================== + // Name : IsValidPattern + // Author : Tom Rombaut + // Function: Test of een bepaald pattern correct is of niet... + // ========================================================================================================================================== +IsValidPattern(Pattern) + Set $ZT="NoValidPattern" + If ""?@Pattern //Creates error + Set $ZT="" + Quit 1 + + ; ORef is not persistent +NoValidPattern + Set $ZE="" + q 0 + + // ========================================================================================================================================== + // Name : Bit + // Author : Tom Rombaut + // Function: Test of een bepaalde bit actief is of niet + // ========================================================================================================================================== +Bit(Number,BitPos) + Quit (Number\($ZPOWER(2,BitPos-1)))#2 + + // ========================================================================================================================================== + // Name : IntToBits + // Author : Tom Rombaut + // Function: Converteer een integer naar een reeks bits, cache stijl (kan dan $bit e.d. gebruiken) + // ========================================================================================================================================== +IntToBits(Number) + New Loop,Bits + Set $BIT(Bits,1)=0 + Set Loop=1 + For Quit:(Number=0) Do + . Set $BIT(Bits,Loop)=(Number#2) + . Set Number=Number\2 + . Set Loop=Loop+1 + Quit Bits + +BitsToInt(Bits) + New Loop,Int + Set Int=0 + For Loop=1:1:$BITCOUNT(Bits) Do + . Set Int=Int+($BIT(Bits,Loop)*(2**(Loop-1))) + Quit Int + +IntToBits2(Number) + New Loop,Bits + Set $BIT(Bits,1)=0 + Set Loop=1 + For Quit:(Number=0) Do + . Set $BIT(Bits,Loop)=(Number#2) + . Set Number=Number\2 + . Set Loop=Loop+1 + Set Number=Bits + Quit + +StrToBits(Str) + New B,i + For i=1:1:$L(Str) Set $Bit(B,i)=$E(Str,i) + Quit B +BitsToStr(B) + New S,i + Set S="" + For i=1:1:$BitCount(B) Set S=S_$Bit(B,i) + Quit S + + // ========================================================================================================================================== + // Name : WildCardToPattern + // Author : Tom Rombaut + // Function: Converteer een wildcard string(met '*' en '?') naar cache pattern style (met .E, 1'J', ...) + // De optionele param StartWith append automatisch een "*" aan de WildCard + // Als de eerste karakter van de wildcard een '�' is dan wordt de rest van de WildCard beschouwt als een PatternMatch, dit om complexe patters mogelijk te maken + // ========================================================================================================================================== +WildCardToPattern(WildCard,StartWith) + New Pattern,Pos,NeedToEnd,CurChar,EscapeChar + Set NeedToEnd=0,Pattern="",EscapeChar=0 + + If $E(WildCard)="�" Quit $E(WildCard,2,999) ; Zelf patternmatch ingegeven ipv van wildcard + + For Pos=1:1:$L(WildCard) Do + . Set CurChar=$E(WildCard,Pos) + . If (CurChar="\") && 'EscapeChar Do Quit + .. Set EscapeChar=1 + . Else If (CurChar="*") && 'EscapeChar Do + .. If NeedToEnd Do + ... Set Pattern=Pattern_"""" + ... Set NeedToEnd=0 + .. Set Pattern=Pattern_".E" + . Else If (CurChar="?") && 'EscapeChar Do + .. If NeedToEnd Do + ... Set Pattern=Pattern_"""" + ... Set NeedToEnd=0 + .. Set Pattern=Pattern_"1E" + . Else Do + .. If 'NeedToEnd Do + ... Set NeedToEnd=1 + ... Set Pattern=Pattern_"1"""_CurChar + .. Else Do + ... Set Pattern=Pattern_CurChar + .. Set EscapeChar=0 + + If NeedToEnd Do + . Set Pattern=Pattern_"""" + + If $G(StartWith) Do + . New PatternLen + . Set PatternLen=$L(Pattern) + . Set:($E(Pattern,PatternLen-1,PatternLen)'=".E") Pattern=Pattern_".E" + + Quit Pattern + + // ==================== + // Name : IsTerminal + // ==================== +IsTerminal(IO) + ;Quit $$IsTerminal^vhTools(.IO) + Set IO=$G(IO,$IO) + Quit IO?1"|TNT|".E1":".N1"|".N + + // ========================= + // Name : GetTerminalList + // ========================= +GetTerminalList(ExcludeSelf) + Quit $$GetTerminalList^vhTools(.ExcludeSelf) + + // ========================================================================================================================================== + // Name : HToNum + // Author : Tom Rombaut + // Function: $H bestaat uit 2 pieces, deze routine maakt er ��n van (handig voor het vergelijken van 2 $h's) + // ========================================================================================================================================== +HToNum(H) + Set H=$G(H,$H) + Quit ($P(H,",",1)*86400)+$P(H,",",2) + // ========================================================================================================================================== + // Name : NumToH + // Author : Tom Rombaut + // Function: + // ========================================================================================================================================== +NumToH(Num) + Quit (Num\86400)_","_(Num#86400) + + // ========================================================================================================================================== + // Name : DottedInt + // Author : Tom Rombaut + // Function: Plaatst dots tussen integers (geen decimale getallen!) + // ========================================================================================================================================== +DottedInt(Integer,Seperator) + Set Integer=+(Integer\1) + Set Seperator=$G(Seperator,".") + Quit $FN(Integer,Seperator) + /*** In commentaar gezet door WimV. op 08/02/2008 *** / + /*** Originele code door TomR. *** / + New DottedInteger,Loop,Len + Set DottedInteger="" + Set Len=$L(Integer) + Set DottedInteger=$E(Integer,Len-2,Len) + For Loop=(Len-3):-3:1 Do + . Set DottedInteger=$E(Integer,Loop-2,Loop)_"."_DottedInteger + Quit DottedInteger + */ + + // ========================================================================================================================================== + // Name : GetEWMSInsertTime + // Author : Tom Rombaut + // Function: Krijg de huidige tijd in een soort van EWMS format: YYYY-MM-DD-HH.MM.SS.000000 + // ========================================================================================================================================== +GetEWMSInsertTime(H) + Set H=$G(H,$H) + Quit $TR($ZDT(H,3)," :","-.")_".000000" + + // ========================================================================================================================================== + // Name : ConvertEWMSInsertTimeToH + // Author : Tom Rombaut + // Function: Vertaal EWMS format (YYYY-MM-DD-HH.MM.SS.000000) naar $H, geeft leeg terug bij foute InsertTime parameter + // ========================================================================================================================================== +ConvertEWMSInsertTimeToH(InsertTime) + New H,tmpVal + ;Vertalen 'YYYY-MM-DD' + Set tmpVal=$ZDH($E(InsertTime,1,10),3,,,,,,,"") + Quit:(tmpVal="") "" + Set $P(H,",",1)=tmpVal + + ;Vertalen 'HH.MM.SS' + Set tmpVal=$ZTH($TR($E(InsertTime,12,19),".",":"),1,"") + Quit:(tmpVal="") "" + Set $P(H,",",2)=tmpVal + + Quit H + + + // ========================================================================================================================================== + // 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) + Quit $$GetJobInfo^vhLib.System(.blnMultiLine,.Indent) + + // ========================================================================================================================================== + // Name : GetMailAddressFromTerminal + // Author : Joren Blancquaert + // Function: Geef mail adres vanuit een ip-adres (enkel binnen ict) + // Device : $I + // ========================================================================================================================================== +GetMailAddressFromTerminal() + Set IP = $$GetClientIP + Set User=$$$IctUserFromIP(IP) + Set:(User="") User=$$$IctUserFromDevice($I) + + Quit:($Length(User)) User_"@vanhoecke.be" + + Quit "" + + // ========================================================================================================================================== + // Name : SendMiniMail + // Author : Tom Rombaut + // Function: Stuurt een minimail + // ========================================================================================================================================== +SendMiniMail(From,To,Subject,Body,BodyIsStream,IsHTML,AuthUser,AuthPwd,lbAttachments,ReplyTo,ccTo,BccTo) + Quit $$SendMiniMail^vhLib.Mail(.From,.To,.Subject,.Body,.BodyIsStream,.IsHTML,.AuthUser,.AuthPwd,.lbAttachments,.ReplyTo,.ccTo,.BccTo) + + // ========================================================================================================================================== + // Name : PiecesToList + // Author : Tom Rombaut + // Function: Bijv. ";A;B;C" -> $LB(A,B,C) of "A;B;C" indien de seperator apart wordt opgegeven + // ========================================================================================================================================== +PiecesToList(Pieces,Sep) + New StartIndex + If $D(Sep) Do + . Set StartIndex=1 + Else Do + . Set StartIndex=2 + . Set Sep=$E(Pieces,1) + New List,Loop + Set List="" + For Loop=StartIndex:1:$L(Pieces,Sep) Do + . Set List=List_$LB($P(Pieces,Sep,Loop)) + Quit List + + // ========================================================================================================================================== + // Name : ListToPieces + // Author : Tom Rombaut + // Function: Bijv. $LB(A,B,C) -> A/B/C met '/' als seperator + // De separator wordt ge-default (',') + // + // Name : ListToDelimited + // Author : Wim Vermeulen + // Function: idem + // De separator wordt NIET ge-default + // ========================================================================================================================================== +ListToPieces(List,Sep) + Quit:(List="") "" + Quit $$ListToDelimited(.List,$G(Sep,",")) +ListToDelimited(List,Sep) ; Parameters: List (List : $LB(), als .local doorgeven voor betere performantie) + New i,Pieces + Set Pieces=$LG(List,1) + For i=2:1:$LL(List) Set Pieces=Pieces_Sep_ $LG(List,i) + Quit Pieces + + // ========================================================================================================================================== + // Name : ListToCRLF + // Author : Wim Vermeulen + // ========================================================================================================================================== +ListToCRLF(lbVal) ; Parameters: lbVal (als .local doorgeven voor betere performantie) + Quit $$ListToDelimited(.lbVal,$$$CRLF) + + + // ========================================================================================================================================== + // Name : AddLeadingChar + // Author : Tom Rombaut + // Function: "er" -> " er" met params " " en 5. "GFT" -> "000GFT" met params "0" en 6. + // ========================================================================================================================================== +AddLeadingChar(Str,Char,ToLen) + New StrLen + Set StrLen=$L(Str) + Quit:(StrLen>ToLen) Str + New ZeroStr + Set $P(ZeroStr,Char,ToLen-StrLen+1)=Str + Quit ZeroStr + + // ========================================================================================================================================== + // Name : AddTrailingChar + // Author : Tom Rombaut + // Function: "er" -> "er " met params " " en 5. "GFT" -> "GFT000" met params "0" en 6. + // ========================================================================================================================================== +AddTrailingChar(Str,Char,ToLen) + New StrLen + Set StrLen=$L(Str) + Quit:(StrLen' volledige datum tonen (d.i. met jaartal) + Quit:(Year'=CurYear) $$$GetTransDate(HDate)_$S(HideTime:"",1:" om "_$ZT(HTime,2)) + + Quit $P($$$GetFullTransDate(HDate)," ",1,2)_$S(HideTime:"",1:" om "_$ZT(HTime,2)) + + // ========================================================================================================================================== + // Name : InDevelop / InWebDevelop + // Author : Tom Rombaut + // Function: Wordt dit programma in development-omgeving uitgevoerd of niet + // ========================================================================================================================================== +InDevelop() + quit ##class(TECH.Config.ConfigMgr).Instance().GetOmgeving()="DEV" + +InWebDevelop() + quit ##class(TECH.Config.ConfigMgr).Instance().GetOmgeving()="DMZ-DEV" + + + // ========================================================================================================================================== + // Name : ClientIsIP / GetClientIP + // Author : WIM VERMEULEN + // Function: ClientIsIP(ip) checkt of het gevraagde ip overeenstemt met het ip-adres van de client/host pc. + // GetClientIP() geeft het IP-adres van de gebruiker (client pc) terug. + // - Werkt voor TELNET / TERMINAL / MAKOVA / VB+VBA (factory alg.) / CSP. + // - Werkt wellicht NIET bij Web Services (SOAP) --> vooraf checken in de SOAP Client kant! + // ========================================================================================================================================== +ClientIsIP(IP) + Set:(IP?1.3N) IP="192.168.1."_IP + Quit ($$GetClientIP()=IP) + +GetClientIP() + new IP + if ($D(MApplication)) { + Set IP = MApplication.GetClientIP() + } + elseif ($IsObject($G(%request)))&&(%request.%IsA("%CSP.Request")) { + Set IP=%request.GetCgiEnv("REMOTE_ADDR") + } + else { + Set IP = $$GetIPFromTerminalSessie + Set:(IP="") IP=##class(TECH.Process).GeefClientIP() ; Added by WimV on 30/08/2011 --> voor factory-connection + } + quit IP + + +GetIPFromTerminalSessie() + New IONaam,CNaam,IP + Set IONaam=$I + Quit:$E(IONaam,1,5)'="|TNT|" "" + Set CNaam=$P($E(IONaam,6,99),":",1) + if $zcvt(CNaam,"l")="localhost" set CNaam=$$$Server + If CNaam?1.3N1"."1.3N1"."1.3N1"."1.3N Do ; eerst kijken of het IPAdres niet vervat zit in de device $I + . Set IP=CNaam + Else Do ; opzoeken van het IPAdress in de cQSYS tabel + . ;Set IP=$P($G(cQSYS(0,"DDB",io)),",",2) + . Set IP="" ; niet opzoeken in cQSYS, altijd via GetIP() + . If IP'?1.3N1"."1.3N1"."1.3N1"."1.3N Set IP=$$GetIP^BLDSYSLOG(CNaam,1) ; vertaling aanvragen van de Computernaam naar IPAdres + Quit IP + +GetICTSysOp() + Set ClientIP = $$GetClientIP() + Set User=$$$IctUserFromIP(ClientIP) + Set:(User="") User=$$$IctUserFromDevice($IO) + + Quit:($Length(User)) User_"@vanhoecke.be" + Quit "ICT_SysOp@vanhoecke.be" + + + // ========================================================================================================================================== + // Name : FirstCase + // Author : Tom Rombaut + // Function: Eerste letter een hoofdletter maken + // ========================================================================================================================================== +FirstCase(String) + Set $E(String)=$ZCVT($E(String),"U") + Quit String + + // ========================================================================================================================================== + // Name : IsLocked + // Author : Tom Rombaut + // Function: Is een bepaalde global gelocked of niet (meegeven als string) + // ========================================================================================================================================== +IsLocked(Global) + Lock +@Global:0 + Else Do Quit 1 + Lock -@Global + Quit 0 + + // ========================================================================================================================================== + // Name : SwapListObjects + // Author : Tom Rombaut + // Function: 2 objects in een ListOfObjects verwisselen van plaats (param LOO=ListOfObjects obj; Obj1 en Obj2: te swappen objs) + // ========================================================================================================================================== +SwapListObjects(LOO,Obj1,Obj2) + New Key,tmpObj,Key1,Key2 + Set (Key,Key1,Key2)="" + For Set tmpObj=LOO.GetNext(.Key) Quit:(Key="") Do + . Set:(tmpObj=Obj1) Key1=Key + . Set:(tmpObj=Obj2) Key2=Key + Quit $$SwapListObjectsViaKey(LOO,Key1,Key2,Obj1,Obj2) + + // ========================================================================================================================================== + // Name : SwapListObjects + // Author : Tom Rombaut + // Function: 2 objects in een ListOfObjects verwisselen van plaats, params: LOO=ListOfObjects obj + // Key1 en Key2: keys van te swappen objs, Obj1 en Obj2 (OPTIONEEL) de overeenkomstige te swappen objs + // ========================================================================================================================================== +SwapListObjectsViaKey(LOO,Key1,Key2,Obj1,Obj2) + Quit:((Key1="") || (Key2="")) 0 + + Set:('$D(Obj1)) Obj1=LOO.GetAt(Key1) + Set:('$D(Obj2)) Obj2=LOO.GetAt(Key2) + + Quit:((Obj1="") || (Obj2="")) 0 + Quit:(Obj1=Obj2) 0 + + If Key1>Key2 Do + . Do LOO.RemoveAt(Key1) + . Do LOO.RemoveAt(Key2) + . Do LOO.InsertAt(Obj1,Key2) + . Do LOO.InsertAt(Obj2,Key1) + Else Do + . Do LOO.RemoveAt(Key2) + . Do LOO.RemoveAt(Key1) + . Do LOO.InsertAt(Obj2,Key1) + . Do LOO.InsertAt(Obj1,Key2) + + Quit 1 + + // ========================================================================================================================================== + // Name : GetClassParamValue + // Author : Tom Rombaut + // Function: Verkrijg de waarde van een parameter gedefinieerd in een class + // ========================================================================================================================================== + #Include %occReference + #Include %occKeyword + #Include %occLocation +GetClassParamValue(ClassName,ParamName) + Quit:('$$$defMemberKeyDefined(ClassName,$$$cCLASSparameter,ParamName,$$$cPARAMdefault)) "" + Quit $$$defMemberKeyGet(ClassName,$$$cCLASSparameter,ParamName,$$$cPARAMdefault) + + // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + // Name : StrToBool + // Author : Manuel Bauwens + // Function: Zet een string om naar een boolean ==> ["0","","false,"False",leeg = 0] [ "true","True", andere tekst = 1] + // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +StrToBool(Str) + q:'$L(Str) 0 + q:Str="" 0 + q:Str="0" 0 + q:Str="False" 0 + q:Str="false" 0 + q:Str="True" 1 + q:Str="true" 1 + Quit 1 + + // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + // Name : BoolToStr + // Author : Manuel Bauwens + // Function: Zet een boolean om naar een string ==> [1 = "True"] [0 = "False"] + // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +BoolToStr(Bool) + q:Bool "True" + Quit "False" + + // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + // Name : InvStrBool + // Author : Manuel Bauwens + // Function: Inverteert een string als boolean + // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +InvStrBool(Str) + Quit $$BoolToStr(Str="False") + + + + + + + + // ========================================================================================================================================== + // Name : IsList + // Author : n/a (George James) + // Function: Test of een bepaalde variabele een $LB is of niet + // ========================================================================================================================================== + ; Is this variable a list + ; If it looks like a list then it is a list + ; $ll and $lf dont always fail even for a valid list so have to try both + ; eg $c(7)_"abc"_$lb(1,2,3) passes the $ll test but fails the $lf test + ; $lb(1,2,3)_"gaga" passes the $lf test but fails the $ll test +IsList(variable) ; + #IF $SYSTEM.Version.GetMajor() < 2000 + Quit $LISTVALID(variable) + #ELSE + New $ETRAP + s $ETRAP="G notList^"_$ZN + i $ll(variable) + i $lf(variable,"anything") + q 1 + ; Variable is not a list +notList + i $ZERROR["" s $ECODE="" q 0 + q 0 + #ENDIF + + // ========================================================================================================================================== + // Name : LocToGlob(Global,Node) + // Author : n/a (Messageboard) + // Function: Plaats alle lokale vars in een global (parameter). Unieke subnode via parameter 'Node', bijv. $J + // ========================================================================================================================================== +LocToGlob(Global,Node) ; save local vars to global + New % + Kill @Global@(Node) + Set %="" + For Set %=$O(@%) Quit:(%="") Do + . Quit:((%="Node") || (%="Global") || (%="%")) //Dit zijn locals eigen aan functie + . m @Global@(Node,%)=@% + Quit + + // ========================================================================================================================================== + // Name : Fill(String,Length,Character) + // Author : n/a (Messageboard) + // Function: Voeg zoveel karakters toe aan 'String' om opgegeven 'Length' te bereiken (indien Length negatief is worden chars achteraan toegevoegd!) + // ========================================================================================================================================== +Fill(Str,Len,Chr) + Set Chr=$G(Chr) + Set:(Chr="") Chr=" " + Quit $$rFill(Str,Len,Chr) +rFill(Str,Len,Chr) + Quit $S($L(Str)'<$ZABS(Len):Str,Len<0:$$rFill(Str_Chr,Len,Chr),1:$$rFill(Chr_Str,Len,Chr)) + + // ========================================================================================================================================== + // Name : Trace(ToJob,Msg) + // Author : n/a (Messageboard) + // Function: Verstuur een bericht(Msg) naar een process(ToJob), dit process kan bijv. een terminal zijn + // ========================================================================================================================================== +Trace(ToJob,Msg) + Set Msg=Msg_$C(13,10) + Quit:($ZU(67,1,ToJob)<2) //Kijken of process waar bericht nr verstuurd wo nog actief is... + If $ZU(94,ToJob,Msg,3) Do + . h .1 + Quit + + // ========================================================================================================================================== + // Name : GetJobList + // Author : n/a (Messageboard) + // Function: Verkrijg een lijst met alle huidige jobs + // ========================================================================================================================================== +GetJobList() //Uitlezen handig via 'Do JobInfo^%SS($J,.Info)' + New Base,Loop,pID,MaxpID,JobList + Set JobList="" + Set Base=$v($zu(40,2,47),-2,"S") + Set MaxpID=$v($zu(40,2,118),-2,4) + For Loop=1:1:MaxpID Do + . Set pID=$v(Loop*4+Base,-3,4) + . Set:pID JobList=JobList_$LB(pID) + Quit JobList + + // ========================================================================================================================================== + // Name : ListEvents + // Author : WIM VERMEULEN + // Function: Geeft een lijst van de Resources gecre�erd in $SYSTEM.Event + // Delim: default=$$$CRLF + // ========================================================================================================================================== +ListEvents(Delim) + Quit $$LCVTSimple^vhLib($SYSTEM.Event.List(),$G(Delim,$$$CRLF)) + + // ========================================================================================================================================== + // Name : Format + // Author : Tom Rombaut + // Function: Format nr (bijv. '#.##0,00#') of datetime (bijv. 'dd/mm/yyyy') + // ========================================================================================================================================== +Format(Fmt,Val,Lang) + If ($G(Val)'="") && $IsValidNum(Val) Quit $$FormatNumber(Fmt,Val) + Else Quit $$FormatDateTime(Fmt,$G(Val),$G(Lang)) + + #Define IsQuote(%v) (%v="'") || (%v="""") + + //------------------------------------------------------------------------------------------------ + // FORMAT DATE/TIME + //------------------------------------------------------------------------------------------------ + #Define fcDateTimeAllowedChars " :/-" + + #Define IsPossibleStartOfToken(%v) "jJyYmMdDwWvVuUhHsSnIi"[%v + + #Define MonthShortN $LB("Jan","Feb","Maa","Apr","Mei","Jun","Jul","Aug","Sep","Okt","Nov","Dec") + #Define MonthShortF $LB("Jan","F�v","Mar","Avr","Mai","Jun","Jul","Ao�","Sep","Oct","Nov","D�c") + #Define MonthShortD $LB("J�n","Feb","M�r","Apr","Mai","Jun","Jul","Aug","Sep","Okt","Nov","Dez") + #Define MonthShortE $LB("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec") + + #Define GetMonthShort(%dn,%l) $CASE(%l,"N":$LI($$$MonthShortN,%dn),"F":$LI($$$MonthShortF,%dn),"D":$LI($$$MonthShortD,%dn),:$LI($$$MonthShortE,%dn)) + + #Define MonthLongN $LB("Januari","Februari","Maart","April","Mei","Juni","Juli","Augustus","September","Oktober","November","December") + #Define MonthLongF $LB("Janvier","F�vrier","Mars","Avril","Mai","Juin","Juillet","Ao�t","Septembre","Octobre","Novembre","D�cembre") + #Define MonthLongD $LB("Januar","Februar","M�rz","April","Mai","Juni","Juli","August","September","Oktober","November","Dezember") + #Define MonthLongE $LB("January","February","March","April","May","June","July","August","September","October","November","December") + + #Define GetMonthLong(%dn,%l) $CASE(%l,"N":$LI($$$MonthLongN,%dn),"F":$LI($$$MonthLongF,%dn),"D":$LI($$$MonthLongD,%dn),:$LI($$$MonthLongE,%dn)) + + #Define DayShortN $LB("Zon","Maa","Din","Woe","Don","Vri","Zat") + #Define DayShortF $LB("Dim","Lun","Mar","Mer","Jeu","Ven","Sam") + #Define DayShortD $LB("Son","Mon","Die","Mit","Don","Fre","Sam") + #Define DayShortE $LB("Sun","Mon","Tue","Wed","Thu","Fri","Sat") + + #Define GetDayShort(%dn,%l) $LI($CASE(%l,"N":$$$DayShortN,"F":$$$DayShortF,"D":$$$DayShortD,:$$$DayShortE),%dn) + + #Define DayLongN $LB("Zondag","Maandag","Dinsdag","Woensdag","Donderdag","Vrijdag","Zaterdag") + #Define DayLongF $LB("Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi") + #Define DayLongD $LB("Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag") + #Define DayLongE $LB("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday") + + #Define GetDayLong(%dn,%l) $CASE(%l,"N":$LI($$$DayLongN,%dn),"F":$LI($$$DayLongF,%dn),"D":$LI($$$DayLongD,%dn),:$LI($$$DayLongE,%dn)) + + //DAY OF MONTH + #Define IsDayOfMonthIn1Or2Digits(%v) (%v="d") || (%v="D") + #Define IsDayOfMonthIn2Digits(%v) $ZCVT(%v,"U")="DD" + #Define IsDayOfWeek3CharsMinuscule(%v) %v="ddd" + #Define IsDayOfWeekFullMinuscule(%v) %v="dddd" + #Define IsDayOfWeek3CharsInitCap(%v) %v="Ddd" + #Define IsDayOfWeekFullInitCap(%v) %v="Dddd" + #Define IsDayOfWeek3CharsA1lCap(%v) %v="DDD" + #Define IsDayOfWeekFullA1lCap(%v) %v="DDDD" + + //MONTH + #Define IsMonthIn1Or2Digits(%v) (%v="m") || (%v="M") + #Define IsMonthIn2Digits(%v) $ZCVT(%v,"U")="MM" + #Define IsMonth3CharsMinuscule(%v) %v="mmm" + #Define IsMonthFullMinuscule(%v) %v="mmmm" + #Define IsMonth3CharsInitCap(%v) %v="Mmm" + #Define IsMonthFullInitCap(%v) %v="Mmmm" + #Define IsMonth3CharsA1lCap(%v) %v="MMM" + #Define IsMonthFullA1lCap(%v) %v="MMMM" + + //YEAR + #Define IsYearIn2Digits(%v) "JJ,YY"[$ZCVT(%v,"U") + #Define IsYearIn4Digits(%v) "JJJJ,YYYY"[$ZCVT(%v,"U") + + //WEEK + #Define IsWeekIn1Or2Digits(%v) (%v="w") || (%v="W") + #Define IsWeekIn2Digits(%v) $ZCVT(%v,"U")="WW" + + //YEAR of WEEK + #Define IsYearOfWeekIn2Digits(%v) $ZCVT(%v,"U")="II" + #Define IsYearOfWeekIn4Digits(%v) $ZCVT(%v,"U")="IIII" + + //DAY (nr) OF WEEK + #Define IsDayNrOfWeek(%v) (%v="v") || (%v="V") + + //HOUR, MINUTE, SECOND + #Define IsHour(%v) (%v="uu") || (%v="hh") + #Define IsMinute(%v) %v="nn" + #Define IsSecond(%v) %v="ss" + + + //$$FormatDateTime^TRTST("") +FormatDateTime(Fmt,Val,Lang) + Set:($G(Val)="") Val=$H + Set:($G(Lang)="") Lang="N" + + New FmtLen, Loop, Output, Char, QuoteChar, StartTokenChar, ExitLoop, tmpToken,TokenLen + New remDateStr,remTimeStr,remDayNr,remMonthNr,remYearNr,remWeekNr,remYearOfWeekNr,remDayNrOfWeek //remDayNr,remMonthNr,remWeekNr met voorloopnul + Set FmtLen=$L(Fmt) + Set Loop=0 + Set Output="" + For Set Loop=Loop+1 Quit:(Loop>FmtLen) Do + . Set Char=$E(Fmt,Loop) + . If $$$IsQuote(Char) Do + .. // *** Textloop + .. Set QuoteChar=Char + .. Set ExitLoop=0 + .. For Quit:(ExitLoop) Set Loop=Loop+1 Quit:(Loop>FmtLen) Do + ... Set Char=$E(Fmt,Loop) + ... If Char=QuoteChar Do + .... Set ExitLoop=1 + ... Else Do + .... Set Output=Output_Char + . Else If $$$IsPossibleStartOfToken(Char) Do + .. // *** Tokenloop (dd,Mm,Yyyy,...) + .. Set tmpToken=Char + .. Set StartTokenChar=$ZCVT(Char,"U") + .. Set ExitLoop=0 + .. For Quit:(ExitLoop) Set Loop=Loop+1 Quit:(Loop>FmtLen) Do + ... Set Char=$E(Fmt,Loop) + ... If $ZCVT(Char,"U")=StartTokenChar Do + .... Set tmpToken=tmpToken_Char + ... Else Do + .... Set ExitLoop=1 + .. // Handle token + .. Set TokenLen=$L(tmpToken) + .. // TOKENLEN = 1 + .. If TokenLen=1 Do + ... If $$$IsDayOfMonthIn1Or2Digits(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remDayNr)) remDayNr=$E(remDateStr,7,8) + .... Set Output=Output_+remDayNr + ... Else If $$$IsMonthIn1Or2Digits(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_+remMonthNr + ... Else If $$$IsWeekIn1Or2Digits(tmpToken) Do + .... Do:('$D(remWeekNr)) GetWeek(Val,.remYearOfWeekNr,.remWeekNr) + .... Set Output=Output_+remWeekNr + ... Else If $$$IsDayNrOfWeek(tmpToken) Do + .... Set:('$D(remDayNrOfWeek)) remDayNrOfWeek=$ZD(Val,10)+1 ;(Zo=1, Ma=2, Di=3,...) + .... Set Output=Output_$S(remDayNrOfWeek=1:7,1:remDayNrOfWeek-1) + .. // TOKENLEN = 2 + .. Else If TokenLen=2 Do + ... If $$$IsDayOfMonthIn2Digits(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remDayNr)) remDayNr=$E(remDateStr,7,8) + .... Set Output=Output_remDayNr + ... Else If $$$IsMonthIn2Digits(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_remMonthNr + ... Else If $$$IsYearIn2Digits(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remYearNr)) remYearNr=$E(remDateStr,1,4) + .... Set Output=Output_$E(remYearNr,3,4) + ... Else If $$$IsWeekIn2Digits(tmpToken) Do + .... Do:('$D(remWeekNr)) GetWeek(Val,.remYearOfWeekNr,.remWeekNr) + .... Set Output=Output_remWeekNr + ... Else If $$$IsYearOfWeekIn2Digits(tmpToken) Do + .... Do:('$D(remYearOfWeekNr)) GetWeek(Val,.remYearOfWeekNr,.remWeekNr) + .... Set Output=Output_$E(remYearOfWeekNr,3,4) + ... Else If $$$IsHour(tmpToken) Do + .... Set:('$D(remTimeStr)) remTimeStr=$ZT($P(Val,",",2)) + .... Set Output=Output_$E(remTimeStr,1,2) + ... Else If $$$IsMinute(tmpToken) Do + .... Set:('$D(remTimeStr)) remTimeStr=$ZT($P(Val,",",2)) + .... Set Output=Output_$E(remTimeStr,4,5) + ... Else If $$$IsSecond(tmpToken) Do + .... Set:('$D(remTimeStr)) remTimeStr=$ZT($P(Val,",",2)) + .... Set Output=Output_$E(remTimeStr,7,8) + .. // TOKENLEN = 3 + .. Else If TokenLen=3 Do + ... If $$$IsDayOfWeek3CharsMinuscule(tmpToken) Do + .... Set:('$D(remDayNrOfWeek)) remDayNrOfWeek=$ZD(Val,10)+1 + .... Set Output=Output_$ZCVT($$$GetDayShort(remDayNrOfWeek,Lang),"L") + ... Else If $$$IsDayOfWeek3CharsInitCap(tmpToken) Do + .... Set:('$D(remDayNrOfWeek)) remDayNrOfWeek=$ZD(Val,10)+1 + .... Set Output=Output_$$$GetDayShort(remDayNrOfWeek,Lang) + ... Else If $$$IsDayOfWeek3CharsA1lCap(tmpToken) Do + .... Set:('$D(remDayNrOfWeek)) remDayNrOfWeek=$ZD(Val,10)+1 + .... Set Output=Output_$ZCVT($$$GetDayShort(remDayNrOfWeek,Lang),"U") + ... Else If $$$IsMonth3CharsMinuscule(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_$ZCVT($$$GetMonthShort(+remMonthNr,Lang),"L") + ... Else If $$$IsMonth3CharsInitCap(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_$$$GetMonthShort(+remMonthNr,Lang) + ... Else If $$$IsMonth3CharsA1lCap(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_$ZCVT($$$GetMonthShort(+remMonthNr,Lang),"U") + .. // TOKENLEN = 4 + .. Else If TokenLen=4 Do + ... If $$$IsDayOfWeekFullMinuscule(tmpToken) Do + .... Set:('$D(remDayNrOfWeek)) remDayNrOfWeek=$ZD(Val,10)+1 + .... Set Output=Output_$ZCVT($$$GetDayLong(remDayNrOfWeek,Lang),"L") + ... Else If $$$IsDayOfWeekFullInitCap(tmpToken) Do + .... Set:('$D(remDayNrOfWeek)) remDayNrOfWeek=$ZD(Val,10)+1 + .... Set Output=Output_$$$GetDayLong(remDayNrOfWeek,Lang) + ... Else If $$$IsDayOfWeekFullA1lCap(tmpToken) Do + .... Set:('$D(remDayNrOfWeek)) remDayNrOfWeek=$ZD(Val,10)+1 + .... Set Output=Output_$ZCVT($$$GetDayLong(remDayNrOfWeek,Lang),"U") + ... Else If $$$IsMonthFullMinuscule(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_$ZCVT($$$GetMonthLong(+remMonthNr,Lang),"L") + ... Else If $$$IsMonthFullInitCap(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_$$$GetMonthLong(+remMonthNr,Lang) + ... Else If $$$IsMonthFullA1lCap(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remMonthNr)) remMonthNr=$E(remDateStr,5,6) + .... Set Output=Output_$ZCVT($$$GetMonthLong(+remMonthNr,Lang),"U") + ... Else If $$$IsYearIn4Digits(tmpToken) Do + .... Set:('$D(remDateStr)) remDateStr=$ZD(Val,8) //20040528 + .... Set:('$D(remYearNr)) remYearNr=$E(remDateStr,1,4) + .... Set Output=Output_$E(remYearNr,1,4) + ... Else If $$$IsYearOfWeekIn4Digits(tmpToken) Do + .... Do:('$D(remYearOfWeekNr)) GetWeek(Val,.remYearOfWeekNr,.remWeekNr) + .... Set Output=Output_remYearOfWeekNr + .. Set Loop=Loop-1 + . Else If $$$fcDateTimeAllowedChars[Char Do + .. // *** Allowed chars + .. Set Output=Output_Char + + Quit Output + + //----------------------------------------------------------------- +GetWeek(HDate,YearNr,WeekNr) + Set HDate=+HDate + + New DateAsStr + Set DateAsStr=$ZD(HDate,8) + + Set YearNr=$E(DateAsStr,1,4) + + New HStartOfYear + Set HStartOfYear=$ZDH(YearNr_"0101",8) + + New StartDay + Set StartDay=$ZD(HStartOfYear,10) + + New FirstDay + Set FirstDay=$S(StartDay<5:StartDay+6,1:StartDay-1) + + New NumberOfDays + Set NumberOfDays=(HDate-HStartOfYear)+FirstDay + + Set WeekNr=NumberOfDays\7 + + If WeekNr=0 Do + . Do GetWeek($ZDH((YearNr-1)_"1231",8),.YearNr,.WeekNr) + Else If WeekNr=53 Do + . New HEndOfYear + . Set HEndOfYear=$ZDH(YearNr_"1231",8) + . If $ZD(HEndOfYear,10)<4 Do //<4: ma, di of woe + .. Set WeekNr=1 + .. Set YearNr=YearNr+1 + + Set:(WeekNr<10) WeekNr="0"_WeekNr + + Quit + + //------------------------------------------------------------------------------------------------ + // FORMAT NUMBER + //------------------------------------------------------------------------------------------------ + + #Define fcThousandSep "." + #Define fcDecimalSep "," + #Define fcDigitPlaceholder "#" + #Define fcDigitPlaceholderZero "0" + #Define fcSectionSeperator ";" + #Define fcPercentage "%" + #Define fcStartCodeSet $$$fcDigitPlaceholder_$$$fcDigitPlaceholderZero_$$$fcThousandSep_$$$fcDecimalSep_$$$fcPercentage + #Define fcNrAllowedChars "$-+:/()!^&~{}=<> " + +FormatNumber(Fmt,Val) + Quit:(Fmt="") Val + + ;Indien Val="", text item teruggeven + Quit:(Val="") $P(Fmt,$$$fcSectionSeperator,4) + + ;Fmt mogelijk opgedeeld in sections (pos, neg & 0), afhankelijk van de waarde van Val reageren + New UseFmt,NegativeNr + If Val=0 Do + . Set UseFmt=$P(Fmt,$$$fcSectionSeperator,3) + . Set:(UseFmt="") UseFmt=$P(Fmt,$$$fcSectionSeperator,1) + . Set NegativeNr=0 + Else If Val<0 Do + . Set UseFmt=$P(Fmt,$$$fcSectionSeperator,2) + . If UseFmt="" Do + .. Set UseFmt=$P(Fmt,$$$fcSectionSeperator,1) + .. Set NegativeNr=1 + . Else Do + .. Set NegativeNr=0 //Zelf verantwoordelijk voor minteken + . Set Val=$ZABS(Val) + Else Do + . Set UseFmt=$P(Fmt,$$$fcSectionSeperator,1) + . Set NegativeNr=0 + + ;Format string parsen en variabel gewijs opbouwen hoe deze eruit ziet + New FmtLen, Loop, Char, QuoteChar, ExitLoop, Output, tmpVal + New ThousandSep,Decimal,ZeroBefore,ZeroAfter,SignificantAfter,ValDecimalCnt + Set Loop=0 + Set FmtLen=$L(UseFmt) + Set Output="" + Set ValDecimalCnt=$L($P(Val,".",2)) + For Set Loop=Loop+1 Quit:(Loop>FmtLen) Do + . Set Char=$E(UseFmt,Loop) + . If $$$IsQuote(Char) Do + .. // *** Textloop + .. Set QuoteChar=Char + .. Set ExitLoop=0 + .. For Quit:(ExitLoop) Set Loop=Loop+1 Quit:(Loop>FmtLen) Do + ... Set Char=$E(UseFmt,Loop) + ... If Char=QuoteChar Do + .... Set ExitLoop=1 + ... Else Do + .... Set Output=Output_Char + . Else If $$$fcStartCodeSet[Char Do + .. // *** FormatCodeLoop (reeds uitgelezen char ook verwerken) + .. Set ThousandSep=0, Decimal=0, ZeroBefore=0, ZeroAfter=0, SignificantAfter=0 + .. Set ExitLoop=0 + .. For Quit:(ExitLoop) Do Set Loop=Loop+1 Set Char=$E(UseFmt,Loop) + ... If Char=$$$fcThousandSep Do + .... Set ThousandSep=1 + ... Else If Char=$$$fcDecimalSep Do + .... Set Decimal=1 + ... Else If Char=$$$fcDigitPlaceholderZero Do + .... If Decimal Do + ..... Set ZeroAfter=ZeroAfter+1 + .... Else Do + ..... Set ZeroBefore=ZeroBefore+1 + ... Else If Char=$$$fcDigitPlaceholder Do + .... Set:(Decimal) SignificantAfter=SignificantAfter+1 + ... Else If Char=$$$fcPercentage Do + .... Set Val=Val*100 + ... Else Do + .... ;Interne loop heeft character niet verwerkt, terug aanbieden aan hoofdloop (deze doet ook nog eens +1, dus loop-2) + .... Set Loop=Loop-2 + .... ;Indien format bijv='0,' dan is ZeroAfter=0 EN SignificantAfter=0 -> Zet Decimal=0 + .... Set:(Decimal && (ZeroAfter=0) && (SignificantAfter=0)) Decimal=0 + .... ;Decimal rounding, decimal zeros + .... ; FORMAT: ... , | 0's | #'s | | + .... ; I II III + .... ; E.g. format='0,00###' dan zit 5,7 in I (ZeroAfter) / 5,754 in II (SignificantAfter) / 5,754487 in III (buiten format) + .... If ValDecimalCnt(ZeroAfter+SignificantAfter) Do ; III: afronden + ..... Set tmpVal=$FN(Val,$S(ThousandSep:".",1:""),ZeroAfter+SignificantAfter) + .... Else Do ; II: enkel thousand seperator verwerken + ..... Set tmpVal=$FN(Val,$S(ThousandSep:".",1:"")) + .... ;Voorloopnullen (ZeroBefore=1 niet 'opvangen', dit is de gewone notatie) + .... If ZeroBefore=0 Do + ..... Set:((tmpVal<1) && ($E(tmpVal)=0)) tmpVal=$E(tmpVal,2,9999) + .... Else If ZeroBefore>1 Do + ..... If tmpVal<(10**(ZeroBefore-1)) Do + ...... Set tmpVal=$J(tmpVal,(ZeroBefore+ZeroAfter+Decimal+SignificantAfter)) + ...... Set tmpVal=$TR(tmpVal," ",$$$fcDigitPlaceholderZero) + .... Set:('ThousandSep) tmpVal=$TR(tmpVal,".",",") + .... Set:(NegativeNr) tmpVal="-"_tmpVal + .... Set Output=Output_tmpVal + .... Set ExitLoop=1 + . Else If $$$fcNrAllowedChars[Char Do + .. // *** Allowed chars + .. Set Output=Output_Char + + Quit Output + + // Name: ValidatePassword, Author : Tom Rombaut, Function: Check of een opgegeven password 'veilig' genoeg is... +ValidatePassword(Password,MinLen,MaxLen,SpaceAllowed,NrRequired,SpecialCharRequired,SpecialCharSet,UserName,AllowThreeEqualConsChars) + Set MinLen=$G(MinLen,6) + Set MaxLen=$G(MaxLen,16) + Set SpaceAllowed=$G(SpaceAllowed,0) + Set SpecialCharRequired=$G(SpecialCharRequired,1) + Set SpecialCharSet=$G(SpecialCharSet,"!*+,-/:'?&;_()`#$%") + Set UserName=$G(UserName) + Set NrRequired=$G(NrRequired,1) + Set AllowThreeEqualConsChars=$G(AllowThreeEqualConsChars,0) ;Mogen is een pwd 3 opeenvolgende gelijke chars voorkomen? + + Quit:($L(Password)MaxLen) "Maximum aantal karakters is "_MaxLen_"." + Quit:('SpaceAllowed && (Password[" ")) "Een spatie is niet toegelaten." + + New SpecialCharFound + Set SpecialCharFound=0 + If SpecialCharRequired Do Quit:('SpecialCharFound) "Minstens ��n speciaal karakter ("_SpecialCharSet_") is vereist." + . New Loop,SpecialChar + . For Loop=1:1:$L(SpecialCharSet) Do Quit:(SpecialCharFound) + .. Set SpecialChar=$E(SpecialCharSet,Loop) + .. Set:(Password[SpecialChar) SpecialCharFound=1 + + Quit:(NrRequired && ($ZSTRIP(Password,"*E'N")="")) "Er dient minstens ��n cijfer voor te komen." + + New EqualConsChar + Set EqualConsChar="" + If 'AllowThreeEqualConsChars Do Quit:(EqualConsChar'="") "Het karakter '"_EqualConsChar_"' komt driemaal achter elkaar voor." + . New Loop,PwdChar + . For Loop=1:1:$L(Password) Do Quit:(EqualConsChar'="") + .. Set PwdChar=$E(Password,Loop) + .. Set:($E(Password,Loop+1,Loop+2)=(PwdChar_PwdChar)) EqualConsChar=PwdChar + + Quit "" + + // Name: ListOfDataTypesToLB, Author : Tom Rombaut, Function: Conversie list of datatypes naar listbuild +ListOfDataTypesToLB(LODT) + New lbResult,Loop + Set lbResult="" + For Loop=1:1:LODT.Count() Do + . Set lbResult=lbResult_$LB(LODT.GetAt(Loop)) + Quit lbResult + + // Name: LBToListOfDataTypes, Author : Tom Rombaut, Function: Conversie list of datatypes naar listbuild +LBToListOfDataTypes(lbList,LODT) + New Loop + Do LODT.Clear() + For Loop=1:1:$LL(lbList) Do + . Do LODT.Insert($LI(lbList,Loop)) + Quit + +ExecuteSQL(SQL,RS) + If $IsObject(RS) Do + . Do RS.Close() ;eventueel vorige cursor sluiten + Else Do + . Set RS=##class(%ResultSet).%New("%DynamicQuery:SQL") + + New tmpStatus + Set tmpStatus=RS.Prepare(SQL) + + Quit:($$$ISERR(tmpStatus)) $$ParseStatus^vhLib(tmpStatus) + + Set tmpStatus=RS.Execute() + + Quit $S(($$$ISERR(tmpStatus)):$$ParseStatus^vhLib(tmpStatus),1:"") + + // Name: TestURL (http of ftp scheme vereist), Author: Tom Rombaut, Function: Euh, test een url +TestURL(URL,ErrStr) + Set ErrStr="" + + New Components + Do ##class(%Net.URLParser).Parse(URL,.Components) + If $G(Components("scheme"))="" Do Quit 0 + . Set ErrStr="Scheme 'http' or 'ftp' not defined." + If $G(Components("host")) Do Quit 0 + . Set ErrStr="Server not defined." + + New HR + Set HR=##class(%Net.HttpRequest).%New() + Set HR.Server=$G(Components("host")) + Do HR.Get($G(Components("path"))) + Quit ($E(HR.HttpResponse.StatusCode)=2) + + // Name: TrimEndOfText, Author: Tom Rombaut, Function: Verwijderen zinloze enters/spaties & andere ctrl-chars op het einde van een text +TrimEndOfText(Text) + New CharLoop + Set CharLoop=$L(Text) + For Quit:((CharLoop=0) || ($ASCII($E(Text,CharLoop))>32)) Do + . Set CharLoop=CharLoop-1 + + Quit $E(Text,1,CharLoop) + +TrimBeginOfText(Text) + New CharLoop,Len + Set CharLoop=0 + Set Len=$L(Text) + For Quit:$I(CharLoop)>Len Quit:($ASCII($E(Text,CharLoop))>32) + Quit $E(Text,CharLoop,Len) + + // Name: EncryptHTTPParamStr, Author : Tom Rombaut, Function: een html parameterstring naar AES, BASE64 encrypteren +EncryptHTTPParamStr(ParamStr,AESKey) + Quit $TR($system.Encryption.Base64Encode($system.Encryption.AESEncode(ParamStr,AESKey)),"+="_$C(10,13),"_-") + + // Name: DecryptHTTPParamStr, Author: Tom Rombaut, Function: een html parameterstring, ge�crypteerd in AES, BASE64, decrypteren +DecryptHTTPParamStr(ParamStr,AESKey) + Quit $TR($system.Encryption.AESDecode($system.Encryption.Base64Decode($TR(ParamStr,"_-","+=")),AESKey),$C(0),"") + + // Name: GetStrAsBytes, Author: Tom Rombaut, Function: geef een string op en krijg het resultaat terug in bytes (gescheiden door spatie) +GetStrAsBytes(Str,BracketCtrlChars) + Set BracketCtrlChars=$G(BracketCtrlChars,1) + + New AsBytes,AsByte,Loop + Set AsBytes="" + For Loop=1:1:$L(Str) Do + . Set AsByte=$ASCII($E(Str,Loop)) + . Set:(BracketCtrlChars && (AsByte<32)) AsByte="("_AsByte_")" + . Set AsBytes=AsBytes_" "_AsByte + + Quit AsBytes + + // Name: AddToText, Author: Tom Rombaut, Function: +ConcatStringWithEmptyCheck(StrToAdd,varText,PrefixStrToAdd,SEP) + Set SEP=$G(SEP,"
") + Set:(StrToAdd'="") varText=$S($G(varText)="":"",1:varText_SEP)_$G(PrefixStrToAdd)_StrToAdd + Quit + + // Name: GetHumanFileSize, Author: Tom Rombaut, Function: vertaalt filesizes uitgedrukt in bytes naar B, KB en MB varianten +GetHumanFileSize(FileSize,Decimal) + Set FileSize=+FileSize + Quit:((FileSize=0) || (FileSize<1024)) FileSize_" bytes" + + Set Decimal=$G(Decimal,1) + Quit:(FileSize<1048576) $FNUMBER(FileSize/1024,".",Decimal)_" kB" + Quit:(FileSize<1073741824) $FNUMBER(FileSize/1048576,".",Decimal)_" MB" + Quit $FNUMBER(FileSize/1073741824,".",Decimal)_" GB" + + // Name: Pluralize, Author: Tom Rombaut +Pluralize(Str,Cnt,DefTags,CntStr) + Set DefTags=$G(DefTags,"[]") + New DefStart,DefStop,DefSep + Set DefStart=$E(DefTags) + Set DefStop=$E(DefTags,2) + Set DefSep="/" + + Set CntStr=$G(CntStr,"%v") + Set Cnt=+Cnt + + New Loop,StrLen,NewStr,InDef,InPlural,Char + Set Loop=1 + Set StrLen=$L(Str) + Set NewStr="" + Set InDef=0 + For Quit:(Loop>StrLen) Do + . Set Char=$E(Str,Loop) + . If 'InDef && (Char=DefStart) Set InDef=1, InPlural=0 + . Else If InDef && (Char=DefSep) Set InPlural=1 + . Else If InDef && (Char=DefStop) Set InDef=0, InPlural=0 + . Else If InDef Set:((Cnt'=1)=InPlural) NewStr=NewStr_Char + . Else Set NewStr=NewStr_Char + . Set Loop=Loop+1 + + Set NewStr=$$REPLACE^vhRtn1(NewStr,CntStr,Cnt) + + Quit NewStr + + // Name: IPIsVanHoecke, Author: Tom Rombaut +IPIsVanHoecke(IP) + Quit (IP="195.130.157.2") + // Name: IPIsIntern, Author: Tom Rombaut +IPIsIntern(IP) + Quit (IP?1"192.168.1."1.3N) + + // Name: GetStrCrossSection, Author: Tom Rombaut +GetStrCrossSection(Str1,Str2,Sep) + New StrR,Loop,Found,MaxPieces + Set MaxPieces=$L(Str2,Sep) + Set Found=0 + For Loop=1:1:MaxPieces Do Quit:(Found'=0) + . If $P(Str1,Sep,Loop)'=$P(Str2,Sep,Loop) Do + .. Set Found=Loop + + Set:('Found) Found=MaxPieces+1 + + Set StrR=$J($P(Str2,Sep,Found,MaxPieces),$L(Str2)) + + Quit StrR + + // Name: VersionIsNewer +VersionIsNewer(VersionToCheck,CurrentVersion) + New MaxLen,Loop,tmpNr,IsNewer,tmpVTC,tmpV + Set MaxLen=$L(VersionToCheck,".") + Set tmpNr=$L(CurrentVersion,".") + Set:(tmpNr>MaxLen) MaxLen=tmpNr + For Loop=1:1:MaxLen Do Quit:(tmpVTC'=tmpCV) + . Set tmpVTC=+$P(VersionToCheck,".",Loop) + . Set tmpCV=+$P(CurrentVersion,".",Loop) + Quit (tmpVTC>tmpCV) + + // Name: SendFileViaFTP +SendFileViaFTP(SourceFile, ServerName, DestDir, DestFileName, UserName, Password, Port, IsBinary) + Quit:('##class(%File).Exists(SourceFile)) $$$ERROR($$$FileDoesNotExist,SourceFile) + + ;Verzenden van bestand via FTP gebeurt adhv stream + New SourceStream,Status + Set SourceStream=##class(%FileBinaryStream).%New() + Set Status=SourceStream.LinkToFile(SourceFile) + Quit:($$$ISERR(Status)) Status + + ;verzenden! + Quit $$SendStreamViaFTP(.SourceStream, .ServerName, .DestDir, .DestFileName, .UserName, .Password, .Port, .IsBinary) + + // Name: SendStreamViaFTP +SendStreamViaFTP(SourceStream, ServerName, DestDir, DestFileName, UserName, Password, Port, IsBinary) + #Define FTPError $$$ERROR($$$GeneralError,FTPSession.ReturnMessage) + + ;Connect FTP + Set UserName=$G(UserName,"anonymous") + + New FTPSession + Set FTPSession=##class(%Net.FtpSession).%New() + Quit:('FTPSession.Connect(ServerName,UserName,$G(Password),.Port)) $$$FTPError + + ;Switch binary/ascii + Set IsBinary=$G(IsBinary,0) + + Set Status=$$$OK + If IsBinary Do + . Set:('FTPSession.Binary()) Status=$$$FTPError + Else Do + . Set:('FTPSession.Ascii()) Status=$$$FTPError + Quit:($$$ISERR(Status)) $$svfLogoutAndQuit(Status) + + ;FTP dir selecteren + Quit:('FTPSession.SetDirectory(DestDir)) $$svfLogoutAndQuit($$$FTPError) + + ;FTP send! + Quit:('FTPSession.Store(DestFileName,SourceStream)) $$svfLogoutAndQuit($$$FTPError) + + ;Logout + Quit:('FTPSession.Logout()) $$$FTPError + + Quit $$$OK + + ;----------------- +svfLogoutAndQuit(Status) + Do FTPSession.Logout() + Quit Status + + // Name: ClassMethod uitvoeren van een classmethod, Author: Paul Verhulst, Function: $zobjclassmethod kan niet geJOBbed worden maar via deze routine kan het wel +ClassMethod(ClassName,Method,NrOfParam,P1,P2,P3,P4,P5,P6,P7,P8) + Try{ + Set NrOfParam=$G(NrOfParam) + If 'NrOfParam Do $zobjclassmethod(ClassName,Method) Quit + If NrOfParam=1 Do $zobjclassmethod(ClassName,Method,.P1) Quit + If NrOfParam=2 Do $zobjclassmethod(ClassName,Method,.P1,.P2) Quit + If NrOfParam=3 Do $zobjclassmethod(ClassName,Method,.P1,.P2,.P3) Quit + If NrOfParam=4 Do $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4) Quit + If NrOfParam=5 Do $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5) Quit + If NrOfParam=6 Do $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5,.P6) Quit + If NrOfParam=7 Do $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5,.P6,.P7) Quit + If NrOfParam=8 Do $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5,.P6,.P7,.P8) Quit + }Catch(E){ + new Exception,Message + set Exception = ##class(TECH.ExceptionHandler).Catch() + set Message="ClassName : "_$g(ClassName)_$$$CRLF_" Method : "_$g(Method)_$$$CRLF_ + " NrOfParam :"_$g(NrOfParam)_$$$CRLF_" P1: "_$g(P1)_$$$CRLF_" P2: "_$g(P2)_$$$CRLF_ + " P3: "_$g(P3)_$$$CRLF_" P4: "_$g(P4)_$$$CRLF_" P5: "_$g(P5)_$$$CRLF_" P6: "_$g(P6)_$$$CRLF_ + " P7: "_$g(P7)_$$$CRLF_" P8: "_$g(P8) + Do ##class(vhLib.Logger).%New("SYSTEM").ErrorMail("ClassMethod_Execution",Message_$$$CRLF_Exception.ToString()) + do ##class(TECH.ExceptionHandler).Rethrow(Exception) + } + Quit + +ClassFunction(ClassName,Method,NrOfParam,P1,P2,P3,P4,P5,P6,P7,P8) + Set NrOfParam=$G(NrOfParam) + If 'NrOfParam Quit $zobjclassmethod(ClassName,Method) + If NrOfParam=1 Quit $zobjclassmethod(ClassName,Method,.P1) + If NrOfParam=2 Quit $zobjclassmethod(ClassName,Method,.P1,.P2) + If NrOfParam=3 Quit $zobjclassmethod(ClassName,Method,.P1,.P2,.P3) + If NrOfParam=4 Quit $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4) + If NrOfParam=5 Quit $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5) + If NrOfParam=6 Quit $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5,.P6) + If NrOfParam=7 Quit $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5,.P6,.P7) + If NrOfParam=8 Quit $zobjclassmethod(ClassName,Method,.P1,.P2,.P3,.P4,.P5,.P6,.P7,.P8) + Quit "" + +NewClass(ClassName) + Quit $SYSTEM.OBJ.New(ClassName) + ;Quit $zobjclassmethod(ClassName,"%New") + + + ;---------------------------------------------- +IsFeestDag(DollarH,OokVervangingsFeestdag) + Set DollarH = $G(DollarH) + Set OokVervangingsFeestdag = $G(OokVervangingsFeestdag) + Quit:'$L(DollarH) 0 + Quit $S(OokVervangingsFeestdag:$P($G(^KBA("VP",DollarH)),"\",1)["F",1:$P($G(^KBA("VP",DollarH)),"\",1)="F") + ;---------------------------------------------- + +ExcelNum(Value) + Set Result=$TR($G(Value),".",",") + Set:($E(Result,1)=",") Result = 0_Result + Quit Result + /* + Set Value=$G(Value) + Set Result=$TR(Value,".",",") + If $E(Result)="," Set Result = 0_Result + Quit Result + */ + + // Ophalen method description uit %Dictionary MethodDefinition +MethodDescription(ClassName,Method) + Set Result = "" + Set oMethod = ##class(%Dictionary.MethodDefinition).%OpenId(ClassName_"||"_Method) + Set:$IsObject(oMethod) Result = oMethod.Description + Quit Result + +