cAFA1	;Standaardfuncties ;%AFA1 ;  [ 09/11/09  10:52:53 ]
	;
T0	;Standaardfuncties ;
T1	;De bestanden zijn in gebruik ... u moet opnieuw proberen ;
T2	;Even geduld a.u.b. ... ;
T3	;U heeft te weinig werkgeheugen om dit programma te kunnen uitvoeren;
T4	;U heeft geen toegang tot deze ;
	;
T0F	;Fonctions standards ;
T1F	;Les fichiers sont en usage ... il faut réessayer ;
T2F	;Veuillez patienter s.v.p. ... ;
T3F	;La mémoire est insuffisante pour exécuter ce programme ;
T4F	;Vous n'avez pas d'accès à ce ;
	;
T0E	;Standard functions ;
T1E	;Files are in use ... please try again ;
T2E	;One moment please ... ;
T3E	;There is not enough memory to carry out this program;
T4E	;You have no access to this ;
	;
T0D	;Standaardfuncties ;
T1D	;Die dossiers sind in Gebrauch ... Sie sollen noch einmal versuchen ;
T2D	;Even geduld a.u.b. ... ;
T3D	;U heeft te weinig werkgeheugen om dit programma te kunnen uitvoeren;
T4D	;U heeft geen toegang tot deze ;
	;
	; ====================================================================
S1	S RZR=$ZR           ; onthouden last reference
S1Z	Q
	;
