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

XUIAMXML.m

Go to the documentation of this file. 
  1. XUIAMXML ;BHM/DLR,DRI - IAM ENTERPRISE NEW PERSON PROBABILISTIC SEARCH ; Dec 18, 2020@15:00
  1.  ;;8.0;KERNEL;**731**;Jul 10, 1995;Build 0
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1.  ;
  1.  ;Utilizes SPML (Service Provisioning Markup Language) for IAM lookup to
  1.  ;PSIM (Person Services Identity Management)
  1.  ;
  1.  ;**731, VAMPI-8214 (dri) - create api to lookup user by secid and retrieve user traits
  1. USER(RETURN,MPIARR) ; - query PSIM for USER traits
  1.  ; Input (one of the following):
  1.  ;   MPIARR("samacctnm") = SECURITY ACCOUNT MANAGER/NETWORK USERNAME
  1.  ;           or
  1.  ;   MPIARR("VAemail") = ACTIVE DIRECTORY USER PRINCIPLE NAME/EMAIL ADDRESS
  1.  ;           or
  1.  ;   MPIARR("secId") = SECURITY ID
  1.  ;
  1.  ; Output (array of traits):
  1.  ;   RETURN("city")=CITY
  1.  ;   RETURN("dob")=DOB (HL7 format)
  1.  ;   RETURN("email")=EMAIL ADDRESS
  1.  ;   RETURN("firstName")=FIRST NAME
  1.  ;   RETURN("gender")=SEX
  1.  ;   RETURN("identityTheft")="N" or "Y"
  1.  ;   RETURN("lastName")=FAMILY (LAST) NAME
  1.  ;   RETURN("mcid")=PSIM MESSAGE CONTROL ID
  1.  ;   RETURN("middleName")=MIDDLE NAME
  1.  ;   RETURN("orgId")=SUBJECT ORGANIZATION
  1.  ;   RETURN("phone")=PHONE NUMBER
  1.  ;   RETURN("pnid")=PERSON NUMBER IDENTIFIED/SSN
  1.  ;   RETURN("postalCode")=ZIP CODE
  1.  ;   RETURN("samacctnm")=SECURITY ACCOUNT MANAGER/NETWORK USERNAME
  1.  ;   RETURN("secId")=SECURITY ID
  1.  ;   RETURN("state")=STATE
  1.  ;   RETURN("street_1")=STREET ADDRESS 1
  1.  ;   RETURN("subjectOrg")=SUBJECT ORGANIZATION
  1.  ;   RETURN("vauid")=VA ACTIVE DIRECTORY UNIQUE ID (for 200AD)
  1.  ;   RETURN("vistaid")=STATION NUMBER|USERID or DUZ^SOURCE ID TYPE^STATION NUMBER^ASSIGNING AUTHORITY| (repeating)
  1.  ;
  1.  ; Example calling api:
  1.  ;   S MPIARR("VAemail")="first.lastname@domain.ext"
  1.  ;             or
  1.  ;   S MPIARR("samacctnm")="VHAMOCLASTNAMEF"
  1.  ;             or
  1.  ;   S MPIARR("secId")=##########
  1.  ;
  1.  ;   D USER^XUIAMXML(.RETURN,.MPIARR)
  1.  ;   ZW RETURN ;returns array of traits
  1.  ;
  1.  ;
  1.  N MPIXML,MPIXMLR,MPID,MPIPAT
  1.  K RETURN
  1.  S MPIXML=$$SXMLBLD(.MPIARR) ;build spml search request
  1.  D POST(MPIXML,.MPIXMLR) ;send spml to psim
  1.  I '$D(MPIXMLR) S RETURN="-1^Unable to communicate with the Enterprise Database." Q
  1.  D SPARSE(.RETURN,.MPIXMLR) ;parse psim response of returned spml
  1.  ;
  1.  ;I $D(RETURN("dob")) S RETURN("dob")=$$HL7TFM^XLFDT(RETURN("dob")) ;leave dob in hl7 format
  1.  ;
  1.  Q
  1.  ;
  1. SNDUSER(RETURN,MPIARR) ; - update PSIM with USER traits
  1.  ; Input
  1.  ;   MPIARR - Array of trait(s) to update
  1.  ; Output
  1.  ;   RETURN - Array of traits psim has
  1.  ;
  1.  N MPIXML,MPIXMLR,MPID,MPIPAT
  1.  K RETURN
  1.  S MPIXML=$$AXMLBLD(.MPIARR) ;build spml for psim
  1.  D POST(MPIXML,.MPIXMLR) ;send spml to psim
  1.  I '$D(MPIXMLR) S RETURN="-1^Unable to communicate with the Enterprise Database." Q
  1.  D SPARSE(.RETURN,.MPIXMLR) ;parse psim response of returned spml
  1.  ;
  1.  ;I $D(RETURN("dob")) S RETURN("dob")=$$HL7TFM^XLFDT(RETURN("dob")) ;leave dob in hl7 format
  1.  ;I $D(RETURN("subjectOrg")) S RETURN("subjectOrg")=$$TITLE^XLFSTR($E(RETURN("subjectOrg"),1,50)) ;subject organization sometimes coming from adr improperly formatted
  1.  ;
  1.  Q
  1.  ;
  1. SXMLBLD(MPIARR) ; setup xml to search for user
  1.  ; Input:
  1.  ;   MPIARR - Array of traits for search
  1.  ;
  1.  ; Output:
  1.  ;   XML for the search
  1.  ;
  1.  ; $$SITE^VASITE - IA #10112
  1.  ;
  1.  N MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID
  1.  S QUOTE=""""
  1.  S MPISITE=$P($$SITE^VASITE,"^",3)
  1.  S MPIPRID=$P($$PARAM^HLCS2,"^",3)
  1.  S MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT)
  1.  I $G(DUZ)>0 S MPIDUZ=$P(^VA(200,DUZ,0),"^") D STDNAME^XLFNAME(.MPIDUZ,"C")
  1.  S MPITHRES=80
  1.  ;
  1.  ; heading
  1.  S MPIXML="<spml:lookupRequest requestID="_QUOTE_516.2018053111223344_QUOTE_" returnData="_QUOTE_"data"_QUOTE_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_">"
  1.  I $G(MPIARR("secId"))'="" S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_MPIARR("secId")_"^PN^200PROV^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>" ;lookup secid
  1.  I $G(MPIARR("secId"))="" S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_$S($G(MPIARR("VAemail"))'="":MPIARR("VAemail"),1:$G(MPIARR("samacctnm")))_"^PN^200AD^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>" ;or lookup by vaemail or samacctnm
  1.  S MPIXML=MPIXML_"</spml:lookupRequest>"
  1.  ;
  1.  K MPIARR("MPIVar")
  1.  Q MPIXML
  1.  ;
  1. MSGID() ;
  1.  N XUNOW
  1.  S XUNOW=$$NOW^XLFDT
  1.  Q $P($$SITE^VASITE,"^",3)_"."_$P(XUNOW,".",1)_$P(XUNOW,".",2)_$J_$R(999999)
  1.  ;
  1. AXMLBLD(MPIARR) ; setup xml to add or modify a user
  1.  ; Input:
  1.  ;   MPIARR - Array of traits for IAM search
  1.  ;
  1.  ; Output:
  1.  ;   XML for the add or modify
  1.  ;
  1.  ; $$SITE^VASITE - IA #10112
  1.  ;
  1.  N MPIPRID,MPISITE,MPIXML,QUOTE
  1.  S QUOTE=""""
  1.  S MPISITE=$P($$SITE^VASITE,"^",3) ;station number
  1.  S MPIPRID=$P($$PARAM^HLCS2,"^",3) ;'p'roduction or 't'est
  1.  ;
  1.  ; heading
  1.  S MPIXML="<spml:"_$S(MPIARR("REQTYPE")="ADD":"addRequest",1:"modifyRequest")_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" requestID="_QUOTE_$$MSGID()_QUOTE_">"
  1.  S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_MPIARR("vistaid")_QUOTE_"></spml:psoID>"
  1.  I MPIARR("REQTYPE")="MODIFY" S MPIXML=MPIXML_"<spml:modification modificationMode="_QUOTE_"replace"_QUOTE_">"
  1.  S MPIXML=MPIXML_"<spml:data>"
  1.  S MPIXML=MPIXML_"<spml:user>"
  1.  S MPIXML=MPIXML_"<spml:environment>"_MPIPRID_"</spml:environment>"
  1.  ;don't default in subjectOrg or orgId, should be returned by psim
  1.  D IFADD("subjectOrg",.MPIARR,.MPIXML,"spml:subjectOrg") ;S MPIXML=MPIXML_"<spml:subjectOrg>Department Of Veterans Affairs</spml:subjectOrg>"
  1.  D IFADD("orgId",.MPIARR,.MPIXML,"spml:orgId") ;S MPIXML=MPIXML_"<spml:orgId>urn:oid:2.16.840.1.113883.4.349</spml:orgId>"
  1.  ;
  1.  ; user data
  1.  D IFADD("firstName",.MPIARR,.MPIXML,"spml:firstName")
  1.  D IFADD("middleName",.MPIARR,.MPIXML,"spml:middleName")
  1.  D IFADD("lastName",.MPIARR,.MPIXML,"spml:lastName")
  1.  ;
  1.  D IFADD("gender",.MPIARR,.MPIXML,"spml:gender")
  1.  D IFADD("dob",.MPIARR,.MPIXML,"spml:dob")
  1.  D IFADD("adUPN",.MPIARR,.MPIXML,"spml:adUPN")
  1.  D IFADD("email",.MPIARR,.MPIXML,"spml:email")
  1.  D IFADD("disabled",.MPIARR,.MPIXML,"spml:disabled") ;disuser
  1.  D IFADD("termDate",.MPIARR,.MPIXML,"spml:termDate") ;termination date
  1.  D IFADD("pnid",.MPIARR,.MPIXML,"spml:ssn") ;ssn
  1.  D IFADD("secId",.MPIARR,.MPIXML,"spml:secId")
  1.  D IFADD("uid",.MPIARR,.MPIXML,"spml:uid")
  1.  D IFADD("npi",.MPIARR,.MPIXML,"spml:npi")
  1.  D IFADD("samAccountName",.MPIARR,.MPIXML,"spml:samAccountName")
  1.  D IFADD("lastAccess",.MPIARR,.MPIXML,"spml:lastAccess")
  1.  ;
  1.  S MPIXML=MPIXML_"</spml:user>"
  1.  S MPIXML=MPIXML_"</spml:data>"
  1.  ;
  1.  S MPIXML=MPIXML_"<spml:capabilityData>"
  1.  S MPIXML=MPIXML_"<spml:operationData requestor="_QUOTE_MPIARR("WHO")_QUOTE_">"
  1.  S MPIXML=MPIXML_"</spml:operationData>"
  1.  S MPIXML=MPIXML_"</spml:capabilityData>"
  1.  I MPIARR("REQTYPE")="MODIFY" S MPIXML=MPIXML_"</spml:modification>"
  1.  S MPIXML=MPIXML_"</spml:"_$S(MPIARR("REQTYPE")="ADD":"addRequest",1:"modifyRequest")_">"
  1.  ;
  1.  Q MPIXML
  1.  ;
  1. IFADD(MPIVAR,MPIARR,MPIXML,MPIXMLN) ;check if there, if so add it to the XML
  1.  ; MPIVAR is the MPIARR variable name
  1.  ; MPIXMLN is the name of the XML to encase
  1.  ; modifies MPIXML to add if it is there
  1.  I $G(MPIARR(MPIVAR))'="" D
  1.  . S MPIXML=MPIXML_"<"_MPIXMLN_">"_MPIARR(MPIVAR)_"</"_MPIXMLN_">"
  1.  Q
  1.  ;
  1. CONV(FIELD) ;check for &, ', > and <
  1.  I FIELD["&" S FIELD=$P(FIELD,"&")_"&"_$P(FIELD,"&",2)
  1.  I FIELD["'" S FIELD=$P(FIELD,"'")_"'"_$P(FIELD,"'",2)
  1.  S:(FIELD["<") FIELD=$$CONVA(FIELD,"<")
  1.  S:(FIELD[">") FIELD=$$CONVA(FIELD,">")
  1.  Q FIELD
  1.  ;
  1. CONVA(FIELD,ENCHAR) ;handle <<pob city>>
  1.  N I,X,VAL
  1.  S VAL="",I=$L(FIELD,ENCHAR) F X=1:1:I S VAL=VAL_$P(FIELD,ENCHAR,X)
  1.  Q VAL
  1.  ;
  1. SPARSE(MPIDATA,MPIXML) ; - parse the data
  1.  ;
  1.  ; EN^MXMLPRSE - IA #4149
  1.  ;
  1.  K ^TMP($J,"XUIAMXML_PARSE")
  1.  N MPICB,MPIUSE,MPIVAR,MPIPAT,MPIALIAS,MPILOC,MPIIDS
  1.  S (MPIPAT,MPIIDS)=0
  1.  S MPICB("STARTELEMENT")="SE^XUIAMXML"
  1.  S MPICB("CHARACTERS")="VALUE^XUIAMXML"
  1.  S ^TMP($J,"XUIAMXML_PARSE",1)=MPIXML
  1.  D EN^MXMLPRSE($NA(^TMP($J,"XUIAMXML_PARSE")),.MPICB)
  1.  K ^TMP($J,"XUIAMXML_PARSE")
  1.  Q
  1.  ;
  1. SE(MPIN,MPIA) ; - used for the parser to call back with STARTELEMENT
  1.  ;
  1.  ; just to protect the process
  1.  S MPIN=$G(MPIN)
  1.  S MPIVAR=""""_MPIN_""""
  1.  S MPILOC="MPIDATA("
  1.  S MPIA("error")=$G(MPIA("error"))
  1.  S MPIA("lastName")=$G(MPIA("lastName"))
  1.  S MPIA("middleName")=$G(MPIA("middleName"))
  1.  S MPIA("firstName")=$G(MPIA("firstName"))
  1.  S MPIA("dob")=$G(MPIA("dob"))
  1.  S MPIA("pnid")=$G(MPIA("pnid"))
  1.  S MPIA("secId")=$G(MPIA("secId"))
  1.  S MPIA("dob")=$G(MPIA("dob"))
  1.  S MPIA("vistaid")=$G(MPIA("vistaid"))
  1.  S MPIA("gender")=$G(MPIA("gender"))
  1.  ; my variable to protect
  1.  ;I MPIN="user" S MPIPAT=MPIPAT+1,MPIALIAS=0,MPILOC="MPIDATA("_MPIPAT Q
  1.  S MPIUSE=$G(MPIUSE)
  1.  ;
  1.  ; got a business rule error
  1.  ;I MPIN="RESULT",MPIA("type")="AA",MPIA("subtype")="QE" S MPIDATA("Result")="QE" Q
  1.  ; don't use these
  1.  ;
  1.  Q
  1.  ;
  1. VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
  1.  S:$D(MPIVAR) @(MPILOC_MPIVAR_")")=MPIT K MPIVAR Q
  1.  Q
  1.  ;
  1. POST(MPIXML,MPIXMLR) ; - post XML to the execute server
  1.  ; $$GETPROXY^XOBWLIB - IA #5421
  1.  N $ETRAP,$ESTACK,SVC
  1.  ; set error trap
  1.  S $ETRAP="DO ERROR^XUIAMXML"
  1.  ; test mode (outgoing)?
  1.  I $D(^XTMP("XUIAMXML_EDIT")) D TEST("OUTGOING",.MPIXML)
  1.  ; make the call
  1.  ;**63 STORY 317469 HTTPS OR HTTP
  1.  S SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_NEW EXECUTE","MPI_PSIM_NEW EXECUTE")
  1.  S MPIXMLR=SVC.execute(MPIXML)
  1.  ; in case debugging needed, save both out and return
  1.  I $D(^XTMP("XUIAMXML_DEBUG")) D
  1.  .N XUIAMSAVE
  1.  .S XUIAMSAVE=$O(^XTMP("XUIAMXML_DEBUG",":"),-1)+1
  1.  .S ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,0)=$$NOW^XLFDT
  1.  .S ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"OUT")=MPIXML
  1.  .S ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"RETURN")=MPIXMLR
  1.  ; test mode (return)?
  1.  I $D(^XTMP("XUIAMXML_EDIT")) D TEST("RETURN",.MPIXMLR)
  1.  Q
  1.  ;
  1. ERROR ; - catch errors
  1.  ; Set ecode to empty to return to calling function
  1.  ;
  1.  ; $$EOFAC^XOBWLIB, ZTER^XOBWLIB - IA #5421
  1.  ; UNWIND^%ZTER - IA #1621
  1.  N MPIERR
  1.  S MPIERR=$$EOFAC^XOBWLIB()
  1.  D ZTER^XOBWLIB(MPIERR)
  1.  S $ECODE=""
  1.  D UNWIND^%ZTER
  1.  Q
  1.  ;
  1. TEST(TYPE,MPIXML) ; - call to possibly edit the xml string
  1.  ; used for testing purposes only.
  1.  ; production NOT allowed
  1.  I $$PROD^XUPROD Q
  1.  I $E($G(IOST),1,2)'="C-" Q
  1.  ;
  1.  N DIC,X,L,T,C,%,%Y
  1.  W !!,"Do you want to edit the "_TYPE_" XML"
  1.  S %=2 D YN^DICN I %'=1 Q
  1.  K ^TMP("XUIAMXML_TEST",$J)
  1.  S L=0,T=""
  1.  F X=1:1 S C=$E(MPIXML,X) Q:C=""  D
  1.  . I C="<",T'="" S L=L+1,^TMP("XUIAMXML_TEST",$J,L,0)=T,T=C Q
  1.  . S T=T_C
  1.  S DIC="^TMP(""XUIAMXML_TEST"",$J,"
  1.  D EN^DIWE
  1.  S MPIXML=""
  1.  S X=0 F  S X=$O(^TMP("XUIAMXML_TEST",$J,X)) Q:'X  S MPIXML=MPIXML_^TMP("XUIAMXML_TEST",$J,X,0)
  1.  Q
  1.  ;