BGUXUSRC ; IHS/OIT/MJL - Request Broker ;
;;1.5;BGU;;MAY 26, 2005
Q ;No entry from top
;
;DATA BROKER calls, First parameter is always call-by-reference
;
;s1=-1^The VERIFY CODE has ....they sign-on.
; |-2|CHOW,SUN&613^FM#Pp^0^1;SELLS HOSPITAL/CLINIC&4585^|
;s1=2|-1^The VERIFY CODE has ....they sign-on.
; |CHOW,SUN&613^FM#Pp^0^1;SELLS HOSPITAL/CLINIC&4585^|
;--------------- QUERY TAG -----------------------------------
CHGACODE(RESULT,XUH,XUDUZ) ; Excerpts from tag AASK1^XUS2
;BGU ACCESSCODE CHANGE- Query to validate the new ACCESS code & store it.
;WARNING : This outputs the LOGON info for the user identified by XUDUZ.
;!!!!!So BGUSRV OCX needs to know when it wants to use this info to
;update the current user.
;INPUTS :XUDUZ = the DUZ sent up by the GUI. If null, use DUZ in partition.
; DA =DUZ
; XUH =the hashed ACCESS code just input by the user.
N DA,XUERR K RESULT S XUERR=""
S DA=$G(DUZ)
I $G(XUDUZ)'="",'$$CKAUTH S XUERR="You are only authorized to change your own ACCESS code!" D SNDER Q
I DA="" S XUERR="No DUZ, must logon first !!" D SNDER Q
;D- S XUU=X,X=$$EN^XUSHSH(X),XUH=X
S 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
;
;DB-temp DELETED sothat when testing, I can just use 2 sets of codes.
;I $D(^VA(200,"AOLD",XUH))!$D(^VA(200,"A",XUH)) S XUERR="This has been used previously as an ACCESS CODE." D SNDER Q
;
;I3- File the new ACCESS- assuming no writes in those executes.
;And send the security info : Access, Verify, and FAC.
D AST(XUH) ;Everywhere DA was DUZ
I $G(DA)>0 S %=$P(^VA(200,DA,0),U)_"&"_DA_U_$P(^VA(200,DA,0),U,4)_U_0_U_$$GETFC^BGUGFAC(DA)_U_"" D ADDRSLT
E S XUERR=XUSER("ERR") D SNDER
Q
CKAUTH() ;
;Check if this user may modify ACCESS code for other users.
; ( DUZ(0) must include "@" or "#" )
S DA=XUDUZ
I DA'=DUZ,DUZ(0)'["@",DUZ(0)'["#" Q 0
Q 1
AST(XUH) ;AST^XUS2- Change ACCESS CODE and index.
;sets:S $P(^VA(200,DA,0),"^",3)=XUH K ^VA(200,"A",X,DA)
;S ^VA(200,"AOLD",X,DA)=+$H,^VA(200,"A",X,DA)=+$H Q
;D- W "OK, Access code has been changed!"
N XUI,XUU,XUWRN
S XUU=$P(^VA(200,DA,0),"^",3),$P(^VA(200,DA,0),"^",3)=XUH
I XUU]"" F XUI=0:0 S X=XUU S XUI=$O(^DD(200,2,1,XUI)) Q:XUI'>0 X ^(XUI,2)
I XUH]"" F XUI=0:0 S X=XUH S XUI=$O(^DD(200,2,1,XUI)) Q:XUI'>0 X ^(XUI,1)
D VST("",1)
I $D(^XMB(3.7,DA,0))[0 S Y=DA D NEW^XM ;Make sure USER has a Mailbox
;Somehow, needs to send this multi-line msg down:
S XUWRN="The VERIFY CODE has been deleted as a security measure. "
S XUWRN=XUWRN_"The user will have to enter a new one the next time they sign-on."
D SNDWRN
Q
;
;--------------- QUERY TAG -----------------------------------
CHGVCODE(RESULT,XUH,XUDUZ) ; Excerpts from tag VASK1^XUS2
;WARNING : This outputs the LOGON info for the user identified by XUDUZ.
;!!!!! So BGUSRV OCX needs to know when it wants to use this info to
;update the current user.
;BGU VERIFYCODE CHANGE- Query to validate the new VERIFY code & store it.
;In VALIDAV^BGUXUSRB, at end I added a call to $$VCVALID(), and may set
;error code=12. When this code 12 is sent to SendSecurityRequest() in
;the OCX, it calls sub PopChangeVerifyDlgBox(), which asks user to
;input the new VERIFY code, and calls query 'ChangeVerifyCode'.
;This Query may also be invoked by the user on demand, from the Application
;side(VB).
;WARNING : this is for the OWNER to change. If for the site mgr to change
;!!!!!! we need to pass in the DA or DUZ.
;INPUTS : XUDUZ = the DUZ sent up by the GUI. If null, use DUZ in partition.
;DA =DUZ
;XUH =the hashed VERIFY code just input by the user.
;R- S XUU=X,X=$$EN^XUSHSH(X),XUH=X
N XUERR K RESULT S XUERR=""
S DA=$G(DUZ)
I $G(XUDUZ)'="",'$$CKAUTH S XUERR="You are only authorized to change your own VERIFY code!" D SNDER Q
I DA="" S XUERR="No DUZ, must logon first !!" D SNDER Q
I $D(^VA(200,DA,.1)),XUH=$P(^(.1),U,2) S XUERR="This code is the same as the current one." D SNDER Q
;
;DB-temp DELETED sothat when testing, I can just use 2 sets of codes.
;$D(^VA(200,DA,"VOLD",XUH)) S XUERR="This has been used previously as the VERIFY CODE." D SNDER Q
I XUH=$P(^VA(200,DA,0),U,3) S XUERR="VERIFY CODE must be different than the ACCESS CODE." D SNDER Q
;I3- File the new VERIFY- assuming no writes in those executes.
;And send the security info : Access, Verify, and FAC.
D VST(XUH,1) ;I $G(DUZ)>0 ...
I $G(DA)>0 S %=$P(^VA(200,DUZ,0),U)_"&"_DUZ_U_$P(^VA(200,DUZ,0),U,4)_U_0_U_$$GETFC^BGUGFAC(DUZ)_U_"" D ADDRSLT
E S XUERR=XUSER("ERR") D SNDER
Q
;
VST(XUH,%) ;I- File Verify code change, mod from VST^XUS2
;XUH = new VERIFY code hashed. XUU = Old VERIFY code hashed.
; DA = 613, IEN
;t#'ou,=B7FC%@0ulm{:t=>123SUN
S XUU=$P($G(^VA(200,DA,.1)),U,2) S $P(^VA(200,DA,.1),"^",1,2)=$H_"^"_XUH
I XUU]"" F XUI=0:0 S X=XUU,XUI=$O(^DD(200,11,1,XUI)) Q:XUI'>0 X ^(XUI,2)
I XUH]"" F XUI=0:0 S X=XUH,XUI=$O(^DD(200,11,1,XUI)) Q:XUI'>0 X ^(XUI,1)
S:DA=DUZ DUZ("NEWCODE")=XUH
Q
;
;------------------
ADDRSLT ; Add % as the new entry
;RESULT(0.01) = Number of recs FOLLOWING 0.01, (Itself is NOT included.)
S BGUI=+$G(RESULT(0.01)),BGUI=BGUI+1,RESULT(0.01)=BGUI
S RESULT(BGUI)=%
Q
SNDER ;Sends error to GUI
;For ERROR, RESULT(0.01)=-1 is required by the system convention.
;INPUTS : XUERR = the error msg.
N BGUI
S BGUI=+$G(RESULT(0.01)),RESULT(0.01)=-1
S RESULT(BGUI)="0"_U_XUERR
Q
SNDWRN ;
;For WARNING, RESULT(0.01)=-2 is required by the system convention.
;So the format for that is :
;RESULT(0.01)= number of lines that follows. (warning text & result)
;for each line of warning msg text, = "-1^text line".
;for result, then just the result
; (so a result may not contain a 1st piece=-1, EX: "-1^...")
;INPUTS : XUWRN = the WARNING msg.
;LOCALS : BGUN1 = -1 warns GUI code that it is a warning.
N BGUI,BGUN1
S BGUI=+$G(RESULT(0.01)),BGUI=BGUI+1,RESULT(0.01)=BGUI
;S RESULT(0.01)=-2
S BGUN1=-1
S RESULT(BGUI)=BGUN1_U_XUWRN
Q
;=================================================================
;=================================================================
BGUXUSRC ; IHS/OIT/MJL - Request Broker ;
+1 ;;1.5;BGU;;MAY 26, 2005
+2 ;No entry from top
QUIT
+3 ;
+4 ;DATA BROKER calls, First parameter is always call-by-reference
+5 ;
+6 ;s1=-1^The VERIFY CODE has ....they sign-on.
+7 ; |-2|CHOW,SUN&613^FM#Pp^0^1;SELLS HOSPITAL/CLINIC&4585^|
+8 ;s1=2|-1^The VERIFY CODE has ....they sign-on.
+9 ; |CHOW,SUN&613^FM#Pp^0^1;SELLS HOSPITAL/CLINIC&4585^|
+10 ;--------------- QUERY TAG -----------------------------------
CHGACODE(RESULT,XUH,XUDUZ) ; Excerpts from tag AASK1^XUS2
+1 ;BGU ACCESSCODE CHANGE- Query to validate the new ACCESS code & store it.
+2 ;WARNING : This outputs the LOGON info for the user identified by XUDUZ.
+3 ;!!!!!So BGUSRV OCX needs to know when it wants to use this info to
+4 ;update the current user.
+5 ;INPUTS :XUDUZ = the DUZ sent up by the GUI. If null, use DUZ in partition.
+6 ; DA =DUZ
+7 ; XUH =the hashed ACCESS code just input by the user.
+8 NEW DA,XUERR
KILL RESULT
SET XUERR=""
+9 SET DA=$GET(DUZ)
+10 IF $GET(XUDUZ)'=""
IF '$$CKAUTH
SET XUERR="You are only authorized to change your own ACCESS code!"
DO SNDER
QUIT
+11 IF DA=""
SET XUERR="No DUZ, must logon first !!"
DO SNDER
QUIT
+12 ;D- S XUU=X,X=$$EN^XUSHSH(X),XUH=X
+13 SET XMB(1)=$ORDER(^VA(200,"A",XUH,0))
+14 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
+15 ;
+16 ;DB-temp DELETED sothat when testing, I can just use 2 sets of codes.
+17 ;I $D(^VA(200,"AOLD",XUH))!$D(^VA(200,"A",XUH)) S XUERR="This has been used previously as an ACCESS CODE." D SNDER Q
+18 ;
+19 ;I3- File the new ACCESS- assuming no writes in those executes.
+20 ;And send the security info : Access, Verify, and FAC.
+21 ;Everywhere DA was DUZ
DO AST(XUH)
+22 IF $GET(DA)>0
SET %=$PIECE(^VA(200,DA,0),U)_"&"_DA_U_$PIECE(^VA(200,DA,0),U,4)_U_0_U_$$GETFC^BGUGFAC(DA)_U_""
DO ADDRSLT
+23 IF '$TEST
SET XUERR=XUSER("ERR")
DO SNDER
+24 QUIT
CKAUTH() ;
+1 ;Check if this user may modify ACCESS code for other users.
+2 ; ( DUZ(0) must include "@" or "#" )
+3 SET DA=XUDUZ
+4 IF DA'=DUZ
IF DUZ(0)'["@"
IF DUZ(0)'["#"
QUIT 0
+5 QUIT 1
AST(XUH) ;AST^XUS2- Change ACCESS CODE and index.
+1 ;sets:S $P(^VA(200,DA,0),"^",3)=XUH K ^VA(200,"A",X,DA)
+2 ;S ^VA(200,"AOLD",X,DA)=+$H,^VA(200,"A",X,DA)=+$H Q
+3 ;D- W "OK, Access code has been changed!"
+4 NEW XUI,XUU,XUWRN
+5 SET XUU=$PIECE(^VA(200,DA,0),"^",3)
SET $PIECE(^VA(200,DA,0),"^",3)=XUH
+6 IF XUU]""
FOR XUI=0:0
SET X=XUU
SET XUI=$ORDER(^DD(200,2,1,XUI))
IF XUI'>0
QUIT
XECUTE ^(XUI,2)
+7 IF XUH]""
FOR XUI=0:0
SET X=XUH
SET XUI=$ORDER(^DD(200,2,1,XUI))
IF XUI'>0
QUIT
XECUTE ^(XUI,1)
+8 DO VST("",1)
+9 ;Make sure USER has a Mailbox
IF $DATA(^XMB(3.7,DA,0))[0
SET Y=DA
DO NEW^XM
+10 ;Somehow, needs to send this multi-line msg down:
+11 SET XUWRN="The VERIFY CODE has been deleted as a security measure. "
+12 SET XUWRN=XUWRN_"The user will have to enter a new one the next time they sign-on."
+13 DO SNDWRN
+14 QUIT
+15 ;
+16 ;--------------- QUERY TAG -----------------------------------
CHGVCODE(RESULT,XUH,XUDUZ) ; Excerpts from tag VASK1^XUS2
+1 ;WARNING : This outputs the LOGON info for the user identified by XUDUZ.
+2 ;!!!!! So BGUSRV OCX needs to know when it wants to use this info to
+3 ;update the current user.
+4 ;BGU VERIFYCODE CHANGE- Query to validate the new VERIFY code & store it.
+5 ;In VALIDAV^BGUXUSRB, at end I added a call to $$VCVALID(), and may set
+6 ;error code=12. When this code 12 is sent to SendSecurityRequest() in
+7 ;the OCX, it calls sub PopChangeVerifyDlgBox(), which asks user to
+8 ;input the new VERIFY code, and calls query 'ChangeVerifyCode'.
+9 ;This Query may also be invoked by the user on demand, from the Application
+10 ;side(VB).
+11 ;WARNING : this is for the OWNER to change. If for the site mgr to change
+12 ;!!!!!! we need to pass in the DA or DUZ.
+13 ;INPUTS : XUDUZ = the DUZ sent up by the GUI. If null, use DUZ in partition.
+14 ;DA =DUZ
+15 ;XUH =the hashed VERIFY code just input by the user.
+16 ;R- S XUU=X,X=$$EN^XUSHSH(X),XUH=X
+17 NEW XUERR
KILL RESULT
SET XUERR=""
+18 SET DA=$GET(DUZ)
+19 IF $GET(XUDUZ)'=""
IF '$$CKAUTH
SET XUERR="You are only authorized to change your own VERIFY code!"
DO SNDER
QUIT
+20 IF DA=""
SET XUERR="No DUZ, must logon first !!"
DO SNDER
QUIT
+21 IF $DATA(^VA(200,DA,.1))
IF XUH=$PIECE(^(.1),U,2)
SET XUERR="This code is the same as the current one."
DO SNDER
QUIT
+22 ;
+23 ;DB-temp DELETED sothat when testing, I can just use 2 sets of codes.
+24 ;$D(^VA(200,DA,"VOLD",XUH)) S XUERR="This has been used previously as the VERIFY CODE." D SNDER Q
+25 IF XUH=$PIECE(^VA(200,DA,0),U,3)
SET XUERR="VERIFY CODE must be different than the ACCESS CODE."
DO SNDER
QUIT
+26 ;I3- File the new VERIFY- assuming no writes in those executes.
+27 ;And send the security info : Access, Verify, and FAC.
+28 ;I $G(DUZ)>0 ...
DO VST(XUH,1)
+29 IF $GET(DA)>0
SET %=$PIECE(^VA(200,DUZ,0),U)_"&"_DUZ_U_$PIECE(^VA(200,DUZ,0),U,4)_U_0_U_$$GETFC^BGUGFAC(DUZ)_U_""
DO ADDRSLT
+30 IF '$TEST
SET XUERR=XUSER("ERR")
DO SNDER
+31 QUIT
+32 ;
VST(XUH,%) ;I- File Verify code change, mod from VST^XUS2
+1 ;XUH = new VERIFY code hashed. XUU = Old VERIFY code hashed.
+2 ; DA = 613, IEN
+3 ;t#'ou,=B7FC%@0ulm{:t=>123SUN
+4 SET XUU=$PIECE($GET(^VA(200,DA,.1)),U,2)
SET $PIECE(^VA(200,DA,.1),"^",1,2)=$HOROLOG_"^"_XUH
+5 IF XUU]""
FOR XUI=0:0
SET X=XUU
SET XUI=$ORDER(^DD(200,11,1,XUI))
IF XUI'>0
QUIT
XECUTE ^(XUI,2)
+6 IF XUH]""
FOR XUI=0:0
SET X=XUH
SET XUI=$ORDER(^DD(200,11,1,XUI))
IF XUI'>0
QUIT
XECUTE ^(XUI,1)
+7 IF DA=DUZ
SET DUZ("NEWCODE")=XUH
+8 QUIT
+9 ;
+10 ;------------------
ADDRSLT ; Add % as the new entry
+1 ;RESULT(0.01) = Number of recs FOLLOWING 0.01, (Itself is NOT included.)
+2 SET BGUI=+$GET(RESULT(0.01))
SET BGUI=BGUI+1
SET RESULT(0.01)=BGUI
+3 SET RESULT(BGUI)=%
+4 QUIT
SNDER ;Sends error to GUI
+1 ;For ERROR, RESULT(0.01)=-1 is required by the system convention.
+2 ;INPUTS : XUERR = the error msg.
+3 NEW BGUI
+4 SET BGUI=+$GET(RESULT(0.01))
SET RESULT(0.01)=-1
+5 SET RESULT(BGUI)="0"_U_XUERR
+6 QUIT
SNDWRN ;
+1 ;For WARNING, RESULT(0.01)=-2 is required by the system convention.
+2 ;So the format for that is :
+3 ;RESULT(0.01)= number of lines that follows. (warning text & result)
+4 ;for each line of warning msg text, = "-1^text line".
+5 ;for result, then just the result
+6 ; (so a result may not contain a 1st piece=-1, EX: "-1^...")
+7 ;INPUTS : XUWRN = the WARNING msg.
+8 ;LOCALS : BGUN1 = -1 warns GUI code that it is a warning.
+9 NEW BGUI,BGUN1
+10 SET BGUI=+$GET(RESULT(0.01))
SET BGUI=BGUI+1
SET RESULT(0.01)=BGUI
+11 ;S RESULT(0.01)=-2
+12 SET BGUN1=-1
+13 SET RESULT(BGUI)=BGUN1_U_XUWRN
+14 QUIT
+15 ;=================================================================
+16 ;=================================================================
