XOBSCAV ;; kec/oak/TECHNATOMY/PB - VistaLink Access/Verify Security ; 12/09/2002 17:00
;;1.6;VistALink Security;**3,4**;May 08, 2009;Build 3
; ;Per VA Directive 6402, this routine should not be modified.
Q
;
; ---------------------------------------------------------------------
; Access/Verify Security: Security Message Request Handler
; (main entry point; utilities; constants)
; ---------------------------------------------------------------------
;
; ==== main entry point ====
;
EN(XOBDATA) ; -- handle parsed messages request
;
I XOBDATA("XOB SECAV","SECURITYTYPE")'=$$MSGTYP^XOBSCAV("request") D Q
.;this routine should never see a message not of this type.
.N XOBSPAR S XOBSPAR(1)=$$MSGTYP^XOBSCAV("request"),XOBSPAR(2)=XOBDATA("SECURITYTYPE")
.D ERROR(.XOBR,$P($T(FCLIENT),";;",2),"Unexpected Message Format",183001,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183001,.XOBSPAR)))
;
;---- now process each security message type ----
I XOBDATA("XOB SECAV","SECURITYACTION")=$P($T(MSGSETUP),";;",2) D SENDITXT^XOBSCAV1 Q
I XOBDATA("XOB SECAV","SECURITYACTION")=$P($T(MSGLGON),";;",2) D LOGON^XOBSCAV1 Q
;added line below to process saml token for 2FA
I XOBDATA("XOB SECAV","SECURITYACTION")=$P($T(MSGLGON1),";;",2) D LOGON^XOBSCAV1 Q
I XOBDATA("XOB SECAV","SECURITYACTION")=$P($T(MSGLGOUT),";;",2) D LOGOUT^XOBSCAV1 Q
I XOBDATA("XOB SECAV","SECURITYACTION")=$P($T(MSGSELDV),";;",2) D DIVSLCT^XOBSCAV1 Q
I XOBDATA("XOB SECAV","SECURITYACTION")=$P($T(MSGUPDVC),";;",2) D SENDNVC^XOBSCAV2 Q
I XOBDATA("XOB SECAV","SECURITYACTION")=$P($T(MSGUSERD),";;",2) D SENDDEM^XOBSCAV2 Q
;
; done processing all known message types
N XOBSPAR S XOBSPAR(1)=XOBDATA("XOB SECAV","SECURITYACTION")
D ERROR(.XOBR,$P($T(FCLIENT),";;",2),"Unexpected Message Format",183002,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183002,.XOBSPAR)))
Q
;
; ==== utilities ====
;
SENDSEC(XOBR,XOBMSGTP,XOBRSTYP,XOBMSG,XOBSTAT,XOBSCHEM) ; -- stream XML security reply back
;
; XOBR: internal VistaLink variable
; XOBMSGTP: type of message (e.g., gov.va.med.foundations.security.response)
; XOBRSTYP: type of response (e.g., AV.SetupAndIntroText)
; XOBMSG: message lines to send inside standard wrapper
; XOBSTAT: type of result (e.g., success)
; XOBSCHEM: noNamespaceSchemaLocation
;
N XOBFILL
; -- prepare socket for writing
D PRE^XOBVSKT
; -- write XML header tag and VistaLink tag
D WRITE^XOBVSKT($$ENVHDR^XOBVLIB(XOBMSGTP,XOBSCHEM))
; -- write SecurityInfo tag
D WRITE^XOBVSKT("<SecurityInfo version="""_$P($T(VRSNSEC),";;",2)_""" />")
; -- write Response opening tag
D WRITE^XOBVSKT("<Response type="""_XOBRSTYP_""" status="""_XOBSTAT_""">")
; -- write lines of message passed in
N XOBI S XOBI=0 F S XOBI=$O(XOBMSG(XOBI)) Q:'+XOBI D WRITE^XOBVSKT(XOBMSG(XOBI))
; -- write closing Response tag, closing VistaLink tag
D WRITE^XOBVSKT("</Response>")
D WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
; -- send eot and flush buffer
D POST^XOBVSKT
;
K XOBDATA("XOB SECAV")
Q
;
ERROR(XOBR,XOBFCODE,XOBFSTR,XOBCODE,XOBSTR) ; -- send security error back to client
;
; XOBR: internal VistaLink variable
; XOBFCODE: the fault code
; XOBFSTRING: the fault string
; XOBCODE: error code
; XOBSTR: error message
;
N XOBFILL
; -- prepare socket for writing
D PRE^XOBVSKT
; -- write XML header tag and VistaLink tag
D WRITE^XOBVSKT($$ENVHDR^XOBVLIB($P($T(ERRTYPE^XOBSCAV),";;",2),$P($T(SCHERROR^XOBSCAV),";;",2)))
; -- write SecurityInfo tag
D WRITE^XOBVSKT("<SecurityInfo version="""_$P($T(VRSNSEC),";;",2)_""" />")
; -- write fault message
D WRITE^XOBVSKT("<Fault>")
D WRITE^XOBVSKT("<FaultCode>"_XOBFCODE_"</FaultCode>")
D WRITE^XOBVSKT("<FaultString>"_XOBFSTR_"</FaultString>")
D WRITE^XOBVSKT("<Detail>")
D WRITE^XOBVSKT("<Error code="""_XOBCODE_""">")
D WRITE^XOBVSKT("<Message>"_XOBSTR_"</Message>")
D WRITE^XOBVSKT("</Error>")
D WRITE^XOBVSKT("</Detail>")
D WRITE^XOBVSKT("</Fault>")
D WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
; -- send eot and flush buffer
D POST^XOBVSKT
; -- log the error/fault unless it's "too many invalid login attempts"
I XOBCODE'=183005 D
.S:$D(XOBDATA("XOB SECAV","AVCODE")) XOBDATA("XOB SECAV","AVCODE")="<masked>"
.S:$D(XOBDATA("XOB SECAV","OLDVC")) XOBDATA("XOB SECAV","OLDVC")="<masked>"
.S:$D(XOBDATA("XOB SECAV","NEWVC")) XOBDATA("XOB SECAV","NEWVC")="<masked>"
.S:$D(XOBDATA("XOB SECAV","NEWVCCHECK")) XOBDATA("XOB SECAV","NEWVCCHECK")="<masked>"
.D APPERROR^%ZTER("VistALink Error ") ;XOBV*1.6*4
K XOBDATA("XOB SECAV")
Q
;
POSTTXT(XOBRET,XOBMSG) ; -- adds the post-sign-in-text to a message being prepared
N XOBI,XOBLINE,XOBCNT
S XOBCNT="",XOBLINE=1 F S XOBCNT=$O(XOBMSG(XOBCNT)) Q:XOBCNT']"" S XOBLINE=XOBCNT
S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<PostSignInText>"
; only return post sign in text if the signon says that the text line count is > 0
; (even if, past XOBRET(5), there are actually messages from the post-sign-in text)
I XOBRET(5)>0 D
.S XOBI=5 F S XOBI=$O(XOBRET(XOBI)) Q:XOBI']"" D
..S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<Line>"_$$CHARCHK^XOBVLIB(XOBRET(XOBI))_"</Line>"
S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="</PostSignInText>"
Q XOBLINE
;
ADDDIVS(XOBRET,XOBMSG) ; -- adds division list to a message being prepared
N XOBI,XOBLINE,XOBCNT,XOBDEF
S XOBCNT="",XOBLINE=1 F S XOBCNT=$O(XOBMSG(XOBCNT)) Q:XOBCNT']"" S XOBLINE=XOBCNT
;
S XOBDEF=$O(^VA(200,DUZ,2,"AX1",1,"")) ; default division if any. Use of ^VA(200,,2,"AX1"): DBIA #4058
S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<"_$P($T(PARTTAG),";;",2)_" needDivisionSelection=""true"">"
S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<Divisions>"
S XOBI=0 F S XOBI=$O(XOBDIVS(XOBI)) Q:XOBI']"" D
.S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<Division ien="""_$P(XOBDIVS(XOBI),U)_""" divName="""_$$CHARCHK^XOBVLIB($P(XOBDIVS(XOBI),U,2))_""" divNumber="""_$$CHARCHK^XOBVLIB($P(XOBDIVS(XOBI),U,3))_""""
.S:($P(XOBDIVS(XOBI),U)=XOBDEF) XOBMSG(XOBLINE)=XOBMSG(XOBLINE)_" default=""true"" "
.S XOBMSG(XOBLINE)=XOBMSG(XOBLINE)_" />"
S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="</Divisions>"
S XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)=" </"_$P($T(PARTTAG),";;",2)_">"
;
Q XOBLINE
;
LOGGEDON() ; -- checks if the environment was previously properly set up, e.g.,
; logon succeeded in some previous call
Q +$G(DUZ)
;
CRCONTXT(XOBOPTNM) ; -- create the context if it doesn't already exist
; INPUT VALUE: XOBOPTNM encoded with Kernel encoding algorithm
; RETURN VALUE: +result will be 1 if successful, or 0 if unsuccessful
; if unsuccessful, result may (or may not) also contain the textual reason for failure
;
; Accessing, Setting and Killing of XQY and XQY0: DBIA #4059
;
N XOBRSLT,XOBOPTN1
;
S XOBOPTN1=$$DECRYP^XUSRB1(XOBOPTNM)
; -- if context already set, quit 1
I $L($G(XQY0)),XQY0=XOBOPTN1 Q 1
; -- if param is empty string, then kill off the context
I XOBOPTN1="" K XQY0,XQY Q 1
; -- otherwise try to create the context
D CRCONTXT^XWBSEC(.XOBRSLT,XOBOPTNM) ; use of CRCONTXT^XWBSEC: DBIA #4053
; -- return the result
Q XOBRSLT
;
CHKCTXT(XOBRPCNM) ; -- does user have access to RPC?
N XWBSEC
D CHKPRMIT^XWBSEC(XOBRPCNM) ; use of CHKPRMIT^XWBSEC: DBIA # 4053
Q:'+$L($G(XWBSEC)) 1
Q XWBSEC
;
; ==== Constants ====
;
MSGTYP(XOBRQRS) ; return request message type
I XOBRQRS="request" Q $P($T(REQTYPE),";;",2)
I XOBRQRS="response" Q $P($T(RESTYPE),";;",2)
I XOBRQRS="error" Q $P($T(ERRTYPE),";;",2)
Q ""
SUCCESS() ; resulttype
Q $P($T(RESTYPES+1),";;",2)
FAILURE() ;
Q $P($T(RESTYPES+2),";;",2)
PARTIAL() ;
Q $P($T(RESTYPES+3),";;",2)
;
RESTYPES ;Result types
;;success
;;failure
;;partialSuccess
;
;Message types
REQTYPE ;;gov.va.med.foundations.security.request
RESTYPE ;;gov.va.med.foundations.security.response
ERRTYPE ;;gov.va.med.foundations.security.fault
;
;Message response types
MSGSETUP ;;AV.SetupAndIntroText
MSGLGON ;;AV.Logon
MSGLGON1 ;;SAML.Logon
MSGLGOUT ;;AV.Logout
MSGSELDV ;;AV.SelectDivision
MSGUPDVC ;;AV.UpdateVC
MSGUSERD ;;AV.GetUserDemographics
;
;Attribute values for response XML messages
VRSNSEC ;;1.0
;
;XML Tag names
PARTTAG ;;PartialSuccessData
MSGTAG ;;Message
;
;XML Schemas
SCHERROR ;;secFault.xsd
SCHLGON ;;secLogonResponse.xsd
SCHPARTS ;;secPartialSuccessResponse.xsd
SCHSETUP ;;secSetupIntroResponse.xsd
SCHSIMPL ;;secSimpleResponse.xsd
SCHUSERD ;;secUserDemographicsResponse.xsd
;
;Faultcodes
FSERVER ;;Server
FCLIENT ;;Client
FVERSION ;;VersionMismatch
FUNDERST ;;MustUnderstand
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBSCAV 8623 printed Oct 16, 2024@18:45:20 Page 2
XOBSCAV ;; kec/oak/TECHNATOMY/PB - VistaLink Access/Verify Security ; 12/09/2002 17:00
+1 ;;1.6;VistALink Security;**3,4**;May 08, 2009;Build 3
+2 ; ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; ---------------------------------------------------------------------
+6 ; Access/Verify Security: Security Message Request Handler
+7 ; (main entry point; utilities; constants)
+8 ; ---------------------------------------------------------------------
+9 ;
+10 ; ==== main entry point ====
+11 ;
EN(XOBDATA) ; -- handle parsed messages request
+1 ;
+2 IF XOBDATA("XOB SECAV","SECURITYTYPE")'=$$MSGTYP^XOBSCAV("request")
Begin DoDot:1
+3 ;this routine should never see a message not of this type.
+4 NEW XOBSPAR
SET XOBSPAR(1)=$$MSGTYP^XOBSCAV("request")
SET XOBSPAR(2)=XOBDATA("SECURITYTYPE")
+5 DO ERROR(.XOBR,$PIECE($TEXT(FCLIENT),";;",2),"Unexpected Message Format",183001,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183001,.XOBSPAR)))
End DoDot:1
QUIT
+6 ;
+7 ;---- now process each security message type ----
+8 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGSETUP),";;",2)
DO SENDITXT^XOBSCAV1
QUIT
+9 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGLGON),";;",2)
DO LOGON^XOBSCAV1
QUIT
+10 ;added line below to process saml token for 2FA
+11 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGLGON1),";;",2)
DO LOGON^XOBSCAV1
QUIT
+12 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGLGOUT),";;",2)
DO LOGOUT^XOBSCAV1
QUIT
+13 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGSELDV),";;",2)
DO DIVSLCT^XOBSCAV1
QUIT
+14 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGUPDVC),";;",2)
DO SENDNVC^XOBSCAV2
QUIT
+15 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGUSERD),";;",2)
DO SENDDEM^XOBSCAV2
QUIT
+16 ;
+17 ; done processing all known message types
+18 NEW XOBSPAR
SET XOBSPAR(1)=XOBDATA("XOB SECAV","SECURITYACTION")
+19 DO ERROR(.XOBR,$PIECE($TEXT(FCLIENT),";;",2),"Unexpected Message Format",183002,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183002,.XOBSPAR)))
+20 QUIT
+21 ;
+22 ; ==== utilities ====
+23 ;
SENDSEC(XOBR,XOBMSGTP,XOBRSTYP,XOBMSG,XOBSTAT,XOBSCHEM) ; -- stream XML security reply back
+1 ;
+2 ; XOBR: internal VistaLink variable
+3 ; XOBMSGTP: type of message (e.g., gov.va.med.foundations.security.response)
+4 ; XOBRSTYP: type of response (e.g., AV.SetupAndIntroText)
+5 ; XOBMSG: message lines to send inside standard wrapper
+6 ; XOBSTAT: type of result (e.g., success)
+7 ; XOBSCHEM: noNamespaceSchemaLocation
+8 ;
+9 NEW XOBFILL
+10 ; -- prepare socket for writing
+11 DO PRE^XOBVSKT
+12 ; -- write XML header tag and VistaLink tag
+13 DO WRITE^XOBVSKT($$ENVHDR^XOBVLIB(XOBMSGTP,XOBSCHEM))
+14 ; -- write SecurityInfo tag
+15 DO WRITE^XOBVSKT("<SecurityInfo version="""_$PIECE($TEXT(VRSNSEC),";;",2)_""" />")
+16 ; -- write Response opening tag
+17 DO WRITE^XOBVSKT("<Response type="""_XOBRSTYP_""" status="""_XOBSTAT_""">")
+18 ; -- write lines of message passed in
+19 NEW XOBI
SET XOBI=0
FOR
SET XOBI=$ORDER(XOBMSG(XOBI))
if '+XOBI
QUIT
DO WRITE^XOBVSKT(XOBMSG(XOBI))
+20 ; -- write closing Response tag, closing VistaLink tag
+21 DO WRITE^XOBVSKT("</Response>")
+22 DO WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
+23 ; -- send eot and flush buffer
+24 DO POST^XOBVSKT
+25 ;
+26 KILL XOBDATA("XOB SECAV")
+27 QUIT
+28 ;
ERROR(XOBR,XOBFCODE,XOBFSTR,XOBCODE,XOBSTR) ; -- send security error back to client
+1 ;
+2 ; XOBR: internal VistaLink variable
+3 ; XOBFCODE: the fault code
+4 ; XOBFSTRING: the fault string
+5 ; XOBCODE: error code
+6 ; XOBSTR: error message
+7 ;
+8 NEW XOBFILL
+9 ; -- prepare socket for writing
+10 DO PRE^XOBVSKT
+11 ; -- write XML header tag and VistaLink tag
+12 DO WRITE^XOBVSKT($$ENVHDR^XOBVLIB($PIECE($TEXT(ERRTYPE^XOBSCAV),";;",2),$PIECE($TEXT(SCHERROR^XOBSCAV),";;",2)))
+13 ; -- write SecurityInfo tag
+14 DO WRITE^XOBVSKT("<SecurityInfo version="""_$PIECE($TEXT(VRSNSEC),";;",2)_""" />")
+15 ; -- write fault message
+16 DO WRITE^XOBVSKT("<Fault>")
+17 DO WRITE^XOBVSKT("<FaultCode>"_XOBFCODE_"</FaultCode>")
+18 DO WRITE^XOBVSKT("<FaultString>"_XOBFSTR_"</FaultString>")
+19 DO WRITE^XOBVSKT("<Detail>")
+20 DO WRITE^XOBVSKT("<Error code="""_XOBCODE_""">")
+21 DO WRITE^XOBVSKT("<Message>"_XOBSTR_"</Message>")
+22 DO WRITE^XOBVSKT("</Error>")
+23 DO WRITE^XOBVSKT("</Detail>")
+24 DO WRITE^XOBVSKT("</Fault>")
+25 DO WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
+26 ; -- send eot and flush buffer
+27 DO POST^XOBVSKT
+28 ; -- log the error/fault unless it's "too many invalid login attempts"
+29 IF XOBCODE'=183005
Begin DoDot:1
+30 if $DATA(XOBDATA("XOB SECAV","AVCODE"))
SET XOBDATA("XOB SECAV","AVCODE")="<masked>"
+31 if $DATA(XOBDATA("XOB SECAV","OLDVC"))
SET XOBDATA("XOB SECAV","OLDVC")="<masked>"
+32 if $DATA(XOBDATA("XOB SECAV","NEWVC"))
SET XOBDATA("XOB SECAV","NEWVC")="<masked>"
+33 if $DATA(XOBDATA("XOB SECAV","NEWVCCHECK"))
SET XOBDATA("XOB SECAV","NEWVCCHECK")="<masked>"
+34 ;XOBV*1.6*4
DO APPERROR^%ZTER("VistALink Error ")
End DoDot:1
+35 KILL XOBDATA("XOB SECAV")
+36 QUIT
+37 ;
POSTTXT(XOBRET,XOBMSG) ; -- adds the post-sign-in-text to a message being prepared
+1 NEW XOBI,XOBLINE,XOBCNT
+2 SET XOBCNT=""
SET XOBLINE=1
FOR
SET XOBCNT=$ORDER(XOBMSG(XOBCNT))
if XOBCNT']""
QUIT
SET XOBLINE=XOBCNT
+3 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)="<PostSignInText>"
+4 ; only return post sign in text if the signon says that the text line count is > 0
+5 ; (even if, past XOBRET(5), there are actually messages from the post-sign-in text)
+6 IF XOBRET(5)>0
Begin DoDot:1
+7 SET XOBI=5
FOR
SET XOBI=$ORDER(XOBRET(XOBI))
if XOBI']""
QUIT
Begin DoDot:2
+8 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)="<Line>"_$$CHARCHK^XOBVLIB(XOBRET(XOBI))_"</Line>"
End DoDot:2
End DoDot:1
+9 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)="</PostSignInText>"
+10 QUIT XOBLINE
+11 ;
ADDDIVS(XOBRET,XOBMSG) ; -- adds division list to a message being prepared
+1 NEW XOBI,XOBLINE,XOBCNT,XOBDEF
+2 SET XOBCNT=""
SET XOBLINE=1
FOR
SET XOBCNT=$ORDER(XOBMSG(XOBCNT))
if XOBCNT']""
QUIT
SET XOBLINE=XOBCNT
+3 ;
+4 ; default division if any. Use of ^VA(200,,2,"AX1"): DBIA #4058
SET XOBDEF=$ORDER(^VA(200,DUZ,2,"AX1",1,""))
+5 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)="<"_$PIECE($TEXT(PARTTAG),";;",2)_" needDivisionSelection=""true"">"
+6 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)="<Divisions>"
+7 SET XOBI=0
FOR
SET XOBI=$ORDER(XOBDIVS(XOBI))
if XOBI']""
QUIT
Begin DoDot:1
+8 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)="<Division ien="""_$PIECE(XOBDIVS(XOBI),U)_""" divName="""_$$CHARCHK^XOBVLIB($PIECE(XOBDIVS(XOBI),U,2))_""" divNumber="""_$$CHARCHK^XOBVLIB($PIECE(XOBDIVS(XOBI),U,3))_""""
+9 if ($PIECE(XOBDIVS(XOBI),U)=XOBDEF)
SET XOBMSG(XOBLINE)=XOBMSG(XOBLINE)_" default=""true"" "
+10 SET XOBMSG(XOBLINE)=XOBMSG(XOBLINE)_" />"
End DoDot:1
+11 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)="</Divisions>"
+12 SET XOBLINE=XOBLINE+1
SET XOBMSG(XOBLINE)=" </"_$PIECE($TEXT(PARTTAG),";;",2)_">"
+13 ;
+14 QUIT XOBLINE
+15 ;
LOGGEDON() ; -- checks if the environment was previously properly set up, e.g.,
+1 ; logon succeeded in some previous call
+2 QUIT +$GET(DUZ)
+3 ;
CRCONTXT(XOBOPTNM) ; -- create the context if it doesn't already exist
+1 ; INPUT VALUE: XOBOPTNM encoded with Kernel encoding algorithm
+2 ; RETURN VALUE: +result will be 1 if successful, or 0 if unsuccessful
+3 ; if unsuccessful, result may (or may not) also contain the textual reason for failure
+4 ;
+5 ; Accessing, Setting and Killing of XQY and XQY0: DBIA #4059
+6 ;
+7 NEW XOBRSLT,XOBOPTN1
+8 ;
+9 SET XOBOPTN1=$$DECRYP^XUSRB1(XOBOPTNM)
+10 ; -- if context already set, quit 1
+11 IF $LENGTH($GET(XQY0))
IF XQY0=XOBOPTN1
QUIT 1
+12 ; -- if param is empty string, then kill off the context
+13 IF XOBOPTN1=""
KILL XQY0,XQY
QUIT 1
+14 ; -- otherwise try to create the context
+15 ; use of CRCONTXT^XWBSEC: DBIA #4053
DO CRCONTXT^XWBSEC(.XOBRSLT,XOBOPTNM)
+16 ; -- return the result
+17 QUIT XOBRSLT
+18 ;
CHKCTXT(XOBRPCNM) ; -- does user have access to RPC?
+1 NEW XWBSEC
+2 ; use of CHKPRMIT^XWBSEC: DBIA # 4053
DO CHKPRMIT^XWBSEC(XOBRPCNM)
+3 if '+$LENGTH($GET(XWBSEC))
QUIT 1
+4 QUIT XWBSEC
+5 ;
+6 ; ==== Constants ====
+7 ;
MSGTYP(XOBRQRS) ; return request message type
+1 IF XOBRQRS="request"
QUIT $PIECE($TEXT(REQTYPE),";;",2)
+2 IF XOBRQRS="response"
QUIT $PIECE($TEXT(RESTYPE),";;",2)
+3 IF XOBRQRS="error"
QUIT $PIECE($TEXT(ERRTYPE),";;",2)
+4 QUIT ""
SUCCESS() ; resulttype
+1 QUIT $PIECE($TEXT(RESTYPES+1),";;",2)
FAILURE() ;
+1 QUIT $PIECE($TEXT(RESTYPES+2),";;",2)
PARTIAL() ;
+1 QUIT $PIECE($TEXT(RESTYPES+3),";;",2)
+2 ;
RESTYPES ;Result types
+1 ;;success
+2 ;;failure
+3 ;;partialSuccess
+4 ;
+5 ;Message types
REQTYPE ;;gov.va.med.foundations.security.request
RESTYPE ;;gov.va.med.foundations.security.response
ERRTYPE ;;gov.va.med.foundations.security.fault
+1 ;
+2 ;Message response types
MSGSETUP ;;AV.SetupAndIntroText
MSGLGON ;;AV.Logon
MSGLGON1 ;;SAML.Logon
MSGLGOUT ;;AV.Logout
MSGSELDV ;;AV.SelectDivision
MSGUPDVC ;;AV.UpdateVC
MSGUSERD ;;AV.GetUserDemographics
+1 ;
+2 ;Attribute values for response XML messages
VRSNSEC ;;1.0
+1 ;
+2 ;XML Tag names
PARTTAG ;;PartialSuccessData
MSGTAG ;;Message
+1 ;
+2 ;XML Schemas
SCHERROR ;;secFault.xsd
SCHLGON ;;secLogonResponse.xsd
SCHPARTS ;;secPartialSuccessResponse.xsd
SCHSETUP ;;secSetupIntroResponse.xsd
SCHSIMPL ;;secSimpleResponse.xsd
SCHUSERD ;;secUserDemographicsResponse.xsd
+1 ;
+2 ;Faultcodes
FSERVER ;;Server
FCLIENT ;;Client
FVERSION ;;VersionMismatch
FUNDERST ;;MustUnderstand
