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

XUS1B.m

Go to the documentation of this file.
  1. XUS1B ;ISF/RWF - Auto sign-on ;12/04/14 14:57
  1. ;;8.0;KERNEL;**59,337,395,469,543,594,638**;Jul 10, 1995;Build 15
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. AUTOXUS() ;Do the check for XUS and Auto Sign-on
  1. N %,FG,Y
  1. I $G(XQXFLG("ASO")) Q 0 ;Already tried once.
  1. G AUTO
  1. ;
  1. AUTOXWB() ;Do the check for XWB and Auto Sign-on
  1. N %,FG,Y,NUNOW
  1. I $G(XQXFLG("ASO")) Q 0 ;Already tried so skip.
  1. S XUNOW=$$NOW^XLFDT ;p543
  1. AUTO ;Common code
  1. I ($T(^XWBCAGNT)="")!($P(XOPT,U,18)="d") S XQXFLG("ZEBRA")=-1 Q 0 ;Disabled
  1. S Y=$$CHKVIP(),%=0
  1. I Y>0 S %=$$PREF($P(XOPT,U,18),$P($G(^VA(200,Y,200)),U,18))
  1. I Y>0,'% S Y=0 ;No Auto signon
  1. ;check parameter, skip set if yes, default is no p594
  1. I Y>0,'$$GET^XPAR("SYS","XU594",1,"Q") S DUZ(2)=+FG ;Set Division p543
  1. Q Y
  1. ;
  1. CHKVIP() ;Check for a Valid current IP
  1. N REF,XREF,IEN,R0,ENV,JOB,HNDL,XTMP
  1. ;D SETUP ;To log data for debug
  1. S IEN=0,ENV=$$ENV,REF=$G(IO("IP")) I $L(REF) D GETHNDL(.HNDL)
  1. ;p638 - Look thru the IPv6 X-ref
  1. I $L(REF) D LKUP("AS4",$$FORCEIP6^XLFIPV(REF)) ;Will set IEN
  1. Q IEN
  1. ;
  1. LKUP(XREF,LK) ;Check one X-ref
  1. N R0,R1,IX,D1,NM ;p543
  1. S IX=0,IEN=0
  1. F S IX=$O(^XUSEC(0,XREF,LK,IX)) Q:'$L(IX) D CHK Q:IEN>0
  1. Q
  1. CHK ;Could this be a good one.
  1. N R0,R1,D1,XIPV6,REF6,XNM,REFNM
  1. S R0=$G(^XUSEC(0,IX,0))
  1. ;Check that IP really matches (Q if IPv6<>REF6)
  1. S XIPV6=$P($G(^XUSEC(0,IX,1)),U,1) ;Stored IPv6 address
  1. S REF6=$$FORCEIP6^XLFIPV(REF) ;Reference address converted to IPv6
  1. I XIPV6'=REF6 Q
  1. ;Check entry does not have sign-off D/T. p543
  1. I $P(R0,U,4) Q
  1. ;Check that Client name matches
  1. S XNM=$$LOW^XLFSTR($P(R0,U,12)) ;Stored client name
  1. S REFNM=$$LOW^XLFSTR($P($G(IO("CLNM")),".")) ;Reference client name
  1. I $L(XNM),$L(REFNM),XNM'=REFNM Q
  1. ;Check date within 8 hours p543
  1. S D1=$$FMDIFF^XLFDT(XUNOW,IX,2) I (D1>28800)!(D1<-5) Q
  1. ;Check handle. Use timeout on Lock p543
  1. S R1=$P(R0,U,13) I $L(R1),$D(HNDL(R1)) D
  1. . L +^XWB("SESSION",IX_"~"_R1):DILOCKTM I $T L -^XWB("SESSION",IX_"~"_R1) Q
  1. . ;Remove D LOG after debug.
  1. . S IEN=+R0,FG=$P(R0,"^",17),XQXFLG("ASO")=IX ;D LOG Q ;Found a match
  1. . Q
  1. Q
  1. ;
  1. ENV() N Y D GETENV^%ZOSV
  1. Q Y
  1. ;
  1. PREF(%1,%2) ;
  1. Q $S($L(%2):%2,1:%1)
  1. ;
  1. GETHNDL(RET) ;Get the Handles from the Client
  1. N %,%1,X,XXX,TS
  1. ;Don't call Terminal servers/Proxy's
  1. S TS=$G(IO("IP"))
  1. I $L(TS),$O(^XTV(8989.3,1,405.2,"B",TS,0)) S XQXFLG("ZEBRA")=-1 Q ;Disable to TS and Proxy's
  1. S %=$$CMD^XWBCAGNT(.XXX,"XWB GET HANDLES") I '% S XQXFLG("ZEBRA")=-1 Q ;Disable on Timeout p543
  1. Q:'$O(XXX(0))
  1. ;build array
  1. S RET=0,%1=1 F %=1:1:$L(XXX(%1),"^") S X=$P(XXX(%1),"^",%) S:X]"" RET(X)="",RET=RET+1
  1. Q
  1. ;Temp for data collection
  1. SETUP ;
  1. N N1,N2
  1. I '$D(^XTMP("XUSP543","CNT")) S ^XTMP("XUSP543",0)=$$HTFM^XLFDT($H+30)_"^"_XUNOW,^("CNT")=0
  1. S N1="XUSP543",N2="CNT"
  1. X "S XTMP=$INCREMENT(^XTMP(N1,N2))"
  1. S ^XTMP("XUSP543",XTMP,0)=$G(IO("IP"))_U_$G(IO("ZIO"))_U_XUNOW
  1. Q
  1. ;
  1. LOG ;Log more data
  1. M ^XTMP("XUSP543",XTMP,"HNDL")=HNDL
  1. S ^XTMP("XUSP543",XTMP,"R0")=R0,^("R1")=R1,^("IX")=IX
  1. Q