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

XUSAML.m

Go to the documentation of this file.
  1. XUSAML ;ISD/HGW - Kernel SAML Token Implementation ; Apr 18, 2022@15:39
  1. ;;8.0;KERNEL;**655,659,630,701,731,771,779**;Jul 10, 1995;Build 5
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Implements the Kernel SAML Token message framework for the Identification and
  1. ; Access Management (IAM) Single Sign-On (SSO) security model.
  1. ;
  1. ; External References:
  1. ; Reference to ^%DT in ICR #10003
  1. ; Reference to $$ATTRIB^MXMLDOM in ICR #3561
  1. ; Reference to $$CHILD^MXMLDOM in ICR #3561
  1. ; Reference to $$EN^MXMLDOM in ICR #3561
  1. ; Reference to $$NAME^MXMLDOM in ICR #3561
  1. ; Reference to $$SIBLING^MXMLDOM in ICR #3561
  1. ; Reference to $$TEXT^MXMLDOM in ICR #3561
  1. ; Reference to $$VALUE^MXMLDOM in ICR #3561
  1. ; Reference to DELETE^MXMLDOM in ICR #3561
  1. ; Reference to TEXT^MXMLDOM in ICR #3561
  1. ; Reference to $$FMADD^XLFDT in ICR #10103
  1. ; Reference to $$NOW^XLFDT in ICR #10103
  1. ; Reference to $$TZ^XLFDT in ICR #10103
  1. ; Reference to $$TITLE^XLFSTR in ICR #10104
  1. ; Reference to $$LOW^XLFSTR in ICR #10104
  1. ; Reference to $$INVERT^XLFSTR in ICR #10104
  1. ; Reference to $$UP^XLFSTR in ICR #10104
  1. ; Reference to $$VALIDATE^XUCERT Private (XU to XU)
  1. ; Reference to $$AUTH^XUESSO2 Private (XU to XU)
  1. ;
  1. Q
  1. EN(DOC) ;Function. Main entry point
  1. ;This function parses and processes the VA Identity and Access Management (IAM) STS SAML token
  1. ; (version 2.0) and returns the DUZ of the user, if found. It does not log the user into VistA.
  1. ; Input: DOC = Closed reference to global root containing XML document (loaded STS SAML Token)
  1. ; Example: S Y=$$EN^XUSAML($NA(^TMP($J,1)))
  1. ; Return: Fail = "-1^Error Message"
  1. ; Success = DUZ
  1. ;ZEXCEPT: XOBDATA ;environment variable
  1. N HDL,XASSRT,XUPN,Y
  1. K ^TMP("XUSAML",$J)
  1. S Y="-1^Error parsing STS SAML Token",XUPN="",XASSRT=""
  1. S XOBDATA("XOB RPC","SECURITY","STATE")="notauthenticated"
  1. S XOBDATA("XOB RPC","SAML","ASSERTION")="notvalidated"
  1. ;--- Call parser
  1. S HDL=$$EN^MXMLDOM(DOC,"W")
  1. ;p701 determine ultimate failure based on XUERR and record them
  1. I HDL>0 D
  1. . D ND(HDL,1,1,.XUPN,.XASSRT) ;Traverse and process document
  1. . S Y="-1^Invalid SAML assertion"
  1. . D VALASSRT(.XASSRT,DOC,.XUERR) ;Validate SAML assertion
  1. . S Y=$$FINDUSER(.XUERR)
  1. . D DELETE^MXMLDOM(HDL)
  1. I $D(XUERR)>0 S DUZ("WARNINGS")=$$WARNINGS(.XUERR)
  1. I +Y'>0!'$$TOKVALID(.DUZ,.XUERR) D LOGFAIL(Y,.DUZ) S Y="-1^Invalid SAML assertion"
  1. I +Y>0 D
  1. . S XOBDATA("XOB RPC","SAML","ASSERTION")="validated"
  1. . S XOBDATA("XOB RPC","SECURITY","STATE")="authenticated"
  1. K ^TMP("XUSAML",$J)
  1. Q Y
  1. ND(HDL,ND,FS,XUPN,XASSRT) ;SR. Traverse tree
  1. N CH,SIB,TX
  1. D SH(HDL,ND,.XUPN,.XASSRT)
  1. S CH=0
  1. S CH=$$CHILD^MXMLDOM(HDL,ND,CH)
  1. I CH D ND(HDL,CH,1,.XUPN,.XASSRT)
  1. Q:'FS ;Don't follow the siblings of siblings
  1. S SIB=ND
  1. F S SIB=$$SIBLING^MXMLDOM(HDL,SIB) Q:'SIB D ND(HDL,SIB,0,.XUPN,.XASSRT)
  1. Q
  1. SH(HDL,ND,XUPN,XASSRT) ;SR. Process node elements
  1. ;ZEXCEPT: XOBDATA ;environment variable
  1. N ELE,I,NM,V,VV,XCHILD,XERR,XTEXT,XVALUE
  1. S ELE=$$NAME^MXMLDOM(HDL,ND)
  1. ; -------------------- saml:Subject Event Processing ---------------------------
  1. I (ELE="Subject")!(ELE="saml:Subject")!(ELE="ns2:Subject") D Q ;Subject element is required
  1. . S XASSRT("Subject")="yes"
  1. ;
  1. ; -------------------- saml:Subject Confirmation Data Event Processing ----------
  1. I (ELE="SubjectConfirmationData")!(ELE="saml:SubjectConfirmationData")!(ELE="ns2:SubjectConfirmationData") D Q
  1. . D EL(HDL,ND,.NM,.XUPN)
  1. . S XASSRT("Recipient")=$O(^TMP("XUSAML",$J,"Recipient",""))
  1. . S XASSRT("Address")=$O(^TMP("XUSAML",$J,"Address",""))
  1. ;
  1. ; -------------------- saml:Conditions Event Processing -------------------------
  1. I (ELE="Conditions")!(ELE="saml:Conditions")!(ELE="ns2:Conditions") D Q
  1. . D EL(HDL,ND,.NM,.XUPN)
  1. . S XASSRT("NotBefore")=$O(^TMP("XUSAML",$J,"NotBefore",""))
  1. . S XASSRT("NotOnOrAfter")=$O(^TMP("XUSAML",$J,"NotOnOrAfter",""))
  1. ;
  1. ; -------------------- saml:AuthnStatement Event Processing ---------------------
  1. I (ELE="AuthnStatement")!(ELE="saml:AuthnStatement")!(ELE="ns2:AuthnStatement") D Q
  1. . D EL(HDL,ND,.NM,.XUPN)
  1. . S XASSRT("AuthnInstant")=$O(^TMP("XUSAML",$J,"AuthnInstant",""))
  1. I (ELE="AuthnContextClassRef")!(ELE="saml:AuthnContextClassRef")!(ELE="ns2:AuthnContextClassRef") D Q
  1. . S XUPN="AuthnContextClassRef"
  1. . D CH(HDL,ND,XUPN)
  1. . S XASSRT("AuthnContextClassRef")=$G(^TMP("XUSAML",$J,"AuthnContextClassRef"))
  1. ;
  1. ; -------------------- saml:Attribute Event Processing --------------------------
  1. I (ELE="Attribute")!(ELE="saml:Attribute")!(ELE="ns2:Attribute") D Q
  1. . S XCHILD=$$CHILD^MXMLDOM(HDL,ND) ;Identify child (AttributeValue) of node ND
  1. . S XTEXT="" S XERR=$$TEXT^MXMLDOM(HDL,XCHILD,$NA(VV)) ;Get text of AttributeValue
  1. . I XERR=1 F I=1:1 Q:'$D(VV(I)) S XTEXT=XTEXT_VV(I)
  1. . S NM=""
  1. . F S NM=$$ATTRIB^MXMLDOM(HDL,ND,NM) Q:'$L(NM) D ;Get name of Attribute
  1. . . I $G(NM)="Name" D
  1. . . . S XVALUE=$$VALUE^MXMLDOM(HDL,ND,NM)
  1. . . . S ^TMP("XUSAML",$J,NM,XVALUE)=XTEXT ;Set up the ^TMP global for the Attribute
  1. Q
  1. CH(HDL,ND,XUPN) ;SR. Process text node
  1. N I,VV,Y
  1. I $G(XUPN)'="" D
  1. . S Y=""
  1. . D TEXT^MXMLDOM(HDL,ND,$NA(VV))
  1. . I $D(VV)>2 F I=1:1 Q:'$D(VV(I)) S Y=Y_VV(I)
  1. . I $P(XUPN,"^",2)="" D
  1. . . S ^TMP("XUSAML",$J,$P(XUPN,"^",1))=Y
  1. . E D
  1. . . S ^TMP("XUSAML",$J,$P(XUPN,"^",1),$P(XUPN,"^",2))=Y
  1. Q
  1. EL(HDL,ND,NM,XUPN) ;SR. Process element
  1. K XUPN S (NM,XUPN)=""
  1. F S NM=$$ATTRIB^MXMLDOM(HDL,ND,NM) Q:'$L(NM) D
  1. . I $L(NM) S XUPN=NM_"^"_$$VALUE^MXMLDOM(HDL,ND,NM)
  1. . I $P(XUPN,"^",2)="" D
  1. . . S ^TMP("XUSAML",$J,$P(XUPN,"^",1))=""
  1. . E D
  1. . . S ^TMP("XUSAML",$J,$P(XUPN,"^",1),$P(XUPN,"^",2))=""
  1. Q
  1. FINDUSER(XUERR) ;Function. Identify user
  1. ;ZEXCEPT: XOBDATA ;environment variable
  1. N VISTAID,X,XARRY,XAUTH,XCTXT,XDUZ,XEDIPI,XPASS,XC,XT,XUHOME,XUIAM,Z
  1. I '$$AUTH^XUESSO2() S XUERR("CALL-RTN")="" Q "-1^Not an authorized calling routine"
  1. S XDUZ="-1^User could not be identified"
  1. S XERR=""
  1. S DUZ("REMAPP")=""
  1. S XUIAM=1 ;Do not trigger IAM updates
  1. S XARRY(1)=$$TITLE^XLFSTR($E($G(^TMP("XUSAML",$J,"Name","urn:oasis:names:tc:xspa:1.0:subject:organization")),1,50)) ;Subject Organization
  1. S XARRY(2)=$$LOW^XLFSTR($E($G(^TMP("XUSAML",$J,"Name","urn:oasis:names:tc:xspa:1.0:subject:organization-id")),1,50)) ;Subject Organization ID
  1. S XARRY(3)=$G(^TMP("XUSAML",$J,"Name","uniqueUserId")) ;Unique User ID
  1. S XARRY(4)=$G(^TMP("XUSAML",$J,"Name","urn:oasis:names:tc:xspa:1.0:subject:subject-id")) ;Subject ID
  1. S:XARRY(4)'["," XARRY(4)=$P(XARRY(4)," ",2)_","_$P(XARRY(4)," ",1)_" "_$P(XARRY(4)," ",3,99) ;P701
  1. S XPASS=$$IDPASS($G(XASSRT("Recipient"))) ;Application ID
  1. I $G(XPASS)'="" D
  1. . S XT=$$GETCNTXT^XUESSO2(XPASS)
  1. . I +XT>0 D
  1. . . S DUZ("REMAPP")=XT_"^"_$P($G(^XWB(8994.5,XT,0)),U) ;Identify remote application
  1. . . S XCTXT=$P($G(^XWB(8994.5,XT,0)),U,2)
  1. . . I $G(XCTXT)'="" S XARRY(5)=XPASS
  1. E S XARRY(5)="" ;Application ID
  1. S XARRY(6)=$G(^TMP("XUSAML",$J,"Name","urn:va:ad:samaccountname")) ;Network Username
  1. S XARRY(7)=$G(^TMP("XUSAML",$J,"Name","urn:va:vrm:iam:secid")) ;SecID
  1. S XARRY(8)=$G(^TMP("XUSAML",$J,"Name","urn:oasis:names:tc:xspa:2.0:subject:npi")) ;NPI
  1. ;S XARRY(9)=$G(^TMP("XUSAML",$J,"Name","SSN")) ;SSN is not part of STS Token specification v2.0
  1. S XARRY(10)=$G(^TMP("XUSAML",$J,"Name","upn")) ;Active Directory User Principle Name (UPN)
  1. S XARRY(11)=$G(^TMP("XUSAML",$J,"Name","email")) ;E-Mail Address
  1. ;S ???=$G(^TMP("XUSAML",$J,"Name","urn:oasis:names:tc:xacml:2.0:subject:role")) ;Role-based access is not yet implemented
  1. S XAUTH=$$LOW^XLFSTR($G(^TMP("XUSAML",$J,"Name","authnsystem"))) ;SSOi, SSOe, or Other authentication
  1. S XUHOME=$$LOW^XLFSTR($G(^TMP("XUSAML",$J,"Name","urn:nhin:names:saml:homeCommunityId"))) ;Home Community ID
  1. S XEDIPI=$G(^TMP("XUSAML",$J,"Name","edipi")) ;DoD CAC card identifier
  1. S DUZ("MVIICN")=$G(^TMP("XUSAML",$J,"Name","urn:va:vrn:iam:mviicn")) ;ICN
  1. ; p771 trim values and lock on XARRY(7) SECID or XARRY(3) unique id
  1. S XARRY(3)=$TR($$LOW^XLFSTR($E($$TRIM^XLFSTR(XARRY(3)),1,40)),"^","%")
  1. S XARRY(7)=$TR($E($$TRIM^XLFSTR(XARRY(7)),1,40),"^","%")
  1. S XARRY(8)=$$TRIM^XLFSTR(XARRY(8))
  1. S XEDIPI=$$TRIM^XLFSTR(XEDIPI)
  1. S XARRY(11)=$$TRIM^XLFSTR(XARRY(11))
  1. ;
  1. I (XUHOME=$P($G(^XTV(8989.3,1,200)),U,3))&(XAUTH="ssoi") D ;SSOi
  1. . S XARRY(3)=XARRY(7) ;UID=SecID
  1. . S DUZ("AUTHENTICATION")="SSOI"
  1. . ; p731,p771 ensure user is found before adding new one and deal with concurrent queries from JLV
  1. . L +^VA(200,"ASECID",XARRY(7)):$G(DILOCKTM,10) I '$T S XDUZ="-1^Could not obtain LOCK" Q
  1. . S XDUZ=$$FINDUSER^XUESSO2(.XARRY) ;Identify existing user with SecID
  1. . I XDUZ'>0 S XARRY(9)=$$MPISSN(.XARRY) ; retry with SSN from MPI
  1. . I $G(XARRY(9))]"" S XDUZ=$$FINDUSER^XUESSO2(.XARRY)
  1. . I XDUZ>0 L -^VA(200,"ASECID",XARRY(7)) Q ; user found
  1. . ;Add new user on the fly
  1. . I $G(XARRY(5))'="" D
  1. . . I '$$TOKVALID(.DUZ,.XUERR) S XDUZ="-1^Cannot add untrusted token-data" Q
  1. . . S XDUZ=$$ADDUSER^XUESSO2(.XARRY)
  1. . L -^VA(200,"ASECID",XARRY(7)) ; end p731,p771
  1. ;
  1. E I (XUHOME=$P($G(^XTV(8989.3,1,200)),U,3))&(XAUTH="ssoe") D ;SSOe
  1. . I ($L($G(XARRY(1)))<3)!($L($G(XARRY(2)))<3) S XDUZ="-1^Invalid SORG or SORGID" Q
  1. . S XARRY(3)=XARRY(7) ;UID=SecID
  1. . I +DUZ("REMAPP")>0 D
  1. . . S DUZ("AUTHENTICATION")="SSOE"
  1. . . L +^VA(200,"ASECID",XARRY(7)):$G(DILOCKTM,10) I '$T S XDUZ="-1^Could not obtain LOCK" Q ; p731,p771
  1. . . S XDUZ=$$FINDUSER^XUESSO2(.XARRY) ;Identify existing user with SecID
  1. . . I XDUZ'>0 S XARRY(9)=$$MPISSN(.XARRY) ; retry with SSN from MPI
  1. . . I $G(XARRY(9))]"" S XDUZ=$$FINDUSER^XUESSO2(.XARRY)
  1. . . I (+XDUZ<0)&($G(XARRY(5))'="") D
  1. . . . I '$$TOKVALID(.DUZ,.XUERR) S XDUZ="-1^Cannot add untrusted token-data" Q
  1. . . . S XDUZ=$$ADDUSER^XUESSO2(.XARRY) ;Add new user on the fly
  1. . . L -^VA(200,"ASECID",XARRY(7)) ; end p731,p771
  1. ;
  1. E I (XARRY(2)["http://")!(XARRY(2)["https://")!((XARRY(2)["urn:oid:")&(XARRY(2)'=$P($G(^XTV(8989.3,1,200)),U,3))) D ; NHIN
  1. . I (+DUZ("REMAPP")>0)&(XAUTH="nhin") D
  1. . . I $G(XARRY(3))="" S XARRY(3)=XARRY(8) ;NHIN: UID is NPI if available (preferred)
  1. . . I $G(XARRY(3))="" S XARRY(3)=XEDIPI ;NHIN: DoD CAC card identifier
  1. . . I $G(XARRY(3))="" S XARRY(3)=XARRY(11) ;NHIN: UID is e-mail if available (alternative to NPI)
  1. . . S DUZ("AUTHENTICATION")="NHIN"
  1. . . L +^VA(200,"UID",XARRY(3)):$G(DILOCKTM,10) I '$T S XDUZ="-1^Could not obtain LOCK" Q ; p731,p771
  1. . . S XDUZ=$$FINDUSER^XUESSO2(.XARRY) ;Identify user by NPI or Unique User ID
  1. . . I +XDUZ<0 D
  1. . . . S XARRY(8)=""
  1. . . . S XDUZ=$$FINDUSER^XUESSO2(.XARRY) ;Identify user by Unique User ID only
  1. . . . I XDUZ'>0 S XARRY(9)=$$MPISSN(.XARRY) ; retry with SSN from MPI
  1. . . . I $G(XARRY(9))]"" S XDUZ=$$FINDUSER^XUESSO2(.XARRY)
  1. . . . I (+XDUZ<0)&($G(XARRY(5))'="") D
  1. . . . . I '$$TOKVALID(.DUZ,.XUERR) S XDUZ="-1^Cannot add untrusted token-data" Q
  1. . . . . S XDUZ=$$ADDUSER^XUESSO2(.XARRY) ;Add new user on the fly
  1. . . L -^VA(200,"UID",XARRY(3)) ; end p731
  1. ;
  1. I XDUZ<0 D ; record NAME and SECID to error
  1. . S XUERR("SECID")=""
  1. . S $P(XDUZ,U,3)=XARRY(4),$P(XDUZ,U,4)=XARRY(7)
  1. Q XDUZ
  1. VALASSRT(XASSRT,DOC,XUERR) ;Intrinsic Subroutine. Validate SAML assertion
  1. ;ZEXCEPT: XOBDATA ;environment variable
  1. N XAUTH,XD,XNOW,XPROOF
  1. S XOBDATA("XOB RPC","SAML","AUTHENTICATION TYPE")=$G(^TMP("XUSAML",$J,"Name","authenticationtype"))
  1. S XOBDATA("XOB RPC","SAML","PROOFING AUTHORITY")=$G(^TMP("XUSAML",$J,"Name","proofingauthority"))
  1. S XAUTH=$$LOW^XLFSTR($G(^TMP("XUSAML",$J,"Name","authnsystem")))
  1. S XPROOF=XOBDATA("XOB RPC","SAML","PROOFING AUTHORITY")
  1. ; Verify Level of Assurance (VA requires LOA-1 through LOA-3, but higher levels are accepted)
  1. K XOBDATA("XOB RPC","SAML","ASSURANCE LEVEL")
  1. S XD=$G(^TMP("XUSAML",$J,"Name","assurancelevel")) I (+XD<1)!(+XD="") S XD=1
  1. S XOBDATA("XOB RPC","SAML","ASSURANCE LEVEL")=XD
  1. S DUZ("LOA")=XD ;Set LOA environment variable for SIGN-ON log and permissions
  1. ;p701
  1. ;I (XAUTH'="nhin")&(XPROOF'="VA-JLV") D ;temporary for pre-SSOe JLV non-VA users
  1. D
  1. . ;Validate time stamps (e.g., NotBefore, NotOnOrAfter)
  1. . S XNOW=$$NOW^XLFDT
  1. . S XD=$$CONVTIME($G(XASSRT("AuthnInstant"))) I XD=-1 D ;invalid time stamp
  1. . . S XUERR("AuthnI")=""
  1. . S XD=$$CONVTIME($G(XASSRT("NotBefore"))) I (XD=-1)!(XD>XNOW) D ;token not valid yet
  1. . . S XUERR("NotBefore")=""
  1. . S XD=$$CONVTIME($G(XASSRT("NotOnOrAfter"))) D
  1. . . ;N DIF1,HR,DAY
  1. . . ;S HR=3600,DAY=86400
  1. . . ;S DIF1=$$FMDIFF^XLFDT(XD,XNOW,2) ;DIF1=$$ABS^XLFMTH(DIF1)
  1. . . ;I (XD=-1)!(DIF1>DAY) S XUERR("EXPIRED+")="" Q
  1. . . I XD<XNOW S XUERR("EXPIRED")=""
  1. . . ;
  1. . I '$D(XASSRT("AuthnContextClassRef")) D
  1. . . S XUERR("AuthnCCR")=""
  1. . ;Validate Digital Signature
  1. . D VALIDATE^XUCERT(DOC,.XUERR)
  1. . ;Validate Token Issuer (Subject of X509 Certificate used to sign token)
  1. . I '($G(XOBDATA("XOB RPC","SAML","ISSUER"))[$P($G(^XTV(8989.3,1,200)),U,1)) D
  1. . . S XUERR("ISSUER")=""
  1. . ;Token has been validated
  1. Q
  1. IDPASS(XUA) ;Intrinsic Function. Extract Application ID
  1. N RETURN,XTD,XTE
  1. S RETURN=$P($G(XUA),"/",4,99)
  1. S XTD=$$DT^XLFDT
  1. S XTE=$$FMADD^XLFDT(XTD,7)
  1. I $G(RETURN)'="" D
  1. . S ^XTMP("XUSAMLAPPID",0)=XTE_"^"_XTD_"^SAML Application ID" ;capture and log application ID from SAML token
  1. . S ^XTMP("XUSAMLAPPID",0,RETURN)=""
  1. ;. S RETURN=$$LOW^XLFSTR(RETURN) p779
  1. Q RETURN
  1. CONVTIME(TIME) ;Intrinsic Function. Convert XML time to FileMan format
  1. ;ZEXCEPT: %DT ;environment variable
  1. N X,XD,XOUT,XT,XZ,Y
  1. S XZ=0 I $G(TIME)["Z" S XZ=1 ;Zulu time (GMT)
  1. S XD=$P($G(TIME),"T",1) ;Date
  1. S XD=$P(XD,"-",2)_"/"_$P(XD,"-",3)_"/"_$P(XD,"-",1) ;Convert date to MM/DD/YYYY
  1. S XT=$P($G(TIME),"T",2) ;Time
  1. I XZ=1 S XT=$P(XT,"Z",1) ;Strip "Z" from time
  1. S X=XD_"@"_XT S %DT="RTS"
  1. D ^%DT S XOUT=Y
  1. I XOUT=-1 Q XOUT ;Invalid date/time
  1. I XZ=1 S XOUT=$$FMADD^XLFDT(XOUT,0,+$E($$TZ^XLFDT,1,3),0,0) ;Adjust from GMT
  1. K %DT(0)
  1. Q XOUT
  1. ;
  1. WARNINGS(XUERR) ;
  1. N X,Y
  1. S (X,Y)=""
  1. F S X=$O(XUERR(X)) Q:X="" S Y=Y_X_";"
  1. Q Y
  1. ;
  1. TOKVALID(DUZ,XUERR) ;
  1. N STRICT
  1. ;S STRICT=$P($G(^XTV(8989.3,1,"XUS")),"^",20)
  1. S STRICT=+$P($G(XOPT),U,20)
  1. I STRICT,$D(XUERR) Q 0
  1. I $G(DUZ("AUTHENTICATION"))="NHIN" Q 1
  1. I $D(XUERR("EXPIRED")) Q 0
  1. ;I $D(XUERR("DIGEST")),$D(XUERR("EXPIRED+")) Q 0
  1. Q 1
  1. ;
  1. LOGFAIL(IEN,DUZ) ; Record failed access
  1. N STRICT,WARN,XUF
  1. S STRICT=$P($G(XOPT),U,20)
  1. S WARN=$S(+STRICT:"STRICT ",1:"NON-STRICT ")
  1. I $G(DUZ("WARNINGS"))'="" S WARN=WARN_"Failed-verifications: "_$G(DUZ("WARNINGS"))
  1. I $P(IEN,U,2)'="" S WARN=WARN_" ERROR:"_$P(IEN,U,2)
  1. I $P(IEN,U,4)'="" S WARN=WARN_". SECID not linked to existing user, SECID:"_$P(IEN,U,4)_" NAME:"_$P(IEN,U,3)_" "
  1. S IEN=+IEN
  1. I IEN>0 S XUF(.3)=IEN S X=$P($G(^VA(200,IEN,1.1)),U,2)+1,$P(^(1.1),"^",2)=X
  1. S XUF(.1)=$E($G(DUZ("AUTHENTICATION")))
  1. S XUF(.2)=$G(XUF(.2))+1,XUF(XUF(.2))=WARN
  1. S XUF=2
  1. D FILE^XUSTZ
  1. Q
  1. ;
  1. MPISSN(XATR) ; Return SSN found in MPI
  1. N SSN,XMPI,XOUT
  1. S SSN=""
  1. S:$G(XATR(7))]"" XMPI("secId")=XATR(7)
  1. S:$G(XATR(6))]"" XMPI("samacctnm")=XATR(6)
  1. S:$G(XATR(10))]"" XMPI("VAemail")=XATR(10)
  1. N XI F XI="secId","samacctnm","VAemail" D Q:SSN]""
  1. . N XIN
  1. . I $G(XMPI(XI))]"" S XIN(XI)=XMPI(XI) D USER^XUIAMXML(.XOUT,.XIN) S SSN=$G(XOUT("pnid"))
  1. Q SSN
  1. ;