| 1 | BMXMSEC ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009
|
|---|
| 2 | ;;2.1;BMX;;Jul 26, 2009
|
|---|
| 3 | ; Edit History
|
|---|
| 4 | ; Line SETUP+2 has been changed to support GT.M //SMH 7/5/09
|
|---|
| 5 | ; Per Wally Fort's GT.M code in XWBTCPM, IP for GT.M is stored
|
|---|
| 6 | ; in IP("GTM-IP"). Changes in BMXMON and here follow that model.
|
|---|
| 7 | ;
|
|---|
| 8 | CHKPRMIT(BMXRP) ;EP - checks to see if remote procedure is permited to run
|
|---|
| 9 | ;Input: BMXRP - Remote procedure to check
|
|---|
| 10 | Q:$$KCHK("XUPROGMODE")
|
|---|
| 11 | N ERR,BMXALLOW
|
|---|
| 12 | S U="^",BMXSEC="" ;clear
|
|---|
| 13 | ;
|
|---|
| 14 | ;In the beginning, when no DUZ is defined and no context exist, setup
|
|---|
| 15 | ;default signon context
|
|---|
| 16 | S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON" ;set up default context
|
|---|
| 17 | ;
|
|---|
| 18 | I BMXRP'="XWB IM HERE",BMXRP'="XWB CREATE CONTEXT",BMXRP'="XWB RPC LIST",BMXRP'="BMX AV CODE" D ;check exemptions. new exemption for XWB*1.1*6 - dpc
|
|---|
| 19 | . I $G(XQY0)'="" D
|
|---|
| 20 | . . S BMXALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),BMXRP) ;do the check
|
|---|
| 21 | . . S:'BMXALLOW BMXSEC=BMXALLOW
|
|---|
| 22 | . E S BMXSEC="Application context has not been created!"
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | OWNSKEY(RET,LIST) ;EP Does user have Key
|
|---|
| 26 | N I,K S I=""
|
|---|
| 27 | I $G(DUZ)'>0 S RET(0)=0 Q
|
|---|
| 28 | I $O(LIST(""))="" S RET(0)=$$KCHK(LIST) Q
|
|---|
| 29 | F S I=$O(LIST(I)) Q:I="" S RET(I)=$$KCHK(LIST(I))
|
|---|
| 30 | Q
|
|---|
| 31 | KCHK(%) Q $S($G(DUZ)>0:$D(^XUSEC(%,DUZ)),1:0) ;EP Key Check
|
|---|
| 32 | ;
|
|---|
| 33 | ;
|
|---|
| 34 | SETUP(RET) ;EP - sets up environment for GUI signon
|
|---|
| 35 | ;
|
|---|
| 36 | K ^TMP("XQCS",$J)
|
|---|
| 37 | ; S IO("IP")=$P D ZIO^%ZIS4 ;IHS/OIT/HMW SAC Exemption Applied For
|
|---|
| 38 | ; --> Begin new code
|
|---|
| 39 | I $$OS^XWBTCPM="GT.M" S IO("IP")=IO("GTM-IP")
|
|---|
| 40 | I $$OS^XWBTCPM="OpenM" S IO("IP")=$P
|
|---|
| 41 | D ZIO^%ZIS4
|
|---|
| 42 | ; <-- End new code //SMH
|
|---|
| 43 | D SET1(0),SET^BMXMSEC("XUS XOPT",XOPT),SET^BMXMSEC("XUS CNT",0)
|
|---|
| 44 | S %ZIS="0H",IOP="NULL" D ^%ZIS
|
|---|
| 45 | ;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen
|
|---|
| 46 | S RET(0)=$P(XUENV,U,3),RET(1)=$P(XUVOL,U),RET(2)=XUCI
|
|---|
| 47 | S RET(3)=$I,RET(4)=$P(XOPT,U,2),RET(5)=0 ;IHS/OIT/HMW SAC Exemption Applied For
|
|---|
| 48 | I $$INHIBIT() Q
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | SET1(FLAG) ;Setup parameters
|
|---|
| 52 | D GETENV^%ZOSV S U="^",XUENV=Y,XUCI=$P(Y,U,1),XQVOL=$P(Y,U,2),XUEON=^%ZOSF("EON"),XUEOFF=^("EOFF")
|
|---|
| 53 | 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
|
|---|
| 54 | 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)
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | INHIBIT() ;Is Logon to this system Inhibited?
|
|---|
| 58 | I $G(^%ZIS(14.5,"LOGON",XQVOL)) Q 1
|
|---|
| 59 | I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(XUVOL,U,3),($P(XUVOL,U,3)'>Y) Q 2
|
|---|
| 60 | Q 0
|
|---|
| 61 | ;
|
|---|
| 62 | NOW S U="^",XUNOW=$$NOW^XLFDT(),DT=$P(XUNOW,"."),XUDEV=0
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | STATE(%) ;Return a state value
|
|---|
| 66 | ;XWBSTATE is required by XUSRB
|
|---|
| 67 | Q:'$L($G(%)) $G(XWBSTATE)
|
|---|
| 68 | Q $G(XWBSTATE(%))
|
|---|
| 69 | ;
|
|---|
| 70 | ;
|
|---|
| 71 | SET(%,VALUE) ;Set the state variable
|
|---|
| 72 | I $G(%)="" S XWBSTATE=VALUE
|
|---|
| 73 | S XWBSTATE(%)=VALUE
|
|---|
| 74 | Q
|
|---|
| 75 | KILL(%) ;Kill state variable
|
|---|
| 76 | I $L($G(%)) K XWBSTATE(%)
|
|---|
| 77 | Q
|
|---|
