cAFVBI01 ; Algemene functies VB -input ;cAFVBI01 ; T1 ;Geen geldig BTW-nummer.; heeft zelfde BTW-nummer.; T2 ;Geen geldige betalingstermijn. T3 ;Geen geldig banknummer.; T4 ; moet alfanumeriek zijn.; moet alfanumeriek zijn en in hoofdletters.; T5 ;Geen geldige map.; T6 ;Geen geldige gestructureerde mededeling.; T7 ;Geen geldige EAN13.; T8 ;EAN13 : Check digit is niet correct.; ; T1F ;N° de TVA invalide.; a le mème n° de TVA.; T2F ;Délai de paiement invalide. T3F ;N° de banque invalide.; T4F ; doit être alphanumérique.; doit être alphanumérique et en majuscules.; T5F ;Répertoire invalid.; T6F ;Communication structurée invalide.; T7F ;EAN13 invalid.; T8F ;EAN13 : Check digit est invalid.; ; T1E ;No valid VAT-Number.; has the same VAT-Number.; T2E ;No valid payment terms. T3E ;No valid bank account number.; T4E ; has to be alphanumeric.; has to be alphanumeric and in capitals.; T5E ;No valid path.; T6E ;No valid structured communication.; T7E ;No valid EAN13.; T8E ;EAN13 : Check digit is not correct.; ; YZ Q ; ARAUN(Q,DMS,K,UI1) ; AR + ARA : check uniek + ook verwijderde indien oude structuur ; DMS = AR.A of ARA.A ; K = input ; UI1 = huidige UI1 S $ZT="^dmERROR" N @$$INITVAR^cAFVBA01("DMS,K,UI1") ARAUNA S OK=$$UNIQUE^cAFVBA01(Q,DMS,101,K,$G(UI1)) I 'OK G ARAUNZ ; moet er een bestand gelijk gehouden worden? ARAUNB S DMSQ=$$DMSQ^cAN008(DMS) I '$L(DMSQ) G ARAUNZ S HUQC=$P(^DMS(DMSQ,DMS,2),D),HUSC=$P(^(2),D,2) I '$L(HUQC)!'$L(HUSC) G ARAUNZ S UREF=$G(^DMC(HUQC,HUSC,"DATA","REF")) I '$L(UREF) G ARAUNZ S HQ=$$Q^cAFA10() N Q S Q=HQ S UI1=$$DI^cAN000(K,"") I $P($G(@UREF@(0)),D,30)=2 S OK=0 G ARAUNZ ARAUNZ Q OK ; ALFANUM(MSG,K,TYPE) ; Check alfanumeriek ; MSG : omschrijving ; K : input ; TYPE : "" of 0 : Alfanumerisch ; 1 : Alfanumerisch + hoofdletters N R,OK D QT^cAFVBO01 I '$L(K) S OK=1 G ALFANUMZ S TYPE=$G(TYPE),OK=1,R=$$DP^cAFA1(K) ; dep. I R'=K S OK="0\"_MSG_$P($T(@("T4"_QT)),U,2) G ALFANUMZ S R=$$UC^cAFA1(R) ; dep + hoofdletters I TYPE=1 S:R'=K OK="0\"_MSG_$P($T(@("T4"_QT)),U,3) G ALFANUMZ ALFANUMZ Q OK ; BANK(Q,K) ; test op geldig banknummer ; Output: 0\Foutboodschap ; 1\Weg te schrijven banknummer N (Q,K,QT) S D="\",U=";" D QT^cAFVBO01 S K=$P($$DI^cAN000(K,"")," ") S OK=$$BANK^cAFI1(K) BANKZ Q OK_"\"_$S(OK=1:K,1:$P($T(@("T3"_QT)),U,2)) ; BET(R,QT) ; betalingstermijn N (R,QT) S $ZT="^dmERROR" S D="\",U=";" D QT^cAFVBO01 I $$LC^cAFA1(R)=$P("contant#comptant#contant#in cash","#",QTU) S R="" I $$BET^cAFI1(R) S OUT=1_D_$S($L(R):R,1:$P("contant#comptant#contant#in cash","#",QTU)) G BETZ S OUT=0_D_$P($T(@("T2"_QT)),U,2) BETZ Q OUT ; BTW(Q,K,DMS,UI1) ; test op geldig BTW-nr ; indien DMS doorgegeven wordt, wordt getest of BTW-nummer uniek is N (Q,K,QT,DMS,UI1) S $ZT="^dmERROR" S D="\",U=";" D QT^cAFVBO01 S K=$P($$DI^cAN000(K,"")," ") I $E(K,1,2)="LL" S OUT=0_D_$P($T(@("T1"_QT)),U,2) G BTWZ I '$$BTW^cAFI1(K) S OUT=0_D_$P($T(@("T1"_QT)),U,2) G BTWZ S OUT=1_D_K I '$L($G(DMS)) G BTWZ S R=$$UI1OP^cAFA1(DMS,116,"\\\"_$G(UI1),$P(OUT,D,2)) I '$L(R) G BTWZ S OUT=-1_D_$TR($P($$SIGN^cAFA1(DMS,R,0),D,1,2),D," ")_$P($T(@("T1"_QT)),U,3)_D_K BTWZ Q OUT ; DUB(Q,DMS,NAAM,POSTC) ; test op dubbele naam via postcode ; Q doorgeven als referentie : .Q S $ZT="^dmERROR" N @$$INITVAR^cAFVBA01("DMS,NAAM,POSTC") S OK=1 I '$L($G(NAAM)) G DUBZ I '$L($G(POSTC)) G DUBZ S OK=$$VB^cAN2050(DMS,NAAM,POSTC) DUBZ Q OK ; EAN13(EAN13) ; test op EAN13 S $ZT="^dmERROR" N @$$INITVAR^cAFVBA01("EAN13") S OK=1 I '$L(EAN13) G EAN13Z I $L(EAN13)'=13 S OK=0_D_$P($T(@("T7"_QT)),U,2) G EAN13Z ; S OK=$$CC^cAN1010(EAN13) I 'OK S OK=0_D_$P($T(@("T8"_QT)),U,2) ; EAN13Z Q OK ; GRIDKOL(GRIDID,SQLKOL) ; ophalen kolomnr voor SQLKOL in GRID N R,i I '$L($G(GRIDID)) S R="" G GRIDKOLZ I '$L($G(SQLKOL)) S R="" G GRIDKOLZ S GRIDID=GRIDID_" 0 " S REF=$$UC^cAFA1($P(SQLKOL,"->",2)),SQLKOL=$P(SQLKOL,"->") S i=GRIDID,SQLKOL=$$UC^cAFA1(SQLKOL),R="" F S i=$o(^VBN(0,"GRID.TAB.COL",i)) q:$e(i,1,$l(GRIDID))'=GRIDID D Q:$L(R) . i $$UC^cAFA1($P($P(^(i,1),D),"->"))'=SQLKOL Q . I '$P(^(0),D,15) Q . I $L(REF) I "#"_$$UC^cAFA1($P($P(^(1),D),"->",2))_"#"'[("#"_REF_"#") Q . S R=$P(^(0),D,19) GRIDKOLZ Q R ; ; INPUT(Q,DMS,INPUT,GRIDID,UI1,B1,B2,SWQ,ALL,SQL,QTD) ; input codebestand ; Q = Q-waarde (door te geven als reference omdat Q(49) ook zou doorgegeven worden) ; DMS = DMS ; INPUT = Inputwaarde ; GRIDID = ID van de grid uit ^VBN(0,"GRID" ; UI1 = ID : indien ingevuld wordt enkel de bindexen opgehaald en wordt er niet meer gezocht ; via de waarde ; B1 = B-index eerste zoeksleutel : indien ingevuld wordt niet meer naar ^DMC gekeken ; B2 = B-index tweede zoeksleutel : indien ingevuld wordt niet meer naar ^DMC gekeken ; SWQ = 1 : Q-waarde maakt deel uit van de key : Q||UI1 ; ALL = verscheidene parameters en dient om niet steeds de klasse te moeten aanpassen (del = "~") ; 1. indien 1 en een ID doorgekregen : toch met volledig SQL naar buiten ; 2. indien 1 : er wordt met zowel operationele als buitengebruik rekeningen gehouden ; 3. Output= GridId van mtemp99 met correcte UI1's ; 4. Input = GridId van mtemp99 met verschillende inputwaardes ; 5. Gekoppelde bestanden: gescheiden door # ; 1. Via gekoppelde zoeksleutel x (1 of 2) (default = 1) ; 2. Vaste waarde andere zoeksleutel dan in 2 ; 3. Skip check op gekoppeld bestand (opgeroepen vanuit INPUTK) ; SQL = SQL-statement dat per gevonden Item moet uitgevoerd worden ; ; Uitgang : ; R = 1_D_UI1_D_B-index1_D_B-index2_D_UQC_D_USC : unieke key ; R = 2_D_INPUT_D_B-index : meerde waardes voor input ; R = 0 : fout ; ; N (Q,DMS,INPUT,GRIDID,UI1,B1,B2,SWQ,QU,QT,ALL,SQL,QTD) S $ZT="^dmERROR" S D="\",U=";" D QT^cAFVBO01 S R=0 I '$L($G(UI1))&'$L($TR($G(INPUT),"+")) G INPUTZ D DMS^cAN000("UQC","USC",DMS,1) I '$L(UQC)!'$L(USC) G INPUTZ I '$D(^DMC(UQC,USC)) G INPUTZ S UREF=^DMC(UQC,USC,"DATA","REF") I '$L(UREF) G INPUTZ ; indien er geen B1 en B2 doorgeven wordt : ophalen definitie F i=1,2 I '$L($G(@("B"_i))) S @("B"_i)=$G(^DMC(UQC,USC,"EXTERN","INPUT","BIN",i)) D SEARCHK(.SK,B1,B2,$G(QTD,QT)) S B1=SK(1),B2=SK(2) I $L($G(UI1)) S R=1_D_UI1 G INPUTB I $E(INPUT)="+" G INPUTA ; steeds zoeken op tweede zoeksleutel S R=$$UI1(.Q,DMS,B1,INPUT,UQC,USC,$P($G(ALL),"~",2)_D_D_D_D_D_$P($G(ALL),"~",3)_D_$P($G(ALL),"~",4),$G(SQL)) G:$P(ALL,"~",4) INPUTB I +R=99,'$L($P(R,D,2)) S R=0 ; eerste zoeksleutel INPUTA I $L($G(B2)),+R=0 S R=$$UI1(.Q,DMS,B2,INPUT,UQC,USC,$P($G(ALL),"~",2)_D_D_D_D_D_$P($G(ALL),"~",3)_D_$P($G(ALL),"~",4),$G(SQL)) I +R=2,$E(INPUT)'="+" S R=0 INPUTB I +R=1 D . ; indien Q deel uitmaakt van de key (enkel : Q||UI1) . I $G(SWQ) s i=$P(R,D,2) I $L(i),'$F(i,"||") S $P(R,D,2)=Q_"||"_i . S $P(R,D,3,6)=$G(B1)_D_$G(B2)_D_UQC_D_USC INPUTZ Q R ; QTD I $D(QT),QT[D S:'$D(QTD)!($G(QTD)=" ") QTD=$P(QT,D,2) S QT=$P(QT,D) D QT^cAFVBO01 I '$D(QTD)!($G(QTD)=" ") S QTD=QT D ; KU : 06.12.05 . N QT,QTU . S QT=QTD . D QT^cAFVBO01 . S QTD=QT,QTDU=QTU QTDZ Q ; INPUTN(Q,DMS,INPUT,GRIDID,UI1,B1,B2,SWQ,ALL,KLAS,PAR,DATEFM,FIXEDWHERE,QTD) ; input codebestand : nieuwe versie (met meertaligheid) ; opgelet : er moet een instance openstaan van de klasse en kan maar vanuit die klasse opgestart worden ; ; Q = Q-waarde (door te geven als reference omdat Q(49) ook zou doorgegeven worden) ; DMS = DMS ; INPUT = Inputwaarde ; GRIDID = ID van de grid uit ^VBN(0,"GRID" ; UI1 = ID : indien ingevuld wordt enkel de bindexen opgehaald en wordt er niet meer gezocht ; via de waarde ; B1 = B-index eerste zoeksleutel : indien ingevuld wordt niet meer naar ^DMC gekeken ; B2 = B-index tweede zoeksleutel : indien ingevuld wordt niet meer naar ^DMC gekeken ; SWQ = 1 : Q-waarde maakt deel uit van de key : Q||UI1 ; ALL = verscheidene parameters en dient om niet steeds de klasse te moeten aanpassen (del = "~") ; 1. indien 1 en een ID doorgekregen : toch met volledig SQL naar buiten ; 2. indien 1 : er wordt met zowel operationele als buitengebruik rekeningen gehouden ; 3. Output= GridId van mtemp99 met correcte UI1's ; 4. Input = GridId van mtemp99 met verschillende inputwaardes ; 5. Gekoppelde bestanden: gescheiden door # ; 1. Via gekoppelde zoeksleutel x (1 of 2) (default = 1) ; 2. Vaste waarde andere zoeksleutel dan in 2 ; 3. Skip check op gekoppeld bestand (opgeroepen vanuit INPUTK) ; KLAS = naam van de klasse ; PAR = String met parameters per parameter (zie ook dmSQL) ; DATEFM = Formaat van datum op de client ; FIXEDWHERE = vast where statement : zie dmSQL voor meer uitleg : enkel geldig als GRIDID doorgegeven werd ; QTD = taal van de gebruiker : indien niet doorgegeven ('$D) wordt QTD=QT gezet of =veld 2 van QT ; Wordt tot op heden nog niet doorgegeven vanuit VB ; S $ZT="^dmERROR" N R,SQL,D,U,QTDU,KOPP,REFKL S D="\",U=";" D QTD ; ; Koppelbestand? ---------- INPUTNA S KOPPEL=$P(ALL,"~",5) I '$L($P(KOPPEL,"#")) S $P(KOPPEL,"#")=1 I $P(KOPPEL,"#",3)!$L($G(UI1)) G INPUTNB ; Opgeroepen vanuit INPUTK S REFKL=$P($$KOPPEL^cAFVBI02($G(KLAS),$P(..BIndexToProperty($S($P($P(ALL,"~",5),"#")="2":B2,1:B1)),D,2)),D,2) I '$L(REFKL) G INPUTNB S R=$$INPUTK^cAFVBI02(Q,INPUT,$G(GRIDID),REFKL,B1,B2,$G(ALL),$G(PAR),$G(FIXEDWHERE),$G(DATEFM),$G(QTD)) G INPUTNZ ; ------------------------- ; ; Samenstellen SQL-query INPUTNB S SQL=$$QUERY($G(KLAS),"~UI1~","","","","",$G(GRIDID),$G(PAR),$G(DATEFM),"",$G(FIXEDWHERE),$G(QTD," ")) ; Ophalen UI1 INPUTNC S R=$$INPUT(.Q,DMS,INPUT,$G(GRIDID),$G(UI1),$G(B1),$G(B2),$G(SWQ),$G(ALL),$G(SQL),$G(QTD," ")) I 'R G INPUTNZ ; Samenstellen query INPUTND I +R=1 S $P(R,D,3,6)=$$QUERY($G(KLAS),$P(R,D,2),$P(..BIndexToProperty($P(R,D,3)),D,2),$P(..BIndexToProperty($P(R,D,4)),D,2),$P(R,D,5),$P(R,D,6),$G(GRIDID),$G(PAR),$G(DATEFM),$S('$P($G(ALL),"~"):$L($G(UI1)),1:""),$G(FIXEDWHERE),$G(QTD," "),$S($L($P(KOPPEL,"#",2)):$P(KOPPEL,"#"),1:"")) G INPUTNZ ; Opzoeken kolom uit grid INPUTNE I (+R'=2)!$P(KOPPEL,"#",3) G INPUTNZ S $P(R,D,3)=$$GRIDKOL($G(GRIDID),$P(..BIndexToProperty($P(R,D,3)),D,2)) I '$L($P(R,D,3)) S R=0 ; kolom niet in de grid gevonden : mag grid niet opstarten ; INPUTNZ Q R ; OGM(K) ; gestructureerde mededeling S D="\",U=";" D QT^cAFVBO01 S K=$P($$DI^cAN000(K,"")," ") I $D(^BA(6,"BE",1)),@^(1) S K="1\"_K G OGMZ S K="0\"_$P($T(@("T6"_QT)),U,2) OGMZ Q K ; QUERY(KLAS,UI1,SQLKOL1,SQLKOL2,UQC,USC,GRIDID,PAR,DATEFM,SWID,FIXEDWHERE,QTD,SWKOL) ; KLAS = naam van de klasse ; SQLKOL1 = SQLkolom van de eerste zoeksleutel ; SQLKOL2 = SQLkolom van de 2de zoeksleutel ; GRIDID = GridId van de grid die opgeroepen wordt indien er meerdere waardes zijn ; PAR = String met parameters per parameter (zie ook dmSQL) ; DATEFM = Formaat van datum op de client ; SWID = 1 ;indien er een ID doorgegeven werd in de INPUT ; FIXEDWHERE = vast where statement : zie dmSQL voor meer uitleg : enkel geldig als GRIDID doorgegeven werd ; QTD = taal van de gebruiker : indien niet doorgegeven ('$D) wordt QTD=QT gezet of =veld 2 van QT ; SWKOL = Gekoppeld bestand: ; "": Alle zoeksleutels tonen van beide koppels (in praktijk = 4) ; 1: Enkel zoeksleutels tonen van eerste deel ; 2: Enkel zoeksleutels tonen van tweede deel ; Uitgang : ; SQL-statement N SQL,i,WHERE,oKLAS,REFKL,Z1,Z2,SQLKOL S $ZT="^dmERROR" I $D(QT),QT[D S:'$D(QTD)!($G(QTD)=" ") QTD=$P(QT,D,2) S QT=$P(QT,D) D QT^cAFVBO01 S oKLAS=KLAS S KLAS=$$TABLE^dmSQL(KLAS) I '$L($G(UQC))!'$L($G(USC)) G QUERYA I '$D(^DMC(UQC,USC,"EXTERN","INPUT","QUERY")) G QUERYA S SQL=$G(^("QUERY",0)) I $D(^(KLAS)) S SQL=^(KLAS) I '$L(SQL) G QUERYA F Q:SQL'["~KLASNAAM~" S SQL=$P(SQL,"~KLASNAAM~")_KLAS_" T1"_$P(SQL,"~KLASNAAM~",2,99) F Q:SQL'["~ID~" S SQL=$P(SQL,"~ID~")_"'"_UI1_"'"_$P(SQL,"~ID~",2,99) F Q:SQL'["~QTD~" S SQL=$P(SQL,"~QTD~")_""""_$E($G(QTD,QT)_"N")_""""_$P(SQL,"~QTD~",2,99) G QUERYY QUERYA S SQL="Select T1.ID" I $$KOPPEL^cAFVBI02(oKLAS,SQLKOL1) G QUERYB S:$L($G(SQLKOL1)) SQL=SQL_", T1."_SQLKOL1 S:$L($G(SQLKOL2)) SQL=SQL_", T1."_SQLKOL2 G QUERYC ; ; Koppelbestand ----------------------------------------------------------------- QUERYB S SQLK="" F i=1:1:2 D . I '$L(@("SQLKOL"_i)) Q . I $G(SWKOL) I SWKOL'=i Q . S REFKL=$P($$KOPPEL^cAFVBI02(oKLAS,@("SQLKOL"_i)),D,2) I '$L(REFKL) Q . S Z1=$$ZKSL^cAFVBI02(REFKL,1,QTD),Z2=$$ZKSL^cAFVBI02(REFKL,2,QTD) I '$L(Z1) Q . S SQLK=SQLK_$S('$L(SQLK):",",$G(SWKOL):",",$L(SQLK):" || "" - "" || ",1:" || ") . S SQLK=SQLK_"T1."_@("SQLKOL"_i)_"->"_Z1 I '$L(Z2) Q . S SQLK=SQLK_$S($G(SWKOL):",",1:" || "_""" """_" || ") . S SQLK=SQLK_"T1."_@("SQLKOL"_i)_"->"_Z2 S SQL=SQL_SQLK ; ------------------------------------------------------------------------------- ; QUERYC S SQL=SQL_" From "_KLAS_" T1 where T1.ID = '"_UI1_"'" ; where-statement uit de grid gaan ophalen QUERYY I '$L($G(GRIDID))!$G(SWID) G QUERYZ S WHERE=$P($$INPUT^dmSQL(GRIDID_" 0",$G(PAR),$G(QT),$G(DATEFM),$G(FIXEDWHERE),$G(QTD," "))," WHERE ",2,99) S WHERE=$P(WHERE," GROUP BY"),WHERE=$P(WHERE," HAVING"),WHERE=$P(WHERE," ORDER BY ") I '$L(WHERE) G QUERYZ S SQL=SQL_" AND "_WHERE QUERYZ Q SQL ; MAP(K) ; controleert de ingave van een map N OK D QT^cAFVBO01 S D="\",U=";" I $E(K,1,2)?1A1":"!($E(K,1,2)?2"/"&$L($P(K,"/",3))&($ZV["NT"))&(K'[D)&($E(K,3,$L(K))'["//") S OK=1 G MAPZ S OK="0\"_$P($T(@("T5"_QT)),U,2) MAPZ Q OK ; UI1(Q,DMS,BI,INPUT,UQC,USC,PAR,SQL) ; opzoeken UI1 voor waarde INPUT via B-index BI ; is afgeleid van UI1^cAFA1, maar hier hoef je niet de volledige code mee te geven ; Q = Q-waarde (door te geven als reference omdat Q(49) ook zou doorgegeven worden) ; DMS = DMS ; INPUT = Inputwaarde ; BI = B-index zoeksleutel ; optioneel : UQC en USC ; PAR = Parameters gescheiden door "\" ; 1. 1 : er wordt met zowel operationele als buitengebruik rekeningen gehouden ; 2. 1 : enkel zoeken naar exacte waardes (gebruikt om uniekheid te testen) ; 3. Volgorde van zoeken : 1 = omgekeerde richting (en wordt steeds naar exacte waardes gezocht) ; 4. UI1 : geen rekening houden met deze UI1 (voor test op uniek) ; 5. 1 : geen rekening houden met Q(49) of DMQ(,DMS) ; 6. Output= GridId van mtemp99 met correcte UI1's ; 7. Input = GridId van mtemp99 met verschillende inputwaardes ; ; SQL = SQL-statement dat per gevonden Item moet uitgevoerd worden ; ; Uitgang : ; R = 1_D_UI1 : unieke key ; R = 2_D_INPUT_D_B-index : meerde waardes voor input ; R = 0 : fout ; R = 99_D_GRIDID_D_B-index : meerdere waardes opgezet in mtemp99 ; N (Q,DMS,BI,INPUT,UQC,USC,QU,QT,PAR,SQL) S $ZT="TRAP^cAN000" S D="\",U=";",R=0 I $E(INPUT)="+" S INPUT=$E(INPUT,2,$L(INPUT)) S X=$P($$DI^cAN000(INPUT,"")," ") I '$L(X) G UI1Z S PAR=$G(PAR),ALL=$P(PAR,D),EXACT=$P(PAR,D,2),SORT=-$P(PAR,D,3)*2+1,OUI1=$P(PAR,D,4) I SORT=-1 S EXACT=1 ; sort = -1 : bedoeling is om laatste UI1 voor een bepaalde exacte waarde te vinden I '$L($G(UQC))!'$L($G(USC)) D DMS^cAN000("UQC","USC",DMS,1) I '$L(UQC)!'$L(USC) G UI1Z I '$D(^DMC(UQC,USC)) G UI1Z S R=$$REF^cAFA10(.Q,DMS,BI,UQC,USC,$P(PAR,D,5)_D_1) S UREF=$P(R,D),IREF=$P(R,D,2),IREF2=$P(R,D,3),S1=$P(R,D,4) S (R,i)=0 I '$L(IREF)&'$L(IREF2) G UI1Z ; er bestaan geen indexbestanden I BI'["M" G UI12 ; geen multiple I INPUT'[D G UI12 ; geen multi-input UI11 F i="",2 I $L(@("IREF"_i)) D . S @("IREF"_i)=$P(@("IREF"_i),")") . F j=1:1:$L(INPUT,D)-1 S @("IREF"_i)=@("IREF"_i)_","""_$P($$DI^cAN000($P(INPUT,D,j),"")," ")_"""" . S @("IREF"_i)=@("IREF"_i)_")" . S X=$P($$DI^cAN000($P(INPUT,D,$L(INPUT,D)),"")," ") ; UI12 S (R,i)=0 I '$P(PAR,D,7) G UI1A S MI="",LUS=1 UI121 S MI=$O(^mtemp99(INPUT,"COMMON",MI)) I '$L(MI) S LUS=0 G UI1Z S X=$P($$DI^cAN000(MI,"")," ") ; ; eerst via index : ^INDEX(Q,DMS,BI,waarde_" "_key) ; snelste manier om nrs op te halen UI1A I '$L(IREF) G UI1C S RI=X_" " S:SORT=-1 RI=RI_"~" ;,R=0,i=0 UI1B S RI=$O(@IREF@(RI),SORT) I $G(EXACT),$P(RI," ")'=X G UI1Y ; indien exact : direct stoppen I $E(RI,1,$L(X))'=X G UI1Y ; waarde niet gevonden S UI1=^(RI) S OP=$$UI1OP(UI1,S1,$G(ALL),$G(SQL),OUI1) ; operationeel en geldig (via SQL) ? I $P(RI," ")=X,$P($O(@IREF@(RI),SORT)," ")'=X,OP!(i=1) D G:i UI1Z G UI1B ; indien input exact gelijk aan de waarde . I OP,i S R=2_D_INPUT_D_BI Q ; er werd reeds 1 gevonden . S:'i R=1_D_UI1,i='$$MTEMP(UI1) I 'OP G UI1B S i=i+1 I $$MTEMP(UI1) G UI1B I i=1 S R=1_D_UI1 I $G(EXACT) G UI1Z I i>1 S R=2_D_INPUT_D_BI G UI1Z G UI1B ; meerdere waardes die overeenkomen met input ; als er nog niets gevonden is, proberen via index2 : ^IND(Q,DMS,BI,waarde,key) ; index moet +- volledig overlopen worden omdat nummers numerisch gesorteerd zijn UI1C ;S R=0 UI1D I '$L(IREF2) G UI1Z S RI=X ;,i=0,R=0 I $G(EXACT) G UI1Z:'$D(@IREF2@(RI)) ; indien exact : direct stoppen indien niet bestaat I $L(RI) S RI=$O(@IREF2@(RI),-1) UI1E S RI=$O(@IREF2@(RI)) I RI="" G UI1Y I $G(EXACT),RI'=X G UI1Y ; indien exact : direct stoppen I $E(RI,1,$L(X))'=X G UI1Y:+X'=X&(+RI'=RI) D:(+X=X&X&(+RI=RI)) G UI1E . N i . S i=X*10 F Q:(i-1)'1 S R=2_D_INPUT_D_BI G UI1Z G UI1F ; meerdere waardes die overeenkomen met input UI1Y I i=1 G UI1Z S R=0 ; UI1Z I $G(LUS),(+R'=2) G UI121 Q $S($P(PAR,D,6):"99\"_$G(GRIDID)_"\"_BI,1:R) ; MTEMP(UI1) N R S R=0 I '$P(PAR,D,6) G MTEMPZ I '$L($G(GRIDID)) S GRIDID=$$GRIDID^cAFVBF01() K ^mtemp99(GRIDID,"COMMON") S ^mtemp99(GRIDID,"COMMON",UI1)="",R=1 MTEMPZ Q R ; UI1OP(UI1,S1,ALL,SQL,OUI1) N OK S OK=0 I $L($G(OUI1)),UI1=OUI1 S OK=0 G UI1OPY ; geen rekening houden met doorgegeven UI1 I $G(ALL) S OK=1 G UI1OPY ; alle records I S1<5,'$P(@UREF@(0),D,30) S OK=1 G UI1OPY ; operationeel I S1=5,'$P(@UREF,D,30) S OK=1 G UI1OPY UI1OPY I $L($G(SQL)),OK S OK=''$$UI1SQL($G(SQL),UI1) ; uitvoeren SQL voor gevonden UI1 UI1OPZ Q OK ; UI1SQL(SQL,UI1) ; uitvoeren query per gevonden item N R F Q:SQL'["~UI1~" S SQL=$P(SQL,"'~UI1~'")_"'"_UI1_"'"_$P(SQL,"'~UI1~'",2,99) S R=$$FR^dmSQL1(SQL) UI1SQLZ Q +$P(R,D,2) ; SEARCHK(SK,B1,B2,TK) ; SK : doorgeven als referentie : in deze variabele worden de searchkeys gezet : ; SK(1)= B-index ; SK(2)= B-index ; TK : indien bestaat : enkel de juiste B-index per taal ; N i,QT,QTU,D S $ZT="TRAP^cAN000" S D="\" K SK I $D(TK) S QT=TK D QT^cAFVBO01 F i=1,2 D . S @("B"_i)=$TR($G(@("B"_i)),"#",D) . I '$L($G(@("B"_i))) S @("B"_i)=100+i_$S(i=2:"\112\122\132",1:"") . I @("B"_i)'?3N.(1"\"3N) S SK(i)="" Q . S SK(i)=@("B"_i) . I $D(QTU) S SK(i)=$P(@("B"_i),D,QTU) S:'$L(SK(i)) SK(i)=$P(@("B"_i),D) SEARCKHZ Q ; ZZ ; 29.08.07 - 10 u 22 * V8.09