cA515 ;Toegangscontrole ;%A515 ;Do uit Menu ; [ 02/21/00  3:29 PM ]
 ;
T0 ; Toonbankadministratie ;
T1 ;Uw toegangscode : ;Uw initialen : ;
 ;
T0F ; Administration ;
T1F ;Votre code d'accès : ;Vos initiales : ;
 ;
T0E ; Toonbankadministratie ;
T1E ;Uw toegangscode : ;Uw initialen : ;
 ;
 ; Toegangscontrole ?
1 S $ZT="^cA405",K="" I '($D(^cLOG(0,"MEMO"))#10) G YZ
11 N R S XQ=^("MEMO"),K=$O(^INDEX(0,"USR",117,"")) G YZ:K=""
 S io=$G(io,$$IO^cQ5)
 ;
 ; Scherm vegen + boodschap
2 ;
 ; 3 pogingen toegangscode
3 S T=0
31 S K="",T=T+1 G Y:T>3 I $I=1 S T=1
37 I '$P($G(^cLOG(boot,"DAM",1)),D) G 39
 ; nieuwe log-in procedure
 S K=$$^cA5001(17,3,1)
 I '$L(K)!(K="-") S K=1 G YZ  ; toegang geweigerd
 S Q=$P(K,D),QM=$P(K,D,2),QN=$P(K,D,3),QU=$P(K,D,4),QT=$P(K,D,5),QTU=$P(K,D,6),(I,QU(1))=$P(K,D,7),QU(2)=$P(K,D,8)
 D USR^cA5000(QU)
 G 8
 ;
39 S I=$P($T(@("T1"_QT)),U,2) W /CUP(22,3),I,/WCMD
 D ^cAFA0(K,22,$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=K_" "
41 S J=$O(^INDEX(0,"USR",117,J)) I $L(J),$P(J," ")=K S I=I+1 G 41
43 G 31:'I I I=1 S J=K_" ",J=$O(^(J)),I=^(J) G 7
 ;
 ; 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
55 S I=$P($T(@("T1"_QT)),U,3) W /CUP(22,3),I,/WCMD
57 D ^cAFA0(K,22,$L(I)+3,2,7,"",60,1,0)
59 G 51:K=""
 ;
 ; geldige initialen I ?
6 S K=$$DI^cAN000(K,""),I=$O(^INDEX(0,"USR",101,K)) G 51:$E(I,1,$L(K))'=K
61 S I=^(I) G 51:I="",51:$P($G(^DATA(0,"USR",I,0)),D,17)'=J
 ;
 ; initialen & taalcode
7 G Y:I="",Y:'$D(^DATA(0,"USR",I,0)) S K=^(0) G Y:$P(K,D,30)
71 S I=Q,J=QM
73 ; Q-waarde
75 ; QM-waarde
77 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)
 ;
 ; koppeling memo's
8 S @("^"_XQ_"MEMO(0,""DI"",boot,io)")=QU,UCI="MGR",UCI2=$ZU($ZV'["MSM"*5)
 D UCI K ^cLOG(boot,"MS",io) S UCI=UCI2 D UCI
81 I $D(@("^"_XQ_"MEMO(0,""IN"",QU)")) S K=^(QU),UCI="MGR",UCI2=$ZU($ZV'["MSM"*5)
 D UCI S ^cLOG(boot,"MS",io)=K S UCI=UCI2 D UCI
83 S K=0 G YY
 ;
Y S K=1 ;no access
YY ;
YZ K I,J,T,UCI,UCI2,XQ Q
 ;
UCI I $ZV["MSM" D INT^cQMSMSW
 Q
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84