cAFA1 ;Standaardfuncties ;%AFA1 ; [ 03/28/01  9:25 AM ]
 ;
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 ;
 ;
BF() ; muntkode BF ophalen
 N R S R=$P($G(@("^"_Q_"BA(39)")),D) I R="" S R="BEF"
 Q R
 ;
BUSY ; in gebruik
 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)
 N ZR,BTWP,RS1 S ZR=$ZR,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)
 S ZR=$O(@ZR)
 Q R
 ;
CTRLF(DMS) ; ^F toegelaten ?
 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
 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
 Q $$DC^cAFD1(R)
 ;
DCO(R) ; datum conversie omgekeerd (jj)jjmmdd -> dd.mm.jj
 Q $$DCO^cAFD1(R)
 ;
DEC(VM) ; decimalen muntcode
 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)"))
 Q R
 ;
DP(R) ; depunctueren
 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
 Q $$DH^cAFD1(R)
 ;
EC(R) ; extended characters -> ascii
 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)
 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
 Q $$HD^cAFD1(K)
 ;
HT(K,S) ; $H naar UU:MM
 Q $$HT^cAFD1(K,$G(S))
 ;
IDEM() ; zelfde UI1 aanhouden
 N R
 S R="S UI1="""_UI1_""""
 Q R
 ;
IP(K,DEC,LEN)      ; interpunctie 
 Q $S('$G(ZONDERIP):$J($TR($FN(K,",T",DEC),".,",",."),LEN),1:K)
 ;
LC(R) ; lowercase conversie
 S R=$TR(R,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
 Q R
 ;
MSG(TXT,LEN,IPC)   ; boodschap met input
 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 K=$P($T(@("T4"_QT)),U,2)_$P(^DMC(UQC,USC,"TAAL",$E(QT_"N")),D)
 D TXT(250)
 Q
 ;
NOF ; kill F-variabelen
 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
 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
 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
 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
 I $ZV["MSM",$G(%K) D INT^cPARTSIZ
 Q
 ;
PGMOV ; melding vóór PGMOV
 S K=$P($T(@("T3"_QT)),U,2) D TXT(250)
 Q
 ;
RELSORT(R)         ; release ^HULP("SORT",R)
 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
 ;
SIG(DMS,UI1,BI)    ; $p uit signalitiek via UI1
 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
 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
 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
 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(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
 I R'?.L S R=$$EC(R)
 S R=$TR(R,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 Q R
 ;
UI1(DMS,M,I1,I2,I3,I4)       ; ophalen UI1 via multiple
 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)
 Q R
 ;
UNIEK(DMS,BI,X)    ; test uniek gegeven
 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
 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 ; 30.03.01 - 13 u 39 * V7.85