| 1 | XHDAUTH ; SLC/JER - Authentication calls for HeVD ; 25 Jul 2003  9:42 AM
 | 
|---|
| 2 |  ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
 | 
|---|
| 3 | AUTHNTC(XHDY,ACCESS,VERIFY) ; authenticate user based on access/verify pair
 | 
|---|
| 4 |  N XHD,UID,SPEC,COL,XHDI
 | 
|---|
| 5 |  S (XHD,XHDI)=0
 | 
|---|
| 6 |  S XHDY=$NA(^TMP("XHDCUID",$J)) K @XHDY
 | 
|---|
| 7 |  D XMLHDR(XHDY,.XHDI)
 | 
|---|
| 8 |  S UID=$$CHKAV^XUVERIFY(ACCESS_";"_VERIFY)
 | 
|---|
| 9 |  I '+UID D
 | 
|---|
| 10 |  . S XHDI=XHDI+1
 | 
|---|
| 11 |  . S @XHDY@(XHDI)="<errorText>Invalid Access/Verify Code Pair</errorText>"
 | 
|---|
| 12 |  E  D UIDTBL(XHDY,UID,.XHDI)
 | 
|---|
| 13 |  D XMLFOOT(XHDY,.XHDI)
 | 
|---|
| 14 |  Q
 | 
|---|
| 15 | BYPASS(XHDY) ; get user demographics w/o security
 | 
|---|
| 16 |  N XHD,UID,SPEC,COL,XHDI
 | 
|---|
| 17 |  S (XHD,XHDI)=0,UID=$G(DUZ)
 | 
|---|
| 18 |  S XHDY=$NA(^TMP("XHDCUID",$J)) K @XHDY
 | 
|---|
| 19 |  D XMLHDR(XHDY,.XHDI)
 | 
|---|
| 20 |  I '+UID D
 | 
|---|
| 21 |  . S XHDI=XHDI+1
 | 
|---|
| 22 |  . S @XHDY@(XHDI)="<errorText>Invalid Access/Verify Code Pair</errorText>"
 | 
|---|
| 23 |  E  D UIDTBL(XHDY,UID,.XHDI)
 | 
|---|
| 24 |  D XMLFOOT(XHDY,.XHDI)
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 | XMLHDR(XHDY,XHDI) ; append header
 | 
|---|
| 27 |  S XHDI=XHDI+1
 | 
|---|
| 28 |  S @XHDY@(XHDI)="<result xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""AuthenticateSchema.xsd"">"
 | 
|---|
| 29 |  Q
 | 
|---|
| 30 | XMLFOOT(XHDY,XHDI)        ; append footer
 | 
|---|
| 31 |  S XHDI=XHDI+1
 | 
|---|
| 32 |  S @XHDY@(XHDI)="</result>"
 | 
|---|
| 33 |  Q
 | 
|---|
| 34 | UIDTBL(XHDY,UID,XHDI) ; userIdTable
 | 
|---|
| 35 |  N SSN,NSDA,FNM,LNM,MI,TITLE
 | 
|---|
| 36 |  S NSDA=+$G(^VA(200,UID,3.1))
 | 
|---|
| 37 |  I NSDA D
 | 
|---|
| 38 |  . N NSE
 | 
|---|
| 39 |  . S NSE=$G(^VA(20,NSDA,1)),LNM=$P(NSE,U),FNM=$P(NSE,U,2),MI=$E($P(NSE,U,3))
 | 
|---|
| 40 |  E  D
 | 
|---|
| 41 |  . N NAME
 | 
|---|
| 42 |  . S NAME=$$NAME^XUSER(UID)
 | 
|---|
| 43 |  . S LNM=$$NAME^TIULS(NAME,"LAST"),FNM=$$NAME^TIULS(NAME,"FIRST"),MI=$$NAME^TIULS(NAME,"MI")
 | 
|---|
| 44 |  S SSN=$E($P($G(^VA(200,UID,1)),U,9),6,10)
 | 
|---|
| 45 |  S TITLE=$P($G(^VA(200,UID,20)),U,3)
 | 
|---|
| 46 |  S XHDI=XHDI+1,@XHDY@(XHDI)="<userInfo>"
 | 
|---|
| 47 |  D ADDELEM(XHDY,"uniqueId",UID,.XHDI)
 | 
|---|
| 48 |  D ADDELEM(XHDY,"firstName",FNM,.XHDI)
 | 
|---|
| 49 |  D ADDELEM(XHDY,"lastName",LNM,.XHDI)
 | 
|---|
| 50 |  D ADDELEM(XHDY,"middleInitial",MI,.XHDI)
 | 
|---|
| 51 |  D ADDELEM(XHDY,"title",TITLE,.XHDI)
 | 
|---|
| 52 |  D ADDELEM(XHDY,"lastFourSSN",SSN,.XHDI)
 | 
|---|
| 53 |  S XHDI=XHDI+1,@XHDY@(XHDI)="</userInfo>"
 | 
|---|
| 54 |  Q
 | 
|---|
| 55 |  ;
 | 
|---|
| 56 | ADDELEM(XHDY,TAG,VAL,XHDI)        ; Insert an element with its value
 | 
|---|
| 57 |  S XHDI=XHDI+1,@XHDY@(XHDI)="<"_TAG_$S(VAL']"":"/>",1:">"_$$ESCAPE^XHDLXM(VAL)_"</"_TAG_">")
 | 
|---|
| 58 |  Q
 | 
|---|
| 59 | BUILDROW(COL,RNM) ; Resolve fields for each row
 | 
|---|
| 60 |  S COL(1)=$$ESCAPE^XHDLXM(RNM)
 | 
|---|
| 61 |  Q
 | 
|---|