cA5000SC ;Toegangscontrole ;%A5000 ;Do uit TTSC ; [ 12/29/00  11:22 AM ]
 ;
T0 ; Administratie ;
T1 ;Code : ;Initialen : ;
T2 ;Poort;Job;
 ;
T0F ; Administration ;
T1F ;Code : ;Initiales : ;
T2F ;Porte;Job;
 ;
T0E ; Administration ;
T1E ;Code : ;Initials : ;
T2E ;Port ;Job ;
 ;
 ; Initialisatie
1 S $ZT="^cA405SC"
 ;
 ; Scherm vegen + boodschap
2 W /CUP(1,1),/ED
21 D O^cA612(1,1,8,20,0,1,1,1)
23 W /CUP(3,1),/cDR(1),/cDR(2,20),/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(3,1),/CUP(3,20-$L(I)\2),/SGR(7),I,/SGR(0)
29 W /CUP(1,1),$P($T(@("T2"_QT)),U,2),$J($G(io,$$IO^cQ5),5)
 W /CUP(2,1),$P($T(@("T2"_QT)),U,3),$J($J,7)
 ;
 ; 3 pogingen toegangscode
3 S T=0
 I '$L($G(Q)) S Q="DAM"
 S %Q1="^"_Q_"BA(""%1"",$I)",@%Q1=1
31 S K="",T=T+1 G Y:T>3 I $I=1 S T=1
33 D ^cA106,^cA105 W /CUP(1,12)," ",DT,/CUP(2,12),"  ",TD
37 I '$P($G(^cLOG(boot,"DAM",1)),D) G 39
 ; nieuwe log-in procedure
 S K=$$^cA5001(4,2,"","",1)
 I '$L(K)!(K="-") S K=1 G YZ  ; toegang geweigerd
 K @%Q1
 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)
 S %Q1="^"_Q_"BA(""%1"",$I)",@%Q1=1           
 D USR^cA5000(QU)
 I $P($G(QU(0,2)),D,26) S QZ=$P(QU(0,2),D,26)
 G 7
 ;
39 S I=$P($T(@("T1"_QT)),U,2) W /CUP(T+3,2),I,/WCMD
 D ^cAFA0(K,T+3,$L(I)+2,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 J
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,2),DT,"   ",TD
55 S I=$P($T(@("T1"_QT)),U,3) W /CUP(T+3,2),I,/WCMD
57 D ^cAFA0(K,T+3,$L(I)+2,3,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 7^cA5000
 ;
Y S K=1 ;no access
YY D C^cA612
YZ K I,J,T Q
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84