XOBSCAV2 ;; kec/oak - VistaLink Access/Verify Security ; 12/09/2002 17:00
;;1.6;VistALink Security;;May 08, 2009;Build 15
;Per VHA directive 2004-038, this routine should not be modified.
QUIT
;
; --------------------------------------------------------------------
; Access/Verify Security: Security Message Request Handler
; (AV.GetUserDemographics req/resp pairs; XML parser callbacks)
; --------------------------------------------------------------------
;
;==== AV.GetUserDemographics.Request message processing ====
SENDDEM ; respond to user demographics request
IF '$$LOGGEDON^XOBSCAV() DO SENDDEM0("User not logged on.")
DO SENDDEM1
QUIT
SENDDEM1 ; success
NEW XOBMSG,XOBI,XOBNC,XOBNC1,XOBDIV,XOBRET,XOBERR,XOBTXT
; get ptr to Name Components file
DO GETS^DIQ(200,DUZ_",","10.1","I","XOBNC","XOBERR")
IF $DATA(XOBERR) DO QUIT
.SET XOBI=0,XOBTXT="FileMan Error: "
.FOR SET XOBI=$ORDER(XOBERR("DIERR",XOBI)) QUIT:'+XOBI SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
.DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
SET XOBNC=XOBNC(200,DUZ_",",10.1,"I")
; get name components -- read access to file 20: DBIA# 3041
DO GETS^DIQ(20,XOBNC_",","1:6","","XOBNC1","XOBERR")
IF $DATA(XOBERR) DO QUIT
.SET XOBI=0,XOBTXT="FileMan Error: "
.FOR SET XOBI=$ORDER(XOBERR("DIERR",XOBI)) QUIT:'+XOBI SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
.DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
; get more userinfo from Kernel
DO USERINFO^XUSRB2(.XOBRET) ; use of USERINFO^XUSRB2: DBIA #4055
; strip any illegal xml chars from data
FOR XOBI=1:1:7 SET XOBRET(XOBI)=$$CHARCHK^XOBVLIB(XOBRET(XOBI))
FOR XOBI=1:1:6 SET XOBNC1(20,XOBNC_",",XOBI)=$$CHARCHK^XOBVLIB(XOBNC1(20,XOBNC_",",XOBI))
; format return message
SET XOBMSG(1)="<NameInfo prefix='"_XOBNC1(20,XOBNC_",",4)_"' givenFirst='"_XOBNC1(20,XOBNC_",",2)_"' middle='"_XOBNC1(20,XOBNC_",",3)
SET XOBMSG(1)=XOBMSG(1)_"' familyLast='"_XOBNC1(20,XOBNC_",",1)_"' suffix='"_XOBNC1(20,XOBNC_",",5)
SET XOBMSG(1)=XOBMSG(1)_"' degree='"_XOBNC1(20,XOBNC_",",6)_"' newPerson01Name='"_XOBRET(1)_"' standardConcatenated='"_XOBRET(2)_"' />"
SET XOBMSG(2)="<UserInfo duz='"_DUZ_"' title='"_$$CHARCHK^XOBVLIB(XOBRET(4))_"' serviceSection='"_$$CHARCHK^XOBVLIB(XOBRET(5))_"' language='"_$$CHARCHK^XOBVLIB(XOBRET(6))_"' timeout='"_$$CHARCHK^XOBVLIB(XOBRET(7))
SET XOBMSG(2)=XOBMSG(2)_"' vpid='"_$$CHARCHK^XOBVLIB($G(XOBRET(8)))_"' />"
SET XOBMSG(3)="<Division ien='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U))_"' divName='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,2))_"' divNumber='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,3))_"' />"
SET XOBMSG(4)="<SiteInfo domainName='"_$$KSP^XUPARAM("WHERE")_"'/>"
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHUSERD^XOBSCAV),";;",2))
QUIT
SENDDEM0(XOBTEXT) ; failure
NEW XOBMSG
SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBTEXT)_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
QUIT
;
; ==== SAX Parser Callbacks ====
;
ELEST(ELE,ATR) ; -- element start event handler
;
IF ELE="VistaLink" DO QUIT
. SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
. SET XOBDATA("XOB SECAV","SECURITYTYPE")=$GET(ATR("messageType"),"unknown")
;
IF ELE="SecurityInfo" DO QUIT
. SET XOBDATA("XOB SECAV","SECURITYVERSION")=$GET(ATR("version"),"unknown")
;
IF ELE="Request" DO QUIT
. SET XOBDATA("XOB SECAV","SECURITYACTION")=$GET(ATR("type"),"unknown")
. ; get ip from msg if provided
. IF "AV.SetupAndIntroText"=XOBDATA("XOB SECAV","SECURITYACTION") DO
. . SET XOBDATA("CLIENTIP")=$GET(ATR("clientIp"))
;
IF XOBDATA("XOB SECAV","SECURITYTYPE")'=$$MSGTYP^XOBSCAV("request") DO QUIT
.;if not a security request, shouldn't be here
.;
IF '$DATA(XOBDATA("XOB SECAV","SECURITYACTION")) DO QUIT
.;if haven't processed the "action" yet, shouldn't be here
;
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SetupAndIntroText" DO QUIT
. IF ELE="productionInfo" DO
. . SET XOBDATA("CLIENTISPRODUCTION")=$GET(ATR("clientIsProduction"))
. . SET XOBDATA("CLIENTPRIMARYSTATION")=$GET(ATR("clientPrimaryStation"))
;
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.GetUserDemographics" DO QUIT
.; nothing needed
.;
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logon" DO QUIT
.IF ELE="avCodes" SET XOBAVCOD=""
.SET XOBDATA("XOB SECAV","REQUESTCVC")=$GET(ATR("requestCvc"))
;
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logout" DO QUIT
.; nothing needed
;
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SelectDivision" DO QUIT
.IF ELE="Division" SET XOBDATA("XOB SECAV","SELECTEDDIVISION")=$GET(ATR("ien"))
;
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.UpdateVC" DO QUIT
.IF ELE="oldVc" SET XOBVCOLD="" QUIT
.IF ELE="newVc" SET XOBVCNEW="" QUIT
.IF ELE="confirmedVc" SET XOBVCCHK="" QUIT
;
;If got here -- an unknown type, ignore.
;
QUIT
;
ELEND(ELE) ; -- element end event handler
;
IF ELE="VistaLink" KILL XOBAVCOD,XOBVCOLD,XOBVCNEW,XOBVCCHK QUIT
IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.Logon",ELE="avCodes" DO QUIT
.SET XOBDATA("XOB SECAV","AVCODE")=XOBAVCOD KILL XOBAVCOD
IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.UpdateVC" DO QUIT
.IF ELE="oldVc" SET XOBDATA("XOB SECAV","OLDVC")=XOBVCOLD KILL XOBVCOLD QUIT
.IF ELE="newVc" SET XOBDATA("XOB SECAV","NEWVC")=XOBVCNEW KILL XOBVCNEW QUIT
.IF ELE="confirmedVc" SET XOBDATA("XOB SECAV","NEWVCCHECK")=XOBVCCHK KILL XOBVCCHK QUIT
.;shouldn't get here.
QUIT
;
CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
; callback gets hit multiple times even though the tag text value is just one piece of data.
; (Yes, this seems kludgie!)
IF $DATA(XOBAVCOD) SET XOBAVCOD=XOBAVCOD_TEXT QUIT
IF $DATA(XOBVCOLD) SET XOBVCOLD=XOBVCOLD_TEXT QUIT
IF $DATA(XOBVCNEW) SET XOBVCNEW=XOBVCNEW_TEXT QUIT
IF $DATA(XOBVCCHK) SET XOBVCCHK=XOBVCCHK_TEXT QUIT
QUIT
;==== AV.UpdateVC.Request message processing ====
SENDNVC ; respond to "change verify code" request. Use of CVC^XUSRB per DBIA #4054
NEW XOBRET,XOBRETDV,XOBSDUZ
SET XOBSDUZ=DUZ ; save DUZ in case of failure - we need to restore
DO CVC^XUSRB(.XOBRET,XOBDATA("XOB SECAV","OLDVC")_U_XOBDATA("XOB SECAV","NEWVC")_U_XOBDATA("XOB SECAV","NEWVCCHECK"))
KILL XOBDATA("XOB SECAV","OLDVC"),XOBDATA("XOB SECAV","NEWVC"),XOBDATA("XOB SECAV","NEWVCCHECK")
IF +$GET(DUZ) DO QUIT ; success changing verify code
.; check the divisions now
.DO DIVGET^XUSRB2(.XOBRETDV,DUZ) ; use of DIVGET^XUSRB2: DBIA #4055
.IF '+XOBRETDV(0) DO SENDNVC1 QUIT
.; otherwise this is a multidivisional user
.DO SENDNVCD(.XOBRETDV)
; cvc failed
SET DUZ=XOBSDUZ ; restore DUZ
DO SENDNVC0 ; failure
QUIT
SENDNVC1 ; send verify code update success
;update the vc/finish the logon
NEW XOBMSG
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
QUIT
SENDNVC0 ; send verify code update error
;update the vc/finish the logon
NEW XOBMSG,XOBI
SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB($GET(XOBRET(1)))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
QUIT
SENDNVCD(XOBDIVS) ; send verify code partial success, need divisions
;XOBDIVS is in format of output from DIVGET^XUSRB2
NEW XOBMSG,XOBI,XOBLINE
SET XOBLINE=$$ADDDIVS^XOBSCAV(.XOBDIVS,.XOBMSG)
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
QUIT
;
;==== utility functions ====
;
GETINTRO(XOBSREF,XOBSCNTR) ;
; XOBSREF: variable in which to store intro text (at one level descendant)
; XOBSCNT: integer subscript counter value at which to start storing text
; returns: XOBSREF containing <IntroText> element text with intro text lines in CDATA section
; XOBSCNT incremented to last subscript at which text was stored (if passed as dot-arg)
;
NEW XOBCCMSK,XOBI,XOBITINF,XOBTMP1
; get intro text
DO INTRO^XUSRB(.XOBITINF) ; use of INTRO^XUSRB: DBIA #4054
; set up control character mask
SET XOBCCMSK="" FOR XOBI=0:1:8,11,12,14:1:31 SET XOBCCMSK=XOBCCMSK_$CHAR(XOBI)
; populate/format return value
SET @XOBSREF@(XOBSCNTR)="<IntroText><![CDATA["
SET XOBTMP1=-1 FOR SET XOBTMP1=$ORDER(XOBITINF(XOBTMP1)) QUIT:XOBTMP1']"" DO
.SET XOBSCNTR=XOBSCNTR+1,@XOBSREF@(XOBSCNTR)=$TRANSLATE(XOBITINF(XOBTMP1),XOBCCMSK,"")_"<BR>"
SET XOBSCNTR=XOBSCNTR+1,@XOBSREF@(XOBSCNTR)="]]></IntroText>"
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBSCAV2 9373 printed Dec 13, 2024@02:45:04 Page 2
XOBSCAV2 ;; kec/oak - VistaLink Access/Verify Security ; 12/09/2002 17:00
+1 ;;1.6;VistALink Security;;May 08, 2009;Build 15
+2 ;Per VHA directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; --------------------------------------------------------------------
+6 ; Access/Verify Security: Security Message Request Handler
+7 ; (AV.GetUserDemographics req/resp pairs; XML parser callbacks)
+8 ; --------------------------------------------------------------------
+9 ;
+10 ;==== AV.GetUserDemographics.Request message processing ====
SENDDEM ; respond to user demographics request
+1 IF '$$LOGGEDON^XOBSCAV()
DO SENDDEM0("User not logged on.")
+2 DO SENDDEM1
+3 QUIT
SENDDEM1 ; success
+1 NEW XOBMSG,XOBI,XOBNC,XOBNC1,XOBDIV,XOBRET,XOBERR,XOBTXT
+2 ; get ptr to Name Components file
+3 DO GETS^DIQ(200,DUZ_",","10.1","I","XOBNC","XOBERR")
+4 IF $DATA(XOBERR)
Begin DoDot:1
+5 SET XOBI=0
SET XOBTXT="FileMan Error: "
+6 FOR
SET XOBI=$ORDER(XOBERR("DIERR",XOBI))
if '+XOBI
QUIT
SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
+7 DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
End DoDot:1
QUIT
+8 SET XOBNC=XOBNC(200,DUZ_",",10.1,"I")
+9 ; get name components -- read access to file 20: DBIA# 3041
+10 DO GETS^DIQ(20,XOBNC_",","1:6","","XOBNC1","XOBERR")
+11 IF $DATA(XOBERR)
Begin DoDot:1
+12 SET XOBI=0
SET XOBTXT="FileMan Error: "
+13 FOR
SET XOBI=$ORDER(XOBERR("DIERR",XOBI))
if '+XOBI
QUIT
SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
+14 DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
End DoDot:1
QUIT
+15 ; get more userinfo from Kernel
+16 ; use of USERINFO^XUSRB2: DBIA #4055
DO USERINFO^XUSRB2(.XOBRET)
+17 ; strip any illegal xml chars from data
+18 FOR XOBI=1:1:7
SET XOBRET(XOBI)=$$CHARCHK^XOBVLIB(XOBRET(XOBI))
+19 FOR XOBI=1:1:6
SET XOBNC1(20,XOBNC_",",XOBI)=$$CHARCHK^XOBVLIB(XOBNC1(20,XOBNC_",",XOBI))
+20 ; format return message
+21 SET XOBMSG(1)="<NameInfo prefix='"_XOBNC1(20,XOBNC_",",4)_"' givenFirst='"_XOBNC1(20,XOBNC_",",2)_"' middle='"_XOBNC1(20,XOBNC_",",3)
+22 SET XOBMSG(1)=XOBMSG(1)_"' familyLast='"_XOBNC1(20,XOBNC_",",1)_"' suffix='"_XOBNC1(20,XOBNC_",",5)
+23 SET XOBMSG(1)=XOBMSG(1)_"' degree='"_XOBNC1(20,XOBNC_",",6)_"' newPerson01Name='"_XOBRET(1)_"' standardConcatenated='"_XOBRET(2)_"' />"
+24 SET XOBMSG(2)="<UserInfo duz='"_DUZ_"' title='"_$$CHARCHK^XOBVLIB(XOBRET(4))_"' serviceSection='"_$$CHARCHK^XOBVLIB(XOBRET(5))_"' language='"_$$CHARCHK^XOBVLIB(XOBRET(6))_"' timeout='"_$$CHARCHK^XOBVLIB(XOBRET(7))
+25 SET XOBMSG(2)=XOBMSG(2)_"' vpid='"_$$CHARCHK^XOBVLIB($GET(XOBRET(8)))_"' />"
+26 SET XOBMSG(3)="<Division ien='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U))_"' divName='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,2))_"' divNumber='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,3))_"' />"
+27 SET XOBMSG(4)="<SiteInfo domainName='"_$$KSP^XUPARAM("WHERE")_"'/>"
+28 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHUSERD^XOBSCAV),";;",2))
+29 QUIT
SENDDEM0(XOBTEXT) ; failure
+1 NEW XOBMSG
+2 SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBTEXT)_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
+3 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
+4 QUIT
+5 ;
+6 ; ==== SAX Parser Callbacks ====
+7 ;
ELEST(ELE,ATR) ; -- element start event handler
+1 ;
+2 IF ELE="VistaLink"
Begin DoDot:1
+3 SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
+4 SET XOBDATA("XOB SECAV","SECURITYTYPE")=$GET(ATR("messageType"),"unknown")
End DoDot:1
QUIT
+5 ;
+6 IF ELE="SecurityInfo"
Begin DoDot:1
+7 SET XOBDATA("XOB SECAV","SECURITYVERSION")=$GET(ATR("version"),"unknown")
End DoDot:1
QUIT
+8 ;
+9 IF ELE="Request"
Begin DoDot:1
+10 SET XOBDATA("XOB SECAV","SECURITYACTION")=$GET(ATR("type"),"unknown")
+11 ; get ip from msg if provided
+12 IF "AV.SetupAndIntroText"=XOBDATA("XOB SECAV","SECURITYACTION")
Begin DoDot:2
+13 SET XOBDATA("CLIENTIP")=$GET(ATR("clientIp"))
End DoDot:2
End DoDot:1
QUIT
+14 ;
+15 IF XOBDATA("XOB SECAV","SECURITYTYPE")'=$$MSGTYP^XOBSCAV("request")
Begin DoDot:1
+16 ;if not a security request, shouldn't be here
+17 ;
End DoDot:1
QUIT
+18 IF '$DATA(XOBDATA("XOB SECAV","SECURITYACTION"))
Begin DoDot:1
+19 ;if haven't processed the "action" yet, shouldn't be here
End DoDot:1
QUIT
+20 ;
+21 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SetupAndIntroText"
Begin DoDot:1
+22 IF ELE="productionInfo"
Begin DoDot:2
+23 SET XOBDATA("CLIENTISPRODUCTION")=$GET(ATR("clientIsProduction"))
+24 SET XOBDATA("CLIENTPRIMARYSTATION")=$GET(ATR("clientPrimaryStation"))
End DoDot:2
End DoDot:1
QUIT
+25 ;
+26 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.GetUserDemographics"
Begin DoDot:1
+27 ; nothing needed
+28 ;
End DoDot:1
QUIT
+29 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logon"
Begin DoDot:1
+30 IF ELE="avCodes"
SET XOBAVCOD=""
+31 SET XOBDATA("XOB SECAV","REQUESTCVC")=$GET(ATR("requestCvc"))
End DoDot:1
QUIT
+32 ;
+33 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logout"
Begin DoDot:1
+34 ; nothing needed
End DoDot:1
QUIT
+35 ;
+36 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SelectDivision"
Begin DoDot:1
+37 IF ELE="Division"
SET XOBDATA("XOB SECAV","SELECTEDDIVISION")=$GET(ATR("ien"))
End DoDot:1
QUIT
+38 ;
+39 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.UpdateVC"
Begin DoDot:1
+40 IF ELE="oldVc"
SET XOBVCOLD=""
QUIT
+41 IF ELE="newVc"
SET XOBVCNEW=""
QUIT
+42 IF ELE="confirmedVc"
SET XOBVCCHK=""
QUIT
End DoDot:1
QUIT
+43 ;
+44 ;If got here -- an unknown type, ignore.
+45 ;
+46 QUIT
+47 ;
ELEND(ELE) ; -- element end event handler
+1 ;
+2 IF ELE="VistaLink"
KILL XOBAVCOD,XOBVCOLD,XOBVCNEW,XOBVCCHK
QUIT
+3 IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.Logon"
IF ELE="avCodes"
Begin DoDot:1
+4 SET XOBDATA("XOB SECAV","AVCODE")=XOBAVCOD
KILL XOBAVCOD
End DoDot:1
QUIT
+5 IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.UpdateVC"
Begin DoDot:1
+6 IF ELE="oldVc"
SET XOBDATA("XOB SECAV","OLDVC")=XOBVCOLD
KILL XOBVCOLD
QUIT
+7 IF ELE="newVc"
SET XOBDATA("XOB SECAV","NEWVC")=XOBVCNEW
KILL XOBVCNEW
QUIT
+8 IF ELE="confirmedVc"
SET XOBDATA("XOB SECAV","NEWVCCHECK")=XOBVCCHK
KILL XOBVCCHK
QUIT
+9 ;shouldn't get here.
End DoDot:1
QUIT
+10 QUIT
+11 ;
CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
+1 ; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
+2 ; callback gets hit multiple times even though the tag text value is just one piece of data.
+3 ; (Yes, this seems kludgie!)
+4 IF $DATA(XOBAVCOD)
SET XOBAVCOD=XOBAVCOD_TEXT
QUIT
+5 IF $DATA(XOBVCOLD)
SET XOBVCOLD=XOBVCOLD_TEXT
QUIT
+6 IF $DATA(XOBVCNEW)
SET XOBVCNEW=XOBVCNEW_TEXT
QUIT
+7 IF $DATA(XOBVCCHK)
SET XOBVCCHK=XOBVCCHK_TEXT
QUIT
+8 QUIT
+9 ;==== AV.UpdateVC.Request message processing ====
SENDNVC ; respond to "change verify code" request. Use of CVC^XUSRB per DBIA #4054
+1 NEW XOBRET,XOBRETDV,XOBSDUZ
+2 ; save DUZ in case of failure - we need to restore
SET XOBSDUZ=DUZ
+3 DO CVC^XUSRB(.XOBRET,XOBDATA("XOB SECAV","OLDVC")_U_XOBDATA("XOB SECAV","NEWVC")_U_XOBDATA("XOB SECAV","NEWVCCHECK"))
+4 KILL XOBDATA("XOB SECAV","OLDVC"),XOBDATA("XOB SECAV","NEWVC"),XOBDATA("XOB SECAV","NEWVCCHECK")
+5 ; success changing verify code
IF +$GET(DUZ)
Begin DoDot:1
+6 ; check the divisions now
+7 ; use of DIVGET^XUSRB2: DBIA #4055
DO DIVGET^XUSRB2(.XOBRETDV,DUZ)
+8 IF '+XOBRETDV(0)
DO SENDNVC1
QUIT
+9 ; otherwise this is a multidivisional user
+10 DO SENDNVCD(.XOBRETDV)
End DoDot:1
QUIT
+11 ; cvc failed
+12 ; restore DUZ
SET DUZ=XOBSDUZ
+13 ; failure
DO SENDNVC0
+14 QUIT
SENDNVC1 ; send verify code update success
+1 ;update the vc/finish the logon
+2 NEW XOBMSG
+3 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
+4 QUIT
SENDNVC0 ; send verify code update error
+1 ;update the vc/finish the logon
+2 NEW XOBMSG,XOBI
+3 SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB($GET(XOBRET(1)))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
+4 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
+5 QUIT
SENDNVCD(XOBDIVS) ; send verify code partial success, need divisions
+1 ;XOBDIVS is in format of output from DIVGET^XUSRB2
+2 NEW XOBMSG,XOBI,XOBLINE
+3 SET XOBLINE=$$ADDDIVS^XOBSCAV(.XOBDIVS,.XOBMSG)
+4 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
+5 QUIT
+6 ;
+7 ;==== utility functions ====
+8 ;
GETINTRO(XOBSREF,XOBSCNTR) ;
+1 ; XOBSREF: variable in which to store intro text (at one level descendant)
+2 ; XOBSCNT: integer subscript counter value at which to start storing text
+3 ; returns: XOBSREF containing <IntroText> element text with intro text lines in CDATA section
+4 ; XOBSCNT incremented to last subscript at which text was stored (if passed as dot-arg)
+5 ;
+6 NEW XOBCCMSK,XOBI,XOBITINF,XOBTMP1
+7 ; get intro text
+8 ; use of INTRO^XUSRB: DBIA #4054
DO INTRO^XUSRB(.XOBITINF)
+9 ; set up control character mask
+10 SET XOBCCMSK=""
FOR XOBI=0:1:8,11,12,14:1:31
SET XOBCCMSK=XOBCCMSK_$CHAR(XOBI)
+11 ; populate/format return value
+12 SET @XOBSREF@(XOBSCNTR)="<IntroText><![CDATA["
+13 SET XOBTMP1=-1
FOR
SET XOBTMP1=$ORDER(XOBITINF(XOBTMP1))
if XOBTMP1']""
QUIT
Begin DoDot:1
+14 SET XOBSCNTR=XOBSCNTR+1
SET @XOBSREF@(XOBSCNTR)=$TRANSLATE(XOBITINF(XOBTMP1),XOBCCMSK,"")_"<BR>"
End DoDot:1
+15 SET XOBSCNTR=XOBSCNTR+1
SET @XOBSREF@(XOBSCNTR)="]]></IntroText>"
+16 QUIT
+17 ;
