XUIAMPR1 ;BHM/DLR,DRI - IAM PROVISIONING - ADD/UPDATE OF A NEW PERSON (CONT) ;1/25/23 18:01
;;8.0;KERNEL;**799**;Jul 10, 1995;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified
;
FINDUSER(XURET,XUREQTYP,XUTERMDT) ;search vista instance to find user ;**663 - STORY 783347 (dri) **799 VAMPI-22625
; Input: XURET(#) = Array containing person's attributes
; XUREQTYP = 'ADD' or 'MODIFY' of a new person
; XUTERMDT = the optional termination date when doing batch entry of
; new persons through 'Grant Access by Profile' option
;
; Return: Fail = "-1^Error Message"
; Success = IEN (DUZ) from file #200 if successfully added
;
;
N CNT,ERRMSG,I,NAME,SOURCEID,VISTAID,XATR,XUATTRTYPE,XUCNT,XUIAMDUZ
;
S CNT=$O(XURET(0)) ;count of person selected
I '$D(XURET(CNT,"adupn")) S XURET(CNT,"adupn")=$$LOW^XLFSTR($G(XURET(CNT,"email"))) ;default email for adupn if the adupn is not returned by psim
;
I $L($G(XURET(CNT,"vistaid")),"|")>1 D ;find person's duz known at enterprise
.;VISTAID should look like 12596^PN^200M^USDVA [userid/duz^source id type^station number^assigning authority].
.F I=2:3:$L(XURET(CNT,"vistaid"),"|") S VISTAID=$P(XURET(CNT,"vistaid"),"|",I) I $P(VISTAID,"^",3)=$P($$SITE^VASITE(),"^",3),($P(VISTAID,"^",2)="PN"),($P(VISTAID,"^",1)'="") S SOURCEID=$P(VISTAID,"^",1) Q
;
;don't default in subjectOrg or orgId, should be returned by psim
S XATR(1)=$G(XURET(CNT,"subjectOrg")) ;$$TITLE^XLFSTR($E("Department Of Veterans Affairs",1,50)) ;subject organization
S XATR(2)=$G(XURET(CNT,"orgId")) ;$$LOW^XLFSTR($E("urn:oid:2.16.840.1.113883.4.349",1,50)) ;subject organization id
S XATR(3)=$TR($$LOW^XLFSTR($E($G(XURET(CNT,"secId")),1,40)),"^","%") ;unique user id
S NAME=$G(XURET(CNT,"lastName"))_"," I $G(XURET(CNT,"firstName"))'="" S NAME=NAME_XURET(CNT,"firstName") I $G(XURET(CNT,"middleName"))'="" S NAME=NAME_" "_XURET(CNT,"middleName")
S XATR(4)=$$FORMAT^XLFNAME7(.NAME,3,35,,0,,,2) ;subject id converted to standard format: name last, first middle
I $G(XATR(4))'?1U.E1","1U.E Q "-1^Subject ID could not be converted to 'LAST,FIRST MIDDLE SUFFIX' VistA standard format"
;S XATR(5)= ;security phrase to establish context option (not implemented)
S XATR(6)=$$UP^XLFSTR($E($G(XURET(CNT,"samacctnm")),1,50)) ;active directory network username
S XATR(7)=$TR($$LOW^XLFSTR($E($G(XURET(CNT,"secId")),1,40)),"^","%") ;security id
S XATR(8)=$G(XURET(CNT,"npi")) ;npi
S XATR(9)=$G(XURET(CNT,"pnid")) ;ssn
S XATR(10)=$$LOW^XLFSTR($G(XURET(CNT,"adupn"))) ;adupn - active directory user principle name
S XATR(11)=$$LOW^XLFSTR($G(XURET(CNT,"email"))) ;va or external email
S XATR(12)=$G(XURET(CNT,"gender")) ;sex/gender
S XATR(13)=$G(XURET(CNT,"dob")) ;date of birth (yyyymmdd)
S XATR(14)=$G(XURET(CNT,"street_1")) ;Street Address 1
S XATR(15)=$G(XURET(CNT,"street_2")) ;Street Address 2
S XATR(16)=$G(XURET(CNT,"street_3")) ;Street Address 3
S XATR(17)=$G(XURET(CNT,"city")) ;City
S XATR(18)=$G(XURET(CNT,"state")) ;State
S XATR(19)=$G(XURET(CNT,"postalCode")) ;Zip
;
; Check for unique identifier (SecID, NPI, SSN, or OID+UID)
I ($G(XATR(7))="")&($G(XATR(8))="")&($G(XATR(9))="")&(($G(XATR(2))="")&($G(XATR(3))="")) Q "-1^Array does not contain a unique identifier"
;
N OID,UID,SECID,NPI,SSN,AOIUID,Y
S OID=$G(XATR(2))
S UID=$G(XATR(3))
S SECID=$G(XATR(7))
S NPI=$G(XATR(8))
S SSN=$G(XATR(9))
S Y=0
;
I $G(SECID)'="" S Y=+$O(^VA(200,"ASECID",$E(SECID,1,30),Y)) I Y S XATR("DUZ",Y,"ASECID")=$E(SECID,1,30)
I $G(NPI)'="" S Y=+$O(^VA(200,"ANPI",NPI,0)) I Y S XATR("DUZ",Y,"NPI")=NPI
I $G(SSN)'="" S Y=+$O(^VA(200,"SSN",SSN,0)) I Y S XATR("DUZ",Y,"SSN")=SSN
I $G(OID)'="",($G(UID)'="") S Y=+$$AOIUID^XUESSO2(OID,UID) I Y S XATR("DUZ",Y,"OIDUID")=OID_"_"_UID
;
;
;multiple users found in vista
I $O(XATR("DUZ",+$O(XATR("DUZ",0)))) D S XUIAMDUZ=-1_"^Possible Duplicate Users" Q XUIAMDUZ
.W !!,"Warning: Multiple users exist in the local VistA instance with the"
.W !?9,"above traits. Please log a Help Desk Ticket and provide the"
.W !?9,"following information to resolve."
.S XUCNT=0
.S XUIAMDUZ="" F S XUIAMDUZ=$O(XATR("DUZ",XUIAMDUZ)) Q:'XUIAMDUZ S XUCNT=XUCNT+1 D
..W !!,XUCNT,".",?3,"Name: ",$$GET1^DIQ(200,XUIAMDUZ_",",.01,"E"),?42,"DISUSER: ",$$GET1^DIQ(200,XUIAMDUZ_",",7,"E"),?57,"Term Date: ",$$GET1^DIQ(200,XUIAMDUZ_",",9.2,"E")
..W !?3,"DUZ: ",XUIAMDUZ
..S XUATTRTYPE="" F S XUATTRTYPE=$O(XATR("DUZ",XUIAMDUZ,XUATTRTYPE)) Q:XUATTRTYPE="" D
...W !?3,$S(XUATTRTYPE="ASECID":"SECID",XUATTRTYPE="NPI":"NPI",XUATTRTYPE="SSN":"SSN",XUATTRTYPE="OIDUID":"OID_UID",1:""),": ",$P(XATR("DUZ",XUIAMDUZ,XUATTRTYPE),"^",1)
;
;
;one user found in vista
I $O(XATR("DUZ",0)) S XUIAMDUZ=+$O(XATR("DUZ",0)) D I XUIAMDUZ<0 Q XUIAMDUZ
.I $G(SOURCEID),(XUIAMDUZ'=SOURCEID) D S XUIAMDUZ=-1_"^Multiple DUZ Issue" Q
..W !!,"Warning: The DUZ of the user at the local VistA instance does not match"
..W !?9,"the DUZ of the user at the Enterprise. Please log a Help Desk"
..W !?9,"Ticket and provide the following information to resolve."
..W !!,"Local VistA User:"
..W !,?3,"Name: ",$$GET1^DIQ(200,XUIAMDUZ_",",.01,"E"),?42,"DISUSER: ",$$GET1^DIQ(200,XUIAMDUZ_",",7,"E"),?57,"Term Date: ",$$GET1^DIQ(200,XUIAMDUZ_",",9.2,"E")
..W !?3,"DUZ: ",XUIAMDUZ
..W !!,"Local VistA User (using DUZ found at Enterprise):"
..W !,?3,"Name: ",$$GET1^DIQ(200,SOURCEID_",",.01,"E"),?42,"DISUSER: ",$$GET1^DIQ(200,SOURCEID_",",7,"E"),?57,"Term Date: ",$$GET1^DIQ(200,SOURCEID_",",9.2,"E")
..W !?3,"DUZ: ",SOURCEID
.;
.W !!,"... user is already known to VistA.",!!,"... updating VistA with traits from Enterprise."
.N XUIAMNPF S XUIAMNPF=1 ;**663 - STORY 1203246 (dri) don't set 'AVIAM' x-ref, only edits outside of this process should appear in NEW PERSON FIELD MONITOR File (#8933.1)
.S ERRMSG=$$UPDU^XUESSO2(.XATR,XUIAMDUZ) ;update local vista fields if differences
.S:(+$G(DUZ)&('+ERRMSG)) ^DISV(DUZ,"^VA(200,")=XUIAMDUZ ;IA #859 (Allow for Space-Bar functionality if record updated by valid user)
;
;
;user isn't known to vista and needs added
I '$O(XATR("DUZ",0)) D
.W !!,"... adding user to VistA."
.N XUIAMNPF S XUIAMNPF=1 ;**663 - STORY 1203246 (dri) don't set 'AVIAM' x-ref when new person is initially added, only edits outside of this process should appear in NEW PERSON FIELD MONITOR File (#8933.1)
.S XUIAMDUZ=$$ADDUSER^XUESSO2(.XATR) ;add person to vista
.I +XUIAMDUZ<0 D W !
..W !!,"... problem adding user to VistA, please log a service ticket for assistance."
..I $P(XUIAMDUZ,"^",2)'="" W !?4,$P(XUIAMDUZ,"^",2) ;error message
.I +XUIAMDUZ'=-1 S XUIAMDUZ=+XUIAMDUZ_"^"_NAME_"^1" ;simulate Fileman return of 'y' with "ien^value of .01^new entry just added"
;
;
;we have a duz, update the enterprise with this site/duz
I XUIAMDUZ>0 D
.;reset "vistaid" to be the newly created vistaid, example format: 112233^PN^463^USDVA
.S XURET(CNT,"vistaid")=+XUIAMDUZ_"^PN^"_$P($$SITE^VASITE(),"^",3)_"^USDVA"
.;
.S XURET(CNT,"WHO")=DUZ_"^PN^"_$P($$SITE^VASITE(),"^",3)_"^USDVA" ;added by
.I $G(XUTERMDT)'="" S XURET(CNT,"termDate")=$$FMTHL7^XLFDT(XUTERMDT) ;optional termination date when doing batch entry
.S XURET(CNT,"REQTYPE")=XUREQTYP ;passing 'add' or 'modify' to ^xuiamxml
.;
.K XUIAM M XUIAM=XURET(CNT) K XURET ;merge traits back to unsubscripted value to pass to psim
.W !!,"... updating Enterprise with traits from VistA.",!
.D SNDUSER^XUIAMXML(.XURET,.XUIAM) ;add person to the enterprise, at this point an error returned in xuret is handled by psim
;
Q XUIAMDUZ
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUIAMPR1 7672 printed Sep 23, 2025@19:45:49 Page 2
XUIAMPR1 ;BHM/DLR,DRI - IAM PROVISIONING - ADD/UPDATE OF A NEW PERSON (CONT) ;1/25/23 18:01
+1 ;;8.0;KERNEL;**799**;Jul 10, 1995;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
FINDUSER(XURET,XUREQTYP,XUTERMDT) ;search vista instance to find user ;**663 - STORY 783347 (dri) **799 VAMPI-22625
+1 ; Input: XURET(#) = Array containing person's attributes
+2 ; XUREQTYP = 'ADD' or 'MODIFY' of a new person
+3 ; XUTERMDT = the optional termination date when doing batch entry of
+4 ; new persons through 'Grant Access by Profile' option
+5 ;
+6 ; Return: Fail = "-1^Error Message"
+7 ; Success = IEN (DUZ) from file #200 if successfully added
+8 ;
+9 ;
+10 NEW CNT,ERRMSG,I,NAME,SOURCEID,VISTAID,XATR,XUATTRTYPE,XUCNT,XUIAMDUZ
+11 ;
+12 ;count of person selected
SET CNT=$ORDER(XURET(0))
+13 ;default email for adupn if the adupn is not returned by psim
IF '$DATA(XURET(CNT,"adupn"))
SET XURET(CNT,"adupn")=$$LOW^XLFSTR($GET(XURET(CNT,"email")))
+14 ;
+15 ;find person's duz known at enterprise
IF $LENGTH($GET(XURET(CNT,"vistaid")),"|")>1
Begin DoDot:1
+16 ;VISTAID should look like 12596^PN^200M^USDVA [userid/duz^source id type^station number^assigning authority].
+17 FOR I=2:3:$LENGTH(XURET(CNT,"vistaid"),"|")
SET VISTAID=$PIECE(XURET(CNT,"vistaid"),"|",I)
IF $PIECE(VISTAID,"^",3)=$PIECE($$SITE^VASITE(),"^",3)
IF ($PIECE(VISTAID,"^",2)="PN")
IF ($PIECE(VISTAID,"^",1)'="")
SET SOURCEID=$PIECE(VISTAID,"^",1)
QUIT
End DoDot:1
+18 ;
+19 ;don't default in subjectOrg or orgId, should be returned by psim
+20 ;$$TITLE^XLFSTR($E("Department Of Veterans Affairs",1,50)) ;subject organization
SET XATR(1)=$GET(XURET(CNT,"subjectOrg"))
+21 ;$$LOW^XLFSTR($E("urn:oid:2.16.840.1.113883.4.349",1,50)) ;subject organization id
SET XATR(2)=$GET(XURET(CNT,"orgId"))
+22 ;unique user id
SET XATR(3)=$TRANSLATE($$LOW^XLFSTR($EXTRACT($GET(XURET(CNT,"secId")),1,40)),"^","%")
+23 SET NAME=$GET(XURET(CNT,"lastName"))_","
IF $GET(XURET(CNT,"firstName"))'=""
SET NAME=NAME_XURET(CNT,"firstName")
IF $GET(XURET(CNT,"middleName"))'=""
SET NAME=NAME_" "_XURET(CNT,"middleName")
+24 ;subject id converted to standard format: name last, first middle
SET XATR(4)=$$FORMAT^XLFNAME7(.NAME,3,35,,0,,,2)
+25 IF $GET(XATR(4))'?1U.E1","1U.E
QUIT "-1^Subject ID could not be converted to 'LAST,FIRST MIDDLE SUFFIX' VistA standard format"
+26 ;S XATR(5)= ;security phrase to establish context option (not implemented)
+27 ;active directory network username
SET XATR(6)=$$UP^XLFSTR($EXTRACT($GET(XURET(CNT,"samacctnm")),1,50))
+28 ;security id
SET XATR(7)=$TRANSLATE($$LOW^XLFSTR($EXTRACT($GET(XURET(CNT,"secId")),1,40)),"^","%")
+29 ;npi
SET XATR(8)=$GET(XURET(CNT,"npi"))
+30 ;ssn
SET XATR(9)=$GET(XURET(CNT,"pnid"))
+31 ;adupn - active directory user principle name
SET XATR(10)=$$LOW^XLFSTR($GET(XURET(CNT,"adupn")))
+32 ;va or external email
SET XATR(11)=$$LOW^XLFSTR($GET(XURET(CNT,"email")))
+33 ;sex/gender
SET XATR(12)=$GET(XURET(CNT,"gender"))
+34 ;date of birth (yyyymmdd)
SET XATR(13)=$GET(XURET(CNT,"dob"))
+35 ;Street Address 1
SET XATR(14)=$GET(XURET(CNT,"street_1"))
+36 ;Street Address 2
SET XATR(15)=$GET(XURET(CNT,"street_2"))
+37 ;Street Address 3
SET XATR(16)=$GET(XURET(CNT,"street_3"))
+38 ;City
SET XATR(17)=$GET(XURET(CNT,"city"))
+39 ;State
SET XATR(18)=$GET(XURET(CNT,"state"))
+40 ;Zip
SET XATR(19)=$GET(XURET(CNT,"postalCode"))
+41 ;
+42 ; Check for unique identifier (SecID, NPI, SSN, or OID+UID)
+43 IF ($GET(XATR(7))="")&($GET(XATR(8))="")&($GET(XATR(9))="")&(($GET(XATR(2))="")&($GET(XATR(3))=""))
QUIT "-1^Array does not contain a unique identifier"
+44 ;
+45 NEW OID,UID,SECID,NPI,SSN,AOIUID,Y
+46 SET OID=$GET(XATR(2))
+47 SET UID=$GET(XATR(3))
+48 SET SECID=$GET(XATR(7))
+49 SET NPI=$GET(XATR(8))
+50 SET SSN=$GET(XATR(9))
+51 SET Y=0
+52 ;
+53 IF $GET(SECID)'=""
SET Y=+$ORDER(^VA(200,"ASECID",$EXTRACT(SECID,1,30),Y))
IF Y
SET XATR("DUZ",Y,"ASECID")=$EXTRACT(SECID,1,30)
+54 IF $GET(NPI)'=""
SET Y=+$ORDER(^VA(200,"ANPI",NPI,0))
IF Y
SET XATR("DUZ",Y,"NPI")=NPI
+55 IF $GET(SSN)'=""
SET Y=+$ORDER(^VA(200,"SSN",SSN,0))
IF Y
SET XATR("DUZ",Y,"SSN")=SSN
+56 IF $GET(OID)'=""
IF ($GET(UID)'="")
SET Y=+$$AOIUID^XUESSO2(OID,UID)
IF Y
SET XATR("DUZ",Y,"OIDUID")=OID_"_"_UID
+57 ;
+58 ;
+59 ;multiple users found in vista
+60 IF $ORDER(XATR("DUZ",+$ORDER(XATR("DUZ",0))))
Begin DoDot:1
+61 WRITE !!,"Warning: Multiple users exist in the local VistA instance with the"
+62 WRITE !?9,"above traits. Please log a Help Desk Ticket and provide the"
+63 WRITE !?9,"following information to resolve."
+64 SET XUCNT=0
+65 SET XUIAMDUZ=""
FOR
SET XUIAMDUZ=$ORDER(XATR("DUZ",XUIAMDUZ))
if 'XUIAMDUZ
QUIT
SET XUCNT=XUCNT+1
Begin DoDot:2
+66 WRITE !!,XUCNT,".",?3,"Name: ",$$GET1^DIQ(200,XUIAMDUZ_",",.01,"E"),?42,"DISUSER: ",$$GET1^DIQ(200,XUIAMDUZ_",",7,"E"),?57,"Term Date: ",$$GET1^DIQ(200,XUIAMDUZ_",",9.2,"E")
+67 WRITE !?3,"DUZ: ",XUIAMDUZ
+68 SET XUATTRTYPE=""
FOR
SET XUATTRTYPE=$ORDER(XATR("DUZ",XUIAMDUZ,XUATTRTYPE))
if XUATTRTYPE=""
QUIT
Begin DoDot:3
+69 WRITE !?3,$SELECT(XUATTRTYPE="ASECID":"SECID",XUATTRTYPE="NPI":"NPI",XUATTRTYPE="SSN":"SSN",XUATTRTYPE="OIDUID":"OID_UID",1:""),": ",$PIECE(XATR("DUZ",XUIAMDUZ,XUATTRTYPE),"^",1)
End DoDot:3
End DoDot:2
End DoDot:1
SET XUIAMDUZ=-1_"^Possible Duplicate Users"
QUIT XUIAMDUZ
+70 ;
+71 ;
+72 ;one user found in vista
+73 IF $ORDER(XATR("DUZ",0))
SET XUIAMDUZ=+$ORDER(XATR("DUZ",0))
Begin DoDot:1
+74 IF $GET(SOURCEID)
IF (XUIAMDUZ'=SOURCEID)
Begin DoDot:2
+75 WRITE !!,"Warning: The DUZ of the user at the local VistA instance does not match"
+76 WRITE !?9,"the DUZ of the user at the Enterprise. Please log a Help Desk"
+77 WRITE !?9,"Ticket and provide the following information to resolve."
+78 WRITE !!,"Local VistA User:"
+79 WRITE !,?3,"Name: ",$$GET1^DIQ(200,XUIAMDUZ_",",.01,"E"),?42,"DISUSER: ",$$GET1^DIQ(200,XUIAMDUZ_",",7,"E"),?57,"Term Date: ",$$GET1^DIQ(200,XUIAMDUZ_",",9.2,"E")
+80 WRITE !?3,"DUZ: ",XUIAMDUZ
+81 WRITE !!,"Local VistA User (using DUZ found at Enterprise):"
+82 WRITE !,?3,"Name: ",$$GET1^DIQ(200,SOURCEID_",",.01,"E"),?42,"DISUSER: ",$$GET1^DIQ(200,SOURCEID_",",7,"E"),?57,"Term Date: ",$$GET1^DIQ(200,SOURCEID_",",9.2,"E")
+83 WRITE !?3,"DUZ: ",SOURCEID
End DoDot:2
SET XUIAMDUZ=-1_"^Multiple DUZ Issue"
QUIT
+84 ;
+85 WRITE !!,"... user is already known to VistA.",!!,"... updating VistA with traits from Enterprise."
+86 ;**663 - STORY 1203246 (dri) don't set 'AVIAM' x-ref, only edits outside of this process should appear in NEW PERSON FIELD MONITOR File (#8933.1)
NEW XUIAMNPF
SET XUIAMNPF=1
+87 ;update local vista fields if differences
SET ERRMSG=$$UPDU^XUESSO2(.XATR,XUIAMDUZ)
+88 ;IA #859 (Allow for Space-Bar functionality if record updated by valid user)
if (+$GET(DUZ)&('+ERRMSG))
SET ^DISV(DUZ,"^VA(200,")=XUIAMDUZ
End DoDot:1
IF XUIAMDUZ<0
QUIT XUIAMDUZ
+89 ;
+90 ;
+91 ;user isn't known to vista and needs added
+92 IF '$ORDER(XATR("DUZ",0))
Begin DoDot:1
+93 WRITE !!,"... adding user to VistA."
+94 ;**663 - STORY 1203246 (dri) don't set 'AVIAM' x-ref when new person is initially added, only edits outside of this process should appear in NEW PERSON FIELD MONITOR File (#8933.1)
NEW XUIAMNPF
SET XUIAMNPF=1
+95 ;add person to vista
SET XUIAMDUZ=$$ADDUSER^XUESSO2(.XATR)
+96 IF +XUIAMDUZ<0
Begin DoDot:2
+97 WRITE !!,"... problem adding user to VistA, please log a service ticket for assistance."
+98 ;error message
IF $PIECE(XUIAMDUZ,"^",2)'=""
WRITE !?4,$PIECE(XUIAMDUZ,"^",2)
End DoDot:2
WRITE !
+99 ;simulate Fileman return of 'y' with "ien^value of .01^new entry just added"
IF +XUIAMDUZ'=-1
SET XUIAMDUZ=+XUIAMDUZ_"^"_NAME_"^1"
End DoDot:1
+100 ;
+101 ;
+102 ;we have a duz, update the enterprise with this site/duz
+103 IF XUIAMDUZ>0
Begin DoDot:1
+104 ;reset "vistaid" to be the newly created vistaid, example format: 112233^PN^463^USDVA
+105 SET XURET(CNT,"vistaid")=+XUIAMDUZ_"^PN^"_$PIECE($$SITE^VASITE(),"^",3)_"^USDVA"
+106 ;
+107 ;added by
SET XURET(CNT,"WHO")=DUZ_"^PN^"_$PIECE($$SITE^VASITE(),"^",3)_"^USDVA"
+108 ;optional termination date when doing batch entry
IF $GET(XUTERMDT)'=""
SET XURET(CNT,"termDate")=$$FMTHL7^XLFDT(XUTERMDT)
+109 ;passing 'add' or 'modify' to ^xuiamxml
SET XURET(CNT,"REQTYPE")=XUREQTYP
+110 ;
+111 ;merge traits back to unsubscripted value to pass to psim
KILL XUIAM
MERGE XUIAM=XURET(CNT)
KILL XURET
+112 WRITE !!,"... updating Enterprise with traits from VistA.",!
+113 ;add person to the enterprise, at this point an error returned in xuret is handled by psim
DO SNDUSER^XUIAMXML(.XURET,.XUIAM)
End DoDot:1
+114 ;
+115 QUIT XUIAMDUZ
+116 ;
