cA500 ;Toegangscontrole ;%A500 ;Do uit II ; [ 11/20/97   1:35 PM ]
 ;
T0 ; Administratie ;
T1 ;Uw toegangscode : ;Uw initialen : ;
T2 ;Schermnummer : ;
T3 ;Goede morgen;Goede middag;Goede avond;, Data-M heet u welkom.;
 ;
T0F ; Administration ;
T1F ;Votre code d'accès : ;Vos initiales : ;
T2F ;N° d'écran : ;
T3F ;Bonjour;Bon après-midi;Bonsoir;, Data-M vous souhaite la bienvenue.;
 ;
T0E ; Administratie ;
T1E ;Uw toegangscode : ;Uw initialen : ;
T2E ;Schermnummer : ;
T3E ;Goede morgen;Goede middag;Goede avond;, Data-M heet u welkom.;
 ;
 ; Toegangscontrole ?
1 S $ZT="^cA405",K="" I '($D(^cLOG(0,"MEMO"))#10) G YZ
11 S XQ=^("MEMO"),K=$O(@("^"_XQ_"UI2(K)")) G YZ:K=""
 ;
 ; Scherm vegen + boodschap
2 W /CUP(1,1),/ED
21 D B^cA612 I $D(^cLOG(0,"ADRES",0)) D
 . W /CUP(1,3),^(^(0),1) F I=2:1:5 W /CUP(I,3),^(I)
23 W /CUP(7,1),/cDR(1),/cDR(2,80),/cDR(0)
25 S I=$$SYSN^cQ5 D  I I=" " S I=$P($T(@("T0"_QT)),U,2)
 . I $E(I)'=" " S I=" "_I
 . I $E(I,$L(I))'=" " S I=I_" "
27 W /CUP(7,80-$L(I)\2),/SGR(7),I,/SGR(0)
29 W /CUP(1,60),$P($T(@("T2"_QT)),U,2),$J($I,3)
 ;
 ; 3 pogingen toegangscode
3 S T=0
31 S K="",T=T+1 G Y:T>3 I $I=1 S T=1
33 D ^cA106,^cA105 W /CUP(2,60),DT,"   ",TD
35 D  W /CUP(9,3),I,/WCML
 . S I=$S(TD<12:2,TD<18:3,1:4)
 . I $D(^cLOG(cs,"DESCRIPTION",$$CONFIG^cQ9,I-1,$E(QT_"N"))) S I=^($E(QT_"N")) Q
 . S I=$P($T(@("T3"_QT)),U,I)_$P($T(@("T3"_QT)),U,5)
37 S I=$P($T(@("T1"_QT)),U,2) W /CUP(T*2+9,3),I,/WCMD
39 D ^cAFA0(K,T*2+9,$L(I)+3,8,7,27,60,1,0) I RK=27 S K="-"
 ;
 ; geldige code ?
4 G 31:'$L(K),Y:K="-" D S5^cA511 G 31:'$L(K) S I=0,J=""
41 S J=$O(@("^"_XQ_"UI2(K,J)")) I J'="" S I=I+1 G 41
43 G 31:'I I I=1 S J=$O(^(J)) G 6
 ;
 ; meerdere initialen met zelfde code
5 S T=0,J=K
51 S K="",T=T+1 G Y:T>3 I $I=1 S T=1
53 D ^cA106,^cA105 W /CUP(2,60),DT,"   ",TD
55 S I=$P($T(@("T1"_QT)),U,3) W /CUP(T*2+9,3),I,/WCMD
57 D ^cAFA0(K,T*2+9,$L(I)+3,2,7,"",60,1,0)
59 G 51:K="",51:'$D(@("^"_XQ_"UI2(J,K)")) S J=K
 ;
 ; initialen : Q-waarde, menu, prioriteiten, taalcode
6 G Y:J="",Y:'$D(@("^"_XQ_"UI1(J)")) S I=^(J),K=@("^"_XQ_"UI(I,0)")
61 G Y:$P(K,D,20) S I=Q,J=QM
63 I $P(K,D,18)?1.3U S Q=$P(K,D,18) I '$D(@("^"_Q_"BA(99,1)")) S Q=I,K=0 G YY
65 I $P(K,D,19)?1.3N S QM=$P(K,D,19) I '$D(@("^"_Q_"BA(""MENU"",QM,0)")) S Q=I,QM=J,K=0 G YY
67 S QN=@("^"_Q_"BA(99,1)"),QL=$P(K,D,16),QU=$P(K,D),QT=$TR($P(K,D,9),"N"),QTU=$S($L(QT):$F("FDE",QT),1:1)
69 S K=0 G YY
 ;
Y S K=1 ;no access
YY D C^cA612
YZ K I,J,T,XQ Q
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84