HELP Help help w "ALFAEDIT() : Testroutine ter vervanging van het ALPHA-EDIT programma (conversie .ANC --> .PPG)"_$C(13,10) W "CLEARTLOG() : Leegmaken van de ""T""-subnode in ^HADPR"_$C(13,10) w "DEBUG() : (GlobalN,HoofdNode,SubNode,Waarde,UseCounter)"_$C(13,10) w " : --> Schrijft Waarde in de opgegeven ^GlobalN(Nodes). UseCounter=1 schrijft op SubNode ^GlobalN(Nodes,LastSN+1)"_$C(13,10) W "FREES() : Test voor het leggen van profielen"_$C(13,10) W "MODPROD() : Modify Producten via KlantNr; ProductNrs en KADID's worden uit ^KTO en ^HADPR gehaald "_$C(13,10) W "ROTATE(X,Y1,Y2) : roteert de coördinaten van een horizontale lijn naar een verticale (rotatie om het middelpunt). Geeft tevens de VML-code"_$C(13,10) W "TESTLEFT() : Vergelijkende test tussen 2 methodes om het 1ste character te verwijderen : $E(txt,1)="""" - txt=$E(txt,2,99999) "_$C(13,10) W "WFILE() : Test voor creëren van een bestand op een netwerkmap"_$C(13,10) Quit // ========================================================================================================================================== #include %cspBuild #include vhLib.Macro #include %occInclude /* * / TestRQ Set:('$D(%ClientIP)) %ClientIP="192.168.1.97" New fopReq,sc Set:('$G(%blFOPDocBase)) %blFOPDocBase=$System.OBJ.New("BL.FOP.DocBase.TestWS") Set fopReq=%blFOPDocBase.NewFopRequest() Set fopReq.data = "" Set fopReq.dataRef = "" ; "c:\Program Files\Assentis\DocBase\Data\resources\processes\TestDocBase\TestDocBase_vh2.xml" Set fopReq.perfTrace = 0 ; "false" Set fopReq.process = "RenderAndDistributeVH" Set fopReq.stage = "DEV" ;Set fopReq.taskProps = "" Set fopReq.traceLevel = 6 d %blFOPDocBase.AddToTaskPropt(fopReq.taskProps,"Test","TestVal") Set:(fopReq.data="") fopReq.data=" " Set:(fopReq.dataRef="") fopReq.dataRef=" " d $System.OBJ.Dump(fopReq) d WL^vhDBG("Dump fopReq "_fopReq_$$$CRLF_$$ObjToText^vhLib(fopReq)) Set sc=fopReq.%Save() If $$$ISERR(sc) Do . w "SaveResult: "_$$ParseStatus^vhLib(sc) Else Do . w "Save OK",! Quit OpenRQ(ReqID) Set:('$D(%ClientIP)) %ClientIP="192.168.1.97" #define WSRequestInfo WS.FOP.WSRequestInfo New fopReq,sc Set fopReq=##class($$$WSRequestInfo).%OpenId($G(ReqID,18)) d WL^vhDBG("Dump fopReq "_fopReq_$$$CRLF_$$ObjToText^vhLib(fopReq)) New aval,val Set aval=fopReq.taskProps d WL^vhDBG(aval_" CountTaskProps:"_aval.Count()) ; _$C(13,10)_$$ObjToText^vhLib(aval)) set val=aval.GetNext("") d WL^vhDBG(val) Set sc="" If $$$ISERR(sc) Do . w "SaveResult: "_$$ParseStatus^vhLib(sc) Else Do . w "Save OK",! Quit /* */ StartDebug() New k,x,y w "Attach Studio to process "_$J_" and press to continue ... " r k,! w !,"First line in Debug mode",! w "Key again ... " r k,! w !,"Second line in Debug mode",! s y=x q Rtn0() #define ResourceName "TestWVEvents" New Param,JobID1,Key,Rslt Do WLIP^vhDBG(97,"Begin of Rtn0. $Job="_$J) Set Param="" Do WL^vhDBG("Starting Rtn1 via JOB") Job Rtn1^WV(Param) Set JobID1=$ZCHILD Do WL^vhDBG("Started Rtn1 (via JOB) --> JobID1:"_JobID1) Do:(0) . Quit:(JobID1=0) . w !,"Press any key ... " . r Key,! . Write !,"continu Rnt0" . Do WL^vhDBG("Send signal to Job 1") . Set Rslt=$SYSTEM.Event.Signal(JobID1) . Do WL^vhDBG("signal sent (to Job 1) --> Result:"_Rslt) Do:(1) . w !,"Press any key ... " . r Key,! . Write !,"continu Rnt0" . If '$SYSTEM.Event.Defined($$$ResourceName) Do Quit .. Do WL^vhDBG("Resource "_$$$ResourceName_" does not exist. No need to signal!") . Do WL^vhDBG("Send signal to Job 2") . Set Rslt=$SYSTEM.Event.Signal($$$ResourceName) . Do WL^vhDBG("signal sent (to Job 2) --> Result:"_Rslt) Do WL^vhDBG("End of Rtn0") Quit Rtn1(Param) New ParentJob,JobID2,Rslt Do WLIP^vhDBG(97,"Begin of Rtn1. $Job="_$J) Set ParentJob=$ZPARENT Do:(ParentJob>0) WL^vhDBG("Rnt1 started by process "_ParentJob) /* */ Do WL^vhDBG("Starting Rtn2 via JOB") Job Rtn2^WV(Param) Set JobID2=$ZCHILD Do WL^vhDBG("Started Rtn2 (via JOB) --> JobID2:"_JobID2) /* */ Do WL^vhDBG("Rtn1 Waiting for Event") Set Rslt=$SYSTEM.Event.Wait("",3) Do WL^vhDBG("Rtn1 after Wait --> Result:"_Rslt) Hang 3 Do WL^vhDBG("End of Rtn1") Quit Rtn2(Param) New ParentJob,JobID1,Rslt Do WLIP^vhDBG(97,"Begin of Rtn2. $Job="_$J) Set ParentJob=$ZPARENT Do:(ParentJob>0) WL^vhDBG("Rnt2 started by process "_ParentJob) Set Rslt=$SYSTEM.Event.Create($$$ResourceName) Do WL^vhDBG("Rtn2 created Resource --> Result:"_Rslt) Do WL^vhDBG("Rtn2 Waiting for Event") Set Rslt=$SYSTEM.Event.Wait($$$ResourceName,10) Do WL^vhDBG("Rtn2 after Wait --> Result:"_Rslt) Hang 5 Set Rslt=$SYSTEM.Event.Delete($$$ResourceName) Do WL^vhDBG("Rtn2 deleted Resource --> Result:"_Rslt) Set JobID1=ParentJob Do WL^vhDBG("Send signal to Job 1") Set Rslt=$SYSTEM.Event.Signal(JobID1) Do WL^vhDBG("signal sent (to Job 1) --> Result:"_Rslt) Do WL^vhDBG("End of Rtn2") Quit GGDP Do GetGADataProd^Prod.GAData.Product.tmpDev(.arPR) Quit CGDP Do CountGADataParams^Prod.GAData.Product.tmpDev() Quit /* OLKenmXtd New GroepID,Kenm,lstWaarde,ArPR,PRNr,Param,sc,arLU Set GroepID="OL" Set Kenm="HoofdGroep" Do okmBuildLookup Do ##class(Prod.Kenmerk.DataIndex).SPAlle(GroepID,"ArPR") ; Array opbouwen van alle producten Set PRNr="" For Set PRNr=$O(ArPR(PRNr)) Quit:(PRNr="") Do . ;q:(PRNr'=107823) . Set sc=##class(Prod.Kenmerk.DataDefinitie).%DeleteId(PRNr_"||"_GroepID_"||"_Kenm) . Set ProdType=$$okmGetProdType(PRNr) . Set lstWaarde=$G(arLU(ProdType)) . If lstWaarde="" Do Quit . . w PRNr_" WAARDE IS LEEG !!!",! . Set Param=GroepID_"\"_Kenm_"\"_PRNr_"\"_lstWaarde . Set sc=##class(Prod.Kenmerk.DataDefinitie).NewObjectViaList(Param) . w PRNr_" "_$S(sc=1:lstWaarde,1 :sc),! Quit okmBuildLookup New i,PT,tmpAr,tmpLB Set tmpAr("HG_Laden")=$LB("Bestek & werkbestek","Messen & werkbestek","Kruiden","Folie","Deegrol","Verwarmer","Weegschaal","Combi-laden") Set tmpAr("HG_VLaden")=$LB("BOXSIDE","Koken","ORGALUX-tray","Voorraad","Brood","Flessen","Combi-voorraadladen","Borden","Afval") Set tmpAr("HG_Laden;HG_VLaden")=$LB("Antislipmatten","Nuttige producten") Set PT="" For Set PT=$O(tmpAr(PT)) Quit:(PT="") Do . Set tmpLB=tmpAr(PT) . For i=1:1:$LL(tmpLB) Set:($L($LG(tmpLB,i))) arLU($LI(tmpLB,i))=PT Quit okmGetProdType(PRNr) ; Ophalen van de Interne Waarde van de "Sleutel" Set DataID=PRNr_"||"_GroepID_"||ProductType" &sql(SELECT Waarden INTO :lbWaarden FROM Prod_Kenmerk.DataDefinitie WHERE (ID=:DataID)) Quit $LG(lbWaarden,1) */ TM(cls,mth) #define IsClassMethod(%cls,%mth) $$$METHclassmethod($$$MGINFO,%cls,%mth) #define IsMethod(%cls,%mth) ($$$METHid($$$MGINFO,%cls,%mth)>0) #define IsWebMethod(%cls,%mth) $$$METHwebmethod($$$MGINFO,%cls,%mth) w $$$IsClassMethod(cls,mth)_" mth:"_$$$IsMethod(cls,mth)_" Web mth:"_$$$IsWebMethod(cls,mth) Quit MultiParam(Args...) w "Via ...: $D()="_$D(Args), ! , $$$ArrayTT("Args"),!,! Do MultiParamViaArray(.Args) Quit MultiParamViaArray(arArgs) w "Via Array: $D()="_$D(arArgs), !, $$$ArrayTT("arArgs"),! Quit ImportOLType(PRNr,pdlLTs,pldLTdef) Quit:($G(PRNr)="") "" Quit:('$IsValidNum(PRNr)) "PRNr expected numeric." Set %ClientIP="192.168.1.97" ;d WL^vhDBG("test:"_$G(PRNr)) New GroepID,Kenmerk,lstWaarde,i,Param Set GroepID="OL" Set Kenmerk="LadeType" // N_ZR;M_ZR;B_ER;D_ER;D_DR;D_BD;D_BC;D_BZ;K_ZR;C_ER;MZ_ZR;BZ_ER;DZ_ER;DZ_DR;DZ_BD;DZ_BC;DZ_BZ;KZ_ZR;CZ_ER Set lstWaarde="" For i=1:1:$L(pldLTdef,";") Do:($P(pdlLTs,";",i)'="") . Set lstWaarde=lstWaarde_";"_$P(pldLTdef,";",i) Set:($E(lstWaarde,1)=";") $E(lstWaarde,1)="" d WL^vhDBG("test:"_$G(PRNr)) ; _" lstW:"_lstWaarde) Set Param=GroepID_"\"_Kenmerk_"\"_PRNr_"\"_lstWaarde Set DDefID=PRNr_"||"_GroepID_"||"_Kenmerk Do ##class(Prod.Kenmerk.DataDefinitie).%DeleteId(DDefID) ;Do ##class(Prod.Kenmerk.DataIndex).DeleteWaarden(GroepID,Kenmerk,PRNr) Quit ##class(Prod.Kenmerk.DataDefinitie).NewObjectViaList(Param) Quit 1 CoCom() // Conditional compilation // INT-code depends on the Server(Name) where the code is compiled. New ComputerName Set ComputerName=$ZCVT($ZUTIL(110),"U") ; $ZCVT($G(ComputerName,$ZUTIL(110)),"U") Write "Computer: "_ComputerName,! #If $ZCVT($ZUTIL(110),"U")="CACHE02" Write "The Develop Server is "_ComputerName #ElseIf $ZCVT($ZUTIL(110),"U")="CACHE01" Write "The ""HALUX"" Server is "_ComputerName #ElseIf $ZCVT($ZUTIL(110),"U")="WWW01" Write "The WebServer is "_ComputerName #ElseIf $Get(^Country,0)="England" Write "The capital is London." #ElseIf $Get(^Country,"FR")="FR" Write "The capital is Paris." #Else Write "The capital Tallinn." #EndIf Write "Fixed text." Quit TestURL(sURL,ServName,ServPort) Set sURL=$G(sURL,"http://192.168.1.67/csp/hadev/TBoxCSP/TandemboxWizard.csp") Set ServName=$G(ServName,"192.168.1.67") Set ServPort=$G(ServPort,"80") Set PageURL=sURL Set PageDomain=$P($P(PageURL,"://",2),"/",1) Set SubPath=PageURL Set:($L(PageDomain)) SubPath=$P(PageURL,PageDomain,2) Set SubPath=$P(SubPath,"/",1,$L(SubPath,"/")-1) Set:(ServName="") ServName="res.vanhoecke.be" Set:(ServPort'=80) ServName=ServName_":"_ServPort w "sURL :"_sURL,! w "PageDomain:"_PageDomain,! w "SubPath :"_SubPath,! w "new :"_"http://"_ServName_SubPath_"/"_"TandemboxOrder.csp?WSID=",! /* Set PageURL=%request.URL Set PageDomain=$P($P(PageURL,"://",2),"/",1) Set SubPath=$P(PageURL,PageDomain,2) Set ServName=$G(%request.CgiEnvs("SERVER_NAME")) Set ServPort=$G(%request.CgiEnvs("SERVER_PORT"),80) Set:(ServName="") ServName="res.vanhoecke.be" Set:(ServPort'=80) ServName=ServName_":"_ServPort
	
	
*/ Quit TestOref #Include %occInclude Set QHandle="" Set QHandle=$zobjnext(QHandle) ;w QHandle_" -> "_$$$objOrefToInt(QHandle) ;w $$$ObjOref(5) quit New QHandle,Row Set QHandle="" For Set QHandle=$zobjnext(QHandle) Quit:(QHandle=$$$SYSFUNCNULLOREF) Do . Set Row=$LB($$$objOrefToInt(QHandle),QHandle.%ClassName(1)) Quit StatTBXUpg(Ref) #define TRIM(%v) $ZSTRIP(%v,"<>w") New arLog,tmpAr,ProdID,KP1,KP2,MK1,MK2,Nd,Cnt Merge arLog=@Ref Kill ^wvStatTBX Set Cnt="" Set ProdID="" For Set ProdID=$O(arLog(ProdID)) Quit:(ProdID="") Do . Kill tmpAr . Merge tmpAr=arLog(ProdID) . Set Cnt=Cnt+1 . Set KP1=+$$$TRIM($TR($P(tmpAr(2),"kostprijs",2),":","")) . Set KP2=+$$$TRIM($TR($P(tmpAr(4),"kostprijs",2),":","")) . Set MK1=+$$$TRIM($TR($P(tmpAr(2),"MaakKost",2),":","")) . Set MK2=+$$$TRIM($TR($P(tmpAr(4),"MaakKost",2),":","")) . Set Nd=0 . Set:(KP1'=KP2) Nd=Nd+1 . Set:(MK1'=MK2) Nd=Nd+2 . Set SubNd=$S(Nd=0:"=", $$stuCalcPct(KP1,KP2)>0.01:">>", 1:"=%") . Set ^wvStatTBX(Nd,SubNd,ProdID,1)=$J((+$P(tmpAr(1),"Staffel=",2)),3)_" / "_$S(Nd=0:"", 1:$J(" ",25))_tmpAr(3)_$S(Nd#2=0:" / "_KP1, 1:"")_$S(Nd<2:" / "_MK1, 1:"") . Set:(KP1'=KP2) ^wvStatTBX(Nd,SubNd,ProdID,2)="KP: "_$J(KP1,0,4)_" ==> "_ $J(KP2,0,4) . Set:(MK1'=MK2) ^wvStatTBX(Nd,SubNd,ProdID,3)="MK: "_$J(MK1,0,4)_" ==> "_ $J(MK2,0,4) . Set:(Nd=3) ^wvStatTBX(Nd,SubNd,ProdID,4)="KPDiff: "_$ZAbs(KP2-KP1)_" MKDiff"_$S((KP1-MK1)=(KP2-MK2):" = ", 1:":"_$ZAbs(MK2-MK1)) . Set ^wvStatTBX(Nd,SubNd)=$G(^wvStatTBX(Nd,SubNd))+1 . Set ^wvStatTBX(Nd)=$G(^wvStatTBX(Nd))+1 Set ^wvStatTBX("I","CNT")=Cnt Set:($D(^wvStatTBX(0))) ^wvStatTBX(0,"I")="SAME" Set:($D(^wvStatTBX(1))) ^wvStatTBX(1,"I")="KPRS" Set:($D(^wvStatTBX(2))) ^wvStatTBX(2,"I")="MAAK" Set:($D(^wvStatTBX(3))) ^wvStatTBX(3,"I")="BOTH" Do stuAddSummary w "Output to ^wvStatTBX()",! Quit stuCalcPct(Val1,Val2) Quit:(Val1=Val2) 0 Quit:(Val1>Val2) (Val1-Val2)/Val1 ; Else Quit (Val2-Val1)/Val2 stuAddSummary n i,j,p,tmpAr Merge tmpAr=^wvStatTBX f i=0:1:3 s j="" f s j=$O(tmpAr(i,j)) q:j="" s p="" f s p=$O(tmpAr(i,j,p)) q:p="" k tmpAr(i,j,p) Merge ^wvStatTBX("I","SUMM")=tmpAr Quit /* FixKPR New PRNr,Tm,GenType,GAProdID,GAObj,DosNr New D,Q,U Set D="\",Q="K",U=";" ;Kill ^WVfixBS Set GAObj="" Set PRNr=210000 ; "" ; For Set PRNr=$O(^KPR(PRNr),1) Quit:(PRNr="") Do . Set Tm=$P($P($G(^KPR(PRNr,2)),"\",17),";",2) . ;Quit:(PRNr\10'=21380) . ;Quit:(PRNr'=213816) . Quit:(Tm="")||($H-Tm>3) . Set GenType=$$GENTYP^HAD(PRNr) . If GenType'?1(1"TBX",1"DIV\GRP",1"DIV\TLM").E Do Quit .. q .. w !,PRNr . Set GAProdID=$P($G(^KPR(PRNr,"G")),"\",13) . w !,PRNr . w " - #d:"_($H-Tm) . w " - GenType:"_GenType . w " - GAProdID:"_GAProdID . Quit:(GAProdID="")||('$D(^Prod.GAData.ProductD(GAProdID)))||(GAProdID<100) . Set GAObj=##class(Prod.GAData.Product).%OpenId(GAProdID) . ;Set GAObj=##class(Prod.GAData.Product).OpenWithCalc(GAProdID) . w " - GAObj :"_GAObj . Quit:('$IsObject(GAObj)) . Set %this=GAObj . Set DosNr=GAObj.Dossier . w " - DosNr :"_DosNr ; $LG($G(^Prod.GAData.ProductD(GAProdID)),6) . ;Do kpcHALFFAB^Prod.GAData.Product.tmpKPRCreate . Set ^WVfixBS("LOG",PRNr)=$LB(GenType,GAProdID,DosNr) . Kill %this . Set GAObj="" Quit */ // ========================================================================================================================================== ExportGA(ProdID) ; Converteert een Array naar Text New OutF,Ref,FName Set Ref="^Prod.GAData.ProductD("_ProdID_")" Set OutF=##class(%Library.File).%New("\\WV_W2K\C$\Wim\wvExport_GA"_ProdID_".txt") w OutF.Open("WSN"),! w "IsOpen:"_$S(OutF.IsOpen:"Open", 1:"Niks"),! ;Set FName=OutF.Directory_"\"_OutF.FileName Set FName=OutF.Name Do ArrayToTextW^vhLib(Ref,OutF) Do OutF.%Close() w "Output geschreven naar bestand: "_FName ;Do DevObj.%Close() Quit CCA Set CheckArray(1,"GR","BASIS2")="BASIS+PROD+KOST" Set CheckArray(1,"SG","CALC")="INPUT+OPTIES+KENM+CALC2" Set CheckArray(1,"DI","PRKENM026")="PRBASIC*+PRKENM2*+PR1DIM*" Set CheckArray(1,"DI","PRKENM027")="PRBASIC*+PRKENM2*+PR1DIM*" Set CheckArray(2,"PR1DIM||1","PRNr")=5 Set CheckArray(3,"T","KST009","OV13")=2 Set CheckArray(3,"T","KST009","OV12")=2 Set CheckArray(3,"T","KST009","OV13")=2 Set CheckArray(4,"PRKENM004")="PRLALI" Set CheckArray(5,"PARAM034","ProgLabel")="VPCP" Set CheckArray(6,"VPKOO","KST010")=4 Set CheckArray(7,"PR1DIM||1","Oms")="Z" Set CheckArray(7,"PR1DIM||1","PRLen")="Q" Set CheckArray(8,"Sub1")="ErrExec1" Set CheckArray(8,"Sub1","Sub2")="ErrExec2" Quit WSTB Do WSTB^BL.PR.GA.TB.tmpDev2 Quit PRGA Do ^BL.PR.GA.TB.tmpDev Quit TLM Do ^BL.PR.GA.TLM.tmpDev Quit KMBM(Groep) ;(Kenmerk -> BuildMeta) Do BuildMeta^Kenm.Basis.MetaDefinitie.LoadObjects(.Groep) Quit KMRD(Groep) ;(Kenmerk -> Remove Data) Do DeleteDataDef^Kenm.Basis.MetaDefinitie.LoadObjects(.Groep) Quit PRBM(Groep) ;(Prod.Kenmerk -> BuildMeta) Do BuildMeta^Prod.Kenmerk.MetaDefinitie.LoadObjects(.Groep) Quit PRRD(Groep) ;(Prod.Kenmerk -> Remove Data) Do DeleteDataDef^Prod.Kenmerk.MetaDefinitie.LoadObjects(.Groep) Quit TESTRClear New clu,i,tmpLid,FindID Set clu=##class(Test.W.Club).%OpenId("C03") Quit:('clu) Do clu.Leden.Clear() w "SaveOK: "_clu.%Save(),! Do clu.%Close() Quit TESTRFind New clu,i,tmpLid,FindID Set clu=##class(Test.W.Club).%OpenId("C03") Quit:('clu) w "Members before CLEAR : "_clu.Leden.Count(),! Do clu.Leden.Clear() ;w "SaveOK: "_clu.%Save(),! for i=1:1:3 do . Set oL=##class(Test.W.Lid).%New() . Set oL.Club=clu . Set oL.Naam="NTest"_$E(1000+i,2,4) . Set oL.Voornaam="VTest"_$E(1000+i,2,4) . Set oL.Code="TST"_$E(1000+i,2,4) . do oL.%Close() w "Members after FILL: "_clu.Leden.Count(),! w "SaveOK: "_clu.%Save(),! Do clu.%Close() Quit TESTRFind2 New clu,i,tmpLid,FindID Set clu=##class(Test.W.Club).%OpenId("C03") Quit:('clu) w "Juist geopend",! Do ListAllObjects^%apiOBJ() w "Aantal Leden before CLEAR : "_clu.Leden.Count(),! ;Do:(clu.Leden.Count()>0) clu.Leden.Clear() Do clu.Leden.Clear() w "Childs are removed. Swizzled refs:",! Do ListAllObjects^%apiOBJ() w "SaveOK: "_clu.%Save(),! Do ListAllObjects^%apiOBJ() for i=1:1:3 do . Set oL=##class(Test.W.Lid).%New() . Set oL.Club=clu . Set oL.Naam="Test"_$E(1000+i,2,4) . Set oL.Voornaam="VTest"_$E(1000+i,2,4) . Set oL.Code="TST"_$E(1000+i,2,4) . ;w "i="_i_" Save:"_oL.%Save(),! . do oL.%Close() w "Na invullen van Leden:",! Do ListAllObjects^%apiOBJ() w "Aantal Leden after FILL: "_clu.Leden.Count(),! Set FindID="TST001" Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID)) w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,! Set FindID="TST003" Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID)) w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,! w "SaveOK: "_clu.%Save(),! Set FindID="TST001" Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID)) w "SVD.FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,! Set FindID="TST003" Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID)) w "SVD.FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,! Do clu.%Close() Quit TESTRFindAgain New clu,i,tmpLid,FindID Set clu=##class(Test.W.Club).%OpenId("C03") Quit:('clu) w "Aantal Leden : "_clu.Leden.Count(),! Set FindID="TST001" Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID)) w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,! Set FindID="TST004" Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID)) w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,! w "SaveOK: "_clu.%Save(),! Do clu.%Close() Quit ;Set FindID="WVT" ;Set i="" ;Set tmpLid=clu.LedenGetChildAt(FindID,.i) ;w "Child : "_FindID_" -> i="_i_" Oref="_tmpLid_" Code="_$S(tmpLid:tmpLid.Code, 1:""),! ;Set i=clu.Leden.FindObject($LB(clu.%Id()_"||"_FindID)) ;w ".FindObject : "_$$LCVT^vhLib($LB(clu.%Id()_"||"_FindID))_" -> i="_i,! TESTREL(clu) New i,tmpLid,FindID Set FindID="WV01" Do clu.ClearLedenIndex() for i=101:1:120 do . Set oL=##class(Test.W.Lid).%New() . Set oL.Club=clu . Set oL.Naam="Test"_$E(1000+i,2,4) . Set oL.Voornaam="VTest"_$E(1000+i,2,4) . Set oL.Code="TST"_$E(1000+i,2,4) . ;Set sc=oL.%Save() . w "i="_i_" Save:"_$$ParseStatus^vhLib($G(sc)),! . do oL.%Close() . Set oL="" Do Start^TRTimer for i=1:1:10000 Set CI="" Set tmpLid=clu.LedenSmartGetByID(FindID,.CI) Do Stop^TRTimer Write !,"Test Relationship SmartGet "_$$GetTime^TRTimer() ;Do Start^TRTimer ;for i=1:1:10000 Set CI="" Set tmpLid=clu.LedenGetByID(FindID,.CI) ;Do Stop^TRTimer ;Write !,"Test Relationship Get "_$$GetTime^TRTimer() Do Start^TRTimer for i=1:1:10000 Set CI="" Set tmpLid=clu.LedenGetChildAt3(FindID,.CI) Do Stop^TRTimer Write !,"Test Relationship Get "_$$GetTime^TRTimer() Do Start^TRTimer for i=1:1:10000 Set CI="" Set tmpLid=clu.LedenGetChildAt(FindID,.CI) Do Stop^TRTimer Write !,"Test Relationship Get "_$$GetTime^TRTimer() Quit ExportXMLStream(Obj,msgNoObj) ; Creates a New CharStream Object and fills it with the XML of the Object Quit:('$G(Obj)) $G(msgNoObj,"") New xs Set xs=##class(%GlobalCharacterStream).%New() Do Obj.XMLExportToStream(xs) Quit xs ExportXML(Obj,msgNoObj) Quit:('$G(Obj)) $G(msgNoObj,"") New xs Set xs="" Do Obj.XMLExportToString(.xs) Quit xs ExportXMLGAProd(Obj,msgNoObj) Quit:('$G(Obj)) $G(msgNoObj,"") New xs, sx Set xs=##class(%GlobalCharacterStream).%New() Do Obj.XMLWrite(xs,"N","","x.XSL") s sx=xs.Read(xs.Size) Set xs="" Quit sx DEBUG(GlobalN,HoofdNode,SubNode,Waarde,UseCounter) New Ref,RetVal,XCmd,i Set GlobalN=$G(GlobalN,"^wvDEBUG") Set HoofdNode=$G(HoofdNode,"1") If $L($G(SubNode)) Do . If SubNode["," Do .. Set XCmd="Set Ref=$Na("_GlobalN_"("_$$dbgQuoteNodes(HoofdNode_","_SubNode)_"))" .. Xecute XCmd . Else Do .. Set Ref=$Na(@GlobalN@(HoofdNode,SubNode)) Else Do . Set Ref=$Na(@GlobalN@(HoofdNode)) ; Debug action at Node @Ref If Waarde="$KILL" Do . Kill @Ref Else If +$G(UseCounter) Do . Set @Ref=$G(@Ref)+1 . Set @Ref@(@Ref)=Waarde . Set RetVal=@Ref . ;Set @Ref@($O(@Ref@(""),-1)+1)=Waarde Else Do . Set @Ref=Waarde Quit $G(RetVal) ;Quit $O(@Ref@(""),-1) dbgQuoteNodes(Nodes) New Nd For i=1:1:$L(Nodes,",") Set Nd=$P(Nodes, ",", i) Do . Set:(Nd="") $P(Nodes, ",", i)="." . If '$IsValidNum(Nd), $E(Nd,1)'="""", $E(Nd,$L(Nd))'="""" Set $P(Nodes,",",i)=""""_Nd_"""" Quit Nodes CreateHexTableStr Set ^VHHex2Bin(0)="0000" Set ^VHHex2Bin(1)="0001" Set ^VHHex2Bin(2)="0010" Set ^VHHex2Bin(3)="0011" Set ^VHHex2Bin(4)="0100" Set ^VHHex2Bin(5)="0101" Set ^VHHex2Bin(6)="0110" Set ^VHHex2Bin(7)="0111" Set ^VHHex2Bin(8)="1000" Set ^VHHex2Bin(9)="1001" Set ^VHHex2Bin("A")="1010" Set ^VHHex2Bin("B")="1011" Set ^VHHex2Bin("C")="1100" Set ^VHHex2Bin("D")="1101" Set ^VHHex2Bin("E")="1110" Set ^VHHex2Bin("F")="1111" Set ^VHHex2Bin("-")="" Quit ROTATE(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)_ "" FREES New BedDef,BedDefID,pl,bl,DestDir,XMLPath Set BedDefID=356 ; 165 ; 20 : PBR-ON / 21 : PBG-ON Set BedDef=##CLASS(Fabr.Frees.BedDef).%OpenId(BedDefID) Read:('BedDef) !,"Geef BedDefID : ", BedDefID Write ! Set:('BedDef)&(BedDefID>0) BedDef=##CLASS(Fabr.Frees.BedDef).%OpenId(BedDefID) Write:('BedDef) "Ongeldig BedDefID. Routine wordt afgebroken.",! Quit:('BedDef) Set bl=##CLASS(Fabr.Frees.BedLijst).NewBedDef(BedDef) w "Opbouw ProfielLijst ...",! Set pl=##CLASS(Fabr.Frees.ProfielLijst).OpenKaderDeur(11087,999999) ;Set pl=##CLASS(Fabr.Frees.ProfielLijst).OpenToelevering(262328) Do frsTestQueryPL ;Do frsTestLeggen Do pl.%Close() Do ##CLASS(Fabr.Frees.BedLijst).LookUpOrefRemove(bl) Do bl.%Close() Do BedDef.%Close() zw ^wvCNC("ALL") Quit frsTestQueryPL w "Testen van de Query ""ProfielLijst"" ...",! New RS,Query Set Query="Fabr.Frees.ProfielLijst:ProfielLijst" Set RS=##class(%ResultSet).%New(Query) If 'RS Do Quit . ;"Kan geen nieuwe instantie van de query '"_Query_"' maken." New tmpStatus Set tmpStatus=RS.Execute(pl,BedDefID) ; do DEBUG^%Serenji("labelDebug+1^"_$zn,"192.168.1.97") ;labelDebug For Quit:('RS.Next()) Do . w "test Qry"_$G(RS.Data("ID"))_" "_$G(RS.Data("Lengte"))_" "_$G(RS.Data("Zijde")),! Do RS.%Close() Quit frsTestLeggen w "Leggen van Profielen ...",! New PLIndex,KalIndex Set PLIndex=1 ;do DEBUG^%Serenji("labelDebug+1^"_$zn,"192.168.1.97") ;labelDebug Set KalIndex="" Set ProfielPlaatsbaarID=pl.ProfielPlaatsbaarID(PLIndex, .KalIndex, (+bl)_";", 0) ;Do bl.ProfielLeggen(pl,1,101) ;Do bl.ProfielLeggen(pl,2,101,,,"AP") ;Do bl.ProfielLeggen(pl,3,101,,,"AP") ;Do bl.ProfielLeggen(pl,4,101,,,"AP") ;Do bl.ProfielLeggen(pl,20,101) ;Do bl.ProfielLeggen(pl,19,101,,,"AP") ;Do bl.ProfielLeggen(pl,17,101,2,,"AP") w "Altern.leggen: Rslt="_bl.AlternerendLeggen(pl, $LB($LB(27,10,""),$LB(28,7,"")), ""),! Do bl.FreesBed.GetAt(1).CNCFiles.Insert("TestXML.ANC") ;Do bl.XMLCreateFile(.XMLPath,,bl.CNCGetDir("TestW5")) ;w "XMLPath="_XMLPath,! ;w "Opbouw CNC-Prog ...",! ;w bl.CreateAll(pl, "4682", "TestW1", .XMLPath),! Quit ALFAEDIT() #define SubDir "week08P" New Resl,DestinDir,ProgAll Set Resl=##class(Fabr.Frees.BedLijst).CNCGetDir($$$SubDir) Quit:($E(Resl,1)="0") Resl ; DestinDir contains the errormessage Set DestinDir=Resl Quit:($G(DestinDir)="") New InF,OutF,FilePath,FileName,BaseName,ToelevNr,i ;R "Geef naam van het ANC-bestand: ", FileName w ! Set FileName="266331test.ANC" ; "266331.ANC" ; "7851AYR.ANC" Set:(FileName'[".ANC") FileName=FileName_".ANC" Set FilePath=##class(%Library.File).NormalizeDirectory(DestinDir)_FileName w "Volledig path: "_FilePath,! Set InF=##class(%Library.File).%New(FilePath) Do InF.Open("RU") If InF.IsOpen Do . Do InF.Rewind() . Set ProgAll=InF.Read(InF.Size) Else Do . w "0;Kan bestand niet openen om uit te lezen: "_FilePath Set InF="" ; Do InF.%Close() Quit:$G(ProgAll)="" Set FilePath=$$REPLACE^vhRtn1(FilePath,".ANC",".PPW") w "Creatie van .PPG bestand ...",! Set OutF=##class(%Library.File).%New(FilePath) Do OutF.Open("WSN") If OutF.IsOpen Do . Do OutF.Rewind() . Do OutF.Write($$aleAncFilter(ProgAll)) . ;Do:(i=1) %this.CNCFiles.Insert(FileName) Else Do . w "0;Kan bestand niet openen: "_FilePath Do OutF.%Close() w "Einde creatie van .PPG bestand.",! Quit 1 aleAncFilter(Prog) Do ##class(Fabr.Frees.emBed).CNCFilterANC(.Prog) Quit Prog WFILE New OutF ;Set OutF=##class(%Library.File).%New("\\Notes01\Shared\W V\wvTEST.txt") Set OutF=##class(%Library.File).%New("\\Notes01\C$\Data\Private\WV\wvTEST.txt") ;Set OutF=##class(%Library.File).%New("\\WV_W2K\C$\Wim\wvTEST.txt") w OutF.Open("WSN"),! w "IsOpen:"_$S(OutF.IsOpen:"Open", 1:"Niks"),! ;Do OutF.Rewind() Set sTxt="Test vanuit Caché voor kalibers. Dit mag weg. WimV."_$C(13,10)_"Tijdstip:"_$ZDATETIME($H,4) Do OutF.Write(sTxt) Do OutF.%Close() Quit WFILESTREAM ; Parameters: (geen) new CStream,LinkOK,SaveOK New arKDtl Set CStream=##class(%FileCharacterStream).%New() Set LinkOK=CStream.LinkToFile("\\Notes01\C$\Data\Private\WV\Test.txt") Do:('LinkOK) MApplication.MessageBox("Link mislukt: "_$$ParseStatus^vhLib(LinkOK)) ; Write to CharacterStream: ;Do ..Product.XMLWrite(CStream,"N","GAF;GAO","Format GAProduct.xsl") Set SaveOK=CStream.SaveStream() Write:('SaveOK) "Save mislukt: "_$$ParseStatus^vhLib(SaveOK) ;Do:('SaveOK) MApplication.MessageBox("Save mislukt: "_$$ParseStatus^vhLib(SaveOK)) Do CStream.%Close() Quit DeleteKenmData(Groep) New PRNr,k,Kenm,CntAll,CntMissed,CntDel,DelStatus Set Groep=$G(Groep,"OL") Set (CntAll,CntMissed,CntDel)=0 Set PRNr="" w ! For Set PRNr=$O(^Prod.Ken.DataDefinitieD(PRNr)) Quit:(PRNr="") Do . w !,PRNr . Set Kenm=$O(^Prod.Ken.DataDefinitieD(PRNr,Groep)) . Quit:($P(Kenm,"||",1)'=Groep) . w " in groep: "_Groep . Set CntAll=CntAll+1 . Quit:($D(^KPR(PRNr))) . Set CntMissed=CntMissed+1 . w !,"Volgend PRNr niet gevonden in ^KPR: "_PRNr,! . ;quit . w "Data voor dit Product verwijderen [J/N] ? " . r *k,! . Set k=$C(k) . Quit:(k'="J")&&(k'="j") . Set DelStatus=##class(Prod.Kenmerk.DataDefinitie).DeleteViaPRNr(PRNr,$LB(Groep)) . w "Result deleting Product "_PRNr_" : "_DelStatus_" "_$S('DelStatus:$$ParseStatus^vhLib(DelStatus), 1:""),! . Set:(DelStatus) CntDel=CntDel+1 w !,"CntAll="_CntAll_" CntMissed="_CntMissed_" CntDel="_CntDel Quit DeleteKenmDataIndex New Groep,Kenmerk,Waarde,PRNr,ArPRNr,Kenm,CntAll,CntMissed,CntDel,DelStatus,blnPresent Set (CntAll,CntMissed,CntDel)=0 Set (Groep,Kenmerk,Waarde,PRNr)="" For Set Groep=$O(^Prod.Ken.DataIndexD(Groep)) Quit:Groep="" Do . For Set Kenmerk=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk)) Quit:Kenmerk="" Do .. For Set Waarde=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde)) Quit:Waarde="" Do ... For Set PRNr=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr)) Quit:PRNr="" Do .... Do dkdDeleteIfNotPresent .... ;Set ArPRNr(PRNr)=$G(ArPRNr(PRNr))+1 .... ;Set ArPRNr(PRNr,ArPRNr(PRNr))=$LB(Groep,Kenmerk,Waarde) ; ArPRNr alfopen en van de niet-bestaande producten de DataIndexen verwijderen Set PRNr="" For Set PRNr=$O(ArPRNr(PRNr)) Quit:PRNr="" Do . Do dkdDeleteIfNotPresent Quit dkdDeleteIfNotPresent ;w !,PRNr If '$D(^Prod.Ken.DataDefinitieD(PRNr)) Do . w !,PRNr . w " niet gevonden in DataDefinitie",! . w "Kill "_$name(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr))_"",! . Kill ^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr) . ;Do dkdDeleteAllIndexen(PRNr) Else Do . Set blnPresent=($D(^KPR(PRNr))>0) . Quit:(blnPresent) ; bestaand product met DataDefinities . w !,PRNr . w " --> eerst DataDefinities verwijderen",! Quit dkdDeleteAllIndexen(PRNr) quit New Groep,Kenmerk,Waarde Set (Groep,Kenmerk,Waarde)="" For Set Groep=$O(^Prod.Ken.DataIndexD(Groep)) Quit:Groep="" Do . For Set Kenmerk=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk)) Quit:Kenmerk="" Do .. For Set Waarde=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde)) Quit:Waarde="" Do ... Kill ^Prod.Ken.DataIndexD(Groep,Kenmerk,Waarde,PRNr) DeleteKenmAllVTL(VTLGroep) // Verwijdert vertalingen voor onbestaande Kenmerk-waarden. Checkt hiervoor alle MetaGroepen // OPGELET: deze routine moet met omzichtigheid gebruikt worden !!! New iVTL,Groep,Kenmerk,VTLType,Taal,sc Do WLIP^vhDBG(97,"DeleteKenmAllVTL started.") Set VTLGroep=$G(VTLGroep,"PK") Set iVTL="" For Set iVTL=$O(^Res.VertalingAbstractD(VTLGroep,iVTL)) Quit:(iVTL="") Do . Write !,iVTL_":" . Quit:($$$Trim(iVTL)?1(1"<".E0.1">")) ; VTL van Sleutel afzonderlijk behandelen . Quit:($$$Trim(iVTL)?1(1"{".E1"}")) ; VTL van InfoSleutel afzonderlijk behandelen . Quit:($$$Trim(iVTL)="ZoneTp_ALLES") ; VTL van ZoneTp_ALLES definitief laten staan . Quit:($$$Trim(iVTL)="ZoneTp_HogeLade") ; VTL van ZoneTp_ALLES definitief laten staan . Quit:($$$Trim(iVTL)="ZoneTp_LageLade") ; VTL van ZoneTp_ALLES definitief laten staan . ;Quit:($$$Trim(iVTL)?1(1"GS_".E)) ; VTL van Groepsleutels voorlopig laten staan - Temporary (10-09-2010 by WimV) . . Set DDefFound=0 . ;For i=1:1:$LL(lbKenm) Set:($O(^Prod.Ken.DataIndexD(Groep,$LI(lbKenm,i),iVTL,""))'="") DDefFound=1 Quit:(DDefFound) . Set (Groep,Kenmerk)="" . For Set Groep=$O(^Prod.Ken.DataIndexD(Groep)) Quit:(Groep="") Do Quit:(DDefFound) . . For Set Kenmerk=$O(^Prod.Ken.DataIndexD(Groep,Kenmerk)) Quit:(Kenmerk="") Do Quit:(DDefFound) . . . Set:($O(^Prod.Ken.DataIndexD(Groep,Kenmerk,iVTL,""))'="") DDefFound=1 . Do:(DDefFound)&&(Groep'="OL") WL^vhDBG(iVTL_": Found in Groep="_Groep) . Quit:(DDefFound) . Do WL^vhDBG(iVTL_": Mag weg") . . Set VTLType="" . For Set VTLType=$O(^Res.VertalingAbstractD(VTLGroep,iVTL,VTLType)) Quit:(VTLType="") Do:(1) dkvDeleteVertalingen(VTLGroep,iVTL,VTLType) . ;Do WL^vhDBG("-") Do WL^vhDBG("DeleteKenmAllVTL finished") Quit DeleteKenmVTL(Groep,VTLGroep,lbVTLTypes) // Verwijdert vertalingen voor onbestaande Kenmerk-waarden. Checkt hiervoor enkel in één bepaalde MetaGroep (Groep="OL" default) // OPGELET: deze routine moet met grote omzichtigheid gebruikt worden, want zeer onvolledige controle !!! #define InList(%l,%f) ($LF(%l,%f)>0) #define VTLTypeOnly "O" New iVTL,Kenmerk,VTLType,blnVTLTypesAll,Taal,sc Do WLIP^vhDBG(97,"DeleteKenmVTL started.") Set Groep=$G(Groep,"OL") Set VTLGroep=$G(VTLGroep,"PK") Set lbVTLTypes=$G(lbVTLTypes,$LB($$$VTLTypeOnly)) If $LG(lbVTLTypes,1)="" Do Quit . Write "VertalingsTypes (lbVTLTypes) is niet correct ingevuld",!,"DeleteKenmVTL aborted.",! Else Do . Set blnVTLTypesAll=($LG(lbVTLTypes,1)="*") Set iVTL="<" For Set iVTL=$O(^Res.VertalingAbstractD(VTLGroep,iVTL)) Quit:(iVTL="")||(iVTL'?1(1"<".E0.1">"0.2" ")) Do . Write !,iVTL_":" . ;Quit:(iVTL?1(1""" compare: "_(iVTL'?1(1"<".E1">")),! Do WL^vhDBG("DeleteKenmVTL finished") Quit dkvDeleteVertalingen(VTLGroep,Intern,VTLType) Set Taal="" Set sc="" For Set Taal=$O(^Res.VertalingAbstractD(VTLGroep,Intern,VTLType,Taal),-1) Quit:(Taal="") Do . ;Quit:('##class(Res.Vertaling).%ExistsId(VTLGroep_"||"_Intern_"||"_VTLType_"||"_Taal)) . If (##class(Res.VertalingLink).%ExistsId(VTLGroep_"||"_Intern_"||"_VTLType_"||"_Taal)) Do . . Set sc=$$$ERROR($$$GeneralError,"Delete niet uitgevoerd, disabled in program.") . . Set:($G(%blnDeleteKenmerkVTL,0)) sc=##class(Res.VertalingLink).%DeleteId(VTLGroep_"||"_Intern_"||"_VTLType_"||"_Taal) . If (##class(Res.Vertaling).%ExistsId(VTLGroep_"||"_Intern_"||"_VTLType_"||"_Taal)) Do . . Set sc=$$$ERROR($$$GeneralError,"Delete niet uitgevoerd, disabled in program.") . . Set:($G(%blnDeleteKenmerkVTL,0)) sc=##class(Res.Vertaling).%DeleteId(VTLGroep_"||"_Intern_"||"_VTLType_"||"_Taal) . d:(Taal="N") WL^vhDBG("Vertaling "_(VTLGroep_"||"_Intern_"||"_VTLType_"||"_Taal)_" werd "_$S($$$ISERR(sc):"NIET ",1:"")_"verwijderd."_$S($$$ISERR(sc):" ERROR "_$$ParseStatus^vhLib(sc),1:"")) . d:(Taal'="N") WL^vhDBG(Taal) Do:(sc'="") WL^vhDBG("-") Quit $G(sc,$$$OK) SetTandemBoxType() // Invullen van TandeboxType voor alle bestaande OL-producten. // i.e. initiële input, na creatie van het kenmerk. New UnID,CntAll,CntErr,sc Set (CntAll,CntErr)=0 Set UnID="" w ! For Set UnID=$O(^Prod.Ken.DataDefinitieD(UnID)) Quit:(UnID="") Do . ;q:(UnID'=386974) . w !,UnID . Quit:($G(^Prod.Ken.DataDefinitieD(UnID,"OL||Sleutel"))="") ; If Sleutel exists in the OL group, then update TandemBoxType kenm. . Set sc=##class(Prod.Kenmerk.DataDefinitie).Set("OL",UnID,"TandemboxType",$LB("TANDEMBOX_plus","TANDEMBOX_intivo")) ; GroepID, UnID, Kenmerk, Values, Delimiter . w "Result setting Kenmerk 'OL||TandemboxType' voor UnID "_UnID_" : "_sc_" "_$S($$$ISERR(sc):$$ParseStatus^vhLib(sc), 1:""),! . Set CntAll=CntAll+1 . Set:($$$ISERR(sc)) CtnErr=CntErr+1 w !,"CntAll="_CntAll_$S(CntErr>0:" - CntErr="_CntErr, 1:" - No errors."),! Quit UpdateASMxxPREV() ; ORGALUX (vorige versie) /* ^Res.VertalingAbstractD("PK","","LB","N")=<<$LB("","ViaSleutelK/AG.jpg")>> ^Res.VertalingAbstractD("PK","","LI","N")=<<$LB("","ViaSleutelG/AG.jpg")>> ^Res.VertalingAbstractD("PK","","LB","N","VertalingLink")=<<$LB("WebOL","JPG","","F","","0","","","B")>> ^Res.VertalingAbstractD("PK","","LI","N","VertalingLink")=<<$LB("WebOL","JPG","","F","","0","","","E")>> */ New lbVTL,Key,Key01,asm,Taal Set lbVTL("G","AG")=$LB("","ViaSleutelG/AG.jpg") Set lbVTL("G","AR")=$LB("","ViaSleutelG/AR.jpg") Set lbVTL("G","AZ")=$LB("","ViaSleutelG/AZ.jpg") Set lbVTL("K","AG")=$LB("","ViaSleutelK/AG.jpg") Set lbVTL("K","AR")=$LB("","ViaSleutelK/AR.jpg") Set lbVTL("K","AZ")=$LB("","ViaSleutelK/AZ.jpg") Set Key01="" Set Key="" For Set Key=$O(^Res.VertalingAbstractD("PK",Key)) Quit:(Key="") Do:(Key?1"<"1(1"AG",1"AR",1"AZ").E1">") . w Key,! . ;quit . Set asm=$E(Key,2,3) . For Taal="N","F","D","E" Do . . Set ^Res.VertalingAbstractD("PK",Key,"LB",Taal)=lbVTL("K",asm) . . Set ^Res.VertalingAbstractD("PK",Key,"LI",Taal)=lbVTL("G",asm) . . Set ^Res.VertalingAbstractD("PK",Key,"LB",Taal,"VertalingLink")=$LB("WebOL","JPG","","F","","0","","","B") . . Set ^Res.VertalingAbstractD("PK",Key,"LI",Taal,"VertalingLink")=$LB("WebOL","JPG","","F","","0","","","E") Quit UpdateASM() ; ORGALUX (nieuwe versie : met AGO-matten) /* ^Res.VertalingAbstractD("PK","","LB","N")=<<$LB("","ViaSleutelK/AO.jpg")>> ^Res.VertalingAbstractD("PK","","LI","N")=<<$LB("","ViaSleutelG/AO.jpg")>> ^Res.VertalingAbstractD("PK","","LB","N","VertalingLink")=<<$LB("WebOL","JPG","","F","","0","","","B")>> ^Res.VertalingAbstractD("PK","","LI","N","VertalingLink")=<<$LB("WebOL","JPG","","F","","0","","","E")>> */ New lbVTL,Key,Key01,asm,Taal Set lbVTL("G","AO")=$LB("","ViaSleutelG/AO.jpg") ; Set lbVTL("G","AR")=$LB("","ViaSleutelG/AR.jpg") Set lbVTL("G","AY")=$LB("","ViaSleutelG/AY.jpg") Set lbVTL("K","AO")=$LB("","ViaSleutelK/AO.jpg") ; Set lbVTL("K","AR")=$LB("","ViaSleutelK/AR.jpg") Set lbVTL("K","AY")=$LB("","ViaSleutelK/AY.jpg") Set Key01="" Set Key="" For Set Key=$O(^Res.VertalingAbstractD("PK",Key)) Quit:(Key="") Do:(Key?1"<"1(1"AO",1"AY").E1">") ; ,1"AR" . w Key,! . ;quit . Set asm=$E(Key,2,3) . For Taal="N","F","D","E" Do . . Set ^Res.VertalingAbstractD("PK",Key,"LB",Taal)=lbVTL("K",asm) . . Set ^Res.VertalingAbstractD("PK",Key,"LI",Taal)=lbVTL("G",asm) . . Set ^Res.VertalingAbstractD("PK",Key,"LB",Taal,"VertalingLink")=$LB("WebOL","JPG","","F","","0","","","B") . . Set ^Res.VertalingAbstractD("PK",Key,"LI",Taal,"VertalingLink")=$LB("WebOL","JPG","","F","","0","","","E") Quit UpdateFotos() ; ORGALUX // Part I // Fill in when vertaling EMPTY: Key="" --> "ViaSleutelK/BX5060GR.jpg" // // Part II // Change vertaling van "ViaSleutel/BX5060GR_K.jpg" naar "ViaSleutelK/BX5060GR.jpg" /* ^Res.VertalingAbstractD("PK","","LB","N")=<<$LB("","ViaSleutelK/AG.jpg")>> ^Res.VertalingAbstractD("PK","","LI","N")=<<$LB("","ViaSleutelG/AG.jpg")>> */ #define OLPath "\\Notes01\Images\Orgalux\" New lbVTL,Key,Key01,asm,Taal d WLIP^vhDBG(97,"Start Orgalux UpdateFotos") ; Get values from an existing Key: Set Key="" Merge arVTL=^Res.VertalingAbstractD("PK",Key,"LB","N") Set lbVTL=$G(arVTL,$LB("","")) Set Key="" For Set Key=$O(^Res.VertalingAbstractD("PK",Key)) Quit:(Key="") Do:(Key?1"<".E1">"0.2" ")&&(Key'?1"",1"",1"",1"")) . ;quit:($$$Trim(Key)'?1(1"")) . ;quit:($$$Trim(Key)'?1(1"")) . ;quit:(Key'?1(1"",1"")) ; temp test Intivo . . ;d WL^vhDBG("Key="_Key_":") . . . // (Added by WimV on 07/04/2011) . Set SkipThisKey=0 . If $G(%CheckFotoSleutelsOnly,1)=1 Do . . // Controleren dat Key voorkomt als FotoSleutel (i.e. kenmerk "InfoSleutel"), anders is Key enkel nodig voor TekstSleutel, dan niet meer invullen van de Foto als VertalingLink . . Set FotoSleutelExists=$D(^Prod.Ken.DataIndexD("OL","InfoSleutel",Key)) . . Set SkipThisKey=(FotoSleutelExists=0) . . Quit:(SkipThisKey) ; EARLY QUIT - CONTINU with next key !!! . . . // Fill in when vertaling EMPTY: Key="" --> "ViaSleutelK/BX5060GR.jpg" . ; Extract ImageName from Key . Set ImgName=$TR($$$Trim(Key),"<>","") . ;Set:(ImgName?1(1"AG",1"AR",1"AZ").E)&&(ImgName'?.E1"AF") ImgName=$E(ImgName,1,2) ; Antislipmatten, behalve eindigend op "AF" . Set:(ImgName?1(1"AO",1"AR",1"AY").E)&&(ImgName'?.E1"AF") ImgName=$E(ImgName,1,2) ; Antislipmatten, behalve eindigend op "AF" . Set:(ImgName?.E1"xx") $E(ImgName,$L(ImgName)-1,99)="" . Set:(ImgName?.E1"xx.ED") ImgName=$E(ImgName,1,$L(ImgName)-5)_"_65" ; voor extra diepte . Set:(ImgName?.E1"xx.65") ImgName=$E(ImgName,1,$L(ImgName)-5)_"_65" ; voor extra diepte . Set:(ImgName?.E1".EDGB") ImgName=$E(ImgName,1,$L(ImgName)-5)_"_65_G" ; voor extra diepte met glazen boxside . Set:(ImgName?.E1".ED") ImgName=$E(ImgName,1,$L(ImgName)-3)_"_65" ; voor extra diepte . Set:(ImgName?.E1".GB") ImgName=$E(ImgName,1,$L(ImgName)-3)_"_G" ; voor glazen boxside . If Key?1"