- 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 Jan 18, 2025@02:58:26 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