source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUVERIFY.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1XUVERIFY ;SF/MUS - Checks a users ACCESS and VERIFY CODES ;11/23/2004 14:43
2 ;;8.0;KERNEL;**2,26,59,265**;Jul 10, 1995
3 ; The variables % and %DUZ must be set before running this
4 ; program % - may equal "A","V" OR both "AV"
5 ; %DUZ - must equal the users DUZ
6 ;
7 ; After the program is run % will return -1,0,1,2
8 ; if %=-1 an "^" was entered if %=0 an "?" was entered
9 ; if %=1 the Code typed was correct
10 ; if %=2 the Code was typed incorrectly
11 ; IA# 10051
12 N %AC,%VC,%R,I,X,Y,Z,XUSTMP D DIALOG
13 I '$D(%)!'$D(%DUZ) S %=2 G KIL
14 I '$D(^VA(200,%DUZ,0)) S %=2 G KIL
15 G:%["A"!(%["V") CHECK S %=2 G KIL
16CHECK S %R=$S(%="V":"VER",1:"ACC") D @%R
17 I X["^" S %=-1
18 I X?1.4"?" S %=0
19KIL X ^%ZOSF("EON") K X,Y,Z,%AC,%VC,%R,I
20 Q
21ACC ;Access code
22 X ^%ZOSF("EOFF") W !,XUSTMP(51) S X=$$ACCEPT^XUS Q:X["^"!(X?1.4"?") D LC^XUS:X?.E1L.E,^XUSHSH S %AC=X
23 I %AC'=$P(^VA(200,%DUZ,0),"^",3) S %AC=2 D:%["V" VER S %=%AC Q
24 S %AC=1 D:%["V" VER S:%'=2 %=%AC
25 Q
26 ;
27VER ;Verify code
28 X ^%ZOSF("EOFF") W !,XUSTMP(52) S X=$$ACCEPT^XUS Q:X["^"!(X?1.4"?") D LC^XUS:X?.E1L.E,^XUSHSH S %VC=X
29 I %VC'=$P(^VA(200,%DUZ,.1),"^",2) S %=2 Q
30 S %=1
31 Q
32 ;
33XUS2 ;MOVED FROM XUS2, TO CHECK OR RETURN USER ATTRIBUTES
34 S:$D(XUS)[0 XUS="" D USER:XUS["A",USER:$D(DUZ)[0,EDIT:XUS["E"
35 K XUS
36 Q
37 ;
38USER ;ASK FOR USER ID, RETURN DUZ
39 N IEN,X2,XUF,XUFAC,XUSTMP S U="^" D DIALOG
40 S DUZ=0,DUZ(0)="",DUZ(1)="",XUF=0
41 X ^%ZOSF("EOFF") S X2=$$ASKAV^XUS
42 S IEN=$$CHKAV(X2)
43 I IEN>0 D DUZ^XUP(IEN)
44 X ^%ZOSF("EON")
45 D CHK^XM:DUZ
46 Q
47 ;
48EDIT ;
49 N XUC,DIE,DUZX,DR,D0,DA,DI,DIC,DQ
50 S XUC="",DIE="^VA(200,",DA=$S($D(DUZX):DUZX,1:DUZ) D AUTO^XUS2:XUS["G"
51 S DR=".01;2"_$S(XUS["M"&$L(XUC):"///"_XUC,1:"")_";11"_$S(XUS["M":";1;3:9;12:20;200:201",1:";1;13")
52 D ^DIE
53 Q
54 ;
55CHKAV(AVCODE) ;EF. IA# 10051
56 ;Return IEN of the AVcode if good.
57 N XUTT,XUF,XUSER,IEN,DUZ
58 S XUF=0,DUZ=$$CHECKAV^XUS(AVCODE)
59 I DUZ>0,$$UVALID^XUS()>0 S DUZ=0
60 Q DUZ
61 ;
62WITNESS(PREFIX,KEYS) ;EF. IA# 1513
63 ;Return IEN of a person if they have A/V & KEYs.
64 ; '^' out = -1, Fail = 0, OK IEN
65 N X2,IEN,CNT,EXIT,XUSTMP D DIALOG
66 S U="^",EXIT=0,IEN=0,CNT=$P(^XTV(8989.3,1,"XUS"),U,2) ;# attemps
67 X ^%ZOSF("EOFF")
68 I $D(PREFIX) S:" "'[$E(PREFIX,$L(PREFIX)) PREFIX=PREFIX_" "
69 F CNT=1:1:CNT D Q:EXIT
70 . S X2=$$ASKAV^XUS($G(PREFIX))
71 . S IEN=$$CHKAV(X2),EXIT=(IEN>0) S:IEN<0 EXIT=1
72 . I IEN>0,$L($G(KEYS)) S EXIT=0 F %=1:1 S X=$P(KEYS,"^",%) Q:X="" S:$D(^XUSEC(X,IEN)) EXIT=1
73 . Q
74 X ^%ZOSF("EON")
75 Q:'EXIT 0 Q IEN
76 ;
77DIALOG ;Set up the dialog
78 S XUSTMP(51)=$$EZBLD^DIALOG(30810.51),XUSTMP(52)=$$EZBLD^DIALOG(30810.52)
Note: See TracBrowser for help on using the repository browser.