XOBSCAV1 ;; kec/oak - VistaLink Access/Verify Security ; [6/28/06 2:26pm]
;;1.5;VistALink Security;**1**;Sep 09, 2005;Build 3
;;Foundations Toolbox Release v1.5 [Build: 1.5.1.001]
;;
QUIT
;
; Access/Verify Security: Security Message Request Handler
; specific message request/response pairs)
;
; ** Setting/Killing of DUZ covered by blanket SAC Kernel exemption for Foundations
;
; ::AV.SetupAndIntroText.Request message processing
SENDITXT ; Do Setup and send Intro Text
NEW XOBSTINF,XOBITINF,XOBMSG,XOBTMP,XOBTMP1,XOBCCMSK,XOBI,XOBPROD
;
IF $$PRODMISM() DO QUIT
. NEW XOBSPAR SET XOBSPAR(1)=$GET(XOBDATA("CLIENTISPRODUCTION")),XOBSPAR(2)=$SELECT($$PROD^XUPROD(0):"true",1:"false")
. DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Production-Test Mismatch",183007,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183007,.XOBSPAR)))
;
IF $$STATMISM() DO QUIT
. NEW XOBSPAR SET XOBSPAR(1)=$GET(XOBDATA("CLIENTPRIMARYSTATION")),XOBSPAR(2)=XOBSYS("PRIMARY STATION#")
. DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Primary Station Mismatch",183010,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183010,.XOBSPAR)))
;
; Do SETUP^XUSRB to setup, then INTRO^XUSRB to get intro text
; NOTE: $$GETPEER^%ZOSV fails for TCP_SERVICES listeners if COM file doesn't set up VISTA$IP logical
SET XWBTIP=$$GETPEER^%ZOSV ; XWBTIP needed by SETUP^XUSRB. Use of GETPEER^%ZOSV: DBIA #4056
;
USE XOBNULL ; protect against direct writes to socket
; note: SETUP/INTRO^XUSRB set current IO to null device
;
IF XOBSYS("ENV")="j2ee" DO
. DO SETUP^XUSRB(.XOBSTINF,"") ; use of SETUP^XUSRB: DBIA #4054
ELSE DO QUIT:$GET(DUZ)>0
. SET XWBVER=1.1 ; to allow VistaLink to contact client agent
. DO SETUP^XUSRB(.XOBSTINF,"") ; use of SETUP^XUSRB: DBIA #4054
. ; start of auto-signon support
. SET DUZ=$$AUTOXWB^XUS1B() IF DUZ<1 KILL DUZ ; use of $$AUTOXWB^XUS1B: DBIA #4060
. IF $GET(DUZ)>0 DO NOW^XUSRB SET XUMSG=$$POST^XUSRB(0) IF XUMSG>0 KILL DUZ ; XUSRB calls: DBIA #4061
. ; do autosignon and quit if DUZ is set
. IF $GET(DUZ)>0 DO QUIT
. .USE XOBPORT ; restore current IO (the TCP port)
. .SET XOBRET(5)=0 DO LOGFIN
. .QUIT
. KILL XWBVER ; once auto-signon fails, don't need to contact client agent
. ; end of autosignon support
;
;if failed autosignon, continue w/intro text
DO INTRO^XUSRB(.XOBITINF) ; use of INTRO^XUSRB: DBIA #4054
; ** use of USE command covered by blanket SAC Kernel exemption for Foundations
USE XOBPORT ; restore current IO (the TCP port)
;
SET XOBMSG(1)="<SetupInfo serverName='"_$$CHARCHK^XOBVLIB(XOBSTINF(0))_"' volume='"
; note: next line, "dtime" attribute value is not DTIME, but is the VistaLink heartbeat rate.
; this is used by the J2SE client code to time out the client dialogs.
; Value may be replaced w/a signon-specific site parameter later.
SET XOBMSG(1)=XOBMSG(1)_$$CHARCHK^XOBVLIB(XOBSTINF(1))_"' uci='"_$$CHARCHK^XOBVLIB(XOBSTINF(2))_"' device='"_$$CHARCHK^XOBVLIB(XOBSTINF(3))_"' numberAttempts='"_$$CHARCHK^XOBVLIB(XOBSTINF(4))_"' dtime='"_$$GETRATE^XOBVLIB()_"'/>"
; add intro text
DO GETINTRO^XOBSCAV2("XOBMSG",2)
;
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGSETUP^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSETUP^XOBSCAV),";;",2))
QUIT
; ::AV.Logon.Request message processing
LOGON ; process login request
NEW XOBAC,XOBVC,XOBRET,XOBRETDV
;
IF $$LOGGEDON^XOBSCAV DO QUIT
.DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Server Partition State",183003,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183003)))
;
KILL DUZ ; if DUZ is around, it shouldn't be.
USE XOBNULL ; protect against direct writes to socket
; try to logon w/avcodes
DO VALIDAV^XUSRB(.XOBRET,XOBDATA("XOB SECAV","AVCODE")) ; use of VALIDAV^XUSRB: DBIA#4054
USE XOBPORT ; restore current IO (the TCP port)
;
; if bad a/v code credentials
IF '+XOBRET(0),'+XOBRET(1),'+XOBRET(2) DO QUIT
. IF XOBSYS("ENV")="j2ee" DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Connector Proxy User Error",183008,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183008,$GET(XOBRET(3)))))
. ; look for particular error string which means IP is locked
. IF $GET(XOBRET(3))["Device/IP address is locked due" DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",182306,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(182306,$GET(XOBRET(3))))) QUIT
. ELSE DO LOGBADCD
;
; if Kernel says user needs to change verify code
IF '+XOBRET(0),'+XOBRET(1),XOBRET(2) DO LOGCVC QUIT
;
IF '+XOBRET(0) DO QUIT ; there was an error
.NEW XOBSPAR
.SET XOBSPAR(1)=$GET(XOBRET(3))
.; look for particular error string which means too many invalid signon attempts
.IF XOBSPAR(1)["too many invalid sign" DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",183005,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183005,.XOBSPAR))) QUIT
.DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",183004,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183004,.XOBSPAR)))
;
; if user requested to change verify code
IF XOBDATA("XOB SECAV","REQUESTCVC")="true" DO LOGCVC QUIT
;
; if j2ee, test for connector proxy user
IF XOBSYS("ENV")="j2ee" QUIT:'$$ISCPROXY()
;
; at this point login was successful
DO LOGFIN
QUIT
LOGFIN ; check the divisions, finish login now
NEW XOBRETDV DO DIVGET^XUSRB2(.XOBRETDV,DUZ) ; use of DIVGET^XUSRB2: DBIA #4055
IF '+XOBRETDV(0) DO QUIT
. DO LOGOK
. DO DUZSV^XOBVSYSI(.DUZ)
; otherwise this is a multidivisional user
DO LOGSELDV(.XOBRETDV)
QUIT
LOGBADCD ; response if bad a/v code pair
NEW XOBMSG
SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBRET(3))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
QUIT
LOGCVC ; response if need to change vc
NEW XOBMSG,XOBLINE
SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
SET XOBMSG(XOBLINE+1)="<"_$PIECE($TEXT(PARTTAG^XOBSCAV),";;",2)_" changeVerify=""true"" cvcHelpText="""_$$CHARCHK^XOBVLIB($$AVHLPTXT^XUS2())_""" />" ; use of AVHLPTXT^XUS2: DBIA #4057
SET XOBMSG(XOBLINE+2)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBRET(3))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
QUIT
LOGSELDV(XOBDIVS) ; response if need to select division
;XOBDIVS is in format of output from DIVGET^XUSRB2
NEW XOBMSG,XOBLINE
SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
SET XOBLINE=$$ADDDIVS^XOBSCAV(.XOBDIVS,.XOBMSG)
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
QUIT
LOGOK ; response if everything's looking good
NEW XOBMSG,XOBLINE
SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHLGON^XOBSCAV),";;",2))
QUIT
; ::AV.Logout.Request message processing
LOGOUT ; logout
USE XOBNULL ; protect against direct writes to socket
; do the logout
DO CLEAN
USE XOBPORT ; restore current IO (the TCP port)
NEW XOBMSG
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGOUT^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
QUIT
; ::Logout to call if connection has timed out
CLEAN ; logout
DO LOGOUT^XUSRB ; use of LOGOUT^XUSRB: DBIA #4054
QUIT
; ::AV.SelectDivision.Request message processing
DIVSLCT ; select division
NEW XOBRET
IF '+DUZ DO DIVSLCT0("User did not complete the access/verify code login process.") QUIT ; need DUZ
DO DIVSET^XUSRB2(.XOBRET,"`"_XOBDATA("XOB SECAV","SELECTEDDIVISION")) ; use of DIVSET^XUSRB2: DBIA #4055
IF +XOBRET DO QUIT
. DO DIVSLCT1
. DO DUZSV^XOBVSYSI(.DUZ)
DO DIVSLCT0("division not found for this user.")
QUIT
;
DIVSLCT0(XOBTEXT) ; send
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(MSGSELDV^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
QUIT
;
DIVSLCT1 ; success
NEW XOBMSG
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGSELDV^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
QUIT
;
PRODMISM() ; returns 1 if production mismatch, 0 if not
IF XOBSYS("ENV")'="j2ee" QUIT 0 ; skip in c/s mode
SET XOBPROD=$SELECT($GET(XOBDATA("CLIENTISPRODUCTION"))="true":1,1:0)
IF '(XOBPROD=$$PROD^XUPROD(0)) QUIT 1
QUIT 0
;
STATMISM() ; return 1 if primary station mismatch, 0 if not
IF XOBSYS("ENV")'="j2ee" QUIT 0 ; no checking for c/s mode
NEW XOBSTAT
; strip off suffix
SET XOBSTAT=$$STRPSUFF($GET(XOBDATA("CLIENTPRIMARYSTATION")))
; compare w/KSP value
IF XOBSTAT'=XOBSYS("PRIMARY STATION#") QUIT 1 ;mismatch found
QUIT 0
;
STRPSUFF(XOBSTAT) ; strip alpha suffix from sta# e.g. AAC "200M"
SET XOBSTAT=+XOBSTAT
; nursing home, treat 9 as suffix
IF $LENGTH(XOBSTAT)=4,$E(XOBSTAT,4)=9 SET XOBSTAT=$E(XOBSTAT,1,3)
QUIT XOBSTAT
;
ISCPROXY() ; c/proxy check
; returns 1 if c/proxy user, 0 if not
NEW XOBCPCHK,XOBOK
SET XOBOK=1
SET XOBCPCHK=$$CPCHK^XUSAP(+XOBRET(0))
IF 'XOBCPCHK DO SET XOBOK=0
. DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Connector Proxy User Error",183008,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183008,$PIECE($GET(XOBCPCHK),U,2))))
QUIT XOBOK
;
XOBSCAV1 ;; kec/oak - VistaLink Access/Verify Security ; [6/28/06 2:26pm]
+1 ;;1.5;VistALink Security;**1**;Sep 09, 2005;Build 3
+2 ;;Foundations Toolbox Release v1.5 [Build: 1.5.1.001]
+3 ;;
+4 QUIT
+5 ;
+6 ; Access/Verify Security: Security Message Request Handler
+7 ; specific message request/response pairs)
+8 ;
+9 ; ** Setting/Killing of DUZ covered by blanket SAC Kernel exemption for Foundations
+10 ;
+11 ; ::AV.SetupAndIntroText.Request message processing
SENDITXT ; Do Setup and send Intro Text
+1 NEW XOBSTINF,XOBITINF,XOBMSG,XOBTMP,XOBTMP1,XOBCCMSK,XOBI,XOBPROD
+2 ;
+3 IF $$PRODMISM()
Begin DoDot:1
+4 NEW XOBSPAR
SET XOBSPAR(1)=$GET(XOBDATA("CLIENTISPRODUCTION"))
SET XOBSPAR(2)=$SELECT($$PROD^XUPROD(0):"true",1:"false")
+5 DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Production-Test Mismatch",183007,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183007,.XOBSPAR)))
End DoDot:1
QUIT
+6 ;
+7 IF $$STATMISM()
Begin DoDot:1
+8 NEW XOBSPAR
SET XOBSPAR(1)=$GET(XOBDATA("CLIENTPRIMARYSTATION"))
SET XOBSPAR(2)=XOBSYS("PRIMARY STATION#")
+9 DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Primary Station Mismatch",183010,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183010,.XOBSPAR)))
End DoDot:1
QUIT
+10 ;
+11 ; Do SETUP^XUSRB to setup, then INTRO^XUSRB to get intro text
+12 ; NOTE: $$GETPEER^%ZOSV fails for TCP_SERVICES listeners if COM file doesn't set up VISTA$IP logical
+13 ; XWBTIP needed by SETUP^XUSRB. Use of GETPEER^%ZOSV: DBIA #4056
SET XWBTIP=$$GETPEER^%ZOSV
+14 ;
+15 ; protect against direct writes to socket
USE XOBNULL
+16 ; note: SETUP/INTRO^XUSRB set current IO to null device
+17 ;
+18 IF XOBSYS("ENV")="j2ee"
Begin DoDot:1
+19 ; use of SETUP^XUSRB: DBIA #4054
DO SETUP^XUSRB(.XOBSTINF,"")
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 ; to allow VistaLink to contact client agent
SET XWBVER=1.1
+22 ; use of SETUP^XUSRB: DBIA #4054
DO SETUP^XUSRB(.XOBSTINF,"")
+23 ; start of auto-signon support
+24 ; use of $$AUTOXWB^XUS1B: DBIA #4060
SET DUZ=$$AUTOXWB^XUS1B()
IF DUZ<1
KILL DUZ
+25 ; XUSRB calls: DBIA #4061
IF $GET(DUZ)>0
DO NOW^XUSRB
SET XUMSG=$$POST^XUSRB(0)
IF XUMSG>0
KILL DUZ
+26 ; do autosignon and quit if DUZ is set
+27 IF $GET(DUZ)>0
Begin DoDot:2
+28 ; restore current IO (the TCP port)
USE XOBPORT
+29 SET XOBRET(5)=0
DO LOGFIN
+30 QUIT
End DoDot:2
QUIT
+31 ; once auto-signon fails, don't need to contact client agent
KILL XWBVER
+32 ; end of autosignon support
End DoDot:1
IF $GET(DUZ)>0
QUIT
+33 ;
+34 ;if failed autosignon, continue w/intro text
+35 ; use of INTRO^XUSRB: DBIA #4054
DO INTRO^XUSRB(.XOBITINF)
+36 ; ** use of USE command covered by blanket SAC Kernel exemption for Foundations
+37 ; restore current IO (the TCP port)
USE XOBPORT
+38 ;
+39 SET XOBMSG(1)="<SetupInfo serverName='"_$$CHARCHK^XOBVLIB(XOBSTINF(0))_"' volume='"
+40 ; note: next line, "dtime" attribute value is not DTIME, but is the VistaLink heartbeat rate.
+41 ; this is used by the J2SE client code to time out the client dialogs.
+42 ; Value may be replaced w/a signon-specific site parameter later.
+43 SET XOBMSG(1)=XOBMSG(1)_$$CHARCHK^XOBVLIB(XOBSTINF(1))_"' uci='"_$$CHARCHK^XOBVLIB(XOBSTINF(2))_"' device='"_$$CHARCHK^XOBVLIB(XOBSTINF(3))_"' numberAttempts='"_$$CHARCHK^XOBVLIB(XOBSTINF(4))_"' dtime='"_$$GETRATE^XOBVLIB()_"'/>"
+44 ; add intro text
+45 DO GETINTRO^XOBSCAV2("XOBMSG",2)
+46 ;
+47 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGSETUP^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSETUP^XOBSCAV),";;",2))
+48 QUIT
+49 ; ::AV.Logon.Request message processing
LOGON ; process login request
+1 NEW XOBAC,XOBVC,XOBRET,XOBRETDV
+2 ;
+3 IF $$LOGGEDON^XOBSCAV
Begin DoDot:1
+4 DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Server Partition State",183003,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183003)))
End DoDot:1
QUIT
+5 ;
+6 ; if DUZ is around, it shouldn't be.
KILL DUZ
+7 ; protect against direct writes to socket
USE XOBNULL
+8 ; try to logon w/avcodes
+9 ; use of VALIDAV^XUSRB: DBIA#4054
DO VALIDAV^XUSRB(.XOBRET,XOBDATA("XOB SECAV","AVCODE"))
+10 ; restore current IO (the TCP port)
USE XOBPORT
+11 ;
+12 ; if bad a/v code credentials
+13 IF '+XOBRET(0)
IF '+XOBRET(1)
IF '+XOBRET(2)
Begin DoDot:1
+14 IF XOBSYS("ENV")="j2ee"
DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Connector Proxy User Error",183008,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183008,$GET(XOBRET(3)))))
+15 ; look for particular error string which means IP is locked
+16 IF $GET(XOBRET(3))["Device/IP address is locked due"
DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",182306,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(182306,$GET(XOBRET(3)))))
QUIT
+17 IF '$TEST
DO LOGBADCD
End DoDot:1
QUIT
+18 ;
+19 ; if Kernel says user needs to change verify code
+20 IF '+XOBRET(0)
IF '+XOBRET(1)
IF XOBRET(2)
DO LOGCVC
QUIT
+21 ;
+22 ; there was an error
IF '+XOBRET(0)
Begin DoDot:1
+23 NEW XOBSPAR
+24 SET XOBSPAR(1)=$GET(XOBRET(3))
+25 ; look for particular error string which means too many invalid signon attempts
+26 IF XOBSPAR(1)["too many invalid sign"
DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",183005,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183005,.XOBSPAR)))
QUIT
+27 DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",183004,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183004,.XOBSPAR)))
End DoDot:1
QUIT
+28 ;
+29 ; if user requested to change verify code
+30 IF XOBDATA("XOB SECAV","REQUESTCVC")="true"
DO LOGCVC
QUIT
+31 ;
+32 ; if j2ee, test for connector proxy user
+33 IF XOBSYS("ENV")="j2ee"
IF '$$ISCPROXY()
QUIT
+34 ;
+35 ; at this point login was successful
+36 DO LOGFIN
+37 QUIT
LOGFIN ; check the divisions, finish login now
+1 ; use of DIVGET^XUSRB2: DBIA #4055
NEW XOBRETDV
DO DIVGET^XUSRB2(.XOBRETDV,DUZ)
+2 IF '+XOBRETDV(0)
Begin DoDot:1
+3 DO LOGOK
+4 DO DUZSV^XOBVSYSI(.DUZ)
End DoDot:1
QUIT
+5 ; otherwise this is a multidivisional user
+6 DO LOGSELDV(.XOBRETDV)
+7 QUIT
LOGBADCD ; response if bad a/v code pair
+1 NEW XOBMSG
+2 SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBRET(3))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
+3 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
+4 QUIT
LOGCVC ; response if need to change vc
+1 NEW XOBMSG,XOBLINE
+2 SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
+3 ; use of AVHLPTXT^XUS2: DBIA #4057
SET XOBMSG(XOBLINE+1)="<"_$PIECE($TEXT(PARTTAG^XOBSCAV),";;",2)_" changeVerify=""true"" cvcHelpText="""_$$CHARCHK^XOBVLIB($$AVHLPTXT^XUS2())_""" />"
+4 SET XOBMSG(XOBLINE+2)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBRET(3))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
+5 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
+6 QUIT
LOGSELDV(XOBDIVS) ; response if need to select division
+1 ;XOBDIVS is in format of output from DIVGET^XUSRB2
+2 NEW XOBMSG,XOBLINE
+3 SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
+4 SET XOBLINE=$$ADDDIVS^XOBSCAV(.XOBDIVS,.XOBMSG)
+5 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
+6 QUIT
LOGOK ; response if everything's looking good
+1 NEW XOBMSG,XOBLINE
+2 SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
+3 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHLGON^XOBSCAV),";;",2))
+4 QUIT
+5 ; ::AV.Logout.Request message processing
LOGOUT ; logout
+1 ; protect against direct writes to socket
USE XOBNULL
+2 ; do the logout
+3 DO CLEAN
+4 ; restore current IO (the TCP port)
USE XOBPORT
+5 NEW XOBMSG
+6 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGOUT^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
+7 QUIT
+8 ; ::Logout to call if connection has timed out
CLEAN ; logout
+1 ; use of LOGOUT^XUSRB: DBIA #4054
DO LOGOUT^XUSRB
+2 QUIT
+3 ; ::AV.SelectDivision.Request message processing
DIVSLCT ; select division
+1 NEW XOBRET
+2 ; need DUZ
IF '+DUZ
DO DIVSLCT0("User did not complete the access/verify code login process.")
QUIT
+3 ; use of DIVSET^XUSRB2: DBIA #4055
DO DIVSET^XUSRB2(.XOBRET,"`"_XOBDATA("XOB SECAV","SELECTEDDIVISION"))
+4 IF +XOBRET
Begin DoDot:1
+5 DO DIVSLCT1
+6 DO DUZSV^XOBVSYSI(.DUZ)
End DoDot:1
QUIT
+7 DO DIVSLCT0("division not found for this user.")
+8 QUIT
+9 ;
DIVSLCT0(XOBTEXT) ; send
+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(MSGSELDV^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
+4 QUIT
+5 ;
DIVSLCT1 ; success
+1 NEW XOBMSG
+2 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGSELDV^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
+3 QUIT
+4 ;
PRODMISM() ; returns 1 if production mismatch, 0 if not
+1 ; skip in c/s mode
IF XOBSYS("ENV")'="j2ee"
QUIT 0
+2 SET XOBPROD=$SELECT($GET(XOBDATA("CLIENTISPRODUCTION"))="true":1,1:0)
+3 IF '(XOBPROD=$$PROD^XUPROD(0))
QUIT 1
+4 QUIT 0
+5 ;
STATMISM() ; return 1 if primary station mismatch, 0 if not
+1 ; no checking for c/s mode
IF XOBSYS("ENV")'="j2ee"
QUIT 0
+2 NEW XOBSTAT
+3 ; strip off suffix
+4 SET XOBSTAT=$$STRPSUFF($GET(XOBDATA("CLIENTPRIMARYSTATION")))
+5 ; compare w/KSP value
+6 ;mismatch found
IF XOBSTAT'=XOBSYS("PRIMARY STATION#")
QUIT 1
+7 QUIT 0
+8 ;
STRPSUFF(XOBSTAT) ; strip alpha suffix from sta# e.g. AAC "200M"
+1 SET XOBSTAT=+XOBSTAT
+2 ; nursing home, treat 9 as suffix
+3 IF $LENGTH(XOBSTAT)=4
IF $EXTRACT(XOBSTAT,4)=9
SET XOBSTAT=$EXTRACT(XOBSTAT,1,3)
+4 QUIT XOBSTAT
+5 ;
ISCPROXY() ; c/proxy check
+1 ; returns 1 if c/proxy user, 0 if not
+2 NEW XOBCPCHK,XOBOK
+3 SET XOBOK=1
+4 SET XOBCPCHK=$$CPCHK^XUSAP(+XOBRET(0))
+5 IF 'XOBCPCHK
Begin DoDot:1
+6 DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Connector Proxy User Error",183008,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183008,$PIECE($GET(XOBCPCHK),U,2))))
End DoDot:1
SET XOBOK=0
+7 QUIT XOBOK
+8 ;
