source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXMSEC.m@ 1561

Last change on this file since 1561 was 1147, checked in by Sam Habiel, 14 years ago

Mumps Routines 4 BMX4
File size: 3.4 KB
Line 
1BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 4/6/11 4:41pm
2 ;;4.1000;BMX;;Apr 17, 2011
3 ;;
4 ; Changes by WV/SMH for *1000 (Feb 2 2010)
5 ; Changes: SETUP now gets GT.M IP depending on ^%ZOSF("OS")
6 ; --> in IP("GTM-IP") per XWBTCPM model.
7 ;
8CHKPRMID(BMXRP) ;EP - checks to see if remote procedure is permited to run
9 ;D DEBUG^%Serenji("CHKPRMID^BMXMSEC(BMXRP)")
10 Q
11 ;
12CHKPRMIT(BMXRP) ;EP - checks to see if remote procedure is permited to run
13 ;Input: BMXRP - Remote procedure to check
14 Q:$$KCHK("XUPROGMODE")
15 N ERR,BMXALLOW
16 S U="^",BMXSEC="" ;clear
17 ;
18 ;In the beginning, when no DUZ is defined and no context exist, setup
19 ;default signon context
20 S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON" ;set up default context
21 S:'$L($G(XQY0)) XQY0="BMXRPC"
22 ;
23 ; Next 2 lines new in BMX 4
24 S XWBSTATE("ALLCTX",XQY0)=1 ; LOCAL ARRAY REMEMBERING ALL APPCONTEXTS USED FOR THIS SESSION
25 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
26 ;
27 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
28 . I $G(XQY0)'="" D
29 . . S BMXALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),BMXRP) ;do the check
30 . . S:'BMXALLOW BMXSEC=BMXALLOW
31 . E S BMXSEC="Application context has not been created!"
32 Q
33 ;
34OWNSKEY(RET,LIST) ;EP Does user have Key
35 N I,K S I=""
36 I $G(DUZ)'>0 S RET(0)=0 Q
37 I $O(LIST(""))="" S RET(0)=$$KCHK(LIST) Q
38 F S I=$O(LIST(I)) Q:I="" S RET(I)=$$KCHK(LIST(I))
39 Q
40KCHK(%) Q $S($G(DUZ)>0:$D(^XUSEC(%,DUZ)),1:0) ;EP Key Check
41 ;
42 ;
43SETUP(RET) ;EP - sets up environment for GUI signon
44 ;
45 K ^TMP("XQCS",$J)
46 S:^%ZOSF("OS")["GT.M" IO("IP")=IO("GTM-IP")
47 S:^%ZOSF("OS")["OpenM" IO("IP")=$P
48 D ZIO^%ZIS4 ;IHS/OIT/HMW SAC Exemption Applied For
49 D SET1(0),SET^BMXMSEC("XUS XOPT",XOPT),SET^BMXMSEC("XUS CNT",0)
50 S %ZIS="0H",IOP="NULL" D ^%ZIS
51 ;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen
52 S RET(0)=$P(XUENV,U,3),RET(1)=$P(XUVOL,U),RET(2)=XUCI
53 S RET(3)=$I,RET(4)=$P(XOPT,U,2),RET(5)=0 ;IHS/OIT/HMW SAC Exemption Applied For
54 I $$INHIBIT() Q
55 Q
56 ;
57SET1(FLAG) ;Setup parameters
58 D GETENV^%ZOSV S U="^",XUENV=Y,XUCI=$P(Y,U,1),XQVOL=$P(Y,U,2),XUEON=^%ZOSF("EON"),XUEOFF=^("EOFF")
59 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
60 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)
61 Q
62 ;
63INHIBIT() ;Is Logon to this system Inhibited?
64 I $G(^%ZIS(14.5,"LOGON",XQVOL)) Q 1
65 I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(XUVOL,U,3),($P(XUVOL,U,3)'>Y) Q 2
66 Q 0
67 ;
68NOW S U="^",XUNOW=$$NOW^XLFDT(),DT=$P(XUNOW,"."),XUDEV=0
69 Q
70 ;
71STATE(%) ;Return a state value
72 ;XWBSTATE is required by XUSRB
73 Q:'$L($G(%)) $G(XWBSTATE)
74 Q $G(XWBSTATE(%))
75 ;
76 ;
77SET(%,VALUE) ;Set the state variable
78 I $G(%)="" S XWBSTATE=VALUE
79 S XWBSTATE(%)=VALUE
80 Q
81KILL(%) ;Kill state variable
82 I $L($G(%)) K XWBSTATE(%)
83 Q
84 ;
85 ;
86ADDCTXT(XQUSR,XCONTEXT) ; SUPPORTS DIRECT MODE IN BMX
87 N XQMES,XQRPC,X,Y,Z,%,XQOPT,TMP
88 S TMP=$NA(^TMP("XQCS",$J))
89 S XQOPT=$O(^DIC(19,"B",XCONTEXT,0)) I 'XQOPT Q
90 S XQRPC=$O(^DIC(19,XQOPT,"RPC","B",0)) I 'XQRPC Q
91 I $D(@TMP@(XQRPC)) Q ; ITS ALREADY IN THERE ; NOTHING MORE TO DO
92 S XQMES=1
93 D USER^XQCS I 'XQMES Q ; USER DOES NOT POSSES THIS APP CONTEXT
94 S XQRPC=0
95 F S XQRPC=$O(^DIC(19,XQOPT,"RPC","B",XQRPC)) Q:'XQRPC S @TMP@(XQRPC,0)=XQRPC
96 Q
97 ;
Note: See TracBrowser for help on using the repository browser.