cA5000 ;Toegangscontrole ;%A5000 ;Do uit IINT ; [ 03/15/01  4:22 PM ]
 ;
T0 ; Administratie ;
T1 ;Uw toegangscode : ;Uw initialen : ;
T2 ;Poort;Job;
T3 ;Goede morgen;Goede middag;Goede avond;, Data-M heet u welkom.;
 ;
T0F ; Administration ;
T1F ;Votre code d'accès : ;Vos initiales : ;
T2F ;Porte;Job;
T3F ;Bonjour;Bon après-midi;Bonsoir;, Data-M vous souhaite la bienvenue.;
 ;
T0E ; Administration ;
T1E ;Your password : ;Your initials : ;
T2E ;Port ;Job;
T3E ;Good morning;Good afternoon;Good evening;, Data-M welcomes you;
 ;
 ; Initialisatie
1 S $ZT="TRAP^cAN000"
 ;
 ; Scherm vegen + boodschap
2 W /CUP(1,1),@F1
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),@F5,$P($T(@("T2"_QT)),U,2),$J($G(io,$$IO^cQ5),5),@F2
 W /CUP(2,60),@F5,$P($T(@("T2"_QT)),U,3),$J($J,7),@F2
 ;
 ; 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,72)," ",DT,/CUP(2,72),"  ",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 I '$P($G(^cLOG(boot,"DAM",1)),D) G 39
 ; nieuwe log-in procedure
 S K=$$^cA5001(11,3)
 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)
 ; indien Caché : naar de juiste namespace gaan
 I $ZV'["MSM",$L($P(K,D,9)) ZN $P(K,D,9)
 S %Q1="^"_Q_"BA(""%1"",$I)",@%Q1=1           
 D USR(QU)
 I $P($G(QU(0,2)),D,26) S QZ=$P(QU(0,2),D,26)
 G 9
 ;
39 S I=$P($T(@("T1"_QT)),U,2) W /CUP(T*2+9,3),I,/WCMD
 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=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,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,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 9:$P($G(^cLOG(boot,"DAM",1)),D),Y:I="",Y:'$D(^DATA(0,"USR",I,0)) S K=^(0) G Y:$P(K,D,30)
71 S QU=$P(K,D),QU(1)=I,QU(2)=$P(K,D,2),QT=$TR($P(K,D,9),"N"),QTU=$S($L(QT):$F("FDE",QT),1:1)
 D USR(QU)
 I $P($G(QU(0,2)),D,26) S QZ=$P(QU(0,2),D,26)
73 I QU="" G Y
 ;
 ; login afh. van systeem
8 S J=I_" ",(Q,QM,QN)=""
81 S J=$O(^DATA(0,"USR_SYS.QQM",J)) G Y:$P(J," ")'=I,81:'$D(^(J,0)),81:$P(^(0),D,30)
83 S T=$P(^(0),D,2) G 81:T="",81:'$D(^DATA(0,"SYS.QQM",T,0)),81:$P(^(0),D,30)
85 S Q=$P(^(0),D,2),QM=$P(^(0),D,3) G 81:Q="",81:QM=""
87 S T=$P(^(0),D) G 81:T="",81:'$D(^DATA(0,"SYS",T,0)),81:$P(^(0),D,30)
89 G 81:$P(^(0),D)'=$ZU($ZV'["MSM"*5),81:'$D(@("^"_Q_"BA(""MENU"",QM,0)")),81:'$D(@("^"_Q_"BA(99,1)")) S QN=^(1)
 ;
 ; prioriteiten
9 S J=I_" ",QL=""
91 S J=$O(^DATA(0,"USR_PRI",J)) G 99:$P(J," ")'=I,91:'$D(^(J,0)),91:$P(^(0),D,30)
93 S T=$P(^(0),D,2) G 91:T="",91:'$D(^DATA(0,"PRI",T,0)),91:$P(^(0),D,30)
95 S QL=QL_T_" " G 91
99 D  S K=0 G YY
 . S J=I_" "                   ; alle profielen per initialen
 . F  S J=$O(^DATA(0,"USR_PRO",J)) Q:$P(J," ")'=I  I $D(^(J,0)) D
 .. I $P(^(0),D,30) Q
 .. N II S II=$P(^(0),D,2) I II="" Q
 .. I '$D(^DATA(0,"PRO",II,0)) Q
 .. I $P(^(0),D,30) Q
 .. N JJ S JJ=II_" "           ; alle prioriteiten per profiel
 .. F  S JJ=$O(^DATA(0,"PRO_PRI",JJ)) Q:$P(JJ," ")'=II  I $D(^(JJ,0)) D
 ... I $P(^(0),D,30) Q
 ... S T=$P(^(0),D,2) I T="" Q
 ... I '$D(^DATA(0,"PRI",T,0)) Q
 ... I $P(^(0),D,30) Q
 ... I " "_QL'[(" "_T_" ") S QL=QL_T_" "
 ;
Y S K=1 ;no access
YY I K'=1 D
 . D LOGJOB^cQ5
 . I $P($G(^cLOG(boot,"DAM",2)),D) D ^cAN325(QU)   ; printers
 . I $P($G(^cLOG(boot,"DAM",3)),D) D ^cAN3250(QU)  ; locaties
 . I $L($G(^DPAR(0,"X","LOGIN",0))) X ^(0)         ; LVH >> ^cUSER
 D C^cA612
YZ I K D OUT^cA5001 K @%Q1
 K I,J,T Q
 ;
USR(INI) ; ophalen gegevens USR en wegschrijven in QU
 I '$L(INI) Q
 N UQC,USC,K,I
 K QU(0),QU(1),QU(2)
 D DMS^cAN000("UQC","USC","USR",1) I '$L(UQC)!'$L(USC) Q
 S K=$$UI1^cAFA1("USR",101,INI) I '$L(K) Q
 S QU(0,1)=$$SIGN^cAFA1("USR",K,0)
 F I=1:1:9 I $D(^(I)) S QU(0,I+1)=^(I)
 S QU=INI,QU(1)=K,QU(2)=$P(QU(0,1),D,2)
 Q
 ;
ZZ ; 30.03.01 - 13 u 39 * V7.85