XUVERIFY ;SF/MUS - Checks a users ACCESS and VERIFY CODES ;11/23/2004 14:43
;;8.0;KERNEL;**2,26,59,265**;Jul 10, 1995
; The variables % and %DUZ must be set before running this
; program % - may equal "A","V" OR both "AV"
; %DUZ - must equal the users DUZ
;
; After the program is run % will return -1,0,1,2
; if %=-1 an "^" was entered if %=0 an "?" was entered
; if %=1 the Code typed was correct
; if %=2 the Code was typed incorrectly
; IA# 10051
N %AC,%VC,%R,I,X,Y,Z,XUSTMP D DIALOG
I '$D(%)!'$D(%DUZ) S %=2 G KIL
I '$D(^VA(200,%DUZ,0)) S %=2 G KIL
G:%["A"!(%["V") CHECK S %=2 G KIL
CHECK S %R=$S(%="V":"VER",1:"ACC") D @%R
I X["^" S %=-1
I X?1.4"?" S %=0
KIL X ^%ZOSF("EON") K X,Y,Z,%AC,%VC,%R,I
Q
ACC ;Access code
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
I %AC'=$P(^VA(200,%DUZ,0),"^",3) S %AC=2 D:%["V" VER S %=%AC Q
S %AC=1 D:%["V" VER S:%'=2 %=%AC
Q
;
VER ;Verify code
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
I %VC'=$P(^VA(200,%DUZ,.1),"^",2) S %=2 Q
S %=1
Q
;
XUS2 ;MOVED FROM XUS2, TO CHECK OR RETURN USER ATTRIBUTES
S:$D(XUS)[0 XUS="" D USER:XUS["A",USER:$D(DUZ)[0,EDIT:XUS["E"
K XUS
Q
;
USER ;ASK FOR USER ID, RETURN DUZ
N IEN,X2,XUF,XUFAC,XUSTMP S U="^" D DIALOG
S DUZ=0,DUZ(0)="",DUZ(1)="",XUF=0
X ^%ZOSF("EOFF") S X2=$$ASKAV^XUS
S IEN=$$CHKAV(X2)
I IEN>0 D DUZ^XUP(IEN)
X ^%ZOSF("EON")
D CHK^XM:DUZ
Q
;
EDIT ;
N XUC,DIE,DUZX,DR,D0,DA,DI,DIC,DQ
S XUC="",DIE="^VA(200,",DA=$S($D(DUZX):DUZX,1:DUZ) D AUTO^XUS2:XUS["G"
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")
D ^DIE
Q
;
CHKAV(AVCODE) ;EF. IA# 10051
;Return IEN of the AVcode if good.
N XUTT,XUF,XUSER,IEN,DUZ
S XUF=0,DUZ=$$CHECKAV^XUS(AVCODE)
I DUZ>0,$$UVALID^XUS()>0 S DUZ=0
Q DUZ
;
WITNESS(PREFIX,KEYS) ;EF. IA# 1513
;Return IEN of a person if they have A/V & KEYs.
; '^' out = -1, Fail = 0, OK IEN
N X2,IEN,CNT,EXIT,XUSTMP D DIALOG
S U="^",EXIT=0,IEN=0,CNT=$P(^XTV(8989.3,1,"XUS"),U,2) ;# attemps
X ^%ZOSF("EOFF")
I $D(PREFIX) S:" "'[$E(PREFIX,$L(PREFIX)) PREFIX=PREFIX_" "
F CNT=1:1:CNT D Q:EXIT
. S X2=$$ASKAV^XUS($G(PREFIX))
. S IEN=$$CHKAV(X2),EXIT=(IEN>0) S:IEN<0 EXIT=1
. 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
. Q
X ^%ZOSF("EON")
Q:'EXIT 0 Q IEN
;
DIALOG ;Set up the dialog
S XUSTMP(51)=$$EZBLD^DIALOG(30810.51),XUSTMP(52)=$$EZBLD^DIALOG(30810.52)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUVERIFY 2615 printed Apr 09, 2024@21:09:50 Page 2
XUVERIFY ;SF/MUS - Checks a users ACCESS and VERIFY CODES ;11/23/2004 14:43
+1 ;;8.0;KERNEL;**2,26,59,265**;Jul 10, 1995
+2 ; The variables % and %DUZ must be set before running this
+3 ; program % - may equal "A","V" OR both "AV"
+4 ; %DUZ - must equal the users DUZ
+5 ;
+6 ; After the program is run % will return -1,0,1,2
+7 ; if %=-1 an "^" was entered if %=0 an "?" was entered
+8 ; if %=1 the Code typed was correct
+9 ; if %=2 the Code was typed incorrectly
+10 ; IA# 10051
+11 NEW %AC,%VC,%R,I,X,Y,Z,XUSTMP
DO DIALOG
+12 IF '$DATA(%)!'$DATA(%DUZ)
SET %=2
GOTO KIL
+13 IF '$DATA(^VA(200,%DUZ,0))
SET %=2
GOTO KIL
+14 if %["A"!(%["V")
GOTO CHECK
SET %=2
GOTO KIL
CHECK SET %R=$SELECT(%="V":"VER",1:"ACC")
DO @%R
+1 IF X["^"
SET %=-1
+2 IF X?1.4"?"
SET %=0
KIL XECUTE ^%ZOSF("EON")
KILL X,Y,Z,%AC,%VC,%R,I
+1 QUIT
ACC ;Access code
+1 XECUTE ^%ZOSF("EOFF")
WRITE !,XUSTMP(51)
SET X=$$ACCEPT^XUS
if X["^"!(X?1.4"?")
QUIT
if X?.E1L.E
DO LC^XUS
DO ^XUSHSH
SET %AC=X
+2 IF %AC'=$PIECE(^VA(200,%DUZ,0),"^",3)
SET %AC=2
if %["V"
DO VER
SET %=%AC
QUIT
+3 SET %AC=1
if %["V"
DO VER
if %'=2
SET %=%AC
+4 QUIT
+5 ;
VER ;Verify code
+1 XECUTE ^%ZOSF("EOFF")
WRITE !,XUSTMP(52)
SET X=$$ACCEPT^XUS
if X["^"!(X?1.4"?")
QUIT
if X?.E1L.E
DO LC^XUS
DO ^XUSHSH
SET %VC=X
+2 IF %VC'=$PIECE(^VA(200,%DUZ,.1),"^",2)
SET %=2
QUIT
+3 SET %=1
+4 QUIT
+5 ;
XUS2 ;MOVED FROM XUS2, TO CHECK OR RETURN USER ATTRIBUTES
+1 if $DATA(XUS)[0
SET XUS=""
if XUS["A"
DO USER
if $DATA(DUZ)[0
DO USER
if XUS["E"
DO EDIT
+2 KILL XUS
+3 QUIT
+4 ;
USER ;ASK FOR USER ID, RETURN DUZ
+1 NEW IEN,X2,XUF,XUFAC,XUSTMP
SET U="^"
DO DIALOG
+2 SET DUZ=0
SET DUZ(0)=""
SET DUZ(1)=""
SET XUF=0
+3 XECUTE ^%ZOSF("EOFF")
SET X2=$$ASKAV^XUS
+4 SET IEN=$$CHKAV(X2)
+5 IF IEN>0
DO DUZ^XUP(IEN)
+6 XECUTE ^%ZOSF("EON")
+7 if DUZ
DO CHK^XM
+8 QUIT
+9 ;
EDIT ;
+1 NEW XUC,DIE,DUZX,DR,D0,DA,DI,DIC,DQ
+2 SET XUC=""
SET DIE="^VA(200,"
SET DA=$SELECT($DATA(DUZX):DUZX,1:DUZ)
if XUS["G"
DO AUTO^XUS2
+3 SET DR=".01;2"_$SELECT(XUS["M"&$LENGTH(XUC):"///"_XUC,1:"")_";11"_$SELECT(XUS["M":";1;3:9;12:20;200:201",1:";1;13")
+4 DO ^DIE
+5 QUIT
+6 ;
CHKAV(AVCODE) ;EF. IA# 10051
+1 ;Return IEN of the AVcode if good.
+2 NEW XUTT,XUF,XUSER,IEN,DUZ
+3 SET XUF=0
SET DUZ=$$CHECKAV^XUS(AVCODE)
+4 IF DUZ>0
IF $$UVALID^XUS()>0
SET DUZ=0
+5 QUIT DUZ
+6 ;
WITNESS(PREFIX,KEYS) ;EF. IA# 1513
+1 ;Return IEN of a person if they have A/V & KEYs.
+2 ; '^' out = -1, Fail = 0, OK IEN
+3 NEW X2,IEN,CNT,EXIT,XUSTMP
DO DIALOG
+4 ;# attemps
SET U="^"
SET EXIT=0
SET IEN=0
SET CNT=$PIECE(^XTV(8989.3,1,"XUS"),U,2)
+5 XECUTE ^%ZOSF("EOFF")
+6 IF $DATA(PREFIX)
if " "'[$EXTRACT(PREFIX,$LENGTH(PREFIX))
SET PREFIX=PREFIX_" "
+7 FOR CNT=1:1:CNT
Begin DoDot:1
+8 SET X2=$$ASKAV^XUS($GET(PREFIX))
+9 SET IEN=$$CHKAV(X2)
SET EXIT=(IEN>0)
if IEN<0
SET EXIT=1
+10 IF IEN>0
IF $LENGTH($GET(KEYS))
SET EXIT=0
FOR %=1:1
SET X=$PIECE(KEYS,"^",%)
if X=""
QUIT
if $DATA(^XUSEC(X,IEN))
SET EXIT=1
+11 QUIT
End DoDot:1
if EXIT
QUIT
+12 XECUTE ^%ZOSF("EON")
+13 if 'EXIT
QUIT 0
QUIT IEN
+14 ;
DIALOG ;Set up the dialog
+1 SET XUSTMP(51)=$$EZBLD^DIALOG(30810.51)
SET XUSTMP(52)=$$EZBLD^DIALOG(30810.52)
