XUSKAAJ ;;12/15/15 08:54;08/24/2006
;;8.0;KERNEL;**329,430,659**;Jul 10, 1995;Build 22
;Per VA Directive 6402, this routine should not be modified.
;;
QUIT
;
; ------------------------------------------------------------------------
; SSO/UC KAAJEE RPCs
; ------------------------------------------------------------------------
;
USERINFO(RET,CLIENTIP,SERVERNM) ; called by XUS KAAJEE GET USER INFO rpc
;
; INPUT:
; CLIENTIP is IP address of the client workstation, used for logging (signon log) and IP blocking (failed access attempts).
; SERVERNM is Identifying name for the calling application or server, used for logging (signon log).
; OUTPUT:
; Result(0) is the users DUZ.
; Result(1) is the user name from the .01 field.
; Result(2) is the users full name from the name standard file.
; Result(3) is the FAMILY (LAST) NAME
; Result(4) is the GIVEN (FIRST) NAME
; Result(5) is the MIDDLE NAME
; Result(6) is the PREFIX
; Result(7) is the SUFFIX
; Result(8) is the DEGREE
; Result(9) is station # of the division that the user is working in.
; Result(10) is the station # of the parent facility for the login division
; Result(11) is the station # from the KSP site parameters, the parent "computer system"
; Result(12) is the signon log entry IEN
; Result(13) = # of permissible divisions
; Result(14-n) are the permissible divisions for user login, in the format:
; IEN of file 4^Station Name^Station Number^default? (1 or 0)
;
N I,XUNC,XUNC1,XUKERR,XUKRET,XUDIVS,XUKI,XULINE,XUPARENT,XUDIVLIN,XUKDEF
;
; initialize return array
S RET(0)=DUZ
F I=1:1:13 S RET(I)=""
;
; get ptr to Name Components file
D GETS^DIQ(200,DUZ_",","10.1","I","XUNC","XUKERR")
I '$D(XUKERR) D
.S XUNC=XUNC(200,DUZ_",",10.1,"I")
.; get name components
.D GETS^DIQ(20,XUNC_",","1:6","","XUNC1","XUKERR")
.I '$D(XUKERR) D
..S RET(3)=XUNC1(20,XUNC_",",1) S:'$L(RET(3)) RET(3)="^"
..S RET(4)=XUNC1(20,XUNC_",",2) S:'$L(RET(4)) RET(4)="^"
..S RET(5)=XUNC1(20,XUNC_",",3) S:'$L(RET(5)) RET(5)="^"
..S RET(6)=XUNC1(20,XUNC_",",4) S:'$L(RET(6)) RET(6)="^"
..S RET(7)=XUNC1(20,XUNC_",",5) S:'$L(RET(7)) RET(7)="^"
..S RET(8)=XUNC1(20,XUNC_",",6) S:'$L(RET(8)) RET(8)="^"
;
; get .01 New Person name, Name components name, and login division info
D USERINFO^XUSRB2(.XUKRET)
S RET(1)=XUKRET(1) S:'$L(RET(1)) RET(1)="^"
S RET(2)=XUKRET(2) S:'$L(RET(2)) RET(2)="^"
S RET(9)=$P(XUKRET(3),U,3) S:'$L(RET(9)) RET(9)="0"
;
; get parent facility station#
S XUPARENT=$$PRNT^XUAF4(RET(9))
S RET(10)=$S(($P(XUPARENT,U)<1):XUPARENT,1:$$STA^XUAF4($P(XUPARENT,U)))
S:'$L(RET(10)) RET(10)="^"
;
; get the computer system station#
S RET(11)=$$STA^XUAF4($$KSP^XUPARAM("INST"))
S:'$L(RET(11)) RET(11)="0"
;
; make signon log entry, get IEN
S RET(12)=$$SIGNLOG^XUSKAAJ(CLIENTIP,SERVERNM)
;
; get permitted divisions
S XUDIVLIN=13 ; return array subscript counter for division start point
D DIVGET^XUSRB2(.XUDIVS,DUZ)
I '+XUDIVS(0) S RET(XUDIVLIN)=1,RET(XUDIVLIN+1)=XUKRET(3)_"^1" ; only 1 division, so use login division.
I +XUDIVS(0) S RET(XUDIVLIN)=+XUDIVS(0) D
.S XUKDEF=$O(^VA(200,DUZ,2,"AX1",1,"")) ; default division if any. Should only be 1.
.S XUKI=0,XULINE=XUDIVLIN F S XUKI=$O(XUDIVS(XUKI)) Q:XUKI']"" D
..S XULINE=XULINE+1,RET(XULINE)=XUDIVS(XUKI)
..S $P(RET(XULINE),U,4)=$S($P(XUDIVS(XUKI),U)=XUKDEF:1,1:0)
;
Q
;
SIGNOFF(RET,DA) ; kill entry in sign-on log. Called by XUS KAAJEE LOGOUT rpc.
D LOUT^XUSCLEAN(DA)
S RET=1 Q
;
SIGNLOG(CLIENTIP,SERVERNM) ; make a signon log entry for KAAJEE user
; todo: expand size of server name field?
N XP1,XPIP,XPCLNM,Y
S:$D(IO("IP")) XPIP=IO("IP") S IO("IP")=CLIENTIP
S:$D(IO("CLNM")) XPCLNM=IO("CLNM") S IO("CLNM")=$E(SERVERNM,1,20)
;
D GETENV^%ZOSV
S XP1=$$SLOG^XUS1($P(Y,U,2),,,$P(Y,U),$P(Y,U,3),"KAAJEE","")
;
S:$D(XPIP) IO("IP")=XPIP
S:$D(XPCLNM) IO("CLNM")=XPCLNM
Q XP1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSKAAJ 3989 printed Dec 13, 2024@02:12:34 Page 2
XUSKAAJ ;;12/15/15 08:54;08/24/2006
+1 ;;8.0;KERNEL;**329,430,659**;Jul 10, 1995;Build 22
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 QUIT
+5 ;
+6 ; ------------------------------------------------------------------------
+7 ; SSO/UC KAAJEE RPCs
+8 ; ------------------------------------------------------------------------
+9 ;
USERINFO(RET,CLIENTIP,SERVERNM) ; called by XUS KAAJEE GET USER INFO rpc
+1 ;
+2 ; INPUT:
+3 ; CLIENTIP is IP address of the client workstation, used for logging (signon log) and IP blocking (failed access attempts).
+4 ; SERVERNM is Identifying name for the calling application or server, used for logging (signon log).
+5 ; OUTPUT:
+6 ; Result(0) is the users DUZ.
+7 ; Result(1) is the user name from the .01 field.
+8 ; Result(2) is the users full name from the name standard file.
+9 ; Result(3) is the FAMILY (LAST) NAME
+10 ; Result(4) is the GIVEN (FIRST) NAME
+11 ; Result(5) is the MIDDLE NAME
+12 ; Result(6) is the PREFIX
+13 ; Result(7) is the SUFFIX
+14 ; Result(8) is the DEGREE
+15 ; Result(9) is station # of the division that the user is working in.
+16 ; Result(10) is the station # of the parent facility for the login division
+17 ; Result(11) is the station # from the KSP site parameters, the parent "computer system"
+18 ; Result(12) is the signon log entry IEN
+19 ; Result(13) = # of permissible divisions
+20 ; Result(14-n) are the permissible divisions for user login, in the format:
+21 ; IEN of file 4^Station Name^Station Number^default? (1 or 0)
+22 ;
+23 NEW I,XUNC,XUNC1,XUKERR,XUKRET,XUDIVS,XUKI,XULINE,XUPARENT,XUDIVLIN,XUKDEF
+24 ;
+25 ; initialize return array
+26 SET RET(0)=DUZ
+27 FOR I=1:1:13
SET RET(I)=""
+28 ;
+29 ; get ptr to Name Components file
+30 DO GETS^DIQ(200,DUZ_",","10.1","I","XUNC","XUKERR")
+31 IF '$DATA(XUKERR)
Begin DoDot:1
+32 SET XUNC=XUNC(200,DUZ_",",10.1,"I")
+33 ; get name components
+34 DO GETS^DIQ(20,XUNC_",","1:6","","XUNC1","XUKERR")
+35 IF '$DATA(XUKERR)
Begin DoDot:2
+36 SET RET(3)=XUNC1(20,XUNC_",",1)
if '$LENGTH(RET(3))
SET RET(3)="^"
+37 SET RET(4)=XUNC1(20,XUNC_",",2)
if '$LENGTH(RET(4))
SET RET(4)="^"
+38 SET RET(5)=XUNC1(20,XUNC_",",3)
if '$LENGTH(RET(5))
SET RET(5)="^"
+39 SET RET(6)=XUNC1(20,XUNC_",",4)
if '$LENGTH(RET(6))
SET RET(6)="^"
+40 SET RET(7)=XUNC1(20,XUNC_",",5)
if '$LENGTH(RET(7))
SET RET(7)="^"
+41 SET RET(8)=XUNC1(20,XUNC_",",6)
if '$LENGTH(RET(8))
SET RET(8)="^"
End DoDot:2
End DoDot:1
+42 ;
+43 ; get .01 New Person name, Name components name, and login division info
+44 DO USERINFO^XUSRB2(.XUKRET)
+45 SET RET(1)=XUKRET(1)
if '$LENGTH(RET(1))
SET RET(1)="^"
+46 SET RET(2)=XUKRET(2)
if '$LENGTH(RET(2))
SET RET(2)="^"
+47 SET RET(9)=$PIECE(XUKRET(3),U,3)
if '$LENGTH(RET(9))
SET RET(9)="0"
+48 ;
+49 ; get parent facility station#
+50 SET XUPARENT=$$PRNT^XUAF4(RET(9))
+51 SET RET(10)=$SELECT(($PIECE(XUPARENT,U)<1):XUPARENT,1:$$STA^XUAF4($PIECE(XUPARENT,U)))
+52 if '$LENGTH(RET(10))
SET RET(10)="^"
+53 ;
+54 ; get the computer system station#
+55 SET RET(11)=$$STA^XUAF4($$KSP^XUPARAM("INST"))
+56 if '$LENGTH(RET(11))
SET RET(11)="0"
+57 ;
+58 ; make signon log entry, get IEN
+59 SET RET(12)=$$SIGNLOG^XUSKAAJ(CLIENTIP,SERVERNM)
+60 ;
+61 ; get permitted divisions
+62 ; return array subscript counter for division start point
SET XUDIVLIN=13
+63 DO DIVGET^XUSRB2(.XUDIVS,DUZ)
+64 ; only 1 division, so use login division.
IF '+XUDIVS(0)
SET RET(XUDIVLIN)=1
SET RET(XUDIVLIN+1)=XUKRET(3)_"^1"
+65 IF +XUDIVS(0)
SET RET(XUDIVLIN)=+XUDIVS(0)
Begin DoDot:1
+66 ; default division if any. Should only be 1.
SET XUKDEF=$ORDER(^VA(200,DUZ,2,"AX1",1,""))
+67 SET XUKI=0
SET XULINE=XUDIVLIN
FOR
SET XUKI=$ORDER(XUDIVS(XUKI))
if XUKI']""
QUIT
Begin DoDot:2
+68 SET XULINE=XULINE+1
SET RET(XULINE)=XUDIVS(XUKI)
+69 SET $PIECE(RET(XULINE),U,4)=$SELECT($PIECE(XUDIVS(XUKI),U)=XUKDEF:1,1:0)
End DoDot:2
End DoDot:1
+70 ;
+71 QUIT
+72 ;
SIGNOFF(RET,DA) ; kill entry in sign-on log. Called by XUS KAAJEE LOGOUT rpc.
+1 DO LOUT^XUSCLEAN(DA)
+2 SET RET=1
QUIT
+3 ;
SIGNLOG(CLIENTIP,SERVERNM) ; make a signon log entry for KAAJEE user
+1 ; todo: expand size of server name field?
+2 NEW XP1,XPIP,XPCLNM,Y
+3 if $DATA(IO("IP"))
SET XPIP=IO("IP")
SET IO("IP")=CLIENTIP
+4 if $DATA(IO("CLNM"))
SET XPCLNM=IO("CLNM")
SET IO("CLNM")=$EXTRACT(SERVERNM,1,20)
+5 ;
+6 DO GETENV^%ZOSV
+7 SET XP1=$$SLOG^XUS1($PIECE(Y,U,2),,,$PIECE(Y,U),$PIECE(Y,U,3),"KAAJEE","")
+8 ;
+9 if $DATA(XPIP)
SET IO("IP")=XPIP
+10 if $DATA(XPCLNM)
SET IO("CLNM")=XPCLNM
+11 QUIT XP1
+12 ;
