- BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 11 Jul 2011 10:44 AM
- ;;4.0;BMX;**1**;JUL 11, 2011;Build 12
- ;;
- ;
- CHKPRMID(BMXRP) ;EP - checks to see if remote procedure is permited to run
- ;D DEBUG^%Serenji("CHKPRMID^BMXMSEC(BMXRP)")
- Q
- ;
- CHKPRMIT(BMXRP) ;EP - checks to see if remote procedure is permited to run
- ;Input: BMXRP - Remote procedure to check
- Q:$$KCHK("XUPROGMODE")
- N ERR,BMXALLOW
- S U="^",BMXSEC="" ;clear
- ;
- ;In the beginning, when no DUZ is defined and no context exist, setup
- ;default signon context
- S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON" ;set up default context
- S:'$L($G(XQY0)) XQY0="BMXRPC"
- ;
- S XWBSTATE("ALLCTX",XQY0)=1 ; LOCAL ARRAY REMEMBERING ALL APPCONTEXTS USED FOR THIS SESSION
- I DUZ D ADDCTXT(DUZ,"BMXRPC") ; IN DIRECT MODE, CHECK USER APP CTXT PERMISSION AND, IF NECESSARY, APPEND THE RPC NODES IN ^TMP("XQCS",$J
- ;
- I BMXRP'="XWB IM HERE",BMXRP'="XWB CREATE CONTEXT",BMXRP'="XUS AV CODE",BMXRP'="XWB RPC LIST",BMXRP'="BMX AV CODE" D ;check exemptions. new exemption for XWB*1.1*6 - dpc
- . I $G(XQY0)'="" D
- . . S BMXALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),BMXRP) ;do the check
- . . S:'BMXALLOW BMXSEC=BMXALLOW
- . E S BMXSEC="Application context has not been created!"
- Q
- ;
- OWNSKEY(RET,LIST) ;EP Does user have Key
- N I,K S I=""
- I $G(DUZ)'>0 S RET(0)=0 Q
- I $O(LIST(""))="" S RET(0)=$$KCHK(LIST) Q
- F S I=$O(LIST(I)) Q:I="" S RET(I)=$$KCHK(LIST(I))
- Q
- KCHK(%) Q $S($G(DUZ)>0:$D(^XUSEC(%,DUZ)),1:0) ;EP Key Check
- ;
- ;
- SETUP(RET) ;EP - sets up environment for GUI signon
- ;
- K ^TMP("XQCS",$J)
- S IO("IP")=$$GETPEER^%ZOSV D ZIO^%ZIS4 ;IHS/OIT/HMW SAC Exemption Applied For ; Patched by GIS 6/1/2011
- D SET1(0),SET^BMXMSEC("XUS XOPT",XOPT),SET^BMXMSEC("XUS CNT",0)
- S %ZIS="0H",IOP="NULL" D ^%ZIS
- ;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen
- S RET(0)=$P(XUENV,U,3),RET(1)=$P(XUVOL,U),RET(2)=XUCI
- S RET(3)=$I,RET(4)=$P(XOPT,U,2),RET(5)=0 ;IHS/OIT/HMW SAC Exemption Applied For
- I $$INHIBIT() Q
- Q
- ;
- SET1(FLAG) ;Setup parameters
- D GETENV^%ZOSV S U="^",XUENV=Y,XUCI=$P(Y,U,1),XQVOL=$P(Y,U,2),XUEON=^%ZOSF("EON"),XUEOFF=^("EOFF")
- S X=$O(^XTV(8989.3,1,4,"B",XQVOL,0)),XUVOL=$S(X>0:^XTV(8989.3,1,4,X,0),1:XQVOL_"^y^1") S:$P(XUVOL,U,6)="y" XRTL=XUCI_","_XQVOL
- S XOPT=$S($D(^XTV(8989.3,1,"XUS")):^("XUS"),1:"") F I=2:1:15 I $P(XOPT,U,I)="" S $P(XOPT,U,I)=$P("^5^900^1^1^^^^1^300^^^^N^90",U,I)
- Q
- ;
- INHIBIT() ;Is Logon to this system Inhibited?
- I $G(^%ZIS(14.5,"LOGON",XQVOL)) Q 1
- I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(XUVOL,U,3),($P(XUVOL,U,3)'>Y) Q 2
- Q 0
- ;
- NOW S U="^",XUNOW=$$NOW^XLFDT(),DT=$P(XUNOW,"."),XUDEV=0
- Q
- ;
- STATE(%) ;Return a state value
- ;XWBSTATE is required by XUSRB
- Q:'$L($G(%)) $G(XWBSTATE)
- Q $G(XWBSTATE(%))
- ;
- ;
- SET(%,VALUE) ;Set the state variable
- I $G(%)="" S XWBSTATE=VALUE
- S XWBSTATE(%)=VALUE
- Q
- KILL(%) ;Kill state variable
- I $L($G(%)) K XWBSTATE(%)
- Q
- ;
- ;
- ADDCTXT(XQUSR,XCONTEXT) ; SUPPORTS DIRECT MODE IN BMX
- N XQMES,XQRPC,X,Y,Z,%,XQOPT,TMP
- S TMP=$NA(^TMP("XQCS",$J))
- S XQOPT=$O(^DIC(19,"B",XCONTEXT,0)) I 'XQOPT Q
- S XQRPC=$O(^DIC(19,XQOPT,"RPC","B",0)) I 'XQRPC Q
- I $D(@TMP@(XQRPC)) Q ; ITS ALREADY IN THERE ; NOTHING MORE TO DO
- S XQMES=1
- D USER^XQCS I 'XQMES Q ; USER DOES NOT POSSES THIS APP CONTEXT
- S XQRPC=0
- F S XQRPC=$O(^DIC(19,XQOPT,"RPC","B",XQRPC)) Q:'XQRPC S @TMP@(XQRPC,0)=XQRPC
- Q
- ;
- BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 11 Jul 2011 10:44 AM
- +1 ;;4.0;BMX;**1**;JUL 11, 2011;Build 12
- +2 ;;
- +3 ;
- CHKPRMID(BMXRP) ;EP - checks to see if remote procedure is permited to run
- +1 ;D DEBUG^%Serenji("CHKPRMID^BMXMSEC(BMXRP)")
- +2 QUIT
- +3 ;
- CHKPRMIT(BMXRP) ;EP - checks to see if remote procedure is permited to run
- +1 ;Input: BMXRP - Remote procedure to check
- +2 IF $$KCHK("XUPROGMODE")
- QUIT
- +3 NEW ERR,BMXALLOW
- +4 ;clear
- SET U="^"
- SET BMXSEC=""
- +5 ;
- +6 ;In the beginning, when no DUZ is defined and no context exist, setup
- +7 ;default signon context
- +8 ;set up default context
- IF '$GET(DUZ)
- SET DUZ=0
- SET XQY0="XUS SIGNON"
- +9 IF '$LENGTH($GET(XQY0))
- SET XQY0="BMXRPC"
- +10 ;
- +11 ; LOCAL ARRAY REMEMBERING ALL APPCONTEXTS USED FOR THIS SESSION
- SET XWBSTATE("ALLCTX",XQY0)=1
- +12 ; IN DIRECT MODE, CHECK USER APP CTXT PERMISSION AND, IF NECESSARY, APPEND THE RPC NODES IN ^TMP("XQCS",$J
- IF DUZ
- DO ADDCTXT(DUZ,"BMXRPC")
- +13 ;
- +14 ;check exemptions. new exemption for XWB*1.1*6 - dpc
- IF BMXRP'="XWB IM HERE"
- IF BMXRP'="XWB CREATE CONTEXT"
- IF BMXRP'="XUS AV CODE"
- IF BMXRP'="XWB RPC LIST"
- IF BMXRP'="BMX AV CODE"
- Begin DoDot:1
- +15 IF $GET(XQY0)'=""
- Begin DoDot:2
- +16 ;do the check
- SET BMXALLOW=$$CHK^XQCS(DUZ,$PIECE(XQY0,U),BMXRP)
- +17 IF 'BMXALLOW
- SET BMXSEC=BMXALLOW
- End DoDot:2
- +18 IF '$TEST
- SET BMXSEC="Application context has not been created!"
- End DoDot:1
- +19 QUIT
- +20 ;
- OWNSKEY(RET,LIST) ;EP Does user have Key
- +1 NEW I,K
- SET I=""
- +2 IF $GET(DUZ)'>0
- SET RET(0)=0
- QUIT
- +3 IF $ORDER(LIST(""))=""
- SET RET(0)=$$KCHK(LIST)
- QUIT
- +4 FOR
- SET I=$ORDER(LIST(I))
- IF I=""
- QUIT
- SET RET(I)=$$KCHK(LIST(I))
- +5 QUIT
- KCHK(%) ;EP Key Check
- QUIT $SELECT($GET(DUZ)>0:$DATA(^XUSEC(%,DUZ)),1:0)
- +1 ;
- +2 ;
- SETUP(RET) ;EP - sets up environment for GUI signon
- +1 ;
- +2 KILL ^TMP("XQCS",$JOB)
- +3 ;IHS/OIT/HMW SAC Exemption Applied For ; Patched by GIS 6/1/2011
- SET IO("IP")=$$GETPEER^%ZOSV
- DO ZIO^%ZIS4
- +4 DO SET1(0)
- DO SET^BMXMSEC("XUS XOPT",XOPT)
- DO SET^BMXMSEC("XUS CNT",0)
- +5 SET %ZIS="0H"
- SET IOP="NULL"
- DO ^%ZIS
- +6 ;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen
- +7 SET RET(0)=$PIECE(XUENV,U,3)
- SET RET(1)=$PIECE(XUVOL,U)
- SET RET(2)=XUCI
- +8 ;IHS/OIT/HMW SAC Exemption Applied For
- SET RET(3)=$IO
- SET RET(4)=$PIECE(XOPT,U,2)
- SET RET(5)=0
- +9 IF $$INHIBIT()
- QUIT
- +10 QUIT
- +11 ;
- SET1(FLAG) ;Setup parameters
- +1 DO GETENV^%ZOSV
- SET U="^"
- SET XUENV=Y
- SET XUCI=$PIECE(Y,U,1)
- SET XQVOL=$PIECE(Y,U,2)
- SET XUEON=^%ZOSF("EON")
- SET XUEOFF=^("EOFF")
- +2 SET X=$ORDER(^XTV(8989.3,1,4,"B",XQVOL,0))
- SET XUVOL=$SELECT(X>0:^XTV(8989.3,1,4,X,0),1:XQVOL_"^y^1")
- IF $PIECE(XUVOL,U,6)="y"
- SET XRTL=XUCI_","_XQVOL
- +3 SET XOPT=$SELECT($DATA(^XTV(8989.3,1,"XUS")):^("XUS"),1:"")
- FOR I=2:1:15
- IF $PIECE(XOPT,U,I)=""
- SET $PIECE(XOPT,U,I)=$PIECE("^5^900^1^1^^^^1^300^^^^N^90",U,I)
- +4 QUIT
- +5 ;
- INHIBIT() ;Is Logon to this system Inhibited?
- +1 IF $GET(^%ZIS(14.5,"LOGON",XQVOL))
- QUIT 1
- +2 IF $DATA(^%ZOSF("ACTJ"))
- XECUTE ^("ACTJ")
- IF $PIECE(XUVOL,U,3)
- IF ($PIECE(XUVOL,U,3)'>Y)
- QUIT 2
- +3 QUIT 0
- +4 ;
- NOW SET U="^"
- SET XUNOW=$$NOW^XLFDT()
- SET DT=$PIECE(XUNOW,".")
- SET XUDEV=0
- +1 QUIT
- +2 ;
- STATE(%) ;Return a state value
- +1 ;XWBSTATE is required by XUSRB
- +2 IF '$LENGTH($GET(%))
- QUIT $GET(XWBSTATE)
- +3 QUIT $GET(XWBSTATE(%))
- +4 ;
- +5 ;
- SET(%,VALUE) ;Set the state variable
- +1 IF $GET(%)=""
- SET XWBSTATE=VALUE
- +2 SET XWBSTATE(%)=VALUE
- +3 QUIT
- KILL(%) ;Kill state variable
- +1 IF $LENGTH($GET(%))
- KILL XWBSTATE(%)
- +2 QUIT
- +3 ;
- +4 ;
- ADDCTXT(XQUSR,XCONTEXT) ; SUPPORTS DIRECT MODE IN BMX
- +1 NEW XQMES,XQRPC,X,Y,Z,%,XQOPT,TMP
- +2 SET TMP=$NAME(^TMP("XQCS",$JOB))
- +3 SET XQOPT=$ORDER(^DIC(19,"B",XCONTEXT,0))
- IF 'XQOPT
- QUIT
- +4 SET XQRPC=$ORDER(^DIC(19,XQOPT,"RPC","B",0))
- IF 'XQRPC
- QUIT
- +5 ; ITS ALREADY IN THERE ; NOTHING MORE TO DO
- IF $DATA(@TMP@(XQRPC))
- QUIT
- +6 SET XQMES=1
- +7 ; USER DOES NOT POSSES THIS APP CONTEXT
- DO USER^XQCS
- IF 'XQMES
- QUIT
- +8 SET XQRPC=0
- +9 FOR
- SET XQRPC=$ORDER(^DIC(19,XQOPT,"RPC","B",XQRPC))
- IF 'XQRPC
- QUIT
- SET @TMP@(XQRPC,0)=XQRPC
- +10 QUIT
- +11 ;
