Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGUXUSRC

BGUXUSRC.m

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