XHDAUTH ; SLC/JER - Authentication calls for HeVD ; 25 Jul 2003 9:42 AM
;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
AUTHNTC(XHDY,ACCESS,VERIFY) ; authenticate user based on access/verify pair
N XHD,UID,SPEC,COL,XHDI
S (XHD,XHDI)=0
S XHDY=$NA(^TMP("XHDCUID",$J)) K @XHDY
D XMLHDR(XHDY,.XHDI)
S UID=$$CHKAV^XUVERIFY(ACCESS_";"_VERIFY)
I '+UID D
. S XHDI=XHDI+1
. S @XHDY@(XHDI)="<errorText>Invalid Access/Verify Code Pair</errorText>"
E D UIDTBL(XHDY,UID,.XHDI)
D XMLFOOT(XHDY,.XHDI)
Q
BYPASS(XHDY) ; get user demographics w/o security
N XHD,UID,SPEC,COL,XHDI
S (XHD,XHDI)=0,UID=$G(DUZ)
S XHDY=$NA(^TMP("XHDCUID",$J)) K @XHDY
D XMLHDR(XHDY,.XHDI)
I '+UID D
. S XHDI=XHDI+1
. S @XHDY@(XHDI)="<errorText>Invalid Access/Verify Code Pair</errorText>"
E D UIDTBL(XHDY,UID,.XHDI)
D XMLFOOT(XHDY,.XHDI)
Q
XMLHDR(XHDY,XHDI) ; append header
S XHDI=XHDI+1
S @XHDY@(XHDI)="<result xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""AuthenticateSchema.xsd"">"
Q
S XHDI=XHDI+1
S @XHDY@(XHDI)="</result>"
Q
UIDTBL(XHDY,UID,XHDI) ; userIdTable
N SSN,NSDA,FNM,LNM,MI,TITLE
S NSDA=+$G(^VA(200,UID,3.1))
I NSDA D
. N NSE
. S NSE=$G(^VA(20,NSDA,1)),LNM=$P(NSE,U),FNM=$P(NSE,U,2),MI=$E($P(NSE,U,3))
E D
. N NAME
. S NAME=$$NAME^XUSER(UID)
. S LNM=$$NAME^TIULS(NAME,"LAST"),FNM=$$NAME^TIULS(NAME,"FIRST"),MI=$$NAME^TIULS(NAME,"MI")
S SSN=$E($P($G(^VA(200,UID,1)),U,9),6,10)
S TITLE=$P($G(^VA(200,UID,20)),U,3)
S XHDI=XHDI+1,@XHDY@(XHDI)="<userInfo>"
D ADDELEM(XHDY,"uniqueId",UID,.XHDI)
D ADDELEM(XHDY,"firstName",FNM,.XHDI)
D ADDELEM(XHDY,"lastName",LNM,.XHDI)
D ADDELEM(XHDY,"middleInitial",MI,.XHDI)
D ADDELEM(XHDY,"title",TITLE,.XHDI)
D ADDELEM(XHDY,"lastFourSSN",SSN,.XHDI)
S XHDI=XHDI+1,@XHDY@(XHDI)="</userInfo>"
Q
;
ADDELEM(XHDY,TAG,VAL,XHDI) ; Insert an element with its value
S XHDI=XHDI+1,@XHDY@(XHDI)="<"_TAG_$S(VAL']"":"/>",1:">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">")
Q
BUILDROW(COL,RNM) ; Resolve fields for each row
S COL(1)=$$ESCAPE^XHDLXM(RNM)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXHDAUTH 2136 printed Oct 16, 2024@17:58:03 Page 2
XHDAUTH ; SLC/JER - Authentication calls for HeVD ; 25 Jul 2003 9:42 AM
+1 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
AUTHNTC(XHDY,ACCESS,VERIFY) ; authenticate user based on access/verify pair
+1 NEW XHD,UID,SPEC,COL,XHDI
+2 SET (XHD,XHDI)=0
+3 SET XHDY=$NAME(^TMP("XHDCUID",$JOB))
KILL @XHDY
+4 DO XMLHDR(XHDY,.XHDI)
+5 SET UID=$$CHKAV^XUVERIFY(ACCESS_";"_VERIFY)
+6 IF '+UID
Begin DoDot:1
+7 SET XHDI=XHDI+1
+8 SET @XHDY@(XHDI)="<errorText>Invalid Access/Verify Code Pair</errorText>"
End DoDot:1
+9 IF '$TEST
DO UIDTBL(XHDY,UID,.XHDI)
+10 DO XMLFOOT(XHDY,.XHDI)
+11 QUIT
BYPASS(XHDY) ; get user demographics w/o security
+1 NEW XHD,UID,SPEC,COL,XHDI
+2 SET (XHD,XHDI)=0
SET UID=$GET(DUZ)
+3 SET XHDY=$NAME(^TMP("XHDCUID",$JOB))
KILL @XHDY
+4 DO XMLHDR(XHDY,.XHDI)
+5 IF '+UID
Begin DoDot:1
+6 SET XHDI=XHDI+1
+7 SET @XHDY@(XHDI)="<errorText>Invalid Access/Verify Code Pair</errorText>"
End DoDot:1
+8 IF '$TEST
DO UIDTBL(XHDY,UID,.XHDI)
+9 DO XMLFOOT(XHDY,.XHDI)
+10 QUIT
XMLHDR(XHDY,XHDI) ; append header
+1 SET XHDI=XHDI+1
+2 SET @XHDY@(XHDI)="<result xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""AuthenticateSchema.xsd"">"
+3 QUIT
+1 SET XHDI=XHDI+1
+2 SET @XHDY@(XHDI)="</result>"
+3 QUIT
UIDTBL(XHDY,UID,XHDI) ; userIdTable
+1 NEW SSN,NSDA,FNM,LNM,MI,TITLE
+2 SET NSDA=+$GET(^VA(200,UID,3.1))
+3 IF NSDA
Begin DoDot:1
+4 NEW NSE
+5 SET NSE=$GET(^VA(20,NSDA,1))
SET LNM=$PIECE(NSE,U)
SET FNM=$PIECE(NSE,U,2)
SET MI=$EXTRACT($PIECE(NSE,U,3))
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 NEW NAME
+8 SET NAME=$$NAME^XUSER(UID)
+9 SET LNM=$$NAME^TIULS(NAME,"LAST")
SET FNM=$$NAME^TIULS(NAME,"FIRST")
SET MI=$$NAME^TIULS(NAME,"MI")
End DoDot:1
+10 SET SSN=$EXTRACT($PIECE($GET(^VA(200,UID,1)),U,9),6,10)
+11 SET TITLE=$PIECE($GET(^VA(200,UID,20)),U,3)
+12 SET XHDI=XHDI+1
SET @XHDY@(XHDI)="<userInfo>"
+13 DO ADDELEM(XHDY,"uniqueId",UID,.XHDI)
+14 DO ADDELEM(XHDY,"firstName",FNM,.XHDI)
+15 DO ADDELEM(XHDY,"lastName",LNM,.XHDI)
+16 DO ADDELEM(XHDY,"middleInitial",MI,.XHDI)
+17 DO ADDELEM(XHDY,"title",TITLE,.XHDI)
+18 DO ADDELEM(XHDY,"lastFourSSN",SSN,.XHDI)
+19 SET XHDI=XHDI+1
SET @XHDY@(XHDI)="</userInfo>"
+20 QUIT
+21 ;
ADDELEM(XHDY,TAG,VAL,XHDI) ; Insert an element with its value
+1 SET XHDI=XHDI+1
SET @XHDY@(XHDI)="<"_TAG_$SELECT(VAL']"":"/>",1:">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">")
+2 QUIT
BUILDROW(COL,RNM) ; Resolve fields for each row
+1 SET COL(1)=$$ESCAPE^XHDLXM(RNM)
+2 QUIT
