Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XOBSCAV2

XOBSCAV2.m

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