S2	I RZR["(",$O(@RZR)          ; terugzetten last reference
	I RZR'["(",$D(@RZR)
S2Z	Q
	;
	; ====================================================================
BF()	; muntkode BF ophalen
	S $ZT="TRAP^cAN000" N RZR D S1
	N R S R=$P($G(@("^"_Q_"BA(39)")),D) I R="" S R="EUR"
	D S2 Q R
	;
	; ====================================================================
BUSY	; in gebruik
	S $ZT="TRAP^cAN000"
	S K=$P($T(@("T1"_QT)),U,2) D TXT(250)
	Q
	;
	; ====================================================================
BTW(R,BTWC,BTWR)	        ;omzetten naar prijs incl. of excl. BTW
	; R = bedrag , BTWC = BTW-kode, BTWR = regime (0 = excl, 1 = incl)
	S $ZT="TRAP^cAN000" N RZR D S1
	N BTWP,RS1 S BTWR=$G(BTWR) I '$D(PBTW) D S1^cA305
	S BTWP=PBTW(BTWC#10) I BTWC>10 S BTWP=BTWP+PTXT(BTWC\10)
	I BTWR S R=R*(BTWP/100+1)
	E  S R=R*100/(BTWP+100)
	D S2 Q R
	;
	; ====================================================================
CTRLF(DMS)	; ^F toegelaten ?
	S $ZT="TRAP^cAN000"
	N R
	S R="" I $L(DMS),$G(QU(1)),$P($G(^DPAR(0,"PAR.DMS",DMS,0)),D,10) D
	. I $P($G(^DATA(0,"USR_PAR.DMS",QU(1)_" "_DMS,0)),D,3) S R=70
	Q R
	;
	; ====================================================================
DBLQ(X)	; double quotes in string
	S $ZT="TRAP^cAN000"
	N Y S Y=0
	F  S Y=$F(X,"""",Y) Q:'Y  S X=$E(X,0,Y-1)_""""_$E(X,Y,$L(X)),Y=Y+1
	Q X
	;
	; ====================================================================
DC(R)	; datum conversie
	S $ZT="TRAP^cAN000"
	Q $$DC^cAFD1(R)
	;
	; ====================================================================
DCO(R)	; datum conversie omgekeerd (jj)jjmmdd -> dd.mm.jj
	S $ZT="TRAP^cAN000"
	Q $$DCO^cAFD1(R)
	;
	; ====================================================================
DEC(VM)	; decimalen muntcode
	S $ZT="TRAP^cAN000" N RZR D S1
	N R
	I $L(VM) S R=2 I $D(@("^"_Q_"BA(11,VM)")) S R=+$P(^(VM),D,7)
	I VM=$$BF!(VM="") S R=+$G(@("^"_Q_"BA(34)"))
	D S2 Q R
	;
	; ====================================================================
DP(R)	; depunctueren
	S $ZT="TRAP^cAN000"
	N S1,S2,S3
	S S2="" F S3=1:1:$L(R) S S1=$E(R,S3) S:S1'?1P S2=S2_S1
	Q S2
	;
	; ====================================================================
DH(R)	; datum omvormen tot $H-VORM
	S $ZT="TRAP^cAN000"
	Q $$DH^cAFD1(R)
	;
	; ====================================================================
EC(R)	; extended characters -> ascii
	S $ZT="TRAP^cAN000"
	I $ZV["MSM" D
	. N I,MORF,OT
	. S MORF="" F I=128:1:255 S MORF=MORF_$C(I)
	. S OT="CueaaaaceeeiiiAAEaAooouuyOUoL0xfaiounNao r    <>"
	. S OT=OT_"     AAAc    cY       aA       ooDEEE III     I "
	. S OT=OT_"OBOOoOuPpUUUyY       $     132  "
	. S R=$TR(R,MORF,OT)
	I $ZV'["MSM" D
	. N I,MORF,OT
	. S MORF="" F I=128:1:255 S MORF=MORF_$C(I)
	. S OT="" F I=1:1:32 S OT=OT_" "
	. S OT=OT_"  cLoY $ ca<  r      u     >    AAAAAAACEEEEIIII"
	. S OT=OT_"DNOOOOO 0UUUUYpBaaaaaaaceeeeiiiionooooo ouuuuyPy"
	. S R=$TR(R,MORF,OT)
	Q R
	;
	; ====================================================================
EG	; even geduld
	D O^cA612(24,1,1,80,0,0,0,0) W /CUP(1,3),$P($T(@("T2"_QT)),U,2)
	Q
	;
	; ====================================================================
GETSORT()	; reserveren ^HULP("SORT",r)
	S $ZT="TRAP^cAN000"
	N R
	L +^HULP("SORT",0)
	S R=$G(^HULP("SORT",0),1),^(0)=R+1 K ^(R) S ^(R)=DT_D_TD
	L -^HULP("SORT",0)
	Q R
	;
	; ====================================================================
HD(K)	; $H naar DD.MM.JJ
	S $ZT="TRAP^cAN000"
	Q $$HD^cAFD1(K)
	;
	; ====================================================================
HT(K,S)	; $H naar UU:MM
	S $ZT="TRAP^cAN000"
	Q $$HT^cAFD1(K,$G(S))
	;
	; ====================================================================
IDEM()	; zelfde UI1 aanhouden
	S $ZT="TRAP^cAN000"
	N R
	S R="S UI1="""_UI1_""""
	Q R
	;
	; ====================================================================
IP(K,DEC,LEN)	     ; interpunctie 
	S $ZT="TRAP^cAN000"
	Q $S('$G(ZONDERIP):$J($TR($FN(K,",T",DEC),".,",",."),LEN),1:K)
	;
	; ====================================================================
LC(R)	; lowercase conversie
	S $ZT="TRAP^cAN000"
	S R=$TR(R,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
	Q R
	;
	; ====================================================================
MSG(TXT,LEN,IPC)	  ; boodschap met input
	S $ZT="TRAP^cAN000"
	D O^cA612(24,1,1,80,0,0,1,1) W /CUP(1,3),@F4,TXT,@F5
MSGA	D ^cAFA0("",24,$L(TXT)+5,LEN,0,27,0,0,0) I RK=27 S K="-"
	I @IPC
	E  G MSGA
	D C^cA612 Q
	;
	; ====================================================================
NOA	; no access
	S $ZT="TRAP^cAN000"
	S K=$P($T(@("T4"_QT)),U,2)_$P(^DMC(UQC,USC,"TAAL",$E(QT_"N")),D)
	D TXT(250)
	Q
	;
	; ====================================================================
NOF	; kill F-variabelen
	S $ZT="TRAP^cAN000"
	K F,F0,F1,F11,F12,F2,F3,F4,F5,F55,F56,F57,F58,F6,F60,F61,F62,F7,F8,F9,F90,F91,F92,F93,F94,F95,FDL,FG,FIN,FR,FS
	Q
	;
	; ====================================================================
OMREK(K,VM1,VM2,AVF,AFR)	    ; omrekenen van VM1 naar VM2
	S $ZT="TRAP^cAN000"
	N R S R=K
	I $L(VM1),VM1'=$$BF S R=R*$$PAR(VM1,AVF)
	I $L(VM2),VM2'=$$BF S R=R/$$PAR(VM2,AVF)
	I AFR S R=$J(R,0,$$DEC(VM2))
	Q R
	;
	; ====================================================================
OMS(DMS,TAAL,EM,UC)	         ; omschrijving
	S $ZT="TRAP^cAN000"
	N R,UQC,USC
	S R="" D DMS^cAN000("UQC","USC",DMS,1) I $L(UQC),$L(USC) D
	. I $G(TAAL) S TAAL=$E("NFDE",TAAL)
	. S R=$P($G(^DMC(UQC,USC,"TAAL",$E($G(TAAL)_"N"))),D,$G(EM,1))
	. I $L(R),$G(UC) D
	.. I UC=1 S R=$$UC($E(R))_$E(R,2,$L(R))
	.. I UC>1 S R=$$UC(R)
OMSZ	Q R
	;
	; ====================================================================
PAR(VM,AVF)	       ; pariteit A/V/F
	S $ZT="TRAP^cAN000"
	N R
	S R=1 I $L(VM),VM'=$$BF D
	. I $D(@("^"_Q_"BA(11,VM)")) S R=$P(^(VM),D,$F("AVF",$$UC(AVF))+2)/$P(^(VM),D,3)
	Q R
	;
	; ====================================================================
PARTSIZE(%K)	      ; verzetten partitiegrootte
	S $ZT="TRAP^cAN000"
	I $ZV["MSM",$G(%K) D INT^cPARTSIZ
	Q
	;
	; ====================================================================
PGMOV	; melding vóór PGMOV
	S $ZT="TRAP^cAN000"
	S K=$P($T(@("T3"_QT)),U,2) D TXT(250)
	Q
	;
	; ====================================================================
RELSORT(R)	        ; release ^HULP("SORT",R)
	S $ZT="TRAP^cAN000"
	L +^HULP("SORT",0)
	K ^HULP("SORT",R) I $O(^(R))="" S ^(0)=R I R>1,$O(^(0))="" S ^(0)=1
	L -^HULP("SORT",0)
	Q
	;
TRDEC(INH)	; verwijderen scheidingsteken duizendtallen en omvormen dec. teken naar .
	I $F(INH,".")>$F(INH,",") S INH=$TR(INH,".,",",")
	S INH=$TR(INH,",.",".")
TRDECZ	Q INH
	;
	; ====================================================================
SIG(DMS,UI1,BI)	   ; $p uit signalitiek via UI1
	S $ZT="TRAP^cAN000"
	N B,K,SW3,UQC,UREF,USC,USL
	D DMS^cAN000("UQC","USC",DMS)
	S K="" I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
	. S UREF=^DMC(UQC,USC,"DATA","REF") I $L(UI1),$D(@UREF) D
	.. S SW3=BI\100,USL=D D R^cAN000 S K=$P(B(BI\100),D,BI#100)
	Q K
	;
	; ====================================================================
SIGN(DMS,UI1,N)	   ; node uit signalitiek via UI1
	S $ZT="TRAP^cAN000"
	N K,UQC,UREF,USC
	D DMS^cAN000("UQC","USC",DMS)
	S K="" I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
	. S UREF=^DMC(UQC,USC,"DATA","REF") I $L(UI1),$D(@UREF) S K=$G(^(UI1,N))
	Q K
	;
	; ====================================================================
SG(DMS,KC,BI)	     ; $p uit signalitiek via KC
	S $ZT="TRAP^cAN000"
	N K,RQ2,UDD,UI1,UQC,USC
	D DMS^cAN000("UQC","USC",DMS)
	S K="" I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
	. S UDD=^DMC(UQC,USC,"DATA"),RQ2=$G(^("DATA","OUD"))
	. I UDD=1 S UI1="" I $L(KC) S UI1=$G(@RQ2@(KC))
	. I UDD=2 S UI1=KC_" "
	. I UDD>2 S UI1=KC
	. I $L(UI1) S K=$$SIG(DMS,UI1,BI)
	Q K
	;
	; ====================================================================
SGN(DMS,KC,N)	     ; node uit signalitiek via KC
	S $ZT="TRAP^cAN000"
	N K,RQ2,UDD,UI1,UQC,USC
	D DMS^cAN000("UQC","USC",DMS)
	S K="" I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
	. S UDD=^DMC(UQC,USC,"DATA"),RQ2=$G(^("DATA","OUD"))
	. I UDD=1 S UI1="" I $L(KC) S UI1=$G(@RQ2@(KC))
	. I UDD=2 S UI1=KC_" "
	. I UDD>2 S UI1=KC
	. I $L(UI1) S K=$$SIGN(DMS,UI1,N)
	Q K
	;
	; ====================================================================
TXT(RT)	; foutboodschap via %TXT
	S $ZT="TRAP^cAN000"
	I $G(NOSCR) Q
	I $G(QW) D O^cA612(24,1,1,80,0,0,1,1)
	I $G(QW) N F S F="/CUP(1,3)"
	X ^cTXT(0,$E(QT_"N"),RT) D ^cAFA0("",0,0,0,0,27,0,0,0) I RK=27 S K="-"
	I $G(QW) D C^cA612
	Q
	;
	; ====================================================================
UC(R)	; uppercase conversie
	S $ZT="TRAP^cAN000"
	S R=$$EC(R)
	S R=$TR(R,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
	Q R
	;
	; ====================================================================
UI1(DMS,M,I1,I2,I3,I4,I5,I6,I7,I8,I9)	      ; ophalen UI1 via multiple
	S $ZT="TRAP^cAN000"
	N IREF,R,RA,RI,UQC,USC
	D DMS^cAN000("UQC","USC",DMS)
	S R="" I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
	. S IREF=^DMC(UQC,USC,"DATA","INDEX")
	. F RA=1:1 Q:'$D(@("I"_RA))  S @("I"_RA)=$$DI^cAN000(@("I"_RA),"")
	. S RA=RA-1 F RI=1:1:RA-1 S @("I"_RI)=$P(@("I"_RI)," ")
	. I RA=1 S RI=$O(@IREF@(M,I1)) I $E(RI,1,$L(I1))=I1 S R=^(RI)
	. I RA=2 S RI=$O(@IREF@(M,I1,I2)) I $E(RI,1,$L(I2))=I2 S R=^(RI)
	. I RA=3 S RI=$O(@IREF@(M,I1,I2,I3)) I $E(RI,1,$L(I3))=I3 S R=^(RI)
	. I RA=4 S RI=$O(@IREF@(M,I1,I2,I3,I4)) I $E(RI,1,$L(I4))=I4 S R=^(RI)
	. I RA=5 S RI=$O(@IREF@(M,I1,I2,I3,I4,I5)) I $E(RI,1,$L(I5))=I5 S R=^(RI)
	. I RA=6 S RI=$O(@IREF@(M,I1,I2,I3,I4,I5,I6)) I $E(RI,1,$L(I6))=I6 S R=^(RI)
	. I RA=7 S RI=$O(@IREF@(M,I1,I2,I3,I4,I5,I6,I7)) I $E(RI,1,$L(I7))=I7 S R=^(RI)
	. I RA=8 S RI=$O(@IREF@(M,I1,I2,I3,I4,I5,I6,I7,I8)) I $E(RI,1,$L(I8))=I8 S R=^(RI)
	. I RA=9 S RI=$O(@IREF@(M,I1,I2,I3,I4,I5,I6,I7,I8,I9)) I $E(RI,1,$L(I9))=I9 S R=^(RI)
UI1Z	Q R
	;
UI1OP(DMS,M,PAR,I1,I2,I3,I4,I5,I6,I7,I8,I9)	; opzoeken UI1 : operationeel of niet afh. van PAR
	; Ingang :
	;    DMS
	;    M  = index of multiple
	;    PAR  : gescheiden door "\"
	;      1. Enkel operationeel  :  1 = ja
	;      2. Volgorde van zoeken :  1 = omgekeerde richting
	;      3. Indien LE\KL : 1 = enkel met nummer naar buiten komen
	;      4. UI1 : geen rekening houden met deze UI1 (voor test op uniek)
	;      5. 1 : geen rekening houden met Q(49) of DMQ(,DMS)
	;      6. Per Ix gescheiden door ";"
	;          Lege waarde beïnvloeden : 0 of "" : leeg laten
	;                                   1 : 0
	;                                   2 : " "
	;    I1...I6 : waardes
	; uitgang : 
	;   "" = niets gevonden
	;   UI1 = intern nr 
	S $ZT="TRAP^cAN000"
	N IREF,R,RA,RI,UQC,USC,UREF,UI1,GE,S1,SORT,I,oQ
UI1OPA	D DMS^cAN000("UQC","USC",DMS)
	S R="",PAR=$G(PAR)
	I '$L(UQC)!'$L(USC) G UI1OPZ
	I '$D(^DMC(UQC,USC)) G UI1OPZ
UI1OPB	I $L($$DMQ49^cAFA10(Q,DMS)) D  G UI1OPZ  ; indien er een ^DMQ(,DMS) opstaat via nieuw principe
	. M oQ=Q N Q M Q=oQ K Q(49) 
	. S Q(49)=$$Q49^cAFVBA03(Q,DMS)  ; KU : 20.02.07
	. S R='$P(PAR,D)_D_1_D_$P(PAR,D,2)_D_$P(PAR,D,4)_D_$P(PAR,D,5),$P(R,D,8)=$P(PAR,D,6)
	. S RI="" F RA=1:1 Q:'$D(@("I"_RA))  S RI=RI_$S($L(RI):D,1:"")_@("I"_RA)
	. S R=$$UI1^cAFVBI01(.Q,DMS,M,RI,UQC,USC,R)
	. I 'R S R="" Q   ; geen gevonden
	. I +R=2 S R="" Q  ; meerdere waardes gevonden
	. S R=$P(R,D,2)   ; 1 exacte waarde
	S S1=^DMC(UQC,USC,"DATA"),IREF=^("DATA","INDEX"),UREF=^("REF")
	S SORT=$S($P($G(PAR),D,2)=1:-1,1:1)  ; bepalen richting van $O
	F RA=1:1 Q:'$D(@("I"_RA))  D
	. S @("I"_RA)=$$DI^cAN000(@("I"_RA),"")
	. I '$L(@("I"_RA)),$P($P(PAR,D,6),U,RA) S @("I"_RA)=$P("0\ ",D,$P($P(PAR,D,6),U,RA))
 
	S RA=RA-1 F RI=1:1:RA-1 S @("I"_RI)=$P(@("I"_RI)," ")
	S GE="@IREF@(M" F I=1:1:RA-1 S GE=GE_",I"_I
	S GE=GE_",RI)",RI=@("I"_RA)_$S(SORT=-1:"~",1:"")
UI1OPC	S RI=$O(@GE,SORT)
	I $E(RI,1,$L(@("I"_RA)))'=@("I"_RA) S R="" G UI1OPY
	S UI1=^(RI)
	I $L($P($G(PAR),D,4)),UI1=$P(PAR,D,4) G UI1OPC
	I '$G(PAR) S R=UI1 G UI1OPY   ; operationeel speelt geen rol
	I $G(PAR),'$P(@UREF@(0),D,30) S R=UI1 G UI1OPY  ; enkel operationeel
	G UI1OPC
UI1OPY	I $L(R),S1=1,$P($G(PAR),D,3) S R=$P(R," ",2)  ; indien KL,LE, ... enkel met nr naar buiten
UI1OPZ	Q R
	;
	; ====================================================================
UNIEK(DMS,BI,X)	   ; test uniek gegeven
	S $ZT="TRAP^cAN000"
	N IREF,R,RI,UDD,UQC,USC
	S X=$$DP($$UC(X))_" "
	D DMS^cAN000("UQC","USC",DMS)
	I UQC="",USC="" S UQC=0,USC=DMS I $L(BI) S UQC=BI ; ivm kodes
	S R=0 I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
	. S UDD=^DMC(UQC,USC,"DATA"),IREF=$G(^("DATA","INDEX"))
	. I UDD<5 S RI=$O(@IREF@(BI,X)),R=$E(RI,1,$L(X))'=X
	. I UDD=5 S R='$D(@IREF@(X)) I K'=" " S K=$P(X," ")
	Q R
	;
	; ====================================================================
UR(DMS,BI,X)	      ; ophalen intern nummer adhv (unieke) omschrijving/code
	S $ZT="TRAP^cAN000"
	N IREF,R,RI,UDD,UQC,USC
	S X=$$DI^cAN000(X,"")
	D DMS^cAN000("UQC","USC",DMS)
	S R="" I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
	. S UDD=^DMC(UQC,USC,"DATA"),IREF=$G(^("DATA","INDEX"))
	. S RI=$O(@IREF@(BI,X)) I $E(RI,1,$L(X))=X S R=^(RI)
	Q R
	;
ZZ	; 07.12.09 - 10 u 00 * V9.06