XUS2 ;SF/RWF - TO CHECK OR RETURN USER ATTRIBUTES ;2/1/2012
;;8.0;KERNEL;**59,180,313,419,437,574**;Jul 10, 1995;Build 5
;Per VHA Directive 2004-038, this routine should not be modified
Q
;
ACCED ; ACCESS CODE EDIT from DD
I "Nn"[$E(X,1) S X="" Q
I "Yy"'[$E(X,1) K X Q
N DIR,DIR0,XUAUTO,XUK
S XUAUTO=($P($G(^XTV(8989.3,1,3)),U,1)="y"),XUH=""
AC1 D CLR,AAUTO:XUAUTO,AASK:'XUAUTO G OUT:$D(DIRUT) D REASK G OUT:$D(DIRUT),AC1:'XUK D CLR,AST(XUH)
G OUT
;
AASK ;Ask for Access code
N X,XUU,XUEX X ^%ZOSF("EOFF")
S XUEX=0
F D AASK1 Q:XUEX!($D(DIRUT))
Q
;
AASK1 ;
W "Enter a new ACCESS CODE <Hidden>: " D GET Q:$D(DIRUT)
I X="@" D DEL D:Y'=1 DIRUT S XUH="",XUEX=1 Q
I X[$C(34)!(X[";")!(X["^")!(X[":")!(X'?.UNP)!($L(X)>20)!($L(X)<6)!(X="MAIL-BOX") D CLR W $C(7),$$AVHLPTXT(1) D AHELP Q
I 'XUAUTO,((X?6.20A)!(X?6.20N)) D CLR W $C(7),$$AVHLPTXT(1),! Q
S XUU=X,X=$$EN^XUSHSH(X),XUH=X,XMB(1)=$O(^VA(200,"A",XUH,0)) I XMB(1),XMB(1)'=DA S XMB="XUS ACCESS CODE VIOLATION",XMB(1)=$P(^VA(200,XMB(1),0),"^"),XMDUN="Security" D ^XMB
I $D(^VA(200,"AOLD",XUH))!$D(^VA(200,"A",XUH)) D CLR W $C(7),"This has been used previously as an ACCESS CODE.",! Q
S XUEX=1 ;Now we can quit
Q
;
REASK S XUK=1 Q:XUH="" D CLR X ^%ZOSF("EOFF")
F XUK=3:-1:1 W "Please re-type the new code to show that I have it right: " D GET G:$D(DIRUT) DIRUT D ^XUSHSH Q:(XUH=X) D CLR W "This doesn't match. Try again!",!,$C(7)
S:XUH'=X XUK=0
Q
;
AST(XUH) ;Change ACCESS CODE and index.
W "OK, Access code has been changed!"
N FDA,IEN,ERR
S IEN=DA_","
S FDA(200,IEN,2)=XUH D FILE^DIE("","FDA","ERR")
W !,"The VERIFY CODE has been deleted as a security measure.",!,"You will need to enter a new VERIFY code so the user can sign-on.",$C(7)
D VST("",1)
I $D(^XMB(3.7,DA,0))[0 S Y=DA D NEW^XM ;Make sure has a Mailbox
Q
;
GET ;Get the user input and convert case.
S X=$$ACCEPT^XUS I (X["^")!('$L(X)) D DIRUT
S X=$$UP^XLFSTR(X)
Q
;
DIRUT S DIRUT=1
Q
;
CLR ;New line or Clear screenman area
I '$D(DDS) W ! Q
N DX,DY
D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X IOXY
Q
;
NEWCODE D REASK I XUK W !,"OK, remember this code for next time!"
G OUT
;
CVC ;From XUS1
N DA,X
S DA=DUZ,X="Y"
W !,"You must change your VERIFY CODE at this time."
;Fall into next code
VERED ; VERIFY CODE EDIT From DD
N DIR,DIR0,XUAUTO,XUSVCMIN,XUSVCACCT S XUSVCACCT=$$SVCACCT(DA),XUSVCMIN=$S(+XUSVCACCT:12,1:8)
I "Nn"[$E(X,1) S X="" Q
I "Yy"'[$E(X,1) K X Q
S XUH="",XUAUTO=($P($G(^XTV(8989.3,1,3)),U,3)="y") S:DUZ=DA XUAUTO="n" ;Auto only for admin
VC1 D CLR,VASK:'XUAUTO,VAUTO:XUAUTO G OUT:$D(DIRUT) D REASK G OUT:$D(DIRUT),VC1:'XUK D CLR,VST(XUH,1)
D CALL^XUSERP(DA,2)
G OUT
;
VASK ;Ask for Verify Code
N X,XUU X ^%ZOSF("EOFF") G:'$$CHKCUR() DIRUT D CLR
VASK1 W "Enter a new VERIFY CODE: " D GET Q:$D(DIRUT)
I '$D(XUNC),(X="@") D DEL G:Y'=1 DIRUT S XUH="" Q
D CLR S XUU=X,X=$$EN^XUSHSH(X),XUH=X,Y=$$VCHK(XUU,XUH) I +Y W $C(7),$P(Y,U,2,9),! D:+Y=1 VHELP G VASK1
Q
;
VCHK(S,EC) ;Call with String and Encrypted versions
;Updated per VHA directive 6210 Strong Passwords
N PUNC,NA,XUPAT S PUNC="~`!@#$%&*()_-+=|\{}[]'<>,.?/"
S NA("FILE")=200,NA("FIELD")=.01,NA("IENS")=DA_",",NA=$$HLNAME^XLFNAME(.NA),XUPAT=XUSVCMIN_".20"
I ($L(S)<XUSVCMIN)!($L(S)>20)!(S'?.UNP)!(S[";")!(S["^")!(S[":") Q "1^"_$$AVHLPTXT
I (S?@(XUPAT_"A"))!(S?@(XUPAT_"N"))!(S?@(XUPAT_"P"))!(S?@(XUPAT_"AN"))!(S?@(XUPAT_"AP"))!(S?@(XUPAT_"NP")) Q "2^VERIFY CODE must be a mix of alpha and numerics and punctuation."
I $D(^VA(200,DA,.1)),EC=$P(^(.1),U,2) Q "3^This code is the same as the current one."
I $D(^VA(200,DA,"VOLD",EC)) Q "4^This has been used previously as the VERIFY CODE."
I EC=$P(^VA(200,DA,0),U,3) Q "5^VERIFY CODE must be different than the ACCESS CODE."
I S[$P(NA,"^")!(S[$P(NA,"^",2)) Q "6^Name cannot be part of code."
Q 0
;
VST(XUH,%) ;
W:$L(XUH)&% !,"OK, Verify code has been changed!"
N FDA,IEN,ERR S IEN=DA_","
S:XUH="" XUH="@" ;11.2 get triggerd
S FDA(200,IEN,11)=XUH D FILE^DIE("","FDA","ERR")
I $D(ERR) D ^%ZTER
I (DUZ'=(+IEN))&$$SVCACCT(+IEN)&(XUH'="@") D ;override trigger of 11.2 by 11 for svc accts
.K FDA,ERR S FDA(200,IEN,11.2)=$H D FILE^DIE("","FDA","ERR")
.I $D(ERR) D ^%ZTER
S:DA=DUZ DUZ("NEWCODE")=XUH Q
;
DEL ;
X ^%ZOSF("EON") W $C(7) S DIR(0)="Y",DIR("A")="Sure you want to delete" D ^DIR I Y'=1 W:$X>55 !?9 W $C(7)," <Nothing Deleted>"
Q
;
AAUTO ;Auto-get Access codes
N XUK,Y
X ^%ZOSF("EON") F XUK=1:1:3 D AGEN Q:(Y=1)!($D(DIRUT))
Q
;
AGEN ;Generate a ACCESS code
S XUU=$$AC^XUS4 S (X,XUH)=$$EN^XUSHSH(XUU) I $D(^VA(200,"A",X))!$D(^VA(200,"AOLD",X)) G AGEN
D CLR W "The new ACCESS CODE is: ",XUU," This is ",XUK," of 3 tries."
D YN
Q
;
AHELP S XUU=$$AC^XUS4 S X=$$EN^XUSHSH(XUU) I $D(^VA(200,"A",X))!$D(^VA(200,"AOLD",X)) G AHELP
W !,"Here is an example of an acceptable Access Code: ",XUU,!
Q
;
VHELP S XUU=$$VC^XUS4 S X=$$EN^XUSHSH(XUU) I ($P($G(^VA(200,DA,0)),U,3)=X)!$D(^VA(200,DA,"VOLD",X)) G VHELP
W !,"Here is an example of an acceptable Verify Code: ",XUU,!
Q
;
VAUTO ;Auto-get Access codes
N XUK
X ^%ZOSF("EON") F XUK=1:1:3 D VGEN Q:(Y=1)!($D(DIRUT))
Q
;
VGEN ;Generate a VERIFY code
S XUU=$$VC^XUS4 S (X,XUH)=$$EN^XUSHSH(XUU) I ($P($G(^VA(200,DA,0)),U,3)=X)!$D(^VA(200,DA,"VOLD",X)) G VGEN
D CLR W "The new VERIFY CODE is: ",XUU," This is ",XUK," of 3 tries."
D YN
Q
YN ;Ask if want to keep
N DIR
S Y=1,DIR(0)="YA",DIR("A")=" Do you want to keep this one? ",DIR("B")="YES",DIR("?",1)="If you don't like this code, we can auto-generate another.",DIR("?")="Remember you only get 3 tries!"
S:XUK=3 DIR("A")="This is your final choice. "_DIR("A")
D ^DIR Q:(Y=1)!$D(DIRUT) I XUK=2 W !,"O.K. You'll have to keep the next one!",! H 2
I (XUK=3)&(Y'=1) W !,"Lets stop and you can try later." H 3 D DIRUT
D CLR
Q
;
OUT ;
K DUOUT S:$D(DIRUT) DUOUT=1
X ^%ZOSF("EON") W !
K DIR,DIRUT,XUKO,XUAUTO,XUU,XUH,XUK,XUI S X=""
Q
;
CHKCUR() ;Check user knows current code, Return 1 if OK to continue
Q:DA'=DUZ 1 ;Only ask user
Q:$P($G(^VA(200,DA,.1)),U,2)="" 1 ;Must have an old one
S XUK=0 D CLR
CHK1 W "Please enter your CURRENT verify code: " D GET Q:$D(DIRUT) 0
I $P(^VA(200,DA,.1),U,2)=$$EN^XUSHSH(X) Q 1
D CLR W "Sorry that is not correct!",!
S XUK=XUK+1 G:XUK<3 CHK1
Q 0
;
BRCVC(XV1,XV2) ;Broker change VC, return 0 if good, '1^msg' if bad.
N XUU,XUH,XUSVCMIN S XUSVCMIN=8
Q:$G(DUZ)'>0 "1^Bad DUZ" S DA=DUZ,XUH=$$EN^XUSHSH(XV2)
I $P($G(^VA(200,DUZ,.1)),"^",2)'=$$EN^XUSHSH(XV1) Q "1^Sorry that isn't the correct current code"
S Y=$$VCHK(XV2,XUH) Q:Y Y
D VST(XUH,0),CALL^XUSERP(DA,2)
Q 0
;
SVCACCT(XUSDUZ) ;return 1^CONNECTOR PROXY if CP svc acct; 0 if not svc acct
Q:$$ISUSERCP^XUSAP1(XUSDUZ) "1^CONNECTOR PROXY"
Q 0
;
AVHLPTXT(%) ;
Q "Enter "_$S($G(%):"6-20",+$G(XUSVCMIN):XUSVCMIN_"-20",1:"8-20")_" characters mixed alphanumeric and punctuation (except '^', ';', ':')"
;
;Left over code, Don't think it is called anymore.
G XUS2^XUVERIFY ;All check or return user attributes moved to XUVERIFY
USER G USER^XUVERIFY
EDIT G EDIT^XUVERIFY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUS2 7176 printed Oct 16, 2024@18:12:42 Page 2
XUS2 ;SF/RWF - TO CHECK OR RETURN USER ATTRIBUTES ;2/1/2012
+1 ;;8.0;KERNEL;**59,180,313,419,437,574**;Jul 10, 1995;Build 5
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
ACCED ; ACCESS CODE EDIT from DD
+1 IF "Nn"[$EXTRACT(X,1)
SET X=""
QUIT
+2 IF "Yy"'[$EXTRACT(X,1)
KILL X
QUIT
+3 NEW DIR,DIR0,XUAUTO,XUK
+4 SET XUAUTO=($PIECE($GET(^XTV(8989.3,1,3)),U,1)="y")
SET XUH=""
AC1 DO CLR
if XUAUTO
DO AAUTO
if 'XUAUTO
DO AASK
if $DATA(DIRUT)
GOTO OUT
DO REASK
if $DATA(DIRUT)
GOTO OUT
if 'XUK
GOTO AC1
DO CLR
DO AST(XUH)
+1 GOTO OUT
+2 ;
AASK ;Ask for Access code
+1 NEW X,XUU,XUEX
XECUTE ^%ZOSF("EOFF")
+2 SET XUEX=0
+3 FOR
DO AASK1
if XUEX!($DATA(DIRUT))
QUIT
+4 QUIT
+5 ;
AASK1 ;
+1 WRITE "Enter a new ACCESS CODE <Hidden>: "
DO GET
if $DATA(DIRUT)
QUIT
+2 IF X="@"
DO DEL
if Y'=1
DO DIRUT
SET XUH=""
SET XUEX=1
QUIT
+3 IF X[$CHAR(34)!(X[";")!(X["^")!(X[":")!(X'?.UNP)!($LENGTH(X)>20)!($LENGTH(X)<6)!(X="MAIL-BOX")
DO CLR
WRITE $CHAR(7),$$AVHLPTXT(1)
DO AHELP
QUIT
+4 IF 'XUAUTO
IF ((X?6.20A)!(X?6.20N))
DO CLR
WRITE $CHAR(7),$$AVHLPTXT(1),!
QUIT
+5 SET XUU=X
SET X=$$EN^XUSHSH(X)
SET XUH=X
SET XMB(1)=$ORDER(^VA(200,"A",XUH,0))
IF XMB(1)
IF XMB(1)'=DA
SET XMB="XUS ACCESS CODE VIOLATION"
SET XMB(1)=$PIECE(^VA(200,XMB(1),0),"^")
SET XMDUN="Security"
DO ^XMB
+6 IF $DATA(^VA(200,"AOLD",XUH))!$DATA(^VA(200,"A",XUH))
DO CLR
WRITE $CHAR(7),"This has been used previously as an ACCESS CODE.",!
QUIT
+7 ;Now we can quit
SET XUEX=1
+8 QUIT
+9 ;
REASK SET XUK=1
if XUH=""
QUIT
DO CLR
XECUTE ^%ZOSF("EOFF")
+1 FOR XUK=3:-1:1
WRITE "Please re-type the new code to show that I have it right: "
DO GET
if $DATA(DIRUT)
GOTO DIRUT
DO ^XUSHSH
if (XUH=X)
QUIT
DO CLR
WRITE "This doesn't match. Try again!",!,$CHAR(7)
+2 if XUH'=X
SET XUK=0
+3 QUIT
+4 ;
AST(XUH) ;Change ACCESS CODE and index.
+1 WRITE "OK, Access code has been changed!"
+2 NEW FDA,IEN,ERR
+3 SET IEN=DA_","
+4 SET FDA(200,IEN,2)=XUH
DO FILE^DIE("","FDA","ERR")
+5 WRITE !,"The VERIFY CODE has been deleted as a security measure.",!,"You will need to enter a new VERIFY code so the user can sign-on.",$CHAR(7)
+6 DO VST("",1)
+7 ;Make sure has a Mailbox
IF $DATA(^XMB(3.7,DA,0))[0
SET Y=DA
DO NEW^XM
+8 QUIT
+9 ;
GET ;Get the user input and convert case.
+1 SET X=$$ACCEPT^XUS
IF (X["^")!('$LENGTH(X))
DO DIRUT
+2 SET X=$$UP^XLFSTR(X)
+3 QUIT
+4 ;
DIRUT SET DIRUT=1
+1 QUIT
+2 ;
CLR ;New line or Clear screenman area
+1 IF '$DATA(DDS)
WRITE !
QUIT
+2 NEW DX,DY
+3 DO CLRMSG^DDS
SET DX=0
SET DY=DDSHBX+1
XECUTE IOXY
+4 QUIT
+5 ;
NEWCODE DO REASK
IF XUK
WRITE !,"OK, remember this code for next time!"
+1 GOTO OUT
+2 ;
CVC ;From XUS1
+1 NEW DA,X
+2 SET DA=DUZ
SET X="Y"
+3 WRITE !,"You must change your VERIFY CODE at this time."
+4 ;Fall into next code
VERED ; VERIFY CODE EDIT From DD
+1 NEW DIR,DIR0,XUAUTO,XUSVCMIN,XUSVCACCT
SET XUSVCACCT=$$SVCACCT(DA)
SET XUSVCMIN=$SELECT(+XUSVCACCT:12,1:8)
+2 IF "Nn"[$EXTRACT(X,1)
SET X=""
QUIT
+3 IF "Yy"'[$EXTRACT(X,1)
KILL X
QUIT
+4 ;Auto only for admin
SET XUH=""
SET XUAUTO=($PIECE($GET(^XTV(8989.3,1,3)),U,3)="y")
if DUZ=DA
SET XUAUTO="n"
VC1 DO CLR
if 'XUAUTO
DO VASK
if XUAUTO
DO VAUTO
if $DATA(DIRUT)
GOTO OUT
DO REASK
if $DATA(DIRUT)
GOTO OUT
if 'XUK
GOTO VC1
DO CLR
DO VST(XUH,1)
+1 DO CALL^XUSERP(DA,2)
+2 GOTO OUT
+3 ;
VASK ;Ask for Verify Code
+1 NEW X,XUU
XECUTE ^%ZOSF("EOFF")
if '$$CHKCUR()
GOTO DIRUT
DO CLR
VASK1 WRITE "Enter a new VERIFY CODE: "
DO GET
if $DATA(DIRUT)
QUIT
+1 IF '$DATA(XUNC)
IF (X="@")
DO DEL
if Y'=1
GOTO DIRUT
SET XUH=""
QUIT
+2 DO CLR
SET XUU=X
SET X=$$EN^XUSHSH(X)
SET XUH=X
SET Y=$$VCHK(XUU,XUH)
IF +Y
WRITE $CHAR(7),$PIECE(Y,U,2,9),!
if +Y=1
DO VHELP
GOTO VASK1
+3 QUIT
+4 ;
VCHK(S,EC) ;Call with String and Encrypted versions
+1 ;Updated per VHA directive 6210 Strong Passwords
+2 NEW PUNC,NA,XUPAT
SET PUNC="~`!@#$%&*()_-+=|\{}[]'<>,.?/"
+3 SET NA("FILE")=200
SET NA("FIELD")=.01
SET NA("IENS")=DA_","
SET NA=$$HLNAME^XLFNAME(.NA)
SET XUPAT=XUSVCMIN_".20"
+4 IF ($LENGTH(S)<XUSVCMIN)!($LENGTH(S)>20)!(S'?.UNP)!(S[";")!(S["^")!(S[":")
QUIT "1^"_$$AVHLPTXT
+5 IF (S?@(XUPAT_"A"))!(S?@(XUPAT_"N"))!(S?@(XUPAT_"P"))!(S?@(XUPAT_"AN"))!(S?@(XUPAT_"AP"))!(S?@(XUPAT_"NP"))
QUIT "2^VERIFY CODE must be a mix of alpha and numerics and punctuation."
+6 IF $DATA(^VA(200,DA,.1))
IF EC=$PIECE(^(.1),U,2)
QUIT "3^This code is the same as the current one."
+7 IF $DATA(^VA(200,DA,"VOLD",EC))
QUIT "4^This has been used previously as the VERIFY CODE."
+8 IF EC=$PIECE(^VA(200,DA,0),U,3)
QUIT "5^VERIFY CODE must be different than the ACCESS CODE."
+9 IF S[$PIECE(NA,"^")!(S[$PIECE(NA,"^",2))
QUIT "6^Name cannot be part of code."
+10 QUIT 0
+11 ;
VST(XUH,%) ;
+1 if $LENGTH(XUH)&%
WRITE !,"OK, Verify code has been changed!"
+2 NEW FDA,IEN,ERR
SET IEN=DA_","
+3 ;11.2 get triggerd
if XUH=""
SET XUH="@"
+4 SET FDA(200,IEN,11)=XUH
DO FILE^DIE("","FDA","ERR")
+5 IF $DATA(ERR)
DO ^%ZTER
+6 ;override trigger of 11.2 by 11 for svc accts
IF (DUZ'=(+IEN))&$$SVCACCT(+IEN)&(XUH'="@")
Begin DoDot:1
+7 KILL FDA,ERR
SET FDA(200,IEN,11.2)=$HOROLOG
DO FILE^DIE("","FDA","ERR")
+8 IF $DATA(ERR)
DO ^%ZTER
End DoDot:1
+9 if DA=DUZ
SET DUZ("NEWCODE")=XUH
QUIT
+10 ;
DEL ;
+1 XECUTE ^%ZOSF("EON")
WRITE $CHAR(7)
SET DIR(0)="Y"
SET DIR("A")="Sure you want to delete"
DO ^DIR
IF Y'=1
if $X>55
WRITE !?9
WRITE $CHAR(7)," <Nothing Deleted>"
+2 QUIT
+3 ;
AAUTO ;Auto-get Access codes
+1 NEW XUK,Y
+2 XECUTE ^%ZOSF("EON")
FOR XUK=1:1:3
DO AGEN
if (Y=1)!($DATA(DIRUT))
QUIT
+3 QUIT
+4 ;
AGEN ;Generate a ACCESS code
+1 SET XUU=$$AC^XUS4
SET (X,XUH)=$$EN^XUSHSH(XUU)
IF $DATA(^VA(200,"A",X))!$DATA(^VA(200,"AOLD",X))
GOTO AGEN
+2 DO CLR
WRITE "The new ACCESS CODE is: ",XUU," This is ",XUK," of 3 tries."
+3 DO YN
+4 QUIT
+5 ;
AHELP SET XUU=$$AC^XUS4
SET X=$$EN^XUSHSH(XUU)
IF $DATA(^VA(200,"A",X))!$DATA(^VA(200,"AOLD",X))
GOTO AHELP
+1 WRITE !,"Here is an example of an acceptable Access Code: ",XUU,!
+2 QUIT
+3 ;
VHELP SET XUU=$$VC^XUS4
SET X=$$EN^XUSHSH(XUU)
IF ($PIECE($GET(^VA(200,DA,0)),U,3)=X)!$DATA(^VA(200,DA,"VOLD",X))
GOTO VHELP
+1 WRITE !,"Here is an example of an acceptable Verify Code: ",XUU,!
+2 QUIT
+3 ;
VAUTO ;Auto-get Access codes
+1 NEW XUK
+2 XECUTE ^%ZOSF("EON")
FOR XUK=1:1:3
DO VGEN
if (Y=1)!($DATA(DIRUT))
QUIT
+3 QUIT
+4 ;
VGEN ;Generate a VERIFY code
+1 SET XUU=$$VC^XUS4
SET (X,XUH)=$$EN^XUSHSH(XUU)
IF ($PIECE($GET(^VA(200,DA,0)),U,3)=X)!$DATA(^VA(200,DA,"VOLD",X))
GOTO VGEN
+2 DO CLR
WRITE "The new VERIFY CODE is: ",XUU," This is ",XUK," of 3 tries."
+3 DO YN
+4 QUIT
YN ;Ask if want to keep
+1 NEW DIR
+2 SET Y=1
SET DIR(0)="YA"
SET DIR("A")=" Do you want to keep this one? "
SET DIR("B")="YES"
SET DIR("?",1)="If you don't like this code, we can auto-generate another."
SET DIR("?")="Remember you only get 3 tries!"
+3 if XUK=3
SET DIR("A")="This is your final choice. "_DIR("A")
+4 DO ^DIR
if (Y=1)!$DATA(DIRUT)
QUIT
IF XUK=2
WRITE !,"O.K. You'll have to keep the next one!",!
HANG 2
+5 IF (XUK=3)&(Y'=1)
WRITE !,"Lets stop and you can try later."
HANG 3
DO DIRUT
+6 DO CLR
+7 QUIT
+8 ;
OUT ;
+1 KILL DUOUT
if $DATA(DIRUT)
SET DUOUT=1
+2 XECUTE ^%ZOSF("EON")
WRITE !
+3 KILL DIR,DIRUT,XUKO,XUAUTO,XUU,XUH,XUK,XUI
SET X=""
+4 QUIT
+5 ;
CHKCUR() ;Check user knows current code, Return 1 if OK to continue
+1 ;Only ask user
if DA'=DUZ
QUIT 1
+2 ;Must have an old one
if $PIECE($GET(^VA(200,DA,.1)),U,2)=""
QUIT 1
+3 SET XUK=0
DO CLR
CHK1 WRITE "Please enter your CURRENT verify code: "
DO GET
if $DATA(DIRUT)
QUIT 0
+1 IF $PIECE(^VA(200,DA,.1),U,2)=$$EN^XUSHSH(X)
QUIT 1
+2 DO CLR
WRITE "Sorry that is not correct!",!
+3 SET XUK=XUK+1
if XUK<3
GOTO CHK1
+4 QUIT 0
+5 ;
BRCVC(XV1,XV2) ;Broker change VC, return 0 if good, '1^msg' if bad.
+1 NEW XUU,XUH,XUSVCMIN
SET XUSVCMIN=8
+2 if $GET(DUZ)'>0
QUIT "1^Bad DUZ"
SET DA=DUZ
SET XUH=$$EN^XUSHSH(XV2)
+3 IF $PIECE($GET(^VA(200,DUZ,.1)),"^",2)'=$$EN^XUSHSH(XV1)
QUIT "1^Sorry that isn't the correct current code"
+4 SET Y=$$VCHK(XV2,XUH)
if Y
QUIT Y
+5 DO VST(XUH,0)
DO CALL^XUSERP(DA,2)
+6 QUIT 0
+7 ;
SVCACCT(XUSDUZ) ;return 1^CONNECTOR PROXY if CP svc acct; 0 if not svc acct
+1 if $$ISUSERCP^XUSAP1(XUSDUZ)
QUIT "1^CONNECTOR PROXY"
+2 QUIT 0
+3 ;
AVHLPTXT(%) ;
+1 QUIT "Enter "_$SELECT($GET(%):"6-20",+$GET(XUSVCMIN):XUSVCMIN_"-20",1:"8-20")_" characters mixed alphanumeric and punctuation (except '^', ';', ':')"
+2 ;
+3 ;Left over code, Don't think it is called anymore.
+4 ;All check or return user attributes moved to XUVERIFY
GOTO XUS2^XUVERIFY
USER GOTO USER^XUVERIFY
EDIT GOTO EDIT^XUVERIFY
